Many of the Tcl and Tk applications that I write fall in to one of several different "families" of applications. Some are filters. Others are simple single-dialog GUIs. Wouldn't it be nice to have a collection of application templates which include some of the "basic stuff" that you end up re-writing into each new application?
As an example, I present a tk Application Template, which includes some basic procedural structure (a 'main'), a simple menu structure, and procedures for new, open, close, etc. It is only a couple of hundred lines, but I seem to keep copying it over and over. You should be able to start with this, similar to "application wizards" found in some IDEs.
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
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
#!/bin/sh
# If running in a UNIX shell, restart wish on the next line \
exec wish "$0" ${1+"$@"}
#--------------------------------------------------
#
# 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
$Edit configure -postcommand "myAppConfigEditMenu $Edit \[bindtags \[focus\]\] "
$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 <Key> {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 myAppFileName
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 [.t get 1.0 end]
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] <<Cut>>
}
proc myAppEditCopy { } {
event generate [focus] <<Copy>>
}
proc myAppEditPaste { } {
event generate [focus] <<Paste>>
}
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} {
<<Cut>> 0
<<Copy>> 1
<<Paste>> 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
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?