# Basic routimes for Teacher Hypertools

set TH_Copyright {Teacher Hypertools: Copyright (c) 1994,1995  David Svoboda}


# Returns value of variable, looking up env_var as an environment variable,
# using default if var and env(env_var) don't exist.
proc setenv {var env_var {default ""}} {
  if {[info globals $var] == ""} {
    global $var env
    if {[catch {set $var $env($env_var)}]} {
      set $var $default
  }}
  return $var
}

proc source_local_files {} {
  global env
  set name [lindex [wm title .] 0]
  if {[file exists $env(HOME)/.th/$name]} {
    source $env(HOME)/.th/$name
  }
  if {[file exists ".$name"]} {
    source ".$name"
}}

# The location of TH's library. (You could instead set your TH_DIR
# environment variable)
setenv TH_Dir TH_DIR "[file dirname [info script]]/.."

source_local_files

# The location of XF (for some of its template procedures)
setenv XF_Dir XF_DIR "/afs/ece/usr/tcl/xf???"

# Which set of bindings to use?
setenv TH_Bindings_Set TH_BINDINGS "th"

if {[info procs update_arguments] == ""} {source $TH_Dir/aux/teach_widgets.tcl}


# Help text.
set TH_Help "" ; append TH_Help {
How to Select Widgets

You select a widget to teach by merely clicking over it when the cursor looks
like a cross '+'. When selecting, no widgets activate (excpet those in the
hypertool itself), so you can select a widget without invoking any action it
might have. For menus, which you cannot make visible without activating their
menubutton (or cascade menu entry), move the mouse over the application with
the entry and click Button 3. This tool will release the X grab, allowing you to
do standard menu traversal in the application. Then pull down (or pop up) the
appropriate menu, holding the mouse over the entry you wish to teach, and press
the Space bar. This tool will then do its work on the menu entry.


Misc Menu

  Help

Well, you're seeing what it does. :) Hit the OK button above this widget to exit
Help.

  Quit

Quits the program. Can be used anytime, even while you are teaching things to
other widgets.


Source Menu

This option menu can display one of three options, which represent three ways
to transmit code to remote programs; unless you are interested in somehow
adding said code to the program, you need not worry about this menu. On some
hypertools, which don't teach code (such as configureth), this menu may not
exist. The options are:

  Include file

This merely teaches the program the code necessary to do this hypertool's
functions; it teaches the program nothing about where this code came from. This
is the default.

  Source Command

Instead of giving the remote program the co  de, give the prgram the necessary
'source' commands needed to load the code itself.

  Add to auto_path

Instead of giving the remote program some files to load or some code, add the
directory of the code to the program's auto_path variable. This will
automatically load the procedures the program needs whenever it invokes them.


The output Text

This space is filled with either:
1. Error message from invalid command.
2. Informative output from query-type command, like "pack info"
3. Complete command executed if successful. (This is the command that was
   executed in the remote interpreter.)


Configuration Files

Before starting up, this program calls the local file of the same name as this
program itself, preceded by a '.', if this file exists. (In other words, if
this program were called 'foo', it would source '.foo'.) It then looks for a
file in $HOME/.th by the same name as the program. (So in our aforementioned
example, it would search for $HOME/.th/foo). This way you can customize any
aspect of these programs you so choose.


Command-line Arguments

This hypertool fills its widgets with the command-line arguments, generally in
order of top-to-bottom, and left-to-right. So if the top widget is an entry,
the first argument to the program will override the default value for that
entry. Generally entries accept strings for arguments, scales prefer numbers,
and checkbuttons prefer values of 1 (for on) and 0 (for off).


} $TH_Copyright {

Permission to use, copy, modify, and distribute this software is hereby
granted, provided that the above copyright line appears at least once in source
code taught by Teacher Hypertools, and in documentation relating to said code.
However, permission is not granted to modify the copyright insertion code.

This basically means: if a Teacher Hypertool sticks a copyright message in code
it teaches, and you copy that code to a file, leave the copyright message in.
And include it in your documentation. If it doesn't stick a copyright in code,
don't worry about it. Go ahead and fiddle around with the Teacher Hypertool
source code, and improve it (and drop me a line if you do, I'd be interested),
but don't change the code that inserts copyright notices.


Disclaimer

I don't see how its possible, but if this software crashes your system,
destroys your hard disk, posts to alt.flame asking for mail-bombs, etc. etc, I
didn't do it, man. :)


Author

David Svoboda
(svoboda@ece.cmu.edu)


Bugs / Limitations

Make sure that the application you want to teach is using Tk version 4.0 or
greater. This hypertool will not be able to teach code to applications using
Tk version 3.6 or earlier.}


# Given x and y (mouse coordinates), fills the global variables App and Widget
# with the application and widget with those absolute coordinates. Class also
# gets the widget's class. If no widget covers X and Y, erases App and Widget
# and Class.
proc which_widget {x y} {
  global App Widget Class X Y
  set Widget ""
  foreach App [winfo interps] {
    if {[catch {send $App winfo containing $x $y} Widget]} {continue}
    if {($Widget != "") && [send $App winfo ismapped $Widget]} { break }
    set Widget ""
  }
  if {($Widget == "") || ($App == "") || ([string index $Widget 0] != ".")} {
    set App "" ; set Widget "" ; set Class ""
    return 0
  } else {
    set Class [send $App winfo class $Widget]
    set X $x ; set Y $y
    return 1
}}

# Gets user to press the button in a remote widget, then calls what_widget
# on his mouse coordinates.
proc get_widget {} {
  global Getting_Widget ; set Getting_Widget 1
# Wait until grab is free before snatching it.
  while {[catch "grab -global ."]} {after 1000}
  . config -cursor cross
  global Grab ; set Grab ""
  bind all <Any-Button> "which_widget %X %Y ; set Getting_Widget 0"
  bind all <Button-3> "setup_for_menu %X %Y"
  tkwait variable Getting_Widget
  grab release .
  . config -cursor ""
  bind all <Any-Button> ""
  bind all <Button-3> ""
  catch "destroy .buttons.gl"
  global Widget ; if {$Widget == ""} {return 0} else {return 1}
}

proc setup_for_menu {x y} {
  if {[which_widget $x $y] == ""} {return}
  global App
  grab release .
  pack [label .buttons.gl -text "Press <space> over a menu item in $App"]
  send $App "bind Menu <space> \{send \{[winfo name .]\} {choose_menu %X %Y}\}"
}

proc choose_menu {x y} {
  global App Widget Getting_Widget
  send $App "bind Menu <space> {tkMenuInvoke %W}"
  if {![which_widget $x $y]} {bell ; return}
  send $App "tkMenuEscape $Widget ; update"
  set Getting_Widget 1
}

# Execute cmd in application, puts output or error in Output text widget. If no
# output, puts cmd in Output.
proc do_cmd {cmd {clear_text 1}} {
  global Output App
  if {![catch {send $App $cmd} Output]} {
    if {$Output == ""} {set Output $cmd
  }}
  show_output $clear_text
}

# Execute cmd in application, puts into Output, does not clear output.
proc do_cmd_out {cmd} {
  global Output App
  set Output $cmd ; append Output "\n"
  send $App $cmd
  show_output 0
}

# Useful for doing 'set' commands (which don't work well with do_cmd).
# It checks that the variable isn't already set.
proc do_cmd_set {var value} {
  global Output App
  if {![catch "send \"$App\" set $var" result] && ($result == $value)} {return}
  set Output [list set $var $value]
  catch {send $App $Output}
  append Output "\n"
  show_output 0
}

proc show_output {{clear_text 1}} {
   global Output
  .output configure -state normal
  if $clear_text {.output delete 1.0 end}
  .output insert end $Output
  .output configure -state disabled
}

proc clear_output {} {
  .output configure -state normal
  .output delete 1.0 end
  .output configure -state disabled
}  

# Returns the contents of file
proc return_source {file} {
  set f [open $file "r"]
  set result [read $f]
  close $f
  return $result
}

# Teaches app these files of Tcl code (or whichever files app doesn't know)
proc include_files {args} {
  global TH_Dir App TH_Copyright Source_Type
  do_cmd_set TH(Copyright) $TH_Copyright

  foreach arg $args {
    set proc [lindex $arg 1] ; set file [lindex $arg 0]
    if {$proc != ""} {
      if {[send $App info proc $proc] != ""} {return ""}}
    set ap [send $App set auto_path]
    if {[lsearch $ap "/*/*th/lib"] >= 0} {return ""}
    switch $Source_Type {
      "Include file" {do_cmd [return_source "$TH_Dir/lib/$file"] 0
    } "Source Command" {do_cmd "source $TH_Dir/lib/$file\n" 0
    } "Add to auto_path" {do_cmd_set auto_path "$TH_Dir/lib $ap"
}}}}

proc get_th_fullpath {} {
  global TH_Dir
  set pwd [pwd]
  cd $TH_Dir
  set TH_Dir [pwd]
  cd $pwd
  return
}

# Set up main window.
set iconname [lindex [wm title .] 0]
get_th_fullpath
set title [string toupper [string index $iconname 0]]
append title [string range $iconname 1 end]
wm title . $title
wm iconname . $iconname
set auto_path "$TH_Dir/lib $auto_path"

if {![catch "frame .buttons"]} {
  pack .buttons -side top -in . -fill x -expand no
  menubutton .buttons.teach -text "Teach" -menu .buttons.teach.m
  menu .buttons.teach.m
  pack .buttons.teach -side left
  menubutton .buttons.misc -text "Misc" -menu .buttons.misc.m
  pack .buttons.misc -side left
  menu .buttons.misc.m
  .buttons.misc.m add command -label "Help" -command show_help
  .buttons.misc.m add command -label "Quit" -command exit
  pack [frame .o] -side top -expand yes -fill both
  pack [scrollbar .o.sy -command ".output yview"] -side left -fill y
  pack [scrollbar .o.sx -command ".output xview" -orient horizontal] -side bottom -fill x
  pack [text .output -state disabled -height 3 -width 40 -wrap none \
	-yscrollcommand ".o.sy set" -xscrollcommand ".o.sx set"] \
	-side right -expand yes -fill both -in .o
}

if {![winfo exists .buttons.source]} {
  tk_optionMenu .buttons.source Source_Type \
	"Include file" "Source Command" "Add to auto_path"
  pack .buttons.source -side right
  set Source_Type "Include file"
}
