-
Notifications
You must be signed in to change notification settings - Fork 5
/
help.tcl
148 lines (145 loc) · 4.66 KB
/
help.tcl
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
#
# $Id$
#
dialog help_window {
param topics {}
param width 100
param height 35
param helpdir .
member history {}
member history_ndx -1
member history_len 0
member rendering 0
method create {} {
ttk::frame $self.menu
ttk::menubutton $self.menu.topics -text "Topics" -underline 0 \
-menu $self.menu.topics.m
pack $self.menu.topics -in $self.menu -side left
set m [menu $self.menu.topics.m]
ttk::menubutton $self.menu.navigate -text "Navigate" -underline 0 \
-menu $self.menu.navigate.m
pack $self.menu.navigate -in $self.menu -side left
set m [menu $self.menu.navigate.m]
$m add command -label "Forward" -underline 0 -state disabled \
-command "$self forward" -accelerator f
$m add command -label "Back" -underline 0 -state disabled \
-command "$self back" -accelerator b
$m add cascade -label "Go" -underline 0 -menu $m.go
menu $m.go -postcommand "$self fill_go_menu"
ttk::frame $self.text
ttk::scrollbar $self.text.sb -command "$self.text.t yview"
text $self.text.t -yscrollcommand "$self.text.sb set" \
-wrap word -setgrid 1 -background white
set t $self.text.t
pack $self.text.sb -in $self.text -side right -fill y
pack $self.text.t -in $self.text -side left -fill both -expand yes
pack $self.menu -in $self -side top -fill x
pack $self.text -in $self -side bottom -fill both -expand yes
bind $self <Key-f> "$self forward"
bind $self <Key-b> "$self back"
bind $self <Alt-Right> "$self forward"
bind $self <Alt-Left> "$self back"
bind $self <Key-space> "$self page_forward"
bind $self <Key-Next> "$self page_forward"
bind $self <Key-BackSpace> "$self page_back"
bind $self <Key-Prior> "$self page_back"
bind $self <Key-Delete> "$self page_back"
bind $self <Key-Down> "$self line_forward"
bind $self <Key-Up> "$self line_back"
}
method reconfig {} {
set m $self.menu.topics.m
$m delete 0 last
foreach topic $slot(topics) {
$m add radiobutton -variable [object_slotname topic] \
-value $topic \
-label $topic \
-command [list $self show_topic $topic]
}
$m add separator
$m add command -label "Close Help" -underline 0 \
-command "destroy $self"
$self.text.t config -width $slot(width) -height $slot(height)
}
method show_topic {topic} {
incr slot(history_ndx)
set slot(history) [lrange $slot(history) 0 $slot(history_ndx)]
set slot(history_len) [expr $slot(history_ndx) + 1]
lappend slot(history) $topic
$self read_topic $topic
}
method read_topic {topic} {
# probably should use uri::geturl from tcllib
set slot(topic) $topic
wm title $self "Help: $topic"
set filename [file join $slot(helpdir) $topic]
if {![file exist $filename]} {
append filename .html
}
set f [open $filename r]
set txt [read $f]
close $f
# Fix for
if [string match -nocase "*ChangeLog" $filename] {
set txt "<html><body><pre>$txt</pre></body></html>"
}
feedback .help_feedback -steps [set slot(len) [string length $txt]] \
-title "Rendering HTML"
.help_feedback grab
set slot(remaining) $slot(len)
set slot(rendering) 1
tkhtml_set_render_hook "$self update_feedback"
tkhtml_set_command "$self follow_link"
tkhtml_render $self.text.t $txt
destroy .help_feedback
set slot(rendering) 0
set m $self.menu.navigate.m
if {($slot(history_ndx)+1) < $slot(history_len)} {
$m entryconfig 1 -state normal
} else {
$m entryconfig 1 -state disabled
}
if {$slot(history_ndx) > 0} {
$m entryconfig 2 -state normal
} else {
$m entryconfig 2 -state disabled
}
}
method follow_link {link} {
$self show_topic $link
}
method forward {} {
if {$slot(rendering) || ($slot(history_ndx)+1) >= $slot(history_len)} return
incr slot(history_ndx)
$self read_topic [lindex $slot(history) $slot(history_ndx)]
}
method back {} {
if {$slot(rendering) || $slot(history_ndx) <= 0} return
incr slot(history_ndx) -1
$self read_topic [lindex $slot(history) $slot(history_ndx)]
}
method fill_go_menu {} {
set m $self.menu.navigate.m.go
catch {$m delete 0 last}
for {set i [expr [llength $slot(history)]-1]} {$i >= 0} {incr i -1} {
set topic [lindex $slot(history) $i]
$m add command -label $topic \
-command [list $self show_topic $topic]
}
}
method update_feedback {n} {
if {($slot(remaining) - $n) > .1*$slot(len)} {
.help_feedback step [expr $slot(remaining) - $n]
update idletasks
set slot(remaining) $n
}
}
method page_forward {} {
$self.text.t yview scroll 1 pages
}
method page_back {} {
$self.text.t yview scroll -1 pages
}
method line_forward {} { $self.text.t yview scroll 1 units }
method line_back {} { $self.text.t yview scroll -1 units }
}