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 ## DataBrowser - Abstract base class for tabbed panes containing 00013 ## a top frame of buttons and a center table 00014 ## 00015 ## 00016 ## Rules for subclassing: 00017 ## 00018 ## - Override init_data in order to perform any additional initializations 00019 ## 00020 ## - Call init_data whenever the frontend has to be set back to an initial 00021 ## state, e.g. after loading a new file 00022 ## 00023 ## - Always call init_data at the end of derived constructor just before 00024 ## itk_initialize 00025 ## 00026 ## - Add and pack additional components in derived constructor 00027 ## use component childsite to insert buttons into top panel 00028 ## 00029 ## - All remaining methods possess default implementation, which may be 00030 ## overridden 00031 ## 00032 ## - Use variable _selection to store table row selection ids 00033 ## 00034 ## - Set variable _idColumnIndex to index number of column, that will contain 00035 ## selectable IDs (set at beginning of derived constructor!) 00036 ## 00037 ## - Override getCData to get a pointer to the underlying C-Structure 00038 ## - Override refreshrow to get data corresponding to the pointer retrieved by getCData 00039 ## and writing it into the table 00040 ## 00041 ## \author Dietmar Dreyer (see also AUTHORS and THANKS for more) 00042 ## 00043 ## $Id: databrowser.tcl,v 1.13 2004/10/11 13:50:06 micha Exp $ 00044 ## ---------------------------------------------------------------------------- 00045 00046 class DataBrowser { 00047 inherit ::itk::Widget 00048 00049 # public methods 00050 public method getSelection {} 00051 public method setSelection {args}; ## \type TclList 00052 public method setIndexedSelection {args}; ## \type TclList 00053 00054 ## abstract methods for retrieving the relevant C or Tcl data values for a given ID 00055 public method getCData {id}; ## \type TclString 00056 00057 public method refreshid {id}; ## \type TclString 00058 00059 # protected methods 00060 protected method init_data {}; ## call at the end of derived constructor 00061 protected method _rowtag {row}; ## \type TclNumber 00062 protected method _return_action {} 00063 protected method _browse_action {w}; ## \type TclWidget 00064 protected method _keypress_action {w k}; ## \type TclWidget, TclKeyBinding 00065 protected method _motion_action {w x y }; ## \type TclWidget,TclNumber,TclNumber 00066 protected method _setCount {n}; ## \type TclNumber 00067 00068 ## abstract method called in refreshid 00069 protected method refreshrow {row item}; ## \type TclNumber, TclString 00070 00071 # private methods 00072 00073 private method _getMatchingRows {regex varnameListIDs varnameMapIDs}; ## \type TclString,TclString,TclString 00074 private method _evalSelectionPatterns {}; ## returns list of matching IDs 00075 00076 constructor {args} {}; ## \type TclList 00077 00078 # protected data members 00079 00080 ## string of current selected row ids 00081 protected variable _selection "" 00082 00083 ## column index of table that contains selectable ids (used in _browse_action) 00084 protected variable _idColumnIndex "" 00085 00086 # string of letters typed by the user for quick access 00087 private variable _prefix "" 00088 00089 }; 00090 00091 ## ---------------------------------------------------------------------------- 00092 ## A DataBrowser constructor. 00093 ## \param args arguments passed to itk_initialize 00094 ## ---------------------------------------------------------------------------- 00095 body DataBrowser::constructor {args} { 00096 set _idColumnIndex 1 00097 itk_component add childsite { 00098 frame $itk_interior.childsite \ 00099 -borderwidth 0 \ 00100 -relief flat \ 00101 } { 00102 keep -cursor -background 00103 } 00104 00105 itk_component add entryfield { 00106 iwidgets::entryfield $itk_interior.entry \ 00107 -textvariable [scope _selection] \ 00108 -labelpos w \ 00109 -textbackground gray80 \ 00110 -labeltext "Selection :" 00111 } { 00112 keep -background -cursor -foreground 00113 rename -labeltext -entrytext entryText EntryText 00114 rename -textfont -entryfont entryFont Font 00115 rename -textbackground -entrybackground entryBackground Background 00116 } 00117 00118 itk_component add table { 00119 MyTable $itk_interior.table \ 00120 -exportselection 0 \ 00121 -rows 20 \ 00122 -cols 9 \ 00123 -cellanchor c \ 00124 -state disabled \ 00125 -colstretchmode all \ 00126 -colseparator " " \ 00127 -rowstretchmode none \ 00128 -selectmode extended \ 00129 -selecttype row \ 00130 -titlecols 1 \ 00131 -titlerows 1 \ 00132 -rowtagcommand [code $this _rowtag] 00133 } { 00134 keep -background -cursor 00135 } 00136 00137 itk_component add countlabel { 00138 label $itk_interior.countlabel \ 00139 -relief flat \ 00140 -borderwidth 0 \ 00141 -text "Count: 0" 00142 } { 00143 keep -background -cursor 00144 } 00145 00146 itk_component add echo_area { 00147 label $itk_interior.echo_area \ 00148 -relief flat \ 00149 -borderwidth 0 00150 } { 00151 keep -background -cursor 00152 } 00153 00154 # packing 00155 grid $itk_component(childsite) -row 0 -column 0 -sticky ew -padx 3 00156 grid $itk_component(countlabel) -row 0 -column 1 -sticky ew -padx 3 00157 grid $itk_component(entryfield) -row 1 -column 0 -sticky ew -padx 3 -pady 3 00158 grid $itk_component(echo_area) -row 1 -column 1 -sticky ew -padx 3 -pady 3 00159 grid $itk_component(table) -row 2 -column 0 -columnspan 2 -sticky news -padx 3 00160 grid rowconfigure $itk_interior 2 -weight 1 00161 grid columnconfigure $itk_interior 0 -weight 1 00162 00163 # some bindings 00164 set table [$itk_component(table) component table] 00165 bind $table <Motion> "[code $this _motion_action %W %x %y]; break" 00166 set ef [$itk_component(entryfield) component entry] 00167 bind $ef <Return> [code $this _return_action] 00168 #bind $ef <KeyRelease> [code "$this _keypress_action; continue"] 00169 bind $table <ButtonRelease-1> [code $this _browse_action %W] 00170 bind $table <KeyPress> [code "$this _keypress_action %A %K; break"] 00171 00172 # Default Table Configurations 00173 $table tag config default 00174 $table tag config colored -bg gray80 00175 00176 eval itk_initialize $args 00177 } 00178 00179 00180 ## ---------------------------------------------------------------------------- 00181 ## browse slot. 00182 ## This method adjusts the selected file in AllFiles::_selection. 00183 ## \param w the widget bound to this slot. 00184 ## ---------------------------------------------------------------------------- 00185 body DataBrowser::_browse_action {w} { 00186 00187 set ids "" 00188 set lastrow 0 00189 foreach index [$w curselection] { 00190 scan $index "%d,%d" row col 00191 if {$lastrow == $row } { 00192 continue 00193 } 00194 set lastrow $row 00195 set id [$w get $row,$_idColumnIndex] 00196 if {$id != ""} { 00197 lappend ids $id 00198 } 00199 } 00200 eval setSelection $ids 00201 } 00202 00203 00204 ## ---------------------------------------------------------------------------- 00205 ## Returns a list of all row indices matching 'regex' in the ID column 00206 ## \param regex regular expression string 00207 ## \param varnameListIDs in-out-parameter, name of local variable to 00208 ## append matching IDs 00209 ## \param varnameMapIDs in-out-parameter, name of local array-variable 00210 ## to insert matching IDs 00211 ## in order to prohibit duplicate selection entries in entry field 00212 ## ---------------------------------------------------------------------------- 00213 body DataBrowser::_getMatchingRows {regex varnameListIDs varnameMapIDs} { 00214 upvar $varnameListIDs matchingIDs 00215 upvar $varnameMapIDs mapIDs 00216 set table $itk_component(table) 00217 00218 set rmax [$table cget -rows] 00219 set ids [$table getCell 1,$_idColumnIndex $rmax,$_idColumnIndex] 00220 00221 set rows "" 00222 foreach id $ids { 00223 if {[regexp -expanded -- "^$regex$" $id match] == 1} { 00224 set row [lsearch $ids $match] 00225 00226 if {$row >= 0 && [info exists mapIDs($match)] == 0} { 00227 lappend rows $row 00228 lappend matchingIDs $match 00229 set mapIDs($match) 1 00230 } 00231 } 00232 } 00233 return $rows 00234 } 00235 00236 00237 ## ---------------------------------------------------------------------------- 00238 ## actions to take place on pressing return in the entryfield. 00239 ## ---------------------------------------------------------------------------- 00240 body DataBrowser::_return_action {} { 00241 set _selection [_evalSelectionPatterns] 00242 set rows [eval setSelection $_selection] 00243 00244 if {$rows != {} } { 00245 $itk_component(table) see "[lindex $rows end],0" 00246 } 00247 } 00248 00249 ## ---------------------------------------------------------------------------- 00250 ## Evaluates input to the entry field as a list of regular expressions 00251 ## and matches them against all IDs in order to return a list of matching 00252 ## IDs 00253 ## ---------------------------------------------------------------------------- 00254 body DataBrowser::_evalSelectionPatterns {} { 00255 set table $itk_component(table) 00256 00257 00258 set rows "" 00259 set matchingIDs "" 00260 set mapIDs(0) "" 00261 00262 foreach pattern $_selection { 00263 set match [_getMatchingRows $pattern matchingIDs mapIDs] 00264 00265 if { $match != "" } { 00266 set rows [concat $rows $match] 00267 } 00268 00269 if {[llength $rows] > 0} { 00270 foreach row $rows { 00271 $table selection set $row,0 00272 } 00273 } 00274 } 00275 00276 if {$rows != {} } { 00277 $itk_component(table) see "[lindex $rows end],0" 00278 } 00279 00280 return $matchingIDs 00281 00282 } 00283 00284 00285 ## ---------------------------------------------------------------------------- 00286 ## return a list of selected ids 00287 ## ---------------------------------------------------------------------------- 00288 body DataBrowser::getSelection {} { 00289 return $_selection 00290 } 00291 00292 00293 00294 ## ---------------------------------------------------------------------------- 00295 ## Select one or more rows. A previous selection is cleared; 00296 ## without arguemnts, removes all selections. 00297 ## 00298 ## ARGS must be a list of strings without spaces in them. 00299 ## ---------------------------------------------------------------------------- 00300 body DataBrowser::setSelection {args} { 00301 set table $itk_component(table) 00302 00303 set rmax [$table cget -rows] 00304 set ids [$table getCell 0,$_idColumnIndex $rmax,$_idColumnIndex] 00305 $table selection clear 0,0 end 00306 00307 set newselection "" 00308 set rows "" 00309 foreach id $args { 00310 set row [lsearch $ids $id] 00311 if {$row >= 0} { 00312 $table selection set $row,0 00313 lappend newselection $id 00314 lappend rows $row 00315 } 00316 } 00317 set _selection $newselection 00318 00319 return $rows 00320 } 00321 00322 ## ---------------------------------------------------------------------------- 00323 ## Select one or more rows. A previous selection is cleared; 00324 ## without arguemnts, removes all selections. 00325 ## 00326 ## ARGS is a list of row indices. 00327 ## ---------------------------------------------------------------------------- 00328 body DataBrowser::setIndexedSelection {args} { 00329 00330 set table $itk_component(table) 00331 set rmax [$table cget -rows] 00332 set ids [$table getCell 0,$_idColumnIndex $rmax,$_idColumnIndex] 00333 $table selection clear 0,0 end 00334 00335 set newselection "" 00336 set rows "" 00337 foreach row $args { 00338 00339 if {$row >= 0 && $row <= $rmax} { 00340 $table selection set $row,0 00341 set id [$table getCell $row,$_idColumnIndex] 00342 lappend newselection $id 00343 } 00344 00345 $table yview [expr $row - 1] 00346 00347 } 00348 set _selection $newselection 00349 } 00350 00351 00352 ## ---------------------------------------------------------------------------- 00353 ## colorize the table rows 00354 ## This method is a callback configured to the table in order to colorize the 00355 ## rows. 00356 ## ---------------------------------------------------------------------------- 00357 body DataBrowser::_rowtag {row} { 00358 if {[expr $row % 2]} { 00359 return "default" 00360 } else { 00361 return "colored" 00362 } 00363 } 00364 00365 00366 ## ---------------------------------------------------------------------------- 00367 ## display the count-label. 00368 ## This number should reflect the number of items selected 00369 ## \param n the number to be set 00370 ## ---------------------------------------------------------------------------- 00371 body DataBrowser::_setCount {n} { 00372 $itk_component(countlabel) configure -text "Count: $n" 00373 if {$n < 20} { 00374 set n 20 00375 } 00376 $itk_component(table) configure -rows [expr $n + 1] 00377 } 00378 00379 00380 ## ---------------------------------------------------------------------------- 00381 ## Default motion slot. 00382 ## \param w the widget where the motion was detected 00383 ## \param x the x coords of the mouse 00384 ## \param y the y coords of the mouse 00385 ## ---------------------------------------------------------------------------- 00386 body DataBrowser::_motion_action {w x y} { 00387 focus $w 00388 } 00389 00390 00391 ## ---------------------------------------------------------------------------- 00392 ## refresh the displayed data for a specific ID 00393 ## ---------------------------------------------------------------------------- 00394 body DataBrowser::refreshid {id} { 00395 set data [getCData $id] 00396 if {$data == "NULL"} return 00397 00398 set table $itk_component(table) 00399 set rmax [$table cget -rows] 00400 set ids [$table getCell 0,0 $rmax,0] 00401 set r [lsearch -exact $ids $id] 00402 00403 if {$r == -1} { 00404 init_data 00405 } else { 00406 refreshrow $r $data 00407 } 00408 } 00409 00410 00411 ## ---------------------------------------------------------------------------- 00412 ## React to a keypress into the table. 00413 ## 00414 ## Keys typed by the user are collected into a string, and the row 00415 ## whose id matches that string is selected. 00416 ## ---------------------------------------------------------------------------- 00417 body DataBrowser::_keypress_action {a k} { 00418 00419 if {"Next" == $k} { 00420 scan [$itk_component(table) yview] "%f %f" a z 00421 set a0 [expr $a + ($z - $a)] 00422 $itk_component(table) yview moveto $a0 00423 return 00424 } 00425 00426 if {"Prior" == $k} { 00427 scan [$itk_component(table) yview] "%f %f" a z 00428 set a0 [expr $a - ($z - $a)] 00429 $itk_component(table) yview moveto $a0 00430 return 00431 } 00432 00433 if {"Home" == $k} { 00434 $itk_component(table) yview moveto 0 00435 return 00436 } 00437 00438 if {"End" == $k} { 00439 $itk_component(table) yview moveto 1 00440 return 00441 } 00442 00443 if {"Down" == $k} { 00444 scan [$itk_component(table) yview] "%f %f" a z 00445 if {1.0 == $z} return 00446 set nrrows [$itk_component(table) cget -rows] 00447 set offset [expr 1.0 / $nrrows] 00448 00449 # In very large tables, the offset that we have calculated may 00450 # be lost in rounding. Therefore we scroll until the yview changes. 00451 set newa $a 00452 set n 0 00453 while {$newa == $a} { 00454 incr n 00455 set a0 [expr $a + $n * $offset] 00456 $itk_component(table) yview moveto $a0 00457 scan [$itk_component(table) yview] "%f %f" newa z 00458 } 00459 return 00460 } 00461 00462 if {"Up" == $k} { 00463 scan [$itk_component(table) yview] "%f %f" a z 00464 if {0 == $a} return 00465 set nrrows [$itk_component(table) cget -rows] 00466 set offset [expr 1.0 / $nrrows] 00467 00468 # In very large tables, the offset that we have calculated may 00469 # be lost in rounding. Therefore we scroll until the yview changes. 00470 set newa $a 00471 set n 0 00472 while {$newa == $a} { 00473 incr n 00474 set a0 [expr $a - $n * $offset] 00475 $itk_component(table) yview moveto $a0 00476 scan [$itk_component(table) yview] "%f %f" newa z 00477 } 00478 return 00479 } 00480 00481 00482 # ignore other unprintables such as Shift_left 00483 if {"" == $a} return 00484 00485 set table $itk_component(table) 00486 set rmax [$table cget -rows] 00487 set ids [$table getCell 1,$_idColumnIndex $rmax,$_idColumnIndex] 00488 00489 if {"BackSpace" == $k} { 00490 00491 # take back one character 00492 regsub ".$" $_prefix "" _prefix 00493 } elseif {"Escape" == $k} { 00494 00495 # cancel search prefix 00496 set _prefix "" 00497 $itk_component(echo_area) configure -text "" 00498 setSelection 00499 return 00500 } elseif {"Tab" == $k} { 00501 00502 # intelligently add characters 00503 00504 # find all keys that start like this 00505 set next "" 00506 foreach id $ids { 00507 if {$id == $_prefix} return 00508 if {[regexp "^${_prefix}(.)" $id dummy c] != 1} continue 00509 if {"" == $next} { 00510 set next $c 00511 } 00512 if {"" != $next && $next != $c} { 00513 return 00514 } 00515 } 00516 00517 # if they all continue the same, add that key to _prefix and repeat 00518 if {"" != $next} { 00519 append _prefix $next 00520 $itk_component(echo_area) configure -text $_prefix 00521 _keypress_action $a $k 00522 } 00523 00524 } else { 00525 append _prefix $a 00526 } 00527 00528 # find first matching row 00529 set found "" 00530 set row 0 00531 foreach id $ids { 00532 incr row 00533 if {[regexp "^$_prefix" $id] == 1} { 00534 set found $id 00535 break 00536 } 00537 } 00538 if {"" == $found} { 00539 set id "" 00540 set row -1 00541 } 00542 00543 # redisplay 00544 $itk_component(echo_area) configure -text $_prefix 00545 if { -1 != $row} { 00546 eval setIndexedSelection $row 00547 } 00548 } 00549