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.