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

update bootsupport,vfs

master
Julian Noble 1 week ago
parent
717432676f
commit
0ced0e1f2f
11 changed files with 842 additions and 38 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 82
      src/bootsupport/modules/punk/console-0.7.1.tm
  2. 51
      src/bootsupport/modules/punk/repl-0.2.2.tm
  3. 116
      src/project_layouts/custom/_project/punk.basic/src/make.tcl
  4. 82
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm
  5. 51
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm
  6. 116
      src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl
  7. 82
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm
  8. 51
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm
  9. 116
      src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl
  10. 82
      src/vfs/_vfscommon.vfs/modules/punk/console-0.7.1.tm
  11. 51
      src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm

82
src/bootsupport/modules/punk/console-0.7.0.tm → src/bootsupport/modules/punk/console-0.7.1.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

51
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm → src/bootsupport/modules/punk/repl-0.2.2.tm
Unescape View File

@ -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

116
src/project_layouts/custom/_project/punk.basic/src/make.tcl
Unescape View File

@ -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

82
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.0.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.1.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

51
src/bootsupport/modules/punk/repl-0.2.1.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm
Unescape View File

@ -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

116
src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl
Unescape View File

@ -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

82
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.7.0.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.7.1.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

51
src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.1.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.2.tm
Unescape View File

@ -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

116
src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl
Unescape View File

@ -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

82
src/vfs/_vfscommon.vfs/modules/punk/console-0.7.0.tm → src/vfs/_vfscommon.vfs/modules/punk/console-0.7.1.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

51
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.1.tm → src/vfs/_vfscommon.vfs/modules/punk/repl-0.2.2.tm
Unescape View File

@ -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
Write Preview
Loading…
Cancel
Save