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
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: htmlview.tcl,v 2.28 2005/01/02 00:45:07 jfontain Exp $
set ::htmlLibraryAdditionalCode {
# use bold and smaller sizes than the HTML library default ones for headers
array set HMtag_map {
h1 {size 22 weight bold}
h2 {size 20 weight bold}
h3 {size 18 weight bold}
h4 {size 16 weight bold}
h5 {size 14 weight bold}
h6 {weight bold}
}
# make headers and preformatted text stand out better by adding new lines around them, extra new lines after lists are too much:
array set HMinsert_map {
h1 \n\n /h1 \n\n h2 \n\n /h2 \n\n h3 \n\n /h3 \n\n h4 \n\n /h4 \n\n h5 \n\n /h5 \n\n h6 \n\n /h6 \n\n pre \n\n /ul {} /ol {}
}
unset HMevents(Enter) ;# prevent links highlighting, try to behave like Netscape
unset HMevents(Leave)
unset HMevents(1)
set HMevents(ButtonRelease-1) {-foreground darkblue}
proc HMset_image {widget label source} { ;# supply image handling procedure
if {![catch {image create photo -file $source} image]} {
bind $label <Destroy> "image delete $image" ;# setup binding so that image is deleted as label is destroyed
HMgot_image $label $image ;# got the image for the specified label
# suppress relief for better visibility and use parent text widget background for transparent areas to really look it
$label configure -borderwidth 0 -background [[winfo parent $label] cget -background]
}
}
}
append ::htmlLibraryAdditionalCode "
set HMtag_map(hmstart) {family [list $global::fontFamily]}
lappend HMtag_map(hmstart) weight medium style r size $global::fontSize Tcenter {} Tlink {} Tnowrap {} Tunderline {} list list\
fill 1 indent {} counter 0 adjust 0
"
proc HMlink_hit {path x y} { ;# is invoked here at the global level by the Tk bind facility instead of in the interpreter
$::htmlViewer::interpreterFromPath($path) eval "HMlink_hit $path $x $y"
}
class htmlViewer {
proc htmlViewer {this parentPath args} composite {[new scroll text $parentPath] $args} {
variable interpreterFromPath
set path $composite::($composite::($this,base),scrolled,path)
# borders are never shown on focus, padding so that lines do not start too close to the left border
$path configure -highlightthickness 0 -state disabled -padx 2 -background white -cursor {} ;# hide insertion cursor
set interpreter [interp create] ;# use separate interpreter because HTML library uses global state data
$interpreter eval "set ::auto_path [list $::auto_path]" ;# in case packages are needed by interpreter
$interpreter eval $::htmlLibraryCode
$interpreter eval $::htmlLibraryAdditionalCode
$interpreter alias $path $path ;# make text widget visible in interpreter
$interpreter alias formulasHelpWindow formulasHelpWindow
foreach command {bind bindtags image pack update winfo} { ;# and a few Tk commands
$interpreter alias $command $command
}
foreach command {button frame label scrollbar text} { ;# along with a few Tk widgets
$interpreter alias $command ::htmlViewer::widget $command $interpreter
}
$interpreter eval "HMinit_win $path"
# make HTML text widget behave more like Netscape
$path tag configure mark -foreground black ;# override list markers color
$path tag configure link -borderwidth 1 -foreground blue -underline 1 ;# override hypertext links border and underline
$interpreter eval "set ::HM${path}(S_symbols) {oooooo\xd7\xb0>:\xb7}" ;# use simple circles for list element markers
set ($this,interpreter) $interpreter
set ($this,textPath) $path
set interpreterFromPath($path) $interpreter ;# required for link hit procedure to find interpreter
composite::complete $this
}
proc ~htmlViewer {this} {
variable interpreterFromPath
# stop rendering in case we were interrupted by the user destroying the window for example
$($this,interpreter) eval "HMset_state $($this,textPath) -stop 1"
unset interpreterFromPath($($this,textPath))
interp delete $($this,interpreter)
}
proc options {this} {
# force initialization of linkto option
return [list\
[list -data {} {}]\
[list -file {} {}]\
[list -linkto $this]\
]
}
# can be set once completed so that widget can be managed (pack, bind, ...) and be visible for updates to occur
proc set-data {this value} {
if {[info exists ($this,loaded)]} {
error {data can only be loaded once}
}
load $this $value
}
proc set-file {this value} {
if {[info exists ($this,loaded)]} {
error {data can only be loaded once}
}
set file [open $value]
load $this [read $file]
close $file
}
proc set-linkto {this viewer} { ;# allow link hits to target another text widget (used in general help from contents)
if {$viewer == $this} {
$($this,interpreter) eval {
proc HMlink_callback {widget reference} { ;# supply link callback procedure
switch -glob -- [string tolower [file tail $reference]] {
formulas.htm - formulas-*.htm {
formulasHelpWindow ;# formulas help can be launched from general help window
}
}
if {![string match #* $reference]} return ;# can only handle internal references
HMgoto $widget [string trimleft $reference #] ;# always update help data text widget
}
}
} else {
$($this,interpreter) alias HMlink_callback ::htmlViewer::linkCallbackRedirect $viewer
}
}
proc load {this data} {
set ($this,loaded) {}
set path $($this,textPath)
busy 1 $path ;# show that we are busy for user feedback
$path configure -state normal
# the interpreter may no longer exists at this point
# ignoring errors here is required in case we are interrupted while rendering by the user closing the window for example,
# in which case the interpreter is destroyed causing the main interpreter to report the impossibility to evaluate the code
catch {$($this,interpreter) eval "HMparse_html {$data} {HMrender $path}"}
if {![winfo exists $path]} return ;# user may have destroyed the window through the window manager, for example
$($this,interpreter) eval "HMset_state $path -stop 1" ;# stop rendering previous page if busy
$path configure -state disabled
busy 0 $path
}
# create a widget of the specified type and make the resulting command available in the slave interpreter
proc widget {type interpreter args} {
set path [eval ::$type $args]
$interpreter alias $path $path
return $path
}
proc linkCallbackRedirect {viewer widget reference} { ;# link callback procedure redirecting to another viewer
$($viewer,interpreter) eval "HMlink_callback $($viewer,textPath) $reference"
}
### public procedures below ###
proc goTo {this url} {
catch {$($this,interpreter) eval "HMlink_callback $($this,textPath) $url"} ;# ignore errors as in load{}
}
}
|
