[PD-cvs] pd/src desire.tk,1.1.2.29,1.1.2.30

Mathieu Bouchard matju at users.sourceforge.net
Tue Sep 6 04:36:32 CEST 2005


Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2681

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
enabled button bar.
more cleanup of code.


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.29
retrieving revision 1.1.2.30
diff -C2 -d -r1.1.2.29 -r1.1.2.30
*** desire.tk	6 Sep 2005 01:43:17 -0000	1.1.2.29
--- desire.tk	6 Sep 2005 02:36:30 -0000	1.1.2.30
***************
*** 157,160 ****
--- 157,161 ----
  
  set cmdline(console) 1000
+ set cmdline(icons) icons
  
  for {set i 0} {$i < $argc} {incr i} {
***************
*** 352,360 ****
  }
  
- 
  # Odd little function to make better Mac accelerators
  proc accel_munge {acc} {
-     #puts "accel_munge::: $acc"
- 
      global pd_nt
      if {$pd_nt == 2} {
--- 353,358 ----
***************
*** 710,738 ****
  		#-command {pd "pd audio-setapi $pd_whichapi ;"}
      }
-     
-     #the original
-     #populate_menu $mbar.audio {} {
- 	#{"Audio settings..." {pd pd audio-properties} ""}
- 	#{"MIDI settings..."  {pd pd midi-properties}  ""}
- 	#{"Test Audio and MIDI" {menu_doc_open doc/7.stuff/tools testtone.pd} ""}
-      #   {"Load Meter" {menu_doc_open doc/7.stuff/tools load-meter.pd} ""}
-     #}
-     
-     #populate_menu $mbar.help {} {
- 	#{"About Pd" {menu_about} ""}
- 	#{"Pure Documentation..." {menu_documentation} ""}
-     #}
-     
-     #error proof
      populate_menu $mbar.audio {} {
! 	{"Audio settings..." {foo "pd audio-properties"} ""}
! 	{"MIDI settings..."  {foo "pd midi-properties"}  ""}
! 	{"Test Audio and MIDI" {foo "menu_doc_open doc/7.stuff/tools testtone.pd"} ""}
!         {"Load Meter" {foo "menu_doc_open doc/7.stuff/tools load-meter.pd"} ""}
      }
-     
      populate_menu $mbar.help {} {
! 	{"About Pd" {foo "menu_about"} ""}
! 	{"Pure Documentation..." {foo "menu_documentation"} ""}
      }
      
--- 708,720 ----
  		#-command {pd "pd audio-setapi $pd_whichapi ;"}
      }
      populate_menu $mbar.audio {} {
! 	{"Audio settings..." {foo pd "pd audio-properties"} ""}
! 	{"MIDI settings..."  {foo pd "pd midi-properties"}  ""}
! 	{"Test Audio and MIDI" {foo pd "menu_doc_open doc/7.stuff/tools testtone.pd"} ""}
!         {"Load Meter" {foo pd "menu_doc_open doc/7.stuff/tools load-meter.pd"} ""}
      }
      populate_menu $mbar.help {} {
! 	{"About Pd" {foo pd "menu_about"} ""}
! 	{"Pure Documentation..." {foo pd "menu_documentation"} ""}
      }
      
***************
*** 740,765 ****
  
  #-----------------------------------------------------------------------------------#
- # Odd little function to make better Mac accelerators
- #proc accel_munge {acc} {
-     #puts "accel_munge::: $acc"
- #
- #    global pd_nt
- #    if {$pd_nt == 2} {
- #        set tmp [string toupper [string map {Ctrl Meta} $acc] end]
- #	if [string is upper [string index $acc end]] {
- #	    return Shift+$tmp
- #	} else {
- #	    return $tmp
- #	}
- #    } else {
- #	return $acc
- #    }
- #}
- #
- #
- 
- #-----------------------------------------------------------------------------------#
  set canvasmenu(file) {
! 	{New     {foo menu_new} "Ctrl+n"}
  	{Open    {foo menu_open} "Ctrl+o"}
  	{}
--- 722,727 ----
  
  #-----------------------------------------------------------------------------------#
  set canvasmenu(file) {
! 	{New     {menu_new} "Ctrl+n"}
  	{Open    {foo menu_open} "Ctrl+o"}
  	{}
***************
*** 863,919 ****
  
  class_new canvas {
! 
! global offset_canvas _
! 
! 
! set canvas_id [format %x [expr 0x80f2b50 + $offset_canvas]]
! set canvas_id .x$canvas_id
! set offset_canvas [expr $offset_canvas + 1]
! set _($canvas_id:obj_in_edit) 0
! 
! puts "new canvas id -> $canvas_id"
! 
! pdtk_canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
!     
! set untitled_number $canvas_id
! 
  }
  
  #-----------------------------------------------------------------------------------#
- proc pdtk_canvas_new {name width height geometry editable} {
-     puts "pdtk_canvas_new::: $name $width $height $geometry $editable"
-     
  
      global pd_opendir pd_tearoff pd_nt cmdline canvasmenu _
-     
-     # my code begines --chun
-     
-     set _(focus) $name.c
-     
-     # my code ends
-     
-     toplevel $name -menu $name.m
-     wm geometry $name $geometry
-     canvas $name.c \
-     	-width $width -height $height \
- 	-background white \
-     	-yscrollcommand "$name.scrollvert set" \
-     	-xscrollcommand "$name.scrollhort set" \
- 	-scrollregion [list 0 0 $width $height] 
-     scrollbar $name.scrollvert -command "$name.c yview"
-     scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal
-     
-     #puts "$name.c"
-     
-     #if {[string compare $cmdline(look) ""]} {
- 	#make_button_bar $name.bbar $name
- 	#pack $name.bbar -side top -fill x -expand no
-     #}
-     statusbar_new $name
-     pack $name.scrollhort -side bottom -fill x
-     pack $name.scrollvert -side  right -fill y
-     pack $name.c -side left -expand 1 -fill both
-     wm minsize $name 1 1
-     wm geometry $name $geometry
      menu $name.m
      menu $name.m.file -tearoff $pd_tearoff
--- 825,842 ----
  
  class_new canvas {
! 	global offset_canvas _
! 	set canvas_id [format %x [expr 0x80f2b50 + $offset_canvas]]
! 	set canvas_id .x$canvas_id
! 	set offset_canvas [expr $offset_canvas + 1]
! 	set _($canvas_id:obj_in_edit) 0
! 	puts "new canvas id -> $canvas_id"
! 	pdtk_canvas_new $canvas_id 300 300 +[expr $offset_canvas*50]+[expr $offset_canvas*50] 1
! 	set untitled_number $canvas_id
  }
  
  #-----------------------------------------------------------------------------------#
  
+ proc canvas_new_menubar {name editable} {
      global pd_opendir pd_tearoff pd_nt cmdline canvasmenu _
      menu $name.m
      menu $name.m.file -tearoff $pd_tearoff
***************
*** 923,930 ****
      $name.m add cascade -label Edit -menu $name.m.edit
      populate_menu $name.m.edit $name $canvasmenu(edit)
! 
! # instead of "red = #BC3C60" we take "grey85", so there is no difference if
  # widget is selected or not.
- 
      $name.m.edit add checkbutton -label "Edit mode" \
      	-indicatoron true -selectcolor grey85 \
--- 846,851 ----
      $name.m add cascade -label Edit -menu $name.m.edit
      populate_menu $name.m.edit $name $canvasmenu(edit)
!     # instead of "red = #BC3C60" we take "grey85", so there is no difference if
  # widget is selected or not.
      $name.m.edit add checkbutton -label "Edit mode" \
      	-indicatoron true -selectcolor grey85 \
***************
*** 944,958 ****
      $name.m add cascade -label Put -menu $name.m.put
      populate_menu $name.m.put $name $canvasmenu(put)
-     
-     # the original
-     #menu $name.m.find -tearoff $pd_tearoff
-     #$name.m add cascade -label Find -menu $name.m.find
-     #populate_menu $name.m.find $name {
- 	#{Find... {menu_findobject %W} "Ctrl+f"}
- 	#{"Find Again" {pd "%W findagain ;"} "Ctrl+g"}
-     	#{"Find last error" {menu_finderror} {}}
-     #}
-     
-     #error proof
      menu $name.m.find -tearoff $pd_tearoff
      $name.m add cascade -label Find -menu $name.m.find
--- 865,868 ----
***************
*** 962,976 ****
      	{"Find last error" {foo menu_finderror} {}}
      }
-     
-     #the original
-     #menu $name.m.windows -postcommand "menu_fixwindowmenu $name" \
- 	#-tearoff $pd_tearoff
-     #populate_menu $name.m.windows $name {
- 	#{"parent window" {menu_windowparent %W} {}}
- 	#{"Pd window" {menu_pop_pd %W} {}}
- 	#{}
-     #}
-     
-     #error proof
      menu $name.m.windows -postcommand "foo menu_fixwindowmenu" \
  	-tearoff $pd_tearoff
--- 872,875 ----
***************
*** 980,984 ****
  	{}
      }
- 
      menu $name.m.audio -tearoff $pd_tearoff
      if {$pd_nt != 2} {
--- 879,882 ----
***************
*** 989,996 ****
          $name.m add cascade -label Window -menu $name.m.windows
      }
- 
      menu $name.m.help -tearoff $pd_tearoff
      $name.m add cascade -label Help -menu $name.m.help
      menu_addstd $name.m
  
      menu $name.popup -tearoff false
--- 887,924 ----
          $name.m add cascade -label Window -menu $name.m.windows
      }
      menu $name.m.help -tearoff $pd_tearoff
      $name.m add cascade -label Help -menu $name.m.help
      menu_addstd $name.m
+ }
+ 
+ proc pdtk_canvas_new {name width height geometry editable} {
+     puts "pdtk_canvas_new::: $name $width $height $geometry $editable"
+     global pd_opendir pd_tearoff pd_nt cmdline canvasmenu _
+     # my code begins --chun
+     set _(focus) $name.c
+     # my code ends
+     
+     toplevel $name -menu $name.m
+     wm geometry $name $geometry
+     canvas $name.c \
+     	-width $width -height $height \
+ 	-background white \
+     	-yscrollcommand "$name.scrollvert set" \
+     	-xscrollcommand "$name.scrollhort set" \
+ 	-scrollregion [list 0 0 $width $height] 
+     scrollbar $name.scrollvert -command "$name.c yview"
+     scrollbar $name.scrollhort -command "$name.c xview" -orient horizontal
+     if {[string compare $cmdline(icons) ""]} {
+ 	make_button_bar $name.bbar $name
+ 	pack $name.bbar -side top -fill x -expand no
+     }
+     statusbar_new $name
+     pack $name.scrollhort -side bottom -fill x
+     pack $name.scrollvert -side  right -fill y
+     pack $name.c -side left -expand 1 -fill both
+     wm minsize $name 1 1
+     wm geometry $name $geometry
+ 
+     canvas_new_menubar $name $editable
  
      menu $name.popup -tearoff false
***************
*** 1003,1084 ****
      wm protocol $name WM_DELETE_WINDOW "menu_close $name"
  
! # bindings.
! # this is idiotic -- how do you just sense what mod keys are down and
! # pass them on? I can't find it anywhere.
! # Here we encode shift as 1, control 2, alt 4, in agreement
! # with definitions in g_canvas.c.  The third button gets "8" but we don't
! # bother with modifiers there.
! # We don't handle multiple clicks yet.
! 
!     bind $name.c <Button>                   {pdtk_canvas_click %W %x %y %b 0}
!     bind $name.c <Shift-Button>             {pdtk_canvas_click %W %x %y %b 1}
!     bind $name.c <Control-Shift-Button>     {pdtk_canvas_click %W %x %y %b 3}
!     bind $name.c <Alt-Button>               {pdtk_canvas_click %W %x %y %b 4}
!     bind $name.c <Alt-Shift-Button>         {pdtk_canvas_click %W %x %y %b 5}
!     bind $name.c <Alt-Control-Button>       {pdtk_canvas_click %W %x %y %b 6}
!     bind $name.c <Alt-Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 7}
      global pd_nt
      if {$pd_nt == 2} {
!         bind $name.c <Button-2>       {pdtk_canvas_click %W %x %y %b 8}
!         bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
      } else {
!         bind $name.c <Button-3>       {pdtk_canvas_click %W %x %y %b 8}
!         bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
      }
      # change mac to right-click, not middle click -atl 2002.09.02
!     bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
!     bind $name.c <Control-Key>       {pdtk_canvas_ctrlkey %W %K 0}
!     bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
!     bind $name.c <Alt-Key>           {pdtk_canvas_altkey %W %K %A}
      if {$pd_nt == 0} {
! 	bind $name.c <Mod1-Key>          {pdtk_canvas_altkey %W %K %A}
! 	bind $name.c <Mod4-Key>          {pdtk_canvas_altkey %W %K %A}
      }
      if {$pd_nt == 2} {
! 	bind $name.c <Mod1-Key>       {pdtk_canvas_ctrlkey %W %K 0}
! 	bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
      }
!     bind $name.c <Key>        {pdtk_canvas_key %W %x %y %K %A 0}
!     bind $name.c <Shift-Key>  {pdtk_canvas_key %W %x %y %K %A 1}
!     bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %x %y %K %A 0}
!     bind $name.c <Motion>     {pdtk_canvas_motion %W %x %y 0 %s}
!     bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4 %s}
!     bind $name.c <Map>        {pdtk_canvas_map %W}
!     bind $name.c <Unmap>      {pdtk_canvas_unmap %W}
!     focus $name.c
      pdtk_canvas_editval $name $editable
!     bind $name.c <Motion> "+statusbar_update $name %x %y"
  
      global pd_nt
      switch $pd_nt { 0 {
! 	bind $name.c <Button-4>  "pdtk_canvas_scroll $name.c y -1"
!     	bind $name.c <Button-5>  "pdtk_canvas_scroll $name.c y +1"
! 	bind $name.c <Shift-Button-4>  "pdtk_canvas_scroll $name.c x -1"
!     	bind $name.c <Shift-Button-5>  "pdtk_canvas_scroll $name.c x +1"
      } default {
! 	bind $name.c  <MouseWheel> \
  	    "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
! 	bind $name.c  <Shift-MouseWheel> \
  	    "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
      }}
      #catch {image create photo mybackground -file "test2.gif"}
!     #catch {$name.c create image -6 -39 -anchor nw -image mybackground -tag bg}
      global _
      set self [canvastosym $name.c]
      set _($self:action) none
-     
      set _($self:selection) {}
      set _($self:selection_wire) {}
      set _($self:grab) ""
-     
      set _($self:current_x) 30
      set _($self:current_y) 30
-     
      puts "pdtk_canvas_new::: $name $width $height $geometry $editable"
-     
  }
  
- 
- 
  # 1 canvas
  #pdtk_canvas_new $canvas 300 300 +700+0 1
--- 931,999 ----
      wm protocol $name WM_DELETE_WINDOW "menu_close $name"
  
!     set c $name.c
!     bind $c <Button>                   {pdtk_canvas_click %W %x %y %b 0}
!     bind $c <Shift-Button>             {pdtk_canvas_click %W %x %y %b 1}
!     bind $c <Control-Shift-Button>     {pdtk_canvas_click %W %x %y %b 3}
!     bind $c <Alt-Button>               {pdtk_canvas_click %W %x %y %b 4}
!     bind $c <Alt-Shift-Button>         {pdtk_canvas_click %W %x %y %b 5}
!     bind $c <Alt-Control-Button>       {pdtk_canvas_click %W %x %y %b 6}
!     bind $c <Alt-Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 7}
      global pd_nt
      if {$pd_nt == 2} {
!         bind $c <Button-2>       {pdtk_canvas_click %W %x %y %b 8}
!         bind $c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
      } else {
!         bind $c <Button-3>       {pdtk_canvas_click %W %x %y %b 8}
!         bind $c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
      }
      # change mac to right-click, not middle click -atl 2002.09.02
!     bind $c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
!     bind $c <Control-Key>       {pdtk_canvas_ctrlkey %W %K 0}
!     bind $c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
!     bind $c <Alt-Key>           {pdtk_canvas_altkey %W %K %A}
      if {$pd_nt == 0} {
! 	bind $c <Mod1-Key>          {pdtk_canvas_altkey %W %K %A}
! 	bind $c <Mod4-Key>          {pdtk_canvas_altkey %W %K %A}
      }
      if {$pd_nt == 2} {
! 	bind $c <Mod1-Key>       {pdtk_canvas_ctrlkey %W %K 0}
! 	bind $c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
      }
!     bind $c <Key>        {pdtk_canvas_key %W %x %y %K %A 0}
!     bind $c <Shift-Key>  {pdtk_canvas_key %W %x %y %K %A 1}
!     bind $c <KeyRelease> {pdtk_canvas_keyup %W %x %y %K %A 0}
!     bind $c <Motion>     {pdtk_canvas_motion %W %x %y 0 %s}
!     bind $c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4 %s}
!     bind $c <Map>        {pdtk_canvas_map %W}
!     bind $c <Unmap>      {pdtk_canvas_unmap %W}
!     focus $c
      pdtk_canvas_editval $name $editable
!     bind $c <Motion> "+statusbar_update $name %x %y"
  
      global pd_nt
      switch $pd_nt { 0 {
! 	bind $c <Button-4>  "pdtk_canvas_scroll $name.c y -1"
!     	bind $c <Button-5>  "pdtk_canvas_scroll $name.c y +1"
! 	bind $c <Shift-Button-4>  "pdtk_canvas_scroll $name.c x -1"
!     	bind $c <Shift-Button-5>  "pdtk_canvas_scroll $name.c x +1"
      } default {
! 	bind $c  <MouseWheel> \
  	    "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
! 	bind $c  <Shift-MouseWheel> \
  	    "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
      }}
      #catch {image create photo mybackground -file "test2.gif"}
!     #catch {$c create image -6 -39 -anchor nw -image mybackground -tag bg}
      global _
      set self [canvastosym $name.c]
      set _($self:action) none
      set _($self:selection) {}
      set _($self:selection_wire) {}
      set _($self:grab) ""
      set _($self:current_x) 30
      set _($self:current_y) 30
      puts "pdtk_canvas_new::: $name $width $height $geometry $editable"
  }
  
  # 1 canvas
  #pdtk_canvas_new $canvas 300 300 +700+0 1
***************
*** 1176,1181 ****
  #-----------------------------------------------------------------------------------#
  
! proc foo {foo} {
! 	puts " $foo not there yet...."
  }
  
--- 1091,1096 ----
  #-----------------------------------------------------------------------------------#
  
! proc foo {args} {
! 	puts " $args not there yet...."
  }
  
***************
*** 2209,2219 ****
      
      pd "$self mouseup $cx $cy $b ;"
- 
      set size [$name bbox all]
      
      if {$size != ""} {
-         
          # not entirely sure what this is, but it executes when there are objects
!         # on canvas and there is a mouseup
          
      	set xmin 0; set xmax 100
--- 2124,2132 ----
      
      pd "$self mouseup $cx $cy $b ;"
      set size [$name bbox all]
      
      if {$size != ""} {
          # not entirely sure what this is, but it executes when there are objects
!         # on canvas and there is a mouseup --chun
          
      	set xmin 0; set xmax 100
***************
*** 2262,2267 ****
  proc pdtk_canvas_key {canvas x y key iso shift} {
  #    .controls.switches.meterbutton configure -text $key
- #  HACK for MAC OSX -- backspace seems different; I don't understand why.
- #  investigate this LATER...
      puts "pdtk_canvas_key::: $canvas $x $y $key $iso $shift"
  
--- 2175,2178 ----
***************
*** 2998,3027 ****
  
  class_new bang {
  
! global offset _
! 
! set offset [expr $offset + 1]
! set canvas $_(focus)
! 
! set bang_id [format %x [expr 0x81168b0 - $offset]]
! 
! puts "new object id -> $bang_id"
! 
! set _($bang_id:w) 15
! set _($bang_id:rcv) 1
! set _($bang_id:snd) 1
! set _($bang_id:bcol) 20
! set _($bang_id:fcol) 5
! set _($bang_id:ldx) 17
! set _($bang_id:ldy) 0
! set _($bang_id:lab) bang
! set _($bang_id:fstyle) 0
! set _($bang_id:fs) 10
! set _($bang_id:lcol) 13
! set _($bang_id:class) bang
! 
! 
! bang_draw $bang_id $canvas
! 
  }
  
--- 2909,2931 ----
  
  class_new bang {
+ 	global offset _
+ 	set offset [expr $offset + 1]
+ 	set canvas $_(focus)
+ 	set bang_id [format %x [expr 0x81168b0 - $offset]]
+ 	puts "new object id -> $bang_id"
  
! 	set _($bang_id:w) 15
! 	set _($bang_id:rcv) 1
! 	set _($bang_id:snd) 1
! 	set _($bang_id:bcol) 20
! 	set _($bang_id:fcol) 5
! 	set _($bang_id:ldx) 17
! 	set _($bang_id:ldy) 0
! 	set _($bang_id:lab) bang
! 	set _($bang_id:fstyle) 0
! 	set _($bang_id:fs) 10
! 	set _($bang_id:lcol) 13
! 	set _($bang_id:class) bang
! 	bang_draw $bang_id $canvas
  }
  
***************
*** 3035,3042 ****
  	set y2 [expr $y1+$ys]
  	set ins  [expr [string compare $@rcv empty]==0]
! 	set outs [expr [string compare $_($self:snd) empty]==0]
  	set colour [parse_color $@bcol]
  	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
  	if {$isnew} {
  		$canvas create oval \
--- 2939,2946 ----
  	set y2 [expr $y1+$ys]
  	set ins  [expr [string compare $@rcv empty]==0]
! 	set outs [expr [string compare $@snd empty]==0]
  	set colour [parse_color $@bcol]
  	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw      $self $canvas $x1 $y1 $xs $ys $ins $outs
  	if {$isnew} {
  		$canvas create oval \
***************
*** 3077,3081 ****
  	set colour [parse_color $@bcol]
  	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
  	set w 1
  	if {$xs >= 30} {set w 2}
--- 2981,2985 ----
  	set colour [parse_color $@bcol]
  	bluebox_draw $self $canvas $x1 $y1 $xs $ys $ins $outs
! 	io_draw      $self $canvas $x1 $y1 $xs $ys $ins $outs
  	set w 1
  	if {$xs >= 30} {set w 2}
***************
*** 3327,3334 ****
  	set @histi 0
  	set @command $command
  	frame $self
  	pack [frame  $self.1]   -side left -fill y
  	pack [frame  $self.1.1] -side top
! 	pack [button $self.1.1.expander -image icon_plus -command "listener_expand $self"] -side left
  	pack [label  $self.1.1.label -text "$name: "] -side left
  	pack [entry $self.entry -width 40] -side left -fill x -expand yes
--- 3231,3239 ----
  	set @histi 0
  	set @command $command
+ 	set @expanded 0
  	frame $self
  	pack [frame  $self.1]   -side left -fill y
  	pack [frame  $self.1.1] -side top
! 	pack [button $self.1.1.expander -image icon_plus -command "listener_toggle_expand $self"] -side left
  	pack [label  $self.1.1.label -text "$name: "] -side left
  	pack [entry $self.entry -width 40] -side left -fill x -expand yes
***************
*** 3336,3340 ****
  	bind $self.entry <Up>   "listener_up   $self"
  	bind $self.entry <Down> "listener_down $self"
! 	bind $self.entry <Return> $command
  }
  
--- 3241,3250 ----
  	bind $self.entry <Up>   "listener_up   $self"
  	bind $self.entry <Down> "listener_down $self"
! 	bind $self.entry <Return> "listener_eval $self"
! }
! 
! def listener toggle_expand {} {
! 	set @expanded [expr 1-$@expanded]
! 	if {$@expanded} {listener_expand $self} {listener_unexpand $self}
  }
  
***************
*** 3344,3349 ****
  	pack [text $self.entry -width 40 -height 8] -side left -fill x -expand yes
  	$self.entry insert 0.0 $text
! 	$self.1.1.expander configure -image icon_minus -command "listener_unexpand $self"
! 	#bind $self.entry <Alt-Return> $@command
  }
  
--- 3254,3259 ----
  	pack [text $self.entry -width 40 -height 8] -side left -fill x -expand yes
  	$self.entry insert 0.0 $text
! 	$self.1.1.expander configure -image icon_minus
! 	bind $self.entry <Alt-Return> "listener_eval $self"
  }
  
***************
*** 3354,3362 ****
  	pack [entry $self.entry -width 40] -side left -fill x -expand yes
  	$self.entry insert 0 $text
! 	$self.1.1.expander configure -image icon_plus -command "listener_expand $self"
! 	bind $self.entry <Up>   "listener_up   $self"
! 	bind $self.entry <Down> "listener_down $self"
! 	bind $self.entry <Return> $@command
! }	
  
  def listener up {} {
--- 3264,3272 ----
  	pack [entry $self.entry -width 40] -side left -fill x -expand yes
  	$self.entry insert 0 $text
! 	$self.1.1.expander configure -image icon_plus
! 	bind $self.entry <Up>     "listener_up   $self"
! 	bind $self.entry <Down>   "listener_down $self"
! 	bind $self.entry <Return> "listener_eval $self"
! }
  
  def listener up {} {
***************
*** 3379,3399 ****
  }
  
! proc tcl_eval {} {
! 	set l [.tcl.entry get]
! 	listener_append .tcl [.tcl.entry get]
! 	.tcl.entry delete 0 end
! 	post %s "tcl: $l\nreturns: [eval $l]"
  }
  
! proc pd_eval {} {
! 	set l [.pd.entry get]
! 	listener_append .tcl [.tcl.entry get]
! 	.tcl.entry delete 0 end
! 	pd "$l;\n"
! }
  
  after 0 {
  	listener_new .tcl "Tcl" {tcl_eval}
! 	listener_new .pd  "Pd" {pd_eval}
  }
  
--- 3289,3312 ----
  }
  
! def listener eval {} {
! 	set e $self.entry
! 	if {$@expanded} {
! 		set l [$e get 0.0 end]
! 		listener_append $self $l
! 		$e delete 0.0 end
! 	} {
! 		set l [$e get]
! 		listener_append $self $l
! 		$e delete 0 end
! 	}
! 	$@command $self $l
  }
  
! proc tcl_eval {self l} {post %s "tcl: $l\nreturns: [eval $l]"}
! proc  pd_eval {self l} {post %s "pd: $l\n"; pd "$l;\n"}
  
  after 0 {
  	listener_new .tcl "Tcl" {tcl_eval}
! 	listener_new .pd  "Pd"   {pd_eval}
  }
  
***************
*** 3414,3418 ****
  	{hradio  {hradio 0}}
  	{vu      {vumeter 0}}
! 	{dropper      {dropper 0}}
  	{canvas  {mycnv 0}}
  	{graph   {graph}}
--- 3327,3331 ----
  	{hradio  {hradio 0}}
  	{vu      {vumeter 0}}
! 	{dropper {dropper 0}}
  	{canvas  {mycnv 0}}
  	{graph   {graph}}
***************
*** 3430,3434 ****
  	global cmdline
  	set icons {mode_edit mode_run}
! 	set dir $cmdline(look)
  	foreach b $butt {
  		if {[string compare [lindex $b 2] noload]!=0} {
--- 3343,3347 ----
  	global cmdline
  	set icons {mode_edit mode_run}
! 	set dir $cmdline(icons)
  	foreach b $butt {
  		if {[string compare [lindex $b 2] noload]!=0} {
***************
*** 3462,3466 ****
  	entry $self.name -font {courier 9} -width 10 -border 0
  	$self.name insert 0 ".[lindex [split $self .] 1]"
! 	$self.name configure -state disabled
  	pack $self.name -side right
  }
--- 3375,3379 ----
  	entry $self.name -font {courier 9} -width 10 -border 0
  	$self.name insert 0 ".[lindex [split $self .] 1]"
! 	#$self.name configure -state disabled
  	pack $self.name -side right
  }





More information about the Pd-cvs mailing list