Main Page | Modules | Class Hierarchy | Alphabetical List | Class List | File List | Class Members | File Members | Related Pages

YadaConfigDocument.tcl

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 ## YadaConfigDocument - abstract base class for all configure documents. 00013 ## \ingroup YadaConfiguration 00014 ## 00015 ## \author Michael Daum 00016 ## 00017 ## $Id: YadaConfigDocument.tcl,v 1.10 2004/02/26 14:23:36 ddreyer Exp $ 00018 ## ---------------------------------------------------------------------------- 00019 class YadaConfigDocument { 00020 inherit itk::Widget YadaPlainDocument 00021 00022 # variables ---------------------------------------------------------------- 00023 protected variable _oldItem "<none>" 00024 protected variable _allAspects "" 00025 00026 private variable _currentItem "" 00027 private variable _allItems; ## \type TclArray 00028 private variable _currentItemNo 0 00029 private variable _counter "0/0" 00030 00031 # methods ------------------------------------------------------------------ 00032 public method init {} 00033 public method activationHandle {} 00034 public method getItem {name}; ## \type TclString 00035 public method getItemNo {name}; ## \type TclString 00036 public method getAllItems {args}; ## \type TclList 00037 public method getAllItemNames {args}; ## \type TclList 00038 public method setItem {item}; ## \type YadaConfigItem 00039 public method unsetItem {item}; ## \type YadaConfigItem 00040 public method setCurrentItem {item}; ## \type YadaConfigItem 00041 public method getCurrentItem {} 00042 public method displayTitle {} 00043 00044 constructor {args} {}; ## \type TclList 00045 destructor {} 00046 00047 00048 private method _undo {} 00049 private method _selectCommand {} 00050 private method _next {} 00051 private method _prev {} 00052 private method _setCounter {} 00053 00054 00055 protected method _askChange {} 00056 protected method _mark {aspect {newData "undef"} {oldData "undef"}}; ## \type TclString, TclString, TclString 00057 protected method _unmark {{aspect ""}}; ## \type TclString 00058 protected method _getMarked {} 00059 protected method _commit {} 00060 00061 protected method _select {{itemName ""}} ;## \purevirtual \type TclString 00062 protected method _new {} ; ## \purevirtual 00063 protected method _delete {} ;## \purevirtual 00064 protected method _defaults {{fileName ""}} ;## \purevirtual \type TclString 00065 protected method _validateCommand {aspect newValue {oldValue ""}}; ## \type TclString, TclString, TclString 00066 00067 protected method isValidPersistanceFile {fileName}; ## \purevirtual \type TclString 00068 00069 }; 00070 00071 ## ---------------------------------------------------------------------------- 00072 ## constructor 00073 ## ---------------------------------------------------------------------------- 00074 body YadaConfigDocument::constructor {args} { 00075 # 00076 # create custom file menu 00077 # 00078 set fileButton [.main component fileButton] 00079 for { 00080 set i 1 00081 set fileMenu $fileButton.menu$i 00082 } {[winfo exists $fileMenu]} {incr i} { 00083 set fileMenu $fileButton.menu$i 00084 } 00085 itk_component add fileMenu { 00086 menu $fileMenu 00087 } { 00088 keep -background -cursor 00089 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00090 } 00091 00092 ## create submenu entry "New" 00093 itk_component add newMenu { 00094 menu $itk_component(fileMenu).newMenu 00095 } { 00096 keep -background -cursor 00097 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00098 } 00099 00100 ## add file menu entries 00101 $itk_component(fileMenu) add command \ 00102 -label "Load" \ 00103 -underline 0 \ 00104 -command [code $this load] 00105 $itk_component(fileMenu) add command \ 00106 -label "Save" \ 00107 -underline 0 \ 00108 -command [code $this save] 00109 $itk_component(fileMenu) add cascade \ 00110 -label "New" \ 00111 -underline 0 \ 00112 -menu $itk_component(newMenu) 00113 $itk_component(fileMenu) add separator 00114 $itk_component(fileMenu) add command \ 00115 -label "Quit" \ 00116 -underline 0 \ 00117 -command {.main quit} 00118 00119 00120 $itk_component(newMenu) add command \ 00121 -label "Runner" \ 00122 -underline 0 \ 00123 -command {YadaDocument::newDocument YadaRunner Runner} 00124 $itk_component(newMenu) add command \ 00125 -label "Difference" \ 00126 -underline 0 \ 00127 -command {YadaDocument::newDocument YadaDifference Difference} 00128 $itk_component(newMenu) add command \ 00129 -label "Gls Statistics" \ 00130 -underline 0 \ 00131 -command {YadaDocument::newDocument YadaGlsStats GlsStatistics} 00132 $itk_component(newMenu) add command \ 00133 -label "Ranking" \ 00134 -underline 0 \ 00135 -command {YadaDocument::newDocument YadaRanking Ranking} 00136 00137 00138 # edit menu 00139 set editButton [.main component editButton] 00140 for { 00141 set i 1 00142 set editMenu [subst $editButton.menu$i] 00143 } {[winfo exists $editMenu]} {incr i} { 00144 set editMenu [subst $editButton.menu$i] 00145 } 00146 00147 itk_component add editMenu { 00148 menu $editMenu 00149 } { 00150 keep -background -cursor 00151 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00152 } 00153 00154 $itk_component(editMenu) add command \ 00155 -label "Undo" \ 00156 -underline 0 \ 00157 -command [code $this _undo] 00158 $itk_component(editMenu) add command \ 00159 -label "Commit" \ 00160 -underline 0 \ 00161 -command [code $this _commit] 00162 $itk_component(editMenu) add command \ 00163 -label "New" \ 00164 -underline 0 \ 00165 -command [code $this _new] 00166 $itk_component(editMenu) add command \ 00167 -label "Delete" \ 00168 -underline 0 \ 00169 -command [code $this _delete] 00170 $itk_component(editMenu) add separator 00171 $itk_component(editMenu) add command \ 00172 -label "Find" \ 00173 -underline 0 \ 00174 -command [code $this _find] \ 00175 -state disabled 00176 00177 # buttons 00178 itk_component add buttonFrame { 00179 frame $itk_interior.buttonFrame 00180 } 00181 itk_component add topButtonFrame { 00182 frame $itk_interior.buttonFrame.top 00183 } 00184 itk_component add botButtonFrame { 00185 frame $itk_interior.buttonFrame.bot 00186 } 00187 itk_component add commitButton { 00188 button $itk_component(topButtonFrame).commitButton \ 00189 -text "Commit" \ 00190 -command [code $this _commit] 00191 } 00192 itk_component add newButton { 00193 button $itk_component(topButtonFrame).newButton \ 00194 -text "New" \ 00195 -command [code $this _new] 00196 } 00197 itk_component add deleteButton { 00198 button $itk_component(topButtonFrame).deleteButton \ 00199 -text "Delete" \ 00200 -command [code $this _delete] 00201 } 00202 itk_component add undoButton { 00203 button $itk_component(topButtonFrame).undoButton \ 00204 -text "Undo" \ 00205 -command [code $this _undo] 00206 } 00207 itk_component add naviFrame { 00208 frame $itk_component(botButtonFrame).naviFrame 00209 } 00210 itk_component add nextButton { 00211 button $itk_component(naviFrame).nextButton \ 00212 -text ">" \ 00213 -command [code $this _next] 00214 } 00215 itk_component add prevButton { 00216 button $itk_component(naviFrame).prevButton \ 00217 -text "<" \ 00218 -command [code $this _prev] 00219 } 00220 00221 # counter 00222 itk_component add counter { 00223 label $itk_interior.counter \ 00224 -textvariable [scope _counter] \ 00225 -anchor se \ 00226 -font {-adobe-helvetica-medium-r-normal--10-*-*-*-*-*-*-*} 00227 } { } 00228 00229 # childsite 00230 itk_component add childsite { 00231 frame $itk_interior.childsite 00232 } 00233 00234 # name 00235 itk_component add nameLabel { 00236 label $itk_component(childsite).nameLabel \ 00237 -text "Name:" \ 00238 -anchor nw 00239 } {} 00240 00241 itk_component add nameMark { 00242 frame $itk_component(childsite).nameMark \ 00243 -borderwidth 2 00244 } {} 00245 00246 itk_component add name { 00247 iwidgets::combobox $itk_component(nameMark).name \ 00248 -completion false \ 00249 -borderwidth 2 \ 00250 -unique true \ 00251 -selectioncommand [code $this _selectCommand] 00252 } {} 00253 set entry [$itk_component(name) component entry] 00254 $entry configure \ 00255 -validate all \ 00256 -validatecommand [code $this _validateCommand "name" %P] 00257 00258 00259 # 00260 # packing + gridding 00261 # 00262 grid columnconfigure $itk_interior 0 -weight 1 00263 grid rowconfigure $itk_interior 0 -weight 1 00264 grid columnconfigure $itk_component(childsite) 1 -weight 1 00265 grid $itk_component(childsite) -sticky news -padx 10 -pady 10 -row 0 -column 0 -rowspan 2 00266 grid $itk_component(buttonFrame) -sticky ns -padx 10 -row 0 -column 2 -pady 10 00267 grid $itk_component(counter) -sticky se -padx 0 -row 1 -column 2 -pady 5 -padx 5 00268 00269 grid $itk_component(nameLabel) -sticky ew -row 0 -column 0 00270 grid $itk_component(nameMark) -sticky ew -row 0 -column 1 -pady 10 -columnspan 2 00271 pack $itk_component(name) -fill both -expand 1 00272 00273 pack $itk_component(topButtonFrame) -side top -fill both -expand 1 00274 pack $itk_component(botButtonFrame) -side top -fill both -expand 1 00275 pack $itk_component(naviFrame) -side bottom -fill x 00276 pack $itk_component(commitButton) -side top -fill x -pady 5 00277 pack $itk_component(undoButton) -side top -fill x -pady 5 00278 pack $itk_component(newButton) -side top -fill x -pady 5 00279 pack $itk_component(deleteButton) -side top -fill x -pady 5 00280 pack $itk_component(prevButton) -side left -fill x -pady 0 00281 pack $itk_component(nextButton) -side right -fill x -pady 0 00282 00283 00284 # bindings 00285 set entry [$itk_component(name) component entry] 00286 bind $entry <Up> +[code $this _selectCommand] 00287 bind $entry <Down> +[code $this _selectCommand] 00288 00289 eval itk_initialize $args 00290 } 00291 00292 ## ---------------------------------------------------------------------------- 00293 ## destructor 00294 ## ---------------------------------------------------------------------------- 00295 body YadaConfigDocument::destructor {} { 00296 foreach item [array names _allItems] { 00297 itcl::delete $_allItems($item) 00298 } 00299 } 00300 00301 ## ---------------------------------------------------------------------------- 00302 ## init 00303 ## ---------------------------------------------------------------------------- 00304 body YadaConfigDocument::init {} { 00305 if {$_isInitialized} { 00306 return 00307 } 00308 chain 00309 00310 if {$name != ""} { 00311 00312 # load resource file 00313 set rcFileName [file join $::env(YADA_ETC) $name.tcl] 00314 if {[file exists $rcFileName]} { 00315 .main printStatus "... loading $name file `$rcFileName'." 00316 _defaults $rcFileName 00317 } else { 00318 .main printStatus "... configure file `$rcFileName' not found ... using defaults." 00319 _defaults 00320 } 00321 } 00322 00323 # initialize the name combobox 00324 eval $itk_component(name) insert list end [getAllItemNames] 00325 } 00326 00327 ## ---------------------------------------------------------------------------- 00328 ## _selectCommand 00329 ## ---------------------------------------------------------------------------- 00330 body YadaConfigDocument::_selectCommand {} { 00331 _unmark 00332 after idle [code $this _select] 00333 } 00334 00335 ## ---------------------------------------------------------------------------- 00336 ## _askChange 00337 ## ---------------------------------------------------------------------------- 00338 body YadaConfigDocument::_askChange {} { 00339 set result 1 00340 00341 set markedAspects [_getMarked] 00342 if {$markedAspects != ""} { 00343 set msg [iwidgets::messagedialog .msg \ 00344 -text "Are you sure that you want to discard your changes?" \ 00345 -title "Yada - Caution" \ 00346 -image [YadaImages::get question] \ 00347 -modality application \ 00348 -master $itk_interior] 00349 $msg buttonconfigure OK -text "Yes" 00350 $msg buttonconfigure Cancel -text "No" 00351 $msg center . 00352 set result [$msg activate] 00353 destroy $msg 00354 00355 # if {!$result} { 00356 # set box $itk_component(name) 00357 # $box delete entry 0 end 00358 # $box insert entry 0 $_oldItem 00359 # } 00360 } 00361 00362 return $result 00363 } 00364 00365 ## ---------------------------------------------------------------------------- 00366 ## activationHandle 00367 ## ---------------------------------------------------------------------------- 00368 body YadaConfigDocument::activationHandle {} { 00369 chain 00370 00371 ## activate custom file menu 00372 set fileButton [.main component fileButton] 00373 $fileButton configure -menu $itk_component(fileMenu) 00374 00375 [getCurrentItem] displayTitle 00376 00377 # set the menus 00378 set editButton [.main component editButton] 00379 $editButton configure -menu $itk_component(editMenu) 00380 } 00381 00382 ## ---------------------------------------------------------------------------- 00383 ## _unmark 00384 ## ---------------------------------------------------------------------------- 00385 body YadaConfigDocument::_unmark {{aspect ""}} { 00386 if {$aspect == ""} { 00387 foreach aspect $_allAspects { 00388 $itk_component(${aspect}Mark) configure -background gray90 00389 } 00390 } else { 00391 $itk_component(${aspect}Mark) configure -background gray90 00392 } 00393 } 00394 00395 ## ---------------------------------------------------------------------------- 00396 ## _mark 00397 ## ---------------------------------------------------------------------------- 00398 body YadaConfigDocument::_mark {aspect {newData "undef"} {oldData "undef"}} { 00399 set itemName [$itk_component(name) get] 00400 if {$itemName == "<none>" || $itemName == ""} { 00401 return 00402 } 00403 00404 if {$newData == "undef"} { 00405 set newData [$itk_component($aspect) get] 00406 } 00407 if {$oldData == "undef"} { 00408 set oldData [string trim [$_currentItem cget -$aspect]] 00409 } 00410 00411 set mark $itk_component(${aspect}Mark) 00412 00413 if {$newData != $oldData} { 00414 $mark configure -background red4 00415 } else { 00416 $mark configure -background gray90 00417 } 00418 } 00419 00420 ## ---------------------------------------------------------------------------- 00421 ## _getMarked 00422 ## ---------------------------------------------------------------------------- 00423 body YadaConfigDocument::_getMarked {} { 00424 set result "" 00425 foreach aspect $_allAspects { 00426 if {[$itk_component(${aspect}Mark) cget -background] == "red4"} { 00427 lappend result $aspect 00428 } 00429 } 00430 00431 return $result 00432 } 00433 00434 ## ---------------------------------------------------------------------------- 00435 ## _undo 00436 ## ---------------------------------------------------------------------------- 00437 body YadaConfigDocument::_undo {} { 00438 if {$_currentItem != ""} { 00439 _select [$_currentItem cget -name] 00440 } 00441 } 00442 00443 ## ---------------------------------------------------------------------------- 00444 ## _validateCommand 00445 ## ---------------------------------------------------------------------------- 00446 body YadaConfigDocument::_validateCommand {aspect newValue {oldValue ""}} { 00447 if {$_currentItem == ""} { 00448 return 00449 } 00450 00451 if {$oldValue == ""} { 00452 set oldValue [string trim [$_currentItem cget -$aspect]] 00453 } 00454 00455 set mark $itk_component(${aspect}Mark) 00456 if {$newValue != $oldValue} { 00457 $mark configure -background red4 00458 } else { 00459 $mark configure -background gray90 00460 } 00461 00462 return 1 00463 } 00464 00465 ## ---------------------------------------------------------------------------- 00466 ## _next 00467 ## ---------------------------------------------------------------------------- 00468 body YadaConfigDocument::_next {} { 00469 set itemNames [getAllItemNames] 00470 set index $_currentItemNo 00471 incr index 00472 set itemName [lindex $itemNames $index] 00473 if {$itemName != ""} { 00474 _select $itemName 00475 } 00476 } 00477 00478 ## ---------------------------------------------------------------------------- 00479 ## _prev 00480 ## ---------------------------------------------------------------------------- 00481 body YadaConfigDocument::_prev {} { 00482 set itemNames [getAllItemNames] 00483 set index $_currentItemNo 00484 incr index -1 00485 set itemName [lindex $itemNames $index] 00486 if {$itemName != ""} { 00487 _select $itemName 00488 } 00489 } 00490 00491 ## ---------------------------------------------------------------------------- 00492 ## getCurrentItem 00493 ## \returns the currently displayed YadaConfigItem 00494 ## ---------------------------------------------------------------------------- 00495 body YadaConfigDocument::getCurrentItem {} { 00496 return $_currentItem 00497 } 00498 00499 ## ---------------------------------------------------------------------------- 00500 ## update the counter label. 00501 ## This method sets the _counter to reflect the number of items in this document. 00502 ## ---------------------------------------------------------------------------- 00503 body YadaConfigDocument::_setCounter {} { 00504 set noItems [llength [array names _allItems]] 00505 if {$noItems == 0} { 00506 set _counter "0/0" 00507 } else { 00508 set _counter "[expr $_currentItemNo +1]/$noItems" 00509 } 00510 } 00511 00512 ## ---------------------------------------------------------------------------- 00513 ## setCurrentItem 00514 ## ---------------------------------------------------------------------------- 00515 body YadaConfigDocument::setCurrentItem {item} { 00516 if {$item == ""} { 00517 set firstName [lindex [getAllItemNames] 0] 00518 set _currentItem [getItem $firstName] 00519 } else { 00520 setItem $item 00521 } 00522 00523 set _currentItem $item 00524 00525 if {$_currentItem == ""} { 00526 set _currentItemNo "0" 00527 } else { 00528 set _currentItemNo [getItemNo [$item cget -name]] 00529 } 00530 _setCounter 00531 } 00532 00533 ## ---------------------------------------------------------------------------- 00534 ## unsetItem 00535 ## ---------------------------------------------------------------------------- 00536 body YadaConfigDocument::unsetItem {item} { 00537 set itemName [$item cget -name] 00538 00539 if {![info exists _allItems($itemName)]} { 00540 return 00541 } 00542 00543 if {$_currentItem == $item} { 00544 setCurrentItem "" 00545 } 00546 00547 unset _allItems($itemName) 00548 _setCounter 00549 } 00550 00551 ## ---------------------------------------------------------------------------- 00552 ## setItem 00553 ## ---------------------------------------------------------------------------- 00554 body YadaConfigDocument::setItem {item} { 00555 if {$item == ""} { 00556 return 00557 } 00558 00559 set itemName [$item cget -name] 00560 set _allItems($itemName) $item 00561 _setCounter 00562 } 00563 00564 ## ---------------------------------------------------------------------------- 00565 ## getItemNo 00566 ## ---------------------------------------------------------------------------- 00567 body YadaConfigDocument::getItemNo {itemName} { 00568 set allNames [getAllItemNames] 00569 return [lsearch $allNames $itemName] 00570 } 00571 00572 ## ---------------------------------------------------------------------------- 00573 ## getItem 00574 ## ---------------------------------------------------------------------------- 00575 body YadaConfigDocument::getItem {itemName} { 00576 if {[info exists _allItems($itemName)]} { 00577 return $_allItems($itemName) 00578 } else { 00579 return "" 00580 } 00581 } 00582 00583 ## ---------------------------------------------------------------------------- 00584 ## getAllItems 00585 ## \returns a list of all known YadaConfigItems in this document 00586 ## ---------------------------------------------------------------------------- 00587 body YadaConfigDocument::getAllItems {args} { 00588 set result "" 00589 00590 foreach itemName [eval getAllItemNames $args] { 00591 lappend result $_allItems($itemName) 00592 } 00593 00594 return $result 00595 } 00596 00597 ## ---------------------------------------------------------------------------- 00598 ## getAllItemNames 00599 ## \returns a list of all known names of YadaConfigItems in this document 00600 ## ---------------------------------------------------------------------------- 00601 body YadaConfigDocument::getAllItemNames {args} { 00602 set result "" 00603 00604 if {[llength $args] == 0} { 00605 return [lsort -dictionary [array names _allItems]] 00606 } 00607 00608 foreach itemName [lsort -dictionary [array names _allItems]] { 00609 foreach pattern $args { 00610 if {[string match $pattern $itemName]} { 00611 lappend result $itemName 00612 break 00613 } 00614 } 00615 } 00616 00617 return $result 00618 } 00619 00620 ## ---------------------------------------------------------------------------- 00621 ## _commit 00622 ## ---------------------------------------------------------------------------- 00623 body YadaConfigDocument::_commit {} { 00624 00625 # check new item name 00626 set newName [$itk_component(name) get] 00627 set oldName [$_currentItem cget -name] 00628 00629 set listBox [$itk_component(name) component list] 00630 set knownNames [$listBox get 0 end] 00631 00632 if {$newName != $oldName} { 00633 if {[info exists _allItems($newName)]} { 00634 printMessage "ERROR: '$newName' exists already." error 00635 return 0 00636 } 00637 00638 # delete the old item name 00639 set index [lsearch $knownNames $oldName] 00640 $listBox delete $index $index 00641 set knownNames [lreplace $knownNames $index $index] 00642 00643 # relockate item in array 00644 unset _allItems($oldName) 00645 set _allItems($newName) $_currentItem 00646 $_currentItem configure -name $newName 00647 set _currentItemNo [getItemNo $newName] 00648 _setCounter 00649 } 00650 00651 # save name unique in comboboxes 00652 if {[getIndexOfName $listBox $newName] < 0} { 00653 lappend knownNames $newName 00654 $listBox delete 0 end 00655 eval $listBox insert 0 [lsort -dictionary $knownNames] 00656 } 00657 00658 return 1 00659 } 00660 00661 ## ---------------------------------------------------------------------------- 00662 ## Update toolbar, menubar and titlebar 00663 ## ---------------------------------------------------------------------------- 00664 body YadaConfigDocument::displayTitle {} { 00665 00666 set currentItem [getCurrentItem] 00667 set loadButton [[[.main getDocument Configure] component toolbar] component loadButton] 00668 set saveButton [[[.main getDocument Configure] component toolbar] component saveButton] 00669 00670 00671 if { $currentItem != "" } { 00672 $currentItem displayTitle 00673 00674 if { [$currentItem hasSavedState] } { 00675 $itk_component(fileMenu) entryconfigure 0 -state normal 00676 $loadButton configure -state normal 00677 } else { 00678 $itk_component(fileMenu) entryconfigure 0 -state disabled 00679 $loadButton configure -state disabled 00680 } 00681 00682 if { [$currentItem isModified] && [string compare [$currentItem cget -name] "<none>"] != 0 } { 00683 $itk_component(fileMenu) entryconfigure 1 -state normal 00684 $saveButton configure -state normal 00685 } else { 00686 $itk_component(fileMenu) entryconfigure 1 -state disabled 00687 $saveButton configure -state disabled 00688 } 00689 } 00690 } 00691 00692

YADA 2.0-alpha (20 Oct 2004)