PreviousUpNext

15.4.815  src/lib/html/pr-html.pkg

## pr-html.pkg

# Compiled by:
#     src/lib/html/html.lib

# Pretty-print an HTML tree.

package unparse_html_tree: (weak)
api {
    unparse_html_tree:  {
            putc:     Char -> Void,
            puts:     String -> Void
          } -> html::Html -> Void;

}
{
    package h=  html;           # html          is from   src/lib/html/html.pkg
    package f=  sfprintf;       # sfprintf      is from   src/lib/src/sfprintf.pkg

    Output_Stream
        =
        OS {
          putc:  Char -> Void,
          puts:  String -> Void
        };

    fun putc (OS { putc, ... }, c) = putc c;
    fun puts (OS { puts, ... }, s) = puts s;

    Attribute_Data
      = IMPLICIT  Bool
      | CDATA   Null_Or( String )
      | NAME    Null_Or( String )
      | NUMBER  Null_Or( Int )
      ;

    stipulate

        fun name to_string NULL    =>  NAME NULL;
            name to_string (THE x) =>  NAME (THE (to_string x));
        end;

    herein

        http_method     = name html::http_method::to_string;
        input_type      = name html::input_type::to_string;
        i_align         = name html::ialign::to_string;
        h_align         = name html::halign::to_string;
        cell_valign     = name html::cell_valign::to_string;
        caption_align   = name html::caption_align::to_string;
        ul_style                = name html::ulstyle::to_string;
        shape           = name html::shape::to_string;
        text_flow_ctl   = name html::text_flow_ctl::to_string;

    end; #  local 

    fun fmt_tag (tag, [])
            =>
            cat ["<", tag, ">"];

        fmt_tag (tag, attributes)
            =>
            {   fun fmt_attribute (attribute_name, IMPLICIT TRUE)
                        =>
                        THE attribute_name;

                    fmt_attribute (attribute_name, CDATA (THE s))
                        =>
                        THE (f::sprintf' "%s=\"%s\"" [f::STRING attribute_name, f::STRING s]);

                    fmt_attribute (attribute_name, NAME (THE s))
                        =>
                        THE (f::sprintf' "%s=%s" [f::STRING attribute_name, f::STRING s]);

                    fmt_attribute (attribute_name, NUMBER (THE n))
                        =>
                        THE (f::sprintf' "%s=%d" [f::STRING attribute_name, f::INT n]);

                    fmt_attribute _
                        =>
                        NULL;
                end;

                attributes = list::map_partial_fn fmt_attribute attributes;

                list_to_string::list_to_string' {
                    first     =>  "<",
                    between   =>  " ",
                    last      =>  ">",
                    to_string =>  fn x = x
                } (tag ! attributes);
            };
    end;

    fun fmt_end_tag tag = cat ["</", tag, ">"];

    fun pr_tag     (OS { puts, ... }, tag, attributes) =  puts (fmt_tag (tag, attributes));
    fun pr_end_tag (OS { puts, ... }, tag       ) =  puts (fmt_end_tag tag);

    fun new_line   (OS { putc, ... } ) =  putc '\n';
    fun space      (OS { putc, ... } ) =  putc ' ';

    # NOTE: once we are doing linebreaks for text,
    # this becomes important.

    fun set_pre (_, _) = ();

    fun pr_block (stream, blk:  html::Block)
        =
        case blk
          

             html::BLOCK_LIST bl
                 =>
                 list::apply (fn b =  pr_block (stream, b)) bl;

             html::TEXTABLOCK txt
                 =>
                 {   pr_text (stream, txt);
                     new_line stream;
                 };

             html::HN { n, align, content }
                 =>
                 {   tag = "H" + int::to_string n;

                     pr_tag (stream, tag, [("align", h_align align)]);
                     pr_text (stream, content);
                     pr_end_tag (stream, tag);
                     new_line stream;
                 };

             html::ADDRESS blk
                 =>
                 {  pr_tag (stream, "ADDRESS", []);
                    new_line stream;
                    pr_block (stream, blk);
                    pr_end_tag (stream, "ADDRESS");
                    new_line stream;
                 };

             html::PP { align, content } 
                =>
                {   pr_tag (stream, "P", [("ALIGN", h_align align)]);
                    new_line stream;
                    pr_text (stream, content);
                    new_line stream;
                };

             html::UL { type, compact, content } 
                 =>
                 {   pr_tag (stream, "UL", [
                         ("TYPE", ul_style type),
                         ("COMPACT", IMPLICIT compact)
                       ]);
                     new_line stream;
                     pr_list_items (stream, content);
                     pr_end_tag (stream, "UL");
                     new_line stream;
                 };

             html::OL { type, start, compact, content } 
                 =>
                 {   pr_tag (stream, "OL", [
                         ("TYPE", CDATA type),
                         ("START", NUMBER start),
                         ("COMPACT", IMPLICIT compact)
                       ]);
                     new_line stream;
                     pr_list_items (stream, content);
                     pr_end_tag (stream, "OL");
                     new_line stream;
                 };

             html::DIR { compact, content } 
                 =>
                 {   pr_tag (stream, "DIR", [("COMPACT", IMPLICIT compact)]);
                     new_line stream;
                     pr_list_items (stream, content);
                     pr_end_tag (stream, "DIR");
                     new_line stream;
                 };

             html::MENU { compact, content } 
                 =>
                 {   pr_tag (stream, "MENU", [("COMPACT", IMPLICIT compact)]);
                     new_line stream;
                     pr_list_items (stream, content);
                     pr_end_tag (stream, "MENU");
                     new_line stream;
                 };

             html::DL { compact, content } 
                 =>
                 {   pr_tag (stream, "DL", [("COMPACT", IMPLICIT compact)]);
                     new_line stream;
                     pr_dlitems (stream, content);
                     pr_end_tag (stream, "DL");
                     new_line stream;
                 };

             html::PRE { width, content } 
                 =>
                 {   pr_tag (stream, "PRE", [("WIDTH", NUMBER width)]);
                     new_line stream;
                     set_pre (stream, TRUE);
                     pr_text (stream, content);
                     set_pre (stream, FALSE);
                     new_line stream;
                     pr_end_tag (stream, "PRE");
                     new_line stream;
                 };

             html::DIV { align, content } 
                 =>
                 {   pr_tag (stream, "DIV", [("ALIGN", h_align (THE align))]);
                     new_line stream;
                     pr_block (stream, content);
                     pr_end_tag (stream, "DIV");
                     new_line stream;
                 };

             html::CENTER bl
                 =>
                 {   pr_tag (stream, "CENTER", []);
                     new_line stream;
                     pr_block (stream, bl);
                     pr_end_tag (stream, "CENTER");
                     new_line stream;
                 };

             html::BLOCKQUOTE bl
                 =>
                 {   pr_tag (stream, "BLOCKQUOTE", []);
                     new_line stream;
                     pr_block (stream, bl);
                     pr_end_tag (stream, "BLOCKQUOTE");
                     new_line stream;
                 };

             html::FORM { action, method', enctype, content } 
                 =>
                 {   pr_tag (stream, "FORM", [
                         ("ACTION", CDATA action),
                         ("METHOD", http_method (THE method')),
                         ("ENCTYPE", CDATA enctype)
                       ]);
                     new_line stream;
                     pr_block (stream, content);
                     pr_end_tag (stream, "FORM");
                     new_line stream;
                 };

             html::ISINDEX { prompt } 
                 =>
                 {   pr_tag (stream, "ISINDEX", [("PROMPT", CDATA prompt)]);
                     new_line stream;
                 };

             html::HR { align, noshade, size, width } 
                 =>
                 {   pr_tag (stream, "HR", [
                         ("ALIGN", h_align align),
                         ("NOSHADE", IMPLICIT noshade),
                         ("SIZE", CDATA size),
                         ("WIDTH", CDATA width)
                       ]);
                     new_line stream;
                 };

             html::TABLE {
                  align, width, border, cellspacing, cellpadding,
                  caption, content
                }
                =>
                 {   pr_tag (stream, "TABLE", [
                         ("ALIGN", h_align align),
                         ("WIDTH", CDATA width),
                         ("BORDER", CDATA border),
                         ("CELLSPACING", CDATA cellspacing),
                         ("CELLPADDING", CDATA cellpadding)
                       ]);
                     new_line stream;
                     pr_caption (stream, caption);
                     pr_table_rows (stream, content);
                     pr_end_tag (stream, "TABLE");
                     new_line stream;
                 };
           esac

    also
    fun pr_list_items (stream, items)
        =
        list::apply print_item items
        where
            fun print_item (html::LI { type, value, content } )
                =
                {
                    pr_tag (stream, "LI", [("TYPE", CDATA type), ("VALUE", NUMBER value)]);
                    new_line stream;
                    pr_block (stream, content);
                };
        end

    also
    fun pr_dlitems (stream, items)
        =
        list::apply print_item items
        where
            fun pr_dt txt
                =
                {   pr_tag (stream, "DT", []);
                    space stream;
                    pr_text (stream, txt);
                    new_line stream;
                };

            fun pr_dd blk
                =
                {   pr_tag (stream, "DD", []);
                    new_line stream;
                    pr_block (stream, blk);
                };

            fun print_item ( { dt, dd } )
                =
                {   list::apply pr_dt dt;
                    pr_dd dd;
                };
        end  

    also
    fun pr_caption (stream, THE (html::CAPTION { align, content } ))
            =>
            {   pr_tag (stream, "CAPTION", [("ALIGN", caption_align align)]);
                new_line stream;
                pr_text (stream, content);
                pr_end_tag (stream, "CAPTION");
                new_line stream;
            };

        pr_caption (stream, NULL)
            =>
            ();
    end 

    also
    fun pr_table_rows (stream, rows)
        =
        list::apply pr_tr rows
        where
            fun pr_tr (html::TR { align, valign, content } )
                =
                {   pr_tag (stream, "TR", [
                        ("ALIGN", h_align align),
                        ("VALIGN", cell_valign valign)
                      ]);

                    new_line stream;

                    list::apply (pr_table_cell stream) content;
                };
        end

    also
    fun pr_table_cell stream cell
        =
        case cell
            (html::TH stuff) => pr_cell ("TH", stuff);
            (html::TD stuff) => pr_cell ("TD", stuff);
        esac
        where
            fun pr_cell (tag, {
                  nowrap, rowspan, colspan, align, valign, width, height,
                  content
                } )
                =
                {   pr_tag (stream, tag, [
                        ("NOWRAP", IMPLICIT nowrap),
                        ("ROWSPAN", NUMBER rowspan),
                        ("COLSPAN", NUMBER colspan),
                        ("ALIGN", h_align align),
                        ("VALIGN", cell_valign valign),
                        ("WIDTH", CDATA width),
                        ("HEIGHT", CDATA height)
                      ]);

                    new_line stream;

                    pr_block (stream, content);
                };
        end

    also
    fun pr_emph (stream, tag, text)
            =
            {   pr_tag (stream, tag, []);
                pr_text (stream, text);
                pr_end_tag (stream, tag);
            }

    also
    fun pr_text (stream, text)
             =
             case text   

                 html::TEXT_LIST tl
                     =>
                     list::apply  (fn txt = pr_text (stream, txt))  tl;

                 html::PCDATA pcdata => pr_pcdata (stream, pcdata);
                 html::TT txt => pr_emph (stream, "TT", txt);
                 html::IX txt => pr_emph (stream, "I", txt);
                 html::BX txt => pr_emph (stream, "B", txt);
                 html::UX txt => pr_emph (stream, "U", txt);
                 html::STRIKE txt => pr_emph (stream, "STRIKE", txt);
                 html::BIG txt => pr_emph (stream, "BIG", txt);
                 html::SMALL txt => pr_emph (stream, "SMALL", txt);
                 html::SUB txt => pr_emph (stream, "SUB", txt);
                 html::SUP txt => pr_emph (stream, "SUP", txt);
                 html::EM txt => pr_emph (stream, "EM", txt);
                 html::STRONG txt => pr_emph (stream, "STRONG", txt);
                 html::DFN txt => pr_emph (stream, "DFN", txt);
                 html::CODE txt => pr_emph (stream, "CODE", txt);
                 html::SAMP txt => pr_emph (stream, "SAMP", txt);
                 html::KBD txt => pr_emph (stream, "KBD", txt);
                 html::VAR txt => pr_emph (stream, "VAR", txt);
                 html::CITE txt => pr_emph (stream, "CITE", txt);
                 html::AX { name, href, rel, reverse, title, content }
                     =>
                     {   pr_tag (stream, "A", [
                             ("NAME", CDATA name),
                             ("HREF", CDATA href),
                             ("REL", CDATA rel),
                             ("REV", CDATA reverse),
                             ("TITLE", CDATA title)
                           ]);
                         pr_text (stream, content);
                         pr_end_tag (stream, "A");
                     };

                 html::IMG {
                      src, alt, align, height, width, border,
                      hspace, vspace, usemap, ismap
                    }
                     =>
                     pr_tag (stream, "IMG", [
                        ("SRC", CDATA (THE src)),
                        ("ALT", CDATA alt),
                        ("ALIGN", i_align align),
                        ("HEIGHT", CDATA height),
                        ("WIDTH", CDATA width),
                        ("BORDER", CDATA border),
                        ("HSPACE", CDATA hspace),
                        ("VSPACE", CDATA vspace),
                        ("USEMAP", CDATA usemap),
                        ("ISMAP", IMPLICIT ismap)
                      ]);

                 html::APPLET {
                      codebase, code, name, alt, align, height, width,
                      hspace, vspace, content
                    }
                     =>
                     {   pr_tag (stream, "APPLET", [
                             ("CODEBASE", CDATA codebase),
                             ("CODE", CDATA (THE code)),
                             ("NAME", CDATA name),
                             ("ALT", CDATA alt),
                             ("ALIGN", i_align align),
                             ("HEIGHT", CDATA height),
                             ("WIDTH", CDATA width),
                             ("HSPACE", CDATA hspace),
                             ("VSPACE", CDATA vspace)
                           ]);
                         pr_text (stream, content);
                         pr_end_tag (stream, "APPLET");
                     };

                 html::PARAM { name, value }
                     =>
                     pr_tag (stream, "PARAM", [
                        ("NAME", NAME (THE name)),
                        ("VALUE", CDATA value)
                      ]);

                 html::FONT { size, color, content }
                     =>
                     {   pr_tag (stream, "FONT", [
                             ("SIZE", CDATA size),
                             ("COLOR", CDATA color)
                           ]);
                         pr_text (stream, content);
                         pr_end_tag (stream, "FONT");
                     };

                 html::BASEFONT { size, content }
                     =>
                     {   pr_tag (stream, "BASEFONT", [("SIZE", CDATA size)]);
                         pr_text (stream, content);
                         pr_end_tag (stream, "BASEFONT");
                     };

                 html::BR { clear }
                     =>
                     {   pr_tag (stream, "BR", [("CLEAR", text_flow_ctl clear)]);
                         new_line stream;
                     };

                 html::MAP { name, content }
                     =>
                     {   pr_tag (stream, "MAP", [("NAME", CDATA name)]);
                         list::apply (pr_area stream) content;
                         pr_end_tag (stream, "MAP");
                     };

                 html::INPUT { type, name, value, checked, size, maxlength, src, align }
                     =>
                     pr_tag (stream, "INPUT", [
                        ("TYPE", input_type type),
                        ("NAME", NAME name),
                        ("VALUE", CDATA value),
                        ("CHECKED", IMPLICIT checked),
                        ("SIZE", CDATA size),
                        ("MAXLENGTH", NUMBER maxlength),
                        ("SRC", CDATA src),
                        ("ALIGN", i_align align)
                      ]);

                 html::SELECT { name, size, content }
                     =>
                     {   pr_tag (stream, "SELECT", [
                             ("NAME", NAME (THE name)),
                             ("SIZE", NUMBER size)
                           ]);
                         list::apply (pr_option stream) content;
                         pr_end_tag (stream, "SELECT");
                     };

                 html::TEXTAREA { name, rows, cols, content }
                     =>
                     {   pr_tag (stream, "TEXTAREA", [
                             ("NAME", NAME (THE name)),
                             ("ROWS", NUMBER (THE rows)),
                             ("COLS", NUMBER (THE cols))
                           ]);
                         pr_pcdata (stream, content);
                         pr_end_tag (stream, "TEXTAREA");
                     };

                 # SCRIPT elements are placeholders
                 # for the next version of HTML 
                 #
                 html::SCRIPT pcdata
                     =>
                     ();
          esac


    also
    fun pr_area stream (html::AREA { shape=>s, coords, href, nohref, alt } )
        =
        pr_tag (stream, "AREA", [
              ("SHAPE", shape s),
              ("COORDS", CDATA coords),
              ("HREF", CDATA href),
              ("nohref", IMPLICIT nohref),
              ("ALT", CDATA (THE alt))
            ])

    also
    fun pr_option stream (html::OPTION { selected, value, content } )
        =
        {
            pr_tag (stream, "OPTION", [
                ("SELECTED", IMPLICIT selected),
                ("VALUE", CDATA value)
              ]);

            pr_pcdata (stream, content);
        }

    also
    fun pr_pcdata (stream, data)
        =
        puts (stream, data);

    fun pr_body (stream, html::BODY {
          background, bgcolor, text, link, vlink, alink, content
        } )
        =
        {   pr_tag (stream, "BODY", [
                ("BACKGROUND", CDATA background),
                ("BGCOLOR", CDATA bgcolor),
                ("TEXT", CDATA text),
                ("LINK", CDATA link),
                ("VLINK", CDATA vlink),
                ("ALINK", CDATA alink)
              ]);

            pr_block (stream, content);
            pr_end_tag (stream, "BODY");
        };

    fun pr_head_element stream element
        =
        case element   

            html::HEAD_TITLE pcdata
                =>
                {   pr_tag (stream, "TITLE", []);
                    pr_pcdata (stream, pcdata);
                    pr_end_tag (stream, "TITLE");
                    new_line stream;
                };

            html::HEAD_ISINDEX { prompt }
                =>
                {   pr_tag (stream, "ISINDEX", [("PROMPT", CDATA prompt)]);
                    new_line stream;
                };

            html::HEAD_BASE { href }
                =>
                {    pr_tag (stream, "BASE", [("HREF", CDATA (THE href))]);
                     new_line stream;
                };

            html::HEAD_META { http_equiv, name, content }
                =>
                {   pr_tag (stream, "META", [
                        ("HTTP-EQUIV", NAME http_equiv),
                        ("NAME", NAME name),
                        ("CONTENT", CDATA (THE content))
                      ]);

                    new_line stream;
                };

            html::HEAD_LINK { id, href, rel, reverse, title }
                =>
                {   pr_tag (stream, "LINK", [
                        ("ID", NAME id),
                        ("HREF", CDATA href),
                        ("REL", CDATA rel),
                        ("REV", CDATA reverse),
                        ("TITLE", CDATA title)
                      ]);
                    new_line stream;
                };

            # SCRIPT/STYLE elements are placeholders
            # for the next version of HTML 

            html::HEAD_SCRIPT pcdata => ();
            html::HEAD_STYLE  pcdata => ();
        esac;


    fun unparse_html_tree { putc, puts } html
        =
        {   stream = OS { putc, puts };

            html ->  html::HTML { head, body, version };
          
            case version
              
                THE v => puts (f::sprintf'
                 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML %s//EN\">\n"
                 [f::STRING v]);

                NULL => ();
            esac;

            puts "<HTML>\n";
            puts "<HEAD>\n";
            list::apply (pr_head_element stream) head;  
            puts "</HEAD>\n";
            pr_body (stream, body);
            puts "</HTML>\n";
        };
};



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext