@ -1,6 +1,10 @@
# t e m p
package provide app-punk 1.0
namespace eval punk {
}
set stdin_info [ chan configure stdin]
if { [ dict exists $stdin_info - inputmode] } {
# t h i s i s t h e o n l y w a y I c u r r e n t l y k n o w t o d e t e c t c o n s o l e o n w i n d o w s . . d o e s n ' t w o r k o n A l m a l i n u x .
@ -23,11 +27,181 @@ proc todo {} {
}
tcl : : tm::add [ pwd ] / modules
if { ! [ info exists : : env( SHELL ) ] } {
set : : env( SHELL ) punk86
}
if { ! [ info exists : : env( TERM ) ] } {
# f a k e i t
# s e t : : e n v ( T E R M ) v t 1 0 0
set : : env( TERM ) xterm-256color
}
namespace eval punk {
set syslog_stdout " 1 2 7 . 0 . 0 . 1 : 5 1 4 "
set syslog_stderr " 1 2 7 . 0 . 0 . 1 : 5 1 4 "
# d e f a u l t f i l e l o g s t o l o g s f o l d e r a t s a m e l o c a t i o n a s e x e i f w r i t a b l e , o r e m p t y s t r i n g
set logfile_stdout " "
set logfile_stderr " "
set exefolder [ file dirname [ info nameofexecutable] ]
set logfolder $exefolder / logs
if { [ file exists $logfolder ] } {
if { [ file isdirectory $logfolder ] && [ file writable $logfolder ] } {
set logfile_stdout $logfolder / repl-exec-stdout.txt
set logfile_stderr $logfolder / repl-exec-stderr.txt
}
}
# o v e r r i d e w i t h e n v v a r s i f s e t
if { [ info exists : : env( PUNK_LOGFILE_STDOUT ) ] } {
set f $::env ( PUNK_LOGFILE_STDOUT )
if { $f ne " d e f a u l t " } {
set logfile_stdout $f
}
}
if { [ info exists : : env( PUNK_LOGFILE_STDERR ) ] } {
set f $::env ( PUNK_LOGFILE_STDERR )
if { $f ne " d e f a u l t " } {
set logfile_stderr $f
}
}
if { [ info exists : : env( PUNK_SYSLOG_STDOUT ) ] } {
set u $::env ( PUNK_SYSLOG_STDOUT )
if { $u ne " d e f a u l t " } {
set syslog_stdout $u
}
}
if { [ info exists : : env( PUNK_SYSLOG_STDERR ) ] } {
set u $::env ( PUNK_SYSLOG_STDERR )
if { $u ne " d e f a u l t " } {
set syslog_stderr $u
}
}
catch {
unset u
unset f
}
# u s e f u l f o r a l i a s e s e . g t r e e m o r e - > x m o r e t r e e
proc xmore { args } {
{ * } $args | more
}
proc winpath { path } {
# c o n v e r t / c / e t c t o C : / e t c
set re { ^ / ( [ [ : alpha : ] ] ) { 1 } / . * }
set volumes [ file volumes]
# e x c l u d e t h i n g s l i k e / / z i p f s : /
set driveletters [ list ]
foreach v $volumes {
if { [ regexp { ^ ( [ [ : alpha : ] ] ) { 1 } : / $ } $v _ letter] } {
lappend driveletters $letter
}
}
# p u t s s t d e r r " - > $ d r i v e l e t t e r s "
if { [ regexp $re $path _ letter] } {
# u p p e r c a s e a p p e a r s t o b e w i n d o w s c a n o n i c a l f o r m
if { [ string toupper $letter ] in $driveletters } {
set path [ string toupper $letter ] : / [ string range $path 3 end]
}
} elseif { [ regexp { ^ / mnt | MNT/ ( [ [ : alpha : ] ] ) { 1 } / .* } $path _ letter] } {
if { [ string toupper $letter ] in $driveletters } {
set path [ string toupper $letter ] : / [ string range $path 7 end]
}
}
# p u t s s t d e r r " = > $ p a t h "
# t h i n g s l i k e ' w h i c h ' s e e m t o r e t u r n a p a t h m i n u s t h e . e x e - s o w e ' l l j u s t t e s t t h e c o n t a i n i n g f o l d e r
if { ! [ file exists [ file dirname $path ] ] } {
set path [ file normalize $path ]
}
return $path
}
proc windir { path } {
return [ file dirname [ punk : : winpath $path ] ]
}
namespace export help aliases alias cdwin cdwindir winpath windir
namespace ensemble create
proc cdwin { path } {
set path [ punk : : winpath $path ]
cd $path
}
proc cdwindir { path } {
set path [ punk : : winpath $path ]
cd [ file dirname $path ]
}
proc help { } {
catch {
package require patternpunk
puts - nonewline stderr [ > punk . rhs]
}
puts stdout " P u n k c o m m a n d s : "
puts stdout " p u n k h e l p "
}
# c u r r e n t i n t e r p a l i a s e s e x c e p t t h o s e c r e a t e d b y p a t t e r n p a c k a g e ' : : p : : * '
proc aliases { { glob * } } {
set interesting [ lmap a [ interp aliases " " ] { expr { ! [ string match : : p::* $a ] ? $a : [ continue ] } } ]
}
proc alias { a args} {
if { [ llength $args ] } {
if { $a in [ interp aliases " " ] } {
set existing [ interp alias " " $a ]
puts stderr " O v e r w r i t i n g e x i s t i n g a l i a s $ a - > $ e x i s t i n g w i t h $ a - > $ a r g s ( i n c u r r e n t s e s s i o n o n l y ) "
}
interp alias " " $a " " { * } $args
} else {
return [ interp alias " " $a ]
}
}
# g l o b a l a l i a s e s - k e e p t o a m i n i m u m
interp alias { } help { } punk help
interp alias { } aliases { } punk aliases
interp alias { } alias { } punk alias
interp alias { } treemore { } punk::xmore tree
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# l e a v e t h e w i n p a t h r e l a t e d a l i a s e s a v a i l a b l e o n a l l p l a t f o r m s
interp alias { } cdwin { } punk cdwin
interp alias { } cdwindir { } punk cdwindir
interp alias { } winpath { } punk winpath
interp alias { } windir { } punk windir
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
interp alias { } ll { } ls - laFo - - color= always
interp alias { } lw { } ls - aFv - - color= always
if { $::tcl_platform ( platform ) eq " w i n d o w s " } {
set has_powershell 1
interp alias { } dl { } dir / q
interp alias { } dw { } dir / W/ D
} else {
# t o d o - n a t s o r t e d e q u i v a l e n t
# i n t e r p a l i a s { } d l { }
# t o d o - p o w e r s h e l l d e t e c t i o n o n o t h e r p l a t f o r m s
set has_powershell 0
}
if { $has_powershell } {
interp alias { } psls { } pwsh - nop - nolo - c ls
interp alias { } psps { } pwsh - nop - nolo - c ps
}
}
set : : punk::PUNKRUN 0 ; # w h e t h e r t o u s e s h e l l f i l t e r : : r u n i n s t e a d o f e x e c .
package require shellfilter
package require Thread
set outdevice [ shellfilter : : stack::new punkout - settings { -tag " p u n k o u t " - buffering none - raw 1 - syslog 127.0 .0.1:514 - file " c : / r e p o / j n / s h e l l s p y / l o g s / r e p l - e x e c - s t d o u t . t x t " } ]
set outdevice [ shellfilter : : stack::new punkout - settings [ list - tag " p u n k o u t " - buffering none - raw 1 - syslog $::punk::syslog_stdout - file $::punk::logfile_stdout ] ]
set out [ dict get $outdevice localchan]
set errdevice [ shellfilter : : stack::new punkerr - settings { -tag " p u n k e r r " - buffering none - raw 1 - syslog 127.0 .0.1:514 - file " c : / r e p o / j n / s h e l l s p y / l o g s / r e p l - e x e c - s t d e r r . t x t " } ]
set errdevice [ shellfilter : : stack::new punkerr - settings [ list - tag" p u n k e r r " - buffering none - raw 1 - syslog $::punk::syslog_stderr - file $::punk::logfile_stderr ] ]
set err [ dict get $errdevice localchan]
#
# s e t i n d e v i c e [ s h e l l f i l t e r : : s t a c k : : n e w c o m m a n d i n - s e t t i n g s { - t a g " c o m m a n d i n " - r e a d b u f f e r i n g l i n e - w r i t e b u f f e r i n g n o n e - r a w 1 - d i r e c t i o n i n } ]
@ -185,19 +359,19 @@ proc unknown args {
# T h e s e c a n b e s t a c k e d w i t h s h e l l f i l t e r a n d o p e r a t e a s O S h a n d l e s - w h i c h w e c a n ' t d o w i t h f i f o 2 e t c
#
if { [ string first " " $new ] > 0 } {
set c1 $name
} else {
set c1 $new
}
# ' s c r i p t ' c o m m a n d t o f a k e a t t y
# n o t e t h a t w e l o s e t h e e x i t c o d e f r o m t h e u n d e r l y i n g c o m m a n d b y u s i n g ' s c r i p t ' i f w e c a l l s h e l l f i l t e r : : r u n w i t h o u t - e o p t i o n t o s c r i p t
set scr [ auto_execok script]
set scr " " ; # s e t s r c t o e m p t y t o d i s a b l e - s c r i p t i s j u s t a p r o b l e m a t i c e x p e r i m e n t
if { $scr ne " " } {
if { [ string first " " $new ] > 0 } {
set c1 $name
} else {
set c1 $new
}
# s e t s c r i p t r u n " ( $ c 1 [ l r a n g e $ a r g s 1 e n d ] ) "
set scriptrun_commandlist [ shellfilter : : get_scriptrun_from_cmdlist_dquote_if_not $args ]
if 0 {
set scriptrun " ( $ c 1 "
@ -239,31 +413,72 @@ proc unknown args {
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# p u t s s t d e r r " > > > s c r i p t r u n _ c o m m a n d l i s t : $ s c r i p t r u n _ c o m m a n d l i s t "
# u p l e v e l 1 [ l i s t : : c a t c h \
[ list : : shellfilter::run [ list $scr - q - e - c $scriptrun / dev/ null] - teehandle punk - inbuffering line - outbuffering none ] \
: : tcl : : UnknownResult : : tcl::UnknownOptions]
if { [ string tolower [ file rootname [ file tail $new ] ] ] ne " s c r i p t " } {
if { $::env ( SHELL ) eq " p u n k 8 6 " } {
set shellcmdflag " p u n k 8 6 c m d b "
} elseif { $::env ( SHELL ) eq " c m d " } {
set shellcmdflag " c m d / c "
} elseif { $::env ( SHELL ) eq " p w s h " } {
set shellcmdflag " p w s h - c "
} else {
# s h e t c
# s e t s h e l l c m d f l a g " $ : : e n v ( S H E L L ) - c "
set shellcmdflag " - c "
}
uplevel 1 [ list : : catch \
[ list : : shellfilter::run $scriptrun_commandlist - teehandle punk - inbuffering line - outbuffering none ] \
: : tcl : : UnknownResult : : tcl::UnknownOptions]
# s e t c o m m a n d l i s t [ s h e l l f i l t e r : : g e t _ s c r i p t r u n _ f r o m _ c m d l i s t _ d q u o t e _ i f _ n o t [ c o n c a t [ l i s t $ n e w ] [ l r a n g e $ a r g s 1 e n d ] ] ]
set commandlist [ shellfilter : : get_scriptrun_from_cmdlist_dquote_if_not $args $shellcmdflag ]
puts stderr " > > > [ l i n d e x $ c o m m a n d l i s t 4 ] "
} else {
set commandlist [ list $new { * } [ lrange $args 1 end] ]
}
puts stderr " > > > s c r i p t r u n _ c o m m a n d l i s t : $ c o m m a n d l i s t "
# p u t s s t d e r r " s c r i p t r e s u l t $ : : t c l : : U n k n o w n O p t i o n s $ : : t c l : : U n k n o w n R e s u l t "
} else {
uplevel 1 [ list : : catch \
[ list : : shellfilter::run [ concat $new [ lrange $args 1 end] ] - teehandle punk - inbuffering line - outbuffering none ] \
: : tcl : : UnknownResult : : tcl::UnknownOptions]
}
if { [ string trim $::tcl::UnknownResult ] ne " e x i t c o d e 0 " } {
dict set : : tcl::UnknownOptions - code error
set : : tcl::UnknownResult " N o n - z e r o e x i t c o d e f r o m c o m m a n d ' $ c 1 [ l r a n g e $ a r g s 1 e n d ] ' $ : : t c l : : U n k n o w n R e s u l t "
# s e t i d _ s t d e r r [ s h e l l f i l t e r : : s t a c k : : a d d s t d e r r a n s i w r a p - s e t t i n g s { - c o l o u r { r e d b o l d } } ]
uplevel # 0 [ list : : catch [ list : : shellfilter::run $commandlist - teehandle punk - inbuffering line - outbuffering none ] : : tcl::UnknownResult : : tcl::UnknownOptions]
# s h e l l f i l t e r : : s t a c k : : r e m o v e s t d e r r $ i d _ s t d e r r
puts stdout " s c r i p t r e s u l t $ : : t c l : : U n k n o w n O p t i o n s $ : : t c l : : U n k n o w n R e s u l t "
if { [ string trim $::tcl::UnknownResult ] ne " e x i t c o d e 0 " } {
dict set : : tcl::UnknownOptions - code error
set : : tcl::UnknownResult " N o n - z e r o e x i t c o d e f r o m c o m m a n d ' $ a r g s ' $ : : t c l : : U n k n o w n R e s u l t "
} else {
# n o p o i n t r e t u r n i n g " e x i t c o d e 0 " i f t h a t ' s t h e o n l y n o n - e r r o r r e t u r n .
# I t i s m i s l e a d i n g . B e t t e r t o r e t u r n e m p t y s t r i n g .
set : : tcl::UnknownResult " "
}
} else {
# n o p o i n t r e t u r n i n g " e x i t c o d e 0 " i f t h a t ' s t h e o n l y n o n - e r r o r r e t u r n .
# I t i s m i s l e a d i n g . B e t t e r t o r e t u r n e m p t y s t r i n g .
set : : tcl::UnknownResult " "
set id_stderr [ shellfilter : : stack::add stderr ansiwrap - settings { -colour { red bold} } ]
if { $::punk::PUNKRUN } {
uplevel 1 [ list : : catch \
[ list : : shellfilter::run [ concat [ list $new ] [ lrange $args 1 end] ] - teehandle punk - inbuffering line - outbuffering none ] \
: : tcl : : UnknownResult : : tcl::UnknownOptions]
if { [ string trim $::tcl::UnknownResult ] ne " e x i t c o d e 0 " } {
dict set : : tcl::UnknownOptions - code error
set : : tcl::UnknownResult " N o n - z e r o e x i t c o d e f r o m c o m m a n d ' $ a r g s ' $ : : t c l : : U n k n o w n R e s u l t "
} else {
# n o p o i n t r e t u r n i n g " e x i t c o d e 0 " i f t h a t ' s t h e o n l y n o n - e r r o r r e t u r n .
# I t i s m i s l e a d i n g . B e t t e r t o r e t u r n e m p t y s t r i n g .
set : : tcl::UnknownResult " "
}
} else {
set redir " > & @ s t d o u t < @ s t d i n "
uplevel 1 [ list : : catch [ concat exec $redir $new [ lrange $args 1 end] ] : : tcl::UnknownResult : : tcl::UnknownOptions]
}
shellfilter : : stack::remove stderr $id_stderr
}
@ -410,7 +625,7 @@ proc do_runraw {commandline} {
set tcmd [ shellfilter : : get_scriptrun_from_cmdlist_dquote_if_not $cmdwords ]
puts stdout " > > t c m d : $ t c m d "
# s e t e x i t i n f o [ s h e l l f i l t e r : : r u n $ t c m d - t e e h a n d l e p u n k - i n b u f f e r i n g l i n e - o u t b u f f e r i n g n o n e ]
set exitinfo " n o t - i m p l e m e n t e d "
set exitinfo " e x i t c o d e o t - i m p l e m e n t e d "
} else {
set exitinfo [ shellfilter : : run $cmdwords - teehandle punk - inbuffering line - outbuffering none ]
}
@ -419,6 +634,13 @@ proc do_runraw {commandline} {
# t o d o - c h e c k e r r o r I n f o m a k e s s e n s e . . r e t u r n - c o d e ? t a i l c a l l ?
error [ dict get $exitinfo error]
}
set code [ dict get $exitinfo exitcode]
if { $code == 0 } {
set c [ shellfilter : : ansi::+ green]
} else {
set c [ shellfilter : : ansi::+ white bold]
}
puts stderr $c
return $exitinfo
}
@ -445,7 +667,17 @@ know {[lindex $args 0] eq "run"} {
}
set runopts [ lmap o $runopts { dict get $aliases $o } ]
set id_err [ shellfilter : : stack::add stderr ansiwrap - settings { -colour { red bold} } ]
set exitinfo [ shellfilter : : run $cmdargs - teehandle punk - inbuffering none - outbuffering none ]
shellfilter : : stack::remove stderr $id_err
set c [ shellfilter : : ansi::+ green]
set n [ shellfilter : : ansi::+ ]
if { [ dict exists $exitinfo error] } {
error [ dict get $exitinfo error]
}
return $exitinfo
}
know { [ lindex $args 0 ] eq " r u n o u t " } {
@ -485,7 +717,16 @@ know {[lindex $args 0] eq "runout"} {
# t o d o - c h e c k e r r o r I n f o m a k e s s e n s e . . r e t u r n - c o d e ? t a i l c a l l ?
error [ dict get $exitinfo error]
}
puts stderr $exitinfo
# e x i t c o d e n o t p a r t o f r e t u r n v a l u e - c o l o u r c o d e a p p r o p r i a t e l y
set n [ shellfilter : : ansi::+ ]
set code [ dict get $exitinfo exitcode]
if { $code == 0 } {
set c [ shellfilter : : ansi::+ green]
} else {
set c [ shellfilter : : ansi::+ white bold]
}
puts stderr $c $exitinfo $n
return $::runout
}
know { [ lindex $args 0 ] eq " r u n e r r " } {
@ -522,8 +763,15 @@ know {[lindex $args 0] eq "runerr"} {
error [ dict get $exitinfo error]
}
puts stderr \ n$exitinfo
# e x i t c o d e n o t p a r t o f r e t u r n v a l u e - c o l o u r c o d e a p p r o p r i a t e l y
set n [ shellfilter : : ansi::+ ]
set code [ dict get $exitinfo exitcode]
if { $code == 0 } {
set c [ shellfilter : : ansi::+ green]
} else {
set c [ shellfilter : : ansi::+ white bold]
}
puts stderr \ n$c $exitinfo $n
return $::runerr
}
know { [ lindex $args 0 ] eq " r u n x " } {
@ -575,7 +823,17 @@ know {[lindex $args 0] eq "runx"} {
if { [ string length $::runerr ] } {
append pretty " $ : : r u n e r r \n "
}
append pretty " $ e x i t i n f o "
set n [ shellfilter : : ansi::+ ]
set c " "
if [ dict exists $exitinfo exitcode] {
set code [ dict get $exitinfo exitcode]
if { $code == 0 } {
set c [ shellfilter : : ansi::+ green]
} else {
set c [ shellfilter : : ansi::+ white bold]
}
}
append pretty " $ c $ e x i t i n f o $ n "
# s e t : : r e p l : : r e s u l t _ p r i n t 0
# r e t u r n [ l i n d e x [ l i s t [ l i s t s t d o u t $ : : r u n o u t s t d e r r $ : : r u n e r r { * } $ e x i t i n f o ] [ s h e l l f i l t e r : : s t a c k : : r e m o v e s t d o u t $ x ] [ p u t s - n o n e w l i n e s t d o u t $ p r e t t y ] [ s e t : : r e p l : : o u t p u t " " ] ] 0 ]
@ -605,12 +863,14 @@ namespace eval repl {
}
proc repl::doprompt { prompt } {
proc repl::doprompt { prompt { col { green bold} } } {
# p r o m p t t o s t d e r r .
# W e c a n p i p e c o m m a n d s i n t o r e p l ' s s t d i n w i t h o u t t h e p r o m p t i n t e r f e r i n g w i t h t h e o u t p u t .
# A l t h o u g h a l l c o m m a n d o u t p u t f o r e a c h l i n e g o e s t o s t d o u t - n o t j u s t w h a t i s e m m i t e d w i t h p u t s
if { $::tcl_interactive } {
puts - nonewline stderr $prompt
set o [ shellfilter : : ansi::+ { * } $col ]
set r [ shellfilter : : ansi::+ ]
puts - nonewline stderr $o $prompt $r
flush stderr
}
}
@ -753,8 +1013,12 @@ proc repl::repl_handler {chan} {
}
append command $line
if { [ info complete $command ] } {
set : : repl::output " "
set id_outstack [ shellfilter : : stack::add stdout tee_to_var - settings { -varname : : repl::output} ]
set : : repl::output_stdout " "
set : : repl::output_stderr " "
set errstack [ list ]
set id_outstack [ shellfilter : : stack::add stdout tee_to_var - settings { -varname : : repl::output_stdout} ]
lappend errstack [ shellfilter : : stack::add stderr ansiwrap - settings { -colour { red bold} } ]
lappend errstack [ shellfilter : : stack::add stderr tee_to_var - settings { -varname : : repl::output_stderr} ]
# c h a n c o n f i g u r e s t d o u t - b u f f e r i n g n o n e
fileevent $chan readable { }
set reading 0
@ -765,14 +1029,23 @@ proc repl::repl_handler {chan} {
if { [ string equal - length [ string length " r u n r a w " ] " r u n r a w " $command ] } {
set status [ catch { uplevel # 0 [ list do_runraw $command ] } result]
} else {
# p u t s s t d e r r " r e p l u p l e v e l 0 ' $ c o m m a n d ' "
set status [ catch { uplevel # 0 $command } result]
}
set lastoutchar [ string range $::repl::output end-1 end]
# p u t s s t d e r r " < o u t p u t > ' $ : : r e p l : : o u t p u t ' l a s t o u t c h a r : ' $ l a s t o u t c h a r ' r e s u l t : ' $ r e s u l t ' "
# p u t s s t d e r r " < o u t p u t > ' $ : : r e p l : : o u t p u t _ s t d o u t ' l a s t o u t c h a r : ' $ l a s t o u t c h a r ' r e s u l t : ' $ r e s u l t ' "
flush stdout
shellfilter : : stack::remove stdout $id_outstack
flush stderr
foreach s [ lreverse $errstack ] {
shellfilter : : stack::remove stderr $s
}
set lastoutchar [ string range $::repl::output_stdout end-1 end]
set lasterrchar [ string range $::repl::output_stderr end-1 end]
if { ! $result_print } {
set result " "
set lastoutchar " "
set lasterrchar " "
}
# $ c o m m a n d i s a n u n e v a l u a t e d s c r i p t a t t h i s p o i n t
# s o m a y n o t b e a w e l l f o r m e d l i s t e . g ' s e t x [ l i s t a " b " ] '
@ -789,18 +1062,22 @@ proc repl::repl_handler {chan} {
set reading 1
if { $result ne " " } {
if { $status == 0 } {
if { [ string length $lastoutchar ] } {
if { [ string length $lastoutchar $lasterrchar ] } {
puts \ n$result
} else {
puts $result
}
doprompt " P % "
} else {
puts stderr $result
# t c l e r r
set c [ shellfilter : : ansi::+ yellow bold]
set n [ shellfilter : : ansi::+ ]
puts stderr $c $result $n
# t c l e r r h i n t p r o m p t - l o w e r c a s e
doprompt " p % "
}
} else {
if { [ string length $lastoutchar ] } {
if { [ string length $lastoutchar $lasterrchar ] } {
doprompt " \n P % "
} else {
doprompt " P % "
