Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30076
Modified Files: Tag: devel_0_39 desire.tk Log Message: IEMPropertiesDialog: more bug fixes
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.363 retrieving revision 1.1.2.364 diff -C2 -d -r1.1.2.363 -r1.1.2.364 *** desire.tk 18 Aug 2006 01:16:33 -0000 1.1.2.363 --- desire.tk 18 Aug 2006 02:51:19 -0000 1.1.2.364 *************** *** 3206,3217 **** lappend orig $_($@of:$var) lappend props2 $@$var ;# does $@$ really work or not? if not, fix objective.tcl ... ! set v $@$var ! switch $var { ! is_log {set val [lsearch {linear logarithmic} $v]} ! isa {set val [lsearch {no yes} $v]} ! steady {set val [lsearch {steady jump} $v]} ! fstyle {set val [lsearch {no yes} $v]} ! default {set val $@$var} ! } if {[regexp -nocase {^([a-z])col$} $var]} {set val [unparse_color $val]} switch -- $val { {} {set val "empty"}} --- 3206,3210 ---- lappend orig $_($@of:$var) lappend props2 $@$var ;# does $@$ really work or not? if not, fix objective.tcl ... ! set val $@$var if {[regexp -nocase {^([a-z])col$} $var]} {set val [unparse_color $val]} switch -- $val { {} {set val "empty"}} *************** *** 3229,3240 **** if {![info exists fields($class)]} {set class obj} foreach var $fields($class) { ! set v $_($of:$var) ! switch $var { ! is_log {set val [say [lindex {linear logarithmic} $v]]} ! isa {set val [say [lindex {no yes} $v]]} ! steady {set val [say [lindex {steady jump} $v]]} ! fstyle {set val [say [lindex {no yes} $v]]} ! default {set val $_($of:$var)} ! } switch -- $val { empty {set val ""}} if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]} --- 3222,3226 ---- if {![info exists fields($class)]} {set class obj} foreach var $fields($class) { ! set val $_($of:$var) switch -- $val { empty {set val ""}} if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]} *************** *** 3247,3285 **** } foreach prop [lrange $fields($class) 5 end] { ! switch $prop { ! w {set d [list $prop [say $prop] integer {-width 7}]} ! h {set d [list $prop [say $prop] integer {-width 7}]} ! hold {set d [list $prop [say $prop] float {-width 9}]} ! break {set d [list $prop [say $prop] float {-width 9}]} ! min {set d [list $prop [say $prop] float {-width 9}]} ! max {set d [list $prop [say $prop] float {-width 9}]} ! is_log { ! set options [list [say $prop] [say linear] [say logarithmic]] ! set d [list $prop $options choice {}] ! } ! isa { ! set options [list [say $prop] 1 0] ! set d [list $prop $options choice {}] ! } ! n {set d [list $prop [say $prop] integer {-width 4}]} ! steady { ! set options [list [say $prop] [say jump] [say steady]] ! set d [list $prop $options choice {}] ! } ! snd {set d [list $prop [say $prop] entry {-width 20}]} ! rcv {set d [list $prop [say $prop] entry {-width 20}]} ! lab {set d [list $prop [say $prop] entry {-width 20}]} ! ldx {set d [list $prop [say $prop] integer {-width 5}]} ! ldy {set d [list $prop [say $prop] integer {-width 5}]} ! fstyle { ! set options [list [say $prop] "courier" "helvetica" "times"] ! set d [list $prop $options choice {}] ! } ! fs {set d [list $prop [say $prop] fontsize {-width 5}]} ! bcol {set d [list $prop [say $prop] color {}]} ! fcol {set d [list $prop [say $prop] color {}]} ! lcol {set d [list $prop [say $prop] color {}]} ! default {set d [list $prop "huh, [say $prop]" integer {}]} ! } properties_dialog $self .$self $d } --- 3233,3262 ---- } foreach prop [lrange $fields($class) 5 end] { ! set d [concat $prop [switch $prop { ! w {list "" integer {-width 7}} ! h {list "" integer {-width 7}} ! hold {list "" float {-width 9}} ! break {list "" float {-width 9}} ! min {list "" float {-width 9}} ! max {list "" float {-width 9}} ! is_log {list [list linear logarithmic] choice {}} ! isa {list [list no yes] choice {}} ! n {list "" integer {-width 4}} ! steady {list [list jump steady] choice {}} ! snd {list "" entry {-width 20}} ! rcv {list "" entry {-width 20}} ! lab {list "" entry {-width 20}} ! ldx {list "" integer {-width 5}} ! ldy {list "" integer {-width 5}} ! fstyle {list [list Courier Helvetica Times] choice {}} ! fs {list "" fontsize {-width 5}} ! bcol {list "" color {}} ! fcol {list "" color {}} ! lcol {list "" color {}} ! val {continue} ! on {continue} ! change {list "" integer {}} ! default {error "huh? ($prop)"} ! }]] properties_dialog $self .$self $d } *************** *** 4234,4238 **** def Listener up {} {if {$@histi>0} {set @histi [expr $@histi-1]; $self replace}} def Listener down {} {if {$@histi<[llength $@hist]} {incr @histi; $self replace}} ! def Listener append {v} {set @hist $v; set @histi [llength $@hist]}
def Listener eval {} { --- 4211,4215 ---- def Listener up {} {if {$@histi>0} {set @histi [expr $@histi-1]; $self replace}} def Listener down {} {if {$@histi<[llength $@hist]} {incr @histi; $self replace}} ! def Listener append {v} {lappend @hist $v; set @histi [llength $@hist]}
def Listener eval {} { *************** *** 4703,4709 **** global _ key set no_max_label 0 ! foreach {name label type options} $struct { set f $w.$name ! if {$label == ""} {set label [say $label]} switch -- $type { side { --- 4680,4687 ---- global _ key set no_max_label 0 ! # excuse me, 2nd argument mod 4 isn't for labeling anymore ! foreach {name choices type options} $struct { set f $w.$name ! set label "[say $name]: " switch -- $type { side { *************** *** 4719,4728 **** pack $f.side.top -side top pack $f.side.bottom -side bottom ! pack $f.side -side left } color { 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 \ --- 4697,4706 ---- pack $f.side.top -side top pack $f.side.bottom -side bottom ! pack $f.side -side left } color { frame $f label $f.label -text $label ! set c $_($self:$name) ;# bug in objtcl set text_color [complement $c] button $f.color -text $c -font {Courier 10} -width 10 -pady 2 -fg $text_color \ *************** *** 4736,4756 **** choice { frame $f set i 0 ! label $f.label -text [say [lindex [split $label |] 0]] ! #pack [label $f.label -text [lindex $label 0]] $f -side left ! # this which is not good, need to sort it out... ! set m [menu $f.$name -tearoff 0] ! set label [string range $label [expr [string first "|" $label 0]+1] end] ! foreach part [split $label |] { ! $m add command -label [say $part] -command [list $self dropmenu_set $f $name $part] ! } ! label $f.label_set -text [say $_($self:$name)] -relief raised -width 20 ! #label $f.label_set -text poo -relief raised -width 20 ! balloon $f.label_set "click to change setting" ! pack $f.label $f.label_set -side left ! # need to sort this out....... ! bind $f.label_set <1> "tk_popup $f.$name [expr %X - 100] %Y" ! } subsection { --- 4714,4729 ---- choice { frame $f + label $f.label -text $label + menu $f.menu -tearoff 0 set i 0 ! foreach part $choices { ! $f.menu add command -label [say $part] \ ! -command [list $self dropmenu_set $f $name $part $i] ! incr i } ! label $f.butt -text [say [lindex $choices $_($self:$name)]] -relief raised -width 20 ! balloon $f.butt "click to change setting" ! pack $f.label $f.butt -side left ! bind $f.butt <1> [list $self dropmenu_open $f] } subsection { *************** *** 4775,4780 **** set n 0 foreach item $label { ! if {$n != 0} {append text " & " [say $item]} else { set text [say $item]} ! incr n } pack [label $f.label -text $text] -side left --- 4748,4753 ---- set n 0 foreach item $label { ! if {$n != 0} {append text " & " [say $item]} else {set text [say $item]} ! incr n } pack [label $f.label -text $text] -side left *************** *** 4795,4799 **** pack [label $f.label -text $label -width 20 -anchor e] -side left listbox $f.a.list -width 50 -height 8 -yscrollcommand "$f.a.yscroll set" \ ! -activestyle none -xscrollcommand "$f.a.xscroll set" foreach line $_($self:$name) {$f.a.list insert end $line} set @$name $f.a.list ;# save the listbox path at @$name instead --- 4768,4772 ---- pack [label $f.label -text $label -width 20 -anchor e] -side left listbox $f.a.list -width 50 -height 8 -yscrollcommand "$f.a.yscroll set" \ ! -activestyle none -xscrollcommand "$f.a.xscroll set" foreach line $_($self:$name) {$f.a.list insert end $line} set @$name $f.a.list ;# save the listbox path at @$name instead *************** *** 4805,4825 **** pack $f.a.yscroll -side left -fill y pack $f.a -side left ! frame $f.b -borderwidth 0 button $f.b.3 -command "$self dir_select $f.a.list" -text "add" -width 6 ! balloon $f.b.3 "click to select directory" ! pack $f.b.3 -side top ! button $f.b.4 -command "$self dir_remove $f.a.list" -text "remove" -width 6 ! balloon $f.b.4 "click to select directory" ! pack $f.b.4 -side top ! button $f.b.5 -command "$self dir_up $f.a.list" -text "up" -width 6 ! balloon $f.b.5 "click to select directory" ! pack $f.b.5 -side top ! button $f.b.6 -command "$self dir_down $f.a.list" -text "down" -width 6 ! balloon $f.b.6 "click to select directory" ! pack $f.b.6 -side top pack $f.b -side top --- 4778,4792 ---- pack $f.a.yscroll -side left -fill y pack $f.a -side left ! frame $f.b -borderwidth 0 button $f.b.3 -command "$self dir_select $f.a.list" -text "add" -width 6 ! balloon $f.b.3 "add a directory using a file dialog" button $f.b.4 -command "$self dir_remove $f.a.list" -text "remove" -width 6 ! balloon $f.b.4 "remove directory selected in the list" button $f.b.5 -command "$self dir_up $f.a.list" -text "up" -width 6 ! balloon $f.b.5 "swap order with previous directory" button $f.b.6 -command "$self dir_down $f.a.list" -text "down" -width 6 ! balloon $f.b.6 "swap order with next directory" ! pack $f.b.3 $f.b.4 $f.b.5 $f.b.6 -side top pack $f.b -side top *************** *** 5000,5008 **** }
! def* Dialog dropmenu_set {frame var val} { ! $frame.label_set configure -text [say $val] ! set _($self:$var) $val }
def* Dialog color_popup_select {frame var color} { --- 4967,4980 ---- }
! def* Dialog dropmenu_open {frame} { ! set x [winfo rootx $frame.butt] ! set y [expr [winfo height $frame.butt] + [winfo rooty $frame.butt]] ! tk_popup $frame.menu $x $y }
+ def* Dialog dropmenu_set {frame var part val} { + $frame.butt configure -text [say $part] + set @$var $val + }
def* Dialog color_popup_select {frame var color} {