[PD-cvs] pd/src desire.tk,1.1.2.319,1.1.2.320

Mathieu Bouchard matju at users.sourceforge.net
Sun Aug 13 06:47:28 CEST 2006


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

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
added more bugs in the completion code and stuff


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.319
retrieving revision 1.1.2.320
diff -C2 -d -r1.1.2.319 -r1.1.2.320
*** desire.tk	12 Aug 2006 15:52:48 -0000	1.1.2.319
--- desire.tk	13 Aug 2006 04:47:26 -0000	1.1.2.320
***************
*** 851,856 ****
      $self populate_menu .mbar.find {
  	find find_again find_last_error}
! #      slash  {$self audio 1}
! #      period {$self audio 0}
        # Q {$main really_quit}
        # s {$self save} S {$self save_as}
--- 851,856 ----
      $self populate_menu .mbar.find {
  	find find_again find_last_error}
!       # slash  {$self audio 1}
!       # period {$self audio 0}
        # Q {$main really_quit}
        # s {$self save} S {$self save_as}
***************
*** 1617,1626 ****
  	if {[info exists @isnew]} {set @isnew 0}
  	set @edit 1
! 	set @tab_repeats 0 
  	$@canvas obj_in_edit= $self
  	set @selected? 1
  	.$@canvas.c delete ${self}TEXT
  	$self update_size
! 	bind Text <Tab> "$self tab; continue"
  	set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
  	set font_str [format $font(str2) $new_size]
--- 1617,1626 ----
  	if {[info exists @isnew]} {set @isnew 0}
  	set @edit 1
! 	set @tab_repeats 0
  	$@canvas obj_in_edit= $self
  	set @selected? 1
  	.$@canvas.c delete ${self}TEXT
  	$self update_size
! 	#bind Text <Tab> "$self tab; continue"
  	set new_size [format %.0f [expr $font(size)*$_($@canvas:scale)]]
  	set font_str [format $font(str2) $new_size]
***************
*** 1644,1649 ****
  	
  	$self item text window [list [expr $cx+2] [expr $cy+2]] -window $t -anchor nw -tags "${self}text $self"
! 	
! 	
  	#$self draw
  	$t configure -pady 0 -padx 1
--- 1644,1648 ----
  	
  	$self item text window [list [expr $cx+2] [expr $cy+2]] -window $t -anchor nw -tags "${self}text $self"
! 
  	#$self draw
  	$t configure -pady 0 -padx 1
***************
*** 1653,1672 ****
  }
  
- def TextBox tab {} {
- 	puts "continue..................."
- 	if {[winfo exists .completion]} {
- 	#completion focus_switch Down .completion.comp .$@canvas.c.${self}text
- 	}
- 	
- 
- }
- 
  def TextBox key {widget x y key iso shift} {
  	after 0 "$self after_key $widget"
  	switch -- $key {
  		Tab {$self propose_completions; $widget configure -state disabled}
- 		#--------------------------------------- label completion
  		#default {lower .$@canvas.c.${self}propose $widget; set @tab_repeats 0}
- 		#---------------------------------------
  	}
  }
--- 1652,1660 ----
***************
*** 3156,3160 ****
      switch -- [lindex $mess 0] {
        "#N" {
- 	post "#N: $mess"
  	set class canvas
  	if {$isnew} {
--- 3144,3147 ----
***************
*** 3167,3171 ****
        }
        "#X" {
- 	post "#X: $mess"
  	set i 1
  	if {[lindex $mess 1] == "obj"} {set i 4}
--- 3154,3157 ----
***************
*** 3372,3376 ****
  
  def PropertiesDialog init {of} {
! 	super
  	set @of $of
  }
--- 3358,3362 ----
  
  def PropertiesDialog init {of} {
! 	super cancel apply ok
  	set @of $of
  }
***************
*** 4028,4032 ****
  
  def Slider bbox {} {
- 	puts [$self _inspect]
  	mset {x1 y1} [$self xy]
  	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
--- 4014,4017 ----
***************
*** 4341,4345 ****
  	set xs $@w
  	set ys $@h
! 	$self item BASE rectangle $x1 $y1 [expr $x1+$xs] [expr $y1+$ys] \
  		-fill [parse_color $@bcol]
  	super
--- 4326,4330 ----
  	set xs $@w
  	set ys $@h
! 	$self item BASE rectangle [list $x1 $y1 [expr $x1+$xs] [expr $y1+$ys]] \
  		-fill [parse_color $@bcol]
  	super
***************
*** 4616,4621 ****
  	set @name $name
  	set @focus ".completion.comp"
- 	set @x $x
- 	set @y $y
  	set @width 0
  	set @height 0
--- 4601,4604 ----
***************
*** 4632,4640 ****
  	foreach class $class_list {
  		if {[string length $s]==0 || [string first $s $class]>=0} {
! 			if {[can_say $class]} {
! 				set t "\[$class\]  [say $class]"
! 			} {
! 				set t "\[$class\]"
! 			}
  			$@listbox insert end $t
  			if {[string length $t] > [string length $@width]} {set @width [string length $t]}
--- 4615,4620 ----
  	foreach class $class_list {
  		if {[string length $s]==0 || [string first $s $class]>=0} {
! 			set t "\[$class\]"
! 			if {[can_say $class]} {append t "  [say $class]"}
  			$@listbox insert end $t
  			if {[string length $t] > [string length $@width]} {set @width [string length $t]}
***************
*** 4642,4646 ****
  	}
  	$@listbox selection set 0 0
- 	puts "matches ::: [$@listbox size] |||| width ::: $@width |||| height ::: $@height"
  }
  
--- 4622,4625 ----
***************
*** 4662,4666 ****
  		catch {
  			set xs [glob "$dir/*.pd*"]
- 			#foreach x $xs {lappend class_list "[lindex [file split $x] end] (not loaded)"}
  			foreach x $xs {
  				set fn [lindex [file split $x] end]
--- 4641,4644 ----
***************
*** 4687,4692 ****
  	pack [frame $f] -side top -fill both -expand yes
  	pack [label .$self.title -text ""] -side top
! 	listbox $f.1 -width 50 -height 20 -yscrollcommand "$f.2 set" \
! 		     -activestyle none
  	scrollbar $f.2 -command "$f.1 yview"
  	text    $f.3 -width 30 -height 20 -yscrollcommand "$f.4 set"
--- 4665,4669 ----
  	pack [frame $f] -side top -fill both -expand yes
  	pack [label .$self.title -text ""] -side top
! 	listbox $f.1 -width 50 -height 20 -yscrollcommand "$f.2 set" -activestyle none
  	scrollbar $f.2 -command "$f.1 yview"
  	text    $f.3 -width 30 -height 20 -yscrollcommand "$f.4 set"
***************
*** 4711,4723 ****
  	$self fill_box ""
  	#bind $f.1 <Button-1> "after 1 \"$self info $f.1 \""
! 	bind $f.1 <Button-1> "after 1 \"$self focus_switch Up $b.2\""
! 	bind $f.1 <KeyPress> "after 1 \"$self focus_switch %K $b.2\""
! 	#bind $b.2 <KeyPress> {after 1 "$self fill_box \[.$self.butt.2 get\]"}
! 	bind $b.2 <KeyPress> "after 1 \"$self focus_switch %K $b.2\""
! 	#after 1 "focus $b.2"
  }
  
  def* Completion list_callback {} {
! 	global class_list font
  	$self search_for_externs
  	set class_list [luniq [lsort $class_list]]
--- 4688,4700 ----
  	$self fill_box ""
  	#bind $f.1 <Button-1> "after 1 \"$self info $f.1 \""
! 	bind $f.1 <Button-1> "after 1 \"$self key Up $b.2\""
! 	foreach w [list $f.1 $b.2] {
! 		bind $w       <KeyPress> "after 1 \"$self key %K $w 0\""
! 		bind $w <Shift-KeyPress> "after 1 \"$self key %K $w 1\""
! 	}
  }
  
  def* Completion list_callback {} {
! 	global class_list
  	$self search_for_externs
  	set class_list [luniq [lsort $class_list]]
***************
*** 4725,4730 ****
  	toplevel .$self
  	wm protocol .$self WM_DELETE_WINDOW "$self cancel"
! 	#$self test_focus 
! 	#wm overrideredirect .$self 1
  	set canvas $@name
  	set f .$self.comp
--- 4702,4706 ----
  	toplevel .$self
  	wm protocol .$self WM_DELETE_WINDOW "$self cancel"
! 	wm overrideredirect .$self 1
  	set canvas $@name
  	set f .$self.comp
***************
*** 4745,4749 ****
  	$self fill_box [$@textbox get 1.0 1.end]
  	$f configure -width $@width
! 	set box_width [winfo reqwidth $f]
  	set box_height [winfo reqheight $f]
  	pack $f -side left -expand yes
--- 4721,4725 ----
  	$self fill_box [$@textbox get 1.0 1.end]
  	$f configure -width $@width
! 	set box_width  [winfo reqwidth  $f]
  	set box_height [winfo reqheight $f]
  	pack $f -side left -expand yes
***************
*** 4767,4782 ****
  	wm geometry .$self [winfo reqwidth .$self]x[winfo reqheight .$self]+$box_x+$box_y
  
! 	bind $f <Button-1> "after 1 \"$self focus_switch Up $@textbox\""
! 	bind $f <KeyPress> "$self focus_switch %K $@textbox"
! 	bind $f <Return> "after 1 \"$self complete\""
! 	# shouldn't bind Text here! -- matju
! 	bind Text <Tab> "$self tab $@textbox; continue"
! 	bind $@textbox <KeyPress> "$self focus_switch %K $@textbox"
! 	#bind $@textbox <Tab> "after 1 \"$self tab %K $@textbox $f \""
  	focus .$self.comp
  }
  
  def ClassBrowser complete {} {
- 	puts "complete me!!!!"
  	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox obj]} {
  		set cut [string first "text" $obj]
--- 4743,4756 ----
  	wm geometry .$self [winfo reqwidth .$self]x[winfo reqheight .$self]+$box_x+$box_y
  
! 	bind $f <Button-1> "after 1 \"$self complete\""
! 	bind $f <Return>   "after 1 \"$self complete\""
! 	bind $f       <KeyPress> "$self key %K $@textbox 0"
! 	bind $f <Shift-KeyPress> "$self key %K $@textbox 1"
! 	bind $@textbox <Tab>      "$self key %K $@textbox; break"
! 	bind $@textbox <KeyPress> "$self key %K $@textbox"
  	focus .$self.comp
  }
  
  def ClassBrowser complete {} {
  	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox obj]} {
  		set cut [string first "text" $obj]
***************
*** 4785,4811 ****
  	set i [$@listbox curselection]
  	set class [string range [lindex [$@listbox get $i] 0] 1 end-1]
- #	set class [lindex [$@listbox get $i] 0]
  	$@textbox delete 1.0 1.end
  	$@textbox insert 1.0 $class
  	$obj unedit
- 	#.$@name.c delete $self
- 	#destroy .$@name.c.comp
  	destroy .$self
- 
  }
  
! def ClassBrowser test_focus {} {
! 	if {[winfo exists .$self]} {
! 		after 500 $self test_focus
! 		puts "focus is:   [focus] || viewable: [winfo viewable .$self]"
! 	}
! }
! 
! def* ClassBrowser tab {textbox} {
! 	set $@focus $@listbox
! 	$self focus_switch Down $textbox
! }
  
! def* ClassBrowser focus_switch {key focus1} {
  	#focus1 = whatever
  	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox textself]} {
--- 4759,4774 ----
  	set i [$@listbox curselection]
  	set class [string range [lindex [$@listbox get $i] 0] 1 end-1]
  	$@textbox delete 1.0 1.end
  	$@textbox insert 1.0 $class
  	$obj unedit
  	destroy .$self
  }
  
! #def* ClassBrowser tab {textbox} {
! #	set $@focus $@listbox
! #	$self key Down $textbox
! #}
  
! def* ClassBrowser key {key focus1 {shift 0}} {
  	#focus1 = whatever
  	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox textself]} {
***************
*** 4813,4870 ****
  		set textself [string range $textself 0 [expr $cut -1]]
  	}
! 	if {$key != "Down" & $key != "Up"} {
! 	puts "------> focus_switch received none down/up key => $key"
  		if {$@focus == $@listbox} {
! 		puts "------> focus_switch focus = $@listbox"
! 		if {[regexp {^[a-zA-Z]{1}$} $key]} {
  			switch $self {
! 				browser {.$self.butt.2 insert end $key}
! 				completion {
! 					puts "------> focus_switch $@listbox receives letter key $key"
! 					$focus1 insert 1.end $key
! 					$textself after_key $@textbox
! 					$self fill_box [$focus1 get 1.0 1.end]
! 					puts "------> focus_switch focus = $focus1"
! 					focus $focus1
! 					set @focus $focus1
! 					}
! 				}
  			}
- 			
- 			if {$key == "BackSpace"} {focus $focus1; set @focus $focus1}
- 		}
- 		
- 		# continue tabbing will go through the matches
- 		if {$key == "Tab"} {
- 		    set next [expr [$@listbox index active] + 1] 
- 		    puts "------> focus_switch !!! move to the item $@select!! [$@listbox index active]"
- 		    if {$next >= [expr [$@listbox size] - 1]} {
- 			$@listbox activate 0
- 		    } else {
- 			#puts "------ [$@listbox yview] ------"
- 			$@listbox activate $next
- 			$@listbox selection clear 0 [expr [$@listbox size] - 1]
- 			$@listbox selection set $next $next
- 			if {$next >= [expr $@height - 1]} {$@listbox yview scroll 1 units}
  		    }
  		}
- 		
  		switch $self {
! 			browser {$self fill_box [$focus1 get]}
! 			completion {
! 				if {$@focus == $focus1 & $key != "Tab"} {
! 					puts "------> focus_switch receives $key @ $@focus"
! 					#if {[regexp {^[a-zA-Z]{1}$} $key]} {$focus1 insert 1.end $key}
! 					if {[winfo exists .$self]} {$self fill_box [$focus1 get 1.0 1.end]}
! 					#hum, no idea why i need after 1 for it to work...
! 					after 1 $textself after_key $@textbox
! 				}
! 			}
  		}
! 	} else {
! 		focus $@listbox
! 		set @focus $@listbox
! 		set @select 0
! 		if {$@name == "browser"} {$self info $@listbox}
  	}
  }
--- 4776,4823 ----
  		set textself [string range $textself 0 [expr $cut -1]]
  	}
!  	switch -regexp -- $key {
! 	  Up|Down {
! 		focus $@listbox
! 		set @focus $@listbox
! 		set @select 0
! 		if {$@name == "browser"} {$self info $@listbox}
! 	  }
! 	  Escape {after 1 "$self cancel"} ;# doesn't really work
! 	  Tab {
! 	    set next [$@listbox index active]
! 	    incr next
! 	    if {$next >= [$@listbox size]} {set next 0}
! 	    $@listbox activate $next
! 	    $@listbox selection clear 0 [expr [$@listbox size] - 1]
! 	    $@listbox selection set $next $next
! 	    if {$next >= [expr $@height - 1]} {$@listbox yview scroll 1 units}
! 	  }
! 	  Backspace {focus $focus1; set @focus $focus1}
! 	  default {
  		if {$@focus == $@listbox} {
! 		    if {[regexp {^[a-zA-Z]{1}$} $key]} {
  			switch $self {
! 			  browser {.$self.butt.2 insert end $key}
! 			  completion {
! 				$focus1 insert 1.end $key
! 				$textself after_key $@textbox
! 				$self fill_box [$focus1 get 1.0 1.end]
! 				focus $focus1
! 				set @focus $focus1
! 			  }
  			}
  		    }
  		}
  		switch $self {
! 		  browser {$self fill_box [$focus1 get]}
! 		  completion {
! 		    if {$@focus == $focus1 & $key != "Tab"} {
! 			if {[winfo exists .$self]} {$self fill_box [$focus1 get 1.0 1.end]}
! 			#hum, no idea why i need after 1 for it to work...
! 			after 1 $textself after_key $@textbox
! 		    }
! 		  }
  		}
! 	  }
  	}
  }
***************
*** 4877,4889 ****
  	$f.3 delete 0.0 end
  	$f.3 insert end "class $class\n"
! 	foreach {k v} $class_info($class) {
! 		$f.3 insert end "$k=\"$v\"\n"
! 	}
  }
  
- ############ completions
  def TextBox propose_completions {} {
  	global class_list
- 	# .x8241f48.c.x8242130text
  	set widget .$@canvas.c.${self}text
  	set propose .$@canvas.c.${self}propose
--- 4830,4838 ----
  	$f.3 delete 0.0 end
  	$f.3 insert end "class $class\n"
! 	foreach {k v} $class_info($class) {$f.3 insert end "$k=\"$v\"\n"}
  }
  
  def TextBox propose_completions {} {
  	global class_list
  	set widget .$@canvas.c.${self}text
  	set propose .$@canvas.c.${self}propose
***************
*** 4891,4895 ****
  	if {![info exists class_list]} {
  		pd pd update-class-list $self propose_completions
- 		post_to_gui "loading class list..."
  		return
  	}
--- 4840,4843 ----
***************
*** 4902,4910 ****
  			if {[string compare [say $class] "{{$class}}"]} {
  				lappend r "$class : [say $class]"
- 				lappend c $class
  			} {
  				lappend r $class
- 				lappend c $class
  			}
  			incr n
  		}
--- 4850,4857 ----
  			if {[string compare [say $class] "{{$class}}"]} {
  				lappend r "$class : [say $class]"
  			} {
  				lappend r $class
  			}
+ 			lappend c $class
  			incr n
  		}
***************
*** 4912,4924 ****
  	}
  	set r [join $r "\n"]
- 	#--------------------------------------- label completion
- 	#set next_obj [lindex $c $@tab_repeats]
- 	#puts "tab....$@tab_repeats ::: $next_obj"
- 	#$propose configure -width [string length $next_obj]
- 	#$propose delete 1.0 1.end
- 	#$propose insert 1.0 $next_obj
- 	#raise $propose $widget
- 	#incr @tab_repeats
- 	#---------------------------------------
  	mset {x1 y1 x2 y2} [$self bbox]
  	Completion new_as completion $@canvas $x1 $y1 $widget
--- 4859,4862 ----
***************
*** 4933,4939 ****
  
  proc properties_dialog {self w struct} {
-     #puts "self::: $self"
-     #puts "w::: $w"
-     #puts "struct::: $struct"
      global _ key
      set no_max_label 0
--- 4871,4874 ----
***************
*** 4959,4972 ****
  		frame $f
  		label $f.label -text $label
! 		# wtf, %6.6x sometimes gives me _8_ chars !?!
! 		#set c $_($self:$name)
! 		#switch -regexp -- $c { ^# { set c 0x[string trimleft $c #] } }
! 		#set c [expr $c & 0xFCFCFC]
! 		set c 0xFCFCFC
! 		set text_color [complement $_($self:$name)]
! 		button $f.color -text $_($self:$name) -font {Courier 10} -width 10 -pady 2 -fg $text_color \
! 			-command [list $self choose_col $f $name $_($self:$name)] \
! 			-relief sunken -background $_($self:$name) \
! 			-highlightbackground [format #%6.6x $c] -activebackground [darker $_($self:$name)]
  		set i 10
  		button $f.preset -text "..." -pady 2 -font {Helvetica 8} -command [list $self color_popup $f $name $i]
--- 4894,4903 ----
  		frame $f
  		label $f.label -text $label
! 		set c $_($self:$name)
! 		set text_color [complement $c]
! 		button $f.color -text $c -font {Courier 10} -width 10 -pady 2 -fg $text_color \
! 			-command [list $self choose_col $f $name $c] \
! 			-relief sunken -background $c \
! 			-highlightbackground "#ffffff" -activebackground [darker $c]
  		set i 10
  		button $f.preset -text "..." -pady 2 -font {Helvetica 8} -command [list $self color_popup $f $name $i]
***************
*** 5133,5137 ****
  		#	pack $f.b.3 -side top
  		#	pack $f.b -side left
! 		#	}	
  		    entry {}
  		    default {
--- 5064,5068 ----
  		#	pack $f.b.3 -side top
  		#	pack $f.b -side left
! 		#	}
  		    entry {}
  		    default {
***************
*** 5148,5155 ****
  	}
      }
-         
  }
  
- 
  ############ .pdrc editor
  #Turns #rgb into 3 elem list of decimal vals.
--- 5079,5084 ----
***************
*** 5187,5191 ****
  }
  
- 
  # this makes the tooltip
  proc balloon {w help} {
--- 5116,5119 ----
***************
*** 5206,5211 ****
      pack [message $top.txt -aspect 10000 -bg lightyellow \
              -font fixed -text $arg]
- #    set wmx [winfo rootx $w]
- #    set wmy [expr [winfo rooty $w]+[winfo height $w]]
      set wmx [expr [winfo rootx $w]+[winfo width $w]]
      set wmy       [winfo rooty $w]
--- 5134,5137 ----
***************
*** 5875,5891 ****
      Português (Portuguese): Nuno Godinho
      Italiano (Italian): Davide Morelli"
!     
  	.$self.text configure -state disabled
  }
  
- #c proc updatesel {_ sel} {
- #c   variable ""
- #c   set os [getsel $_]
- #c   up $_ canvas sel
- #c   redraw $_  [lsort -unique [concat $os $sel]]
- #c      }
- #c that thing..redraws anythign that is currently selected or was currently selected
- #c lsort proably does what u want (has an integer flag too)
- 
  set manager [Manager new]
  
--- 5801,5809 ----
      Português (Portuguese): Nuno Godinho
      Italiano (Italian): Davide Morelli"
! 
! 	# this looks bad on OSX, iirc
  	.$self.text configure -state disabled
  }
  
  set manager [Manager new]
  





More information about the Pd-cvs mailing list