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
|
#
# TXT
#
proc ::helpdoc::attr2array_ {arrayName attributes} {
upvar $arrayName arrayVar
catch {array unset arrayVar}; # EXPERIMENTAL: this should be the
# desired behavior, because one wants to
# tranform attribute-list to associative
# array, hence the previous key-value
# pairs should be cleared
foreach {name value} [::textutil::splitx $attributes "=\"|\"\[ \n\r\\t\]|\"$"] {
if { $name != "" } {
set arrayVar($name) [string trim $value =]
}
}
}
proc ::helpdoc::arr {elem} {
variable arr
if { [info exists arr($elem)] } {
return $arr($elem)
}
return ""
}
proc ::helpdoc::printf {content {extraSpace 0}} {
variable txtDepth
variable indentNum
variable fid
set indent [indent $txtDepth]
if { $extraSpace > 0 } {
set indent $indent[::textutil::blank $extraSpace]
}
foreach line [split $content \n] {
puts $fid(txt) ${indent}$line
}
}
proc helpdoc::printfNormalize {content} {
variable txtDepth
variable fid
puts $fid(txt) [formatString $content $txtDepth]
}
proc helpdoc::labelMsg {label msg} {
set il 1
set len [string length $label]
set message {}
foreach line [split [string trim $msg] \n] {
if { $il == 1 } {
append message [::format "%${len}s %s" $label $line]
incr il
} else {
append message [::format "\n%${len}s %s" {} $line]
}
}
return $message
}
proc ::helpdoc::txt_ref_link {content} {
set re_ref {(@ref)\s+(\w+([%]\w)*)}
set re_link {(@link)\s+([.,;:]*[\w\+-]+([.,;:][\w\+-]+)*)}
set re "($re_ref|$re_link)"
return [regsub -all $re $content {"\3"}]
}
proc ::helpdoc::txt_tag_enter {tree node tag attr content depth} {
variable txtDepth
variable indentNum
variable fid
variable arr
variable vargroup
variable dimensiongroup
variable colgroup
variable rowgroup
variable card
variable mode
variable rows
variable cols
variable info
variable options
variable options_first
if { [info exists arr] } {
unset arr
}
set content [formatString [trimEmpty [txt_atTags [txt_ref_link $content]]]]
#set content [formatString [trimEmpty $content]]
attr2array_ arr $attr
global sourcedir
source [file join $sourcedir txt_enter.tcl]
}
proc ::helpdoc::txt_tag_leave {tree node tag attr content depth} {
variable fid
variable txtDepth
variable vargroup
variable dimensiongroup
variable colgroup
variable rowgroup
variable mode
variable card
variable rows
variable cols
variable arr
variable options
variable options_first
attr2array_ arr $attr
global sourcedir
source [file join $sourcedir txt_leave.tcl]
}
proc ::helpdoc::txt_subtree {tree node newMode} {
variable mode
lappend mode $newMode
set newTree [::struct::tree]
$newTree deserialize [$tree serialize $node]
$newTree walkproc [$newTree rootname] -order both txt_subtree_print
$newTree destroy
::tclu::lpop mode
}
proc ::helpdoc::txt_subtree_print {tree node action} {
set depth [$tree depth $node]
set tag [$tree get $node tag]
set attributes [getFromTree $tree $node attributes]
set content [getFromTree $tree $node text]
txt_tag_${action} $tree $node $tag $attributes $content [expr $depth - 1]
}
proc ::helpdoc::printableVarDescription {tree node} {
variable mode
# Purpose: the description of variable in the card is printed only
# when at least one of info, status or see records is present.
set Info [getTextFromDescendant $tree $node info]
set Status [getTextFromDescendant $tree $node status]
set See [getTextFromDescendant $tree $node see]
set Opt [getTextFromDescendant $tree $node opt]
if { ! [::tclu::lpresent $mode card] || ($Info != "" || $Status != "" || $See != "" || $Opt != "") } {
return 1
}
return 0
}
|
