#! /bin/sh -f
# The next line is executed by /bin/sh, but not Tcl \
exec guiwish -f $0 ${1+"$@"}
#
# GuiBuilder V 1.0
#
# Copyright (c) 1995 Sean Halliday
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL SEAN HALLIDAY BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF SEAN HALLIDAY
# HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# SEAN HALLIDAY SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND SEAN HALLIDAY HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# halliday@cs.sfu.ca or halliday@cs.ualberta.ca

set version v1.0

proc echo {args} {
  puts "$args"
}

if [file executable guiBuilder] {
  set env(GUI_BUILDER) $env(PWD)
} else {
  set env(GUI_BUILDER) [file dirname [exec which guiBuilder]]
}
echo $env(GUI_BUILDER)

if {[catch "set env(GUI_BUILDER)"]} {
  echo
  echo
  echo Environment variable GUI_BUILDER not set.
  echo TRY: setenv GUI_BUILDER /path/to/guiBuilder
  echo I will use $env(PWD) but this may lead to problems.
  echo
  echo
  set env(GUI_BUILDER) $env(PWD)
  source $env(GUI_BUILDER)/gui_warn.tcl
  gui_warn "
    Environment variable GUI_BUILDER not set.
    TRY: setenv GUI_BUILDER /path/to/guiBuilder
    I will use $env(PWD) but this may lead to problems.
  "
} else {
  source $env(GUI_BUILDER)/gui_warn.tcl
}

source $env(GUI_BUILDER)/common.tcl
set align_list ""
source $env(GUI_BUILDER)/extensions.tcl
source $env(GUI_BUILDER)/proc_edit.tcl
source $env(GUI_BUILDER)/colors.tcl
source $env(GUI_BUILDER)/page_config.tcl
wm withdraw .colors
global Defaults
set smallfont "-*-clean-bold-r-normal--8-*"
set Defaults(pp_shape) place
set Defaults(stretchX) 1
set Defaults(stretchY) 1
set Defaults(moveX) 1
set Defaults(moveY) 1
set Defaults(snap) 1
set Defaults(grid) 5
set selected(null) 0
unset selected(null) 

set grid $Defaults(grid)
set snap $Defaults(snap)
set lastX 0
set lastY 0
set Procs(0) 0
unset Procs(0)

proc set_grid_def {v} {
  global grid Defaults
  set grid $v
  set Defaults(grid) $v
  catch ".guibuilder.fr2.s set $v"
}

proc set_defaults {} {
  global Defaults
  if {[winfo exists .defaults]} {return}
  toplevel .defaults
  set D .defaults
  frame $D.f1
  frame $D.f2
  frame $D.f3
  frame $D.f4
  frame $D.f5
  frame $D.f6
  frame $D.f7
  frame $D.f8
  pack $D.f6 -expand 1 -fill both
  pack $D.f1 -expand 1 -fill both
  pack $D.f2 -expand 1 -fill both
  pack $D.f3 -expand 1 -fill both
  pack $D.f4 -expand 1 -fill both
  pack $D.f5 -expand 1 -fill both
  pack $D.f7 -expand 1 -fill both
  pack $D.f8 -expand 1 -fill both
  label $D.f1.l -text "Geometry Manager" -width 17 -anchor w
  radiobutton $D.f1.r1 -text "Pack" -value pack -variable Defaults(pp_shape) -width 5 -anchor w
  radiobutton $D.f1.r2 -text "Place" -value place -variable Defaults(pp_shape) -width 5 -anchor w
  radiobutton $D.f1.r3 -text "Table" -value blt_table -variable Defaults(pp_shape) -width 5 -anchor w
  #radiobutton $D.f1.r4 -text "Align" -value align -variable Defaults(pp_shape) -width 5 -anchor w
  pack $D.f1.l -side left
  pack $D.f1.r2 -side left
  pack $D.f1.r1 -side left
  pack $D.f1.r3 -side left
  pack $D.f1.r4 -side left
  label $D.f2.l -text "StretchX" -width 17 -anchor w
  radiobutton $D.f2.r1 -text "On" -value 1 -variable Defaults(stretchX) -width 7 -anchor w
  radiobutton $D.f2.r2 -text "Off" -value 0 -variable Defaults(stretchX) -width 7 -anchor w
  pack $D.f2.l -side left
  pack $D.f2.r1 -side left
  pack $D.f2.r2 -side left
  label $D.f3.l -text "StretchY" -width 17 -anchor w
  radiobutton $D.f3.r1 -text "On" -value 1 -variable Defaults(stretchY) -width 7 -anchor w
  radiobutton $D.f3.r2 -text "Off" -value 0 -variable Defaults(stretchY) -width 7 -anchor w
  pack $D.f3.l -side left
  pack $D.f3.r1 -side left
  pack $D.f3.r2 -side left
  label $D.f4.l -text "MoveX" -width 17 -anchor w
  radiobutton $D.f4.r1 -text "On" -value 1 -variable Defaults(moveX) -width 7 -anchor w
  radiobutton $D.f4.r2 -text "Off" -value 0 -variable Defaults(moveX) -width 7 -anchor w
  pack $D.f4.l -side left
  pack $D.f4.r1 -side left
  pack $D.f4.r2 -side left
  label $D.f5.l -text "MoveY" -width 17 -anchor w
  radiobutton $D.f5.r1 -text "On" -value 1 -variable Defaults(moveY) -width 7 -anchor w
  radiobutton $D.f5.r2 -text "Off" -value 0 -variable Defaults(moveY) -width 7 -anchor w
  pack $D.f5.l -side left
  pack $D.f5.r1 -side left
  pack $D.f5.r2 -side left
  label $D.f7.l -text "Grid Snap" -width 17 -anchor w
  radiobutton $D.f7.r1 -text "On" -value 1 -variable Defaults(snap) -width 7 -anchor w -command "global snap;set snap 1"
  radiobutton $D.f7.r2 -text "Off" -value 0 -variable Defaults(snap) -width 7 -anchor w -command "global snap;set snap 0"
  pack $D.f7.l -side left
  pack $D.f7.r1 -side left
  pack $D.f7.r2 -side left
  label $D.f8.l -text "Granularity" -width 17 -anchor w
  scale $D.f8.sc -command "set_grid_def" -from 1 -to 10 -orient horizontal
  $D.f8.sc set $Defaults(grid)
  pack $D.f8.l -side left
  pack $D.f8.sc -side left -expand 1 -fill x
  button $D.f6.save -text Save -command save_defaults
  button $D.f6.load -text Load -command load_defaults
  pack $D.f6.save -side left -fill x -expand 1
  pack $D.f6.load -side left -fill x -expand 1
  button $D.done -text Done -command "destroy .defaults"
  pack $D.done -fill x -expand 1
}

proc save_defaults {} {
  global Defaults env
  set filename $env(HOME)/.guibuilder_defaults
  set file [open $filename w]
  puts $file "global Defaults"
  for_array_keys k Defaults {
    puts $file "set Defaults($k) $Defaults($k)"
  }
  #puts $file "set Defaults(pp_shape) $Defaults(pp_shape)"
  #puts $file "set Defaults(stretchX) $Defaults(stretchX)"
  #puts $file "set Defaults(stretchY) $Defaults(stretchY)"
  #puts $file "set Defaults(moveX) $Defaults(moveX)"
  #puts $file "set Defaults(moveY) $Defaults(moveY)"
  #puts $file "set Defaults(snap) $Defaults(snap)"
  #puts $file "set Defaults(grid) $Defaults(grid)"
  close $file
}

proc load_defaults {} {
  global env Defaults
  if {[file exists $env(HOME)/.guibuilder_defaults]} {
    source $env(HOME)/.guibuilder_defaults
  }
  catch ".defaults.f8.sc set $Defaults(grid)"
  catch ".guibuilder.fr2.s set $Defaults(grid)"
}


proc parse_options {} {
  global argc argv
  #echo $argc $argv
  for {set i 0} {$i < $argc} {incr i 2} {
    echo "option add *[lindex $argv $i] [lindex $argv [expr $i+1]]"
    option add *[lindex $argv $i] [lindex $argv [expr $i+1]]
  }
}


proc echo {args} {
  puts stdout "$args"
}


parse_options

proc remove_root {w} {
  for {i=1} {$i < [clength $w]} {incr i} {
    if {[csubstr $w $i $i]=="."} {
      return [csubstr $w $i end]
    }
  }
  return ""
}

set theParent "123456789abcdefg"

proc save_comp_widget {top w file istop} {
  global images num_images theParent
  global pp_shape Menu_string env Procs is_saved
  set W $w
  set Wid $top$w
  if { [winfo exists $Wid] } {
    if {[winfo class $Wid] != "Toplevel" && [winfo class $Wid] != "TixPopupMenu" && ![isset pp_shape($Wid)]} return
    if [is_tix_widget [winfo parent $Wid]] return
    puts $file ""
    if {$istop == 1} {
      set theParent $Wid
      if {$top == "."} {puts $file "set Name .$W"
      } else { puts $file "set Name \[unique2 \$Composite$W\]" }
      puts $file "set Parent \$Name"
    } else {
      set W [remove_root $W]
      puts $file "set Name \$Parent$W"
    }
    if {[winfo parent $Wid] == "." && [isset Procs($Wid)]} {  
      puts $file "global Procs"
      puts $file "set Procs(\$Name) \{$Procs($Wid)\}"
      foreach proc $Procs($Wid) {
        if {[lindex $proc 0] == "bind"} {
          set Name $Wid
          set Bind [list [eval $proc]]
          puts $file "$proc $Bind"
        } else {
          if {[scan $proc "\$Name.%s" prc]==0} {set prc $proc
          } else {set prc $Wid.$prc}
          if ![isset is_saved($prc)] {
            puts $file "[list proc $prc [info args $prc] [info body $prc]]"
            if {[lindex $proc 0] != "bind"} {set is_saved($prc) 1}
          }
        }
      }
    }
    if {[winfo parent $Wid] == "."} return
    puts $file "#------------------------------------------"
    create_widget $Wid $file
    if {[winfo class $Wid] == "Text"} {
      puts $file "\$Name insert end \{[$Wid get 0.0 end]\}"
    }
    if {[winfo class $Wid] == "Menubutton"} {
      puts $file "set Menu_string(\$Name) {$Menu_string($Wid)}"
      puts $file "\$Name configure -menu \$Name.m\neval \"make_menu \$Name \$Menu_string(\$Name)\""
    }
    if [isset pp_shape($Wid)] {
      if {$pp_shape($Wid)=="place"} {
        puts $file "place \$Name [place info $Wid]"
      } elseif {$pp_shape($Wid) == "pack"} { 
        global tk_version
        if {$tk_version>=4} {
          set info [pack info $Wid]
        } else {
          set info [pack newinfo $Wid]
        }
        lvarpop info
        lvarpop info
        puts $file "pack \$Name $info" 
      } elseif {$pp_shape($Wid) == "blt_table"} { 
        puts $file "blt_table \[winfo parent \$Name\] \$Name [lrange [blt_table info $Wid] 1 end]" 
      } elseif {$pp_shape($Wid) == "align"} { 
        puts $file "align \$Name [align info $Wid]"
      } elseif {$pp_shape($Wid) == "Text"} { 
        puts $file "\[winfo parent \$Name\] window create [[winfo parent $Wid] index $Wid] -window \$Name"
      }
    }
    if [isset Procs($Wid)] {  
      puts $file "global Procs"
      puts $file "set Procs(\$Name) \{$Procs($Wid)\}"
      foreach proc $Procs($Wid) {
        if {[lindex $proc 0] == "bind"} {
          set Name $Wid
          set Bind [list [eval $proc]]
          puts $file "$proc $Bind"
        } else {
          if {[scan $proc "\$Name.%s" prc]==0} {set prc $proc
          } else {set prc $Wid.$prc}
          if ![isset is_saved($prc)] {
            puts $file "[list proc $prc [info args $prc] [info body $prc]]"
            if {[lindex $proc 0] != "bind"} {set is_saved($prc) 1}
          }
        }
      }
    }
  }
}

proc save_comp_rec {top w len file} {
  global istop
  #echo [csubstr $w $len end]
  save_comp_widget $top [csubstr $w $len end] $file $istop
  set istop 0
  foreach c [winfo child $w] {
    if {[winfo class $c] == "Menu"} continue
    if {[is_gui_widget $c]==1} continue
    save_comp_rec $top $c $len $file 
  }
}

proc scan_composites {} {
  global env
  set L .guibuilder.fr3.new.lb
  $L delete 0 end
  foreach f [exec ls -a $env(GUI_BUILDER)/Composites] {
    if {[file isdirectory $f]} continue
    $L insert end $f
  }
  if [isset env(MY_COMPOSITES)] {
    foreach f [exec ls -a $env(MY_COMPOSITES)] {
      if {[file isdirectory $f]} continue
      $L insert end $f
    }
  }
}

proc array_clear {a} {
  upvar $a A
  for_array_keys k A {
    unset A($k)
  }
}

proc save_comp_cb {w} {
  global env istop is_saved images num_images
  set istop 1
  if [isset env(MY_COMPOSITES)] {
    set fname $env(MY_COMPOSITES)/[.comp.fName:.e get]
  } else {
    gui_warn "
Environment variable MY_COMPOSITES not set.
Attempting to save to $env(GUI_BUILDER)/Composites
"
    set fname $env(GUI_BUILDER)/Composites/[.comp.fName:.e get]
  }
  set fname [space2_ $fname]
  set file [open $fname w]
  echo opened $file
  set sub [string length [winfo parent $w]]
  set is_saved(NULL) NULL
  array_clear is_saved
  puts $file "global num_images images"
  puts $file "if {!\[info exists num_images\]} {set num_images 0}"
  for {set i 0} {$i < $num_images} {incr i} {
    puts $file "catch \"image create photo $images($i) -file $images($i)\""
    puts $file "set images(\$num_images) $images($i)"
    puts $file "incr num_images"
  }
  save_comp_rec [winfo parent $w] $w $sub $file
  close $file
  scan_composites
  destroy .comp
}

proc save_comp {w} {
  global Mx My
  catch "destroy .comp"
  toplevel .comp
  wm geom .comp +$Mx+$My
  set Bind "save_comp_cb $w"
  set F [my_entry .comp Name: 5 "" $Bind]
  pack $F
  button .comp.can -text Cancel -command "destroy .comp"
  pack .comp.can -fill x -expand 1
}

proc get_composite {w} {
  global env
  set file [$w get [$w curselection]]
  if [isset env(MY_COMPOSITES)] {
    if [file exists $env(MY_COMPOSITES)/$file] {
      load_comp_grab $env(MY_COMPOSITES)/$file
    } elseif [file exists $env(GUI_BUILDER)/Composites/$file] {
      load_comp_grab $env(GUI_BUILDER)/Composites/$file
    }
  } elseif [file exists $env(GUI_BUILDER)/Composites/$file] {
    load_comp_grab $env(GUI_BUILDER)/Composites/$file
  }
}

proc load_comp_ungrab {file} {
  grab release .grab.m
  global Mx My
  set w [winfo containing $Mx $My]
  destroy .grab
  echo $w
  if {$w == ""} return
  if {[is_gui_widget [winfo toplevel $w]]} return
  load_comp $w $file
}

proc load_comp_grab {file} {
  set_type comp $file
  return
  global Mx My
  catch "destroy .grab"
  toplevel .grab
  wm geom .grab +$Mx+$My
  message .grab.m -text "Select parent with mouse button one.  Cancel with button two" -aspect 800 -justify left 
  pack .grab.m
  update
  grab .grab.m
  bind .grab.m <Button-2> "grab release .grab.m;destroy .grab"
  bind .grab.m <Button-1> "load_comp_ungrab $file"
}

proc load_comp {w file} {
  global Menu_string Topstate Topgeom Toppos Topborder
  set Composite $w
  source $file
  update
  foreach w [make_widget_list] {
    if {[winfo class $w] == "Toplevel"} {
      set Topborder($w) [expr 1-[wm override $w]]
      set Topstate($w) [wm state $w]
      continue
    }
    if {[winfo class $w] == "Frame" } {
      #bind $w <1> "add_widget $w \$Type %x %y"
    }
    get_placement_info $w
    bind_widget $w
  }
  show_widget_tree
  update_scrollbars $Composite ""
  return $Parent
}


set widget_count 0
set tag_count 0
set top_count 0
set filename "tmp.tcl"
set sourcename ""
set colors "white black red orange yellow green blue purple violet gray10 gray20 gray30 gray40 gray50 gray60 gray70 gray80 gray90"

if {[isset env(GUI_COLORS)]} {set colors $env(GUI_COLORS)}


proc mouse_update {x y} {
  global Mx My
  set Mx $x 
  set My $y
}

proc arg_config {f args} {
  set lla  [llength $args]
  for {set i 0} {$i < $lla} {incr i 2} {
    set i2 [expr $i+1]
    set cmd "$f config [lindex $args $i] [lindex $args $i2]"
    catch "$cmd"
  }
}

proc configure {f args} {
  eval "arg_config $f $args"
}

proc i=0 {} {
  upvar i I
  set I 0
}
proc i=1 {} {
  upvar i I
  set I 1
}

proc i++ {} {
  upvar i I
  incr I
}

proc ord {a} {
  scan $a %c b
  return $b
}

proc char {n} {
  format %c $n
}

catch "destroy .select_cmd"
catch "destroy .select_cmd@"
checkbutton .select_cmd
for {i=0} {$i<10} {i++} {
  catch "destroy .select_cmd$i"
  checkbutton .select_cmd$i
  rename .select_cmd$i .select_cmd_$i
  set body "proc .select_cmd$i {args} {eval return \\\[.select_cmd $i \$args\\\]}"
  uplevel #0 {
    eval $body
  }
}
for {set i a} {$i!=[char [expr [ord z]+1]]} {} {
  catch "destroy .select_cmd$i"
  checkbutton .select_cmd$i
  rename .select_cmd$i .select_cmd_$i
  set body "proc .select_cmd$i {args} {eval return \\\[.select_cmd $i \$args\\\]}"
  uplevel #0 {
    eval $body
  }
  set i [char [expr [ord $i]+1]]
}
for {set i A} {$i!=[char [expr [ord Z]+1]]} {} {
  catch "destroy .select_cmd$i"
  checkbutton .select_cmd$i
  rename .select_cmd$i .select_cmd_$i
  set body "proc .select_cmd$i {args} {eval return \\\[.select_cmd $i \$args\\\]}"
  uplevel #0 {
    eval $body
  }
  set i [char [expr [ord $i]+1]]
}

checkbutton .select_cmd@

set cur_sel 1

proc .select_cmd {n args} {
  global selected 
  set cmd ".select_cmd@ $args"
  set a [catch "$cmd"]
  if {[llength $args] > 2} {
    for_array_keys w selected {
      if {$selected($w)==$n} {
        set tmp $args
        str_rep tmp %W $w
        set cmd "$w $tmp"
        catch "$cmd"
      }
    }
  }
  return $a
}

proc sel_table {conf w op val} {
  global selected pp_shape
  if [is_gui_widget $w] {
    scan $w ".select_cmd%s" n
    for_array_keys wi selected {
      if {$selected($wi)==$n} {
        catch "place forget $wi"
        catch "pack forget $wi"
        catch "align forget $wi"
        set pp_shape($wi) blt_table
        set cmd "blt_table configure $wi $op $val"
        catch "$cmd"
      }
    }
  } else {
    blt_table configure $w $op $val
  }
}

proc sel_pack {w op val} {
  global selected pp_shape
  if [is_gui_widget $w] {
    scan $w ".select_cmd%s" n
    for_array_keys wi selected {
      if {$selected($wi)==$n} {
        catch "place forget $wi"
        catch "blt_table forget $wi"
        catch "align forget $wi"
        set pp_shape($wi) pack
        set cmd "pack $wi $op $val"
        catch "$cmd"
      }
    }
  } else {
    pack $w $op $val
  }
}

proc toggle_select {w {n 0}} {
  global selected pp_shape Mx My cur_sel smallfont
  if {[winfo parent $w]=="."} return
  if {$n!=0} {set cur_sel $n}
  if {[catch "set selected($w)"]==1} {
    set selected($w) $cur_sel
  } else {
    if {$selected($w)==0} {set selected($w) $cur_sel 
    } else {
      if {$n == $selected($w)} { set selected($w) 0
      } else {set selected($w) $n}
    }
  }
  if {$selected($w)!=0} {
    set p [winfo parent $w]
    set n [winfo name $w]
    catch "destroy $p.sel$n"
    #set c [lindex $colors $cur_sel]
    set c #10a020
    button $p.sel$n -text $cur_sel -bg $c -activeb $c -font $smallfont \
      -fg black -activef black -command \
"
 global cur_sel Mx My
 set cur_sel \[get_widget_value $p.sel$n text\]
 edit_widget Select .select_cmd\$cur_sel \$Mx \$My
"
    bindtags $p.sel$n {$p.sel$n Button}
    place $p.sel$n -in $w -width 18 -height 18
    set Bind [bind Button <Any-Enter>]
    bind $p.sel$n <Any-Enter> "$Bind;focus %W"
    bind $p.sel$n <Key-1> "toggle_select $w 1"
    bind $p.sel$n <Key-2> "toggle_select $w 2"
    bind $p.sel$n <Key-3> "toggle_select $w 3"
    bind $p.sel$n <Key-4> "toggle_select $w 4"
    bind $p.sel$n <Key-5> "toggle_select $w 5"
    bind $p.sel$n <Key-6> "toggle_select $w 6"
    bind $p.sel$n <Key-7> "toggle_select $w 7"
    bind $p.sel$n <Key-8> "toggle_select $w 8"
    bind $p.sel$n <Key-9> "toggle_select $w 9"
    for {set i a} {[ord $i] <= [ord z]} {set i [char [expr [ord $i]+1]]} {
      bind $p.sel$n <Key-$i> "toggle_select $w $i"
    } 
    for {set i A} {[ord $i] <= [ord Z]} {set i [char [expr [ord $i]+1]]} {
      bind $p.sel$n <Key-$i> "toggle_select $w $i"
    } 
  } else {
    set p [winfo parent $w]
    set n [winfo name $w]
    catch "destroy $p.sel$n"
  }
  update_sel
  show_widget_tree
}

bind all <Motion> "mouse_update %X %Y"
#bind all <Escape> exit



set menu_string "{\
\n  {Output command \"puts OUTPUT\"}\
\n  {Male radiobutton \"puts male\" -variable sex}\
\n  {Female radiobutton \"puts female\" -variable sex}\
\n  {separator}\
\n  {\"More --->\" menu {\
\n    {Hello command \"puts hello\"}\
\n    {\"Station 1\" radiobutton \"puts 1\" -variable radio}\
\n    {\"Station 2\" radiobutton \"puts 2\" -variable radio}\
\n    } -background red3 -foreground white -activebackground red1\
\n  }\
\n  {\"Check Oil\" checkbutton \"puts {checked oil} \" -background blue}\
\n  {\"Check Brakes\" checkbutton \"puts {checked brakes}\" -background blue}\
\n} -background green3 -activebackground green1"


proc get_anchor {w} {
   set i [place info $w]
   return [lindex $i [expr [llength $i]-1]]
}

proc get_place {w v {v2 NULL}} {
  global pp_shape
  if {$pp_shape($w) == "place"} {
    set found 0
    foreach c [place info $w] {
      if {$found} {return $c}
      if {"$c"=="$v"} {set found 1}
      if {"$c"=="$v2"} {set found 1}
    }
  }
}

set FreezeX 0
set FreezeY 0
set Can_Resize 1

proc itemStartResize {b x y} {
    global lastX lastY Type pp_shape Can_Resize FreezeX FreezeY SHOW
    set SHOW ""
    catch "destroy .showfeedback"
    menu .showfeedback
    label .showfeedback.l -width 16 -anchor w -textvariable SHOW \
      -relief groove -fg white -bg gray30
    pack .showfeedback.l
    .showfeedback post 0 0
    if {$pp_shape($b) == "pack"} {
      set lastX [winfo rootx $b]
      set lastY [winfo rooty $b]
    }
    if {$pp_shape($b) == "place" || $pp_shape($b) == "align"} {
      set c [winfo parent $b]
      set lastX [winfo rootx $b]
      set lastY [winfo rooty $b]
      set W [winfo width $b]
      set H [winfo height $b]
      set anchor none
      set Can_Resize 0
      set FreezeX 0
      set FreezeY 0
      set W10 [expr $W-10]
      set H10 [expr $H-10]
      if {[expr $x-$lastX] < 10 && [expr $y-$lastY] < 10} {set anchor se}
      if {[expr $x-$lastX]>$W10 && [expr $y-$lastY] < 10} {set anchor sw}
      if {[expr $x-$lastX] < 10 && [expr $y-$lastY] > $H10} {set anchor ne}
      if {[expr $x-$lastX]>$W10 && [expr $y-$lastY] > $H10} {set anchor nw}
      if {$anchor == "none"} {
         if {[expr $x-$lastX] < 10} {set FreezeY 1;set anchor ne}
         if {[expr $x-$lastX] > $W10} {set FreezeY 1;set anchor nw}
         if {[expr $y-$lastY] < 10} {set FreezeX 1;set anchor se}
         if {[expr $y-$lastY] > $H10} {set FreezeX 1;set anchor nw}
      }
      if {$anchor == "ne"} {
        set Can_Resize 1
        set nx [expr [my_winfo x $b]+$W]
        set ny [my_winfo y $b]
        set lastX [expr [winfo rootx $b]+$W]
        set_position $b $nx $ny
        place $b -anchor ne
      }
      if {$anchor == "se"} {
        set Can_Resize 1
        set nx [expr [my_winfo x $b]+$W]
        set ny [expr [my_winfo y $b]+$H]
        set lastX [expr [winfo rootx $b]+$W]
        set lastY [expr [winfo rooty $b]+$H]
        set_position $b $nx $ny
        place $b -anchor se
      }
      if {$anchor == "sw"} {
        set Can_Resize 1
        set nx [my_winfo x $b]
        set ny [expr [my_winfo y $b]+$H]
        set lastY [expr [winfo rooty $b]+$H]
        set_position $b $nx $ny
        place $b -anchor sw
      }
      if {$anchor == "nw"} {
        set Can_Resize 1
      }
    } 
    return
}

proc itemDoneResize {b} {
  global pp_shape FreezeX FreezeY Can_Resize
  catch "destroy .showfeedback"
  if {$pp_shape($b) == "pack"} return
  if {$pp_shape($b) == "blt_table"} return
  if {$pp_shape($b) == "Text"} return
  set an [get_anchor $b]
  if {$an == "nw"} {
    set FreezeX 0
    set FreezeY 0
    set Can_Resize 1
    return
  }
  set nx [my_winfo x $b]
  set ny [my_winfo y $b]
  set_position $b $nx $ny
  place $b -anchor nw
  set FreezeX 0
  set FreezeY 0
  set Can_Resize 1
}
proc set_wid_hi {b wid hi} {
  global stretchX stretchY pp_shape FreezeX FreezeY
  set hastext {Text Entry Button Label Menubutton Checkbutton Radiobutton}
  if {$pp_shape($b) == "align" || $pp_shape($b) == "pack"} {
    set c [winfo parent $b]
    if {[winfo class $b] == "old_Listbox"} {
      scan "[get_widget_value $b geometry]" "%dx%d" W H
      if {$W <= 0} {set W 1}
      if {$H <= 0} {set H 1}
      set sx [expr double($W)/double([winfo reqwidth $b])]
      set sy [expr double($H)/double([winfo reqheight $b])]
      if {$FreezeX ==0} { set W [expr int($wid*$sx)] }
      if {$FreezeY ==0} { set H [expr int($hi*$sy)] }
      if {$W > 1000} {set W 1000}
      if {$H > 1000} {set H 1000}
      if {$W <= 0} {set W 1}
      if {$H <= 0} {set H 1}
      catch "$b config -geom [format "%sx%s" $W $H]"
    } elseif {[winfo class $b] == "Scale" || [winfo class $b] == "Scrollbar"} {
      if {[get_widget_value $b orient]=="horizontal"} {
        if !$FreezeX {$b config -length $wid}
        if !$FreezeY {$b config -width $hi}
      } else {
        if !$FreezeX {$b config -width $wid}
        if !$FreezeY {$b config -length $hi}
      }
    } else {
      if {$FreezeX == 0} {
        set W [get_widget_value $b width]
        if {$W == 0} {set W [string length [get_widget_value $b text]]}
        set sx [expr double($W)/double([winfo reqwidth $b])]
        set wid [expr [gridify $wid]]
        if {$wid < 4} {set wid 4}
        set c [winfo class $b]
        case $c in $hastext { 
          if {$wid < 5} {set wid 0}
          if {[get_widget_value $b bitmap] == {{}}} {set wid [expr $wid*$sx]}
          if {[get_widget_value $b bitmap] == {}} {set wid [expr $wid*$sx]}
        }
        if {$wid > 1000} {set wid 1000}
        catch "$b config -wid [expr int($wid)]"
      } else {set wid -}
      if {$FreezeY == 0} {
        set H [get_widget_value $b height]
        if {$H == 0} {set H 1}
        set sy [expr double($H)/double([winfo reqheight $b])]
        set hi [expr [gridify $hi]]
        if {$hi < 4} {set hi 4}
        set c [winfo class $b]
        case $c in $hastext {
          if {$hi < 5} {set hi 0}
          if {[get_widget_value $b bitmap] == {{}}} {set hi [expr $hi*$sy]}
          if {[get_widget_value $b bitmap] == {}} {set hi [expr $hi*$sy]}
        }
        if {$hi > 1000} {set hi 1000}
        catch "$b config -height [expr int($hi)]"
        after 0 update
      } else {set hi -}
    }
    global SHOW
    set SHOW "$wid x $hi"
  } elseif {$pp_shape($b) == "blt_table"} {set SHOW blt_table} 
}

proc set_size {b wid hi} {
  global stretchX stretchY pp_shape FreezeX FreezeY
  if {$pp_shape($b) == "place"} {
    set c [winfo parent $b]
    if {$FreezeX == 0} {
      if {$stretchX($b)} {
        set wid [expr $wid.0 / [my_winfo width $c]]
        set wid [gridify $wid]
        if {$wid < 0.01} {set wid 0.01}
        catch "place $b -wid 0"
        catch "place $b -relwid $wid"
      } else {
        set wid [gridify $wid]
        if {$wid < 4} {set wid 4}
        catch "place $b -relwid 0"
        catch "place $b -wid $wid"
      }
    } else {set wid [get_place $b -relwidth -width]}
    if {$FreezeY == 0} {
      if {$stretchY($b)} {
        set hi [expr $hi.0 / [my_winfo height $c]]
        set hi [gridify $hi]
        if {$hi < 0.01} {set hi 0.01}
        catch "place $b -height 0"
        catch "place $b -relheight $hi"
      } else {
        set hi [gridify $hi]
        if {$hi < 4} {set hi 4}
        catch "place $b -relheight 0"
        catch "place $b -height $hi"
      }
    } else {set hi [get_place $b -relheight -height]}
    global SHOW
    set SHOW "$wid x $hi"
  } elseif {$pp_shape($b) == "pack"} {
    set SHOW Packed
  } elseif {$pp_shape($b) == "blt_table"} {set SHOW blt_table
  } elseif {$pp_shape($b) == "align"} {set SHOW align}
}

proc itemResize {b x y} {
    global lastX lastY pp_shape Can_Resize SHOW
    if {$Can_Resize == 0} return
    if {$pp_shape($b) == "place"} {
      if {$Can_Resize == 0} return
      set c [winfo parent $b]
      #set lastX [winfo rootx $b]
      #set lastY [winfo rooty $b]
      #echo $lastX $lastY 
      if {[get_anchor $b] == "nw"} {
        set wid [expr $x-$lastX]
        set hi [expr $y-$lastY]
      }
      if {[get_anchor $b] == "ne"} {
        set wid [expr $lastX-$x]
        set hi [expr $y-$lastY]
      }
      if {[get_anchor $b] == "se"} {
        set wid [expr $lastX-$x]
        set hi [expr $lastY-$y]
      }
      if {[get_anchor $b] == "sw"} {
        set wid [expr $x-$lastX]
        set hi [expr $lastY-$y]
      }
      set_size $b $wid $hi
    } elseif {$pp_shape($b) == "blt_table"} {set SHOW blt_table
    } elseif {$pp_shape($b) == "align" || $pp_shape($b) == "pack"} {
      if {$Can_Resize == 0} return
      set c [winfo parent $b]
      #set lastX [winfo rootx $b]
      #set lastY [winfo rooty $b]
      #echo $lastX $lastY 
      if {$pp_shape($b) == "align"} {set anc [get_anchor $b]
      } else {set anc nw}
      if {$anc == "nw"} {
        set wid [expr $x-$lastX]
        set hi [expr $y-$lastY]
      }
      if {$anc == "ne"} {
        set wid [expr $lastX-$x]
        set hi [expr $y-$lastY]
      }
      if {$anc == "se"} {
        set wid [expr $lastX-$x]
        set hi [expr $lastY-$y]
      }
      if {$anc == "sw"} {
        set wid [expr $x-$lastX]
        set hi [expr $lastY-$y]
      }
      set_wid_hi $b $wid $hi
    }
}


proc round {x} {
  return [expr round($x)]
}

proc gridify {x} {
  global snap grid
  if {$snap == 0} {return $x}
  if {$x < 1} {
    set g [expr $grid*10]
    set x [expr $x * $g]
    set x [round $x]
    set x [expr $x.0 / $g]
    return $x
  } else {
    set g [expr $grid*10]
# Bad to use 400.0 but I don't know the window size!
    set x [expr $x / 400.0]
    set x [expr $x * $g]
    set x [round $x]
    set x [expr $x.0 / $g]
    set x [expr $x * 400.0]
    return $x
  }
}
 

proc itemStartDrag {b x y} {
    catch "destroy .showfeedback"
    menu .showfeedback
    set SHOW ""
    label .showfeedback.l -width 16 -anchor w -textvariable SHOW \
      -relief groove -fg white -bg gray30
    pack .showfeedback.l
    .showfeedback post 0 0
    global lastX lastY
    set lastX [expr $x - [my_winfo x $b]]
    set lastY [expr $y - [my_winfo y $b]]
}

proc set_position {b x y} {
    global moveX moveY pp_shape SHOW
    set c [winfo parent $b]
    if {$pp_shape($b) == "place" || $pp_shape($b) == "align"} {
      if {$moveX($b)} {
        set x [expr $x.0 / [my_winfo width $c]]
        set x [gridify $x]
        catch "place $b -x 0"
        catch "place $b -relx $x"
      } else {
        set x [gridify $x]
        catch "place $b -relx 0"
        catch "place $b -x $x"
      }
      if {$moveY($b)} {
      set y [expr $y.0 / [my_winfo height $c]]
        set y [gridify $y]
        catch "place $b -y 0"
        catch "place $b -rely $y"
      } else {
        set y [gridify $y]
        catch "place $b -rely 0"
        catch "place $b -y $y"
      }
      set SHOW "($x , $y)"
    } elseif {$pp_shape($b) == "pack"} {
      set SHOW Packed
    } elseif {$pp_shape($b) == "blt_table"} {
      set SHOW blt_table
    }
}

proc itemDrag {b x y} {
    global lastX lastY
    global moveX moveY
    set x [expr $x-$lastX]
    set y [expr $y-$lastY]
    set_position $b $x $y
}

proc create_new_toplevel {{name ""}} {
  global top_count stretchX stretchY pp_shape 
  global Topgeom Toppos Topstate Topborder Defaults
  set top $name
  if {$name == ""} {set top .top$top_count}
  catch "destroy $top"
  set Topgeom($top) 1
  set Toppos($top) 0
  set Topstate($top) normal
  set Topborder($top) 1
  toplevel $top
  for_array_keys k Defaults {
    catch "$top config -$k $Defaults($k)"
  }
  raise $top
  set x [expr 15+[expr $top_count*10]]
  set y [expr 40+[expr $top_count*10]]
  wm geometry $top 400x400+$x+$y
  wm minsize $top 10 10
  set top_count [expr $top_count+1]
  bind $top <Enter> "global top\nset top $top"
  #bind $top <1> "global Type\nadd_widget \$top \$Type %x %y"
  bind $top <Shift-3> "edit_widget Toplevel $top %X %Y"
  bind $top <Control-3> "rename_w $top \"\" 0"
  set stretchX($top) 1
  set stretchY($top) 1
  set pp_shape($top) place
  show_widget_tree
  return $top
}

proc update_scrollbars {par sb} {
  set ch [winfo child $par]
  if {$sb == ""} {
    foreach W $ch {
      set type [winfo class $W]
      if { $type == "Entry" || $type == "Canvas" || $type == "Listbox" || $type == "Text"} {
        catch "$W configure -yscrollcommand \"\""
        catch "$W configure -xscrollcommand \"\""
        catch "$W configure -scrollcommand \"\""
      }
    }
    foreach W $ch {
      set type [winfo class $W]
      if {$type == "Scrollbar"} {
        update_scrollbars $par $W
      }
      if {$type == "Frame"} {
        update_scrollbars $W $sb
      }
      if {$type == "Toplevel"} {
        update_scrollbars $W $sb
      }
    }
  } else {
    set attached 0
    foreach W $ch {
      set type [winfo class $W]
      eval "set orient [get_widget_value $sb orient]"
      if { $type == "Text" || $type == "Canvas" || $type == "Listbox" } {
        if {$orient == "vertical"} {
          $W configure -yscrollcommand "$sb set"
          $sb configure -command "$W yview"
          set attached 1
        }
        if {$orient == "horizontal"} {
          $W configure -xscrollcommand "$sb set"
          $sb configure -command "$W xview"
          set attached 1
        }
      }
      if {$type == "Entry"} {
        if {$orient == "horizontal"} {
          $W configure -scrollcommand "$sb set"
          $sb configure -command "$W xview" 
          set attached 1
        }
      }
    }
    if {$attached==0} {
      foreach W $ch {update_scrollbars $W $sb}
    }
  }
} 

set comp_count 0
proc unique2 w {
  global comp_count
  if {[winfo exists $w] == 0} {return $w}
  while 1 {
    if [winfo exists $w$comp_count] {incr comp_count
    } else { return $w$comp_count}
  }
}

proc unique w {
  global widget_count
  while 1 {
    if [winfo exists $w$widget_count] {incr widget_count
    } else { return $w$widget_count}
  }
}

proc add_widget {top type x y {newname ""} args} {
  global widget_count Defaults
  global tag_count
  global stretchX stretchY moveX moveY pp_shape 

  set x [expr $x-[get_widget_value $top borderwidth]]
  set y [expr $y-[get_widget_value $top borderwidth]]

  if {$type == "none" || $type == "comp"} { 
    echo Select a type first.
    return
  }
  if {$type == "canvas"} {
    set W [unique $top.c]
    if {$newname != ""} {set W $top$newname}
    canvas $W -relief groove -width 40 -height 40 -scrollregion {0c 0c 10c 10c}
    #$W create text 1m 1m -text "Hello" -anchor nw
  } elseif {$type == "listbox"} {
    set W [unique $top.lb]
    if {$newname != ""} {set W $top$newname}
    listbox $W -relief sunken
    $W insert end item1
    $W insert end item2
  } elseif {$type == "scrollbar"} {
    set W [unique $top.sb]
    if {$newname != ""} {set W $top$newname}
    scrollbar $W
    update_scrollbars $top ""
  } elseif {$type == "button"} {
    set W [unique $top.b]
    if {$newname != ""} {set W $top$newname}
    button $W -text button$widget_count 
  } elseif {$type == "message"} {
    set W [unique $top.mg]
    if {$newname != ""} {set W $top$newname}
    message $W -text message$widget_count 
  } elseif {$type == "checkbutton"} {
    set W [unique $top.b]
    if {$newname != ""} {set W $top$newname}
    checkbutton $W -text button$widget_count -width 8 
  } elseif {$type == "radiobutton"} {
    set W [unique $top.b]
    if {$newname != ""} {set W $top$newname}
    radiobutton $W -text button$widget_count -width 8 
  } elseif {$type == "frame"} {
    set W [unique $top.f]
    if {$newname != ""} {set W $top$newname}
    frame $W -borderwidth 2 -relief raised -width 50 -height 50
    #bind $W <1> "add_widget $W \$Type %x %y"
  } elseif {$type == "label"} {
    set W [unique $top.l]
    if {$newname != ""} {set W $top$newname}
    label $W -text label$widget_count
  } elseif {$type == "entry"} {
    set W [unique $top.e]
    if {$newname != ""} {set W $top$newname}
    entry $W -relief sunken
  } elseif {$type == "text"} {
    set W [unique $top.t]
    if {$newname != ""} {set W $top$newname}
    text $W -relief sunken -width 10 -height 5 -borderwidth 3
  } elseif {$type == "menubutton"} {
    set W [unique $top.m]
    if {$newname != ""} {set W $top$newname}
    menubutton $W -text menu$widget_count -relief raised -menu $W.m
    global Menu_string
    global menu_string
    set Menu_string($W) "$menu_string"
    eval "make_menu $W $Menu_string($W)"
  } elseif {$type == "scale"} {
    set W [unique $top.s]
    if {$newname != ""} {set W $top$newname}
    scale $W -relief sunken
  } else {
    set W [unique $top.o]    ;# other
    if [catch "[string tolower $type] $W"] {
      while {[llength $args] == 1} {set args [lindex $args 0]}
      eval "$type $W $args"
    }
  }
  set stretchX($W) $Defaults(stretchX)
  set stretchY($W) $Defaults(stretchY)
  set moveX($W) $Defaults(moveX)
  set moveY($W) $Defaults(moveY)
  set pp_shape($W) $Defaults(pp_shape)
  if {[winfo class $top]=="Text"} {
    set pp_shape($W) Text
    $top window create @$x,$y -window $W
  }
  if {$pp_shape($W) == "place"} {place $W -x $x -y $y
  } elseif {$pp_shape($W) == "pack"} {pack $W
  } elseif {$pp_shape($W) == "blt_table"} {
    if {[is_gui_widget [winfo toplevel $top]]} {place $W -x $x -y $y} else {
    blt_table [winfo parent $W] $W [get_free_index [winfo parent $W]]}
  } elseif {$pp_shape($W) == "align"} {
    if {[is_gui_widget [winfo toplevel $top]]} {place $W -x $x -y $y} else {
    align $W}
  }
  for_array_keys k Defaults {
    catch "$W config -$k $Defaults($k)"
  }
  update; 
  new_place $top $W $x $y
  bind_widget $W
  incr tag_count 
  incr widget_count 
  update_scrollbars . ""
  show_widget_tree
  return $W
}

proc tk4 {args} {
  global tk_version
  if {$tk_version >= 4} {
    uplevel 1 $args
  }
}

proc edit_post {} {
  global current
  catch "destroy .edit"
  create_edit_menu
  .edit post [winfo rootx $current] [expr [winfo rooty $current]+[winfo height $current]]
}

proc create_edit_menu {} {
  global current Mx My
  catch "destroy .edit"
  menu .edit -activeback gray90
  .edit add command -label "Configure <Shift-3>" -command {
    global current Mx My
    grab release .edit
    .edit unpost
    edit_widget [get_type $current] $current $Mx $My
  }
  .edit add command -label "Configure Options" -command {
    global current Mx My
    grab release .edit
    .edit unpost
    Configure . $current
  }
  .edit add command -label "Procedures/Bindings" -command {
    global current Mx My
    grab release .edit
    .edit unpost
    proc_edit $current
  }
  .edit add command -label "Edit Colors" -command {
    global current Mx My
    grab release .edit
    .edit unpost
    wm deicon .colors
  }
  .edit add command -label "Delete    <Delete-3>" -command {
    global current
    grab release .edit
    .edit unpost
    delete_widget $current 
  }
  .edit add command -label "Duplicate <Ctrl-3>" -command {
    global current Mx My
    set x [expr $Mx-[winfo rootx $current]]
    set y [expr $My-[winfo rooty $current]]
    grab release .edit
    .edit unpost
    duplicate $current $x $y
  }
  .edit add command -label "Raise" -command {
    global current
    grab release .edit
    .edit unpost
    my_raise $current 
  }
  set F1 F1
  global env
  if {[isset env(GUI_SELECT)]} {set F1 $env(GUI_SELECT)}
  .edit add command -label "Toggle Select <$F1>" -command {
    global current
    grab release .edit
    .edit unpost
    toggle_select $current 
  }
  .edit add command -label "Select all children" -command {
    global current
    grab release .edit
    .edit unpost
    select_all_children $current 
  }
  .edit add command -label "Unselect all children" -command {
    global current
    grab release .edit
    .edit unpost
    unselect_all_children $current 
  }
  .edit add command -label "Save as Composite" -command {
    global current
    grab release .edit
    .edit unpost
    save_comp $current 
  }
  catch "Add_Class_Commands .edit $current"
  set Bind [bind Menu <Any-Motion>]
  bind .edit <Any-Motion> "$Bind;mouse_update %X %Y"
  bind .edit <1> {
    global Mx My
    set w [winfo containing $Mx $My]
    if {"$w" != ".edit"} {
      grab release .edit
      .edit unpost
    }
  }
}

#create_edit_menu

proc set_name {w} {
  set p [winfo parent $w]
  eval "$w config -text \"[$p.rename_it get]\""
  grab release $p.rename_it
  destroy $p.rename_it
}

proc handle_backspace {w} {
  if {[catch {$w delete sel.first sel.last}]} {
    set pos [expr [$w index insert]-1]
    $w delete $pos [expr $pos+1]
  }
}

proc edit_name {w} {
  if [catch "$w cget -text"] return
  set p [winfo parent $w]
  catch "destroy $p.rename_it"
  set name [$w cget -text]
  entry $p.rename_it -width 0 -borderwidth 2
  pack $p.rename_it -expand 1 -padx 3 -pady 3 -in $w
  $p.rename_it insert end $name
  bindtags $p.rename_it "$p.rename_it Entry"
  bind $p.rename_it <Return> "set_name $w"
  focus $p.rename_it
  update
  grab $p.rename_it
}

proc toggle_allow_edit {} {
  global allow_edit
  foreach w [make_widget_list] {
    if {[winfo class $w] == "Text" || [winfo class $w] == "Entry"} {
      if {$allow_edit} {
        bindtags $w "$w [winfo class $w] all"
      } else {
        bindtags $w "$w [winfo class $w] all Markers"
      }
    }
  }
}

proc bind_widget {w} {
  global current
  global tk_version
  set type [get_type $w]
  tk4 bindtags $w "$w [winfo class $w] all Markers"
  set break ""
  if {$tk_version >= 4} {
    set break break
  }
  set F1 F1
  global env
  if {[isset env(GUI_SELECT)]} {set F1 $env(GUI_SELECT)}
  bind Markers <Any-$F1> "toggle_select %W;$break"
  bind Markers <3> "itemStartDrag %W %X %Y;$break"
  bind Markers <B3-Motion> "itemDrag %W %X %Y;$break"
  bind Markers <2> "itemStartResize %W %X %Y;$break"
  bind Markers <B2-Motion> "itemResize %W %X %Y;$break"
  bind Markers <ButtonRelease-2> "itemDoneResize %W;$break"
  bind Markers <Shift-3> "edit_widget $type %W %X %Y;$break"
  bind Markers <Shift-1> "set current %W;edit_post;grab -global .edit;$break"
  bind Markers <Control-3> "duplicate %W %x %y;$break"
  bind Markers <Any-Enter> "+focus %W;$break"
  bind Markers <Double-1> "after 100 edit_name %W"
  bind Markers <B3-Delete> "delete_widget %W;$break"
  bind Markers <Key-1> "toggle_select %W 1;$break"
  bind Markers <Key-2> "toggle_select %W 2;$break"
  bind Markers <Key-3> "toggle_select %W 3;$break"
  bind Markers <Key-4> "toggle_select %W 4;$break"
  bind Markers <Key-5> "toggle_select %W 5;$break"
  bind Markers <Key-6> "toggle_select %W 6;$break"
  bind Markers <Key-7> "toggle_select %W 7;$break"
  bind Markers <Key-8> "toggle_select %W 8;$break"
  bind Markers <Key-9> "toggle_select %W 9;$break"
  for {set i a} {[ord $i] <= [ord z]} {set i [char [expr [ord $i]+1]]} {
    bind Markers <Key-$i> "toggle_select %W $i;$break"
  } 
  for {set i A} {[ord $i] <= [ord Z]} {set i [char [expr [ord $i]+1]]} {
    bind Markers <Key-$i> "toggle_select %W $i;$break"
  } 

}

proc new_place {par w x y} {
  set_position $w $x $y
  #set_size $w [winfo width $w] [winfo height $w]
}


proc delete_widget {w} {
  global selected
  foreach ch [winfo child $w] {
    if {[winfo exist $ch] == 0} continue
    if [string match "sel*" [winfo name $ch]] continue
    delete_widget $ch
  }
  echo deleted $w
  catch "unset selected($w)"
  set p [winfo parent $w]
  set n [winfo name $w]
  catch "destroy $p.sel$n"
  catch "destroy .gui_edit$n"
  catch "destroy $w"
  update_scrollbars . "" 
  show_widget_tree
}

proc set_from_to {w e ft} {
  set val [$e get]
  catch "$w configure -$ft $val"
}

proc set_command {w e} {
  set val [$e get]
  if ![is_gui_widget $w] {str_rep val %W $w}
  if {[llength $val] != 1} {set val "\{$val\}"}
  catch "$w configure -command $val"
}

proc set_text {w e} {
  set val [$e get]
  if {[llength $val] != 1} {set val "\{$val\}"}
  catch "wm title $w $val"
  set A [catch "$w configure -label $val"]
  if {$A == 1} {catch "$w configure -text $val"}
}

proc space2_ {n} {
  set new ""
  for {i=0} {$i<[string length $n]} {i++} {
    if {[csubstr $n $i $i] == " "} {set c _} else {set c [csubstr $n $i $i]}
    append new $c
  }
  return $new
}

proc my_entry {e name wid val b args} {
  set name2 [space2_ $name]
  catch "destroy $e.f$name2"
  frame $e.f$name2
  set E $e.f$name2.e
  set L $e.f$name2.l
  label $L -text $name -width $wid -anchor w
  entry $E -relief sunken 
  $E insert 0 $val
  #bind $E <Leave> "$b"
  #eval "bind $E <Enter> $args"
  bind $E <Return> "$b"
  pack $L -fill x -side left
  pack $E -fill x -side left -expand 1
  return $e.f$name2
}

proc color_menu {m w op} {
  global colors
  foreach c $colors {
    $m add command -label $c -command "configure $w -$op $c" -background $c
  }
}

proc my_winfo {val w} {
  set list {x y rootx rooty}
  if {[lsearch -exact $list $val] == -1} {
    set bw [get_widget_value $w borderwidth]
    set bw [expr 2 * $bw]
  } else {
    set bw [get_widget_value [winfo parent $w] borderwidth]
  }
  return [expr [winfo $val $w]-$bw]
}

proc unselect_all {{m ""}} {
  global selected
  for_array_keys s selected {
    if {$m == "" || $m==$selected($s)} {
      catch "destroy [winfo parent $s].sel[winfo name $s]"
      unset selected($s)
    }
  }
  show_widget_tree
}

proc select_all {} {
  unselect_all
  foreach w [make_widget_list] {
    toggle_select $w 1
  }
}


proc marker_used {m} {
  global selected
  set found 0
  for_array_keys s selected {
    if {$selected($s) == $m} {set found 1;set mark $m}
    if $found {return $mark}
  }
  if $found {return $mark}
  return 0
}


proc get_free_marker {} {
  for {i=1} {$i<10} {i++} {
    if [marker_used $i] { continue
    } else {
      return $i
    }
  }
  return 0
}

proc sel_rem {m} {
  global selected
  if {$m==0} {
    error "No free markers!"
  }
  if ![winfo exists .select_cmd$m] {
    error "Bad marker name $m"
  }
  foreach w [make_widget_list] {
    if {![isset selected($w)] || $selected($w) == 0} {
      toggle_select $w $m
    } 
  }
}

proc select_remain {auto} {
  global selected
  if $auto {
    set m [get_free_marker]
    sel_rem $m
  } else {
    global Mx My
    catch "destroy .selremain"
    toplevel .selremain 
    wm title .selremain {Mark Remaining As}
    wm geometry .selremain +$Mx+$My
    wm minsize .selremain 10 10
    button .selremain.b11
    .selremain.b11 configure -command {destroy .selremain} -text Cancel
    pack .selremain.b11 -in .selremain -anchor sw -expand 1 -fill x -side bottom
    label .selremain.l
    .selremain.l configure  -text {Marker Name:}
    pack .selremain.l -in .selremain -anchor nw -side left
    entry .selremain.e
    .selremain.e configure -relief sunken
    pack .selremain.e -in .selremain -anchor nw -expand 1 -fill x -side left
    bind .selremain.e <Return> "sel_rem \[%W get\];destroy .selremain"
  }
}

proc unsel_mark {w} {
  set m [$w get]
  unselect_all $m
}

proc unselect_marker {} {
  global Mx My
  catch "destroy .selunmark"
  toplevel .selunmark  
  wm title .selunmark {Unmark}
  wm geometry .selunmark +$Mx+$My
  wm minsize .selunmark 10 10
  button .selunmark.b11
  .selunmark.b11 configure -command {destroy .selunmark} -text Cancel
  pack .selunmark.b11 -in .selunmark -anchor sw -expand 1 -fill x -side bottom
  label .selunmark.l
  .selunmark.l configure  -text {Marker Name:}
  pack .selunmark.l -in .selunmark -anchor nw -side left
  entry .selunmark.e
  .selunmark.e configure -relief sunken
  pack .selunmark.e -in .selunmark -anchor nw -expand 1 -fill x -side left
  bind .selunmark.e <Return> "unsel_mark %W;destroy .selunmark"
}

proc del_mark {{m ""}} {
  global selected
  for_array_keys s selected {
    if {$m == "" || $m==$selected($s)} {
      catch "destroy [winfo parent $s].sel[winfo name $s]"
      catch "destroy $s"
      unset selected($s)
    }
  }
  show_widget_tree
}

proc del_by_mark {w} {
  global selected 
  set m [$w get]
  del_mark $m
}

proc delete_by_marker {} {
  global Mx My
  catch "destroy .delbymark"
  toplevel .delbymark
  wm title .delbymark {Delete By Marker}
  wm geometry .delbymark +$Mx+$My
  wm minsize .delbymark 10 10
  button .delbymark.b11
  .delbymark.b11 configure -command {destroy .delbymark} -text Cancel
  pack .delbymark.b11 -in .delbymark -anchor sw -expand 1 -fill x -side bottom
  label .delbymark.l
  .delbymark.l configure  -text {Marker Name:}
  pack .delbymark.l -in .delbymark -anchor nw -side left
  entry .delbymark.e
  .delbymark.e configure -relief sunken
  pack .delbymark.e -in .delbymark -anchor nw -expand 1 -fill x -side left
  bind .delbymark.e <Return> "del_by_mark %W;destroy .delbymark"
}


proc change_mark {from to} {
  global selected
  set f [$from get]
  set t [$to get]
  if {$t==$f} return
  if ![winfo exists .select_cmd$t] {
    error "Bad marker name $t"
  }
  if ![winfo exists .select_cmd$f] {
    error "Bad marker name $f"
  }
  for_array_keys s selected {
    if {$selected($s)==$f} {toggle_select $s $t}
  }
  $from delete 0 end
  $from insert end $t
}

proc change_marker {} {
  global Mx My
  catch "destroy .selchange"
  toplevel .selchange  
  wm title .selchange {Change Marker}
  wm geometry .selchange +$Mx+$My

  frame .selchange.f9
  .selchange.f9 configure -borderwidth 2 -height 50 -relief flat -width 50
  pack .selchange.f9 -anchor nw -fill x 
#------------------------------------------
  label .selchange.f9.from
  .selchange.f9.from configure -anchor w -text From: -width 5
  pack .selchange.f9.from -anchor center -fill x -side left
#------------------------------------------
  entry .selchange.f9.e15
  .selchange.f9.e15 configure -relief sunken
  pack .selchange.f9.e15 -anchor center -expand 1 -fill x -side left
#------------------------------------------
  frame .selchange.f10
  .selchange.f10 configure  -borderwidth 2 -height 50 -relief flat -width 50
  pack .selchange.f10 -anchor nw -fill x 
#------------------------------------------
  label .selchange.f10.to
  .selchange.f10.to configure  -anchor w -text To: -width 5
  pack .selchange.f10.to -anchor center -fill x -side left
#------------------------------------------
  entry .selchange.f10.e16
  .selchange.f10.e16 configure -relief sunken
  pack .selchange.f10.e16 -anchor center -expand 1 -fill x -side left
#------------------------------------------
  button .selchange.cancel
  .selchange.cancel configure -command {destroy .selchange} -text Cancel
  pack .selchange.cancel -anchor nw -fill x

  bind .selchange.f9.e15 <Return> {
    change_mark .selchange.f9.e15 .selchange.f10.e16;
  }
  bind .selchange.f10.e16 <Return> {
    change_mark .selchange.f9.e15 .selchange.f10.e16;
  }
}

proc select_all_children {p} {
  global selected
  set m [get_free_marker]
  foreach c [winfo child $p] {
    if [is_gui_widget $c] continue
    if {[isset selected($c)] == 0 || $selected($c) != $m} {
      toggle_select $c $m
    }
  }
}

proc unselect_all_children {p} {
  global selected
  set m [get_free_marker]
  foreach c [winfo child $p] {
    if [is_gui_widget $c] continue
    if {[isset selected($c)] != 0 && $selected($c) != 0} {
      toggle_select $c $selected($c)
    }
  }
}

proc update_shape {w marker} {
  global selected stretchX stretchY moveX moveY pp_shape snap 
  if [is_gui_widget $w] {
    scan $w ".select_cmd%d" cur_sel
    for_array_keys s selected {
      if {$selected($s)!=$cur_sel} continue
      set stretchX($s) $stretchX(.select_cmd$marker)
      set stretchY($s) $stretchY(.select_cmd$marker)
      set moveX($s) $moveX(.select_cmd$marker)
      set moveY($s) $moveY(.select_cmd$marker)
      if {"$pp_shape($s)" != "$pp_shape(.select_cmd$marker)"} {
        set pp_shape($s) $pp_shape(.select_cmd$marker)
        use_shape $s $pp_shape($s) $marker
      }
      set oldSnap $snap
      set snap 0
      #echo CALLED SET_SIZE
      set_size $s [winfo wid $s] [winfo height $s]
      set_position $s [my_winfo x $s] [my_winfo y $s]
      #echo [winfo wid $s] 
      #echo [place info $s]
      set snap $oldSnap
    }
  }
}

proc apply_entries {w} {
  if {[winfo class $w]=="Entry"} {
    set Bind [bind $w <Return>]
    str_rep Bind %W $w
    eval $Bind
  }
  foreach ch [winfo child $w] {apply_entries $ch}
}

proc done_edit {e w d marker} {
  global Menu_string
  global selected stretchX stretchY moveX moveY pp_shape 
  if ![is_gui_widget $w] {apply_entries $e}
  if { [winfo exists $e.textframe.t] } {
    set str [$e.textframe.t get 0.0 end]
    eval "make_menu $w $str"
    set Menu_string($w) $str
  }
  #set_size $w [winfo width $w] [winfo height $w]
  #set_position $w [my_winfo x $w] [my_winfo y $w]
  if {$d} {catch "destroy $e"
  } else {
    update_shape $w $marker
    if [is_gui_widget $w] {
      for_array_keys s selected {
        if {$selected($s) == $marker} {copy_attributes .select_cmd$marker $s}
      }
    }
  }
  set w [lindex [place slave $w] 0]
  if {$w != ""} {
    if ![is_gui_widget $w] {place $w -in [winfo parent $w]}
  }
}

proc my_raise {w} {
  global selected pp_shape tk_version 
  catch "wm deicon $w"
  raise $w
  if {[isset selected($w)]==1 && $selected($w)!=0} {
    raise [winfo parent $w].sel[winfo name $w]
  }
  if {$pp_shape($w) == "pack"} {
    if {$tk_version>=4} {
      set info [pack info $w]
    } else {
      set info [pack newinfo $w]
    } 
    pack forget $w
    eval "pack $w $info"
  }
  show_widget_tree
}

proc paste {w} {
  set is_sel [catch "selection get"]
  if { $is_sel == 0 } {
    set sel [selection get]
    $w insert insert $sel
  }
}

proc get_config {w name wid} {
  set val [get_widget_value $w [csubstr $name 1 end]]
  $wid delete 0 end
  if {[llength $val] != 1} {set val "\{$val\}"}
  $wid insert 0 $val
}

set num_images 0
proc set_config {w name wid is_gw} {
  global images num_images
  set val [$wid get]
  if {$name == "-image" && [string length $val] > 0} {
    image create photo $val -file $val
    set images($num_images) $val
    incr num_images
  }
  if {[llength $val] != 1} {set val "\{$val\}"}
  set A [catch "$w config $name $val"]
  if {$A == 1 && $is_gw == 0} { 
    get_config $w $name $wid 
  }
}

proc set_entry {w name item e is_gw} {
  $e delete 0 end
  $e insert 0 $item
  set_config $w $name $e $is_gw
}

proc Attributes {w} {
  eval [get_type $w] $w-tmp
  set list {}
  foreach a [$w config] {
    set len [expr [llength $a] - 1]
    if {$len != 1} {
      set name [lindex $a 0]
      if {$name == "-menu"} continue
      set val [lindex $a $len]
      set val2 [lindex $a [expr $len - 1]]
      if { $val == $val2 } continue
      set val2 [get_widget_value $w-tmp  [csubstr $name 1 end]]
      if { $val == $val2 } continue
      lappend list [csubstr $name 1 end]
    }
  }
  destroy $w-tmp
  return $list
}

proc Configure {e w} {
  global colors cur_sel selected
  eval "set options { 
    {-bitmap @gui.xbm info error gray25 gray50 hourglass questhead question warning}
    {-anchor n e w s ne nw se sw c}
    {-justify right left center}
    {-cursor xterm hand1 hand2 arrow}
    {-state normal active disabled}
    {-orient horizontal vertical}
    {-showvalue 0 1}
    {-sliderforeground $colors}
    {-activebackground $colors}
    {-activeforeground $colors}
    {-background $colors}
    {-foreground $colors}
    {-insertbackground $colors}
    {-insertforeground $colors}
    {-selectbackground $colors}
    {-selectforeground $colors}
    {-disabledforeground $colors}
    {-disabledbackground $colors}
    {-selector $colors}
  }"
  set nlist {-text -label -command -relief -padx -pady -width -height -geometry}
  set nlist {}
  set n [winfo name $w]
  set CG .config_$n
  catch "destroy $CG"
  toplevel $CG
  global Mx My
  wm geom $CG +$Mx+$My
  wm minsize $CG 10 10
  label $CG.l -text "Use Right Button for Menu." -relief groove
  pack $CG.l -fill x
  frame $CG.fr
  pack $CG.fr
  set CT $CG.fr.t
  text $CT -yscrollcommand "$CG.fr.sb set" -width 50 -state disabled
  pack $CT -fill y -expand 1 -side left
  scrollbar $CG.fr.sb -orient vert -command "$CT yview"
  pack $CG.fr.sb -side right -fill y

  set is_gw [is_gui_widget $w]
  set config_list [$w config]
  if $is_gw {
    for_array_keys sel selected {
      if {$selected($sel)==$cur_sel} {
        set sel_list [$sel config]
        foreach sl $sel_list {
          set ix [string first [lindex $sl 0] $config_list]
          if {$ix == -1} {
            lappend config_list $sl
          }
        }
      }
    }
  }

  foreach a $config_list {
    set len [expr [llength $a] - 1]
    if {$len != 1} {
      set name [lindex $a 0]
      if { [lsearch -exact $nlist $name] < 0} {
        set val [lindex $a $len]
        set val2 [lindex $a [expr $len - 1]]
        set F [my_entry $CT $name 20 $val "set_config $w $name %W $is_gw" "get_config $w $name %W"]
        foreach op $options {
          set opt [lindex $op 0]
          if { $opt == $name } {
            catch "destroy $CT.m$name"
            menu $CT.m$name
            lvarpop op
            foreach item $op {
              $CT.m$name add command -label $item -command "set_entry $w $name $item $F.e $is_gw"
            }
            bind $F.e <3> "$CT.m$name post %X %Y\nfocus $CT.m$name"
            bind $CT.m$name <Leave> "%W unpost"
            #bind $F.e <ButtonRelease-3> "$CT.m$name unpost"
          }
        }
        $CT window create end -window $F
      }
    }
  }
  button $CG.cancel -text Done -command "
    if ![is_gui_widget $w] {apply_entries $CG}
    destroy $CG
  "
  pack $CG.cancel -fill x -side bottom
}

proc spack {w pad e v} {
  sel_pack $w $pad $v
  $e delete 0 end
  $e insert end $v
}

proc new_max {s e} {
  set v [$e get]
  $s config -to $v
  $s set $v
}

proc get_free_index {w} {
  if [catch "blt_table slaves $w"] {return 0,0}
  echo [blt_table row $w dim],[blt_table col $w dim]
  for {set c 0} {$c < 100000} {incr c} {
    for {set r 0} {$r < [blt_table row $w dim]} {incr r} {
      if [is_free $r,$c $w] {return $r,$c}
    }
  }
}

proc is_free {i t} {
  #echo [blt_table slaves $t]
  foreach e [blt_table slaves $t] {
    set I [lindex [blt_table info $e] 1]
    if {$i==$I} {return 0}
  }
  return 1
}

proc set_rows {w m r} {
  global selected
  if [is_gui_widget $w] {
    for_array_keys s selected {
      if {$selected($s) == $m} {
        set_rows $s $m $r
      }
    }
    return
  }
  set p [winfo parent $w]  
  if {[catch "blt_table info $w"]==0} {
    set c [blt_table info $w]
    set c [lindex $c 1]
    scan $c "%d,%d" a c
  } else {set c 0}
  echo $w $r,$c is [is_free $r,$c $p]
  if [is_free $r,$c $p] {blt_table $p $w $r,$c}
}

proc set_cols {w m c} {
  global selected
  if [is_gui_widget $w] {
    for_array_keys s selected {
      if {$selected($s) == $m} {
        set_cols $s $m $c
      }
    }
    return
  }
  if {[catch "blt_table info $w"]==0} {
    set p [winfo parent $w] 
    set r [blt_table info $w]
    set r [lindex $r 1]
  } else {set r 0}
  scan $r "%d,%d" r a
  if [is_free $r,$c $p] {blt_table $p $w $r,$c}
}

proc edit_widget {type w x y} {
  global cur_sel
  set n [winfo name $w]
  set EB .gui_edit$n
  catch "destroy $EB"
  toplevel $EB
  if {[is_gui_widget $w]} {
    wm title $EB "Marker $cur_sel"
  } else {wm title $EB $w}
  wm minsize $EB 10 10
  set x [expr {$x+100}]
  wm geometry $EB +$x+$y
  frame $EB.mb
  set marker $cur_sel
  button $EB.mb.edit_col -text "Edit Colors" -command "
    global current
    set current $w
    wm deicon .colors
  "
  menubutton $EB.mb.fg -text "Foreground" -menu $EB.mb.fg.m -relief raised
  menu $EB.mb.fg.m 
  color_menu $EB.mb.fg.m $w fg

  menubutton $EB.mb.bg -text "Background" -menu $EB.mb.bg.m -relief raised
  menu $EB.mb.bg.m 
  color_menu $EB.mb.bg.m $w bg

  menubutton $EB.mb.afg -text "Active FG" -menu $EB.mb.afg.m -relief raised
  menu $EB.mb.afg.m 
  color_menu $EB.mb.afg.m $w activefore

  menubutton $EB.mb.abg -text "Active BG" -menu $EB.mb.abg.m -relief raised
  menu $EB.mb.abg.m 
  color_menu $EB.mb.abg.m $w activeback

  tk_menuBar $EB.mb $EB.mb.fg $EB.mb.bg $EB.mb.afg $EB.mb.abg
  pack $EB.mb.edit_col -side left -fill x -expand 1
  pack $EB.mb.fg -side left -fill x -expand 1
  pack $EB.mb.bg -side left -fill x -expand 1
  pack $EB.mb.afg -side left -fill x -expand 1
  pack $EB.mb.abg -side left -fill x -expand 1
  pack $EB.mb -fill x -expand 1

  button $EB.done -text Done -command "done_edit $EB $w 1 $marker"
  button $EB.apply -text Apply -command "done_edit $EB $w 0 $marker"
  button $EB.config -text "Configure Options" -command "Configure $EB $w"
  button $EB.proc -text "Edit Procedures/Bindings" -command "proc_edit $w"
  set Bind "set_text $w %W"
  if {[winfo class $w]!="Toplevel"} {
    set F [my_entry $EB Name: 13 "[get_widget_value $w text]" $Bind]
  }
  if {[winfo class $w]=="Toplevel"} {
    set F [my_entry $EB Name: 13 "[wm title $w]" $Bind]
    set FR $EB.topfr
    frame $FR
    global Topstate Topgeom Topborder
    checkbutton $FR.r1 -text "Fixed Size" -variable Topgeom($w) -command "toggle_fixed_size $w"
    checkbutton $FR.r2 -text "Fixed Position" -variable Toppos($w) 
    radiobutton $FR.r3 -text "Open" -variable Topstate($w) -value\
      "normal"
    radiobutton $FR.r4 -text "Iconified" -variable Topstate($w) -value\
      "iconic"
    radiobutton $FR.r5 -text "Withdrawn" -variable Topstate($w) -value\
      "withdrawn"
    checkbutton $FR.r6 -text "Border" -variable Topborder($w) -command "toggle_border $w"
    pack $FR.r1 $FR.r2 $FR.r3 $FR.r4 $FR.r5 $FR.r6 -fill x -expand 1 -side left
    pack $FR -fill x
  }
  pack $F -side top -expand 1 -fill x
  if [string match "sel*" [winfo name $w]] {
    set Bind "do_reparent %W $marker"
    set F $EB.pn
    frame $F
    button $F.pn -text "Parent Name:" -width 13 -command "do_grab $F.pn $F.e $marker" 
    entry $F.e -relief sunken 
    bind $F.e <Return> "$Bind"
    pack $F.pn -fill x -side left
    pack $F.e -fill x -side left -expand 1
    pack $F -side top -expand 1 -fill x
  } else {
    set Bind "do_rename $w %W"
    set F [my_entry $EB "Widget Name:" 13 "$w" $Bind]
    pack $F -side top -expand 1 -fill x
  }
  set Bind "set_command $w %W"
  pack [my_entry $EB Command: 13 "[get_widget_value $w command]" $Bind] -side top -expand 1 -fill x
  scale $EB.bw -orient horiz -from 0 -to 20 -label Borderwidth
  if ![is_gui_widget $w] {
    $EB.bw set [get_widget_value $w borderwidth]
  }
  pack $EB.bw -fill x 
  update
  $EB.bw config -command "configure $w -borderwidth"
  if [string match "sel*" [winfo name $w]] {
    button $EB.group -text group -command "group $marker"
    pack $EB.group
  }
  frame $EB.frame
  frame $EB.frame1
  frame $EB.frame4
  set R $EB.frame
  set R2 $EB.frame1
  #set R3 $EB.frame4
  pack $R -expand 1 -fill x
  if {[winfo class $w]!="Toplevel"} {pack $R2 -expand 1 -fill x}
  #pack $R3
  global pp_shape 
  radiobutton $R2.pack -text "Use Pack" -variable pp_shape($w) -value pack -command "use_shape $w pack $marker"
  radiobutton $R2.place -text "Use Place" -variable pp_shape($w) -value place -command "use_shape $w place $marker"
  radiobutton $R2.blt -text "Use Table" -variable pp_shape($w) -value blt_table -command "use_shape $w blt_table $marker"
  #radiobutton $R2.align -text "Use Align" -variable pp_shape($w) -value align -command "use_shape $w align $marker"
  pack $R2.pack -side left -fill x -expand 1
  pack $R2.place -side left -fill x -expand 1
  pack $R2.blt -side left -fill x -expand 1
  #if ![is_gui_widget $w] {pack $R2.align -side left -fill x -expand 1}
  global Relief
  set Relief($w) [get_widget_value $w relief]
  radiobutton $R.1 -text "Raised" -command "configure $w -relief raised" -value raised -variable Relief($w)
  radiobutton $R.2 -text "Sunken" -command "configure $w -relief sunken" -value sunken -variable Relief($w)
  radiobutton $R.3 -text "Flat" -command "configure $w -relief flat" -value flat -variable Relief($w)
  radiobutton $R.4 -text "Ridge" -command "configure $w -relief ridge" -value ridge -variable Relief($w)
  radiobutton $R.5 -text "Groove" -command "configure $w -relief groove" -value groove -variable Relief($w)
  pack $R.1 -side left -fill x -expand 1
  pack $R.2 -side left -fill x -expand 1
  pack $R.3 -side left -fill x -expand 1
  pack $R.4 -side left -fill x -expand 1
  pack $R.5 -side left -fill x -expand 1

  set R $EB.frame2
  set Ra $EB.frame2a.frame1
  set Rb $EB.frame2a.frame2
  set Rc $EB.frame2a.frame3
  set Rd $EB.frame2a.frame4
  frame $R
  frame $EB.frame2a
  frame $Ra
  frame $Rb 
  frame $Rc 
  frame $Rd 
  scale $Rc.s1 -label "padx" -orient horizontal -from 0 -to 20 -command "spack $w -padx $Rd.e1" -show 0
  entry $Rd.e1 -width 4 -relief sunken
  set v [pack_val $w -padx]; if {$v==""} {set v 0}
  $Rd.e1 insert 0 $v; if {$v > 20} {new_max  $Rc.s1 $Rd.e1}
  $Rc.s1 set $v
  bind $Rd.e1 <Return> "new_max $Rc.s1 $Rd.e1"
  scale $Rc.s2 -label "pady" -orient horizontal -from 0 -to 20 -command "spack $w -pady $Rd.e2" -show 0
  entry $Rd.e2 -width 4 -relief sunken
  set v [pack_val $w -pady]; if {$v==""} {set v 0}
  $Rd.e2 insert 0 $v; if {$v > 20} {new_max  $Rc.s2 $Rd.e2}
  $Rc.s2 set $v
  bind $Rd.e2 <Return> "new_max $Rc.s2 $Rd.e2"
  scale $Rc.s3 -label "ipadx" -orient horizontal -from 0 -to 20 -command "spack $w -ipadx $Rd.e3" -show 0
  entry $Rd.e3 -width 4 -relief sunken
  set v [pack_val $w -ipadx]; if {$v==""} {set v 0}
  $Rd.e3 insert 0 $v; if {$v > 20} {new_max  $Rc.s3 $Rd.e3}
  $Rc.s3 set $v
  bind $Rd.e3 <Return> "new_max $Rc.s3 $Rd.e3"
  scale $Rc.s4 -label "ipady" -orient horizontal -from 0 -to 20 -command "spack $w -ipady $Rd.e4" -show 0
  entry $Rd.e4 -width 4 -relief sunken
  set v [pack_val $w -ipady]; if {$v==""} {set v 0}
  $Rd.e4 insert 0 $v; if {$v > 20} {new_max  $Rc.s4 $Rd.e4}
  $Rc.s4 set $v
  bind $Rd.e4 <Return> "new_max $Rc.s4 $Rd.e4"
  checkbutton $R.1 -text "Stretch X" -command "update_shape $w $marker" -variable stretchX($w)
  checkbutton $R.2 -text "Stretch Y" -command "update_shape $w $marker" -variable stretchY($w)
  checkbutton $R.3 -text "Move X" -command "update_shape $w $marker" -variable moveX($w)
  checkbutton $R.4 -text "Move Y" -command "update_shape $w $marker" -variable moveY($w)
  global Fill
  set Fill($w) [pack_val $w -fill]
  radiobutton $Ra.1 -text X -command "sel_pack $w -fill x" -variable Fill($w) -value x
  radiobutton $Ra.2 -text Y -command "sel_pack $w -fill y" -variable Fill($w) -value y
  radiobutton $Ra.3 -text Both -command "sel_pack $w -fill both" -variable Fill($w) -value both -anchor w
  radiobutton $Ra.4 -text None -command "sel_pack $w -fill none" -variable Fill($w) -value none -anchor w
  global Expand
  set Expand($w) [pack_val $w -expand]
  if {$Expand($w)==""} {set Expand($w) 0}
  checkbutton $Ra.5 -text "Expand" -command "sel_pack $w -expand \$Expand($w)" -variable Expand($w)
  global Side
  set Side($w) [pack_val $w -side]
  radiobutton $Ra.6 -text Top -command "sel_pack $w -side top" -variable Side($w) -anchor w -value top
  radiobutton $Ra.7 -text Bottom -command "sel_pack $w -side bottom" -variable Side($w) -anchor w -value bottom
  radiobutton $Ra.8 -text Right -command "sel_pack $w -side right" -variable Side($w) -anchor w -value right
  radiobutton $Ra.9 -text Left -command "sel_pack $w -side left" -variable Side($w) -anchor w -value left
  pack $Rc.s1 -fill x -expand 1
  pack $Rc.s2 -fill x -expand 1
  pack $Rc.s3 -fill x -expand 1
  pack $Rc.s4 -fill x -expand 1
  pack $Rd.e1 -fill none -expand 1
  pack $Rd.e2 -fill none -expand 1
  pack $Rd.e3 -fill none -expand 1
  pack $Rd.e4 -fill none -expand 1
  pack $Ra.6 -side bottom -fill x -expand 1
  pack $Ra.7 -side bottom -fill x -expand 1
  pack $Ra.8 -side bottom -fill x -expand 1
  pack $Ra.9 -side bottom -fill x -expand 1

  pack $Ra.5 -side bottom -fill x -expand 1
  pack $Ra.4 -side bottom -fill x -expand 1
  pack $Ra.3 -side bottom -fill x -expand 1
  pack $Ra.1 -side left -fill x -expand 1
  pack $Ra.2 -side left -fill x -expand 1
  pack $Ra -side left -expand 0
  pack $Rc -side left -expand 0 -fill y
  pack $Rd -side left -expand 0 -fill y 
  pack $Rb -side left -expand 1 -fill both
  global Anchor
  set Anchor($w) [pack_val $w -anchor]
  radiobutton $Rb.nw -text "NW" -command "sel_pack $w -anchor nw" -variable Anchor($w) -value nw
  radiobutton $Rb.n -text "N " -command "sel_pack $w -anchor n" -variable Anchor($w) -value n
  radiobutton $Rb.ne -text "NE" -command "sel_pack $w -anchor ne" -variable Anchor($w) -value ne
  radiobutton $Rb.w -text "W " -command "sel_pack $w -anchor w" -variable Anchor($w) -value w
  radiobutton $Rb.c -text "C " -command "sel_pack $w -anchor c" -variable Anchor($w) -value center
  radiobutton $Rb.e -text "E " -command "sel_pack $w -anchor e" -variable Anchor($w) -value e
  radiobutton $Rb.sw -text "SW" -command "sel_pack $w -anchor sw" -variable Anchor($w) -value sw
  radiobutton $Rb.s -text "S " -command "sel_pack $w -anchor s" -variable Anchor($w) -value s
  radiobutton $Rb.se -text "SE" -command "sel_pack $w -anchor se" -variable Anchor($w) -value se
  place $Rb.nw -relx 0 -rely 0 -relw 0.33 -relh 0.33
  place $Rb.n -relx 0.33 -rely 0 -relw 0.33 -relh 0.33
  place $Rb.ne -relx 0.66 -rely 0 -relw 0.33 -relh 0.33
  place $Rb.w -relx 0 -rely 0.33 -relw 0.33 -relh 0.33
  place $Rb.c -relx 0.33 -rely 0.33 -relw 0.33 -relh 0.33
  place $Rb.e -relx 0.66 -rely 0.33 -relw 0.33 -relh 0.33
  place $Rb.sw -relx 0 -rely 0.66 -relw 0.33 -relh 0.33
  place $Rb.s -relx 0.33 -rely 0.66 -relw 0.33 -relh 0.33
  place $Rb.se -relx 0.66 -rely 0.66 -relw 0.33 -relh 0.33

  set BT $EB.frame2b
  frame $BT 
  frame $BT.f1 
  frame $BT.f2 
  frame $BT.f3 -width 150 -height 100
  frame $BT.f4 
  frame $BT.f5 
  frame $BT.f6 
  label $BT.f1.r -text "Row:" -width 10
  scale $BT.f1.s -orient horizontal -command "set_rows $w $marker" -to 20 -width 5
  pack $BT.f1.r -side left
  pack $BT.f1.s -side left -fill x -expand 1
  label $BT.f2.c -text "Column:" -width 10
  scale $BT.f2.s -orient horizontal -command "set_cols $w $marker" -to 20 -width 5
  pack $BT.f2.c -side left
  pack $BT.f2.s -side left -fill x -expand 1
  pack $BT.f1 -fill both -expand 1
  pack $BT.f2 -fill both -expand 1
  pack $BT.f3 -expand 1 -fill both
  label $BT.f4.rs -text "Row span:" -width 10
  scale $BT.f4.s -orient horizontal -command "sel_table configure $w -rowspan" -from 1 -to 20 -width 5
  label $BT.f5.cs -text "Col span:" -width 10
  scale $BT.f5.s -orient horizontal -command "sel_table configure $w -columnspan" -from 1 -to 20 -width 5
  pack $BT.f4.rs -side left
  pack $BT.f4.s -side left -fill x -expand 1
  pack $BT.f5.cs -side left
  pack $BT.f5.s -side left -fill x -expand 1
  pack $BT.f4 -expand 1 -fill both
  pack $BT.f5 -expand 1 -fill both
  pack $BT.f6 -expand 1 -fill both
  radiobutton $BT.f6.r1 -text "Fill X" -command "sel_table configure $w -fill x"
  radiobutton $BT.f6.r2 -text "Fill Y" -command "sel_table configure $w -fill y"
  radiobutton $BT.f6.r3 -text "Fill None" -command "sel_table configure $w -fill none"
  radiobutton $BT.f6.r4 -text "Fill Both" -command "sel_table configure $w -fill both"
  pack $BT.f6.r1 $BT.f6.r2 $BT.f6.r3 $BT.f6.r4 -side left -expand 1 -fill both
  set BF $BT.f3
  radiobutton $BF.nw -text "NW" -command "sel_table config $w -anchor nw" -variable Anchor($w) -value nw
  radiobutton $BF.n -text "N " -command "sel_table config $w -anchor n" -variable Anchor($w) -value n
  radiobutton $BF.ne -text "NE" -command "sel_table config $w -anchor ne" -variable Anchor($w) -value ne
  radiobutton $BF.w -text "W " -command "sel_table config $w -anchor w" -variable Anchor($w) -value w
  radiobutton $BF.c -text "C " -command "sel_table config $w -anchor c" -variable Anchor($w) -value center
  radiobutton $BF.e -text "E " -command "sel_table config $w -anchor e" -variable Anchor($w) -value e
  radiobutton $BF.sw -text "SW" -command "sel_table config $w -anchor sw" -variable Anchor($w) -value sw
  radiobutton $BF.s -text "S " -command "sel_table config $w -anchor s" -variable Anchor($w) -value s
  radiobutton $BF.se -text "SE" -command "sel_table config $w -anchor se" -variable Anchor($w) -value se
  place $BF.nw -relx 0 -rely 0 -relw 0.33 -relh 0.33
  place $BF.n -relx 0.33 -rely 0 -relw 0.33 -relh 0.33
  place $BF.ne -relx 0.66 -rely 0 -relw 0.33 -relh 0.33
  place $BF.w -relx 0 -rely 0.33 -relw 0.33 -relh 0.33
  place $BF.c -relx 0.33 -rely 0.33 -relw 0.33 -relh 0.33
  place $BF.e -relx 0.66 -rely 0.33 -relw 0.33 -relh 0.33
  place $BF.sw -relx 0 -rely 0.66 -relw 0.33 -relh 0.33
  place $BF.s -relx 0.33 -rely 0.66 -relw 0.33 -relh 0.33
  place $BF.se -relx 0.66 -rely 0.66 -relw 0.33 -relh 0.33

  set AL $EB.frame2c
  frame $AL
  button $AL.al -text "Align w/mouse" -command "get_edge"
  button $AL.ala -text "Auto Align" -command "auto_align $w"
  global alignment
  if [info exists alignment($w,F)] {
    button $AL.fill -text "Fill $alignment($w,F)" -command "change_fill $w $AL.fill"
  } else {
    button $AL.fill -text "Fill N" -command "change_fill $w $AL.fill"
  }
  frame $AL.f
  frame $AL.f2
  label $AL.f.l -text "Pad x:"
  scale $AL.f.padx -command "align $w -xpad" -orient horiz -to 20
  label $AL.f2.l -text "Pad y:"
  scale $AL.f2.pady -command "align $w -ypad" -orient horiz -to 20
  pack $AL.f.l -side left 
  pack $AL.f.padx -side right -fill x -expand 1
  pack $AL.f2.l -side left 
  pack $AL.f2.pady -side right -fill x -expand 1
  pack $AL.al -side left
  pack $AL.ala -side left
  pack $AL.fill -side left
  pack $AL.f -fill x
  pack $AL.f2 -fill x

  if {$pp_shape($w) == "place"} {pack $R -fill x -expand 1}
  if {$pp_shape($w) == "pack"} {pack $EB.frame2a -fill x -expand 1}
  if {$pp_shape($w) == "blt_table"} {pack $EB.frame2b -fill x -expand 1}
  if {$pp_shape($w) == "align"} {pack $EB.frame2c -fill x -expand 1}
  
  pack $R.1 -side left -fill x -expand 1
  pack $R.2 -side left -fill x -expand 1
  pack $R.3 -side left -fill x -expand 1
  pack $R.4 -side left -fill x -expand 1
  pack $EB.done -side bottom -fill x
  pack $EB.apply -side bottom -fill x
  pack $EB.config -side bottom -fill x
  pack $EB.proc -side bottom -fill x
  if {$type == "menubutton"} {
    set F $EB.textframe
    frame $F
    pack $F -expand 1 -fill both
    set W $F.t
    scrollbar $F.sbh -command "$W xview" -orient horiz
    scrollbar $F.sbv -command "$W yview" -orient vert
    pack $F.sbh -side bottom -fill x 
    pack $F.sbv -side right -fill y 
    text $W -borderwidth 2 -relief raised -width 0 -yscrollcommand "$F.sbv set" -xscrollcommand "$F.sbh set" -wrap none
    $W delete 0.0 end
    global Menu_string
    $W insert end $Menu_string($w)
    bind $W <2> "paste $W"
    pack $W -expand 1 -fill both -side left
  }
  if {$type == "scrollbar"} {
    frame $EB.orf
    set EBF $EB.orf
    radiobutton $EBF.r1 -text "Horizontal" -command "$w configure -orient horizontal\nafter 100 \"update_scrollbars . \\\"\\\"\""
    radiobutton $EBF.r2 -text "Vertical" -command "$w configure -orient vertical\nafter 100 \"update_scrollbars . \\\"\\\"\""
    pack $EBF.r1 -side left -fill x -expand 1
    pack $EBF.r2 -side right -fill x -expand 1
    pack $EBF -fill x -expand 1
  }
  if {$type == "scale"} {
    frame $EB.orf
    set EBF $EB.orf
    label $EBF.l1 -text "From:"
    pack $EBF.l1 -fill x -side left
    entry $EBF.f -width 10 -relief sunken
    $EBF.f insert 0 [get_widget_value $w from]
    bind $EBF.f <Return> "set_from_to $w $EBF.f from"
    bind $EBF.f <Leave> "set_from_to $w $EBF.f from"
    entry $EBF.to -width 10 -relief sunken
    $EBF.to insert 0 [get_widget_value $w to]
    bind $EBF.to <Return> "set_from_to $w $EBF.to to"
    bind $EBF.to <Leave> "set_from_to $w $EBF.to to"
    pack $EBF.f -fill x -side left
    label $EBF.l2 -text "To:"
    pack $EBF.l2 -fill x -side left
    pack $EBF.to -fill x -side left
    radiobutton $EBF.r1 -text "Horizontal" -command "$w configure -orient horizontal"
    radiobutton $EBF.r2 -text "Vertical" -command "$w configure -orient vertical"

    pack $EBF.r1 -side left
    pack $EBF.r2 -side right
    pack $EBF -fill x -expand 1
  }
}

set menu_bind [bind Menu <ButtonRelease>]

proc bind_menu {} {
  bind Menu <ButtonRelease> {global Type; add_menu_item %W $Type}
}
bind Menu <Motion> {+focus -force %W;}
bind Menu <b> {add_menu_item %W button}
bind Menu <c> {add_menu_item %W checkbutton}
bind Menu <r> {add_menu_item %W radiobutton}
bind Menu <s> {add_menu_item %W label}
bind Menu <m> {add_menu_item %W menubutton}
bind Menu <d> "%W delete active"

global cur_menu

proc print_menu {w args} {
  eval "set args $args"
  lappend cur_menu "\n[print_menu2 $w $args]"
  set attrs [$w config] 
  foreach a $attrs {
    set A [lindex $a 3]
    set B [lindex $a 4]
    set con [lindex $a 0]
    if {$A != $B} {
      if {$con != "-label" && $con != "-command" && $con != "-menu"} {
        append cur_menu " $con $B"
      }
    }
  }
  return "$cur_menu"
}
proc print_menu2 {w args} {
  set num_items [$w index 10000]
  for {set i 0} {$i <= $num_items} {incr i} {
    set type [$w type $i]
    set cur_menu_item ""
    if {$type == "command" || $type == "radiobutton" || $type == "checkbutton"} {
      lappend cur_menu_item [$w entrycget $i -label]
      lappend cur_menu_item $type
      lappend cur_menu_item [$w entrycget $i -command]
    } elseif {$type == "cascade"} {
      lappend cur_menu_item [$w entrycget $i -label]
      lappend cur_menu_item menu
      append cur_menu_item " [print_menu [$w entrycget $i -menu] {  }]"
    } elseif {$type == "separator" || $type == "tearoff"} {
      lappend cur_menu_item $type
    }
    set attrs [$w entryconfig $i] 
    foreach a $attrs {
      set A [lindex $a 3]
      set B [lindex $a 4]
      set con [lindex $a 0]
      if {$A != $B} {
        if {$con != "-label" && $con != "-command" && 
           $con != "-menu" && $con != "-state"} {
          lappend cur_menu_item $con $B
        }
      }
    }
    eval "set args $args"
    eval "append cur_menu \"$args\""
    append cur_menu "\{$cur_menu_item\}\n"
  }
  return "$cur_menu"
}

proc get_menu_parent {w} {
  while {[winfo class $w] != "Menubutton"} {
    set w [winfo parent $w]
  }
  return $w
}

proc add_menu_item {w Type} {
  global menu_bind Menu_string
  set i [$w index active]
  if {$Type == "button"} {
    $w insert [expr $i+1] command -label "Button"
  } elseif {$Type == "radiobutton"} {
    $w insert [expr $i+1] radiobutton -label "Radio"
  } elseif {$Type == "checkbutton"} {
    $w insert [expr $i+1] checkbutton -label "Check"
  } elseif {$Type == "label"} {
    $w insert [expr $i+1] separator
  } elseif {$Type == "menubutton"} {
    menu $w.m$i -takefocus 1
    $w insert [expr $i+1] cascade -label "Submenu" -menu $w.m$i
  }
  set cur_menu ""
  set par [get_menu_parent $w]
  echo [print_menu $par.m]
  set Menu_string($par) [print_menu $par.m]
  set t .gui_edit[winfo name $par].textframe.t
  echo $t
  if {[winfo exists $t]} {
    $t delete 0.0 end
    $t insert end $Menu_string($par)
  }
  bind Menu <ButtonRelease> $menu_bind
}

proc show_focus {} {
  after 1000 "echo \[focus\];show_focus"
}

#show_focus
    
proc set_type {t {file ""}} {
  global Type Mx My tmp_file tk_version
  set tmp_file $file
  set Type $t
  catch "destroy .showfeedback"
  menu .showfeedback -borderwidth 0 -background red
  bindtags .showfeedback .showfeedback
  if {$file == ""} {set w [add_widget .showfeedback $Type 0 0]
  } else {
    load_comp .showfeedback $file
    set w [lindex [winfo child .showfeedback] 0]
  }
  place forget $w
  catch "pack $w -in .showfeedback -padx 2 -pady 2"
  .showfeedback post $Mx $My
  update
  grab -global .showfeedback
  catch "wm geom .showfeedback +$Mx+$My"
  focus .showfeedback
  echo [focus]
  bind .showfeedback <Key-Escape> {
    grab release .showfeedback
    destroy .showfeedback
  }
  bind .showfeedback <Any-Motion> {
    catch "wm geom .showfeedback +%X+%Y"
    set w [winfo containing [expr %X-4] [expr %Y-4]]
    if {$w != "" && [winfo class $w] == "Menubutton"} {
      grab release .showfeedback
      destroy .showfeedback
      tkMbPost $w %X %Y
      bind_menu
    }
  }
  bind $w <Any-Motion> {
    catch "wm geom .showfeedback +%X+%Y"
  }
  get_placement_info .showfeedback
  get_placement_info [lindex [winfo child .showfeedback] 0]
  if {$tk_version >= 4} {
    bind Menu <ButtonRelease> {
      catch "tkMenuInvoke %W"
    }
  }
  bind .showfeedback <ButtonRelease-1> {
    global Type tmp_file pp_shape
    grab release .showfeedback
    destroy .showfeedback
    update
    set w [winfo containing %X %Y]
    if {$w == ""} return
    if [is_gui_widget [winfo toplevel $w]] return
    if {$tmp_file == ""} {
      add_widget $w $Type [expr [expr %X-[winfo rootx $w]]+2] \
                          [expr [expr %Y-[winfo rooty $w]]+2]
    } else {
      echo Loading ...
      set r [load_comp $w $tmp_file]
      if ![info exists pp_shape($r)] return
      set_position $r [expr [expr %X-[my_winfo rootx $w]]+2] \
                      [expr [expr %Y-[my_winfo rooty $w]]+2]

    }
  }
}

proc get_widgets2 {w tab} {
  global widget_list
  if {[winfo class $w] != "Menu"} {lappend widget_list "$tab$w"}
  foreach c [winfo child $w] {
    if {[is_gui_widget $c]==1} continue
    get_widgets2 $c "  $tab"
  }
  return $w
}
proc get_widgets {w} {
  global widget_list
  if {[winfo class $w] != "Menu"} {lappend widget_list $w}
  foreach c [winfo child $w] {
    if {[is_gui_widget $c]==1} continue
    get_widgets $c
  }
  return $w
}

proc get_type {w} {
  set w [winfo class $w]
  set a [string range $w 0 1]
  set b [string range $w 2 end]
  return [string tolower $a]$b
}

proc is_tix_widget {w} {
  set p $w
  while {$p != "."} {
    if {[string range [winfo class $p] 0 2] == "Tix"} break
    set p [winfo parent $p]
  }
  if {[string range [winfo class $p] 0 2] == "Tix"} {return 1}
  return 0
}

proc str_rep {S old new} {
  upvar $S str
  if {[string first $old $new]==-1} {
    while {[set ix [string first $old $str]]!=-1} {
      set str "[string range $str 0 [expr $ix -1]]$new[string range $str [expr $ix+[string length $old]] end]"
    }
    return $str
  } else {
    if {[set ix [string first $old $str]]!=-1} {
      set str "[string range $str 0 [expr $ix -1]]$new[string range $str [expr $ix+[string length $old]] end]"
    }
    return $str
  }
}
  

proc add_tix_children {w {new ""}} {
  set str ""
  echo $w
  if [is_tix_widget $w] {
    foreach c [winfo child $w] {
      if {$new != ""} {append str "\ncatch \"$new add [winfo name $c] [config_cmd $c]\""
      } else {append str "\ncatch \"\$Name add [winfo name $c] [$c cget -label]\""}
    }
    if {$new != ""} {
      str_rep str $w $new
    }
    return $str
  }
  return ""
}

set pageNum 1

proc set_page_names {Name w} {
  set line [$Name get 0.0 1.end]
  set i 0
  set pages [$w pages]
  while {$line != {}} {
    echo $line
    $Name delete 0.0 2.0
    echo $w pageconfig [lindex $pages $i] -label $line
    $w pageconfig [lindex $pages $i] -label $line
    set line [$Name get 0.0 1.end]
    incr i
  }
  destroy .page_names
}

proc page_names {w} { 
  catch "destroy .page_names"
  toplevel .page_names
  wm title .page_names {page_names}
  set Name .page_names
  set Parent $Name

  set Name $Parent.t2
  text $Name -borderwidth 3 -height 5 -width 10
  pack $Name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top
  button $Parent.done -command "set_page_names $Name $w"
  pack $Parent.done -side bottom -fill x
  foreach p [$w pages] { 
    $Name insert end [lindex [$w pageconfig $p -label] 4]\n
  }
}

proc Add_Class_Commands {e in_w} {
  global pageNum
  if {$in_w == "."} return
  set w $in_w
  if {[winfo class $w] == "TixNoteBook"} {
    $e add command -label "Configure Pages" -command "page_config $w"
    incr pageNum
    return
  }  
  Add_Class_Commands $e [winfo parent $in_w]
}

proc create_widget {w file} {
  if {[winfo class $w] == "TixSelect"} {
    puts $file "tixSelect \$Name [config_cmd $w]"
    puts $file "[add_tix_children $w]"
    return
  }
  if {[winfo class $w] == "TixNoteBook"} {
    puts $file "tixNoteBook \$Name [config_cmd $w]"
    foreach page [$w pages] {
      puts $file "\$Name add $page"
      set Attr [$w pageconfig $page]
      foreach a $Attr {
        if {[lindex $a 4] != [lindex $a 3]} {
          puts $file "\$Name pageconfig $page [lindex $a 0] \"[lindex $a 4]\""
        }
      }
    }
    return
  }
  if {[winfo class $w] == "TixDlgBtns"} {
    puts $file "tixDlgBtns \$Name [config_cmd $w]"
    puts $file "[add_tix_children $w]"
    return
  }
  set C [winfo class $w]
  set a [string range $C 0 1]
  set b [string range $C 2 end]
  puts $file "[string tolower $a]$b \$Name [config_cmd $w]"
}

proc is_gui_widget c {
  if {[winfo exists $c]} {set n [winfo name $c] 
  } else {
    set tmp $c
    set n $c
    root_child tmp c
    set n [csubstr $n 1 end]
    echo $n
  }
  if [string match "colors*" $n] {return 1}
  if [string match "gui_warn*" $n] {return 1}
  if [string match "guibuilder*" $n] {return 1}
  if [string match "proc_edit*" $n] {return 1}
  if [string match "showfeedback*" $n] {return 1}
  if [string match "wtree*" $n] {return 1}
  if [string match "defaults*" $n] {return 1}
  if [string match "gui_edit*" $n] {return 1}
  if [string match "config_*" $n] {return 1}
  if [string match "kill*" $n] {return 1}
  if [string match "grab*" $n] {return 1}
  if [string match "select_cmd*" $n] {return 1}
  if [string match "sel*" $n] {return 1}
  if [string match "gui_m" $n] {return 1}
  if [string match "comp*" $n] {return 1}
  if {$c==".grab"} {return 1}
  return 0
}

proc make_widget_list2 {} {
  global widget_list
  set widget_list ""
  foreach c [winfo child .] {
    if {[winfo class $c] == "TixPopupMenu"} {
      get_widgets2 $c ""
    }
    if {[winfo class $c] == "Toplevel"} {
      if {[is_gui_widget $c]==1} continue
      get_widgets2 $c ""
    }
  }
  return $widget_list
}

proc make_widget_list {} {
  global widget_list
  set widget_list ""
  foreach c [winfo child .] {
    if {[winfo class $c] == "TixPopupMenu"} {
      get_widgets $c
    }
    if {[winfo class $c] == "Toplevel"} {
      if {[is_gui_widget $c]==1} continue
      get_widgets $c
    }
  }
  return $widget_list
}


proc make_widgets {filename} {
  global top_count env images num_images
  global widget_list
  global Menu_string
  global sourcename
  global stretchX stretchY moveX moveY pp_shape is_saved

  if { $filename == "" } {set file stdout} else {
    set file [open $filename w]
    echo Opened $file
  }
   
  set widgets {message checkbutton radiobutton button label entry menubutton 
		scale canvas scrollbar text listbox frame}  
  make_widget_list 
  update_scrollbars . ""
  if [file executable guiwish] {
    puts $file "#!$env(PWD)/guiwish"
  } else {
    puts $file "#![exec which guiwish]"
  }
  puts $file "if \[file executable guiBuilder\] {"
  puts $file "  set env(GUI_BUILDER) \$env(PWD)"
  puts $file "} else {"
  puts $file "  set env(GUI_BUILDER) \[file dirname \[exec which guiBuilder\]\]"
  puts $file "}"
  puts $file "global num_images images"
  puts $file "if {!\[info exists num_images\]} {set num_images 0}"
  for {set i 0} {$i < $num_images} {incr i} {
    puts $file "catch \"image create photo $images($i) -file $images($i)\""
    puts $file "set images(\$num_images) $images($i)"
    puts $file "incr num_images"
  }
  puts $file "global Menu_string"
  puts $file "global auto_path images num_images"
  if {$sourcename != ""} {
    puts $file "set sourcename $sourcename"
    if {[csubstr $sourcename 0 0] != "/"} {
      set path [pwd]
      set tail [file tail $sourcename]
    } else {
      set path [file dirname $sourcename]
      set tail [file tail $sourcename]
    }
    #puts $file "source $path/$tail"
    puts $file "auto_mkindex $path $tail"
    puts $file "set auto_path \[linsert \$auto_path 0 $path\]"
  }
  puts $file "if {\[file exists \$env(GUI_BUILDER)/common.tcl\]} {"
  puts $file "  puts \"loading \$env(GUI_BUILDER)/common.tcl\""
  puts $file "  source  \$env(GUI_BUILDER)/common.tcl"
  puts $file "  puts \"loading \$env(GUI_BUILDER)/extensions.tcl\""
  puts $file "  source  \$env(GUI_BUILDER)/extensions.tcl"
  puts $file "}"
  puts $file "set align_list \"\""
  puts $file "wm withdraw ."
  puts $file "global Topgeom Toppos"
  set is_saved(NULL) NULL
  array_clear is_saved

  foreach top [winfo child .] {
    if {[winfo class $top] != "Toplevel"} continue
    if {[is_gui_widget $top]==1} continue
    puts $file "catch \"destroy $top\""
    puts $file "#- TOP LEVEL -----------------------------------------"
    puts $file "toplevel $top [config_cmd $top]"
    puts $file "wm title $top {[wm title $top]}"
    set x [winfo x $top]
    set y [winfo y $top]
    global Topgeom Toppos Topstate Topborder
    if $Topgeom($top) {
      puts $file "wm geometry $top [winfo width $top]x[winfo height $top]"
    }
    if $Toppos($top) {
      puts $file "wm geometry $top +$x+$y"
    }
    if {$Topstate($top) == "iconic"} {
      puts $file "wm iconify $top"
    } elseif {$Topstate($top) == "withdrawn"} {
      puts $file "wm withdraw $top"
    }
    if {$Topborder($top) == 0} {
      puts $file "wm override $top 1"
    }
    if {$stretchX($top)} {
      puts $file "wm minsize $top 1 1"
    }
    puts $file "set Toppos($top) $Toppos($top)"
    puts $file "set Topgeom($top) $Topgeom($top)"
    global istop
    set istop 1
    save_comp_rec [winfo parent $top] $top 1 $file
  }
  if {$sourcename != ""} {
    puts $file "catch \"source $path/$tail\""
  }
  puts $file "if {\[info procs main\] == \"main\"} {main}"
  if {$file != "stdout"} {
    close $file
    echo closed $file
    exec chmod +x $filename
  }
}

proc Test {} {
  global filename
  set pid [exec guiwish -f $filename &]
  catch "destroy .kill"
  toplevel .kill
  button .kill.b -text "Done Testing" -command "destroy .kill;exec kill -9 $pid"
  pack .kill.b
  global Mx My
  wm geometry .kill +$Mx+$My
}
 
proc set_filename {w} {
  global filename
  set filename [$w get]
}

proc set_sourcename {w} {
  global sourcename
  set sourcename [$w get]
  if {$sourcename != ""} {source $sourcename}
}

proc config_cmd {w} {
  if {[winfo class $w] == "TixPopupMenu"} {
    return "Popup MenuProc\$Name\
\ntixPupBindParents \$Name \[winfo parent \$Name\]"}
  set list ""
  foreach a [Attributes $w] {
    eval "lappend list -$a [get_widget_value $w $a]"
  }
  return $list
}

proc duplicate {old x y {par ""} {newname ""}} {
  global moveX moveY stretchX stretchY pp_shape tk_version snap
  set Osnap $snap
  set snap 0
  set type [get_type $old]
  if {$par == ""} {set par [winfo parent $old]}
  if {$x >= 0} {
    set x [expr $x+[my_winfo x $old]]
    set y [expr $y+[my_winfo y $old]]
  }
  set new [add_widget $par $type $x $y $newname [config_cmd $old]]
  if [is_tix_widget $new] {
    set cmd [add_tix_children $old $new]
    eval $cmd
  }
  copy_attributes $old $new
  if {$pp_shape($old)=="place"} {
    catch "pack forget $new"
    catch "align forget $new"
    catch "blt_table forget $new"
    set pp_shape($new) place
    catch "place $new [place info $old]"
    #echo place $new [place info $old]
  }
  if {$x >= 0} {
    if { [lsearch [place info $old] -width] != -1} {
      set_size $new [winfo width $old] [winfo height $old]
    }
  }
  if {$x >= 0} {set_position $new $x $y}
  if {$pp_shape($old) == "pack"} {
    catch "place forget $new"
    catch "align forget $new"
    catch "blt_table forget $new"
    if {$tk_version>=4} {
      set info [pack info $old]
    } else {
      set info [pack newinfo $old]
    }
    lvarpop info
    lvarpop info
    eval pack $new $info
    set pp_shape($new) pack
  } elseif {$pp_shape($old)=="place"} {
    set stretchX($new) $stretchX($old)
    set stretchY($new) $stretchY($old)
    set moveX($new) $moveX($old)
    set moveY($new) $moveY($old)
  } elseif {$pp_shape($old) == "blt_table"} {
    catch "place forget $new"
    catch "pack forget $new"
    catch "align forget $new"
    eval "blt_table [winfo parent $new] $new [lrange [blt_table info $old] 1 end]" 
  }
  foreach ch [winfo child $old] {
    if {[is_gui_widget $ch]==1} continue
    if [is_tix_widget $old] continue
    if {[winfo class $ch] == "Menu"} {
      global Menu_string
      set Menu_string($new) $Menu_string($old)
      eval "make_menu $new $Menu_string($new)"
      $new configure -menu $new.m
    } else {
      duplicate $ch -1 -1 $new
    }
  }
  set snap $Osnap
}

proc do_rename {w e} {
  set val [$e get]
  if {[csubstr $val 0 0] != "."} {
    set val .$val
  }
  if {"$w" == "$val"} {
    #error "Same name."
    return
  } else { 
    if {[winfo exists $val]} {
      error "Widget $val exists."
      return
    }
  }
  rename_w $w $val
}

proc grab_name {w e marker} {
  global Mx My
  set w [winfo containing $Mx $My]
  $e delete 0 end
  $e insert 0 $w
  destroy .grab
  do_reparent $e $marker
}

proc update_sel {} {
  global selected stretchX stretchY moveX moveY pp_shape
  for_array_keys s selected {
    if {[winfo exists $s]==0} {
      echo Bad selected pointer $s!
      unset selected($s)
    } 
  }
}

proc do_grab {w e marker} {
  global Mx My
  catch "destroy .grab"
  toplevel .grab
  wm geom .grab +$Mx+$My
  message .grab.m -text "Select parent with mouse button one.  Cancel with button two" -aspect 800 -justify left 
  pack .grab.m
  grab .grab.m
  bind .grab.m <Button-2> "grab release .grab.m;destroy .grab"
  bind .grab.m <Button-1> "grab release .grab.m;after 100 grab_name %W $e $marker"
}

proc do_reparent {e marker} {
  set val [$e get]
  if {[csubstr $val 0 0] == "."} {
    reparent $val $marker
  } else {
    reparent .$val $marker
  }
}

proc reparent {name marker} {
  global selected
  for_array_keys s selected {
    if {$selected($s) == $marker} {
      set w $s
      set n [winfo name $w]
      #echo REPARENT $w $name.$n
      rename_w $w $name.$n
    } 
  }
  update_sel
}

proc root_child {r c} {
  upvar $r r2
  upvar $c c2
  for {set i [clength $c2]} {$i > 0} {set i [expr $i-1]} {
    if {[csubstr $c2 $i $i]=="."} {
      set a [csubstr $c2 0 [expr $i-1]]
      set b [csubstr $c2 $i end]
      set r2 $a
      set c2 $b
      return
    }
  }
}


proc rename_w {w name {DEL 1}} {
  set par [winfo parent $w]
  set Opar $par 
  set Oname $name
  if {$name == "."} {set name ""}
  if {$name != ""} {root_child par name}
  if {"$Opar$name" == "$par" && "$par" != "."} {
    error "Bad parrent ($par)"
    return
  }
  if {[is_gui_widget [winfo toplevel $par]]} {
    error "Parent is part of GUI Builder"
    return
  }
  if {[is_gui_widget $name]} {
    error "Widget is part of GUI Builder"
    return
  }
  #echo RENAME2 $par $name
  if {$par != "."} {
    duplicate $w -1 -1 $par $name
  #set new [add_widget $par $type $x $y $newname]
    if $DEL {delete_widget $w}
  } else {
    set top [create_new_toplevel $name]
    copy_attributes $w $top
    wm geom $top [wm geom $w]
    foreach ch [winfo children $w] {
      if {[is_gui_widget $ch]==1} continue
      duplicate $ch -1 -1 $top
    }
    if $DEL {delete_widget $w}
  }
}

proc copy_attributes {from to} {
  global Procs
  foreach a [$from config] {
     set b [lindex $a 0]
     set b [csubstr $b 1 end]
     catch "$to configure -$b [get_widget_value $from $b]"
  }
  if [isset Procs($from)] {
    set Procs($to) $Procs($from)
    foreach p $Procs($from) {
      if {[lindex $p 0] == "bind"} {
        set Name $from
        set Bind [eval $p]
        set Name $to
        echo "bind $to [lindex $p 2] [list $Bind]"
        bind $to [lindex $p 2] $Bind
      }
    }
  }
}

proc get_placement_info {w} {
  global moveX moveY stretchX stretchY pp_shape
  set p [winfo parent $w]
  if {[is_placed $w]} {
    set pli [place info $w]
    set pp_shape($w) place
    set moveX($w) 1
    set moveY($w) 1
    set stretchX($w) 1
    set stretchY($w) 1
    foreach pl $pli {
      switch -exact -- $pl {
        {-x} {set moveX($w) 0}
        {-y} {set moveY($w) 0}
        {-width} {set stretchX($w) 0}
        {-height} {set stretchY($w) 0}
      }
    }
  } elseif {[is_packed $w]} {
    set pp_shape($w) pack
  } elseif {[is_aligned $w]} {
    set pp_shape($w) align
  } elseif {[is_blt_table $w]} {
    set pp_shape($w) blt_table
  }
}


proc load_widgets {filename} {
  global widget_count sourcename top_count env Topstate Toppos 
  global Topborder pp_shape stretchX
  set widget_count 0
  source $filename
  wm deiconify .
  update
  after 400
  set top_count 0
  foreach w [winfo child .] {
    if {[scan $w .top%d d] == 1} {
      if {$d > $top_count} {set top_count $d}
    }
  }
  set top_count [expr $top_count+1]
  echo top_count = $top_count
  
  foreach w [make_widget_list] {
    set widget_count [expr {$widget_count + 1}]
    if {[winfo class $w] == "Toplevel"} {
      bind $w <Enter> "global top\nset top $w"
      #bind $w <1> "global Type\nadd_widget $w \$Type %x %y"
      bind $w <Shift-3> "edit_widget Toplevel $w %X %Y"
      bind $w <Control-3> "rename_w $w \"\" 0"
      set Topborder($w) [expr 1-[wm override $w]]
      set Topstate($w) [wm state $w]
      set pp_shape($w) place
      if {[wm minsize $w]==""} {
        set stretchX($w) 0
      } else {
        set stretchX($w) 1
      }
      echo [wm state $w]
    } else {
      if {[winfo class $w] == "Frame" } {
        #bind $w <1> "add_widget $w \$Type %x %y"
      }
      get_placement_info $w
      bind_widget $w
    }
  }
  show_widget_tree
}

proc flash {w} {
  set bg [get_widget_value $w background]
  $w configure -bg red
  update
  after 100 
  $w configure -bg $bg
}

proc do_flash {w} {
  set _ [$w get active]
  set _ [lindex $_ 0]
  flash $_
}

proc do_configure {w} {
  global Mx My
  set _ [lindex [$w get [lindex [$w curselection] 0]] 0]
  edit_widget [winfo class $_] $_ $Mx $My
}

set in_delete 0
proc show_widget_tree {{always 0}} {
  global selected cur_sel in_delete
  catch "raise .wtree"
  if {!$always && (![winfo exists .wtree] || ![winfo ismapped .wtree])} {
    return
  }
  if $in_delete return
  catch {
    toplevel .wtree
    wm title .wtree "Widget Tree"
    frame .wtree.f
    button .wtree.f.pop -text Dismiss -command {destroy .wtree}
    button .wtree.f.del -text Delete -command {
      set in_delete 1
      catch {foreach _ [.wtree.l curselection] {delete_widget [lindex [.wtree.l get $_] 0]}}
      set in_delete 0
      after 100 show_widget_tree 
    }
    button .wtree.f.conf -text "Configure" -command {
      catch {
        do_configure .wtree.l
      }
    }
    button .wtree.f.ts -text "Toggle Select" -command {
      catch {
        foreach _ [.wtree.l curselection] {
          toggle_select [lindex [.wtree.l get $_] 0]
        }
      }
    }
    button .wtree.f.dup -text "Duplicate" -command {
      catch {
        set _ [lindex [.wtree.l get [lindex [.wtree.l curselection] 0]] 0]
        if {[winfo class $_] == "Toplevel"} {
         rename_w $_ "" 0
        } else {
          duplicate $_ -1 -1 
        }
      }
    }
    button .wtree.f.rai -text Raise -command {
      catch {
        set _ [lindex [.wtree.l get [lindex [.wtree.l curselection] 0]] 0]
        my_raise $_
      }
    }
    listbox .wtree.l -yscrollcommand {.wtree.sb set}
    scrollbar .wtree.sb -command {.wtree.l yview}
    pack .wtree.f.pop .wtree.f.conf .wtree.f.ts .wtree.f.rai .wtree.f.dup .wtree.f.del -side left
    pack .wtree.f -side top
    pack .wtree.sb -side left -anchor w -fill y
    pack .wtree.l -side left -expand y -fill both
    bind .wtree.l <Any-ButtonRelease-1> "do_flash %W"
    bind .wtree.l <Double-1> "do_configure %W"
  }
  catch ".wtree.l select to 1"
  .wtree.l select clear 0 end
  update
  .wtree.l delete 0 end
  global selected
  foreach w [make_widget_list2] {  
    eval "set W $w"
    if {[isset selected($W)] && $selected($W)!=0} {
      set s "*$selected($W)"} else {set s ""}
    .wtree.l insert end "$w $s"
  }
}


proc do_browser {} {
  global filename sourcename env
  set filename [exec $env(GUI_BUILDER)/browser "*.tcl"]
  for {set i [clength $filename]} {$i > 0} {set i [expr $i-1]} {
    if {[csubstr $filename $i 1]=="/"} break
  }
  after 100 ".guibuilder.frn.e xview [expr $i+1]"
  set sourcename ""
}
proc do_browser2 {} {
  global sourcename env
  set sourcename [exec $env(GUI_BUILDER)/browser "*.tcl"]
  for {set i [clength $sourcename]} {$i > 0} {set i [expr $i-1]} {
    if {[csubstr $sourcename $i 1]=="/"} break
  }
  after 100 ".guibuilder.frs.e xview [expr $i+1]"
}


load_defaults
#set top [create_new_toplevel]
set Type none

set G .guibuilder
catch "destroy $G"
toplevel $G
wm title $G "GuiBuilder $version Copyright 1995 by Sean Halliday"
frame $G.frn
pack $G.frn -fill x -expand 1
button $G.frn.b -text "Filename:" -command "do_browser" -width 13
entry $G.frn.e -textvariable filename -relief sunken
pack $G.frn.b -side left -fill x -expand 1
pack $G.frn.e -side left -fill x -expand 1

frame $G.frs 
pack $G.frs -fill x -expand 1
button $G.frs.b -text "Sourcename:" -command "do_browser2" -width 13
entry $G.frs.e -textvariable sourcename -relief sunken
pack $G.frs.b -side left -fill x -expand 1
pack $G.frs.e -side left -fill x -expand 1

frame $G.fr 
frame $G.fr2
pack $G.fr -fill x -expand 1
menubutton $G.fr.file -text "File" -menu $G.fr.file.m -relief raised
menu $G.fr.file.m
#bind $G.fr.file <1> "tk_mbButtonDown %W;focus %W.m"
$G.fr.file.m add command -label "Save" -command "global filename\nmake_widgets \$filename"
$G.fr.file.m add command -label "Load" -command "global filename\nload_widgets \$filename"
$G.fr.file.m add command -label "Test" -command "Test"
$G.fr.file.m add command -label "View Source" -command {
  global filename
  exec view_source $filename &
}
$G.fr.file.m add command -label "Exit" -command "destroy ."
menubutton $G.fr.edit -text "Edit" -menu $G.fr.edit.m -relief raised
menu $G.fr.edit.m
global allow_edit
set allow_edit 0
$G.fr.edit.m add checkbutton -label "Allow text editting" -variable allow_edit -command toggle_allow_edit
$G.fr.edit.m add command -label "Select all" -command select_all
$G.fr.edit.m add command -label "Select remaining" -command "select_remain 1"
$G.fr.edit.m add command -label "Select remaining as" -command "select_remain 0"
$G.fr.edit.m add command -label "Unselect all" -command unselect_all
$G.fr.edit.m add command -label "Unselect a marker" -command unselect_marker
$G.fr.edit.m add command -label "Change a marker" -command change_marker
$G.fr.edit.m add command -label "Delete by marker" -command delete_by_marker

button $G.fr.tree -text "Tree" -command "show_widget_tree 1" -width 5

button $G.fr.help -text "Help" -command "exec guiHelp &" -width 5
button $G.fr.def -text "Defaults" -command "set_defaults" -width 9
pack $G.fr.file -side left -fill x -expand 1
pack $G.fr.edit -side left -fill x -expand 1
pack $G.fr.tree -side left -fill x -expand 1
pack $G.fr.help -side left -fill x -expand 1
pack $G.fr.def -side left -fill x -expand 1

proc set_grid {v} {
  global grid
  set grid $v
}

checkbutton $G.fr2.rb -text "Grid Snap" -variable snap 
scale $G.fr2.s -orient horizontal -from 1 -to 10 -label "Less <- Granularity -> More" -command "set_grid" -length 200
$G.fr2.s set $grid
pack $G.fr2.rb -side left -fill both -expand 1
pack $G.fr2.s -side left -expand 1 -fill x
pack $G.fr2 -expand 1 -fill x -side bottom

wm geometry $G +600+40 
#wm minsize $G 440 10

frame $G.fr3 -relief ridge -borderwidth 3 
frame $G.fr3.create
frame $G.fr3.new 
pack $G.fr3 -padx 8 -pady 8 -ipadx 3 -ipady 3 -fill both -expand 1
pack $G.fr3.create -side left -expand 1 -fill both
pack $G.fr3.new -side left -expand 1 -fill both
set N $G.fr3.new
set GB $G.fr3.create

label $N.l -text "Composite Widgets"
pack $N.l
listbox $N.lb -relief sunken -yscrollcommand "$N.sc set"
set Bind [bind Listbox <1>]
bind $N.lb <1> "$Bind;get_composite %W"
scrollbar $N.sc -command "$N.lb yview"
pack $N.lb -side left -expand 1 -fill both
pack $N.sc -side left -fill y

button $GB.nt -text "New Toplevel" -command "global top\nset top \[create_new_toplevel\]"
pack $GB.nt -fill x

radiobutton $GB.b -text "Create Button" -anchor w -variable radiomenu -value button
pack $GB.b -fill x
bind $GB.b <Button-1> "set_type button;set radiomenu button"

radiobutton $GB.rb -text "Create Radio Button" -anchor w -variable radiomenu -value radiobutton
pack $GB.rb -fill x
bind $GB.rb <Button-1> "set_type radiobutton;set radiomenu radiobutton"

radiobutton $GB.cb -text "Create Check Button" -anchor w -variable radiomenu -value checkbutton
pack $GB.cb -fill x
bind $GB.cb <Button-1> "set_type checkbutton;set radiomenu checkbutton"

radiobutton $GB.f -text "Create Frame" -anchor w -variable radiomenu -value frame
pack $GB.f -fill x
bind $GB.f <Button-1> "set_type frame;set radiomenu frame"

radiobutton $GB.l -text "Create Label" -anchor w -variable radiomenu -value label
pack $GB.l -fill x
bind $GB.l <Button-1> "set_type label;set radiomenu label"

radiobutton $GB.mg -text "Create Message" -anchor w -variable radiomenu -value message
pack $GB.mg -fill x
bind $GB.mg <Button-1> "set_type message;set radiomenu message"

radiobutton $GB.e -text "Create Entry" -anchor w -variable radiomenu  -value entry
pack $GB.e -fill x
bind $GB.e <Button-1> "set_type entry;set radiomenu entry"

radiobutton $GB.t -text "Create Text" -anchor w -variable radiomenu  -value text
pack $GB.t -fill x
bind $GB.t <Button-1> "set_type text;set radiomenu text"

radiobutton $GB.m -text "Create Menu" -anchor w -variable radiomenu  -value menubutton
pack $GB.m -fill x
bind $GB.m <Button-1> "set_type menubutton;set radiomenu menubutton"

radiobutton $GB.s -text "Create Scale" -anchor w -variable radiomenu  -value scale
pack $GB.s -fill x
bind $GB.s <Button-1> "set_type scale;set radiomenu scale"

radiobutton $GB.c -text "Create Canvas" -anchor w -variable radiomenu  -value canvas
pack $GB.c -fill x
bind $GB.c <Button-1> "set_type canvas;set radiomenu canvas"

radiobutton $GB.lb -text "Create Listbox" -anchor w -variable radiomenu  -value listbox
pack $GB.lb -fill x
bind $GB.lb <Button-1> "set_type listbox;set radiomenu listbox"

radiobutton $GB.sby -text "Create Scrollbar" -anchor w -variable radiomenu  -value scrollbar
pack $GB.sby -fill x
bind $GB.sby <Button-1> "set_type scrollbar;set radiomenu scrollbar"

#radiobutton $GB.tcb -text "Create ComboBox" -anchor w -variable radiomenu  -value tixComboBox
#pack $GB.tcb -fill x
#bind $GB.tcb <Button-1> "set_type tixComboBox;set radiomenu tixComboBox"


catch "destroy .gui_m"
message .gui_m -text "GUI Builder \n Version $version \n by Sean Halliday" \
-font -*-helvetica-bold-r-normal--18-*-*-*-p-103-iso8859-1 \
-aspect 300 -justify c -relief ridge -borderwidth 8 -bg #100020 -fg #100020
pack .gui_m
wm geom . +490+635
wm withdraw .
update
wm override . 1
wm deicon .
raise .
bind .gui_m <1> "wm withdraw ."
update
#wm minsize $G 10 10

after 3000 fadein 

proc fadein {} {
  set j 0
  foreach i {00 10 20 30 40 50 60 70 80 90 a0 b0 c0 d0 e0 f0} {
    incr j
    set val #10$i
    append val 20
    after [expr 200*$j] .gui_m config -fg $val
  }
}

update
scan_composites

proc fadeingray {w} {
  set j 0
  foreach i {10 20 30 40 50 60 70 80} {
    incr j
    after [expr 40*$j] $w config -bg gray$i
  }
}

proc toggle_border {w} {
  global Topborder
  wm withdraw $w
  if $Topborder($w) {wm override $w 0} else {wm override $w 1}
  update
  wm deiconify $w
}

proc toggle_fixed_size {w} {
  global Topgeom
  if $Topgeom($w) {wm geom $w [winfo width $w]x[winfo height $w]
  } else {wm geom $w ""}
  update
}

catch "raise .gui_warn"
