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


# Default file to place resources
set App_File "configureth.resources"

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]"
}}
foreach file {ColorBox CursorBox FSBox FontBox} {
  if {[info procs $file] == ""} {
    catch {source "$XF_Dir/templates/Procedures/$file.t"}
}}


# Help text.
set Help "" ; append Help {Configureth - A 'Teacher Hypertool' for Tk's configure command

This is a teaching hypertool in the sense that its sole purpose is to change
and enhance other Tk applications. You can enter some parameters to tk's
configure command, click on the Configure button and then click on any widget
in any Tk application. The program will execute Tk's configure command on
whatever widget is clicked on.

You can use this program to interactively configure any currently visible Tk
widget, including things like changing its colors and fonts. By using
multiple-clicks and some keys, you can cause your changes to be remembered in
the application, and even across different Tk applications.


Widgets of Configureth

The Configuration Menu and Entry

Enter some arguments to tk's configure command in the configuration entry, such
as '-bg black' or '-font 9x15'. When configuring the widget, the contents of
this entry get passed to the widget being configured. You can have multiple
configurations like "-bg black -fg white" in the configure entry.

If you leave the entry blank, configureth will return all configurations of the
current widget. If you only leave one word (like "-bg"), configureth will
return that particular configuration for the widget, in accordance with Tk's
configure command.


Various Configuration Buttons (Color, Cursor, File, Font)

These buttons are useful for selecting appropriate values for the configuration
entry. For example, after entering "-background " in the configuration entry,
you can click 'Color', which brings up a color selection dialog box. When you
leave the dialog box, the color you selected is entered in the configuration
entry, at the location of the insert cursor.

You can likewise use the Cursor button to select an appropriate cursor. And
Font selects an appropriate font, and File selects an appropriate File.

Kudos to Sven Delmas for giving us XF! (from whence these selectors came!) If
you do not have XF for Tk4.0, these buttons will be inactive.


The Defaults Menu and Entry

This indicates the location of your resource-defaults file. This starts out as
'configureth.resources', which will get created and store the output of any
resources you indicate. However, you can change this to any resource file, such
as ~/.Xdefaults.


The Teach Menu

Pick a menu entry here to start configuring widgets. See the Tutorial for an
explanation of the menu options.


The Widgets Menu

This is a set of options indicating which group of widgets is to be selected.
See the following section for more info.


Semantics of Configurations (A Tutorial)

While configuring, you can do the following: If you are just messing around,
and don't want your configurations remembered, you can use the Teach menu,
Configure submenu, Widget entry to execute tk's configure command on a remote
widget, but the new configuration will be forgotten as soon as the widget is
destroyed.

Try this now. Put:
	-background red
in the configuration entry, and then select Teach,Configure,Widget. Then click
any mousebutton on, say, the button marked "Cursor".

However this configuration will be forgotten as soon as the widget gets
destroyed.

If you would like the remote program to remember the configuration, use the
Options,Widget menu entry instead. This will add the configuration to the
options database in the remote program (although it does not itself configure
the widget). So if the widget is destroyed, and recreated without overwriting
your configs, your configs will still remain visible. However, your
configuration will still be forgotten when the application quits.

If you would like the new configuration remembered the next time the program
starts up, use the Applications,Widget menu entry. This appends the
configuration to your defaults file. (which should be an application-specific
resource file or ~/.Xdefaults). Be aware that your configuration will only be
used if the application doesn't specify a different configuration for that
widget.

Now, you can work with just one widget, or with a group of widgets, bu using
different options in the Widgets option menu on the right. If you just want to
work with one widget, you don't have to worry about this menu.

If you want to configure all the similar widgets in a group (such as all the
buttons in a row), you should select "Local Group" in the Widgets menu. This
may or may not work on the set of widgets you want, but it will only affect
widgets of the same class as the one you clicked on. (i.e. if you clicked on a
scrollbar, only other scrollbars will be affected)

For example, with your configuration entry still reading:
	-background red
select "Local Group", and then select "Configure,Widget" and click on the
Cursor button. All four buttons on that row are now red. Of course, this will
be forgotten next time you run configureth.

However, "Local Group" won't affect more than one of the menus here. This is
because they are packed differently in the configureth window. If you want to
configure all the widgets of one class in a program, first select "All in
Class" under the Widgets menu. You can then select Configure,Widget and click
on, say, the Configuration menubutton to configure all of the menus in
configureth.

All of the above steps can configure any currently visible widget with varying
degrees of permenance. Since configureth never destroys its widgets, any
changes you make to configureth will be remembered until you quit the program;
however other programs are not so simple.

OK, so you can change all the widgets of a class at a time. But this does not
mean you can predefine the widgets that may yet be created. To see this, put
	-foreground blue
in the configuration entry, select "All in Class", and configure the Cursor
button. Now all the text in your buttons are blue. But if you then press the
Cursor button, a new window will come up, with several buttons whose text will
not be blue. They didn't exist when you did the configuration.

You can change this by using the "Add Options","Class" menu entry. This adds to
the options database the new configuration for the class of the widget next
selected. Try this, and then press the Cursor button. Now the new window will
have buttons with blue text, even if configureth's window doesn't.

OK, you can now do any configuring inside a single application, but all your
configurations will be forgotten as soon as you quit. To have them remembered,
make sure the Defaults entry has a good file for saving configurations
(~/.Xdefaults for example), and select the "Add to Appliction","Widget" entry,
and click on a widget. This will append the configuration to your resources
file, and so it will be remembered the next time the program starts up.

You could also use "Add to Application","Class" to have the configuration
remembered for that class of widgets so all future widgets in that program
receive your new configuration.

These menuentries will save your configuration for whatever program controls
the widget you clicked in, but no other programs will care. If you want a
configuration to apply to all Tk widgets of some class in an application, use
the "Add to Application","Tk Widget" before clicking. Or use "Add to
Application","Tk Class" to ultimately state that all widgets of your specified
class (in any Tk program) should receive the new configuration.

The last specialty you can do in Configureth is configure part of a widget. If
you select the "Configure","Item" menu entry before clicking over a widget
item, only that widget item is configured, not the entire widget. For text
widgets, you can configure a single tag, for canvas widgets, you can configure
a single canvas item, such as a rectangle or bitmap, and for menu widgets, you
can configure a single menuentry.

When configuring items in widgets, if the Widgets menu has selected "One
wWidget", the most visible item (be it tag or canvas item) is configured, If
"Local Group" is selected, the next most visible item is configured, and if
"All in Class" is selected, then the least visible item, iff there are at least
3 items under the pointer. For menu entries, you must have the Widgets menu set
to "One Widget".

Items in widgets can be configured, however they cannot be added to the options
database or saved to a resource file, so they only last as long as the widget
lasts.


Example Configure Commands:

-background <color>            -foreground <color>
Change background or foreground to specified color.

-fill <color>
Many canvas items use this to fill their region instead of -foreground.

-text <text>
Change text in the widget to specified text. (Most Tk widgets that can contain
text will have text specified by the program, so while you can change text in a
program on the fly, you probably won't be able to save the changes; they'll get
overridden by the program.)

-bitmap <bitmap>   -image <image>
Change bitmap in the widget. Sample bitmaps include: error, hourglass, grey25.
To use a file as a bitmap, precede the filename with '@'.

-font <font>
Change font of text to specified font.

-cursor <cursor>
Change mouse cursor, including foreground color, background color, and shape.

-relief <relief>
Specifies the 3-D effect desired for the widget.  Acceptable values are 
raised,  sunken, flat, ridge, and groove.  The value indicates how the interior
of the widget should appear relative to its  exterior; for example, raised
means the interior of the widget should appear to protrude from the screen,
relative to the exterior of the widget.

-borderwidth <number>
Change size of the widget's border.

-padx <number>             -pady <number>
Change size of the widget's horizontal or vertical padding.

-height <height>    -width <width>
Specifies the geometry of a widget.

} $TH_Help {

While you can save new configurations over any program, that program may still
override your new configurations. There is no way to circumvent program-defined
configurations permenantly; you'll just have to reconfigure them on the fly.

Embedded widgets in canvas and text widgets should be configured with
"Configure","Widget", not "Configure","Item".}


# Executes configureth_rmt_code in app, gives class as parm. Teaches code if app
# doesn't know it.
proc remote_widgets {top} {
  global App Class
  if {[send $App info procs configureth] == ""} {
    global configureth_rmt_code
    send $App $configureth_rmt_code
  }
  return [send $App configureth_widgets_of_class $Class $top]
}

# This code (meant to be executed remotely) returns all widgets of a particular
# class.
set configureth_rmt_code {
proc configureth_widgets_of_class {class {top "."}} {
  if {[winfo class $top] == $class} {set results $top
  } else {set results ""}

  foreach w [winfo children $top] {
    set result [configureth_widgets_of_class $class $w]
    if {$result != ""} {set results [concat $results $result]}
  }
  return $results
}}

# Given a widget, returns an appropriate option string for that widget.
proc return_resource_widget {widget} {
  if {$widget == "."} {return ""}
  regsub -all -- {\.} $widget "\*" result
  return $result
}

# Creates command from C, depending on parameters.
# option: 1- use "option add w*config value ; option add ..."
#         0- use "w*config: value \n widget*config ..."
proc divide_up_multiple_configs {widget w {option 1}} {
  global C App
  set l [llength $C]
  if {[expr $l % 2] == 1} {return ""}
  set cmd ""
  for {set c 0} {$c < $l} {incr c 2} {
    if $option {append cmd "option add "}
    append cmd $w
    set o [lindex $C $c]
    set v [lindex $C [expr $c+1]]
    set O [lindex [send $App $widget configure $o] 1]
    append cmd "*$O"
    if $option {append cmd " "} else {append cmd ":\t"}
    if {$option && ([llength $v] > 1)} {append cmd "{" $v "}"
    } else {append cmd $v}
    if {[expr $c+2] != $l} {append cmd "\n"
  }}
  return $cmd
}


# These next procedures operate on a remote widget, performing various
# levels of configuration.

# Configures an item inside a widget.
proc do_configure_subwidget {} {
  global C App Widget Class X Y
  if {![get_widget]} {return ""}

  set root_x [send $App winfo rootx $Widget]
  set root_y [send $App winfo rooty $Widget]
  switch $Class {
    Canvas {
      set new_x [send $App $Widget canvasx [expr $X - $root_x]]
      set new_y [send $App $Widget canvasy [expr $Y - $root_y]]
      set items [send $App $Widget find overlapping $new_x $new_y $new_x $new_y]
    } Text {
      set items [send $App $Widget tag names \
                          @[expr $X - $root_x],[expr $Y - $root_y]]
    } Menu {
      set items [send $App $Widget index @[expr $Y - $root_y]]
  }}

  
  set l [llength $items]
  if {$l == 0} {bell ; return}
  global Level ; switch $Level {
    "One Widget" {incr l -1 ; set item [lindex $items $l]
    } "Local Group" {if {$l <= 1} {bell ; return
         } else {incr l -2 ; set item [lindex $items $l]}
    } "All in Class" {if {$l <= 2} {bell ; return
         } else {set item [lindex $items 0]}
  }}

  switch $Class {
    Canvas {set cmd "$Widget itemconfigure $item $C"
    } Text {set cmd "$Widget tag configure $item $C"
    } Menu {set cmd "$Widget entryconfigure $item $C"
  }}

  do_cmd $cmd
}

# Returns widgets
proc which_widgets {} {
  global App Class Widget Level
  if {![get_widget]} {return ""}
  switch $Level {
    "One Widget" {set w $Widget
  } "Local Group" {set w [send $App winfo parent $Widget]
  } "All in Class" {set w "."}}
  return $w
}

# Executes the configure command some remote widgets.
proc do_configure_widgets {} {
  global C
  if {[set widget [which_widgets]] == ""} {bell ; return}
  if {[llength [set widgets [remote_widgets $widget]]] == 1} {
    do_cmd "[lindex $widgets 0] configure $C"
  } else {
    do_cmd "foreach widget \{$widgets\} \{\n\$widget configure $C\}"
}}

# Adds configuration of remote widgets to remote options database.
proc do_option_widgets {} {
  if {[set widget [which_widgets]] == ""} {bell ; return}
  set cmd ""
  foreach widget [remote_widgets $widget] {
    append cmd [divide_up_multiple_configs $widget [return_resource_widget $widget]] "\n"}
  do_cmd $cmd
}

# Adds configuration of remote widget's class to remote options database.
proc do_option_class {} {
  global Level App Class Widget ; if {$Level == "One Widget"} {bell ; return}
  if {[set widget [which_widgets]] == ""} {bell ; return}
  do_cmd [divide_up_multiple_configs $Widget "[return_resource_widget $widget]*$Class"]
}

proc do_appfile_widgets {{app_flag 0}} {
  if {[set widget [which_widgets]] == ""} {bell ; return}
  global Output App
  set Output ""
  if $app_flag {set prefix [send $App winfo class .]
  } else {set prefix [lindex [send $App winfo name .] 0]}
  foreach widget [remote_widgets $widget] {
    append Output [divide_up_multiple_configs $widget \
	"$prefix[return_resource_widget $widget]" 0] "\n"
  }
  append_output
}

proc do_appfile_class {{app_flag 0}} {
  global App Widget Class Level ; if {$Level == "One Widget"} {bell ; return}
  if {[set widget [which_widgets]] == ""} {bell ; return}
  global Output
  if $app_flag {set prefix [send $App winfo class .]
  } else {set prefix [lindex [send $App winfo name .] 0]}
  set Output [divide_up_multiple_configs $Widget \
	"$prefix[return_resource_widget $widget]*$Class" 0]
  append_output
}

# Make sure not to append the same thing to the file twice. Xrdb will usually
# not like duplication.
set Old_Output ""
proc append_output {} {
  global Output App_File Old_Output
  if {$Output == $Old_Output} {return}
  set Old_Output $Output
  set fd [open $App_File "a"]
  puts $fd $Output
  close $fd
  show_output
}


destroy .buttons.source
create_form_entry .config "Configuration" C ""

frame .frame2 -relief {raised}
button .frame2.button -text {File} -command {.config.e insert insert [FSBox]}
if {[info procs FSBox] == ""} {.frame2.button configure -state disabled}
button .frame2.button2 -text {Cursor} -command {.config.e insert insert \
	[list [concat [CursorBox $XF_Dir/lib/Cursors $XF_Dir/lib/Colors]]]}
if {[info procs CursorBox] == ""} {.frame2.button2 configure -state disabled}
button .frame2.button3 -text {Color} -command {.config.e insert insert [ColorBox $XF_Dir/lib/Colors]}
if {[info procs ColorBox] == ""} {.frame2.button3 configure -state disabled}
button .frame2.button4 -text {Font} -command {.config.e insert insert [FontBox $XF_Dir/lib/Fonts]}
if {[info procs FontBox] == ""} {.frame2.button4 configure -state disabled}
pack .frame2.button3 -side left -expand yes -fill x
pack .frame2.button2 -side left -expand yes -fill x
pack .frame2.button -side left -expand yes -fill x
pack .frame2.button4 -side left -expand yes -fill x
pack .frame2 -side top -expand no -fill x
create_form_entry .appfile "Resource File" App_File
# Have .appfile complete filenames.


set menu .buttons.teach.m
$menu add cascade -label "Configure" -menu $menu.c ; menu $menu.c
$menu.c add command -label "Widget" -command "do_configure_widgets"
$menu.c add command -label "Item" -command "do_configure_subwidget"
$menu add cascade -label "Add Option" -menu $menu.o ; menu $menu.o
$menu.o add command -label "Widget" -command "do_option_widgets"
$menu.o add command -label "Class" -command "do_option_class"
$menu add cascade -label "Add to Application File" -menu $menu.a ; menu $menu.a
$menu.a add command -label "Widget" -command "do_appfile_widgets"
$menu.a add command -label "Tk Widget" -com "do_appfile_widgets 1"
$menu.a add command -label "Class" -command "do_appfile_class"
$menu.a add command -label "Tk Class" -command "do_appfile_class 1"
tk_optionMenu .buttons.level Level "One Widget" "Local Group" "All in Class"
set Level "One Widget"
pack .buttons.level -side right

foreach arg "~/.Xdefaults $App_File" {
  th_add_history .appfile.thistory .appfile.e $arg $arg
}
lappend TH(Completions,.appfile.e) {th_line_complete th_filter_glob none}
