# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # SYNOPSIS # # Help package for wish (tcl/tk) scripts. # # # # DESCRIPTION # # This is John Chambers' tcl/tk version of a simple Help facility. If you # # source this file in your wish script, it sets up a binding for the Help # # and F1 keys to the Help routine. Then, when Help or F1 is pressed, a # # .help window will pop up which will be filled with the contents of the # # current widget's help file. # # # # Here's how you might load this file into your program: # # foreach d [split $env(PATH) :] { # # if [file readable $d/Help.w] { # # if {$V>1} {puts "$me: source $d/Help.w"} # # source $d/Help.w # # break # # } } # # # # The help file's name is generated as follows: We catenate "/help/", the # # program name, and the widget's name, and replace all dots with slashes. # # If that file exists, it's the help file. If not, we strip fields off the # # name until we find a file that exists. # # # # Thus, for widget .x.y.z in program foo, we start with the file # # "/help/foo/x/y/z". If that doesn't exist, we try "/help/foo/x/y" and # # "/help/foo/x". So if you make a help file for a widget, it is also the # # help file for any contained widgets that don't have their own help file. # # # # As a special kludge to assist in dealing with arrays of widgets, we also # # strip out any digits that precede the dots in the widget name. This means # # that .x.y1.z and .x.y2.z will have the same help file /help/foo/x/y/z. # # Note that this only applies immediately before the dots, not at the end # # of the widget's name or the program's name. Perhaps final digits should # # also be stripped off, too, but this isn't done at present. # # # # As a special case if the pointer is outside any widget, then we will use # # "/help/foo/foo" as the help file name, so you can produce a help file for # # the whole application. Some window managers will cooperate by passing on # # the Help or F1 event in the title bar or border; others won't. Note that # # olwm suppresses the Help key entirely; you must use F1 there. And, of # # course, most PC keyboards don't even have a Help key. (The turkeys!) # # # # If none of these files exist, we fill the help window with a list of the # # file names, to make it easy for developers to generate the right help # # files. After writing your wish script (which sources this file), just # # point at a widget, press Help, and copy one of the file names to your # # editor. # # # # GLOBALS # # This package uses some global variables which will be set if they haven't # # already been assigned values by the caller: # # # # V holds the debug level. # # # # me holds the program's name. # # # # errmsg holds the "latest" error message. # # # # helpwdgt is the name of the current widget. # # # # BUGS # # SEE ALSO # # # # AUTHOR # # John Chambers # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # global V env errmsg helpdir helppath helpwdgt me set helpwdgt {} if ![info exists V] {set V 1} if ![info exists me] {set me [lindex [wm title .] 0]} if [winfo exists .help] {destroy .help} if ![info exists helppath] { if [info exists env(HELPPATH)] { regsub -all {:} $env(HELPPATH) { } helppath } else { set helppath {help /help} } } if ![info exists helpdir] { if [info exists env(HELPDIR)] { set helpdir $env(HELPDIR) } else { set helpdir help } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Here's the main routine, which creates the help window and attempts to fill # # it with the help file for the current widget. Feel free to call Help # # directly, if you want to build some other help mechanism. See the bindings # # at the end of this file for examples of how you might get the name and # # screen position of the current widget. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc Help {w X Y} { global V me helpdir helpfiles helppath helpwdgt if ![winfo exists .help] { toplevel .help -bd 0 -relief ridge if {$X == {}} {set X [winfo pointerx .]} if {$Y == {}} {set Y [winfo pointery .]} wm geometry .help "+$X+$Y" frame .help.s -width 10 -height 10 -bd 0 pack .help.s -in .help -side right -fill y text .help.text -width 60 -height 10 -bd 0 -relief ridge \ -yscrollcommand ".help.s.y set" \ -xscrollcommand ".help.sbx set" \ -wrap none -bd 3 -relief flat scrollbar .help.s.y -command ".help.text yview" -width 10 -orient vertical scrollbar .help.sbx -command ".help.text xview" -width 10 -orient horizontal button .help.s.x -bd 0 -text * -padx 0 -pady 0 -command { destroy .help destroy .helppopup } BindHelp .help.s.x Close pack .help.s.x -in .help.s -side bottom -fill x pack .help.s.y -in .help.s -side top -fill y -expand 1 pack .help.sbx -in .help -side bottom -fill x pack .help.text -in .help -side left -expand 1 -fill both } .help.text delete 1.0 end wm deiconify .help raise .help set helpwdgt $w if {$V>2} {FillHelp "Widget: $helpwdgt\n"} if {$helpwdgt == {.}} { set name /$me } else { regsub -all {[0-9]*\.} $helpwdgt {/} name } if {$V>2} {puts "name=\"$name\""} set hpath "/$me$name"; # Path within help directory. set helpfiles {} if {$V>2} {puts "hpath=\"$hpath\""} while {$hpath != {}} { if {$V>2} {puts "hpath=\"$hpath\""} if {$V>2} {FillHelp "\t$hpath\n"} foreach f "$hpath $hpath/.help" { if {$V>2} {puts "f=\"$f\""} foreach d $helppath { set p "$d$f" if {$V>2} {puts "d=\"$d\" f=\"$f\" p=\"$p\""} if [file isfile "$p"] {ShowHelp $p; return} lappend helpfiles $p } } regsub {/+[^/]*$} $hpath {} hpath if {$V>2} {puts "hpath=\"$hpath\""} } foreach f "help/$me/$me /help/$me/$me" { if [file isfile $f] {ShowHelp $f; return} lappend helpfiles $f } NoHelp $name } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Bind the help message m to the widget w. This produces a litte popup # # message when the pointer moves into the widget. Such messages should be # # kept very short, of course. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc BindHelp {w m} { bind $w "after 200 {HelpPopup $w {$m} %X %Y}" bind $w {after 200 destroy .helppopup} } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Produce the popup window when the pointer enters a widget. We offset it by # # 10 pixels down and to the right, to minimize overlap with text; you might # # like a larger offset. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc HelpPopup {w m X Y} { if [winfo exists .helppopup] {destroy .helppopup} toplevel .helppopup wm geometry .helppopup +[incr X 10]+[incr Y 10] label .helppopup.t -text $m -bd 2 -relief ridge -fg orange -bg black pack .helppopup.t -in .helppopup wm overrideredirect .helppopup 1 } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Load a file into the help window. proc ShowHelp {path} { wm title .help $path set p [open "$path" r] while {![eof $p]} { .help.text insert end [read $p 1000] } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Append some text to the end of the help window. proc FillHelp {str} {.help.text insert end $str} # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # We couldn't find a help file for a widget. Explain to the user, and give a # # list of the places that we looked, so they can possibly create a help file. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc NoHelp {path} { global helpfiles helpwdgt wm title .help "No help for $helpwdgt" FillHelp "Can't find help files for widget:" FillHelp "\n\t$helpwdgt" FillHelp "\nPossible help file names:" foreach f $helpfiles { if [regexp {^/} $f] { FillHelp "\n\t$f" } else { FillHelp "\n\t $f" } } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This is our routine to put a default action on the entire keyboard. All we # # actually do with this is to look for the keycode 22, which is what Sun has # # for the unlabelled key next to the Help button. If the user presses this # # key, we respond as if the Help key had been pressed. This is useful with # # OpenLook, which preempts the Help key for its own use. This routine can # # also be useful when faced with some bizarre new keyboard whose Help or F1 # # keys don't seem to work right. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc Press {K k X Y W x y} { global V me lastX lastY if {$V>5} {puts "$me/Press: K=$K k=$k X=$X Y=$Y W=$W x=$x y=$y"} if {$K == {??} && $k == 22} { if {$V>3} {puts "$me/Press: Fake Help Key on Sun keyboard."} Help [set lastX $X] [set lastY $Y] } if {$V>3} {flush stdout} } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Here's how to bind the three most-likely keys that function as Help keys. # # The third case is to handle the unlabelled key that many Sun keyboards have # # next to the Help key (which is disabled by olwm, the turkeys). Many of our # # applications will, of course, override the KeyPress binding with more # # specific bindings, which will then take precedence. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # bind all { Press %K %k %X %Y %W %x %y } bind all { set helpwdgt [winfo containing %X %Y] if {$V>2} {puts "~jc/sh/Help: X=%X Y=%y x=%x y=%y $helpwdgt"} Help $helpwdgt %X %Y } bind all { set helpwdgt [winfo containing %X %Y] if {$V>5} {puts "~jc/sh/Help: X=%X Y=%y x=%x y=%y $helpwdgt"} Help $helpwdgt %X %Y } set errmsg {Point and press Help or F1 for information} # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Here's a function that raises a window to the top. This works on OpenLook, # # unlike the tcl raise command. However, it can only raise the window to the # # top; it can't fine-tune the stacking order. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # proc Raise {w} { global V me # if {$V>2} {puts "$me: Raise $w via \"raise\""} # raise $w ;# Doesn't work with olwm. if {$V>2} {puts "$me: Raise $w via iconify/deiconify"} wm iconify $w wm deiconify $w }