1# Copyright (C) 1987-2015 by Jeffery P. Hansen 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 16# 17# Last edit by hansen on Sat Jan 31 08:14:59 2009 18# 19 20############################################################################# 21# 22# This file contains tcl scripts for creating and managing menus (except 23# popup menus). 24# 25# Menu states: 26# edit Normal edit mode is active 27# interface-all Top-level interface screen 28# interface-block Interface editor on a normal block is active 29# interface-symbol Interface editor on a symbol block is active 30# simulate Simulator is active 31# 32# Special Flags: 33# D Create only if debug mode is active 34# X If mode guard failed, do not create entry 35# 36# Base Flags: 37# C Active only if cutable object is selected 38# P Active only if pasteable object in cut buffer 39# U Active only if undoable actions exist 40# R Active only if redoable actions exist 41# b Symbol bitmap operations are active 42# p Symbol port operations are active 43# 44# 45namespace eval Menu { 46 variable accelTable 47 variable state edit 48 variable menuId 49 variable flags 50 array set flags {D 0 C 0 P 0 U 0 R 0 X 0} 51 52 variable baseFlags {C P R U b p} 53 variable baseFlagEntries 54 55 variable editorMenus {file edit tool simulate format module make help} 56 variable scopeMenus {scope_file scope_sim scope_trace scope_help} 57 58 # Name func. Flags Mode 59 variable menuButtonData { 60 {file - - *} 61 {edit - - *} 62 {tool - - {edit interface-*}} 63 {simulate - - {simulate}} 64 {module - - *} 65 {format - - edit} 66 {make gat_makeMakeMenu - edit} 67 {help - - *} 68 {scope_file - - *} 69 {scope_sim - - *} 70 {scope_trace - - *} 71 {scope_help - - *} 72 } 73 74 75 # 76 # This table contains information about all menu data. The entry names should have 77 # the form "name.ent" where "name" defines which menu it should belong to. The text 78 # for the menu is taken from the message "menu.name.ent" (e.g., for "file.new", the 79 # message tag will be "menu.file.new") 80 # 81 # Entry Name Action Image Sel. Image Var. Flags Mode 82 variable menuEntryData { 83 {file.new newFile file_new - - - *} 84 {file.open loadFile file_open - - - *} 85 {file.save saveFile file_save - - - *} 86 {file.saveas saveAsFile file_saveas - - - *} 87 {file.separator - - - - - *} 88 {file.print print file_print - - - *} 89 {file.separator - - - - - *} 90 {file.openlib loadLibrary file_lib - - - *} 91 {file.cprop editCProps i_circprops - - - *} 92 {file.separator - - - - X interface-symbol} 93 {file.import importImage symed_import - - X interface-symbol} 94 {file.export exportImage symed_export - - X interface-symbol} 95 {file.separator - - - - - *} 96 {file.quit exit emptytool - - - *} 97 98 {edit.undo undo back - - U {edit interface-*}} 99 {edit.redo redo forward - - R {edit interface-*}} 100 {edit.separator - - - - X {edit interface-symbol}} 101 {edit.cut cutToBuf edit_cut - - XC {edit}} 102 {edit.copy copyToBuf edit_copy - - XC {edit}} 103 {edit.paste yankFromBuf edit_paste - - XP {edit}} 104 {edit.cut seCutToBuf edit_cut - - XC {interface-symbol}} 105 {edit.copy seCopyToBuf edit_copy - - XC {interface-symbol}} 106 {edit.paste seYankFromBuf edit_paste - - XP {interface-symbol}} 107 {edit.overlay seOverlayFromBuf edit_overlay - - XP {interface-symbol}} 108 {edit.selall selectAll emptytool - - X edit} 109 {edit.find findObject edit_find - - X {edit simulate}} 110 111 {edit.separator - - - - X {edit simulate}} 112 {edit.zoomin zoomIn zoom_in - - X {edit simulate}} 113 {edit.zoomout zoomOut zoom_out - - X {edit simulate}} 114 {edit.separator - - - - X interface-symbol} 115 {edit.zoomin seZoomIn zoom_in - - X interface-symbol} 116 {edit.zoomout seZoomOut zoom_out - - X interface-symbol} 117 118 {edit.separator - - - - X interface-symbol} 119 {edit.rshift seRShiftBits arrow0 - - X interface-symbol} 120 {edit.lshift seLShiftBits arrow180 - - X interface-symbol} 121 {edit.ushift seUShiftBits arrow90 - - X interface-symbol} 122 {edit.dshift seDShiftBits arrow270 - - X interface-symbol} 123 {edit.cwrotate seCWRotate symed_cwrotate - - X interface-symbol} 124 {edit.ccwrotate seCCWRotate symed_ccwrotate - - X interface-symbol} 125 126 {edit.separator - - - - X interface-symbol} 127 {edit.pcwrotate seCWRotPort symed_pcrot - - X interface-symbol} 128 {edit.pccwrotate seCCWRotPort symed_pccrot - - X interface-symbol} 129 130 {edit.separator - - - - X interface-symbol} 131 {edit.autobold seBoldBits symed_autobold - - X interface-symbol} 132 133 {tool.move editMode mov_curs mov_curs_S mode=1 X {edit interface-all interface-block}} 134 {tool.cutw cutMode cut_curs cut_curs_S mode=0 X {edit interface-all interface-block}} 135 {tool.inv invertMode inv_curs inv_curs_S mode=2 X edit} 136 {tool.bitw sizeMode size_curs size_curs_S mode=9 X {edit interface-all interface-block}} 137 {tool.debug debugMode bug_curs bug_curs_S mode=12 XD edit} 138 139 {tool.point null symed_point symed_point_S SymbolEdit::emode=point X interface-symbol} 140 {tool.line null symed_line symed_line_S SymbolEdit::emode=line X interface-symbol} 141 {tool.rect null symed_rect symed_rect_S SymbolEdit::emode=rect X interface-symbol} 142 {tool.fillrect null symed_fillrect symed_fillrect_S SymbolEdit::emode=fillrect X interface-symbol} 143 {tool.port null symed_port symed_port_S SymbolEdit::emode=port X interface-symbol} 144 {tool.select null symed_select symed_select_S SymbolEdit::emode=select X interface-symbol} 145 146 147 {tool.separator - - - - X edit} 148 {tool.rep replicate replicate - - - *} 149 150 {tool.separator - - - - - *} 151 {tool.options editOptions emptytool - - - *} 152 {tool.tclshell shellWindow emptytool - - D *} 153 154 {simulate.begin startSimulator simstart - - X {edit interface-*}} 155 {simulate.end endSimulator simstart - - X simulate} 156 {simulate.separator - - - - X simulate} 157 {simulate.run simRun sim_go - - X simulate} 158 {simulate.pause simStop sim_stop - - X simulate} 159 {simulate.step simStep sim_step - - X simulate} 160 {simulate.cycle simCycleOrRotate sim_clock - - X simulate} 161 {simulate.break editBreakpoints sim_break - - X simulate} 162 {simulate.script doSimScript sim_script - - X simulate} 163 {simulate.separator - - - - X simulate} 164 {simulate.load simLoadMem sim_load - - X simulate} 165 {simulate.dump simDumpMem sim_dump - - X simulate} 166 {simulate.view simViewMem sim_view - - X simulate} 167 {simulate.separator - - - - X simulate} 168 {simulate.addprobe toggleProbe emptytool - - X simulate} 169 170 {module.open openMod blk_open - - - *} 171 {module.close closeMod blk_close - - - *} 172 {module.separator - - - - X edit} 173 {module.interface -cascade editintr - - X edit} 174 {module.interface.edit editBlockDesc - - - - *} 175 {module.interface.set setBlockDesc - - - - *} 176 {module.interface.update updateInterface - - - - *} 177 {module.interface.updateall updateAllInterface - - - - *} 178 {module.interface.auto autoGenerateCanvas - - - - *} 179 180 {module.separator - - - - X {edit interface-*}} 181 {module.new blockNew blk_new - - X {edit interface-*}} 182 {module.del blockDelete blk_delete - - X {edit interface-*}} 183 {module.copy blockCopy blk_copy - - X {edit interface-*}} 184 {module.rename blockRename blk_rename - - X {edit interface-*}} 185 {module.claim blockClaim blk_claim - - X {edit interface-*}} 186 {module.setroot blockSetRoot blk_root - - X {edit interface-*}} 187 {module.prop blockProp i_modprops - - X {edit interface-*}} 188 189 {format.addport addPort addport - - - *} 190 {format.separator - - - - - *} 191 {format.anchor anchor anchor - - - *} 192 {format.unanchor unAnchor unanchor - - - *} 193 {format.separator - - - - X edit} 194 {format.algnv vAlign edit_valgn - - X edit} 195 {format.algnh hAlign edit_halgn - - X edit} 196 {format.separator - - - - - *} 197 {format.settech -cascade emptytool - - - *} 198 {format.rot -cascade rotation0 - - X edit} 199 {format.rot.0 rot0 rotation0 rotation0_S rot=0 X edit} 200 {format.rot.90 rot90 rotation90 rotation90_S rot=1 X edit} 201 {format.rot.180 rot180 rotation180 rotation180_S rot=2 X edit} 202 {format.rot.270 rot270 rotation270 rotation270_S rot=3 X edit} 203 {format.rot.separator -separator - - - - edit} 204 {format.rot.rotate simCycleOrRotate edit_rotate - - X edit} 205 {format.rot.brotate backRotate edit_brotate - - X edit} 206 {format.prop editProps i_gateprops - - - *} 207 208 {help.about showAbout about - - - *} 209 {help.license showLicense gnuhead - - - *} 210 {help.doc showDocumentation helpdoc - - - *} 211 {help.separator - - - - - *} 212 {help.home loadWelcome helpdoc - - - edit} 213 {help.tut loadTutorial helpdoc - - - edit} 214 {help.example loadExample helpdoc - - - edit} 215 216 {scope_file.ptrace printTrace file_print - - - *} 217 {scope_file.close endSimulator simstart - - - *} 218 219 {scope_sim.run simRun sim_go - - - *} 220 {scope_sim.pause simStop sim_stop - - - *} 221 {scope_sim.step simStep sim_step - - - *} 222 {scope_sim.cycle simCycleOrRotate sim_clock - - - *} 223 {scope_sim.break editBreakpoints sim_break - - - *} 224 {scope_sim.script doSimScript sim_script - - - *} 225 {scope_sim.separator - - - - - *} 226 {scope_sim.load simLoadMem sim_load - - - *} 227 {scope_sim.dump simDumpMem sim_dump - - - *} 228 {scope_sim.separator - - - - - *} 229 {scope_sim.addprobe toggleProbe emptytool - - - *} 230 231 {scope_trace.zoomin scopeZoomIn zoom_in - - - *} 232 {scope_trace.zoomout scopeZoomOut zoom_out - - - *} 233 234 {scope_help.about showAbout about - - - *} 235 {scope_help.license showLicense gnuhead - - - *} 236 {scope_help.doc showDocumentation helpdoc - - - *} 237 } 238 239 proc menuEntry {m cLabel args} { 240 global menuCommandTable 241 variable accelTable 242 243 set command "" 244 set radio 0 245 set state normal 246 set variable "" 247 set value "" 248 set image "" 249 set selectimage "" 250 set menu "" 251 parseargs $args {-command -state -variable -value -radio -image -selectimage -menu} 252 253 parseName $cLabel label underline 254 255 set accelerator "" 256 if {[info exists accelTable($command)]} { 257 set accelerator $accelTable($command) 258 } 259 260 set index "" 261 262 # 263 # The -image, -selectimage and -compound options are not supported before Tk 8.4, so 264 # we must check for an error and be ready to generate menu entries without symbols. 265 # 266 if {$menu != ""} { 267 safeeval $::menu_forbidden $m add cascade -label $label -underline $underline -menu $menu \ 268 -state $state -image $image -compound left 269 set index [$m index end] 270 } elseif {$radio} { 271 if { $image != "" } { 272 safeeval $::menu_forbidden $m add radiobutton -label $label -underline $underline -command $command \ 273 -state $state -variable $variable -value $value \ 274 -image $image -selectimage $selectimage -compound left -indicatoron 0 -accelerator $accelerator 275 set index [$m index end] 276 } else { 277 $m add radiobutton -label $label -underline $underline -command $command \ 278 -state $state -variable $variable -value $value -accelerator $accelerator 279 set index [$m index end] 280 } 281 } else { 282 safeeval $::menu_forbidden $m add command -label $label -underline $underline -command $command \ 283 -state $state -image $image -compound left -accelerator $accelerator 284 set index [$m index end] 285 } 286 287 # 288 # This is a kludge to exclude popup menus. 289 # 290 if {! [string match ".pop_*" $m ] } { 291 set idx [$m index end] 292 lappend menuCommandTable($command) ${idx}:$m 293 } 294 295 return $index 296 } 297 298 proc parseName {cName _name _ul} { 299 upvar $_name name 300 upvar $_ul ul 301 302 set name "" 303 set ul -1 304 if { [scan $cName "%d:%\[^\n\]" ul name] != 2 } { 305 set name $cName 306 } 307 } 308 309 ############################################################################# 310 # 311 # Rebuild the menus for $tag. 312 # 313 proc rebuildMenu {tag} { 314 variable menuId 315 316 foreach m $menuId($tag) { 317 if {$tag == "make"} continue 318 $m delete 0 end 319 foreach sm [winfo children $m] { 320 $sm delete 0 end 321 } 322 makeMenu $m $tag 323 } 324 } 325 326 proc rebuildAll {} { 327 variable menuButtonData 328 variable menuId 329 variable state 330 variable baseFlags 331 variable baseFlagEntries 332 333 # 334 # Clear the base flags 335 # 336 foreach f $baseFlags { 337 set baseFlagEntries($f) {} 338 } 339 340 foreach b $menuButtonData { 341 set name [lindex $b 0] 342 set func [lindex $b 1] 343 set flags [lindex $b 2] 344 set gstate [lindex $b 3] 345 346 set itemstate disabled 347 foreach x $gstate { 348 if {[string match $x $state]} { 349 set itemstate normal 350 } 351 } 352 353 foreach m $menuId($name) { 354 catch { [winfo parent $m] configure -state $itemstate } 355 } 356 357 if {$itemstate == "normal" } { 358 catch { rebuildMenu $name } 359 } 360 } 361 } 362 363 364 365 ############################################################################# 366 # 367 # Make the menu for $tag in the menu $w 368 # 369 proc makeMenu {m tag} { 370 variable menuEntryData 371 variable menuButtonData 372 variable menuId 373 variable flags 374 variable state 375 variable baseFlags 376 variable baseFlagEntries 377 378 # 379 # Register the menu. 380 # 381 if {![info exists menuId($tag)]} {set menuId($tag) {}} 382 if {[lsearch $menuId($tag) $m] < 0} { 383 lappend menuId($tag) $m 384 } 385 386 # 387 # If a custom creation function is specified, use that function and return. 388 # 389 set button [assocg $tag $menuButtonData] 390 if {[lindex $button 1] != "-"} { 391 [lindex $button 1] $m 392 return 393 } 394 395 # 396 # Create the menu entries 397 # 398 foreach entry $menuEntryData { 399 set name "" 400 set action "" 401 set image "" 402 set simage "" 403 set varval "" 404 lscan $entry name action image simage varval gflags gstate 405 406 # 407 # Seprate name into chars before last "." and chars after last "." 408 # 409 set lname [string map {. " "} $name] 410 set mname [lindex $lname 0] 411 set ename [lindex $lname 1] 412 413 if {$mname != $tag } continue 414 415 # 416 # Check to see if we are disabled due to a guarded state 417 # 418 set itemstate disabled 419 foreach x $gstate { 420 if {[string match $x $state]} { 421 set itemstate normal 422 } 423 } 424 425 # 426 # If we are disabled due to a guarded state and the X flag is set, then ignore this entry. 427 # 428 if {[string first "X" $gflags] >= 0 && $itemstate != "normal"} { 429 continue 430 } 431 432 # 433 # If debug flag is required, but not set, then ignore this entry 434 # 435 if {[string first "D" $gflags] >= 0 && !$flags(D)} { 436 continue 437 } 438 439 # 440 # Test other regular flags. Set item to disabled if the test fails. 441 # 442 foreach f $baseFlags { 443 if {[info exists flags($f)] && !$flags($f) } { 444 if {[string first $f $gflags] >= 0 } { 445 set itemstate disabled 446 } 447 } 448 } 449 450 if {$image != "" && $image != "-"} { set image [gifI $image.gif]} { set image "" } 451 if {$simage != "" && $simage != "-"} { set simage [gifI $simage.gif]} { set simage "" } 452 453 set index "" 454 455 if {[llength $lname] > 2} { 456 set subm [string map {" " .} [lrange $lname 1 [expr [llength $lname]-2]]] 457 set em $m.$subm 458 set lname {} 459 } else { 460 set em $m 461 } 462 463 catch { menu $em } 464 if { $ename == "separator" || $action == "-separator"} { 465 # This is a spearator entry 466 $em add separator 467 set index [$em index last] 468 } elseif { $action == "-cascade" } { 469 # This is an cascade parent 470 set submenu $em.$ename 471 catch { menu $em.$ename -tearoff 0} 472 set index [menuEntry $em [m menu.$name] -menu $submenu -image $image -state $itemstate] 473 } elseif { $varval != "-"} { 474 set var "" 475 set val "" 476 scan $varval "%\[^=\]=%s" var val 477 set index [menuEntry $em [m menu.$name] -command Action::$action -radio 1 \ 478 -variable $var -value $val -image $image -selectimage $simage -state $itemstate] 479 } else { 480 # This is a normal command entry 481 set index [menuEntry $em [m menu.$name] -command Action::$action -image $image -state $itemstate] 482 } 483 484 # 485 # Record menu entries that use 486 # 487 for {set i 0} {$i < [string length $gflags] } { incr i } { 488 set f [string index $gflags $i] 489 if {[string is alnum $f] && [lsearch $baseFlags $f] >= 0 } { 490 if {![info exists baseFlagEntries($f)] || [lsearch $baseFlagEntries($f) [list $em $index] ] < 0 } { 491 lappend baseFlagEntries($f) [list $em $index] 492 } 493 } 494 } 495 496 } 497 } 498 499 500 ###################################################################### 501 # 502 # This procedure builds the actual menu bar. It is assumed that the frame 503 # for the menu bar has already been created. 504 # 505 proc makeBar {w type} { 506 variable menuButtonData 507 variable menuEntryData 508 variable menuId 509 variable baseFlags 510 variable baseFlagEntries 511 variable editorMenus 512 variable scopeMenus 513 514 switch $type { 515 editor { set menuList $editorMenus } 516 scope { set menuList $scopeMenus } 517 } 518 519 # 520 # Clear the base flags 521 # 522 foreach f $baseFlags { 523 set baseFlagEntries($f) {} 524 } 525 526 frame $w -takefocus 1 527 528 # 529 # Initialize menuId for all buttons if necessary 530 # 531 foreach button $menuButtonData { 532 set name [lindex $button 0] 533 534 if {![info exists menuId($name)]} { 535 set menuId($name) {} 536 } 537 } 538 539 # 540 # Create the menu buttons 541 # 542 foreach button $menuList { 543 set data [assocg $button $menuButtonData] 544 set name [lindex $data 0] 545 set func [lindex $data 1] 546 547 parseName [m menu.$name] label ul 548 menubutton $w.$name -text $label -underline $ul -menu $w.$name.menu 549 pack $w.$name -in $w -side left 550 551 makeMenu $w.$name.menu $name 552 } 553 554# bind $w <FocusIn> { puts FocusIn } 555# bind $w <FocusOut> { puts FocusOut } 556 } 557 558 ############################################################################# 559 # 560 # Register a key sequence with a command. 561 # 562 # Parameters: 563 # cmd Name of command to register. 564 # keyseq Key sequenc corresponding to a command. 565 # 566 proc setAccelerator {cmd keyseq} { 567 variable accelTable 568 569 set accelTable($cmd) $keyseq 570 } 571 572 ############################################################################# 573 # 574 # Set or clear flags that can control menu appearance 575 # 576 proc setFlags args { 577 variable flags 578 variable baseFlags 579 variable baseFlagEntries 580 581 set state 1 582 set estate "normal" 583 set rebuild 0 584 585 foreach f $args { 586 if {$f == "-clear"} { 587 set state 0 588 set itemstate disabled 589 } elseif {$f == "-set"} { 590 set state 1 591 set itemstate normal 592 } elseif {[lsearch $baseFlags $f] >= 0 } { 593 if { $flags($f) == $state } continue 594 set flags($f) $state 595 596 foreach p $baseFlagEntries($f) { 597 [lindex $p 0] entryconfigure [lindex $p 1] -state $itemstate 598 } 599 } else { 600 if { $flags($f) == $state } continue 601 set flags($f) $state 602 set rebuild 1 603 } 604 } 605 606 if {$rebuild} { 607 rebuildAll 608 } 609 } 610 611 ############################################################################# 612 # 613 # Inform the menu manager of the current tkgate mode. 614 # 615 proc setState {s} { 616 variable state 617 618 if {$s == $state } return 619 620 set state $s 621 rebuildAll 622 } 623} 624
