diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/choosedir.tcl | 11 | ||||
| -rw-r--r-- | library/iconlist.tcl | 725 | ||||
| -rw-r--r-- | library/tclIndex | 29 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 798 | ||||
| -rw-r--r-- | library/unsupported.tcl | 30 |
6 files changed, 749 insertions, 851 deletions
@@ -1,3 +1,10 @@ +2009-02-12 Donal K. Fellows <dkf@users.sf.net> + + * library/iconlist.tcl: Split out the IconList megawidget from + tkfbox.tcl into its own file so as to make it easier to maintain. Also + cleans up the API for the megawidget, making it more like a + conventional Tk widget. + 2009-02-11 Donal K. Fellows <dkf@users.sf.net> * library/demos/items.tcl, .../label.tcl, .../twind.tcl: diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 3d14664..2351781 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -5,7 +5,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.tcl,v 1.23 2007/12/13 15:26:27 dgp Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.24 2009/02/12 21:32:49 dkf Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -211,9 +211,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 4b. If the value is different from the current directory, change to # that directory. - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]] + set iconText [$data(icons) get [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] Done $w $iconText } else { @@ -261,10 +261,9 @@ proc ::tk::dialog::file::chooseDir::IsOK? {w text} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set filenameFragment \ - [tk::IconList_Get $data(icons) [lindex $selection 0]] + set filenameFragment [$data(icons) get [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w [list $filenameFragment] diff --git a/library/iconlist.tcl b/library/iconlist.tcl new file mode 100644 index 0000000..9828ecf --- /dev/null +++ b/library/iconlist.tcl @@ -0,0 +1,725 @@ +# iconlist.tcl +# +# Implements the icon-list megawidget used in the "Tk" standard file +# selection dialog boxes. +# +# RCS: @(#) $Id: iconlist.tcl,v 1.1 2009/02/12 21:32:49 dkf Exp $ +# +# Copyright (c) 1994-1998 Sun Microsystems, Inc. +# Copyright (c) 2009 Donal K. Fellows +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +package require Tk 8.6 + +oo::class create ::tk::IconList { + variable w canvas list index itemList textList selection sbar \ + maxIW maxIH maxTW maxTH numItems noScroll hull fill \ + selected rect font itemsPerColumn options arrangeCB + constructor args { + set w [namespace tail [self]] + my configure {*}$args + rename [self] _$w + my Create + rename ::$w theFrame + rename [self] ::$w + set arrangeCB {} + } + self { + method unknown {w args} { + if {[string match .* $w]} { + uplevel 1 [list [self] create $w {*}$args] + return $w + } + next $w {*}$args + } + unexport new unknown + } + destructor { + after cancel $arrangeCB + my Reset + if {[winfo exists $w]} { + bind $hull <Destroy> {} + destroy $w + } + } + + # ---------------------------------------------------------------------- + + method index i { + if {![info exist list]} { + set list {} + } + switch -regexp -- $i { + "^-?[0-9]+$" { + if {$i < 0} { + set i 0 + } + if {$i >= [llength $list]} { + set i [expr {[llength $list] - 1}] + } + return $i + } + "^anchor$" { + return $index(anchor) + } + "^end$" { + return [llength $list] + } + "@-?[0-9]+,-?[0-9]+" { + scan $i "@%d,%d" x y + set item [$canvas find closest \ + [$canvas canvasx $x] [$canvas canvasy $y]] + return [lindex [$canvas itemcget $item -tags] 1] + } + } + } + + method selection {op args} { + switch -exact -- $op { + anchor { + if {[llength $args] == 1} { + set index(anchor) [$w index [lindex $args 0]] + } else { + return $index(anchor) + } + } + clear { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + set ind 0 + foreach item $selection { + if {$item >= $first} { + set first $ind + break + } + incr ind + } + set ind [expr {[llength $selection] - 1}] + for {} {$ind >= 0} {incr ind -1} { + set item [lindex $selection $ind] + if {$item <= $last} { + set last $ind + break + } + } + + if {$first > $last} { + return + } + set selection [lreplace $selection $first $last] + event generate $w <<ListboxSelect>> + my DrawSelection + } + get { + return $selection + } + includes { + return [expr {[lindex $args 0] in $selection}] + } + set { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + + for {set i $first} {$i <= $last} {incr i} { + lappend selection $i + } + set selection [lsort -integer -unique $selection] + event generate $w <<ListboxSelect>> + my DrawSelection + } + } + } + + method get item { + set rTag [lindex $list $item 2] + lassign $itemList($rTag) iTag tTag text serial + return $text + } + + # Configure the widget variables of IconList, according to the command + # line arguments. + # + method configure args { + # 1: the configuration specs + # + set specs { + {-command "" "" ""} + {-font "" "" "TkIconFont"} + {-multiple "" "" "0"} + } + + # 2: parse the arguments + # + tclParseConfigSpec [my varname options] $specs "" $args + } + + method cget option { + return $options($option) + } + + # Deletes all the items inside the canvas subwidget and reset the + # iconList's state. + # + method deleteall {} { + $canvas delete all + unset -nocomplain selected rect list itemList + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + set noScroll 1 + set selection {} + set index(anchor) "" + $sbar set 0.0 1.0 + $canvas xview moveto 0 + } + + # Adds an icon into the IconList with the designated image and text + # + method add {image items} { + foreach text $items { + set iID item$numItems + set iTag [$canvas create image 0 0 -image $image -anchor nw \ + -tags [list icon $numItems $iID]] + set tTag [$canvas create text 0 0 -text $text -anchor nw \ + -font $options(-font) -fill $fill \ + -tags [list text $numItems $iID]] + set rTag [$canvas create rect 0 0 0 0 -fill "" -outline "" \ + -tags [list rect $numItems $iID]] + + lassign [$canvas bbox $iTag] x1 y1 x2 y2 + set iW [expr {$x2 - $x1}] + set iH [expr {$y2 - $y1}] + if {$maxIW < $iW} { + set maxIW $iW + } + if {$maxIH < $iH} { + set maxIH $iH + } + + lassign [$canvas bbox $tTag] x1 y1 x2 y2 + set tW [expr {$x2 - $x1}] + set tH [expr {$y2 - $y1}] + if {$maxTW < $tW} { + set maxTW $tW + } + if {$maxTH < $tH} { + set maxTH $tH + } + + lappend list [list $iTag $tTag $rTag $iW $iH $tW $tH $numItems] + set itemList($rTag) [list $iTag $tTag $text $numItems] + set textList($numItems) [string tolower $text] + incr numItems + } + my ArrangeWhenIdle + } + + # Gets called when the user invokes the IconList (usually by + # double-clicking or pressing the Return key). + # + method invoke {} { + if {$options(-command) ne "" && [llength $selection]} { + uplevel #0 $options(-command) + } + } + + # If the item is not (completely) visible, scroll the canvas so that it + # becomes visible. + # + method see rTag { + if {$noScroll} { + return + } + set sRegion [$canvas cget -scrollregion] + if {$sRegion eq ""} { + return + } + + if {$rTag < 0 || $rTag >= [llength $list]} { + return + } + + set bbox [$canvas bbox item$rTag] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + + set x1 [lindex $bbox 0] + set x2 [lindex $bbox 2] + incr x1 [expr {$pad * -2}] + incr x2 [expr {$pad * -1}] + + set cW [expr {[winfo width $canvas] - $pad*2}] + + set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] + set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}] + set oldDispX $dispX + + # check if out of the right edge + # + if {($x2 - $dispX) >= $cW} { + set dispX [expr {$x2 - $cW}] + } + # check if out of the left edge + # + if {($x1 - $dispX) < 0} { + set dispX $x1 + } + + if {$oldDispX ne $dispX} { + set fraction [expr {double($dispX) / double($scrollW)}] + $canvas xview moveto $fraction + } + } + + # ---------------------------------------------------------------------- + + method ArrangeWhenIdle {} { + if {$arrangeCB eq ""} { + set arrangeCB [after idle [namespace code {my Arrange}]] + } + return + } + + # Places the icons in a column-major arrangement. + # + method Arrange {} { + set arrangeCB "" + + if {![info exists list]} { + if {[info exists canvas] && [winfo exists $canvas]} { + set noScroll 1 + $sbar configure -command "" + } + return + } + + set W [winfo width $canvas] + set H [winfo height $canvas] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + if {$pad < 2} { + set pad 2 + } + + incr W [expr {$pad*-2}] + incr H [expr {$pad*-2}] + + set dx [expr {$maxIW + $maxTW + 8}] + if {$maxTH > $maxIH} { + set dy $maxTH + } else { + set dy $maxIH + } + incr dy 2 + set shift [expr {$maxIW + 4}] + + set x [expr {$pad * 2}] + set y [expr {$pad * 1}] ; # Why * 1 ? + set usedColumn 0 + foreach sublist $list { + set usedColumn 1 + lassign $sublist iTag tTag rTag iW iH tW tH + + set i_dy [expr {($dy - $iH)/2}] + set t_dy [expr {($dy - $tH)/2}] + + $canvas coords $iTag $x [expr {$y + $i_dy}] + $canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] + $canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] + + incr y $dy + if {($y + $dy) > $H} { + set y [expr {$pad * 1}] ; # *1 ? + incr x $dx + set usedColumn 0 + } + } + + if {$usedColumn} { + set sW [expr {$x + $dx}] + } else { + set sW $x + } + + if {$sW < $W} { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command "" + $canvas xview moveto 0 + set noScroll 1 + } else { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command [list $canvas xview] + set noScroll 0 + } + + set itemsPerColumn [expr {($H-$pad) / $dy}] + if {$itemsPerColumn < 1} { + set itemsPerColumn 1 + } + + my DrawSelection + } + + method DrawSelection {} { + $canvas delete selection + $canvas itemconfigure selectionText -fill black + $canvas dtag selectionText + set cbg [ttk::style lookup TEntry -selectbackground focus] + set cfg [ttk::style lookup TEntry -selectforeground focus] + foreach item $selection { + set rTag [lindex $list $item 2] + foreach {iTag tTag text serial} $itemList($rTag) { + break + } + + set bbox [$canvas bbox $tTag] + $canvas create rect $bbox -fill $cbg -outline $cbg \ + -tags selection + $canvas itemconfigure $tTag -fill $cfg -tags selectionText + } + $canvas lower selection + return + } + + # Creates an IconList widget by assembling a canvas widget and a + # scrollbar widget. Sets all the bindings necessary for the IconList's + # operations. + # + method Create {} { + ttk::frame $w + set hull [ttk::entry $w.cHull -takefocus 0] + set sbar [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] + catch {$sbar configure -highlightthickness 0} + set canvas [canvas $w.cHull.canvas -highlightthick 0 -takefocus 1 \ + -width 400 -height 120 -background white] + pack $sbar -side bottom -fill x -padx 2 -in $hull -pady {0 2} + pack $canvas -expand yes -fill both -padx 2 -pady {2 0} + pack $hull -expand yes -fill both -ipadx 2 -ipady 2 + + $sbar configure -command [list $canvas xview] + $canvas configure -xscrollcommand [list $sbar set] + + # Initializes the max icon/text width and height and other variables + # + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + set noScroll 1 + set selection {} + set index(anchor) "" + set fg [option get $canvas foreground Foreground] + if {$fg eq ""} { + set fill black + } else { + set fill $fg + } + + # Creates the event bindings. + # + bind $canvas <Configure> [namespace code {my ArrangeWhenIdle}] + + bind $canvas <1> [namespace code {my Btn1 %x %y}] + bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}] + bind $canvas <B1-Leave> [namespace code {my Leave1 %x %y}] + bind $canvas <Control-1> [namespace code {my CtrlBtn1 %x %y}] + bind $canvas <Shift-1> [namespace code {my ShiftBtn1 %x %y}] + bind $canvas <B1-Enter> [list tk::CancelRepeat] + bind $canvas <ButtonRelease-1> [list tk::CancelRepeat] + bind $canvas <Double-ButtonRelease-1> \ + [namespace code {my Double1 %x %y}] + + bind $canvas <Control-B1-Motion> {;} + bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] + + bind $canvas <Up> [namespace code {my UpDown -1}] + bind $canvas <Down> [namespace code {my UpDown 1}] + bind $canvas <Left> [namespace code {my LeftRight -1}] + bind $canvas <Right> [namespace code {my LeftRight 1}] + bind $canvas <Return> [namespace code {my ReturnKey}] + bind $canvas <KeyPress> [namespace code {my KeyPress %A}] + bind $canvas <Control-KeyPress> ";" + bind $canvas <Alt-KeyPress> ";" + + bind $canvas <FocusIn> [namespace code {my FocusIn}] + bind $canvas <FocusOut> [namespace code {my FocusOut}] + + bind $hull <Destroy> [namespace code {my destroy}] + + return $w + } + + # This procedure is invoked when the mouse leaves an entry window with + # button 1 down. It scrolls the window up, down, left, or right, + # depending on where the mouse left the window, and reschedules itself + # as an "after" command so that the window continues to scroll until the + # mouse moves back into the window or the mouse button is released. + # + method AutoScan {} { + variable ::tk::Priv + if {![winfo exists $w]} return + set x $Priv(x) + set y $Priv(y) + if {$noScroll} { + return + } + if {$x >= [winfo width $canvas]} { + $canvas xview scroll 1 units + } elseif {$x < 0} { + $canvas xview scroll -1 units + } elseif {$y >= [winfo height $canvas]} { + # do nothing + } elseif {$y < 0} { + # do nothing + } else { + return + } + my Motion1 $x $y + set Priv(afterId) [after 50 [namespace code {my AutoScan}]] + } + + # ---------------------------------------------------------------------- + + # Event handlers + method Btn1 {x y} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + } + method CtrlBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w selection includes $i]} { + $w selection clear $i + } else { + $w selection set $i + $w selection anchor $i + } + } + } + method ShiftBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w index anchor] eq ""} { + $w selection anchor $i + } + $w selection clear 0 end + $w selection set anchor $i + } + } + + # Gets called on button-1 motions + # + method Motion1 {x y} { + variable ::tk::Priv + set Priv(x) $x + set Priv(y) $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + } + method ShiftMotion1 {x y} { + variable ::tk::Priv + set Priv(x) $x + set Priv(y) $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set anchor $i + } + method Double1 {x y} { + if {[llength $selection]} { + $w invoke + } + } + method ReturnKey {} { + $w invoke + } + method Leave1 {x y} { + variable ::tk::Priv + set Priv(x) $x + set Priv(y) $y + my AutoScan + } + method FocusIn {} { + $hull state focus + if {![info exists list]} { + return + } + if {[llength $selection]} { + my DrawSelection + } + } + method FocusOut {} { + $hull state !focus + $w selection clear 0 end + } + + # Moves the active element up or down by one element + # + # Arguments: + # amount - +1 to move down one item, -1 to move back one item. + # + method UpDown amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i $amount + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Moves the active element left or right by one column + # + # Arguments: + # amount - +1 to move right one column, -1 to move left one column + # + method LeftRight amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i [expr {$amount * $itemsPerColumn}] + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Gets called when user enters an arbitrary key in the listbox. + # + method KeyPress key { + variable ::tk::Priv + append Priv(ILAccel,[self]) $key + my Goto $Priv(ILAccel,[self]) + catch { + after cancel $Priv(ILAccel,[self],afterId) + } + set Priv(ILAccel,[self],afterId) \ + [after 500 [namespace code {my Reset}]] + } + method Goto text { + if {![info exists list]} { + return + } + if {$text eq "" || $numItems == 0} { + return + } + + if {[llength [$w selection get]]} { + set start [$w index anchor] + } else { + set start 0 + } + set theIndex -1 + set less 0 + set len [string length $text] + set len0 [expr {$len - 1}] + set i $start + + # Search forward until we find a filename whose prefix is a + # case-insensitive match with $text + while {1} { + if {[string equal -nocase -length $len0 $textList($i) $text]} { + set theIndex $i + break + } + incr i + if {$i == $numItems} { + set i 0 + } + if {$i == $start} { + break + } + } + + if {$theIndex > -1} { + $w selection clear 0 end + $w selection set $theIndex + $w selection anchor $theIndex + $w see $theIndex + } + } + method Reset {} { + variable ::tk::Priv + + unset -nocomplain Priv(ILAccel,[self]) + } +} diff --git a/library/tclIndex b/library/tclIndex index df4c046..6729ff3 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -79,6 +79,7 @@ set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]] set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]] set auto_index(::tk::FocusOK) [list source [file join $dir focus.tcl]] set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]] +set auto_index(::tk::IconList) [list source [file join $dir iconlist.tcl]] set auto_index(::tk::ListboxBeginSelect) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxMotion) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxBeginExtend) [list source [file join $dir listbox.tcl]] @@ -198,34 +199,6 @@ set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] -set auto_index(::tk::IconList) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Index) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Selection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CurSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DrawSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Get) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Config) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Create) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_AutoScan) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DeleteAll) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Add) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Arrange) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Invoke) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_See) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Btn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CtrlBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ShiftBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Motion1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Double1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ReturnKey) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Leave1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusIn) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusOut) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_UpDown) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_LeftRight) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_KeyPress) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Goto) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Reset) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]] diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 03d8859..c0ef0c4 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.71 2009/01/07 14:35:39 patthoyts Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.72 2009/02/12 21:32:49 dkf Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -19,780 +19,6 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -#---------------------------------------------------------------------- -# -# I C O N L I S T -# -# This is a pseudo-widget that implements the icon list inside the -# ::tk::dialog::file:: dialog box. -# -#---------------------------------------------------------------------- - -# ::tk::IconList -- -# -# Creates an IconList widget. -# -proc ::tk::IconList {w args} { - IconList_Config $w $args - IconList_Create $w -} - -proc ::tk::IconList_Index {w i} { - upvar #0 ::tk::$w data ::tk::$w:itemList itemList - if {![info exists data(list)]} { - set data(list) {} - } - switch -regexp -- $i { - "^-?[0-9]+$" { - if {$i < 0} { - set i 0 - } - if {$i >= [llength $data(list)]} { - set i [expr {[llength $data(list)] - 1}] - } - return $i - } - "^active$" { - return $data(index,active) - } - "^anchor$" { - return $data(index,anchor) - } - "^end$" { - return [llength $data(list)] - } - "@-?[0-9]+,-?[0-9]+" { - foreach {x y} [scan $i "@%d,%d"] { - break - } - set item [$data(canvas) find closest \ - [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] - return [lindex [$data(canvas) itemcget $item -tags] 1] - } - } -} - -proc ::tk::IconList_Selection {w op args} { - upvar ::tk::$w data - switch -exact -- $op { - "anchor" { - if {[llength $args] == 1} { - set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]] - } else { - return $data(index,anchor) - } - } - "clear" { - if {[llength $args] == 2} { - foreach {first last} $args { - break - } - } elseif {[llength $args] == 1} { - set first [set last [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - clear first ?last?" - } - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if {$first > $last} { - set tmp $first - set first $last - set last $tmp - } - set ind 0 - foreach item $data(selection) { - if { $item >= $first } { - set first $ind - break - } - incr ind - } - set ind [expr {[llength $data(selection)] - 1}] - for {} {$ind >= 0} {incr ind -1} { - set item [lindex $data(selection) $ind] - if { $item <= $last } { - set last $ind - break - } - } - - if { $first > $last } { - return - } - set data(selection) [lreplace $data(selection) $first $last] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - "includes" { - set index [lsearch -exact $data(selection) [lindex $args 0]] - return [expr {$index != -1}] - } - "set" { - if { [llength $args] == 2 } { - foreach {first last} $args { - break - } - } elseif { [llength $args] == 1 } { - set last [set first [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - set first ?last?" - } - - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if { $first > $last } { - set tmp $first - set first $last - set last $tmp - } - for {set i $first} {$i <= $last} {incr i} { - lappend data(selection) $i - } - set data(selection) [lsort -integer -unique $data(selection)] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - } -} - -proc ::tk::IconList_CurSelection {w} { - upvar ::tk::$w data - return $data(selection) -} - -proc ::tk::IconList_DrawSelection {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete selection - $data(canvas) itemconfigure selectionText -fill black - $data(canvas) dtag selectionText - set cbg [ttk::style lookup TEntry -selectbackground focus] - set cfg [ttk::style lookup TEntry -selectforeground focus] - foreach item $data(selection) { - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - - set bbox [$data(canvas) bbox $tTag] - $data(canvas) create rect $bbox -fill $cbg -outline $cbg \ - -tags selection - $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText - } - $data(canvas) lower selection - return -} - -proc ::tk::IconList_Get {w item} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - return $text -} - -# ::tk::IconList_Config -- -# -# Configure the widget variables of IconList, according to the command -# line arguments. -# -proc ::tk::IconList_Config {w argList} { - - # 1: the configuration specs - # - set specs { - {-command "" "" ""} - {-multiple "" "" "0"} - } - - # 2: parse the arguments - # - tclParseConfigSpec ::tk::$w $specs "" $argList -} - -# ::tk::IconList_Create -- -# -# Creates an IconList widget by assembling a canvas widget and a -# scrollbar widget. Sets all the bindings necessary for the IconList's -# operations. -# -proc ::tk::IconList_Create {w} { - upvar ::tk::$w data - - ttk::frame $w - ttk::entry $w.cHull -takefocus 0 - set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] - catch {$data(sbar) configure -highlightthickness 0} - set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \ - -width 400 -height 120 -takefocus 1 -background white] - pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2} - pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0} - pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2 - - $data(sbar) configure -command [list $data(canvas) xview] - $data(canvas) configure -xscrollcommand [list $data(sbar) set] - - # Initializes the max icon/text width and height and other variables - # - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - set fg [option get $data(canvas) foreground Foreground] - if {$fg eq ""} { - set data(fill) black - } else { - set data(fill) $fg - } - - # Creates the event bindings. - # - bind $data(canvas) <Configure> [list tk::IconList_Arrange $w] - - bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y] - bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y] - bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y] - bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y] - bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y] - bind $data(canvas) <B1-Enter> [list tk::CancelRepeat] - bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat] - bind $data(canvas) <Double-ButtonRelease-1> \ - [list tk::IconList_Double1 $w %x %y] - - bind $data(canvas) <Control-B1-Motion> {;} - bind $data(canvas) <Shift-B1-Motion> \ - [list tk::IconList_ShiftMotion1 $w %x %y] - - bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1] - bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1] - bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1] - bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1] - bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w] - bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A] - bind $data(canvas) <Control-KeyPress> ";" - bind $data(canvas) <Alt-KeyPress> ";" - - bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w] - bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w] - - return $w -} - -# ::tk::IconList_AutoScan -- -# -# This procedure is invoked when the mouse leaves an entry window -# with button 1 down. It scrolls the window up, down, left, or -# right, depending on where the mouse left the window, and reschedules -# itself as an "after" command so that the window continues to scroll until -# the mouse moves back into the window or the mouse button is released. -# -# Arguments: -# w - The IconList window. -# -proc ::tk::IconList_AutoScan {w} { - upvar ::tk::$w data - variable ::tk::Priv - - if {![winfo exists $w]} return - set x $Priv(x) - set y $Priv(y) - - if {$data(noScroll)} { - return - } - if {$x >= [winfo width $data(canvas)]} { - $data(canvas) xview scroll 1 units - } elseif {$x < 0} { - $data(canvas) xview scroll -1 units - } elseif {$y >= [winfo height $data(canvas)]} { - # do nothing - } elseif {$y < 0} { - # do nothing - } else { - return - } - - IconList_Motion1 $w $x $y - set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]] -} - -# Deletes all the items inside the canvas subwidget and reset the IconList's -# state. -# -proc ::tk::IconList_DeleteAll {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete all - unset -nocomplain data(selected) data(rect) data(list) itemList - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - $data(sbar) set 0.0 1.0 - $data(canvas) xview moveto 0 -} - -# Adds an icon into the IconList with the designated image and text -# -proc ::tk::IconList_Add {w image items} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - upvar ::tk::$w:textList textList - - foreach text $items { - set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \ - -tags [list icon $data(numItems) item$data(numItems)]] - set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \ - -font $data(font) -fill $data(fill) \ - -tags [list text $data(numItems) item$data(numItems)]] - set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \ - -tags [list rect $data(numItems) item$data(numItems)]] - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] { - break - } - set iW [expr {$x2 - $x1}] - set iH [expr {$y2 - $y1}] - if {$data(maxIW) < $iW} { - set data(maxIW) $iW - } - if {$data(maxIH) < $iH} { - set data(maxIH) $iH - } - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] { - break - } - set tW [expr {$x2 - $x1}] - set tH [expr {$y2 - $y1}] - if {$data(maxTW) < $tW} { - set data(maxTW) $tW - } - if {$data(maxTH) < $tH} { - set data(maxTH) $tH - } - - lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \ - $tH $data(numItems)] - set itemList($rTag) [list $iTag $tTag $text $data(numItems)] - set textList($data(numItems)) [string tolower $text] - incr data(numItems) - } -} - -# Places the icons in a column-major arrangement. -# -proc ::tk::IconList_Arrange {w} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - if {[info exists data(canvas)] && [winfo exists $data(canvas)]} { - set data(noScroll) 1 - $data(sbar) configure -command "" - } - return - } - - set W [winfo width $data(canvas)] - set H [winfo height $data(canvas)] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - if {$pad < 2} { - set pad 2 - } - - incr W -[expr {$pad*2}] - incr H -[expr {$pad*2}] - - set dx [expr {$data(maxIW) + $data(maxTW) + 8}] - if {$data(maxTH) > $data(maxIH)} { - set dy $data(maxTH) - } else { - set dy $data(maxIH) - } - incr dy 2 - set shift [expr {$data(maxIW) + 4}] - - set x [expr {$pad * 2}] - set y [expr {$pad * 1}] ; # Why * 1 ? - set usedColumn 0 - foreach sublist $data(list) { - set usedColumn 1 - foreach {iTag tTag rTag iW iH tW tH} $sublist { - break - } - - set i_dy [expr {($dy - $iH)/2}] - set t_dy [expr {($dy - $tH)/2}] - - $data(canvas) coords $iTag $x [expr {$y + $i_dy}] - $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] - $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] - - incr y $dy - if {($y + $dy) > $H} { - set y [expr {$pad * 1}] ; # *1 ? - incr x $dx - set usedColumn 0 - } - } - - if {$usedColumn} { - set sW [expr {$x + $dx}] - } else { - set sW $x - } - - if {$sW < $W} { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command "" - $data(canvas) xview moveto 0 - set data(noScroll) 1 - } else { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command [list $data(canvas) xview] - set data(noScroll) 0 - } - - set data(itemsPerColumn) [expr {($H-$pad)/$dy}] - if {$data(itemsPerColumn) < 1} { - set data(itemsPerColumn) 1 - } - - IconList_DrawSelection $w -} - -# Gets called when the user invokes the IconList (usually by double-clicking -# or pressing the Return key). -# -proc ::tk::IconList_Invoke {w} { - upvar ::tk::$w data - - if {$data(-command) ne "" && [llength $data(selection)]} { - uplevel #0 $data(-command) - } -} - -# ::tk::IconList_See -- -# -# If the item is not (completely) visible, scroll the canvas so that -# it becomes visible. -proc ::tk::IconList_See {w rTag} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - if {$data(noScroll)} { - return - } - set sRegion [$data(canvas) cget -scrollregion] - if {$sRegion eq ""} { - return - } - - if { $rTag < 0 || $rTag >= [llength $data(list)] } { - return - } - - set bbox [$data(canvas) bbox item$rTag] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - - set x1 [lindex $bbox 0] - set x2 [lindex $bbox 2] - incr x1 -[expr {$pad * 2}] - incr x2 -[expr {$pad * 1}] ; # *1 ? - - set cW [expr {[winfo width $data(canvas)] - $pad*2}] - - set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] - set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}] - set oldDispX $dispX - - # check if out of the right edge - # - if {($x2 - $dispX) >= $cW} { - set dispX [expr {$x2 - $cW}] - } - # check if out of the left edge - # - if {($x1 - $dispX) < 0} { - set dispX $x1 - } - - if {$oldDispX ne $dispX} { - set fraction [expr {double($dispX)/double($scrollW)}] - $data(canvas) xview moveto $fraction - } -} - -proc ::tk::IconList_Btn1 {w x y} { - upvar ::tk::$w data - - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i -} - -proc ::tk::IconList_CtrlBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if { [IconList_Selection $w includes $i] } { - IconList_Selection $w clear $i - } else { - IconList_Selection $w set $i - IconList_Selection $w anchor $i - } - } -} - -proc ::tk::IconList_ShiftBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if {[IconList_Index $w anchor] eq ""} { - IconList_Selection $w anchor $i - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i - } -} - -# Gets called on button-1 motions -# -proc ::tk::IconList_Motion1 {w x y} { - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i -} - -proc ::tk::IconList_ShiftMotion1 {w x y} { - upvar ::tk::$w data - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i -} - -proc ::tk::IconList_Double1 {w x y} { - upvar ::tk::$w data - - if {[llength $data(selection)]} { - IconList_Invoke $w - } -} - -proc ::tk::IconList_ReturnKey {w} { - IconList_Invoke $w -} - -proc ::tk::IconList_Leave1 {w x y} { - variable ::tk::Priv - - set Priv(x) $x - set Priv(y) $y - IconList_AutoScan $w -} - -proc ::tk::IconList_FocusIn {w} { - upvar ::tk::$w data - - $w.cHull state focus - if {![info exists data(list)]} { - return - } - - if {[llength $data(selection)]} { - IconList_DrawSelection $w - } -} - -proc ::tk::IconList_FocusOut {w} { - $w.cHull state !focus - IconList_Selection $w clear 0 end -} - -# ::tk::IconList_UpDown -- -# -# Moves the active element up or down by one element -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move down one item, -1 to move back one item. -# -proc ::tk::IconList_UpDown {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [tk::IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [tk::IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i $amount - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -# ::tk::IconList_LeftRight -- -# -# Moves the active element left or right by one column -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move right one column, -1 to move left one column. -# -proc ::tk::IconList_LeftRight {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i [expr {$amount*$data(itemsPerColumn)}] - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -#---------------------------------------------------------------------- -# Accelerator key bindings -#---------------------------------------------------------------------- - -# ::tk::IconList_KeyPress -- -# -# Gets called when user enters an arbitrary key in the listbox. -# -proc ::tk::IconList_KeyPress {w key} { - variable ::tk::Priv - - append Priv(ILAccel,$w) $key - IconList_Goto $w $Priv(ILAccel,$w) - catch { - after cancel $Priv(ILAccel,$w,afterId) - } - set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]] -} - -proc ::tk::IconList_Goto {w text} { - upvar ::tk::$w data - upvar ::tk::$w:textList textList - - if {![info exists data(list)]} { - return - } - - if {$text eq "" || $data(numItems) == 0} { - return - } - - if {[llength [IconList_CurSelection $w]]} { - set start [IconList_Index $w anchor] - } else { - set start 0 - } - - set theIndex -1 - set less 0 - set len [string length $text] - set len0 [expr {$len-1}] - set i $start - - # Search forward until we find a filename whose prefix is a - # case-insensitive match with $text - while {1} { - if {[string equal -nocase -length $len0 $textList($i) $text]} { - set theIndex $i - break - } - incr i - if {$i == $data(numItems)} { - set i 0 - } - if {$i == $start} { - break - } - } - - if {$theIndex > -1} { - IconList_Selection $w clear 0 end - IconList_Selection $w set $theIndex - IconList_Selection $w anchor $theIndex - IconList_See $w $theIndex - } -} - -proc ::tk::IconList_Reset {w} { - variable ::tk::Priv - - unset -nocomplain Priv(ILAccel,$w) -} - -#---------------------------------------------------------------------- -# -# F I L E D I A L O G -# -#---------------------------------------------------------------------- - namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file { namespace import -force ::tk::msgcat::* @@ -1233,8 +459,7 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { } set iconListCommand [list ::tk::dialog::file::OkCmd $w] ::tk::SetAmpText $w.contents.f2.lab $fNameCaption - ::tk::IconList_Config $data(icons) \ - [list -multiple $multi -command $iconListCommand] + $data(icons) configure -multiple $multi -command $iconListCommand return } @@ -1313,7 +538,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] $w configure -cursor watch update idletasks - ::tk::IconList_DeleteAll $data(icons) + $data(icons) deleteall set showHidden $::tk::dialog::file::showHiddenVar @@ -1329,7 +554,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] } lappend dirList $d } - ::tk::IconList_Add $data(icons) $folder $dirList + $data(icons) add $folder $dirList if {$class eq "TkFDialog"} { # Make the file list if this is a File Dialog, selecting all @@ -1346,11 +571,9 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] eval [list lappend cmd] $data(filter) } set fileList [lsort -dictionary -unique [eval $cmd]] - ::tk::IconList_Add $data(icons) $file $fileList + $data(icons) add $file $fileList } - ::tk::IconList_Arrange $data(icons) - # Update the Directory: option menu # set list "" @@ -1417,7 +640,6 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { # proc ::tk::dialog::file::SetFilter {w type} { upvar ::tk::dialog::file::[winfo name $w] data - upvar ::tk::$data(icons) icons set data(filterType) $type set data(filter) [lindex $type 1] @@ -1446,7 +668,7 @@ proc ::tk::dialog::file::SetFilter {w type} { } } - $icons(sbar) set 0.0 0.0 + $data(icons) see 0 UpdateWhenIdle $w } @@ -1719,8 +941,8 @@ proc ::tk::dialog::file::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data set filenames {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend filenames [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend filenames [$data(icons) get $item] } if {([llength $filenames] && !$data(-multiple)) || \ @@ -1762,8 +984,8 @@ proc ::tk::dialog::file::ListBrowse {w} { upvar ::tk::dialog::file::[winfo name $w] data set text {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend text [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend text [$data(icons) get $item] } if {[llength $text] == 0} { return diff --git a/library/unsupported.tcl b/library/unsupported.tcl index 32e0a9e..cb66a8f 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -3,7 +3,7 @@ # Commands provided by Tk without official support. Use them at your # own risk. They may change or go away without notice. # -# RCS: @(#) $Id: unsupported.tcl,v 1.5 2005/11/25 15:58:15 dkf Exp $ +# RCS: @(#) $Id: unsupported.tcl,v 1.6 2009/02/12 21:32:49 dkf Exp $ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -88,34 +88,6 @@ namespace eval ::tk::unsupported { tkFocusOK ::tk::FocusOK tkGenerateMenuSelect ::tk::GenerateMenuSelect tkIconList ::tk::IconList - tkIconList_Add ::tk::IconList_Add - tkIconList_Arrange ::tk::IconList_Arrange - tkIconList_AutoScan ::tk::IconList_AutoScan - tkIconList_Btn1 ::tk::IconList_Btn1 - tkIconList_Config ::tk::IconList_Config - tkIconList_Create ::tk::IconList_Create - tkIconList_CtrlBtn1 ::tk::IconList_CtrlBtn1 - tkIconList_Curselection ::tk::IconList_CurSelection - tkIconList_DeleteAll ::tk::IconList_DeleteAll - tkIconList_Double1 ::tk::IconList_Double1 - tkIconList_DrawSelection ::tk::IconList_DrawSelection - tkIconList_FocusIn ::tk::IconList_FocusIn - tkIconList_FocusOut ::tk::IconList_FocusOut - tkIconList_Get ::tk::IconList_Get - tkIconList_Goto ::tk::IconList_Goto - tkIconList_Index ::tk::IconList_Index - tkIconList_Invoke ::tk::IconList_Invoke - tkIconList_KeyPress ::tk::IconList_KeyPress - tkIconList_Leave1 ::tk::IconList_Leave1 - tkIconList_LeftRight ::tk::IconList_LeftRight - tkIconList_Motion1 ::tk::IconList_Motion1 - tkIconList_Reset ::tk::IconList_Reset - tkIconList_ReturnKey ::tk::IconList_ReturnKey - tkIconList_See ::tk::IconList_See - tkIconList_Select ::tk::IconList_Select - tkIconList_Selection ::tk::IconList_Selection - tkIconList_ShiftBtn1 ::tk::IconList_ShiftBtn1 - tkIconList_UpDown ::tk::IconList_UpDown tkListbox ::tk::Listbox tkListboxAutoScan ::tk::ListboxAutoScan tkListboxBeginExtend ::tk::ListboxBeginExtend |