% *** html.pl *** (Version 96.1.2)
% A Simple HTML Package for Prolog and CLP systems
% 
% Copyright (C) 1996 UPM-CLIP.
% 
% This package is free software; you can redistribute it and/or
% modify it under the terms of the GNU Library General Public
% License as published by the Free Software Foundation; either
% version 2 of the License, or (at your option) any later version.
% 
% This package is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
% Library General Public License for more details.
% 
% You should have received a copy of the GNU Library General Public
% License along with this package; if not, write to the Free
% Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
% 
% M. Hermenegildo (herme@fi.upm.es) & D. Cabeza (dcabeza@fi.upm.es)
% using input from L. Naish's forms and F. Bueno's previous Chat interface

%% Taken from the CIAO system library

%%% Part 0 - Configuration %%%

%% CHANGED BY Makefile
icon_base_address('<ICONDIR>').
cgi_bin_dir('<CGIBINDIR>').

%% Hook predicate to define macros
% Leave at least one so that no existence errors are generated
% on any system. Take care to not transform something into itself!
html_expansion(bf(X),b(X)).
html_expansion(it(X),i(X)).

%%% Part 1 - Some icon addresses %%%

icon_address(warning,IAddress):-
        icon_base_address(BAddress),
        atom_concat(BAddress,'warning_large.gif',IAddress).
icon_address(dot,IAddress):-
        icon_base_address(BAddress),
        atom_concat(BAddress,'redball.gif',IAddress).
icon_address(clip,IAddress):-
        icon_base_address(BAddress),
        atom_concat(BAddress,'clip.gif',IAddress).

%%% Part 2 - generation of HTML documents and forms %%%

% The idea is to have a CIAO/Prolog syntax description of a document as a 
% term and then use html_term/3 to generate a list of atoms
% which can be then written into a document. 

% Some operators used
:- op(500,xfx,'$').
:- op(500,fx,'$').

% Translate html format and send to stdout
output_html(F) :-
        html_term(F,L,[]),
        output_list(L).

% Error handling
html_report_error(X) :-
        (icon_address(warning,Icon) -> Image = image(Icon); Image = ''),
        output_html([
          form_reply,
          start,
          title('html_pl Error Report'), 
          --,
          Image,
          heading(1,'html_pl Error Report'),
          --,
          heading(3,'The following error was encountered:'),
          X,
          --,
          end]),
        ttyflush.

% HTML translation 
html_term(X) --> {var(X)}, !,
        ['<b>**Warning free variable**</b>'].
html_term(T) --> {html_expansion(T,NT)}, !,
        html_term(NT).
html_term(start) --> !, ['<html>'].
html_term(end)   --> !, ['</html>'].
html_term(--)  --> !, newline, ['<hr>'], newline.
html_term(\\) --> !, ['<br>'], newline.
html_term($)  --> !, newline, ['<p>'].
html_term(comment(C)) --> !,
        ['<!-- ',C,' -->'],
        newline.
html_term(title(T)) --> !,
        ['<title>',T,'</title>'],
        newline.
html_term(image(Addr)) --> !,
        ['<img'],
        html_atts([src=Addr]),
        ['>'].
html_term(image(Addr,Atts)) --> !,
        ['<img'],
        html_atts([src=Addr|Atts]),
        ['>'].
html_term(ref(Addr,Text)) --> !,
        ['<a'],
        html_atts([href=Addr]),
        ['>'],
        html_term(Text),
        ['</a>'].
html_term(label(Label,Text)) --> !,
        ['<a'],
        html_atts([name=Label]),
        ['>'],
        html_term(Text),
        ['</a>'].
html_term(heading(L,X)) --> !,
        {atom_concat('h',L,E)},
        html_env(E,X),
        newline.
html_term(itemize(L)) --> !,
        ['<ul>'],
        newline,
        html_items(L),
        ['</ul>'].
html_term(enumerate(L)) --> !,
        ['<ol>'],
        newline,
        html_items(L),
        ['</ol>'].
html_term(description(L)) --> !,
        ['<dl>'],
        newline,
        html_descriptions(L),
        ['</dl>'].
html_term(nice_itemize(L)) --> !,
        ['<dl>'],
        newline,
        html_nice_items(L),
        ['</dl>'].
html_term(preformatted(X)) --> !,
        ['<pre>'],
        newline,
        preformatted_lines(X),
        ['</pre>'].
% Forms
html_term(form(Addr)) --> !, 
        ['<form method="POST" action="',Addr,'">'],
        newline.
html_term(end_form) --> !,
        ['</form>'].
html_term(checkbox(Name,on)) --> !,
        ['<input'],
        html_atts([name=Name,type=checkbox,checked]),
        ['>'].
html_term(checkbox(Name,_)) --> !,
        ['<input'],
        html_atts([name=Name,type=checkbox]),
        ['>'].
html_term(radio(Name,Value,Value)) --> !,
        ['<input'],
        html_atts([name=Name,type=radio,value=Value,checked]),
        ['>'].
html_term(radio(Name,Value,_)) --> !,
        ['<input'],
        html_atts([name=Name,type=radio,value=Value]),
        ['>'].
html_term(input(Type,Atts)) --> !,
        ['<input'],
        html_atts([type=Type|Atts]),
        ['>'].
html_term(textarea(Name,Atts,Text)) --> !,
        ['<textarea'],
        html_atts([name=Name|Atts]),
        ['>',Text,'</textarea>'].
html_term(menu(Name,Atts,Items)) --> !,
        ['<select'],
        html_atts([name=Name|Atts]),
        ['>'],
        html_options(Items),
        ['</select>'].
html_term(form_reply) --> !,
        ['Content-type: text/html'],
        newline,
        newline.
% Constructs
html_term(verbatim(Text)) --> !,
        html_quoted(Text).
html_term(nl) --> !, newline. % Just to improve HTML source readability
html_term([]) --> !.
html_term([E|Es]) --> !,
        html_term(E),
        html_term(Es).
html_term(begin(T)) --> !,
        ['<',T,'>'].
html_term(begin(T,Atts)) --> !,
        ['<',T],
        html_atts(Atts),
        ['>'].
html_term(end(T)) --> !,
        ['</',T,'>'].
html_term(T$Atts) --> !,
        ['<',T],
        html_atts(Atts),
        ['>'].
html_term(F) --> {F =.. [Env,X]}, !,
        html_env(Env,X).
html_term(F) --> {F =.. [Env,Atts,X]}, !,
        html_env_atts(Env,Atts,X).
html_term(X) --> [X].

newline --> ['
'].

html_atts([]) --> [].
html_atts([A|As]) -->
        [' '],
        html_att(A),
        html_atts(As).

html_att(A) --> {atom(A)}, !, [A].
html_att(A=V) --> !, [A,'="',V,'"'].

html_env(E,I) -->
        ['<',E,'>'],
        html_term(I),
        ['</',E,'>'].

html_env_atts(E,Atts,I) -->
        ['<',E],
        html_atts(Atts),
        ['>'],
        html_term(I),
        ['</',E,'>'].

html_items([]) --> [].
html_items([It|Its]) -->
        ['<li> '],
        html_term(It),
        newline,
        html_items(Its).

html_descriptions([]) --> [].
html_descriptions([D|Ds]) -->
        html_description(D),
        html_descriptions(Ds).

html_description((T,D)) --> !,
        ['<dt>'],
        html_term(T),
        newline,
        html_description(D).
html_description(D) -->
        ['<dd>'],
        html_term(D),
        newline.

html_nice_items([]) --> [].
html_nice_items([It|Its]) -->
        {icon_address(dot,Button)},
        ['<dd><img src="',Button,'" align="bottom" alt="*">'],
        html_term(It),
        newline,
        html_nice_items(Its).

preformatted_lines([]) --> [].
preformatted_lines([X|Xs]) -->
        html_term(X),
        newline,
        preformatted_lines(Xs).

html_options([]) --> [].
html_options([$Op|Ops]) --> !,
        ['<option selected>',Op,'</option>'],
        newline,
        html_options(Ops).
html_options([Op|Ops]) -->
        ['<option>',Op,'</option>'],
        newline,
        html_options(Ops).

html_quoted(T) -->
        {name(T,N),
         html_quoted_chars(N,NQ,[]),
         name(TQ,NQ)},
        [TQ].

html_quoted_chars([]) --> [].
html_quoted_chars([C|T]) -->
        html_quoted_char(C),
        html_quoted_chars(T).

html_quoted_char(0'>) --> !, "&gt;".
html_quoted_char(0'<) --> !, "&lt;".
html_quoted_char(0'&) --> !, "&amp;".
html_quoted_char(0'") --> !, "&quot;".
html_quoted_char(C)   --> [C].

output_list([]) :- !.
output_list([H|T]) :- !,
        output_list(H),
        output_list(T).
output_list(Atom) :- write(Atom).

%%% Part 3 - parsing of forms input %%%

% First, some checks (not always appropriate)
html_form_check :-
        html_check_content,
        html_check_method.

html_check_content :-
        (getenv('CONTENT_TYPE', 'application/x-www-form-urlencoded') ->
          true
        ;
          html_report_error(
          'This script can only be used to decode form results.')
        ).

html_check_method :-
        (getenv('REQUEST_METHOD', 'POST') ->
          true
        ;
          html_report_error([
          'This script should be referenced with a METHOD of POST.', \\,
          'If you don''t understand this, read the ',
          ref('http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs/fill-out-forms/overview.html','forms overview'),'.'])
        ).

% Receiving form input as a dictionary of attribute=value pairs
html_get_form_input(NVs) :-
        html_get_input_chars(Cs),
        html_input_to_nvs(NVs, Cs, []).

html_get_input_chars(Cs) :-
        (getenv('CONTENT_LENGTH', N) ->
             atom_chars(N,NS),
             number_chars(No,NS),
             read_all(No,Cs,"&")
        ;
          Cs = []
        ).

% read N chars from input (N>=0)
read_all(0) --> !, "".
read_all(N) -->
        {get0(C)},
        [C],
        {N1 is N - 1},
        read_all(N1).

% Converts string "name1=val1&name2=val2&name3=&" into
% list of pairs [name1='val1', name2='val2', name3=true] etc
% Funny chars, eg = and & never occur in vals (they appear as
% escape sequences)
html_input_to_nvs([]) --> "".
html_input_to_nvs([N1=V1|NVs]) -->
        chars_to(N,0'=),
        {name(N1, N)},
        chars_to(V,0'&),
        {expand_esc_plus(V,EV,[]),
         to_value(EV,V1)},
        html_input_to_nvs(NVs).

chars_to([],C) --> [C].
chars_to([C|Cs],D) -->
        [C],
        {C \== D},
        chars_to(Cs,D).

% Expands escape sequences and converts "+" back into " " in a string
expand_esc_plus([]) --> "".
expand_esc_plus([0'+|Cs]) --> !,
        " ",
        expand_esc_plus(Cs).
expand_esc_plus([0'%,C1,C2|Cs]) --> !,
        {hex_digit(C1,D1),
         hex_digit(C2,D2),
         C is D1 * 16 + D2},
        [C],
        expand_esc_plus(Cs).
expand_esc_plus([C|Cs]) -->
        [C],
        expand_esc_plus(Cs).

hex_digit(C, D) :-
        (C >= 0'A ->
          D is ((C /\ 223) - 0'A) + 10 % 223 = bin(11011111)
        ;
          D is C - 0'0
        ).

to_value(S,N) :- S = "" -> N=true ; name(N,S).

% Get value Val for attribute Var in dictionary Dic
% Does not fail: value is '' if not found.
html_get_value([],_Var,'').
html_get_value([Var=Val|_],Var,Val) :- !.
html_get_value([_|Dic],Var,Val) :- 
        html_get_value(Dic,Var,Val).

% Some generic help for dealing with the very weird things that empty text 
% areas and boxes can send
html_empty_value(true) :- !.
html_empty_value([]) :- !.
html_empty_value(X) :- name(X,XS), html_empty_string(XS,[]), !.

html_empty_string --> [].
html_empty_string --> foochar, html_empty_string.

foochar --> [10].
foochar --> [13].
foochar --> " ".

% Set form defaults
default(Val,Default,NewVal) :- 
        ( Val == '' -> NewVal = Default; NewVal = Val).

