tDOM

Check-in [7718b1e0ff]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Merged from schema.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | virtualConstraints
Files: files | file ages | folders
SHA3-256: 7718b1e0ff9c075ae4a780a52707085896fb377f492e1c9522a717753eec7fb2
User & Date: rolf 2019-02-19 01:36:03
Context
2019-02-19
23:06
Allow schema definition command "tcl" only inside of sequential content particles. Still uncertain about the interface. check-in: 23f4f6f626 user: rolf tags: virtualConstraints
01:36
Merged from schema. check-in: 7718b1e0ff user: rolf tags: virtualConstraints
01:33
Merged from trunk. check-in: 15ba66e204 user: rolf tags: schema
2019-02-09
01:45
Merged from schema. check-in: 48f9a019fa user: rolf tags: virtualConstraints
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to apps/toschema.tcl.

40
41
42
43
44
45
46










47

48
49
50
51
52
53
54
            return
        }
        "ANY" {
            puts "[indent]ANY\}"
            return
        }
        "SEQ" {










            puts "[indent]group $quant \{"

        }
        "CHOICE" {
            puts "[indent]choice $quant \{"
        }
    }
    foreach cp $content {
        fromDTD_serialize [expr {$level +1}] {*}$cp






>
>
>
>
>
>
>
>
>
>
|
>







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
            return
        }
        "ANY" {
            puts "[indent]ANY\}"
            return
        }
        "SEQ" {
            if {$level == 1 && $quant eq ""} {
                # At least directly below defelement there isn't any
                # need to wrap a ! SEQ into a group container -
                # defelement childs are already processed as sequence
                # while validating.
                foreach cp $content {
                    fromDTD_serialize $level {*}$cp
                }
                return
            } else {
                puts "[indent]group $quant \{"
            }
        }
        "CHOICE" {
            puts "[indent]choice $quant \{"
        }
    }
    foreach cp $content {
        fromDTD_serialize [expr {$level +1}] {*}$cp

Changes to doc/schema.xml.


1
2
3
4
5
6
7
...
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
...
353
354
355
356
357
358
359






































360
361
362
363
364
365
366
<manpage id="schema" cat="schema" title="schema">
  <namesection>
    <name>tdom::schema</name>
    <desc>Create a schema validation command</desc>
  </namesection>

  <synopsis>
................................................................................
      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc></desc>
      </commanddef>
      
      <commanddef>
        <command><cmd>tcl</cmd> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the tcl script <m>tclcmd arg arg ... /m> and
        the text to validate appended to the argument list. The return
        value of the tcl command is interpreted as a boolean.</desc>
      </commanddef>
      <commanddef>
        <command><cmd>enumeration</cmd> <m>list</m></command>
        <desc></desc>
      </commanddef>
................................................................................
        <command><cmd>nmtoken</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>nmtokens</cmd></command>
        <desc></desc>
      </commanddef>






































    </commandlist>
  </section>
  
  <section>
    <title>Exampels</title>

    <p>The XML Schema Part 0: Primer Second Edition
>







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
...
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
...
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
<!DOCTYPE  manpage  PUBLIC "-//jenglish//DTD TMML 0.6//EN" "tmml.dtd">
<manpage id="schema" cat="schema" title="schema">
  <namesection>
    <name>tdom::schema</name>
    <desc>Create a schema validation command</desc>
  </namesection>

  <synopsis>
................................................................................
      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc></desc>
      </commanddef>
      
      <commanddef>
        <command><cmd>tcl</cmd> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the tcl script <m>tclcmd arg arg ... </m> and
        the text to validate appended to the argument list. The return
        value of the tcl command is interpreted as a boolean.</desc>
      </commanddef>
      <commanddef>
        <command><cmd>enumeration</cmd> <m>list</m></command>
        <desc></desc>
      </commanddef>
................................................................................
        <command><cmd>nmtoken</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>nmtokens</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>number</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>boolean</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>isodate</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>maxLength</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>minLength</cmd></command>
        <desc></desc>
      </commanddef>
      <commanddef>
        <command><cmd>oneOf</cmd> <m>&lt;constraint script></m></command>
        <desc>This text constraint match if one of the text
        constraints defined in the argument <m>constraint script</m>
        match the text. It stops after the first match and probes the
        text constraints in the order of definition.</desc>
      </commanddef>
      <commanddef>
        <command><cmd>allOf</cmd> <m>&lt;constraint script></m></command>
        <desc>This text constraint match if all of the text
        constraints defined in the argument <m>constraint script</m>
        match the text. It stops after the first match failues and
        probes the text constraints in the order of definition. Since
        the schema definition commmand <m>text</m> also expects all
        text constraints to match the text constraint <m>allOf</m> is
        useful mostly together with the <m>oneOf</m> text constraint
        commmand.</desc>
      </commanddef>
    </commandlist>
  </section>
  
  <section>
    <title>Exampels</title>

    <p>The XML Schema Part 0: Primer Second Edition

Added doc/tmml.schema.
































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
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
239
240
241
242
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
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
start manpage
defelement manpage {
    attribute version ?
    attribute title 
    attribute id 
    attribute cat 
    attribute package ?
    element head ?
    element namesection 
    element synopsis ?
    element section *
    element seealso ?
    element keywords ?
}
defelement DEF {
    attribute cat ?
    attribute name 
    attribute package ?
    attribute subpart ?
    attribute manpage ?
}
defelement INDEX {
    attribute package ?
    attribute standalone ?
    attribute title 
    element head ?
    choice * {
        element MAN 
        element DEF 
        element KWD 
    }
}
defelement KWD {
    attribute manpage ?
    attribute name 
}
defelement MAN {
    attribute id 
    attribute title 
}
defelement argdef {
    attribute version ?
    element argtype 
    element name 
    element argmode ?
    element desc 
}
defelement arglist {
    element argdef +
}
defelement argmode {
    text
}
defelement argtype {
    text
}
defelement b {
    attribute cat ?
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement br {
}
defelement categories {
    element category +
}
defelement category {
    attribute title ?
    attribute id 
}
defelement class {
    text
}
defelement cmd {
    text
}
defelement command {
    mixed {
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement commanddef {
    attribute version ?
    element command 
    element desc 
}
defelement commandlist {
    element commanddef +
}
defelement dbclass {
    text
}
defelement dbname {
    text
}
defelement dd {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
        element p 
        element ul 
        element ol 
        element dl 
        element sl 
        element xl 
        element example 
        element syntax 
        element commandlist 
        element optlist 
    }
}
defelement desc {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
        element p 
        element ul 
        element ol 
        element dl 
        element sl 
        element xl 
        element example 
        element syntax 
        element commandlist 
        element optlist 
    }
}
defelement division {
    element title 
    choice  {
        element division *
        choice * {
            element manpage 
            element subdoc 
            element extref 
        }
    }
}
defelement dl {
    attribute cat ?
    attribute scope ? {enumeration {local global}}
    choice + {
        element dle 
        group  {
            element dt 
            element dd 
        }
    }
}
defelement dle {
    attribute version ?
    element dt +
    element dd 
}
defelement dt {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement emph {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement example {
    mixed {
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement extension {
    attribute gi 
    attribute tmml 
}
defelement extensions {
    choice * {
        element extension 
        element xlh 
    }
}
defelement extref {
    attribute title 
    attribute href 
    attribute type 
}
defelement file {
    text
}
defelement fun {
    text
}
defelement head {
    choice * {
        element extensions 
        element info 
        element link 
        element category 
    }
}
defelement i {
    attribute cat ?
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement info {
    attribute key 
    attribute value 
}
defelement keyword {
    text
}
defelement keywords {
    element keyword +
}
defelement l {
    text
}
defelement li {
    attribute version ?
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
        element p 
        element ul 
        element ol 
        element dl 
        element sl 
        element xl 
        element example 
        element syntax 
        element commandlist 
        element optlist 
    }
}
defelement link {
    attribute href 
    attribute rel 
}
defelement m {
    text
}
defelement manual {
    attribute version ?
    attribute package 
    element title 
    element head ?
    choice  {
        element division *
        choice * {
            element manpage 
            element subdoc 
            element extref 
        }
    }
}
defelement method {
    text
}
defelement name {
    attribute cat ?
    attribute name ?
    text
}
defelement namesection {
    choice  {
        element name +
        group  {
            element title 
            element name *
        }
    }
    element desc 
}
defelement new {
    attribute version 
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement o {
    mixed {
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement ol {
    element li +
}
defelement optarg {
    text
}
defelement optdef {
    element optname 
    element optarg ?
    element desc 
}
defelement option {
    text
}
defelement optiondef {
    attribute version ?
    element name 
    element dbname 
    element dbclass 
    element desc 
}
defelement optionlist {
    attribute cat ?
    attribute scope ? {enumeration {local global}}
    element optiondef +
}
defelement optlist {
    element optdef +
}
defelement optname {
    text
}
defelement p {
    attribute version ?
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement package {
    text
}
defelement ref {
    attribute cat ?
    attribute href ?
    attribute refid ?
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement samp {
    mixed {
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement section {
    attribute id ?
    attribute version ?
    element title 
    choice * {
        element p 
        element ul 
        element ol 
        element dl 
        element sl 
        element xl 
        element example 
        element syntax 
        element commandlist 
        element optlist 
        element arglist 
        element optionlist 
    }
    element subsection *
}
defelement seealso {
    choice + {
        element ref 
        element url 
    }
}
defelement sl {
    attribute cols ?
    attribute cat ?
    element li +
}
defelement subdoc {
    attribute href 
}
defelement subsection {
    attribute id ?
    attribute version ?
    element title 
    choice * {
        element p 
        element ul 
        element ol 
        element dl 
        element sl 
        element xl 
        element example 
        element syntax 
        element commandlist 
        element optlist 
        element arglist 
        element optionlist 
    }
}
defelement synopsis {
    choice + {
        element syntax 
        element example 
    }
}
defelement syntax {
    attribute name ?
    attribute scope ? {enumeration {local global}}
    attribute cat ?
    mixed {
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement syscmd {
    text
}
defelement term {
    attribute cat ?
    text
}
defelement title {
    text
}
defelement type {
    text
}
defelement ul {
    element li +
}
defelement url {
    text
}
defelement variable {
    text
}
defelement widget {
    text
}
defelement xh {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}
defelement xl {
    element xlh ?
    element xle +
}
defelement xle {
    element xt +
    element desc ?
}
defelement xlh {
    attribute gi ?
    element xh +
}
defelement xt {
    mixed {
        element emph 
        element ref 
        element url 
        element samp 
        element command 
        element new 
        element m 
        element l 
        element o 
        element i 
        element b 
        element br 
        element term 
        element cmd 
        element variable 
        element method 
        element option 
        element file 
        element syscmd 
        element fun 
        element widget 
        element package 
        element type 
        element class 
    }
}

Changes to generic/dom.c.

1505
1506
1507
1508
1509
1510
1511







1512

1513
1514
1515
1516
1517
1518
1519
....
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
    domNode       *parentNode;
    domLineColumn *lc;
    Tcl_HashEntry *h;
    char          *s;
    int            len, hnew, only_whites;
    
    len = Tcl_DStringLength (info->cdata);







    if (!len && !info->cdataSection) return;

    s = Tcl_DStringValue (info->cdata);
    
    parentNode = info->currentNode;
    if (!parentNode) return;

    if (   parentNode->lastChild 
        && parentNode->lastChild->nodeType == TEXT_NODE
................................................................................

        /* normalize text node, i.e. there are no adjacent text nodes */
        node = (domTextNode*)parentNode->lastChild;
        node->nodeValue = REALLOC(node->nodeValue, node->valueLength + len);
        memmove(node->nodeValue + node->valueLength, s, len);
        node->valueLength += len;


    } else {

        if (info->ignoreWhiteSpaces) {
            char *pc;
            int   i;

            only_whites = 1;






>
>
>
>
>
>
>

>







 







>







1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
....
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
    domNode       *parentNode;
    domLineColumn *lc;
    Tcl_HashEntry *h;
    char          *s;
    int            len, hnew, only_whites;
    
    len = Tcl_DStringLength (info->cdata);
#ifndef TDOM_NO_SCHEMA
    if (!len && !info->cdataSection
        && !(info->sdata
             && info->sdata->stack
             && info->sdata->stack->pattern->flags & CONSTRAINT_TEXT_CHILD))
        return;
#else
    if (!len && !info->cdataSection) return;
#endif
    s = Tcl_DStringValue (info->cdata);
    
    parentNode = info->currentNode;
    if (!parentNode) return;

    if (   parentNode->lastChild 
        && parentNode->lastChild->nodeType == TEXT_NODE
................................................................................

        /* normalize text node, i.e. there are no adjacent text nodes */
        node = (domTextNode*)parentNode->lastChild;
        node->nodeValue = REALLOC(node->nodeValue, node->valueLength + len);
        memmove(node->nodeValue + node->valueLength, s, len);
        node->valueLength += len;

        only_whites = 0;
    } else {

        if (info->ignoreWhiteSpaces) {
            char *pc;
            int   i;

            only_whites = 1;

Changes to generic/schema.c.

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
359
360
361
362
363
364
365

366
367
368
369
370
371
372
...
403
404
405
406
407
408
409

410
411
412
413
414
415
416
...
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513
514
515

516
517
518
519
520
521
522
523
...
658
659
660
661
662
663
664
665
666
667
668
669

670
671

672
673
674
675
676
677
678
679
680
681
....
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
....
1809
1810
1811
1812
1813
1814
1815





















1816
1817
1818
1819
1820
1821
1822
1823
....
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897

































1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
....
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
....
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026





2027
2028
2029
2030
2031
2032
2033
....
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067





2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
























2081







2082
2083
2084
2085
2086
2087
2088
2089
2090
....
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
....
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
....
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
....
2702
2703
2704
2705
2706
2707
2708
2709

2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
....
2836
2837
2838
2839
2840
2841
2842

2843
2844
2845
2846

2847














2848
2849
2850
2851

2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
....
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
....
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976

2977
2978
2979
2980
2981
2982
2983
....
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
....
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
....
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
....
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
....
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
....
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
....
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
....
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
....
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
....
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
....
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
....
3575
3576
3577
3578
3579
3580
3581

















































































3582
3583
3584
3585
3586
3587
3588
....
3653
3654
3655
3656
3657
3658
3659




3660
3661
3662
3663
}
# define SETASI(v) SetActiveSchemaData (v)
#endif


#define CHECK_SI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context.");        \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (sdata->isTextConstraint) {                                      \
        SetResult ("Command called in invalid schema context.");        \
        return TCL_ERROR;                                               \
    }

#define CHECK_TI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context.");        \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (!sdata->isTextConstraint) {                                     \
        SetResult ("Command called in invalid schema context.");        \
        return TCL_ERROR;                                               \
    }

#define CHECK_TOPLEVEL                                                  \
    if (sdata->defineToplevel) {                                        \
        SetResult("Command not allowed at top level "                   \
                  "in schema define evaluation");                       \
................................................................................

    sdata = TMALLOC (SchemaData);
    memset (sdata, 0, sizeof(SchemaData));
    Tcl_InitHashTable (&sdata->element, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->pattern, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->attrNames, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->namespace, TCL_STRING_KEYS);

    sdata->emptyNamespace = Tcl_CreateHashEntry (
        &sdata->namespace, "", &hnew);
    sdata->patternList = (SchemaCP **) MALLOC (
        sizeof (SchemaCP*) * ANON_PATTERN_ARRAY_SIZE_INIT);
    sdata->patternListSize = ANON_PATTERN_ARRAY_SIZE_INIT;
    sdata->quants = (SchemaQuant *) MALLOC (
        sizeof (SchemaQuant) * QUANTS_ARRAY_SIZE_INIT);
................................................................................

    if (sdata->start) FREE (sdata->start);
    if (sdata->startNamespace) FREE (sdata->startNamespace);
    Tcl_DeleteHashTable (&sdata->namespace);
    Tcl_DeleteHashTable (&sdata->element);
    Tcl_DeleteHashTable (&sdata->pattern);
    Tcl_DeleteHashTable (&sdata->attrNames);

    for (i = 0; i < sdata->numPatternList; i++) {
        freeSchemaCP (sdata->patternList[i]);
    }
    FREE (sdata->patternList);
    if (sdata->numQuants) {
        FREE (sdata->quants);
    }
................................................................................
    int m
    )
{
    SchemaCP *wrapperCP;
    SchemaCP *savedCP = NULL;
    unsigned int savedContenSize;

    if (sdata->cp->type == SCHEMA_CTYPE_CHOICE) {

        if (pattern->type == SCHEMA_CTYPE_CHOICE) {
            if (pattern->flags & MIXED_CONTENT) {
                sdata->cp->flags |= MIXED_CONTENT;
            }
            wrapperCP = initSchemaCP (SCHEMA_CTYPE_PATTERN, NULL, NULL);
            REMEMBER_PATTERN (wrapperCP);
            wrapperCP->content[0] = pattern;
            wrapperCP->quants[0] = SCHEMA_CQUANT_ONE;
            wrapperCP->nc = 1;
            pattern = wrapperCP;
        }

        if (quant != SCHEMA_CQUANT_ONE) {
            wrapperCP = initSchemaCP (SCHEMA_CTYPE_PATTERN, NULL, NULL);
            REMEMBER_PATTERN (wrapperCP);
            if (sdata->cp->nc == sdata->contentSize) {
                sdata->cp->content =
                    REALLOC (sdata->cp->content,
                             2 * sdata->contentSize
                             * sizeof (SchemaCP*));
................................................................................
    sdata->stack = se;
}

/* The cp argument must be type SCHEMA_CTYPE_TEXT */
static int
checkText (
    Tcl_Interp *interp,
    SchemaCP *cp,
    char *text
    )
{
    int i;

    SchemaConstraint *sc;


    for (i = 0; i < cp->nc; i++) {
        sc = (SchemaConstraint *) cp->content[i];
        if ((sc->constraint) (interp, sc->constraintData, text) != TCL_OK) {
            return 0;
        }
    }
    return 1;
}

static int
................................................................................
            break;
        }
        if (only_whites)  return TCL_OK;
        if (matchText (interp, sdata, text)) {
            return TCL_OK;
        }
    }

    SetResult ("Unexpected text content");
    return TCL_ERROR;
}

static void
startElement(
    void         *userData,
    const char   *name,
................................................................................
static int
validateDOM (
    Tcl_Interp *interp,
    SchemaData *sdata,
    domNode    *node
    )
{





















    if (probeElement (interp, sdata, node->nodeName,
                      node->namespace ?
                      node->ownerDocument->namespaces[node->namespace-1]->uri
                      : NULL)
        != TCL_OK) {
        return TCL_ERROR;
    }
    if (node->firstAttr) {
................................................................................
            != TCL_OK) return TCL_ERROR;
        Tcl_DStringSetLength (sdata->cdata, 0);
    }
    if (probeElementEnd (interp, sdata) != TCL_OK) return TCL_ERROR;
    return TCL_OK;
}

static void
schemaReset (
    SchemaData *sdata
    )
{
    while (sdata->stack) popStack (sdata);
    sdata->validationState = VALIDATION_READY;
    sdata->skipDeep = 0;
}


































int
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData  *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *entryPtr;
    SchemaCP   *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;

    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern", "start", "event", "delete",
        "nrForwardDefinitions", "state", "reset", "define",
        "validate", "domvalidate", NULL
    };
    enum schemaInstanceMethod {
        m_defelement, m_defpattern, m_start, m_event, m_delete,
        m_nrForwardDefinitions, m_state, m_reset, m_define,
        m_validate, m_domvalidate
    };

    static const char *eventKeywords[] = {
        "start", "end", "text", NULL
    };

    enum eventKeyword
................................................................................
            type = SCHEMA_CTYPE_PATTERN;
        }
        savedNumPatternList = sdata->numPatternList;
        namespacePtr = NULL;
        patternIndex = 3-i;
        if (objc == 5-i) {
            patternIndex = 4-i;
            entryPtr = Tcl_CreateHashEntry (&sdata->namespace,
                                            Tcl_GetString (objv[3-i]), &hnew);
            if (entryPtr != sdata->emptyNamespace) {
                namespacePtr = Tcl_GetHashKey (&sdata->namespace,
                                               entryPtr);
            }
        }
        entryPtr = Tcl_CreateHashEntry (hashTable,
                                        Tcl_GetString (objv[2-i]), &hnew);
        pattern = NULL;
        if (!hnew) {
            pattern = (SchemaCP *) Tcl_GetHashValue (entryPtr);
            while (pattern) {
                if (pattern->namespace == namespacePtr) {
                    if (pattern->flags & FORWARD_PATTERN_DEF
                        || pattern->flags & PLACEHOLDER_PATTERN_DEF) {
                        forwardDef = 1;
                        break;
                    }
................................................................................
                    return TCL_ERROR;
                }
                pattern = pattern->next;
            }
        }
        if (pattern == NULL) {
            pattern = initSchemaCP (type, namespacePtr,
                                       Tcl_GetHashKey (hashTable, entryPtr));
            if (!hnew) {
                current = (SchemaCP *) Tcl_GetHashValue (entryPtr);
                pattern->next = current;
            }
            REMEMBER_PATTERN (pattern);
            Tcl_SetHashValue (entryPtr, pattern);
        }

        if (!sdata->defineToplevel) {





            SETASI(sdata);
        }
        savedDefineToplevel = sdata->defineToplevel;
        savedNamespacePtr = sdata->currentNamespace;
        sdata->defineToplevel = 0;
        sdata->currentNamespace = namespacePtr;
        sdata->cp = pattern;
................................................................................
            }
        } else {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = savedDefineToplevel;
        sdata->currentNamespace = savedNamespacePtr;
        if (!savedDefineToplevel) {
            SETASI(0);
        }
        break;

    case m_define:
        if (objc != 3) {
            Tcl_WrongNumArgs (interp, 2, objv, "<definition commands>");
            return TCL_ERROR;
        }





        SETASI(sdata);
        savedNumPatternList = sdata->numPatternList;
        sdata->currentNamespace = 0;
        sdata->cp = NULL;
        sdata->contentSize = 0;
        sdata->defineToplevel = 1;
        sdata->evalStub[3] = objv[2];
        result = Tcl_EvalObjv (interp, 4, sdata->evalStub,
                               TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
        if (result != TCL_OK) {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = 0;
























        SETASI(0);







        break;

    case m_start:
        if (objc < 3-i || objc > 4-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "<documentElement>"
                              " ?<namespace>?");
            return TCL_ERROR;
        }
        if (sdata->start) {
................................................................................
        case k_elementstart:
            if (objc < 4 && objc > 6) {
                Tcl_WrongNumArgs (interp, 3, objv, "<elementname>"
                    "?<attInfo>? ?<namespace>?");
                return TCL_ERROR;
            }
            if (objc == 6) {
                entryPtr = Tcl_FindHashEntry (&sdata->namespace,
                                              Tcl_GetString (objv[5]));
                if (entryPtr && entryPtr != sdata->emptyNamespace) {
                    namespacePtr = Tcl_GetHashKey (&sdata->namespace,
                                                   entryPtr);
                } else {
                    namespacePtr = NULL;
                }
            } else {
                namespacePtr = NULL;
            }
            result = probeElement (interp, sdata, Tcl_GetString (objv[3]),
................................................................................
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]),
                            Tcl_GetStringResult (interp), 0);
            }
            SetBooleanResult (0);
        }
        schemaReset (sdata);

        break;

    default:
        Tcl_SetResult (interp, "unknown method", NULL);
        result = TCL_ERROR;
        break;

................................................................................
    if (clientData == (ClientData) 1) {
        pattern->flags |= MIXED_CONTENT;
    }
    return evalDefinition (interp, sdata, objc == 2 ? objv[1] : objv[2],
                           pattern, quant, n, m);
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
    Tcl_Obj *script
    )
{
    int result;
    SchemaCP *savedCP;
    unsigned int savedContenSize;

    /* Save some state of sdata .. */
    savedCP = sdata->cp;
    savedContenSize = sdata->contentSize;
    /* ... and prepare sdata for definition evaluation. */
    sdata->cp = cp;
    sdata->contentSize = CONTENT_ARRAY_SIZE_INIT;
    sdata->isTextConstraint = 1;
    sdata->textStub[3] = script;
    result = Tcl_EvalObjv (interp, 4, sdata->textStub,
                           TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
    sdata->isTextConstraint = 0;
    /* ... and restore the previously saved sdata states  */
    sdata->cp = savedCP;
    sdata->contentSize = savedContenSize;
    if (!sdata->isAttributeConstaint && cp->nc) {
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    return result;
}

static int maybeAddAttr (
    Tcl_Interp *interp,
    SchemaData *sdata,
    Tcl_Obj *nameObj,
    Tcl_Obj *namespaceObj,
    Tcl_Obj *scriptObj,
    int required
................................................................................
        }
    }
    attr = TMALLOC (SchemaAttr);
    attr->namespace = namespace;
    attr->name = name;
    attr->required = required;
    if (scriptObj) {
        cp = initSchemaCP (SCHEMA_CTYPE_TEXT, NULL, NULL);

        REMEMBER_PATTERN (cp)
        cp->content = (SchemaCP**) MALLOC (
            sizeof(SchemaCP*) * CONTENT_ARRAY_SIZE_INIT
            );
        cp->quants = (SchemaQuant*) MALLOC (
            sizeof (SchemaQuant) * CONTENT_ARRAY_SIZE_INIT
            );
        sdata->isAttributeConstaint = 1;
        result = evalConstraints (interp, sdata, cp, scriptObj);
        sdata->isAttributeConstaint = 0;
        attr->cp = cp;
    } else {
        attr->cp = NULL;
    }
................................................................................
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaQuant quant = SCHEMA_CQUANT_OPT;
    SchemaCP *pattern;


    CHECK_SI
    CHECK_TOPLEVEL
    checkNrArgs (1,2,"?<definition script>?");

    pattern = initSchemaCP (SCHEMA_CTYPE_TEXT, NULL, NULL);














    REMEMBER_PATTERN (pattern)
    if (objc == 2) quant = SCHEMA_CQUANT_ONE;
    addToContent (sdata, pattern, quant, 0, 0);
    

    if (objc == 2) {
        pattern->content = (SchemaCP**) MALLOC (
            sizeof(SchemaCP*) * CONTENT_ARRAY_SIZE_INIT
            );
        pattern->quants = (SchemaQuant*) MALLOC (
            sizeof (SchemaQuant) * CONTENT_ARRAY_SIZE_INIT
            );
        return evalConstraints (interp, sdata, pattern, objv[1]);
    }
    return TCL_OK;
}

static int
VirtualPatternObjCmd (
................................................................................
    void *constraintData,
    char *text
    )
{
    int n;

    if (Tcl_GetInt (interp, text, &n) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int
integerTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................

    tcdata->evalStub[tcdata->nrArg-1] = Tcl_NewStringObj(text, -1);
    Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    result = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
                           TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    if (result != TCL_OK) {
        return TCL_ERROR;
    }
    result = Tcl_GetBooleanFromObj (interp, Tcl_GetObjResult (interp), &bool);
    if (result != TCL_OK) {
        return TCL_ERROR;
    }
    if (bool) {
        return TCL_OK;
    } else {
        return TCL_ERROR;
    }

}

static int
tclTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
fixedImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    if (strcmp (text, (char *) constraintData) == 0) {
        return TCL_OK;
    }
    return TCL_ERROR;
}

static int
fixedTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    Tcl_HashTable *values = (Tcl_HashTable *) constraintData;

    if (Tcl_FindHashEntry(values, text)) return TCL_OK;
    return TCL_ERROR;
}

static int
enumerationTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
matchImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    if (Tcl_StringMatch (text, Tcl_GetString ((Tcl_Obj *) constraintData)))
        return TCL_OK;
    return TCL_ERROR;
}

static int
matchTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................


    textObj = Tcl_NewStringObj(text, -1);
    rc = Tcl_RegExpMatchObj (interp, textObj,  (Tcl_Obj *) constraintData);
    Tcl_DecrRefCount (textObj);
    /* rc may be 1, 0, -1 */
    if (rc == 1) {
        return TCL_OK;
    }
    return TCL_ERROR;
}

static int
regexpTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    while (*p && *p == ' ') {
        p++;
    }
    while (*p && *p != ' ') {
        clen = UTF8_CHAR_LEN (*p);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return TCL_ERROR;
        }
        if (!UTF8_GET_NAMING_NMTOKEN (p, clen)) {
            SetResult ("Attribute value isn't a NMTOKEN");
            return TCL_ERROR;
        }
        tokenSeen = 1;
        p += clen;
    }
    /* Skip following space */
    while (*p && *p == ' ') {
        p++;
    }
    if (*p) {
        SetResult ("Attribute value isn't a NMTOKEN");
        return TCL_ERROR;
    }
    if (!*p && !tokenSeen) {
        SetResult ("Missing NMTOKEN value");
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int
nmtokenTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    while (*p) {
        if (*p == ' ') {
            p++; continue;
        }
        clen = UTF8_CHAR_LEN (*p);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return TCL_ERROR;
        }
        if (!UTF8_GET_NAMING_NMTOKEN (p, clen)) {
            SetResult ("Invalid charcter: attribute value isn't a NMTOKENS");
            return TCL_ERROR;
        }
        tokenSeen = 1;
        p += clen;
    }
    /* Any following space is already skipped above */
    if (!tokenSeen) {
        SetResult ("Missing NMTOKENS value");
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int
nmtokensTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    void *constraintData,
    char *text
    )
{
    double d;

    if (Tcl_GetDouble (interp, text, &d) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int
numberTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    void *constraintData,
    char *text
    )
{
    int b;

    if (Tcl_GetBoolean (interp, text, &b) != TCL_OK) {
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int
booleanTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    int i, y, m, d;

    if (*text == '-') {
        /* A bce date */
        text++;
    }
    for (i = 0; i < 4; i++) {
        if (*text < '0' || *text > '9') return TCL_ERROR;
        text++;
    }
    if (*text != '-') return TCL_ERROR;
    y = atoi(text-4);
    /* There isn't a year 0. it's either 0001 or -0001 */
    if (y == 0) return TCL_ERROR;
    text++;
    for (i = 0; i < 2; i++) {
        if (*text < '0' || *text > '9') return TCL_ERROR;
        text++;
    }
    if (*text != '-') return TCL_ERROR;
    m = atoi(text-2);
    if (m < 1 || m > 12) return TCL_ERROR;
    text++;
    for (i = 0; i < 2; i++) {
        if (*text < '0' || *text > '9') return TCL_ERROR;
        text++;
    }
    if (*text != '\0') return TCL_ERROR;
    d = atoi(text-2);
    if (d < 1) return TCL_ERROR;
    switch (m) {
    case 1:
    case 3:
    case 5:
    case 7:
    case 8:
    case 10:
    case 12:
        if (d > 31) return TCL_ERROR;
        break;
    case 4:
    case 6:
    case 9:
    case 11:
        if (d > 30) return TCL_ERROR;
        break;
    case 2:
        if (y % 4 == 0 && (y % 100 != 0 || y % 400 == 0)) {
            if (d > 29) return TCL_ERROR;
        } else {
            if (d > 28) return TCL_ERROR;
        }
        break;
    }
    return TCL_OK;
}

static int
isodateTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    long maxlen = (long) constraintData;
    int len = 0, clen;

    while (*text != '\0') {
        clen = UTF8_CHAR_LEN (*text);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return TCL_ERROR;
        }
        len++;
        if (len > maxlen) return TCL_ERROR;
        text += clen;
    }
    return TCL_OK;
}

static int
maxLengthTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    long minlen = (long) constraintData;
    int len = 0, clen;

    while (*text != '\0') {
        clen = UTF8_CHAR_LEN (*text);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return TCL_ERROR;
        }
        len++;
        if (len >= minlen) return TCL_OK;
        text += clen;
    }
    return TCL_ERROR;
}

static int
minLengthTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
        SetResult ("The minimum length must be at least 1");
    }
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = minLengthImpl;
    sc->constraintData = (void *)len;
    return TCL_OK;
}


















































































void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          booleanTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::isodate",
                          isodateTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::maxLength",
                          maxLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::minLength",
                          minLengthTCObjCmd, NULL, NULL);




}


#endif  /* #ifndef TDOM_NO_SCHEMA */






|



|





|



|







 







>







 







>







 







|
>











>
|







 







|




>


>


|







 







|
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







 







|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>













|

|
|






|
|
|


|
|
|







 







|

|
|
<


|
<


|







 







|

|



|



>
>
>
>
>







 







|








>
>
>
>
>













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>

|







 







|

|
|
<







 







<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|
>

<
<
<
<
<
<







 







>



|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
|
>

<
<
<
<
<
<







 







|

|







 







|



|


|
<
<
|
>







 







|

|







 







|
|







 







|
|







 







|

|







 







|



|










|



|

|







 







|



|







|

|







 







|

|







 







|

|







 







|


|


|


|


|

|


|


|

|








|





|



|

|



|







 







|


|


|







 







|


|


|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>




140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
...
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
...
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
....
1647
1648
1649
1650
1651
1652
1653
1654

1655
1656
1657
1658
1659
1660
1661
....
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
....
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
....
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048

2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
....
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
....
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
....
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230

2231
2232
2233
2234
2235
2236
2237
....
2340
2341
2342
2343
2344
2345
2346

2347
2348
2349
2350
2351
2352
2353
....
2725
2726
2727
2728
2729
2730
2731
































2732
2733
2734
2735
2736
2737
2738
....
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775






2776
2777
2778
2779
2780
2781
2782
....
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923


2924
2925
2926






2927
2928
2929
2930
2931
2932
2933
....
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
....
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041


3042
3043
3044
3045
3046
3047
3048
3049
3050
....
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
....
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
....
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
....
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
....
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
....
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
....
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
....
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
....
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
....
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
....
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
....
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
....
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
}
# define SETASI(v) SetActiveSchemaData (v)
#endif


#define CHECK_SI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context");         \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (sdata->isTextConstraint) {                                      \
        SetResult ("Command called in invalid schema context");         \
        return TCL_ERROR;                                               \
    }

#define CHECK_TI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context");         \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (!sdata->isTextConstraint) {                                     \
        SetResult ("Command called in invalid schema context");         \
        return TCL_ERROR;                                               \
    }

#define CHECK_TOPLEVEL                                                  \
    if (sdata->defineToplevel) {                                        \
        SetResult("Command not allowed at top level "                   \
                  "in schema define evaluation");                       \
................................................................................

    sdata = TMALLOC (SchemaData);
    memset (sdata, 0, sizeof(SchemaData));
    Tcl_InitHashTable (&sdata->element, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->pattern, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->attrNames, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->namespace, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->textDef, TCL_STRING_KEYS);
    sdata->emptyNamespace = Tcl_CreateHashEntry (
        &sdata->namespace, "", &hnew);
    sdata->patternList = (SchemaCP **) MALLOC (
        sizeof (SchemaCP*) * ANON_PATTERN_ARRAY_SIZE_INIT);
    sdata->patternListSize = ANON_PATTERN_ARRAY_SIZE_INIT;
    sdata->quants = (SchemaQuant *) MALLOC (
        sizeof (SchemaQuant) * QUANTS_ARRAY_SIZE_INIT);
................................................................................

    if (sdata->start) FREE (sdata->start);
    if (sdata->startNamespace) FREE (sdata->startNamespace);
    Tcl_DeleteHashTable (&sdata->namespace);
    Tcl_DeleteHashTable (&sdata->element);
    Tcl_DeleteHashTable (&sdata->pattern);
    Tcl_DeleteHashTable (&sdata->attrNames);
    Tcl_DeleteHashTable (&sdata->textDef);
    for (i = 0; i < sdata->numPatternList; i++) {
        freeSchemaCP (sdata->patternList[i]);
    }
    FREE (sdata->patternList);
    if (sdata->numQuants) {
        FREE (sdata->quants);
    }
................................................................................
    int m
    )
{
    SchemaCP *wrapperCP;
    SchemaCP *savedCP = NULL;
    unsigned int savedContenSize;

    if (sdata->cp->type == SCHEMA_CTYPE_CHOICE
         || sdata->cp->type == SCHEMA_CTYPE_INTERLEAVE) {
        if (pattern->type == SCHEMA_CTYPE_CHOICE) {
            if (pattern->flags & MIXED_CONTENT) {
                sdata->cp->flags |= MIXED_CONTENT;
            }
            wrapperCP = initSchemaCP (SCHEMA_CTYPE_PATTERN, NULL, NULL);
            REMEMBER_PATTERN (wrapperCP);
            wrapperCP->content[0] = pattern;
            wrapperCP->quants[0] = SCHEMA_CQUANT_ONE;
            wrapperCP->nc = 1;
            pattern = wrapperCP;
        }
        if (sdata->cp->type == SCHEMA_CTYPE_CHOICE
            && quant != SCHEMA_CQUANT_ONE) {
            wrapperCP = initSchemaCP (SCHEMA_CTYPE_PATTERN, NULL, NULL);
            REMEMBER_PATTERN (wrapperCP);
            if (sdata->cp->nc == sdata->contentSize) {
                sdata->cp->content =
                    REALLOC (sdata->cp->content,
                             2 * sdata->contentSize
                             * sizeof (SchemaCP*));
................................................................................
    sdata->stack = se;
}

/* The cp argument must be type SCHEMA_CTYPE_TEXT */
static int
checkText (
    Tcl_Interp *interp,
    void *clientData,
    char *text
    )
{
    int i;
    SchemaCP *cp = (SchemaCP *) clientData;
    SchemaConstraint *sc;

    /* Look also at oneOfImpl */
    for (i = 0; i < cp->nc; i++) {
        sc = (SchemaConstraint *) cp->content[i];
        if (!(sc->constraint) (interp, sc->constraintData, text)) {
            return 0;
        }
    }
    return 1;
}

static int
................................................................................
            break;
        }
        if (only_whites)  return TCL_OK;
        if (matchText (interp, sdata, text)) {
            return TCL_OK;
        }
    }
    SetResult ("Text content doesn't match");

    return TCL_ERROR;
}

static void
startElement(
    void         *userData,
    const char   *name,
................................................................................
static int
validateDOM (
    Tcl_Interp *interp,
    SchemaData *sdata,
    domNode    *node
    )
{
    char *ln;

    if (node->namespace) {
        if (node->ownerDocument->namespaces[node->namespace-1]->prefix[0] == '\0') {
            ln = node->nodeName;
        } else {
            ln = node->nodeName;
            while (*ln && (*ln != ':')) {
                ln++;
            }
            if (*ln == ':') {
                ln++;
            } else {
                /* Ups? */
                ln = node->nodeName;
            }
        }
    } else {
        ln = node->nodeName;
    }
    
    if (probeElement (interp, sdata, ln,
                      node->namespace ?
                      node->ownerDocument->namespaces[node->namespace-1]->uri
                      : NULL)
        != TCL_OK) {
        return TCL_ERROR;
    }
    if (node->firstAttr) {
................................................................................
            != TCL_OK) return TCL_ERROR;
        Tcl_DStringSetLength (sdata->cdata, 0);
    }
    if (probeElementEnd (interp, sdata) != TCL_OK) return TCL_ERROR;
    return TCL_OK;
}

void
schemaReset (
    SchemaData *sdata
    )
{
    while (sdata->stack) popStack (sdata);
    sdata->validationState = VALIDATION_READY;
    sdata->skipDeep = 0;
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
    Tcl_Obj *script
    )
{
    int result, savedIsTextConstraint;
    SchemaCP *savedCP;
    unsigned int savedContenSize;

    /* Save some state of sdata .. */
    savedCP = sdata->cp;
    savedContenSize = sdata->contentSize;
    savedIsTextConstraint = sdata->isTextConstraint;
    /* ... and prepare sdata for definition evaluation. */
    sdata->cp = cp;
    sdata->contentSize = CONTENT_ARRAY_SIZE_INIT;
    sdata->isTextConstraint = 1;
    sdata->textStub[3] = script;
    result = Tcl_EvalObjv (interp, 4, sdata->textStub,
                           TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
    sdata->isTextConstraint = savedIsTextConstraint;
    /* ... and restore the previously saved sdata states  */
    sdata->cp = savedCP;
    sdata->contentSize = savedContenSize;
    if (sdata->cp && !sdata->isAttributeConstaint && cp->nc) {
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    return result;
}

int
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata = NULL, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *h;
    SchemaCP      *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;

    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern",  "start", "event", "delete",
        "nrForwardDefinitions",      "state", "reset", "define",
        "validate",   "domvalidate", "deftext", NULL
    };
    enum schemaInstanceMethod {
        m_defelement,  m_defpattern,  m_start, m_event, m_delete,
        m_nrForwardDefinitions,       m_state, m_reset, m_define,
        m_validate,    m_domvalidate, m_deftext
    };

    static const char *eventKeywords[] = {
        "start", "end", "text", NULL
    };

    enum eventKeyword
................................................................................
            type = SCHEMA_CTYPE_PATTERN;
        }
        savedNumPatternList = sdata->numPatternList;
        namespacePtr = NULL;
        patternIndex = 3-i;
        if (objc == 5-i) {
            patternIndex = 4-i;
            h = Tcl_CreateHashEntry (&sdata->namespace,
                                            Tcl_GetString (objv[3-i]), &hnew);
            if (h != sdata->emptyNamespace) {
                namespacePtr = Tcl_GetHashKey (&sdata->namespace, h);

            }
        }
        h = Tcl_CreateHashEntry (hashTable, Tcl_GetString (objv[2-i]), &hnew);

        pattern = NULL;
        if (!hnew) {
            pattern = (SchemaCP *) Tcl_GetHashValue (h);
            while (pattern) {
                if (pattern->namespace == namespacePtr) {
                    if (pattern->flags & FORWARD_PATTERN_DEF
                        || pattern->flags & PLACEHOLDER_PATTERN_DEF) {
                        forwardDef = 1;
                        break;
                    }
................................................................................
                    return TCL_ERROR;
                }
                pattern = pattern->next;
            }
        }
        if (pattern == NULL) {
            pattern = initSchemaCP (type, namespacePtr,
                                       Tcl_GetHashKey (hashTable, h));
            if (!hnew) {
                current = (SchemaCP *) Tcl_GetHashValue (h);
                pattern->next = current;
            }
            REMEMBER_PATTERN (pattern);
            Tcl_SetHashValue (h, pattern);
        }

        if (!sdata->defineToplevel) {
            savedsdata = GETASI;
            if (savedsdata == sdata) {
                SetResult ("Recursive call of schema command is not allowed");
                return TCL_ERROR;
            }
            SETASI(sdata);
        }
        savedDefineToplevel = sdata->defineToplevel;
        savedNamespacePtr = sdata->currentNamespace;
        sdata->defineToplevel = 0;
        sdata->currentNamespace = namespacePtr;
        sdata->cp = pattern;
................................................................................
            }
        } else {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = savedDefineToplevel;
        sdata->currentNamespace = savedNamespacePtr;
        if (!savedDefineToplevel) {
            SETASI(savedsdata);
        }
        break;

    case m_define:
        if (objc != 3) {
            Tcl_WrongNumArgs (interp, 2, objv, "<definition commands>");
            return TCL_ERROR;
        }
        savedsdata = GETASI;
        if (savedsdata == sdata) {
            SetResult ("Recursive call of schema command is not allowed");
            return TCL_ERROR;
        }
        SETASI(sdata);
        savedNumPatternList = sdata->numPatternList;
        sdata->currentNamespace = 0;
        sdata->cp = NULL;
        sdata->contentSize = 0;
        sdata->defineToplevel = 1;
        sdata->evalStub[3] = objv[2];
        result = Tcl_EvalObjv (interp, 4, sdata->evalStub,
                               TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
        if (result != TCL_OK) {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = 0;
        SETASI(savedsdata);
        break;

    case m_deftext:
        if (objc !=  4-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "<name>"
                              " <constraints script>");
            return TCL_ERROR;
        }
        h = Tcl_CreateHashEntry (&sdata->textDef, Tcl_GetString (objv[2-i]),
                                 &hnew);
        if (!hnew) {
            SetResult ("There is already a text type definition with this "
                       "name");
            return TCL_ERROR;
        }
        savedsdata = GETASI;
        if (savedsdata == sdata) {
            SetResult ("Recursive call of schema command is not allowed");
            return TCL_ERROR;
        }
        pattern = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
        pattern->type = SCHEMA_CTYPE_TEXT;
        REMEMBER_PATTERN (pattern)
        SETASI(sdata);
        result = evalConstraints (interp, sdata, pattern, objv[3-i]);
        SETASI(savedsdata);
        if (result == TCL_OK) {
            Tcl_SetHashValue (h, pattern);
        } else {
            Tcl_DeleteHashEntry (h);
        }
        break;
        
    case m_start:
        if (objc < 3-i || objc > 4-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "<documentElement>"
                              " ?<namespace>?");
            return TCL_ERROR;
        }
        if (sdata->start) {
................................................................................
        case k_elementstart:
            if (objc < 4 && objc > 6) {
                Tcl_WrongNumArgs (interp, 3, objv, "<elementname>"
                    "?<attInfo>? ?<namespace>?");
                return TCL_ERROR;
            }
            if (objc == 6) {
                h = Tcl_FindHashEntry (&sdata->namespace,
                                              Tcl_GetString (objv[5]));
                if (h && h != sdata->emptyNamespace) {
                     namespacePtr = Tcl_GetHashKey (&sdata->namespace, h);

                } else {
                    namespacePtr = NULL;
                }
            } else {
                namespacePtr = NULL;
            }
            result = probeElement (interp, sdata, Tcl_GetString (objv[3]),
................................................................................
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]),
                            Tcl_GetStringResult (interp), 0);
            }
            SetBooleanResult (0);
        }
        schemaReset (sdata);

        break;

    default:
        Tcl_SetResult (interp, "unknown method", NULL);
        result = TCL_ERROR;
        break;

................................................................................
    if (clientData == (ClientData) 1) {
        pattern->flags |= MIXED_CONTENT;
    }
    return evalDefinition (interp, sdata, objc == 2 ? objv[1] : objv[2],
                           pattern, quant, n, m);
}

































static int maybeAddAttr (
    Tcl_Interp *interp,
    SchemaData *sdata,
    Tcl_Obj *nameObj,
    Tcl_Obj *namespaceObj,
    Tcl_Obj *scriptObj,
    int required
................................................................................
        }
    }
    attr = TMALLOC (SchemaAttr);
    attr->namespace = namespace;
    attr->name = name;
    attr->required = required;
    if (scriptObj) {
        cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
        cp->type = SCHEMA_CTYPE_TEXT;
        REMEMBER_PATTERN (cp)






        sdata->isAttributeConstaint = 1;
        result = evalConstraints (interp, sdata, cp, scriptObj);
        sdata->isAttributeConstaint = 0;
        attr->cp = cp;
    } else {
        attr->cp = NULL;
    }
................................................................................
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaQuant quant = SCHEMA_CQUANT_OPT;
    SchemaCP *pattern;
    Tcl_HashEntry *h;

    CHECK_SI
    CHECK_TOPLEVEL
    checkNrArgs (1,3,"?<definition script>? | type <name>");
    if (objc == 1) {
        pattern = initSchemaCP (SCHEMA_CTYPE_TEXT, NULL, NULL);
    } else if (objc == 2) {
        quant = SCHEMA_CQUANT_ONE;
        pattern = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
        pattern->type = SCHEMA_CTYPE_TEXT;
    } else {
        h = Tcl_FindHashEntry (&sdata->textDef, Tcl_GetString (objv[2]));
        if (!h) {
            SetResult ("Unknown text type");
            return TCL_ERROR;
        }
        pattern = (SchemaCP *) Tcl_GetHashValue (h);
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    if (objc < 3) {
        REMEMBER_PATTERN (pattern)


    }
    addToContent (sdata, pattern, quant, 0, 0);
    if (objc == 2) {






        return evalConstraints (interp, sdata, pattern, objv[1]);
    }
    return TCL_OK;
}

static int
VirtualPatternObjCmd (
................................................................................
    void *constraintData,
    char *text
    )
{
    int n;

    if (Tcl_GetInt (interp, text, &n) != TCL_OK) {
        return 0;
    }
    return 1;
}

static int
integerTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................

    tcdata->evalStub[tcdata->nrArg-1] = Tcl_NewStringObj(text, -1);
    Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    result = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
                           TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    if (result != TCL_OK) {
        return 0;
    }
    result = Tcl_GetBooleanFromObj (interp, Tcl_GetObjResult (interp), &bool);
    if (result != TCL_OK) {
        return 0;
    }
    if (bool) {
        return 1;


    } 
    return 0;
}

static int
tclTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
fixedImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    if (strcmp (text, (char *) constraintData) == 0) {
        return 1;
    }
    return 0;
}

static int
fixedTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    Tcl_HashTable *values = (Tcl_HashTable *) constraintData;

    if (Tcl_FindHashEntry(values, text)) return 1;
    return 0;
}

static int
enumerationTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
matchImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    if (Tcl_StringMatch (text, Tcl_GetString ((Tcl_Obj *) constraintData)))
        return 1;
    return 0;
}

static int
matchTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................


    textObj = Tcl_NewStringObj(text, -1);
    rc = Tcl_RegExpMatchObj (interp, textObj,  (Tcl_Obj *) constraintData);
    Tcl_DecrRefCount (textObj);
    /* rc may be 1, 0, -1 */
    if (rc == 1) {
        return 1;
    }
    return 0;
}

static int
regexpTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    while (*p && *p == ' ') {
        p++;
    }
    while (*p && *p != ' ') {
        clen = UTF8_CHAR_LEN (*p);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return 0;
        }
        if (!UTF8_GET_NAMING_NMTOKEN (p, clen)) {
            SetResult ("Attribute value isn't a NMTOKEN");
            return 0;
        }
        tokenSeen = 1;
        p += clen;
    }
    /* Skip following space */
    while (*p && *p == ' ') {
        p++;
    }
    if (*p) {
        SetResult ("Attribute value isn't a NMTOKEN");
        return 0;
    }
    if (!*p && !tokenSeen) {
        SetResult ("Missing NMTOKEN value");
        return 0;
    }
    return 1;
}

static int
nmtokenTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    while (*p) {
        if (*p == ' ') {
            p++; continue;
        }
        clen = UTF8_CHAR_LEN (*p);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return 0;
        }
        if (!UTF8_GET_NAMING_NMTOKEN (p, clen)) {
            SetResult ("Invalid charcter: attribute value isn't a NMTOKENS");
            return 0;
        }
        tokenSeen = 1;
        p += clen;
    }
    /* Any following space is already skipped above */
    if (!tokenSeen) {
        SetResult ("Missing NMTOKENS value");
        return 0;
    }
    return 1;
}

static int
nmtokensTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    void *constraintData,
    char *text
    )
{
    double d;

    if (Tcl_GetDouble (interp, text, &d) != TCL_OK) {
        return 0;
    }
    return 1;
}

static int
numberTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    void *constraintData,
    char *text
    )
{
    int b;

    if (Tcl_GetBoolean (interp, text, &b) != TCL_OK) {
        return 0;
    }
    return 1;
}

static int
booleanTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    int i, y, m, d;

    if (*text == '-') {
        /* A bce date */
        text++;
    }
    for (i = 0; i < 4; i++) {
        if (*text < '0' || *text > '9') return 0;
        text++;
    }
    if (*text != '-') return 0;
    y = atoi(text-4);
    /* There isn't a year 0. it's either 0001 or -0001 */
    if (y == 0) return 0;
    text++;
    for (i = 0; i < 2; i++) {
        if (*text < '0' || *text > '9') return 0;
        text++;
    }
    if (*text != '-') return 0;
    m = atoi(text-2);
    if (m < 1 || m > 12) return 0;
    text++;
    for (i = 0; i < 2; i++) {
        if (*text < '0' || *text > '9') return 0;
        text++;
    }
    if (*text != '\0') return 0;
    d = atoi(text-2);
    if (d < 1) return 0;
    switch (m) {
    case 1:
    case 3:
    case 5:
    case 7:
    case 8:
    case 10:
    case 12:
        if (d > 31) return 0;
        break;
    case 4:
    case 6:
    case 9:
    case 11:
        if (d > 30) return 0;
        break;
    case 2:
        if (y % 4 == 0 && (y % 100 != 0 || y % 400 == 0)) {
            if (d > 29) return 0;
        } else {
            if (d > 28) return 0;
        }
        break;
    }
    return 1;
}

static int
isodateTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    long maxlen = (long) constraintData;
    int len = 0, clen;

    while (*text != '\0') {
        clen = UTF8_CHAR_LEN (*text);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return 0;
        }
        len++;
        if (len > maxlen) return 0;
        text += clen;
    }
    return 1;
}

static int
maxLengthTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
    long minlen = (long) constraintData;
    int len = 0, clen;

    while (*text != '\0') {
        clen = UTF8_CHAR_LEN (*text);
        if (!clen) {
            SetResult ("Invalid UTF-8 character");
            return 0;
        }
        len++;
        if (len >= minlen) return 1;
        text += clen;
    }
    return 0;
}

static int
minLengthTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
................................................................................
        SetResult ("The minimum length must be at least 1");
    }
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = minLengthImpl;
    sc->constraintData = (void *)len;
    return TCL_OK;
}

static int
oneOfImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaCP *cp = (SchemaCP *) constraintData;
    SchemaConstraint *sc;
    int i;

    /* Look also at checkText */
    for (i = 0; i < cp->nc; i++) {
        sc = (SchemaConstraint *) cp->content[i];
        if ((sc->constraint) (interp, sc->constraintData, text)) {
            return 1;
        }
    }
    return 0;
}

static int
oneOfTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaCP *cp;
    SchemaConstraint *sc;
    int rc;

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (2,2,"Expected: <text constraint script>");
    
    cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
    cp->type = SCHEMA_CTYPE_TEXT;
    REMEMBER_PATTERN (cp)
    rc = evalConstraints (interp, sdata, cp, objv[1]);
    if (rc == TCL_OK) {
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = oneOfImpl;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    return TCL_ERROR;
}

static int
allOfTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaCP *cp;
    SchemaConstraint *sc;
    int rc;

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (2,2,"Expected: <text constraint script>");
    
    cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
    cp->type = SCHEMA_CTYPE_TEXT;
    REMEMBER_PATTERN (cp)
    rc = evalConstraints (interp, sdata, cp, objv[1]);
    if (rc == TCL_OK) {
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = checkText;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    return TCL_ERROR;
}

void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          booleanTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::isodate",
                          isodateTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::maxLength",
                          maxLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::minLength",
                          minLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::oneOf",
                          oneOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::allOf",
                          allOfTCObjCmd, NULL, NULL);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to generic/schema.h.

109
110
111
112
113
114
115

116
117
118
119
120
121
122
...
192
193
194
195
196
197
198




199
200
    char *start;
    char *startNamespace;
    Tcl_HashTable element;
    Tcl_HashTable namespace;
    Tcl_HashEntry *emptyNamespace;
    Tcl_HashTable pattern;
    Tcl_HashTable attrNames;

    SchemaCP **patternList; 
    unsigned int numPatternList;
    unsigned int patternListSize;
    unsigned int forwardPatternDefs;
    SchemaQuant *quants;
    unsigned int numQuants;
    unsigned int quantsSize;
................................................................................
int
probeText (
    Tcl_Interp *interp,
    SchemaData *sdata,
    char *text
    );






#endif 






>







 







>
>
>
>


109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
193
194
195
196
197
198
199
200
201
202
203
204
205
    char *start;
    char *startNamespace;
    Tcl_HashTable element;
    Tcl_HashTable namespace;
    Tcl_HashEntry *emptyNamespace;
    Tcl_HashTable pattern;
    Tcl_HashTable attrNames;
    Tcl_HashTable textDef;
    SchemaCP **patternList; 
    unsigned int numPatternList;
    unsigned int patternListSize;
    unsigned int forwardPatternDefs;
    SchemaQuant *quants;
    unsigned int numQuants;
    unsigned int quantsSize;
................................................................................
int
probeText (
    Tcl_Interp *interp,
    SchemaData *sdata,
    char *text
    );

void
schemaReset (
    SchemaData *sdata
    );

#endif 

Changes to generic/tcldom.c.

6613
6614
6615
6616
6617
6618
6619



6620
6621
6622
6623
6624
6625
6626
                          useForeignDTD,
                          paramEntityParsing,
#ifndef TDOM_NO_SCHEMA
                          sdata,
#endif
                          interp,
                          &status);



    if (doc == NULL) {
        char s[50];
        long byteIndex, i;
        
        switch (status) {
        case TCL_BREAK:
            /* Abort of parsing by the application */






>
>
>







6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
                          useForeignDTD,
                          paramEntityParsing,
#ifndef TDOM_NO_SCHEMA
                          sdata,
#endif
                          interp,
                          &status);
#ifndef TDOM_NO_SCHEMA
    if (sdata) schemaReset (sdata);
#endif
    if (doc == NULL) {
        char s[50];
        long byteIndex, i;
        
        switch (status) {
        case TCL_BREAK:
            /* Abort of parsing by the application */

Changes to generic/tclexpat.c.

705
706
707
708
709
710
711



712
713
714
715
716
717
718
719
...
810
811
812
813
814
815
816



817
818
819
820
821
822
823
824
825
826
827
828
829



830
831
832
833
834
835
836
...
839
840
841
842
843
844
845



846
847
848
849
850
851
852
...
863
864
865
866
867
868
869





870
871
872
873
874
875
876
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
  TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData;
  char *data;
  int len = 0, optionIndex, result = TCL_OK;




  static const char *options[] = {
      "configure", "cget", "currentmarkup", "free", "get",
      "parse", "parsechannel", "parsefile", "reset", "delete",
      NULL
  };
  enum options {
      EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_CURRENTMARKUP, EXPAT_FREE, EXPAT_GET,
................................................................................
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
        data = Tcl_GetStringFromObj(objv[2], &len);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_STRING);
        if (expat->final || result != TCL_OK) {



            expat->final = 1;
            expat->finished = 1;
        }
        break;
        
    case EXPAT_PARSECHANNEL:

        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }



        data = Tcl_GetString(objv[2]);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_CHANNEL);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }
        break;
................................................................................

        CheckArgs (3,3,2, "<filename>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }



        data = Tcl_GetString(objv[2]);
        result = TclExpatParse (interp, expat, data, len, 
                                EXPAT_INPUT_FILENAME);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }
................................................................................
        } else {
            result = TclExpatInitializeParser (interp, expat, 1);
        }
        break;

  }






  return result;
}


/*
 *----------------------------------------------------------------------------
 *






>
>
>
|







 







>
>
>













>
>
>







 







>
>
>







 







>
>
>
>
>







705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
...
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
...
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
...
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
  TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData;
  char *data;
  int len = 0, optionIndex, result = TCL_OK;
#ifndef TDOM_NO_SCHEMA
  int resetsdata = 0;
#endif
  
  static const char *options[] = {
      "configure", "cget", "currentmarkup", "free", "get",
      "parse", "parsechannel", "parsefile", "reset", "delete",
      NULL
  };
  enum options {
      EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_CURRENTMARKUP, EXPAT_FREE, EXPAT_GET,
................................................................................
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
        data = Tcl_GetStringFromObj(objv[2], &len);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_STRING);
        if (expat->final || result != TCL_OK) {
#ifndef TDOM_NO_SCHEMA
            resetsdata = 1;
#endif
            expat->final = 1;
            expat->finished = 1;
        }
        break;
        
    case EXPAT_PARSECHANNEL:

        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
#ifndef TDOM_NO_SCHEMA
        resetsdata = 1;
#endif
        data = Tcl_GetString(objv[2]);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_CHANNEL);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }
        break;
................................................................................

        CheckArgs (3,3,2, "<filename>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
#ifndef TDOM_NO_SCHEMA
        resetsdata = 1;
#endif
        data = Tcl_GetString(objv[2]);
        result = TclExpatParse (interp, expat, data, len, 
                                EXPAT_INPUT_FILENAME);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }
................................................................................
        } else {
            result = TclExpatInitializeParser (interp, expat, 1);
        }
        break;

  }

#ifndef TDOM_NO_SCHEMA
  if (resetsdata && expat->sdata) {
      schemaReset (expat->sdata);
  }
#endif
  return result;
}


/*
 *----------------------------------------------------------------------------
 *

Changes to lib/tdom.tcl.

637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
...
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
...
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
...
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
...
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
...
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
...
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
# cp1251 koi8-u macDingbats iso8859-7 cp1252 iso8859-8 cp1253
# iso8859-9 cp1254 cp1255 cp850 cp1256 cp932 identity cp1257 cp852
# macJapan cp1258 shiftjis utf-8 cp855 cp936 symbol cp775 unicode
# cp857
# 
# Just add more mappings (and mail them to the tDOM mailing list, please).

proc tdom::IANAEncoding2TclEncoding {IANAName} {
    
    # First the most widespread encodings with there
    # preferred MIME name, to speed lookup in this
    # usual cases. Later the official names and the
    # aliases.
    #
    # For "official names for character sets that may be
................................................................................
    }
}

#----------------------------------------------------------------------------
#   xmlOpenFileWorker
#
#----------------------------------------------------------------------------
proc tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forRead 0}} {

    # This partly (mis-)use the encoding of a channel handed to [dom
    # parse -channel ..] as a marker: if the channel encoding is utf-8
    # then behind the scene Tcl_Read() is used, otherwise
    # Tcl_ReadChars(). This is used for the encodings understood (and
    # checked) by the used expat implementation: utf-8 and utf-16 (in
    # either byte order).
................................................................................
    return $fd
}

#----------------------------------------------------------------------------
#   xmlOpenFile
#
#----------------------------------------------------------------------------
proc tdom::xmlOpenFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString]
    return $fd
}

#----------------------------------------------------------------------------
#   xmlReadFile
#
#----------------------------------------------------------------------------
proc tdom::xmlReadFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 0 1]
    set data [read $fd [file size $filename]]
................................................................................
    return $data
}

#----------------------------------------------------------------------------
#   xmlReadFileForSimple
#
#----------------------------------------------------------------------------
proc tdom::xmlReadFileForSimple {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 1]
    set data [read $fd [file size $filename]]
................................................................................
#   
#   A very simple external entity resolver, included for convenience.
#   Depends on the tcllib package uri and resolves only file URLs. 
#
#----------------------------------------------------------------------------

if {![catch {package require uri}]} {
    proc tdom::extRefHandler {base systemId publicId} {
        variable extRefHandlerDebug
        variable useForeignDTD

        if {$extRefHandlerDebug} {
            puts stderr "tdom::extRefHandler called with:"
            puts stderr "\tbase:     '$base'"
            puts stderr "\tsystemId: '$systemId'"
            puts stderr "\tpublicId: '$publicId'"
        }
        if {$systemId == ""} {
            if {$useForeignDTD != ""} {
                set systemId $useForeignDTD
................................................................................
#----------------------------------------------------------------------------
#   baseURL
#   
#   A simple convenience proc which returns an absolute URL for a given
#   filename.
#
#----------------------------------------------------------------------------
proc tdom::baseURL {path} {
    # FIXME - path components need to be URL-encoded

    # Note [file join] will return path as is if it is already absolute.
    # Also on Windows, it will change \ -> /. This is necessary because
    # file URIs must always use /, never \.
    set path [file join [pwd] $path]

................................................................................
    variable extRefHandlerDebug 0
    variable useForeignDTD ""

    namespace export xmlOpenFile xmlReadFile xmlReadFileForSimple \
        extRefHandler baseURL
}

foreach cmd {
    xmlOpenFile
    xmlReadFile
    xmlReadFileForSimple
    extRefHandler
    baseURL
} {
    interp alias {} tDOM::$cmd {} tdom::$cmd
}

# EOF






|







 







|







 







|













|







 







|







 







|




|







 







|







 







|






|



637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
...
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
...
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
...
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
...
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
...
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
...
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
# cp1251 koi8-u macDingbats iso8859-7 cp1252 iso8859-8 cp1253
# iso8859-9 cp1254 cp1255 cp850 cp1256 cp932 identity cp1257 cp852
# macJapan cp1258 shiftjis utf-8 cp855 cp936 symbol cp775 unicode
# cp857
# 
# Just add more mappings (and mail them to the tDOM mailing list, please).

proc ::tdom::IANAEncoding2TclEncoding {IANAName} {
    
    # First the most widespread encodings with there
    # preferred MIME name, to speed lookup in this
    # usual cases. Later the official names and the
    # aliases.
    #
    # For "official names for character sets that may be
................................................................................
    }
}

#----------------------------------------------------------------------------
#   xmlOpenFileWorker
#
#----------------------------------------------------------------------------
proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forRead 0}} {

    # This partly (mis-)use the encoding of a channel handed to [dom
    # parse -channel ..] as a marker: if the channel encoding is utf-8
    # then behind the scene Tcl_Read() is used, otherwise
    # Tcl_ReadChars(). This is used for the encodings understood (and
    # checked) by the used expat implementation: utf-8 and utf-16 (in
    # either byte order).
................................................................................
    return $fd
}

#----------------------------------------------------------------------------
#   xmlOpenFile
#
#----------------------------------------------------------------------------
proc ::tdom::xmlOpenFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString]
    return $fd
}

#----------------------------------------------------------------------------
#   xmlReadFile
#
#----------------------------------------------------------------------------
proc ::tdom::xmlReadFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 0 1]
    set data [read $fd [file size $filename]]
................................................................................
    return $data
}

#----------------------------------------------------------------------------
#   xmlReadFileForSimple
#
#----------------------------------------------------------------------------
proc ::tdom::xmlReadFileForSimple {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 1]
    set data [read $fd [file size $filename]]
................................................................................
#   
#   A very simple external entity resolver, included for convenience.
#   Depends on the tcllib package uri and resolves only file URLs. 
#
#----------------------------------------------------------------------------

if {![catch {package require uri}]} {
    proc ::tdom::extRefHandler {base systemId publicId} {
        variable extRefHandlerDebug
        variable useForeignDTD

        if {$extRefHandlerDebug} {
            puts stderr "::tdom::extRefHandler called with:"
            puts stderr "\tbase:     '$base'"
            puts stderr "\tsystemId: '$systemId'"
            puts stderr "\tpublicId: '$publicId'"
        }
        if {$systemId == ""} {
            if {$useForeignDTD != ""} {
                set systemId $useForeignDTD
................................................................................
#----------------------------------------------------------------------------
#   baseURL
#   
#   A simple convenience proc which returns an absolute URL for a given
#   filename.
#
#----------------------------------------------------------------------------
proc ::tdom::baseURL {path} {
    # FIXME - path components need to be URL-encoded

    # Note [file join] will return path as is if it is already absolute.
    # Also on Windows, it will change \ -> /. This is necessary because
    # file URIs must always use /, never \.
    set path [file join [pwd] $path]

................................................................................
    variable extRefHandlerDebug 0
    variable useForeignDTD ""

    namespace export xmlOpenFile xmlReadFile xmlReadFileForSimple \
        extRefHandler baseURL
}

foreach ::tdom::cmd {
    xmlOpenFile
    xmlReadFile
    xmlReadFileForSimple
    extRefHandler
    baseURL
} {
    interp alias {} tDOM::$::tdom::cmd {} tdom::$::tdom::cmd
}

# EOF

Changes to tests/data/REC-xslt-19991116.xml.

1
2
3
4
5
6
7
8
9
10
11
<?xml version="1.0" encoding="iso-8859-1"?>
<!-- $Id$ -->
<!DOCTYPE spec PUBLIC "-//W3C//DTD Specification V2.0//EN"
                      "/XML/1998/06/xmlspec-v20.dtd" [
<!ENTITY XML "http://www.w3.org/TR/REC-xml">
<!ENTITY XMLNames "http://www.w3.org/TR/REC-xml-names">
<!ENTITY XSLT.ns "http://www.w3.org/1999/XSL/Transform">
<!ENTITY XSLTA.ns "http://www.w3.org/1999/XSL/TransformAlias">
<!ENTITY XSLFO.ns "http://www.w3.org/1999/XSL/Format">
<!ENTITY XHTML.ns "http://www.w3.org/TR/xhtml1/strict">
<!ENTITY year "1999">


|







1
2
3
4
5
6
7
8
9
10
11
<?xml version="1.0" encoding="iso-8859-1"?>
<!-- $Id$ -->
<!DOCTYPE spec PUBLIC "-//W3C//DTD Specification V2.0//EN"
                      "xmlspec-v20.dtd" [
<!ENTITY XML "http://www.w3.org/TR/REC-xml">
<!ENTITY XMLNames "http://www.w3.org/TR/REC-xml-names">
<!ENTITY XSLT.ns "http://www.w3.org/1999/XSL/Transform">
<!ENTITY XSLTA.ns "http://www.w3.org/1999/XSL/TransformAlias">
<!ENTITY XSLFO.ns "http://www.w3.org/1999/XSL/Format">
<!ENTITY XHTML.ns "http://www.w3.org/TR/xhtml1/strict">
<!ENTITY year "1999">

Changes to tests/schema.test.

228
229
230
231
232
233
234
235






























































236
237
238
239
240
241
242
...
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
...
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
...
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
...
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
...
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
...
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
...
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
...
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
...
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
....
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
....
2278
2279
2280
2281
2282
2283
2284




















































2285
2286
2287
2288
2289
2290
2291
....
2777
2778
2779
2780
2781
2782
2783





































































































































2784
2785
2786
2787
2788
2789
2790
....
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
....
3113
3114
3115
3116
3117
3118
3119





3120






3121

































































































































































        {<doc><a/><b/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0}
        






























































test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {
................................................................................
    }
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/></doc>
    } doc
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    $doc delete
    grammar reset
    dom parse -validateCmd grammar {
        <doc><e1/><e2/></doc>
    } doc
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    $doc delete
    grammar reset
    dom parse -validateCmd grammar {
        <doc><e1/><e2/><e2/><e2/></doc>
    } doc
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    $doc delete
    grammar delete
} {}

proc schema-5.3 {base systemId publicId} {
    return [list "string" "" "<foo/>"]
}

test schema-5.3 {dom parse -validateCmd} {
................................................................................
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.1.1 {group} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.2 {group} {
    tdom::schema create grammar
    grammar defelement doc {
        element e1
................................................................................
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.2.1 {group} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.3 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1><e2/></e1><e2/><e1><e2/></e1><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.4 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1><e2/></e1><e2/></doc>
    } doc
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.5 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
        }
    }
    ::xml::parser p -validateCmd grammar
    p parse {
        <doc><e1/><e1><e2/></e1><e2/></doc>
    }
    p delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.6 {nested groups via refs} {
    tdom::schema create grammar
    grammar define {
        defpattern a foouri {
................................................................................
           <e2/>
           <e3/>
           <!-- inside ref b: ref a end -->
           <!-- ref b end -->
         </doc>
    }]
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar reset
    set result [grammar validate {
         <doc>
           <!-- ref b start -->
           <b2/>
           <!-- inside ref b: ref a start -->
           <e1/>
           <e1>
................................................................................
           </e1>
           <e2/>
           <e3/>
           <!-- ref a end -->
         </doc>
    }]
    $doc delete
    if {[grammar state] ne "FINISHED"} {
        error "Wrong state."
    }
    grammar delete
} {}

test schema-7.9 {loop over seq} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
                element e2
                choice 2 {
                    element e3
                    element e4
                }
            }
        }
        foreach e {e1 e2 e3 e4} {
            defelement $e foouri {}
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        {<doc><e1/></doc>}
        {<doc><e2/><e3/></doc>}
        {<doc><e2/></doc>}
................................................................................
        lappend result [s domvalidate [$doc documentElement]]
        lappend result [s validate $xml]
        $doc delete
    }
    s delete
    set result
} {1 1 1 1 1 1 0 0 0 0}





















































test schema-13.1 {XML namespaces} {
    tdom::schema create s
    s defelement doc ns1 {
        # Forward defined element inherits child namespace
        element elm1
        element elm2
................................................................................
    set schema-15.2 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg ${schema-15.2}
    set result
} {1 {} astartaendastartaend}






































































































































test schema-16.1 {interleave} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element a
                element b
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 1 1 0}

        # <doc/>
        # <doc><a/><b1/><b2/><c/></doc>
        # <doc><b1/><b2/><a/><c/></doc>
        # <doc><c/><b1/><b2/><a/></doc>
        # <doc><c/><b1/><a/><b2/></doc>
        # <doc><b1/><b2/><a/><b1/><b2/><c/><b1/><b2/></doc>
        # <doc><a/><c/></doc>
        # <doc>12</doc>

test schema-16.7 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 0 1 0}













}







































































































































































|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<

<



<
<
<

<



<
<
<

<







 







<
<
<







 







<
<
<







 







<
<
<







 







<
<
<







 







<
<
<







 







<
<
<







 







<
<
<







 







<
<
<
<







 







<
<
<







 







<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
|
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
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
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
...
499
500
501
502
503
504
505



506

507
508
509



510

511
512
513



514

515
516
517
518
519
520
521
...
587
588
589
590
591
592
593



594
595
596
597
598
599
600
...
613
614
615
616
617
618
619



620
621
622
623
624
625
626
...
633
634
635
636
637
638
639



640
641
642
643
644
645
646
...
655
656
657
658
659
660
661



662
663
664
665
666
667
668
...
679
680
681
682
683
684
685



686
687
688
689
690
691
692
...
702
703
704
705
706
707
708



709
710
711
712
713
714
715
...
726
727
728
729
730
731
732



733
734
735
736
737
738
739
...
857
858
859
860
861
862
863




864
865
866
867
868
869
870
...
920
921
922
923
924
925
926



927
928
929
930
931
932
933
....
1795
1796
1797
1798
1799
1800
1801



1802
1803
1804
1805
1806
1807
1808
....
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
....
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
....
3172
3173
3174
3175
3176
3177
3178









3179
3180
3181
3182
3183
3184
3185
....
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
        {<doc><a/><b/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0}

test schema-1.15 {call structure constraint outside define/defelement} {
    set result [catch {tdom::schema::element foo} errMsg]
    lappend result $errMsg
    tdom::schema create grammar
    lappend result [catch {tdom::schema::element foo} errMsg]
    lappend result $errMsg
    lappend result [catch {grammar define {::tdom::schema::element foo}} errMsg]
    lappend result $errMsg
    lappend result [catch {grammar defelement bar {::tdom::schema::element foo}} errMsg]
    lappend result $errMsg
    grammar delete
    set result
} {1 {Command called outside of schema context} 1 {Command called outside of schema context} 1 {Command not allowed at top level in schema define evaluation} 0 {}}

test schema-1.16 {call another schema cmd in a schema definition script} {
    tdom::schema create s1
    s1 define {
        defelement s1a {
            element s1b *
            element s1c
        }
        ::tdom::schema ::s2
        s2 define {
            defelement s1a {
                element s1b *
                element s1c
            }
        }
        defelement s1b {
            element s1b1
        }
    }
    set result [list]
    foreach xml {
        <s1a/>
        <s1a><s1b/><s1c/></s1a>
        <s1a><s1c/></s1a>
        <s1a><s1b><s1b1/></s1b><s1c/></s1a>
    } {
        lappend result [s1 validate $xml]
        lappend result [s2 validate $xml]
    }
    s1 delete
    s2 delete
    set result
} {0 0 0 1 1 1 1 0}

test schema-1.17 {call schema cmd evaluation in his own schema definition script} {
    tdom::schema create s1
    set result [catch {s1 define {
        defelement s1a {
            s1 defelement s1b {
                element s1b1
            }
            element s1b *
            element s1c
        }
    }} errMsg]
    s1 delete
    set result
} 1

test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {
................................................................................
    }
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/></doc>
    } doc



    $doc delete

    dom parse -validateCmd grammar {
        <doc><e1/><e2/></doc>
    } doc



    $doc delete

    dom parse -validateCmd grammar {
        <doc><e1/><e2/><e2/><e2/></doc>
    } doc



    $doc delete

} {}

proc schema-5.3 {base systemId publicId} {
    return [list "string" "" "<foo/>"]
}

test schema-5.3 {dom parse -validateCmd} {
................................................................................
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.1.1 {group} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.2 {group} {
    tdom::schema create grammar
    grammar defelement doc {
        element e1
................................................................................
    foreach e {e1 e2} {
        grammar defelement $e {}
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.2.1 {group} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1/><e2/><e1/><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.3 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1><e2/></e1><e2/><e1><e2/></e1><e2/><e2/><e2/><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.4 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
            grammar defelement $e {}
        }
    }
    dom parse -validateCmd grammar {
        <doc><e1/><e1><e2/></e1><e2/></doc>
    } doc
    $doc delete



    grammar delete
} {}

test schema-7.5 {group with inline defined element} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
        }
    }
    ::xml::parser p -validateCmd grammar
    p parse {
        <doc><e1/><e1><e2/></e1><e2/></doc>
    }
    p delete



    grammar delete
} {}

test schema-7.6 {nested groups via refs} {
    tdom::schema create grammar
    grammar define {
        defpattern a foouri {
................................................................................
           <e2/>
           <e3/>
           <!-- inside ref b: ref a end -->
           <!-- ref b end -->
         </doc>
    }]
    $doc delete




    set result [grammar validate {
         <doc>
           <!-- ref b start -->
           <b2/>
           <!-- inside ref b: ref a start -->
           <e1/>
           <e1>
................................................................................
           </e1>
           <e2/>
           <e3/>
           <!-- ref a end -->
         </doc>
    }]
    $doc delete



    grammar delete
} {}

test schema-7.9 {loop over seq} {
    tdom::schema create grammar
    grammar define {
        defelement doc {
................................................................................
                element e2
                choice 2 {
                    element e3
                    element e4
                }
            }
        }



    }
    set result [list]
    foreach xml {
        <doc/>
        {<doc><e1/></doc>}
        {<doc><e2/><e3/></doc>}
        {<doc><e2/></doc>}
................................................................................
        lappend result [s domvalidate [$doc documentElement]]
        lappend result [s validate $xml]
        $doc delete
    }
    s delete
    set result
} {1 1 1 1 1 1 0 0 0 0}

test schema-12.5 {domvalidate doch w/ xml namespace} {
    tdom::schema s 
    s define {
        defelement addressBook http://foo.bar {
            element card *
        }
        defelement card http://foo.bar {
            element name
            element email
        }
        foreach e {name email} {
            defelement $e http://foo.bar {text}
        }
    }
    set doc [dom parse {
<addressBook xmlns="http://foo.bar">
  <card>
    <name>John Smith</name>
    <email>[email protected]</email>
  </card>
  <card>
    <name>Fred Bloggs</name>
    <email>[email protected]</email>
  </card>
</addressBook>        
    }]
    set result [s domvalidate $doc]
    lappend result [s domvalidate [$doc documentElement]]
    lappend result [s domvalidate [[$doc documentElement] firstChild]]
    lappend result [s domvalidate [[[$doc documentElement] firstChild] firstChild]]
    $doc delete
    set doc [dom parse {
<ns1:addressBook xmlns:ns1="http://foo.bar">
  <ns1:card>
    <ns1:name>John Smith</ns1:name>
    <ns1:email>[email protected]</ns1:email>
  </ns1:card>
  <ns1:card>
    <ns1:name>Fred Bloggs</ns1:name>
    <ns1:email>[email protected]</ns1:email>
  </ns1:card>
</ns1:addressBook>        
}]
    lappend result [s domvalidate $doc]
    lappend result [s domvalidate [$doc documentElement]]
    lappend result [s domvalidate [[$doc documentElement] firstChild]]
    lappend result [s domvalidate [[[$doc documentElement] firstChild] firstChild]]
    $doc delete
    s delete
    set result
} {1 1 1 1 1 1 1 1}

test schema-13.1 {XML namespaces} {
    tdom::schema create s
    s defelement doc ns1 {
        # Forward defined element inherits child namespace
        element elm1
        element elm2
................................................................................
    set schema-15.2 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg ${schema-15.2}
    set result
} {1 {} astartaendastartaend}

test schema-14.15 {text: oneOf} {
    tdom::schema s
    s define {
        defelement doc {
            text {
                oneOf {
                    maxLength 3
                    isodate
                }
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>foo</doc>
        <doc>1</doc>
        <doc>12</doc>
        <doc>1234-12-31</doc>
        <doc>-14.23</doc>
        <doc>&#x1F46E;&#x1234;&#x1234;&#x1234;&#x1234;</doc>
        <doc>1234-12</doc>
        <doc>12345678901234567890</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 1 1 1 0 0 0 0}

test schema-14.16 {text: oneOf} {
    tdom::schema s
    s define {
        defelement doc {
            text {
                minLength 1
                oneOf {
                    maxLength 3
                    isodate
                }
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>foo</doc>
        <doc>1</doc>
        <doc>12</doc>
        <doc>1234-12-31</doc>
        <doc>-14.23</doc>
        <doc>&#x1F46E;&#x1234;&#x1234;&#x1234;&#x1234;</doc>
        <doc>1234-12</doc>
        <doc>12345678901234567890</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 1 1 1 0 0 0 0}

test schema-14.17 {text: oneOf w/ allOf} {
    tdom::schema s
    s define {
        defelement doc {
            text {
                minLength 1
                oneOf {
                    allOf {
                        maxLength 3
                        minLength 1
                    }
                    isodate                    
                }
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>foo</doc>
        <doc>1</doc>
        <doc>12</doc>
        <doc>1234-12-31</doc>
        <doc>-14.23</doc>
        <doc>&#x1F46E;&#x1234;&#x1234;&#x1234;&#x1234;</doc>
        <doc>1234-12</doc>
        <doc>12345678901234567890</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 1 1 1 0 0 0 0}

test schema-14.18 {deftext} {
    tdom::schema s
    s deftext len2-4 {
        minLength 2
        maxLength 4
    }
    s defelement doc {
         element e ! {text type len2-4}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><e/></doc>
        <doc><e></e></doc>
        {<doc><e> </e></doc>}
        {<doc><e>1</e></doc>}
        {<doc><e>12</e></doc>}
        {<doc><e>  </e></doc>}
        {<doc><e>123</e></doc>}
        {<doc><e>1234</e></doc>}
        {<doc><e>1234 </e></doc>}
        {<doc><e>12345</e></doc>}
        {<doc><e>123&#x1234;</e></doc>}
    } {
        lappend result [s validate $xml]
        set rc [catch {dom parse -validateCmd s $xml doc}]
        if {$rc == 0} {
            $doc delete
        }
        lappend result $rc
    }
    s delete
    set result
} {0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0}

test schema-16.1 {interleave} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element a
                element b
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 1 1 0}










test schema-16.7 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 0 1 0}

test schema-16.11 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
            interleave {
                element a
                choice {
                    element b1
                    element b2
                }
                element c
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/><b1/><c/></doc>
        <doc><b2/><a/><c/></doc>
        <doc><c/><b1/><a/></doc>
        <doc><c/><b1/><a/><b2/></doc>
        <doc><b1/><b2/><a/><b1/><b2/><c/><b1/><b2/></doc>
        <doc><a/><c/></doc>
        <doc>12</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 0 0 0}

test schema-16.12 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
            interleave {
                element a
                choice ? {
                    element b1
                    element b2
                }
                element c
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/><b1/><c/></doc>
        <doc><b2/><a/><c/></doc>
        <doc><c/><b1/><a/></doc>
        <doc><c/><b1/><a/><b2/></doc>
        <doc><b1/><b2/><a/><b1/><b2/><c/><b1/><b2/></doc>
        <doc><a/><c/></doc>
        <doc>12</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 0 0 1 0}

test schema-16.13 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
            interleave {
                element a
                choice + {
                    element b1
                    element b2
                }
                element c
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/><b1/><c/></doc>
        <doc><b2/><a/><c/></doc>
        <doc><c/><b1/><a/></doc>
        <doc><c/><b1/><a/><b2/></doc>
        <doc><b1/><b2/><a/><b1/><b2/><c/><b1/><b2/></doc>
        <doc><a/><c/></doc>
        <doc>12</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 0 0}

test schema-16.14 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b2 c} {
            defelement $e {}
        }
        defelement doc {
            interleave {
                element a
                choice * {
                    element b1
                    element b2
                }
                element c
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/><b1/><c/></doc>
        <doc><b2/><a/><c/></doc>
        <doc><c/><b1/><a/></doc>
        <doc><c/><b1/><a/><b2/></doc>
        <doc><b1/><b2/><a/><b1/><b2/><c/><b1/><b2/></doc>
        <doc><a/><c/></doc>
        <doc>12</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 1 0}

test schema-16.15 {interleave} {
    tdom::schema s
    s define {
        foreach e {a b1 b11 b2 c} {
            defelement $e {}
        }
        defelement doc {
            interleave {
                element a
                choice * {
                    element b1
                    group {
                        element b11
                        element b2
                    }
                }
                element c
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/><b1/><c/></doc>
        <doc><b2/><a/><c/></doc>
        <doc><c/><b1/><a/></doc>
        <doc><c/><b1/><a/><b2/></doc>
        <doc><b11/><b2/><a/><b11/><b2/><c/><b11/><b2/></doc>
        <doc><a/><c/></doc>
        <doc>12</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 0 1 0 1 1 0}

}