# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This module has routines that create the various windows that the HTML tool # # uses. The single arg to these is a true/false (1/0) value saying whether to # # show the window. Normally, we only show the main window, and the rest are # # shown only if the user requests them. However, if you check the calls on # # these routines, you'll find that some will show initially if the debug # # level is above some threshold. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # global Vals set Vals(ALT) { 0 {} {Show ALT values only if no image} 1 {} {Always show ALT values} } set Vals(Debug) { 0 {DebugWin 0} {Hide the Debug window} 1 {DebugWin 1} {Show the Debug window} } set Vals(Header) { 0 {HeaderWin 0} {Hide the Header window} 1 {HeaderWin 1} {Show the Header window} } set Vals(Option) { 0 {OptionWin 0} {Hide the Option window} 1 {OptionWin 1} {Show the Option window} } set Vals(Source) { 0 {SourceWin 0} {Hide the Source window} 1 {SourceWin 1} {Show the Source window} } set Vals(H) { 0 {} {Assume plain text for unknown document types} 1 {} {Assume all documents are HTML} } set Vals(IMG) { 0 {} {Ignore images} 1 {} {Load and show images} } set Vals(TABLE) { 0 {} {No TABLEs; treat them as lists} 1 {} {TABLEs using tk only} 2 {} {TABLEs using tkTable} } set Vals(TCL) { 0 {} {Don't eval TCL inclusions} 1 {} {TCL inclusions evaluated} } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Create the debug window. If it exists, we will fill it as we HTML text. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc DebugWin {show} { global B BB C V F R me myname opt docPid imagePid curX curY if {$V>4} {puts "$me/DebugWin: x=$show"} if ![winfo exists .dbg] { toplevel .dbg wm title .dbg "Debug for $myname" wm geometry .dbg +$curX+$curY # Button bar: frame .dbg.b -bd 2 -relief $R pack .dbg.b -in .dbg -side top -fill x label .dbg.b.lprot -text PROT: entry .dbg.b.vprot -textvariable PROT -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 label .dbg.b.lhost -text HOST: entry .dbg.b.vhost -textvariable HOST -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 label .dbg.b.ldir -text DIR: entry .dbg.b.vdir -textvariable DIR -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 pack .dbg.b.lprot .dbg.b.vprot .dbg.b.lhost .dbg.b.vhost .dbg.b.ldir -in .dbg.b -side left pack .dbg.b.vdir -in .dbg.b -side left -expand 1 -fill x # PID bar: frame .dbg.p -bd 2 -relief $R pack .dbg.p -in .dbg -side top -fill x label .dbg.p.lpids -text PIDs: pack .dbg.p.lpids -in .dbg.p -side left label .dbg.p.lpdoc -text doc= label .dbg.p.vpdoc -textvariable docPid pack .dbg.p.lpdoc .dbg.p.vpdoc -in .dbg.p -side left label .dbg.p.lpimg -text img= label .dbg.p.vpimg -textvariable imagePid pack .dbg.p.lpimg .dbg.p.vpimg -in .dbg.p -side left # Text: frame .dbg.txt -bd 2 -relief $R pack .dbg.txt -in .dbg -side bottom -expand 1 -fill both text .dbg.txt.t -width 60 -height 10 \ -yscrollcommand ".dbg.txt.s.y set" \ -xscrollcommand ".dbg.txt.sbx set" \ -wrap none -bd 1 -relief flat frame .dbg.txt.s -width 10 -height 10 -bd 0 scrollbar .dbg.txt.s.y -command ".dbg.txt.t yview" -width 8 -orient vertical scrollbar .dbg.txt.sbx -command ".dbg.txt.t xview" -width 8 -orient horizontal eval button .dbg.txt.s.x -command {{.dbg.txt.t delete 1.0 end}} -bd 1 -text * $BB BindHelp .dbg.txt.s.x Clear pack .dbg.txt.s -in .dbg.txt -side right -fill y pack .dbg.txt.s.x -in .dbg.txt.s -side bottom -fill x pack .dbg.txt.s.y -in .dbg.txt.s -side top -fill y -expand 1 pack .dbg.txt.sbx -in .dbg.txt -side bottom -fill x pack .dbg.txt.t -in .dbg.txt -side bottom -expand 1 -fill both } if [set opt(Debug) $show] { wm deiconify .dbg ;# Make sure it's open. raise .dbg ;# Make sure it's visible. update idletasks ;# Make sure it has been drawn. } else { wm withdraw .dbg ;# Hide the debug window. } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Create the header window. If it exists, we will fill it as we HTML text. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc HeaderWin {show} { global V me opt if {$V>4} {puts "$me/HeaderWin: x=$show"} if ![winfo exists .hdr] {txtWin .hdr {HeaderWin 0} Hide} if [set opt(Header) $show] { wm deiconify .hdr ;# Make sure it's open. raise .hdr ;# Make sure it's visible. } else { wm withdraw .hdr ;# Hide the header window. } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Create the debug window. If it exists, we will fill it as we HTML text. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc OptionWin {show} { global B BB C V EB FB R Dsc errmsg me myname opt docPid imagePid Vals global idlist agentid PrintCmd SendCmd curX curY if {$V>4} {puts "$me/OptionWin: x=$show"} if ![winfo exists .opt] { toplevel .opt wm title .opt "Options for $myname" # Option title frame: frame .opt.t menubutton .opt.t.bsave -text Save -menu .opt.t.bsave.menu -highlightthickness 0 bind .opt.t.bsave {menuOptSave %X %Y} label .opt.t.vtitl -text {Global variables} -fg $C(fg:title) button .opt.t.bclos -text Close -command {OptionWin 0} -highlightthickness 0 pack .opt.t.bsave -in .opt.t -side left -expand 1 pack .opt.t.vtitl -in .opt.t -side left -expand 1 pack .opt.t.bclos -in .opt.t -side right -expand 1 pack .opt.t -in .opt -side top -expand 1 -fill x # Global variable frame: frame .opt.v -bd 3 -relief ridge # Viewer options frame: frame .opt.x -bd 3 -relief ridge set r 0 foreach x {B V R} { label .opt.v.l$x -bd 2 -relief $R -text $x: entry .opt.v.v$x -bd 2 -relief $R -textvariable $x \ -width 0 -fg $C(E) -highlightthickness 0 label .opt.v.d$x -bd 2 -relief $R -text $Dsc(var:$x) grid .opt.v.l$x -in .opt.v -row $r -column 0 -sticky w grid .opt.v.v$x -in .opt.v -row $r -column 1 -sticky w grid .opt.v.d$x -in .opt.v -row $r -column 2 -sticky w incr r } pack .opt.v -in .opt -side top -fill x frame .opt.x.agent menubutton .opt.x.agent.lb -text {Agent ID} -menu .opt.x.agent.lb.menu menu .opt.x.agent.lb.menu -tearoff 0 -activeborderwidth 0 foreach i $idlist { .opt.x.agent.lb.menu add command -label $i -command "set agentid {$i}" } entry .opt.x.agent.id -textvariable agentid pack .opt.x.agent.lb -in .opt.x.agent -side left pack .opt.x.agent.id -in .opt.x.agent -side left -expand 1 -fill x pack .opt.x.agent -in .opt.x -expand 1 -fill x frame .opt.x.prntc label .opt.x.prntc.lb -text {Print command} entry .opt.x.prntc.vl -textvariable PrintCmd pack .opt.x.prntc.lb -in .opt.x.prntc -side left pack .opt.x.prntc.vl -in .opt.x.prntc -side left -expand 1 -fill x pack .opt.x.prntc -in .opt.x frame .opt.x.sendc label .opt.x.sendc.lb -text {Send command} entry .opt.x.sendc.vl -textvariable SendCmd pack .opt.x.sendc.lb -in .opt.x.sendc -side left pack .opt.x.sendc.vl -in .opt.x.sendc -side left -expand 1 -fill x pack .opt.x.sendc -in .opt.x pack .opt.x -in .opt -side top -fill x # Option frame: label .opt.otitle -text {Options} -fg $C(fg:title) pack .opt.otitle -in .opt -side top -expand 1 frame .opt.o -bd 3 -relief ridge set r 0 foreach x {ALT IMG HTML Debug Header Option Source TABLE TCL} { if [info exists Vals($x)] { menubutton .opt.o.l$x -bd 2 -relief $R -text $x: -menu .opt.o.l$x.m -highlightthickness 0 menu .opt.o.l$x.m foreach {n c v} $Vals($x) { if {$c == {}} {set cmd "set opt($x) $n"} else {set cmd "set opt($x) $n; $c"} .opt.o.l$x.m add command -label "$n: $v" -command $cmd } } else { label .opt.o.l$x -bd 2 -relief $R -text $x: } if ![info exists opt($x)] {set opt($x) {???}} eval entry .opt.o.v$x -bd 2 -relief $R -textvariable opt($x) \ -width 0 -fg $C(E) -highlightthickness 0 eval label .opt.o.d$x -bd 2 -relief $R -text {$Dsc(opt:$x)} grid .opt.o.l$x -in .opt.o -row $r -column 0 -sticky e grid .opt.o.v$x -in .opt.o -row $r -column 1 -sticky w grid .opt.o.d$x -in .opt.o -row $r -column 2 -sticky w incr r } pack .opt.o -in .opt -side top -fill x # Message bar: eval frame .opt.b -bd 3 -relief ridge eval entry .opt.b.e -textvariable errmsg -bd 3 -relief ridge -fg $C(E) -bg black pack .opt.b -in .opt -side top -fill x pack .opt.b.e -in .opt.b -side left -expand 1 -fill x if ![info exists errmsg] {set errmsg {...}} # URL frame: eval frame .opt.u -bd 3 -relief ridge label .opt.u.lprot -text PROT: entry .opt.u.vprot -textvariable PROT -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 label .opt.u.lhost -text HOST: entry .opt.u.vhost -textvariable HOST -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 label .opt.u.ldir -text DIR: entry .opt.u.vdir -textvariable DIR -width 0 -bd 2 -relief $R -fg $C(E) -highlightthickness 0 pack .opt.u.lprot .opt.u.vprot .opt.u.lhost .opt.u.vhost .opt.u.ldir -in .opt.u -side left pack .opt.u.vdir -in .opt.u -side left -expand 1 -fill x pack .opt.u -in .opt -side top -fill x } if [set opt(Option) $show] { wm deiconify .opt ;# Make sure it's open. raise .opt ;# Make sure it's visible. set curX [winfo pointerx .] set curY [winfo pointery .] wm geometry .opt +$curX+$curY } else { wm withdraw .opt ;# Hide the option window. } } if [winfo exists .opt] {destroy .opt; OptionWin [expr $V>1]} proc menuOptSave {X Y} { global V me DIR env initfile global curX curY set curX $X set curY $Y if [winfo exists .opt.t.bsave.menu] {destroy .opt.t.bsave.menu} menu .opt.t.bsave.menu foreach f "$initfile .htmlinit $DIR/.htmlinit $env(HOME)/.htmlinit" { if {$f != {}} { .opt.t.bsave.menu add command -label "$f" -command "SaveSettings $f" } } if {$X && $Y} {tk_popup .opt.t.bsave.menu $X $Y} } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # We put the top-level packs into a callable routine so we can re-pack them # all dynamically. This is needed because "pack .t -side top" actually puts # the .t frame at the bottom when called at run time. proc Packs w { global opt if {$opt(TTL)} {pack $w.i.t -in $w.i -side top -fill x} else {pack forget $w.i.t} if {$opt(URL)} {pack $w.i.u -in $w.i -side top -fill x} else {pack forget $w.i.u} if {$opt(MSG)} {pack $w.i.e -in $w.i -side top -fill x} else {pack forget $w.i.e} if {$opt(LNK)} {pack $w.i.l -in $w.i -side top -fill x} else {pack forget $w.i.l} if {$opt(NAM)} {pack $w.i.n -in $w.i -side top -fill x} else {pack forget $w.i.n} # pack forget $w.i; pack $w.i -side top -fill x pack forget $w.b; pack $w.b -side top -fill x pack forget $w.d; pack $w.d -side top -expand 1 -fill both } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Create the source window. If it exists, we will fill it as we HTML text. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc SourceWin {show} { global V me opt if {$V>4} {puts "$me/SourceWin: x=$show"} if ![winfo exists .src] {txtWin .src {SourceWin 0} Hide} if [set opt(Source) $show] { wm deiconify .src ;# Make sure it's open. raise .src ;# Make sure it's visible. } else { wm withdraw .src ;# Hide the source window. } }