diff options
Diffstat (limited to 'pd/tcl/scrollbox.tcl')
| -rw-r--r-- | pd/tcl/scrollbox.tcl | 191 |
1 files changed, 191 insertions, 0 deletions
diff --git a/pd/tcl/scrollbox.tcl b/pd/tcl/scrollbox.tcl new file mode 100644 index 00000000..b06670a0 --- /dev/null +++ b/pd/tcl/scrollbox.tcl @@ -0,0 +1,191 @@ +######### scrollbox -- utility scrollbar with default bindings ####### +# scrollbox is used in the Path and Startup dialogs to edit lists of options + +package provide scrollbox 0.1 + +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 ::scrollbox::get_curidx { mytoplevel } { + set idx [$mytoplevel.listbox.box index active] + if {$idx < 0 || \ + $idx == [$mytoplevel.listbox.box index end]} { + return [expr {[$mytoplevel.listbox.box index end] + 1}] + } + return [expr $idx] +} + +proc ::scrollbox::insert_item { mytoplevel idx name } { + if {$name != ""} { + $mytoplevel.listbox.box insert $idx $name + set activeIdx [expr {[$mytoplevel.listbox.box index active] + 1}] + $mytoplevel.listbox.box see $activeIdx + $mytoplevel.listbox.box activate $activeIdx + $mytoplevel.listbox.box selection clear 0 end + $mytoplevel.listbox.box selection set active + focus $mytoplevel.listbox.box + } +} + +proc ::scrollbox::add_item { mytoplevel add_method } { + set dir [$add_method] + insert_item $mytoplevel [expr {[get_curidx $mytoplevel] + 1}] $dir +} + +proc ::scrollbox::edit_item { mytoplevel edit_method } { + set idx [expr {[get_curidx $mytoplevel]}] + set initialValue [$mytoplevel.listbox.box get $idx] + if {$initialValue != ""} { + set dir [$edit_method $initialValue] + + if {$dir != ""} { + $mytoplevel.listbox.box delete $idx + insert_item $mytoplevel $idx $dir + } + $mytoplevel.listbox.box activate $idx + $mytoplevel.listbox.box selection clear 0 end + $mytoplevel.listbox.box selection set active + focus $mytoplevel.listbox.box + } +} + +proc ::scrollbox::delete_item { mytoplevel } { + set cursel [$mytoplevel.listbox.box curselection] + foreach idx $cursel { + $mytoplevel.listbox.box delete $idx + } +} + +# Double-clicking on the listbox should edit the current item, +# or add a new one if there is no current +proc ::scrollbox::dbl_click { mytoplevel edit_method add_method x y } { + if { $x == "" || $y == "" } { + return + } + + set curBB [$mytoplevel.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 $mytoplevel $add_method + } else { + edit_item $mytoplevel $edit_method + } +} + +proc ::scrollbox::click { mytoplevel x y } { + # record the index of the current element being + # clicked on + variable ::lastIdx [$mytoplevel.listbox.box index @$x,$y] + + focus $mytoplevel.listbox.box +} + +# For drag-and-drop reordering, recall the last-clicked index +# and move it to the position of the item currently under the mouse +proc ::scrollbox::release { mytoplevel x y } { + variable lastIdx + set curIdx [$mytoplevel.listbox.box index @$x,$y] + + if { $curIdx != $::lastIdx } { + # clear any current selection + $mytoplevel.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 + } + + $mytoplevel.listbox.box insert $newIdx [$mytoplevel.listbox.box get $::lastIdx] + $mytoplevel.listbox.box delete $oldIdx + $mytoplevel.listbox.box activate $newIdx + $mytoplevel.listbox.box selection set $selIdx + } +} + +# 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 ::scrollbox::make { mytoplevel listdata add_method edit_method } { + frame $mytoplevel.listbox + listbox $mytoplevel.listbox.box \ + -selectmode browse -activestyle dotbox \ + -yscrollcommand [list "$mytoplevel.listbox.scrollbar" set] + + # Create a scrollbar and keep it in sync with the current + # listbox view + pack $mytoplevel.listbox.box [scrollbar "$mytoplevel.listbox.scrollbar" \ + -command [list $mytoplevel.listbox.box yview]] \ + -side left -fill y -anchor w + + # Populate the listbox widget + foreach item $listdata { + $mytoplevel.listbox.box insert end $item + } + + # Standard listbox key/mouse bindings + event add <<Delete>> <Delete> + if { $::windowingsystem eq "aqua" } { event add <<Delete>> <BackSpace> } + + bind $mytoplevel.listbox.box <ButtonPress> "::scrollbox::click $mytoplevel %x %y" + bind $mytoplevel.listbox.box <Double-1> "::scrollbox::dbl_click $mytoplevel $edit_method $add_method %x %y" + bind $mytoplevel.listbox.box <ButtonRelease> "::scrollbox::release $mytoplevel %x %y" + bind $mytoplevel.listbox.box <Return> "::scrollbox::edit_item $mytoplevel $edit_method" + bind $mytoplevel.listbox.box <<Delete>> "::scrollbox::delete_item $mytoplevel" + + # <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 $mytoplevel <Configure> "$mytoplevel.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 $mytoplevel.listbox.box -side left -fill both -expand 1 + pack $mytoplevel.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 $mytoplevel.actions + pack $mytoplevel.actions -side top -padx 2m -fill x + button $mytoplevel.actions.add_path -text {New...} \ + -command "::scrollbox::add_item $mytoplevel $add_method" + button $mytoplevel.actions.edit_path -text {Edit...} \ + -command "::scrollbox::edit_item $mytoplevel $edit_method" + button $mytoplevel.actions.delete_path -text {Delete} \ + -command "::scrollbox::delete_item $mytoplevel" + + pack $mytoplevel.actions.delete_path -side right -pady 2m + pack $mytoplevel.actions.edit_path -side right -pady 2m + pack $mytoplevel.actions.add_path -side right -pady 2m + + $mytoplevel.listbox.box activate end + $mytoplevel.listbox.box selection set end + focus $mytoplevel.listbox.box +} |