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 ## CdgMenu - menu component of the XCDG application. 00013 ## 00014 ## \author Michael Daum (see also AUTHORS and THANKS for more) 00015 ## $Id: menu.tcl,v 1.33 2004/06/11 07:59:22 foth Exp $ 00016 ## ---------------------------------------------------------------------------- 00017 class CdgMenu { 00018 inherit ::itk::Widget 00019 00020 00021 # public 00022 public method init_data {} 00023 00024 constructor {args} {}; ## \type TclList 00025 00026 # private 00027 private method _setVerbosity {} 00028 private method _setFlag {name}; ## \type TclString 00029 private method _toggleSheets {} 00030 private method _toggleShell {} 00031 private method _load_dir_action {} 00032 private method _load_action {} 00033 private method _reload_action {} 00034 private method _run_action {} 00035 private method _reset_action {} 00036 private method _prefs_action {} 00037 private method _about_action {} 00038 private method _help_action {} 00039 00040 private variable _hintsFlag 1 00041 private variable _infosFlag 1 00042 private variable _warningsFlag 1 00043 private variable _evalFlag 1 00044 private variable _searchresultFlag 1 00045 private variable _profileFlag 0 00046 private variable _errorFlag 1 00047 private variable _debugFlag 0 00048 private variable _traceFlag 0 00049 private variable _sheetsFlag 1 00050 private variable _shellFlag 1 00051 private variable _agendaNormalizationFlag 0 00052 private variable _useCacheFlag 1 00053 private variable _searchModifiesNetFlag 1 00054 private variable _showDeletedFlag 0 00055 private variable _sloppySubsumesWarningsFlag 0 00056 private variable _statisticsFlag 0 00057 private variable _sortNodesFlag 0 00058 private variable _manyWindowsFlag 0 00059 private variable _confirmExitFlag 0 00060 }; 00061 00062 ## ---------------------------------------------------------------------------- 00063 ## constructor 00064 ## ---------------------------------------------------------------------------- 00065 body CdgMenu::constructor {args} { 00066 00067 itk_component add lmenu { 00068 frame $itk_interior.lmenu 00069 } {} 00070 00071 itk_component add rmenu { 00072 frame $itk_interior.rmenu 00073 } {} 00074 00075 # file menu 00076 itk_component add filebutton { 00077 menubutton $itk_component(lmenu).filebutton \ 00078 -text "File" \ 00079 -underline 0 \ 00080 -menu $itk_component(lmenu).filebutton.menu 00081 } { 00082 keep -background -cursor 00083 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00084 } 00085 00086 itk_component add filemenu { 00087 menu $itk_component(filebutton).menu 00088 } { 00089 keep -background -cursor 00090 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00091 } 00092 00093 $itk_component(filemenu) add command \ 00094 -label "Load ..." \ 00095 -underline 0 \ 00096 -command [code $this _load_action] 00097 $itk_component(filemenu) add command \ 00098 -label "Load dir ..." \ 00099 -underline 0 \ 00100 -command [code $this _load_dir_action] 00101 $itk_component(filemenu) add command \ 00102 -label "Reload" \ 00103 -underline 0 \ 00104 -command [code $this _reload_action] 00105 $itk_component(filemenu) add command \ 00106 -label "Run ..." \ 00107 -underline 0 \ 00108 -command [code $this _run_action] 00109 $itk_component(filemenu) add separator 00110 $itk_component(filemenu) add command \ 00111 -label "Preferences ..." \ 00112 -underline 0 \ 00113 -command [code $this _prefs_action] 00114 00115 $itk_component(filemenu) add separator 00116 $itk_component(filemenu) add command \ 00117 -label "Reset ..." \ 00118 -underline 0 \ 00119 -command [code $this _reset_action] 00120 $itk_component(filemenu) add command \ 00121 -label "Quit" \ 00122 -underline 0 \ 00123 -command cmd::Quit 00124 00125 # settings menu 00126 itk_component add settingsbutton { 00127 menubutton $itk_component(lmenu).settingsbutton \ 00128 -text "Settings" \ 00129 -underline 0 \ 00130 -menu $itk_component(lmenu).settingsbutton.menu 00131 } { 00132 keep -background -cursor 00133 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00134 } 00135 00136 itk_component add settingsmenu { 00137 menu $itk_component(settingsbutton).menu 00138 } { 00139 keep -background -cursor 00140 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00141 } 00142 00143 $itk_component(settingsmenu) add checkbutton \ 00144 -label "Cache Scores" \ 00145 -variable [scope _useCacheFlag] \ 00146 -command [code $this _setFlag useCache] 00147 $itk_component(settingsmenu) add checkbutton \ 00148 -label "Search modifies net" \ 00149 -variable [scope _searchModifiesNetFlag] \ 00150 -command [code $this _setFlag searchModifiesNet] 00151 $itk_component(settingsmenu) add checkbutton \ 00152 -label "Show deleted values" \ 00153 -variable [scope _showDeletedFlag] \ 00154 -command [code $this _setFlag showDeleted] 00155 $itk_component(settingsmenu) add checkbutton \ 00156 -label "Sloppy subsume warnings" \ 00157 -variable [scope _sloppySubsumesWarningsFlag] \ 00158 -command [code $this _setFlag sloppySubsumesWarnings] 00159 $itk_component(settingsmenu) add checkbutton \ 00160 -label "Compute statistics" \ 00161 -variable [scope _statisticsFlag] \ 00162 -command [code $this _setFlag statistics] 00163 $itk_component(settingsmenu) add checkbutton \ 00164 -label "Sort nodes" \ 00165 -variable [scope _sortNodesFlag] \ 00166 -command [code $this _setFlag sortNodes] 00167 $itk_component(settingsmenu) add checkbutton \ 00168 -label "Many parse windows" \ 00169 -variable [scope _manyWindowsFlag] \ 00170 -command [code $this _setFlag manyWindows] 00171 $itk_component(settingsmenu) add checkbutton \ 00172 -label "Confirm exit" \ 00173 -variable [scope _confirmExitFlag] \ 00174 -command [code $this _setFlag confirmExit] 00175 $itk_component(settingsmenu) add separator 00176 $itk_component(settingsmenu) add checkbutton \ 00177 -label "Hints" \ 00178 -variable "[scope _hintsFlag]" \ 00179 -command [code $this _setVerbosity] 00180 $itk_component(settingsmenu) add checkbutton \ 00181 -label "Infos" \ 00182 -variable "[scope _infosFlag]" \ 00183 -command [code $this _setVerbosity] 00184 $itk_component(settingsmenu) add checkbutton \ 00185 -label "Warnings" \ 00186 -variable "[scope _warningsFlag]" \ 00187 -command [code $this _setVerbosity] 00188 $itk_component(settingsmenu) add checkbutton \ 00189 -label "Debug" \ 00190 -variable "[scope _debugFlag]" \ 00191 -command [code $this _setVerbosity] 00192 $itk_component(settingsmenu) add checkbutton \ 00193 -label "Error" \ 00194 -variable "[scope _errorFlag]" \ 00195 -command [code $this _setVerbosity] 00196 $itk_component(settingsmenu) add checkbutton \ 00197 -label "Trace" \ 00198 -variable "[scope _traceFlag]" \ 00199 -command [code $this _setFlag trace] 00200 $itk_component(settingsmenu) add checkbutton \ 00201 -label "Profile" \ 00202 -variable "[scope _profileFlag]" \ 00203 -command [code $this _setVerbosity] 00204 $itk_component(settingsmenu) add checkbutton \ 00205 -label "Eval" \ 00206 -variable "[scope _evalFlag]" \ 00207 -command [code $this _setVerbosity] 00208 $itk_component(settingsmenu) add checkbutton \ 00209 -label "Searchresults" \ 00210 -variable "[scope _searchresultFlag]" \ 00211 -command [code $this _setVerbosity] 00212 00213 # Windows 00214 itk_component add windowbutton { 00215 menubutton $itk_component(lmenu).windowbutton \ 00216 -text "Window" \ 00217 -underline 0 \ 00218 -menu $itk_component(lmenu).windowbutton.menu 00219 } { 00220 keep -background -cursor 00221 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00222 } 00223 00224 itk_component add windowmenu { 00225 menu $itk_component(windowbutton).menu 00226 } { 00227 keep -background -cursor 00228 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00229 } 00230 00231 $itk_component(windowmenu) add checkbutton \ 00232 -label "Datasheets" \ 00233 -variable "[scope _sheetsFlag]" \ 00234 -command [code $this _toggleSheets] 00235 $itk_component(windowmenu) add checkbutton \ 00236 -label "Shell" \ 00237 -variable "[scope _shellFlag]" \ 00238 -command [code $this _toggleShell] 00239 00240 # help menu 00241 itk_component add helpbutton { 00242 menubutton $itk_component(rmenu).helpbutton \ 00243 -text "Help" \ 00244 -underline 0 \ 00245 -menu $itk_component(rmenu).helpbutton.menu 00246 } { 00247 keep -background -cursor 00248 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00249 } 00250 00251 itk_component add helpmenu { 00252 menu $itk_component(helpbutton).menu 00253 } { 00254 keep -background -cursor 00255 rename -borderwidth -menuborderwidth menuBorderwidth Borderwidth 00256 } 00257 00258 $itk_component(helpmenu) add command \ 00259 -label "About" \ 00260 -command [code $this _about_action] 00261 $itk_component(helpmenu) add command \ 00262 -label "Help" \ 00263 -command [code $this _help_action] 00264 00265 # register the helpmessages 00266 .cdgmain help sethelpstr \ 00267 $itk_component(filemenu)\ 0 \ 00268 "Load a cdg-file." \ 00269 $itk_component(filemenu)\ 1 \ 00270 "Execute a cdg-command-file" \ 00271 $itk_component(filemenu)\ 3 \ 00272 "Change general preferences" \ 00273 $itk_component(filemenu)\ 5 \ 00274 "Reset the application." \ 00275 $itk_component(filemenu)\ 6 \ 00276 "Terminate the application." \ 00277 $itk_component(settingsmenu)\ 0 \ 00278 "Toggle the use of the score cache of binary evaluations" \ 00279 $itk_component(settingsmenu)\ 1 \ 00280 "Nodevalues of the net are adjusted after a netsearch." \ 00281 $itk_component(settingsmenu)\ 2 \ 00282 "Show or don`t show deleted nodevalues when displaying a net." \ 00283 $itk_component(settingsmenu)\ 3 \ 00284 "Suppress warnings due to sloppy grammar writing." \ 00285 $itk_component(settingsmenu)\ 4 \ 00286 "Compute statistics when applying net-algorithms." \ 00287 $itk_component(settingsmenu)\ 5 \ 00288 "Toggle sorting of constraint nodes after they've been built." \ 00289 $itk_component(settingsmenu)\ 7 \ 00290 "Toggle display of HINTS." \ 00291 $itk_component(settingsmenu)\ 8 \ 00292 "Toggle display of INFOS." \ 00293 $itk_component(settingsmenu)\ 9 \ 00294 "Toggle display of WARNINGS." \ 00295 $itk_component(settingsmenu)\ 10 \ 00296 "Toggle display of DEBUGS." \ 00297 $itk_component(settingsmenu)\ 11 \ 00298 "Toggle display ERRORS." \ 00299 $itk_component(settingsmenu)\ 12 \ 00300 "Toggle display of error-traces in the shell." \ 00301 $itk_component(settingsmenu)\ 13 \ 00302 "Toggle display of profiling information." \ 00303 $itk_component(settingsmenu)\ 14 \ 00304 "Toggle display of evaluation process." \ 00305 $itk_component(settingsmenu)\ 15 \ 00306 "Toggle display of results in the log-window after\ 00307 applying a net-algorithm."\ 00308 $itk_component(helpmenu)\ 1 \ 00309 "Show general information on xcdg" \ 00310 $itk_component(helpmenu)\ 2 \ 00311 "Onlinehelp" 00312 00313 pack $itk_component(lmenu) \ 00314 $itk_component(rmenu) -side left -expand 1 -fill x 00315 pack $itk_component(filebutton) \ 00316 $itk_component(settingsbutton) \ 00317 $itk_component(windowbutton) -side left -padx 5 -pady 5 00318 pack $itk_component(helpbutton) -side right -padx 5 -pady 5 00319 00320 eval itk_initialize $args 00321 00322 init_data 00323 } 00324 00325 ## ---------------------------------------------------------------------------- 00326 ## initialize the verbosity flags 00327 ## ---------------------------------------------------------------------------- 00328 body CdgMenu::init_data {} { 00329 global CDG_HINT CDG_INFO CDG_WARNING CDG_EVAL CDG_SEARCHRESULT 00330 global CDG_PROFILE CDG_ERROR CDG_DEBUG 00331 global cnSortNodesMethod 00332 00333 set verbosity [hkVerbosity_get] 00334 00335 set _hintsFlag [expr ($verbosity & $CDG_HINT) > 0] 00336 set _infosFlag [expr ($verbosity & $CDG_INFO) > 0] 00337 set _warningsFlag [expr ($verbosity & $CDG_WARNING) > 0] 00338 set _evalFlag [expr ($verbosity & $CDG_EVAL) > 0] 00339 set _searchresultFlag [expr ($verbosity & $CDG_SEARCHRESULT) > 0] 00340 set _profileFlag [expr ($verbosity & $CDG_PROFILE) > 0] 00341 set _debugFlag [expr ($verbosity & $CDG_DEBUG) > 0] 00342 set _errorFlag [expr ($verbosity & $CDG_ERROR) > 0] 00343 set _traceFlag [.cdgmain shell cget -showTrace] 00344 set _sheetsFlag 1 00345 set _shellFlag 1 00346 set _useCacheFlag [scUseCache_get] 00347 set _searchModifiesNetFlag [nsSearchModifiesNetFlag_get] 00348 set _showDeletedFlag [cnShowDeletedFlag_get] 00349 set _sloppySubsumesWarningsFlag [evalSloppySubsumesWarnings_get] 00350 set _statisticsFlag [statUseStatisticsFlag_get] 00351 set _sortNodesFlag $cnSortNodesMethod 00352 set _manyWindowsFlag 1 00353 set _confirmExitFlag 1 00354 00355 return $verbosity 00356 } 00357 00358 ## ---------------------------------------------------------------------------- 00359 ## set the named flag according to our local variables 00360 ## ---------------------------------------------------------------------------- 00361 body CdgMenu::_setFlag {name} { 00362 00363 switch $name { 00364 "agendaNormalization" { 00365 ::cmd::Set normalizeAgenda $_agendaNormalizationFlag 00366 } 00367 "useCache" { 00368 ::cmd::Set cache $_useCacheFlag 00369 } 00370 "searchModifiesNet" { 00371 ::cmd::Set searchmodifiesnet $_searchModifiesNetFlag 00372 } 00373 "showDeleted" { 00374 ::cmd::Set showdeleted $_showDeletedFlag 00375 } 00376 "sloppySubsumesWarnings" { 00377 ::cmd::Set subsumesWarnings $_sloppySubsumesWarningsFlag 00378 } 00379 "sortNodes" { 00380 ::cmd::Set sortnodes $_sortNodesFlag 00381 } 00382 "manyWindows" { 00383 .cdgmain parses setManyWindows $_manyWindowsFlag 00384 } 00385 "confirmExit" { 00386 ::cmd::Set confirmexit $_confirmExitFlag 00387 } 00388 "trace" { 00389 ::cmd::Set trace $_traceFlag 00390 } 00391 default { 00392 error "unknown flag $name" 00393 } 00394 } 00395 } 00396 00397 ## ---------------------------------------------------------------------------- 00398 ## set the verbosity according to our local variables 00399 ## ---------------------------------------------------------------------------- 00400 body CdgMenu::_setVerbosity {} { 00401 global CDG_HINT CDG_INFO CDG_WARNING CDG_EVAL CDG_SEARCHRESULT 00402 global CDG_PROFILE CDG_ERROR CDG_DEBUG CDG_DEFAULT 00403 hkVerbosity_set [expr $_hintsFlag * $CDG_HINT + \ 00404 $_infosFlag * $CDG_INFO + \ 00405 $_warningsFlag * $CDG_WARNING + \ 00406 $_evalFlag * $CDG_EVAL + \ 00407 $_searchresultFlag * $CDG_SEARCHRESULT + \ 00408 $_profileFlag * $CDG_PROFILE + \ 00409 $_debugFlag * $CDG_DEBUG + \ 00410 $_errorFlag * $CDG_ERROR + \ 00411 $CDG_DEFAULT] 00412 } 00413 00414 ## ---------------------------------------------------------------------------- 00415 ## delegate command to CdgMain 00416 ## ---------------------------------------------------------------------------- 00417 body CdgMenu::_load_action {} { 00418 .cdgmain files load 00419 } 00420 00421 ## ---------------------------------------------------------------------------- 00422 ## open a directory selection dialog. 00423 ## ---------------------------------------------------------------------------- 00424 body CdgMenu::_load_dir_action {} { 00425 .cdgmain files load_dir 00426 } 00427 00428 ## ---------------------------------------------------------------------------- 00429 ## delegate command to CdgMain 00430 ## ---------------------------------------------------------------------------- 00431 body CdgMenu::_reload_action {} { 00432 .cdgmain files reload 00433 } 00434 00435 ## ---------------------------------------------------------------------------- 00436 ## reset application 00437 ## ---------------------------------------------------------------------------- 00438 body CdgMenu::_reset_action {} { 00439 ::cmd::Reset 00440 } 00441 00442 ## ---------------------------------------------------------------------------- 00443 ## load a script and execute it 00444 ## ---------------------------------------------------------------------------- 00445 body CdgMenu::_run_action {} { 00446 set types { 00447 {"CDG scripts" {.run .scr .cdg}} 00448 {"CDG files" {.cdg m4} } 00449 {"All files" * } 00450 } 00451 set filename [tk_getOpenFile -filetypes $types -parent .] 00452 if {$filename == ""} { return } 00453 00454 .cdgmain shell safeSource $filename 00455 } 00456 00457 ## ---------------------------------------------------------------------------- 00458 ## delegate command to CdgMain 00459 ## ---------------------------------------------------------------------------- 00460 body CdgMenu::_prefs_action {} { 00461 .cdgmain prefs activate 00462 } 00463 00464 ## ---------------------------------------------------------------------------- 00465 ## startup the about-dialog 00466 ## ---------------------------------------------------------------------------- 00467 body CdgMenu::_about_action {} { 00468 .cdgmain confirm \ 00469 "\[X\]CDG parser, Copyright (C) 1997-2004 The CDG Team 00470 00471 The CDG parser comes with ABSOLUTELY NO WARRANTY. 00472 This is free software, and you are welcome to redistribute it 00473 under certain conditions; type `license' for details." 00474 00475 } 00476 00477 ## ---------------------------------------------------------------------------- 00478 ## startup the help 00479 ## ---------------------------------------------------------------------------- 00480 body CdgMenu::_help_action {} { 00481 .cdgmain confirm "Help is available under cdg/doc/ ." 00482 } 00483 00484 ## ---------------------------------------------------------------------------- 00485 ## show/hide data-sheets 00486 ## ---------------------------------------------------------------------------- 00487 body CdgMenu::_toggleSheets {} { 00488 set pane [.cdgmain component pane] 00489 if {$_sheetsFlag == 0} { 00490 if {$_shellFlag == 0} { 00491 set _sheetsFlag 1 00492 return 00493 } 00494 $pane hide 0 00495 } else { 00496 $pane show 0 00497 $pane fraction 70 30 00498 update idletask 00499 .cdgmain shell see end 00500 } 00501 } 00502 00503 ## ---------------------------------------------------------------------------- 00504 ## show/hide shell 00505 ## ---------------------------------------------------------------------------- 00506 body CdgMenu::_toggleShell {} { 00507 set pane [.cdgmain component pane] 00508 if {$_shellFlag == 0} { 00509 if {$_sheetsFlag == 0} { 00510 set _shellFlag 1 00511 return 00512 } 00513 $pane hide 1 00514 } else { 00515 $pane show 1 00516 $pane fraction 70 30 00517 update idletask 00518 .cdgmain shell see end 00519 } 00520 }