prompt

Here is a script that provides a prompt for non-interactive tcl/tk sessions. It uses a fileevent on stdin so as not to block the event loop.

  # ==================================================================== #
  #
  # prompt.tcl --
  # An interactive prompt for non-interactive tcl/tk sessions
  # Copyright (C) 2000-2010, b i n a r i s m . c o m
  #
  # See the file "LICENSE.txt" or "LICENSE.html" for information on usage
  # and distribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  #
  # $Id$
  # $Name$
  #
  # ==================================================================== #

    namespace eval prompt {}

  # ==================================================================== #

  proc prompt::_init {} {

    variable buffer ""
    variable continue 0
    variable prompt1 "% "
    variable prompt2 ""

    return

  }

  # ==================================================================== #

  proc prompt::_getline {line} {

    variable buffer
    variable continue

    set n1 [string length $line]
    set line2 [string trimright $line \\]
    set n2 [string length $line2]
    set cont [expr {($n1 - $n2) % 2 == 1}]
    if { $cont } {
      set line [string range $line 0 end-1]
    }
    if { $continue } {
      append buffer " [string trimleft $line]"
    } elseif { [string length $buffer] } {
      append buffer \n$line
    } else {
      set buffer $line
    }
    set continue $cont
    if { $continue } {
      set complete 0
    } else {
      set complete [info complete $buffer]
    }
    if { !$continue && [info complete $buffer] } {
      set code [catch {uplevel #0 $buffer} result]
      set std [expr {$code > 0 ? "stderr" : "stdout"}]
      if { [string length $result] } {
        puts $std "$result"
      }
      set buffer ""
      _prompt 1
    } else {
      _prompt 2
    }

    return

  }

  # ==================================================================== #

  proc prompt::_readable {chan} {

    variable status

    set code [catch {gets $chan line} chars]

    if { $code > 0 } {
      puts stderr "error reading $chan: $chars"
      set status "error"
    } elseif { $chars > -1 } {
      _getline $line
    } elseif { [eof $chan] } {
      set status "eof"
    } elseif { [fblocked $chan] } {
      return
    } else {
      set status "unknown"
    }

    return

  }

  # ==================================================================== #

  proc prompt::_prompt {n} {

    global tcl_prompt$n
    variable prompt$n

    if { [info exists tcl_prompt$n] } {
      if { [catch {uplevel #0 [set tcl_prompt$n]} result] } {
        puts stderr $result
        flush stderr
      }
    } else {
      puts -nonewline stdout [set prompt$n]
    }
    flush stdout

    return

  }

  # ==================================================================== #

  proc prompt::prompt {} {

    _prompt 1

    fileevent stdin readable [list [namespace current]::_readable stdin]

    vwait [namespace current]::status

    return

  }

  # ==================================================================== #

    prompt::_init

    if { [info exists argv0] && [string equal $argv0 [info script]] } {
  #   set tcl_prompt2 {puts -nonewline "> "}
      set prompt::prompt2 "> "
      prompt::prompt
    }

  # ==================================================================== #

Example usage:

1. Create a file called hello.tcl containing:

  button .b -text "Hello World" -command [list puts "Hello World"]
  pack .b
  source prompt.tcl
  prompt::prompt

1. Run wish with the file:

  > wish hello.tcl

and you should be greeted with a prompt.