jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

whitespace - change line-endings from crlf to lf

master
Julian Noble 2 years ago
parent
9f01dcc372
commit
91a7960701
6 changed files with 4640 additions and 4640 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 5386
      src/modules/flagfilter-0.3.tm
  2. 314
      src/modules/overtype-1.3.tm
  3. 530
      src/modules/patternpunk-1.1.tm
  4. 1084
      src/modules/punk-0.1.tm
  5. 776
      src/modules/shellrun-0.1.tm
  6. 1190
      src/modules/shellthread-1.6.tm

5386
src/modules/flagfilter-0.3.tm
View File

File diff suppressed because it is too large Load Diff

314
src/modules/overtype-1.3.tm
Unescape View File

@ -1,157 +1,157 @@
package provide [lassign {overtype 1.3} pkg ver]$pkg [namespace eval $pkg[set pkg {}] {list [variable version $ver[set ver {}]]$version}] package provide [lassign {overtype 1.3} pkg ver]$pkg [namespace eval $pkg[set pkg {}] {list [variable version $ver[set ver {}]]$version}]
#Julian Noble <julian@precisium.com.au> - 2003 #Julian Noble <julian@precisium.com.au> - 2003
#Released under standard 'BSD license' conditions. #Released under standard 'BSD license' conditions.
# #
#todo - ellipsis truncation indicator for center,right #todo - ellipsis truncation indicator for center,right
namespace eval overtype { namespace eval overtype {
namespace export * namespace export *
} }
proc overtype::about {} { proc overtype::about {} {
return "Simple text formatting. Author JMN. BSD-License" return "Simple text formatting. Author JMN. BSD-License"
} }
proc overtype::left {args} { proc overtype::left {args} {
# @c overtype starting at left (overstrike) # @c overtype starting at left (overstrike)
# @c can/should we use something like this?: 'format "%-*s" $len $overtext # @c can/should we use something like this?: 'format "%-*s" $len $overtext
if {[llength $args] < 2} { if {[llength $args] < 2} {
error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext}
} }
foreach {undertext overtext} [lrange $args end-1 end] break foreach {undertext overtext} [lrange $args end-1 end] break
set opt(-ellipsis) 0 set opt(-ellipsis) 0
set opt(-ellipsistext) {...} set opt(-ellipsistext) {...}
set opt(-overflow) 0 set opt(-overflow) 0
array set opt [lrange $args 0 end-2] array set opt [lrange $args 0 end-2]
set len [string length $undertext] set len [string length $undertext]
set overlen [string length $overtext] set overlen [string length $overtext]
set diff [expr {$overlen - $len}] set diff [expr {$overlen - $len}]
if {$diff > 0} { if {$diff > 0} {
if {$opt(-overflow)} { if {$opt(-overflow)} {
return $overtext return $overtext
} else { } else {
if {$opt(-ellipsis)} { if {$opt(-ellipsis)} {
return [overtype::right [string range $overtext 0 [expr {$len -1}]] $opt(-ellipsistext)] return [overtype::right [string range $overtext 0 [expr {$len -1}]] $opt(-ellipsistext)]
} else { } else {
return [string range $overtext 0 [expr {$len -1}]] return [string range $overtext 0 [expr {$len -1}]]
} }
} }
} else { } else {
return "$overtext[string range $undertext $overlen end]" return "$overtext[string range $undertext $overlen end]"
} }
} }
# test - use more tcl8.5 features. # test - use more tcl8.5 features.
proc overtype::left2 {args} { proc overtype::left2 {args} {
# @c overtype starting at left (overstrike) # @c overtype starting at left (overstrike)
# @c can/should we use something like this?: 'format "%-*s" $len $overtext # @c can/should we use something like this?: 'format "%-*s" $len $overtext
if {[llength $args] < 2} { if {[llength $args] < 2} {
error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext}
} }
foreach {undertext overtext} [lrange $args end-1 end] break foreach {undertext overtext} [lrange $args end-1 end] break
set opt(-ellipsis) 0 set opt(-ellipsis) 0
set opt(-ellipsistext) {...} set opt(-ellipsistext) {...}
set opt(-overflow) 0 set opt(-overflow) 0
array set opt [lrange $args 0 end-2] array set opt [lrange $args 0 end-2]
set len [string length $undertext] set len [string length $undertext]
set overlen [string length $overtext] set overlen [string length $overtext]
set diff [expr {$overlen - $len}] set diff [expr {$overlen - $len}]
if {$diff > 0} { if {$diff > 0} {
if {$opt(-overflow)} { if {$opt(-overflow)} {
return $overtext return $overtext
} else { } else {
if {$opt(-ellipsis)} { if {$opt(-ellipsis)} {
return [overtype::right [string range $overtext 0 $len-1] $opt(-ellipsistext)] return [overtype::right [string range $overtext 0 $len-1] $opt(-ellipsistext)]
} else { } else {
return [string range $overtext 0 $len-1 ] return [string range $overtext 0 $len-1 ]
} }
} }
} else { } else {
#return "$overtext[string range $undertext $overlen end]" #return "$overtext[string range $undertext $overlen end]"
return [string replace $undertext 0 $overlen-1 $overtext] return [string replace $undertext 0 $overlen-1 $overtext]
} }
} }
proc overtype::centre {args} { proc overtype::centre {args} {
if {[llength $args] < 2} { if {[llength $args] < 2} {
error {usage: ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} error {usage: ?-bias [left|right]? ?-overflow [1|0]? undertext overtext}
} }
foreach {undertext overtext} [lrange $args end-1 end] break foreach {undertext overtext} [lrange $args end-1 end] break
set opt(-bias) left set opt(-bias) left
set opt(-overflow) 0 set opt(-overflow) 0
array set opt [lrange $args 0 end-2] array set opt [lrange $args 0 end-2]
set olen [string length $overtext] set olen [string length $overtext]
set ulen [string length $undertext] set ulen [string length $undertext]
set diff [expr {$ulen - $olen}] set diff [expr {$ulen - $olen}]
if {$diff > 0} { if {$diff > 0} {
set half [expr {round(int($diff / 2))}] set half [expr {round(int($diff / 2))}]
if {[string match right $opt(-bias)]} { if {[string match right $opt(-bias)]} {
if {[expr {2 * $half}] < $diff} { if {[expr {2 * $half}] < $diff} {
incr half incr half
} }
} }
set rhs [expr {$diff - $half - 1}] set rhs [expr {$diff - $half - 1}]
set lhs [expr {$half - 1}] set lhs [expr {$half - 1}]
set a [string range $undertext 0 $lhs] set a [string range $undertext 0 $lhs]
set b $overtext set b $overtext
set c [string range $undertext end-$rhs end] set c [string range $undertext end-$rhs end]
return $a$b$c return $a$b$c
} else { } else {
if {$diff < 0} { if {$diff < 0} {
if {$opt(-overflow)} { if {$opt(-overflow)} {
return $overtext return $overtext
} else { } else {
return [string range $overtext 0 [expr {$ulen - 1}]] return [string range $overtext 0 [expr {$ulen - 1}]]
} }
} else { } else {
return $overtext return $overtext
} }
} }
} }
proc overtype::right {args} { proc overtype::right {args} {
# @d !todo - implement overflow, length checks etc # @d !todo - implement overflow, length checks etc
if {[llength $args] < 2} { if {[llength $args] < 2} {
error {usage: ?-overflow [1|0]? undertext overtext} error {usage: ?-overflow [1|0]? undertext overtext}
} }
foreach {undertext overtext} [lrange $args end-1 end] break foreach {undertext overtext} [lrange $args end-1 end] break
set opt(-overflow) 0 set opt(-overflow) 0
array set opt [lrange $args 0 end-2] array set opt [lrange $args 0 end-2]
set olen [string length $overtext] set olen [string length $overtext]
set ulen [string length $undertext] set ulen [string length $undertext]
if {$opt(-overflow)} { if {$opt(-overflow)} {
return [string range $undertext 0 end-$olen]$overtext return [string range $undertext 0 end-$olen]$overtext
} else { } else {
if {$olen > $ulen} { if {$olen > $ulen} {
set diff [expr {$olen - $ulen}] set diff [expr {$olen - $ulen}]
return [string range $undertext 0 end-$olen][string range $overtext 0 end-$diff] return [string range $undertext 0 end-$olen][string range $overtext 0 end-$diff]
} else { } else {
return [string range $undertext 0 end-$olen]$overtext return [string range $undertext 0 end-$olen]$overtext
} }
} }
} }
namespace eval overtype { namespace eval overtype {
interp alias {} ::overtype::center {} ::overtype::centre interp alias {} ::overtype::center {} ::overtype::centre
} }

530
src/modules/patternpunk-1.1.tm
Unescape View File

@ -1,265 +1,265 @@
#<?xml version="1.0"?> #<?xml version="1.0"?>
#<xml> #<xml>
#<xpack> #<xpack>
#<code> #<code>
#<![CDATA[ #<![CDATA[
# Author: Julian Marcel Noble <julian@cyberclad.com> # Author: Julian Marcel Noble <julian@cyberclad.com>
# 2004 - Public Domain # 2004 - Public Domain
# #
# PatternPunk - DIALECT # PatternPunk - DIALECT
#Dynamic Instance Accumulation Language Extending Classic Tcl #Dynamic Instance Accumulation Language Extending Classic Tcl
#The goofy acronym is a fancy way of not referring to PatternPunk as yet another OO system. #The goofy acronym is a fancy way of not referring to PatternPunk as yet another OO system.
package require pattern package require pattern
package require overtype package require overtype
pattern::init pattern::init
package provide patternpunk [namespace eval punk { package provide patternpunk [namespace eval punk {
variable version variable version
set version 1.1 set version 1.1
}] }]
::>pattern .. Create ::>punk ::>pattern .. Create ::>punk
::>punk .. Property license {Public Domain} ::>punk .. Property license {Public Domain}
::>punk .. Property logo2 { ::>punk .. Property logo2 {
+-----------------------+ +-----------------------+
| Pattern PUNK | | Pattern PUNK |
| . \\\_ . | | . \\\_ . |
| .*. \@ > .=. | | .*. \@ > .=. |
| .*.*. | ~ .=.=. | | .*.*. | ~ .=.=. |
|.*.*.*.\_- -_/.=.=.=.| |.*.*.*.\_- -_/.=.=.=.|
| .*.*. \\ .=.=. | | .*.*. \\ .=.=. |
| .*. / \ .=. | | .*. / \ .=. |
| . _+ +_ . | | . _+ +_ . |
+-----------------------+ +-----------------------+
} }
set ::punk::bannerTemplate { set ::punk::bannerTemplate {
+-----------------------+ +-----------------------+
| .000000000000000. | | .000000000000000. |
| .*. \\\_ .=. | | .*. \\\_ .=. |
| .*.*. \@ > .=.=. | | .*.*. \@ > .=.=. |
|.*.*.*. | ~ .=.=.=.| |.*.*.*. | ~ .=.=.=.|
| .*.*. \_- -_/ .=.=. | | .*.*. \_- -_/ .=.=. |
| .*. \\ .=. | | .*. \\ .=. |
| . / \ . | | . / \ . |
|111111111_+ +_2222222| |111111111_+ +_2222222|
+-----------------------+ +-----------------------+
} }
>punk .. Method banner {args} { >punk .. Method banner {args} {
set defaults [list -title "Pattern PUNK" -left "" -right ""] set defaults [list -title "Pattern PUNK" -left "" -right ""]
if {[catch {set opts [dict merge $defaults $args]} ]} { if {[catch {set opts [dict merge $defaults $args]} ]} {
error "usage: banner \[-title \$title -left \$left -right \$right\]" error "usage: banner \[-title \$title -left \$left -right \$right\]"
} }
set word1 [overtype::left [string repeat " " 9] [dict get $opts -left]] set word1 [overtype::left [string repeat " " 9] [dict get $opts -left]]
set word2 [overtype::right [string repeat " " 7] [dict get $opts -right]] set word2 [overtype::right [string repeat " " 7] [dict get $opts -right]]
set title [overtype::centre [string repeat " " 15] [dict get $opts -title]] set title [overtype::centre [string repeat " " 15] [dict get $opts -title]]
return [string map [list 111111111 $word1 2222222 $word2 000000000000000 $title] $punk::bannerTemplate] return [string map [list 111111111 $word1 2222222 $word2 000000000000000 $title] $punk::bannerTemplate]
} }
>punk .. Property logo [>punk . banner] >punk .. Property logo [>punk . banner]
>punk .. Property versionLogo [>punk . banner -left " Ver" -right "$::punk::version "] >punk .. Property versionLogo [>punk . banner -left " Ver" -right "$::punk::version "]
>punk .. Property version $::punk::version >punk .. Property version $::punk::version
>punk .. Property front { >punk .. Property front {
_|_ _|_
@ v @ @ v @
~ ~
- - - -
|_\ /_| |_\ /_|
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property back { >punk .. Property back {
| |
( | ) ( | )
| |
- - - -
|_\ /_| |_\ /_|
/ \ / \
_- -_ _- -_
} }
>punk .. Property rhs { >punk .. Property rhs {
\\\_ \\\_
\@ > \@ >
| ~ | ~
\_- -_ \_- -_
\\ / \\ /
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property right >punk .. Property right
>punk .. PropertyRead right {} { >punk .. PropertyRead right {} {
return $o_rhs return $o_rhs
} }
>punk .. Property lhs { >punk .. Property lhs {
_/// _///
< @/ < @/
~ | ~ |
_- -_/ _- -_/
\ // \ //
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property left >punk .. Property left
>punk .. PropertyRead left {} { >punk .. PropertyRead left {} {
return $o_lhs return $o_lhs
} }
>punk .. Property rhs_air { >punk .. Property rhs_air {
\\\_ \\\_
\@ > \@ >
| ~ | ~
\_- -_/ \_- -_/
\\ \\
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property lhs_air { >punk .. Property lhs_air {
_/// _///
< @/ < @/
~ | ~ |
\_- -_/ \_- -_/
// //
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property lhs_hips { >punk .. Property lhs_hips {
_/// _///
< @/ < @/
~ | ~ |
_- -_ _- -_
\ | | / \ | | /
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property rhs_hips { >punk .. Property rhs_hips {
\\\_ \\\_
\@ > \@ >
| ~ | ~
_- -_ _- -_
\ | | / \ | | /
/ \ / \
_+ +_ _+ +_
} }
>punk .. Property piss { >punk .. Property piss {
\\\_ \\\_
\@ > \@ >
| ~ | ~
\_- -_/ \_- -_/
\\_ .. \\_ ..
/ \ .. / \ ..
_+ +_ . _+ +_ .
} }
>punk .. Property poop { >punk .. Property poop {
_/// _///
< @/ < @/
^ | ^ |
_- -_ _- -_
\ \\ / \ \\ /
//. ~ //. ~
_+_+ @ _+_+ @
} }
>punk .. Method dumpProperties {{object ::>punk}} { >punk .. Method dumpProperties {{object ::>punk}} {
foreach {p v} [$object .. Properties . pairs] { foreach {p v} [$object .. Properties . pairs] {
puts $p puts $p
puts [set $v] puts [set $v]
puts \n puts \n
} }
} }
>punk .. Method listProperties {{object ::>punk}} { >punk .. Method listProperties {{object ::>punk}} {
set result {} set result {}
foreach {p v} [$object .. Properties . pairs] { foreach {p v} [$object .. Properties . pairs] {
lappend result $p [set $v] lappend result $p [set $v]
} }
return $result return $result
} }
########################################################## ##########################################################
#CANDY-CODE #CANDY-CODE
# #
#!todo - unset etc. #!todo - unset etc.
if {[info proc ::punk::_unknown] eq ""} {rename unknown ::punk::_unknown} if {[info proc ::punk::_unknown] eq ""} {rename unknown ::punk::_unknown}
proc ::punk::var {varname {= {}} args} { proc ::punk::var {varname {= {}} args} {
if {${=} == "="} { if {${=} == "="} {
if {[llength $args] > 1} { if {[llength $args] > 1} {
uplevel 1 [list set $varname [uplevel 1 $args]] uplevel 1 [list set $varname [uplevel 1 $args]]
} else { } else {
uplevel 1 [list set $varname [lindex $args 0]] uplevel 1 [list set $varname [lindex $args 0]]
} }
} else { } else {
uplevel 1 [list set $varname] uplevel 1 [list set $varname]
} }
} }
proc unknown {args} { proc unknown {args} {
if {[lindex $args 1] eq "="} { if {[lindex $args 1] eq "="} {
set n [lindex $args 0] set n [lindex $args 0]
set v [lindex $args 2] set v [lindex $args 2]
#uplevel 1 [string map [list @n@ $n @v@ $v] {proc @n@ {= val} {uplevel 1 set @n@ $val}}] #uplevel 1 [string map [list @n@ $n @v@ $v] {proc @n@ {= val} {uplevel 1 set @n@ $val}}]
uplevel 1 [list interp alias {} $n {} ::punk::var $n] uplevel 1 [list interp alias {} $n {} ::punk::var $n]
#uplevel 1 [list trace add variable $n unset [string map [list @n@ $n] {uplevel 1 [list interp alias {} @n@ {}]}]] #uplevel 1 [list trace add variable $n unset [string map [list @n@ $n] {uplevel 1 [list interp alias {} @n@ {}]}]]
uplevel 1 [list trace add variable $n unset [list interp alias {} $n {}]] uplevel 1 [list trace add variable $n unset [list interp alias {} $n {}]]
if {[llength $args] > 3} { if {[llength $args] > 3} {
#RHS consists of multiple args; evaluate #RHS consists of multiple args; evaluate
return [uplevel 1 [list set $n [uplevel 1 [lrange $args 2 end]]]] return [uplevel 1 [list set $n [uplevel 1 [lrange $args 2 end]]]]
} else { } else {
#RHS is single arg; treat as value #RHS is single arg; treat as value
return [uplevel 1 [list set $n $v]] return [uplevel 1 [list set $n $v]]
} }
} else { } else {
#delegate to original 'unknown' command #delegate to original 'unknown' command
uplevel 1 ::punk::_unknown $args uplevel 1 ::punk::_unknown $args
} }
} }
#Cute names for file I/O #Cute names for file I/O
proc <- filename { proc <- filename {
set fp [open $filename] set fp [open $filename]
::pattern::K [read $fp] [close $fp] ::pattern::K [read $fp] [close $fp]
} }
proc -> {filename string} { proc -> {filename string} {
set fp [open $filename w] set fp [open $filename w]
puts $fp $string puts $fp $string
close $fp close $fp
} }
proc ->> {filename string} { proc ->> {filename string} {
set fp [open $filename a] set fp [open $filename a]
puts $fp $string puts $fp $string
close $fp close $fp
} }
#presumably this is to allow calling of standard objects using dotted notation? #presumably this is to allow calling of standard objects using dotted notation?
::>pattern .. Create ::> ::>pattern .. Create ::>
::> .. Method item {args} { ::> .. Method item {args} {
#uplevel #0 $args #uplevel #0 $args
#uplevel #0 [join $args] #uplevel #0 [join $args]
uplevel #0 $args uplevel #0 $args
} }
#]]> #]]>
#</code> #</code>
#<files> #<files>
#</files> #</files>
#</xpack> #</xpack>
#</xml> #</xml>

1084
src/modules/punk-0.1.tm
View File

File diff suppressed because it is too large Load Diff

776
src/modules/shellrun-0.1.tm
Unescape View File

@ -1,388 +1,388 @@
# vim: set ft=tcl # vim: set ft=tcl
# #
package provide shellrun [namespace eval shellrun { package provide shellrun [namespace eval shellrun {
variable version variable version
set version 0.1 set version 0.1
}] }]
#purpose: handle the run commands that call shellfilter::run #purpose: handle the run commands that call shellfilter::run
#e.g run,runout,runerr,runx #e.g run,runout,runerr,runx
#NOTE: the run,runout,runerr,runx commands only produce an error if the command didn't run. #NOTE: the run,runout,runerr,runx commands only produce an error if the command didn't run.
# - If it did run, but there was a non-zero exitcode it is up to the application to check that. # - If it did run, but there was a non-zero exitcode it is up to the application to check that.
#This is deliberate, but means 'catch' doesn't catch errors within the command itself - the exitcode has to be checked. #This is deliberate, but means 'catch' doesn't catch errors within the command itself - the exitcode has to be checked.
#The user can always use exec for different process error semantics (they don't get exitcode with exec) #The user can always use exec for different process error semantics (they don't get exitcode with exec)
namespace eval shellrun { namespace eval shellrun {
variable runout variable runout
variable runerr variable runerr
proc run {args} { proc run {args} {
set ::punk::last_run_display [list] set ::punk::last_run_display [list]
#we provide -nonewline for 'run' even though run doesn't deliver stderr or stdout to the tcl return value #we provide -nonewline for 'run' even though run doesn't deliver stderr or stdout to the tcl return value
#This is for compatibility with other runX commands, and the difference is also visible when calling from repl. #This is for compatibility with other runX commands, and the difference is also visible when calling from repl.
set known_runopts [list "-echo" "-e" "-nonewline" "-n"] set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
set runopts [list] set runopts [list]
set cmdargs [list] set cmdargs [list]
set idx_first_cmdarg [lsearch -not $args "-*"] set idx_first_cmdarg [lsearch -not $args "-*"]
set runopts [lrange $args 0 $idx_first_cmdarg-1] set runopts [lrange $args 0 $idx_first_cmdarg-1]
set cmdargs [lrange $args $idx_first_cmdarg end] set cmdargs [lrange $args $idx_first_cmdarg end]
foreach o $runopts { foreach o $runopts {
if {$o ni $known_runopts} { if {$o ni $known_runopts} {
error "run: Unknown runoption $o" error "run: Unknown runoption $o"
} }
} }
set runopts [lmap o $runopts {dict get $aliases $o}] set runopts [lmap o $runopts {dict get $aliases $o}]
if {"-nonewline" in $runopts} { if {"-nonewline" in $runopts} {
set nonewline 1 set nonewline 1
} else { } else {
set nonewline 0 set nonewline 0
} }
set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] set id_err [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}]
set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
shellfilter::stack::remove stderr $id_err shellfilter::stack::remove stderr $id_err
flush stderr flush stderr
flush stdout flush stdout
set c [shellfilter::ansi::+ green] set c [shellfilter::ansi::+ green]
set n [shellfilter::ansi::+] set n [shellfilter::ansi::+]
if {[dict exists $exitinfo error]} { if {[dict exists $exitinfo error]} {
error [dict get $exitinfo error] error [dict get $exitinfo error]
} }
return $exitinfo return $exitinfo
} }
proc runout {args} { proc runout {args} {
set ::punk::last_run_display [list] set ::punk::last_run_display [list]
variable runout variable runout
variable runerr variable runerr
set runout "" set runout ""
set runerr "" set runerr ""
set known_runopts [list "-echo" "-e" "-nonewline" "-n"] set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
set runopts [list] set runopts [list]
set cmdargs [list] set cmdargs [list]
set idx_first_cmdarg [lsearch -not $args "-*"] set idx_first_cmdarg [lsearch -not $args "-*"]
set runopts [lrange $args 0 $idx_first_cmdarg-1] set runopts [lrange $args 0 $idx_first_cmdarg-1]
set cmdargs [lrange $args $idx_first_cmdarg end] set cmdargs [lrange $args $idx_first_cmdarg end]
foreach o $runopts { foreach o $runopts {
if {$o ni $known_runopts} { if {$o ni $known_runopts} {
error "runout: Unknown runoption $o" error "runout: Unknown runoption $o"
} }
} }
set runopts [lmap o $runopts {dict get $aliases $o}] set runopts [lmap o $runopts {dict get $aliases $o}]
if {"-nonewline" in $runopts} { if {"-nonewline" in $runopts} {
set nonewline 1 set nonewline 1
} else { } else {
set nonewline 0 set nonewline 0
} }
#puts stdout "RUNOUT cmdargs: $cmdargs" #puts stdout "RUNOUT cmdargs: $cmdargs"
#todo add -data boolean and -data lastwrite to -settings with default being -data all #todo add -data boolean and -data lastwrite to -settings with default being -data all
# because sometimes we're only interested in last char (e.g to detect something was output) # because sometimes we're only interested in last char (e.g to detect something was output)
#set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}] #set outvar_stackid [shellfilter::stack::add commandout tee_to_var -action float -settings {-varname ::runout}]
# #
#when not echoing - use float-locked so that the repl's stack is bypassed #when not echoing - use float-locked so that the repl's stack is bypassed
if {"-echo" in $runopts} { if {"-echo" in $runopts} {
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
#set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}] #set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}]
} else { } else {
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}]
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}]
} }
#shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler #shellfilter::run [lrange $args 1 end] -teehandle punk -outchan stdout -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler
set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ] set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none ]
flush stderr flush stderr
flush stdout flush stdout
shellfilter::stack::remove stdout $stdout_stackid shellfilter::stack::remove stdout $stdout_stackid
shellfilter::stack::remove stderr $stderr_stackid shellfilter::stack::remove stderr $stderr_stackid
#shellfilter::stack::remove commandout $outvar_stackid #shellfilter::stack::remove commandout $outvar_stackid
if {[dict exists $exitinfo error]} { if {[dict exists $exitinfo error]} {
#we must raise an error. #we must raise an error.
#todo - check errorInfo makes sense.. return -code? tailcall? #todo - check errorInfo makes sense.. return -code? tailcall?
error [dict get $exitinfo error] error [dict get $exitinfo error]
} }
set chunklist [list] set chunklist [list]
set n [a+] set n [a+]
set c "" set c ""
if [dict exists $exitinfo exitcode] { if [dict exists $exitinfo exitcode] {
set code [dict get $exitinfo exitcode] set code [dict get $exitinfo exitcode]
if {$code == 0} { if {$code == 0} {
set c [a+ green] set c [a+ green]
} else { } else {
set c [a+ white bold] set c [a+ white bold]
} }
} else { } else {
set c [a+ Yellow red bold] set c [a+ Yellow red bold]
} }
#exitcode not part of return value for runout - colourcode appropriately #exitcode not part of return value for runout - colourcode appropriately
lappend chunklist [list stderr "$c$exitinfo$n\n"] lappend chunklist [list stderr "$c$exitinfo$n\n"]
set chunk "[a+ red bold]stderr[a+]\n" set chunk "[a+ red bold]stderr[a+]\n"
if {[string length $::shellrun::runerr]} { if {[string length $::shellrun::runerr]} {
if {$nonewline} { if {$nonewline} {
set e [string trimright $::shellrun::runerr \r\n] set e [string trimright $::shellrun::runerr \r\n]
} else { } else {
set e $::shellrun::runerr set e $::shellrun::runerr
} }
append chunk "[a+ red light]$e[a+]\n" append chunk "[a+ red light]$e[a+]\n"
} }
lappend chunklist [list stderr $chunk] lappend chunklist [list stderr $chunk]
lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"] lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
set chunk "" set chunk ""
if {[string length $::shellrun::runout]} { if {[string length $::shellrun::runout]} {
if {$nonewline} { if {$nonewline} {
set o [string trimright $::shellrun::runout \r\n] set o [string trimright $::shellrun::runout \r\n]
} else { } else {
set o $::shellrun::runout set o $::shellrun::runout
} }
append chunk "$o\n" ;#this newline is the display output separator - always there whether data has trailing newline or not. append chunk "$o\n" ;#this newline is the display output separator - always there whether data has trailing newline or not.
} }
lappend chunklist [list stdout $chunk] lappend chunklist [list stdout $chunk]
set ::punk::last_run_display $chunklist set ::punk::last_run_display $chunklist
if {$nonewline} { if {$nonewline} {
return [string trimright $::shellrun::runout \r\n] return [string trimright $::shellrun::runout \r\n]
} else { } else {
return $::shellrun::runout return $::shellrun::runout
} }
} }
proc runerr {args} { proc runerr {args} {
set ::punk::last_run_display [list] set ::punk::last_run_display [list]
variable runout variable runout
variable runerr variable runerr
set runout "" set runout ""
set runerr "" set runerr ""
set known_runopts [list "-echo" "-e" "-nonewline" "-n"] set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
set runopts [list] set runopts [list]
set cmdargs [list] set cmdargs [list]
set idx_first_cmdarg [lsearch -not $args "-*"] set idx_first_cmdarg [lsearch -not $args "-*"]
set runopts [lrange $args 0 $idx_first_cmdarg-1] set runopts [lrange $args 0 $idx_first_cmdarg-1]
set cmdargs [lrange $args $idx_first_cmdarg end] set cmdargs [lrange $args $idx_first_cmdarg end]
foreach o $runopts { foreach o $runopts {
if {$o ni $known_runopts} { if {$o ni $known_runopts} {
error "runerr: Unknown runoption $o" error "runerr: Unknown runoption $o"
} }
} }
set runopts [lmap o $runopts {dict get $aliases $o}] set runopts [lmap o $runopts {dict get $aliases $o}]
if {"-nonewline" in $runopts} { if {"-nonewline" in $runopts} {
set nonewline 1 set nonewline 1
} else { } else {
set nonewline 0 set nonewline 0
} }
if {"-echo" in $runopts} { if {"-echo" in $runopts} {
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action float-locked -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action float-locked -settings {-varname ::shellrun::runout}]
} else { } else {
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -settings {-varname ::shellrun::runout}]
} }
set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
shellfilter::stack::remove stderr $stderr_stackid shellfilter::stack::remove stderr $stderr_stackid
shellfilter::stack::remove stdout $stdout_stackid shellfilter::stack::remove stdout $stdout_stackid
flush stderr flush stderr
flush stdout flush stdout
#we raise an error because an error during calling is different to collecting stderr from a command, and the caller should be able to wrap in a catch #we raise an error because an error during calling is different to collecting stderr from a command, and the caller should be able to wrap in a catch
# to determine something other than just a nonzero exit code or output on stderr. # to determine something other than just a nonzero exit code or output on stderr.
if {[dict exists $exitinfo error]} { if {[dict exists $exitinfo error]} {
#todo - check errorInfo makes sense.. return -code? tailcall? #todo - check errorInfo makes sense.. return -code? tailcall?
error [dict get $exitinfo error] error [dict get $exitinfo error]
} }
set chunklist [list] set chunklist [list]
set n [a+] set n [a+]
set c "" set c ""
if [dict exists $exitinfo exitcode] { if [dict exists $exitinfo exitcode] {
set code [dict get $exitinfo exitcode] set code [dict get $exitinfo exitcode]
if {$code == 0} { if {$code == 0} {
set c [a+ green] set c [a+ green]
} else { } else {
set c [a+ white bold] set c [a+ white bold]
} }
} else { } else {
set c [a+ Yellow red bold] set c [a+ Yellow red bold]
} }
#exitcode not part of return value for runout - colourcode appropriately #exitcode not part of return value for runout - colourcode appropriately
lappend chunklist [list stderr "$c$exitinfo$n\n"] lappend chunklist [list stderr "$c$exitinfo$n\n"]
lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"] lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
set chunk "" set chunk ""
if {[string length $::shellrun::runout]} { if {[string length $::shellrun::runout]} {
if {$nonewline} { if {$nonewline} {
set o [string trimright $::shellrun::runout \r\n] set o [string trimright $::shellrun::runout \r\n]
} else { } else {
set o $::shellrun::runout set o $::shellrun::runout
} }
append chunk "[a+ white light]$o[a+]\n" ;#this newline is the display output separator - always there whether data has trailing newline or not. append chunk "[a+ white light]$o[a+]\n" ;#this newline is the display output separator - always there whether data has trailing newline or not.
} }
lappend chunklist [list stdout $chunk] lappend chunklist [list stdout $chunk]
set chunk "[a+ red bold]stderr[a+]\n" set chunk "[a+ red bold]stderr[a+]\n"
if {[string length $::shellrun::runerr]} { if {[string length $::shellrun::runerr]} {
if {$nonewline} { if {$nonewline} {
set e [string trimright $::shellrun::runerr \r\n] set e [string trimright $::shellrun::runerr \r\n]
} else { } else {
set e $::shellrun::runerr set e $::shellrun::runerr
} }
append chunk "$e\n" append chunk "$e\n"
} }
lappend chunklist [list stderr $chunk] lappend chunklist [list stderr $chunk]
set ::punk::last_run_display $chunklist set ::punk::last_run_display $chunklist
if {$nonewline} { if {$nonewline} {
return [string trimright $::shellrun::runerr \r\n] return [string trimright $::shellrun::runerr \r\n]
} }
return $::shellrun::runerr return $::shellrun::runerr
} }
proc runx {args} { proc runx {args} {
set ::punk::last_run_display [list] set ::punk::last_run_display [list]
variable last_run_display variable last_run_display
variable runout variable runout
variable runerr variable runerr
set runout "" set runout ""
set runerr "" set runerr ""
set known_runopts [list "-echo" "-e" "-nonewline" "-n"] set known_runopts [list "-echo" "-e" "-nonewline" "-n"]
set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self set aliases [list "-e" "-echo" "-echo" "-echo" "-n" "-nonewline" "-nonewline" "-nonewline"] ;#include map to self
set runopts [list] set runopts [list]
set cmdargs [list] set cmdargs [list]
set idx_first_cmdarg [lsearch -not $args "-*"] set idx_first_cmdarg [lsearch -not $args "-*"]
set runopts [lrange $args 0 $idx_first_cmdarg-1] set runopts [lrange $args 0 $idx_first_cmdarg-1]
set cmdargs [lrange $args $idx_first_cmdarg end] set cmdargs [lrange $args $idx_first_cmdarg end]
foreach o $runopts { foreach o $runopts {
if {$o ni $known_runopts} { if {$o ni $known_runopts} {
error "runx: Unknown runoption $o - known options $known_runopts" error "runx: Unknown runoption $o - known options $known_runopts"
} }
} }
set runopts [lmap o $runopts {dict get $aliases $o}] set runopts [lmap o $runopts {dict get $aliases $o}]
if {"-nonewline" in $runopts} { if {"-nonewline" in $runopts} {
set nonewline 1 set nonewline 1
} else { } else {
set nonewline 0 set nonewline 0
} }
#shellfilter::stack::remove stdout $::repl::id_outstack #shellfilter::stack::remove stdout $::repl::id_outstack
if {"-echo" in $runopts} { if {"-echo" in $runopts} {
set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr tee_to_var -action sink-locked -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout tee_to_var -action sink-locked -settings {-varname ::shellrun::runout}]
} else { } else {
#set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::shellrun::runerr}] #set stderr_stackid [shellfilter::stack::add stderr var -action sink-locked -settings {-varname ::shellrun::runerr}]
#set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::shellrun::runout}] #set stdout_stackid [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::shellrun::runout}]
#float above the repl's tee_to_var to deliberately block it. #float above the repl's tee_to_var to deliberately block it.
#a var transform is naturally a junction point because there is no flow-through.. #a var transform is naturally a junction point because there is no flow-through..
# - but mark it with -junction 1 just to be explicit # - but mark it with -junction 1 just to be explicit
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -junction 1 -settings {-varname ::shellrun::runerr}] set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -junction 1 -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -junction 1 -settings {-varname ::shellrun::runout}] set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -junction 1 -settings {-varname ::shellrun::runout}]
} }
#set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler] #set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none -stdinhandler ::repl::repl_handler]
set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none] set exitinfo [shellfilter::run $cmdargs -teehandle punk -inbuffering none -outbuffering none]
shellfilter::stack::remove stdout $stdout_stackid shellfilter::stack::remove stdout $stdout_stackid
shellfilter::stack::remove stderr $stderr_stackid shellfilter::stack::remove stderr $stderr_stackid
flush stderr flush stderr
flush stdout flush stdout
if {[dict exists $exitinfo error]} { if {[dict exists $exitinfo error]} {
#todo - check errorInfo makes sense.. return -code? tailcall? #todo - check errorInfo makes sense.. return -code? tailcall?
error [dict get $exitinfo error] error [dict get $exitinfo error]
} }
#set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}] #set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}]
set chunklist [list] set chunklist [list]
lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"] lappend chunklist [list stderr "[a+ white bold]stdout[a+]\n"]
set chunk "" set chunk ""
if {[string length $::shellrun::runout]} { if {[string length $::shellrun::runout]} {
if {$nonewline} { if {$nonewline} {
set o [string trimright $::shellrun::runout \r\n] set o [string trimright $::shellrun::runout \r\n]
} else { } else {
set o $::shellrun::runout set o $::shellrun::runout
} }
append chunk $o\n append chunk $o\n
} }
lappend chunklist [list stdout $chunk] lappend chunklist [list stdout $chunk]
set chunk "[a+ red bold]stderr[a+]\n" set chunk "[a+ red bold]stderr[a+]\n"
if {[string length $::shellrun::runerr]} { if {[string length $::shellrun::runerr]} {
if {$nonewline} { if {$nonewline} {
set e [string trimright $::shellrun::runerr \r\n] set e [string trimright $::shellrun::runerr \r\n]
} else { } else {
set e $::shellrun::runerr set e $::shellrun::runerr
} }
append chunk $e\n append chunk $e\n
} }
lappend chunklist [list stderr $chunk] lappend chunklist [list stderr $chunk]
set n [a+] set n [a+]
set c "" set c ""
if [dict exists $exitinfo exitcode] { if [dict exists $exitinfo exitcode] {
set code [dict get $exitinfo exitcode] set code [dict get $exitinfo exitcode]
if {$code == 0} { if {$code == 0} {
set c [a+ green] set c [a+ green]
} else { } else {
set c [a+ white bold] set c [a+ white bold]
} }
} }
lappend chunklist [list stderr "$c$exitinfo$n\n"] lappend chunklist [list stderr "$c$exitinfo$n\n"]
set ::punk::last_run_display $chunklist set ::punk::last_run_display $chunklist
#set ::repl::result_print 0 #set ::repl::result_print 0
#return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0] #return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0]
if {$nonewline} { if {$nonewline} {
return [list stdout [string trimright $::shellrun::runout \r\n] stderr [string trimright $::shellrun::runerr \r\n] {*}$exitinfo] return [list stdout [string trimright $::shellrun::runout \r\n] stderr [string trimright $::shellrun::runerr \r\n] {*}$exitinfo]
} }
#always return exitinfo $code at beginning of dict (so that punk unknown can interpret the exit code as a unix-style bool if double evaluated) #always return exitinfo $code at beginning of dict (so that punk unknown can interpret the exit code as a unix-style bool if double evaluated)
return [list {*}$exitinfo stdout $::shellrun::runout stderr $::shellrun::runerr] return [list {*}$exitinfo stdout $::shellrun::runout stderr $::shellrun::runerr]
} }
} }

1190
src/modules/shellthread-1.6.tm
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save