Scid  4.6.5
htext.tcl
Go to the documentation of this file.
1 ###################
2 # htext.tcl: Online help/hypertext display module for Scid
3 #
4 # The htext module implements html-like display in a text widget.
5 # It is used in Scid for the help and crosstable windows, and for
6 # the game information area.
7 
8 namespace eval ::htext {}
9 
10 set helpWin(Stack) {}
11 set helpWin(yStack) {}
12 set helpWin(Indent) 0
13 
14 # help_PushStack and help_PopStack:
15 # Implements the stack of help windows for the "Back" button.
16 #
17 proc help_PushStack {name {heading ""}} {
18  global helpWin
19  lappend helpWin(Stack) $name
20  if {[llength $helpWin(Stack)] > 10} {
21  set helpWin(Stack) [lrange $helpWin(Stack) 1 end]
22  }
23  if {[winfo exists .helpWin]} {
24  set helpWin(yStack) [linsert $helpWin(yStack) 0 \
25  [lindex [.helpWin.text yview] 0]]
26  if {[llength $helpWin(yStack)] > 10} {
27  set helpWin(yStack) [lrange $helpWin(yStack) 0 9]
28  }
29  }
30 }
31 
32 set ::htext::headingColor "\#990000"
33 array set ::htext:updates {}
34 
35 proc help_PopStack {} {
36  global helpWin helpText
37  set len [llength $helpWin(Stack)]
38  if {$len < 1} { return}
39  incr len -2
40  set name [lindex $helpWin(Stack) $len]
41  set helpWin(Stack) [lrange $helpWin(Stack) 0 $len]
42 
43  set ylen [llength $helpWin(yStack)]
44  set yview 0.0
45  if {$ylen >= 1} {
46  set yview [lindex $helpWin(yStack) 0]
47  set helpWin(yStack) [lrange $helpWin(yStack) 1 end]
48  }
49  updateHelpWindow $name
50  .helpWin.text yview moveto $yview
51 }
52 
53 proc helpWindow {name {heading ""}} {
54  help_PushStack $name
55  updateHelpWindow $name $heading
56 }
57 
58 proc updateHelpWindow {name {heading ""}} {
59  global helpWin helpText helpTitle windowsOS language
60  set w .helpWin
61 
62  set slist [split $name " "]
63  if {[llength $slist] > 1} {
64  set name [lindex $slist 0]
65  set heading [lindex $slist 1]
66  }
67 
68  if {[info exists helpText($language,$name)] && [info exists helpTitle($language,$name)]} {
69  set title $helpTitle($language,$name)
70  set helptext $helpText($language,$name)
71  } elseif {[info exists helpText($name)] && [info exists helpTitle($name)]} {
72  set title $helpTitle($name)
73  set helptext $helpText($name)
74  } else {
75  return
76  }
77 
78  if {![winfo exists $w]} {
79  toplevel $w
80  # wm geometry $w -10+0
82  setWinSize $w
83 
84  wm minsize $w 20 5
85  text $w.text -setgrid yes -wrap word -width $::winWidth($w) -height $::winHeight($w) -relief sunken -border 0 -yscroll "$w.scroll set"
86  ttk::scrollbar $w.scroll -command "$w.text yview"
87 
88  ttk::frame $w.b -relief raised -border 2
89  pack $w.b -side bottom -fill x
90  ttk::button $w.b.contents -textvar ::tr(Contents) -command { helpWindow Contents }
91  ttk::button $w.b.index -textvar ::tr(Index) -command { helpWindow Index }
92  ttk::button $w.b.back -textvar ::tr(Back) -command { help_PopStack }
93  ttk::button $w.b.close -textvar ::tr(Close) -command {
94  set ::helpWin(Stack) {}
95  set ::helpWin(yStack) {}
96  destroy .helpWin
97  }
98 
99  pack $w.b.contents $w.b.index $w.b.back -side left -padx 1 -pady 2
100  pack $w.b.close -side right -padx 5 -pady 2
101  pack $w.scroll -side right -fill y -padx 2 -pady 2
102  pack $w.text -fill both -expand 1 -padx 1
103 
104  $w.text configure -font font_Regular -foreground black -background white
105  ::htext::init $w.text
106  bind $w <Configure> "recordWinSize $w"
107  }
108 
109  $w.text configure -cursor top_left_arrow
110  $w.text configure -state normal
111  $w.text delete 0.0 end
112 
113  $w.b.index configure -state normal
114  if {$name == "Index"} { $w.b.index configure -state disabled}
115  $w.b.contents configure -state normal
116  if {$name == "Contents"} { $w.b.contents configure -state disabled}
117  $w.b.back configure -state disabled
118  if {[llength $helpWin(Stack)] >= 2} {
119  $w.b.back configure -state normal
120  }
121 
122  wm title $w "Scid Help: $title"
123  wm iconname $w "Scid help"
124 
125  $w.text delete 0.0 end
126  bind $w <Up> "$w.text yview scroll -1 units"
127  bind $w <Down> "$w.text yview scroll 1 units"
128  bind $w <Prior> "$w.text yview scroll -1 pages"
129  bind $w <Next> "$w.text yview scroll 1 pages"
130  bind $w <Key-Home> "$w.text yview moveto 0"
131  bind $w <Key-End> "$w.text yview moveto 0.99"
132  bind $w <Escape> "$w.b.close invoke"
133  bind $w <Key-b> "$w.b.back invoke"
134  bind $w <Left> "$w.b.back invoke"
135  bind $w <Key-i> "$w.b.index invoke"
136 
137  ::htext::display $w.text $helptext $heading 0
138  focus $w
139 }
140 
141 proc ::htext::updateRate {w rate} {
142  set ::htext::updates($w) $rate
143 }
144 
145 proc ::htext::init {w} {
146  set cyan "\#007000"
147  set maroon "\#990000"
148  set green "darkgreen"
149 
150  set ::htext::updates($w) 100
151  $w tag configure black -foreground black
152  $w tag configure white -foreground white
153  $w tag configure red -foreground red
154  $w tag configure blue -foreground blue
155  $w tag configure darkblue -foreground darkBlue
156  $w tag configure green -foreground $green
157  $w tag configure cyan -foreground $cyan
158  $w tag configure yellow -foreground yellow
159  $w tag configure maroon -foreground $maroon
160  $w tag configure gray -foreground gray20
161 
162  $w tag configure bgBlack -background black
163  $w tag configure bgWhite -background white
164  $w tag configure bgRed -background red
165  $w tag configure bgBlue -background blue
166  $w tag configure bgLightBlue -background lightBlue
167  $w tag configure bgGreen -background $green
168  $w tag configure bgCyan -background $cyan
169  $w tag configure bgYellow -background yellow
170 
171  $w tag configure tab -lmargin2 50
172  $w tag configure li -lmargin2 50
173  $w tag configure center -justify center
174 
175  if {[$w cget -font] == "font_Small"} {
176  $w tag configure b -font font_SmallBold
177  $w tag configure i -font font_SmallItalic
178  } else {
179  $w tag configure b -font font_Bold
180  $w tag configure i -font font_Italic
181  }
182  $w tag configure bi -font font_BoldItalic
183  $w tag configure tt -font font_Fixed
184  $w tag configure u -underline 1
185  $w tag configure h1 -font font_H1 -foreground $::htext::headingColor \
186  -justify center
187  $w tag configure h2 -font font_H2 -foreground $::htext::headingColor
188  $w tag configure h3 -font font_H3 -foreground $::htext::headingColor
189  $w tag configure h4 -font font_H4 -foreground $::htext::headingColor
190  $w tag configure h5 -font font_H5 -foreground $::htext::headingColor
191  $w tag configure footer -font font_Small -justify center
192 
193  $w tag configure term -font font_BoldItalic -foreground $::htext::headingColor
194  $w tag configure menu -font font_Bold -foreground $cyan
195 
196  # PGN-window-specific tags:
197  $w tag configure tag -foreground $::pgnColor(Header)
198  if { $::pgn::boldMainLine } {
199  $w tag configure nag -foreground $::pgnColor(Nag) -font font_Regular
200  $w tag configure var -foreground $::pgnColor(Var) -font font_Regular
201  } else {
202  $w tag configure nag -foreground $::pgnColor(Nag)
203  $w tag configure var -foreground $::pgnColor(Var)
204  ### TODO
205  ### $w tag configure var -foreground $::pgnColor(Var) -font font_Figurine_Var
206 
207  }
208  $w tag configure ip1 -lmargin1 25 -lmargin2 25
209  $w tag configure ip2 -lmargin1 50 -lmargin2 50
210  $w tag configure ip3 -lmargin1 75 -lmargin2 75
211  $w tag configure ip4 -lmargin1 100 -lmargin2 100
212 }
213 
214 proc ::htext::isStartTag {tagName} {
215  return [expr {![strIsPrefix "/" $tagName]}]
216 }
217 
218 proc ::htext::isEndTag {tagName} {
219  return [strIsPrefix "/" $tagName]
220 }
221 
222 proc ::htext::isLinkTag {tagName} {
223  return [strIsPrefix "a " $tagName]
224 }
225 
226 proc ::htext::extractLinkName {tagName} {
227  if {[::htext::isLinkTag $tagName]} {
228  return [lindex [split [string range $tagName 2 end] " "] 0]
229  }
230  return ""
231 }
232 
233 proc ::htext::extractSectionName {tagName} {
234  if {[::htext::isLinkTag $tagName]} {
235  return [lindex [split [string range $tagName 2 end] " "] 1]
236  }
237  return ""
238 }
239 
240 set ::htext::interrupt 0
241 
242 proc ::htext::display {w helptext {section ""} {fixed 1}} {
243  global helpWin
244  # set start [clock clicks -milli]
245  set helpWin(Indent) 0
246  set ::htext::interrupt 0
247  $w mark set insert 0.0
248  $w configure -state normal
249  set linkName ""
250 
251  set count 0
252  set str $helptext
253  if {$fixed} {
254  regsub -all "\n\n" $str "<p>" str
255  regsub -all "\n" $str " " str
256  } else {
257  regsub -all "\[ \n\]+" $str " " str
258  regsub -all ">\[ \n\]+" $str "> " str
259  regsub -all "\[ \n\]+<" $str " <" str
260  }
261  set tagType ""
262  set seePoint ""
263 
264  if {! [info exists ::htext::updates($w)]} {
265  set ::htext::updates($w) 100
266  }
267 
268  # Loop through the text finding the next formatting tag:
269 
270  while {1} {
271  set startPos [string first "<" $str]
272  if {$startPos < 0} { break}
273  set endPos [string first ">" $str]
274  if {$endPos < 1} { break}
275 
276  set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]]
277 
278  # Check if it is a starting tag (no "/" at the start):
279 
280  if {![strIsPrefix "/" $tagName]} {
281 
282  # Check if it is a link tag:
283  if {[strIsPrefix "a " $tagName]} {
284  set linkName [::htext::extractLinkName $tagName]
285  set sectionName [::htext::extractSectionName $tagName]
286  set linkTag "link ${linkName} ${sectionName}"
287  set tagName "a"
288  $w tag configure "$linkTag" -foreground blue -underline 1
289  $w tag bind "$linkTag" <ButtonRelease-1> \
290  "helpWindow $linkName $sectionName"
291  $w tag bind $linkTag <Any-Enter> \
292  "$w tag configure \"$linkTag\" -background yellow
293  $w configure -cursor hand2"
294  $w tag bind $linkTag <Any-Leave> \
295  "$w tag configure \"$linkTag\" -background {}
296  $w configure -cursor {}"
297  } elseif {[strIsPrefix "url " $tagName]} {
298  # Check if it is a URL tag:
299  set urlName [string range $tagName 4 end]
300  set urlTag "url $urlName"
301  set tagName "url"
302  $w tag configure "$urlTag" -foreground red -underline 1
303  $w tag bind "$urlTag" <ButtonRelease-1> "openURL {$urlName}"
304  $w tag bind $urlTag <Any-Enter> \
305  "$w tag configure \"$urlTag\" -background yellow
306  $w configure -cursor hand2"
307  $w tag bind $urlTag <Any-Leave> \
308  "$w tag configure \"$urlTag\" -background {}
309  $w configure -cursor {}"
310  } elseif {[strIsPrefix "run " $tagName]} {
311  # Check if it is a Tcl command tag:
312  set runName [string range $tagName 4 end]
313  set runTag "run $runName"
314  set tagName "run"
315  $w tag bind "$runTag" <ButtonRelease-1> "catch {$runName}"
316  $w tag bind $runTag <Any-Enter> \
317  "$w tag configure \"$runTag\" -foreground yellow
318  $w tag configure \"$runTag\" -background darkBlue
319  $w configure -cursor hand2"
320  $w tag bind $runTag <Any-Leave> \
321  "$w tag configure \"$runTag\" -foreground {}
322  $w tag configure \"$runTag\" -background {}
323  $w configure -cursor {}"
324  } elseif {[strIsPrefix "go " $tagName]} {
325  # Check if it is a goto tag:
326  set goName [string range $tagName 3 end]
327  set goTag "go $goName"
328  set tagName "go"
329  $w tag bind "$goTag" <ButtonRelease-1> \
330  "catch {$w see \[lindex \[$w tag nextrange $goName 1.0\] 0\]}"
331  $w tag bind $goTag <Any-Enter> \
332  "$w tag configure \"$goTag\" -foreground yellow
333  $w tag configure \"$goTag\" -background maroon
334  $w configure -cursor hand2"
335  $w tag bind $goTag <Any-Leave> \
336  "$w tag configure \"$goTag\" -foreground {}
337  $w tag configure \"$goTag\" -background {}
338  $w configure -cursor {}"
339  } elseif {[strIsPrefix "pi " $tagName]} {
340  # Check if it is a player info tag:
341  set playerTag $tagName
342  set playerName [string range $playerTag 3 end]
343  set tagName "pi"
344  $w tag configure "$playerTag" -foreground darkBlue
345  $w tag bind "$playerTag" <ButtonRelease-1> "::pinfo::playerInfo \"$playerName\""
346  $w tag bind $playerTag <Any-Enter> \
347  "$w tag configure \"$playerTag\" -foreground yellow
348  $w tag configure \"$playerTag\" -background darkBlue
349  $w configure -cursor hand2"
350  $w tag bind $playerTag <Any-Leave> \
351  "$w tag configure \"$playerTag\" -foreground darkBlue
352  $w tag configure \"$playerTag\" -background {}
353  $w configure -cursor {}"
354  } elseif {[strIsPrefix "g_" $tagName]} {
355  # Check if it is a game-load tag:
356  set gameTag $tagName
357  set tagName "g"
358  set gnum [string range $gameTag 2 end]
359  set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y"
360  $w tag bind $gameTag <ButtonPress-1> $glCommand
361  $w tag bind $gameTag <ButtonPress-$::MB3> \
362  "::gbrowser::new [sc_base current] $gnum"
363  $w tag bind $gameTag <Any-Enter> \
364  "$w tag configure $gameTag -foreground yellow
365  $w tag configure $gameTag -background darkBlue
366  $w configure -cursor hand2"
367  $w tag bind $gameTag <Any-Leave> \
368  "$w tag configure $gameTag -foreground {}
369  $w tag configure $gameTag -background {}
370  $w configure -cursor {}"
371  } elseif {[strIsPrefix "m_" $tagName]} {
372  # Check if it is a move tag:
373  set moveTag $tagName
374  set tagName "m"
375  ### TODO
376  ### Does not work for variations as the var-Tag appears before
377  ### the <m_ tags, therefore this overwrites font sizes
378  ### $w tag configure $moveTag -font font_Figurine_ML
379  $w tag bind $moveTag <ButtonRelease-1> "sc_move pgn [string range $moveTag 2 end]; updateBoard"
380  # Bind middle button to popup a PGN board:
381  $w tag bind $moveTag <ButtonPress-$::MB2> "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y"
382  # invoking contextual menu in PGN window
383  $w tag bind $moveTag <ButtonPress-$::MB3> "sc_move pgn [string range $moveTag 2 end]; updateBoard"
384  $w tag bind $moveTag <Any-Enter> "$w tag configure $moveTag -underline 1
385  $w configure -cursor hand2"
386  $w tag bind $moveTag <Any-Leave> "$w tag configure $moveTag -underline 0
387  $w configure -cursor {}"
388  } elseif {[strIsPrefix "c_" $tagName]} {
389  # Check if it is a comment tag:
390  set commentTag $tagName
391  set tagName "c"
392  if { $::pgn::boldMainLine } {
393  $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular
394  } else {
395  $w tag configure $commentTag -foreground $::pgnColor(Comment)
396  }
397  $w tag bind $commentTag <ButtonRelease-1> "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin"
398  $w tag bind $commentTag <Any-Enter> "$w tag configure $commentTag -underline 1
399  $w configure -cursor hand2"
400  $w tag bind $commentTag <Any-Leave> "$w tag configure $commentTag -underline 0
401  $w configure -cursor {}"
402  }
403 
404  if {$tagName == "h1"} {$w insert end "\n"}
405 
406  }
407 
408  # Now insert the text up to the formatting tag:
409  $w insert end [string range $str 0 [expr {$startPos - 1}]]
410 
411  # Check if it is a name tag matching the section we want:
412  if {$section != "" && [strIsPrefix "name " $tagName]} {
413  set sect [string range $tagName 5 end]
414  if {$section == $sect} { set seePoint [$w index insert]}
415  }
416 
417  if {[string index $tagName 0] == "/"} {
418  # Get rid of initial "/" character:
419  set tagName [string range $tagName 1 end]
420  switch -- $tagName {
421  h1 - h2 - h3 - h4 - h5 {$w insert end "\n"}
422  }
423  if {$tagName == "p"} {$w insert end "\n"}
424  #if {$tagName == "h1"} {$w insert end "\n"}
425  if {$tagName == "menu"} {$w insert end "\]"}
426  if {$tagName == "ul"} {
427  incr helpWin(Indent) -4
428  $w insert end "\n"
429  }
430  if {[info exists startIndex($tagName)]} {
431  switch -- $tagName {
432  a {$w tag add $linkTag $startIndex($tagName) [$w index insert]}
433  g {$w tag add $gameTag $startIndex($tagName) [$w index insert]}
434  c {$w tag add $commentTag $startIndex($tagName) [$w index insert]}
435  m {$w tag add $moveTag $startIndex($tagName) [$w index insert]}
436  pi {$w tag add $playerTag $startIndex($tagName) [$w index insert]}
437  url {$w tag add $urlTag $startIndex($tagName) [$w index insert]}
438  run {$w tag add $runTag $startIndex($tagName) [$w index insert]}
439  go {$w tag add $goTag $startIndex($tagName) [$w index insert]}
440  default {$w tag add $tagName $startIndex($tagName) [$w index insert]}
441  }
442  unset startIndex($tagName)
443  }
444  } else {
445  switch -- $tagName {
446  ul {incr helpWin(Indent) 4}
447  li {
448  $w insert end "\n"
449  for {set space 0} {$space < $helpWin(Indent)} {incr space} {
450  $w insert end " "
451  }
452  }
453  p {$w insert end "\n"}
454  br {$w insert end "\n"}
455  q {$w insert end "\""}
456  lt {$w insert end "<"}
457  gt {$w insert end ">"}
458  h2 - h3 - h4 - h5 {$w insert end "\n"}
459  }
460  #Set the start index for this type of tag:
461  set startIndex($tagName) [$w index insert]
462  if {$tagName == "menu"} {$w insert end "\["}
463  }
464 
465  # Check if it is an image or button tag:
466  if {[strIsPrefix "img " $tagName]} {
467  set imgName [string range $tagName 4 end]
468  set winName $w.$imgName
469  while {[winfo exists $winName]} { append winName a}
470  label $winName -image $imgName -relief flat -borderwidth 0 -background white
471  $w window create end -window $winName
472  }
473  if {[strIsPrefix "button " $tagName]} {
474  set idx [ string first "-command" $tagName]
475  set cmd ""
476  if {$idx == -1} {
477  set imgName [string range $tagName 7 end]
478  } else {
479  set imgName [string trim [string range $tagName 7 [expr $idx -1]]]
480  set cmd [ string range $tagName [expr $idx +9] end]
481  }
482  set winName $w.$imgName
483  while {[winfo exists $winName]} { append winName a}
484  button $winName -image $imgName -command $cmd
485  $w window create end -window $winName
486  }
487  if {[strIsPrefix "window " $tagName]} {
488  set winName [string range $tagName 7 end]
489  $w window create end -window $winName
490  }
491 
492  # Now eliminate the processed text from the string:
493  set str [string range $str [expr {$endPos + 1}] end]
494  incr count
495  if {$count == $::htext::updates($w)} { update idletasks; set count 1}
496  if {$::htext::interrupt} {
497  $w configure -state disabled
498  return
499  }
500  }
501 
502  # Now add any remaining text:
503  if {! $::htext::interrupt} { $w insert end $str}
504 
505  if {$seePoint != ""} { $w yview $seePoint}
506  $w configure -state disabled
507  # set elapsed [expr {[clock clicks -milli] - $start}]
508 }
509 
510 
511 # openURL:
512 # Sends a command to the user's web browser to view a webpage given
513 # its URL.
514 #
515 proc openURL {url} {
516  global windowsOS
517  busyCursor .
518  if {$windowsOS} {
519  # On Windows, use the "start" command:
520  regsub -all " " $url "%20" url
521  if {[string match $::tcl_platform(os) "Windows NT"]} {
522  catch {exec $::env(COMSPEC) /c start $url &}
523  } else {
524  catch {exec start $url &}
525  }
526  } elseif {$::macOS} {
527  # On Mac OS X use the "open" command:
528  catch {exec open $url &}
529  } else {
530  # On Unix systems, there is no standard for invoking favorite
531  # web browser, so just try starting Mozilla or Netscape.
532 
533  # First, check if Mozilla seems to be available:
534  if {[file executable [auto_execok firefox]]} {
535  # First, try -remote mode:
536  if {[catch {exec /bin/sh -c "$::auto_execs(firefox) -remote 'openURL($url)'"}]} {
537  # Now try a new Mozilla process:
538  catch {exec /bin/sh -c "$::auto_execs(firefox) '$url'" &}
539  }
540  } elseif {[file executable [auto_execok iceweasel]]} {
541  # First, try -remote mode:
542  if {[catch {exec /bin/sh -c "$::auto_execs(iceweasel) -remote 'openURL($url)'"}]} {
543  # Now try a new Mozilla process:
544  catch {exec /bin/sh -c "$::auto_execs(iceweasel) '$url'" &}
545  }
546  } elseif {[file executable [auto_execok mozilla]]} {
547  # First, try -remote mode:
548  if {[catch {exec /bin/sh -c "$::auto_execs(mozilla) -remote 'openURL($url)'"}]} {
549  # Now try a new Mozilla process:
550  catch {exec /bin/sh -c "$::auto_execs(mozilla) '$url'" &}
551  }
552  } elseif {[file executable [auto_execok www-browser]]} {
553  # Now try a new Mozilla process:
554  catch {exec /bin/sh -c "$::auto_execs(www-browser) '$url'" &}
555  } elseif {[file executable [auto_execok netscape]]} {
556  # OK, no Mozilla (poor user) so try Netscape (yuck):
557  # First, try -remote mode to avoid starting a new netscape process:
558  if {[catch {exec /bin/sh -c "$::auto_execs(netscape) -raise -remote 'openURL($url)'"}]} {
559  # Now just try starting a new netscape process:
560  catch {exec /bin/sh -c "$::auto_execs(netscape) '$url'" &}
561  }
562  } else {
563  foreach executable {iexplorer opera lynx w3m links epiphan galeon
564  konqueror mosaic amaya browsex elinks} {
565  set executable [auto_execok $executable]
566  if [string length $executable] {
567  # Is there any need to give options to these browsers? how?
568  set command [list $executable $url &]
569  catch {exec /bin/sh -c "$executable '$url'" &}
570  break
571  }
572  }
573  }
574  }
575  unbusyCursor .
576 }