[PD-cvs] pd/src desire.tk,1.1.2.22,1.1.2.23
Mathieu Bouchard
matju at users.sourceforge.net
Sun Sep 4 10:31:20 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18595
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
adding code for: console, buttonbar, tooltips, classbrowser, completions.
note that most of that code is not functioning and has to be reintegrated with other components.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.22
retrieving revision 1.1.2.23
diff -C2 -d -r1.1.2.22 -r1.1.2.23
*** desire.tk 4 Sep 2005 06:59:08 -0000 1.1.2.22
--- desire.tk 4 Sep 2005 08:31:17 -0000 1.1.2.23
***************
*** 19,23 ****
proc def {class selector args body} {
! proc ${class}_$selector "self $args" "global _; $body"
}
--- 19,24 ----
proc def {class selector args body} {
! proc ${class}_$selector "self $args" \
! "global _; [regsub -all @(\\w+) $body _(\$self:\\1)]"
}
***************
*** 143,146 ****
--- 144,161 ----
# puts stderr [bind all]
+ set cmdline(console) 0
+
+ for {set i 0} {$i < $argc} {incr i} {
+ global cmdline
+ set o [lindex $argv $i]
+ switch -- $o {
+ -console {
+ incr i
+ set cmdline(console) [lindex $argv $i]
+ }
+ default {puts "ERROR: command line argument: unknown $o"}
+ }
+ }
+
################## set up main window #########################
menu .mbar
***************
*** 1241,1245 ****
puts "object_xy"
set canvas_id [canvastosym $canvas]
!
if {[info exists _($self:cx)]} {
return [list $_($self:cx) $_($self:cy)]
--- 1256,1260 ----
puts "object_xy"
set canvas_id [canvastosym $canvas]
!
if {[info exists _($self:cx)]} {
return [list $_($self:cx) $_($self:cy)]
***************
*** 2111,2116 ****
foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
wire_draw lnew $canvas 1 $cx $cy $cx $cy
! #!@#$ -dash blows up on OSX
! switch -- $pd_nt { 2 {} default { $canvas itemconfigure lnew -dash "4 4 4 4" }}
set wire_from [list $id $out]
return
--- 2126,2130 ----
foreach {ox1 oy1 ox2 oy2} [$canvas bbox ${id}o${out}] {}
wire_draw lnew $canvas 1 $cx $cy $cx $cy
! $canvas itemconfigure lnew -dash {4 4 4 4}
set wire_from [list $id $out]
return
***************
*** 3686,3702 ****
#####################################################################################
############ evaluator
def listener new {name command} {
! set _($self:hist) {}
! set _($self:histi) 0
! set _($self:command) $command
frame $self
! button $self.expander -image icon_plus -command "listener_expand $self"
! label $self.label -text "$name: "
! entry $self.entry -width 40
! pack $self.expander -side left
! pack $self.label -side left
! pack $self.entry -side left -fill x -expand yes
pack $self -fill x -expand no
bind $self.entry <Up> "listener_up $self"
--- 3700,3772 ----
#####################################################################################
+ ############ console
+
+ proc make_console {} {
+ global cmdline pd_nt
+ set errMsg ""
+ catch {
+ if {$cmdline(console) != 0} {
+ frame .log
+ text .log.1 -width 60 -height 10 -yscrollcommand ".log.2 set"
+ scrollbar .log.2 -command ".log.1 yview"
+ global tcl_version tk_version pd_myversion tcl_platform pd_nt
+ #.log.1 insert end "$pd_myversion"
+ .log.1 insert end "DesireData 0.39.A"
+ .log.1 insert end "Tcl $tcl_version, Tk $tk_version, pd_nt=$pd_nt\n"
+ foreach k [array names tcl_platform] {
+ .log.1 insert end "tcl_platform($k) = $tcl_platform($k)\n"
+ }
+ pack .log.1 -side left -fill both -expand yes
+ pack .log.2 -side left -fill y -expand no
+ pack .log -fill both -expand yes
+ .log.2 set 0.0 1.0
+ switch $pd_nt { 2 {
+ bind .log.1 <MouseWheel> {
+ .log.1 yview scroll [expr -2-abs(%D)/%D] units
+ }
+ }}
+ }
+ } errMsg
+ if {[string compare "" $errMsg] != 0} {puts stderr "ERROR: $errMsg"}
+ }
+
+ set console_scrollback_count 0
+ proc post_to_gui {x} {
+ global cmdline console_scrollback_count
+ if {[catch {
+ set oldpos [lindex [.log.2 get] 1]
+ .log.1 insert end $x
+ incr console_scrollback_count
+ if {$console_scrollback_count >= $cmdline(console)} {
+ .log.1 delete 1.0 2.0
+ }
+ if {$oldpos > 0.9999} {.log.1 see end}
+ }]} {
+ puts -nonewline stderr $x
+ }
+ }
+
+ proc post {args} {
+ global cmdline
+ if {$cmdline(console)} {
+ post_to_gui [eval [linsert $args 0 format]]
+ post_to_gui "\n"
+ } else {
+ puts stderr [eval [linsert $args 0 format]]
+ }
+ }
+
+ if {$cmdline(console)} {make_console}
+
############ evaluator
def listener new {name command} {
! set @hist {}
! set @histi 0
! set @command $command
frame $self
! pack [button $self.expander -image icon_plus -command "listener_expand $self"] -side left
! pack [label $self.label -text "$name: "] -side left
! pack [entry $self.entry -width 40] -side left -fill x -expand yes
pack $self -fill x -expand no
bind $self.entry <Up> "listener_up $self"
***************
*** 3709,3716 ****
destroy $self.entry
text $self.entry -width 40 -height 8
! $self.entry insert 0.0 $text
! pack $self.entry -side left -fill x -expand yes
$self.expander configure -image icon_minus -command "listener_unexpand $self"
! #bind $self.entry <Alt-Return> $_($self:command)
}
--- 3779,3785 ----
destroy $self.entry
text $self.entry -width 40 -height 8
! pack [$self.entry insert 0.0 $text] -side left -fill x -expand yes
$self.expander configure -image icon_minus -command "listener_unexpand $self"
! #bind $self.entry <Alt-Return> $@command
}
***************
*** 3725,3748 ****
bind $self.entry <Up> "listener_up $self"
bind $self.entry <Down> "listener_down $self"
! bind $self.entry <Return> $_($self:command)
}
def listener up {} {
! if {$_($self:histi) > 0} {set _($self:histi) [expr -1+$_($self:histi)]}
$self.entry delete 0 end
! $self.entry insert 0 [lindex $_($self:hist) $_($self:histi)]
$self.entry icursor end
}
def listener down {} {
! if {$_($self:histi) < [llength $_($self:hist)]} {incr _($self:histi)}
$self.entry delete 0 end
! $self.entry insert 0 [lindex $_($self:hist) $_($self:histi)]
$self.entry icursor end
}
def listener append {v} {
! lappend _($self:hist) $v
! set _($self:histi) [llength $_($self:hist)]
}
--- 3794,3817 ----
bind $self.entry <Up> "listener_up $self"
bind $self.entry <Down> "listener_down $self"
! bind $self.entry <Return> $@command
}
def listener up {} {
! if {$@histi > 0} {set @histi [expr -1+$@histi]}
$self.entry delete 0 end
! $self.entry insert 0 [lindex $@hist $@histi]
$self.entry icursor end
}
def listener down {} {
! if {$@histi < [llength $@hist]} {incr @histi}
$self.entry delete 0 end
! $self.entry insert 0 [lindex $@hist $@histi]
$self.entry icursor end
}
def listener append {v} {
! lappend @hist $v
! set @histi [llength $@hist]
}
***************
*** 3761,3769 ****
}
! #####################################################################################
! proc post {args} {
! # post_to_gui [eval [linsert $args 0 format]]
! # post_to_gui "\n"
! puts stderr [eval [linsert $args 0 format]]
}
--- 3830,4053 ----
}
! ############ button bar
! set butt {
! {object {obj 0}}
! {message {msg 0}}
! {number {floatatom 0}}
! {symbol {symbolatom 0}}
! {comment {text 0}}
! {bang {bng 0}}
! {toggle {toggle 0}}
! {number2 {numbox 0}}
! {vslider {vslider 0}}
! {hslider {hslider 0}}
! {vradio {vradio 0}}
! {hradio {hradio 0}}
! {vu {vumeter 0}}
! {dropper {dropper 0}}
! {canvas {mycnv 0}}
! {graph {graph}}
! {array {menuarray}}
! }
!
! proc button_bar_add {x y} {
! global butt
! lappend butt [list $x $y noload]
!
! }
!
! proc load_button_bar {} {
! global butt
! global cmdline
! set icons {mode_edit mode_run}
! set dir $cmdline(look)
! foreach b $butt {
! if {[string compare [lindex $b 2] noload]!=0} {
! lappend icons [lindex $b 0]
! }
! }
! foreach im $icons {
! set errMsg {}
! if {[catch {image create photo icon_$im -file $dir/$im.gif }]} {
! # post_to_gui "ERROR: $errorInfo\n"
! }
! }
! }
!
! set buttons_loaded 0
! proc make_button_bar {self doc} {
! global buttons_loaded
! if {!$buttons_loaded} {load_button_bar}
! global butt
! frame $self
! button $self.edit -image icon_mode_edit -border 1 \
! -command "menu_editmode $doc"
! pack $self.edit -side left
! foreach b $butt {
! catch {
! button "$self.[lindex $b 0]" -image "icon_[lindex $b 0]" -border 1 \
! -command [list pd "$doc [lindex $b 1] ;"]
! pack $self.[lindex $b 0] -side left
! }
! }
! 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
! }
!
! ############ tooltips
!
! set tooltip(mx) -1000
! set tooltip(my) -1000
! set tooltip(canvas) foo
! set tooltip(visible) 0
! set tooltip(text) ""
!
! # woops, self is for future use
! proc show_canvas_tooltip {self canvas x y text} {
! global current_x current_y tooltip
! if {$tooltip(visible) && [string compare $text $tooltip(text)==0]} {return}
! hide_canvas_tooltip $canvas
! set border 4
! set x [expr $x+$border+4]
! $canvas create text $x $y -text $text -anchor w -tags tooltip_fg
! foreach {x1 y1 x2 y2} [$canvas bbox tooltip_fg] {}
! set w 0
! set h 0
! $canvas create rectangle \
! [expr $x1-$border] [expr $y1-$border] \
! [expr $x2+$border] [expr $y2+$border] \
! -fill "#ffffcc" -outline "#000000" -tags tooltip_bg
! $canvas lower tooltip_bg tooltip_fg
! set tooltip(mx) $current_x
! set tooltip(my) $current_y
! set tooltip(canvas) $canvas
! set tooltip(visible) 1
! set tooltip(text) $text
! }
!
! proc hide_canvas_tooltip {canvas} {
! $canvas delete tooltip_bg tooltip_fg
! global tooltip
! set tooltip(visible) 0
! }
!
! ############ class list
!
! proc show_class_list {} {
! pd "pd update-path ; pd update-class-list class_list_callback ;"
! }
!
! proc class_list_fill_box {s} {
! global class_list
! set n 0
! .browser.cl.1 delete 0 end
! foreach class [lsort $class_list] {
! if {[string length $s]==0 || [string first $s $class]>=0} {
! .browser.cl.1 insert end "$class"
! incr n
! }
! }
! .browser.title configure -text "$n/[llength $class_list] registered object classes"
! .browser.cl.1 selection set 0 0
! }
!
! proc search_for_externs {} {
! global pd_path
! global class_list
! foreach dir $pd_path {
! catch {
! set xs [glob "$dir/*.pd*"]
! foreach x $xs {lappend class_list "[lindex [file split $x] end] (not loaded)"}
! }
! }
! }
!
! proc class_list_callback {} {
! global class_list
! search_for_externs
! toplevel .browser
! frame .browser.cl
! label .browser.title -text ""
! pack .browser.title -side top
! listbox .browser.cl.1 -width 30 -height 10 -yscrollcommand ".browser.cl.2 set"
! scrollbar .browser.cl.2 -command ".browser.cl.1 yview"
! text .browser.cl.3 -width 30 -height 10 -yscrollcommand ".browser.cl.4 set"
! scrollbar .browser.cl.4 -command ".browser.cl.3 yview"
! pack .browser.cl -side top -fill both -expand yes
!
! frame .browser.cl.5
! button .browser.cl.5.help -text "Help" -command {pd "pd help [.browser.cl.1 get [.browser.cl.1 curselection]] ;"}
! pack .browser.cl.5.help -side top
! pack .browser.cl.5 -side left -fill y -expand no
! pack .browser.cl.1 -side left -fill both -expand yes
! pack .browser.cl.2 -side left -fill y -expand no
! pack .browser.cl.3 -side left -fill both -expand yes
! pack .browser.cl.4 -side left -fill y -expand no
!
! frame .browser.butt
! label .browser.butt.1 -text "Filter: "
! entry .browser.butt.2 -width 15
! pack .browser.butt.1 .browser.butt.2 -side left
! button .browser.butt.close -text "Close" -command "destroy .browser"
! pack .browser.butt.close -side right
! pack .browser.butt -side bottom -fill x -expand no
! class_list_fill_box ""
! bind .browser.cl.1 <Button-1> {
! after 1 {
! set i [.browser.cl.1 curselection]
! set class [.browser.cl.1 get $i]
! pd "pd update-class-info $class ;"
! }
! }
! bind .browser.butt.2 <KeyPress> {after 1 {class_list_fill_box [.browser.butt.2 get]}}
! after 1 {focus .browser.butt.2}
}
+
+ proc class_info_callback {class} {
+ global class_info
+ set i [.browser.cl.1 curselection]
+ set class [.browser.cl.1 get $i]
+ .browser.cl.3 delete 0.0 end
+ .browser.cl.3 insert end "class $class\n"
+ foreach {k v} $class_info($class) {
+ .browser.cl.3 insert end "$k=\"$v\"\n"
+ }
+ }
+
+ ############ completions
+
+ set completion_closure {}
+
+ proc propose_completions {self canvas x y text} {
+ global class_list completion_closure
+ set completion_closure [list $self $canvas $x $y $text]
+ pd "pd update-class-list propose_completions2 ;"
+ if {![info exists class_list]} {
+ post_to_gui "loading class list..."
+
+ } else {
+ propose_completions2
+ }
+ }
+
+ proc propose_completions2 {} {
+ global class_list completion_closure
+ foreach {self canvas x y text} $completion_closure {}
+ set r {}
+ set n 0
+ foreach class [lsort $class_list] {
+ if {[string length $text]==0 || [string first $text $class]>=0} {
+ lappend r $class
+ incr n
+ }
+ if {$n > 20} {lappend r ...; break}
+ }
+ #post_to_gui "$r\n"
+ set r [string map {" " "\n"} $r]
+ global tooltip
+ show_canvas_tooltip $self $canvas $x $y $r
+ }
+
More information about the Pd-cvs
mailing list