[PD-cvs] SF.net SVN: pure-data: [9911] branches/pd-extended/v0-40/pd/src/u_main.tk
eighthave at users.sourceforge.net
eighthave at users.sourceforge.net
Sun May 25 22:13:12 CEST 2008
Revision: 9911
http://pure-data.svn.sourceforge.net/pure-data/?rev=9911&view=rev
Author: eighthave
Date: 2008-05-25 13:13:10 -0700 (Sun, 25 May 2008)
Log Message:
-----------
checked in David Golightly's path and startup panels
Modified Paths:
--------------
branches/pd-extended/v0-40/pd/src/u_main.tk
Modified: branches/pd-extended/v0-40/pd/src/u_main.tk
===================================================================
--- branches/pd-extended/v0-40/pd/src/u_main.tk 2008-05-25 19:28:42 UTC (rev 9910)
+++ branches/pd-extended/v0-40/pd/src/u_main.tk 2008-05-25 20:13:10 UTC (rev 9911)
@@ -66,6 +66,37 @@
}
}
+# namespace for general-purpose functions
+proc pdtk_encode { listdata } {
+ set outlist {}
+ foreach this_path $listdata {
+ if {0==[string match "" $this_path]} {
+ lappend outlist [pdtk_encodedialog $this_path]
+ }
+ }
+ return $outlist
+}
+
+
+# args is a list of length 1 or 2,
+# specifying optional additional x, y offsets for the window
+proc center_window { w args } {
+ set offx 0
+ set offy 0
+
+ if { [llength $args] >= 2 } {
+ set offx [lindex $args 0]
+ set offy [lindex $args 1]
+ }
+
+ set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]] + $offx]
+ set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]] + $offy]
+ wm geom $w +$x+$y
+}
+
+
# start Pd-extended font hacks -----------------------------
# Pd-0.39.2-extended hacks to make font/box sizes the same across platform
@@ -4532,174 +4563,417 @@
}
}
-############ pdtk_path_dialog -- dialog window for search path #########
-proc path_apply {id} {
- global pd_extrapath pd_verbose
- global pd_path_count
- set pd_path {}
+############ namespace ScrollBox -- utility scrollbar with default bindings #########
+# This ScrollBox is used in the Path and Startup dialogs to edit lists of options
- for {set x 0} {$x < $pd_path_count} {incr x} {
- global pd_path$x
- set this_path [set pd_path$x]
- if {0==[string match "" $this_path]} {lappend pd_path [pdtk_encodedialog $this_path]}
+namespace eval ScrollBox {
+ # This variable keeps track of the last list element we clicked on,
+ # used to implement drag-drop reordering of list items
+ variable lastIdx 0
+
+ proc get_curidx { id } {
+ set idx [$id.listbox.box index active]
+ if {$idx < 0 || \
+ $idx == [$id.listbox.box index end]} {
+ return [expr {[$id.listbox.box index end] + 1}]
+ }
+ return [expr $idx]
}
- pd [concat pd path-dialog $pd_extrapath $pd_verbose $pd_path \;]
-}
+ proc insert_item { id idx name } {
+ if {$name != ""} {
+ $id.listbox.box insert $idx $name
+ set activeIdx [expr {[$id.listbox.box index active] + 1}]
+ $id.listbox.box see $activeIdx
+ $id.listbox.box activate $activeIdx
+ $id.listbox.box selection clear 0 end
+ $id.listbox.box selection set active
+ focus $id.listbox.box
+ }
+ }
-proc path_cancel {id} {
- pd [concat $id cancel \;]
-}
+ proc add_item { id add_method } {
+ set dir [$add_method]
+ insert_item $id [expr {[get_curidx $id] + 1}] $dir
+ }
-proc path_ok {id} {
- path_apply $id
- path_cancel $id
-}
+ proc edit_item { id edit_method } {
+ set idx [expr {[get_curidx $id]}]
+ set initialValue [$id.listbox.box get $idx]
+ if {$initialValue != ""} {
+ set dir [$edit_method $initialValue]
-proc pdtk_path_dialog {id extrapath verbose} {
- global pd_extrapath pd_verbose
- global pd_path
- global pd_path_count
+ if {$dir != ""} {
+ $id.listbox.box delete $idx
+ insert_item $id $idx $dir
+ }
+ $id.listbox.box activate $idx
+ $id.listbox.box selection clear 0 end
+ $id.listbox.box selection set active
+ focus $id.listbox.box
+ }
+ }
- set pd_path_count [expr [llength $pd_path] + 2]
- if { $pd_path_count < 10 } { set pd_path_count 10 }
+ proc delete_item { id } {
+ set cursel [$id.listbox.box curselection]
+ foreach idx $cursel {
+ $id.listbox.box delete $idx
+ }
+ }
- for {set x 0} {$x < $pd_path_count} {incr x} {
- global pd_path$x
- set pd_path$x [lindex $pd_path $x]
+ # Double-clicking on the listbox should edit the current item,
+ # or add a new one if there is no current
+ proc dbl_click { id edit_method add_method x y } {
+ if { $x == "" || $y == "" } {
+ return
+ }
+
+ set curBB [$id.listbox.box bbox @$x,$y]
+
+ # listbox bbox returns an array of 4 items in the order:
+ # left, top, width, height
+ set height [lindex $curBB 3]
+ set top [lindex $curBB 1]
+ if { $height == "" || $top == "" } {
+ # If for some reason we didn't get valid bbox info,
+ # we want to default to adding a new item
+ set height 0
+ set top 0
+ set y 1
+ }
+
+ set bottom [expr {$height + $top}]
+
+ if {$y > $bottom} {
+ add_item $id $add_method
+ } else {
+ edit_item $id $edit_method
+ }
}
- set pd_extrapath $extrapath
- set pd_verbose $verbose
- toplevel $id
- wm title $id {PD search path for patches and other files}
- wm protocol $id WM_DELETE_WINDOW [concat path_cancel $id]
+ proc click { id x y } {
+ # record the index of the current element being
+ # clicked on
+ set ::lastIdx [$id.listbox.box index @$x,$y]
- pdtk_panelkeybindings $id "path"
+ focus $id.listbox.box
+ }
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text {Cancel}\
- -command "path_cancel $id"
- button $id.buttonframe.apply -text {Apply}\
- -command "path_apply $id"
- button $id.buttonframe.ok -text {OK}\
- -command "path_ok $id"
- pack $id.buttonframe.cancel -side left -expand 1
- pack $id.buttonframe.apply -side left -expand 1
- pack $id.buttonframe.ok -side left -expand 1
-
- frame $id.extraframe
- pack $id.extraframe -side bottom -fill x -pady 2m
- checkbutton $id.extraframe.extra -text {use standard extensions} \
- -variable pd_extrapath -anchor w
- checkbutton $id.extraframe.verbose -text {verbose} \
- -variable pd_verbose -anchor w
- button $id.extraframe.save -text {Save all settings}\
- -command "path_apply $id \; pd pd save-preferences \\;"
- pack $id.extraframe.extra $id.extraframe.verbose $id.extraframe.save \
- -side left -expand 1
+ # For drag-and-drop reordering, recall the last-clicked index
+ # and move it to the position of the item currently under the mouse
+ proc release { id x y } {
+ set curIdx [$id.listbox.box index @$x,$y]
- for {set x 0} {$x < $pd_path_count} {incr x} {
- entry $id.f$x -textvariable pd_path$x -width 80
- pack $id.f$x -side top
+ if { $curIdx != $::lastIdx } {
+ # clear any current selection
+ $id.listbox.box selection clear 0 end
+
+ set oldIdx $::lastIdx
+ set newIdx [expr {$curIdx+1}]
+ set selIdx $curIdx
+
+ if { $curIdx < $::lastIdx } {
+ set oldIdx [expr {$::lastIdx + 1}]
+ set newIdx $curIdx
+ set selIdx $newIdx
+ }
+
+ $id.listbox.box insert $newIdx [$id.listbox.box get $::lastIdx]
+ $id.listbox.box delete $oldIdx
+ $id.listbox.box activate $newIdx
+ $id.listbox.box selection set $selIdx
+ }
}
- focus $id.f0
-}
+ # Make a ScrollBox widget in a given window and set of data.
+ #
+ # id - the parent window for the scrollbox
+ # listdata - array of data to populate the scrollbox
+ # add_method - method to be called when we add a new item
+ # edit_method - method to be called when we edit an existing item
+ proc make { id listdata add_method edit_method } {
+ global pd_nt
+ frame $id.listbox
+ listbox $id.listbox.box \
+ -selectmode browse -activestyle dotbox \
+ -yscrollcommand [list "$id.listbox.scrollbar" set]
-proc pd_set {var value} {
- global $var
- set $var $value
+ # Create a scrollbar and keep it in sync with the current
+ # listbox view
+ pack $id.listbox.box [scrollbar "$id.listbox.scrollbar" \
+ -command [list $id.listbox.box yview]] \
+ -side left -fill y -anchor w
+
+ # Populate the listbox widget
+ foreach item $listdata {
+ $id.listbox.box insert end $item
+ }
+
+ # Standard listbox key/mouse bindings
+ event add <<Delete>> <Delete>
+ if { $pd_nt == 2 } { event add <<Delete>> <BackSpace> }
+
+ bind $id.listbox.box <ButtonPress> "ScrollBox::click $id %x %y"
+ bind $id.listbox.box <Double-1> "ScrollBox::dbl_click $id $edit_method $add_method %x %y"
+ bind $id.listbox.box <ButtonRelease> "ScrollBox::release $id %x %y"
+ bind $id.listbox.box <Return> "ScrollBox::edit_item $id $edit_method"
+ bind $id.listbox.box <<Delete>> "ScrollBox::delete_item $id"
+
+ # <Configure> is called when the user modifies the window
+ # We use it to capture resize events, to make sure the
+ # currently selected item in the listbox is always visible
+ bind $id <Configure> "$id.listbox.box see active"
+
+ # The listbox should expand to fill its containing window
+ # the "-fill" option specifies which direction (x, y or both) to fill, while
+ # the "-expand" option (false by default) specifies whether the widget
+ # should fill
+ pack $id.listbox.box -side left -fill both -expand 1
+ pack $id.listbox -side top -pady 2m -padx 2m -fill both -expand 1
+
+ # All widget interactions can be performed without buttons, but
+ # we still need a "New..." button since the currently visible window
+ # might be full (even though the user can still expand it)
+ frame $id.actions
+ pack $id.actions -side top -padx 2m -fill x
+ button $id.actions.add_path -text {New...} \
+ -command "ScrollBox::add_item $id $add_method"
+ button $id.actions.edit_path -text {Edit...} \
+ -command "ScrollBox::edit_item $id $edit_method"
+ button $id.actions.delete_path -text {Delete} \
+ -command "ScrollBox::delete_item $id"
+
+ pack $id.actions.delete_path -side right -pady 2m
+ pack $id.actions.edit_path -side right -pady 2m
+ pack $id.actions.add_path -side right -pady 2m
+
+ $id.listbox.box activate end
+ $id.listbox.box selection set end
+ focus $id.listbox.box
+ }
}
-########## pdtk_startup_dialog -- dialog window for startup options #########
-proc startup_apply {id} {
- global pd_nort pd_flags
- global pd_startup_count
- set pd_startup {}
- for {set x 0} {$x < $pd_startup_count} {incr x} {
- global pd_startup$x
- set this_startup [set pd_startup$x]
- if {0==[string match "" $this_startup]} {lappend pd_startup [pdtk_encodedialog $this_startup]}
+############ namespace dlg_ScrollBoxWindow -- scrollbox window with default bindings #########
+## This is the base dialog behind the Path and Startup dialogs
+## This namespace specifies everything the two dialogs have in common,
+## with arguments specifying the differences
+##
+## By default, this creates a dialog centered on the viewing area of the screen
+## with cancel, apply, and OK buttons
+## which contains a ScrollBox widget populated with the given data
+namespace eval dlg_ScrollBoxWindow {
+ proc get_listdata { id } {
+ return [$id.listbox.box get 0 end]
}
- pd [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] $pd_startup \;]
+ proc do_apply { id commit_method listdata } {
+ $commit_method [pdtk_encode $listdata]
+ pd "pd save-preferences \;"
+ }
+
+ # Cancel button action
+ proc cancel { id } {
+ pd [concat $id cancel \;]
+ }
+
+ # Apply button action
+ proc apply { id commit_method } {
+ do_apply $id $commit_method [get_listdata $id]
+ }
+
+ # OK button action
+ # The "commit" action can take a second or more,
+ # long enough to be noticeable, so we only write
+ # the changes after closing the dialog
+ proc ok { id commit_method } {
+ set listdata [get_listdata $id]
+ cancel $id
+ do_apply $id $commit_method $listdata
+ }
+
+ # "Constructor" function for building the window
+ # id -- the window id to use
+ # listdata -- the data used to populate the scrollbox
+ # add_method -- a reference to a proc to be called when the user adds a new item
+ # edit_method -- same as above, for editing and existing item
+ # commit_method -- same as above, to commit during the "apply" action
+ # title -- top-level title for the dialog
+ # width, height -- initial width and height dimensions for the window, also minimum size
+ proc make { id listdata add_method edit_method commit_method title width height } {
+ toplevel $id
+ wm title $id $title
+ wm protocol $id WM_DELETE_WINDOW [concat dlg_ScrollBoxWindow::cancel $id]
+
+ # Enforce a minimum size for the window
+ wm minsize $id $width $height
+
+ # Set the current dimensions of the window
+ wm geometry $id "${width}x${height}"
+
+ # Center the window on the screen
+ after idle "center_window $id"
+
+ # Add the scrollbox widget
+ ScrollBox::make $id $listdata $add_method $edit_method
+
+ # Use two frames for the buttons, since we want them both
+ # bottom and right
+ frame $id.nb
+ pack $id.nb -side bottom -fill x -pady 2m
+
+ frame $id.nb.buttonframe
+ pack $id.nb.buttonframe -side right -padx 2m
+
+ button $id.nb.buttonframe.cancel -text {Cancel}\
+ -command "dlg_ScrollBoxWindow::cancel $id"
+ button $id.nb.buttonframe.apply -text {Apply}\
+ -command "dlg_ScrollBoxWindow::apply $id $commit_method"
+ button $id.nb.buttonframe.ok -text {OK}\
+ -command "dlg_ScrollBoxWindow::ok $id $commit_method"
+
+ pack $id.nb.buttonframe.cancel -side left -expand 1 -padx 2m
+ pack $id.nb.buttonframe.apply -side left -expand 1 -padx 2m
+ pack $id.nb.buttonframe.ok -side left -expand 1 -padx 2m
+ }
}
-proc startup_cancel {id} {
- pd [concat $id cancel \;]
+
+############ pdtk_path_dialog -- dialog window for search path #########
+namespace eval dlg_Path {
+ proc choosePath { curValue title } {
+ if {$curValue == ""} {
+ set curValue "~"
+ }
+ return [tk_chooseDirectory -initialdir $curValue -title $title]
+ }
+
+ proc add {} {
+ return [dlg_Path::choosePath "" {Add a new path}]
+ }
+
+ proc edit { curValue } {
+ return [dlg_Path::choosePath $curValue "Edit existing path \[$curValue\]"]
+ }
+
+ proc commit { new_path } {
+ global pd_extrapath pd_verbose
+ global pd_path
+ set pd_path $new_path
+
+ pd [concat pd path-dialog $pd_extrapath $pd_verbose $pd_path \;]
+ }
+
+ proc init { id extrapath verbose } {
+ global pd_extrapath pd_verbose
+ global pd_path
+
+ set pd_extrapath $extrapath
+ set pd_verbose $verbose
+
+ dlg_ScrollBoxWindow::make $id $pd_path \
+ dlg_Path::add dlg_Path::edit dlg_Path::commit \
+ {PD search path for patches and other files} \
+ 400 300
+
+ frame $id.extraframe
+ pack $id.extraframe -side bottom -pady 2m
+ checkbutton $id.extraframe.extra -text {use standard extensions} \
+ -variable pd_extrapath -anchor w
+ checkbutton $id.extraframe.verbose -text {verbose} \
+ -variable pd_verbose -anchor w
+ pack $id.extraframe.extra $id.extraframe.verbose \
+ -side left -expand 1
+ }
}
-proc startup_ok {id} {
- startup_apply $id
- startup_cancel $id
+proc pdtk_path_dialog { id extrapath verbose } {
+ dlg_Path::init $id $extrapath $verbose
}
-proc pdtk_startup_dialog {id nort flags} {
- global pd_nort pd_nt pd_flags
- global pd_startup
- global pd_startup_count
- set pd_startup_count [expr [llength $pd_startup] + 2]
- if { $pd_startup_count < 10 } { set pd_startup_count 10 }
+########## pdtk_startup_dialog -- dialog window for startup options #########
+namespace eval dlg_Startup {
+ # Create a simple modal window with an entry widget
+ # for editing/adding a startup command
+ # (the next-best-thing to in-place editing)
+ proc chooseCommand { prompt initialValue } {
+ global cmd
+ set cmd $initialValue
- for {set x 0} {$x < $pd_startup_count} {incr x} {
- global pd_startup$x
- set pd_startup$x [lindex $pd_startup $x]
- }
+ toplevel .inputBox
+ wm title .inputBox $prompt
+ wm minsize .inputBox 450 30
+ wm resizable .inputBox 1 0
+ wm geom .inputBox "450x30"
+ after idle { center_window .inputBox 10 50 }
- set pd_nort $nort
- set pd_flags $flags
- toplevel $id
- wm title $id {Pd binaries to load (on next startup)}
- wm protocol $id WM_DELETE_WINDOW [concat startup_cancel $id]
+ button .inputBox.cmdOK -text "OK" -command { destroy .inputBox }
- pdtk_panelkeybindings $id "startup"
+ entry .inputBox.txtInput -width 50 -textvariable cmd
+ pdtk_standardkeybindings .inputBox.txtInput
+ bind .inputBox.txtInput <KeyPress-Return> { destroy .inputBox }
+ bind .inputBox.txtInput <KeyPress-Escape> { destroy .inputBox }
+ pack .inputBox.txtInput -side left -expand 1 -fill x -padx 2m
+ pack .inputBox.cmdOK -side left
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text {Cancel}\
- -command "startup_cancel $id"
- button $id.buttonframe.apply -text {Apply}\
- -command "startup_apply $id"
- button $id.buttonframe.ok -text {OK}\
- -command "startup_ok $id"
- pack $id.buttonframe.cancel -side left -expand 1
- pack $id.buttonframe.apply -side left -expand 1
- pack $id.buttonframe.ok -side left -expand 1
-
- frame $id.flags
- pack $id.flags -side bottom
- label $id.flags.entryname -text {startup flags}
- entry $id.flags.entry -textvariable pd_flags -width 80
- pack $id.flags.entryname $id.flags.entry -side left
+ focus .inputBox.txtInput
- frame $id.nortframe
- pack $id.nortframe -side bottom -fill x -pady 2m
- if {$pd_nt != 1} {
- checkbutton $id.nortframe.nort -text {defeat real-time scheduling} \
- -variable pd_nort -anchor w
+ grab .inputBox
+ raise .inputBox
+ wm transient .inputBox
+ tkwait window .inputBox
+
+ return $cmd
}
- button $id.nortframe.save -text {Save all settings}\
- -command "startup_apply $id \; pd pd save-preferences \\;"
- if {$pd_nt != 1} {
- pack $id.nortframe.nort $id.nortframe.save -side left -expand 1
- } else {
- pack $id.nortframe.save -side left -expand 1
+
+ proc add {} {
+ return [chooseCommand {Add new startup command} ""]
}
+ proc edit { curValue } {
+ return [chooseCommand {Edit startup command} $curValue]
+ }
+ proc commit { new_startup } {
+ global pd_nort pd_flags
+ global pd_startup
+ set pd_startup $new_startup
- for {set x 0} {$x < $pd_startup_count} {incr x} {
- entry $id.f$x -textvariable pd_startup$x -width 80 -borderwidth 1 -bg grey98 \
- -highlightthickness 1 -highlightcolor blue
- pack $id.f$x -side top
+ pd [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] $pd_startup \;]
}
- focus $id.f0
+ proc init { id nort flags } {
+ global pd_nort pd_nt pd_flags
+ global pd_startup
+
+ set pd_nort $nort
+ set pd_flags $flags
+
+ dlg_ScrollBoxWindow::make $id $pd_startup \
+ dlg_Startup::add dlg_Startup::edit dlg_Startup::commit \
+ {PD binaries to load (on next startup)} \
+ 400 300
+
+ label $id.entryname -text {startup flags:}
+ entry $id.entry -textvariable pd_flags -width 60
+ bind $id.entry <KeyPress-Return> [concat dlg_Startup::ok $id]
+ pdtk_standardkeybindings $id.entry
+ pack $id.entryname $id.entry -side left
+ pack $id.entry -side right -padx 2m -fill x -expand 1
+
+ frame $id.nortframe
+ pack $id.nortframe -side bottom -fill x -pady 2m
+ if {$pd_nt != 1} {
+ checkbutton $id.nortframe.nort -text {defeat real-time scheduling} \
+ -variable pd_nort -anchor w
+ }
+ }
}
+proc pdtk_startup_dialog {id nort flags} {
+ dlg_Startup::init $id $nort $flags
+}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the Pd-cvs
mailing list