Tk editor application template

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 <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 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] <<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

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" ??

IDG Because it allows users with non-standard versions in their path to get what they want. On my system,

~> /usr/bin/tclsh
% info patch
8.5.9
% ~> /usr/bin/env tclsh
% info patch
8.6b2
%

Category Example