home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tclxml2.0 / sgml-8.0.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  3.8 KB  |  162 lines
  1. # sgml-8.0.tcl --
  2. #
  3. #    This file provides generic parsing services for SGML-based
  4. #    languages, namely HTML and XML.
  5. #    This file supports Tcl 8.0 characters and regular expressions.
  6. #
  7. #    NB.  It is a misnomer.  There is no support for parsing
  8. #    arbitrary SGML as such.
  9. #
  10. # Copyright (c) 1998,1999 Zveno Pty Ltd
  11. # http://www.zveno.com/
  12. #
  13. # Zveno makes this software available free of charge for any purpose.
  14. # Copies may be made of this software but all of this notice must be included
  15. # on any copy.
  16. #
  17. # The software was developed for research purposes only and Zveno does not
  18. # warrant that it is error free or fit for any purpose.  Zveno disclaims any
  19. # liability for all claims, expenses, losses, damages and costs any user may
  20. # incur as a result of using, copying or modifying this software.
  21. #
  22. # Copyright (c) 1997 ANU and CSIRO on behalf of the
  23. # participants in the CRC for Advanced Computational Systems ('ACSys').
  24. # 
  25. # ACSys makes this software and all associated data and documentation 
  26. # ('Software') available free of charge for any purpose.  You may make copies 
  27. # of the Software but you must include all of this notice on any copy.
  28. # 
  29. # The Software was developed for research purposes and ACSys does not warrant
  30. # that it is error free or fit for any purpose.  ACSys disclaims any
  31. # liability for all claims, expenses, losses, damages and costs any user may
  32. # incur as a result of using, copying or modifying the Software.
  33. #
  34. # $Id: sgml-8.0.tcl,v 1.2 2000/03/09 06:52:16 steve Exp $
  35.  
  36. package require -exact Tcl 8.0
  37.  
  38. package provide sgml 1.8
  39.  
  40. namespace eval sgml {
  41.  
  42.     # Convenience routine
  43.     proc cl x {
  44.     return "\[$x\]"
  45.     }
  46.  
  47.     # Define various regular expressions
  48.  
  49.     # Character classes
  50.     variable Char \t\n\r\ -\xFF
  51.     variable BaseChar A-Za-z
  52.     variable Letter $BaseChar
  53.     variable Digit 0-9
  54.     variable CombiningChar {}
  55.     variable Extender {}
  56.     variable Ideographic {}
  57.  
  58.     # white space
  59.     variable Wsp " \t\r\n"
  60.     variable noWsp [cl ^$Wsp]
  61.  
  62.     # Various XML names
  63.     variable NameChar \[-$Letter$Digit._:$CombiningChar$Extender\]
  64.     variable Name \[_:$BaseChar$Ideographic\]$NameChar*
  65.     variable Names ${Name}(?:$Wsp$Name)*
  66.     variable Nmtoken $NameChar+
  67.     variable Nmtokens ${Nmtoken}(?:$Wsp$Nmtoken)*
  68.  
  69.     # table of predefined entities for XML
  70.  
  71.     variable EntityPredef
  72.     array set EntityPredef {
  73.     lt <   gt >   amp &   quot \"   apos '
  74.     }
  75.  
  76. }
  77.  
  78. # These regular expressions are defined here once for better performance
  79.  
  80. namespace eval sgml {
  81.     variable Wsp
  82.  
  83.     # Watch out for case-sensitivity
  84.  
  85.     set attlist_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#REQUIRED|#IMPLIED)
  86.     set attlist_enum_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*\\(([cl ^)]*)\\)[cl $Wsp]*("([cl ^")])")? ;# "
  87.     set attlist_fixed_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#FIXED)[cl $Wsp]*([cl ^$Wsp]+)
  88.  
  89.     set param_entity_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^"$Wsp]*)[cl $Wsp]*"([cl ^"]*)"
  90.  
  91.     set notation_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(.*)
  92.  
  93. }
  94.  
  95. ### Utility procedures
  96.  
  97. # sgml::noop --
  98. #
  99. #    A do-nothing proc
  100. #
  101. # Arguments:
  102. #    args    arguments
  103. #
  104. # Results:
  105. #    Nothing.
  106.  
  107. proc sgml::noop args {
  108.     return 0
  109. }
  110.  
  111. # sgml::identity --
  112. #
  113. #    Identity function.
  114. #
  115. # Arguments:
  116. #    a    arbitrary argument
  117. #
  118. # Results:
  119. #    $a
  120.  
  121. proc sgml::identity a {
  122.     return $a
  123. }
  124.  
  125. # sgml::Error --
  126. #
  127. #    Throw an error
  128. #
  129. # Arguments:
  130. #    args    arguments
  131. #
  132. # Results:
  133. #    Error return condition.
  134.  
  135. proc sgml::Error args {
  136.     uplevel return -code error [list $args]
  137. }
  138.  
  139. ### Following procedures are based on html_library
  140.  
  141. # sgml::zapWhite --
  142. #
  143. #    Convert multiple white space into a single space.
  144. #
  145. # Arguments:
  146. #    data    plain text
  147. #
  148. # Results:
  149. #    As above
  150.  
  151. proc sgml::zapWhite data {
  152.     regsub -all "\[ \t\r\n\]+" $data { } data
  153.     return $data
  154. }
  155.  
  156. proc sgml::Boolean value {
  157.     regsub {1|true|yes|on} $value 1 value
  158.     regsub {0|false|no|off} $value 0 value
  159.     return $value
  160. }
  161.  
  162.