Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/smlnj-lib/HTML/pr-html.sml
ViewVC logotype

Diff of /sml/trunk/src/smlnj-lib/HTML/pr-html.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3, Sat Oct 4 23:33:46 1997 UTC revision 8, Sun Jan 18 01:01:29 1998 UTC
# Line 2  Line 2 
2   *   *
3   * COPYRIGHT (c) 1996 AT&T REsearch.   * COPYRIGHT (c) 1996 AT&T REsearch.
4   *   *
5   * Pretty-print an HTML tree.  The print routine accepts optional header   * Pretty-print an HTML tree.
  * and footer strings that are included at the beginning and end of the  
  * page's body.  
6   *)   *)
7    
8  structure PrHTML : sig  structure PrHTML : sig
# Line 12  Line 10 
10      val prHTML : {      val prHTML : {
11              putc    : char -> unit,              putc    : char -> unit,
12              puts    : string -> unit              puts    : string -> unit
13            } -> {            } -> HTML.html -> unit
             html    : HTML.html,  
             optHead : string option,  
             optFoot : string option  
           } -> unit  
14    
15    end = struct    end = struct
16    
# Line 64  Line 58 
58              | fmtAttr _ = NONE              | fmtAttr _ = NONE
59            val attrs = List.mapPartial fmtAttr attrs            val attrs = List.mapPartial fmtAttr attrs
60            in            in
61              ListFormat.formatList {              ListFormat.fmt {
62                  init = "<",                  init = "<",
63                  sep = " ",                  sep = " ",
64                  final = ">",                  final = ">",
# Line 417  Line 411 
411    
412      and prPCData (strm, data) = puts (strm, data)      and prPCData (strm, data) = puts (strm, data)
413    
414        fun prBody (strm, HTML.BODY{
415              background, bgcolor, text, link, vlink, alink, content
416            }) = (
417              prTag (strm, "BODY", [
418                  ("BACKGROUND", CDATA background),
419                  ("BGCOLOR", CDATA bgcolor),
420                  ("TEXT", CDATA text),
421                  ("LINK", CDATA link),
422                  ("VLINK", CDATA vlink),
423                  ("ALINK", CDATA alink)
424                ]);
425              prBlock (strm, content);
426              prEndTag (strm, "BODY"))
427    
428      fun prHeadElement strm elem = (case elem      fun prHeadElement strm elem = (case elem
429             of (HTML.Head_TITLE pcdata) => (             of (HTML.Head_TITLE pcdata) => (
430                  prTag (strm, "TITLE", []);                  prTag (strm, "TITLE", []);
# Line 450  Line 458 
458              | (HTML.Head_STYLE pcdata) => ()              | (HTML.Head_STYLE pcdata) => ()
459            (* end case *))            (* end case *))
460    
461      fun prHTML {putc, puts} {html, optHead, optFoot} = let      fun prHTML {putc, puts} html = let
462            val strm = OS{putc=putc, puts=puts}            val strm = OS{putc=putc, puts=puts}
463            val HTML.HTML{head, body, version} = html            val HTML.HTML{head, body, version} = html
           fun prOpt NONE = ()  
             | prOpt (SOME txt) = puts txt  
464            in            in
465              case version              case version
466               of NONE => ()               of NONE => ()
# Line 466  Line 472 
472              puts "<HEAD>\n";              puts "<HEAD>\n";
473              List.app (prHeadElement strm) head;              List.app (prHeadElement strm) head;
474              puts "</HEAD>\n";              puts "</HEAD>\n";
475              puts "<BODY>\n";              prBody (strm, body);
             prOpt optHead;  
             prBlock (strm, body);  
             prOpt optFoot;  
             puts "</BODY>\n";  
476              puts "</HTML>\n"              puts "</HTML>\n"
477            end            end
478    

Legend:
Removed from v.3  
changed lines
  Added in v.8

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0