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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/smlnj-lib/HTML/check-html-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/HTML/check-html-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* check-html-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * This implements a tree walk over an HTML file to check for
6 :     * errors, such as violations of exclusions.
7 :     *)
8 :    
9 :     functor CheckHTMLFn (Err : HTML_ERROR) : sig
10 :    
11 :     type context = {file : string option, line : int}
12 :    
13 :     val check : context -> HTML.html -> unit
14 :    
15 :     end = struct
16 :    
17 :     type context = Err.context
18 :    
19 : monnier 8 fun check context (HTML.HTML{body=HTML.BODY{content, ...}, ...}) = let
20 : monnier 2 fun error (elem, ctx) =
21 :     Err.syntaxError context
22 :     (Format.format "unexpected %s element in %s" [
23 :     Format.STR elem, Format.STR ctx
24 :     ])
25 :     fun contentError ctx =
26 :     Err.syntaxError context
27 :     (Format.format "unexpected element in %s" [Format.STR ctx])
28 :     fun formError elem =
29 :     Err.syntaxError context
30 :     (Format.format "unexpected %s element not in FORM" [
31 :     Format.STR elem
32 :     ])
33 :     fun attrError attr = Err.missingAttr context attr
34 :     fun checkBodyContent {inForm} b = (case b
35 :     of (HTML.Hn{n, align, content}) => checkText {
36 :     inAnchor=false, inForm=inForm, inPre=false, inApplet=false
37 :     } content
38 :     | (HTML.ADDRESS block) => checkAddress {inForm=inForm} block
39 :     | (HTML.BlockList bl) =>
40 :     List.app (checkBodyContent {inForm=inForm}) bl
41 :     | block => checkBlock {inForm=inForm} block
42 :     (* end case *))
43 :     and checkAddress {inForm} blk = (case blk
44 :     of (HTML.BlockList bl) =>
45 :     List.app (checkAddress {inForm=inForm}) bl
46 :     | (HTML.TextBlock txt) => checkText {
47 :     inAnchor=false, inForm=inForm, inPre=false, inApplet = false
48 :     } txt
49 :     | (HTML.P{content, ...}) => checkText {
50 :     inAnchor=false, inForm=inForm, inPre=false, inApplet = false
51 :     } content
52 :     | _ => contentError "ADDRESS"
53 :     (* end case *))
54 :     and checkBlock {inForm} blk = (case blk
55 :     of (HTML.BlockList bl) =>
56 :     List.app (checkBlock {inForm=inForm}) bl
57 :     | (HTML.TextBlock txt) => checkText {
58 :     inAnchor=false, inForm=inForm, inPre=false, inApplet = false
59 :     } txt
60 :     | (HTML.P{content, ...}) => checkText {
61 :     inAnchor=false, inForm=inForm, inPre=false, inApplet = false
62 :     } content
63 :     | (HTML.UL{content, ...}) =>
64 :     checkItems {inForm=inForm, inDirOrMenu=false} content
65 :     | (HTML.OL{content, ...}) =>
66 :     checkItems {inForm=inForm, inDirOrMenu=false} content
67 :     | (HTML.DIR{content, ...}) =>
68 :     checkItems {inForm=inForm, inDirOrMenu=true} content
69 :     | (HTML.MENU{content, ...}) =>
70 :     checkItems {inForm=inForm, inDirOrMenu=true} content
71 :     | (HTML.DL{content, ...}) =>
72 :     checkDLItems {inForm=inForm} content
73 :     | (HTML.PRE{content, ...}) => checkText {
74 :     inAnchor=false, inForm=inForm, inPre=true, inApplet = false
75 :     } content
76 :     | (HTML.DIV{content, ...}) =>
77 :     checkBodyContent {inForm=inForm} content
78 :     | (HTML.CENTER content) =>
79 :     checkBodyContent {inForm=inForm} content
80 :     | (HTML.BLOCKQUOTE content) =>
81 :     checkBodyContent {inForm=inForm} content
82 :     | (HTML.FORM{content, ...}) => (
83 :     if inForm then error("FORM", "FORM") else ();
84 :     checkBodyContent {inForm=true} content)
85 :     | (HTML.ISINDEX _) => ()
86 :     | (HTML.HR _) => ()
87 :     | (HTML.TABLE{
88 :     caption=SOME(HTML.CAPTION{content=caption, ...}),
89 :     content, ...
90 :     }) => (
91 :     checkText {
92 :     inAnchor=false, inForm=inForm, inPre=false,
93 :     inApplet = false
94 :     } caption;
95 :     checkRows {inForm=inForm} content)
96 :     | (HTML.TABLE{content, ...}) => checkRows {inForm=inForm} content
97 :     | (HTML.Hn _) => error ("Hn", "block")
98 :     | (HTML.ADDRESS _) => error ("ADDRESS", "block")
99 :     (* end case *))
100 :     and checkItems {inForm, inDirOrMenu} items = let
101 :     fun chkBlk (HTML.BlockList bl) = List.app chkBlk bl
102 :     | chkBlk (HTML.TextBlock txt) = ()
103 :     | chkBlk (HTML.P _) = ()
104 :     | chkBlk _ = error ("block", "DIR/MENU")
105 :     val chk = if inDirOrMenu
106 :     then (fn (HTML.LI{content, ...}) => (
107 :     chkBlk content; checkBlock {inForm=inForm} content))
108 :     else (fn (HTML.LI{content, ...}) => (
109 :     checkBlock {inForm=inForm} content))
110 :     in
111 :     List.app chk items
112 :     end
113 :     and checkDLItems {inForm} items = let
114 :     fun chk {dt, dd} = (
115 :     List.app
116 :     (checkText {
117 :     inAnchor=false, inForm=inForm, inPre=false, inApplet=false
118 :     })
119 :     dt;
120 :     checkBlock {inForm=inForm} dd)
121 :     in
122 :     List.app chk items
123 :     end
124 :     and checkRows {inForm} rows = let
125 :     fun chkCell (HTML.TH{content, ...}) =
126 :     checkBodyContent {inForm=inForm} content
127 :     | chkCell (HTML.TD{content, ...}) =
128 :     checkBodyContent {inForm=inForm} content
129 :     fun chkRow (HTML.TR{content, ...}) = List.app chkCell content
130 :     in
131 :     List.app chkRow rows
132 :     end
133 :     and checkText {inAnchor, inForm, inPre, inApplet} = let
134 :     fun chk txt = (case txt
135 :     of (HTML.TextList tl) => List.app chk tl
136 :     | (HTML.PCDATA _) => ()
137 :     | (HTML.TT txt) => chk txt
138 :     | (HTML.I txt) => chk txt
139 :     | (HTML.B txt) => chk txt
140 :     | (HTML.U txt) => chk txt
141 :     | (HTML.STRIKE txt) => chk txt
142 :     | (HTML.BIG txt) => (
143 :     if inPre then error("BIG", "PRE") else ();
144 :     chk txt)
145 :     | (HTML.SMALL txt) => (
146 :     if inPre then error("SMALL", "PRE") else ();
147 :     chk txt)
148 :     | (HTML.SUB txt) => (
149 :     if inPre then error("SUB", "PRE") else ();
150 :     chk txt)
151 :     | (HTML.SUP txt) => (
152 :     if inPre then error("SUP", "PRE") else ();
153 :     chk txt)
154 :     | (HTML.EM txt) => chk txt
155 :     | (HTML.STRONG txt) => chk txt
156 :     | (HTML.DFN txt) => chk txt
157 :     | (HTML.CODE txt) => chk txt
158 :     | (HTML.SAMP txt) => chk txt
159 :     | (HTML.KBD txt) => chk txt
160 :     | (HTML.VAR txt) => chk txt
161 :     | (HTML.CITE txt) => chk txt
162 :     | (HTML.A{content, ...}) => (
163 :     if (inAnchor) then error("anchor", "anchor") else ();
164 :     checkText {
165 :     inAnchor=true, inForm=inForm, inPre=inPre,
166 :     inApplet=inApplet
167 :     } content)
168 :     | (HTML.IMG _) =>
169 :     if inPre then error("IMG", "PRE") else ()
170 :     | (HTML.APPLET{content, ...}) => checkText {
171 :     inAnchor=false, inForm=inForm, inPre=inPre,
172 :     inApplet=true
173 :     } content
174 :     | (HTML.PARAM _) =>
175 :     if inApplet then error ("param", "applet") else ()
176 :     | (HTML.FONT{content, ...}) =>
177 :     if inPre then error("FONT", "PRE") else ()
178 :     | (HTML.BASEFONT{content, ...}) =>
179 :     if inPre then error("BASEFONT", "PRE") else ()
180 :     | (HTML.BR _) => ()
181 :     | (HTML.MAP _) => ()
182 :     | (HTML.INPUT{ty, name, value, ...}) => (
183 :     if (not inForm) then formError "INPUT" else ();
184 :     if ((name = NONE)
185 :     andalso (ty <> SOME(HTML.InputType.submit))
186 :     andalso (ty <> SOME(HTML.InputType.reset)))
187 :     then attrError "NAME"
188 :     else ();
189 :     if ((value = NONE)
190 :     andalso ((ty = SOME(HTML.InputType.radio))
191 :     orelse (ty = SOME(HTML.InputType.checkbox))))
192 :     then attrError "VALUE"
193 :     else ())
194 :     | (HTML.SELECT _) =>
195 :     if (not inForm) then formError "SELECT" else ()
196 :     | (HTML.TEXTAREA _) =>
197 :     if (not inForm) then formError "TEXTAREA" else ()
198 :     | (HTML.SCRIPT _) => ()
199 :     (* end case *))
200 :     in
201 :     chk
202 :     end
203 :     in
204 : monnier 8 checkBodyContent {inForm=false} content
205 : monnier 2 end
206 :    
207 :     end

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