1:- use_module(library(pillow)).    2:- use_module(parser_utils).    3:- use_module(library(lists)).    4
    5:- dynamic html_env/1.    6
    7browse_html(File,Atom):-
    8    read_file_to_string(File,String),
    9    html2terms(String,Term),
   10    atom_codes(Atom,SearchString),
   11    find_pos(env(a,[name=SearchString],[]),Term,Following),
   12    print_html(Following).
   13
   14list_topics(File):-
   15    read_file_to_string(File,String),
   16    html2terms(String,Term),
   17    write('Help available on the following topics'), nl,
   18    write('======================================'), nl,
   19    list_topics_term(Term).
   20
   21list_topics_term([env(a,[name=Topics],[])|T]):- !,
   22    write(' *'), format('~s',[Topics]), write('* '), nl,
   23    list_topics_term(T).
   24list_topics_term([]).
   25list_topics_term([env(_,_,L)|T]):-!,
   26    list_topics_term(L),
   27    list_topics_term(T).
   28list_topics_term([_|T]):-
   29    list_topics_term(T).
   30
   31find_pos(H,[H|T],T):- !.
   32find_pos(H,[env(_,_,L)|_],R):-
   33    find_pos(H,L,R),!.
   34find_pos(X,[_|T],R):-
   35    find_pos(X,T,R).
   36
   37print_html([]):-!.
   38print_html([env(a,[name=_],[])|_]):- !. % Next help topic: end
   39print_html([env(h1,_,[L])|T]):- !, nl, format('~s',[L]), nl, 
   40    underline(L,'='), nl, print_html(T).
   41print_html([env(h2,_,[L])|T]):- !, nl, format('~s',[L]), nl, 
   42    underline(L,'='), nl, print_html(T).
   43print_html([env(h3,_,[L])|T]):- !, nl, format('~s',[L]), nl,
   44    underline(L,'-'), nl, print_html(T).
   45print_html([env(h4,_,[L])|T]):- !, nl, format('~s',[L]), nl,
   46    nl, print_html(T).
   47print_html([env(h5,_,[L])|T]):- !, nl, format('~s',[L]), print_html(T).
   48print_html([env(h6,_,[L])|T]):- !, nl, format('~s',[L]), print_html(T).
   49print_html([env(p,_,L)|T]):- !, print_html(L), nl, print_html(T).
   50print_html([comment(_)|T]):- !, print_html(T).
   51print_html([env(a,_,L)|T]):- !, write(' *'), print_html(L), write('* '), print_html(T).
   52print_html([env(ul,_,L)|T]):- !, print_html(L), nl, print_html(T).
   53print_html([li$[]|T]):- !, nl, write(' - '), print_html(T).
   54print_html([env(li,_,L)|T]):- !, nl, write(' - '), print_html(L), print_html(T).
   55print_html([env(center,_,L)|T]):- !, nl, write('   '), print_html(L), nl, print_html(T).
   56% Ugly but fast ...
   57print_html([env(pre,_,L)|T]):- assert(html_env(pre)), print_html(L), nl, 
   58    retract(html_env(pre)), print_html(T).
   59print_html([p$[]|T]):-!, nl, print_html(T).
   60print_html([br$[]|T]):- !, nl, print_html(T).
   61print_html([hr$[]|T]):-!, nl, 
   62    write('---------------------------------------------------------------------'),
   63    nl,
   64    print_html(T).
   65print_html([env(_ENV,_,L)|T]):- %all other environments are ignored
   66    !, print_html(L), print_html(T).
   67print_html([[]|T]):-!,
   68    print_html(T).
   69%print_html([L|T]):-
   70%    L=[10|L1],!,
   71%    format('~s',[L1]),
   72%    print_html(T).
   73print_html([L|T]):-
   74    L=[_|_],!,
   75    %format('~s',[L]),
   76    print_string(L),
   77    print_html(T).
   78
   79underline([],_).
   80underline([_|T],C):-
   81    format('~s',[C]),
   82    underline(T,C).
   83
   84print_string([]).
   85print_string([10|S]):- html_env(pre), !, nl, print_string(S).
   86print_string([10|S]):- write(' '), print_string(S).
   87print_string(S):-
   88    special_char(Char,Atom),
   89    atom_codes(Char,S1), append(S1,T,S),!,
   90    write(Atom), print_string(T).
   91print_string([C|S]):- format('~s',[[C]]), print_string(S).
   92
   93% Special html characters: special_char(htmlcode,atom to visualise).
   94special_char('→','--->').
   95special_char('∧','/\\').
   96special_char('∨','\\/').
   97special_char('∃',' EXISTS ').
   98special_char('∀',' FORALL ').
   99special_char('>','>').
  100special_char('&lt;','<').
  101special_char('&nbsp;',' ')