00001 # Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 # 00003 # This file is free software; as a special exception the author gives 00004 # unlimited permission to copy and/or distribute it, with or without 00005 # modifications, as long as this notice is preserved. 00006 # 00007 # This program is distributed in the hope that it will be useful, but 00008 # WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 00011 ## ---------------------------------------------------------------------------- 00012 ## MyTable - OO wrapper for tktable. 00013 ## Some time aggo Jeffrey Hobbs, the maintainer of tktable, discontinued the 00014 ## 00 wrapper for this marvelous widget. So here is my version of it. 00015 ## Its main purpose is to delegate calls from MyTable to the embedded table 00016 ## component. 00017 ## 00018 ## There are some value addons that have been done ontop, that is 00019 ## - the table is sorteable (MyTable::sortRows()) 00020 ## - clearing table cells is easier (MyTable::erase()) 00021 ## - provide an array to store the table content 00022 ## - vertical and horizontal scrollbars 00023 ## - table rows are collored 00024 ## - an improved widget layout 00025 ## 00026 ## \author Michael Daum 00027 ## 00028 ## $Id: MyTable.tcl,v 1.12 2004/02/25 14:42:09 micha Exp $ 00029 ## ---------------------------------------------------------------------------- 00030 class MyTable { 00031 inherit itk::Widget 00032 00033 # new options 00034 itk_option define -vscrollmode vscrollMode ScrollMode "static" 00035 itk_option define -hscrollmode hscrollMode ScrollMode "static" 00036 itk_option define -selforeground selForeground SelForeground "yellow" 00037 itk_option define -selbackground selBackground SelBackground "gray50" 00038 itk_option define -state state State "disabled" 00039 itk_option define -rows rows Rows 20 00040 itk_option define -cols cols Cols 10 00041 itk_option define -outerborderwidth outerBorderWidth Width 2 00042 itk_option define -outerrelief outerRelief Relief "sunk" 00043 itk_option define -troughcolor troughColor Background "gray" 00044 00045 # public methods 00046 public method activate {args}; ## \type TclList 00047 public method childsite {} 00048 public method clear {args}; ## \type TclList 00049 public method delete {args}; ## \type TclList 00050 public method erase {fromCell toCell}; ## \type CellSpec, CellSpec 00051 public method getCell {args}; ## \type TclList 00052 public method hset {args}; ## \type TclList 00053 public method icursor {args}; ## \type TclList 00054 public method index {args}; ## \type TclList 00055 public method insert {args}; ## \type TclList 00056 public method print {} 00057 public method see {args}; ## \type TclList 00058 public method selection {args}; ## \type TclList 00059 public method setCell {args}; ## \type TclList 00060 public method spans {args}; ## \type TclList 00061 public method tag {args}; ## \type TclList 00062 public method vset {args}; ## \type TclList 00063 public method width {args}; ## \type TclList 00064 public method xview {args}; ## \type TclList 00065 public method yview {args}; ## \type TclList 00066 public method curselection {args }; ## \type TclList 00067 public method sortRows {index args}; ## \type TclNumber, TclList 00068 00069 constructor {args} {}; ## \type TclList 00070 00071 00072 # private methods 00073 private method resize {} 00074 private method colorize {num} ; ## \type TclNumber 00075 00076 ## storage for the table content. 00077 private variable _myArray; ## \type TclArray 00078 }; 00079 00080 ## ---------------------------------------------------------------------------- 00081 ## constructor 00082 ## ---------------------------------------------------------------------------- 00083 body MyTable::constructor {args} { 00084 00085 # define all widget-components 00086 itk_component add frame { 00087 frame $itk_interior.frame 00088 } { 00089 rename -borderwidth -outerborderwidth outerBorderWidth Width 00090 rename -relief -outerrelief outerRelief Relief 00091 } 00092 00093 itk_component add table { 00094 table $itk_component(frame).table \ 00095 -relief flat \ 00096 -drawmode slow \ 00097 -variable [scope _myArray] \ 00098 -xscrollcommand [code $this hset] \ 00099 -yscrollcommand [code $this vset] \ 00100 -rowtagcommand [code $this colorize ] \ 00101 -borderwidth 2 \ 00102 -highlightthickness 0 00103 } { 00104 keep -state -background -cursor -browsecommand -selectioncommand\ 00105 -colstretchmode -rowstretchmode -rowseparator -colseparator \ 00106 -exportselection -selectmode -selecttype -titlecols \ 00107 -titlerows -rowtagcommand -coltagcommand -font -borderwidth \ 00108 -selecttitles 00109 rename -anchor -cellanchor cellAnchor Anchor 00110 } 00111 $itk_component(table) tag config title \ 00112 -anchor c \ 00113 -relief raised \ 00114 -borderwidth 1 00115 $itk_component(table) tag config sel \ 00116 -relief flat 00117 $itk_component(table) tag config active \ 00118 -anchor w \ 00119 -fg black \ 00120 -bg gray 00121 00122 00123 itk_component add vbar { 00124 scrollbar $itk_component(frame).vbar \ 00125 -orient vertical \ 00126 -command [code $this yview] \ 00127 -elementborderwidth -1 \ 00128 -width 12 \ 00129 -borderwidth 2 00130 } { } 00131 00132 itk_component add hbar { 00133 scrollbar $itk_component(frame).hbar \ 00134 -orient horizontal \ 00135 -command [code $this xview] \ 00136 -elementborderwidth -1 \ 00137 -width 12 \ 00138 -borderwidth 2 00139 } { } 00140 00141 # packing + gridding 00142 pack $itk_component(frame) -fill both -expand 1 00143 grid $itk_component(table) -row 0 -column 0 -sticky news -padx 1 00144 grid $itk_component(vbar) -row 0 -column 1 -sticky ns -pady 1 00145 grid $itk_component(hbar) -row 1 -column 0 -sticky ew -padx 2 -pady 1 00146 00147 grid columnconfig $itk_component(frame) 0 -weight 1 00148 grid rowconfig $itk_component(frame) 0 -weight 1 00149 00150 # some bindings 00151 bind $itk_component(table) <Configure> [code $this resize] 00152 00153 eval itk_initialize $args 00154 } 00155 00156 ## ---------------------------------------------------------------------------- 00157 ## xview. 00158 ## ---------------------------------------------------------------------------- 00159 body MyTable::xview {args} { 00160 eval $itk_component(table) xview $args 00161 } 00162 00163 ## ---------------------------------------------------------------------------- 00164 ## yview 00165 ## ---------------------------------------------------------------------------- 00166 body MyTable::yview {args} { 00167 eval $itk_component(table) yview $args 00168 } 00169 00170 ## ---------------------------------------------------------------------------- 00171 ## delegate the set command to the vertical scrollbar. 00172 ## ---------------------------------------------------------------------------- 00173 body MyTable::vset {args} { 00174 eval $itk_component(vbar) set $args 00175 } 00176 00177 ## ---------------------------------------------------------------------------- 00178 ## delegate the set command to the horizontal scrollbar. 00179 ## ---------------------------------------------------------------------------- 00180 body MyTable::hset {args} { 00181 eval $itk_component(hbar) set $args 00182 } 00183 00184 ## ---------------------------------------------------------------------------- 00185 ## propagate table resizing to the scrollbars. 00186 ## ---------------------------------------------------------------------------- 00187 body MyTable::resize {} { 00188 if {$itk_option(-hscrollmode) == "dynamic"} { 00189 if {[string comp {0 1} [xview]]} { 00190 grid $itk_component(hbar) 00191 } else { 00192 grid remove $itk_component(hbar) 00193 } 00194 } 00195 00196 if {$itk_option(-vscrollmode) == "dynamic"} { 00197 if {[string comp {0 1} [yview]]} { 00198 grid $itk_component(vbar) 00199 } else { 00200 remove $itk_component(vbar) 00201 } 00202 } 00203 } 00204 ## ---------------------------------------------------------------------------- 00205 ## rowtag callback of the table. 00206 ## This method is called whenever the tktable component needs a tag for a 00207 ## table row. 00208 ## ---------------------------------------------------------------------------- 00209 body MyTable::colorize {num} { 00210 if {$num>0 && $num%2} { 00211 return "" 00212 } else { 00213 return colored 00214 } 00215 } 00216 00217 ## ---------------------------------------------------------------------------- 00218 ## print the stored data. 00219 ## This simply calls parray on the _myArray variable. 00220 ## ---------------------------------------------------------------------------- 00221 body MyTable::print {} { 00222 parray _myArray 00223 } 00224 00225 ## ---------------------------------------------------------------------------- 00226 ## erase table cells. 00227 ## This method clears the content between two cell specifications by directly 00228 ## manipulating the _myArray. A cell specification has the format \a "row,col", 00229 ## where \a row and \a col are integers. 00230 ## \param fromCell the cell which is the first to be cleared 00231 ## \param toCell the cell which is the last to be cleared 00232 ## ---------------------------------------------------------------------------- 00233 body MyTable::erase {fromCell toCell} { 00234 00235 scan $fromCell "%d,%d" fromRow fromCol 00236 scan $toCell "%d,%d" toRow toCol 00237 00238 if {$fromRow > $toRow} { 00239 set temp $fromRow 00240 set fromRow $toRow 00241 set toRow $temp 00242 } 00243 if {$fromCol > $toCol} { 00244 set temp $fromCol 00245 set fromCol $toCol 00246 set toCol $temp 00247 } 00248 00249 for {set i $fromRow} {$i <= $toRow} {incr i} { 00250 for {set j $fromCol} {$j <= $toCol} {incr j} { 00251 set _myArray($i,$j) "" 00252 } 00253 } 00254 } 00255 00256 ## ---------------------------------------------------------------------------- 00257 ## clear 00258 ## ---------------------------------------------------------------------------- 00259 body MyTable::clear {args} { 00260 eval $itk_component(table) clear $args 00261 } 00262 00263 ## ---------------------------------------------------------------------------- 00264 ## retrieve the table component. 00265 ## \returns the widget path to the tktable 00266 ## ---------------------------------------------------------------------------- 00267 body MyTable::childsite {} { 00268 return $itk_component(table) 00269 } 00270 00271 ## ---------------------------------------------------------------------------- 00272 ## delegate the tag command to the table 00273 ## ---------------------------------------------------------------------------- 00274 body MyTable::tag {args} { 00275 eval $itk_component(table) tag $args 00276 } 00277 00278 # ---------------------------------------------------------------------------- 00279 # delegate the see command to the table 00280 # ---------------------------------------------------------------------------- 00281 body MyTable::see {args} { 00282 eval $itk_component(table) see $args 00283 } 00284 00285 ## ---------------------------------------------------------------------------- 00286 ## delegate the selection command to the table. 00287 ## ---------------------------------------------------------------------------- 00288 body MyTable::selection {args} { 00289 eval $itk_component(table) selection $args 00290 } 00291 00292 ## ---------------------------------------------------------------------------- 00293 ## delegate the set command to the table 00294 ## ---------------------------------------------------------------------------- 00295 body MyTable::setCell {args} { 00296 eval $itk_component(table) set $args 00297 00298 # set _myArray($index) $value 00299 # if {$args != ""} { 00300 # eval setCell $args 00301 # } 00302 } 00303 00304 ## ---------------------------------------------------------------------------- 00305 ## delegate the width command to the table 00306 ## ---------------------------------------------------------------------------- 00307 body MyTable::width {args} { 00308 eval $itk_component(table) width $args 00309 } 00310 00311 ## ---------------------------------------------------------------------------- 00312 ## delegate the index command to the table 00313 ## ---------------------------------------------------------------------------- 00314 body MyTable::index {args} { 00315 eval $itk_component(table) index $args 00316 } 00317 00318 ## ---------------------------------------------------------------------------- 00319 ## delegate the insert command to the table 00320 ## ---------------------------------------------------------------------------- 00321 body MyTable::insert {args} { 00322 eval $itk_component(table) insert $args 00323 } 00324 00325 ## ---------------------------------------------------------------------------- 00326 ## delegate the delete command to the table 00327 ## ---------------------------------------------------------------------------- 00328 body MyTable::delete {args} { 00329 eval $itk_component(table) delete $args 00330 } 00331 00332 ## ---------------------------------------------------------------------------- 00333 ## get a value of a table-cell 00334 ## ---------------------------------------------------------------------------- 00335 body MyTable::getCell {args} { 00336 eval $itk_component(table) get $args 00337 } 00338 00339 ## ---------------------------------------------------------------------------- 00340 ## delegate the activate command to the table 00341 ## ---------------------------------------------------------------------------- 00342 body MyTable::activate {args} { 00343 eval $itk_component(table) activate $args 00344 } 00345 00346 ## ---------------------------------------------------------------------------- 00347 ## delegate the icursor command to the table 00348 ## ---------------------------------------------------------------------------- 00349 body MyTable::icursor {args} { 00350 eval $itk_component(table) icursor $args 00351 } 00352 00353 ## ---------------------------------------------------------------------------- 00354 ## delegate the spans command to the table 00355 ## ---------------------------------------------------------------------------- 00356 body MyTable::spans {args} { 00357 eval $itk_component(table) spans $args 00358 } 00359 00360 ## ---------------------------------------------------------------------------- 00361 ## delegate the curselection command to the table 00362 ## ---------------------------------------------------------------------------- 00363 body MyTable::curselection {args} { 00364 eval $itk_component(table) curselection $args 00365 } 00366 00367 ## ---------------------------------------------------------------------------- 00368 ## sort the table rows in the given column. 00369 ## This method sorts the table along the column given by the parameter \a index. 00370 ## The sorting itself is the done by a \c lsort command 00371 ## \param index the column which along which the table is sorted 00372 ## \param args the arguments for the \c lsort command 00373 ## ---------------------------------------------------------------------------- 00374 body MyTable::sortRows {index args} { 00375 set table $itk_component(table) 00376 set rmax [$table cget -rows] 00377 set cmax [$table cget -cols] 00378 set noTitleRows [$table cget -titlerows] 00379 00380 # build a list of sublist representing the array 00381 set restList "" 00382 set tableList "" 00383 for {set rowNo $noTitleRows} {$rowNo < $rmax} {incr rowNo} { 00384 set row [$table get $rowNo,0 $rowNo,$cmax] 00385 set cell [lindex $row $index] 00386 if {$cell == "" || $cell == "{}"} { 00387 lappend restList $row 00388 } else { 00389 lappend tableList $row 00390 } 00391 } 00392 00393 if {$tableList != ""} { 00394 set tableList [eval lsort $args -index $index \$tableList] 00395 } 00396 00397 # restore the rows 00398 erase $noTitleRows,0 $rmax,$cmax 00399 set rowNo $noTitleRows 00400 00401 foreach row $tableList { 00402 $table set row $rowNo,0 $row 00403 incr rowNo 00404 } 00405 foreach row $restList { 00406 $table set row $rowNo,0 $row 00407 incr rowNo 00408 } 00409 } 00410 00411 ## ---------------------------------------------------------------------------- 00412 ## itk_option -troughcolor. 00413 ## set the troughcolor of the scollbars 00414 ## ---------------------------------------------------------------------------- 00415 configbody MyTable::troughcolor { 00416 $itk_component(hbar) configure -troughcolor $itk_option(-troughcolor) 00417 $itk_component(vbar) configure -troughcolor $itk_option(-troughcolor) 00418 } 00419 00420 ## ---------------------------------------------------------------------------- 00421 ## itk_option -vscrollmode. 00422 ## Enable/disable display and mode of vertical scrollbar. 00423 ## ---------------------------------------------------------------------------- 00424 configbody MyTable::vscrollmode { 00425 switch $itk_option(-vscrollmode) { 00426 static { grid $itk_component(vbar) } 00427 dynamic - 00428 none { grid remove $itk_component(vbar) } 00429 default { 00430 error "bad vscrollmode option\ 00431 \"$itk_option(-vscrollmode)\": should\ 00432 be static, dynamic, or none" 00433 } 00434 } 00435 } 00436 00437 ## ---------------------------------------------------------------------------- 00438 ## itk_option -hscrollmode. 00439 ## Enable/disable display and mode of horizontal scrollbar. 00440 ## ---------------------------------------------------------------------------- 00441 configbody MyTable::hscrollmode { 00442 switch $itk_option(-hscrollmode) { 00443 static { grid $itk_component(hbar) } 00444 dynamic - 00445 none { grid remove $itk_component(hbar) } 00446 default { 00447 error "bad hscrollmode option\ 00448 \"$itk_option(-hscrollmode)\": should\ 00449 be static, dynamic, or none" 00450 } 00451 } 00452 } 00453 00454 ## ---------------------------------------------------------------------------- 00455 ## itk_option -selforeground. 00456 ## set the color of the selected row 00457 ## ---------------------------------------------------------------------------- 00458 configbody MyTable::selforeground { 00459 $itk_component(table) tag config sel \ 00460 -foreground $itk_option(-selforeground) 00461 } 00462 00463 ## ---------------------------------------------------------------------------- 00464 ## itk_option -selbackground. 00465 ## set the color of the selected row 00466 ## ---------------------------------------------------------------------------- 00467 configbody MyTable::selbackground { 00468 $itk_component(table) tag config sel \ 00469 -background $itk_option(-selbackground) 00470 } 00471 00472 ## ---------------------------------------------------------------------------- 00473 ## itk_option -rows. 00474 ## configure the number of rows of the table 00475 ## ---------------------------------------------------------------------------- 00476 configbody MyTable::rows { 00477 $itk_component(table) configure -rows $itk_option(-rows) 00478 resize 00479 } 00480 00481 ## ---------------------------------------------------------------------------- 00482 ## itk_option -cols. 00483 ## configure the number of cols of the table 00484 ## ---------------------------------------------------------------------------- 00485 configbody MyTable::cols { 00486 $itk_component(table) configure -cols $itk_option(-cols) 00487 resize 00488 } 00489