From 0ced0e1f2f27ac8e794e430aa3ab83a115c69428 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 6 Jul 2026 02:23:51 +1000 Subject: [PATCH] update bootsupport,vfs --- .../{console-0.7.0.tm => console-0.7.1.tm} | 82 ++++++++++++- .../modules/punk/repl-0.2.2.tm} | 51 +++++++- .../custom/_project/punk.basic/src/make.tcl | 116 +++++++++++++++++- .../modules/punk/console-0.7.1.tm} | 82 ++++++++++++- .../bootsupport/modules/punk/repl-0.2.2.tm} | 51 +++++++- .../_project/punk.project-0.1/src/make.tcl | 116 +++++++++++++++++- .../modules/punk/console-0.7.1.tm} | 82 ++++++++++++- .../bootsupport/modules/punk/repl-0.2.2.tm} | 51 +++++++- .../_project/punk.shell-0.1/src/make.tcl | 116 +++++++++++++++++- .../{console-0.7.0.tm => console-0.7.1.tm} | 82 ++++++++++++- .../modules/punk/repl-0.2.2.tm} | 51 +++++++- 11 files changed, 842 insertions(+), 38 deletions(-) rename src/bootsupport/modules/punk/{console-0.7.0.tm => console-0.7.1.tm} (98%) rename src/{project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm => bootsupport/modules/punk/repl-0.2.2.tm} (98%) rename src/project_layouts/custom/_project/{punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.0.tm => punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm} (98%) rename src/{bootsupport/modules/punk/repl-0.2.1.tm => project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm} (98%) rename src/project_layouts/custom/_project/{punk.project-0.1/src/bootsupport/modules/punk/console-0.7.0.tm => punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm} (98%) rename src/{vfs/_vfscommon.vfs/modules/punk/repl-0.2.1.tm => project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm} (98%) rename src/vfs/_vfscommon.vfs/modules/punk/{console-0.7.0.tm => console-0.7.1.tm} (98%) rename src/{project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm => vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm} (98%) diff --git a/src/bootsupport/modules/punk/console-0.7.0.tm b/src/bootsupport/modules/punk/console-0.7.1.tm similarity index 98% rename from src/bootsupport/modules/punk/console-0.7.0.tm rename to src/bootsupport/modules/punk/console-0.7.1.tm index b1c791b0..aac663a3 100644 --- a/src/bootsupport/modules/punk/console-0.7.0.tm +++ b/src/bootsupport/modules/punk/console-0.7.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::console 0.7.0 +# Application punk::console 0.7.1 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::console 0 0.7.0] +#[manpage_begin punkshell_module_punk::console 0 0.7.1] #[copyright "2024"] #[titledesc {punk console}] [comment {-- Name section and table of contents description --}] #[moddesc {punk console}] [comment {-- Description at end of page heading --}] @@ -705,6 +705,16 @@ namespace eval punk::console { #For mintty-without-winpty (terminal presenting pipes) the twapi raw cycle was already a #no-op via its get_console_handle early-return, so nothing is lost by skipping. set input_is_console_or_tty [expr {[dict exists $previous_input_state -inputmode] || [dict exists $previous_input_state -mode]}] + if {!$input_is_console_or_tty && $input eq "stdin" && $::punk::console::has_twapi} { + #Tcl 8.6 windows console channels have no -inputmode configure key, so the + #dict test alone misclassifies a real 8.6 console as a pipe: the raw cycle + #is then skipped and the query response sits in the cooked line buffer until + #Enter - timeout here plus the response leaking to the line reader as phantom + #input. A twapi console handle for stdin is definitive. Channels other than + #stdin stay excluded - the guard's purpose (pipe probes must not flip the + #process console) is unchanged. + set input_is_console_or_tty [expr {![catch {twapi::get_console_handle stdin}]}] + } if {![tsv::get punk_console is_raw]} { set was_raw 0 if {$input_is_console_or_tty} { @@ -2009,6 +2019,16 @@ namespace eval punk::console { #pending keystroke with a probe read here. return 0 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key, so the dict test above + #misses them. Beyond the pending-keystroke concern, the probe read is fatal here: + #a read on a drained 8.6 console channel makes the channel driver park a blocking + #cooked-mode ReadConsole that cannot be cancelled by a later raw-mode flip - it + #swallows a terminal query response emitted afterwards (get_ansi_response_payload + #calls this guard immediately before its raw cycle) and only completes on Enter. + return 0 + } #pipe-like channel - probe without blocking to force eof detection if {[catch { set prior_blocking [dict get $conf -blocking] @@ -2057,6 +2077,14 @@ namespace eval punk::console { #tty on unix-like platforms return 1 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key - a twapi console + #handle for stdin is definitive: process stdin is the real console. Terminals + #presenting channels as pipes (mintty without winpty) have no console handle + #and fall through to the env heuristics below. + return 1 + } if {[input_at_eof $input]} { return 0 } @@ -2861,7 +2889,14 @@ namespace eval punk::console { proc ensure_object_integration {} { variable object_integration_done if {$object_integration_done} { - return + return 1 + } + if {![namespace exists ::opunk::console]} { + #opunk::console not loaded - nothing to integrate with yet. In-module callers only + #reach here after a successful 'package require opunk::console'; external/manual + #callers may call speculatively. Deliberately does not set object_integration_done, + #so a later call after opunk::console loads performs the wiring. + return 0 } set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting if {$::opunk::console::size_query_provider eq ""} { @@ -2872,8 +2907,27 @@ namespace eval punk::console { #consult-time liveness validation still cover the default console there) if {[info exists ::opunk::console::lifecycle_callback] && $::opunk::console::lifecycle_callback eq ""} { set ::opunk::console::lifecycle_callback [list ::punk::console::internal::object_console_lifecycle] + #catch-up registration: anchors created in this interp before the callback was + #wired never fired a 'created' event, so their consoles have no recorded owner + #(seen when user code does 'package require opunk::console; opunk::console::create ...' + #before any punk::console object operation triggers this wiring). Anchors are + #per-interp/per-thread, so the anchoring context is this thread - register it. + #Only fills empty entries: an existing live registration is newer information than + #these pre-wiring anchors (and for the default console first-registration wins). + foreach v [info vars ::opunk::console::instances::*] { + if {![info exists $v]} { + continue + } + if {[catch {::opunk::Console::channels [set $v]} channels]} { + continue + } + if {[console_owner_get $channels] eq ""} { + console_owner_register $channels + } + } } set object_integration_done 1 + return 1 } lappend PUNKARGS [list { @@ -2944,12 +2998,19 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + #flush before querying: the position query may execute in the console-owning + #thread (G-007 routing), whose flush acts on its own channel instance for the same + #OS handle - an unflushed move here would leave the terminal reporting the + #unmoved cursor position (seen as 'columns 1' on tcl 8.6 where the -winsize + #shortcut is unavailable and this mechanism actually runs) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::move $start_row $start_col] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -2983,12 +3044,16 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::cursor_save_dec][punk::ansi::move 2000 2000] + #flush before querying - see get_size_using_cursormove (G-007 routing: the query + #may flush a different channel instance in the console-owning thread) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::cursor_restore][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::cursor_restore_dec] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -4238,6 +4303,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before each cursor query: the query may execute in the console-owning thread + #(G-007 routing) whose flush acts on its own channel instance - unflushed emissions + #here would be measured as if they never happened (see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -4259,6 +4328,7 @@ namespace eval punk::console { } errM]} { puts stderr "test_char_width couldn't emit this string - \nerror: $errM" } + flush $out ;#the test emission must reach the terminal before the (possibly routed) query measures it set response [punk::console::get_cursor_pos $inoutchannels] lassign [split $response ";"] _row2 col2 @@ -4313,6 +4383,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before the cursor query - the alt-screen/move/erase emissions above must reach + #the terminal first (the query may flush a different channel instance in the + #console-owning thread under G-007 routing - see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -6254,7 +6328,7 @@ namespace eval ::punk::args::register { ## Ready package provide punk::console [namespace eval punk::console { variable version - set version 0.7.0 + set version 0.7.1 }] return diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm b/src/bootsupport/modules/punk/repl-0.2.2.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm rename to src/bootsupport/modules/punk/repl-0.2.2.tm index 6459e1a8..355c9abf 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm +++ b/src/bootsupport/modules/punk/repl-0.2.2.tm @@ -1635,6 +1635,7 @@ proc repl::repl_handler {inputchan readmore prompt_config} { #note -inputmode not available in Tcl 8.6 for chan configure! #According to DKF - -buffering option doesn't affect input channels set rawmode 0 + set waiting_needs_reader 0 ;#set when the 8.6-console waiting-chunks path skips its read on a drained channel - the readable handler must be armed (not the after-idle reinvoke) or the pending partial line could never complete set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { @@ -1693,9 +1694,46 @@ proc repl::repl_handler {inputchan readmore prompt_config} { uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] set input_chunks_waiting($inputchan) [list $waitingchunk] } else { - set chunk [read $inputchan] + set hostage_noread 0 + if {"windows" eq $::tcl_platform(platform) + && ![dict exists $original_input_conf -inputmode] + && $::punk::console::has_twapi + && ![catch {twapi::get_console_handle stdin}]} { + #tcl 8.6 windows console channel (no -inputmode configure key, real console + #handle). On the 8.6 console driver a read on a *drained* channel parks a + #blocking cooked-mode ReadConsole that a later raw-mode flip cannot cancel: + #it swallows terminal query responses until Enter (see punk::console 0.7.1 + #buildversion notes). This waiting-chunks path is normally entered via + #'after idle' with the channel drained - only consume what is already in the + #Tcl channel buffer (sized read - no driver probe); when nothing is buffered, + #process the stashed complete lines without reading and arm the readable + #handler for the rest. + set avail [chan pending input $inputchan] + if {$avail > 0} { + set chunk [read $inputchan $avail] + } else { + set chunk "" + set hostage_noread 1 + set waiting_needs_reader 1 + } + } else { + set chunk [read $inputchan] + } set chunksize [string length $chunk] - if {$chunksize > 0} { + if {$hostage_noread} { + #nothing in the Tcl buffer and we must not probe the drained driver. + #Process the complete stashed lines now; a remaining partial line can only + #progress via more user input, which the armed readable handler delivers. + if {[llength $stdinlines]} { + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + } + if {$waitingchunk ne ""} { + set input_chunks_waiting($inputchan) [list $waitingchunk] + } else { + set input_chunks_waiting($inputchan) [list] + } + } elseif {$chunksize > 0} { if {[string index $chunk end] eq "\n"} { lappend stdinlines $waitingchunk[string range $chunk 0 end-1] #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" @@ -1864,7 +1902,12 @@ proc repl::repl_handler {inputchan readmore prompt_config} { ################################################################################## #Re-enable channel read handler only if no waiting chunks - must process in order ################################################################################## - if {![llength $input_chunks_waiting($inputchan)]} { + if {![llength $input_chunks_waiting($inputchan)] || $waiting_needs_reader} { + #waiting_needs_reader: the 8.6-console waiting-chunks path found nothing in the + #Tcl channel buffer and must not probe the drained driver - the waiting data is + #an incomplete line that can only progress when the user types more, so arm the + #reader (the driver listening for input is its job here) instead of an after-idle + #reinvoke that could never make progress. chan event $inputchan readable [list ::repl::repl_handler $inputchan $readmore $prompt_config] } else { #review @@ -4172,7 +4215,7 @@ namespace eval repl { } package provide punk::repl [namespace eval punk::repl { variable version - set version 0.2.1 + set version 0.2.2 }] #repl::start $program_read_stdin_pipe diff --git a/src/project_layouts/custom/_project/punk.basic/src/make.tcl b/src/project_layouts/custom/_project/punk.basic/src/make.tcl index c7f006ba..c31f1c75 100644 --- a/src/project_layouts/custom/_project/punk.basic/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.basic/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -328,6 +328,55 @@ proc ::punkboot::lib::bootsupport_prompt_yesno {prompt} { return [expr {$answer eq "y" || $answer eq "yes"}] } +#------------------------------------------------------------------------------ +# Project-version helpers — self-contained Tcl, no punk package deps. +# Used by the 'projectversion' subcommand to verify that punkproject.toml +# and CHANGELOG.md stay consistent and that the project version is bumped +# when src/ changes ship user-visible behaviour. Advisory only (warns). +#------------------------------------------------------------------------------ + +# Read the [project] version from a TOML file via a simple line scan. +# Returns the version string (e.g. "0.2.0") or "" if not found. +proc ::punkboot::lib::read_punkproject_version {tomlfile} { + if {![file exists $tomlfile]} {return ""} + set fh [open $tomlfile r] + try { + set content [read $fh] + } finally { + close $fh + } + set in_project 0 + foreach line [split $content \n] { + set trimmed [string trim $line] + if {[string index $trimmed 0] eq {[} && [string index $trimmed end] eq {]}} { + set in_project [expr {$trimmed eq "\[project\]"}] + continue + } + if {$in_project && [regexp {^version\s*=\s*"([^"]+)"} $trimmed _ v]} { + return $v + } + } + return "" +} + +# Read the latest ## [X.Y.Z] version header from a changelog file. +# Returns the version string or "" if no header found. +proc ::punkboot::lib::read_changelog_latest_version {changelogfile} { + if {![file exists $changelogfile]} {return ""} + set fh [open $changelogfile r] + try { + set content [read $fh] + } finally { + close $fh + } + foreach line [split $content \n] { + if {[regexp {^##\s*\[([0-9][^\]]*)\]} $line _ v]} { + return $v + } + } + return "" +} + if {"::try" ni [info commands ::try]} { puts stderr "Tcl interpreter possibly too old - need at least tcl 8.6 - 'try' command not found - aborting" exit 1 @@ -1358,6 +1407,8 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - show module/library paths and any potentially problematic packages for running this script" \n append h " $scriptname shell" \n append h " - run the punk shell using bootsupport libraries." \n + append h " $scriptname projectversion" \n + append h " - advisory check: verify CHANGELOG.md matches punkproject.toml and warn if src/ has changes since the last project-version bump." \n \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1532,7 +1583,7 @@ if {[lsearch $::argv -k] >= 0} { # - minor bump -> prompt user; backward-compat aliases *should* keep old bootsupport functional # - patch bump -> warn and proceed (non-breaking) # 'check' is exempt in all cases — the warning is shown at the end of its output instead. -if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check"} { +if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check" && $::punkboot::command ne "projectversion"} { set _stale $::punkboot::stale_bootsupport set _have_major 0 set _have_minor 0 @@ -1825,8 +1876,69 @@ if {$::punkboot::command eq "info"} { exit 0 } +if {$::punkboot::command eq "projectversion"} { + set sep [string repeat - 75] + puts stdout $sep + puts stdout "project version check" + puts stdout $sep + + set pp_file [file join $projectroot punkproject.toml] + set cl_file [file join $projectroot CHANGELOG.md] + set src_folder [file join $projectroot src] + + set pp_version [::punkboot::lib::read_punkproject_version $pp_file] + set cl_version [::punkboot::lib::read_changelog_latest_version $cl_file] + + puts stdout "punkproject.toml version : [expr {[string length $pp_version] ? $pp_version : "(not found)"}]" + puts stdout "CHANGELOG.md version : [expr {[string length $cl_version] ? $cl_version : "(not found)"}]" + # 1. Consistency: CHANGELOG latest header must match punkproject.toml version. + if {![string length $pp_version]} { + puts stderr "WARNING: could not read version from $pp_file" + } elseif {![string length $cl_version]} { + puts stderr "WARNING: no '## [X.Y.Z]' version header found in $cl_file" + } elseif {$pp_version ne $cl_version} { + puts stderr "WARNING: version mismatch — punkproject.toml=$pp_version but CHANGELOG.md=$cl_version" + puts stderr " The latest '## [X.Y.Z]' header in CHANGELOG.md must match the version in punkproject.toml." + } else { + puts stdout "consistency: OK (versions match)" + } + # 2. Staleness: warn if src/ has git commits since the last commit + # touching punkproject.toml (version bump may be overdue). + # Best-effort — silently skipped if git is unavailable or the repo + # is not under git revision control. + set pp_commit "" + if {![catch {exec git -C $projectroot log -1 --format=%H -- punkproject.toml} pp_raw]} { + set pp_commit [string trim $pp_raw] + } + if {[string length $pp_commit]} { + if {![catch {exec git -C $projectroot log --oneline ${pp_commit}..HEAD -- src/} src_raw]} { + set src_changes [string trim $src_raw] + if {[string length $src_changes]} { + set n [llength [split $src_changes \n]] + puts stderr "WARNING: $n commit(s) in src/ since last punkproject.toml change — a project-version bump may be overdue." + puts stderr " Review the changes and bump punkproject.toml per the root AGENTS.md 'Project Versioning' section." + puts stderr " (showing first 5 commits below)" + set i 0 + foreach line [split $src_changes \n] { + if {$i >= 5} break + puts stderr " $line" + incr i + } + } else { + puts stdout "staleness: OK (no src/ changes since last punkproject.toml commit)" + } + } else { + puts stdout "staleness: skipped (git query failed)" + } + } else { + puts stdout "staleness: skipped (punkproject.toml has no git history or git unavailable)" + } + + puts stdout $sep + exit 0 +} if {$::punkboot::command eq "shell"} { package require struct::list diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.0.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm index b1c791b0..aac663a3 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::console 0.7.0 +# Application punk::console 0.7.1 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::console 0 0.7.0] +#[manpage_begin punkshell_module_punk::console 0 0.7.1] #[copyright "2024"] #[titledesc {punk console}] [comment {-- Name section and table of contents description --}] #[moddesc {punk console}] [comment {-- Description at end of page heading --}] @@ -705,6 +705,16 @@ namespace eval punk::console { #For mintty-without-winpty (terminal presenting pipes) the twapi raw cycle was already a #no-op via its get_console_handle early-return, so nothing is lost by skipping. set input_is_console_or_tty [expr {[dict exists $previous_input_state -inputmode] || [dict exists $previous_input_state -mode]}] + if {!$input_is_console_or_tty && $input eq "stdin" && $::punk::console::has_twapi} { + #Tcl 8.6 windows console channels have no -inputmode configure key, so the + #dict test alone misclassifies a real 8.6 console as a pipe: the raw cycle + #is then skipped and the query response sits in the cooked line buffer until + #Enter - timeout here plus the response leaking to the line reader as phantom + #input. A twapi console handle for stdin is definitive. Channels other than + #stdin stay excluded - the guard's purpose (pipe probes must not flip the + #process console) is unchanged. + set input_is_console_or_tty [expr {![catch {twapi::get_console_handle stdin}]}] + } if {![tsv::get punk_console is_raw]} { set was_raw 0 if {$input_is_console_or_tty} { @@ -2009,6 +2019,16 @@ namespace eval punk::console { #pending keystroke with a probe read here. return 0 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key, so the dict test above + #misses them. Beyond the pending-keystroke concern, the probe read is fatal here: + #a read on a drained 8.6 console channel makes the channel driver park a blocking + #cooked-mode ReadConsole that cannot be cancelled by a later raw-mode flip - it + #swallows a terminal query response emitted afterwards (get_ansi_response_payload + #calls this guard immediately before its raw cycle) and only completes on Enter. + return 0 + } #pipe-like channel - probe without blocking to force eof detection if {[catch { set prior_blocking [dict get $conf -blocking] @@ -2057,6 +2077,14 @@ namespace eval punk::console { #tty on unix-like platforms return 1 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key - a twapi console + #handle for stdin is definitive: process stdin is the real console. Terminals + #presenting channels as pipes (mintty without winpty) have no console handle + #and fall through to the env heuristics below. + return 1 + } if {[input_at_eof $input]} { return 0 } @@ -2861,7 +2889,14 @@ namespace eval punk::console { proc ensure_object_integration {} { variable object_integration_done if {$object_integration_done} { - return + return 1 + } + if {![namespace exists ::opunk::console]} { + #opunk::console not loaded - nothing to integrate with yet. In-module callers only + #reach here after a successful 'package require opunk::console'; external/manual + #callers may call speculatively. Deliberately does not set object_integration_done, + #so a later call after opunk::console loads performs the wiring. + return 0 } set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting if {$::opunk::console::size_query_provider eq ""} { @@ -2872,8 +2907,27 @@ namespace eval punk::console { #consult-time liveness validation still cover the default console there) if {[info exists ::opunk::console::lifecycle_callback] && $::opunk::console::lifecycle_callback eq ""} { set ::opunk::console::lifecycle_callback [list ::punk::console::internal::object_console_lifecycle] + #catch-up registration: anchors created in this interp before the callback was + #wired never fired a 'created' event, so their consoles have no recorded owner + #(seen when user code does 'package require opunk::console; opunk::console::create ...' + #before any punk::console object operation triggers this wiring). Anchors are + #per-interp/per-thread, so the anchoring context is this thread - register it. + #Only fills empty entries: an existing live registration is newer information than + #these pre-wiring anchors (and for the default console first-registration wins). + foreach v [info vars ::opunk::console::instances::*] { + if {![info exists $v]} { + continue + } + if {[catch {::opunk::Console::channels [set $v]} channels]} { + continue + } + if {[console_owner_get $channels] eq ""} { + console_owner_register $channels + } + } } set object_integration_done 1 + return 1 } lappend PUNKARGS [list { @@ -2944,12 +2998,19 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + #flush before querying: the position query may execute in the console-owning + #thread (G-007 routing), whose flush acts on its own channel instance for the same + #OS handle - an unflushed move here would leave the terminal reporting the + #unmoved cursor position (seen as 'columns 1' on tcl 8.6 where the -winsize + #shortcut is unavailable and this mechanism actually runs) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::move $start_row $start_col] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -2983,12 +3044,16 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::cursor_save_dec][punk::ansi::move 2000 2000] + #flush before querying - see get_size_using_cursormove (G-007 routing: the query + #may flush a different channel instance in the console-owning thread) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::cursor_restore][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::cursor_restore_dec] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -4238,6 +4303,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before each cursor query: the query may execute in the console-owning thread + #(G-007 routing) whose flush acts on its own channel instance - unflushed emissions + #here would be measured as if they never happened (see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -4259,6 +4328,7 @@ namespace eval punk::console { } errM]} { puts stderr "test_char_width couldn't emit this string - \nerror: $errM" } + flush $out ;#the test emission must reach the terminal before the (possibly routed) query measures it set response [punk::console::get_cursor_pos $inoutchannels] lassign [split $response ";"] _row2 col2 @@ -4313,6 +4383,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before the cursor query - the alt-screen/move/erase emissions above must reach + #the terminal first (the query may flush a different channel instance in the + #console-owning thread under G-007 routing - see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -6254,7 +6328,7 @@ namespace eval ::punk::args::register { ## Ready package provide punk::console [namespace eval punk::console { variable version - set version 0.7.0 + set version 0.7.1 }] return diff --git a/src/bootsupport/modules/punk/repl-0.2.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm similarity index 98% rename from src/bootsupport/modules/punk/repl-0.2.1.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm index 6459e1a8..355c9abf 100644 --- a/src/bootsupport/modules/punk/repl-0.2.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm @@ -1635,6 +1635,7 @@ proc repl::repl_handler {inputchan readmore prompt_config} { #note -inputmode not available in Tcl 8.6 for chan configure! #According to DKF - -buffering option doesn't affect input channels set rawmode 0 + set waiting_needs_reader 0 ;#set when the 8.6-console waiting-chunks path skips its read on a drained channel - the readable handler must be armed (not the after-idle reinvoke) or the pending partial line could never complete set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { @@ -1693,9 +1694,46 @@ proc repl::repl_handler {inputchan readmore prompt_config} { uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] set input_chunks_waiting($inputchan) [list $waitingchunk] } else { - set chunk [read $inputchan] + set hostage_noread 0 + if {"windows" eq $::tcl_platform(platform) + && ![dict exists $original_input_conf -inputmode] + && $::punk::console::has_twapi + && ![catch {twapi::get_console_handle stdin}]} { + #tcl 8.6 windows console channel (no -inputmode configure key, real console + #handle). On the 8.6 console driver a read on a *drained* channel parks a + #blocking cooked-mode ReadConsole that a later raw-mode flip cannot cancel: + #it swallows terminal query responses until Enter (see punk::console 0.7.1 + #buildversion notes). This waiting-chunks path is normally entered via + #'after idle' with the channel drained - only consume what is already in the + #Tcl channel buffer (sized read - no driver probe); when nothing is buffered, + #process the stashed complete lines without reading and arm the readable + #handler for the rest. + set avail [chan pending input $inputchan] + if {$avail > 0} { + set chunk [read $inputchan $avail] + } else { + set chunk "" + set hostage_noread 1 + set waiting_needs_reader 1 + } + } else { + set chunk [read $inputchan] + } set chunksize [string length $chunk] - if {$chunksize > 0} { + if {$hostage_noread} { + #nothing in the Tcl buffer and we must not probe the drained driver. + #Process the complete stashed lines now; a remaining partial line can only + #progress via more user input, which the armed readable handler delivers. + if {[llength $stdinlines]} { + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + } + if {$waitingchunk ne ""} { + set input_chunks_waiting($inputchan) [list $waitingchunk] + } else { + set input_chunks_waiting($inputchan) [list] + } + } elseif {$chunksize > 0} { if {[string index $chunk end] eq "\n"} { lappend stdinlines $waitingchunk[string range $chunk 0 end-1] #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" @@ -1864,7 +1902,12 @@ proc repl::repl_handler {inputchan readmore prompt_config} { ################################################################################## #Re-enable channel read handler only if no waiting chunks - must process in order ################################################################################## - if {![llength $input_chunks_waiting($inputchan)]} { + if {![llength $input_chunks_waiting($inputchan)] || $waiting_needs_reader} { + #waiting_needs_reader: the 8.6-console waiting-chunks path found nothing in the + #Tcl channel buffer and must not probe the drained driver - the waiting data is + #an incomplete line that can only progress when the user types more, so arm the + #reader (the driver listening for input is its job here) instead of an after-idle + #reinvoke that could never make progress. chan event $inputchan readable [list ::repl::repl_handler $inputchan $readmore $prompt_config] } else { #review @@ -4172,7 +4215,7 @@ namespace eval repl { } package provide punk::repl [namespace eval punk::repl { variable version - set version 0.2.1 + set version 0.2.2 }] #repl::start $program_read_stdin_pipe diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl index c7f006ba..c31f1c75 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -328,6 +328,55 @@ proc ::punkboot::lib::bootsupport_prompt_yesno {prompt} { return [expr {$answer eq "y" || $answer eq "yes"}] } +#------------------------------------------------------------------------------ +# Project-version helpers — self-contained Tcl, no punk package deps. +# Used by the 'projectversion' subcommand to verify that punkproject.toml +# and CHANGELOG.md stay consistent and that the project version is bumped +# when src/ changes ship user-visible behaviour. Advisory only (warns). +#------------------------------------------------------------------------------ + +# Read the [project] version from a TOML file via a simple line scan. +# Returns the version string (e.g. "0.2.0") or "" if not found. +proc ::punkboot::lib::read_punkproject_version {tomlfile} { + if {![file exists $tomlfile]} {return ""} + set fh [open $tomlfile r] + try { + set content [read $fh] + } finally { + close $fh + } + set in_project 0 + foreach line [split $content \n] { + set trimmed [string trim $line] + if {[string index $trimmed 0] eq {[} && [string index $trimmed end] eq {]}} { + set in_project [expr {$trimmed eq "\[project\]"}] + continue + } + if {$in_project && [regexp {^version\s*=\s*"([^"]+)"} $trimmed _ v]} { + return $v + } + } + return "" +} + +# Read the latest ## [X.Y.Z] version header from a changelog file. +# Returns the version string or "" if no header found. +proc ::punkboot::lib::read_changelog_latest_version {changelogfile} { + if {![file exists $changelogfile]} {return ""} + set fh [open $changelogfile r] + try { + set content [read $fh] + } finally { + close $fh + } + foreach line [split $content \n] { + if {[regexp {^##\s*\[([0-9][^\]]*)\]} $line _ v]} { + return $v + } + } + return "" +} + if {"::try" ni [info commands ::try]} { puts stderr "Tcl interpreter possibly too old - need at least tcl 8.6 - 'try' command not found - aborting" exit 1 @@ -1358,6 +1407,8 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - show module/library paths and any potentially problematic packages for running this script" \n append h " $scriptname shell" \n append h " - run the punk shell using bootsupport libraries." \n + append h " $scriptname projectversion" \n + append h " - advisory check: verify CHANGELOG.md matches punkproject.toml and warn if src/ has changes since the last project-version bump." \n \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1532,7 +1583,7 @@ if {[lsearch $::argv -k] >= 0} { # - minor bump -> prompt user; backward-compat aliases *should* keep old bootsupport functional # - patch bump -> warn and proceed (non-breaking) # 'check' is exempt in all cases — the warning is shown at the end of its output instead. -if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check"} { +if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check" && $::punkboot::command ne "projectversion"} { set _stale $::punkboot::stale_bootsupport set _have_major 0 set _have_minor 0 @@ -1825,8 +1876,69 @@ if {$::punkboot::command eq "info"} { exit 0 } +if {$::punkboot::command eq "projectversion"} { + set sep [string repeat - 75] + puts stdout $sep + puts stdout "project version check" + puts stdout $sep + + set pp_file [file join $projectroot punkproject.toml] + set cl_file [file join $projectroot CHANGELOG.md] + set src_folder [file join $projectroot src] + + set pp_version [::punkboot::lib::read_punkproject_version $pp_file] + set cl_version [::punkboot::lib::read_changelog_latest_version $cl_file] + + puts stdout "punkproject.toml version : [expr {[string length $pp_version] ? $pp_version : "(not found)"}]" + puts stdout "CHANGELOG.md version : [expr {[string length $cl_version] ? $cl_version : "(not found)"}]" + # 1. Consistency: CHANGELOG latest header must match punkproject.toml version. + if {![string length $pp_version]} { + puts stderr "WARNING: could not read version from $pp_file" + } elseif {![string length $cl_version]} { + puts stderr "WARNING: no '## [X.Y.Z]' version header found in $cl_file" + } elseif {$pp_version ne $cl_version} { + puts stderr "WARNING: version mismatch — punkproject.toml=$pp_version but CHANGELOG.md=$cl_version" + puts stderr " The latest '## [X.Y.Z]' header in CHANGELOG.md must match the version in punkproject.toml." + } else { + puts stdout "consistency: OK (versions match)" + } + # 2. Staleness: warn if src/ has git commits since the last commit + # touching punkproject.toml (version bump may be overdue). + # Best-effort — silently skipped if git is unavailable or the repo + # is not under git revision control. + set pp_commit "" + if {![catch {exec git -C $projectroot log -1 --format=%H -- punkproject.toml} pp_raw]} { + set pp_commit [string trim $pp_raw] + } + if {[string length $pp_commit]} { + if {![catch {exec git -C $projectroot log --oneline ${pp_commit}..HEAD -- src/} src_raw]} { + set src_changes [string trim $src_raw] + if {[string length $src_changes]} { + set n [llength [split $src_changes \n]] + puts stderr "WARNING: $n commit(s) in src/ since last punkproject.toml change — a project-version bump may be overdue." + puts stderr " Review the changes and bump punkproject.toml per the root AGENTS.md 'Project Versioning' section." + puts stderr " (showing first 5 commits below)" + set i 0 + foreach line [split $src_changes \n] { + if {$i >= 5} break + puts stderr " $line" + incr i + } + } else { + puts stdout "staleness: OK (no src/ changes since last punkproject.toml commit)" + } + } else { + puts stdout "staleness: skipped (git query failed)" + } + } else { + puts stdout "staleness: skipped (punkproject.toml has no git history or git unavailable)" + } + + puts stdout $sep + exit 0 +} if {$::punkboot::command eq "shell"} { package require struct::list diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.0.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm index b1c791b0..aac663a3 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::console 0.7.0 +# Application punk::console 0.7.1 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::console 0 0.7.0] +#[manpage_begin punkshell_module_punk::console 0 0.7.1] #[copyright "2024"] #[titledesc {punk console}] [comment {-- Name section and table of contents description --}] #[moddesc {punk console}] [comment {-- Description at end of page heading --}] @@ -705,6 +705,16 @@ namespace eval punk::console { #For mintty-without-winpty (terminal presenting pipes) the twapi raw cycle was already a #no-op via its get_console_handle early-return, so nothing is lost by skipping. set input_is_console_or_tty [expr {[dict exists $previous_input_state -inputmode] || [dict exists $previous_input_state -mode]}] + if {!$input_is_console_or_tty && $input eq "stdin" && $::punk::console::has_twapi} { + #Tcl 8.6 windows console channels have no -inputmode configure key, so the + #dict test alone misclassifies a real 8.6 console as a pipe: the raw cycle + #is then skipped and the query response sits in the cooked line buffer until + #Enter - timeout here plus the response leaking to the line reader as phantom + #input. A twapi console handle for stdin is definitive. Channels other than + #stdin stay excluded - the guard's purpose (pipe probes must not flip the + #process console) is unchanged. + set input_is_console_or_tty [expr {![catch {twapi::get_console_handle stdin}]}] + } if {![tsv::get punk_console is_raw]} { set was_raw 0 if {$input_is_console_or_tty} { @@ -2009,6 +2019,16 @@ namespace eval punk::console { #pending keystroke with a probe read here. return 0 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key, so the dict test above + #misses them. Beyond the pending-keystroke concern, the probe read is fatal here: + #a read on a drained 8.6 console channel makes the channel driver park a blocking + #cooked-mode ReadConsole that cannot be cancelled by a later raw-mode flip - it + #swallows a terminal query response emitted afterwards (get_ansi_response_payload + #calls this guard immediately before its raw cycle) and only completes on Enter. + return 0 + } #pipe-like channel - probe without blocking to force eof detection if {[catch { set prior_blocking [dict get $conf -blocking] @@ -2057,6 +2077,14 @@ namespace eval punk::console { #tty on unix-like platforms return 1 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key - a twapi console + #handle for stdin is definitive: process stdin is the real console. Terminals + #presenting channels as pipes (mintty without winpty) have no console handle + #and fall through to the env heuristics below. + return 1 + } if {[input_at_eof $input]} { return 0 } @@ -2861,7 +2889,14 @@ namespace eval punk::console { proc ensure_object_integration {} { variable object_integration_done if {$object_integration_done} { - return + return 1 + } + if {![namespace exists ::opunk::console]} { + #opunk::console not loaded - nothing to integrate with yet. In-module callers only + #reach here after a successful 'package require opunk::console'; external/manual + #callers may call speculatively. Deliberately does not set object_integration_done, + #so a later call after opunk::console loads performs the wiring. + return 0 } set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting if {$::opunk::console::size_query_provider eq ""} { @@ -2872,8 +2907,27 @@ namespace eval punk::console { #consult-time liveness validation still cover the default console there) if {[info exists ::opunk::console::lifecycle_callback] && $::opunk::console::lifecycle_callback eq ""} { set ::opunk::console::lifecycle_callback [list ::punk::console::internal::object_console_lifecycle] + #catch-up registration: anchors created in this interp before the callback was + #wired never fired a 'created' event, so their consoles have no recorded owner + #(seen when user code does 'package require opunk::console; opunk::console::create ...' + #before any punk::console object operation triggers this wiring). Anchors are + #per-interp/per-thread, so the anchoring context is this thread - register it. + #Only fills empty entries: an existing live registration is newer information than + #these pre-wiring anchors (and for the default console first-registration wins). + foreach v [info vars ::opunk::console::instances::*] { + if {![info exists $v]} { + continue + } + if {[catch {::opunk::Console::channels [set $v]} channels]} { + continue + } + if {[console_owner_get $channels] eq ""} { + console_owner_register $channels + } + } } set object_integration_done 1 + return 1 } lappend PUNKARGS [list { @@ -2944,12 +2998,19 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + #flush before querying: the position query may execute in the console-owning + #thread (G-007 routing), whose flush acts on its own channel instance for the same + #OS handle - an unflushed move here would leave the terminal reporting the + #unmoved cursor position (seen as 'columns 1' on tcl 8.6 where the -winsize + #shortcut is unavailable and this mechanism actually runs) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::move $start_row $start_col] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -2983,12 +3044,16 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::cursor_save_dec][punk::ansi::move 2000 2000] + #flush before querying - see get_size_using_cursormove (G-007 routing: the query + #may flush a different channel instance in the console-owning thread) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::cursor_restore][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::cursor_restore_dec] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -4238,6 +4303,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before each cursor query: the query may execute in the console-owning thread + #(G-007 routing) whose flush acts on its own channel instance - unflushed emissions + #here would be measured as if they never happened (see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -4259,6 +4328,7 @@ namespace eval punk::console { } errM]} { puts stderr "test_char_width couldn't emit this string - \nerror: $errM" } + flush $out ;#the test emission must reach the terminal before the (possibly routed) query measures it set response [punk::console::get_cursor_pos $inoutchannels] lassign [split $response ";"] _row2 col2 @@ -4313,6 +4383,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before the cursor query - the alt-screen/move/erase emissions above must reach + #the terminal first (the query may flush a different channel instance in the + #console-owning thread under G-007 routing - see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -6254,7 +6328,7 @@ namespace eval ::punk::args::register { ## Ready package provide punk::console [namespace eval punk::console { variable version - set version 0.7.0 + set version 0.7.1 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm similarity index 98% rename from src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.1.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm index 6459e1a8..355c9abf 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm @@ -1635,6 +1635,7 @@ proc repl::repl_handler {inputchan readmore prompt_config} { #note -inputmode not available in Tcl 8.6 for chan configure! #According to DKF - -buffering option doesn't affect input channels set rawmode 0 + set waiting_needs_reader 0 ;#set when the 8.6-console waiting-chunks path skips its read on a drained channel - the readable handler must be armed (not the after-idle reinvoke) or the pending partial line could never complete set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { @@ -1693,9 +1694,46 @@ proc repl::repl_handler {inputchan readmore prompt_config} { uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] set input_chunks_waiting($inputchan) [list $waitingchunk] } else { - set chunk [read $inputchan] + set hostage_noread 0 + if {"windows" eq $::tcl_platform(platform) + && ![dict exists $original_input_conf -inputmode] + && $::punk::console::has_twapi + && ![catch {twapi::get_console_handle stdin}]} { + #tcl 8.6 windows console channel (no -inputmode configure key, real console + #handle). On the 8.6 console driver a read on a *drained* channel parks a + #blocking cooked-mode ReadConsole that a later raw-mode flip cannot cancel: + #it swallows terminal query responses until Enter (see punk::console 0.7.1 + #buildversion notes). This waiting-chunks path is normally entered via + #'after idle' with the channel drained - only consume what is already in the + #Tcl channel buffer (sized read - no driver probe); when nothing is buffered, + #process the stashed complete lines without reading and arm the readable + #handler for the rest. + set avail [chan pending input $inputchan] + if {$avail > 0} { + set chunk [read $inputchan $avail] + } else { + set chunk "" + set hostage_noread 1 + set waiting_needs_reader 1 + } + } else { + set chunk [read $inputchan] + } set chunksize [string length $chunk] - if {$chunksize > 0} { + if {$hostage_noread} { + #nothing in the Tcl buffer and we must not probe the drained driver. + #Process the complete stashed lines now; a remaining partial line can only + #progress via more user input, which the armed readable handler delivers. + if {[llength $stdinlines]} { + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + } + if {$waitingchunk ne ""} { + set input_chunks_waiting($inputchan) [list $waitingchunk] + } else { + set input_chunks_waiting($inputchan) [list] + } + } elseif {$chunksize > 0} { if {[string index $chunk end] eq "\n"} { lappend stdinlines $waitingchunk[string range $chunk 0 end-1] #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" @@ -1864,7 +1902,12 @@ proc repl::repl_handler {inputchan readmore prompt_config} { ################################################################################## #Re-enable channel read handler only if no waiting chunks - must process in order ################################################################################## - if {![llength $input_chunks_waiting($inputchan)]} { + if {![llength $input_chunks_waiting($inputchan)] || $waiting_needs_reader} { + #waiting_needs_reader: the 8.6-console waiting-chunks path found nothing in the + #Tcl channel buffer and must not probe the drained driver - the waiting data is + #an incomplete line that can only progress when the user types more, so arm the + #reader (the driver listening for input is its job here) instead of an after-idle + #reinvoke that could never make progress. chan event $inputchan readable [list ::repl::repl_handler $inputchan $readmore $prompt_config] } else { #review @@ -4172,7 +4215,7 @@ namespace eval repl { } package provide punk::repl [namespace eval punk::repl { variable version - set version 0.2.1 + set version 0.2.2 }] #repl::start $program_read_stdin_pipe diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl index c7f006ba..c31f1c75 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -328,6 +328,55 @@ proc ::punkboot::lib::bootsupport_prompt_yesno {prompt} { return [expr {$answer eq "y" || $answer eq "yes"}] } +#------------------------------------------------------------------------------ +# Project-version helpers — self-contained Tcl, no punk package deps. +# Used by the 'projectversion' subcommand to verify that punkproject.toml +# and CHANGELOG.md stay consistent and that the project version is bumped +# when src/ changes ship user-visible behaviour. Advisory only (warns). +#------------------------------------------------------------------------------ + +# Read the [project] version from a TOML file via a simple line scan. +# Returns the version string (e.g. "0.2.0") or "" if not found. +proc ::punkboot::lib::read_punkproject_version {tomlfile} { + if {![file exists $tomlfile]} {return ""} + set fh [open $tomlfile r] + try { + set content [read $fh] + } finally { + close $fh + } + set in_project 0 + foreach line [split $content \n] { + set trimmed [string trim $line] + if {[string index $trimmed 0] eq {[} && [string index $trimmed end] eq {]}} { + set in_project [expr {$trimmed eq "\[project\]"}] + continue + } + if {$in_project && [regexp {^version\s*=\s*"([^"]+)"} $trimmed _ v]} { + return $v + } + } + return "" +} + +# Read the latest ## [X.Y.Z] version header from a changelog file. +# Returns the version string or "" if no header found. +proc ::punkboot::lib::read_changelog_latest_version {changelogfile} { + if {![file exists $changelogfile]} {return ""} + set fh [open $changelogfile r] + try { + set content [read $fh] + } finally { + close $fh + } + foreach line [split $content \n] { + if {[regexp {^##\s*\[([0-9][^\]]*)\]} $line _ v]} { + return $v + } + } + return "" +} + if {"::try" ni [info commands ::try]} { puts stderr "Tcl interpreter possibly too old - need at least tcl 8.6 - 'try' command not found - aborting" exit 1 @@ -1358,6 +1407,8 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - show module/library paths and any potentially problematic packages for running this script" \n append h " $scriptname shell" \n append h " - run the punk shell using bootsupport libraries." \n + append h " $scriptname projectversion" \n + append h " - advisory check: verify CHANGELOG.md matches punkproject.toml and warn if src/ has changes since the last project-version bump." \n \n append h "" \n if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} { set has_recommended 0 @@ -1532,7 +1583,7 @@ if {[lsearch $::argv -k] >= 0} { # - minor bump -> prompt user; backward-compat aliases *should* keep old bootsupport functional # - patch bump -> warn and proceed (non-breaking) # 'check' is exempt in all cases — the warning is shown at the end of its output instead. -if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check"} { +if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ne "check" && $::punkboot::command ne "projectversion"} { set _stale $::punkboot::stale_bootsupport set _have_major 0 set _have_minor 0 @@ -1825,8 +1876,69 @@ if {$::punkboot::command eq "info"} { exit 0 } +if {$::punkboot::command eq "projectversion"} { + set sep [string repeat - 75] + puts stdout $sep + puts stdout "project version check" + puts stdout $sep + + set pp_file [file join $projectroot punkproject.toml] + set cl_file [file join $projectroot CHANGELOG.md] + set src_folder [file join $projectroot src] + + set pp_version [::punkboot::lib::read_punkproject_version $pp_file] + set cl_version [::punkboot::lib::read_changelog_latest_version $cl_file] + + puts stdout "punkproject.toml version : [expr {[string length $pp_version] ? $pp_version : "(not found)"}]" + puts stdout "CHANGELOG.md version : [expr {[string length $cl_version] ? $cl_version : "(not found)"}]" + # 1. Consistency: CHANGELOG latest header must match punkproject.toml version. + if {![string length $pp_version]} { + puts stderr "WARNING: could not read version from $pp_file" + } elseif {![string length $cl_version]} { + puts stderr "WARNING: no '## [X.Y.Z]' version header found in $cl_file" + } elseif {$pp_version ne $cl_version} { + puts stderr "WARNING: version mismatch — punkproject.toml=$pp_version but CHANGELOG.md=$cl_version" + puts stderr " The latest '## [X.Y.Z]' header in CHANGELOG.md must match the version in punkproject.toml." + } else { + puts stdout "consistency: OK (versions match)" + } + # 2. Staleness: warn if src/ has git commits since the last commit + # touching punkproject.toml (version bump may be overdue). + # Best-effort — silently skipped if git is unavailable or the repo + # is not under git revision control. + set pp_commit "" + if {![catch {exec git -C $projectroot log -1 --format=%H -- punkproject.toml} pp_raw]} { + set pp_commit [string trim $pp_raw] + } + if {[string length $pp_commit]} { + if {![catch {exec git -C $projectroot log --oneline ${pp_commit}..HEAD -- src/} src_raw]} { + set src_changes [string trim $src_raw] + if {[string length $src_changes]} { + set n [llength [split $src_changes \n]] + puts stderr "WARNING: $n commit(s) in src/ since last punkproject.toml change — a project-version bump may be overdue." + puts stderr " Review the changes and bump punkproject.toml per the root AGENTS.md 'Project Versioning' section." + puts stderr " (showing first 5 commits below)" + set i 0 + foreach line [split $src_changes \n] { + if {$i >= 5} break + puts stderr " $line" + incr i + } + } else { + puts stdout "staleness: OK (no src/ changes since last punkproject.toml commit)" + } + } else { + puts stdout "staleness: skipped (git query failed)" + } + } else { + puts stdout "staleness: skipped (punkproject.toml has no git history or git unavailable)" + } + + puts stdout $sep + exit 0 +} if {$::punkboot::command eq "shell"} { package require struct::list diff --git a/src/vfs/_vfscommon.vfs/modules/punk/console-0.7.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/console-0.7.1.tm similarity index 98% rename from src/vfs/_vfscommon.vfs/modules/punk/console-0.7.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/console-0.7.1.tm index b1c791b0..aac663a3 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/console-0.7.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/console-0.7.1.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::console 0.7.0 +# Application punk::console 0.7.1 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::console 0 0.7.0] +#[manpage_begin punkshell_module_punk::console 0 0.7.1] #[copyright "2024"] #[titledesc {punk console}] [comment {-- Name section and table of contents description --}] #[moddesc {punk console}] [comment {-- Description at end of page heading --}] @@ -705,6 +705,16 @@ namespace eval punk::console { #For mintty-without-winpty (terminal presenting pipes) the twapi raw cycle was already a #no-op via its get_console_handle early-return, so nothing is lost by skipping. set input_is_console_or_tty [expr {[dict exists $previous_input_state -inputmode] || [dict exists $previous_input_state -mode]}] + if {!$input_is_console_or_tty && $input eq "stdin" && $::punk::console::has_twapi} { + #Tcl 8.6 windows console channels have no -inputmode configure key, so the + #dict test alone misclassifies a real 8.6 console as a pipe: the raw cycle + #is then skipped and the query response sits in the cooked line buffer until + #Enter - timeout here plus the response leaking to the line reader as phantom + #input. A twapi console handle for stdin is definitive. Channels other than + #stdin stay excluded - the guard's purpose (pipe probes must not flip the + #process console) is unchanged. + set input_is_console_or_tty [expr {![catch {twapi::get_console_handle stdin}]}] + } if {![tsv::get punk_console is_raw]} { set was_raw 0 if {$input_is_console_or_tty} { @@ -2009,6 +2019,16 @@ namespace eval punk::console { #pending keystroke with a probe read here. return 0 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key, so the dict test above + #misses them. Beyond the pending-keystroke concern, the probe read is fatal here: + #a read on a drained 8.6 console channel makes the channel driver park a blocking + #cooked-mode ReadConsole that cannot be cancelled by a later raw-mode flip - it + #swallows a terminal query response emitted afterwards (get_ansi_response_payload + #calls this guard immediately before its raw cycle) and only completes on Enter. + return 0 + } #pipe-like channel - probe without blocking to force eof detection if {[catch { set prior_blocking [dict get $conf -blocking] @@ -2057,6 +2077,14 @@ namespace eval punk::console { #tty on unix-like platforms return 1 } + variable has_twapi + if {$input eq "stdin" && $has_twapi && ![catch {twapi::get_console_handle stdin}]} { + #Tcl 8.6 windows console channels expose no -inputmode key - a twapi console + #handle for stdin is definitive: process stdin is the real console. Terminals + #presenting channels as pipes (mintty without winpty) have no console handle + #and fall through to the env heuristics below. + return 1 + } if {[input_at_eof $input]} { return 0 } @@ -2861,7 +2889,14 @@ namespace eval punk::console { proc ensure_object_integration {} { variable object_integration_done if {$object_integration_done} { - return + return 1 + } + if {![namespace exists ::opunk::console]} { + #opunk::console not loaded - nothing to integrate with yet. In-module callers only + #reach here after a successful 'package require opunk::console'; external/manual + #callers may call speculatively. Deliberately does not set object_integration_done, + #so a later call after opunk::console loads performs the wiring. + return 0 } set ::opunk::console::waiting_chunks_arrayvar ::punk::console::input_chunks_waiting if {$::opunk::console::size_query_provider eq ""} { @@ -2872,8 +2907,27 @@ namespace eval punk::console { #consult-time liveness validation still cover the default console there) if {[info exists ::opunk::console::lifecycle_callback] && $::opunk::console::lifecycle_callback eq ""} { set ::opunk::console::lifecycle_callback [list ::punk::console::internal::object_console_lifecycle] + #catch-up registration: anchors created in this interp before the callback was + #wired never fired a 'created' event, so their consoles have no recorded owner + #(seen when user code does 'package require opunk::console; opunk::console::create ...' + #before any punk::console object operation triggers this wiring). Anchors are + #per-interp/per-thread, so the anchoring context is this thread - register it. + #Only fills empty entries: an existing live registration is newer information than + #these pre-wiring anchors (and for the default console first-registration wins). + foreach v [info vars ::opunk::console::instances::*] { + if {![info exists $v]} { + continue + } + if {[catch {::opunk::Console::channels [set $v]} channels]} { + continue + } + if {[console_owner_get $channels] eq ""} { + console_owner_register $channels + } + } } set object_integration_done 1 + return 1 } lappend PUNKARGS [list { @@ -2944,12 +2998,19 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] + #flush before querying: the position query may execute in the console-owning + #thread (G-007 routing), whose flush acts on its own channel instance for the same + #OS handle - an unflushed move here would leave the terminal reporting the + #unmoved cursor position (seen as 'columns 1' on tcl 8.6 where the -winsize + #shortcut is unavailable and this mechanism actually runs) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::move $start_row $start_col] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -2983,12 +3044,16 @@ namespace eval punk::console { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::cursor_save_dec][punk::ansi::move 2000 2000] + #flush before querying - see get_size_using_cursormove (G-007 routing: the query + #may flush a different channel instance in the console-owning thread) + flush $out lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::cursor_restore][punk::ansi::cursor_on];flush $out set result [dict create columns $cols rows $lines] } errM]} { puts -nonewline $out [punk::ansi::cursor_restore_dec] puts -nonewline $out [punk::ansi::cursor_on] + catch {flush $out} error "$errM" } else { return $result @@ -4238,6 +4303,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before each cursor query: the query may execute in the console-owning thread + #(G-007 routing) whose flush acts on its own channel instance - unflushed emissions + #here would be measured as if they never happened (see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -4259,6 +4328,7 @@ namespace eval punk::console { } errM]} { puts stderr "test_char_width couldn't emit this string - \nerror: $errM" } + flush $out ;#the test emission must reach the terminal before the (possibly routed) query measures it set response [punk::console::get_cursor_pos $inoutchannels] lassign [split $response ";"] _row2 col2 @@ -4313,6 +4383,10 @@ namespace eval punk::console { if {!$emit} { puts -nonewline $out \033\[2K\033\[1G ;#2K erase line, 1G cursor at col1 } + #flush before the cursor query - the alt-screen/move/erase emissions above must reach + #the terminal first (the query may flush a different channel instance in the + #console-owning thread under G-007 routing - see get_size_using_cursormove) + flush $out set response "" if {[catch { set response [punk::console::get_cursor_pos $inoutchannels] @@ -6254,7 +6328,7 @@ namespace eval ::punk::args::register { ## Ready package provide punk::console [namespace eval punk::console { variable version - set version 0.7.0 + set version 0.7.1 }] return diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm rename to src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm index 6459e1a8..355c9abf 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm @@ -1635,6 +1635,7 @@ proc repl::repl_handler {inputchan readmore prompt_config} { #note -inputmode not available in Tcl 8.6 for chan configure! #According to DKF - -buffering option doesn't affect input channels set rawmode 0 + set waiting_needs_reader 0 ;#set when the 8.6-console waiting-chunks path skips its read on a drained channel - the readable handler must be armed (not the after-idle reinvoke) or the pending partial line could never complete set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { @@ -1693,9 +1694,46 @@ proc repl::repl_handler {inputchan readmore prompt_config} { uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] set input_chunks_waiting($inputchan) [list $waitingchunk] } else { - set chunk [read $inputchan] + set hostage_noread 0 + if {"windows" eq $::tcl_platform(platform) + && ![dict exists $original_input_conf -inputmode] + && $::punk::console::has_twapi + && ![catch {twapi::get_console_handle stdin}]} { + #tcl 8.6 windows console channel (no -inputmode configure key, real console + #handle). On the 8.6 console driver a read on a *drained* channel parks a + #blocking cooked-mode ReadConsole that a later raw-mode flip cannot cancel: + #it swallows terminal query responses until Enter (see punk::console 0.7.1 + #buildversion notes). This waiting-chunks path is normally entered via + #'after idle' with the channel drained - only consume what is already in the + #Tcl channel buffer (sized read - no driver probe); when nothing is buffered, + #process the stashed complete lines without reading and arm the readable + #handler for the rest. + set avail [chan pending input $inputchan] + if {$avail > 0} { + set chunk [read $inputchan $avail] + } else { + set chunk "" + set hostage_noread 1 + set waiting_needs_reader 1 + } + } else { + set chunk [read $inputchan] + } set chunksize [string length $chunk] - if {$chunksize > 0} { + if {$hostage_noread} { + #nothing in the Tcl buffer and we must not probe the drained driver. + #Process the complete stashed lines now; a remaining partial line can only + #progress via more user input, which the armed readable handler delivers. + if {[llength $stdinlines]} { + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + } + if {$waitingchunk ne ""} { + set input_chunks_waiting($inputchan) [list $waitingchunk] + } else { + set input_chunks_waiting($inputchan) [list] + } + } elseif {$chunksize > 0} { if {[string index $chunk end] eq "\n"} { lappend stdinlines $waitingchunk[string range $chunk 0 end-1] #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" @@ -1864,7 +1902,12 @@ proc repl::repl_handler {inputchan readmore prompt_config} { ################################################################################## #Re-enable channel read handler only if no waiting chunks - must process in order ################################################################################## - if {![llength $input_chunks_waiting($inputchan)]} { + if {![llength $input_chunks_waiting($inputchan)] || $waiting_needs_reader} { + #waiting_needs_reader: the 8.6-console waiting-chunks path found nothing in the + #Tcl channel buffer and must not probe the drained driver - the waiting data is + #an incomplete line that can only progress when the user types more, so arm the + #reader (the driver listening for input is its job here) instead of an after-idle + #reinvoke that could never make progress. chan event $inputchan readable [list ::repl::repl_handler $inputchan $readmore $prompt_config] } else { #review @@ -4172,7 +4215,7 @@ namespace eval repl { } package provide punk::repl [namespace eval punk::repl { variable version - set version 0.2.1 + set version 0.2.2 }] #repl::start $program_read_stdin_pipe