blob: f1179cf84cd4375ed0f9defd33a4a111565b51e7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
# sgml-8.0.tcl --
#
# This file provides generic parsing services for SGML-based
# languages, namely HTML and XML.
# This file supports Tcl 8.0 characters and regular expressions.
#
# NB. It is a misnomer. There is no support for parsing
# arbitrary SGML as such.
#
# Copyright (c) 1998,1999 Zveno Pty Ltd
# http://www.zveno.com/
#
# See the file "LICENSE" in this distribution for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: sgml-8.0.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $
package require -exact Tcl 8.0
package provide sgml 1.9
namespace eval sgml {
# Convenience routine
proc cl x {
return "\[$x\]"
}
# Define various regular expressions
# Character classes
variable Char \t\n\r\ -\xFF
variable BaseChar A-Za-z
variable Letter $BaseChar
variable Digit 0-9
variable CombiningChar {}
variable Extender {}
variable Ideographic {}
# white space
variable Wsp " \t\r\n"
variable noWsp [cl ^$Wsp]
# Various XML names
variable NameChar \[-$Letter$Digit._:$CombiningChar$Extender\]
variable Name \[_:$BaseChar$Ideographic\]$NameChar*
variable Names ${Name}(?:$Wsp$Name)*
variable Nmtoken $NameChar+
variable Nmtokens ${Nmtoken}(?:$Wsp$Nmtoken)*
# table of predefined entities for XML
variable EntityPredef
array set EntityPredef {
lt < gt > amp & quot \" apos '
}
}
# These regular expressions are defined here once for better performance
namespace eval sgml {
variable Wsp
# Watch out for case-sensitivity
set attlist_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#REQUIRED|#IMPLIED)
set attlist_enum_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*\\(([cl ^)]*)\\)[cl $Wsp]*("([cl ^")])")? ;# "
set attlist_fixed_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#FIXED)[cl $Wsp]*([cl ^$Wsp]+)
set param_entity_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^"$Wsp]*)[cl $Wsp]*"([cl ^"]*)"
set notation_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(.*)
}
### Utility procedures
# sgml::noop --
#
# A do-nothing proc
#
# Arguments:
# args arguments
#
# Results:
# Nothing.
proc sgml::noop args {
return 0
}
# sgml::identity --
#
# Identity function.
#
# Arguments:
# a arbitrary argument
#
# Results:
# $a
proc sgml::identity a {
return $a
}
# sgml::Error --
#
# Throw an error
#
# Arguments:
# args arguments
#
# Results:
# Error return condition.
proc sgml::Error args {
uplevel return -code error [list $args]
}
### Following procedures are based on html_library
# sgml::zapWhite --
#
# Convert multiple white space into a single space.
#
# Arguments:
# data plain text
#
# Results:
# As above
proc sgml::zapWhite data {
regsub -all "\[ \t\r\n\]+" $data { } data
return $data
}
proc sgml::Boolean value {
regsub {1|true|yes|on} $value 1 value
regsub {0|false|no|off} $value 0 value
return $value
}
|
