From a85699b3e1d55c39896fb599c37e48923147be7b Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 1 May 2024 13:41:44 +1000 Subject: [PATCH] textblock table class --- src/bootsupport/modules/punk/ansi-0.1.1.tm | 22 +- .../punk/mix/commandset/scriptwrap-0.1.0.tm | 22 +- .../utility/scriptappwrappers/multishell.cmd | 113 ++- .../utility/scriptappwrappers/multishell2.cmd | 680 ++++++++++++++ src/modules/textblock-999999.0a1.0.tm | 859 +++++++++++++++++- src/modules/textblock-buildversion.txt | 2 +- 6 files changed, 1651 insertions(+), 47 deletions(-) create mode 100644 src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell2.cmd diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index 462c383..23d2939 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -762,19 +762,25 @@ namespace eval punk::ansi { #CSI m = SGR (Select Graphic Rendition) variable SGR_setting_map { - bold 1 dim 2 blink 5 fastblink 6 noblink 25 hide 8 normal 22 - underline 4 doubleunderline 21 nounderline 24 strike 9 nostrike 29 italic 3 noitalic 23 - reverse 7 noreverse 27 defaultfg 39 defaultbg 49 nohide 28 - overline 53 nooverline 55 frame 51 framecircle 52 noframe 54 + reset 0 bold 1 dim 2 italic 3 noitalic 23 + underline 4 doubleunderline 21 nounderline 24 blink 5 fastblink 6 noblink 25 + reverse 7 noreverse 27 hide 8 nohide 28 strike 9 nostrike 29 + normal 22 defaultfg 39 defaultbg 49 overline 53 nooverline 55 + frame 51 framecircle 52 noframe 54 underlinedefault 59 } variable SGR_colour_map { - black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37 - Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47 - BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107 + black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37 + Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47 + xblack 90 xred 91 xgreen 92 xyellow 93 xblue 94 xpurple 95 xcyan 96 xwhite 97 + BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107 } - variable SGR_map + variable SGR_map ;#public - part of interface - review set SGR_map [dict merge $SGR_colour_map $SGR_setting_map] + proc get_sgr_map {} { + variable SGR_map + return $SGR_map + } proc colourmap1 {{bgname White}} { package require textblock diff --git a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 2ae511a..8ea2489 100644 --- a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -761,6 +761,7 @@ namespace eval punk::mix::commandset::scriptwrap { -outputfolder "\uFFFF"\ -template "\uFFFF"\ -returnextra 0\ + -force 0\ ] set known_opts [dict keys $defaults] dict for {k v} $args { @@ -784,6 +785,7 @@ namespace eval punk::mix::commandset::scriptwrap { set opt_template [dict get $opts -template] set opt_outputfolder [dict get $opts -outputfolder] set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- @@ -1010,9 +1012,21 @@ namespace eval punk::mix::commandset::scriptwrap { close $fdexisting set objFile_existing [fileline::textinfo new $existing_file_data] puts stdout "wrap_in_multishell: target file $output_file already exists. File size: [$objFile_existing chunklen] Line count: [$objFile_existing linecount]" - - $objFile_existing destroy - error "aborting.." + if {!$opt_force} { + if {$opt_askme} { + set answer [util::askuser "Do you want to overwrite $output_file? Y|N"] + if {[string tolower $answer] ne "y"} { + puts stderr "aborting due to user response '$answer' (required Y or y to proceed) use -force 1 or -askme 0 to avoid prompts." + $objFile_existing destroy + error "aborting.." + } + } else { + $objFile_existing destroy + error "aborting.." + } + } else { + puts stdout "overwriting $output_file because -force = $opt_force" + } } @@ -1268,7 +1282,7 @@ namespace eval punk::mix::commandset::scriptwrap { incr linenum continue } - if {[string match "*#*<*>*" $lntrim]} { + if {[string match "*#*<*>*" $lntrim] || [string match "*:*<*>*" $lntrim]} { set taginfo [_scriptapp_tag_from_line $ln] ;#use untrimmed line - to get indent if {[dict get $taginfo istag]} { set nm [dict get $taginfo name] diff --git a/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd b/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd index 366b762..047321e 100644 --- a/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd +++ b/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd @@ -13,7 +13,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' : Continuation char at end of this line and rem with curly-braces used to exlude Tcl from the whole cmd block \ : { @REM ############################################################################################################################ -@REM THIS IS A POLYGLOT SCRIPT - supporting payloads in Tcl, bash, sh and/or powershelll (powershell.exe or pwsh.exe) +@REM THIS IS A POLYGLOT SCRIPT - supporting payloads in Tcl, bash, (some sh) and/or powershelll (powershell.exe or pwsh.exe) @REM It should remain portable between unix-like OSes & windows if the proper structure is maintained. @REM ############################################################################################################################ @REM On windows, change the value of nextshell to one of the listed 2 digit values if desired, and add code within payload sections for tcl,sh,bash,powershell as appropriate. @@ -22,25 +22,44 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' @REM On unix-like systems, call with sh, bash or tclsh. (powershell untested on unix - and requires wscript if security elevation is used) @REM Due to lack of shebang (#! line) Unix-like systems will probably (hopefully) default to sh if the script is called without an interpreter - but it may depend on the shell in use when called. @REM If you find yourself really wanting/needing to add a shebang line - do so on the basis that the script will exist on unix-like systems only. +@REM in batch scripts - array syntax with square brackets is a simulation of arrays or associative arrays. +@REM note that many shells linked as sh do not support substition syntax and may fail - e.g dash etc - generally bash should be used in this context @SETLOCAL EnableExtensions EnableDelayedExpansion -@SET "validshells= ^(10^) 'pwsh' ^(11^) 'sh' (^12^) 'bash' (^13^) 'tclsh' (^14^) 'perl'" -@SET "shells[10]=pwsh" -@SET "shells[11]=sh" -@set "shells[12]=bash" -@SET "shells[13]=tclsh" -@SET "shells[14]=perl" +@SET "validshelltypes= powershell______ sh______________ wslbash_________ bash____________ tcl_____________ perl____________" +@REM for batch - only win32 is relevant - but other scripts on other platforms also parse the nextshell block to determine next shell to launch +@REM nextshellpath and nextshelltype indices (underscore-padded to 16wide) are "other" plus those returned by Tcl platform pkg e.g win32,linux,freebsd,macosx +@REM The horrible underscore-padded fixed-widths are to keep the batch labels aligned whilst allowing values to be set +@REM If more than 32 chars needed for a target, it can still be done but overall script padding may need checking/adjusting +@REM Supporting more explicit oses than those listed may also require script padding adjustment : -@SET "nextshell=13" +@SET "nextshellpath[win32___________]=tclsh___________________________" +@SET "nextshelltype[win32___________]=tcl_____________" +@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" +@SET "nextshelltype[dragonflybsd____]=tcl_____________" +@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[freebsd_________]=tcl_____________" +@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[netbsd__________]=tcl_____________" +@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[linux___________]=tcl_____________" +@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[macosx__________]=tcl_____________" +@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[other___________]=tcl_____________" : @rem asadmin is for automatic elevation to administrator. Separate window will be created (seems unavoidable with current elevation mechanism) and user will still get security prompt (probably reasonable). : @SET "asadmin=0" : -@REM nextshell set to index for validshells .eg 10 for pwsh -@REM @ECHO nextshell is %nextshell% -@SET "selected=!shells[%nextshell%]!" -@REM @ECHO selected %selected% -@CALL SET "keyRemoved=%%validshells:'!selected!'=%%" +@REM @ECHO nextshelltype is %nextshelltype[win32___________]% +@REM @SET "selected_shelltype=%nextshelltype[win32___________]%" +@SET "selected_shelltype=%nextshelltype[win32___________]%" +@ECHO selected_shelltype %selected_shelltype% +@CALL :stringTrimTrailingUnderscores %selected_shelltype% selected_shelltype_trimmed +@ECHO selected_shelltype_trimmed %selected_shelltype_trimmed% +@SET "selected_shellpath=%nextshellpath[win32___________]%" +@CALL :stringTrimTrailingUnderscores %selected_shellpath% selected_shellpath_trimmed +@CALL SET "keyRemoved=%%validshelltypes:!selected_shelltype!=%%" @REM @ECHO keyremoved %keyRemoved% @REM Note that 'powershell' e.g v5 is just a fallback for when pwsh is not available @REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### @@ -94,17 +113,30 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) @SET "vbsGetPrivileges=%temp%\punk_bat_elevate_%fname%.vbs" @SET arglist=%* -@SET qstrippedargs=%arglist:"=% -@IF /i "%qstrippedargs:~0,13%"=="PUNK-ELEVATED" ( +@SET "qstrippedargs=args%arglist%" +@SET "qstrippedargs=%qstrippedargs:"=%" +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( GOTO :gotPrivileges ) @IF !asadmin!==1 ( net file 1>NUL 2>NUL @IF '!errorlevel!'=='0' ( GOTO :gotPrivileges ) else ( GOTO :getPrivileges ) ) +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding @GOTO skip_privileges :getPrivileges -@IF /i "%qstrippedargs:~0,13%"=="PUNK-ELEVATED" (echo PUNK-ELEVATED & shift /1 & goto :gotPrivileges ) +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo PUNK-ELEVATED & shift /1 & goto :gotPrivileges ) @ECHO Set UAC = CreateObject^("Shell.Application"^) > "%vbsGetPrivileges%" @ECHO args = "PUNK-ELEVATED " >> "%vbsGetPrivileges%" @ECHO For Each strArg in WScript.Arguments >> "%vbsGetPrivileges%" @@ -119,7 +151,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' @REM setlocal & pushd . @PUSHD . @cd /d %~dp0 -@IF /i "%qstrippedargs:~0,13%"=="PUNK-ELEVATED" ( +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( @DEL "%vbsGetPrivileges%" 1>nul 2>nul @SET arglist=%arglist:~14% ) @@ -143,7 +175,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' COPY "%~dp0%~n0%~x0" "%~dp0%~n0.ps1" >NUL ) @REM avoid using CALL to launch pwsh,tclsh etc - it will intercept some args such as /? -@IF "!shells[%nextshell%]!"=="pwsh" ( +@IF "%selected_shelltype_trimmed%"=="powershell" ( REM pws vs powershell hasn't been tested because we didn't need to copy cmd to ps1 this time REM test availability of preferred option of powershell7+ pwsh pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; write-host "statusmessage: pwsh-found" >NUL @@ -160,22 +192,23 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' SET task_exitcode=!errorlevel! ) ) ELSE ( - IF "!shells[%nextshell%]!"=="bash" ( + IF "%selected_shelltype_trimmed%"=="wslbash" ( CALL :getWslPath %winpath% wslpath REM ECHO wslfullpath "!wslpath!%fname%" - !shells[%nextshell%]! "!wslpath!%fname%" %arglist% + %selected_shellpath_trimmed% "!wslpath!%fname%" %arglist% SET task_exitcode=!errorlevel! ) ELSE ( - REM probably tclsh or sh - IF NOT "x%keyRemoved%"=="x%validshells%" ( + REM perl or tcl or sh or bash + IF NOT "x%keyRemoved%"=="x%validshelltypes%" ( REM sh on windows uses /c/ instead of /mnt/c - at least if using msys. Todo, review what is the norm on windows with and without msys2,cygwin,wsl REM and what logic if any may be needed. For now sh with /c/xxx seems to work the same as sh with c:/xxx - !shells[%nextshell%]! "%~dp0%fname%" %arglist% + %selected_shellpath_trimmed% "%~dp0%fname%" %arglist% SET task_exitcode=!errorlevel! ) ELSE ( - ECHO %fname% has invalid nextshell value ^(%nextshell%^) !shells[%nextshell%]! valid options are %validshells% + ECHO %fname% has invalid nextshelltype value %selected_shelltype% valid options are %validshelltypes% SET task_exitcode=66 @REM boundary padding + @REM boundary padding GOTO :exit_multishell ) ) @@ -321,7 +354,28 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) ) @EXIT /B - +:stringTrimTrailingUnderscores +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "trimstring=%~1" + @REM trim up to 31 underscores from the end of a string using string substitution + @SET trimstring=%trimstring%### + @SET trimstring=%trimstring:________________###=###% + @SET trimstring=%trimstring:________###=###% + @SET trimstring=%trimstring:____###=###% + @SET trimstring=%trimstring:__###=###% + @SET trimstring=%trimstring:_###=###% + @SET trimstring=%trimstring:###=% + @SET "result=!trimstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringTrimTrailingUnderscores %string% result: %result% + ) +) +@EXIT /B :isNumeric @SETLOCAL @SET "notnumeric="&FOR /F "delims=0123456789" %%i in ("%1") do set "notnumeric=%%i" @@ -342,6 +396,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' :endlib : \ +@REM padding @REM @SET taskexit_code=!errorlevel! & goto :exit_multishell @GOTO :exit_multishell # } @@ -398,11 +453,11 @@ namespace eval ::punk::multishell { # # -# +# # -# +# # -- --- --- --- --- --- --- --- --- --- --- --- @@ -460,7 +515,7 @@ exitcode=$? # -- --- --- --- --- --- --- --- # -# +# #printf "sh/bash done \n" @@ -635,7 +690,7 @@ $1 = @' : \ @REM @ECHO exitcode: !task_exitcode! : \ -@IF /i "%qstrippedargs:~0,13%"=="PUNK-ELEVATED" (echo. & @cmd /k echo elevated prompt: type exit to quit) +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo. & @cmd /k echo elevated prompt: type exit to quit) : \ @EXIT /B !task_exitcode! # cmd has exited diff --git a/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell2.cmd b/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell2.cmd new file mode 100644 index 0000000..a9688b6 --- /dev/null +++ b/src/bootsupport/modules/punk/mix/templates/utility/scriptappwrappers/multishell2.cmd @@ -0,0 +1,680 @@ +: "punk MULTISHELL - shebangless polyglot for Tcl Perl sh bash cmd pwsh powershell" + "[rename set s;proc Hide x {proc $x args {}};Hide :]" + "\$(function : {<#pwsh#>})" + "perlhide" + qw^ +set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' +: heredoc1 - hide from powershell using @ and squote above. close sqote for unix shells + ' \ +: .bat/.cmd launch section, leading colon hides from cmd, trailing slash hides next line from tcl + \ +: "[Hide @GOTO; Hide =begin; Hide @REM] #not necessary but can help avoid errs in testing" + +: << 'HEREDOC1B_HIDE_FROM_BASH_AND_SH' +: STRONG SUGGESTION: DO NOT MODIFY FIRST LINE OF THIS SCRIPT - except for first double quoted section. +: shebang line is not required on unix or windows and will reduce functionality and/or portability. +: Even comment lines can be part of the functionality of this script (both on unix and windows) - modify with care. +@GOTO :skip_perl_pod_start ^; +=begin excludeperl +: skip_perl_pod_start +: Continuation char at end of this line and rem with curly-braces used to exlude Tcl from the whole cmd block \ +: { +@REM ############################################################################################################################ +@REM THIS IS A POLYGLOT SCRIPT - supporting payloads in Tcl, bash, sh and/or powershelll (powershell.exe or pwsh.exe) +@REM It should remain portable between unix-like OSes & windows if the proper structure is maintained. +@REM ############################################################################################################################ +@REM On windows, change the value of nextshell to one of the listed 2 digit values if desired, and add code within payload sections for tcl,sh,bash,powershell as appropriate. +@REM This wrapper can be edited manually (carefully!) - or sh,bash,tcl,powershell scripts can be wrapped using the Tcl-based punkshell system +@REM e.g from within a running punkshell: deck scriptwrap.multishell -outputfolder +@REM On unix-like systems, call with sh, bash or tclsh. (powershell untested on unix - and requires wscript if security elevation is used) +@REM Due to lack of shebang (#! line) Unix-like systems will probably (hopefully) default to sh if the script is called without an interpreter - but it may depend on the shell in use when called. +@REM If you find yourself really wanting/needing to add a shebang line - do so on the basis that the script will exist on unix-like systems only. +@SETLOCAL EnableExtensions EnableDelayedExpansion +@SET "validshells= ^(10^) 'pwsh' ^(11^) 'sh' (^12^) 'bash' (^13^) 'tclsh' (^14^) 'perl'" +@SET "shells[10]=pwsh" +@SET "shells[11]=sh" +@set "shells[12]=bash" +@SET "shells[13]=tclsh" +@SET "shells[14]=perl" +: +@SET "nextshell=13" +: +@rem asadmin is for automatic elevation to administrator. Separate window will be created (seems unavoidable with current elevation mechanism) and user will still get security prompt (probably reasonable). +: +@SET "asadmin=0" +: +@REM nextshell set to index for validshells .eg 10 for pwsh +@REM @ECHO nextshell is %nextshell% +@SET "selected=!shells[%nextshell%]!" +@REM @ECHO selected %selected% +@CALL SET "keyRemoved=%%validshells:'!selected!'=%%" +@REM @ECHO keyremoved %keyRemoved% +@REM Note that 'powershell' e.g v5 is just a fallback for when pwsh is not available +@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### +@REM -- cmd/batch file section (ignored on unix but should be left in place) +@REM -- This section intended mainly to launch the next shell (and to escalate privileges if necessary) +@REM -- Avoid customising this if you are not familiar with batch scripting. cmd/batch script can be useful, but is probably the least expressive language and most error prone. +@REM -- For example - as this file needs to use unix-style lf line-endings - the label scanner is susceptible to the 512Byte boundary issue: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 +@REM -- This label issue can be triggered/abused in files with crlf line endings too - but it is less likely to happen accidentaly. +@REm -- See also: https://stackoverflow.com/questions/4094699/how-does-the-windows-command-interpreter-cmd-exe-parse-scripts/4095133#4095133 +@REM ############################################################################################################################ +@REM -- Due to this issue -seemingly trivial edits of the batch file section can break the script! (for Windows anyway) +@REM -- Even something as simple as adding or removing an @REM +@REM -- From within punkshell - use: +@REM -- deck scriptwrap.checkfile +@REM -- to check your templates or final wrapped scripts for byte boundary issues +@REM -- It will report any labels that are on boundaries +@REM -- This is why the nextshell value above is a 2 digit key instead of a string - so that editing the value doesn't change the byte offsets. +@REM -- Editing your sh,bash,tcl,pwsh payloads is much less likely to cause an issue. There is the possibility of the final batch :exit_multishell label spanning a boundary - so testing using deck scriptwrap.checkfile is still recommended. +@REM -- Alternatively, as you should do anyway - test the final script on windows +@REM -- Aside from adding comments/whitespace to tweak the location of labels - you can try duplicating the label (e.g just add the label on a line above) but this is not guaranteed to work in all situations. +@REM -- '@REM' is a safer comment mechanism than a leading colon - which is used sparingly here. +@REM -- A colon anywhere in the script that happens to land on a 512 Byte boundary (from file start or from a callsite) could be misinterpreted as a label +@REM -- It is unknown what versions of cmd interpreters behave this way - and deck scriptwrap.checkfile doesn't check all such boundaries. +@REm -- For this reason, batch labels should be chosen to be relatively unlikely to collide with other strings in the file, and simple names such as :exit or :end should probably be avoided +@REM ############################################################################################################################ +@REM -- custom windows payloads should be in powershell,tclsh (or sh/bash if available) code sections +@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### +@SET "winpath=%~dp0" +@SET "fname=%~nx0" +@REM @ECHO fname %fname% +@REM @ECHO winpath %winpath% +@REM @ECHO commandlineascalled %0 +@REM @ECHO commandlineresolved %~f0 +@CALL :getNormalizedScriptTail nftail +@REM @ECHO normalizedscripttail %nftail% +@CALL :getFileTail %0 clinetail +@REM @ECHO clinetail %clinetail% +@CALL :stringToUpper %~nx0 capscripttail +@REM @ECHO capscriptname: %capscripttail% + +@IF "%nftail%"=="%capscripttail%" ( + @ECHO forcing asadmin=1 due to file name on filesystem being uppercase + @SET "asadmin=1" +) else ( + @CALL :stringToUpper %clinetail% capcmdlinetail + @REM @ECHO capcmdlinetail !capcmdlinetail! + IF "%clinetail%"=="!capcmdlinetail!" ( + @ECHO forcing asadmin=1 due to cmdline scriptname in uppercase + @set "asadmin=1" + ) +) +@SET "vbsGetPrivileges=%temp%\punk_bat_elevate_%fname%.vbs" +@SET arglist=%* +@SET "qstrippedargs=args%arglist%" +@SET "qstrippedargs=%qstrippedargs:"=%" +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( + GOTO :gotPrivileges +) +@IF !asadmin!==1 ( + net file 1>NUL 2>NUL + @IF '!errorlevel!'=='0' ( GOTO :gotPrivileges ) else ( GOTO :getPrivileges ) +) +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@REM +@GOTO skip_privileges +:getPrivileges +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo PUNK-ELEVATED & shift /1 & goto :gotPrivileges ) +@ECHO Set UAC = CreateObject^("Shell.Application"^) > "%vbsGetPrivileges%" +@ECHO args = "PUNK-ELEVATED " >> "%vbsGetPrivileges%" +@ECHO For Each strArg in WScript.Arguments >> "%vbsGetPrivileges%" +@ECHO args = args ^& strArg ^& " " >> "%vbsGetPrivileges%" +@ECHO Next >> "%vbsGetPrivileges%" +@ECHO UAC.ShellExecute "%~dp0%~n0%~x0", args, "", "runas", 1 >> "%vbsGetPrivileges%" +@ECHO Launching script in new windows due to administrator elevation +@"%SystemRoot%\System32\WScript.exe" "%vbsGetPrivileges%" %* +@EXIT /B + +:gotPrivileges +@REM setlocal & pushd . +@PUSHD . +@cd /d %~dp0 +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( + @DEL "%vbsGetPrivileges%" 1>nul 2>nul + @SET arglist=%arglist:~14% +) + +:skip_privileges +@SET need_ps1=0 +@REM we want the ps1 to exist even if the nextshell isn't powershell +@if not exist "%~dp0%~n0.ps1" ( + @SET need_ps1=1 +) ELSE ( + fc "%~dp0%~n0%~x0" "%~dp0%~n0.ps1" >nul || goto different + @REM @ECHO "files same" + @SET need_ps1=0 +) +@GOTO :pscontinue +:different +@REM @ECHO "files differ" +@SET need_ps1=1 +:pscontinue +@IF !need_ps1!==1 ( + COPY "%~dp0%~n0%~x0" "%~dp0%~n0.ps1" >NUL +) +@REM avoid using CALL to launch pwsh,tclsh etc - it will intercept some args such as /? +@IF "!shells[%nextshell%]!"=="pwsh" ( + REM pws vs powershell hasn't been tested because we didn't need to copy cmd to ps1 this time + REM test availability of preferred option of powershell7+ pwsh + pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; write-host "statusmessage: pwsh-found" >NUL + SET pwshtest_exitcode=!errorlevel! + REM ECHO pwshtest_exitcode !pwshtest_exitcode! + REM fallback to powershell if pwsh failed + IF !pwshtest_exitcode!==0 ( + pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; "%~dp0%~n0.ps1" %arglist% + SET task_exitcode=!errorlevel! + ) ELSE ( + REM CALL powershell -nop -nol -c write-host powershell-found + REM powershell -nop -nol -file "%~dp0%~n0.ps1" %* + powershell -nop -nol -c set-executionpolicy -Scope Process Unrestricted; %~dp0%~n0.ps1" %arglist% + SET task_exitcode=!errorlevel! + ) +) ELSE ( + IF "!shells[%nextshell%]!"=="bash" ( + CALL :getWslPath %winpath% wslpath + REM ECHO wslfullpath "!wslpath!%fname%" + !shells[%nextshell%]! "!wslpath!%fname%" %arglist% + SET task_exitcode=!errorlevel! + ) ELSE ( + REM probably tclsh or sh + IF NOT "x%keyRemoved%"=="x%validshells%" ( + REM sh on windows uses /c/ instead of /mnt/c - at least if using msys. Todo, review what is the norm on windows with and without msys2,cygwin,wsl + REM and what logic if any may be needed. For now sh with /c/xxx seems to work the same as sh with c:/xxx + !shells[%nextshell%]! "%~dp0%fname%" %arglist% + SET task_exitcode=!errorlevel! + ) ELSE ( + ECHO %fname% has invalid nextshell value ^(%nextshell%^) !shells[%nextshell%]! valid options are %validshells% + SET task_exitcode=66 + @REM boundary padding + @REM boundary padding + GOTO :exit_multishell + ) + ) +) +@REM batch file library functions +@REM boundary padding +@GOTO :endlib + +:getWslPath +@SETLOCAL + @SET "_path=%~p1" + @SET "name=%~nx1" + @SET "drive=%~d1" + @SET "rtrn=%~2" + @SET "result=/mnt/%drive:~0,1%%_path:\=/%%name%" +@ENDLOCAL & ( + @if "%~2" neq "" ( + SET "%rtrn%=%result%" + ) ELSE ( + ECHO %result% + ) +) +@EXIT /B + +:getFileTail +@REM return tail of file without any normalization e.g c:/punkshell/bin/Punk.cmd returns Punk.cmd even if file is punk.cmd +@REM we can't use things such as %~nx1 as it can change capitalisation +@REM This function is designed explicitly to preserve capitalisation +@REM accepts full paths with either / or \ as delimiters - or +@SETLOCAL + @SET "rtrn=%~2" + @SET "arg=%~1" + @REM @SET "result=%_arg:*/=%" + @REM @SET "result=%~1" + @SET LF=^ + + + : The above 2 empty lines are important. Don't remove + @CALL :stringContains "!arg!" "\" hasBackSlash + @IF "!hasBackslash!"=="true" ( + @for %%A in ("!LF!") do @( + @FOR /F %%B in ("!arg:\=%%~A!") do @set "result=%%B" + ) + ) ELSE ( + @CALL :stringContains "!arg!" "/" hasForwardSlash + @IF "!hasForwardSlash!"=="true" ( + @FOR %%A in ("!LF!") do @( + @FOR /F %%B in ("!arg:/=%%~A!") do @set "result=%%B" + ) + ) ELSE ( + @set "result=%arg%" + ) + ) +@ENDLOCAL & ( + @if "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding +:getNormalizedScriptTail +@SETLOCAL + @SET "result=%~nx0" + @SET "rtrn=%~1" +@ENDLOCAL & ( + @IF "%~1" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B + +:getNormalizedFileTailFromPath +@REM warn via echo, and do not set return variable if path not found +@REM note that %~nx1 does not preserve case of provided path - hence the name 'normalized' +@REM boundary padding +@REM boundary padding +@REM boundary padding +@REM boundary padding +@SETLOCAL + @CALL :stringContains %~1 "\" hasBackSlash + @CALL :stringContains %~1 "/" hasForwardSlash + @IF "%hasBackslash%-%hasForwardslash%"=="false-false" ( + @SET "P=%cd%%~1" + @CALL :getNormalizedFileTailFromPath "!P!" ftail2 + @SET "result=!ftail2!" + ) else ( + @IF EXIST "%~1" ( + @SET "result=%~nx1" + ) else ( + @ECHO error getNormalizedFileTailFromPath file not found: %~1 + @EXIT /B 1 + ) + ) + @SET "rtrn=%~2" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + SET "%rtrn%=%result%" + ) ELSE ( + @ECHO getNormalizedFileTailFromPath %1 result: %result% + ) +) +@EXIT /B + +:stringContains +@REM usage: @CALL:stringContains string needle returnvarname +@SETLOCAL + @SET "rtrn=%~3" + @SET "string=%~1" + @SET "needle=%~2" + @IF "!string:%needle%=!"=="!string!" @( + @SET "result=false" + ) ELSE ( + @SET "result=true" + ) +@ENDLOCAL & ( + @IF "%~3" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringContains %string% %needle% result: %result% + ) +) +@EXIT /B + +:stringToUpper +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "capstring=%~1" + @FOR %%A in (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) DO @( + @SET "capstring=!capstring:%%A=%%A!" + ) + @SET "result=!capstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringToUpper %string% result: %result% + ) +) +@EXIT /B + +:isNumeric +@SETLOCAL + @SET "notnumeric="&FOR /F "delims=0123456789" %%i in ("%1") do set "notnumeric=%%i" + @IF defined notnumeric ( + @SET "result=false" + ) else ( + @SET "result=true" + ) + @SET "rtrn=%~2" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B + +:endlib +: \ +@REM @SET taskexit_code=!errorlevel! & goto :exit_multishell +@GOTO :exit_multishell +# } +# -*- tcl -*- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- tcl script section +# -- This is a punk multishell file +# -- Primary payload target is Tcl, with sh,bash,powershell as helpers +# -- but it may equally be used with any of these being the primary script. +# -- It is tuned to run when called as a batch file, a tcl script a sh/bash script or a pwsh/powershell script +# -- i.e it is a polyglot file. +# -- The specific layout including some lines that appear just as comments is quite sensitive to change. +# -- It can be called on unix or windows platforms with or without the interpreter being specified on the commandline. +# -- e.g ./filename.polypunk.cmd in sh or bash +# -- e.g tclsh filename.cmd +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +rename set ""; rename s set; set k {-- "$@" "a}; if {[info exists ::env($k)]} {unset ::env($k)} ;# tidyup and restore +Hide :exit_multishell;Hide {<#};Hide '@ +namespace eval ::punk::multishell { + set last_script_root [file dirname [file normalize ${argv0}/__]] + set last_script [file dirname [file normalize [info script]/__]] + if {[info exists argv0] && + $last_script eq $last_script_root + } { + set ::punk::multishell::is_main($last_script) 1 ;#run as executable/script - likely desirable to launch application and return an exitcode + } else { + set ::punk::multishell::is_main($last_script) 0 ;#sourced - likely to be being used as a library - no launch, no exit. Can use return. + } + if {"::punk::multishell::is_main" ni [info commands ::punk::multishell::is_main]} { + proc ::punk::multishell::is_main {{script_name {}}} { + if {$script_name eq ""} { + set script_name [file dirname [file normalize [info script]/--]] + } + if {![info exists ::punk::multishell::is_main($script_name)]} { + #e.g a .dll or something else unanticipated + puts stderr "Warning punk::multishell didn't recognize info script result: $script_name - will treat as if sourced and return instead of exiting" + puts stderr "Info: script_root: [file dirname [file normalize ${argv0}/__]]" + return 0 + } + return [set ::punk::multishell::is_main($script_name)] + } + } +} +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl Payload +#puts "script : [info script]" +#puts "argcount : $::argc" +#puts "argvalues: $::argv" +#puts "argv0 : $::argv0" +# -- --- --- --- --- --- --- --- --- --- --- --- + + +# +# + +# +# + + +# +# + + +# -- --- --- --- --- --- --- --- --- --- --- --- +# -- Best practice is to always return or exit above, or just by leaving the below defaults in place. +# -- If the multishell script is modified to have Tcl below the Tcl Payload section, +# -- then Tcl bracket balancing needs to be carefully managed in the shell and powershell sections below. +# -- Only the # in front of the two relevant if statements below needs to be removed to enable Tcl below +# -- but the sh/bash 'then' and 'fi' would also need to be uncommented. +# -- This facility left in place for experiments on whether configuration payloads etc can be appended +# -- to tail of file - possibly binary with ctrl-z char - but utility is dependent on which other interpreters/shells +# -- can be made to ignore/cope with such data. +if {[::punk::multishell::is_main]} { + exit 0 +} else { + return +} +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl Payload +# end hide from unix shells \ +HEREDOC1B_HIDE_FROM_BASH_AND_SH +# sh/bash \ +shift && set -- "${@:1:$#-1}" +#------------------------------------------------------ +# -- This if block only needed if Tcl didn't exit or return above. +if false==false # else { + then + : # +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- sh/bash script section +# -- leave as is if all that is required is launching the Tcl payload" +# -- +# -- Note that sh/bash script isn't called when running a .bat/.cmd from cmd.exe on windows by default +# -- adjust the %nextshell% value above +# -- if sh/bash scripting needs to run on windows too. +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin sh Payload +exitcode=0 +#printf "start of bash or sh code" + +# +# + +# -- --- --- --- --- --- --- --- +# +#-- sh/bash launches Tcl here instead of shebang line at top +#-- use exec to use exitcode (if any) directly from the tcl script +#exec /usr/bin/env tclsh "$0" "$@" +#-- alternative - can run sh/bash script after the tcl call. +/usr/bin/env tclsh "$0" "$@" +exitcode=$? +#echo "sh/bash reporting tcl exitcode: ${exitcode}" +#-- override exitcode example +#exit 66 +# +# -- --- --- --- --- --- --- --- + +# +# + + +#printf "sh/bash done \n" +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end sh Payload +#------------------------------------------------------ +fi +exit ${exitcode} +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- Perl script section +# -- leave the script below as is, if all that is required is launching the Tcl payload" +# -- +# -- Note that perl script isn't called by default when simply running this script by name +# -- adjust the nextshell value at the top of the script to point to perl +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +=cut +#!/user/bin/perl +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin perl Payload +my $exit_code = 0; +#use ExtUtils::Installed; +#my $installed = ExtUtils::Installed->new(); +#my @modules = $installed->modules(); +#print "Modules:\n"; +#foreach my $m (@modules) { +# print "$m\n"; +#} +# -- --- --- + + + +my $scriptname = $0; +print "perl $scriptname\n"; +my $i =1; +foreach my $a(@ARGV) { + print "Arg # $i: $a\n"; +} + +# +# + + + +# -- --- --- --- --- --- --- --- +# +$exit_code=system("tclsh", $scriptname, @ARGV); +#print "perl reporting tcl exitcode: $exit_code"; +# +# -- --- --- --- --- --- --- --- + +# +# + + +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end perl Payload +exit $exit_code; +__END__ + +# end hide sh/bash/perl block from Tcl +# This comment with closing brace should stay in place whether if commented or not } +#------------------------------------------------------ +# begin hide powershell-block from Tcl - only needed if Tcl didn't exit or return above +if 0 { +: end heredoc1 - end hide from powershell \ +'@ +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- powershell/pwsh section +# -- Do not edit if current file is the .ps1 +# -- Edit the corresponding .cmd and it will autocopy +# -- unbalanced braces { } here *even in comments* will cause problems if there was no Tcl exit or return above +# -- custom script should generally go below the begin_powershell_payload line +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +function GetScriptName { $myInvocation.ScriptName } +$scriptname = GetScriptName +function GetDynamicParamDictionary { + [CmdletBinding()] + param( + [Parameter(ValueFromPipeline=$true, Mandatory=$true)] + [string] $CommandName + ) + + begin { + # Get a list of params that should be ignored (they're common to all advanced functions) + $CommonParameterNames = [System.Runtime.Serialization.FormatterServices]::GetUninitializedObject([type] [System.Management.Automation.Internal.CommonParameters]) | + Get-Member -MemberType Properties | + Select-Object -ExpandProperty Name + } + + process { + # Create the dictionary that this scriptblock will return: + $DynParamDictionary = New-Object System.Management.Automation.RuntimeDefinedParameterDictionary + + # Convert to object array and get rid of Common params: + (Get-Command $CommandName | select -exp Parameters).GetEnumerator() | + Where-Object { $CommonParameterNames -notcontains $_.Key } | + ForEach-Object { + $DynamicParameter = New-Object System.Management.Automation.RuntimeDefinedParameter ( + $_.Key, + $_.Value.ParameterType, + $_.Value.Attributes + ) + $DynParamDictionary.Add($_.Key, $DynamicParameter) + } + + # Return the dynamic parameters + return $DynParamDictionary + } +} +# GetDynamicParamDictionary +# - This can make it easier to share a single set of param definitions between functions +# - sample usage +#function ParameterDefinitions { +# param( +# [Parameter(Mandatory)][string] $myargument +# ) +#} +#function psmain { +# [CmdletBinding()] +# param() +# dynamicparam { GetDynamicParamDictionary ParameterDefinitions } +# process { +# #called once with $PSBoundParameters dictionary +# #can be used to validate arguments, or set a simpler variable name for access +# switch ($PSBoundParameters.keys) { +# 'myargumentname' { +# Set-Variable -Name $_ -Value $PSBoundParameters."$_" +# } +# #... +# } +# foreach ($boundparam in $PSBoundParameters.GetEnumerator()) { +# #... +# } +# } +# end { +# #Main function logic +# Write-Host "myargumentname value is: $myargumentname" +# #myotherfunction @PSBoundParameters +# } +#} +#psmain @args +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin powershell Payload +#"Timestamp : {0,10:yyyy-MM-dd HH:mm:ss}" -f $(Get-Date) | write-host +#"Script Name : {0}" -f $scriptname | write-host +#"Powershell Version: {0}" -f $PSVersionTable.PSVersion.Major | write-host +#"powershell args : {0}" -f ($args -join ", ") | write-host +# -- --- --- --- + +# +# + + +# -- --- --- --- --- --- --- --- +# +tclsh $scriptname $args +#"powershell reporting exitcode: {0}" -f $LASTEXITCODE | write-host +# +# -- --- --- --- --- --- --- --- + + +# +# + +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end powershell Payload +Exit $LASTEXITCODE +# heredoc2 for powershell to ignore block below +$1 = @' +' +: comment end hide powershell-block from Tcl \ +# This comment with closing brace should stay in place whether 'if' commented or not } +: multishell doubled-up cmd exit label - return exitcode +:exit_multishell +:exit_multishell +: \ +@REM @ECHO exitcode: !task_exitcode! +: \ +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo. & @cmd /k echo elevated prompt: type exit to quit) +: \ +@EXIT /B !task_exitcode! +# cmd has exited +: comment end heredoc2 \ +'@ +<# +# id:tailblock0 +# -- powershell multiline comment +#> +<# +no script engine should try to run me +# id:tailblock1 +# + +# +# -- unreachable by tcl directly if ctrl-z character is in the section above. (but file can be read and split on \x1A) +# -- Potential for zip and/or base64 contents, but we can't stop pwsh parser from slurping in the data +# -- so for example a plain text tar archive could cause problems depending on the content. +# -- final line in file must be the powershell multiline comment terminator or other data it can handle. +# -- e.g plain # comment lines will work too +# -- (for example a powershell digital signature is a # commented block of data at the end of the file) +#> + + diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index ac6906d..b907b7f 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -20,13 +20,436 @@ #package require punk package require punk::args package require punk::char +package require punk::ansi package require punk::lib catch {package require patternpunk} package require overtype package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? package require textutil +namespace eval textblock { + namespace eval class { + if {[info commands [namespace current]::table] eq ""} { + #*** !doctools + #[subsection {Namespace textblock::class}] + #[para] class definitions + #[list_begin itemized] [comment {- textblock::class groupings -}] + # [item] + # [para] [emph {handler_classes}] + # [list_begin enumerated] + + oo::class create [namespace current]::table { + #*** !doctools + #[enum] CLASS [class interface_caphandler.registry] + #[list_begin definitions] + # [para] [emph METHODS] + variable o_opts_table + variable o_columndefs + variable o_columndata + variable o_rowdefs + variable o_rowstates + variable o_opts_table_defaults + constructor {args} { + #*** !doctools + #[call class::table [method constructor] [arg args]] + + set o_opts_table_defaults [dict create\ + -title ""\ + -frametype "unicode_box"\ + -show_header ""\ + ] + if {[llength $args] == 1} { + set args [list -title [lindex $args 0]] + } + if {[llength $args] %2 !=0} { + error "[namespace current]::table constructor - unexpected argument count. Require single value being title, or name value pairs" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_table_defaults]} { + error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + set o_opts_table [dict merge $o_opts_table_defaults $args] + set o_columndefs [dict create] + set o_columndata [dict create] + set o_rowdefs [dict create] ;#user requested row data e.g -minheight -maxheight + set o_rowstates [dict create] ;#actual row data such as -minheight and -maxheight detected from supplied row data + + } + method configure args { + if {![llength $args]} { + return $o_opts_table + } else { + if {[llength $args] %2 != 0} { + error "[namespace current]::table configure - unexpected argument count. Require name value pairs" + } + dict for {k v} $args { + if {$k ni [dict keys $o_opts_table_defaults]} { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + set o_opts_table [dict merge $o_opts_table $args] + } + } + method add_column {args} { + #*** !doctools + #[call class::table [method add_column] [arg args]] + set defaults [dict create\ + -header ""\ + -footer ""\ + -style ""\ + -minwidth ""\ + -maxwidth ""\ + ] + if {[llength $args] %2 != 0} { + error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + } + dict for {k v} $args { + if {$k ni [dict keys $defaults]} { + error "[namespace current]::table::add_column unknown option '$k'. Known options: [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set colcount [dict size $o_columndefs] + set h [dict get $opts -header] + #todo - multiline header + if {[string is integer -strict $h]} { + error "table::add_column -header cannot be an integer" + } + set coldef [dict create -header $h -style [dict get $opts -style] -minwidth [dict get $opts -minwidth] -maxwidth [dict get $opts -maxwidth]] + dict set o_columndefs $colcount $coldef + return $colcount + } + method add_row {valuelist args} { + #*** !doctools + #[call class::table [method add_row] [arg args]] + if {[llength $valuelist] > [dict size $o_columndefs]} { + error "too many row values - only [dict size $o_columndefs] defined" + } + set defaults [dict create\ + -minheight 1\ + -maxheight ""\ + ] + if {[llength $args] %2 !=0} { + error "[namespace current]::table::add_row unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + } + set opts [dict merge $defaults $args] + set opt_minh [dict get $opts -minheight] + set opt_maxh [dict get $opts -maxheight] + if {![string is integer $opt_minh] || ($opt_maxh ne "" && ![string is integer -strict $opt_maxh])} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must be integers greater than or equal to 1" + } + if {$opt_minh < 1 || ($opt_maxh ne "" && $opt_maxh < 1)} { + error "[namespace current]::table::add_row error -minheight '$opt_minh' and -maxheight '$opt_maxh' must both be 1 or greater" + } + if {$opt_maxh ne "" && $opt_maxh < $opt_minh} { + error "[namespace current]::table::add_row error -maxheight '$opt_maxh' must greater than -minheight '$opt_minh'" + } + set rowcount [dict size $o_rowdefs] + dict set o_rowdefs $rowcount -minheight $opt_minh + dict set o_rowdefs $rowcount -maxheight $opt_maxh + dict set o_rowstates $rowcount -minheight $opt_minh + set c 0 + set max_height_seen 1 + foreach v $valuelist { + dict lappend o_columndata $c $v + set valheight [textblock::height $v] + if {$valheight > $max_height_seen} { + set max_height_seen $valheight + } + incr c + } + if {$opt_maxh ne ""} { + dict set o_rowstates $rowcount -maxheight [expr {min($opt_maxh,$max_height_seen)}] + } else { + dict set o_rowstates $rowcount -maxheight $max_height_seen + } + } + method Get_columns_by_name {namematch_list} { + + } + #specify range with x..y + method Get_columns_by_indices {index_list} { + foreach spec $index_list { + if {[string is integer -strict $c]} { + set colidx $c + } else { + dict for {colidx coldef} $o_columndefs { + #if {[string match x x]} {} + } + } + } + } + method get_column_by_index {i args} { + set defaults [dict create\ + -positiontype "inner"\ + ] + set valid_positiontypes [list left inner right solo] + dict for {k v} $args { + if {$k ni [dict keys $defaults]} { + error "[namespace::current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + } + } + set opts [dict merge $defaults $args] + set opt_posn [dict get $opts -positiontype] + + if {$opt_posn ni $valid_positiontypes} { + error "[namespace::current]::table::get_column_by_index error invalid value '$opt_posn' for -positiontype. Valid values $valid_positiontypes" + } + + set columninfo [my get_column_cells_by_index $i] + set header [dict get $columninfo header] + set cells [dict get $columninfo cells] + + set columninfo [my get_column_cells_by_index $i] + set topt_show_header [dict get $o_opts_table -show_header] + if {$topt_show_header eq ""} { + set allheaders "" + set all_cols [dict keys $o_columndefs] + foreach c $all_cols { + append allheaders [dict get $o_columndefs $c -header] + } + if {$allheaders eq ""} { + set do_show_header 0 + } else { + set do_show_header 1 + } + } else { + set do_show_header $topt_show_header + } + set output "" + set boxlimits "" + set joins "" + set header_boxlimits [list] + set header_joins [list] + switch -- $opt_posn { + left { + set header_boxlimits {hl tlc blc vll} + set header_joins {down-light} + set boxlimits {hlb blc vll} + set boxlimits_headerless {hl blc vll tlc} + set joins {down} + } + inner { + set header_boxlimits {hl tlc blc vll} + set header_joins {left down-light} + set boxlimits {hlb blc vll} + set boxlimits_headerless {hl blc vll tlc} + set joins {down left} + } + right { + set header_boxlimits {hl tlc blc vl trc brc} + set header_joins {left down-light} + set boxlimits {hlb blc vl brc} + set boxlimits_headerless {hl blc vl brc tlc trc} + set joins {down left} + } + solo { + set header_boxlimits {hl tlc blc vl trc brc} + set header_joins {down-light} + set boxlimits {hlb blc vl brc} + set boxlimits_headerless {hl blc vl brc tlc trc} + set joins {down} + } + } + if {$do_show_header} { + append output [textblock::frame -type unicode_box_heavy -boxlimits $header_boxlimits -joins $header_joins $header]\n + } + set r 0 + set rmax [expr {[llength $cells]-1}] + foreach c $cells { + #todo - joinleft,joinright,joindown based on opts in args + #append output [textblock::frame -boxlimits {vll blc hlb} $c]\n + if {$r == 0} { + if {$r == $rmax} { + set joins [lremove $joins [lsearch $joins down]] + } + if {$do_show_header} { + append output [textblock::frame -boxlimits $boxlimits -joins $joins $c]\n + } else { + append output [textblock::frame -boxlimits $boxlimits_headerless -joins $joins $c]\n + } + } else { + if {$r == $rmax} { + set joins [lremove $joins [lsearch $joins down]] + } + append output [textblock::frame -boxlimits $boxlimits -joins $joins $c]\n + } + incr r + } + return [string trimright $output \n] + } + + method get_column_cells_by_index {i} { + set cidx [lindex [dict keys $o_columndefs] $i] + if {$cidx eq ""} { + set range "" + if {[dict size $o_columndefs] > 0} { + set range "0..[expr {[dict size $o_columndefs] -1}] + } + error "table::get_column_by_index no such index $i valid range is $range" + } + set cdef [dict get $o_columndefs $cidx] + set t [dict get $cdef -header] ;#may be empty string + set items [dict get $o_columndata $cidx] + + set defminw [dict get $cdef -minwidth] + set defmaxw [dict get $cdef -maxwidth] + set defstyle [dict get $cdef -style] + set stylecodes "" + if {$defstyle ne ""} { + set stylecodes [punk::ansi::a+ {*}$defstyle] + } + + if {"$defminw$defmaxw" ne "" && $defminw eq $defmaxw} { + #an exact width is defined for the column - no need to look at data width + set colwidth $defminw + } else { + #todo - predetermine if any items in column contain newlines and are truncated vertically due to o_rowdefs configuration. + #if so - a truncated line shouldn't be included in our width calculation + set widest [tcl::mathfunc::max {*}[lmap v [concat [list $t] $items] {textblock::width $v}]] + if {$defminw eq ""} { + if {$defmaxw eq ""} { + set colwidth $widest + } else { + set colwidth [expr {min(1,$defmaxw,$widest)}] + } + } else { + if {$defmaxw eq ""} { + set colwidth [expr {max($defminw,$widest)}] + } else { + if {$widest < $defminw} { + set colwidth $defminw + } else { + if {$widest > $defmaxw} { + set colwidth $defmaxw + } else { + set colwidth [expr {max($defminw,$widest)}] + } + } + } + } + } + set cell_line_blank [string repeat " " $colwidth] + set output [dict create] + if {$t ne ""} { + dict set output header [overtype::left $cell_line_blank $t] + } else { + dict set output header $cell_line_blank + } + + set r 0 + foreach cval $items { + set maxdataheight [dict get $o_rowstates $r -maxheight] + set rowdefminh [dict get $o_rowdefs $r -minheight] + set rowdefmaxh [dict get $o_rowdefs $r -maxheight] + if {"$rowdefminh$rowdefmaxh" ne "" && $rowdefminh eq $rowdefmaxh} { + #an exact height is defined for the row + set rowh $rowdefminh + } else { + if {$rowdefminh eq ""} { + if {$rowdefmaxh eq ""} { + #both defs empty + set rowh $maxdataheight + } else { + set rowh [expr {min(1,$rowdefmaxh,$maxdataheight)}] + } + } else { + if {$rowdefmaxh eq ""} { + set rowh [expr {max($rowdefminh,$maxdataheight)}] + } else { + if {$maxdataheight < $rowdefminh} { + set rowh $rowdefminh + } else { + set rowh [expr {max($rowdefminh,$maxdataheight)}] + } + } + } + } + if {$stylecodes ne ""} { + set cval $stylecodes$cval + } + set cell_lines [lrepeat $rowh $cell_line_blank] + set cell_blank [join $cell_lines \n] + set cval_lines [split $cval \n] + set cval_lines [lrange $cval_lines 0 $rowh-1] + set cval_block [join $cval_lines \n] + #TODO! fix overtype library + set cell [overtype::left -experimental test_mode $cell_blank $cval_block] + dict lappend output cells $cell + + incr r + } + return $output + } + method debug {} { + puts stdout "rowdefs: $o_rowdefs" + puts stdout "rowstates: $o_rowstates" + puts stdout "columndefs: $o_columndefs" + } + method print {args} { + if {![llength $args]} { + set cols [dict keys $o_columndata] + } else { + set cols [list] + foreach colspec $args { + set allcols [dict keys $o_columndata] + if {[string first .. $colspec] >=0} { + set parts [punk::ansi::ta::_perlish_split {\.\.} $colspec] + if {[llength $parts] != 3} { + error "[namespace::current]::table error invalid print specification '$colspec'" + } + lassign $parts from _dd to + if {$from eq ""} { + set from 0 + } + if {$to eq ""} { + set to end + } + set indices [lrange $allcols $from $to] + lappend cols {*}$indices + } else { + set c [lindex $allcols $colspec] + if {$c ne ""} { + lappend cols $c + } + } + } + } + set blocks [list] + set colposn 0 + set numposns [llength $cols] + foreach c $cols { + set flags [list] + if {$colposn == 0 && $colposn == $numposns-1} { + set flags [list -positiontype solo] + } elseif {$colposn == 0} { + set flags [list -positiontype left] + } elseif {$colposn == $numposns-1} { + set flags [list -positiontype right] + } else { + set flags [list -positiontype inner] + } + lappend blocks [my get_column_by_index $c {*}$flags] + incr colposn + } + if {[llength $blocks]} { + return [textblock::join {*}$blocks] + } else { + return "No columns matched" + } + } + + #*** !doctools + #[list_end] + } + #*** !doctools + # [list_end] [comment {- end enumeration provider_classes }] + #[list_end] [comment {- end itemized list textblock::class groupings -}] + } + } +} # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # #Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width @@ -314,6 +737,9 @@ namespace eval textblock { } else { set blocks $args } + if {![llength $blocks]} { + return + } set idx 0 set fordata [list] @@ -405,13 +831,15 @@ namespace eval textblock { set contents [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] % 2 != 0} { - error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? " + error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " } #todo args -justify left|centre|right (center) set defaults [dict create\ -etabs 0\ -type unicode_box\ + -boxlimits [list hl vl tlc blc trc brc]\ + -joins [list]\ -title ""\ -subtitle ""\ -width ""\ @@ -423,7 +851,7 @@ namespace eval textblock { set opts [dict merge $defaults $arglist] foreach {k v} $opts { switch -- $k { - -etabs - -type - -title - -subtitle - -width - -ansiborder - -ansibase - -align - -ellipsis {} + -etabs - -type - -boxlimits - -joins - -title - -subtitle - -width - -ansiborder - -ansibase - -align - -ellipsis {} default { error "frame option '$k' not understood. Valid options are [dict keys $defaults]" } @@ -432,6 +860,8 @@ namespace eval textblock { # -- --- --- --- --- --- set opt_etabs [dict get $opts -etabs] set opt_type [dict get $opts -type] + set opt_boxlimits [dict get $opts -boxlimits] + set opt_joins [dict get $opts -joins] set known_types [list unicode_box unicode_box_heavy unicode_arc unicode_double ascii altg] set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] @@ -457,6 +887,54 @@ namespace eval textblock { } set custom_frame [dict merge $default_custom $opt_type] } + set is_boxlimits_ok 1 + foreach v $opt_boxlimits { + switch -- $v { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set is_joins_ok 1 + foreach v $opt_joins { + switch -- $v { + left - left-light - right - right-light - up - up-light - down - down-light {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down" + } + #sorted order down left right up + #1 x choose 4 + #4 x choose 3 + #6 x choose 2 + #4 x choose 1 + #15 combos + set join_directions [list] + #modifiers - light,heavy (double?) - seem to be some required glyphs missing from unicode + #e.g down-light, up-heavy + set join_modifiers [dict create left "" down "" right "" up ""] + foreach jt $opt_joins { + lassign [split $jt -] direction modifier + if {$modifier ne ""} { + dict set join_modifiers $direction $modifier + } + lappend join_directions $direction + } + set join_directions [lsort -unique $join_directions] + set do_joins [::join $join_directions _] + + # -- --- --- --- --- --- set opt_title [dict get $opts -title] set opt_subtitle [dict get $opts -subtitle] @@ -511,6 +989,9 @@ namespace eval textblock { set underlayline [string repeat " " $contentwidth] set underlay [::join [lrepeat $linecount $underlayline] \n] + set vll_width 1 ;#default for all except custom (printing width) + set vlr_width 1 + switch -- $opt_type { "altg" { #old style ansi escape sequences with alternate graphics page G0 @@ -554,8 +1035,122 @@ namespace eval textblock { set trc [punk::char::charshort boxd_ldl] set blc [punk::char::charshort boxd_lur] set brc [punk::char::charshort boxd_lul] + #15 combos + #sort order: down left right up + #ltj,rtj,ttj,btj e.g left T junction etc. + #Look at from the perspective of a frame/table outline with a clean border and arms pointing inwards + switch -- $do_joins { + down { + #1 + switch -- [dict get $join_modifiers down] { + heavy { + set blc [punk::char::charshort boxd_dhrul] ;#down light and right up heavy (ltj) + } + default { + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + } + } + set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + } + left { + #2 + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + right { + #3 + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + up { + #4 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + } + down_left { + #5 + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + } + down_right { + #6 + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + down_up { + #7 + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) - joinleft + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + #from3 + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + set tlc [punk::char::charshort boxd_ldhz] ;#T shape (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + set brc [punk::char::charshort boxd_lvl] ;#light vertical and right (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set blc [punk::char::charshort boxd_lvr] ;#light vertical and right (ltj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + set brc [punk::char::charshort boxd_luhz] ;#upside down T shape (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set blc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set trc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + set brc [punk::char::charshort boxd_lvhz] ;#light vertical and horizontal (fwj) + } + } + set tbar [string repeat $hl $contentwidth] set bbar $tbar + #four way junction (cd::fwj) (punk::ansi::g0 n) (punk::char::charshort lvhz) (+) } "unicode_box_heavy" { #unicode box drawing set @@ -569,6 +1164,132 @@ namespace eval textblock { set trc [punk::char::charshort boxd_hdl] set blc [punk::char::charshort boxd_hur] set brc [punk::char::charshort boxd_hul] + switch -- $do_joins { + down { + #1 + switch -- [dict get $join_modifiers down] { + light { + set blc [punk::char::charshort boxd_dlruh] ;#down light and right up heavy (ltj) + set brc [punk::char::charshort boxd_dlluh] ;#down light and left up heavy (rtj) + } + default { + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + } + left { + #2 + set tlc [punk::char::charshort boxd_ldhz] ;# (ttj) + set blc [punk::char::charshort boxd_luhz] ;# (btj) + } + right { + #3 + set trc [punk::char::charshort boxd_hdhz] ;#T shape (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + up { + #4 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + } + down_left { + #5 + switch -- d-[dict get $join_modifiers down]_l-[dict get $join_modifiers left] { + d-light_l- { + set blc [punk::char::charshort boxd_dluhzh] ;#down light and up horizontal heavy (fwj) + set brc [punk::char::charshort boxd_dlluh] ;#down light and left up heavy (rtj) + } + d-_l-light { + set blc [punk::char::charshort boxd_llrvh] ;# left light and right Vertical Heavy (fwj) + set brc [punk::char::charshort boxd_vhll] ;#vertical heavy and left light (rtj) + } + d-light_l-light { + set blc [punk::char::charshort boxd_ruhldl] ;#right up heavy and left down light (fwj) + set brc [punk::char::charshort boxd_uhldl] ;#up heavy and left down light (rtj) + } + default { + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + } + } + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + } + down_right { + #6 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + down_up { + #7 + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + } + left_right { + #8 + #from 2 + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + #from3 + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + left_up { + #9 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + } + right_up { + #10 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + } + down_left_right { + #11 + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hdhz] ;# (ttj) + set tlc [punk::char::charshort boxd_hdhz] ;# (ttj) + + } + down_left_up { + #12 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvl] ;# (rtj) + set brc [punk::char::charshort boxd_hvl] ;# (rtj) + + } + down_right_up { + #13 + set tlc [punk::char::charshort boxd_hvr] ;# (ltj) + set blc [punk::char::charshort boxd_hvr] ;# (ltj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + left_right_up { + #14 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_huhz] ;# (btj) + set brc [punk::char::charshort boxd_huhz] ;# (btj) + + } + down_left_right_up { + #15 + set tlc [punk::char::charshort boxd_hvhz] ;# (fwj) + set blc [punk::char::charshort boxd_hvhz] ;# (fwj) + set trc [punk::char::charshort boxd_hvhz] ;# (fwj) + set brc [punk::char::charshort boxd_hvhz] ;# (fwj) + } + } + set tbar [string repeat $hl $contentwidth] set bbar $tbar } @@ -673,6 +1394,51 @@ namespace eval textblock { } } } + set leftborder 0 + set rightborder 0 + set topborder 0 + set bottomborder 0 + # hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + foreach lim $opt_boxlimits { + switch -- $lim { + hl { + set topborder 1 + set bottomborder 1 + } + hlt { + set topborder 1 + } + hlb { + set bottomborder 1 + } + vl { + set leftborder 1 + set rightborder 1 + } + vll { + set leftborder 1 + } + vlr { + set rightborder 1 + } + tlc { + set topborder 1 + set leftborder 1 + } + trc { + set topborder 1 + set rightborder 1 + } + blc { + set bottomborder 1 + set leftborder 1 + } + brc { + set bottomborder 1 + set rightborder 1 + } + } + } #keep lhs/rhs separate? can we do vertical text on sidebars? set lhs [string repeat $vll\n $linecount] set lhs [string range $lhs 0 end-1] @@ -689,6 +1455,44 @@ namespace eval textblock { set rhs $opt_ansiborder$rhs$rst } + #boxlimits used for partial borders in table generation + if {"vll" ni $opt_boxlimits && "vl" ni $opt_boxlimits} { + set blank_vll [string repeat " " $vll_width] + set lhs [string repeat $blank_vll\n $linecount] + set lhs [string range $lhs 0 end-1] + } + if {"vlr" ni $opt_boxlimits && "vl" ni $opt_boxlimits} { + set blank_vlr [string repeat " " $vlr_width] + set rhs [string repeat $blank_vlr\n $linecount] + set rhs [string range $rhs 0 end-1] + } + if {"hl" ni $opt_boxlimits && "hlt" ni $opt_boxlimits} { + set bar_width [punk::ansi::printing_length $tbar] + set tbar [string repeat " " $bar_width] + } + if {"tlc" ni $opt_boxlimits} { + set tlc_width [punk::ansi::printing_length $tlc] + set tlc [string repeat " " $tlc_width] + } + if {"trc" ni $opt_boxlimits} { + set trc_width [punk::ansi::printing_length $trc] + set trc [string repeat " " $trc_width] + } + + if {"hl" ni $opt_boxlimits && "hlb" ni $opt_boxlimits} { + set bar_width [punk::ansi::printing_length $bbar] + set bbar [string repeat " " $bar_width] + } + if {"blc" ni $opt_boxlimits} { + set blc_width [punk::ansi::printing_length $blc] + set blc [string repeat " " $blc_width] + } + if {"brc" ni $opt_boxlimits} { + set brc_width [punk::ansi::printing_length $brc] + set brc [string repeat " " $brc_width] + } + + if {$opt_title ne ""} { set topbar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $tbar $opt_title] ;#overtype supports gx0 on/off } else { @@ -704,11 +1508,56 @@ namespace eval textblock { } else { set rstbase [a]$opt_ansibase } - append fs $tlc$topbar$trc\n + + if {$opt_title ne ""} { + #title overrides -boxlimits for topborder + set topborder 1 + } + if {$topborder} { + if {$leftborder && $rightborder} { + append fs $tlc$topbar$trc\n + } else { + if {$leftborder} { + append fs $tlc$topbar\n + } elseif {$rightborder} { + append fs $topbar$trc\n + } else { + append fs $topbar\n + } + } + } set inner [overtype::$opt_align -ellipsis $opt_ellipsis $opt_ansibase$underlay$rstbase $opt_ansibase$contents$rstbase] - set body [textblock::join -- $lhs $opt_ansibase$inner$rstbase $rhs] + if {$leftborder && $rightborder} { + set bodyparts [list $lhs $opt_ansibase$inner$rstbase $rhs] + } else { + if {$leftborder} { + set bodyparts [list $lhs $opt_ansibase$inner$rstbase] + } elseif {$rightborder} { + set bodyparts [list $opt_ansibase$inner$rstbase $rhs] + } else { + set bodyparts [list $opt_ansibase$inner$rstbase] + } + } + set body [textblock::join -- {*}$bodyparts] + #set body [textblock::join -- $lhs $opt_ansibase$inner$rstbase $rhs] append fs $body - append fs \n $blc$bottombar$brc + if {$opt_subtitle ne ""} { + #subtitle overrides boxlimits for bottomborder + set bottomborder 1 + } + if {$bottomborder} { + if {$leftborder && $rightborder} { + append fs \n$blc$bottombar$brc + } else { + if {$leftborder} { + append fs \n$blc$bottombar + } elseif {$rightborder} { + append fs \n$bottombar$brc + } else { + append fs \n$bottombar + } + } + } return $fs diff --git a/src/modules/textblock-buildversion.txt b/src/modules/textblock-buildversion.txt index f47d01c..781c895 100644 --- a/src/modules/textblock-buildversion.txt +++ b/src/modules/textblock-buildversion.txt @@ -1,3 +1,3 @@ -0.1.0 +0.1.1 #First line must be a semantic version number #all other lines are ignored.