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: xml.tokenize xml.data xml.state kernel sequences ascii
   4 fry xml.errors combinators hashtables namespaces xml.entities
   5 strings xml.name ;
   6 IN: xml.dtd
   7
   8 : take-decl-contents ( -- first second )
   9     pass-blank take-word pass-blank ">" take-string ;
  10
  11 : take-element-decl ( -- element-decl )
  12     take-decl-contents <element-decl> ;
  13
  14 : take-attlist-decl ( -- attlist-decl )
  15     take-decl-contents <attlist-decl> ;
  16
  17 : take-notation-decl ( -- notation-decl )
  18     take-decl-contents <notation-decl> ;
  19
  20 UNION: dtd-acceptable
  21     directive comment instruction ;
  22
  23 : take-entity-def ( var -- entity-name entity-def )
  24     [
  25         take-word pass-blank get-char {
  26             { CHAR: ' [ parse-quote ] }
  27             { CHAR: " [ parse-quote ] }
  28             [ drop take-external-id close ]
  29         } case
  30    ] dip '[ swap _ [ ?set-at ] change ] 2keep ;
  31
  32 : take-entity-decl ( -- entity-decl )
  33     pass-blank get-char {
  34         { CHAR: % [ next pass-blank pe-table take-entity-def t ] }
  35         [ drop extra-entities take-entity-def f ]
  36     } case close <entity-decl> ;
  37
  38 : take-inner-directive ( string -- directive )
  39     {
  40         { "ELEMENT" [ take-element-decl ] }
  41         { "ATTLIST" [ take-attlist-decl ] }
  42         { "ENTITY" [ take-entity-decl ] }
  43         { "NOTATION" [ take-notation-decl ] }
  44         [ bad-directive ]
  45     } case ;