commandloop

Difference between version 11 and 12 - Previous - Next
The [Tclx] package documents '''commandloop''' as:

    :   '''commandloop''' ''options''

Create an interactive command loop reading commands from
[stdin] and writing results to [stdout]. Command loops are maybe
either be blocking or event oriented. This command is useful
for Tcl scripts that do not normally converse interactively
with a user through a Tcl command interpreter, but which
sometimes want to enter this mode, perhaps for debugging or
user configuration. The command loop terminates on EOF.

The following options are available:

   '''-async''':   A command handler will be associated with [stdin]. When input is available on [stdin], it will be read and accumulated until a full command is available. That command will then be evaluated. An event loop must be entered for input to be read and processed.

   '''-interactive''' '''on'''|'''off'''|'''tty''':   Enable or disable interactive command mode. In interactive mode, commands are prompted for and the results of comments are printed. The value maybe any boolean value or '''tty'''. If '''tty''' is used, interactive mode is enabled if stdin is associated with a terminal or terminal emulator. The default is '''tty'''.

   '''-prompt1''' ''cmd'':   If specified, ''cmd'' is used is evaluate and its result used for the main command prompt. If not specified, the command in [tcl_prompt1] is evaluated to output the prompt. Note the difference in behavior, ''cmd'' results is used, while [tcl_prompt1] outputs. This is to allow for future expansion to command loops that write to other than [stdout].

   '''-prompt2''' ''cmd'':   If specified, ''cmd'' is used is evaluate and its result used for the secondary (continuation) command prompt. If not specified, the command in [tcl_prompt2] is evaluated to output the prompt.

   '''-endcommand''' ''cmd'':   If specified, ''cmd'' is evaluated when the command loop terminates.

In interactive mode, the results of set commands with two arguments are not printed.

If SIGINT is configured to generate a Tcl error (with [signal]), it can be used to delete the current command being type without aborting the program in progress.
----
<<discussion>>
[KBK] 2004-05-18 - Something very similar can be done in pure Tcl; the signal handling and 'isatty' checking is Unix and hence unportable, but the following code works for many purposes:

======
 namespace eval ::mainloop {
     variable partialCommand {}
 }
 
 proc ::mainloop::prompt {} {
     variable partialCommand
 
     if { [info complete $partialCommand] } {
         set status [catch {
             uplevel \#0 $partialCommand
         } result]
         if { $result ne {} } {
             if { $status != 0 } {
                 puts stderr $result
             } else {
                 puts stdout $result
             }
         }
         set partialCommand {}
         if { [info exists ::tcl_prompt1] } {
             catch { uplevel \#0 $::tcl_prompt1 } prompt
         } else {
             set prompt "% "
         }
     } else {
         append partialCommand \n
         if { [info exists ::tcl_prompt2] } {
             catch { uplevel \#0 $::tcl_prompt2 } prompt
         } else {
             set prompt "> "
         }
     }
     puts -nonewline stderr $prompt
 
     return
 }
 
 proc ::mainloop::readable {} {
     variable partialCommand
     variable eof
 
     if { [gets stdin text] < 0 } {
         fileevent stdin readable {}
         set eof 1
     } else {
         append partialCommand $text
         prompt
     }
     return
 }
 
 proc ::mainloop::mainloop {} {
 
     variable eof
 
     set ::tcl_interactive 1
     info script ""
 
     fconfigure stdin -buffering line -blocking 0
     fileevent stdin readable ::mainloop::readable
     
     ::mainloop::prompt
 
     vwait [namespace which -variable eof]
 
     return
 }
 
 ::mainloop::mainloop
======
----

[JH] wrote the following code that you tack on to the end of a script to get the near equivalence of the tclsh prompt.  For those who really want an interactive loop and are doing UI apps, look into the [console] megawidget or [tkcon], both of which can be embedded into apps and provide many more features and polish.
======
 if {!$tcl_interactive} {
     set long_command ""
     set verbose_history 0
     if {![catch {rename unknown tcl_unknown}]} {
         proc unknown {cmdname args} {
             if {[regexp "^!..*" $cmdname]} {
                 banghist [string range $cmdname 1 end]
             } else {
                 tcl_unknown $cmdname $args
             }
         }
     }
 
     proc banghist {val} {
         global verbose_history
         if {![string compare $val "!"]} {set val ""}
         if {$verbose_history} {puts "[history event $val]"}
         history redo $val
     }
 
     if {![info exists tcl_prompt1]} {
         set tcl_prompt1 {puts -nonewline "tclsh ([history nextid]) % "}
     }
     proc read_stdin {} {
         global eventLoop tcl_prompt1 long_command
         set l [gets stdin]
         if {[eof stdin]} {
             set eventLoop "done"     ;# terminate the vwait eventloop
         } else {
             if {[string compare $l {}]} {
                 append long_command "\n$l"
                 set l $long_command
                 if {[info complete $l]} {
                     if {[catch {uplevel \#0 history add [list $l] exec} err]} {
                         puts stderr $err
                     } elseif {[string compare $err {}]} {
                         puts $err
                     }
                     set long_command ""
                     catch $tcl_prompt1
                 } else {
                     puts -nonewline "> "
                 }
             } elseif {![string compare $long_command {}]} {
                 catch $tcl_prompt1
             } else {
                 puts -nonewline "> "
             }
             flush stdout
         }
     }
 
     # set up our keyboard read event handler:
     # Vector stdin data to the socket
     fileevent stdin readable read_stdin
 
     catch $tcl_prompt1
     flush stdout
     # wait for and handle or stdin events...
     vwait eventLoop
 }
======
----

[MH] It would be great to see an example of command line completion here. Is this possible with commandloop ?
----
[RS] provides a minimal version here
[http://groups.google.com/group/comp.lang.tcl/msg/d7603f0403592348]:
======
 while 1 { 
    puts -nonewline "% "; flush stdout ;#-- prompt - can be more elaborated 
    gets stdin line 
    catch $line res 
    puts $res 
 } 
======


Other noteworthy functional alternatives include 
a cute hack of [the rc file] by [Stephan Kuhagen]
[http://groups.google.com/group/comp.lang.tcl/msg/e3f2bbbfec3d6b42]
and 
Ivan Young's [stdin]-based approach
[http://groups.google.com/group/comp.lang.tcl/msg/040b658be7e4695d]
----
[stk] If you don't mind, I add my [tclshrc]-hack, mentioned above, here. My first contribution here, so I hope, I do not mess things up...
Put the following script into your ~/.tclshrc:
======
 if {[info exists env(TCL_INIT_FILE)] && [info exists env(TCL_INIT_ARGS)]} {
   if {[file exists $env(TCL_INIT_FILE)]} {
     source "$env(TCL_INIT_FILE)"
   }
   catch {tclsh_init_proc "$env(TCL_INIT_ARGS)"}
 }
======
Now, if you have a Tcl script running, and the environment vars TCL_INIT_FILE and TCL_INIT_ARGS are set, then the Tcl-initialization will source that file, and call a proc named tclsh_init_proc afterwards, which should contain all your initialization stuff. The args to this proc are the args to your script. Your wrapper script mentioned above should then look like this:
======
 #!/bin/sh
 #\
 export TCL_INIT_FILE="$0"
 #\
 export TCL_INIT_ARGS="$@"
 #\
 exec tclsh
 
 proc tclsh_init_proc {args} {
   puts "Do your init-stuff here"
   puts "my args are: $args"
   set ::example_var "Try to reach this var from the interactive shell"
 }
======
[DKF]: Here's a version I wrote:
======
proc commandloop {} {
    global tcl_prompt1 tcl_prompt2 errorInfo
    if {![info exists tcl_prompt1]} {
        set tcl_prompt1 {puts -nonewline "% ";flush stdout}
    }
    # Show that this works too
    if {![info exists tcl_prompt2]} {
        set tcl_prompt2 {puts -nonewline "> ";flush stdout}
    }

    set prompt $tcl_prompt1
    set script ""
    while {![eof stdin]} {
        uplevel 1 $prompt
        if {[gets stdin line] >= 0} {
            append script $line "\n"
            if {[info complete $script]} {
                if {[catch [list uplevel 1 $script] msg opt]} {
                    set ei [dict get $opt -errorinfo]
                    set errorInfo [join [lrange [split $ei "\n"] 0 end-6] "\n"]
                    puts stderr $msg
                } elseif {$msg ne ""} {
                    puts stdout $msg
                }
                set script ""
                set prompt $tcl_prompt1
            } else {
                set prompt $tcl_prompt2
            }
        }
    }
}
======
<<categories>> Command | TclX