mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
65f41d71b2
extras/cgi/html.m:
There is no HTML tag named "it", it is supposed to be "i".
Fix a misformed attribute value.
Fix incorrect character code character escapes.
451 lines
14 KiB
Mathematica
451 lines
14 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1997, 2006 The University of Melbourne.
|
|
% Copyright (C) 2014, 2018, 2022, 2025-2026 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: html.m.
|
|
% Author: fjh.
|
|
%
|
|
% This module provides a strongly-typed, quite declarative method
|
|
% for representing and outputting arbitrary HTML text.
|
|
% It is intended for use in CGI scripts.
|
|
%
|
|
% Basically all the predicates here are wrappers around io.write_string.
|
|
% However, the types defined here let you indicate the structure of your
|
|
% HTML text in the structure of the Mercury terms used to represent it.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module html.
|
|
:- interface.
|
|
|
|
:- import_module bool.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module pair.
|
|
:- import_module string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type html
|
|
---> html(
|
|
header,
|
|
body
|
|
).
|
|
|
|
:- type header == list(header_item).
|
|
|
|
:- type header_item
|
|
---> title(markup)
|
|
; header_item(string). % String can contain any HTML markup.
|
|
% This is a general "catch-all" for
|
|
% anything not covered by the above
|
|
% cases.
|
|
:- type body == markup.
|
|
|
|
% XXX add anchors
|
|
:- type markup
|
|
---> heading(int, markup)
|
|
; style(style, markup) % a.k.a. logical style
|
|
; font(font, markup) % a.k.a. physical style
|
|
; text(string)
|
|
; definition_list(list(pair(markup)))
|
|
; list(list_type, list(markup))
|
|
; form(string, markup) % actionURL, form contents
|
|
; field(string, field) % name, field type
|
|
; address(markup)
|
|
; np % new paragraph
|
|
; br % line break
|
|
; hr % horizontal_rule
|
|
; markup(string) % String can contain any HTML markup.
|
|
% This is a general "catch-all" for
|
|
% anything not covered by the above
|
|
% cases.
|
|
; ','(markup, markup).
|
|
|
|
:- type list_type
|
|
---> ordered
|
|
; unordered
|
|
; menu
|
|
; directory.
|
|
|
|
:- type style
|
|
---> emph
|
|
; strong
|
|
; samp
|
|
; code
|
|
; keyboard
|
|
; cite
|
|
; var.
|
|
|
|
:- type font
|
|
---> italics
|
|
; bold
|
|
; underline
|
|
; typewriter. % typewriter fixed-width font
|
|
|
|
% XXX add maps
|
|
:- type field
|
|
---> text(
|
|
int, % size (display width in characters)
|
|
int, % maxlength
|
|
string % initial (default) value
|
|
)
|
|
|
|
; password(
|
|
int, % size
|
|
int, % maxlength
|
|
string % initial (default) value
|
|
)
|
|
|
|
; textarea(
|
|
int, int, % rows, columns
|
|
string % initial (default) value
|
|
)
|
|
|
|
; checkbox(
|
|
bool, % initial (default) value
|
|
string % value sent, if checkbox set
|
|
)
|
|
|
|
; radio(
|
|
bool, % initial (default) value
|
|
string % value sent, if button set
|
|
)
|
|
|
|
; select(
|
|
int, % size,
|
|
bool, % allow multiple selections?
|
|
list(pair(
|
|
string, % selection text
|
|
bool % selected?
|
|
))
|
|
)
|
|
|
|
; submit(
|
|
string % text on the pushbutton
|
|
)
|
|
|
|
; reset(
|
|
|
|
string % text on the pushbutton
|
|
)
|
|
|
|
; hidden(
|
|
string % value
|
|
).
|
|
|
|
:- pred output_content_type_html(io::di, io::uo) is det.
|
|
|
|
:- pred output_html(html::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_header(header::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_header_item(header_item::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_body(body::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_markup(markup::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_field(string::in, field::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_form_start(string::in, io::di, io::uo) is det.
|
|
|
|
:- pred output_form_end(io::di, io::uo) is det.
|
|
|
|
% Convert any special characters in a HTML markup string into
|
|
% appropriate HTML escapes.
|
|
%
|
|
:- func escape_html_string(string) = string.
|
|
:- pred escape_html_string(string::in, string::out) is det.
|
|
|
|
% Convert any special characters in a HTML attribute value string into
|
|
% appropriate HTML escapes.
|
|
%
|
|
:- func escape_attr_string(string) = string.
|
|
:- pred escape_attr_string(string::in, string::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module char.
|
|
:- import_module int.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func list_type_name(list_type) = string.
|
|
|
|
list_type_name(ordered) = "ol".
|
|
list_type_name(unordered) = "ul".
|
|
list_type_name(menu) = "menu".
|
|
list_type_name(directory) = "dir".
|
|
|
|
:- func style_name(style) = string.
|
|
|
|
style_name(emph) = "em".
|
|
style_name(strong) = "strong".
|
|
style_name(samp) = "samp".
|
|
style_name(code) = "code".
|
|
style_name(keyboard) = "kbd".
|
|
style_name(cite) = "cite".
|
|
style_name(var) = "var".
|
|
|
|
:- func font_name(font) = string.
|
|
|
|
font_name(italics) = "i".
|
|
font_name(bold) = "b".
|
|
font_name(underline) = "u".
|
|
font_name(typewriter) = "tt".
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
output_content_type_html(!IO) :-
|
|
io.write_string("Content-type: text/html\n\n", !IO).
|
|
|
|
output_html(html(Head, Body), !IO) :-
|
|
output_header(Head, !IO),
|
|
io.nl(!IO),
|
|
output_body(Body, !IO).
|
|
|
|
output_header(HeaderItems, !IO) :-
|
|
output_markup_scope("head",
|
|
output_list(output_header_item, HeaderItems), !IO).
|
|
|
|
output_header_item(title(Title), !IO) :-
|
|
output_markup_scope("title", output_markup(Title), !IO).
|
|
output_header_item(header_item(Markup), !IO):-
|
|
io.write_string(Markup, !IO).
|
|
|
|
output_body(Body, !IO) :-
|
|
output_markup_scope("body", output_markup(Body), !IO).
|
|
|
|
output_markup((Markup1, Markup2), !IO) :-
|
|
output_markup(Markup1, !IO),
|
|
output_markup(Markup2, !IO).
|
|
output_markup(address(Address), !IO) :-
|
|
output_markup_scope("address", output_markup(Address), !IO).
|
|
output_markup(heading(Level, Heading), !IO) :-
|
|
io.format("<h%d>", [i(Level)], !IO),
|
|
output_markup(Heading, !IO),
|
|
io.format("</h%d>\n", [i(Level)], !IO).
|
|
output_markup(definition_list(Definitions), !IO) :-
|
|
output_markup_scope("dl",
|
|
output_list(output_definition, Definitions), !IO).
|
|
output_markup(list(ListType, Items), !IO) :-
|
|
output_markup_scope(list_type_name(ListType),
|
|
output_list(output_list_item, Items), !IO).
|
|
output_markup(style(Style, Markup), !IO) :-
|
|
output_markup_scope(style_name(Style),
|
|
output_markup(Markup), !IO).
|
|
output_markup(font(Font, Markup), !IO) :-
|
|
output_markup_scope(font_name(Font),
|
|
output_markup(Markup), !IO).
|
|
output_markup(text(Text), !IO) :-
|
|
io.write_string(escape_html_string(Text), !IO).
|
|
output_markup(form(ActionURL, Markup), !IO) :-
|
|
output_form_start(ActionURL, !IO),
|
|
output_markup(Markup, !IO),
|
|
output_form_end(!IO).
|
|
output_markup(field(Name, Field), !IO):-
|
|
output_field(Name, Field, !IO).
|
|
output_markup(markup(String), !IO):-
|
|
io.write_string(String, !IO).
|
|
output_markup(np, !IO) :-
|
|
io.write_string("<p>\n", !IO).
|
|
output_markup(br, !IO) :-
|
|
io.write_string("<br>\n", !IO).
|
|
output_markup(hr, !IO) :-
|
|
io.write_string("<hr>\n", !IO).
|
|
|
|
:- pred output_definition(pair(markup)::in, io::di, io::uo) is det.
|
|
|
|
output_definition(Item - Description, !IO) :-
|
|
io.write_string("<dt> ", !IO),
|
|
output_markup(Item, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("<dd> ", !IO),
|
|
output_markup(Description, !IO),
|
|
io.nl(!IO).
|
|
|
|
:- pred output_list_item(markup::in, io::di, io::uo) is det.
|
|
|
|
output_list_item(Item, !IO) :-
|
|
io.write_string("<li> ", !IO),
|
|
output_markup(Item, !IO),
|
|
io.nl(!IO).
|
|
|
|
output_form_start(ActionURL, !IO) :-
|
|
io.format("<form action=""%s"" method=""POST"">\n",
|
|
[s(escape_attr_string(ActionURL))], !IO).
|
|
|
|
output_form_end(!IO) :-
|
|
io.write_string("</form>\n", !IO).
|
|
|
|
output_field(Name, text(Size, MaxLength, Value), !IO) :-
|
|
io.format(
|
|
"<input name=""%s"" type=""text"" size=""%d"" maxlength=""%d"" value=""%s"">",
|
|
[s(Name), i(Size), i(MaxLength), s(escape_attr_string(Value))], !IO).
|
|
output_field(Name, password(Size, MaxLength, Value), !IO) :-
|
|
io.format(
|
|
"<input name=""%s"" type=""password"" size=""%d"" maxlength=""%d"" value=""%s"">",
|
|
[s(Name), i(Size), i(MaxLength), s(escape_attr_string(Value))], !IO).
|
|
output_field(Name, textarea(Rows, Columns, Value), !IO) :-
|
|
io.format("<textarea name=""%s"" rows=""%d"" cols=""%d"">",
|
|
[s(Name), i(Rows), i(Columns)], !IO),
|
|
io.write_string(escape_html_string(Value), !IO),
|
|
io.write_string("</textarea>", !IO).
|
|
output_field(Name, checkbox(Checked, Value), !IO) :-
|
|
io.format("<input name=""%s"" type=""checkbox"" value=""%s""",
|
|
[s(Name), s(escape_attr_string(Value))], !IO),
|
|
(
|
|
Checked = yes,
|
|
io.write_string(" checked", !IO)
|
|
;
|
|
Checked = no
|
|
),
|
|
io.write_string(">", !IO).
|
|
output_field(Name, radio(Checked, Value), !IO) :-
|
|
io.format("<input name=""%s"" type=""radio"" value=""%s""",
|
|
[s(Name), s(escape_attr_string(Value))], !IO),
|
|
(
|
|
Checked = yes,
|
|
io.write_string(" checked", !IO)
|
|
;
|
|
Checked = no
|
|
),
|
|
io.write_string(">", !IO).
|
|
output_field(Name, select(Size, Multiple, Options), !IO) :-
|
|
io.format("<select name=""%s"" size=""%d"" ", [s(Name), i(Size)], !IO),
|
|
(
|
|
Multiple = yes,
|
|
io.write_string("multiple", !IO)
|
|
;
|
|
Multiple = no
|
|
),
|
|
io.write_string(">\n", !IO),
|
|
output_list(output_selection_option, Options, !IO),
|
|
io.write_string("</select>", !IO).
|
|
output_field(Name, submit(Value), !IO) :-
|
|
io.format("<input name=""%s"" type=""submit"" value=""%s"">",
|
|
[s(Name), s(escape_attr_string(Value))], !IO).
|
|
output_field(Name, reset(Value), !IO) :-
|
|
io.format("<input name=""%s"" type=""reset"" value=""%s"">",
|
|
[s(Name), s(escape_attr_string(Value))], !IO).
|
|
output_field(Name, hidden(Value), !IO) :-
|
|
io.format("<input name=""%s"" type=""hidden"" value=""%s"">",
|
|
[s(Name), s(escape_attr_string(Value))], !IO).
|
|
|
|
:- pred output_selection_option(pair(string, bool)::in, io::di, io::uo)
|
|
is det.
|
|
|
|
output_selection_option(Text - Selected, !IO) :-
|
|
(
|
|
Selected = yes,
|
|
io.write_string("<option selected>", !IO)
|
|
;
|
|
Selected = no,
|
|
io.write_string("<option>", !IO)
|
|
),
|
|
io.write_string(escape_html_string(Text), !IO),
|
|
io.nl(!IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred output_markup_scope(string::in, pred(io, io)::in(pred(di, uo) is det),
|
|
io::di, io::uo) is det.
|
|
|
|
output_markup_scope(Name, OutputBody, !IO) :-
|
|
io.format("<%s>\n", [s(Name)], !IO),
|
|
OutputBody(!IO),
|
|
io.format("</%s>\n", [s(Name)], !IO).
|
|
|
|
:- pred output_list(pred(T, io, io)::in(pred(in, di, uo) is det), list(T)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
output_list(Pred, List, !IO) :-
|
|
list.foldl(Pred, List, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
escape_html_string(S) = ES :-
|
|
escape_html_string(S, ES).
|
|
|
|
escape_html_string(String, EscapedString) :-
|
|
string.to_char_list(String, Chars),
|
|
escape_html_chars(Chars, EscapedChars, []),
|
|
string.from_char_list(EscapedChars, EscapedString).
|
|
|
|
:- pred escape_html_chars(list(char)::in, list(char)::out, list(char)::in)
|
|
is det.
|
|
|
|
escape_html_chars([]) --> [].
|
|
escape_html_chars([Char|Chars]) -->
|
|
escape_html_char(Char),
|
|
escape_html_chars(Chars).
|
|
|
|
:- pred escape_html_char(char::in, list(char)::out, list(char)::in) is det.
|
|
|
|
escape_html_char(Char) -->
|
|
( if { special_html_char(Char, String) } then
|
|
{ string.to_char_list(String, Chars) },
|
|
insert(Chars)
|
|
else
|
|
[Char]
|
|
).
|
|
|
|
escape_attr_string(S) = ES :-
|
|
escape_attr_string(S, ES).
|
|
|
|
escape_attr_string(String, EscapedString) :-
|
|
string.to_char_list(String, Chars),
|
|
escape_attr_chars(Chars, EscapedChars, []),
|
|
string.from_char_list(EscapedChars, EscapedString).
|
|
|
|
:- pred escape_attr_chars(list(char)::in, list(char)::out, list(char)::in)
|
|
is det.
|
|
|
|
escape_attr_chars([]) --> [].
|
|
escape_attr_chars([Char | Chars]) -->
|
|
escape_attr_char(Char),
|
|
escape_attr_chars(Chars).
|
|
|
|
:- pred escape_attr_char(char::in, list(char)::out, list(char)::in) is det.
|
|
|
|
escape_attr_char(Char) -->
|
|
( if { special_attr_char(Char, String) } then
|
|
{ string.to_char_list(String, Chars) },
|
|
insert(Chars)
|
|
else
|
|
[Char]
|
|
).
|
|
|
|
:- pred special_html_char(char::in, string::out) is semidet.
|
|
|
|
special_html_char('&',"&").
|
|
special_html_char('<',"<").
|
|
special_html_char('>',">").
|
|
|
|
:- pred special_attr_char(char::in, string::out) is semidet.
|
|
|
|
special_attr_char('&', "&").
|
|
special_attr_char('>', ">").
|
|
special_attr_char('\t', "	").
|
|
special_attr_char('\r', " ").
|
|
special_attr_char('\n', " ").
|
|
special_attr_char(' ', " ").
|
|
special_attr_char('"', """).
|
|
|
|
:- pred insert(list(T)::in, list(T)::out, list(T)::in) is det.
|
|
|
|
insert(NewChars, Chars, Chars0) :-
|
|
list.append(NewChars, Chars0, Chars).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module html.
|
|
%---------------------------------------------------------------------------%
|