| Line 1... |
Line 1... |
#! /usr/bin/env tclsh
|
#! /usr/bin/env tclsh
|
# -*- tcl -*-
|
# -*- tcl -*-
|
# $Id: ti_rri 504 2013-04-13 15:37:24Z mueller $
|
# $Id: ti_rri 511 2013-04-27 13:51:46Z mueller $
|
#
|
#
|
# Copyright 2011-2013 by Walter F.J. Mueller
|
# Copyright 2011-2013 by Walter F.J. Mueller
|
#
|
#
|
# This program is free software; you may redistribute and/or modify it under
|
# This program is free software; you may redistribute and/or modify it under
|
# the terms of the GNU General Public License as published by the Free
|
# the terms of the GNU General Public License as published by the Free
|
| Line 13... |
Line 13... |
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# for complete details.
|
# for complete details.
|
#
|
#
|
# Revision History:
|
# Revision History:
|
# Date Rev Version Comment
|
# Date Rev Version Comment
|
|
# 2013-04-26 510 1.1.5 reorganize readline startup
|
# 2013-04-12 504 1.1.4 add --pack; trailing '-' argv implies --int
|
# 2013-04-12 504 1.1.4 add --pack; trailing '-' argv implies --int
|
# 2013-02-05 482 1.1.3 stop server is rls found
|
# 2013-02-05 482 1.1.3 stop server is rls found
|
# 2013-01-27 478 1.1.2 use 'exec sh -c $cmd &' for --run implementation
|
# 2013-01-27 478 1.1.2 use 'exec sh -c $cmd &' for --run implementation
|
# 2013-01-02 467 1.1.1 call rlc close only when really open
|
# 2013-01-02 467 1.1.1 call rlc close only when really open
|
# 2012-12-27 465 1.1 add --cuff support
|
# 2012-12-27 465 1.1 add --cuff support
|
| Line 42... |
Line 43... |
# --
|
# --
|
# tcl cmds
|
# tcl cmds
|
# @...tcl
|
# @...tcl
|
#
|
#
|
|
|
|
set tirri_interactive 0
|
|
|
array set opts {
|
array set opts {
|
pack_ ""
|
pack_ ""
|
fifo 0
|
fifo 0
|
fifo_ ""
|
fifo_ ""
|
term 0
|
term 0
|
| Line 71... |
Line 74... |
#
|
#
|
# cleanup handler
|
# cleanup handler
|
# must be in a proc so that it can be called from tclreadline
|
# must be in a proc so that it can be called from tclreadline
|
# must be defined before ::tclreadline::Loop called (all after ignored...)
|
# must be defined before ::tclreadline::Loop called (all after ignored...)
|
#
|
#
|
proc exit_cleanup {} {
|
proc tirri_exit {{doexit 1}} {
|
global opts
|
global opts
|
global runpid
|
global runpid
|
|
|
# check for rlink server, stop it
|
# check for rlink server, stop it
|
if { [info commands rls] eq "rls" } { rls server -stop }
|
if { [info commands rls] eq "rls" } { rls server -stop }
|
| Line 88... |
Line 91... |
# FIXME_code: should sync here with -run process run-down
|
# FIXME_code: should sync here with -run process run-down
|
# but no wait available in tcl (grr...)
|
# but no wait available in tcl (grr...)
|
if { "$runpid" ne "" } {
|
if { "$runpid" ne "" } {
|
after 100; # currently just wait 100ms
|
after 100; # currently just wait 100ms
|
}
|
}
|
|
if { $doexit } {
|
|
puts {}; # \n to ensure shell prompt on new line
|
|
exit
|
|
}
|
return
|
return
|
}
|
}
|
|
|
foreach arg $argv {
|
foreach arg $argv {
|
if { $optsendseen } {
|
if { $optsendseen } {
|
| Line 287... |
Line 294... |
}
|
}
|
|
|
# setup simulation mode default
|
# setup simulation mode default
|
set rlink::sim_mode [rlink::isfifo]
|
set rlink::sim_mode [rlink::isfifo]
|
|
|
|
# if tclsh runs a script given on the command line or is invoked
|
|
# like here via a shebang the tcl_interactive is always set to 0
|
|
# so we have to check whether stdin/stdout is a terminal and set
|
|
# tcl_interactive accordingly
|
|
|
|
# FIXME_code: fstat not available (grr...), currently just assume istty
|
|
set tcl_interactive 1
|
|
|
|
# determine whether interactive mode, if yes, initialize readline
|
|
if {$opts(int) || [llength $clist] == 0 } {
|
|
set tirri_interactive 1
|
|
|
|
package require tclreadline
|
|
namespace eval tclreadline {
|
|
proc prompt1 {} {
|
|
set version [info tclversion]
|
|
return "ti_rri > "
|
|
}
|
|
}
|
|
::tclreadline::readline eofchar {::tirri_exit; puts {}; exit}
|
|
}
|
|
|
|
# now execute all commands and scripts given as start-up arguments
|
foreach cmd $clist {
|
foreach cmd $clist {
|
|
# puts "executing: $cmd"
|
# handle @filename commands
|
# handle @filename commands
|
if { [regexp {^@(.+)} $cmd dummy filename] } {
|
if { [regexp {^@(.+)} $cmd dummy filename] } {
|
# handle @file.tcl --> source tcl file
|
# handle @file.tcl --> source tcl file
|
if { [regexp {\.tcl$} $filename] } {
|
if { [regexp {\.tcl$} $filename] } {
|
if { [catch {source $filename} errmsg] } {
|
if { [catch {source $filename} errmsg] } {
|
| Line 316... |
Line 347... |
break
|
break
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
# if tclsh runs a script given on the command line or is invoked
|
|
# like here via a shebang the tcl_interactive is always set to 0
|
|
# so we have to check whether stdin/stdout is a terminal and set
|
|
# tcl_interactive accordingly
|
|
|
|
# FIXME_code: fstat not available (grr...), currently just assume istty
|
|
set tcl_interactive 1
|
|
|
|
if { $opts(int) || [llength $clist] == 0 } {
|
if { $tirri_interactive } {
|
if {$tcl_interactive} {
|
|
package require tclreadline
|
|
namespace eval tclreadline {
|
|
proc prompt1 {} {
|
|
set version [info tclversion]
|
|
return "ti_rri > "
|
|
}
|
|
}
|
|
::tclreadline::readline eofchar {::exit_cleanup; puts {}; exit}
|
|
::tclreadline::Loop
|
::tclreadline::Loop
|
}
|
|
} else {
|
} else {
|
exit_cleanup
|
tirri_exit 0
|
}
|
}
|
|
|
return 0
|
return 0
|
