basis/xml/dtd/dtd.factor

   1 ! Copyright (C) 2005, 2009 Daniel Ehrenberg, Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators hashtables kernel namespaces xml.data
   4 xml.errors xml.name xml.state xml.tokenize ;
   5 IN: xml.dtd
   6
   7 : take-decl-contents ( -- first second )
   8     pass-blank take-word pass-blank ">" take-string ;
   9
  10 : take-element-decl ( -- element-decl )
  11     take-decl-contents <element-decl> ;
  12
  13 : take-attlist-decl ( -- attlist-decl )
  14     take-decl-contents <attlist-decl> ;
  15
  16 : take-notation-decl ( -- notation-decl )
  17     take-decl-contents <notation-decl> ;
  18
  19 UNION: dtd-acceptable
  20     directive comment instruction ;
  21
  22 : take-entity-def ( var -- entity-name entity-def )
  23     [
  24         take-word pass-blank get-char {
  25             { CHAR: ' [ parse-quote ] }
  26             { CHAR: \" [ parse-quote ] }
  27             [ drop take-external-id close ]
  28         } case
  29    ] dip '[ swap _ [ ?set-at ] change ] 2keep ;
  30
  31 : take-entity-decl ( -- entity-decl )
  32     pass-blank get-char {
  33         { CHAR: % [ next pass-blank pe-table take-entity-def t ] }
  34         [ drop extra-entities take-entity-def f ]
  35     } case close <entity-decl> ;
  36
  37 : take-inner-directive ( string -- directive )
  38     {
  39         { "ELEMENT" [ take-element-decl ] }
  40         { "ATTLIST" [ take-attlist-decl ] }
  41         { "ENTITY" [ take-entity-decl ] }
  42         { "NOTATION" [ take-notation-decl ] }
  43         [ bad-directive ]
  44     } case ;