www.gibmonks.com

  Previous section   Next section

Practical Programming in Tcl & Tk, Third Edition
By Brent B. Welch

Table of Contents
Chapter 22.  Tk by Example


A Tcl Shell

This section demonstrates the text widget with a simple Tcl shell application. It uses a text widget to prompt for commands and display their results. It uses a second Tcl interpreter to evaluate the commands you type. This dual interpreter structure is used by the console built into the Windows and Macintosh versions of wish. The TkCon application written by Jeff Hobbs is an even more elaborate console that has many features to support interactive Tcl use.

Example 22-4 is written to be used with the browser from Example 22-3 in the same application. The browser's Run button runs the current example in the shell. An alternative is to have the shell run as a separate process and use the send command to communicate Tcl commands between separate applications. That alternative is shown in Example 40-2 on page 565.

Example 22-4 A Tcl shell in a text widget.
#!/usr/local/bin/wish
# Simple evaluator. It executes Tcl in a slave interpreter

set t [Scrolled_Text .eval -width 80 -height 10]
pack .eval -fill both -expand true

# Text tags give script output, command errors, command
# results, and the prompt a different appearance

$t tag configure prompt -underline true
$t tag configure result -foreground purple
$t tag configure error -foreground red
$t tag configure output -foreground blue

# Insert the prompt and initialize the limit mark

set eval(prompt) "tcl> "
$t insert insert $eval(prompt) prompt
$t mark set limit insert
$t mark gravity limit left
focus $t
set eval(text) $t

# Key bindings that limit input and eval things. The break in
# the bindings skips the default Text binding for the event.

bind $t <Return> {EvalTypein ; break}
bind $t <BackSpace> {
   if {[%W tag nextrange sel 1.0 end] != ""} {
      %W delete sel.first sel.last
   } elseif {[%W compare insert > limit]} {
      %W delete insert-1c
      %W see insert
   }
   break
}
bind $t <Key> {
   if [%W compare insert < limit] {
      %W mark set insert end
   }
}

# Evaluate everything between limit and end as a Tcl command

proc EvalTypein {} {
   global eval
   $eval(text) insert insert \n
   set command [$eval(text) get limit end]
   if [info complete $command] {
      $eval(text) mark set limit insert
      Eval $command
   }
}

# Echo the command and evaluate it

proc EvalEcho {command} {
   global eval
   $eval(text) mark set insert end
   $eval(text) insert insert $command\n
   Eval $command
}

# Evaluate a command and display its result

proc Eval {command} {
   global eval
   $eval(text) mark set insert end
   if [catch {$eval(slave) eval $command}result] {
      $eval(text) insert insert $result error
   } else {
      $eval(text) insert insert $result result
   }
   if {[$eval(text) compare insert != "insert linestart"]} {
       $eval(text) insert insert \n
   }
   $eval(text) insert insert $eval(prompt) prompt
   $eval(text) see insert
   $eval(text) mark set limit insert
   return
}

# Create and initialize the slave interpreter

proc SlaveInit {slave} {
   interp create $slave
   load {}Tk $slave
   interp alias $slave reset {}ResetAlias $slave
   interp alias $slave puts {}PutsAlias $slave
   return $slave
}

# The reset alias deletes the slave and starts a new one

proc ResetAlias {slave} {
   interp delete $slave
   SlaveInit $slave
}

# The puts alias puts stdout and stderr into the text widget

proc PutsAlias {slave args} {
   if {[llength $args] > 3} {
      error "invalid arguments"
   }
   set newline "\n"
   if {[string match "-nonewline" [lindex $args 0]]} {
      set newline ""
      set args [lreplace $args 0 0]
   }
   if {[llength $args] == 1} {
      set chan stdout
      set string [lindex $args 0]$newline
   } else {
      set chan [lindex $args 0]
      set string [lindex $args 1]$newline
   }
   if [regexp (stdout|stderr) $chan] {
      global eval
      $eval(text) mark gravity limit right
      $eval(text) insert limit $string output
      $eval(text) see limit
      $eval(text) mark gravity limit left
   } else {
      puts -nonewline $chan $string
   }
}
set eval(slave) [SlaveInit shell]

Text Marks, Tags, and Bindings

The shell uses a text mark and some extra bindings to ensure that users only type new text into the end of the text widget. A mark represents a position in the text that is updated as characters are inserted and deleted. The limit mark keeps track of the boundary between the read-only area and the editable area. The insert mark is where the cursor is displayed. The end mark is always the end of the text. The EvalTypein procedure looks at all the text between limit and end to see if it is a complete Tcl command. If it is, it evaluates the command in the slave interpreter.

The <Key> binding checks to see where the insert mark is and bounces it to the end if the user tries to input text before the limit mark. The puts alias sets right gravity on limit, so the mark is pushed along when program output is inserted right at limit. Otherwise, the left gravity on limit means that the mark does not move when the user inserts right at limit.

Text tags are used to give different regions of text difference appearances. A tag applies to a range of text. The tags are configured at the beginning of the script and they are applied when text is inserted.

Chapter 33 describes the text widget in more detail.

Multiple Interpreters

The SlaveInit procedure creates another interpreter to evaluate the commands. This prevents conflicts with the procedures and variables used to implement the shell. Initially, the slave interpreter only has access to Tcl commands. The load command installs the Tk commands, and it creates a new top-level window that is "." for the slave interpreter. Chapter 20 describes how you can embed the window of the slave within other frames.

The shell interpreter is not created with the -safe flag, so it can do anything. For example, if you type exit, it will exit the whole application. The SlaveInit procedure installs an alias, reset, that just deletes the slave interpreter and creates a new one. You can use this to clean up after working in the shell for a while. Chapter 19 describes the interp command in detail.

Native Look and Feel

When you run a Tk script on different platforms, it uses native buttons, menus, and scrollbars. The text and entry widgets are tuned to give the application the native look and feel. The following screen shots show the combined browser and shell as it looks on Macintosh, Windows, and UNIX.

Example 22-5 Macintosh look and feel.

graphics/22fig02.jpg

Example 22-6 Windows look and feel.

graphics/22fig03.gif

Example 22-7 UNIX look and feel.

graphics/22fig04.gif


      Previous section   Next section
    Top