/*  --- University of Sussex POPLOG file -----------------------------------
 *  File:           $usepop/pop/local/plog/lib/xref/xrfout.pl
 *  Purpose:        Prolog Cross-Reference Program - Output module
 *  Author:         Dave Bowen (Edinburgh), Nov 20 1983
 *  Machines:       cvaxa unx1
 *  Documentation:  HELP * XREF
 *  Related Files:  Loaded by $usepop/pop/local/plog/lib/xref.pl
 */

/*
 :- mode do_imports(+).
 :- mode do_output(+).
 :- mode do_publics(+).
 :- mode format_out(+).
 :- mode f_back(+,+,-,+).
 :- mode f_front(+,+,+,+).
 :- mode f_output(+,+).
 :- mode f_write(+,+,-,+).
 :- mode f_writepred(+,+,+,-,+).
 :- mode getentries(+,-).
 :- mode getexts(+,-).
 :- mode imports1(+).
 :- mode lngth(+,-).
 :- mode makeroom(+,+,-,+).
 :- mode nl(+).
 :- mode number_length(+,-).
 :- mode one_imp_decl(+).
 :- mode one_pub_decl(+).
 :- mode outputdclrs(+).
 :- mode publics1(+).
 :- mode writes(+).
 :- mode write_callers(+,+,-,+).
 :- mode write_centre(+,+).
*/

                /* O/P cross-ref listing in reqd format.*/
do_output(L) :-
    get_crf(File,Chars),            %  Get filename for cross-ref listing
    tell_chek(File), !,         %  Get another if can't 'tell' it
    format_out(L),              %  Output cross-reference list
    told,
    nl, 
    write('Cross-reference listing written to '),
    write(File), nl, !,
    outglobals.             %  Output import/export lists if reqd


format_out(Dbase) :- 
    get_title(Title),
    get_width(Width),
    nl,
    write_centre('**********************************',Width),
    nl,
    write_centre('* PROLOG CROSS REFERENCE LISTING *',Width),
    nl,
    write_centre('**********************************',Width),
    nl(2), write_centre(Title,Width),
    nl(3),
    tab(2), write('PREDICATE'), tab(15), write('FILE'),
    tab(11), write('CALLED BY'), nl(3),
    f_output(Dbase,Width).

                /* formatted output of cross refs */
f_output(Dbase,Width) :-
    member(e(F,N,f(I,Cs)),Dbase),
    f_front(F,N,I,Width), 
    f_back(Cs,38,_,Width), 
    fail.
f_output(_,_).

                /* Write predicate and file where defined */
f_front(F,N,I,W) :- 
    nl(2),
    f_writepred(F,N,0,C1,W),
    pos(C1,24),
    f_write(I,24,C2,W),
    pos(C2,38).

                /* Either write callers or 'NOT CALLED' */
f_back([],C1,C2,W) :- 
    f_write('NOT CALLED',C1,C2,W).
f_back([H|T],C1,C2,W) :- 
    write_callers([H|T],C1,C2,W).

                /* List callers of the predicate */
write_callers([],C,C,_) :- !.
write_callers([c(F,N)|Zs],C1,C4,W) :- 
    f_writepred(F,N,C1,C2,W),
    tab(1), C3 is C2+1,
    write_callers(Zs,C3,C4,W).

                /* Multiple newline */
nl(0) :- !.
nl(N) :- nl, N1 is N - 1, nl(N1).

                /* L is the length in chars of X */
lngth(X,L) :- 
    atomic(X), !,           % Is X an atom?
    name(X,Chars),
    length(Chars,L).
lngth(/(F,N),L) :- !,           % Is it of the form F/N?
    lngth(F,L1),
    lngth(N,L2),
    L is L1+L2+1.
lngth(X,L) :-               % Must be a list
    length(X,L).
   
                /* Write predicate remembering format info */
f_writepred('<user>',0,C1,C2,W) :- !,
    makeroom(6,C1,C2,W),
    write('<user>').
f_writepred(F,N,C1,C2,W) :-
    lngth(/(F,N),L), 
    makeroom(L,C1,C2,W),
    write(F),write(/),write(N).

                /* Write atom ditto */
f_write(X,C1,C2,W) :-
    lngth(X,L), 
    makeroom(L,C1,C2,W),
    write(X).

                /* Make sure there is room to write L */ 
makeroom(L,C1,C2,W) :- 
    (L+C1 < W ; C1 =< 38), !,
    C2 is C1+L
    ;  nl,
       tab(38),
       C2 is 38+L.

                /* Write X in the centre of current line */
write_centre(X,W) :-
    lngth(X,L),
    tab((W-L) div 2),
    writes(X).

                /* Move from column From to To */
pos(From,To) :-
    To > From, !,
    tab(To-From) ;
    nl, tab(To).

                /* Write out list of chars (string), or atom */
writes([]) :- !.
writes([C|Cs]) :- put(C), writes(Cs).
writes(X) :- write(X).

                /* Produce lists of imports and exports if
                   wanted. */

outglobals :-
    get_globals_file(File,Chars),   % Import/exp list reqd for each file?
    tell_chek(File), !,     % Yes, open file (or backtrack)
    decls_to_one_file,      % Output globals for all files
    told,
    nl,
    write('Globals listing written to '),
        write(File), nl.

                /* Output imp/exp lists for all files */
decls_to_one_file :-
    recorded('$file'(_),'$file'(F),P),  % Yes, find a file in database
    erase(P),               % Erase it
    write('FILE  '), write(F), nl, nl,
    outputdclrs(F), nl, nl,         % Backtrack thro all files
    fail.
decls_to_one_file.

                /* Output 'public' and 'import' declarations
                   for a file. Declarations start with
                   '%declarations%' and end with '%end%' */
outputdclrs(F) :-
    getexts(F,Lx),              %  List its imports
    getentries(F,Le),           %  List its exports
    qsort(Lx,Lsx,[]),           %  Sort import list
    qsort(Le,Lse,[]),           %  Sort export list
    write('%declarations%'), nl, nl,
    do_publics(Lse),
    do_imports(Lsx),
    write('%end%'), nl.

                /* Build list of externals */
getexts(F,[e(G,N,f(I,_))|Exts]) :-
    recorded(F,'$ext'(F,P),Ptr),
    erase(Ptr), !,
    functor(P,G,N),
    defn_file(P,I),
    getexts(F,Exts).
getexts(_,[]).

                /* Build list of entries */
getentries(F,[e(G,N,_)|Ents]) :-
    recorded(F,'$entry'(F,P),Ptr),
    erase(Ptr), !,
    functor(P,G,N),
    getentries(F,Ents).
getentries(_,[]).

                /* Output public decls (exports) for a file */
do_publics([]) :- !.
do_publics([E|L]) :-
    write('% public procedures:'), nl, one_pub_decl(E), publics1(L).

one_pub_decl(e(F,N,_)) :- put(37), put(9), put(9), writepred(F,N).

publics1([E|L]) :- !, nl, one_pub_decl(E), publics1(L).
publics1([]) :- nl, nl.

                /* Output import decls for a file */
do_imports([]) :- !.
do_imports(L) :-
    write('% imports:'), nl,
    imports1(L), nl.

imports1([]).
imports1([E|L]) :- one_imp_decl(E), imports1(L).

one_imp_decl(e(F,N,f(I,_))) :-
    put(37), put(9), put(9), writepred(F,N),
    name(F,Na), length(Na,N1),
    number_length(N,N2), tab(24-N1-N2 - 1),
    write('(from '), write(I), put(41), nl.

number_length(N,1) :- N<10, !.
number_length(N,2) :- N<100, !.
number_length(N,3).
