diff options
Diffstat (limited to 'library/iconlist.tcl')
| -rw-r--r-- | library/iconlist.tcl | 97 |
1 files changed, 30 insertions, 67 deletions
diff --git a/library/iconlist.tcl b/library/iconlist.tcl index 84f5612..2503181 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -3,7 +3,7 @@ # Implements the icon-list megawidget used in the "Tk" standard file # selection dialog boxes. # -# RCS: @(#) $Id: iconlist.tcl,v 1.3 2009/10/08 12:40:31 dkf Exp $ +# RCS: @(#) $Id: iconlist.tcl,v 1.4 2010/03/12 13:53:43 dkf Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # Copyright (c) 2009 Donal K. Fellows @@ -30,36 +30,24 @@ package require Tk 8.6 -::oo::class create ::tk::IconList { - variable w hull canvas sbar accel accelCB arrangeCB fill font index \ +::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget { + variable w canvas sbar accel accelCB fill font index \ itemList itemsPerColumn list maxIH maxIW maxTH maxTW noScroll \ numItems oldX oldY options rect selected selection textList constructor args { - set w [namespace tail [self]] - my configure {*}$args - rename [self] _$w - my Create - rename ::$w theFrame - rename [self] ::$w - set arrangeCB {} + next {*}$args set accelCB {} } - self { - method unknown {w args} { - if {[string match .* $w]} { - [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 + next + } + + method GetSpecs {} { + concat [next] { + {-command "" "" ""} + {-font "" "" "TkIconFont"} + {-multiple "" "" "0"} } } @@ -192,27 +180,6 @@ package require Tk 8.6 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. # @@ -269,7 +236,8 @@ package require Tk 8.6 set textList($numItems) [string tolower $text] incr numItems } - my ArrangeWhenIdle + my WhenIdle Arrange + return } # Gets called when the user invokes the IconList (usually by @@ -330,18 +298,9 @@ package require Tk 8.6 # ---------------------------------------------------------------------- - 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 @@ -442,15 +401,13 @@ package require Tk 8.6 # operations. # method Create {} { - ttk::frame $w - set hull [ttk::entry $w.cHull -takefocus 0 -cursor {}] - set sbar [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] + variable hull + set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0] catch {$sbar configure -highlightthickness 0} - set canvas [canvas $w.cHull.canvas -highlightthick 0 -takefocus 1 \ + set canvas [canvas $hull.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 $sbar -side bottom -fill x -padx 2 -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] @@ -474,7 +431,7 @@ package require Tk 8.6 # Creates the event bindings. # - bind $canvas <Configure> [namespace code {my ArrangeWhenIdle}] + bind $canvas <Configure> [namespace code {my WhenIdle Arrange}] bind $canvas <1> [namespace code {my Btn1 %x %y}] bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}] @@ -501,8 +458,6 @@ package require Tk 8.6 bind $canvas <FocusIn> [namespace code {my FocusIn}] bind $canvas <FocusOut> [namespace code {my FocusOut}] - bind $hull <Destroy> [namespace code {my destroy}] - return $w } @@ -613,7 +568,7 @@ package require Tk 8.6 my AutoScan } method FocusIn {} { - $hull state focus + $w state focus if {![info exists list]} { return } @@ -622,7 +577,7 @@ package require Tk 8.6 } } method FocusOut {} { - $hull state !focus + $w state !focus $w selection clear 0 end } @@ -654,7 +609,8 @@ package require Tk 8.6 # Moves the active element left or right by one column # # Arguments: - # amount - +1 to move right one column, -1 to move left one column + # amount - +1 to move right one column, -1 to move left one + # column # method LeftRight amount { if {![info exists list]} { @@ -731,3 +687,10 @@ package require Tk 8.6 unset -nocomplain accel } } + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |