This application template illustrates the basic structure and functionality of a basic Tk GUI application. It includes procedures to construct the GUI, File and Edit menus and procedures, and a simple "main" program. You can start with this code, and just edit the "myApp" string, or you can start from scratch using this structure. If you uncomment the code in the procedures, you will get a simple file editor. The code was culled from several of my own applications which were based on examples in Brent Welch's book, vtcl, tkcon, and others. Please feel free to improve this template, or add others. '''RWT''' ---- # /usr/bin/env wish #-------------------------------------------------- # # tkTemplate.tcl # # Template Tk Application # # This template contains some of the structures # typically included in a basic Tk application. # # All the procedures in this code are # prefixed by "myApp", which you can # globally replace with your app name. # # You should add code in several places within # the myApp procedures. Sample code for a dead- # simple text editor is included at points # commented out with '###' # #-------------------------------------------------- #-------------------------------------------------- # # myAppMain # # Performs basic initialization of myApp. # #-------------------------------------------------- proc myAppMain { argc argv } { #-------------------------------------------------- # Construct the UI #-------------------------------------------------- myAppInitGui . #-------------------------------------------------- # If we have an argument, then open the file #-------------------------------------------------- if { [llength $argv] > 0 } { myAppFileOpen [lindex $argv 0] } } #-------------------------------------------------- # # myAppInitGui # # Construct and initialize UI # #-------------------------------------------------- proc myAppInitGui { root } { #-------------------------------------------------- # treat root window "." as a special case #-------------------------------------------------- if {$root == "."} { set base "" } else { set base $root } #-------------------------------------------------- # Define the menu bar #-------------------------------------------------- menu $base.menu $root config -menu $base.menu foreach m {File Edit Help} { # Use [string tolower] to ensure magic menu names are right - DKF set $m [menu $base.menu.[string tolower $m] -tearoff 0] $base.menu add cascade -label $m -underline 0 -menu [set $m] } $File add command -underline 0 -label "New..." -command myAppFileNew $File add command -underline 0 -label "Open..." -command myAppFileOpen $File add command -underline 0 -label "Close" -command myAppFileClose $File add separator $File add command -underline 0 -label "Save" -command myAppFileSave $File add command -underline 5 -label "Save As..." -command myAppFileSaveAs $File add separator $File add command -underline 1 -label "Exit" -command myAppExit $Edit add command -underline 2 -label "Cut" -command myAppEditCut $Edit add command -underline 0 -label "Copy" -command myAppEditCopy $Edit add command -underline 0 -label "Paste" -command myAppEditPaste # Test if focus returns a valid window before calling - Ingemar Hansson append pCmd "myAppConfigEditMenu $Edit " {{if {[focus] != {}} {[bindtags [focus]]}}} $Edit configure -postcommand $pCmd $Help add command -label About -command myAppHelpAbout #-------------------------------------------------- # Set window manager properties for myApp #-------------------------------------------------- wm protocol $root WM_DELETE_WINDOW { myAppExit } wm title $root "myApp" #-------------------------------------------------- # insert code defining myApp main window #-------------------------------------------------- ### text .t ### bind .t {set myAppChangedFlag 1} ### pack .t } #-------------------------------------------------- # # File Procedures # # Note that opening, saving, and closing files # are all intertwined. This code assumes that # new/open/close/exit may lose some data. # #-------------------------------------------------- set myAppFileName "" set myAppChangedFlag 0 set myAppFileTypes { {{tcl files} {.tcl .tk}} {{All Files} * } } proc myAppFileNew { } { global myAppFileName global myAppChangedFlag if { $myAppChangedFlag } { myAppPromptForSave } #-------------------------------------------------- # insert code for "new" operation #-------------------------------------------------- ### .t delete 1.0 end set myAppFileName "" set myAppChangedFlag 0 } proc myAppFileOpen { {filename ""} } { global myAppFileName global myAppChangedFlag global myAppFileTypes if { $myAppChangedFlag } { myAppPromptForSave } if {$filename == ""} { set filename [tk_getOpenFile -filetypes $myAppFileTypes] } if {$filename != ""} { if { [catch {open $filename r} fp] } { error "Cannot Open File $filename for Reading" } #-------------------------------------------------- # insert code for "open" operation #-------------------------------------------------- ### .t insert end [read $fp [file size $filename]] close $fp set myAppFileName $filename set myAppChangedFlag 0 } } proc myAppFileClose { } { global myAppFileName global myAppChangedFlag if { $myAppChangedFlag } { myAppPromptForSave } #-------------------------------------------------- # insert code for "close" operation #-------------------------------------------------- ### .t delete 1.0 end set myAppFileName "" set myAppChangedFlag 0 } proc myAppFileSave { {filename ""} } { global myAppFileName global myAppChangedFlag #BMA if { $filename == "" } { set filename $myAppFileName } if { $filename != "" } { if { [catch {open $filename w} fp] } { error "Cannot write to $filename" } #-------------------------------------------------- # insert code for "save" operation #-------------------------------------------------- ### puts -nonewline $fp [.t get 1.0 end] #BMA close $fp set myAppFileName $filename set myAppChangedFlag 0 } } proc myAppFileSaveAs { } { global myAppFileTypes set filename [tk_getSaveFile -filetypes $myAppFileTypes] if { $filename != "" } { myAppFileSave $filename } } proc myAppPromptForSave { } { set answer [tk_messageBox -title "myApp: Do you want to save?" \ -type yesno -icon question \ -message "Do you want to save the changes?"] if { $answer == "yes" } { myAppFileSaveAs } } proc myAppExit { } { myAppFileClose exit } #-------------------------------------------------- # Cut/Copy/Paste # # These procedures generate events # for all Tk Widgets in the GUI #-------------------------------------------------- proc myAppEditCut { } { event generate [focus] <> } proc myAppEditCopy { } { event generate [focus] <> } proc myAppEditPaste { } { event generate [focus] <> } proc myAppSearchBindingsAndEval {event bindtags script} { foreach tag $bindtags { foreach sequence [bind $tag] { if {[string first $event $sequence] == 0} { return [uplevel $script] } } } } proc myAppConfigEditMenu {menu bindtags} { foreach {event index} {<> 0 <> 1 <> 2 } { $menu entryconfigure $index -state disabled myAppSearchBindingsAndEval $event $bindtags { $menu entryconfigure $index -state normal } } } #-------------------------------------------------- # Help Operations #-------------------------------------------------- proc myAppHelpAbout { } { tk_messageBox -message "myApp Application Template" } #-------------------------------------------------- # Execute the main procedure #-------------------------------------------------- myAppMain $argc $argv ---- Modified to make the Help menu special on platforms that support it (i.e. everywhere except Windows!) and to only enable the Cut, Copy and Paste options on the menu where the focus context makes sense. '''DKF''' ---- [LV]: Has anyone thought about updating the above to account for message catalogs (for i18n and l10n support), option database (to allow customization of fonts, sizes, etc. and introspection (what support would be useful to include by default so that one can interact with the application dynamically)? ---- [EMJ]: Run the above on Windows and select a menu before clicking anywhere else in the app, and you get an error. I assume this is because -postcommand is different on Windows, but can anyone correct this so that it will work there? ---- The problem is that a Tk application on Windows doesn't get focus when started. 'focus' returns an empty string in Edit menu's -postcommand causing the postcommand to fail because 'bindtags ""' is illegal. I've put the -postcommand line into two lines for clarity (IMO at least). '''Ingemar Hansson''' [EMJ]: Thanx, I should have seen that! ---- [BMA] Fixed up a couple of things that I found missing. [D. McC] Substituted "/usr/bin/env wish" for "exec magic" at beginning--see [exec magic]. [rdt] Which is just as bad as having "/usr/bin/wish" as the first line. Thus the need for the [exec magic]. Why do people insist in using "/usr/bin/env" when that is no more standard than "/usr/bin/wish" ?? [Category Example]