[Richard Suchenwirth] 2007-09-28 - Installing Visual Studio 8, I found a [listbox] with some buttons to insert, delete, or move up or down items, and as I was waiting for a lengthy build, of course I had to try this in Tcl too :^) 

[WikiDbImage xlistbox.JPG]

For the "insert" function, a little overrideredirect toplevel with an entry is overlaid. This is however not very robust: pixel geometry needed to be tweaked (and is probably not right for other windowing themes), and it is only destroyed when the user hits <Return>. If he doesn't, multiple of those may be scattered over the screen... Improvement hints are very welcome.

 proc xlb'delete w {
    set sel [$w curselection]
    $w delete $sel
    if {$sel==[$w size]} {incr sel -1}
    $w selection set $sel
 }
 proc xlb'insert w {
    set sel [$w curselection]
    if {$sel eq ""} {set sel 0}
    $w insert $sel ""
    $w selection clear 0 end
    $w selection set $sel
    foreach {x0 y0 x1 y1} [$w bbox $sel] break
    regexp {\+(.+)\+(.+)} [winfo geometry [winfo parent $w]] -> xx yy
    regexp {\+(.+)\+(.+)} [winfo geometry $w] -> x2 y2
    set topl [toplevel .[clock clicks]]
    wm overrideredirect $topl 1
    wm geometry $topl +[expr {$x0+$xx+$x2+2}]+[expr {$y0+$yy+$y2+22}]
    pack [entry $topl.e -textvariable $topl]
    focus $topl.e
    bind $topl.e <Return> [list xlb'rewrite $w $topl $sel]
 }
 proc xlb'rewrite {w topl sel} {
    global $topl
    $w delete $sel
    $w insert $sel [set $topl]
    $w selection set $sel
    destroy $topl
 }
 proc xlb'move {w offset} {
    set sel [$w curselection]
    if {$sel ne "" && ($offset==-1 && $sel>0 || $offset==1 && $sel<[$w size]-1)} {
        set it [$w get $sel]
        $w delete $sel
        incr sel $offset
        $w insert $sel $it
        $w selection set $sel
    }
 }
#-- Test and demo:
 pack [frame .f] -anchor e
 button .f.+ -width 2 -text + -command {xlb'insert .l}
 button .f.x -width 2 -text x -command {xlb'delete .l}
 button .f.up -width 2 -text \u2191 -command {xlb'move .l -1} 
 button .f.dn -width 2 -text \u2193 -command {xlb'move .l 1}
 eval pack [winfo children .f] -side left

 pack [listbox .l]
 .l insert end foo bar grill baz wibble


----
[Category Example]