1proc ::helpdoc::attrsToOpts_ {attrList} {
2    # PURPOSE
3    # Tranform attribute list to option list, i.e.:
4    # {name ident type} --> {-name -ident -type}
5
6    set optList {}
7    foreach attr $attrList {
8	lappend optList -$attr
9    }
10    return $optList
11}
12
13
14proc ::helpdoc::optVal2AttrVal_ {optValList} {
15    # PURPOSE
16    # Tranform option-value pairs to attribute value pairs, i.e.:
17    # {-option1 value1 -option2 value2} --> {option1="value1" option2="value2"}
18
19    set result ""
20    foreach {opt val} $optValList {
21	set attr [string trimleft $opt -]
22	append result "$attr=\"$val\" "
23    }
24    return $result
25}
26
27
28proc ::helpdoc::checkIdent_ {ident} {
29    # PURPOSE
30    # Check if $ident is valid ident: it should not start with -, and
31    # should be one word only, starting with an alphabetical
32    # character"
33
34    set ident [string trim $ident]
35    set tag [tag -3]
36    if { [regexp {^-} $ident] } {
37	::tclu::abort "expecting ident for tag \"$tag\", but got an option $ident"
38    }
39
40    if { [llength $ident] > 1 } {
41	::tclu::abort "expecting ident for tag \"$tag\" (ident should be a single word), but got a text: $ident"
42    }
43
44    if { ! [regexp {^[a-zA-Z_]} $ident] } {
45	::tclu::abort "not a proper ident, $ident, for tag \"$tag\", ident start with a-z, or A-Z, or _"
46    }
47}
48
49proc ::helpdoc::rootnameTag_ {args} {
50    variable tree
51    variable stack
52    variable state
53    variable elemArr
54
55    set tag  [tag -2]
56    set code [lindex $args end]
57    set tree [::struct::tree]
58    set node [$tree rootname]
59
60    $tree set $node tag $tag
61
62    parseTagMsg_; puts ""
63
64    # do tag uses ident ?
65
66    #puts "tag=$tag"
67    #puts "array(IDENT,*):    [array names elemArr IDENT,*]\n"
68    #puts "array(ATTRLIST,*): [array names elemArr ATTRLIST,*]\n"
69
70    if { [info exists elemArr(IDENT,$tag)] } {
71	# add name="string" to attribute list
72	set ident [lindex $args 0]
73	checkIdent_ $ident
74	set attr  "name=\"$ident\" "
75	set args  [lrange $args 1 end]
76    }
77
78    # do tag use attributes ?
79
80    if { [info exists elemArr(ATTRLIST,$tag)] } {
81	append attr [optVal2AttrVal_ [::tclu::extractArgs \
82					  [attrsToOpts_ $elemArr(ATTRLIST,$tag)]  args]]
83	if { [llength $args] != 1 } {
84	    # wrong attributes have been specified
85	    ::tclu::abort "wrong attributes for the \"$tag\" specified, must be one of: [join $elemArr(ATTRLIST,$tag) ,]"
86	}
87    }
88
89    # store attributes into the tree ...
90
91    if { [info exists attr] } {
92	$tree set $node attributes $attr
93    }
94
95    # proceed further
96
97    $stack push [$tree rootname]
98    namespace eval tag $code
99    $stack pop
100
101    puts {[OK] - parsing finished}
102}
103
104
105proc ::helpdoc::elementTag_ {args} {
106    variable tree
107    variable stack
108    variable state
109    variable elemArr
110
111    set tag  [tag -2]
112
113    if { $tree == "" } {
114	# an element tag has been specified before rootelement
115	::tclu::abort "an element \"$tag\" specified before the rootelement \"$state(rootElem)\""
116    }
117
118    set node [$tree insert [$stack peek] end]
119    set code [lindex $args end]
120
121
122    $tree set $node tag $tag
123
124    #puts "tag=$tag"
125    #puts "array(TEXT,*):     [array names elemArr TEXT,*]\n"
126    #puts "array(IDENT,*):    [array names elemArr IDENT,*]\n"
127    #puts "array(ATTRLIST,*): [array names elemArr ATTRLIST,*]\n"
128
129    # do tag uses ident ?
130
131    if { [info exists elemArr(IDENT,$tag)] } {
132	# add name="string" to attribute list
133	set name [lindex $args 0]
134	parseTagMsg_ $name;
135
136	checkIdent_ $name
137	set attr  "name=\"$name\" "
138	set args  [lrange $args 1 end]
139	if { $args == "" } { set code "" }
140    } else {
141	parseTagMsg_;
142    }
143
144    # do tag use attributes ?
145
146    if { [info exists elemArr(ATTRLIST,$tag)] } {
147	if { [llength $args] > 1 } {
148	    # this is quick-and-dirty, but we need to do more cheking on order, optionality, ....
149	    append attr [optVal2AttrVal_ [::tclu::extractArgs \
150					      [attrsToOpts_ $elemArr(ATTRLIST,$tag)]  args]]
151	    if { [llength $args] != 1 } {
152		# wrong attributes have been specified
153		::tclu::abort "wrong attributes for the \"$tag\" specified, must be one of: [join $elemArr(ATTRLIST,$tag) ,]"
154	    }
155	}
156    }
157
158    # TODO: checks on order, optionality, ...
159
160    # store attributes into the tree ...
161
162    if { [info exists attr] } {
163	$tree set $node attributes $attr
164    }
165
166    # we have a leaf or a complex-element ?
167
168    if { [info exists elemArr(WORD,$tag)] || [info exists elemArr(STRING,$tag)] ||
169	 [info exists elemArr(TEXT,$tag)] || [info exists elemArr(CLIST,$tag)] || [info exists elemArr(PLIST,$tag)] } {
170
171	# we have a simple-element (leaf)
172	$tree set $node text [lindex $args 0]
173	#parseTagMsg_; puts ok
174	puts ok
175
176    } else {
177	# we have a complex element
178	puts ""; # (needed for nice print-out)
179
180	# proceed further
181
182	$stack push $node
183	namespace eval tag $code
184	$stack pop
185
186	parseTagMsgOK_;
187    }
188}
189
190
191proc ::helpdoc::parseTagMsg_ {{name {}}} {
192    variable tree
193
194    set indent [uplevel 1 {indent [$tree depth $node]}]
195    set tag    [string toupper [tag -3]]
196    puts -nonewline "${indent}parsing $tag $name ... "
197}
198
199proc ::helpdoc::parseTagMsgOK_ {{name {}}} {
200    variable tree
201    set indent [uplevel 1 {indent [$tree depth $node]}]
202    set tag    [string toupper [tag -3]]
203
204    if { $name == "" } {
205	puts "${indent}\[OK\] - parsing $tag completed"
206    } else {
207	puts "${indent}\[OK\] - parsing $tag $name completed"
208    }
209}
210
211