1#!/bin/sh 2# -*- tcl -*- \ 3exec tclsh "$0" ${1+"$@"} 4 5 6package require Tcl 8.6 7package require Tk 8 9package require TclOO 10 11## -- 12## Extend auto_path so package require will find the menubar package 13## in the tklib directory hierarchy. 14set selfdir [file dirname [file normalize [info script]]] 15set modules [file join [file dirname [file dirname $selfdir]] modules] 16lappend auto_path [file join ${modules} menubar] 17 18package require menubar 19 20# uncomment the following line to enable the debugging menu 21# package require menubar::debug 22 23package provide AppMain 0.5 24 25# -- 26# 27namespace eval Main { 28 29 variable wid 30 variable mbar 31 variable wid 32 33 proc main { } { 34 variable mbar 35 variable wid 36 set wid 0 37 38 wm withdraw . 39 40 ## 41 ## Create a menu bar definition 42 ## 43 44 # create an instance of the menubar class 45 set mbar [menubar new \ 46 -borderwidth 4 \ 47 -relief groove \ 48 -foreground black \ 49 -background tan \ 50 -cursor dot \ 51 -activebackground red \ 52 -activeforeground white \ 53 ] 54 55 # define the menu tree for the instance 56 ${mbar} define { 57 File M:file { 58 # Label Type Tag Name(s) 59 # ----------------- ---- --------- 60 "New Window" C new 61 -- S s0 62 "Show Macros Menu" C mshow 63 "Hide Macros Menu" C mhide 64 "Toggle Paste State" C paste_state 65 -- S s1 66 Close C close 67 -- S s2 68 Exit C exit 69 } 70 Edit M:items+ { 71 # Label Type Tag Name(s) 72 # ----------------- ---- --------- 73 "Cut" C cut 74 "Copy" C copy 75 "Paste" C paste 76 "Scope (buttons)" S s3 77 "Global" M:opts+ { 78 "CheckButtons" S s4 79 Apple X apple+ 80 Bread X bread 81 Coffee X coffee 82 Donut X donut+ 83 "RadioButtons" S s5 84 "Red" R color 85 "Green" R color+ 86 "Blue" R color 87 "~!@#%^&*()_+{}: <>?`-=;',./" R color 88 } 89 "Local" M:opts2 { 90 "Default" M:local1+ { 91 "CheckButtons" S s6 92 Square X@ square 93 Triangle X@ triangle+ 94 rectangle X@ rectangle 95 "RadioButtons" S s7 96 "Magenta" R@ ryb+ 97 "Yellow" R@ ryb 98 "Cyan" R@ ryb 99 } 100 "Notebook Tab" M:local2+ { 101 "CheckButtons" S s8 102 Right X= right 103 Left X= left+ 104 Top X= top 105 "RadioButtons" S s9 106 "North" R= compass+ 107 "South" R= compass 108 "East" R= compass 109 } 110 } 111 } 112 Macros M:macros+ { 113 # Label Type Tag Name(s) 114 # ----------------- ---- --------- 115 "Add Item" C item_add 116 "Delete Item" C item_delete 117 "Add MARK Item" C mark_add 118 "Move MARK Up" C mark_up 119 "Move MARK Down" C mark_down 120 "Delete MARK" C mark_del 121 "Macros" C macro_entries 122 "Save Macros" C serialize 123 "Restore Macros" C deserialize 124 --COMMANDGROUP-- G macro 125 } 126 Debug M:debug { 127 # Label Type Tag Name(s) 128 # ----------------- ---- --------- 129 "Test tag.cget" C testcget 130 "Debug Tree" C debug_tree 131 "Debug Nodes" C debug_nodes 132 "Debug Installs" C debug_installs 133 "Debug notebook" C debug_notebook 134 "ptree" C ptree 135 "pnodes" C pnodes 136 "pkeys" C pkeys 137 } 138 Help M:help { 139 # Label Type Tag Name(s) 140 # ----------------- ---- --------- 141 About C about 142 -- S s10 143 Clear C clear 144 } 145 } 146 147 NewWindow 148 149 } 150 151 proc NewWindow { args } { 152 variable mbar 153 variable wid 154 155 # create pathname for new toplevel window 156 set w ".top${wid}" 157 incr wid 158 159 Gui new ${wid} ${w} ${mbar} 160 } 161} 162 163# -- 164# 165oo::class create Gui { 166 167 # ---------------------------------------- 168 # Create a toplevel with a menu bar 169 constructor { wid w menubar } { 170 my variable mbar 171 my variable wtop 172 my variable nb 173 my variable tout 174 my variable tabvars 175 176 ## 177 ## Create toplevel window 178 ## 179 180 set wtop ${w} 181 toplevel ${wtop} 182 wm withdraw ${wtop} 183 184 ## 185 ## Define the GUI 186 ## 187 188 # -- note 189 # This demo doesn't use the notebook frames. 190 # A real application would include gui elements in the 191 # notebook frames. 192 193 set nb [ttk::notebook ${wtop}.nb] 194 set tout [text ${wtop}.t -height 12] 195 grid ${nb} -sticky news 196 grid ${tout} -sticky news 197 grid rowconfigure ${wtop} 1 -weight 1 198 grid rowconfigure ${wtop} 2 -weight 0 199 200 # add binding for notebook tabs 201 bind ${nb} "<<NotebookTabChanged>>" [list [self object] nbTabSelect ${wtop}] 202 203 ## 204 ## Install & Configure the menu bar 205 ## 206 207 set mbar ${menubar} 208 209 ${mbar} install ${wtop} { 210 211 # Create tags for this windows text widget. They will be 212 # used by the menubar callbacks to direct output to the 213 # text widget. 214 ${mbar} tag.add tout ${tout} 215 ${mbar} tag.add gui [self object] 216 217 ${mbar} menu.configure -command { 218 # file menu 219 new {::Main::NewWindow} 220 mshow {my mShow} 221 mhide {my mHide} 222 paste_state {my TogglePasteState} 223 close {my Close} 224 exit {my Exit} 225 # Item menu 226 cut {my Edit cut} 227 copy {my Edit copy} 228 paste {my Edit paste} 229 # boolean menu 230 apple {my BoolToggle} 231 bread {my BoolToggle} 232 coffee {my BoolToggle} 233 donut {my BoolToggle} 234 square {my BoolToggle} 235 triangle {my BoolToggle} 236 rectangle {my BoolToggle} 237 left {my NotebookBoolToggle} 238 right {my NotebookBoolToggle} 239 top {my NotebookBoolToggle} 240 # radio menu 241 color {my RadioToggle} 242 ryb {my RadioToggle} 243 compass {my NotebookRadioToggle} 244 # Help menu 245 about {my About} 246 clear {my Clear} 247 } -state { 248 mhide disabled 249 paste disabled 250 } -bind { 251 exit {1 Cntl+Q Control-Key-q} 252 cut {2 Cntl+X Control-Key-x} 253 copy {0 Cntl+C Control-Key-c} 254 paste {0 Cntl+V Control-Key-v} 255 apple {0 Cntl+A Control-Key-a} 256 bread {0 Cntl+B Control-Key-b} 257 about 0 258 clear {0 {} Control-Key-d} 259 } -background { 260 exit red 261 } -foreground { 262 exit white 263 } 264 265 266 # change the namespace for commands associated the 267 # 'macros' commands and 'macro' command group 268 ${mbar} menu.namespace macros ::Macros 269 ${mbar} menu.namespace macro ::Macros 270 271 # configure the macros menu 272 ${mbar} menu.configure -command { 273 item_add {NewItem} 274 item_delete {DeleteItem} 275 mark_add {Mark add} 276 mark_up {Mark up} 277 mark_down {Mark down} 278 mark_del {Mark delete} 279 macro_entries {Macros} 280 serialize {Serialize} 281 deserialize {Deserialize} 282 } -bind { 283 item_add {0 Cntl+I Control-Key-i} 284 mark_add {0 Cntl+m Control-Key-m} 285 mark_up {0 Cntl+U Control-Key-u} 286 mark_down {0 Cntl+J Control-Key-j} 287 mark_del {0 Cntl+K Control-Key-k} 288 } 289 290 # initally hide the macros menu 291 ${mbar} menu.hide macros 292 293 # hide the debugging menu unless the package is loaded 294 if { [catch {package present menubar::debug}] } { 295 ${mbar} menu.hide debug 296 } else { 297 ${mbar} menu.configure -command { 298 testcget {my TestCget} 299 debug_tree {my Debug tree} 300 debug_nodes {my Debug nodes} 301 debug_installs {my Debug installs} 302 debug_notebook {my Debug notebook} 303 ptree {my print tree} 304 pnodes {my print nodes} 305 pkeys {my print keys} 306 } 307 } 308 } 309 310 # After the menubar is installed we add 3 tabs 311 # to its widget scope. 312 my nbNewTab "One" 313 my nbNewTab "Two" 314 my nbNewTab "Three" 315 316 wm minsize ${wtop} 300 300 317 wm geometry ${wtop} 300x300+[expr ${wid}*20]+[expr ${wid}*20] 318 wm protocol ${wtop} WM_DELETE_WINDOW [list [self object] closeWindow ${wtop}] 319 wm title ${wtop} "Menubar Demo" 320 wm focusmodel ${wtop} active 321 wm deiconify ${wtop} 322 323 return 324 } 325 326 method pout { txt } { 327 my variable wtop 328 my variable mbar 329 set tout [${mbar} tag.cget ${wtop} tout] 330 ${tout} insert end "${txt}\n" 331 } 332 333 method nbNewTab { text } { 334 my variable mbar 335 my variable wtop 336 my variable nb 337 set tabid [${nb} index end] 338 incr tabid 339 set tabwin ${wtop}.tab${tabid} 340 ${nb} add [frame ${tabwin}] -text ${text} 341 ${mbar} notebook.addTabStore ${tabwin} 342 } 343 344 method nbTabSelect { wtop args } { 345 my variable mbar 346 my variable nb 347 my Clear 348 # restore tab values 349 set tabwin [${nb} select] 350 ${mbar} notebook.restoreTabValues ${tabwin} 351 my pout "Tab Selected: ${tabwin}" 352 } 353 354 method mShow { args } { 355 my variable mbar 356 ${mbar} menu.show macros 357 ${mbar} menu.configure -state { 358 mshow disabled 359 mhide normal 360 } 361 } 362 363 method mHide { args } { 364 my variable mbar 365 ${mbar} menu.hide macros 366 ${mbar} menu.configure -state { 367 mshow normal 368 mhide disabled 369 } 370 } 371 372 method closeWindow { wtop } { 373 my variable mbar 374 destroy ${wtop} 375 # check to see if we closed the last window 376 if { [winfo children .] eq "" } { 377 my Exit 378 } 379 } 380 381 method Close { args } { 382 my closeWindow {*}${args} 383 } 384 385 method Exit { args } { 386 puts "Goodbye" 387 exit 388 } 389 390 method Debug { args } { 391 my variable wtop 392 my variable mbar 393 lassign ${args} type 394 my Clear 395 foreach line [${mbar} debug ${type}] { 396 my pout ${line} 397 } 398 } 399 method Clear { args } { 400 my variable wtop 401 my variable mbar 402 set tout [${mbar} tag.cget ${wtop} tout] 403 ${tout} delete 0.0 end 404 } 405 406 method TestCget { args } { 407 my variable wtop 408 my variable mbar 409 my Clear 410 my pout "user define tag: tout = [${mbar} tag.cget ${wtop} tout]" 411 my pout "Command tag: exit -background = [${mbar} tag.cget ${wtop} exit -background]" 412 my pout "Checkbutton tag: apple -state = [${mbar} tag.cget ${wtop} apple -state]" 413 my pout "Radiobutton tag: color -state = [${mbar} tag.cget ${wtop} color -state]" 414 my pout "Cascade tag: chx -background = [${mbar} tag.cget ${wtop} chx -background]" 415 } 416 417 method Edit { args } { 418 my pout "Edit: [join ${args} {, }]" 419 } 420 421 method TogglePasteState { args } { 422 my variable mbar 423 my pout "TogglePasteState: [join ${args} {, }]" 424 lassign ${args} wtop 425 set value [${mbar} tag.cget ${wtop} paste -state] 426 if { [${mbar} tag.cget ${wtop} paste -state] eq "normal" } { 427 ${mbar} tag.configure ${wtop} paste -state "disabled" -background {} 428 } else { 429 ${mbar} tag.configure ${wtop} paste -state "normal" -background green 430 } 431 } 432 433 method BoolToggle { args } { 434 my variable wtop 435 my variable mbar 436 my variable nb 437 my pout "BoolToggle: [join ${args} {, }]" 438 } 439 440 method RadioToggle { args } { 441 my variable wtop 442 my variable mbar 443 my variable nb 444 my pout "RadioToggle: [join ${args} {, }]" 445 } 446 447 method NotebookBoolToggle { args } { 448 my variable wtop 449 my variable mbar 450 my variable nb 451 my pout "NotebookBoolToggle: [join ${args} {, }]" 452 lassign ${args} wtop tag val 453 set tabwin [${nb} select] 454 ${mbar} notebook.setTabValue ${tabwin} ${tag} 455 } 456 457 method NotebookRadioToggle { args } { 458 my variable wtop 459 my variable mbar 460 my variable nb 461 my pout "NotebookRadioToggle: [join ${args} {, }]" 462 lassign ${args} wtop tag val 463 set tabwin [${nb} select] 464 ${mbar} notebook.setTabValue ${tabwin} ${tag} 465 } 466 467 method About { args } { 468 my pout "MenuBar Demo 0.5" 469 } 470 471 method print { args } { 472 my variable mbar 473 lassign ${args} type wtop 474 ${mbar} print ${type} 475 } 476} 477 478# -- 479# 480namespace eval Macros { 481 482 variable next 0 483 variable stream 484 variable stream_next 485 486 proc Mark { args } { 487 set mbar $::Main::mbar 488 489 lassign ${args} action wtop 490 set gui [${mbar} tag.cget ${wtop} gui] 491 492 set errno 0 493 switch -exact -- ${action} { 494 "add" { 495 set errno [${mbar} group.add macro MARK {Mout "MARK"} Cntl+0 Control-Key-0] 496 if { ${errno} != 0 } { 497 ${gui} pout "warning: MARK already exists" 498 } else { 499 ${mbar} group.configure macro MARK \ 500 -background tan \ 501 -foreground white 502 } 503 } 504 "delete" { 505 set errno [${mbar} group.delete macro MARK] 506 if { ${errno} != 0 } { 507 ${gui} pout "warning: MARK not found" 508 } 509 } 510 "up" { 511 set errno [${mbar} group.move up macro MARK] 512 if { ${errno} != 0 } { 513 ${gui} pout "warning: MARK move up failed" 514 } 515 } 516 "down" { 517 set errno [${mbar} group.move down macro MARK] 518 if { ${errno} != 0 } { 519 ${gui} pout "warning: MARK move down failed" 520 } 521 }} 522 } 523 524 proc NewItem { args } { 525 variable next 526 if { ${next} == 9 } { return } 527 incr next 528 set mbar $::Main::mbar 529 set errno [${mbar} group.add macro Item${next} "Mout item${next}" Cntl+${next} Control-Key-${next}] 530 if { ${errno} != 0 } { 531 lassign ${args} wtop 532 set gui [${mbar} tag.cget ${wtop} gui] 533 ${gui} pout "warning: Item${next} already exists" 534 } 535 } 536 537 proc DeleteItem { args } { 538 variable next 539 set mbar $::Main::mbar 540 set item "Item${next}" 541 ${mbar} group.delete macro ${item} 542 if { ${next} > 0 } { 543 incr next -1 544 } 545 } 546 547 proc Macros { args } { 548 set mbar $::Main::mbar 549 puts "---" 550 puts [${mbar} group.entries macro] 551 } 552 553 proc Serialize { args } { 554 variable next 555 variable stream 556 variable stream_next 557 set mbar $::Main::mbar 558 set stream [${mbar} group.serialize macro] 559 set stream_next ${next} 560 puts "---" 561 puts ${stream} 562 } 563 564 proc Deserialize { args } { 565 variable next 566 variable stream 567 variable stream_next 568 set next ${stream_next} 569 set mbar $::Main::mbar 570 ${mbar} group.deserialize macro ${stream} 571 } 572 573 proc Mout { args } { 574 set mbar $::Main::mbar 575 lassign ${args} action wtop 576 set gui [${mbar} tag.cget ${wtop} gui] 577 ${gui} pout "Mout: [join ${args} {, }]" 578 } 579} 580 581 582Main::main 583