pd/src desire.tk,1.1.2.600.2.31,1.1.2.600.2.32 - Pd-cvs

7 Dec 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14363
Modified Files:
      Tag: desiredata
    desire.tk 
Log Message:
removed @isnew and implemented deferred-edit
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.31
retrieving revision 1.1.2.600.2.32
diff -C2 -d -r1.1.2.600.2.31 -r1.1.2.600.2.32
*** desire.tk	7 Dec 2006 01:12:25 -0000	1.1.2.600.2.31
--- desire.tk	7 Dec 2006 02:09:05 -0000	1.1.2.600.2.32
***************
*** 251,258 ****
  #   obj, msg, floatatom, symbolatom, text, connect, text_setto, array.
  # this does NOT happen with #X coords/restore/pop.
! proc netsend {message {callback nonesuch}} {
    global serial replyset sock
    if {$sock == ""} {error "connection to server needed for doing this"}
! 	if {[string compare $callback nonesuch]} {
    	set replyset($serial) $callback
    	incr serial
--- 251,258 ----
  #   obj, msg, floatatom, symbolatom, text, connect, text_setto, array.
  # this does NOT happen with #X coords/restore/pop.
! proc* netsend {message {callback noserial}} {
    global serial replyset sock
    if {$sock == ""} {error "connection to server needed for doing this"}
! 	if {[string compare $callback noserial]} {
    	set replyset($serial) $callback
    	incr serial
***************
*** 888,892 ****
      netsend "pd filename Untitled-$untitled_number $untitled_folder"
      netsend "#N canvas"
!     netsend "#X pop 1" {none}
      incr untitled_number
  }
--- 888,892 ----
      netsend "pd filename Untitled-$untitled_number $untitled_folder"
      netsend "#N canvas"
!     netsend "#X pop 1"
      incr untitled_number
  }
***************
*** 1775,1788 ****
    set y1 [expr $y/$@zoom]
    switch $sel {
! 		obj {netsend [join [concat [list .$self $sel $x $y] $args]] [list $self new_object_edit]}
! 		msg {netsend [join [concat [list .$self $sel $x $y] $args]] [list $self new_object_edit]}
! 		default {netsend [join [concat [list .$self $sel $x $y] $args]] [list $self new_object_callback]}
    }
! 	
  }
def Canvas new_object_callback {obj} {}
! 
! def Canvas new_object_edit {obj} {$obj isnew= 1}
def Canvas insertxy {} {return [list $@insert_x $@insert_y]}
--- 1775,1787 ----
    set y1 [expr $y/$@zoom]
    switch $sel {
! 		obj {    set goto [list $self new_object_edit]}
! 		msg {    set goto [list $self new_object_edit]}
! 		default {set goto [list $self new_object_callback]}
    }
! 	netsend [join [concat [list .$self $sel $x $y] $args]] $goto
  }
def Canvas new_object_callback {obj} {}
! def Canvas new_object_edit     {obj} {$obj edit}
def Canvas insertxy {} {return [list $@insert_x $@insert_y]}
***************
*** 1995,1999 ****
def TextBox draw {} {
- 	global font leet
    # "TEXT" is the text label while "text" is the the input text field tk widget.
    # the text should be drawn before, so that update_size works at the right time.
--- 1994,1997 ----
***************
*** 2001,2012 ****
    if {$@edit} {
    	set t [$@canvas widget].${self}text
    	$self item text window [list [expr {$x1+2}] [expr {$y1+2}]] \
    	-window $t -anchor nw -tags "${self}text $self text"
    } {
! 		if {$leet} {
! 			set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $@text]
! 		} else {
! 			set text $@text
! 		}
    	$self item TEXT text [l+ {2 2} [list $x1 $y1]] \
    	    -font [View_look $self font] -text $text \
--- 1999,2008 ----
    if {$@edit} {
    	set t [$@canvas widget].${self}text
+ 		if {![winfo exists $t]} {$self draw_edit}
    	$self item text window [list [expr {$x1+2}] [expr {$y1+2}]] \
    	-window $t -anchor nw -tags "${self}text $self text"
    } {
! 		set text $@text
! 		if {$::leet} {set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $text]}
    	$self item TEXT text [l+ {2 2} [list $x1 $y1]] \
    	    -font [View_look $self font] -text $text \
***************
*** 2021,2030 ****
def TextBox edit {} {
- 	global font
    if {$@edit} {return}
    set c [$@canvas widget]
    if {[lsearch [$@canvas selection] $self] < 0} {$@canvas selection+= $self}
    set t $c.${self}text
- 	#if {[info exists @isnew]} {set @isnew 0}
    set @edit 1
    set @tab_repeats 0
--- 2017,2029 ----
def TextBox edit {} {
    if {$@edit} {return}
+ 	set @edit 1
+ 	$self changed
+ }
+ 
+ def TextBox draw_edit {} {
    set c [$@canvas widget]
    if {[lsearch [$@canvas selection] $self] < 0} {$@canvas selection+= $self}
    set t $c.${self}text
    set @edit 1
    set @tab_repeats 0
***************
*** 2047,2053 ****
    	if {[string length $line] > $width} {set width [string length $line]}
    }
! 	text $t -height $nl -width $width -relief flat \
! 		-bg [$c itemcget ${self}BASE -fill] -borderwidth 0 -highlightthickness 0\
! 	        -font $font_str -fg [$self look fg] -insertbackground [$self look fg]
    bind $t <Key> "$self resize %K; $self key_input %W %x %y %K %A 0"
    bind $t <Control-Return> "$self key_input %W %x %y 10 %A 0"
--- 2046,2051 ----
    	if {[string length $line] > $width} {set width [string length $line]}
    }
! 	text $t -height $nl -width $width -relief flat -bg [$self look bg] -borderwidth 0 \
! 		-highlightthickness 0 -font $font_str -fg [$self look fg] -insertbackground [$self look fg]
    bind $t <Key> "$self resize %K; $self key_input %W %x %y %K %A 0"
    bind $t <Control-Return> "$self key_input %W %x %y 10 %A 0"
***************
*** 2147,2151 ****
    set @noutlets 0
    set @pdclass ""
- 	set @isnew 0
  }
--- 2145,2148 ----
***************
*** 2209,2214 ****
    super
          $self draw_io
! 	if {$@isnew} {$self edit} ;# why this here ?
! 	# @isnew indicates a object is newly created, and turn it into edit mode here..
  }
--- 2206,2210 ----
    super
          $self draw_io
! 	#if {$@isnew} {$self edit} ;# why this here ?
  }
***************
*** 2251,2255 ****
    set t $c.${self}text
    if {$accept} {$self setto [$t get 1.0 "end - 1 chars"]}
- 	if {[info exists @isnew]} {set @isnew 0}
    after 1 "destroy $t"
    if {[winfo exists .completion]} {$@action cancel}
--- 2247,2250 ----
***************
*** 2538,2542 ****
def Canvas motion {x y f target} {
- 	global font
    set c [$self widget]
    $self motion_checkhairtip $target $x $y
--- 2533,2536 ----
***************
*** 2929,2933 ****
    	}
    }
! 	netsend "#X pop 1" [list $self new_object_callback]
  }
--- 2923,2927 ----
    	}
    }
! 	netsend "#X pop 1"
  }
***************
*** 3957,3961 ****
  #	if {[$self class] == "Canvas"} {$self restack}
  }
- def Box isnew= {val} {set @isnew $val}
  def Box draw_box {} {}
  def Box edit {} {}
--- 3951,3954 ----
***************
*** 4025,4033 ****
  # View xy is virtual (for GOP)
  def Box moveto {x1 y1} {
! 	if {[info exists @isnew]} {
! 		if {!$@isnew} {netsend [join [list .$@canvas object_moveto !$self $x1 $y1]]}
! 	} else {
! 		netsend [join [list .$@canvas object_moveto !$self $x1 $y1]]
! 	}
    [$@canvas history] add [list $self moveto $@x1 $@y1]
    if {[$self class] == "Canvas"} {
--- 4018,4022 ----
  # View xy is virtual (for GOP)
  def Box moveto {x1 y1} {
! 	netsend ".$@canvas object_moveto !$self $x1 $y1"
    [$@canvas history] add [list $self moveto $@x1 $@y1]
    if {[$self class] == "Canvas"} {
***************
*** 4337,4342 ****
proc update_object {self e ninlets noutlets} {
- 	global paste
- 	#if {$paste(state) != "0"} {pasting_count $self}
    foreach mess [pd_mess_split $e] {update_object_2 $self $mess}
    if {[lindex $e 1] == "array"} {
--- 4326,4329 ----
***************
*** 4351,4373 ****
proc update_object_2 {self mess} {
! 	global _ classinfo canvas paste
    set isnew [expr ![info exists _($self:_class)]]
    switch -- [lindex $mess 0] {
! 		"#N" {
! 			set class canvas
! 			if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}
! 		}
    	"#X" {
! 			set i 1
! 			if {[lindex $mess 1] == "obj"} {set i 4}
    		set class [lindex $mess $i]
    		if {[info exists classinfo($class)]} {
    			set _class [lindex $classinfo($class) 0]
    		} else {
- 				#set class obj
    			set _class ObjectBox
- 				# this is not the same @isnew as $isnew !
- 				# in the future, @isnew should go elsewhere or disappear
- 			#	set _($self:isnew) [expr [llength $mess] == 4]
    		}
    		if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
--- 4338,4352 ----
proc update_object_2 {self mess} {
! 	global _ classinfo
    set isnew [expr ![info exists _($self:_class)]]
    switch -- [lindex $mess 0] {
! 		"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
    	"#X" {
! 			if {[lindex $mess 1] == "obj"} {set i 4} {set i 1}
    		set class [lindex $mess $i]
    		if {[info exists classinfo($class)]} {
    			set _class [lindex $classinfo($class) 0]
    		} else {
    			set _class ObjectBox
    		}
    		if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
***************
*** 4379,4387 ****
    	}
    	"#A" {
! 			post "#A: $mess"
    		$self array_set [lrange $mess 2 end]
    	}
    	"#V" {
! 			post "#V: $mess"
    	}
    	default {if {$mess != ""} {error "what you say? ($mess)"}}
--- 4358,4366 ----
    	}
    	"#A" {
! 			#post "#A: $mess"
    		$self array_set [lrange $mess 2 end]
    	}
    	"#V" {
! 			#post "#V: $mess"
    	}
    	default {if {$mess != ""} {error "what you say? ($mess)"}}
***************
*** 4432,4443 ****
  }
def MessageBox draw {} {
    super
    $self draw_io
    super
- 	#comment out the following to see what happens with the q......
- 	if {[info exists @isnew]} { 
- 		if {$@isnew} {$self edit;set @isnew 0; set @edit 1} 
- 	}
  }
--- 4411,4419 ----
  }
+ # shouldn't call super twice!
  def MessageBox draw {} {
    super
    $self draw_io
    super
  }
***************
*** 4470,4474 ****
def AtomBox draw {} {
- 	global font
    super
    mset {x1 y1} [$self xy]
--- 4446,4449 ----
***************
*** 4479,4484 ****
    	set string [string range $@text 0 [expr $@w-1]]
    }
- 	#$self item TEXT text [l+ {2 2} [list $x1 $y1]] \
- 	    #	-text $string -fill [$self look fg] -font $font(str) -anchor nw
    $self item TEXT text [l+ {2 2} [list $x1 $y1]] \
        -text $string -fill [$self look fg] -font [$self look font] -anchor nw
--- 4454,4457 ----