home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / Tkhtml / hv.tcl next >
Encoding:
Text File  |  2001-10-22  |  8.4 KB  |  352 lines
  1. #
  2. # This script implements the "hv" application.  Type "hv FILE" to
  3. # view FILE as HTML.
  4. #
  5. # This application is used for testing the HTML widget.  It can
  6. # also server as an example of how to use the HTML widget.
  7. # 
  8. # @(#) $Id: hv.tcl,v 1.26 2001/06/17 22:45:35 peter Exp $
  9. #
  10. wm title . {HTML File Viewer}
  11. wm iconname . {HV}
  12.  
  13. # Make sure the html widget is loaded into
  14. # our interpreter
  15. #
  16. if {[info command html]==""} {
  17.   if {![package require Tkhtml]} return
  18.   foreach f {
  19.     ./tkhtml.so
  20.     /usr/lib/tkhtml.so
  21.     /usr/local/lib/tkhtml.so
  22.     ./tkhtml.dll
  23.   } {
  24.     if {[file exists $f]} {
  25.       if {[catch {load $f Tkhtml}]==0} break
  26.     }
  27.   }
  28. }
  29.  
  30. # The HtmlTraceMask only works if the widget was compiled with
  31. # the -DDEBUG=1 command-line option.  "file" is the name of the
  32. # first HTML file to be loaded.
  33. #
  34. set HtmlTraceMask 0
  35. set file {}
  36. foreach a $argv {
  37.   if {[regexp {^debug=} $a]} {
  38.     scan $a "debug=0x%x" HtmlTraceMask
  39.   } else {
  40.     set file $a
  41.   }
  42. }
  43.  
  44. # These images are used in place of GIFs or of form elements
  45. #
  46. image create photo biggray -data {
  47.     R0lGODdhPAA+APAAALi4uAAAACwAAAAAPAA+AAACQISPqcvtD6OctNqLs968+w+G4kiW5omm
  48.     6sq27gvH8kzX9o3n+s73/g8MCofEovGITCqXzKbzCY1Kp9Sq9YrNFgsAO///
  49. }
  50. image create photo smgray -data {
  51.     R0lGODdhOAAYAPAAALi4uAAAACwAAAAAOAAYAAACI4SPqcvtD6OctNqLs968+w+G4kiW5omm
  52.     6sq27gvH8kzX9m0VADv/
  53. }
  54. image create photo nogifbig -data {
  55.     R0lGODdhJAAkAPEAAACQkADQ0PgAAAAAACwAAAAAJAAkAAACmISPqcsQD6OcdJqKM71PeK15
  56.     AsSJH0iZY1CqqKSurfsGsex08XuTuU7L9HywHWZILAaVJssvgoREk5PolFo1XrHZ29IZ8oo0
  57.     HKEYVDYbyc/jFhz2otvdcyZdF68qeKh2DZd3AtS0QWcDSDgWKJXY+MXS9qY4+JA2+Vho+YPp
  58.     FzSjiTIEWslDQ1rDhPOY2sXVOgeb2kBbu1AAADv/
  59. }
  60. image create photo nogifsm -data {
  61.     R0lGODdhEAAQAPEAAACQkADQ0PgAAAAAACwAAAAAEAAQAAACNISPacHtD4IQz80QJ60as25d
  62.     3idKZdR0IIOm2ta0Lhw/Lz2S1JqvK8ozbTKlEIVYceWSjwIAO///
  63. }
  64.  
  65. # Construct the main window
  66. #
  67. frame .mbar -bd 2 -relief raised
  68. pack .mbar -side top -fill x
  69. menubutton .mbar.file -text File -underline 0 -menu .mbar.file.m
  70. pack .mbar.file -side left -padx 5
  71. set m [menu .mbar.file.m]
  72. $m add command -label Open -underline 0 -command Load
  73. $m add command -label Refresh -underline 0 -command Refresh
  74. $m add separator
  75. $m add command -label Exit -underline 1 -command exit
  76. menubutton .mbar.view -text View -underline 0 -menu .mbar.view.m
  77. pack .mbar.view -side left -padx 5
  78. set m [menu .mbar.view.m]
  79. set underlineHyper 0
  80. $m add checkbutton -label {Underline Hyperlinks} -variable underlineHyper
  81. trace variable underlineHyper w ChangeUnderline
  82. proc ChangeUnderline args {
  83.   global underlineHyper
  84.   .h.h config -underlinehyperlinks $underlineHyper
  85. }
  86. set showTableStruct 0
  87. $m add checkbutton -label {Show Table Structure} -variable showTableStruct
  88. trace variable showTableStruct w ShowTableStruct
  89. proc ShowTableStruct args {
  90.   global showTableStruct HtmlTraceMask
  91.   if {$showTableStruct} {
  92.     set HtmlTraceMask [expr {$HtmlTraceMask|0x8}]
  93.     .h.h config -tablerelief flat
  94.   } else {
  95.     set HtmlTraceMask [expr {$HtmlTraceMask&~0x8}]
  96.     .h.h config -tablerelief raised
  97.   }
  98.   Refresh
  99. }
  100. set showImages 1
  101. $m add checkbutton -label {Show Images} -variable showImages
  102. trace variable showImages w Refresh
  103.  
  104. # Construct the main HTML viewer
  105. #
  106. frame .h
  107. pack .h -side top -fill both -expand 1
  108. html .h.h \
  109.   -yscrollcommand {.h.vsb set} \
  110.   -xscrollcommand {.f2.hsb set} \
  111.   -padx 5 \
  112.   -pady 9 \
  113.   -formcommand FormCmd \
  114.   -imagecommand ImageCmd \
  115.   -scriptcommand ScriptCmd \
  116.   -appletcommand AppletCmd \
  117.   -underlinehyperlinks 0 \
  118.   -bg white -tablerelief raised
  119.  
  120. # If the tracemask is not 0, then draw the outline of all
  121. # tables as a blank line, not a 3D relief.
  122. #
  123. if {$HtmlTraceMask} {
  124.   .h.h config -tablerelief flat
  125. }
  126.  
  127. # A font chooser routine.
  128. #
  129. # .h.h config -fontcommand pickFont
  130. proc pickFont {size attrs} { 
  131.   puts "FontCmd: $size $attrs"
  132.   set a [expr {-1<[lsearch $attrs fixed]?{courier}:{charter}}]
  133.   set b [expr {-1<[lsearch $attrs italic]?{italic}:{roman}}]
  134.   set c [expr {-1<[lsearch $attrs bold]?{bold}:{normal}}]
  135.   set d [expr {int(12*pow(1.2,$size-4))}]
  136.   list $a $d $b $c
  137. } 
  138.  
  139. # This routine is called for each form element
  140. #
  141. proc FormCmd {n cmd args} {
  142.   # puts "FormCmd: $n $cmd $args"
  143.   switch $cmd {
  144.     select -
  145.     textarea -
  146.     input {
  147.       set w [lindex $args 0]
  148.       label $w -image nogifsm
  149.     }
  150.   }
  151. }
  152.  
  153. # This routine is called for every <IMG> markup
  154. #
  155. # proc ImageCmd {args} {
  156. # puts "image: $args"
  157. #   set fn [lindex $args 0]
  158. #   if {[catch {image create photo -file $fn} img]} {
  159. #     return nogifsm
  160. #   } else {
  161. #    global Images
  162. #    set Images($img) 1
  163. #    return $img
  164. #  }
  165. #}
  166. proc ImageCmd {args} {
  167.   global OldImages Images showImages
  168.   if {!$showImages} {
  169.     return smgray
  170.   }
  171.   set fn [lindex $args 0]
  172.   if {[info exists OldImages($fn)]} {
  173.     set Images($fn) $OldImages($fn)
  174.     unset OldImages($fn)
  175.     return $Images($fn)
  176.   }
  177.   if {[catch {image create photo -file $fn} img]} {
  178.     return smgray
  179.   }
  180.   if {[image width $img]*[image height $img]>20000} {
  181.     global BigImages
  182.     set b [image create photo -width [image width $img] \
  183.            -height [image height $img]]
  184.     set BigImages($b) $img
  185.     set img $b
  186.     after idle "MoveBigImage $b"
  187.   }
  188.   set Images($fn) $img
  189.   return $img
  190. }
  191. proc MoveBigImage b {
  192.   global BigImages
  193.   if {![info exists BigImages($b)]} return
  194.   $b copy $BigImages($b)
  195.   image delete $BigImages($b)
  196.   unset BigImages($b)
  197.   update
  198. }
  199.  
  200.  
  201. # This routine is called for every <SCRIPT> markup
  202. #
  203. proc ScriptCmd {args} {
  204.   # puts "ScriptCmd: $args"
  205. }
  206.  
  207. # This routine is called for every <APPLET> markup
  208. #
  209. proc AppletCmd {w arglist} {
  210.   # puts "AppletCmd: w=$w arglist=$arglist"
  211.   label $w -text "The Applet $w" -bd 2 -relief raised
  212. }
  213.  
  214. # This procedure is called when the user clicks on a hyperlink.
  215. # See the "bind .h.h.x" below for the binding that invokes this
  216. # procedure
  217. #
  218. proc HrefBinding {x y} {
  219.   set new [.h.h href $x $y]
  220.   # puts "link to [list $new]"; return
  221.   if {$new!=""} {
  222.     global LastFile
  223.     set pattern $LastFile#
  224.     set len [string length $pattern]
  225.     incr len -1
  226.     if {[string range $new 0 $len]==$pattern} {
  227.       incr len
  228.       .h.h yview [string range $new $len end]
  229.     } else {
  230.       LoadFile $new
  231.     }
  232.   }
  233. }
  234. bind .h.h.x <1> {HrefBinding %x %y}
  235.  
  236. # Pack the HTML widget into the main screen.
  237. #
  238. pack .h.h -side left -fill both -expand 1
  239. scrollbar .h.vsb -orient vertical -command {.h.h yview}
  240. pack .h.vsb -side left -fill y
  241.  
  242. frame .f2
  243. pack .f2 -side top -fill x
  244. frame .f2.sp -width [winfo reqwidth .h.vsb] -bd 2 -relief raised
  245. pack .f2.sp -side right -fill y
  246. scrollbar .f2.hsb -orient horizontal -command {.h.h xview}
  247. pack .f2.hsb -side top -fill x
  248.  
  249. # This procedure is called when the user selects the File/Open
  250. # menu option.
  251. #
  252. set lastDir [pwd]
  253. proc Load {} {
  254.   set filetypes {
  255.     {{Html Files} {.html .htm}}
  256.     {{All Files} *}
  257.   }
  258.   global lastDir htmltext
  259.   set f [tk_getOpenFile -initialdir $lastDir -filetypes $filetypes]
  260.   if {$f!=""} {
  261.     LoadFile $f
  262.     set lastDir [file dirname $f]
  263.   }
  264. }
  265.  
  266. # Clear the screen.
  267. #
  268. # Clear the screen.
  269. #
  270. proc Clear {} {
  271.   global Images OldImages hotkey
  272.   if {[winfo exists .fs.h]} {set w .fs.h} {set w .h.h}
  273.   $w clear
  274.   catch {unset hotkey}
  275.   ClearBigImages
  276.   ClearOldImages
  277.   foreach fn [array names Images] {
  278.     set OldImages($fn) $Images($fn)
  279.   }
  280.   catch {unset Images}
  281. }
  282. proc ClearOldImages {} {
  283.   global OldImages
  284.   foreach fn [array names OldImages] {
  285.     image delete $OldImages($fn)
  286.   }
  287.   catch {unset OldImages}
  288. }
  289. proc ClearBigImages {} {
  290.   global BigImages
  291.   foreach b [array names BigImages] {
  292.     image delete $BigImages($b)
  293.   }
  294.   catch {unset BigImages}
  295. }
  296.  
  297. # Read a file
  298. #
  299. proc ReadFile {name} {
  300.   if {[catch {open $name r} fp]} {
  301.     tk_messageBox -icon error -message $fp -type ok
  302.     return {}
  303.   } else {
  304.     fconfigure $fp -translation binary
  305.     set r [read $fp [file size $name]]
  306.     close $fp
  307.     return $r
  308.   }
  309. }
  310.  
  311. # Load a file into the HTML widget
  312. #
  313. proc LoadFile {name} {
  314.   set html [ReadFile $name]
  315.   if {$html==""} return
  316.   Clear
  317.   global LastFile
  318.   set LastFile $name
  319.    .h.h config -base $name
  320.   .h.h parse $html
  321.   ClearOldImages
  322. }
  323.  
  324. # Refresh the current file.
  325. #
  326. proc Refresh {args} {
  327.   global LastFile
  328.   if {![info exists LastFile]} return
  329.   LoadFile $LastFile
  330. }
  331.  
  332. # If an arguent was specified, read it into the HTML widget.
  333. #
  334. update
  335. if {$file!=""} {
  336.   LoadFile $file
  337. }
  338.  
  339.  
  340. # This binding changes the cursor when the mouse move over
  341. # top of a hyperlink.
  342. #
  343. bind HtmlClip <Motion> {
  344.   set parent [winfo parent %W]
  345.   set url [$parent href %x %y] 
  346.   if {[string length $url] > 0} {
  347.     $parent configure -cursor hand2
  348.   } else {
  349.     $parent configure -cursor {}
  350.   }
  351. }
  352.