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

YadaGrammars.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 ## YadaGrammars - configure document for all grammars. 00013 ## \ingroup YadaConfiguration 00014 ## 00015 ## \author Michael Daum 00016 ## 00017 ## $Id: YadaGrammars.tcl,v 1.26 2004/10/15 17:24:37 micha Exp $ 00018 ## ---------------------------------------------------------------------------- 00019 class YadaGrammars { 00020 inherit YadaConfigDocument 00021 00022 00023 # variables ---------------------------------------------------------------- 00024 private variable _noAllWordgraphs 0 00025 private variable _noSelWordgraphs 0 00026 private variable _scannedCurrentGrammar 0 00027 00028 # methods ------------------------------------------------------------------ 00029 public method init {} 00030 public method _rescanGrammar {}; # access modifier changed from private to public, 00031 # as it's being called by YadaConfig::save 00032 public method _show {} 00033 00034 public method load {} 00035 public method save {} 00036 00037 00038 00039 constructor {args} {}; ## \type TclList 00040 00041 00042 protected method isValidPersistanceFile {fileName}; ## \type TclString 00043 00044 private method _select {{grammarName ""}}; ## \type TclString 00045 private method _commit {} 00046 private method _new {} 00047 private method _delete {} 00048 private method _editGrammar {} 00049 private method _fileChooser {} 00050 private method _mark {aspect}; ## \type TclString 00051 private method _getSelectedWordgraphs {} 00052 private method _selectWordgraphs {{wordgraphs ""}}; ## \type TclList 00053 private method _unselectWordgraphs {{wordgraphs ""}}; ## \type TclList 00054 private method _invertWordgraphs {{wordgraphs ""}}; ## \type TclList 00055 private method _defaults {{fileName ""}}; ## \type TclString 00056 private method _leaveTableCommand {} 00057 private method _escapeCommand {} 00058 private method _returnCommand {} 00059 private method _randomSelection {} 00060 private method _lengthSelection {{min -1} {max -1}} ;## \type TclNumber, TclNumber 00061 private method _validateCommand {aspect newValue} ;## \type TclString, TclString 00062 private method loadNonTclGrammars {} 00063 }; 00064 00065 ## ---------------------------------------------------------------------------- 00066 ## constructor 00067 ## ---------------------------------------------------------------------------- 00068 body YadaGrammars::constructor {args} { 00069 00070 set _allAspects {name files wordgraphs} 00071 00072 # edit menu 00073 set index [$itk_component(editMenu) index "Delete"] 00074 incr index 00075 $itk_component(editMenu) insert [incr index] command \ 00076 -label "Edit Grammar" \ 00077 -underline 0 \ 00078 -command [code $this _editGrammar] 00079 $itk_component(editMenu) insert [incr index] command \ 00080 -label "Rescan" \ 00081 -underline 0 \ 00082 -command [code $this _rescanGrammar] 00083 $itk_component(editMenu) insert [incr index] separator 00084 $itk_component(editMenu) insert [incr index] command \ 00085 -label "Select" \ 00086 -underline 0 \ 00087 -command [code $this _selectWordgraphs] 00088 $itk_component(editMenu) insert [incr index] command \ 00089 -label "Unselect" \ 00090 -underline 0 \ 00091 -command [code $this _unselectWordgraphs] 00092 $itk_component(editMenu) insert [incr index] command \ 00093 -label "Invert Selection" \ 00094 -underline 0 \ 00095 -command [code $this _invertWordgraphs] 00096 $itk_component(editMenu) insert [incr index] command \ 00097 -label "Random Selection" \ 00098 -underline 0 \ 00099 -command [code $this _randomSelection] 00100 $itk_component(editMenu) insert [incr index] command \ 00101 -label "Length Selection" \ 00102 -underline 0 \ 00103 -command [code $this _lengthSelection] 00104 $itk_component(editMenu) insert [incr index] separator 00105 00106 # more buttons 00107 itk_component add editButton { 00108 button $itk_component(topButtonFrame).editButton \ 00109 -text "Edit" \ 00110 -command [code $this _editGrammar] 00111 } 00112 00113 itk_component add rescanButton { 00114 button $itk_component(topButtonFrame).rescanButton \ 00115 -text "Rescan" \ 00116 -command [code $this _rescanGrammar] 00117 } 00118 00119 itk_component add selButton { 00120 button $itk_component(topButtonFrame).selButton \ 00121 -text "Select" \ 00122 -command [code $this _selectWordgraphs] 00123 } 00124 00125 itk_component add unselButton { 00126 button $itk_component(topButtonFrame).unselButton \ 00127 -text "Unselect" \ 00128 -command [code $this _unselectWordgraphs] 00129 } 00130 00131 00132 itk_component add invertButton { 00133 button $itk_component(topButtonFrame).invertButton \ 00134 -text "Invert" \ 00135 -command [code $this _invertWordgraphs] 00136 } 00137 itk_component add randomButton { 00138 button $itk_component(topButtonFrame).randomButton \ 00139 -text "Random" \ 00140 -command [code $this _randomSelection] 00141 } 00142 itk_component add lengthButton { 00143 button $itk_component(topButtonFrame).lengthButton \ 00144 -text "Length" \ 00145 -command [code $this _lengthSelection] 00146 } 00147 00148 # 00149 # files 00150 itk_component add filesLabel { 00151 label $itk_component(childsite).filesLabel \ 00152 -text "Files:" \ 00153 -anchor nw 00154 } {} 00155 00156 itk_component add filesMark { 00157 frame $itk_component(childsite).filesMark \ 00158 -borderwidth 2 00159 } {} 00160 00161 itk_component add files { 00162 entry $itk_component(filesMark).files \ 00163 -borderwidth 2 \ 00164 -validate all \ 00165 -validatecommand [code $this _validateCommand "files" %P] 00166 } {} 00167 00168 itk_component add filesButton { 00169 button $itk_component(filesMark).filesButton \ 00170 -image [YadaImages::get defaultFolder] \ 00171 -padx 5 \ 00172 -pady 0 \ 00173 -command [code $this _fileChooser] 00174 } {} 00175 00176 # 00177 # the wordgraph selector 00178 # 00179 itk_component add wordgraphsMark { 00180 frame $itk_component(childsite).wordgraphsMark \ 00181 -borderwidth 2 00182 } {} 00183 00184 itk_component add wordgraphLabel { 00185 label $itk_component(wordgraphsMark).label \ 00186 -text "Wordgraphs:" \ 00187 -anchor nw 00188 } {} 00189 00190 itk_component add totalCount { 00191 iwidgets::entryfield $itk_component(wordgraphsMark).totalCount \ 00192 -labeltext "Total:"\ 00193 -labelpos w \ 00194 -state disabled \ 00195 -textvariable [scope _noAllWordgraphs] \ 00196 -borderwidth 2 \ 00197 -disabledforeground black \ 00198 } {} 00199 00200 itk_component add selCount { 00201 iwidgets::entryfield $itk_component(wordgraphsMark).selCount \ 00202 -labeltext "Selected:"\ 00203 -labelpos w \ 00204 -state disabled \ 00205 -textvariable [scope _noSelWordgraphs] \ 00206 -borderwidth 2 \ 00207 -disabledforeground black \ 00208 } {} 00209 00210 itk_component add table { 00211 MyTable $itk_component(wordgraphsMark).table \ 00212 -exportselection 1 \ 00213 -selecttitles 1 \ 00214 -rowseparator "\n" \ 00215 -colseparator "\t" \ 00216 -rows 20 \ 00217 -cols 5 \ 00218 -state normal \ 00219 -cellanchor w \ 00220 -colstretchmode last \ 00221 -rowstretchmode none \ 00222 -selectmode extended \ 00223 -selecttype row \ 00224 -titlerows 1 \ 00225 -titlecols 1 \ 00226 -borderwidth 3 \ 00227 -outerborderwidth 2 \ 00228 -outerrelief sunk \ 00229 -selforeground "" \ 00230 -selbackground "" \ 00231 -font {-adobe-helvetica-medium-r-normal--12-*-*-*-*-*-*-*} \ 00232 -hscrollmode static \ 00233 -vscrollmode static \ 00234 } {} 00235 00236 $itk_component(table) setCell \ 00237 0,0 "no." \ 00238 0,1 "wordgraph" \ 00239 0,2 "no words" \ 00240 0,3 "trivial" \ 00241 0,4 "sentence" 00242 00243 $itk_component(table) tag config title -font {-adobe-helvetica-medium-r-normal--12-*-*-*-*-*-*-*} -anchor w 00244 $itk_component(table) tag config sel -fg "" -bg "" -relief raised -bd 1 00245 $itk_component(table) tag config mark -bg green3 -fg black 00246 00247 00248 $itk_component(table) width 0 4 1 15 2 7 3 5 00249 00250 # 00251 # packing + gridding 00252 # 00253 grid rowconfigure $itk_component(childsite) 3 -weight 1 00254 00255 pack $itk_component(editButton) -side top -fill x -pady 5 00256 pack $itk_component(rescanButton) -side top -fill x -pady 5 00257 pack $itk_component(selButton) -side top -fill x -pady 5 00258 pack $itk_component(unselButton) -side top -fill x -pady 5 00259 pack $itk_component(invertButton) -side top -fill x -pady 5 00260 pack $itk_component(randomButton) -side top -fill x -pady 5 00261 pack $itk_component(lengthButton) -side top -fill x -pady 5 00262 00263 grid $itk_component(filesLabel) -sticky ew -row 1 -column 0 -pady 10 00264 grid $itk_component(filesMark) -sticky ew -row 1 -column 1 -pady 10 00265 pack $itk_component(files) -fill both -expand 1 -side left 00266 pack $itk_component(filesButton) -side left 00267 00268 grid $itk_component(wordgraphsMark) -sticky news -row 3 -column 0 -pady 10 -columnspan 3 00269 grid columnconfigure $itk_component(wordgraphsMark) 0 -weight 1 00270 grid rowconfigure $itk_component(wordgraphsMark) 1 -weight 1 00271 00272 grid $itk_component(wordgraphLabel) -sticky nw -row 0 -column 0 00273 grid $itk_component(table) -sticky news -row 1 -column 0 -columnspan 2 -pady 5 00274 grid $itk_component(totalCount) -sticky ew -row 2 -column 0 00275 grid $itk_component(selCount) -sticky ew -row 2 -column 1 -padx 10 00276 00277 00278 # bindings 00279 bind [$itk_component(table) component table] <Double-Button-1> \ 00280 +[code $this _invertWordgraphs] 00281 00282 00283 set hull $itk_component(hull) 00284 set tableInTable [$itk_component(table) component table] 00285 bind $hull <Leave> [code $this _leaveTableCommand] 00286 bind $hull <FocusOut> [code $this _leaveTableCommand] 00287 bind $tableInTable <KeyPress-Escape> [code "$this _escapeCommand; break"] 00288 bind $tableInTable <KeyPress-Return> [code "$this _returnCommand; break"] 00289 00290 eval itk_initialize $args 00291 } 00292 00293 ## ---------------------------------------------------------------------------- 00294 ## init 00295 ## ---------------------------------------------------------------------------- 00296 body YadaGrammars::init {} { 00297 if {$_isInitialized} { 00298 return 00299 } 00300 chain 00301 loadNonTclGrammars 00302 00303 set grammars [itcl_info objects -class YadaGrammar] 00304 00305 _select "<none>" 00306 } 00307 00308 00309 ## ---------------------------------------------------------------------------- 00310 ## _select 00311 ## ---------------------------------------------------------------------------- 00312 body YadaGrammars::_select {{grammarName ""}} { 00313 00314 # get a grammar name from the combobox if we didn't provide one 00315 if {$grammarName == ""} { 00316 set grammarName [$itk_component(name) get] 00317 } 00318 00319 set item [getItem $grammarName] 00320 if {$item == ""} { 00321 printMessage "ERROR: grammar `$grammarName' is unknown" error 00322 return 00323 } 00324 00325 # check if we didn't commit changes 00326 if {![_askChange]} { 00327 return 00328 } 00329 00330 00331 # set the active grammar 00332 setCurrentItem $item 00333 00334 00335 ## update title bar 00336 displayTitle 00337 00338 if {$grammarName == "<none>"} { 00339 set _scannedCurrentGrammar 1 00340 } else { 00341 set _scannedCurrentGrammar 0 00342 } 00343 00344 00345 # update the name box 00346 set box $itk_component(name) 00347 set grammarNames [[$box component list] get 0 end] 00348 set index [lsearch $grammarNames $grammarName] 00349 $box selection set $index $index 00350 $box delete entry 0 end 00351 $box insert entry 0 $grammarName 00352 00353 # update the entries 00354 set entry $itk_component(files) 00355 $entry delete 0 end 00356 $entry insert 0 [$item cget -files] 00357 00358 # remove marking 00359 _unmark 00360 00361 00362 # show the wordgraphs 00363 _show 00364 00365 00366 # remember this selected name 00367 set _oldItem $grammarName 00368 } 00369 00370 ## ---------------------------------------------------------------------------- 00371 ## _commit 00372 ## ---------------------------------------------------------------------------- 00373 body YadaGrammars::_commit {} { 00374 00375 set currentItem [getCurrentItem] 00376 set oldName [$currentItem cget -name] 00377 set oldFiles [$currentItem cget -files] 00378 set oldSelection [$currentItem getSelection] 00379 00380 if {![chain]} { 00381 return 00382 } 00383 00384 set newName [$currentItem cget -name] 00385 00386 # adjust each experiment using a grammar with a changed name 00387 if {$oldName != $newName} { 00388 foreach experiment [.main getExperiments] { 00389 if {[$experiment cget -grammarName] == $oldName} { 00390 $experiment configure -grammarName $newName 00391 } 00392 } 00393 } 00394 00395 # save the files 00396 $currentItem configure -files [$itk_component(files) get] 00397 00398 # save the wordgraph selection 00399 eval $currentItem setSelection [_getSelectedWordgraphs] 00400 00401 set newFiles [$currentItem cget -files] 00402 set newSelection [$currentItem getSelection] 00403 00404 # recheck every experiment using this grammar 00405 if {$oldFiles != $newFiles || $oldSelection != $newSelection} { 00406 foreach experiment [.main getExperiments] { 00407 00408 if {[$experiment cget -grammarName] == $newName} { 00409 .main printStatus "... checking experiment [$experiment cget -name]" 00410 $experiment configure -isUpToDate 0 00411 $experiment check 00412 } 00413 } 00414 .main printStatus "" 00415 } 00416 00417 # remember this selected name 00418 set _oldItem [$currentItem cget -name] 00419 00420 # remove marking 00421 _unmark 00422 _select 00423 } 00424 00425 ## ---------------------------------------------------------------------------- 00426 ## _delete 00427 ## ---------------------------------------------------------------------------- 00428 body YadaGrammars::_delete {} { 00429 00430 # get the grammar name 00431 set currentItem [getCurrentItem] 00432 set grammarName [$currentItem cget -name] 00433 00434 # grammar "<none>" is undeleteable 00435 if {$grammarName == "<none>"} { 00436 return 00437 } 00438 00439 # are you sure? 00440 set msg [iwidgets::messagedialog .msg \ 00441 -text "Are you sure that you want to delete grammar\n`$grammarName'?" \ 00442 -title "Yada - Caution" \ 00443 -bitmap questhead \ 00444 -modality application \ 00445 -master $itk_interior] 00446 $msg buttonconfigure OK -text "Yes" 00447 $msg buttonconfigure Cancel -text "No" 00448 $msg center . 00449 set result [$msg activate] 00450 destroy $msg 00451 if {!$result} { 00452 return 00453 } 00454 00455 # delete the data 00456 unsetItem $currentItem 00457 itcl::delete object $currentItem 00458 set _scannedCurrentGrammar 0 00459 00460 # update the names 00461 set box $itk_component(name) 00462 set index [getIndexOfName [$box component list] $grammarName] 00463 if {$index >= 0} { 00464 $box delete list $index $index 00465 } 00466 00467 # show something 00468 _select "<none>" 00469 } 00470 00471 ## ---------------------------------------------------------------------------- 00472 ## _new 00473 ## ---------------------------------------------------------------------------- 00474 body YadaGrammars::_new {} { 00475 00476 # ask for a new name 00477 set prd [iwidgets::promptdialog .prd \ 00478 -title "Yada - New grammar" \ 00479 -modality application \ 00480 -labeltext "Name:" \ 00481 -labelpos w] 00482 00483 set grammarName [$itk_component(name) get] 00484 set entry [$prd component prompt] 00485 $entry configure -width 40 00486 $entry insert 0 $grammarName 00487 00488 $prd center . 00489 $prd hide Apply 00490 $prd hide Help 00491 after idle "focus [$prd component prompt]" 00492 00493 set result [$prd activate] 00494 set grammarName [$prd get] 00495 destroy $prd 00496 00497 if {!$result} { 00498 return 00499 } 00500 00501 set item [getItem $grammarName] 00502 if {$item != ""} { 00503 printMessage "ERROR: grammar `$grammarName' exists already." error 00504 return [_new] 00505 } 00506 00507 # build a new grammar 00508 set currentItem [getCurrentItem] 00509 setCurrentItem [$currentItem clone -name $grammarName] 00510 00511 set _scannedCurrentGrammar 0 00512 #puts "DEBUG: new grammar `$grammarName'" 00513 00514 # store all aspects 00515 set box $itk_component(name) 00516 $box delete entry 0 end 00517 $box insert entry 0 $grammarName 00518 _commit 00519 00520 # display it 00521 _select $grammarName 00522 } 00523 00524 ## ---------------------------------------------------------------------------- 00525 ## _validateCommand 00526 ## ---------------------------------------------------------------------------- 00527 body YadaGrammars::_validateCommand {aspect newValue} { 00528 00529 switch $aspect { 00530 "wordgraphs" { 00531 set currentItem [getCurrentItem] 00532 set oldValue [$currentItem getSelection] 00533 } 00534 "files" { 00535 set currentItem [getCurrentItem] 00536 set oldValue [string trim [$currentItem cget -files]] 00537 } 00538 default { 00539 set oldValue "" 00540 } 00541 } 00542 00543 chain $aspect $newValue $oldValue 00544 00545 return 1 00546 } 00547 00548 ## ---------------------------------------------------------------------------- 00549 ## _mark 00550 ## ---------------------------------------------------------------------------- 00551 body YadaGrammars::_mark {aspect} { 00552 00553 switch $aspect { 00554 "wordgraphs" { 00555 set currentItem [getCurrentItem] 00556 set newData [$this _getSelectedWordgraphs] 00557 set oldData [$currentItem getSelection] 00558 } 00559 "files" { 00560 set currentItem [getCurrentItem] 00561 set newData [$itk_component($aspect) get] 00562 set oldData [string trim [$currentItem cget -files]] 00563 } 00564 default { 00565 set newData "" 00566 set oldData "" 00567 } 00568 } 00569 00570 chain $aspect $newData $oldData 00571 } 00572 00573 ## ---------------------------------------------------------------------------- 00574 ## _show 00575 ## ---------------------------------------------------------------------------- 00576 body YadaGrammars::_show {} { 00577 00578 # clear the tables 00579 set rmax [$itk_component(table) cget -rows] 00580 $itk_component(table) erase 1,1 $rmax,4 00581 $itk_component(table) clear tags 1,1 $rmax,4 00582 $itk_component(table) selection clear all 00583 00584 # get all wordgraphs 00585 set currentItem [getCurrentItem] 00586 set allWordgraphs [$currentItem getWordgraphs] 00587 if {$allWordgraphs == "" && !$_scannedCurrentGrammar} { 00588 update 00589 00590 if { [$currentItem hasSavedState] && ![$currentItem persistenceFileInSync] } { 00591 set msg [iwidgets::messagedialog .msg \ 00592 -text "Rescan wordgraphs of grammar `[$currentItem cget -name]' or load from XML-file?" \ 00593 -title "Yada - Question" \ 00594 -image [YadaImages::get question] \ 00595 -modality application \ 00596 -master $itk_interior] 00597 $msg delete OK 00598 $msg insert 0 Rescan 00599 $msg insert 0 Load 00600 $msg default Rescan 00601 00602 00603 $msg buttonconfigure Rescan -text "Rescan" -command [code $msg deactivate 0] 00604 $msg buttonconfigure Load -text "Load" -command [code $msg deactivate 1] 00605 $msg buttonconfigure Cancel -text "Cancel" -command [code $msg deactivate 2] 00606 $msg center . 00607 set result [$msg activate] 00608 destroy $msg 00609 if {$result==0} { 00610 _rescanGrammar 00611 set allWordgraphs [$currentItem getWordgraphs] 00612 } elseif { $result==1} { 00613 load 00614 _show 00615 return 00616 } 00617 } else { 00618 set msg [iwidgets::messagedialog .msg \ 00619 -text "Rescan wordgraphs of grammar `[$currentItem cget -name]'?" \ 00620 -title "Yada - Question" \ 00621 -image [YadaImages::get question] \ 00622 -modality application \ 00623 -master $itk_interior] 00624 00625 00626 $msg buttonconfigure OK -text "OK" 00627 $msg buttonconfigure Cancel -text "Cancel" 00628 $msg center . 00629 set result [$msg activate] 00630 destroy $msg 00631 if {$result} { 00632 _rescanGrammar 00633 set allWordgraphs [$currentItem getWordgraphs] 00634 } 00635 } 00636 } 00637 set _scannedCurrentGrammar 1 00638 # set the total counter 00639 set _noAllWordgraphs [llength $allWordgraphs] 00640 set _noSelWordgraphs 0 00641 if {$_noAllWordgraphs < 20} { 00642 set rmax 20 00643 } else { 00644 set rmax [expr $_noAllWordgraphs +1] 00645 } 00646 $itk_component(table) configure -rows $rmax 00647 00648 # insert a row for each wordgraph 00649 set row 1 00650 set selection [$currentItem getSelection] 00651 00652 00653 00654 foreach wordgraph $allWordgraphs { 00655 set words [$wordgraph getWords] 00656 $itk_component(table) setCell \ 00657 $row,0 [format "%4d" $row ] \ 00658 $row,1 [$wordgraph cget -name] \ 00659 $row,2 [llength $words] \ 00660 $row,3 [$wordgraph cget -isTrivial] \ 00661 $row,4 [join $words] 00662 00663 # establish the selection 00664 set wgName [$wordgraph cget -name] 00665 if {[lsearch -exact $selection $wgName] >= 0} { 00666 $itk_component(table) tag row mark $row 00667 incr _noSelWordgraphs 00668 } else { 00669 $itk_component(table) tag row "" $row 00670 } 00671 incr row 00672 } 00673 00674 # adjust the view 00675 $itk_component(table) see 1,1 00676 } 00677 00678 ## ---------------------------------------------------------------------------- 00679 ## _selectWordgraphs 00680 ## ---------------------------------------------------------------------------- 00681 body YadaGrammars::_selectWordgraphs {{wordgraphs ""}} { 00682 00683 set table $itk_component(table) 00684 00685 if {$wordgraphs == ""} { 00686 # get selection from table 00687 foreach cell [$table curselection] { 00688 scan $cell "%d,%d" row col 00689 if {$row > 0 && $col == 1} { 00690 if {[$table getCell $row,0] != ""} { 00691 if {[$table selection includes $cell]} { 00692 $table tag row mark $row 00693 } 00694 } 00695 } 00696 } 00697 } else { 00698 # select given wordgraphs 00699 set rmax [$table cget -rows] 00700 set ids [$table getCell 0,1 $rmax,1] 00701 foreach wordgraph $wordgraphs { 00702 set row [lsearch -exact $ids $wordgraph] 00703 $table tag row mark $row 00704 } 00705 } 00706 00707 set _noSelWordgraphs [llength [_getSelectedWordgraphs]] 00708 _mark "wordgraphs" 00709 } 00710 00711 ## ---------------------------------------------------------------------------- 00712 ## _unselectWordgraphs 00713 ## ---------------------------------------------------------------------------- 00714 body YadaGrammars::_unselectWordgraphs {{wordgraphs ""}} { 00715 00716 set table $itk_component(table) 00717 00718 if {$wordgraphs == ""} { 00719 # get selection from table 00720 foreach cell [$table curselection] { 00721 scan $cell "%d,%d" row col 00722 if {$row > 0 && $col == 1} { 00723 if {[$table getCell $row,0] != ""} { 00724 if {[$table selection includes $cell]} { 00725 $table tag row "" $row 00726 } 00727 } 00728 } 00729 } 00730 } else { 00731 # unselect given wordgraphs 00732 set rmax [$table cget -rows] 00733 set ids [$table getCell 0,1 $rmax,1] 00734 foreach wordgraph $wordgraphs { 00735 set row [lsearch -exact $ids $wordgraph] 00736 $table tag row "" $row 00737 } 00738 } 00739 00740 set _noSelWordgraphs [llength [_getSelectedWordgraphs]] 00741 _mark "wordgraphs" 00742 } 00743 00744 ## ---------------------------------------------------------------------------- 00745 ## _invertWordgraphs 00746 ## ---------------------------------------------------------------------------- 00747 body YadaGrammars::_invertWordgraphs {{wordgraphs ""}} { 00748 00749 set table $itk_component(table) 00750 00751 if {$wordgraphs == ""} { 00752 # get selection from table 00753 foreach cell [$table curselection] { 00754 scan $cell "%d,%d" row col 00755 if {$row > 0 && $col == 1} { 00756 if {[$table getCell $row,0] != ""} { 00757 if {[$table selection includes $cell]} { 00758 if {[$table tag includes mark $cell]} { 00759 $table tag row "" $row 00760 } else { 00761 $table tag row mark $row 00762 } 00763 } 00764 } 00765 } 00766 } 00767 } else { 00768 # invert given wordgraphs 00769 set rmax [$table cget -rows] 00770 set ids [$table getCell 0,1 $rmax,1] 00771 incr row 00772 foreach wordgraph $wordgraphs { 00773 set row [lsearch -exact $ids $wordgraph] 00774 if {[$table tag includes mark $row,1]} { 00775 $table tag row "" $row 00776 } else { 00777 $table tag row mark $row 00778 } 00779 } 00780 } 00781 00782 set _noSelWordgraphs [llength [_getSelectedWordgraphs]] 00783 _mark "wordgraphs" 00784 } 00785 00786 ## ---------------------------------------------------------------------------- 00787 ## _editGrammar 00788 ## ---------------------------------------------------------------------------- 00789 body YadaGrammars::_editGrammar {} { 00790 set configureDocument [.main component Configure] 00791 set miscDocument [$configureDocument component misc] 00792 00793 set editor [$miscDocument cget -editor] 00794 00795 #puts "DEBUG: spawning editor `$editor'" 00796 set currentItem [getCurrentItem] 00797 catch {eval exec -- $editor [$currentItem cget -files]} 00798 } 00799 00800 ## ---------------------------------------------------------------------------- 00801 ## _defaults 00802 ## ---------------------------------------------------------------------------- 00803 body YadaGrammars::_defaults {{fileName ""}} { 00804 global env 00805 00806 if {$fileName == ""} { 00807 set fileName [file join $env(YADA_LIB) grammars.tcl.sample] 00808 } 00809 00810 # ... configured grammars 00811 if {[catch {source $fileName} errMsg]} { 00812 bgerror "There's an error in your grammars init file $fileName!" 00813 } 00814 00815 # required <none> grammar 00816 YadaGrammar ::#auto -name "<none>" 00817 00818 # assert grammars into the class 00819 set grammars [itcl_info objects -class YadaGrammar] 00820 foreach grammar $grammars { 00821 set grammarName [$grammar cget -name] 00822 set item [getItem $grammarName] 00823 if {$item != ""} { 00824 puts "ERROR: grammar `$grammarName' already exists" 00825 itcl::delete object $grammar 00826 } else { 00827 setItem $grammar 00828 } 00829 } 00830 00831 .main printStatus "... built [llength $grammars] grammars" 00832 } 00833 00834 ## ---------------------------------------------------------------------------- 00835 ## _leaveTableCommand 00836 ## ---------------------------------------------------------------------------- 00837 body YadaGrammars::_leaveTableCommand {} { 00838 set table $itk_component(table) 00839 set lastActiveCell [$table tag cell active] 00840 if {$lastActiveCell == ""} { 00841 return 00842 } 00843 00844 scan $lastActiveCell "%d,%d" row col 00845 $table activate -1,-1 00846 } 00847 00848 ## ---------------------------------------------------------------------------- 00849 ## _returnCommand 00850 ## ---------------------------------------------------------------------------- 00851 body YadaGrammars::_returnCommand {} { 00852 set table $itk_component(table) 00853 set lastActiveCell [$table tag cell active] 00854 scan $lastActiveCell "%d,%d" row col 00855 set colMax [expr [$table cget -cols] -1] 00856 if {$col == $colMax} { 00857 incr row 00858 set col 1 00859 } else { 00860 incr col 00861 } 00862 00863 $table activate $row,$col 00864 $table see $row,$col 00865 } 00866 00867 ## ---------------------------------------------------------------------------- 00868 ## _escapeCommand 00869 ## ---------------------------------------------------------------------------- 00870 body YadaGrammars::_escapeCommand {} { 00871 set table $itk_component(table) 00872 set lastActiveCell [$table tag cell active] 00873 scan $lastActiveCell "%d,%d" row col 00874 00875 if {$col == 0} { 00876 $table selection clear all 00877 } else { 00878 $table activate -1,-1 00879 } 00880 } 00881 00882 ## ---------------------------------------------------------------------------- 00883 ## select a random subset of the already selected wordgraphs. 00884 ## ---------------------------------------------------------------------------- 00885 body YadaGrammars::_randomSelection {} { 00886 set grammarName [$itk_component(name) get] 00887 if {$grammarName == "<none>" || !$_scannedCurrentGrammar} { 00888 return 00889 } 00890 00891 # get current selected wordgraphs 00892 set allWordgraphNames [_getSelectedWordgraphs] 00893 00894 # unselect all 00895 set table $itk_component(table) 00896 set rmax [$table cget -rows] 00897 for {set row 0} {$row < $rmax} {incr row} { 00898 $table tag row "" $row 00899 } 00900 00901 # choose some random wordgraphs 00902 set noWordgraphs [llength $allWordgraphNames] 00903 set half [expr int($noWordgraphs * 0.5)] 00904 set selection "" 00905 expr srand([clock seconds]) 00906 00907 for {set i $half} {$i >=0} {incr i -1} { 00908 set index [expr int(rand() * $noWordgraphs)] 00909 lappend selection [lindex $allWordgraphNames $index] 00910 incr noWordgraphs -1 00911 set allWordgraphNames [lreplace $allWordgraphNames $index $index] 00912 } 00913 00914 # select them 00915 _selectWordgraphs $selection 00916 } 00917 00918 ## ---------------------------------------------------------------------------- 00919 ## select wordgraphs of a limited length from the current selection. 00920 ## If min or max has not been specified then a dialog pops up to get these 00921 ## values interactively. 00922 ## \see YadaGrammar::getWordgraphDistribution() 00923 ## \param min minimum length of a sentence to be selected (optional parameter) 00924 ## \param max maximum length of a sentence to be selected (optional parameter) 00925 ## \returns the selected wordgraph names 00926 ## ---------------------------------------------------------------------------- 00927 body YadaGrammars::_lengthSelection {{min -1} {max -1}} { 00928 00929 set grammarName [$itk_component(name) get] 00930 if {$grammarName == "<none>" || !$_scannedCurrentGrammar} { 00931 return 00932 } 00933 00934 if {$min < 0 || $max < 0} { 00935 # TODO: selection dialog 00936 set min 0 00937 set max 60 00938 } 00939 00940 # get current selected wordgraphs 00941 set allWordgraphNames [_getSelectedWordgraphs] 00942 00943 # unselect all 00944 set table $itk_component(table) 00945 set rmax [$table cget -rows] 00946 for {set row 0} {$row < $rmax} {incr row} { 00947 $table tag row "" $row 00948 } 00949 00950 # construct a new selection 00951 set selection "" 00952 set grammar [getCurrentItem] 00953 foreach wordgraphName $allWordgraphNames { 00954 set wordgraph [$grammar getWordgraph $wordgraphName] 00955 if {$wordgraph == ""} { 00956 continue 00957 } 00958 set length [llength [$wordgraph getWords]] 00959 if {$length >= $min && $length <= $max} { 00960 lappend selection $wordgraphName 00961 } 00962 } 00963 00964 # select them 00965 _selectWordgraphs $selection 00966 } 00967 00968 ## ---------------------------------------------------------------------------- 00969 ## _getSelectedWordgraphs 00970 ## ---------------------------------------------------------------------------- 00971 body YadaGrammars::_getSelectedWordgraphs {} { 00972 set rmax [$itk_component(table) cget -rows] 00973 set result "" 00974 for {set row 1} {$row < $rmax} {incr row} { 00975 if {[$itk_component(table) tag includes mark $row,1]} { 00976 lappend result [$itk_component(table) getCell $row,1] 00977 } 00978 } 00979 00980 return "$result" 00981 } 00982 00983 ## ---------------------------------------------------------------------------- 00984 ## _rescanGrammar 00985 ## ---------------------------------------------------------------------------- 00986 body YadaGrammars::_rescanGrammar {} { 00987 set grammarName [$itk_component(name) get] 00988 if {$grammarName == "<none>"} { 00989 set _scannedCurrentGrammar 1 00990 return 00991 } 00992 00993 ## Set cursor busy and save old cursors 00994 set oldCursors [setBusy] 00995 00996 00997 set currentItem [getCurrentItem] 00998 $currentItem rescan 00999 set _scannedCurrentGrammar 1 01000 01001 ## Restore old cursors 01002 resetBusy $oldCursors 01003 01004 _unmark 01005 _show 01006 } 01007 01008 ## ---------------------------------------------------------------------------- 01009 ## _fileChooser 01010 ## ---------------------------------------------------------------------------- 01011 body YadaGrammars::_fileChooser {} { 01012 set currentItem [getCurrentItem] 01013 if {$currentItem == ""} { 01014 return 01015 } 01016 01017 set files [$currentItem cget -files] 01018 set directory [file dirname [lindex $files 0]] 01019 set selection [.fileSelector activate \ 01020 -directory $directory \ 01021 -title "Choose CDG grammar files" \ 01022 -filter {"*.cd? *.m4" "*.cd?" "*.m4" "*" } \ 01023 -mode "multi" \ 01024 -selection $files] 01025 01026 if {$selection != ""} { 01027 $currentItem configure -files $selection 01028 _select 01029 } 01030 } 01031 01032 01033 ## ---------------------------------------------------------------------------- 01034 ## Overriding default implementation. Delegates command to current grammar's 01035 ## load method 01036 ## ---------------------------------------------------------------------------- 01037 body YadaGrammars::load {} { 01038 set currentItem [getCurrentItem] 01039 01040 if { $currentItem != "" && [$currentItem cget -name] != "<none>"} { 01041 set oldCursors [setBusy] 01042 01043 if { [catch {$currentItem load} errorMessage] } { 01044 resetBusy $oldCursors 01045 error $errorMessage 01046 } 01047 resetBusy $oldCursors 01048 displayTitle 01049 } 01050 } 01051 01052 ## ---------------------------------------------------------------------------- 01053 ## Overriding default implementation. Delegates command to current grammar's 01054 ## save method 01055 ## ---------------------------------------------------------------------------- 01056 body YadaGrammars::save {} { 01057 set currentItem [getCurrentItem] 01058 01059 if { $currentItem != "" && [$currentItem cget -name] != "<none>"} { 01060 set oldCursors [setBusy] 01061 01062 if { [catch {$currentItem save} errorMessage] } { 01063 resetBusy $oldCursors 01064 error $errorMessage 01065 } 01066 resetBusy $oldCursors 01067 displayTitle 01068 } 01069 01070 } 01071 01072 01073 ## ---------------------------------------------------------------------------- 01074 ## Creates grammar objects, that have no Tcl source, from XML files 01075 ## ---------------------------------------------------------------------------- 01076 body YadaGrammars::loadNonTclGrammars {} { 01077 global env 01078 01079 set fileList [glob -nocomplain -directory $env(YADA_DATA) "*.xml.gz" ] 01080 01081 01082 set grammarsKnown [itcl_info objects -class YadaGrammar] 01083 01084 set grammarNamesKnown {} 01085 01086 foreach grammarKnown $grammarsKnown { 01087 lappend grammarNamesKnown [$grammarKnown cget -name] 01088 } 01089 01090 set grammarNamesNonTcl {} 01091 01092 foreach file $fileList { 01093 set grammarName [isValidPersistanceFile $file] 01094 01095 if { $grammarName != "" && [lsearch $grammarNamesKnown $grammarName] == -1} { 01096 lappend grammarNamesNonTcl $grammarName 01097 } 01098 } 01099 01100 if { $grammarNamesNonTcl != ""} { 01101 foreach grammarName $grammarNamesNonTcl { 01102 set grammar [YadaGrammar ::#auto -name $grammarName] 01103 $grammar load 01104 setItem $grammar 01105 } 01106 # initialize the name combobox 01107 eval $itk_component(name) insert list end $grammarNamesNonTcl 01108 } 01109 01110 01111 } 01112 01113 01114 ## ---------------------------------------------------------------------------- 01115 ## Checks, whether given file contains valid grammar data, 01116 ## returning an empty string, if it is not valid, otherwise 01117 ## the unique name of the grammar 01118 ## ---------------------------------------------------------------------------- 01119 body YadaGrammars::isValidPersistanceFile { fileName } { 01120 01121 if { ![file exists $fileName]} { 01122 error "File $fileName not found." 01123 } 01124 01125 set fileID [open "|zcat $fileName" {RDONLY}] 01126 set xmlData [read $fileID] 01127 close $fileID 01128 set document [dom parse $xmlData] 01129 set rootNode [$document documentElement] 01130 01131 set xpath "/yada/grammar" 01132 set nodeGrammar [$rootNode selectNodes $xpath] 01133 01134 if { $nodeGrammar == "" } { 01135 return "" 01136 } else { 01137 return [$nodeGrammar getAttribute name] 01138 } 01139 } 01140 01141 01142 01143 01144 01145 01146 01147 01148 01149

YADA 2.0-alpha (20 Oct 2004)