Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | toschema
Files: files | file ages | folders
SHA3-256: 55d2228ae4cabb35d9e108768c79c75dee28ab9bb358a86673f5b0948e9ff9f9
User & Date: rolf 2019-11-30 00:22:06
Context
2019-11-30
00:22
wip Leaf check-in: 55d2228ae4 user: rolf tags: toschema
00:07
Implemented the text constraint commands unsignedByte, unsignedShort, unsignedInt and unsignedLong, along the xsd counterparts. check-in: 051ae451a2 user: rolf tags: schema
Changes

Changes to apps/toschema.tcl.

1
2
3
4
5
6
7





8
9
10
11
12
13
14
..
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
...
136
137
138
139
140
141
142

143
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
...
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230



231







232
233
234
235
236
237
238
...
243
244
245
246
247
248
249



250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266
267
268
269
270

package require tdom
package require uri

variable dtdStart ""
variable dtdFinished 0
variable indent 4






proc indent {} {
    variable indent
    upvar level level
    return [string repeat " " [expr {$indent * $level}]]
}

................................................................................
}
    
proc fromDTD_generate {} {
    variable dtdStart
    variable dtdElements
    variable dtdAttributes
    variable nslookup
    
    if {$dtdStart ne ""} {
        if {![info exists dtdElements($dtdStart)]} {
            puts "Document element not defined."
            exit 1
        }
        puts "start $dtdStart"
    }
    set elements [lsort [array names dtdElements]]

    set startInd [lsearch -exact $elements $dtdStart]
    set elements [lreplace $elements $startInd $startInd]
    set elements [linsert $elements 0 $dtdStart]

    set level 1
    foreach name $elements {
        # First round over attributes to get possible namespace
        # declarations
        foreach {attkey attDef} [array get dtdAttributes $name,*] {
            lassign $attDef attname type default isRequired
            if {$attname eq "xmlns"} {
................................................................................
        # Second round over attributes for the actualy attribute
        # declarations.
        foreach {attkey attDef} [array get dtdAttributes $name,*] {
            lassign $attDef attname type default isRequired
            set parts [split $attname ":"]
            if {[llength $parts] == 2} {
                set prefix [lindex $parts 0]

                if {![info exists nslookup($prefix)]} {
                    # Hmmm. Either dtd error or the namespace is
                    # defined somewhere on the ancestors. To be
                    # handled. TODO
                    set cmd "attribute $attname"
                } else {
                    set cmd "nsattribute [lindex $parts 1] $nslookup($prefix)"
                }
            } else {

                set cmd "attribute $attname"
            }
            if {$isRequired && $default != ""} {
                puts "[indent]$cmd ? {[list "fixed" $default]}"
                continue
            }
            switch $type {
................................................................................
                    # All above to be done
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                "NMTOKEN" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken\}"
                }
                "ID" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken;id\}"
                }
                "IDREF" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{idref\}"
                }
                "IDREFS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{split \{idref\}\}"
                }
                "NMTOKENS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtokens\}"
                }
                "CDATA" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
................................................................................

proc fromDTD_attlistDecl {elname name type default isRequired} {
    variable dtdAttributes

    set dtdAttributes($elname,$name) [list $name $type $default $isRequired]
}

proc fromDTD {file} {

    ::xml::parser p \
        -baseurl [tdom::baseURL $file] \
        -paramentityparsing always \
        -externalentitycommand tdom::extRefHandler \
        -startdoctypedeclcommand fromDTD_startDoctypeDecl \
        -enddoctypedeclcommand fromDTD_endDoctypeDecl \
        -elementdeclcommand fromDTD_elementDecl \
        -attlistdeclcommand fromDTD_attlistDecl
        



    p parse [tdom::xmlReadFile $file]







}

proc usage {} {
    puts "$argv0 ?options? file"
}

proc run {args} {
................................................................................
            exit 1
        }
        set needToGuess 0
        switch [file extension $file] {
            ".xml" {
                fromDTD $file
            }



            default {
                set needToGuess 1
            }
        }
        if {$needToGuess} {
            # Just probe everything we have in no specific order
            foreach reader {
                fromDTD

            } {
                if {![catch {$reader $file}]} {
                    return
                }
            }
        }
        return
    }
    usage
}

run {*}$argv








>
>
>
>
>







 







|
<
<
<
<
<
<
<

>
|
|
|
>







 







>









>







 







|


|


|







 







|
<








|
>
>
>

>
>
>
>
>
>
>







 







>
>
>








>

|











1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
73
74
75
76
77
78
79
80







81
82
83
84
85
86
87
88
89
90
91
92
93
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
...
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285

package require tdom
package require uri

variable dtdStart ""
variable dtdFinished 0
variable indent 4

if {[info commands ::tdom::xmlReadFile] == ""} {
    # tcldomsh without the script library. Source the lib.
    source [file join [file dir [info script]] ../lib tdom.tcl]
}

proc indent {} {
    variable indent
    upvar level level
    return [string repeat " " [expr {$indent * $level}]]
}

................................................................................
}
    
proc fromDTD_generate {} {
    variable dtdStart
    variable dtdElements
    variable dtdAttributes
    variable nslookup








    set elements [lsort [array names dtdElements]]
    if {$dtdStart ne "" && [info exists dtdElements($dtdStart)]} {
        set startInd [lsearch -exact $elements $dtdStart]
        set elements [lreplace $elements $startInd $startInd]
        set elements [linsert $elements 0 $dtdStart]
    }
    set level 1
    foreach name $elements {
        # First round over attributes to get possible namespace
        # declarations
        foreach {attkey attDef} [array get dtdAttributes $name,*] {
            lassign $attDef attname type default isRequired
            if {$attname eq "xmlns"} {
................................................................................
        # Second round over attributes for the actualy attribute
        # declarations.
        foreach {attkey attDef} [array get dtdAttributes $name,*] {
            lassign $attDef attname type default isRequired
            set parts [split $attname ":"]
            if {[llength $parts] == 2} {
                set prefix [lindex $parts 0]
                if {$prefix eq "xmlns"} continue
                if {![info exists nslookup($prefix)]} {
                    # Hmmm. Either dtd error or the namespace is
                    # defined somewhere on the ancestors. To be
                    # handled. TODO
                    set cmd "attribute $attname"
                } else {
                    set cmd "nsattribute [lindex $parts 1] $nslookup($prefix)"
                }
            } else {
                if {$attname eq "xmlns"} continue
                set cmd "attribute $attname"
            }
            if {$isRequired && $default != ""} {
                puts "[indent]$cmd ? {[list "fixed" $default]}"
                continue
            }
            switch $type {
................................................................................
                    # All above to be done
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                "NMTOKEN" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken\}"
                }
                "ID" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{name;id\}"
                }
                "IDREF" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{name;idref\}"
                }
                "IDREFS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{split \{name;idref\}\}"
                }
                "NMTOKENS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtokens\}"
                }
                "CDATA" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
................................................................................

proc fromDTD_attlistDecl {elname name type default isRequired} {
    variable dtdAttributes

    set dtdAttributes($elname,$name) [list $name $type $default $isRequired]
}

proc setupFromDTDParser {file} {

    ::xml::parser p \
        -baseurl [tdom::baseURL $file] \
        -paramentityparsing always \
        -externalentitycommand tdom::extRefHandler \
        -startdoctypedeclcommand fromDTD_startDoctypeDecl \
        -enddoctypedeclcommand fromDTD_endDoctypeDecl \
        -elementdeclcommand fromDTD_elementDecl \
        -attlistdeclcommand fromDTD_attlistDecl
}    

proc fromDTD {file} {
    setupFromDTDParser $file
    p parse [tdom::xmlReadFile $file]
    p free
}

proc fromDTDfile {file} {
    setupFromDTDParser $file
    p parse "<!DOCTYPE svg SYSTEM \"$file\"><svg/>"
    p free
}

proc usage {} {
    puts "$argv0 ?options? file"
}

proc run {args} {
................................................................................
            exit 1
        }
        set needToGuess 0
        switch [file extension $file] {
            ".xml" {
                fromDTD $file
            }
            ".dtd" {
                fromDTDfile $file
            }
            default {
                set needToGuess 1
            }
        }
        if {$needToGuess} {
            # Just probe everything we have in no specific order
            foreach reader {
                fromDTD
                fromDTDfile
            } {
                if {![catch {$reader $file} errMsg]} {
                    return
                }
            }
        }
        return
    }
    usage
}

run {*}$argv