#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


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 {Displayth -- A Teacher Hypertool to assist with displaying widgets

This program, based on an earlier one called packeth, lets you adjust the
display attributes of any remote widgets. This includes their size, external
padding, and their behavior when the window is resized. You can also move
widgets around in the window, or even create and delete copies of the original
widgets, and menuentries, and you can convert menuentries to widgets and back
again.


Widgets of Displayth

The Configurations Menu and Entry

This entry is used with the Configure menu option under the Display menu. If
you select Configure and click on a widget with this entry blank, the current
configurations are output. If you fill this entry with some (different)
configurations, select Configure, and click on a widget, the configurations in
the entry will be applied to the remote widget. These might be packing info, or
window alignment info, depending on if the widget is being managed by the
packer, placer, or a text or canvas widget.


Possible Configurations:

(These apply to widgets displayed with the packer, widgets embedded in text or
canvas widgets, or managed by the placer may have different 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 Display Menu

Select an entry in the Display menu, and select a widget to apply that function
to. After selecting an entry, the cursor changes to a cross, and all
mouseclicks get shunted to displayth.

  Move

For this option, you select two widgets, a 'source' widget to move, and a
'destination' widget showing where the source widget should go. The source
widget can be any widget (except a toplevel window). If the destionation widget
is the same widget that manages the source widget, or a child of the source
widget's manager, the source widget gets moved to the location where the user
clicked, this may mean moving a window embedded in a text or canvas widget to a
different location in the same widget, or changing the packing order of the
source widget. If the destination widget is different, displayth attempts to
move the source widget so it is managed by the destination widget (or the
destination widget's manager). Due to limitations in the packer and placer, and
window embedding, this may not always work; if it fails, an error message will
be displayed in the output text window.

  Duplicate

This works like Move, except that a duplicate of the source widget is made in
the location specified by the destination widget. This avoids packing/placing
limitations (the duplicate widget can go anywhere), but introduces a new
problem; how much of the source widget should get duplicated? Currently, only
the configuration options for the source widget get copied. So labels, and the
various button types get copied fully. Also every submenu of a menubutton gets
duplicated, so menus get copied fully, too. But texts, entries, canvases, and
listboxes lose their contents, and scales and scrollbars forget their settings.

In addition to duplicating widgets, you can also duplicate menuentries around
in the same menu, or from one menu to another. As stated above, any submenus
get copied too, so you can quickly duplicate entire menus this way. You can
also duplicate a menuentry into a non-menu widget, which converts the menuentry
into some type of button. Command menuentries get converted to buttons,
checkbutton entries get converted to checkbuttons, radiobutton entries get
converted to radiobuttons, and cascade entries get converted to menubuttons
(with the cascaded submenu duplicated to boot). And you can duplicate buttons,
checkbuttons, radiobuttons, and menubuttons back into menus, where they get
converted to the corresponding type of menuentry. (You cannot move separator
and tearoff entries outside of menus, of course.)

  Forget

For this option, you select a single widget, and the application ceases to
display the widget (although it still exists in memory). You can instruct an
application to forget any widget managed by the packer, placer, or a canvas
widget. Also, if you click on a toplevel window, that window will be withdrawn.
You cannot instruct an application to forget an embedded window inside a text
widget, or a menuentry.

  Destroy

This is similar to Forget, except that the remote widget is destroyed, so it no
longer resides in memory. You can destroy any widget, or any single menuentry
(including the tearoff menuentry). This feature should be used sparingly,
because it is so destructive.

  Configure

For this option, you can leave the configuration entry blank to see a widget's
current display configurations. Or you can add a configuration yourself. The
configuration is shown as a list of pairs.

  Propagate (OFF/ON)

This is a feature of the packer that can be turned on or off. When turned on,
the packer expands a master window upon the addition of new windows, so the
master window can hold all the new windows. When turned off, the master window
does not expand, so new windows may get clipped. (There is no corresponding
feature for text or canvas windows, or the placer, so this feature is only
applicable to widgets managed by the packer.) You can elect to turn propagation
off or on in a remote master widget using this option.

  Slaves

This entry can be used to see what widgets are managed by a single widget. This
is either the slaves of the packer, placer, or the children of a canvas or text
widget.

} $TH_Help {

As stated above, the duplicate feature does not copy text inside of entries,
texts, listboxes or canvases, and it does not duplicate the settings on scales
or scrollbars.}


# Returns the index of the point clicked on for widget.
# This is either a menu index if the widget is a menu, or a list of XY
# coords if the widget is a canvas, or a text index if the widget is a text,
# or nothing, or the relative points if the widget manages other widgets with
# the placer.
proc display_index {widget {class ""}} {
  global App X Y
  if {$class == ""} {set class [send $App winfo class $widget]}
  set x [expr $X - [send $App winfo rootx $widget]]
  set y [expr $Y - [send $App winfo rooty $widget]]
  switch $class {
    "Canvas" {return [list [send $App $widget canvasx $x] [send $App $widget canvasy $y]]
    } "Text" {return [send $App $widget index "@$x,$y"]
    } "Menu" {return [send $App $widget index "@$y"]
    } default {if {[send $App place slaves $widget] == ""} {return}
	set width [send $App winfo width $widget]
	set height [send $App winfo height $widget]
	return [list -relx [expr $x / "$width.0"] -rely [expr $y / "$height.0"]]
    }}
}

proc config_list {options} {
  set result {}
  foreach option $options {
    if {[lindex $option 4] == ""} {continue}
    lappend result [lindex $option 0] [lindex $option 4]
  }
  return $result
}

# Find a widget desceneded from p (or p itself) that contains Widget
proc find_parent {p} {
  global App Widget Mgr
  if {[string tolower [send $App winfo class $p]] == $Mgr} {
    switch $Mgr {
	"text" {if {[lsearch [send $App $p window names] $Widget] >= 0} {return $p}}
	"canvas" {if {[lsearch [send $App winfo children $p] $Widget] >= 0} {return $p}}}}
  foreach w [send $App winfo children $p] {
    if {[set answer [find_parent $w]] != ""} {return $answer}}
  return ""
}

# Fills some global variables, depending on widget geometry management:
# Mgr 		Item 		Configs 	Parent
# pack 		{}		pack info 	pack master
# place		{}		place info 	{}
# canvas	canvasid	window configs 	canvas widget
# text		text index	window configs	text widget
# {} (menu)	menuentry index	entry configs	{}
proc display_info {} {
  global App Widget Class Item Configs Mgr Parent
  set Item "" ; set Configs ""
  set Parent ""

  switch [set Mgr [send $App winfo manager $Widget]] {
    "pack" {
	set c [send $App pack info $Widget]
        set Parent [lindex $c 1]
	set Configs [lrange $c 2 [expr [llength $c] - 3]]
    } "place" {set c [send $App place info $Widget]
	foreach option {-relx -rely} {
	  if {[set l [lsearch $c $option]] >= 0} {
	    set c [lreplace $c $l [expr $l + 1]]
	}}
	set Configs $c
    } "text" {
        if {[set Parent [find_parent [send $App winfo parent $Widget]]] == ""} {error "Don't know which text widget manages $Widget!"}
        set Item [display_index $Parent "Text"]
	set c [send $App $Parent window configure $Item]
	set Configs [config_list [lrange $c 0 [expr [llength $c] - 2]]]
    } "canvas" {
        if {[set Parent [find_parent [send $App winfo parent $Widget]]] == ""} {error "Don't know which canvas widget manages $Widget!"}
        set xy [display_index $Parent "Canvas"]
	set Item [lindex [eval send \"$App\" $Parent find overlapping $xy $xy] 0]
	set c [send $App $Parent itemconfigure $Item]
	set Configs [config_list [lrange $c 0 [expr [llength $c] - 2]]]
  }}
  if {$Class == "Menu"} {set Item [display_index $Widget $Class]
    set Configs [config_list [send $App $Widget entryconfigure $Item]]
}}

# Figure out a name for a new widget in parent
proc new_widget_name {parent} {
  global App
  set i 1
  if {$parent == "."} {set p ""} else {set p $parent}
  while {[send $App winfo exists "$p.th$i"]} {incr i}
  return "$p.th$i"
}  

# Copies src_menu into a new widget inside dest_parent.
proc copy_submenus {src_menu dest_parent {configs "-menu foobar"}} {
  global App
  set new_submenu [new_widget_name $dest_parent]
  do_cmd_out "tkMenuDup $src_menu $new_submenu"
  set mi [lsearch $configs "-menu"] ; incr mi
  return [lreplace $configs $mi $mi $new_submenu]
}

# Creates a menuentry like the widget (or menuentry) Either src_menu is a menu
# and src_widget is an index in src_menu of menuentry to copy, or src_menu is
# {} and src_widget is widget to copy. New menuentry gets placed in dest_menu
# after index with configs.
proc duplicate_menuentry {src_menu src_widget dest_menu index configs} {
  global App
  set cmd "$dest_menu insert $index"
  if {$src_menu != ""} {
# Menu-to-menu conversion
    set type [send $App $src_menu type $src_widget]
    if {$type == "cascade"} {
      set configs [copy_submenus [send $App $src_menu entrycget $src_widget -menu] $dest_menu $configs]
  }} else {
# Outside-widget-to-menu conversion
    set configs [config_list [send $App $src_widget configure]]
# Take out the following options, they don't apply to menuentries.
    foreach option {-anchor -borderwidth -cursor -disabledforeground 
			-height -highlightbackground -highlightcolor 
			-highlightthickness -justify -padx -pady -textvariable
			-relief -width -wraplength -indicatoron} {
      if {[set i [lsearch $configs $option]] >= 0} {
        set configs [lreplace $configs $i [expr $i+1]]}}
    if {[set i [lsearch $configs "-text"]] >= 0} {
      set configs [lreplace $configs $i $i "-label"]}
    if {[set i [lsearch $configs "-menu"]] >= 0} {
      set configs [copy_submenus [send $App $src_widget cget -menu] $dest_widget $configs]}

    set class [send $App winfo class $src_widget]
    switch $class {
      "Checkbutton" - "Radiobutton" {
		set type [string tolower $class]
	} "Button" {set type "command"
	} "Menubutton" {set type "cascade"
	} default {bell ; return}}}
  do_cmd_out "$cmd $type $configs"
}

# Creates a widget, called dest_widget, just like the widget (or menuentry)
# Either src_menu is a menu and src_widget is an index in src_menu of menuentry
# to copy, or src_menu is {} and src_widget is widget to copy.
proc duplicate_widget {src_menu src_widget dest_widget} {
  global App
  if {$src_menu != ""} {
# Menu-to-outside-widget conversion
    set configs [config_list [send $App $src_menu entryconfigure $src_widget]]
    foreach option {} {
      if {[set i [lsearch $configs $option]] >= 0} {
        set configs [lreplace $configs $i [expr $i+1]]}}
    if {[set i [lsearch $configs "-label"]] >= 0} {
      set configs [lreplace $configs $i $i "-text"]}
    if {[set i [lsearch $configs "-menu"]] >= 0} {
      set submenu [lindex $configs [expr $i + 1]]}

    set type [send $App $src_menu type $src_widget]
    switch $type {
      "checkbutton" {set class "Checkbutton"
 	} "radiobutton" {set class "Radiobutton"
	} "command" {set class "Button"
	} "cascade" {set class "Menubutton"
	} default {bell ; return}}
  } else {
# widget-widget duplication
    set configs [config_list [send $App $src_widget configure]]
    set class [send $App winfo class $src_widget]
    if {$class == "Menubutton"} {
      set submenu [send $App $src_widget cget -menu]
  }}

  do_cmd_out "[string tolower $class] $dest_widget $configs"
  if {$class == "Menubutton"} {
    set config [copy_submenus $submenu $dest_widget]
    do_cmd_out "$dest_widget configure $config"
}}


# Lets user move a widget. Makes a duplicate of the widget if duplicate_flag
# is set.
proc do_move_widget {duplicate_flag} {
  global App Class Widget Item Configs Mgr Parent
# Get source widget
  if {![get_widget]} {bell ; return}
  display_info
  set src_item $Item ; set src_configs $Configs
  set src_mgr $Mgr ; set src_parent $Parent
  set src_app $App ; set src_widget $Widget ; set src_class $Class

# Now get target
  if {![get_widget]} {bell ; return}
  if {($App != $src_app)} {return}
# We want the source widget to go inside a frame, toplevel, text, or canvas,
# but next to any other kind of widget
  switch $Class {
    "Text" - "Canvas" {
	set dest_mgr [string tolower $Class]
	set dest_parent $Widget
	set dest_index [display_index $Widget $Class]
  } "Toplevel" - "Frame" {
	if {[send $App place slaves $Widget] != ""} {set dest_mgr place
	} else {set dest_mgr pack}
	set dest_parent $Widget
	set dest_index [display_index $Widget $Class]
  } "Menu" {
	set dest_mgr ""
	set dest_parent $Widget
	set dest_index [display_index $Widget $Class]
  } default {
	if {[set dest_mgr [send $App winfo manager $Widget]] == "pack"} {
	  set dest_parent [lindex [send $App pack info $Widget] 1]
        } else {set dest_parent [send $App winfo parent $Widget]}
	set dest_index [display_index $dest_parent]
  }}
  set dest_widget $Widget ; set dest_class $Class

  switch $dest_mgr {
    "text" - "canvas" {set dest_configs $dest_index
    } "place" {set dest_configs $dest_index
    } "pack" {set dest_configs ""
	if {($dest_parent == $src_parent) && ($dest_parent != $dest_widget)} {
	  set list [send $App pack slaves $src_parent]
	  set w [lsearch $list $src_widget]
	  set p [lsearch $list $dest_widget]
	  set l [llength $list]
	  if {($w == [expr $p - 1]) && ($p == [expr $l - 1])} {
	    set dest_configs "-after $dest_widget"
	}}
	if {$dest_configs == ""} {
	  set dest_configs "-in $dest_parent"
	  if {$dest_parent != $dest_widget} {
	    set side [lindex [send $App pack info $dest_widget] end]
	    set dest_configs "-in $dest_parent -before $dest_widget -side $side"}}
    } default {if {[set dest_configs $dest_index] != ""} {incr dest_configs}
  }}

  clear_output

  if $duplicate_flag {
    if {$src_class == "Menu"} {
	set m1 $src_widget ; set m2 $src_item
    } else {set m1 "" ; set m2 $src_widget}
    if {$dest_class == "Menu"} {
      duplicate_menuentry $m1 $m2 $dest_parent $dest_configs $src_configs
    } else {
      set dest_widget [new_widget_name $dest_parent]
      duplicate_widget $m1 $m2 $dest_widget
  }} else {
    set dest_widget $src_widget
    if {($src_class == "Menu") || ($dest_class == "Menu")} {bell ; return}
  }

# Now make the widget viewable
  if {$src_mgr != $dest_mgr} {set configs ""} else {set configs $src_configs}

  switch $dest_mgr {
    "text" {do_cmd_out "$dest_parent window create $dest_configs -window $dest_widget $configs"
    } "canvas" {do_cmd_out "$dest_parent create window $dest_configs $configs -window $dest_widget"
    } "pack" {do_cmd_out "pack $dest_widget $dest_configs $configs"
    } "place" {do_cmd_out "place $dest_widget $dest_configs $configs"
  }}
  return $dest_widget
}

proc do_destroy_widget {} {
  if {![get_widget]} {bell ; return}
  global App Widget Class
  if {$Class == "Menu"} {
    global Item ; display_info
    if {[send $App $Widget type $Item] == "tearoff"} {
      do_cmd "$Widget configure -tearoff 0\n"
    } else {
      do_cmd "$Widget delete $Item\n"
  }} else {do_cmd "destroy $Widget\n"
}}

proc do_forget_widget {} {
  if {![get_widget]} {bell ; return}
  global App Widget Class Parent Mgr Item
  display_info
  switch $Mgr {
    "pack" {do_cmd "pack forget $Widget\n"
  } "place" {do_cmd "place forget $Widget\n"
  } "canvas" {do_cmd "$Parent delete $Item\n"
  } default {if {$Class == "Toplevel"} {do_cmd "wm withdraw $Widget\n"
	} else {bell ; return}
}}}

proc do_configure_widget {} {
  global App Class Widget Item Configs C Output Mgr Parent
  if {![get_widget]} {bell ; return}
  display_info
  if {$C == ""} {
    if {$Class == "Menu"} {bell ; return}
    set Output $Configs
    show_output
  } else {switch $Mgr {
      "pack" {do_cmd "pack configure $Widget $C\n"
    } "place" {do_cmd "place configure $Widget $C\n"
    } "text" {do_cmd "$Parent window configure $Item $C\n"
    } "canvas" {do_cmd "$Parent itemconfigure $Item $C\n"
    } default {bell}
}}}

proc do_propagate_widget {value} {
  global App Class Widget Item Configs C Output
  if {![get_widget]} {bell ; return}
  if {[lsearch "Frame Toplevel" $Class] >= 0} {
    do_cmd "pack propagate $Widget $value\n" ; return}

  set w $Widget
  while {1} {
    set p [send $App winfo parent $w]
    switch [send $App winfo manager $w] {
      "" {bell ; return
      } "pack" {
	set p [lindex [send $App pack info $w] 1]
	do_cmd "pack propagate $p $value\n" ; return
    }}
    set w $p
}}

proc do_slaves_widget {} {
  global App Class Widget Item Configs C Output
  if {![get_widget]} {bell ; return}
  if {[lsearch "Frame Toplevel Canvas Text" $Class] >= 0} {
    set w $Widget
    set c $Class
  } else {
    set w [send $App winfo parent $Widget]
    set c [send $App winfo class $w]
  }
  if {[send $App place slaves $w] == ""} {set cmd pack} else {set cmd place}
  switch $c {
    "Frame" - "Toplevel" {
	do_cmd "$cmd slaves $w\n"
    } "Canvas" {
	do_cmd "winfo children $w\n"
    } "Text" {
	do_cmd "$w window names\n"
    } default {if {$w == "."} {do_cmd "$cmd slaves .\n"} else {bell}
}}}


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

set menu .buttons.teach.m
$menu add command -label "Move" -command "do_move_widget 0"
$menu add command -label "Duplicate" -command "do_move_widget 1"
$menu add command -label "Forget" -command "do_forget_widget"
$menu add command -label "Destroy" -command "do_destroy_widget"
$menu add command -label "Configure" -command "do_configure_widget"
$menu add cascade -label "Propagate" -menu $menu.pm
menu $menu.pm
$menu.pm add command -label "OFF" -command "do_propagate_widget 0"
$menu.pm add command -label "ON" -command "do_propagate_widget 1"
$menu add command -label "Slaves" -command "do_slaves_widget"
