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

commands.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 ## Namespace cmd 00013 ## 00014 ## this namespace defines all commands which are allowed to be evaluated 00015 ## in the cdg-script-language 00016 ## 00017 ## \todo purge this interface with the help of \c commandEval 00018 ## \todo return values of the XCDG commands are a mess. See cmd::Verify() 00019 ## and cmd::Constraint(). 00020 ## 00021 ## \author Michael Daum (see also AUTHORS and THANKS for more) 00022 ## $Id: commands.tcl,v 1.117 2004/09/06 13:40:53 micha Exp $ 00023 ## ---------------------------------------------------------------------- 00024 namespace eval ::cmd { 00025 00026 ## ---------------------------------------------------------------------- 00027 ## try to find out on what net the command will operate. 00028 ## ---------------------------------------------------------------------- 00029 proc deduceNetName {cmdline} {; ## \type TclString 00030 00031 foreach s [split $cmdline] { 00032 00033 # detect named parameters of some commands 00034 regsub "^net=(.*)$" $s "\1" s 00035 00036 # find constraint net by that name 00037 set net [cnFindNet $s] 00038 if {$net != "NULL"} { 00039 return $s 00040 } 00041 } 00042 00043 # assume that the command uses the most recent net 00044 set net [cnMostRecentlyCreatedNet_get] 00045 if {$net != "NULL"} { 00046 return [ConstraintNetStruct_id_get $net] 00047 } 00048 00049 return "" 00050 00051 } 00052 00053 ## ---------------------------------------------------------------------- 00054 ## quits the cdg-tool 00055 ## ---------------------------------------------------------------------- 00056 proc Quit {} { 00057 00058 set result 1 00059 00060 if {[.cdgmain shell getConfirmExit]} { 00061 set result [.cdgmain question "Quit: Are you sure?"] 00062 } 00063 00064 if {$result == 1} { 00065 wm withdraw . 00066 exit 00067 } 00068 } 00069 00070 ## ---------------------------------------------------------------------- 00071 ## loads one or more file 00072 ## ---------------------------------------------------------------------- 00073 proc Load {args} {; ## \type TclList 00074 00075 eval .cdgmain files load $args 00076 00077 return 00078 } 00079 00080 ## ---------------------------------------------------------------------- 00081 ## loads one or more file 00082 ## ---------------------------------------------------------------------- 00083 proc Source {file} {; ## \type TclString 00084 00085 .cdgmain shell safeSource $file 00086 00087 return 00088 } 00089 00090 00091 ## ---------------------------------------------------------------------- 00092 ## delegate the command to the C core. 00093 ## ---------------------------------------------------------------------- 00094 proc Constraint {args} {; ## \type TclList 00095 commandEval "constraint $args" 00096 return 00097 } 00098 00099 ## ---------------------------------------------------------------------- 00100 ## delegate the command to the C core. 00101 ## ---------------------------------------------------------------------- 00102 proc Level {args} {; ## \type TclList 00103 commandEval "level $args" 00104 return 00105 } 00106 00107 ## ---------------------------------------------------------------------- 00108 ## delegate the command to the C core. 00109 ## ---------------------------------------------------------------------- 00110 proc Showlevel {args} {; ## \type TclList 00111 commandEval "showlevel $args" 00112 return 00113 } 00114 00115 ## ---------------------------------------------------------------------- 00116 ## delegate the command to the C core. 00117 ## ---------------------------------------------------------------------- 00118 proc Uselevel {args} {; ## \type TclList 00119 commandEval "uselevel $args" 00120 return 00121 } 00122 00123 ## ---------------------------------------------------------------------- 00124 ## delegate the command to the C core. 00125 ## ---------------------------------------------------------------------- 00126 proc Useconstraint {args} {; ## \type TclList 00127 commandEval "useconstraint $args" 00128 return 00129 } 00130 00131 ## ---------------------------------------------------------------------- 00132 ## delegate the command to the C core. 00133 ## ---------------------------------------------------------------------- 00134 proc Lexicon {args} {; ## \type TclList 00135 commandEval "lexicon $args" 00136 return 00137 } 00138 00139 ## ---------------------------------------------------------------------- 00140 ## delegate the command to the C core. 00141 ## ---------------------------------------------------------------------- 00142 proc Wordgraph {args} {; ## \type TclList 00143 00144 commandEval "wordgraph $args" 00145 00146 return 00147 } 00148 00149 ## ---------------------------------------------------------------------- 00150 ## delegate the command to the C core. 00151 ## ---------------------------------------------------------------------- 00152 proc Annotation {args} {; ## \type TclList 00153 00154 commandEval "annotation $args" 00155 00156 return 00157 } 00158 00159 ## ---------------------------------------------------------------------- 00160 ## delegate the command to the C core and add the new parse to AllParses. 00161 ## ---------------------------------------------------------------------- 00162 proc Anno2Parse {args} {; ## \type TclList 00163 00164 commandEval "anno2parse $args" 00165 set p [parseMostRecentlyCreatedParse_get] 00166 if {$p != "NULL"} { 00167 .cdgmain parses addParse $p 00168 } 00169 return 00170 } 00171 00172 ## ---------------------------------------------------------------------- 00173 ## delegate the command to the C core. 00174 ## ---------------------------------------------------------------------- 00175 proc Hierarchy {args} {; ## \type TclList 00176 commandEval "hierarchy $args" 00177 return 00178 } 00179 00180 00181 ## ---------------------------------------------------------------------- 00182 ## delegate the command to the C core. 00183 ## ---------------------------------------------------------------------- 00184 proc Section {} { 00185 commandEval "section" 00186 return 00187 } 00188 00189 ## ---------------------------------------------------------------------- 00190 ## delegate the command to the C core. 00191 ## ---------------------------------------------------------------------- 00192 proc Deactivate {args} {; ## \type TclList 00193 commandEval "deactivate $args" 00194 return 00195 } 00196 00197 ## ---------------------------------------------------------------------- 00198 ## delegate the command to the C core. 00199 ## ---------------------------------------------------------------------- 00200 proc Activate {args} {; ## \type TclList 00201 commandEval "activate $args" 00202 return 00203 } 00204 00205 ## ---------------------------------------------------------------------- 00206 ## delegate the command to the C core. 00207 ## ---------------------------------------------------------------------- 00208 proc Net {args} {; ## \type TclList 00209 commandEval "net $args" 00210 return 00211 } 00212 00213 ## ---------------------------------------------------------------------- 00214 ## delegate the command to the C core. 00215 ## Additionally this function displays a busy box and adds the 00216 ## resulting parse to AllParses 00217 ## ---------------------------------------------------------------------- 00218 proc Netsearch {args} {; ## \type TclList 00219 00220 set netId [deduceNetName [join $args]] 00221 if {$netId == ""} { 00222 Printf "WARNING: netsearch called with no available netId" 00223 return 00224 } 00225 00226 .cdgmain busy compute "Computing: netsearch $netId" \ 00227 [code commandEval "netsearch $args"] 00228 00229 00230 set result [.cdgmain busy compute "Computing: parses for $netId" \ 00231 [code .cdgmain parses addParsesOfNet $netId]] 00232 00233 .cdgmain networks refreshid $netId 00234 eval .cdgmain parses setSelection $result 00235 00236 return $result 00237 } 00238 00239 ## ---------------------------------------------------------------------- 00240 ## delegate the command to the C core. 00241 ## ---------------------------------------------------------------------- 00242 proc IC {args} {; ## \type TclList 00243 00244 if {$args == {}} { 00245 Printf "WARNING: IC called with no utterance!" 00246 return 0 00247 } 00248 00249 commandEval "incrementalCompletion $args" 00250 return 1 00251 } 00252 00253 ## ---------------------------------------------------------------------- 00254 ## delegate the command to the C core and refresh AllNetworks. 00255 ## ---------------------------------------------------------------------- 00256 proc Netdelete {args} {; ## \type TclList 00257 commandEval "netdelete $args" 00258 .cdgmain networks init_data 00259 return 00260 } 00261 00262 ## ---------------------------------------------------------------------- 00263 ## delegate the command to the C core. 00264 ## ---------------------------------------------------------------------- 00265 proc Edges {netId {startId ""} {stopId ""}} {; ## \type TclString, TclString, TclString 00266 commandEval "edges [concat $netId $startId $stopId]" 00267 return 00268 } 00269 00270 ## ---------------------------------------------------------------------- 00271 ## delegate the command to the C core. 00272 ## ---------------------------------------------------------------------- 00273 proc Writeannotation {args} {; ## \type TclList 00274 commandEval "writeannotation $args" 00275 return 00276 } 00277 00278 ## ---------------------------------------------------------------------- 00279 ## delegate the command to the C core. 00280 ## ---------------------------------------------------------------------- 00281 proc Writenet {args} {; ## \type TclList 00282 commandEval "writenet $args" 00283 return 00284 } 00285 00286 ## ---------------------------------------------------------------------- 00287 ## delegate the command to the C core. 00288 ## ---------------------------------------------------------------------- 00289 proc Status {} { 00290 commandEval "status" 00291 return 00292 } 00293 00294 ## ---------------------------------------------------------------------- 00295 ## delegate the command to the C core. 00296 ## ---------------------------------------------------------------------- 00297 proc Set {variable {value ""}} {; ## \type TclString, TclString 00298 global _getValue 00299 00300 switch $variable { 00301 cdgEditor { 00302 .cdgmain configure -editor $value 00303 } 00304 cdgGrammarpath { 00305 .cdgmain configure -grammarpath $value 00306 } 00307 manywindows { 00308 .cdgmain parses setManyWindows $value 00309 } 00310 trace { 00311 .cdgmain shell configure -showTrace $value 00312 } 00313 confirmexit { 00314 .cdgmain shell setConfirmExit $value 00315 } 00316 default { 00317 if {$value != ""} { 00318 commandEval "set $variable '$value'" 00319 } else { 00320 set oldHook [getHookCmd printf] 00321 setHookCmd printf [code _get $oldHook] 00322 commandEval "set $variable" 00323 regsub {^[a-zA-Z]* = } $_getValue "" value 00324 return $value 00325 } 00326 } 00327 } 00328 } 00329 00330 ## ---------------------------------------------------------------------- 00331 ## callback installed by Set(). 00332 ## This function captures the returnvalue of a CDG set command. 00333 # ---------------------------------------------------------------------- 00334 proc _get {oldHook value} {; ## \type TclCommand, TclString 00335 global _getValue 00336 set _getValue $value 00337 setHookCmd printf $oldHook 00338 } 00339 00340 ## ---------------------------------------------------------------------- 00341 ## delegate the command to the C core. 00342 ## In addition this function refreshes AllNetworks. 00343 ## ---------------------------------------------------------------------- 00344 proc Newnet {{wordGraphId ""}} {; ## \type TclString 00345 00346 if {$wordGraphId == ""} { 00347 set lattice [inputMostRecentlyCreatedLattice_get] 00348 if {$lattice == "NULL"} { 00349 error "no wordGraphId specified" 00350 } else { 00351 set wordGraphId [LatticeStruct_id_get $lattice] 00352 } 00353 } 00354 00355 cnMostRecentlyCreatedNet_set NULL 00356 .cdgmain busy compute "Computing: newnet $wordGraphId" \ 00357 [code commandEval "newnet $wordGraphId"] 00358 00359 set net [cnMostRecentlyCreatedNet_get] 00360 if {$net != "NULL" } { 00361 set netId [ConstraintNetStruct_id_get $net] 00362 .cdgmain networks refreshid $netId 00363 .cdgmain networks setSelection $netId 00364 return $netId 00365 } else { 00366 return "" 00367 } 00368 00369 } 00370 00371 ## ---------------------------------------------------------------------- 00372 ## delegate the command to the C core. 00373 ## ---------------------------------------------------------------------- 00374 proc Distance {netId } {; ## \type TclString 00375 commandEval "distance $netId" 00376 return 00377 } 00378 00379 ## ---------------------------------------------------------------------- 00380 ## delegate the command to the C core. 00381 ## In addition this function refreshes AllWordgraphs. 00382 ## ---------------------------------------------------------------------- 00383 proc Inputwordgraph {word args} {; ## \type TclString, TclList 00384 00385 commandEval "inputwordgraph [concat $word $args]" 00386 00387 set lattice [inputMostRecentlyCreatedLattice_get] 00388 if {$lattice != "NULL"} { 00389 set lattice_id [LatticeStruct_id_get $lattice] 00390 .cdgmain wordgraphs refreshid $lattice_id 00391 # .cdgmain files init_data 00392 } else { 00393 set lattice_id "" 00394 } 00395 00396 return $lattice_id 00397 } 00398 00399 ## ---------------------------------------------------------------------- 00400 ## delegate the command to the C core. 00401 ## ---------------------------------------------------------------------- 00402 proc Parses2Prolog {args} {; ## \type TclList 00403 commandEval "parses2prolog $args" 00404 return 00405 } 00406 00407 proc Annos2Prolog {args} {; ## \type TclList 00408 commandEval "annos2prolog $args" 00409 return 00410 } 00411 00412 00413 ## ---------------------------------------------------------------------- 00414 ## delegate the command to the C core. 00415 ## Additionally this function updates AllNetworks. 00416 ## ---------------------------------------------------------------------- 00417 proc Isearch {args} {; ## \type TclList 00418 00419 set wgId [lindex $args 0] 00420 .cdgmain busy compute "Computing: isearch $wgId" \ 00421 [code commandEval "iSearch $args"] 00422 00423 set net [cnMostRecentlyCreatedNet_get] 00424 if {$net != "NULL" } { 00425 set netId [ConstraintNetStruct_id_get $net] 00426 .cdgmain networks refreshid $netId 00427 .cdgmain networks setSelection $netId 00428 } else { 00429 set netId "" 00430 } 00431 00432 return $netId 00433 } 00434 00435 00436 ## ---------------------------------------------------------------------- 00437 ## intercept the tcl command puts to print to the Shell. 00438 ## ---------------------------------------------------------------------- 00439 proc Puts {arg1 {arg2 ""}} {; ## \type TclString, TclString 00440 switch -- $arg1 { 00441 -nonewline { 00442 set text $arg2 00443 set newline "" 00444 } 00445 -newline { 00446 set text $arg2 00447 set newline "\n" 00448 } 00449 -* { 00450 error "Unknown option `$mode', should be -nonewline, newline" 00451 } 00452 default { 00453 if {$arg2 != ""} { 00454 error "wrong #arguments to puts" 00455 } 00456 set text $arg1 00457 set newline "\n" 00458 } 00459 } 00460 00461 if {$text != "" || $newline != ""} { 00462 .cdgmain shell insert $text$newline 00463 .cdgmain shell setCursor end 00464 } 00465 return 00466 } 00467 00468 ## ---------------------------------------------------------------------- 00469 ## immitate the C command printf in tcl. 00470 ## ---------------------------------------------------------------------- 00471 proc Printf {format args} {; ## \type TclString, TclList 00472 set text [format $format $args] 00473 if {$text != "" } { 00474 .cdgmain shell insert $text 00475 .cdgmain shell setCursor end 00476 } 00477 return 00478 } 00479 00480 ## ---------------------------------------------------------------------- 00481 ## implement the shell command ls. 00482 ## ---------------------------------------------------------------------- 00483 proc Ls {args} {; ## \type TclList 00484 if {$args == ""} { 00485 set args "-xAF" 00486 } 00487 set allArgs "" 00488 set options "" 00489 00490 00491 foreach arg $args { 00492 if {[regexp -- "-.*" $arg]} { 00493 lappend allArgs $arg 00494 } else { 00495 lappend allArgs [glob -nocomplain -- $arg] 00496 } 00497 00498 } 00499 set result [ \ 00500 if {"$allArgs" == ""} { 00501 exec /bin/ls 00502 } else { 00503 exec /bin/sh -c "/bin/ls $allArgs" 00504 }] 00505 Puts $result 00506 return 00507 } 00508 00509 ## ---------------------------------------------------------------------- 00510 ## clear the shell window. 00511 ## ---------------------------------------------------------------------- 00512 proc Clear {args} {; ## \type TclList 00513 eval .cdgmain shell clear $args 00514 return 00515 } 00516 00517 ## ---------------------------------------------------------------------- 00518 ## delegate the command to the C core. 00519 ## ---------------------------------------------------------------------- 00520 proc Hook {args} {; ## \type TclList 00521 commandEval "hook $args" 00522 return 00523 00524 } 00525 00526 ## ---------------------------------------------------------------------- 00527 ## delegate the command to the C core. 00528 ## ---------------------------------------------------------------------- 00529 proc Levelsort {args} {; ## \type TclList 00530 00531 commandEval "levelsort $args" 00532 00533 return 00534 } 00535 00536 ## ---------------------------------------------------------------------- 00537 ## enable AllParses::showparse() in the xcdg shell. 00538 ## ---------------------------------------------------------------------- 00539 proc Showparse {args} {; ## \type TclList 00540 00541 if {$args == {} } { 00542 error "missing argument `parseId'" 00543 return 00544 } 00545 00546 eval .cdgmain parses showparse $args 00547 return 00548 } 00549 00550 ## ---------------------------------------------------------------------- 00551 ## enable AllParses::deleteparse() in the xcdg shell. 00552 ## ---------------------------------------------------------------------- 00553 proc Deleteparse {args} {; ## \type TclList 00554 if {$args == {} } { 00555 error "missing argument `parseId'" 00556 return 00557 } 00558 eval .cdgmain parses deleteparse $args 00559 return 00560 } 00561 00562 ## ---------------------------------------------------------------------- 00563 ## delegate the command to the C core. 00564 ## ---------------------------------------------------------------------- 00565 proc Nonspeccompatible {args} {; ## \type TclList 00566 commandEval "nonspeccompatible $args" 00567 return 00568 } 00569 00570 ## ---------------------------------------------------------------------- 00571 ## implement the extraordinary feature of directory changing. 00572 ## ---------------------------------------------------------------------- 00573 proc Cd {args} {; ## \type TclList 00574 eval cd $args 00575 } 00576 00577 ## ---------------------------------------------------------------------- 00578 ## question a core reset of the system. 00579 ## ---------------------------------------------------------------------- 00580 proc Reset {args} {; ## \type TclList 00581 00582 if {"$args" == "force"} { 00583 set result 1 00584 } else { 00585 set result [.cdgmain question "Reset: Are you sure?\n All data will be lost!!!"] 00586 } 00587 if {$result == 1} { 00588 commandEval "reset" 00589 .cdgmain files init_data 00590 .cdgmain networks init_data 00591 .cdgmain wordgraphs init_data 00592 .cdgmain constraints init_data 00593 .cdgmain levels init_data 00594 .cdgmain lexemes init_data 00595 .cdgmain hierarchies init_data 00596 .cdgmain parses init_data 00597 } 00598 00599 } 00600 00601 ## ---------------------------------------------------------------------- 00602 ## delegate the command to the C core. 00603 ## Additionally, we get a busy box and update AllParses and AllNetworks. 00604 ## ---------------------------------------------------------------------- 00605 proc Frobbing {args} {; ## \type TclList 00606 00607 set cmdline [join $args] 00608 set netId [deduceNetName $cmdline] 00609 00610 # should we allow user input during frobbing? 00611 00612 # If the user specified `manual', then yes. 00613 # If the user gave an execute= keyword, then yes (the user 00614 # is reponsible for adding `q' to the program). 00615 # Otherwise, no. 00616 set interactive [regexp "execute=|manual" $cmdline] 00617 if {!$interactive} { 00618 lappend args "execute=q" 00619 } 00620 00621 # If no input is allowed, pop up a busy box. 00622 if {$interactive} { 00623 commandEval "frobbing $args" 00624 } else { 00625 .cdgmain busy compute "Computing: frobbing $netId" commandEval "frobbing $args" 00626 } 00627 00628 if {$netId != ""} { 00629 .cdgmain networks refreshid $netId 00630 .cdgmain parses setSelection [.cdgmain parses addParsesOfNet $netId] 00631 } 00632 return 00633 00634 } 00635 00636 ## ---------------------------------------------------------------------- 00637 ## delegate the command to the C core. 00638 ## Additionally, we get a busy box and update AllParses and AllNetworks. 00639 ## ---------------------------------------------------------------------- 00640 proc Gls {args} {; ## \type TclList 00641 00642 set netId [deduceNetName [join $args]] 00643 if {$netId == ""} { 00644 Printf "WARNING: gls called with no available netId" 00645 return 00646 } 00647 00648 .cdgmain busy compute "Computing: gls on $netId" [code commandEval "gls $args"] 00649 00650 set result [.cdgmain busy compute "Computing: parses for $netId" \ 00651 [code .cdgmain parses addParsesOfNet $netId]] 00652 00653 .cdgmain networks refreshid $netId 00654 eval .cdgmain parses setSelection $result 00655 00656 return $result 00657 } 00658 00659 ## ---------------------------------------------------------------------- 00660 ## delegate the command to the C core. 00661 ## Additionally, we get a busy box and update AllParses and AllNetworks. 00662 ## ---------------------------------------------------------------------- 00663 proc NewGls {args} {; ## \type TclList 00664 00665 set netId [deduceNetName [join $args]] 00666 if {$netId == ""} { 00667 Printf "WARNING: gls called with no available netId" 00668 return 00669 } 00670 00671 .cdgmain busy compute "Computing: new gls on $netId" [code commandEval "ngls $args"] 00672 00673 set result [.cdgmain busy compute "Computing: parses for $netId" \ 00674 [code .cdgmain parses addParsesOfNet $netId]] 00675 00676 .cdgmain networks refreshid $netId 00677 eval .cdgmain parses setSelection $result 00678 00679 return $result 00680 } 00681 00682 ## ---------------------------------------------------------------------- 00683 ## delegate the command to the C core. 00684 ## ---------------------------------------------------------------------- 00685 proc Verify {args} {; ## \type TclList 00686 commandEval "verify $args" 00687 } 00688 00689 ## ---------------------------------------------------------------------- 00690 ## delegate the command to the C core. 00691 ## ---------------------------------------------------------------------- 00692 proc Compile {args} {; ## \type TclList 00693 commandEval "compile $args" 00694 } 00695 00696 00697 ## ---------------------------------------------------------------------- 00698 ## delegate the command to the C core. 00699 ## ---------------------------------------------------------------------- 00700 proc IncrementalCompletion {args} {; ## \type TclList 00701 commandEval "incrementalCompletion $args" 00702 } 00703 00704 00705 ## ---------------------------------------------------------------------- 00706 ## delegate the command to the C core. 00707 ## ---------------------------------------------------------------------- 00708 proc PrintParse {args} {; ## \type TclList 00709 commandEval "printparse $args" 00710 } 00711 00712 00713 ## ---------------------------------------------------------------------- 00714 ## delegate the command to the C core. 00715 ## ---------------------------------------------------------------------- 00716 proc PrintParses {args} {; ## \type TclList 00717 commandEval "printparses $args" 00718 } 00719 00720 00721 ## ---------------------------------------------------------------------- 00722 ## delegate the command to the C core. 00723 ## ---------------------------------------------------------------------- 00724 proc Renewnet {args} {; ## \type TclList 00725 commandEval "renewnet $args" 00726 } 00727 00728 ## ---------------------------------------------------------------------- 00729 ## delegate the command to the C core. 00730 ## ---------------------------------------------------------------------- 00731 proc Version {args} {; ## \type TclList 00732 commandEval "version $args" 00733 } 00734 00735 00736 ## ---------------------------------------------------------------------- 00737 ## delegate the command to the C core. 00738 ## ---------------------------------------------------------------------- 00739 proc WriteParses {args} {; ## \type TclList 00740 commandEval "writeparses $args" 00741 } 00742 00743 ## ---------------------------------------------------------------------- 00744 ## delegate the command to the C core. 00745 ## ---------------------------------------------------------------------- 00746 proc WriteWordgraph {args} {; ## \type TclList 00747 commandEval "writewordgraph $args" 00748 } 00749 00750 ## ---------------------------------------------------------------------- 00751 ## delegate the command to the C core. 00752 ## ---------------------------------------------------------------------- 00753 proc License {args} {; ## \type TclList 00754 commandEval "license $args" 00755 } 00756 00757 ## ---------------------------------------------------------------------- 00758 ## delegate the command to the C core. 00759 ## ---------------------------------------------------------------------- 00760 proc Compareparses {args} {; ## \type TclList 00761 commandEval "compareparses $args" 00762 } 00763 00764 ## ---------------------------------------------------------------------- 00765 ## delegate the command to the C core. 00766 ## ---------------------------------------------------------------------- 00767 proc Help {args} {; ## \type TclList 00768 commandEval "help $args" 00769 } 00770 00771 ## ---------------------------------------------------------------------- 00772 ## delegate the command to the C core. 00773 ## ---------------------------------------------------------------------- 00774 proc Tagger {args} {; ## \type TclList 00775 commandEval "tagger $args" 00776 } 00777 00778 ## ---------------------------------------------------------------------- 00779 ## delegate the command to the C core. 00780 ## ---------------------------------------------------------------------- 00781 proc Testing {args} {; ## \type TclList 00782 commandEval "testing $args" 00783 } 00784 00785 ## ---------------------------------------------------------------------- 00786 ## delegate the command to the C core. 00787 ## ---------------------------------------------------------------------- 00788 proc Weight {args} {; ## \type TclList 00789 commandEval "weight $args" 00790 } 00791 00792 ## ---------------------------------------------------------------------- 00793 ## delegate the command to the C core. 00794 ## ---------------------------------------------------------------------- 00795 proc Chunk {args} {; ## \type TclList 00796 commandEval "chunk $args" 00797 } 00798 00799 ## ---------------------------------------------------------------------- 00800 ## delegate the command to the C core. 00801 ## ---------------------------------------------------------------------- 00802 proc Shift {args} {; ## \type TclList 00803 00804 set netId [deduceNetName [join $args]] 00805 if {$netId == ""} { 00806 Printf "WARNING: shift-reduce called with no available net" 00807 return 00808 } 00809 00810 commandEval "shift-reduce $args" 00811 00812 .cdgmain networks refreshid $netId 00813 .cdgmain parses setSelection [.cdgmain parses addParsesOfNet $netId] 00814 00815 } 00816 00817 00818 }

XCDG 0.95 (20 Oct 2004)