#!/usr/local/bin/wishx -f
#
# GuiBuilder V 0.9 (Beta)
#
# Copyright (c) 1995 Sean Halliday
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, 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@BanffCentre.AB.CA or halliday@cs.ualberta.ca 


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

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

proc arg_config {f args} {
  for {set i 0} {$i < [llength $args]} {set i [expr $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"
}

bind all <Motion> "mouse_update %X %Y"

source /Ptarmigan/halliday/GuiBuilder/common.tcl

set menu_string "{\
\n  {Button command \"puts button\"}\
\n  {Radiobutton1 radiobutton \"puts radio1\" -variable r1}\
\n  {Radiobutton2 radiobutton \"puts radio2\" -variable r1}\
\n  {separator}\
\n  {SubMenu menu {\
\n    {Button command \"puts button\"}\
\n    {Radiobutton1 radiobutton \"puts radio1\" -variable r2}\
\n    {Radiobutton2 radiobutton \"puts radio2\" -variable r2}\
\n    } -background red\
\n  }\
\n  {Checkbutton2 checkbutton \"puts check2\" -background blue}\
\n  {Checkbutton1 checkbutton \"puts check1\"}\
\n}"

proc get_widget_value {w v} {
  set RET ""
  set A [catch "$w configure -$v"]
  if {$A == 0} {
    set val [lindex [$w configure -$v] 4]
    if {[llength $val] != 1} {return \{$val\}}
    return $val
  }
  return {}
}

proc itemStartResize {b x y} {
    global lastX lastY Type
    return
}

proc set_size {b wid hi} {
    global stretchX stretchY
    set c [winfo parent $b]
    if {$stretchX($b)} {
      set wid [expr $wid.0 / [winfo width $c]]
      catch "place $b -relwid [gridify $wid]"
    } else {
      catch "place $b -wid [gridify $wid]"
    }
    if {$stretchY($b)} {
      set hi [expr $hi.0 / [winfo height $c]]
      catch "place $b -relheight [gridify $hi]"
    } else {
      catch "place $b -height [gridify $hi]"
    }
}

proc itemResize {b x y} {
    global lastX lastY
    set c [winfo parent $b]
    set lastX [expr [winfo x $c] + [winfo x $b]]
    set lastY [expr [winfo y $c] + [winfo y $b]]
    set lastX [winfo rootx $b]
    set lastY [winfo rooty $b]
    set wid [expr $x-$lastX]
    set hi [expr $y-$lastY]
    set_size $b $wid $hi
}

proc gridify {x} {
  set x [expr $x * 100]
  set x [int $x]
  set x [expr $x.0 / 100]
  return $x
}
 

proc itemStartDrag {b x y} {
    global lastX lastY
    set w [expr [winfo width $b] /2]
    set h [expr [winfo height $b] /2]
    set w 0
    set h 0
    set lastX [expr $x - [winfo x $b]]
    set lastY [expr $y - [winfo y $b]]
    set lastX [expr $lastX - $w]
    set lastY [expr $lastY - $h]
}

proc set_position {b x y} {
    global moveX moveY
    set c [winfo parent $b]
    if {$moveX($b)} {
      set x [expr $x.0 / [winfo width $c]]
      catch "place $b -relx [gridify $x]"
    } else {
      catch "place $b -x [gridify $x]"
    }
    if {$moveY($b)} {
    set y [expr $y.0 / [winfo height $c]]
      catch "place $b -rely [gridify $y]"
    } else {
      catch "place $b -y [gridify $y]"
    }
}


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 {} {
  global top_count stretchX stretchY
  set top .top$top_count
  catch "destroy $top"
  toplevel $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"
  set stretchX($top) 1
  set stretchY($top) 1
  return $top
}

proc update_scrollbars {par sb} {
  set ch [winfo child $par]
  if {$sb == ""} {
    for {set i 0} {$i < [llength $ch]} {set i [expr $i+1]} {
      set W [lindex $ch $i]
      set type [winfo class $W]
      if { $type == "Entry" || $type == "Canvas" || $type == "Listbox" || $type == "Text"} {
        catch "$W configure -yscroll \"\""
        catch "$W configure -xscroll \"\""
        catch "$W configure -scrollcommand \"\""
      }
    }
    for {set i 0} {$i < [llength $ch]} {set i [expr $i+1]} {
      set W [lindex $ch $i]
      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 {
    for {set i 0} {$i < [llength $ch]} {set i [expr $i+1]} {
      set W [lindex $ch $i]
      set type [winfo class $W]
      eval "set orient [get_widget_value $sb orient]"
      if { $type == "Canvas" || $type == "Listbox" } {
        $W configure -yscroll ""
        $W configure -xscroll ""
        if {$orient == "vertical"} {
          $W configure -yscroll "$sb set"
          $sb configure -command "$W yview"
        }
        if {$orient == "horizontal"} {
          $W configure -xscroll "$sb set"
          $sb configure -command "$W xview"
        }
      }
      if {$type == "Entry"} {
        $W configure -scrollcommand ""
        if {$orient == "horizontal"} {
          $W configure -scrollcommand "$sb set"
          $sb configure -command "$W view" 
        }
      }
      if {$type == "Text"} {
        $W configure -yscroll ""
        if {$orient == "vertical"} {
          $W configure -yscroll "$sb set"
          $sb configure -command "$W yview" 
        }
      }
    }
  }
} 

proc my_scrollbar {par w} {
  set ch [winfo child $par]
  scrollbar $w
  for {set i 0} {$i < [llength $ch]} {set i [expr $i+1]} {
    set W [lindex $ch $i]
    set type [winfo class $W]
  }
  return $w
}

proc add_widget {top type x y} {
  global widget_count
  global tag_count
  global stretchX stretchY moveX moveY
  
  if {$type == "none"} { 
    echo "Select a type first."
    return
  }
  if {$type == "canvas"} {
    set W $top.c$widget_count
    canvas $W -relief groove -width 40 -height 40 -scrollregion {0c 0c 10c 10c}
    $W create text 1m 1m -text "Hello" -anchor nw
  }
  if {$type == "listbox"} {
    set W $top.lb$widget_count
    listbox $W -relief sunken
    $W insert end item1
    $W insert end item2
  }
  if {$type == "scrollbar"} {
    set W $top.sb$widget_count
    scrollbar $W
    update_scrollbars $top ""
  }
  if {$type == "button"} {
    set W $top.b$widget_count
    button $W -text button$widget_count -width 8 
  }
  if {$type == "message"} {
    set W $top.mg$widget_count
    message $W -text message$widget_count 
  }
  if {$type == "checkbutton"} {
    set W $top.b$widget_count
    checkbutton $W -text button$widget_count -width 8 
  }
  if {$type == "radiobutton"} {
    set W $top.b$widget_count
    radiobutton $W -text button$widget_count -width 8 
  }
  if {$type == "frame"} {
    set W $top.f$widget_count
    frame $W -borderwidth 2 -relief raised -width 50 -height 50
    bind $W <1> "add_widget $W \$Type %x %y"
  }
  if {$type == "label"} {
    set W $top.l$widget_count
    label $W -text label$widget_count
  }
  if {$type == "entry"} {
    set W $top.e$widget_count
    entry $W -relief sunken
  }
  if {$type == "text"} {
    set W $top.t$widget_count
    text $W -relief sunken -width 10 -height 5 -borderwidth 3
  }
  if {$type == "texty"} {
    set W [texty $top.ty$widget_count -borderwidth 2 -relief raised]
  }
  if {$type == "menubutton"} {
    set W $top.m$widget_count
    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)"
  }
  if {$type == "scale"} {
    set W $top.s$widget_count
    scale $W -relief sunken
  }
  set stretchX($W) 1
  set stretchY($W) 1
  set moveX($W) 1
  set moveY($W) 1
  place $W -x $x -y $y
# Use after so that above command actually places window before replacing!
  after 500 "new_place $top $W $x $y"
#.c.can create window $x $y -window $W -tag t$tag_count -anchor nw
  bind $W <3> "itemStartDrag $W %X %Y"
#  bind $W <B3-Motion> "itemDrag t$tag_count %X %Y"
  bind $W <B3-Motion> "itemDrag $W %X %Y"
  bind $W <2> "itemStartResize $W %X %Y"
  bind $W <B2-Motion> "itemResize $W %X %Y"
  bind $W <Shift-3> "edit_widget $type $W %X %Y"
  set Bind [bind [winfo class $W] <Any-Enter>]
  bind $W <Enter> "$Bind\nfocus $W"
  bind $W <B3-Delete> "delete_widget $W"
  set tag_count [expr {$tag_count + 1}]
  set widget_count [expr {$widget_count + 1}]
  update_scrollbars . ""
  return $W
}

proc new_place {par w x y} {
  set x [expr $x.0 / [winfo width $par]]
  set y [expr $y.0 / [winfo height $par]]
  set wid [expr [winfo width $w].0 / [winfo width $par].0]
  set hi [expr [winfo height $w].0 / [winfo height $par].0]
  place $w -relx $x -rely $y -relwidth $wid -relheight $hi
}


proc delete_widget {w} {
  echo deleted $w
  catch "destroy $w"
  update_scrollbars . "" 
}

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 {[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 -text $val"]
  if {$A == 1} {catch "$w configure -label $val"}
}

proc my_entry {e name wid val b args} {
  catch "destroy $e.f$name"
  frame $e.f$name
  set E $e.f$name.e
  set L $e.f$name.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
  return $e.f$name
}

proc color_menu {m w op} {
  global colors
  for {set i 0} {$i < [llength $colors]} {set i [expr $i+1]} {
    set c [lindex $colors $i]
    $m add command -label $c -command "configure $w -$op $c" -background $c
  }
}

proc done_edit {e w d} {
  global Menu_string
  if { [winfo exists $e.t] } {
    set str [.eb.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 [winfo x $w] [winfo y $w]
  if {$d} {destroy $e}
}

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
}

proc set_config {w name wid} {
  set val [$wid get]
  if {[llength $val] != 1} {set val "\{$val\}"}
  set A [catch "$w config $name $val"]
  if {$A == 1} { 
    get_config $w $name $wid 
  }
}

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

proc Attributes {w} {
  set list {}
  foreach a [$w config] {
    set len [expr [llength $a] - 1]
    if {$len != 1} {
      set name [lindex $a 0]
      set val [lindex $a $len]
      set val2 [lindex $a [expr $len - 1]]
      if { $val != $val2 } { lappend list [csubstr $name 1 end]}
    }
  }
  return $list
}

proc Configure {e w} {
  global colors
  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}
  catch "destroy .cg"
  toplevel .cg
  global Mx My
  wm geom .cg +$Mx+$My
  label .cg.l -text "Use Right Button for Menu." -relief groove
  pack .cg.l -fill x

  foreach a [$w config] {
    set len [expr [llength $a] - 1]
    if {$len != 1} {
      set name [lindex $a 0]
      if { [intersect $name $nlist] == "" } {
        set val [lindex $a $len]
        set val2 [lindex $a [expr $len - 1]]
        set F [my_entry .cg $name 20 $val "set_config $w $name %W" "get_config $w $name %W"]
        foreach op $options {
          set opt [lindex $op 0]
          if { $opt == $name } {
            catch "destroy .m$name"
            menu .m$name
            lvarpop op
            foreach item $op {
              .m$name add command -label $item -command "set_entry $w $name $item $F.e"
            }
            bind $F.e <3> ".m$name post %X %Y\nfocus .m$name"
            bind .m$name <Leave> "%W unpost"
            #bind $F.e <ButtonRelease-3> ".m$name unpost"
          }
        }
        pack $F
      }
    }
  }
  button .cg.cancel -text Done -command "destroy .cg"
  pack .cg.cancel -fill x
}
 
proc edit_widget {type w x y} {
  catch "destroy .eb"
  catch "destroy .cg"
  toplevel .eb
  wm title .eb $w
  set x [expr {$x+100}]
  wm geometry .eb +$x+$y
  frame .eb.mb
  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.fg -side left
  pack .eb.mb.bg -side left
  pack .eb.mb.afg -side left
  pack .eb.mb.abg -side left
  pack .eb.mb -fill x

  button .eb.done -text Done -command "done_edit .eb $w 1"
  pack .eb.done -side bottom -fill x
  button .eb.apply -text Apply -command "done_edit .eb $w 0"
  pack .eb.apply -side bottom -fill x
  button .eb.config -text "Configure Options" -command "Configure .eb $w"
  pack .eb.config -side bottom -fill x
  set Bind "set_text $w %W"
  if {[winfo class $w]!="Toplevel"} {
    set F [my_entry .eb Name: 9 "[get_widget_value $w text]" $Bind]}
  if {[winfo class $w]=="Toplevel"} {
    set F [my_entry .eb Name: 9 "[wm title $w]" $Bind]}
  pack $F -side top
  set Bind "set_command $w %W"
  pack [my_entry .eb Command: 9 "[get_widget_value $w command]" $Bind] -side top
  scale .eb.bw -command "configure $w -borderwidth" -orient horiz -from 0 -to 20 -label Borderwidth
  pack .eb.bw
  frame .eb.frame
  set R .eb.frame
  radiobutton $R.1 -text "Raised" -command "configure $w -relief raised"
  radiobutton $R.2 -text "Sunken" -command "configure $w -relief sunken"
  radiobutton $R.3 -text "Flat" -command "configure $w -relief flat"
  radiobutton $R.4 -text "Ridge" -command "configure $w -relief ridge"
  radiobutton $R.5 -text "Groove" -command "configure $w -relief groove"
  pack $R.1 -side left
  pack $R.2 -side left
  pack $R.3 -side left
  pack $R.4 -side left
  pack $R.5 -side left
  pack $R
  frame .eb.frame2
  set R .eb.frame2
  checkbutton $R.1 -text "Stretch X" -command "" -variable stretchX($w)
  checkbutton $R.2 -text "Stretch Y" -command "" -variable stretchY($w)
  checkbutton $R.3 -text "Move X" -command "" -variable moveX($w)
  checkbutton $R.4 -text "Move Y" -command "" -variable moveY($w)
  pack $R  
  
  pack $R.1 -side left 
  pack $R.2 -side left
  pack $R.3 -side left 
  pack $R.4 -side left
  if {$type == "menubutton"} {
    set W .eb.t
    text $W -borderwidth 2 -relief raised -width 60
    $W delete 0.0 end
    global Menu_string
    $W insert end $Menu_string($w)
    bind $W <2> "paste $W"
    pack $W
  }
  if {$type == "scrollbar"} {
    radiobutton .eb.r1 -text "Horizontal" -command "$w configure -orient horizontal\nafter 100 \"update_scrollbars . \\\"\\\"\""
    radiobutton .eb.r2 -text "Vertical" -command "$w configure -orient vertical\nafter 100 \"update_scrollbars . \\\"\\\"\""
    pack .eb.r1 -side left
    pack .eb.r2 -side right
  }
  if {$type == "scale"} {
    label .eb.l1 -text "From:"
    pack .eb.l1 -fill x -side left
    entry .eb.f -width 10 -relief sunken
    .eb.f insert 0 [get_widget_value $w from]
    bind .eb.f <Return> "set_from_to $w .eb.f from"
    bind .eb.f <Leave> "set_from_to $w .eb.f from"
    entry .eb.to -width 10 -relief sunken
    .eb.to insert 0 [get_widget_value $w to]
    bind .eb.to <Return> "set_from_to $w .eb.to to"
    bind .eb.to <Leave> "set_from_to $w .eb.to to"
    pack .eb.f -fill x -side left
    label .eb.l2 -text "To:"
    pack .eb.l2 -fill x -side left
    pack .eb.to -fill x -side left
    radiobutton .eb.r1 -text "Horizontal" -command "$w configure -orient horizontal"
    radiobutton .eb.r2 -text "Vertical" -command "$w configure -orient vertical"

    pack .eb.r1 -side left
    pack .eb.r2 -side right
  }
}
 
    
proc set_type {t} {
  global Type
  set Type $t
}

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

proc get_type {w} {
  set type [winfo class $w]
  set ord [ctype ord $type]
  set ord [expr $ord+32]
  set type "[ctype char $ord][csubstr $type 1 end]"
  return $type
}



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


proc make_widgets {filename} {
  global top_count
  global widget_list

  if { $filename == "" } {set file stdout} else {set file [open $filename w]}
   
  set widgets {message checkbutton radiobutton button label entry menubutton \
		scale canvas scrollbar text listbox frame}  
  make_widget_list 
  update_scrollbars . ""
  global Menu_string
  global sourcename
  puts $file "#!/usr/local/bin/wishx -f"
  if {$sourcename != ""} {puts $file "set sourcename $sourcename"}
  puts $file "source /Ptarmigan/halliday/GuiBuilder/common.tcl"
  #puts $file "button .quit -text Quit -command exit"
  #puts $file "pack .quit"
  puts $file "wm withdraw ."
  puts $file "global stretchX stretchY moveX moveY Menu_string"
  for {set ti 0} {$ti < $top_count} {set ti [expr $ti+1]} {
    set top .top$ti
    if {[winfo exists $top]==1} {
	set new_top .top$ti
	#catch "destroy $new_top"
	puts $file "catch \"destroy $new_top\""
      set attribs [Attributes $top]
      set top_as ""
      foreach a $attribs {
        append top_as " -$a [get_widget_value $top $a]"
      } 
	#eval "toplevel $new_top $top_as"
	puts $file "#------------------------------------------"
	puts $file "toplevel $new_top $top_as"
	puts $file "wm title $new_top {[wm title $new_top]}"
	set x [expr [expr [winfo x $top] + [winfo width $top]] + 40]
	set x [winfo x $top]
	set y [winfo y $top]
	#wm geometry $new_top [winfo width $top]x[winfo height $top]+$x+$y
	puts $file "wm geometry $new_top [winfo width $top]x[winfo height $top]+$x+$y"
	global stretchX stretchY moveX moveY
      puts $file "set stretchX($top) $stretchX($top)"
      if {$stretchX($top)} {
        puts $file "wm minsize $top 10 10"
      }
	set size [llength $widget_list]
	for {set i 0} {$i < $size} {set i [expr $i+1]} {
	  set Wid [lindex $widget_list $i]
	  set W [csubstr $Wid [expr [clength $top]+1] end]
        if { [winfo exists $top.$W] } {
	    set cmd "[get_type $top.$W] $new_top.$W"
	    puts $file "#------------------------------------------"
          if {[winfo class $Wid] == "Menubutton"} {
            puts $file "set Menu_string($Wid) {$Menu_string($Wid)}"
            set cmd "$cmd\n$new_top.$W configure -menu $new_top.$W.m\neval \"make_menu $new_top.$W \$Menu_string($Wid)\""
          }
	    set cmd_args ""
	    for {set k 0} {$k < [llength $widgets]} {set k [expr $k+1]} {
	      set widget [lindex $widgets $k]
	      if {[get_type $top.$W] == $widget} {
              set attribs [Attributes $Wid]
		  for {set j 0} {$j < [llength $attribs]} {set j [expr $j+1]} {
		    set attrib [lindex $attribs $j]
                set val [get_widget_value $Wid $attrib]
		    append cmd_args " -$attrib $val"
		  }
	      }
          }
	    puts $file $cmd
	    #eval $cmd
	    puts $file "$new_top.$W configure $cmd_args"
	    #eval "$new_top.$W config $cmd_args"
          set par [winfo parent $Wid]
	    set xp [expr [winfo rootx $Wid]-[winfo rootx $par]]
	    set yp [expr [winfo rooty $Wid]-[winfo rooty $par]]
          set place_cmd "place $new_top.$W"
          puts $file "set stretchX($Wid) $stretchX($Wid)"
          puts $file "set stretchY($Wid) $stretchY($Wid)"
          puts $file "set moveX($Wid) $moveX($Wid)"
          puts $file "set moveY($Wid) $moveY($Wid)"
          if {$stretchX($Wid)} {
            set wid [expr [winfo width $Wid].0 / [winfo width $par].0]
            lappend place_cmd -relwidth $wid
          } else {
            set wid [winfo width $Wid]
            lappend place_cmd -width $wid
          }
          if {$stretchY($Wid)} {
            set hi [expr [winfo height $Wid].0 / [winfo height $par].0]
            lappend place_cmd -relheight $hi
          } else {
            set hi [winfo height $Wid]
            lappend place_cmd -height $hi
          }
          if {$moveX($Wid)} {
            set x [expr $xp.0 / [winfo width $par]]
            lappend place_cmd -relx $x
          } else {
            lappend place_cmd -x $xp
          }
          if {$moveY($Wid)} {
            set y [expr $yp.0 / [winfo height $par]]
            lappend place_cmd -rely $y
          } else {
            lappend place_cmd -y $yp
          }
          #eval "$place_cmd"
          puts $file "$place_cmd"
	  }
	}
	#wm minsize $new_top 10 10
    }
  }
  if {$sourcename != ""} {
    if {[csubstr $sourcename 0 1] != "/"} {
      puts $file "source [pwd]/$sourcename"
    } else {
      puts $file "source $sourcename"
    }
  }
  if {$file != "stdout"} {close $file}
}

proc Test {} {
  global filename
  set pid [exec wishx -f $filename &]
  toplevel .kill
  button .kill.b -text "Done Testing" -command "kill SIGKILL $pid\ndestroy .kill"
  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 load_widgets {filename} {
  global widget_count sourcename top_count
  set widget_count 0
  source $filename
  wm deiconify .
  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
  
  make_widget_list
  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"
    } else {
      if {[winfo class $w] == "Frame" } {
        bind $w <1> "add_widget $w \$Type %x %y"
      }
      bind $w <3> "itemStartDrag $w %X %Y"
      bind $w <B3-Motion> "itemDrag $w %X %Y"
      bind $w <2> "itemStartResize $w %X %Y"
      bind $w <B2-Motion> "itemResize $w %X %Y"
      bind $w <Shift-3> "edit_widget [get_type $w] $w %X %Y"
      set Bind [bind [winfo class $w] <Any-Enter>]
      bind $w <Enter> "$Bind\nfocus $w"
      bind $w <B3-Delete> "delete_widget $w"
    }
  }
}

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


set top [create_new_toplevel]
set Type none

catch "destroy .frn"
frame .frn
pack .frn
button .frn.b -text "Filename:" -command "do_browser" -width 13
entry .frn.e -textvariable filename -relief sunken
pack .frn.b -side left
pack .frn.e -side left

catch "destroy .frs"
frame .frs
pack .frs
button .frs.b -text "Sourcename:" -command "do_browser2" -width 13
entry .frs.e -textvariable sourcename -relief sunken
pack .frs.b -side left
pack .frs.e -side left

catch "destroy .fr"
frame .fr 
pack .fr
button .fr.mak -text "Save" -command "global filename\nmake_widgets \$filename" -width 6

button .fr.test -text "Test" -command "Test" -width 6

button .fr.load -text "Load" -command "global filename\nload_widgets \$filename" -width 6

button .fr.exit -text "Exit" -command "destroy ." -width 6

button .fr.help -text "Help" -command "exec wishx -f help.tcl &" -width 6
pack .fr.mak -side left
pack .fr.test -side left
pack .fr.load -side left
pack .fr.exit -side left
pack .fr.help -side left

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

catch "destroy .b"
radiobutton .b -text "Create Button" -command "set_type button" -anchor w -variable radiomenu 
pack .b -fill x

catch "destroy .rb"
radiobutton .rb -text "Create Radio Button" -command "set_type radiobutton" -anchor w -variable radiomenu 
pack .rb -fill x

catch "destroy .cb"
radiobutton .cb -text "Create Check Button" -command "set_type checkbutton" -anchor w -variable radiomenu 
pack .cb -fill x

catch "destroy .f"
radiobutton .f -text "Create Frame" -command "set_type frame" -anchor w -variable radiomenu
pack .f -fill x

catch "destroy .l"
radiobutton .l -text "Create Label" -command "set_type label" -anchor w -variable radiomenu
pack .l -fill x

catch "destroy .mg"
radiobutton .mg -text "Create Message" -command "set_type message" -anchor w -variable radiomenu
pack .mg -fill x

catch "destroy .e"
catch "destroy .e"
radiobutton .e -text "Create Entry" -command "set_type entry" -anchor w -variable radiomenu 
pack .e -fill x

catch "destroy .t"
radiobutton .t -text "Create Text" -command "set_type text" -anchor w -variable radiomenu 
pack .t -fill x

catch "destroy .m"
radiobutton .m -text "Create Menu" -command "set_type menubutton"  -anchor w -variable radiomenu 
pack .m -fill x

catch "destroy .s"
radiobutton .s -text "Create Scale" -command "set_type scale"  -anchor w -variable radiomenu 
pack .s -fill x

catch "destroy .c"
radiobutton .c -text "Create Canvas" -command "set_type canvas"   -anchor w -variable radiomenu 
pack .c -fill x

catch "destroy .lb"
radiobutton .lb -text "Create Listbox" -command "set_type listbox"  -anchor w -variable radiomenu 
pack .lb -fill x

catch "destroy .sby"
radiobutton .sby -text "Create Scrollbar" -command "set_type scrollbar" -anchor w -variable radiomenu 
pack .sby -fill x

wm geometry . +440+40
