File: scrollbox.tcl

package info (click to toggle)
puredata 0.55.2%2Bds-1~bpo12%2B1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm-backports
  • size: 20,336 kB
  • sloc: ansic: 118,788; tcl: 10,221; cpp: 9,327; makefile: 1,632; sh: 1,476; python: 152; xml: 98; awk: 13
file content (285 lines) | stat: -rw-r--r-- 10,152 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
######### 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
}

array set ::scrollbox::entrytext {}

proc ::scrollbox::get_curidx { mytoplevel } {
    set box $mytoplevel.listbox.box
    if { ! [winfo exists $box] } {
        return
    }
    set idx [$box index active]
    if {$idx < 0 || \
            $idx == [$box index end]} {
        return [expr {[$box index end] + 1}]
    }
    return [expr $idx]
}
proc ::scrollbox::my_edit_cancel { mytoplevel popup initialvalue } {
    set ::scrollbox::entrytext($mytoplevel) $initialvalue
    destroy $popup
}

proc ::scrollbox::my_edit { mytoplevel {initialvalue {}} } {
    set lb $mytoplevel.listbox.box
    set popup $lb.popup

    if { ! [winfo exists $lb ] } {
        return $initialvalue
    }
    destroy $popup

    set ::scrollbox::entrytext($mytoplevel) $initialvalue
    set selected {}

    # calculate the position of the popup
    # if there's an original entry (edit), place it over that
    # if there's none (add), shift it slightly left+down
    foreach {x y w h} {0 0 0 0} {break}
    foreach selected [$lb curselection] {break}
    if { $selected == "" } {
        foreach {x y w h} [$lb bbox end] {break}
        set y [expr $y + $h ]
    } else {
        foreach {x y _ _} [$lb bbox $selected] {break}
        if { $initialvalue == "" } {
            # adding a new entry: shift entry widget slightly down
            set y1 $y
            foreach {_ y1 _ _} [$lb bbox [expr $selected + 1]] {break}
            if { $y == $y1 } {
                set x [expr $x + 10]
                set y [expr $y + 10]
            } else {
                set x [expr $x + ($y1 - $y) / 2]
                set y [expr ($y + $y1) / 2 ]
            }
        }
    }

    # create a new popup entry
    entry $popup -textvariable ::scrollbox::entrytext($mytoplevel)
    $popup selection from 0
    $popup selection adjust end
    place $popup -x $x -y $y -relwidth 1.0
    focus $popup

    # override the Return/ESC bindings
    # note the 'break' at the end that prevents uplevel widgets from receiving the events
    bind $popup <KeyPress-Return> "destroy $popup; break"
    bind $popup <KeyPress-Escape> "::scrollbox::my_edit_cancel {$mytoplevel} {$popup} {$initialvalue}; break"
    bind $popup <FocusOut> "::scrollbox::my_edit_cancel {$mytoplevel} {$popup} {$initialvalue}; break"

    # wait until the user hits <Return> or <Escape>
    tkwait window $popup

    # and return the new value
    if {[catch {set value $::scrollbox::entrytext($mytoplevel)}]} {
        ## if the user double-clicked while editing, this proc is called multiple times in parallel
        ## if this happened, the latecomers are skipped
        return ""
    }
    array unset ::scrollbox::entrytext $mytoplevel
    return $value
}

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 } {
    if { $add_method == "" } {
        set dir [::scrollbox::my_edit $mytoplevel ]
    } else {
        set dir [$add_method]
    }
    set idx [get_curidx $mytoplevel]
    if { $idx ne {} } {
        insert_item $mytoplevel [expr {[get_curidx $mytoplevel] + 1}] $dir
    }
}

proc ::scrollbox::edit_item { mytoplevel edit_method } {
    set idx [get_curidx $mytoplevel]
    if { $idx eq {} } {
        return
    }
    set box $mytoplevel.listbox.box
    set initialValue [$box get $idx]
    if {$initialValue != ""} {
        if { $edit_method == "" } {
            set dir [::scrollbox::my_edit $mytoplevel $initialValue ]
        } else {
            set dir [$edit_method $initialValue]
        }
        if { ! [winfo exists $box ] } {
            return
        }

        if {$dir != ""} {
            $box delete $idx
            insert_item $mytoplevel $idx $dir
        }
        $box activate $idx
        $box selection clear 0 end
        $box selection set active
        focus $box
    }
}

proc ::scrollbox::delete_item { mytoplevel } {
    set cursel [$mytoplevel.listbox.box curselection]
    foreach idx $cursel {
        $mytoplevel.listbox.box delete $idx
    }
    $mytoplevel.listbox.box selection set active
}

# 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
    }

    foreach {left top width height} {"" "" "" ""} {break}
    # listbox bbox returns an array of 4 items in the order:
    # left, top, width, height
    foreach {left top width height} [$mytoplevel.listbox.box bbox @$x,$y] {break}

    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 {title ""}} {
    if { ${title} eq "" } {
        frame $mytoplevel.listbox
    } else {
        labelframe $mytoplevel.listbox -text ${title} -padx 5 -pady 5
    }
    listbox $mytoplevel.listbox.box -relief raised -highlightthickness 0 \
        -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}; break"
    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 -padx 5 -ipadx 10
    pack $mytoplevel.actions.edit_path -side right -pady 2m -padx 5 -ipadx 10
    pack $mytoplevel.actions.add_path -side right -pady 2m -padx 5 -ipadx 10

    $mytoplevel.listbox.box activate end
    $mytoplevel.listbox.box selection set end
    focus $mytoplevel.listbox.box
}