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 ## YadaExperiments - configure document for all experiments. 00013 ## \ingroup YadaConfiguration 00014 ## 00015 ## \author Michael Daum 00016 ## 00017 ## $Id: YadaExperiments.tcl,v 1.9 2004/10/15 17:24:37 micha Exp $ 00018 ## ---------------------------------------------------------------------------- 00019 class YadaExperiments { 00020 inherit YadaConfigDocument 00021 00022 00023 # variables ---------------------------------------------------------------- 00024 private variable _experimentTypes "" 00025 private variable _isActive 1 00026 private variable _isComplete 0 00027 00028 # methods ------------------------------------------------------------------ 00029 public method init {} 00030 public method getActiveExperiments {args}; ## \type TclList 00031 public method activationHandle {} 00032 public method load {} 00033 public method save {} 00034 00035 constructor {args} {}; ## \type TclList 00036 00037 private method _select {{experimentName ""}}; ## \type TclString 00038 private method _commit {} 00039 private method _mark {aspect}; ## \type TclString 00040 private method _new {} 00041 private method _dataDirChooser {} 00042 private method _delete {} 00043 private method _defaults {{fileName ""}}; ## \type TclString 00044 private method _initGrammarNames {} 00045 private method _checkExperiment {} 00046 00047 }; 00048 00049 ## ---------------------------------------------------------------------------- 00050 ## constructor 00051 ## ---------------------------------------------------------------------------- 00052 body YadaExperiments::constructor {args} { 00053 00054 set _allAspects {name type command dataDir grammarName machineName \ 00055 script status} 00056 00057 # edit menu 00058 set index [$itk_component(editMenu) index "Delete"] 00059 incr index 00060 $itk_component(editMenu) insert [incr index] command \ 00061 -label "Check Experiment" \ 00062 -underline 0 \ 00063 -command [code $this _checkExperiment] 00064 00065 # type 00066 itk_component add typeLabel { 00067 label $itk_component(childsite).typeLabel \ 00068 -text "Type:" \ 00069 -anchor nw 00070 } {} 00071 00072 itk_component add typeMark { 00073 frame $itk_component(childsite).typeMark \ 00074 -borderwidth 2 00075 } {} 00076 00077 itk_component add type { 00078 iwidgets::combobox $itk_component(typeMark).box \ 00079 -completion false \ 00080 -unique true \ 00081 -borderwidth 2 \ 00082 -editable 0 \ 00083 } {} 00084 set entry [$itk_component(type) component entry] 00085 $entry configure \ 00086 -validate all \ 00087 -validatecommand [code $this _validateCommand "type" %P] 00088 00089 # grammar 00090 itk_component add grammarLabel { 00091 label $itk_component(childsite).grammarLabel \ 00092 -text "Grammar:" \ 00093 -anchor nw 00094 } {} 00095 00096 itk_component add grammarNameMark { 00097 frame $itk_component(childsite).grammarNameMark \ 00098 -borderwidth 2 00099 } {} 00100 00101 itk_component add grammarName { 00102 iwidgets::combobox $itk_component(grammarNameMark).box \ 00103 -completion false \ 00104 -unique true \ 00105 -borderwidth 2 \ 00106 -editable 0 \ 00107 } {} 00108 set entry [$itk_component(grammarName) component entry] 00109 $entry configure \ 00110 -validate all \ 00111 -validatecommand [code $this _validateCommand "grammarName" %P] 00112 00113 # machine 00114 itk_component add machineLabel { 00115 label $itk_component(childsite).machineLabel \ 00116 -text "Machine:" \ 00117 -anchor nw 00118 } {} 00119 00120 itk_component add machineNameMark { 00121 frame $itk_component(childsite).machineNameMark \ 00122 -borderwidth 2 00123 } {} 00124 00125 itk_component add machineName { 00126 iwidgets::combobox $itk_component(machineNameMark).box \ 00127 -completion false \ 00128 -unique true \ 00129 -borderwidth 2 \ 00130 -editable 0 \ 00131 } {} 00132 set entry [$itk_component(machineName) component entry] 00133 $entry configure \ 00134 -validate all \ 00135 -validatecommand [code $this _validateCommand "machineName" %P] 00136 00137 # experiment script 00138 itk_component add scriptLabel { 00139 label $itk_component(childsite).scriptLabel \ 00140 -text "Script:" \ 00141 -anchor nw 00142 } {} 00143 00144 itk_component add scriptMark { 00145 frame $itk_component(childsite).scriptMark \ 00146 -borderwidth 2 00147 } {} 00148 00149 itk_component add script { 00150 iwidgets::scrolledtext $itk_component(scriptMark).text \ 00151 -hscrollmode none \ 00152 -vscrollmode static \ 00153 -wrap none \ 00154 -borderwidth 2 \ 00155 -sbwidth 12 \ 00156 -troughcolor gray \ 00157 -textbackground gray80 \ 00158 -height 100 \ 00159 -highlightthickness 2 \ 00160 -highlightcolor gray90 \ 00161 -textfont fixed 00162 } {} 00163 00164 00165 # command 00166 itk_component add commandLabel { 00167 label $itk_component(childsite).commandLabel \ 00168 -text "Command:" \ 00169 -anchor nw 00170 } {} 00171 00172 itk_component add commandMark { 00173 frame $itk_component(childsite).commandMark \ 00174 -borderwidth 2 00175 } {} 00176 00177 itk_component add command { 00178 iwidgets::combobox $itk_component(commandMark).box \ 00179 -completion false \ 00180 -unique true \ 00181 -borderwidth 2 \ 00182 } {} 00183 set entry [$itk_component(command) component entry] 00184 $entry configure \ 00185 -validate all \ 00186 -validatecommand [code $this _validateCommand "command" %P] 00187 00188 # data dir 00189 itk_component add dataDirLabel { 00190 label $itk_component(childsite).dataDirLabel\ 00191 -text "Data Dir:" \ 00192 -anchor nw 00193 } {} 00194 00195 itk_component add dataDirMark { 00196 frame $itk_component(childsite).dataDirMark \ 00197 -borderwidth 2 00198 } {} 00199 00200 itk_component add dataDir { 00201 entry $itk_component(dataDirMark).entry \ 00202 -borderwidth 2 \ 00203 -validate all \ 00204 -validatecommand [code $this _validateCommand "dataDir" %P] 00205 } {} 00206 00207 itk_component add dataDirButton { 00208 button $itk_component(dataDirMark).button \ 00209 -image [YadaImages::get defaultFolder] \ 00210 -padx 5 \ 00211 -pady 0 \ 00212 -command [code $this _dataDirChooser] 00213 } {} 00214 00215 # status buttons 00216 itk_component add statusLabel { 00217 label $itk_component(childsite).statusLabel \ 00218 -text "Status:" \ 00219 -anchor nw 00220 } 00221 00222 itk_component add statusMark { 00223 frame $itk_component(childsite).statusMark \ 00224 -borderwidth 2 00225 } {} 00226 00227 itk_component add isActive { 00228 checkbutton $itk_component(statusMark).isActive \ 00229 -text "Active" \ 00230 -variable [scope _isActive] \ 00231 -command [code $this _mark "isActive"] 00232 } {} 00233 00234 itk_component add isComplete { 00235 checkbutton $itk_component(statusMark).isComplete \ 00236 -text "Complete" \ 00237 -variable [scope _isComplete] \ 00238 -command [code $this _mark "isComplete"] 00239 } {} 00240 00241 # more buttons 00242 itk_component add checkButton { 00243 button $itk_component(topButtonFrame).checkButton \ 00244 -text "Check" \ 00245 -command [code $this _checkExperiment] 00246 } 00247 00248 00249 # 00250 # bindings 00251 # 00252 00253 # script texts 00254 set text [$itk_component(script) childsite] 00255 bind $text <FocusOut> [code $this _mark "script"] 00256 bind $text <Leave> [code $this _mark "script"] 00257 bind $text <KeyPress> [code $this _mark "script"] 00258 00259 # 00260 # packing + gridding 00261 # 00262 grid rowconfigure $itk_component(childsite) 7 -weight 1 00263 00264 grid $itk_component(typeLabel) -sticky w -row 2 -column 0 00265 grid $itk_component(typeMark) -sticky ew -row 2 -column 1 -pady 10 00266 pack $itk_component(type) -fill both -expand 1 00267 00268 grid $itk_component(grammarLabel) -sticky ew -row 3 -column 0 00269 grid $itk_component(grammarNameMark) -sticky ew -row 3 -column 1 -pady 10 -columnspan 2 00270 pack $itk_component(grammarName) -fill both -expand 1 00271 00272 grid $itk_component(commandLabel) -sticky ew -row 4 -column 0 -pady 10 00273 grid $itk_component(commandMark) -sticky ew -row 4 -column 1 -pady 10 -columnspan 2 00274 pack $itk_component(command) -fill both -expand 1 00275 00276 grid $itk_component(machineLabel) -sticky ew -row 5 -column 0 -pady 10 00277 grid $itk_component(machineNameMark) -sticky ew -row 5 -column 1 -pady 10 -columnspan 2 00278 pack $itk_component(machineName) -fill both -expand 1 00279 00280 grid $itk_component(dataDirLabel) -sticky ew -row 6 -column 0 -pady 10 00281 grid $itk_component(dataDirMark) -sticky ew -row 6 -column 1 -pady 10 -columnspan 2 00282 pack $itk_component(dataDir) -fill both -expand 1 -side left 00283 pack $itk_component(dataDirButton) -side left 00284 00285 grid $itk_component(scriptLabel) -sticky new -row 7 -column 0 -pady 10 00286 grid $itk_component(scriptMark) -sticky news -row 7 -column 1 -rowspan 2 -pady 10 -columnspan 2 00287 pack $itk_component(script) -fill both -expand 1 00288 00289 grid $itk_component(statusLabel) -sticky w -row 9 -column 0 00290 grid $itk_component(statusMark) -sticky w -row 9 -column 1 00291 pack $itk_component(isActive) \ 00292 $itk_component(isComplete) -fill both -side left -expand 1 00293 00294 pack $itk_component(checkButton) -side top -fill x -pady 5 00295 00296 eval itk_initialize $args 00297 } 00298 00299 ## ---------------------------------------------------------------------------- 00300 ## init 00301 ## ---------------------------------------------------------------------------- 00302 body YadaExperiments::init {} { 00303 if {$_isInitialized} { 00304 return 00305 } 00306 chain 00307 00308 # initialize the comboboxes 00309 set commands "" 00310 foreach item [getAllItems] { 00311 00312 #if { [$item hasSavedState] } { 00313 # $item setModified 00314 #} 00315 00316 set command [$item cget -command] 00317 if {[lsearch $commands $command] < 0} { 00318 lappend commands $command 00319 } 00320 } 00321 eval $itk_component(type) insert list 0 [lsort -dictionary $_experimentTypes] 00322 eval $itk_component(command) insert list 0 [lsort -dictionary $commands] 00323 00324 # read the grammars and machines 00325 eval $itk_component(grammarName) insert list end [.main getGrammarNames] 00326 eval $itk_component(machineName) insert list end "[.main getMachineNames] {}" 00327 00328 _select "<none>" 00329 } 00330 00331 ## ---------------------------------------------------------------------------- 00332 ## _select 00333 ## ---------------------------------------------------------------------------- 00334 body YadaExperiments::_select {{experimentName ""}} { 00335 00336 # get a experiment name from the combobox if we didn't provide one 00337 if {$experimentName == ""} { 00338 set experimentName [$itk_component(name) get] 00339 } 00340 set currentItem [getItem $experimentName] 00341 if {$currentItem == ""} { 00342 printMessage "Experiment `$experimentName' is unknown." error 00343 return 00344 } 00345 00346 # check if we didn't commit changes 00347 if {![_askChange]} { 00348 return 00349 } 00350 00351 00352 # set the new active experiment 00353 setCurrentItem $currentItem 00354 00355 ## update title bar 00356 displayTitle 00357 00358 # update the name box 00359 set box $itk_component(name) 00360 set entries [[$box component list] get 0 end] 00361 set index [lsearch $entries $experimentName] 00362 if {$index < 0} { 00363 error "ERROR: experiment `$experimentName' not in combobox" 00364 } 00365 $box selection set $index $index 00366 $box delete entry 0 end 00367 $box insert entry 0 $experimentName 00368 00369 # update the command box 00370 set box $itk_component(command) 00371 set command [$currentItem cget -command] 00372 set entries [[$box component list] get 0 end] 00373 set index [lsearch $entries $command] 00374 if {$index < 0} { 00375 error "ERROR: command `$command' not in combobox" 00376 } 00377 $box selection set $index $index 00378 $box delete entry 0 end 00379 $box insert entry 0 $command 00380 00381 00382 # update the boxes 00383 foreach aspect {type grammarName machineName} { 00384 set box $itk_component($aspect) 00385 set value [$currentItem cget -$aspect] 00386 set index [getIndexOfName [$box component list] $value] 00387 if {$index < 0} { 00388 error "ERROR: $aspect `$value' is unknown" 00389 } 00390 $box selection set $index $index 00391 set isEditable [$box cget -editable] 00392 if {!$isEditable} { 00393 $box configure -editable 1 00394 } 00395 $box delete entry 0 end 00396 $box insert entry 0 $value 00397 if {!$isEditable} { 00398 $box configure -editable 0 00399 } 00400 } 00401 00402 # update the script 00403 set text $itk_component(script) 00404 $text delete 1.0 end 00405 $text insert 1.0 [$currentItem cget -script] 00406 00407 # update the entries 00408 foreach entryName {dataDir} { 00409 set entry $itk_component($entryName) 00410 $entry delete 0 end 00411 $entry insert 0 [$currentItem cget -$entryName] 00412 } 00413 00414 # update the checkbuttons 00415 set _isActive [$currentItem cget -isActive] 00416 set _isComplete [$currentItem cget -isComplete] 00417 00418 # remove marking 00419 _unmark 00420 00421 # remember this selected name 00422 set _oldItem $experimentName 00423 } 00424 00425 ## ---------------------------------------------------------------------------- 00426 ## _commit 00427 ## ---------------------------------------------------------------------------- 00428 body YadaExperiments::_commit {} { 00429 00430 if {![chain]} { 00431 return 00432 } 00433 00434 set currentItem [getCurrentItem] 00435 00436 # set all aspects of the object 00437 foreach aspect {type grammarName command dataDir machineName} { 00438 $currentItem configure -$aspect [$itk_component($aspect) get] 00439 } 00440 00441 # set the script property of the object 00442 set text $itk_component(script) 00443 $currentItem configure -script [$text get 1.0 end] 00444 00445 # save the checkbuttons 00446 $currentItem configure -isActive $_isActive 00447 $currentItem configure -isComplete $_isComplete 00448 00449 # save data unique in comboboxes 00450 foreach aspect {type grammarName command machineName} { 00451 set box $itk_component($aspect) 00452 set value [$currentItem cget -$aspect] 00453 set listBox [$box component list] 00454 if {[getIndexOfName $listBox $value] < 0} { 00455 set entries [$listBox get 0 end] 00456 lappend entries $value 00457 $listBox delete 0 end 00458 eval $listBox insert 0 [lsort -dictionary $entries] 00459 } 00460 } 00461 00462 [getCurrentItem] setModified 00463 00464 # remember this selected name 00465 set _oldItem [$currentItem cget -name] 00466 00467 # remove marking 00468 _unmark 00469 _select 00470 } 00471 00472 ## ---------------------------------------------------------------------------- 00473 ## _new 00474 ## ---------------------------------------------------------------------------- 00475 body YadaExperiments::_new {} { 00476 00477 # ask for a new name 00478 set prd [iwidgets::promptdialog .prd \ 00479 -title "Yada - New experiment" \ 00480 -modality application \ 00481 -labeltext "Name:" \ 00482 -labelpos w] 00483 00484 set experimentName [$itk_component(name) get] 00485 set entry [$prd component prompt] 00486 $entry configure -width 40 00487 $entry insert 0 $experimentName 00488 00489 $prd center . 00490 $prd hide Apply 00491 $prd hide Help 00492 after idle "focus [$prd component prompt]" 00493 00494 set result [$prd activate] 00495 set experimentName [$prd get] 00496 destroy $prd 00497 00498 if {!$result} { 00499 return 00500 } 00501 00502 set item [getItem $experimentName] 00503 if {$item != ""} { 00504 set message "ERROR: experiment `$experimentName' exists already." 00505 .main printStatus $message 00506 printMessage $message error 00507 return [_new] 00508 } 00509 .main printStatus "" 00510 00511 # build a new experiment 00512 set currentItem [getCurrentItem] 00513 setCurrentItem [$currentItem clone -name $experimentName] 00514 .main printStatus "New experiment `$experimentName'" 00515 00516 # store all aspects 00517 set box $itk_component(name) 00518 $box delete entry 0 end 00519 $box insert entry 0 $experimentName 00520 _commit 00521 00522 # display it 00523 _select $experimentName 00524 } 00525 00526 ## ---------------------------------------------------------------------------- 00527 ## _dataDirChooser 00528 ## ---------------------------------------------------------------------------- 00529 body YadaExperiments::_dataDirChooser {} { 00530 focus $itk_component(dataDir) 00531 00532 set experimentName [$itk_component(name) get] 00533 00534 set currentItem [getCurrentItem] 00535 set dataDir [$currentItem cget -dataDir] 00536 set directory [file dirname $dataDir] 00537 set selection [.fileSelector activate \ 00538 -directory $directory \ 00539 -title "Choose a data directory" \ 00540 -filter [list "*.log.gz *.xml.gz" "*log.gz" "*.xml.gz" "*"] \ 00541 -selection $dataDir] 00542 #-mode "singledir" \ 00543 00544 if {$selection != ""} { 00545 if {[llength $selection] > 1 || ![file isdirectory $selection]} { 00546 set message "ERROR: please select one directory." 00547 .main printStatus $message 00548 printMessage $message error 00549 return [_dataDirChooser] 00550 } else { 00551 .main printStatus "" 00552 $itk_component(dataDir) delete 0 end 00553 $itk_component(dataDir) insert 0 $selection 00554 _mark "dataDir" 00555 } 00556 } 00557 } 00558 00559 ## ---------------------------------------------------------------------------- 00560 ## _delete 00561 ## ---------------------------------------------------------------------------- 00562 body YadaExperiments::_delete {} { 00563 00564 # get the experiment name 00565 set currentItem [getCurrentItem] 00566 set experimentName [$currentItem cget -name] 00567 00568 # experiment "<none>" is undeleteable 00569 if {$experimentName == "<none>"} { 00570 return 00571 } 00572 00573 # are you sure? 00574 set msg [iwidgets::messagedialog .msg \ 00575 -text "Are you sure that you want to delete experiment\n`$experimentName'?" \ 00576 -title "Yada - Caution" \ 00577 -image [YadaImages::get question] \ 00578 -modality application \ 00579 -master $itk_interior] 00580 $msg buttonconfigure OK -text "Yes" 00581 $msg buttonconfigure Cancel -text "No" 00582 $msg center . 00583 set result [$msg activate] 00584 destroy $msg 00585 if {!$result} { 00586 return 00587 } 00588 00589 # delete the data 00590 unsetItem $currentItem 00591 itcl::delete object $currentItem 00592 00593 # update the names 00594 set box $itk_component(name) 00595 set index [getIndexOfName [$box component list] $experimentName] 00596 if {$index >= 0} { 00597 $box delete list $index $index 00598 } 00599 00600 # show something 00601 _select "<none>" 00602 } 00603 00604 ## ---------------------------------------------------------------------------- 00605 ## _defaults 00606 ## ---------------------------------------------------------------------------- 00607 body YadaExperiments::_defaults {{fileName ""}} { 00608 global env 00609 00610 # possible variables 00611 00612 # default 00613 if {$fileName == ""} { 00614 set fileName [file join $env(YADA_LIB) experiments.tcl.sample] 00615 } 00616 00617 # ... configured experiments 00618 if {[catch {source $fileName} errMsg]} { 00619 bgerror "There's an error in your experiments init file $fileName!" 00620 } 00621 00622 # required the <none> experiment 00623 YadaExperiment ::#auto \ 00624 -name "<none>" \ 00625 -type "<none>" \ 00626 -grammarName "<none>" \ 00627 -machineName "<none>" \ 00628 -command "<none>" \ 00629 -dataDir "<none>" 00630 00631 # assert experiments and types into the class 00632 set experiments [itcl_info objects -class YadaExperiment] 00633 set _experimentTypes "" 00634 foreach experiment $experiments { 00635 set experimentName [$experiment cget -name] 00636 set isValid 1 00637 00638 # collect experiment types 00639 set experimentType [$experiment cget -type] 00640 if {[lsearch -exact _experimentTypes $experimentType] < 0} { 00641 lappend _experimentTypes $experimentType 00642 } 00643 00644 # validation checks: 00645 # (a) check if experiment already exists 00646 # (b) check if the used grammar exists 00647 # (c) check if the experiments data store is unique 00648 00649 # (a) 00650 if {$isValid} { 00651 set item [getItem $experimentName] 00652 if {$item != ""} { 00653 printMessage "Experiment `$experimentName' already exists!" error 00654 set isValid 0 00655 } 00656 } 00657 00658 # (b) 00659 if {$isValid} { 00660 set grammarName [$experiment cget -grammarName] 00661 set grammar [.main getGrammar $grammarName] 00662 if {$grammar == ""} { 00663 printMessage \ 00664 "Grammar `$grammarName' is unknown! 00665 ... ignoring experiment `$experimentName'." error 00666 set isValid 0 00667 } 00668 } 00669 00670 # (c) 00671 if {$isValid} { 00672 set experimentDataDir [$experiment cget -dataDir] 00673 if {[info exists dataDirs($experimentDataDir)]} { 00674 printMessage \ 00675 "`$experimentName' uses the same data directory as $dataDirs($experimentDataDir)! 00676 ... ignoring experiment `$experimentName'." error 00677 set isValid 0 00678 } else { 00679 set dataDirs($experimentDataDir) $experimentName 00680 } 00681 } 00682 00683 if {$isValid} { 00684 setItem $experiment 00685 } else { 00686 itcl::delete object $experiment 00687 } 00688 } 00689 set _experimentTypes [lsort -dictionary $_experimentTypes] 00690 00691 # just to be tidy 00692 array unset dataDirs 00693 .main printStatus "... built [llength $experiments] experiments" 00694 } 00695 00696 ## ---------------------------------------------------------------------------- 00697 ## getActiveExperiments 00698 ## ---------------------------------------------------------------------------- 00699 body YadaExperiments::getActiveExperiments {args} { 00700 set result "" 00701 foreach experiment [eval getAllItems $args] { 00702 if {[$experiment cget -isActive]} { 00703 lappend result [$experiment cget -name] 00704 } 00705 } 00706 00707 return $result 00708 } 00709 00710 ## ---------------------------------------------------------------------------- 00711 ## _mark 00712 ## ---------------------------------------------------------------------------- 00713 body YadaExperiments::_mark {aspect} { 00714 00715 switch $aspect { 00716 "script" { 00717 set currentItem [getCurrentItem] 00718 set oldData [string trim [$currentItem cget -$aspect]] 00719 set newData [string trim [$itk_component(script) get 1.0 end]] 00720 } 00721 "dataDir" { 00722 set currentItem [getCurrentItem] 00723 set oldData [glob -nocomplain [$currentItem cget -$aspect]] 00724 set newData [glob -nocomplain [$itk_component($aspect) get]] 00725 } 00726 "isActive" { 00727 set currentItem [getCurrentItem] 00728 set oldData [$currentItem cget -isActive] 00729 set newData $_isActive 00730 set aspect "status" 00731 } 00732 "isComplete" { 00733 set currentItem [getCurrentItem] 00734 set oldData [$currentItem cget -isComplete] 00735 set newData $_isComplete 00736 set aspect "status" 00737 } 00738 default { 00739 set oldData "" 00740 set newData "" 00741 } 00742 } 00743 00744 chain $aspect $newData $oldData 00745 } 00746 00747 ## ---------------------------------------------------------------------------- 00748 ## activationHandle 00749 ## ---------------------------------------------------------------------------- 00750 body YadaExperiments::activationHandle {} { 00751 chain 00752 00753 # refresh the grammars 00754 $itk_component(grammarName) delete list 0 end 00755 eval $itk_component(grammarName) insert list end [.main getGrammarNames] 00756 00757 # refresh the machines 00758 $itk_component(machineName) delete list 0 end 00759 eval $itk_component(machineName) insert list end [.main getMachineNames] 00760 00761 # redisplay the current selection 00762 _select 00763 } 00764 00765 ## ---------------------------------------------------------------------------- 00766 ## _checkExperiment 00767 ## ---------------------------------------------------------------------------- 00768 body YadaExperiments::_checkExperiment {} { 00769 set currentItem [getCurrentItem] 00770 if {$currentItem == ""} { 00771 return 00772 } 00773 $currentItem check 00774 _select 00775 } 00776 00777 00778 ## ---------------------------------------------------------------------------- 00779 ## Overriding default implementation. Delegates command to current grammar's 00780 ## load method 00781 ## ---------------------------------------------------------------------------- 00782 body YadaExperiments::load {} { 00783 set currentItem [getCurrentItem] 00784 00785 if { [$currentItem cget -name] != "<none>"} { 00786 [getCurrentItem] load 00787 _select 00788 displayTitle 00789 } 00790 } 00791 00792 ## ---------------------------------------------------------------------------- 00793 ## Overriding default implementation. Delegates command to current grammar's 00794 ## save method 00795 ## ---------------------------------------------------------------------------- 00796 body YadaExperiments::save {} { 00797 set currentItem [getCurrentItem] 00798 00799 if { [$currentItem cget -name] != "<none>"} { 00800 [getCurrentItem] save 00801 } 00802 displayTitle 00803 } 00804 00805 00806