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 /smlnj-lib/trunk/HTML4/html4-token-utils.sml
ViewVC logotype

Diff of /smlnj-lib/trunk/HTML4/html4-token-utils.sml

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

revision 3530, Tue May 18 21:26:05 2010 UTC revision 3531, Fri May 21 00:12:21 2010 UTC
# Line 7  Line 7 
7    
8  structure HTML4TokenUtils = struct  structure HTML4TokenUtils = struct
9    
10    (* ____________________________________________________________ *)
11    (* Attribute handling *)
12    (* XXX Is this too heavyweight?  It certainly gives us some
13       flexibility in the future. *)
14    
15    structure HTML4AttrParser = HTML4AttrParseFn(HTML4AttrLexer)
16    
17    fun parseAttrsFromStream inStream =
18        let
19            val sourceMap = AntlrStreamPos.mkSourcemap ()
20            val lex = HTML4AttrLexer.lex sourceMap
21            val stream = HTML4AttrLexer.streamifyInstream inStream
22            val (result, _, _) = HTML4AttrParser.parse lex stream
23        in
24            if isSome result then valOf result else []
25        end
26    
27    fun parseAttrs inStr = parseAttrsFromStream (TextIO.openString inStr)
28    
29    (* ____________________________________________________________ *)
30  open HTML4Tokens  open HTML4Tokens
31    
32  val strict_tuple_list = [  val strict_tuple_list = [
# Line 109  Line 129 
129      ("NOFRAMES", STARTNOFRAMES, SOME ENDNOFRAMES)      ("NOFRAMES", STARTNOFRAMES, SOME ENDNOFRAMES)
130  ]  ]
131    
132  fun endTagNameTest ch = (case ch of  val endTagNameTest = Char.notContains " \t\r\n>"
133                               #" " => true | #"\t" => true | #"\r" => true  
134                             | #"\n" => true | #">" => true | _ => false)  fun splitTagStart inStr =
135        Substring.splitl endTagNameTest (Substring.full inStr)
 fun split ch_test =  
     let fun loop [] = []  
           | loop (ch :: rst) = if ch_test ch then [] else ch :: (loop rst)  
     in loop end  
136    
137  fun extractTag str =  fun extractTag str =
138      let val split_tag = split endTagNameTest      let
139          val ch_list = case String.explode str of          val (tagStart, _) = splitTagStart str
140                            #"<" :: #"/" :: rst => rst          val tagNameChs = case Substring.explode tagStart
141                              of #"<" :: #"/" :: rst => rst
142                          | #"<" :: rst => rst                          | #"<" :: rst => rst
143                          | rst => rst                          | rst => rst
         val ch_list' = split_tag ch_list  
144      in      in
145          Atom.atom (String.implode (map Char.toUpper ch_list'))          Atom.atom (String.implode (map Char.toUpper tagNameChs))
146        end
147    
148    fun extractAttrs str =
149        let
150            val (_, tagRest) = splitTagStart str
151            val (tagRest', _) = Substring.splitr (fn c => c = #">") tagRest
152        in
153            parseAttrs (Substring.string tagRest')
154      end      end
155    
156  structure AtomMap : ORD_MAP = RedBlackMapFn(struct  structure AtomMap : ORD_MAP = RedBlackMapFn(struct
# Line 160  Line 184 
184    
185  val close_map_ref = ref strict_close_map  val close_map_ref = ref strict_close_map
186    
187  fun mkOpenTag payload =  fun mkOpenTag payloadStr =
188      let val tag_atom = extractTag payload      let val tag_atom = extractTag payloadStr
189      in case AtomMap.find(!open_map_ref, tag_atom) of      in case AtomMap.find(!open_map_ref, tag_atom) of
190             NONE => OPENTAG (tag_atom, payload)             NONE => OPENTAG (tag_atom, (payloadStr, extractAttrs payloadStr))
191           | SOME ctor => ctor payload           | SOME ctor => ctor (payloadStr, extractAttrs payloadStr)
192      end      end
193    
194  fun mkCloseTag payload =  fun mkCloseTag payloadStr =
195      let val tag_atom = extractTag payload      let val tag_atom = extractTag payloadStr
196      in case AtomMap.find(!close_map_ref, tag_atom) of      in case AtomMap.find(!close_map_ref, tag_atom) of
197             NONE => CLOSETAG tag_atom             NONE => CLOSETAG tag_atom
198           | SOME tok => tok           | SOME tok => tok

Legend:
Removed from v.3530  
changed lines
  Added in v.3531

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