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 # Author: Michael Daum 00012 # $Id: mytable.tcl,v 1.17 2004/09/27 10:32:59 foth Exp $ 00013 00014 ## ---------------------------------------------------------------------------- 00015 ## MyTable - OO wrapper for tktable. 00016 ## Some time aggo Jeffrey Hobbs, the maintainer of tktable, discontinued the 00017 ## 00 wrapper for this marvelous widget. So here is my version of it. 00018 ## Its main purpose is to delegate calls from MyTable to the embedded table 00019 ## component. 00020 ## 00021 ## There are some value addons that have been done ontop, that is 00022 ## - the table is sorteable (MyTable::sortRows()) 00023 ## - clearing table cells is easier (MyTable::erase()) 00024 ## - provide an array to store the table content 00025 ## - vertical and horizontal scrollbars 00026 ## - table rows are collored 00027 ## - an improved widget layout 00028 ## ---------------------------------------------------------------------------- 00029 class MyTable { 00030 inherit itk::Widget 00031 00032 # new options 00033 itk_option define -vscrollmode vscrollMode ScrollMode static 00034 itk_option define -hscrollmode hscrollMode ScrollMode static 00035 itk_option define -selforeground selForeground SelForeground yellow 00036 itk_option define -selbackground selBackground SelBackground gray50 00037 itk_option define -state state State disabled 00038 itk_option define -rows rows Rows 20 00039 itk_option define -cols cols Cols 10 00040 itk_option define -outerborderwidth outerBorderWidth Width 2 00041 itk_option define -outerrelief outerRelief Relief sunk 00042 itk_option define -troughcolor troughColor Background gray 00043 00044 # public methods 00045 public method activate {args}; ## \type TclList 00046 public method childsite {} 00047 public method clear {args}; ## \type TclList 00048 public method delete {args}; ## \type TclList 00049 public method erase {fromCell toCell}; ## \type CellSpec, CellSpec 00050 public method getCell {args}; ## \type TclList 00051 public method hset {args}; ## \type TclList 00052 public method icursor {args}; ## \type TclList 00053 public method index {args}; ## \type TclList 00054 public method insert {args}; ## \type TclList 00055 public method print {} 00056 public method see {args}; ## \type TclList 00057 public method selection {args}; ## \type TclList 00058 public method setCell {args}; ## \type TclList 00059 public method spans {args}; ## \type TclList 00060 public method tag {args}; ## \type TclList 00061 public method vset {args}; ## \type TclList 00062 public method width {args}; ## \type TclList 00063 public method xview {args}; ## \type TclList 00064 public method yview {args}; ## \type TclList 00065 public method curselection {args }; ## \type TclList 00066 public method sortRows {index args}; ## \type TclNumber, TclList 00067 00068 constructor {args} {}; ## \type TclList 00069 00070 00071 # private methods 00072 private method resize {} 00073 private method colorize {num} ; ## \type TclNumber 00074 00075 ## storage for the table content. 00076 private variable _myArray 00077 }; 00078 00079 ## ---------------------------------------------------------------------------- 00080 ## constructor 00081 ## ---------------------------------------------------------------------------- 00082 body MyTable::constructor {args} { 00083 00084 # define all widget-components 00085 itk_component add frame { 00086 frame $itk_interior.frame 00087 } { 00088 rename -borderwidth -outerborderwidth outerBorderWidth Width 00089 rename -relief -outerrelief outerRelief Relief 00090 } 00091 00092 itk_component add table { 00093 table $itk_component(frame).table \ 00094 -relief flat \ 00095 -drawmode slow \ 00096 -variable [scope _myArray] \ 00097 -xscrollcommand [code $this hset] \ 00098 -yscrollcommand [code $this vset] \ 00099 -rowtagcommand [code $this colorize ] \ 00100 -borderwidth 2 \ 00101 -highlightthickness 0 00102 } { 00103 keep -state -background -cursor -browsecommand -selectioncommand\ 00104 -colstretchmode -rowstretchmode -rowseparator -colseparator \ 00105 -exportselection -selectmode -selecttype -titlecols \ 00106 -titlerows -rowtagcommand -coltagcommand -font -borderwidth \ 00107 -selecttitles 00108 rename -anchor -cellanchor cellAnchor Anchor 00109 } 00110 $itk_component(table) tag config title \ 00111 -anchor c \ 00112 -relief raised \ 00113 -borderwidth 1 00114 $itk_component(table) tag config sel \ 00115 -relief flat 00116 $itk_component(table) tag config active \ 00117 -anchor w \ 00118 -fg black \ 00119 -bg gray 00120 00121 00122 itk_component add vbar { 00123 scrollbar $itk_component(frame).vbar \ 00124 -orient vertical \ 00125 -command [code $this yview] \ 00126 -elementborderwidth -1 \ 00127 -width 12 \ 00128 -borderwidth 2 00129 } { } 00130 00131 itk_component add hbar { 00132 scrollbar $itk_component(frame).hbar \ 00133 -orient horizontal \ 00134 -command [code $this xview] \ 00135 -elementborderwidth -1 \ 00136 -width 12 \ 00137 -borderwidth 2 00138 } { } 00139 00140 # packing + gridding 00141 pack $itk_component(frame) -fill both -expand 1 00142 grid $itk_component(table) -row 0 -column 0 -sticky news -padx 1 00143 grid $itk_component(vbar) -row 0 -column 1 -sticky ns -pady 1 00144 grid $itk_component(hbar) -row 1 -column 0 -sticky ew -padx 2 -pady 1 00145 00146 grid columnconfig $itk_component(frame) 0 -weight 1 00147 grid rowconfig $itk_component(frame) 0 -weight 1 00148 00149 # some bindings 00150 bind $itk_component(table) <Configure> [code $this resize] 00151 00152 eval itk_initialize $args 00153 } 00154 00155 ## ---------------------------------------------------------------------------- 00156 ## xview. 00157 ## ---------------------------------------------------------------------------- 00158 body MyTable::xview {args} { 00159 eval $itk_component(table) xview $args 00160 } 00161 00162 ## ---------------------------------------------------------------------------- 00163 ## yview 00164 ## ---------------------------------------------------------------------------- 00165 body MyTable::yview {args} { 00166 set result [eval $itk_component(table) yview $args] 00167 return $result 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 ## 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 ## 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 ## 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 ## 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 ## 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 ## 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 ## 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