jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
420 Commits
1 Branch
1 Tag
241 MiB
 
 
 
 
 
 
Tree: eb1fd7d6c5
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'eb1fd7d6c5'
${ noResults }
punkshell/src/modules/punk/winshell-999999.0a1.0.tm

426 lines
14 KiB
Raw Blame History

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application punk::winshell 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_punk::winshell 0 999999.0a1.0]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::winshell]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of punk::winshell
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::winshell
#[list_begin itemized]
package require Tcl 8.6-
#*** !doctools
#[item] [package {Tcl 8.6}]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#tcl::namespace::eval punk::winshell::class {
#*** !doctools
#[subsection {Namespace punk::winshell::class}]
#[para] class definitions
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} {
#*** !doctools
#[list_begin enumerated]
# oo::class create interface_sample1 {
# #*** !doctools
# #[enum] CLASS [class interface_sample1]
# #[list_begin definitions]
# method test {arg1} {
# #*** !doctools
# #[call class::interface_sample1 [method test] [arg arg1]]
# #[para] test method
# puts "test: $arg1"
# }
# #*** !doctools
# #[list_end] [comment {-- end definitions interface_sample1}]
# }
#*** !doctools
#[list_end] [comment {--- end class enumeration ---}]
#}
#}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::winshell {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
#variable xyz
#*** !doctools
#[subsection {Namespace punk::winshell}]
#[para] Core API functions for punk::winshell
#[list_begin definitions]
#The windows api we need here is createPseudoConsole et al.
variable autoshellid 0
variable shellinfo [dict create]
#test of exec and named pipes.
#we don't get a console
proc cmdexec {{id ""}} {
variable autoshellid
variable shellinfo
package require twapi
set pipebase {\\.\pipe\punkwinshell}
if {$id eq ""} {
incr autoshellid
set shellid $autoshellid
} else {
set shellid $id
}
set pipename_stdin $pipebase$shellid-stdin
set pipename_stdout $pipebase$shellid-stdout
set pipename_stderr $pipebase$shellid-stderr
#swapped thisend/child - labels now wrong - todo - relabel or swap back?
set h_stdin [twapi::namedpipe_server $pipename_stdin] ;#handle for child process redirection
set p_stdin [twapi::namedpipe_client $pipename_stdin] ;#this end
set h_stdout [twapi::namedpipe_server $pipename_stdout] ;#handle for child process redirection
set p_stdout [twapi::namedpipe_client $pipename_stdout] ;#this end
chan configure $p_stdout -blocking 0
set h_stderr [twapi::namedpipe_server $pipename_stderr] ;#handle for child process redirection
set p_stderr [twapi::namedpipe_client $pipename_stderr] ;#this end
chan configure $p_stderr -blocking 0
set pid [exec cmd.exe /k >@$p_stdout 2>@$p_stderr <@$p_stdin &]
dict set shellinfo $shellid id $shellid
dict set shellinfo $shellid pid $pid
dict set shellinfo $shellid stdin $h_stdin
dict set shellinfo $shellid stdout $h_stdout
dict set shellinfo $shellid stderr $h_stderr
return [dict get $shellinfo $shellid]
}
variable ack 0
proc handle_out {chan args} {
variable ack
#if {[catch {
# if {$ack} {
# punk::console::move_emit_return 3 79 "\\"
# set ack 0
# } else {
# punk::console::move_emit_return 3 79 /
# set ack 1
# }
#} errM]} {
# puts "err on move_emit_return"
#}
puts -nonewline stdout [punk::ansi::ansistring VIEW [read $chan]]
}
proc handle_err {chan args} {
variable ack
#if {$ack} {
# punk::console::move_emit_return 3 79 -
# set ack 0
#} else {
# punk::console::move_emit_return 3 79 |
# set ack 1
#}
puts -nonewline stderr [read $chan]
}
proc cmdtest {{id ""}} {
set cinfo [cmdexec $id]
set o [dict get $cinfo stdout]
chan conf $o -buffering none -blocking 0
set e [dict get $cinfo stderr]
chan conf $e -buffering none -blocking 0
chan event $o readable [list ::punk::winshell::handle_out $o]
chan event $e readable [list ::punk::winshell::handle_err $e]
return $cinfo
}
#test with twapi create_process
proc cmdcreate {{id ""}} {
variable autoshellid
variable shellinfo
package require twapi
set pipebase {\\.\pipe\punkwinshell}
if {$id eq ""} {
incr autoshellid
set shellid $autoshellid
} else {
set shellid $id
}
#Method 1) - using windows named pipes
set pipename_stdin $pipebase$shellid-stdin
set pipename_stdout $pipebase$shellid-stdout
set pipename_stderr $pipebase$shellid-stderr
#set h_stdin [twapi::namedpipe_server $pipename_stdin] ;#handle for child process redirection - child to read
#set p_stdin [twapi::namedpipe_client $pipename_stdin] ;#this end for writing
#set h_stdout [twapi::namedpipe_server $pipename_stdout] ;#handle for child process redirection - child to write
#set p_stdout [twapi::namedpipe_client $pipename_stdout] ;#this end for reading
#set h_stderr [twapi::namedpipe_server $pipename_stderr] ;#handle for child process redirection - child to write
#set p_stderr [twapi::namedpipe_client $pipename_stderr] ;#this end for reading
#test
set p_stdout [twapi::namedpipe_server $pipename_stdout] ;#handle for child process redirection - child to write
set p_stdin ""
set p_stderr ""
chan configure $p_stdout -blocking 0
#Method 2) - using tcl's 'chan pipe' which creates OS level channels
#chan pipe returns rd wr channels in that order
#lassign [chan pipe] h_stdin p_stdin
#lassign [chan pipe] p_stdout h_stdout
#lassign [chan pipe] p_stderr h_stderr
#chan configure $p_stdout -blocking 0
#chan configure $p_stderr -blocking 0
#set cmd {C:\Users\sleek\scoop\apps\windows-terminal\current\WindowsTerminal.exe} ;#doesn't work?
#set cmd "[auto_execok cmd.exe] /k"
#set cmd "[auto_execok powershell] -nop"
#set cmd "[auto_execok tclsh]"
set cmd "[auto_execok tclsh90]"
set flagdict [dict create\
-cmdline "$cmd"\
-newconsole 1\
-inherithandles 0\
-background blue\
-title "punk::winshell $shellid"
]
#dict set flagdict -stdchannels [list $h_stdin $h_stdout $h_stderr]
set program ""
lassign [twapi::create_process $program {*}$flagdict] pid tid
puts stdout "launched with pid:$pid tid:$tid"
#set pid [exec cmd.exe /k >@$h_stdout 2>@$h_stderr <@$h_stdin &]
dict set shellinfo $shellid id $shellid
dict set shellinfo $shellid pid $pid
dict set shellinfo $shellid type "create_process"
dict set shellinfo $shellid stdin $p_stdin
dict set shellinfo $shellid stdout $p_stdout
dict set shellinfo $shellid stderr $p_stderr
return [dict get $shellinfo $shellid]
}
proc cmdexit {shellid} {
variable shellinfo
set info [dict get $shellinfo $shellid]
switch -- [dict get $info type] {
"create_process" {
set exitresult [twapi::end_process [dict get $info pid]]
}
"exec" {
puts stderr "todo.."
puts stderr "manually kill exec process [dict get $info pid]"
set exitresult 0
}
}
return [dict create exitresult $exitresult]
}
proc cmdkill {shellid} {
variable shellinfo
set info [dict get $shellinfo $shellid]
set pid [dict get $info pid]
set killcmd [list taskkill /PID $pid]
if {[catch {
exec {*}$killcmd
} errMsg]} {
puts stderr "$killcmd returned an error:"
puts stderr $errMsg
#if {!$forcekill} {
# puts stderr "(try 'kill -9 $pid' ??)"
#}
#review - *no running instance* works with windows taskkill - "*No such process*" works with kill -9 on FreeBSD and linux - other platforms?
if {![string match "*no running instance*" $errMsg] && ![string match "*No such process*" $errMsg]} {
lappend failed_kits [list reason "could not kill running process for shellid $shellid (using '$killcmd')"]
continue
} else {
puts stderr ""
}
} else {
puts stderr "$killcmd ran without error"
incr count_killed
}
}
proc shellinfo {} {
variable shellinfo
return $shellinfo
}
proc cmdinfo {{id ""}} {
variable autoshellid
variable shellinfo
if {$id eq ""} {
#last created
set shellid $autoshellid
} else {
set shellid $id
}
set info [dict get $shellinfo $shellid]
set pid [dict get $info pid]
catch {
set statusresult [tcl::process status $pid]
dict set info status $statusresult
}
set cmdline [twapi::get_process_commandline $pid]
dict set info cmdline $cmdline
return [showdict $info]
}
#quick n dirty - status of last (or identified) winshell
proc cmdstat {{id ""}} {
variable autoshellid
variable shellinfo
if {$id eq ""} {
#last created
set shellid $autoshellid
} else {
set shellid $id
}
set pid [dict get $shellinfo $shellid pid]
set statusresult ""
catch {
#not in 8.6?
set statusresult [tcl::process status $pid]
}
return [dict create id $shellid status $statusresult]
}
#proc sample1 {p1 n args} {
# #*** !doctools
# #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]]
# #[para]Description of sample1
# #[para] Arguments:
# # [list_begin arguments]
# # [arg_def tring p1] A description of string argument p1.
# # [arg_def integer n] A description of integer argument n.
# # [list_end]
# return "ok"
#}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::winshell ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::winshell::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace punk::winshell::lib}]
#[para] Secondary functions that are part of the API
#[list_begin definitions]
#proc utility1 {p1 args} {
# #*** !doctools
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
# #[para]Description of utility1
# return 1
#}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::winshell::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
#tcl::namespace::eval punk::winshell::system {
#*** !doctools
#[subsection {Namespace punk::winshell::system}]
#[para] Internal functions that are not part of the API
#}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::winshell [tcl::namespace::eval punk::winshell {
variable pkg punk::winshell
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]