#!/afs/ece/usr/tcl/bin/wish -f

foreach pair {{th_history_sanity_check lib/history.tcl}
		{get_widget aux/teach.tcl}} {
  if {[info procs [lindex $pair 0]] == ""} {
    source "[file dirname [info script]]/../[lindex $pair 1]"
}}


# Help text.

set Help "" ; append Help {Packeth -- A Teacher Hypertool based on Tk's pack command.

You can use this program to interactively repack any currently visible Tk
widget. This gives you the power to interactively move and resize widgets around
the window. Of course, the new configuration will be forgotten when the widget
is destroyed. Enter some parameters to tk's pack command and click on the Pack
button and then click on any widget in any Tk application. The program will
execute Tk's 'pack configure' command on whatever widget is clicked on. You can
supply arguments by typing them in the 'Pack' entry.


Widgets of Packeth

The Pack Menu and Entry

Enter some arguments to tk's pack command in the pack entry, such as '-side
left' or '-padx 5'. When using the Configure menu option to pack a widget, the
contents of this entry get passed to the widget being repacked.


Possible Pack Configurations:

-anchor <anchor>
Which side of the cavity to anchor the widget. Can be n,s,e,w,ne,nw,se,sw or
center.

-expand <expand>
Specifies whether the slaves should be expanded to consume  extra space  in 
their  master.   Boolean  may  have any proper boolean value, such as 1 or no. 
Defaults to 0.

-fill <style>
If a slave's parcel is larger than its requested dimensions, this option  may be
used to stretch the slave.  Style may be none,x,y or both.

-ipadx <amount>    -ipady <amount>     -padx <amount>      -pady <amount>
Amount specifiex how much x/y internal or external padding to leave on each 
side  of  the widget.

-side <side>
Specifies which side of the master the slave(s)  will  be  packed against.  Must
be left, right, top, or bottom.


The Pack Menu

Select an entry in the Pack menu, and select a widget to apply that pack command
to. See the Tutorial for more info on the Pack menu.

When doing packing, the cursor changes to a cross, and all mouseclicks get
shunted to packeth.

  Move

Special to packeth. If this menu entry is selected, then click on two remote
widgets. The first widget will move (in the packing order) to before the 2nd
widget if it was after it, or it will move to after the 2nd widget if it was
before it. You can use this to repack various ordered widgets, such as
menubuttons.

  Configure

For this option, you can leave the pack entry blank to see the widget's current
packing configurations. Or you can add a configuration yourself.

  Forget

This causes the packer to forget about the widget, so it goes away. (It is not,
however, destroyed.)

  Info

This returns the packing configurations for the widget (it is the same as
selecting configure with no configuration specified).

  Propagate OFF

When repacking, indicate that slaves to this widget should not be repacked, but
displayed as is.

  Propagate ON

When repacking, indicate that slaves to this widget should be repacked also.
This is the default.

  Slaves

The widgets packed in this widget are displayed in the output text. This widget
must contain other widgets for this command to be legal.


The Widgets Menu

This is a set of options indicating which widget gets packed. You can elect to
pack:

  Widget

If this option is selected, packs the foremost widget that you select in the
remote application.

  Parent

If this option is selected, packs the parent of the foremost widget that you
select in the remote application.

  Grandparent

If this option is selected, packs the grandparent of the foremost widget that
you select in the remote application.

} $TH_Help {

Bugs / Limitations

None
(I hope!)
}


proc which_pack_widget {} {
  global App Class Widget Level
  if {![get_widget]} {return ""}
  switch $Level {
    1 {set w $Widget
  } 2 {set w [send $App winfo parent $Widget]
  } 3 {set w [send $App winfo parent \[winfo parent $Widget\]]}}
  return $w
}

# Executes the pack command over a widget
proc do_pack_widget {subcmd} {
  if {[set widget [which_pack_widget]] == ""} {th_beep ; return}
  global Widget C
  if {$subcmd == ""} {
    do_cmd "pack configure $Widget $C"
  } else {
    do_cmd "pack [lindex $subcmd 0] $widget [lrange $subcmd 1 end]"
}}

# Lets user move a widget around in the packing order.
proc do_move_widget {} {
  if {[set widget [which_pack_widget]] == ""} {th_beep ; return}
  global Moving_App Moving_Widget App Moving_Parent Move_Choke Old_Move_Widget
  set Moving_App $App
  set Moving_Widget $widget
  set Moving_Parent [send $Moving_App winfo parent $Moving_Widget]
# An impossible widget prefix
  set Old_Move_Widget "foo"
  if {[set widget [which_pack_widget]] == ""} {th_beep ; return}
  if {($App != $Moving_App)} {return}
  if {![string match "$Moving_Parent*" $widget]} {return}
  if {[string match "$Moving_Widget*" $widget]} {return}
  if {[string match "$Old_Move_Widget*" $widget]} {return}
# User moved mouse to a different widget in same parent.
  set Move_Choke 1
  set parent $widget
  while {$parent != $Moving_Parent} {
    set widget $parent
    set parent [send $Moving_App winfo parent $parent]
  }
  set list [send $Moving_App pack slaves $Moving_Parent]
  set w [lsearch $list $Moving_Widget]
  set p [lsearch $list $widget]
  if {$w > $p} {
    do_cmd "pack configure $Moving_Widget -before $widget"
  } else {
    do_cmd "pack configure $Moving_Widget -after $widget"
  }
  set Old_Move_Widget $widget
  set Move_Choke 0
}


catch "destroy .buttons.source"
create_form_entry .packconf "Pack" C ""
.buttons.teach configure -text Pack

set menu .buttons.teach.m
$menu add command -label "Move" -command "do_move_widget"
$menu add command -label "Configure" -command "do_pack_widget {}"
$menu add command -label "Forget" -command "do_pack_widget forget"
$menu add command -label "Info" -command "do_pack_widget newinfo"
$menu add command -label "Propagate OFF" -command "do_pack_widget {propagate 0}"
$menu add command -label "Propagate ON" -command "do_pack_widget {propagate 1}"
$menu add command -label "Slaves" -command "do_pack_widget slaves"

set menu .buttons.level.m
menubutton .buttons.level -text "Widgets" -menu $menu ; menu $menu
pack .buttons.level -after .buttons.teach -side left ; set Level 1
$menu add radiobutton -label "Widget" -variable Level -value 1
$menu add radiobutton -label "Parent" -variable Level -value 2
$menu add radiobutton -label "Grandparent" -variable Level -value 3
tk_menuBar .buttons .buttons.teach .buttons.level .buttons.misc
