#console show package require tkdnd namespace eval ::ix { proc qo {p t e} { set s [$p get $e] if {$s ne ""} { pd [concat $t.rp _cb symbol [pdtk_enquote $s] \;] } else {pd [concat $t.rp _cb bang \;]} } proc qi {p t i} { $p selection clear 0 end $p selection set $i qo $p $t $i } proc q_go {p t d} { array set direction "next 1 prev -1" array set edge "next end prev 0" set cs [$p curselection] if {$cs eq "" && [$p index end] != 0} { set go 0 } else { set go [expr $direction($d) + [lindex $cs $edge($d)]]} if {$go >= [$p index end]} {set go 0} if {$go < 0} {set go [expr [$p index end] - 1]} qi $p $t $go } } #> q listbox #. -selectmode extended -font {{Bitstream Vera Sans} 8} -exportselection 0 #. -relief flat -borderwidth 0 -selectborderwidth 0 -bg "#ccffcc" -fg black #. @list foreach x [list .#args] {.- insert end $x} #. @add .- insert end [join [lrange [list .#args] 0 end] " "] #. @scroll .- yview scroll .#1 units #. @symbol .- insert end {.#1} #. @float ::ix::qi .- .| .#1 #. @clear .- delete 0 end #. @next ::ix::q_go .- .| next #. @prev ::ix::q_go .- .| prev #. @cmd eval ".- .#args" bind .- {focus .-} bind .- {focus .^.c} bind .- <4> { pd [concat .|.rp _cb scroll -5 \;]} bind .- <5> { pd [concat .|.rp _cb scroll 5 \;]} bind .- {.- xview scroll [expr {- (%D / 120) * 4}] units} bind .- {} bind .- {dnd drag %W} dnd bindtarget .- text/plain { foreach l [split %D "\n"] {.- insert end [regsub -- {^file:[/]+} $l "/"]} } dnd bindtarget .- text/uri-list {foreach d %D {.- insert end [regsub -- {^file:[/]+} $d "/"]}} dnd bindsource .- text/uri-list { set sel [.- curselection] if {$sel ne ""} { set dd {} foreach el $sel { lappend dd [.- get $el] } return $dd } } bind .- <> { set sel [.- curselection] if {$sel ne ""} { ::ix::qo .- .| [lindex $sel end] # foreach el $sel { # ::ix::qo .- .| $el # } } } bind .- <> { set sel [.- curselection] if {$sel ne ""} { for {set i [expr [llength $sel] - 1]} {0 <= $i} {incr i -1} { .- delete [lindex $sel $i] } } } bind .- <> { .- selection set 0 end } event add <> event add <> event add <> event add <> puts "q .- .|"