@ -23,27 +23,99 @@ set tcl_interactive 1
proc todo { } { proc todo { } {
puts " t c l H i s t o r y " puts " t c l H i s t o r y "
} }
tcl : : tm::add [ pwd ] / modulestcl : : tm::add [ pwd ] / modules
if { ! [ info exists : : env( SHELL ) ] } { if { ! [ info exists : : env( SHELL ) ] } {
set : : env( SHELL ) punk86 set : : env( SHELL ) punk86
} }
if { ! [ info exists : : env( TERM ) ] } { if { ! [ info exists : : env( TERM ) ] } {
# f a k e i t # t s e t - r s e e m s t o r e l y o n e n v ( T E R M ) - s o t h i s d o e s n ' t s e e m t o w o r k
# s e t : : e n v ( T E R M ) v t 1 0 0 # i f { ! [ c a t c h { e x e c t s e t - r } r e s u l t ] } {
set : : env( TERM ) xterm-256color # # e . g T e r m i n a l t y p e i s x t e r m - 2 5 6 c o l o r .
# s e t t [ s t r i n g t r i m r i g h t [ l i n d e x $ r e s u l t e n d ] . ]
# s e t : : e n v ( T E R M ) $ t
# } e l s e {
# 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
# }
} }
# T h e s e a r e s t r o n g d e p e n d e n c i e s
# - t h e r e p l r e q u i r e s T h r e a d i n g a n d p u n k , s h e l l f i l t e r , s h e l l r u n t o c a l l a n d d i s p l a y p r o p e r l y .
package require shellfilterpackage require shellfilter
package require shellrunpackage require shellrun
package require Threadpackage require Thread
package require punkpackage require punk
# t o d o - m o v e t o l e s s g e n e r i c n a m e s p a c e
namespace eval repl {
variable screen_last_chars " " ; # a s m a l l s l i d i n g a p p e n d b u f f e r f o r l a s t c h a r o f a n y s c r e e n o u t p u t t o d e t e c t \ n v s s t r i n g
variable screen_last_char_list [ list ]
variable last_unknown " "
variable prompt_reset_flag 0 ; # t r i g g e r r e p l t o r e - r e t r i e v e p r o m p t s e t t i n g s
variable output " "
# i m p o r t a n t n o t t o i n i t i a l i z e - a s i t c a n b e p r e s e t b y c o o p e r a t i n g p a c k a g e b e f o r e a p p - p u n k h a s b e e n p a c k a g e r e q u i r e d
variable post_script
variable signal_control_c 0
}
namespace eval punkrepl {
variable debug_repl 0
}
namespace eval : : repl::term {
}
package require term::ansi::code::ctrl
if { $::tcl_platform ( platform ) eq " w i n d o w s " } {
package require twapi
proc : : repl::term::handler_console_control { args } {
set : : repl::signal_control_c 1
# r p u t s s t d e r r " * c o n s o l e _ c o n t r o l : $ a r g s "
# r e t u r n 0 t o f a l l t h r o u g h t o d e f a u l t h a n d l e r
return 1
}
twapi : : set_console_control_handler : : repl::term::handler_console_control
proc : : repl::term::set_console_title { text } {
# t w a p i : : s e t _ c o n s o l e _ t i t l e $ t e x t
puts - nonewline [ term : : ansi::code::ctrl::title $text ]
}
proc : : repl::term::set_console_icon { name } {
# t o d o
}
} else {
# T O D O
proc : : repl::term::set_console_title { text } {
# t o d o - t e r m i n f o / t e r m c a p ?
# p u t s - n o n e w l i n e " \ 0 3 3 \ ] 2 ; $ t e x t \ 0 0 7 " ; # w o r k s f o r x t e r m a n d m o s t d e r i v a t i v e s
puts - nonewline [ term : : ansi::code::ctrl::title $text ]
}
proc : : repl::term::set_console_icon { name } {
# o l d x t e r m f e a t u r e f o r l a b e l g i v e n t o x t e r m w i n d o w w h e n m i n i a t u r i z e d ? T O D O r e s e a r c h
# p u t s - n o n e w l i n e " \ 0 3 3 \ ] 1 ; $ n a m e \ 0 0 7 "
}
}
# e x p e r m e n t a l t e r m i n a l a l t s c r e e n s
proc : : repl::term::screen_push_alt { } {
# t p u t s m c u p
puts - nonewline stderr " \033 \[ ? 1 0 4 9 h "
}
proc : : repl::term::screen_pop_alt { } {
# t p u t r m c u p
puts - nonewline stderr " \033 \[ ? 1 0 4 9 l "
}
interp alias { } smcup { } : : repl::term::screen_push_alt
interp alias { } rmcup { } : : repl::term::screen_pop_alt
@ -77,7 +149,8 @@ set err [dict get $errdevice localchan]
# a r g s - A l i s t w h o s e e l e m e n t s a r e t h e w o r d s o f t h e o r i g i n a l # a r g s - A l i s t w h o s e e l e m e n t s a r e t h e w o r d s o f t h e o r i g i n a l
# c o m m a n d , i n c l u d i n g t h e c o m m a n d n a m e . # c o m m a n d , i n c l u d i n g t h e c o m m a n d n a m e .
proc unknown args { proc : : unknown args {
variable : : tcl::UnknownPending variable : : tcl::UnknownPending
global auto_noexec auto_noload env tcl_interactive errorInfo errorCode global auto_noexec auto_noload env tcl_interactive errorInfo errorCode
@ -305,9 +378,12 @@ proc unknown args {
set : : tcl::UnknownResult " " set : : tcl::UnknownResult " "
} }
} else { } else {
set idlist_stdout [ list ]
set idlist_stderr [ list ]
set shellrun::runout " "
# w h e n u s i n g e x e c w i t h > & @ s t d o u t ( t o e n s u r e p r o c e s s i s c o n n e c t e d t o c o n s o l e ) - t h e o u t p u t u n f o r t u n a t e l y d o e s n ' t g o v i a t h e s h e l l f i l t e r s t a c k s # w h e n u s i n g e x e c w i t h > & @ s t d o u t ( t o e n s u r e p r o c e s s i s c o n n e c t e d t o c o n s o l e ) - t h e o u t p u t u n f o r t u n a t e l y d o e s n ' t g o v i a t h e s h e l l f i l t e r s t a c k s
set id_stderr [ shellfilter : : stack::add stderr ansiwrap - settings { -colour { red bold} } ] # l a p p e n d i d l i s t _ 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 } } ]
# l a p p e n d i d l i s t _ s t d o u t [ s h e l l f i l t e r : : s t a c k : : a d d s t d o u t t e e _ t o _ v a r - a c t i o n f l o a t - s e t t i n g s { - v a r n a m e : : s h e l l r u n : : r u n o u t } ]
if { ! [ dict get $::punk::config::running exec_unknown] } { if { ! [ dict get $::punk::config::running exec_unknown] } {
uplevel 1 [ list : : catch \ uplevel 1 [ list : : catch \
@ -323,16 +399,34 @@ proc unknown args {
set : : tcl::UnknownResult " " set : : tcl::UnknownResult " "
} }
} else { } else {
set : : punk::last_run_display [ list ]
set redir " > & @ s t d o u t < @ s t d i n " 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] uplevel 1 [ list : : catch [ concat exec $redir $new [ lrange $args 1 end] ] : : tcl::UnknownResult : : tcl::UnknownOptions]
# w e c a n ' t d e t e c t s t d o u t / s t d e r r o u t p u t f r o m t h e e x e c # w e c a n ' t d e t e c t s t d o u t / s t d e r r o u t p u t f r o m t h e e x e c
# f o r n o w e m i t a n e x t r a \ n o n s t d e r r # f o r n o w e m i t a n e x t r a \ n o n s t d e r r
# t o d o - u s e c o n s o l e a p i s ( t w a p i o n w i n d o w s ) t o d e t e c t c u r s o r p o s n ? # t o d o - u s e c o n s o l e a p i s ( t w a p i o n w i n d o w s ) t o d e t e c t c u r s o r p o s n ?
puts - nonewline stderr \ n[ a + green bold] - [ a + ] #
} # - u s e [ d i c t g e t $ : : t c l : : U n k n o w n O p t i o n s - c o d e ] ( 0 | 1 ) e x i t
if { [ dict get $::tcl::UnknownOptions - code] == 0 } {
set c green
set m " o k "
} else {
set c yellow
set m " e r r o r C o d e $ : : e r r o r C o d e "
}
set chunklist [ list ]
lappend chunklist [ list " i n f o " " [ a + $ c ] $ m [ a + ] " ]
set : : punk::last_run_display $chunklist
}
shellfilter : : stack::remove stderr $id_stderr foreach id $idlist_stdout {
shellfilter : : stack::remove stdout $id
}
foreach id $idlist_stderr {
shellfilter : : stack::remove stderr $id
}
} }
@ -362,174 +456,93 @@ proc unknown args {
return - options $::tcl::UnknownOptions $::tcl::UnknownResult return - options $::tcl::UnknownOptions $::tcl::UnknownResult
} }
set ret [ catch { set candidates [ info commands $name * ] } msg] set ret [ catch { set candidates [ info commands $name * ] } msg]
if { $name eq " : : " } { if { $name eq " : : " } {
set name " " set name " "
}
if { $ret != 0 } {
dict append opts - errorinfo \
" \n ( e x p a n d i n g c o m m a n d p r e f i x \" $ n a m e \" i n u n k n o w n ) "
return - options $opts $msg
}
# F i l t e r o u t b o g u s m a t c h e s w h e n $ n a m e c o n t a i n e d
# a g l o b - s p e c i a l c h a r [ B u g 9 4 6 9 5 2 ]
if { $name eq " " } {
# H a n d l e e m p t y $ n a m e s e p a r a t e l y d u e t o s t r a n g e n e s s
# i n [ s t r i n g f i r s t ] ( S e e R F E 1 2 4 3 3 5 4 )
set cmds $candidates
} else {
set cmds [ list ]
foreach x $candidates {
if { [ string first $name $x ] == 0 } {
lappend cmds $x
}
}
}
if { [ llength $cmds ] == 1 } {
uplevel 1 [ list : : catch [ lreplace $args 0 0 [ lindex $cmds 0 ] ] \
: : tcl : : UnknownResult : : tcl::UnknownOptions]
dict incr : : tcl::UnknownOptions - level
return - options $::tcl::UnknownOptions $::tcl::UnknownResult
}
if { [ llength $cmds ] } {
return - code error " a m b i g u o u s c o m m a n d n a m e \" $ n a m e \" : [ l s o r t $ c m d s ] "
}
} }
return - code error - errorcode [ list TCL LOOKUP COMMAND $name ] \ if { $ret != 0 } {
" i n v a l i d c o m m a n d n a m e \" $ n a m e \" " dict append opts - errorinfo \
} " \n ( e x p a n d i n g c o m m a n d p r e f i x \" $ n a m e \" i n u n k n o w n ) "
return - options $opts $msg
proc know { cond body} {
proc unknown { args } [ string map [ list @ c@ $cond @ b@ $body ] {
if { ! [ catch { expr { @ c @ } } res] && $res } {
return [ eval { @ b @ } ]
# t a i l c a l l @ b @
}
} ] [ info body unknown]
}
proc know? { } {
puts [ string range [ info body unknown] 0 511 ]
}
if 1 {
know { [ expr $args ] || 1 } { expr $args }
know { [ regexp { ^ ( [ 0-9 ] + ) \ . \ .( [ 0-9 ] + ) $ } [ lindex $args 0 ] - > from to] } {
set res { }
while { $from <= $to } { lappend res $from ; incr from}
set res
}
# h a n d l e p r o c e s s r e t u r n d i c t o f f o r m { e x i t c o d e n u m e t c b l a h }
# i e w h e n t h e r e t u r n r e s u l t a s a w h o l e i s t r e a t e d a s a c o m m a n d
# e x i t c o d e m u s t b e t h e f i r s t k e y
know { [ lindex $args 0 0 ] eq " e x i t c o d e " } {
# s e t c [ l i n d e x $ a r g s 0 1 ]
uplevel 1 [ list exitcode { * } [ lrange [ lindex $args 0 ] 1 end] ]
}
# r u n a s r a w s t r i n g i n s t e a d o f t c l - l i s t - n o v a r i a b l e s u b s t e t c
proc do_runraw { commandline } {
# r e t u r n [ s h e l l f i l t e r : : r u n [ l r a n g e $ a r g s 1 e n 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 n o n e - o u t b u f f e r i n g n o n e - s t d i n h a n d l e r : : r e p l : : r e p l _ h a n d l e r ]
puts stdout " > > r u n r a w g o t : $ c o m m a n d l i n e "
# r u n a l w a y s e c h o e s a n y w a y . . a s w e a r e n ' t d i v e r t i n g s t d o u t / s t d e r r o f f f o r c a p t u r i n g
# f o r c o n s i s t e n c y w i t h o t h e r r u n x x x c o m m a n d s - w e ' l l j u s t c o n s u m e i t . ( r e v i e w )
# s e t w o r d p a r t s [ r e g e x p - i n l i n e - a l l { \ S + } $ c o m m a n d l i n e ]
package require string::token::shell
set parts [ string token shell - indices $commandline ]
puts stdout " > > s h e l l p a r t s : $ p a r t s "
set runwords [ list ]
foreach p $parts {
set ptype [ lindex $p 0 ]
set pval [ lindex $p 3 ]
if { $ptype eq " P L A I N " } {
lappend runwords [ lindex $p 3 ]
} elseif { $ptype eq " D : Q U O T E D " } {
set v { " }
append v $pval
append v { " }
lappend runwords $v
} elseif { $ptype eq " S : Q U O T E D " } {
set v { ' }
append v $pval
append v { ' }
lappend runwords $v
}
} }
puts stdout " > > r u n r a w r u n w o r d s : $ r u n w o r d s " # F i l t e r o u t b o g u s m a t c h e s w h e n $ n a m e c o n t a i n e d
set runwords [ lrange $runwords 1 end] # a g l o b - s p e c i a l c h a r [ B u g 9 4 6 9 5 2 ]
if { $name eq " " } {
puts stdout " > > r u n r a w r u n w o r d s : $ r u n w o r d s " # H a n d l e e m p t y $ n a m e s e p a r a t e l y d u e t o s t r a n g e n e s s
# s e t a r g s [ l r a n g e $ a r g s 1 e n d ] # i n [ s t r i n g f i r s t ] ( S e e R F E 1 2 4 3 3 5 4 )
# s e t r u n w o r d s [ l r a n g e $ w o r d p a r t s 1 e n d ] set cmds $candidates
} else {
set known_runopts [ list " - e c h o " " - e " " - t e r m i n a l " " - t " ] set cmds [ list ]
set aliases [ list " - e " " - e c h o " " - e c h o " " - e c h o " " - t " " - t e r m i n a l " " - t e r m i n a l " " - t e r m i n a l " ] ; # i n c l u d e m a p t o s e l f foreach x $candidates {
set runopts [ list ] if { [ string first $name $x ] == 0 } {
set cmdwords [ list ] lappend cmds $x
set idx_first_cmdarg [ lsearch - not $runwords " - * " ] }
set runopts [ lrange $runwords 0 $idx_first_cmdarg-1 ]
set cmdwords [ lrange $runwords $idx_first_cmdarg end]
foreach o $runopts {
if { $o ni $known_runopts } {
error " r u n r a w : U n k n o w n r u n o p t i o n $ o "
} }
} }
set runopts [ lmap o $runopts { dict get $aliases $o } ] # p u n k - d i s a b l e p r e f i x m a t c h s e a r c h
set default_cmd_search 0
set cmd_as_string [ join $cmdwords " " ] if { $default_cmd_search } {
puts stdout " > > c m d _ a s _ s t r i n g : $ c m d _ a s _ s t r i n g " if { [ llength $cmds ] == 1 } {
uplevel 1 [ list : : catch [ lreplace $args 0 0 [ lindex $cmds 0 ] ] \
if { " - t e r m i n a l " in $runopts } { : : tcl : : UnknownResult : : tcl::UnknownOptions]
set tcmd [ shellfilter : : get_scriptrun_from_cmdlist_dquote_if_not $cmdwords ] dict incr : : tcl::UnknownOptions - level
puts stdout " > > t c m d : $ t c m d " return - options $::tcl::UnknownOptions $::tcl::UnknownResult
# 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 " e x i t c o d e n o t - i m p l e m e n t e d " if { [ llength $cmds ] } {
return - code error " a m b i g u o u s c o m m a n d n a m e \" $ n a m e \" : [ l s o r t $ c m d s ] "
}
} else { } else {
set exitinfo [ shellfilter : : run $cmdwords - teehandle punk - inbuffering line - outbuffering none ] # p u n k h a c k e d v e r s i o n - r e p o r t m a t c h e s b u t d o n ' t r u n
} if { [ llength $cmds ] } {
return - code error " u n k n o w n c o m m a n d n a m e \" $ n a m e \" : p o s s i b l e m a t c h ( e s ) [ l s o r t $ c m d s ] "
}
if { [ dict exists $exitinfo error] } {
# 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 - code error - errorcode [ list TCL LOOKUP COMMAND $name ] \
return $exitinfo " i n v a l i d c o m m a n d n a m e \" $ n a m e \" "
} }
punk : : configure_unknown ; # m u s t b e c a l l e d b e c a u s e w e h a c k e d t h e t c l ' u n k n o w n ' p r o c
know { [ lindex $args 0 ] eq " r u n r a w " } {
return [ do_runraw $args ]
}
}
namespace eval repl { proc repl::reset_prompt { } {
variable output " " variable prompt_reset_flag
# i m p o r t a n t n o t t o i n i t i a l i z e - a s i t c a n b e p r e s e t b y c o o p e r a t i n g p a c k a g e b e f o r e a p p - p u n k h a s b e e n p a c k a g e r e q u i r e d set prompt_reset_flag 1
variable post_script
} }
# t o d o - r e v i e w
proc repl::term::reset { } {
set prompt_reset_flag 1
# c l e a r ; # c a l l t o e x t e r n a l e x e c u t a b l e w h i c h m a y n o t b e a v a i l a b l e
puts stdout [ : : term : : ansi::code::ctrl::rd]
}
proc repl::doprompt { prompt { col { green bold} } } { proc repl::doprompt { prompt { col { green bold} } } {
# p r o m p t t o s t d e r r . # 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 . # 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 # 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 } { if { $::tcl_interactive } {
set o [ shellfilter : : ansi::+ { * } $col ] set o [ a + { * } $col ]
set r [ shellfilter : : ansi::+ ] set r [ a + ]
puts - nonewline stderr $o $prompt $r puts - nonewline stderr $o $prompt $r
flush stderr flush stderr
} }
} }
proc repl::get_prompt_config { } {
if { $::tcl_interactive } {
set resultprompt " [ a + g r e e n b o l d ] - [ a + ] "
set infoprompt " [ a + g r e e n b o l d ] * [ a + ] "
set debugprompt " [ a + p u r p l e b o l d ] ~ [ a + ] "
} else {
set resultprompt " "
set infoprompt " "
set debugprompt " "
}
return [ list resultprompt $resultprompt infoprompt $infoprompt debugprompt $debugprompt ]
}
proc repl::start { inchan } { proc repl::start { inchan } {
variable command variable command
variable running variable running
@ -537,8 +550,9 @@ proc repl::start {inchan} {
variable done variable done
set running 1 set running 1
set command " " set command " "
set prompt_config [ get_prompt_config ]
doprompt " P % " doprompt " P % "
fileevent $inchan readable [ list [ namespace current] : : repl_handler $inchan ] fileevent $inchan readable [ list [ namespace current] : : repl_handler $inchan $prompt_config ]
set reading 1 set reading 1
vwait [ namespace current] : : done vwait [ namespace current] : : done
# t o d o - o v e r r i d e e x i t ? # t o d o - o v e r r i d e e x i t ?
@ -553,10 +567,7 @@ proc repl::post_operations {} {
set : : repl::post_script " " set : : repl::post_script " "
uplevel # 0 { eval $::repl::running_script } uplevel # 0 { eval $::repl::running_script }
} }
# t o d o - t i d y u p s o r e p l c o u l d b e r e s t a r t e d # t o d o - t i d y u p s o r e p l c o u l d b e r e s t a r t e d
set repl::post_operations_done 0 set repl::post_operations_done 0
} }
@ -645,7 +656,167 @@ proc repl::reopen_stdinX {} {
after 10 repl::start $a after 10 repl::start $a
} }
proc repl::repl_handler { chan } {
# a d d t o s l i d i n g b u f f e r o f l a s t x c h a r s e m m i t t e d t o s c r e e n b y r e p l
# ( w e c o u l d m a i n t a i n o n l y o n e c h a r - m o r e k e p t m e r e l y f o r d e b u g a s s i s t a n c e )
# w i l l n o t d e t e c t e m i s s i o n s f r o m e x e c w i t h s t d o u t r e d i r e c t e d a n d p r e s u m a b l y s o m e e x t e n s i o n s e t c
proc repl::screen_last_char_add { c what { why " " } } {
variable screen_last_chars
variable screen_last_char_list
if { ! [ string length $c ] } {
return [ string index $screen_last_chars end]
}
if { [ string length $screen_last_chars ] > 10 } {
set screen_last_chars [ string range $screen_last_chars 1 end] ; # e v i c t f i r s t c h a r
set screen_last_char_list [ lrange $screen_last_char_list 1 end]
}
append screen_last_chars $c
lappend screen_last_char_list [ list $c $what $why ]
# r e t u r n [ s t r i n g i n d e x $ s c r e e n _ l a s t _ c h a r s e n d ]
return [ lindex $screen_last_char_list 0 0 ]
}
proc repl::screen_last_char_get { } {
variable screen_last_char_list
return [ lindex $screen_last_char_list end 0 ]
}
proc repl::screen_last_char_getinfo { } {
variable screen_last_char_list
return [ lindex $screen_last_char_list end]
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# a n o t h e r e x p e r i m e n t
proc repl::newout { } {
namespace eval : : replout {
namespace ensemble create - map {
initialize init
finalize close
watch watch
write write
}
}
proc : : replout::init { id mode} {
return { initialize finalize watch write}
}
proc : : replout::close { id } {
}
proc : : replout::watch { id spec} {
}
proc : : replout::write { id data} {
puts - nonewline stderr $data
return [ string length $data ]
}
close stdout
set fd [ chan create write : : replout]
chan configure $fd - buffering none
return $fd
}
interp alias { } newout { } repl::newout
proc repl::newout2 { } {
close stdout
set s [ open " C O N " w]
chan configure $s - buffering none
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# u s e r p u t s i n r e p l _ h a n d l e r i n s t e a d o f p u t s
# - t o h e l p e n s u r e w e d o n ' t e m i t e x t r a b l a n k l i n e s i n i n f o o r d e b u g o u t p u t
# r p u t s e x p e c t s t h e s t a n d a r d t c l ' p u t s ' c o m m a n d t o b e i n p l a c e .
# a l l b e t s a r e o f f i f t h i s h a s b e e n r e d e f i n e d w i t h s o m e o t h e r a p i
# r p u t s d e l i b e r a t e l y d o e s n ' t c h e c k s c r e e n _ l a s t _ c h a r s b e f o r e e m i t t i n g d a t a ( u n l e s s r e p o r t i n g a n e r r o r i n r p u t s i t s e l f )
proc repl::rputs { args } {
variable screen_last_chars
variable last_out_was_newline
variable last_repl_char
if { [ : : tcl : : mathop::<= 1 [ llength $args ] 3 ] } {
set out [ lindex $args end]
if { ( [ llength $args ] > 1 ) && [ lindex $args 0 ] ne " - n o n e w l i n e " } {
set this_tail \ n
set rputschan [ lindex $args 0 ]
} elseif { [ llength $args ] == 1 } {
set this_tail \ n
set rputschan " s t d o u t "
} else {
# > 1 a r g w i t h - n o n e w l i n e
set this_tail [ string index $out end]
set rputschan [ lindex $args 1 ]
}
set last_char_info_width 40
set summary " [ : : s h e l l f i l t e r : : a n s i : : s t r i p c o d e s [ s t r i n g r a n g e $ o u t 0 $ l a s t _ c h a r _ i n f o _ w i d t h ] ] "
if { [ string length $out ] > $last_char_info_width } {
append summary " . . . "
}
screen_last_char_add $this_tail repl-$rputschan " $ s u m m a r y
# t a i l c a l l ?
puts { * } $args
} else {
# l o o k s l i k e a n i n v a l i d p u t s c a l l - u s e t h e n o r m a l e r r o r p r o d u c e d b y t h e p u t s c o m m a n d
# T h i s s h o u l d o n l y o c c u r i f t h e r e p l i t s e l f i s b e i n g r e w r i t t e n / d e b u g g e d ,
# s o w e w i l l u s e r e d " ! " a n d n o t w o r r y a b o u t t h e e x t r a n e w l i n e s b e f o r e a n d a f t e r
if { [ catch { puts { * } $args } err] } {
set c [ a + yellow bold]
set n [ a + ]
# p o s s i b l y n o n p u n k - c o m p l i a n t o u t p u t b e c a u s e w e ' r e a s s u m i n g t h e r e p l w a s t h e m o s t r e c e n t e m i t t e r
# c o u l d b e w r o n g , i n w h i c h c a s e w e m a y e m i t a n e x t r a n e w l i n e
# - s h o u l d n ' t m a t t e r i n t h i s c a s e
# s e t l a s t _ c h a r [ s t r i n g r a n g e $ s c r e e n _ l a s t _ c h a r s e n d ]
set last_char [ screen_last_char_get ]
if { $last_char eq " \n " } {
set clear " "
} else {
set clear " \n "
}
puts - nonewline stderr " $ c l e a r [ a + r e d b o l d ] ! R E P L E R R O R I N r p u t s $ c $ e r r $ n \n "
screen_last_char_add " \n " replerror " r p u t s e r r : ' $ e r r ' "
return
} else {
# ? ? s h o u l d n ' t h a p p e n w i t h s t a n d a r d p u t s c o m m a n d
# d o o u r b e s t a n d a s s u m e f i n a l a r g i s s t i l l t h e d a t a b e i n g e m i t t e d
# w o r s t t h a t w i l l h a p p e n i s w e w o n ' t d e t e c t a t r a i l i n g n e w l i n e a n d w i l l l a t e r e m i t a n e x t r a b l a n k l i n e .
set out [ lindex $args end]
set this_tail [ string index $out end]
screen_last_char_add $this_tail replunknown " r p u t s $ a r g s "
return
}
}
}
# w h e t h e r w e n e e d a n e w l i n e a s c l e a r a n c e f r o m p r e v i o u s o u t p u t
proc repl::screen_needs_clearance { } {
variable screen_last_chars
# s e t l a s t _ c h a r [ s t r i n g i n d e x $ s c r e e n _ l a s t _ c h a r s e n d ]
set last_char_info [ screen_last_char_getinfo ]
if { ! [ llength $last_char_info ] } {
# a s s u m p t i o n
return 1
}
lassign $last_char_info c what why
if { $what in [ list " s t d o u t " " s t d e r r " " s t d o u t / s t d e r r " ] } {
return 1
}
if { $c eq " \n " } {
return 0
} else {
return 1
}
}
proc repl::repl_handler { inputchan prompt_config} {
variable prompt_reset_flag
if { $prompt_reset_flag == 1 } {
set prompt_config [ get_prompt_config ]
set prompt_reset_flag 0
}
variable last_repl_char " " ; # l a s t c h a r e m i t t e d b y t h i s h a n d l e r t o s t d o u t / s t d e r r
variable lastoutchar " "
variable lasterrchar " "
variable command variable command
variable running variable running
variable reading variable reading
@ -653,14 +824,14 @@ proc repl::repl_handler {chan} {
variable id_outstack variable id_outstack
upvar : : punk::last_run_display last_run_display upvar : : punk::last_run_display last_run_display
upvar : : punk::config::running running_config upvar : : punk::config::running running_config
set chunksize [ gets $chan line] set chunksize [ gets $input chan line]
if { $chunksize < 0 } { if { $chunksize < 0 } {
if { [ chan eof $chan ] } { if { [ chan eof $input chan ] } {
fileevent $chan readable { } fileevent $input chan readable { }
set reading 0 set reading 0
set running 0 set running 0
if { $::tcl_interactive } { if { $::tcl_interactive } {
puts stderr " \n | r e p l > E O F o n $ c h a n . " r puts" \n | r e p l > E O F o n $ i n p u t c h a n . "
} }
set [ namespace current] : : done 1 set [ namespace current] : : done 1
# t e s t # t e s t
@ -668,47 +839,153 @@ proc repl::repl_handler {chan} {
return return
} }
} }
append command $line set resultprompt [ dict get $prompt_config resultprompt]
set infoprompt [ dict get $prompt_config infoprompt]
set debugprompt [ dict get $prompt_config debugprompt]
append command $line \ n
set : : repl::last_repl_char " \n " ; # t h i s i s a c t u a l l y t h e e o l f r o m s t d i n
screen_last_char_add " \n " stdin $line
if { [ info complete $command ] } { if { [ info complete $command ] } {
set : : repl::output_stdout " " set : : repl::output_stdout " "
set : : repl::output_stderr " " set : : repl::output_stderr " "
set outstack [ list ] set outstack [ list ]
set errstack [ list ] set errstack [ list ]
if { [ string length [ dict get $running_config color_stdout] ] } {
# o n e s h o t r e p l d e b u g
set wordparts [ regexp - inline - all { \ S + } $command ]
lassign $wordparts cmd_firstword cmd_secondword
if { $cmd_firstword eq " d e b u g r e p l " } {
if { [ string is integer - strict $cmd_secondword ] } {
incr : : punkrepl::debug_repl $cmd_secondword
} else {
incr : : punkrepl::debug_repl
}
set command " s e t : : p u n k r e p l : : d e b u g _ r e p l "
}
if { $::punkrepl::debug_repl > 0 } {
proc debug_repl_emit { msg } [ string map [ list % p% [ list $debugprompt ] ] {
set p % p%
# d o n ' t a u t o - a p p e n d \ n e v e n i f m i s s i n g .
# w e m a y w a n t t o u s e d e b u g _ r e p l _ e m i t w i t h m u l t i p l e c a l l s f o r o n e o u t p u t l i n e
# i f { [ s t r i n g i n d e x $ m s g e n d ] n e " \ n " } {
# s e t m s g " $ m s g \ n "
# }
# s e t l a s t _ c h a r [ s t r i n g i n d e x $ : : r e p l : : s c r e e n _ l a s t _ c h a r s e n d ]
set last_char [ screen_last_char_get ]
if { $last_char ne " \n " } {
set clearance " \n "
} else {
set clearance " "
}
rputs stderr $clearance $p [ string map [ list \ n \ n$p ] $msg ]
} ]
set info " l a s t _ r u n _ i n f o \n "
append info " l e n g t h : [ l l e n g t h $ : : p u n k : : l a s t _ r u n _ d i s p l a y ] \n "
debug_repl_emit $info
} else {
proc debug_repl_emit { msg } { return }
}
set : : punk::last_run_display [ list ]
set : : repl::last_unknown " "
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
# d o n ' t u s e p u t s , r p u t s o r d e b u g _ r e p l _ e m i t i n t h i s b l o c k
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
if { [ string length [ dict get $running_config color_stdout] ] && [ punk : : ansi] } {
lappend outstack [ shellfilter : : stack::add stdout ansiwrap - settings [ list - colour [ dict get $running_config color_stdout] ] ] lappend outstack [ shellfilter : : stack::add stdout ansiwrap - settings [ list - colour [ dict get $running_config color_stdout] ] ]
} }
lappend outstack [ shellfilter : : stack::add stdout tee_to_var - settings { -varname : : repl::output_stdout} ] lappend outstack [ shellfilter : : stack::add stdout tee_to_var - settings { -varname : : repl::output_stdout} ]
if { [ string length [ dict get $running_config color_stderr] ] } { if { [ string length [ dict get $running_config color_stderr] ] && [ punk : : ansi] } {
lappend errstack [ shellfilter : : stack::add stderr ansiwrap - settings [ list - colour [ dict get $running_config color_stderr] ] ] lappend errstack [ shellfilter : : stack::add stderr ansiwrap - settings [ list - colour [ dict get $running_config color_stderr] ] ]
} }
lappend errstack [ shellfilter : : stack::add stderr tee_to_var - settings { -varname : : repl::output_stderr} ] 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 # 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 { } fileevent $input chan readable { }
set reading 0 set reading 0
# d o n ' t l e t u n k n o w n u s e ' a r g s ' t o c o n v e r t c o m m a n d t o l i s t # d o n ' t l e t u n k n o w n u s e ' a r g s ' t o c o n v e r t c o m m a n d t o l i s t
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
if { [ string equal - length [ string length " r u n r a w " ] " r u n r a w " $command ] } { # A c t u a l c o m m a n d c a l l
set status [ catch { uplevel # 0 [ list do_runraw $command ] } result] # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
if { [ string equal - length [ string length " r e p l _ r u n r a w " ] " r e p l _ r u n r a w " $command ] } {
# p a s s u n e v a l u a t e d c o m m a n d t o r u n r a w
set status [ catch { uplevel # 0 [ list runraw $command ] } result]
} else { } 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 ' " # 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 status [ catch { uplevel # 0 $command } result]
} }
# = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
flush stdout flush stdout
flush stderr flush stderr
foreach s [ lreverse $outstack ] { foreach s [ lreverse $outstack ] {
shellfilter : : stack::remove stdout $s shellfilter : : stack::remove stdout $s
} }
foreach s [ lreverse $errstack ] { foreach s [ lreverse $errstack ] {
shellfilter : : stack::remove stderr $s 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]
set : : repl::last_stdout $::repl::output_stdout
set : : repl::last_stderr $::repl::output_stderr set lastoutchar [ string index $::repl::output_stdout end]
set lasterrchar [ string index $::repl::output_stderr end]
# t o d e t e r m i n e w h e t h e r c u r s o r i s b a c k a t c o l 0 o f n e w l i n e
screen_last_char_add [ string index $lastoutchar $lasterrchar end] " s t d o u t / s t d e r r "
set result_is_chunk_list 0
# - - - - - -
# t o d o - f i x . I t d o e s n ' t m a k e m u c h s e n s e t o o n l y d e t e c t i f t h e u n k n o w n c o m m a n d o c c u r r e d i n f i r s t w o r d .
# e . g s e t x [ s o m e t h i n g a r g ] n o t d e t e c t e d v s s o m e t h i n g a r g
# a l s o - u n k n o w n c o m m a n d s a r e n ' t t h e o n l y t h i n g s t h a t c a n w r i t e d i r e c t l y t o t h e o s h a n d l e s s t d e r r & s t d o u t
if {
[ string length $::repl::last_unknown ] && \
[ string equal - length [ string length $::repl::last_unknown ] $::repl::last_unknown $command ]
} {
# c a n ' t c u r r e n t l y d e t e c t s t d o u t / s t d e r r w r i t e s f r o m u n k n o w n ' s c a l l t o e x e c
# a d d a c l e a r a n c e n e w l i n e f o r d i r e c t u n k n o w n c a l l s f o r n o w
# t h e r e i s u s u a l l y o u t p u t a n y w a y - b u t w e w i l l g e t a n e x t r a b l a n k l i n e n o w e v e n f o r a c a l l t h a t o n l y h a d a n e x i t c o d e
#
#
set unknown_clearance " \n * r e p l n e w l i n e "
screen_last_char_add " \u F F F F " clearance " c l e a r a n c e a f t e r d i r e c t u n k n o w n c a l l "
if { [ llength $last_run_display ] } {
if { $status == 0 } {
set result $last_run_display
} else {
}
set result_is_chunk_list 1
}
}
# - - - - - -
# o k t o u s e r e p l : : s c r e e n _ n e e d s _ c l e a r a n c e f r o m h e r e d o w n . . ( c o d e s m e l l p r o c o n l y v a l i d u s e i n n a r r o w c o n t e x t )
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
# r p u t s - n o n e w l i n e s t d e r r $ u n k n o w n _ c l e a r a n c e
set lastcharinfo " \n "
set whatcol [ string repeat " " 12 ]
foreach cinfo $::repl::screen_last_char_list {
lassign $cinfo c whatinfo whyinfo
set cdisplay [ string map [ list \ r " - r - " \ n " - n - " ] $c ]
if { [ string length $cdisplay ] == 1 } {
set cdisplay " $ c d i s p l a y " ; # m a k e 3 w i d e t o m a t c h - n - a n d - r -
}
set whatinfo [ string range $whatinfo $whatcol 0 [ string length $whatcol ] ]
set whysummary [ string map [ list \ n " - n - " ] $whyinfo ]
append lastcharinfo " $ c d i s p l a y $ w h a t i n f o $ w h y s u m m a r y \n "
}
debug_repl_emit " s c r e e n _ l a s t _ c h a r s : $ l a s t c h a r i n f o "
debug_repl_emit " l a s t o u t c h a r : ' $ l a s t o u t c h a r ' l a s t e r r c h a r : ' $ l a s t e r r c h a r ' "
if { $status == 0 } {
debug_repl_emit " c o m m a n d c a l l s t a t u s : $ s t a t u s O K "
} else {
debug_repl_emit " c o m m a n d c a l l s t a t u s : $ s t a t u s E R R "
}
# 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 ' " # 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 ' "
# $ 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 # $ 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
@ -716,13 +993,11 @@ proc repl::repl_handler {chan} {
# - l i n d e x w i l l f a i l # - l i n d e x w i l l f a i l
# i f { [ l i n d e x $ c o m m a n d 0 ] e q " r u n x " } { } # i f { [ l i n d e x $ c o m m a n d 0 ] e q " r u n x " } { }
set result_is_chunk_list 0 if {
set test [ string trim $command ]
if {
[ string equal - length [ string length " . / " ] " . / " $command ] || \ [ string equal - length [ string length " . / " ] " . / " $command ] || \
[ string equal " . / " $command ] || \ [ string equal " . / \n " $command ] || \
[ string equal - length [ string length " . . / " ] " . . / " $command ] || \ [ string equal - length [ string length " . . / " ] " . . / " $command ] || \
[ string equal " . . / " $command ] || \ [ string equal " . . / \n $command ] || \
[ string equal - length [ string length " r u n x " ] " r u n x " $command ] || \ [ string equal - length [ string length " r u n x " ] " r u n x " $command ] || \
[ string equal - length [ string length " s h _ r u n x " ] " s h _ r u n x " $command ] || \ [ string equal - length [ string length " s h _ r u n x " ] " s h _ r u n x " $command ] || \
[ string equal - length [ string length " r u n o u t " ] " r u n o u t " $command ] || \ [ string equal - length [ string length " r u n o u t " ] " r u n o u t " $command ] || \
@ -736,45 +1011,92 @@ proc repl::repl_handler {chan} {
set result_is_chunk_list 1 set result_is_chunk_list 1
} }
} }
fileevent $chan readable [ list [ namespace current] : : repl_handler $chan ]
set reading 1 set reading 1
if { $result ne " " } { if { $result ne " " } {
if { $status == 0 } { if { $status == 0 } {
if { [ string length $lastoutchar $lasterrchar ] } { if { [ screen_needs_clearance ] } {
puts - nonewline stderr \ n r puts- nonewline stderr \ n
} }
if { $result_is_chunk_list } { if { $result_is_chunk_list } {
foreach c $result { foreach c $result {
lassign $c chan text lassign $c term chan text
if { [ string length $text ] } { if { [ string length $text ] } {
puts - nonewline $chan $text if { $termchan eq " r e s u l t " } {
rputs stdout $resultprompt [ string map [ list \ n " \n $ r e s u l t p r o m p t " ] $text ]
# p u t s - n o n e w l i n e s t d o u t $ t e x t
} elseif { $termchan eq " r e s u l t e r r " } {
rputs stderr $resultprompt [ string map [ list \ n " \n $ r e s u l t p r o m p t " ] $text ]
} elseif { $termchan eq " i n f o " } {
rputs stderr $infoprompt [ string map [ list \ n " \n $ i n f o p r o m p t " ] $text ]
} else {
rputs - nonewline $termchan $text
}
} }
} }
} else { } else {
puts $result rputs $resultprompt [ string map [ list \ n " \n $ r e s l p r o m p t " ] $result ]
} }
doprompt " P % " doprompt " P % "
} else { } else {
# t c l e r r # t c l e r r
set c [ shellfilter : : ansi::+ yellow bold] if { $result_is_chunk_list } {
set n [ shellfilter : : ansi::+ ] foreach c $last_run_display {
puts stderr $c $result $n lassign $c termchan text
if { [ string length $text ] } {
if { $termchan eq " r e s u l t " } {
rputs stdout $resultprompt [ string map [ list \ n " \n $ r e s u l t p r o m p t " ] $text ]
# p u t s - n o n e w l i n e s t d o u t $ t e x t
} elseif { $termchan eq " r e s u l t e r r " } {
rputs stderr $resultprompt [ string map [ list \ n " \n $ r e s u l t p r o m p t " ] $text ]
} elseif { $termchan eq " i n f o " } {
rputs stderr $infoprompt [ string map [ list \ n " \n $ i n f o p r o m p t " ] $text ]
} else {
rputs - nonewline $termchan $text
}
}
}
}
set c [ a + yellow bold]
set n [ a + ]
rputs 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 # 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 % " doprompt " p % "
} }
} else { } else {
if { [ string length $lastoutchar $lasterrchar ] } { if { [ screen_needs_clearance ] } {
doprompt " \n P % " doprompt " \n P % "
} else { } else {
doprompt " P % " doprompt " P % "
} }
} }
set command " " set command " "
if { $::punkrepl::debug_repl > 0 } {
incr : : punkrepl::debug_repl - 1
}
} else { } else {
append command \ n # a p p e n d c o m m a n d \ n
doprompt " > " if { $::repl::signal_control_c } {
set : : repl::signal_control_c 0
rputs stderr " * c o n s o l e _ c o n t r o l : c o n t r o l - c "
set c [ a + yellow bold]
set n [ a + ]
rputs stderr " $ { c } r e p l i n t e r r u p t e d $ n "
# s e t c o m m a n d [ l i s t e r r o r " r e p l i n t e r r u p t e d " ]
set command " "
doprompt " > _ "
} else {
doprompt " > "
}
} }
fileevent $inputchan readable [ list [ namespace current] : : repl_handler $inputchan $prompt_config ]
} }
repl : : start stdinrepl : : start stdin
