Browse Source

telnet,ansi,winrun,scriptwrap fixes

master
Julian Noble 8 months ago
parent
commit
4aa2a348fd
  1. 32
      src/bootsupport/modules/overtype-1.6.0.tm
  2. 19
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  3. 13
      src/bootsupport/modules/punk/console-0.1.1.tm
  4. 2
      src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm
  5. 40
      src/modules/punk/ansi-999999.0a1.0.tm
  6. 64
      src/modules/punk/basictelnet-999999.0a1.0.tm
  7. 46
      src/modules/punk/console-999999.0a1.0.tm
  8. 48
      src/modules/punk/lib-999999.0a1.0.tm
  9. 2
      src/modules/punk/mix/commandset/project-999999.0a1.0.tm
  10. 31
      src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm
  11. 17
      src/modules/punk/repl-0.1.tm
  12. 82
      src/modules/punk/winrun-999999.0a1.0.tm

32
src/bootsupport/modules/overtype-1.6.0.tm

@ -1605,7 +1605,14 @@ proc overtype::renderline {args} {
switch -- $leadernorm { switch -- $leadernorm {
7CSI - 8CSI { 7CSI - 8CSI {
if {[string index $code end] eq "m"} { #need to exclude certain leaders after the lb e.g < for SGR 1006 mouse
#REVIEW - what else could end in m but be mistaken as a normal SGR code here?
set maybemouse ""
if {[string index $c1c2 0] eq "\x1b"} {
set maybemouse [string index $code 2]
}
if {$maybemouse ne "<" && [string index $code end] eq "m"} {
if {[punk::ansi::codetype::is_sgr_reset $code]} { if {[punk::ansi::codetype::is_sgr_reset $code]} {
set u_codestack [list "\x1b\[m"] set u_codestack [list "\x1b\[m"]
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} {
@ -2240,18 +2247,24 @@ proc overtype::renderline {args} {
set c1 [string index $code 0] set c1 [string index $code 0]
set c1c2 [string range $code 0 1] set c1c2c3 [string range $code 0 2]
#set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)}
set leadernorm [string range [string map [list\ set leadernorm [string range [string map [list\
\x1b\[< 1006\
\x1b\[ 7CSI\ \x1b\[ 7CSI\
\x9b 8CSI\ \x9b 8CSI\
\x1b\] 7OSC\ \x1b\] 7OSC\
\x9d 8OSC\ \x9d 8OSC\
\x1b 7ESC\ \x1b 7ESC\
] $c1c2] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars ] $c1c2c3] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars
#we leave the tail of the code unmapped for now #we leave the tail of the code unmapped for now
switch -- $leadernorm { switch -- $leadernorm {
1006 {
#https://invisible-island.net/xterm/ctlseqs/ctlseqs.html
#SGR (1006) CSI < followed by colon separated encoded-button-value,px,py ordinates and final M for button press m for button release
set codenorm [string cat $leadernorm [string range $code 3 end]]
}
7CSI - 7OSC { 7CSI - 7OSC {
set codenorm [string cat $leadernorm [string range $code 2 end]] set codenorm [string cat $leadernorm [string range $code 2 end]]
} }
@ -2269,6 +2282,19 @@ proc overtype::renderline {args} {
#we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables.
switch -- $leadernorm { switch -- $leadernorm {
1006 {
#TODO
#
switch -- [string index $codenorm end] {
M {
puts stderr "mousedown $codenorm"
}
m {
puts stderr "mouseup $codenorm"
}
}
}
{7CSI} - {8CSI} { {7CSI} - {8CSI} {
set param [string range $codenorm 4 end-1] set param [string range $codenorm 4 end-1]
#puts stdout "--> CSI [string index $leadernorm 0] bit param:$param" #puts stdout "--> CSI [string index $leadernorm 0] bit param:$param"

19
src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -2366,7 +2366,8 @@ namespace eval punk::ansi::class {
::punk::ansi::class::renderer::base_renderer destroy ;#will automatically destroy other classes such as class_cp437 that use this as a superclass ::punk::ansi::class::renderer::base_renderer destroy ;#will automatically destroy other classes such as class_cp437 that use this as a superclass
} }
oo::class create base_renderer { oo::class create base_renderer {
variable o_width o_wrap o_overflow o_appendlines o_looplimit variable o_width
variable o_wrap o_overflow o_appendlines o_looplimit
variable o_cursor_column o_cursor_row variable o_cursor_column o_cursor_row
#variable o_render_index ;#index of input (from_ansistring) grapheme/ansi-code that *has* been rendered #variable o_render_index ;#index of input (from_ansistring) grapheme/ansi-code that *has* been rendered
@ -2515,8 +2516,20 @@ namespace eval punk::ansi::class {
set count_rendered [expr {$start_elements_unrendered - $end_elements_unrendered}] set count_rendered [expr {$start_elements_unrendered - $end_elements_unrendered}]
assert {$rendercount == $count_rendered} assert {$rendercount == $count_rendered}
#todo - renderline equivalent? #todo - renderline equivalent that operates on already split data
#we start with one inputchunk, but we get appends/inserts if the whole chunk isn't for a single line of output
set inputchunks [list $newtext]
if 0 {
while {[llength $inputchunks]} {
set overtext [lpop inputchunks 0]
if {![string length $overtext]} {
continue
}
#set rinfo [overtype::renderline -info 1 -insert_mode 0 -autowrap_mode 1 -width $o_width -overflow 0 -cursor_column $col -cursor_row $row $undertext $overtext]
}
}
$o_to_ansistring append $newtext $o_to_ansistring append $newtext
return [dict create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered] return [dict create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered]

13
src/bootsupport/modules/punk/console-0.1.1.tm

@ -664,18 +664,29 @@ namespace eval punk::console {
} else { } else {
#! todo? for now, emit a clue as to what's happening. #! todo? for now, emit a clue as to what's happening.
puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]"
if {$::repl::running} {
if {[eof $input]} {
puts stdout "restarting repl"
repl::reopen_stdin
}
}
} }
} }
#Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines) #Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines)
#The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables.
#todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated?
} elseif {[llength $::repl::in_repl_handler]} { } elseif {$::repl::running} {
if {[llength $input_chunks_waiting($input)]} { if {[llength $input_chunks_waiting($input)]} {
#don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting.
#triggering it by putting it on the eventloop will potentially result in re-entrancy #triggering it by putting it on the eventloop will potentially result in re-entrancy
#The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed.
#puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]"
} }
if {[eof $input]} {
#test
puts stdout "restarting repl"
repl::reopen stdin
}
} }
catch { catch {

2
src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm

@ -915,7 +915,7 @@ namespace eval punk::mix::commandset::scriptwrap {
#process_extensions - either a single one - or all found or as per .wrapconfig #process_extensions - either a single one - or all found or as per .wrapconfig
if {$opt_template eq "\uFFFF"} { if {$opt_template eq "\uFFFF"} {
set templatename punk-multishell.cmd set templatename punk.multishell.cmd
} else { } else {
set templatename $opt_template set templatename $opt_template
} }

40
src/modules/punk/ansi-999999.0a1.0.tm

@ -473,25 +473,6 @@ namespace eval punk::ansi {
$obj destroy $obj destroy
return $result return $result
} }
proc is_utf8_char {char} {
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
[\x00-\x7F] | # Single-byte chars (ASCII range)
[\xC0-\xDF] [\x80-\xBF] | # Two-byte chars (\u0080-\u07FF)
[\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
[\xF0-\xF4] [\x80-\xBF]{3} # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
} $char
}
proc get_utf8 {text} {
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
\A (
[\x00-\x7F] | # Single-byte chars (ASCII range)
[\xC0-\xDF] [\x80-\xBF] | # Two-byte chars (\u0080-\u07FF)
[\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
[\xF0-\xF4] [\x80-\xBF]{3} # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
) +
} $text completeChars
return $completeChars
}
proc example {} { proc example {} {
#todo - review dependency on punk::repo ? #todo - review dependency on punk::repo ?
package require textblock package require textblock
@ -2355,7 +2336,7 @@ namespace eval punk::ansi::ta {
# -- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- ---
namespace eval punk::ansi::class { namespace eval punk::ansi::class {
#assertions specifically for punk::ansi::class namespace #assertions specifically for punk::ansi::class namespace
if {![llength [info commands ::punk::assertion::assert]]} { if {![llength [info commands ::punk::ansi::class::assert]]} {
namespace import ::punk::assertion::assert namespace import ::punk::assertion::assert
punk::assertion::active 1 punk::assertion::active 1
} }
@ -2366,7 +2347,8 @@ namespace eval punk::ansi::class {
::punk::ansi::class::renderer::base_renderer destroy ;#will automatically destroy other classes such as class_cp437 that use this as a superclass ::punk::ansi::class::renderer::base_renderer destroy ;#will automatically destroy other classes such as class_cp437 that use this as a superclass
} }
oo::class create base_renderer { oo::class create base_renderer {
variable o_width o_wrap o_overflow o_appendlines o_looplimit variable o_width
variable o_wrap o_overflow o_appendlines o_looplimit
variable o_cursor_column o_cursor_row variable o_cursor_column o_cursor_row
#variable o_render_index ;#index of input (from_ansistring) grapheme/ansi-code that *has* been rendered #variable o_render_index ;#index of input (from_ansistring) grapheme/ansi-code that *has* been rendered
@ -2515,8 +2497,20 @@ namespace eval punk::ansi::class {
set count_rendered [expr {$start_elements_unrendered - $end_elements_unrendered}] set count_rendered [expr {$start_elements_unrendered - $end_elements_unrendered}]
assert {$rendercount == $count_rendered} assert {$rendercount == $count_rendered}
#todo - renderline equivalent? #todo - renderline equivalent that operates on already split data
#we start with one inputchunk, but we get appends/inserts if the whole chunk isn't for a single line of output
set inputchunks [list $newtext]
if 0 {
while {[llength $inputchunks]} {
set overtext [lpop inputchunks 0]
if {![string length $overtext]} {
continue
}
#set rinfo [overtype::renderline -info 1 -insert_mode 0 -autowrap_mode 1 -width $o_width -overflow 0 -cursor_column $col -cursor_row $row $undertext $overtext]
}
}
$o_to_ansistring append $newtext $o_to_ansistring append $newtext
return [dict create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered] return [dict create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered]

64
src/modules/punk/basictelnet-999999.0a1.0.tm

@ -261,6 +261,8 @@ namespace eval punk::basictelnet {
variable initiate_will variable initiate_will
set initiate_will [list] set initiate_will [list]
# ----------------------------------- # -----------------------------------
variable fromserver_unprocessed
set fromserver_unprocessed ""
variable in_sb ;#whether we are in subnegotiation parameters and waiting for SE e.g for STATUS we may get multiple or evan all other codes as a report of the other side's perception of the option states. variable in_sb ;#whether we are in subnegotiation parameters and waiting for SE e.g for STATUS we may get multiple or evan all other codes as a report of the other side's perception of the option states.
set in_sb 0 set in_sb 0
@ -387,7 +389,6 @@ namespace eval punk::basictelnet {
#fconfigure $sock -buffering none -blocking 0 -encoding binary -translation crlf -eofchar {} #fconfigure $sock -buffering none -blocking 0 -encoding binary -translation crlf -eofchar {}
fconfigure $sock -buffering none -blocking 0 -encoding binary -translation binary -eofchar {} fconfigure $sock -buffering none -blocking 0 -encoding binary -translation binary -eofchar {}
fconfigure stdout -buffering none fconfigure stdout -buffering none
#fileevent $sock readable [list initEvents $sock]
fileevent $sock readable [list [namespace current]::fromServer $sock] fileevent $sock readable [list [namespace current]::fromServer $sock]
chan configure stdin -blocking 0 chan configure stdin -blocking 0
fileevent stdin readable [list [namespace current]::toServer $sock] fileevent stdin readable [list [namespace current]::toServer $sock]
@ -397,11 +398,6 @@ namespace eval punk::basictelnet {
chan conf stdin -blocking 1 chan conf stdin -blocking 1
} }
proc initEvents {sock} {
puts -nonewline [read $sock 4096]
fileevent $sock readable [list [namespace current]::fromServer $sock]
fileevent stdin readable [list [namespace current]::toServer $sock]
}
#specifically named 'waiting' argument as last argument for cooperative input reading with other punk channel handlers (repl in particular) #specifically named 'waiting' argument as last argument for cooperative input reading with other punk channel handlers (repl in particular)
#waiting data will be supplied to this handler if the other handler over-read (e.g repl handling ANSI ESC \[6n response on stdin finding other data before the ANSI response.) #waiting data will be supplied to this handler if the other handler over-read (e.g repl handling ANSI ESC \[6n response on stdin finding other data before the ANSI response.)
@ -488,9 +484,29 @@ namespace eval punk::basictelnet {
} }
proc fromServer {sock} { proc fromServer {sock} {
variable fromserver_unprocessed
fileevent $sock readable {} fileevent $sock readable {}
variable in_sb variable in_sb
set data [read $sock 4096] set chunksize 4096 ;#No choice of chunksize can avoid the possibility of splitting a token such as a Telnet protocol command or an ANSI sequence.
#in theory, a split ANSI sequence won't cause a problem - except if we have debug on which could emit a request on stdout (e.g get_cursor_pos)
#as a byte oriented supposedly ascii-by-default protocol - we shouldn't expect to get utf-8 without having negotiated it - but it looks suspiciously like this is the sort of thing that happens (2024) review? Examples? mapscii.me 1984.ws? Test.
#randomly chosen chunk boundaries - whether due to size or a combination of network speed and event scheduling can mean we get some utf8 characters split too.
set data $fromserver_unprocessed
set fromserver_unprocessed ""
append data [read $sock $chunksize]
#repeatedly appending when not fblocked - will somewhat reduce the risk of splitting both ANSI and TELNET commands - but at the cost of starving the output processing
#somewhat conveniently? - the IAC \xFF byte is not valid in utf-8 or ascii
#this whole mechanism may need to be reviewed/modified if/when Telnet binary mode and/or charset changing is implemented/understood by the author.
#The current basic system is tested on the few available public telnet servers. - todo - test on some old industrial equipment, read more RFCs.
#for now we'll use punk::lib::get_utf8_leading as a hack way to determine if we should throw some trailing data aside for next loop to process?
#while {![fblocked $sock] && ![eof $sock]} {
# add_debug "[a+ red bold]RE-READ[a]\n" stdin $sock
# append data [read $sock $chunksize]
#}
if {[eof $sock]} { if {[eof $sock]} {
add_debug "[a+ red]socket eof[a]\n" stdin $sock add_debug "[a+ red]socket eof[a]\n" stdin $sock
@ -510,6 +526,7 @@ namespace eval punk::basictelnet {
return return
} }
} }
#mini debug buffer for each fromServer call - render using add_debug each loop #mini debug buffer for each fromServer call - render using add_debug each loop
set debug_info "" set debug_info ""
append debug_info "------raw data [string length $data]------" \n append debug_info "------raw data [string length $data]------" \n
@ -536,20 +553,22 @@ namespace eval punk::basictelnet {
#write [string range $data 0 $idx-1] #write [string range $data 0 $idx-1]
puts -nonewline stdout [encoding convertfrom utf-8 [string range $data 0 $idx-1]] puts -nonewline stdout [encoding convertfrom utf-8 [string range $data 0 $idx-1]]
flush stdout flush stdout
set byte [string index $data [expr {$idx+1}]] set post_IAC_byte [string index $data [expr {$idx+1}]]
incr idx 2 incr idx 2
if {$byte < "\xef"} { if {$post_IAC_byte < "\xef"} {
#?? #??
write \xf0$byte #write \xf0$post_IAC_byte ;#from wiki code. purpose not understood.
set data [string range $data $idx end] set data [string range $data $idx end]
} elseif {$byte == "\xff"} { } elseif {$post_IAC_byte == "\xff"} {
#?? #write \xf0 ;#?? This came from wiki code - intention unclear.. latin small letter Eth
write \xf0 #RFC indicates double up of \xff is treated as literal
#this can't be part of utf-8 - so
puts -nonewline stdout \xff
set data [string range $data $idx end] set data [string range $data $idx end]
} else { } else {
set ophex "" set ophex ""
#telnet commands are at least 2 bytes #telnet commands are at least 2 bytes
binary scan $byte H2 cmdhex binary scan $post_IAC_byte H2 cmdhex
switch -- $cmdhex { switch -- $cmdhex {
fb - fc - fd - fe { fb - fc - fd - fe {
#WILL, WON'T, DO, DON'T #WILL, WON'T, DO, DON'T
@ -607,7 +626,13 @@ namespace eval punk::basictelnet {
} ;#end inner while } ;#end inner while
#puts -nonewline stdout $data #puts -nonewline stdout $data
puts -nonewline stdout "[encoding convertfrom utf-8 $data]" set prefix [punk::lib::get_utf8_leading $data]
set plen [string length $prefix]
set tail [string range $data $plen end]
puts -nonewline stdout "[encoding convertfrom utf-8 $prefix]"
set fromserver_unprocessed $tail
flush stdout flush stdout
set data "" set data ""
} ;#end outer while } ;#end outer while
@ -615,7 +640,14 @@ namespace eval punk::basictelnet {
punk::basictelnet::add_debug $debug_info stdin $sock punk::basictelnet::add_debug $debug_info stdin $sock
set debug_info "" set debug_info ""
#after idle [list fileevent $sock readable [list [namespace current]::fromServer $sock]] #after idle [list fileevent $sock readable [list [namespace current]::fromServer $sock]]
fileevent $sock readable [list [namespace current]::fromServer $sock] if {[string length $fromserver_unprocessed]} {
#review - by throwing to another loop without waiting for readable event - we could spin on same data...?
#after idle [list [namespace current]::fromServer $sock]
fileevent $sock readable [list [namespace current]::fromServer $sock]
} else {
fileevent $sock readable [list [namespace current]::fromServer $sock]
}
} }
proc disconnect {sock} { proc disconnect {sock} {

46
src/modules/punk/console-999999.0a1.0.tm

@ -551,7 +551,20 @@ namespace eval punk::console {
fileevent $input readable {} fileevent $input readable {}
set input_state [fconfigure $input] set input_state [fconfigure $input]
#todo - make timeout configurable?
set waitvarname "::punk::console::ansi_response_wait($callid)"
#500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review
set timeoutid($callid) [after 2000 [list set $waitvarname timedout]]
#JMN
# - stderr vs stdout
#It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions
#(presumably race conditions as to when data hits console?)
#review - experiment changing this and calling functions to stderr and see if it works
#review - Are there disadvantages to using stdout vs stderr?
#puts stdout "sending console request [ansistring VIEW $query]"
puts -nonewline $output $query;flush $output
#todo - test and save rawstate so we don't disableRaw if console was already raw #todo - test and save rawstate so we don't disableRaw if console was already raw
if {!$::punk::console::is_raw} { if {!$::punk::console::is_raw} {
@ -564,25 +577,19 @@ namespace eval punk::console {
# #
#in handler - its used for a boolean match (capturing aspect not used) #in handler - its used for a boolean match (capturing aspect not used)
set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on set clock($callid) [clock millis] ;#time of launch - may be delay before first event depending on what's going on
fileevent $input readable [list $this_handler $input $callid $capturingendregex]
# - stderr vs stdout #first shot without using filevent, call the stdin reader directly - maybe it's there already
#It has to be same channel as used by functions such as test_char_width or erroneous results returned for those functions #This can be significantly faster than setting up a fileevent (2024 e.g 1.5ms vs 65ms)
#(presumably race conditions as to when data hits console?) $this_handler $input $callid $capturingendregex
#review - experiment changing this and calling functions to stderr and see if it works if {$waitvar($callid) ne "ok"} {
#review - Are there disadvantages to using stdout vs stderr? fileevent $input readable [list $this_handler $input $callid $capturingendregex]
}
#puts stdout "sending console request [ansistring VIEW $query]"
puts -nonewline $output $query;flush $output
#JMN
#response from terminal #response from terminal
#e.g for cursor position \033\[46;1R #e.g for cursor position \033\[46;1R
#todo - make timeout configurable?
set waitvarname "::punk::console::ansi_response_wait($callid)"
#500ms is generally plenty for a terminal to respond.. but not in some cases. e.g event loop busy with stdin keypress?? review
set timeoutid($callid) [after 2000 [list set $waitvarname timedout]]
if {[set waitvar($callid)] eq ""} { if {[set waitvar($callid)] eq ""} {
vwait ::punk::console::ansi_response_wait($callid) vwait ::punk::console::ansi_response_wait($callid)
@ -664,18 +671,29 @@ namespace eval punk::console {
} else { } else {
#! todo? for now, emit a clue as to what's happening. #! todo? for now, emit a clue as to what's happening.
puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]"
if {$::repl::running} {
if {[eof $input]} {
puts stdout "restarting repl"
repl::reopen_stdin
}
}
} }
} }
#Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines) #Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines)
#The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables.
#todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated?
} elseif {[llength $::repl::in_repl_handler]} { } elseif {$::repl::running} {
if {[llength $input_chunks_waiting($input)]} { if {[llength $input_chunks_waiting($input)]} {
#don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting.
#triggering it by putting it on the eventloop will potentially result in re-entrancy #triggering it by putting it on the eventloop will potentially result in re-entrancy
#The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed. #The cooperating reader must be designed to consume waiting chunks and only reschedule it's channel read handler once all waiting chunks have been consumed.
#puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" #puts stderr "[punk::ansi::a+ green bold]--> repl_handler has chunks to consume [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]"
} }
if {[eof $input]} {
#test
puts stdout "restarting repl"
repl::reopen stdin
}
} }
catch { catch {

48
src/modules/punk/lib-999999.0a1.0.tm

@ -302,6 +302,54 @@ namespace eval punk::lib {
#[para]see [uri https://wiki.tcl-lang.org/page/K] #[para]see [uri https://wiki.tcl-lang.org/page/K]
#[para]It is used in cases where command-substitution at the calling-point performs some desired effect. #[para]It is used in cases where command-substitution at the calling-point performs some desired effect.
proc is_utf8_first {str} {
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
^
(?:
[\x00-\x7F] | # Single-byte chars (ASCII range)
[\xC0-\xDF] [\x80-\xBF] | # Two-byte chars (\u0080-\u07FF)
[\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
[\xF0-\xF4] [\x80-\xBF]{3} # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
)
} $str
}
proc is_utf8_single {1234bytes} {
#*** !doctools
#[call [fun is_utf8_single] [arg 1234bytes]]
#[para] Tests input of 1,2,3 or 4 bytes and responds with a boolean indicating if it is a valid utf-8 character (codepoint)
regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
^
(?:
[\x00-\x7F] | # Single-byte chars (ASCII range)
[\xC0-\xDF] [\x80-\xBF] | # Two-byte chars (\u0080-\u07FF)
[\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
[\xF0-\xF4] [\x80-\xBF]{3} # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
)
$
} $1234bytes
}
proc get_utf8_leading {rawbytes} {
#*** !doctools
#[call [fun get_utf8_leading] [arg rawbytes]]
#[para] return the leading portion of rawbytes that is a valid utf8 sequence.
#[para] This will stop at the point at which the bytes can't be interpreted as a complete utf-8 codepoint
#[para] e.g It will not return the first byte or 2 of a 3-byte utf-8 character if the last byte is missing, and will return only the valid utf-8 string from before the first byte of the incomplete character.
#[para] It will also only return the prefix before any bytes that cannot be part of a utf-8 sequence at all.
#[para] Note that while this will return valid utf8 - it has no knowledge of grapheme clusters or diacritics
#[para] This means if it is being used to process bytes split at some arbitrary point - the trailing data that isn't returned could be part of a grapheme cluster that belongs with the last character of the leading string already returned
#[para] The utf-8 BOM \xEF\xBB\xBF is a valid UTF8 3-byte sequence and so can also be returned as part of the leading utf8 bytes
if {[regexp {(?x) # Expanded regexp syntax, so I can put in comments :-)
\A (
[\x00-\x7F] | # Single-byte chars (ASCII range)
[\xC0-\xDF] [\x80-\xBF] | # Two-byte chars (\u0080-\u07FF)
[\xE0-\xEF] [\x80-\xBF]{2} | # Three-byte chars (\u0800-\uFFFF)
[\xF0-\xF4] [\x80-\xBF]{3} # Four-byte chars (U+10000-U+10FFFF, not supported by Tcl 8.5)
) +
} $rawbytes completeChars]} {
return $completeChars
}
return ""
}
proc hex2dec {args} { proc hex2dec {args} {
#*** !doctools #*** !doctools
#[call [fun hex2dec] [opt {option value...}] [arg list_largeHex]] #[call [fun hex2dec] [opt {option value...}] [arg list_largeHex]]

2
src/modules/punk/mix/commandset/project-999999.0a1.0.tm

@ -168,6 +168,8 @@ namespace eval punk::mix::commandset::project {
# -- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- ---
#todo - install support binaries on a per-project basis in a way that doesn't impact machine (e.g not added to path) - cache in user config dir if possible, supply mechanism to clear cache
#
set fossil_prog [auto_execok fossil] set fossil_prog [auto_execok fossil]
if {![string length $fossil_prog]} { if {![string length $fossil_prog]} {
puts stderr "The fossil program was not found. A fossil executable is required to use most deck features." puts stderr "The fossil program was not found. A fossil executable is required to use most deck features."

31
src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm

@ -915,19 +915,32 @@ namespace eval punk::mix::commandset::scriptwrap {
#process_extensions - either a single one - or all found or as per .wrapconfig #process_extensions - either a single one - or all found or as per .wrapconfig
if {$opt_template eq "\uFFFF"} { if {$opt_template eq "\uFFFF"} {
set templatename punk-multishell.cmd set templatename punk.multishell.cmd
} else { } else {
set templatename $opt_template set templatename $opt_template
} }
set templatename_root [file rootname [file tail $templatename]]
#determine name of file on disk based on whether templatename is prefixed with vendor.
set templatename_vendor ""
set templatename_fileroot $templatename_root
if {[llength [split $templatename_root .]] > 1} {
set tparts [split $templatename_root .]
set templatename_vendor [lindex $tparts 0]
set templatename_fileroot [join [lrange $tparts 1 end] .]
}
#assertion: templatename_fileroot is the base of the filname without the vendor and first dot
set template_base_dict [punk::mix::base::lib::get_template_basefolders] set template_base_dict [punk::mix::base::lib::get_template_basefolders]
set tpldirs [list] set tpldirs [list]
dict for {tdir tsourceinfo} $template_base_dict { dict for {tdir tsourceinfo} $template_base_dict {
if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { set vendor [dict get $tsourceinfo vendor]
if {[file exists $tdir/utility/scriptappwrappers/$templatename]} {
lappend tpldirs $tdir
} elseif {[file exists $tdir/utility/scriptappwrappers/$templatename_fileroot.[file extension $templatename]]} {
lappend tpldirs $tdir lappend tpldirs $tdir
} }
} }
if {[string length $customwrapper_folder] && [file exists [file join $customwrapper_folder $templatename] ]} { if {[string length $customwrapper_folder] && [file exists [file join $customwrapper_folder $templatename] ]} {
@ -942,9 +955,13 @@ namespace eval punk::mix::commandset::scriptwrap {
#last pkg with templates cap which was loaded has highest precedence #last pkg with templates cap which was loaded has highest precedence
set wrapper_template "" set wrapper_template ""
foreach tdir [lreverse $tpldirs] { foreach tdir [lreverse $tpldirs] {
set ftest [file join $tdir utility scriptappwrappers $templatename] set ftest1 [file join $tdir utility scriptappwrappers $templatename]
if {[file exists $ftest]} { set ftest2 [file join $tdir utility scriptappwrappers $templatename_fileroot.[file extension $templatename]]
set wrapper_template $ftest if {[file exists $ftest1]} {
set wrapper_template $ftest1
break
} elseif {[file exists $ftest2]} {
set wrapper_template $ftest2
break break
} }
} }

17
src/modules/punk/repl-0.1.tm

@ -659,13 +659,11 @@ proc repl::start {inchan args} {
variable editbuf_list ;#command history variable editbuf_list ;#command history
variable editbuf_linenum_submitted variable editbuf_linenum_submitted
# --- # ---
catch {
set punk::console::tabwidth [punk::console::get_tabstop_apparent_width]
}
variable running variable running
variable reading variable reading
variable done variable done
set done 0
variable startinstance variable startinstance
variable loopinstance variable loopinstance
if {[namespace exists ::punkapp]} { if {[namespace exists ::punkapp]} {
@ -696,6 +694,10 @@ proc repl::start {inchan args} {
doprompt "P% " doprompt "P% "
fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config]
set reading 1 set reading 1
catch {
#set punk::console::tabwidth [punk::console::get_tabstop_apparent_width]
}
vwait [namespace current]::done vwait [namespace current]::done
#todo - override exit? #todo - override exit?
#after 0 ::repl::post_operations #after 0 ::repl::post_operations
@ -1494,7 +1496,7 @@ proc repl::repl_handler_checkchannel {inputchan} {
rputs stderr "\n|repl> EOF on $inputchan." rputs stderr "\n|repl> EOF on $inputchan."
} }
set [namespace current]::done 1 set [namespace current]::done 1
#test after 1 [list repl::reopen_stdin]
#tailcall repl::reopen_stdin #tailcall repl::reopen_stdin
} }
} }
@ -1675,7 +1677,8 @@ proc repl::repl_handler {inputchan prompt_config} {
} }
#################################################### ####################################################
} else { } else {
catch {rputs stderr "repl_handler EOF $inputchannel:[chan conf $inputchan]"} #rputs stderr "repl_handler EOF inputchannel:[chan conf $inputchan]"
repl_handler_checkchannel $inputchan
} }
set in_repl_handler [list] set in_repl_handler [list]
} }
@ -2033,7 +2036,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
} }
set stdinconf [fconfigure $inputchan] set stdinconf [fconfigure $inputchan]
if {$::tcl_platform(platform) eq "windows" && [dict get $stdinconf -encoding] ni [list unicode utf-16]} { if {$::tcl_platform(platform) eq "windows" && [dict get $stdinconf -encoding] ni [list unicode utf-16 utf-8]} {
#some long console inputs are split weirdly when -encoding and -translation are left at defaults - requiring extra enter-key to get repl to process. #some long console inputs are split weirdly when -encoding and -translation are left at defaults - requiring extra enter-key to get repl to process.
#experiment to see if using binary and handling line endings manually gives insight. #experiment to see if using binary and handling line endings manually gives insight.
# - do: chan conf stdin -encoding binary -translation lf # - do: chan conf stdin -encoding binary -translation lf
@ -2048,7 +2051,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
#puts "--inputchan:$inputchan> [fconfigure $inputchan]" #puts "--inputchan:$inputchan> [fconfigure $inputchan]"
append commandstr $line append commandstr $line
puts "1=============>[string length $commandstr] bytes , [ansistring VIEW $commandstr] , info complete:[info complete $line]" puts "1=============>[string length $commandstr] bytes , [ansistring VIEW $commandstr] , info complete:[info complete $line] stdinconf:$stdinconf"
set commandstr [string range $commandstr 0 end-3] set commandstr [string range $commandstr 0 end-3]
set commandstr [encoding convertfrom utf-16be $commandstr] ;#This is weird - but it seems to be big endian? set commandstr [encoding convertfrom utf-16be $commandstr] ;#This is weird - but it seems to be big endian?
set commandstr [string trimright $commandstr] set commandstr [string trimright $commandstr]

82
src/modules/punk/winrun-999999.0a1.0.tm

@ -35,6 +35,88 @@ namespace eval punk::winrun {
package require twapi package require twapi
set psinfo [twapi::create_process {} -cmdline $cmdline {*}$args] set psinfo [twapi::create_process {} -cmdline $cmdline {*}$args]
} }
proc readchild_handler {chan hpid} {
#fileevent $chan readable {}
set data [read $chan 4096]
while {![fblocked $chan] && ![eof $chan]} {
append data [read $chan 4096]
}
puts stdout "-->$data eof:[eof $chan] fblocked [fblocked $chan]"
flush stdout
if {![eof $chan]} {
puts stdout "not eof $chan [fconfigure $chan] fblocked:[fblocked $chan]"
#fileevent $chan readable [list punk::winrun::readchild_handler $chan $hpid]
} else {
#puts "eof: waiting exit process"
set punk::winrun::waitresult [twapi::wait_on_handle $hpid -wait -1]
}
}
proc readchilderr_handler {chan} {
fileevent $chan readable {}
set data [read $chan]
puts stderr "err: $data"
flush stderr
if {![eof $chan]} {
fileevent $chan readable [list punk::winrun::readchild_handler $chan]
}
}
proc testrun {cmdline} {
#twapi::create_file to redirect?
package require twapi
set cmdid [clock millis]
set childout [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stdout-%id%}] -access write]
set childerr [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stderr-%id%}] -access write]
set childin [twapi::namedpipe_server [string map [list %id% $cmdid ] {//./pipe/tcl-stdin-%id%}] -access read]
set psinfo [twapi::create_process {} -cmdline $cmdline -returnhandles 1 -detached 0 -newconsole 1 -showwindow hidden -inherithandles 1 -stdchannels [list $childin $childout $childerr]]
puts stdout "psinfo:$psinfo"
lassign $psinfo _pid _tid hpid htid
set readout [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stdout-%id%}] -access read]
set readerr [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stderr-%id%}] -access read]
set writein [twapi::namedpipe_client [string map [list %id% $cmdid ] {//./pipe/tcl-stdin-%id%}] -access write]
#after 1000
chan configure $readout -blocking 0
fileevent $readout readable [list readchild_handler $readout $hpid]
puts stdout "input: [chan configure $writein]"
puts $writein "puts stdout blah;"
flush $writein
puts $writein "flush stdout"
flush $writein
puts $writein "puts exiting"
puts $writein "after 10;exit 4"
flush $writein
#puts stdout x--[read $readout]
#if the cmdline is a pipeline - the wait will return as soon as the first process returns... not the entire pipeline. :/
#set waitresult [twapi::wait_on_handle $hpid -wait -1]
#e.g timeout, signalled
close $childout
close $childerr
close $childin
#after 1 [list wait_on $hpid]
variable waitresult
vwait punk::winrun::waitresult
if {$waitresult eq "timeout"} {
puts stderr "tw_run: timeout waiting for process"
}
fileevent $readout readable {}
fileevent $readerr readable {}
set code [twapi::get_process_exit_code $hpid]
twapi::close_handle $htid
twapi::close_handle $hpid
return [dict create exitcode $code]
}
proc wait_on {hpid} {
set punk::winrun::waitresult [twapi::wait_on_handle $hpid -wait -1]
}
proc tw_run {cmdline} { proc tw_run {cmdline} {
#twapi::create_file to redirect? #twapi::create_file to redirect?
package require twapi package require twapi

Loading…
Cancel
Save