3 # This [sub]program is Copyright (C) 1997-1999 Ian Jackson
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2, or (at your option)
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software Foundation,
17 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19 # $Id: asynch.tcl,v 1.1 2000-08-14 21:09:51 ijackson Exp $
21 proc asynch_startcmd
{} {
29 global asynch_sofar asynch_result asynch_code errorInfo
30 set r
[read -nonewline stdin
]
32 fconfigure stdin
-blocking true
36 append asynch_sofar
$r
37 if {[info complete
$asynch_sofar]} {
38 uplevel #0 {set asynch_code [catch $asynch_sofar asynch_result]}
42 } elseif
{[string length
$asynch_result]} {
43 puts "=> $asynch_result"
50 if {[llength $argv] && "[lindex $argv 0]" == "-d"} {
52 set argv
[lreplace $argv 0 0]
53 } elseif
{[llength $argv] && "[lindex $argv 0]" == "-dd"} {
55 set argv
[lreplace $argv 0 0]
58 if {[llength $argv] &&
59 [regexp {^
-a(\d
+)$} [lindex $argv 0] asynch_dummy asynch_appdebug
]} {
60 set argv
[lreplace $argv 0 0]
63 if {[llength $argv]} {
64 set asynch_script
[lindex $argv 0]
65 set argv
[lreplace $argv 0 0]
70 fileevent stdin readable morecmd
71 fconfigure stdin
-blocking false