├── pkgIndex.tcl.in ├── license.terms ├── README.txt ├── configure.in ├── ANNOUNCE.txt ├── Makefile.in ├── CHANGES.txt ├── test.tcl ├── example.tcl ├── ChangeLog ├── mclistbox.test ├── mclistbox.pod ├── defs ├── mclistbox.html └── mclistbox.tcl /pkgIndex.tcl.in: -------------------------------------------------------------------------------- 1 | package ifneeded @PACKAGE@ @VERSION@ [list source [file join $dir mclistbox.tcl]] 2 | -------------------------------------------------------------------------------- /license.terms: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999, Bryan Douglas Oakley 2 | All Rights Reserved. 3 | 4 | This software is provided AS-IS with no waranty expressed or 5 | implied. This software may be used free of charge, though I would 6 | appreciate it if you give credit where credit is due and mention my 7 | name when you use it. 8 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Mclistbox version 1.02 2 | Copyright (c) 1999, Bryan Douglas Oakley 3 | All Rights Reserved. 4 | 5 | http://purl.oclc.org/net/oakley/tcl/mclistbox/index.html 6 | mailto:oakley@channelpoint.com 7 | 8 | This software is provided AS-IS with no waranty expressed or 9 | implied. This software may be used free of charge, though I would 10 | appreciate it if you give credit where credit is due and mention my 11 | name when you use it. 12 | 13 | To use, place mclistbox.tcl where your programs can get at it either 14 | via autoloading or from a "source" command. Then, use 15 | "mclistbox::mclistbox" to create a mclistbox, or do "import 16 | ::mclistbox::*" to use the mclistbox command without the namespace qualifier. 17 | 18 | To see a quick example, start up a wish process and cd to the directory 19 | where mclistbox.tcl is located. Then do "source example.tcl". 20 | 21 | To run some simple tests, source "test.tcl" or "mclistbox.test" 22 | 23 | -------------------------------------------------------------------------------- /configure.in: -------------------------------------------------------------------------------- 1 | AC_INIT(mclistbox.tcl) 2 | 3 | AC_CONFIG_AUX_DIR(config) 4 | CONFIGDIR=${srcdir}/config 5 | AC_SUBST(CONFIGDIR) 6 | 7 | PACKAGE=mclistbox 8 | 9 | MAJOR_VERSION=1 10 | MINOR_VERSION=02 11 | PATCHLEVEL= 12 | 13 | VERSION=${MAJOR_VERSION}.${MINOR_VERSION}${PATCHLEVEL} 14 | NODOT_VERSION=${MAJOR_VERSION}${MINOR_VERSION} 15 | 16 | AC_SUBST(PACKAGE) 17 | AC_SUBST(VERSION) 18 | eval AC_DEFINE_UNQUOTED(VERSION, "${VERSION}") 19 | 20 | AC_PROG_INSTALL 21 | 22 | #-------------------------------------------------------------------- 23 | # "cygpath" is used on windows to generate native path names for include 24 | # files. 25 | # These variables should only be used with the compiler and linker since 26 | # they generate native path names. 27 | # 28 | # Unix tclConfig.sh points SRC_DIR at the top-level directory of 29 | # the Tcl sources, while the Windows tclConfig.sh points SRC_DIR at 30 | # the win subdirectory. Hence the different usages of SRC_DIR below. 31 | # 32 | # This must be done before calling SC_PUBLIC_TCL_HEADERS 33 | #-------------------------------------------------------------------- 34 | 35 | case "`uname -s`" in 36 | *win32* | *WIN32* | *CYGWIN_NT*|*CYGWIN_98*|*CYGWIN_95*) 37 | CYGPATH="cygpath -w" 38 | ;; 39 | *) 40 | CYGPATH=echo 41 | ;; 42 | esac 43 | 44 | AC_SUBST(CYGPATH) 45 | 46 | AC_OUTPUT([Makefile \ 47 | pkgIndex.tcl]) 48 | -------------------------------------------------------------------------------- /ANNOUNCE.txt: -------------------------------------------------------------------------------- 1 | WHO: Bryan Oakley 2 | WHAT: mclistbox v1.02, a pure tcl multicolumn listbox widget 3 | WHERE: http://purl.oclc.org/net/oakley/tcl/mclistbox/index.html 4 | 5 | REQUIREMENTS: tcl/tk 8.0 or greater (8.0.3 recommended) 6 | SUPPORTS: all platforms supported by tcl 8.x 7 | 8 | 9 | WHAT'S NEW SINCE 1.0: 10 | 11 | * fixed bugs in how yview was computed. yview should now return 12 | the proper value even when the window is resized, and scrolling 13 | the listbox after resizing should properly scroll all the way 14 | up and down. 15 | 16 | * fixed some bugs when a column id has spaces in it 17 | 18 | * fixed a bug in the label bind command, where curly braces were 19 | improperly being added around the %W substitution. 20 | 21 | * added additional tests to the test suite, and improved the format 22 | of tests to be a bit more readable 23 | 24 | * added the file "defs" to the distribution, so that the test 25 | script (mclistbox.test) would work. This is a modified version 26 | of the "defs" file that comes with the tcl source. The modifications 27 | allow for a more human-friendly format of the test data 28 | 29 | * fixed a bug where the fill column wasn't filling properly 30 | 31 | * fixed a bug when trying to canonize a column name. 32 | 33 | 34 | BASIC FEATURES: 35 | 36 | * multiple columns, each which may have its own foreground and 37 | background colors (and fonts, with a caveat), and which may 38 | be visible or invisible. 39 | 40 | * column headers, which may be turned on or off. Headers may 41 | have fonts, colors and borders distinct from the columns 42 | 43 | * scrollable -- the width of all of the columns may exceed the 44 | size of the container; the view can be adjusted using normal 45 | methods (ie: by attaching scrollbars) 46 | 47 | * a -selectcommand option, which will run a command whenever 48 | the selection changes. Doing something when the selection 49 | changes seems to be something a lot of beginners stumble 50 | over; this feature is an attempt to alleviate that to some 51 | degree. 52 | 53 | * written in pure tcl. Nothing more to download or install. 54 | 55 | * completely, totally, free. I retain copyright but you are 56 | free to use the code however you see fit. Don't be mean. 57 | 58 | * fully cross-platform. Works on Macintosh, Unix, and other 59 | more inferior operating systems :-) 60 | 61 | * an API that is a superset of the standard listbox (for a low, 62 | low double-yer-money-back-guarantee learning curve) 63 | 64 | 65 | 66 | KNOWN BUGS: 67 | 68 | * I'm not sure if the option database code is working right; I'm 69 | not really up to speed on how best to use it. 70 | 71 | * if you use different fonts for different columns, if those 72 | fonts don't have the same line height the data will not line 73 | up properly. There is no workaround other than to use fonts 74 | with the same height. 75 | 76 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | # Makefile.in -- 2 | # 3 | # This file is a Makefile for the BLE executable. 4 | # 5 | # Copyright (c) 1999-2000 Ajuba Solutions. 6 | # 7 | # See the file "license.terms" for information on usage and redistribution 8 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9 | # 10 | # RCS: @(#) $Id: Makefile.in,v 1.6 2002/09/25 22:56:35 hobbs Exp $ 11 | 12 | 13 | MCLISTBOX_SOURCES = \ 14 | mclistbox.tcl 15 | 16 | PKGINDEX_TCL = \ 17 | pkgIndex.tcl 18 | 19 | #======================================================================== 20 | # Nothing of the variables below this line need to be changed. 21 | #======================================================================== 22 | 23 | SHELL = @SHELL@ 24 | EXEEXT = @EXEEXT@ 25 | 26 | srcdir = @srcdir@ 27 | top_srcdir = @top_srcdir@ 28 | prefix = @prefix@ 29 | exec_prefix = @exec_prefix@ 30 | bindir = @bindir@ 31 | libdir = @libdir@ 32 | 33 | pkglibdir = $(libdir)/@PACKAGE@@VERSION@ 34 | 35 | DESTDIR = 36 | 37 | top_builddir = . 38 | 39 | INSTALL = @INSTALL@ 40 | INSTALL_PROGRAM = @INSTALL_PROGRAM@ 41 | INSTALL_DATA = @INSTALL_DATA@ 42 | INSTALL_SCRIPT = @INSTALL_SCRIPT@ 43 | 44 | PACKAGE = @PACKAGE@ 45 | VERSION = @VERSION@ 46 | PROWRAP = @PROWRAP@ 47 | AUTOCONF = autoconf 48 | CYGPATH=@CYGPATH@ 49 | CONFIGDIR = @CONFIGDIR@ 50 | mkinstalldirs = $(SHELL) $(CONFIGDIR)/mkinstalldirs 51 | 52 | #======================================================================== 53 | # TEA TARGETS. Please note that the "libraries:" target refers to platform 54 | # independent files, and the "binaries:" target inclues executable programs and 55 | # platform-dependent libraries. Modify these targets so that they install 56 | # the various pieces of your package. The make and install rules 57 | # for the BINARIES that you specified above have already been done. 58 | #======================================================================== 59 | 60 | all: binaries libraries doc 61 | 62 | binaries: 63 | 64 | libraries: 65 | 66 | doc: 67 | 68 | install: all install-binaries install-libraries install-doc 69 | 70 | test: 71 | 72 | depend: 73 | 74 | install-binaries: 75 | 76 | install-libraries: installdirs 77 | @echo "Installing script files in $(DESTDIR)$(pkglibdir)" 78 | @for i in $(MCLISTBOX_SOURCES) ; do \ 79 | $(INSTALL_SCRIPT) $(srcdir)/$$i $(DESTDIR)$(pkglibdir) ; \ 80 | done; 81 | $(INSTALL_SCRIPT) $(PKGINDEX_TCL) $(DESTDIR)$(pkglibdir) 82 | 83 | install-doc: 84 | @echo "Installing html documentation in $(DESTDIR)$(pkglibdir)/html" 85 | @for i in $(srcdir)/*.html ; do \ 86 | $(INSTALL_SCRIPT) $$i $(DESTDIR)$(pkglibdir)/html; \ 87 | done; 88 | 89 | installdirs: 90 | $(mkinstalldirs) $(DESTDIR)$(pkglibdir) 91 | $(mkinstalldirs) $(DESTDIR)$(pkglibdir)/html 92 | 93 | clean: 94 | -test -z "$(BINARIES)" || rm -f $(BINARIES) 95 | -rm -f *.o core *.core 96 | -rm -f *.$(OBJEXT) 97 | -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) 98 | 99 | distclean: clean 100 | -rm -f *.tab.c 101 | -rm -f Makefile $(CONFIG_CLEAN_FILES) 102 | -rm -f config.cache config.log stamp-h stamp-h[0-9]* 103 | -rm -f config.status 104 | 105 | Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status 106 | cd $(top_builddir) \ 107 | && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status 108 | 109 | #config.status: $(srcdir)/configure 110 | # $(SHELL) ./config.status --recheck 111 | 112 | #$(srcdir)/configure: $(srcdir)/configure.in 113 | # cd $(srcdir) && $(AUTOCONF) -l $(srcdir)/../../../sampleextension 114 | 115 | .PHONY: all binaries clean depend distclean doc install installdirs \ 116 | libraries test 117 | 118 | # Tell versions [3.59,3.63) of GNU make to not export all variables. 119 | # Otherwise a system limit (for SysV at least) may be exceeded. 120 | .NOEXPORT: 121 | -------------------------------------------------------------------------------- /CHANGES.txt: -------------------------------------------------------------------------------- 1 | Changes to mclistbox.tcl and related files: 2 | 3 | ## version 1.02: 4 | 5 | * fixed bugs in how yview was computed. yview should now return 6 | the proper value even when the window is resized, and scrolling 7 | the listbox after resizing should properly scroll all the way 8 | up and down. 9 | 10 | * fixed some bugs when a column id has spaces in it 11 | 12 | * fixed a bug in the label bind command, where curly braces were 13 | improperly being added around the %W substitution. 14 | 15 | * added additional tests to the test suite, and improved the format 16 | of tests to be a bit more readable 17 | 18 | * added the file "defs" to the distribution, so that the test 19 | script (mclistbox.test) would work. This is a modified version 20 | of the "defs" file that comes with the tcl source. The modifications 21 | allow for a more human-friendly format of the test data 22 | 23 | 24 | ## version 1.01: 25 | 26 | * fixed bug where the fill column wasn't filling properly 27 | 28 | * fixed bug when trying to canonize a column name. 29 | 30 | 31 | ## version 1.00 (final): 32 | 33 | * fixed the -width option for columns; a width of zero should now 34 | do what the documentation says it will do (e.g. set the column 35 | to be just wide enough to show the longest item) 36 | 37 | * fixed the bug where we were trying to update the scrollbars even 38 | after the widget has been destroyed 39 | 40 | * "column nearest" should now work 41 | 42 | * a few other small bugs have been fixed 43 | 44 | 45 | 46 | ## version 1.00b3: 47 | 48 | * =INCOMPATIBILITY= added the column option "-visible"; removed 49 | the column commands "show" and "hide". This seems to be more 50 | "standard", and allows a way for the application programmer 51 | to query whether a column is visible or not. 52 | 53 | * added the following widget commands: 'bbox', 'column nearest', 54 | 'column cget' 55 | 56 | * options and commands may now be specified with the shortest 57 | unique string (eg: -labela will be translated to -labelanchor, 58 | but -label will return an error since it matches several 59 | options) 60 | 61 | * documented the -font, -foreground and -background column 62 | options (oops!) 63 | 64 | * column identifiers with embedded whitespace seem to work now. 65 | 66 | * scanning in the x direction works now 67 | 68 | * added support for -exportselection (hope I got it right!) 69 | 70 | * resizable columns may be turned off on the widget as a 71 | whole, and by column name (ie: you can mix and match 72 | columns which are resizable and those which aren't) 73 | 74 | * example shows how to provide column-specific popup menus 75 | (press the right mouse button to see) 76 | 77 | * fixed case where new columns weren't properly inheiriting 78 | the background color of the widget. 79 | 80 | * update the documentation for the 'get' and 'column names' 81 | commands to reflect the fact that 'column names' reports 82 | the order in which data is returned by 'get'. 83 | 84 | * the fillcolumn now will not shrink below it's original size. 85 | If the user resizes the column interactively, the new 86 | size will become the new minimum size for filling. 87 | 88 | * pkg_mkIndex should now properly index mclistbox.tcl without 89 | any extra effort 90 | 91 | * lots of internal comments, and a slightly better conformance 92 | to the scriptics tcl style guide (though I'm still not perfect) 93 | 94 | * the beginnings of a complete automated test suite based on the 95 | same code used by the tcl distribution 96 | 97 | * other random bug fixes 98 | 99 | 100 | ### version 1.00b2: 101 | 102 | * added -fillcolumn option. With this you can designate a column 103 | that will grow or shrink so that the widget is completely filled 104 | 105 | * the command "label bind" has been added 106 | 107 | * scanning in the Y direction has been fixed. The x direction is 108 | still busted. 109 | 110 | * added the option -resizablecolumns; if set the columns can be 111 | resized interactively with the mouse. 112 | 113 | * removed the option -labelimage. It was in by accident and 114 | never had any effect. 115 | 116 | * added -image and -bitmap options to "column configure" 117 | 118 | * the example shows how to bind ButtonPress-1 to a label in order 119 | to sort the column. 120 | 121 | * various bug fixes 122 | 123 | 124 | ### version 1.00b1: 125 | 126 | * first public release -------------------------------------------------------------------------------- /test.tcl: -------------------------------------------------------------------------------- 1 | # some (very!) rudimentary test code for mclistbox.tcl 2 | 3 | source mclistbox.tcl 4 | package require mclistbox 1.00 5 | catch {namespace import mclistbox::*} 6 | 7 | proc test {{addcolumns 1}} { 8 | source mclistbox.tcl 9 | 10 | destroy .vsb .container .hsb 11 | 12 | frame .container -bd 2 -relief sunken 13 | pack .container -side top -fill both -expand y 14 | 15 | puts "creating mclistbox" 16 | set ::foo [::mclistbox::mclistbox .container.foo \ 17 | -yscrollcommand [list .container.vsb set] \ 18 | -xscrollcommand [list .container.hsb set] \ 19 | -selectmode extended \ 20 | -borderwidth 0 \ 21 | -width 60 \ 22 | -height 20 ] 23 | 24 | scrollbar .container.vsb \ 25 | -orient vertical \ 26 | -command [list .container.foo yview] 27 | scrollbar .container.hsb \ 28 | -orient horizontal \ 29 | -command [list .container.foo xview] 30 | 31 | grid .container.vsb -row 0 -column 1 -sticky ns 32 | grid .container.hsb -row 1 -column 0 -sticky ew 33 | grid .container.foo -row 0 -column 0 -sticky nsew -padx 0 -pady 0 34 | grid columnconfigure .container 0 -weight 1 35 | grid columnconfigure .container 1 -weight 0 36 | grid rowconfigure .container 0 -weight 1 37 | grid rowconfigure .container 1 -weight 0 38 | 39 | set commands [lsort [info commands]] 40 | 41 | puts "adding column number" 42 | .container.foo column add number -label "Num" -width 5 43 | puts "adding column command" 44 | .container.foo column add command -label "Command" -width 30 45 | puts "adding column size" 46 | .container.foo column add size -label "String Length" -width 13 47 | 48 | puts "inserting data" 49 | set count [llength $commands] 50 | set row 1 51 | foreach command $commands { 52 | set stuff [list $row $command "[string length $command] chars"] 53 | .container.foo insert end $stuff 54 | incr row 55 | } 56 | 57 | 58 | puts "$row rows added..." 59 | 60 | .container.foo configure -width 49 61 | 62 | 63 | # bind .container.foo {findColumn %X} 64 | bind .container.foo {testConvert %W %x %y %X %Y} 65 | 66 | } 67 | 68 | proc testIndicies {w} { 69 | puts "deleting all columns..." 70 | foreach column [$w column names] { 71 | $w column delete $column 72 | } 73 | puts "adding a single column" 74 | $w column add col0 -label "Column 0" 75 | 76 | puts "deleting everything from 0 to end" 77 | $w delete 0 end 78 | puts "inserting at 0..." 79 | $w insert 0 A0 80 | puts "inserting at @0,0..." 81 | $w insert @0,0 A1 82 | puts "inserting at end..." 83 | $w insert end A2 84 | puts "contents should be A1,A0,A2: [$w get 0 end]" 85 | 86 | } 87 | 88 | proc testConvert {w x y rx ry} { 89 | # let's calculate the coordinates to see how they compare 90 | # to the magic conversion: 91 | set rootx [winfo rootx .container.foo] 92 | set rooty [winfo rooty .container.foo] 93 | puts "calculated: [expr $rx - $rootx],[expr $ry - $rooty]" 94 | set result [::mclistbox::convert $w -W -x $x -y $y] 95 | foreach {w x y} $result {} 96 | puts "%W=$w %x=$x %y=$y" 97 | } 98 | 99 | proc findColumn {x} { 100 | puts "findColumn..." 101 | # sigh. We are passed in a root x which we have to convert 102 | # to something relative to the widget. Easy enough to do... 103 | set x [expr $x - [winfo rootx .container.foo]] 104 | puts "findColumn: [.container.foo column nearest $x]" 105 | } 106 | 107 | proc testConfig {} { 108 | set listbox .container.foo 109 | puts "testing global options" 110 | if {[catch { 111 | foreach config [lsort [array names ::mclistbox::globalOptions]] { 112 | puts "$config..." 113 | puts -nonewline " result of cget: " 114 | puts "'[set result(cget) [$listbox cget $config]]'" 115 | puts -nonewline " result of configure: " 116 | puts "'[set result(configure) [$listbox configure $config]]'" 117 | set oname [lindex $result(configure) 1] 118 | set oclass [lindex $result(configure) 2] 119 | puts -nonewline " from the option database: " 120 | puts "'[option get $listbox $oname $oclass]'" 121 | if {$result(cget) != [lindex $result(configure) 4]} { 122 | puts stderr " the values are not the same: " 123 | puts stderr " cget=$result(cget)" 124 | puts stderr " configure=[lindex $result(configure) 4]" 125 | } 126 | } 127 | } error]} { 128 | puts stderr "error with the config foo: $error" 129 | } 130 | } 131 | 132 | proc testColumnConfig {} { 133 | set listbox .container.foo 134 | foreach column {number command size} { 135 | foreach config [lsort [array names ::mclistbox::columnOptions]] { 136 | 137 | } 138 | } 139 | puts "testing commands with a bogus column:" 140 | catch {$listbox column configure bogus -width 10} 141 | } 142 | 143 | 144 | proc addrows {w n} { 145 | for {set i 0} {$i < $n} {incr i} { 146 | $w insert end $i 147 | } 148 | } 149 | 150 | proc addrowsfast {w n} { 151 | set biglist {} 152 | for {set i 0} {$i < $n} {incr i} { 153 | lappend biglist $i 154 | update idletasks 155 | } 156 | update idletasks 157 | eval $w insert end $biglist 158 | } 159 | 160 | 161 | test 162 | testConfig 163 | testColumnConfig 164 | -------------------------------------------------------------------------------- /example.tcl: -------------------------------------------------------------------------------- 1 | # a simple directory viewer 2 | # 3 | # this program uses a multicolumn listbox (mclistbox) to implement 4 | # a simple directory browser 5 | 6 | # substitute your favorite method here... 7 | source mclistbox.tcl 8 | package require mclistbox 1.02 9 | catch {namespace import mclistbox::*} 10 | 11 | proc showSelection {args} { 12 | puts "selection has changed: $args" 13 | } 14 | 15 | proc main {} { 16 | wm title . "Simple Directory Viewer" 17 | 18 | # this lets us be reentrant... 19 | eval destroy [winfo children .] 20 | 21 | # we want the listbox and two scrollbars to be embedded in a 22 | frame .container -bd 2 -relief sunken 23 | 24 | # frame so they look like a single widget 25 | scrollbar .vsb -orient vertical -command [list .listbox yview] 26 | scrollbar .hsb -orient horizontal -command [list .listbox xview] 27 | 28 | # we will purposefully make the width less than the sum of the 29 | # columns so that the scrollbars will be functional right off 30 | # the bat. 31 | mclistbox .listbox \ 32 | -bd 0 \ 33 | -height 10 \ 34 | -width 60 \ 35 | -columnrelief flat \ 36 | -labelanchor w \ 37 | -columnborderwidth 0 \ 38 | -selectcommand "showSelection" \ 39 | -selectmode extended \ 40 | -labelborderwidth 2 \ 41 | -fillcolumn name \ 42 | -xscrollcommand [list .hsb set] \ 43 | -yscrollcommand [list .vsb set] 44 | 45 | # add the columns we want to see 46 | .listbox column add name -label "Name" -width 40 47 | .listbox column add size -label "Size" -width 12 48 | .listbox column add mod -label "Last Modified" -width 18 49 | 50 | # set up bindings to sort the columns. 51 | .listbox label bind name "sort %W name" 52 | .listbox label bind size "sort %W size" 53 | .listbox label bind mod "sort %W mod" 54 | 55 | grid .vsb -in .container -row 0 -column 1 -sticky ns 56 | grid .hsb -in .container -row 1 -column 0 -sticky ew 57 | grid .listbox -in .container -row 0 -column 0 -sticky nsew -padx 0 -pady 0 58 | grid columnconfigure .container 0 -weight 1 59 | grid columnconfigure .container 1 -weight 0 60 | grid rowconfigure .container 0 -weight 1 61 | grid rowconfigure .container 1 -weight 0 62 | 63 | pack .container -side top -fill both -expand y 64 | 65 | # populate the columns with information about the files in the 66 | # current directory 67 | foreach file [lsort [glob *]] { 68 | if {$file == "." || $file == ".."} continue 69 | set size [set mtime ""] 70 | 71 | catch {set mtime [clock format [file mtime $file] -format "%x %X"]} 72 | set size [file size $file] 73 | if {$size > 1048576} { 74 | set size [format "%2.2fMB" [expr $size / 1048576.0]] 75 | } elseif {$size > 1024} { 76 | set size [format "%2.2fKB" [expr $size / 1024.0]] 77 | } 78 | 79 | .listbox insert end [list $file $size $mtime] 80 | } 81 | 82 | # bind the right click to pop up a context-sensitive menu 83 | # we can use the proc ::mclistbox::convert to convert the 84 | # binding substitutions we need. I've included two examples 85 | # to illustrate. Either method should give identical results. The 86 | # first method is slightly more efficient since it calls the 87 | # conversion routine only once. The second method calls the 88 | # procedure once for each of %W, %x and %y. 89 | 90 | # bind .listbox \ 91 | # {eval showContextMenu [::mclistbox::convert %W -W -x %x -y %y] %X %Y} 92 | 93 | bind .listbox \ 94 | {showContextMenu \ 95 | [::mclistbox::convert %W -W] \ 96 | [::mclistbox::convert %W -x %x] \ 97 | [::mclistbox::convert %W -y %y] \ 98 | %X %Y} 99 | 100 | } 101 | 102 | # x,y are the coordinates relative to the upper-left corner of the 103 | # listbox; rootx,rooty are screen coordinates (for knowing where 104 | # to place the menu). w is the name of the mclistbox widget that was 105 | # clicked on. 106 | proc showContextMenu {w x y rootx rooty} { 107 | catch {destroy .contextMenu} 108 | menu .contextMenu -tearoff false 109 | 110 | # ask the widget for what column this is 111 | set column [$w column nearest $x] 112 | set columnLabel [$w column cget $column -label] 113 | 114 | .contextMenu configure -title "$columnLabel" 115 | .contextMenu add command \ 116 | -label "Sort by $columnLabel" \ 117 | -command [list sort $w $column] 118 | .contextMenu add command \ 119 | -label "Hide $columnLabel" \ 120 | -command [list $w column configure $column -visible false] 121 | .contextMenu add separator 122 | .contextMenu add command \ 123 | -label "Show All Hidden Columns" \ 124 | -command "showAllColumns $w" 125 | 126 | tk_popup .contextMenu $rootx $rooty 127 | } 128 | 129 | proc showAllColumns {w} { 130 | foreach column [$w column names] { 131 | $w column configure $column -visible true 132 | } 133 | } 134 | 135 | # sort the list based on a particular column 136 | proc sort {w id} { 137 | 138 | set data [$w get 0 end] 139 | set index [lsearch -exact [$w column names] $id] 140 | 141 | set result [lsort -index $index $data] 142 | 143 | $w delete 0 end 144 | 145 | # ... and add our sorted data in 146 | eval $w insert end $result 147 | 148 | } 149 | 150 | main 151 | 152 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2002-09-25 Jeff Hobbs 2 | 3 | * Makefile.in: better DESTDIR/libdir support (steffen) 4 | 5 | 2001-09-07 Andreas Kupries 6 | 7 | * mclistbox.tcl: Added 'FirstVisibleColumn' to retrieve the id of 8 | the first non-hidden column. Using this procedure in some place 9 | which have trouble to compute a sensible value for a hidden 10 | column (pointer location to row index for example). This fixes 11 | bug [455732]. 12 | 13 | 2000-09-24 Dan Kuchler 14 | 15 | * mclistbox.tcl: Added a column field to the mclistbox 16 | '-dropcmd' callback so that special things can be done 17 | based on both the column as well as the row. 18 | 19 | 2000-08-07 Dan Kuchler 20 | 21 | * mclistbox.tcl: Added support for the '-state' flag so that 22 | the mclistbox can be either normal or disabled state. Since 23 | the listbox can't be disabled until tk 8.4, for now, it only 24 | disables the mclistbox by changing its foreground to the disabled 25 | foreground color. 26 | 27 | 2000-06-19 Dan Kuchler 28 | 29 | * mclistbox.tcl: Added a new binding for ButtonPress-1 to store the 30 | index of the row that is clicked on, so that when a drag event happens 31 | and the mclistbox::_init_drag_cmd os called, the index has already 32 | been calculated. Previously if the drag moved too quickly the wrong 33 | item would be dragged. 34 | 35 | 2000-06-16 Dan Kuchler 36 | 37 | * mclistbox.tcl: Replaced several catch {unset varname} calls with 38 | if {[info exists varname]} {unset varname}. This avoids using the 39 | catch, and also prevents the ::errorInfo corruption that was happening 40 | in mclistbox 41 | 42 | 2000-05-01 Dan Kuchler 43 | 44 | * mclistbox.tcl: Improved the AdjustColumns function to consider 45 | the width of the label of the column as well as the contents of 46 | the column when the width is set to 0 and AdjustColumns is 47 | calculating what the width of the column should be. 48 | 49 | 2000-03-09 Sven Delmas 50 | 51 | * mclistbox.tcl: Added a binding to Unmap, so that the grab is 52 | released when the mclistbox (with the active inline editing entry) 53 | is unmapped. 54 | 55 | 1999-12-14 Eric Melski 56 | 57 | * mclistbox.tcl: Fixed some bugs in the _over_cmd dealing with empty 58 | listboxes. Basically just had to put some checks around the return from 59 | bbox; in case it was null, do something a little different. 60 | 61 | 1999-12-10 Eric Melski 62 | 63 | * mclistbox.tcl: Changed syntax of edit/editcombo to take the name of a 64 | return variable as a parameter and return 0/1 for failure/success, instead 65 | of returning null/non-null (because some people feel they need to be able 66 | to allow null values or some such nonsense...) 67 | 68 | 1999-12-09 Eric Melski 69 | 70 | * mclistbox.tcl: Added auto-scroll for drag-and-drop. When dragging over 71 | the listbox, it will scroll the listbox up or down if the cursor is in a 72 | "hotspot" near the top or bottom of the list. 73 | 74 | 1999-11-23 Eric Melski 75 | 76 | * mclistbox.tcl: Added editcombo function, same as edit function but uses 77 | a combo box. 78 | Fixed bug in bbox. 79 | Fixed yscrollcommand handling to get *all* the updates. 80 | Fixed some formatting bugs. 81 | 82 | 1999-10-28 Eric Melski 83 | 84 | * mclistbox.tcl: Added -editable/-editcommand for columns and 85 | -iseditableindexcommand for the listbox. The first two control the 86 | placement and function of an "Edit" button for the specified column -- 87 | if editable is true, the button is there. When clicked, it calls 88 | -editcommand with the name of the megawidget, the column name and the 89 | currently selected index. 90 | 91 | The third allows the user to specify a function that will return 1 or 0, 92 | indicating whether the selected index (or indices) are editable. If 93 | they are, then the Edit buttons are enabled; if not, they are disabled. 94 | If not iseditableindexcommand is set, then the buttons are enabled 95 | anytime there is just one item selected (ie, no multi-selections allowed). 96 | 97 | 1999-10-25 Eric Melski 98 | 99 | * mclistbox.tcl: Fixed a small bug with drag&drop and the insertion frame. 100 | The _over_drag_frame_cmd and _drop_drag_frame_cmd functions are brittle in 101 | the sense that they are dependant on the way that the widgets in the 102 | megawidget are created. Be sure to watch for that in the future. 103 | 104 | 1999-10-15 Eric Melski 105 | 106 | * mclistbox.tcl: Added a flag "hidden" to NewColumn (defaults to false), 107 | which controls if the column will be a hidden column or not. Hidden cols 108 | are children of the frame, non-hidden ones are children of the text widget. 109 | This makes clipping work correctly for the non-hidden columns (ie, they 110 | no longer run over the border). This is kind of a kludgy way to do it, 111 | but it's safer than introducing another widget (which would be the 112 | "correct" way to do it -- put an enclosing frame on the widget, and 113 | use that to show the border, etc). 114 | 115 | 1999-10-15 Eric Melski 116 | 117 | * mclistbox.tcl: Added widgetDefault values for drag/drop options; 118 | extended edit command to allow the specification of a validate 119 | command, for validating the input before withdrawing the widgets; 120 | added tests of dropenabled/dragenabled in NewColumn, to only 121 | register the widget as a drag/drop site if it is enabled. 122 | 123 | 1999-10-14 Eric Melski 124 | 125 | * mclistbox.tcl: Extended drag-and-drop support with a -dropcursor 126 | option; this lets the user specify what kind of insertion cursor 127 | will be shown when performing a drop into a listbox. It can be 128 | one of before (shows a line before the dropindex), after (line 129 | after the dropindex), on (highlights the dropindex) or none (does 130 | nothing). 131 | Fixed a particularly bad bug in Configure: there were several 132 | comments inappropriately placed in a switch statement that were 133 | preventing it from ever executing. It's a wonder that the listbox 134 | worked at all. 135 | Added some code to remove the insertion bar when leaving the widget 136 | during dragover. 137 | Added an edit function, for doing inline edits. 138 | 139 | 1999-10-13 Eric Melski 140 | 141 | * mclistbox.tcl: Added support for BWidget drag-and-drop protocol. 142 | Added a drag_end command. 143 | 144 | -------------------------------------------------------------------------------- /mclistbox.test: -------------------------------------------------------------------------------- 1 | # -*- tcl -*- 2 | # 3 | # Packages covered: mclistbox 4 | # Commands covered: mclistbox 5 | # 6 | # This file contains a collection of tests for the "mclistbox" mega- 7 | # widget. Sourcing this file into Tcl runs the tests and generates 8 | # output for errors. No output means no errors were found. 9 | 10 | if {![info exists DEFS_HAS_BEEN_LOADED]} {source defs} 11 | if {[llength [info commands ::mclistbox::*]] == 0} {source mclistbox.tcl} 12 | 13 | # make sure no other widgets presently exist 14 | eval destroy [winfo children .] 15 | wm geometry . {} 16 | raise . 17 | 18 | # testing the mclistbox command itself... 19 | test mclistbox-1.0 { 20 | description "mclistbox creation" 21 | constraints {} 22 | script {::mclistbox::mclistbox .mclistbox} 23 | expected {.mclistbox} 24 | } 25 | 26 | 27 | # this creates the widget we'll use for later tests... 28 | test mclistbox-1.1 { 29 | description "mclistbox command with no arguments" 30 | constraints {} 31 | 32 | script { 33 | list [catch {::mclistbox::mclistbox} msg] $msg 34 | } 35 | 36 | expected { 37 | [list 1 {wrong # args: should be "mclistbox pathName ?options?"}] 38 | } 39 | } 40 | 41 | # testing when we give it the name of an already existing widget 42 | test mclistbox-1.2 { 43 | description "mclistbox command with name of an existing widget" 44 | constraints {} 45 | script { 46 | catch {destroy .mclistbox} 47 | ::mclistbox::mclistbox .mclistbox 48 | list [catch {::mclistbox::mclistbox .mclistbox} msg] $msg 49 | } 50 | expected { 51 | [list 1 {window name ".mclistbox" already exists}] 52 | } 53 | } 54 | 55 | test mclistbox-1.3 { 56 | description "mclistbox creates a widget of the proper name and class" 57 | script { 58 | catch {destroy .mclistbox} 59 | ::mclistbox::mclistbox .mclistbox 60 | list \ 61 | [winfo exists .mclistbox] \ 62 | [winfo class .mclistbox] \ 63 | [info commands .mclistbox] 64 | } 65 | expected { 66 | [list 1 Mclistbox .mclistbox] 67 | } 68 | } 69 | 70 | # try to create the widget with a bogus option 71 | test mclistbox-1.4 { 72 | description { 73 | mclistbox command with a bogus option 74 | } 75 | 76 | script { 77 | catch {destroy .bogus} 78 | list \ 79 | [catch {::mclistbox::mclistbox .bogus -bogus foo} msg] \ 80 | $msg \ 81 | [winfo exists .bogus] \ 82 | [info commands .bogus] 83 | } 84 | 85 | expected { 86 | [ list \ 87 | 1 \ 88 | {unknown option "-bogus"; must be one of\ 89 | -background, -bd, -bg, -borderwidth,\ 90 | -columnbd, -columnborderwidth, -columnrelief,\ 91 | -cursor, -exportselection, -fg, -fillcolumn,\ 92 | -font, -foreground, -height, -highlightbackground,\ 93 | -highlightcolor, -highlightthickness, -labelanchor,\ 94 | -labelbackground, -labelbd, -labelbg, -labelborderwidth,\ 95 | -labelfg, -labelfont, -labelforeground, -labelheight,\ 96 | -labelimage, -labelrelief, -labels, -relief,\ 97 | -resizablecolumns, -selectbackground, -selectborderwidth,\ 98 | -selectcommand, -selectforeground, -selectmode, -setgrid,\ 99 | -takefocus, -width, -xscrollcommand or -yscrollcommand} \ 100 | 0 \ 101 | {}] 102 | } 103 | } 104 | 105 | # make the window from the previous command visible 106 | pack .mclistbox -side top -fill both -expand y 107 | 108 | # these are tests on the various configuration options. Each option 109 | # should have two tests -- one that uses a valid value and one that 110 | # uses an invalid value. 111 | set tests { 112 | {-background \ 113 | #ff0000 #ff0000 \ 114 | non-existent {unknown color name "non-existent"}} 115 | {-bd \ 116 | 4 4 \ 117 | badValue {bad screen distance "badValue"}} 118 | {-bg \ 119 | #ff0000 #ff0000 \ 120 | non-existent {unknown color name "non-existent"}} 121 | {-borderwidth \ 122 | 1.3 1 \ 123 | badValue {bad screen distance "badValue"}} 124 | {-columnborderwidth \ 125 | 4 4 \ 126 | badValue {bad screen distance "badValue"}} 127 | {-columnrelief \ 128 | raised raised \ 129 | badValue {bad relief type "badValue":\ 130 | must be flat, groove, raised, ridge, solid, or sunken}} 131 | {-cursor \ 132 | arrow arrow \ 133 | badValue {bad cursor spec "badValue"}} 134 | {-exportselection \ 135 | yes 1 \ 136 | xyzzy {expected boolean value but got "xyzzy"}} 137 | {-fg \ 138 | #110022 #110022 \ 139 | badValue {unknown color name "badValue"}} 140 | {-fillcolumn \ 141 | bogus bogus \ 142 | {} {}} 143 | {-font \ 144 | {Helvetica 12} {Helvetica 12} \ 145 | {} {font "" doesn't exist}} 146 | {-foreground \ 147 | #110022 #110022 \ 148 | badValue {unknown color name "badValue"}} 149 | {-height \ 150 | 30 30 \ 151 | 20p {expected integer but got "20p"}} 152 | {-highlightbackground \ 153 | #112233 #112233 \ 154 | ugly {unknown color name "ugly"}} 155 | {-highlightcolor \ 156 | #123456 #123456 \ 157 | badValue {unknown color name "badValue"}} 158 | {-highlightthickness \ 159 | 6 6 badValue \ 160 | {bad screen distance "badValue"}} 161 | {-highlightthickness \ 162 | -2 0 \ 163 | {} {}} 164 | {-labelimage \ 165 | {} {} \ 166 | badValue {image "badValue" doesn't exist}} 167 | {-labelheight \ 168 | 20 20 \ 169 | 20p {expected integer but got "20p"}} 170 | {-labels \ 171 | true 1 \ 172 | badValue {expected boolean value but got "badValue"}} 173 | {-labelrelief \ 174 | raised raised \ 175 | badValue {bad relief "badValue":\ 176 | must be flat, groove, raised, ridge, solid, or sunken}} 177 | {-labelfont \ 178 | {Helvetica 12} {Helvetica 12} \ 179 | {} {font "" doesn't exist}} 180 | {-labelanchor \ 181 | n n \ 182 | badValue {bad anchor "badValue":\ 183 | must be n, ne, e, se, s, sw, w, nw, or center}} 184 | {-labelbackground \ 185 | #ff0000 #ff0000 \ 186 | non-existent {unknown color name "non-existent"}} 187 | {-labelforeground \ 188 | #ff0000 #ff0000 \ 189 | non-existent {unknown color name "non-existent"}} 190 | {-labelborderwidth \ 191 | 4 4 \ 192 | badValue {bad screen distance "badValue"}} 193 | {-relief \ 194 | groove groove \ 195 | 1.5 {bad relief type "1.5":\ 196 | must be flat, groove, raised, ridge, solid, or sunken}} 197 | {-resizablecolumns \ 198 | true 1 \ 199 | badValue {expected boolean value but got "badValue"}} 200 | {-selectbackground \ 201 | #110022 #110022 \ 202 | badValue {unknown color name "badValue"}} 203 | {-selectborderwidth \ 204 | 1.3 1 \ 205 | badValue {bad screen distance "badValue"}} 206 | {-selectforeground \ 207 | #654321 #654321 \ 208 | badValue {unknown color name "badValue"}} 209 | {-selectcommand \ 210 | string string \ 211 | {} {}} 212 | {-selectmode \ 213 | string string \ 214 | {} {}} 215 | {-setgrid \ 216 | false 0 \ 217 | lousy {expected boolean value but got "lousy"}} 218 | {-takefocus \ 219 | "any string" "any string" \ 220 | {} {}} 221 | {-width \ 222 | 45 45 \ 223 | 3p {expected integer but got "3p"}} 224 | {-xscrollcommand \ 225 | {Some command} {Some command} \ 226 | {} {}} 227 | {-yscrollcommand \ 228 | {Another command} {Another command} \ 229 | {} {}} 230 | } 231 | 232 | # generally speaking, each option should have two tests, one with 233 | # a valid value and one with an invalid value. Some option tests 234 | # skip the latter... 235 | set i 1 236 | foreach test $tests { 237 | set name [lindex $test 0] 238 | test mclistbox-2.$i "configuration options ([lindex $test 0])" \ 239 | {.mclistbox configure $name [lindex $test 1] 240 | list [lindex [.mclistbox configure $name] 4] \ 241 | [.mclistbox cget $name]} \ 242 | [list [lindex $test 2] [lindex $test 2]] 243 | incr i 244 | 245 | if {[lindex $test 3] != ""} { 246 | test mclistbox-2.$i "configuration options ([lindex $test 0])" { 247 | list [catch {.mclistbox configure $name [lindex $test 3]} msg] $msg 248 | } [list 1 [lindex $test 4]] 249 | } 250 | .mclistbox configure $name [lindex [.mclistbox configure $name] 3] 251 | incr i 252 | } 253 | 254 | 255 | # column related commands 256 | 257 | test mclistbox-3.0 { 258 | description "mclistbox columns" 259 | script { 260 | list [catch {.mclistbox column add col0 "Column 0"} msg] $msg 261 | } 262 | expected { 263 | [list 1 {unknown column option "Column 0"; must be one of\ 264 | -background, -bitmap, -font, -foreground,\ 265 | -image, -label, -position, -resizable, -visible\ 266 | or -width}] 267 | } 268 | } 269 | 270 | test mclistbox-3.1 { 271 | description "adding columns" 272 | script { 273 | .mclistbox column add col0 -label "Column 0" 274 | .mclistbox column add col1 -label "Column 1" 275 | .mclistbox column add col2 -label "Column 2" -position 1 276 | .mclistbox column add col3 -label "Column 3" -position end 277 | .mclistbox column add col4 -label "Column 4" -position start 278 | .mclistbox column names 279 | } 280 | expected { 281 | [list col4 col0 col2 col1 col3] 282 | } 283 | } 284 | 285 | test mclistbox-3.2 { 286 | description "deleting columns" 287 | script { 288 | .mclistbox column delete col2 289 | .mclistbox column names 290 | } 291 | expected { 292 | [list col4 col0 col1 col3] 293 | } 294 | } 295 | 296 | test mclistbox-3.3 { 297 | description "showing and hiding columns" 298 | script { 299 | .mclistbox column configure col0 -visible 0 300 | .mclistbox column configure col1 -visible 1 301 | .mclistbox column configure col3 -visible 0 302 | .mclistbox column configure col4 -visible 1 303 | list \ 304 | [.mclistbox column cget col0 -visible] \ 305 | [.mclistbox column cget col1 -visible] \ 306 | [.mclistbox column cget col3 -visible] \ 307 | [.mclistbox column cget col4 -visible] 308 | } 309 | expected { 310 | [list 0 1 0 1] 311 | } 312 | } 313 | 314 | test mclistbox-3.4 { 315 | description "columns with spaces as identifiers" 316 | script { 317 | .mclistbox column add "new column" 318 | .mclistbox column names 319 | } 320 | expected { 321 | [list col4 col0 col1 col3 {new column}] 322 | } 323 | } 324 | 325 | # inserting and retrieving data 326 | # this assumes we have four columns... 327 | test mclistbox-4.0 { 328 | description "inserting data" 329 | script { 330 | .mclistbox insert end [list "1" ] 331 | .mclistbox insert 0 [list "2" one] 332 | .mclistbox insert @0,0 [list "3" one two] 333 | .mclistbox activate 1 334 | .mclistbox selection anchor 2 335 | .mclistbox insert active [list "4" one two three] 336 | .mclistbox insert anchor [list "5" one two three four] 337 | .mclistbox get 0 end 338 | } 339 | expected { 340 | [list \ 341 | [list 3 one two {} {}] \ 342 | [list 4 one two three {}] \ 343 | [list 2 one {} {} {}] \ 344 | [list 5 one two three four] \ 345 | [list 1 {} {} {} {}]] 346 | } 347 | } 348 | 349 | test mclistbox-4.1 { 350 | description "inserting data at a bogus index" 351 | script { 352 | list [catch {.mclistbox insert bogus \ 353 | [list "Column 0" {} {}]} msg] $msg 354 | } 355 | expected { 356 | [list 1 {bad listbox index "bogus": must be active,\ 357 | anchor, end, @x,y, or a number}] 358 | } 359 | } 360 | 361 | test mclistbox-5.0 { 362 | description "deleting all data" 363 | script {.mclistbox delete 0 end} 364 | expected {} 365 | } 366 | 367 | test mclistbox-5.1 { 368 | description "deleting some data" 369 | script { 370 | .mclistbox insert end {zero} 371 | .mclistbox insert end {one} 372 | .mclistbox insert end {two} 373 | .mclistbox delete 1 1 374 | .mclistbox get 0 end 375 | } 376 | expected { 377 | [list [list zero {} {} {} {}] [list two {} {} {} {}]] 378 | } 379 | } 380 | 381 | # yview. Mostly I'm just looking for catastrophic failures... 382 | # This test adds some data used by later tests, so modify with 383 | # caution.. 384 | test mclistbox-6.0 { 385 | description "retrieving the yview" 386 | script { 387 | .mclistbox configure -height 5 -labels 1 388 | .mclistbox delete 0 end 389 | .mclistbox insert end [list "0" ] 390 | .mclistbox insert end [list "1" one] 391 | .mclistbox insert end [list "2" two] 392 | .mclistbox insert end [list "3" three] 393 | .mclistbox insert end [list "4" four] 394 | .mclistbox insert end [list "5" five] 395 | .mclistbox insert end [list "6" six] 396 | .mclistbox insert end [list "7" seven] 397 | .mclistbox insert end [list "8" eight] 398 | .mclistbox insert end [list "9" nine] 399 | update idletasks 400 | .mclistbox yview 401 | } 402 | expected { 403 | [list 0 0.5] 404 | } 405 | } 406 | 407 | # this test assumes data is still left over from test 6.0... 408 | test mclistbox-6.1 { 409 | description "adjusting the yview" 410 | script { 411 | .mclistbox yview 5 412 | .mclistbox yview 413 | } 414 | expected { 415 | [list 0.5 1] 416 | } 417 | } 418 | 419 | test mclistbox-6.2 { 420 | description "adjusting the yview" 421 | script { 422 | .mclistbox yview 0 423 | .mclistbox yview moveto .3 424 | .mclistbox yview 425 | } 426 | expected { 427 | [list 0.3 0.8] 428 | } 429 | } 430 | 431 | test mclistbox-6.3 { 432 | description "scrolling in the Y direction" 433 | script { 434 | .mclistbox yview 0 435 | .mclistbox yview scroll 3 units 436 | set first [.mclistbox yview] 437 | .mclistbox yview 0 438 | .mclistbox yview scroll 1 page 439 | set second [.mclistbox yview] 440 | set result [list $first $second] 441 | } 442 | expected { 443 | [list {0.3 0.8} {0.3 0.8}] 444 | } 445 | } 446 | 447 | # xview. Mostly I'm just looking for catastrophic failures... 448 | # This test adds some data used by later tests, so modify with 449 | # caution.. 450 | 451 | test mclistbox-7.0 { 452 | 453 | description "determining the xview" 454 | 455 | script { 456 | .mclistbox configure -height 5 -width 25 -labels 1 457 | foreach column [.mclistbox column names] { 458 | .mclistbox column delete $column 459 | } 460 | .mclistbox column add col0 -label "Column 0" -width 25 461 | .mclistbox column add col1 -label "Column 1" -width 25 462 | .mclistbox column add col2 -label "Column 2" -width 25 463 | .mclistbox column add col3 -label "Column 3" -width 25 464 | update idletasks 465 | 466 | set result [.mclistbox xview] 467 | .mclistbox xview moveto .25 468 | set result [concat $result [.mclistbox xview]] 469 | 470 | # There's a little "slop" somewhere, but I'm not sure where. 471 | # (probably in column borders and such...) So, for the time 472 | # being we'll round the results of the xview command to two 473 | # decimal places. The main goal for this test is to make sure the 474 | # xview command doesn't crash, and at least gives answers that 475 | # are mostly correct. 476 | 477 | set newResult "" 478 | foreach item $result { 479 | set item [expr {int($item * 100) / 100.0}] 480 | lappend newResult $item 481 | } 482 | set newResult 483 | } 484 | expected { 485 | [list 0.0 0.25 0.25 0.5] 486 | } 487 | } 488 | 489 | return 490 | -------------------------------------------------------------------------------- /mclistbox.pod: -------------------------------------------------------------------------------- 1 | # mclistbox.pod 2 | # Copyright (c) 1999, Bryan Oakley 3 | # All Rights Reserved. 4 | # 5 | # this uses a modified version of pod2html. Specifically, it uses the 6 | # non-standard R<> directive, which inserts a line break. 7 | 8 | =pod 9 | 10 | =head2 NAME 11 | 12 | mclistbox::mclistbox - Create and manipulate a multi-column listbox 13 | 14 | =head2 SYNOPSIS 15 | 16 | B 17 | 18 | B I I 19 | 20 | =head2 EXPORTS 21 | 22 | mclistbox 23 | 24 | =head2 STANDARD OPTIONS 25 | 26 | B<-background> 27 | B<-borderwidth> 28 | B<-cursor> 29 | B<-exportselection> 30 | B<-font> 31 | B<-foreground> 32 | B<-height> 33 | B<-highlightbackground> 34 | B<-highlightcolor> 35 | B<-highlightthickness> 36 | B<-relief> 37 | B<-selectbackground> 38 | B<-selectborderwidth> 39 | B<-selectforeground> 40 | B<-setgrid> 41 | B<-takefocus> 42 | B<-width> 43 | B<-xscrollcommand> 44 | B<-yscrollcommand> 45 | 46 | See the I manual entry for detailed descriptions of the above options. 47 | 48 | 49 | =head2 WIDGET-SPECIFIC OPTIONS 50 | 51 | Command-Line Name: B<-columnborderwidth> R<> 52 | Database Name: BR<> 53 | Database Class: B 54 | 55 | 56 | Specifies a non-negative value indicating the width of the 3-D border 57 | to draw around the outside of the column (if such a border is being 58 | drawn; the B option typically determines this). The value may 59 | also be used when drawing 3-D effects in the interior of the 60 | widget. The value may have any of the forms acceptable to 61 | Tk_GetPixels. 62 | 63 | Command-Line Name: B<-columnrelief> R<> 64 | Database Name: B R<> 65 | Database Class: B 66 | 67 | Specifies the 3-D effect desired for the column. Acceptable values 68 | are raised, B, B, B, B, and B. The 69 | value indicates how the interior of the column should appear relative to its 70 | exterior; for example, raised means the interior of the column should 71 | appear to protrude from the screen, relative to the exterior of the 72 | column. 73 | 74 | Command-Line Name: B<-fillcolumn> R<> 75 | Database Name: BR<> 76 | Database Class: B 77 | 78 | Specifies which column should grow or shrink such that all columns 79 | exactly fill the listbox widget. 80 | 81 | Command-Line Name: B<-labelanchor> R<> 82 | Database Name: BR<> 83 | Database Class: B 84 | 85 | Specifies how the information in the column label is 86 | to be displayed. Must be one of the values B, B, B, B, 87 | B, B, B, B, or B
. For example, nw means display 88 | the information such that its top-left corner is at the top-left 89 | corner of the column label. 90 | 91 | Command-Line Name: B<-labelbackground> or B<-labelbg>R<> 92 | Database Name: B R<> 93 | Database Class: B 94 | 95 | Specifies the normal background color to use when displaying the 96 | label. 97 | 98 | Command-Line Name: B<-labelborderwidth or -labelbd> R<> 99 | Database Name: B R<> 100 | Database Class: B 101 | 102 | Specifies a non-negative value indicating the width of the 3-D border 103 | to draw around the outside of the column label (if such a border is 104 | being drawn; the relief option typically determines this). The value 105 | may also be used when drawing 3-D effects in the interior of the 106 | column label. The value may have any of the forms acceptable to 107 | Tk_GetPixels. 108 | 109 | Command-Line Name: B<-labelfont> R<> 110 | Database Name: B R<> 111 | Database Class: B 112 | 113 | Specifies the font to use when drawing text inside the column label. 114 | 115 | Command-Line Name: B<-labelforeground> R<> 116 | Database Name: B R<> 117 | Database Class: B 118 | 119 | Specifies the normal foreground color to use when displaying the 120 | column label. 121 | 122 | Command-Line Name: B<-labelheight> R<> 123 | Database Name: BR<> 124 | Database Class: B 125 | 126 | Specifies a desired height for the label. If an image or bitmap is 127 | being displayed in the label then the value is in screen units 128 | (i.e. any of the forms acceptable to Tk_GetPixels); for text it is in 129 | lines of text. If this option isn't specified, the label's desired 130 | height is computed from the size of the image or bitmap or text being 131 | displayed in it. 132 | 133 | Command-Line Name: B<-labelrelief> R<> 134 | Database Name: BR<> 135 | Database Class: B 136 | 137 | Specifies the 3-D effect desired for the column label. Acceptable 138 | values are B, B, B, B, B, and 139 | B. The value indicates how the interior of the column label 140 | should appear relative to its exterior; for example, raised means the 141 | interior of the column label should appear to protrude from the 142 | screen, relative to the exterior of the column label. 143 | 144 | 145 | Command-Line Name: B<-labels> R<> 146 | Database Name: BR<> 147 | Database Class: B 148 | 149 | A boolean value which determines whether column labels are shown or 150 | not. 151 | 152 | Command-Line Name: B<-selectcommand> I R<> 153 | Database Name: BR<> 154 | Database Class: B 155 | 156 | Specifies a Tcl command to be run whenever the selection in the mclistbox 157 | changes. The command will be called with the result of the 158 | curselection command. 159 | 160 | Command-Line Name: B<-resizablecolumns> R<> 161 | Database Name: B R<> 162 | Database Class: B 163 | 164 | Specifies whether the columns can be resized interactively. If set to 165 | true, mouse bindings will be defined to allow the columns to be 166 | resized. See B for more information. 167 | 168 | Command-Line Name: B<-selectmode> R<> 169 | Database Name: BR<> 170 | Database Class: B 171 | 172 | Specifies one of several styles for manipulating the selection. The 173 | value of the option may be arbitrary, but the default bindings expect 174 | it to be either B, B, B, or B; the 175 | default value is browse. 176 | 177 | =head2 DESCRIPTION 178 | 179 | The B command creates a new window (given by the 180 | I argument) and makes it into a mclistbox widget. Additional 181 | options, described above, may be specified on the command line to 182 | configure aspects of the mclistbox such as its colors, font, text, and 183 | relief. The mclistbox command returns its pathName argument. At the 184 | time this command is invoked, there must not exist a window named 185 | pathName, but pathName's parent must exist. 186 | 187 | A mclistbox is a widget that displays a list of strings, one per 188 | line. When first created, a new mclistbox has no elements and no 189 | columns. Columns and elementd may 190 | be added or deleted using widget commands described below. In 191 | addition, one or more elements may be selected as described 192 | below. When an element in one column is selected, the elements in all 193 | columns are selected. 194 | 195 | It is not necessary for all the elements to be displayed in the 196 | mclistbox window at once; commands described below may be used to change 197 | the view in the window. Mclistboxes allow scrolling in both directions 198 | using the standard xScrollCommand and yScrollCommand options. They 199 | also support scanning, as described below. 200 | 201 | =head2 WIDGET COMMAND 202 | 203 | The widget command accepts many of the same arguments as the standard 204 | listbox command. The following commands behave identically to the 205 | standard listbox commands: 206 | 207 | =over 4 208 | 209 | B 210 | B 211 | B 212 | B 213 | B 214 | B 215 | B 216 | B 217 | B 218 | B 219 | B 220 | B 221 | B 222 | B 223 | 224 | =back 225 | 226 | In addition, there are a few commands unique to the mclistbox: 227 | 228 | =over 4 229 | 230 | =item I B I