Browse Source

Improvements to punk-multishell script and scriptwrap system.

master
Julian Noble 11 months ago
parent
commit
bb06ce56e6
  1. 34
      src/doc/punk/_module_fileline-0.1.0.tm.man
  2. 68
      src/embedded/man/files/punk/_module_fileline-0.1.0.tm.n
  3. 132
      src/embedded/md/doc/files/punk/_module_fileline-0.1.0.tm.md
  4. 106
      src/embedded/www/doc/files/punk/_module_fileline-0.1.0.tm.html
  5. 7
      src/modules/punk/ansi-999999.0a1.0.tm
  6. 537
      src/modules/punk/fileline-999999.0a1.0.tm
  7. 2
      src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm
  8. 787
      src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm
  9. 80
      src/modules/punk/mix/templates/utility/scriptappwrappers/punk-multishell.cmd
  10. 19
      src/modules/punk/mix/util-999999.0a1.0.tm
  11. 15
      src/scriptapps/punk.tcl

34
src/doc/punk/_module_fileline-0.1.0.tm.man

@ -29,10 +29,20 @@
[para]No support for lone carriage-returns being interpreted as line-endings. [para]No support for lone carriage-returns being interpreted as line-endings.
[para]CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module. [para]CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module.
[subsection dependencies] [subsection dependencies]
[para] packages used by punk::fileline [para] packages needed by punk::fileline
[list_begin itemized] [list_begin itemized]
[item] [package {Tcl 8.6}] [item] [package {Tcl 8.6}]
[list_end] [list_end] [comment {- end dependencies list -}]
[subsection {optional dependencies}]
[para] packages that add functionality but aren't strictly required
[list_begin itemized]
[item] [package {punk::ansi}]
[para] - recommended for class::textinfo [method chunk_boundary_display]
[item] [package {punk::char}]
[para] - recommended for class::textinfo [method chunk_boundary_display]
[item] [package {overtype}]
[para] - recommended for class::textinfo [method chunk_boundary_display]
[list_end] [comment {- end optional dependencies list -}]
[section API] [section API]
[subsection {Namespace punk::fileline::class}] [subsection {Namespace punk::fileline::class}]
[para] class definitions [para] class definitions
@ -56,10 +66,11 @@ or
[para] objName chunk 0 end [para] objName chunk 0 end
[call class::textinfo [method chunklen]] [call class::textinfo [method chunklen]]
[para] Number of bytes/characters in the raw data of the file [para] Number of bytes/characters in the raw data of the file
[call class::textinfo [method chunk_boundary_display]]
[para]Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend
[para]Defaults to using ansi colour if punk::ansi module is available. Use -ansi 0 to disable colour
[call class::textinfo [method linecount]] [call class::textinfo [method linecount]]
[para] Number of lines in the raw data of the file, counted as per the policy in effect [para] Number of lines in the raw data of the file, counted as per the policy in effect
[call class::textinfo [method regenerate_lines]]
[para]generate a list of lines from the stored raw data chunk and keep a map of line-endings indexed by lineindex
[call class::textinfo [method line] [arg lineindex]] [call class::textinfo [method line] [arg lineindex]]
[para]Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata [para]Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata
[para]A 'line' may be returned without a line-ending if the unerlying chunk had trailing data without a line-ending (or the chunk was loaded under a non-standard -policy setting) [para]A 'line' may be returned without a line-ending if the unerlying chunk had trailing data without a line-ending (or the chunk was loaded under a non-standard -policy setting)
@ -91,6 +102,8 @@ or
[para]Return a dict of the metadata and text for the line indicated by the zero-based lineindex [para]Return a dict of the metadata and text for the line indicated by the zero-based lineindex
[para]This returns the same info as the [method linemeta] with an added key of 'payload' which is the text of the line without line-ending. [para]This returns the same info as the [method linemeta] with an added key of 'payload' which is the text of the line without line-ending.
[para]The 'payload' value is the same as is returned from the [method linepayload] method. [para]The 'payload' value is the same as is returned from the [method linepayload] method.
[call class::textinfo [method lineinfolist] [arg startidx] [arg endidx]]
[para]Returns list of lineinfo dicts for each line in line index range startidx to endidx
[call class::textinfo [method linerange_to_chunkrange] [arg startidx] [arg endidx]] [call class::textinfo [method linerange_to_chunkrange] [arg startidx] [arg endidx]]
[call class::textinfo [method linerange_to_chunk] [arg startidx] [arg endidx]] [call class::textinfo [method linerange_to_chunk] [arg startidx] [arg endidx]]
[call class::textinfo [method lines] [arg startidx] [arg endidx]] [call class::textinfo [method lines] [arg startidx] [arg endidx]]
@ -111,6 +124,11 @@ or
[para]Basic addition and subtraction expressions such as 4-1 5+2 are accepted [para]Basic addition and subtraction expressions such as 4-1 5+2 are accepted
[para]startidx higher than endidx is allowed [para]startidx higher than endidx is allowed
[para]Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max [para]Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max
[call class::textinfo [method regenerate_lines]]
[para]generate a list of lines from the current state of the stored raw data chunk and keep a map of line-endings indexed by lineindex
[para]This is called automatically by the Constructor during object creation
[para]It is exposed in the API experimentally - as chunk and line manipulation functions are considered.
[para]TODO - review whether such manual control will be necessary/desirable
[list_end] [list_end]
[list_end] [comment {--- end class enumeration ---}] [list_end] [comment {--- end class enumeration ---}]
[subsection {Namespace punk::fileline}] [subsection {Namespace punk::fileline}]
@ -143,4 +161,12 @@ or
[section Internal] [section Internal]
[subsection {Namespace punk::fileline::system}] [subsection {Namespace punk::fileline::system}]
[para] Internal functions that are not part of the API [para] Internal functions that are not part of the API
[subsection {Namespace punk::fileline::ansi}]
[para]These are ansi functions imported from punk::ansi - or no-ops if that package is unavailable
[para]See [package punk::ansi] for documentation
[list_begin definitions]
[call [fun ansi::a]]
[call [fun ansi::a+]]
[call [fun ansi::stripansi]]
[list_end] [comment {--- end definitions namespace punk::fileline::ansi ---}]
[manpage_end] [manpage_end]

68
src/embedded/man/files/punk/_module_fileline-0.1.0.tm.n

@ -282,9 +282,9 @@ class::textinfo \fBchunk\fR \fIchunkstart\fR \fIchunkend\fR
.sp .sp
class::textinfo \fBchunklen\fR class::textinfo \fBchunklen\fR
.sp .sp
class::textinfo \fBlinecount\fR class::textinfo \fBchunk_boundary_display\fR
.sp .sp
class::textinfo \fBregenerate_lines\fR class::textinfo \fBlinecount\fR
.sp .sp
class::textinfo \fBline\fR \fIlineindex\fR class::textinfo \fBline\fR \fIlineindex\fR
.sp .sp
@ -294,6 +294,8 @@ class::textinfo \fBlinemeta\fR \fIlineindex\fR
.sp .sp
class::textinfo \fBlineinfo\fR \fIlineindex\fR class::textinfo \fBlineinfo\fR \fIlineindex\fR
.sp .sp
class::textinfo \fBlineinfolist\fR \fIstartidx\fR \fIendidx\fR
.sp
class::textinfo \fBlinerange_to_chunkrange\fR \fIstartidx\fR \fIendidx\fR class::textinfo \fBlinerange_to_chunkrange\fR \fIstartidx\fR \fIendidx\fR
.sp .sp
class::textinfo \fBlinerange_to_chunk\fR \fIstartidx\fR \fIendidx\fR class::textinfo \fBlinerange_to_chunk\fR \fIstartidx\fR \fIendidx\fR
@ -312,8 +314,16 @@ class::textinfo \fBnumeric_chunkrange\fR \fIstartidx\fR \fIendidx\fR
.sp .sp
class::textinfo \fBnormalize_indices\fR \fIstartidx\fR \fIendidx\fR \fImax\fR class::textinfo \fBnormalize_indices\fR \fIstartidx\fR \fIendidx\fR \fImax\fR
.sp .sp
class::textinfo \fBregenerate_lines\fR
.sp
\fBlib::range_spans_chunk_boundaries\fR \fIstart\fR \fIend\fR \fIchunksize\fR \fBlib::range_spans_chunk_boundaries\fR \fIstart\fR \fIend\fR \fIchunksize\fR
.sp .sp
\fBansi::a\fR
.sp
\fBansi::a+\fR
.sp
\fBansi::stripansi\fR
.sp
.BE .BE
.SH DESCRIPTION .SH DESCRIPTION
.PP .PP
@ -351,10 +361,26 @@ No support for lone carriage-returns being interpreted as line-endings\&.
CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module\&. CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module\&.
.SS DEPENDENCIES .SS DEPENDENCIES
.PP .PP
packages used by punk::fileline packages needed by punk::fileline
.IP \(bu .IP \(bu
\fBTcl 8\&.6\fR \fBTcl 8\&.6\fR
.PP .PP
.SS "OPTIONAL DEPENDENCIES"
.PP
packages that add functionality but aren't strictly required
.IP \(bu
\fBpunk::ansi\fR
.sp
- recommended for class::textinfo \fBchunk_boundary_display\fR
.IP \(bu
\fBpunk::char\fR
.sp
- recommended for class::textinfo \fBchunk_boundary_display\fR
.IP \(bu
\fBovertype\fR
.sp
- recommended for class::textinfo \fBchunk_boundary_display\fR
.PP
.SH API .SH API
.SS "NAMESPACE PUNK::FILELINE::CLASS" .SS "NAMESPACE PUNK::FILELINE::CLASS"
.PP .PP
@ -394,13 +420,15 @@ class::textinfo \fBchunklen\fR
.sp .sp
Number of bytes/characters in the raw data of the file Number of bytes/characters in the raw data of the file
.TP .TP
class::textinfo \fBlinecount\fR class::textinfo \fBchunk_boundary_display\fR
.sp .sp
Number of lines in the raw data of the file, counted as per the policy in effect Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend
.sp
Defaults to using ansi colour if punk::ansi module is available\&. Use -ansi 0 to disable colour
.TP .TP
class::textinfo \fBregenerate_lines\fR class::textinfo \fBlinecount\fR
.sp .sp
generate a list of lines from the stored raw data chunk and keep a map of line-endings indexed by lineindex Number of lines in the raw data of the file, counted as per the policy in effect
.TP .TP
class::textinfo \fBline\fR \fIlineindex\fR class::textinfo \fBline\fR \fIlineindex\fR
.sp .sp
@ -462,6 +490,10 @@ This returns the same info as the \fBlinemeta\fR with an added key of 'payload'
.sp .sp
The 'payload' value is the same as is returned from the \fBlinepayload\fR method\&. The 'payload' value is the same as is returned from the \fBlinepayload\fR method\&.
.TP .TP
class::textinfo \fBlineinfolist\fR \fIstartidx\fR \fIendidx\fR
.sp
Returns list of lineinfo dicts for each line in line index range startidx to endidx
.TP
class::textinfo \fBlinerange_to_chunkrange\fR \fIstartidx\fR \fIendidx\fR class::textinfo \fBlinerange_to_chunkrange\fR \fIstartidx\fR \fIendidx\fR
.TP .TP
class::textinfo \fBlinerange_to_chunk\fR \fIstartidx\fR \fIendidx\fR class::textinfo \fBlinerange_to_chunk\fR \fIstartidx\fR \fIendidx\fR
@ -501,6 +533,16 @@ Basic addition and subtraction expressions such as 4-1 5+2 are accepted
startidx higher than endidx is allowed startidx higher than endidx is allowed
.sp .sp
Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max
.TP
class::textinfo \fBregenerate_lines\fR
.sp
generate a list of lines from the current state of the stored raw data chunk and keep a map of line-endings indexed by lineindex
.sp
This is called automatically by the Constructor during object creation
.sp
It is exposed in the API experimentally - as chunk and line manipulation functions are considered\&.
.sp
TODO - review whether such manual control will be necessary/desirable
.RE .RE
.PP .PP
.SS "NAMESPACE PUNK::FILELINE" .SS "NAMESPACE PUNK::FILELINE"
@ -550,6 +592,18 @@ This function automatically uses lseq (if Tcl >= 8\&.7) when number of boundarie
.SS "NAMESPACE PUNK::FILELINE::SYSTEM" .SS "NAMESPACE PUNK::FILELINE::SYSTEM"
.PP .PP
Internal functions that are not part of the API Internal functions that are not part of the API
.SS "NAMESPACE PUNK::FILELINE::ANSI"
.PP
These are ansi functions imported from punk::ansi - or no-ops if that package is unavailable
.PP
See \fBpunk::ansi\fR for documentation
.TP
\fBansi::a\fR
.TP
\fBansi::a+\fR
.TP
\fBansi::stripansi\fR
.PP
.SH KEYWORDS .SH KEYWORDS
file, module, parse, text file, module, parse, text
.SH COPYRIGHT .SH COPYRIGHT

132
src/embedded/md/doc/files/punk/_module_fileline-0.1.0.tm.md

@ -28,17 +28,21 @@ punkshell\_module\_punk::fileline \- file line\-handling utilities
- [dependencies](#subsection3) - [dependencies](#subsection3)
- [optional dependencies](#subsection4)
- [API](#section3) - [API](#section3)
- [Namespace punk::fileline::class](#subsection4) - [Namespace punk::fileline::class](#subsection5)
- [Namespace punk::fileline](#subsection5) - [Namespace punk::fileline](#subsection6)
- [Namespace punk::fileline::lib](#subsection6) - [Namespace punk::fileline::lib](#subsection7)
- [Internal](#section4) - [Internal](#section4)
- [Namespace punk::fileline::system](#subsection7) - [Namespace punk::fileline::system](#subsection8)
- [Namespace punk::fileline::ansi](#subsection9)
- [Keywords](#keywords) - [Keywords](#keywords)
@ -51,22 +55,27 @@ package require punk::fileline
[class::textinfo __constructor__ *datachunk* ?option value\.\.\.?](#1) [class::textinfo __constructor__ *datachunk* ?option value\.\.\.?](#1)
[class::textinfo __chunk__ *chunkstart* *chunkend*](#2) [class::textinfo __chunk__ *chunkstart* *chunkend*](#2)
[class::textinfo __chunklen__](#3) [class::textinfo __chunklen__](#3)
[class::textinfo __linecount__](#4) [class::textinfo __chunk\_boundary\_display__](#4)
[class::textinfo __regenerate\_lines__](#5) [class::textinfo __linecount__](#5)
[class::textinfo __line__ *lineindex*](#6) [class::textinfo __line__ *lineindex*](#6)
[class::textinfo __linepayload__ *lineindex*](#7) [class::textinfo __linepayload__ *lineindex*](#7)
[class::textinfo __linemeta__ *lineindex*](#8) [class::textinfo __linemeta__ *lineindex*](#8)
[class::textinfo __lineinfo__ *lineindex*](#9) [class::textinfo __lineinfo__ *lineindex*](#9)
[class::textinfo __linerange\_to\_chunkrange__ *startidx* *endidx*](#10) [class::textinfo __lineinfolist__ *startidx* *endidx*](#10)
[class::textinfo __linerange\_to\_chunk__ *startidx* *endidx*](#11) [class::textinfo __linerange\_to\_chunkrange__ *startidx* *endidx*](#11)
[class::textinfo __lines__ *startidx* *endidx*](#12) [class::textinfo __linerange\_to\_chunk__ *startidx* *endidx*](#12)
[class::textinfo __linepayloads__ *startidx* *endidx*](#13) [class::textinfo __lines__ *startidx* *endidx*](#13)
[class::textinfo __chunkrange\_to\_linerange__ *chunkstart* *chunkend*](#14) [class::textinfo __linepayloads__ *startidx* *endidx*](#14)
[class::textinfo __chunkrange\_to\_lineinfolist__ *chunkstart* *chunkend* ?option value\.\.\.?](#15) [class::textinfo __chunkrange\_to\_linerange__ *chunkstart* *chunkend*](#15)
[class::textinfo __numeric\_linerange__ *startidx* *endidx*](#16) [class::textinfo __chunkrange\_to\_lineinfolist__ *chunkstart* *chunkend* ?option value\.\.\.?](#16)
[class::textinfo __numeric\_chunkrange__ *startidx* *endidx*](#17) [class::textinfo __numeric\_linerange__ *startidx* *endidx*](#17)
[class::textinfo __normalize\_indices__ *startidx* *endidx* *max*](#18) [class::textinfo __numeric\_chunkrange__ *startidx* *endidx*](#18)
[__lib::range\_spans\_chunk\_boundaries__ *start* *end* *chunksize*](#19) [class::textinfo __normalize\_indices__ *startidx* *endidx* *max*](#19)
[class::textinfo __regenerate\_lines__](#20)
[__lib::range\_spans\_chunk\_boundaries__ *start* *end* *chunksize*](#21)
[__ansi::a__](#22)
[__ansi::a\+__](#23)
[__ansi::stripansi__](#24)
# <a name='description'></a>DESCRIPTION # <a name='description'></a>DESCRIPTION
@ -114,13 +123,29 @@ something else before the data is supplied to this module\.
## <a name='subsection3'></a>dependencies ## <a name='subsection3'></a>dependencies
packages used by punk::fileline packages needed by punk::fileline
- __Tcl 8\.6__ - __Tcl 8\.6__
## <a name='subsection4'></a>optional dependencies
packages that add functionality but aren't strictly required
- __punk::ansi__
\- recommended for class::textinfo __chunk\_boundary\_display__
- __punk::char__
\- recommended for class::textinfo __chunk\_boundary\_display__
- __overtype__
\- recommended for class::textinfo __chunk\_boundary\_display__
# <a name='section3'></a>API # <a name='section3'></a>API
## <a name='subsection4'></a>Namespace punk::fileline::class ## <a name='subsection5'></a>Namespace punk::fileline::class
class definitions class definitions
@ -155,15 +180,18 @@ class definitions
Number of bytes/characters in the raw data of the file Number of bytes/characters in the raw data of the file
- <a name='4'></a>class::textinfo __linecount__ - <a name='4'></a>class::textinfo __chunk\_boundary\_display__
Number of lines in the raw data of the file, counted as per the policy Returns a string displaying the boundaries at chunksize bytes between
in effect chunkstart and chunkend
Defaults to using ansi colour if punk::ansi module is available\. Use
\-ansi 0 to disable colour
- <a name='5'></a>class::textinfo __regenerate\_lines__ - <a name='5'></a>class::textinfo __linecount__
generate a list of lines from the stored raw data chunk and keep a map Number of lines in the raw data of the file, counted as per the policy
of line\-endings indexed by lineindex in effect
- <a name='6'></a>class::textinfo __line__ *lineindex* - <a name='6'></a>class::textinfo __line__ *lineindex*
@ -243,17 +271,22 @@ class definitions
The 'payload' value is the same as is returned from the The 'payload' value is the same as is returned from the
__linepayload__ method\. __linepayload__ method\.
- <a name='10'></a>class::textinfo __linerange\_to\_chunkrange__ *startidx* *endidx* - <a name='10'></a>class::textinfo __lineinfolist__ *startidx* *endidx*
Returns list of lineinfo dicts for each line in line index range
startidx to endidx
- <a name='11'></a>class::textinfo __linerange\_to\_chunk__ *startidx* *endidx* - <a name='11'></a>class::textinfo __linerange\_to\_chunkrange__ *startidx* *endidx*
- <a name='12'></a>class::textinfo __lines__ *startidx* *endidx* - <a name='12'></a>class::textinfo __linerange\_to\_chunk__ *startidx* *endidx*
- <a name='13'></a>class::textinfo __linepayloads__ *startidx* *endidx* - <a name='13'></a>class::textinfo __lines__ *startidx* *endidx*
- <a name='14'></a>class::textinfo __chunkrange\_to\_linerange__ *chunkstart* *chunkend* - <a name='14'></a>class::textinfo __linepayloads__ *startidx* *endidx*
- <a name='15'></a>class::textinfo __chunkrange\_to\_lineinfolist__ *chunkstart* *chunkend* ?option value\.\.\.? - <a name='15'></a>class::textinfo __chunkrange\_to\_linerange__ *chunkstart* *chunkend*
- <a name='16'></a>class::textinfo __chunkrange\_to\_lineinfolist__ *chunkstart* *chunkend* ?option value\.\.\.?
Return a list of dicts each with structure like the result of the Return a list of dicts each with structure like the result of the
__lineinfo__ method \- but possibly with extra keys for truncation __lineinfo__ method \- but possibly with extra keys for truncation
@ -270,7 +303,7 @@ class definitions
method \- and will not be reflected in __lineinfo__ queries to the method \- and will not be reflected in __lineinfo__ queries to the
main chunk\. main chunk\.
- <a name='16'></a>class::textinfo __numeric\_linerange__ *startidx* *endidx* - <a name='17'></a>class::textinfo __numeric\_linerange__ *startidx* *endidx*
A helper to return any Tcl\-style end end\-x values given to startidx or A helper to return any Tcl\-style end end\-x values given to startidx or
endidx; converted to their specific values based on the current state endidx; converted to their specific values based on the current state
@ -279,13 +312,13 @@ class definitions
This is used internally by API functions such as __line__ to enable This is used internally by API functions such as __line__ to enable
it to accept more expressive indices it to accept more expressive indices
- <a name='17'></a>class::textinfo __numeric\_chunkrange__ *startidx* *endidx* - <a name='18'></a>class::textinfo __numeric\_chunkrange__ *startidx* *endidx*
A helper to return any Tcl\-style end end\-x entries supplied to startidx A helper to return any Tcl\-style end end\-x entries supplied to startidx
or endidx; converted to their specific values based on the current or endidx; converted to their specific values based on the current
state of the underlying chunk data state of the underlying chunk data
- <a name='18'></a>class::textinfo __normalize\_indices__ *startidx* *endidx* *max* - <a name='19'></a>class::textinfo __normalize\_indices__ *startidx* *endidx* *max*
A utility to convert some of the of Tcl\-style list\-index expressions A utility to convert some of the of Tcl\-style list\-index expressions
such as end, end\-1 etc to valid indices in the range 0 to the supplied such as end, end\-1 etc to valid indices in the range 0 to the supplied
@ -298,13 +331,25 @@ class definitions
Unlike Tcl's index expressions \- we raise an error if the calculated Unlike Tcl's index expressions \- we raise an error if the calculated
index is out of bounds 0 to max index is out of bounds 0 to max
## <a name='subsection5'></a>Namespace punk::fileline - <a name='20'></a>class::textinfo __regenerate\_lines__
generate a list of lines from the current state of the stored raw data
chunk and keep a map of line\-endings indexed by lineindex
This is called automatically by the Constructor during object creation
It is exposed in the API experimentally \- as chunk and line
manipulation functions are considered\.
TODO \- review whether such manual control will be necessary/desirable
## <a name='subsection6'></a>Namespace punk::fileline
Core API functions for punk::fileline Core API functions for punk::fileline
## <a name='subsection6'></a>Namespace punk::fileline::lib ## <a name='subsection7'></a>Namespace punk::fileline::lib
- <a name='19'></a>__lib::range\_spans\_chunk\_boundaries__ *start* *end* *chunksize* - <a name='21'></a>__lib::range\_spans\_chunk\_boundaries__ *start* *end* *chunksize*
Takes start and end offset, generally representing bytes or character Takes start and end offset, generally representing bytes or character
indices, and computes a list of boundaries at multiples of the chunksize indices, and computes a list of boundaries at multiples of the chunksize
@ -339,10 +384,23 @@ Core API functions for punk::fileline
# <a name='section4'></a>Internal # <a name='section4'></a>Internal
## <a name='subsection7'></a>Namespace punk::fileline::system ## <a name='subsection8'></a>Namespace punk::fileline::system
Internal functions that are not part of the API Internal functions that are not part of the API
## <a name='subsection9'></a>Namespace punk::fileline::ansi
These are ansi functions imported from punk::ansi \- or no\-ops if that package is
unavailable
See __punk::ansi__ for documentation
- <a name='22'></a>__ansi::a__
- <a name='23'></a>__ansi::a\+__
- <a name='24'></a>__ansi::stripansi__
# <a name='keywords'></a>KEYWORDS # <a name='keywords'></a>KEYWORDS
[file](\.\./\.\./\.\./index\.md\#file), [module](\.\./\.\./\.\./index\.md\#module), [file](\.\./\.\./\.\./index\.md\#file), [module](\.\./\.\./\.\./index\.md\#module),

106
src/embedded/www/doc/files/punk/_module_fileline-0.1.0.tm.html

@ -117,18 +117,20 @@
<li class="doctools_subsection"><a href="#subsection1">Concepts</a></li> <li class="doctools_subsection"><a href="#subsection1">Concepts</a></li>
<li class="doctools_subsection"><a href="#subsection2">Notes</a></li> <li class="doctools_subsection"><a href="#subsection2">Notes</a></li>
<li class="doctools_subsection"><a href="#subsection3">dependencies</a></li> <li class="doctools_subsection"><a href="#subsection3">dependencies</a></li>
<li class="doctools_subsection"><a href="#subsection4">optional dependencies</a></li>
</ul> </ul>
</li> </li>
<li class="doctools_section"><a href="#section3">API</a> <li class="doctools_section"><a href="#section3">API</a>
<ul> <ul>
<li class="doctools_subsection"><a href="#subsection4">Namespace punk::fileline::class</a></li> <li class="doctools_subsection"><a href="#subsection5">Namespace punk::fileline::class</a></li>
<li class="doctools_subsection"><a href="#subsection5">Namespace punk::fileline</a></li> <li class="doctools_subsection"><a href="#subsection6">Namespace punk::fileline</a></li>
<li class="doctools_subsection"><a href="#subsection6">Namespace punk::fileline::lib</a></li> <li class="doctools_subsection"><a href="#subsection7">Namespace punk::fileline::lib</a></li>
</ul> </ul>
</li> </li>
<li class="doctools_section"><a href="#section4">Internal</a> <li class="doctools_section"><a href="#section4">Internal</a>
<ul> <ul>
<li class="doctools_subsection"><a href="#subsection7">Namespace punk::fileline::system</a></li> <li class="doctools_subsection"><a href="#subsection8">Namespace punk::fileline::system</a></li>
<li class="doctools_subsection"><a href="#subsection9">Namespace punk::fileline::ansi</a></li>
</ul> </ul>
</li> </li>
<li class="doctools_section"><a href="#keywords">Keywords</a></li> <li class="doctools_section"><a href="#keywords">Keywords</a></li>
@ -144,22 +146,27 @@
<li><a href="#1">class::textinfo <b class="method">constructor</b> <i class="arg">datachunk</i> <span class="opt">?option value...?</span></a></li> <li><a href="#1">class::textinfo <b class="method">constructor</b> <i class="arg">datachunk</i> <span class="opt">?option value...?</span></a></li>
<li><a href="#2">class::textinfo <b class="method">chunk</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></li> <li><a href="#2">class::textinfo <b class="method">chunk</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></li>
<li><a href="#3">class::textinfo <b class="method">chunklen</b></a></li> <li><a href="#3">class::textinfo <b class="method">chunklen</b></a></li>
<li><a href="#4">class::textinfo <b class="method">linecount</b></a></li> <li><a href="#4">class::textinfo <b class="method">chunk_boundary_display</b></a></li>
<li><a href="#5">class::textinfo <b class="method">regenerate_lines</b></a></li> <li><a href="#5">class::textinfo <b class="method">linecount</b></a></li>
<li><a href="#6">class::textinfo <b class="method">line</b> <i class="arg">lineindex</i></a></li> <li><a href="#6">class::textinfo <b class="method">line</b> <i class="arg">lineindex</i></a></li>
<li><a href="#7">class::textinfo <b class="method">linepayload</b> <i class="arg">lineindex</i></a></li> <li><a href="#7">class::textinfo <b class="method">linepayload</b> <i class="arg">lineindex</i></a></li>
<li><a href="#8">class::textinfo <b class="method">linemeta</b> <i class="arg">lineindex</i></a></li> <li><a href="#8">class::textinfo <b class="method">linemeta</b> <i class="arg">lineindex</i></a></li>
<li><a href="#9">class::textinfo <b class="method">lineinfo</b> <i class="arg">lineindex</i></a></li> <li><a href="#9">class::textinfo <b class="method">lineinfo</b> <i class="arg">lineindex</i></a></li>
<li><a href="#10">class::textinfo <b class="method">linerange_to_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#10">class::textinfo <b class="method">lineinfolist</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#11">class::textinfo <b class="method">linerange_to_chunk</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#11">class::textinfo <b class="method">linerange_to_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#12">class::textinfo <b class="method">lines</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#12">class::textinfo <b class="method">linerange_to_chunk</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#13">class::textinfo <b class="method">linepayloads</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#13">class::textinfo <b class="method">lines</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#14">class::textinfo <b class="method">chunkrange_to_linerange</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></li> <li><a href="#14">class::textinfo <b class="method">linepayloads</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#15">class::textinfo <b class="method">chunkrange_to_lineinfolist</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i> <span class="opt">?option value...?</span></a></li> <li><a href="#15">class::textinfo <b class="method">chunkrange_to_linerange</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></li>
<li><a href="#16">class::textinfo <b class="method">numeric_linerange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#16">class::textinfo <b class="method">chunkrange_to_lineinfolist</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i> <span class="opt">?option value...?</span></a></li>
<li><a href="#17">class::textinfo <b class="method">numeric_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li> <li><a href="#17">class::textinfo <b class="method">numeric_linerange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#18">class::textinfo <b class="method">normalize_indices</b> <i class="arg">startidx</i> <i class="arg">endidx</i> <i class="arg">max</i></a></li> <li><a href="#18">class::textinfo <b class="method">numeric_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></li>
<li><a href="#19"><b class="function">lib::range_spans_chunk_boundaries</b> <i class="arg">start</i> <i class="arg">end</i> <i class="arg">chunksize</i></a></li> <li><a href="#19">class::textinfo <b class="method">normalize_indices</b> <i class="arg">startidx</i> <i class="arg">endidx</i> <i class="arg">max</i></a></li>
<li><a href="#20">class::textinfo <b class="method">regenerate_lines</b></a></li>
<li><a href="#21"><b class="function">lib::range_spans_chunk_boundaries</b> <i class="arg">start</i> <i class="arg">end</i> <i class="arg">chunksize</i></a></li>
<li><a href="#22"><b class="function">ansi::a</b></a></li>
<li><a href="#23"><b class="function">ansi::a+</b></a></li>
<li><a href="#24"><b class="function">ansi::stripansi</b></a></li>
</ul> </ul>
</div> </div>
</div> </div>
@ -188,14 +195,25 @@
<p>CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module.</p> <p>CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module.</p>
</div> </div>
<div id="subsection3" class="doctools_subsection"><h3><a name="subsection3">dependencies</a></h3> <div id="subsection3" class="doctools_subsection"><h3><a name="subsection3">dependencies</a></h3>
<p>packages used by punk::fileline</p> <p>packages needed by punk::fileline</p>
<ul class="doctools_itemized"> <ul class="doctools_itemized">
<li><p><b class="package">Tcl 8.6</b></p></li> <li><p><b class="package">Tcl 8.6</b></p></li>
</ul> </ul>
</div> </div>
<div id="subsection4" class="doctools_subsection"><h3><a name="subsection4">optional dependencies</a></h3>
<p>packages that add functionality but aren't strictly required</p>
<ul class="doctools_itemized">
<li><p><b class="package">punk::ansi</b></p>
<p>- recommended for class::textinfo <b class="method">chunk_boundary_display</b></p></li>
<li><p><b class="package">punk::char</b></p>
<p>- recommended for class::textinfo <b class="method">chunk_boundary_display</b></p></li>
<li><p><b class="package">overtype</b></p>
<p>- recommended for class::textinfo <b class="method">chunk_boundary_display</b></p></li>
</ul>
</div>
</div> </div>
<div id="section3" class="doctools_section"><h2><a name="section3">API</a></h2> <div id="section3" class="doctools_section"><h2><a name="section3">API</a></h2>
<div id="subsection4" class="doctools_subsection"><h3><a name="subsection4">Namespace punk::fileline::class</a></h3> <div id="subsection5" class="doctools_subsection"><h3><a name="subsection5">Namespace punk::fileline::class</a></h3>
<p>class definitions</p> <p>class definitions</p>
<ol class="doctools_enumerated"> <ol class="doctools_enumerated">
<li><p>CLASS <b class="class">textinfo</b></p> <li><p>CLASS <b class="class">textinfo</b></p>
@ -217,10 +235,11 @@ or
<p>objName chunk 0 end</p></dd> <p>objName chunk 0 end</p></dd>
<dt><a name="3">class::textinfo <b class="method">chunklen</b></a></dt> <dt><a name="3">class::textinfo <b class="method">chunklen</b></a></dt>
<dd><p>Number of bytes/characters in the raw data of the file</p></dd> <dd><p>Number of bytes/characters in the raw data of the file</p></dd>
<dt><a name="4">class::textinfo <b class="method">linecount</b></a></dt> <dt><a name="4">class::textinfo <b class="method">chunk_boundary_display</b></a></dt>
<dd><p>Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend</p>
<p>Defaults to using ansi colour if punk::ansi module is available. Use -ansi 0 to disable colour</p></dd>
<dt><a name="5">class::textinfo <b class="method">linecount</b></a></dt>
<dd><p>Number of lines in the raw data of the file, counted as per the policy in effect</p></dd> <dd><p>Number of lines in the raw data of the file, counted as per the policy in effect</p></dd>
<dt><a name="5">class::textinfo <b class="method">regenerate_lines</b></a></dt>
<dd><p>generate a list of lines from the stored raw data chunk and keep a map of line-endings indexed by lineindex</p></dd>
<dt><a name="6">class::textinfo <b class="method">line</b> <i class="arg">lineindex</i></a></dt> <dt><a name="6">class::textinfo <b class="method">line</b> <i class="arg">lineindex</i></a></dt>
<dd><p>Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata</p> <dd><p>Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata</p>
<p>A 'line' may be returned without a line-ending if the unerlying chunk had trailing data without a line-ending (or the chunk was loaded under a non-standard -policy setting)</p> <p>A 'line' may be returned without a line-ending if the unerlying chunk had trailing data without a line-ending (or the chunk was loaded under a non-standard -policy setting)</p>
@ -252,44 +271,51 @@ or
<dd><p>Return a dict of the metadata and text for the line indicated by the zero-based lineindex</p> <dd><p>Return a dict of the metadata and text for the line indicated by the zero-based lineindex</p>
<p>This returns the same info as the <b class="method">linemeta</b> with an added key of 'payload' which is the text of the line without line-ending.</p> <p>This returns the same info as the <b class="method">linemeta</b> with an added key of 'payload' which is the text of the line without line-ending.</p>
<p>The 'payload' value is the same as is returned from the <b class="method">linepayload</b> method.</p></dd> <p>The 'payload' value is the same as is returned from the <b class="method">linepayload</b> method.</p></dd>
<dt><a name="10">class::textinfo <b class="method">linerange_to_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="10">class::textinfo <b class="method">lineinfolist</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd><p>Returns list of lineinfo dicts for each line in line index range startidx to endidx</p></dd>
<dt><a name="11">class::textinfo <b class="method">linerange_to_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd></dd> <dd></dd>
<dt><a name="11">class::textinfo <b class="method">linerange_to_chunk</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="12">class::textinfo <b class="method">linerange_to_chunk</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd></dd> <dd></dd>
<dt><a name="12">class::textinfo <b class="method">lines</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="13">class::textinfo <b class="method">lines</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd></dd> <dd></dd>
<dt><a name="13">class::textinfo <b class="method">linepayloads</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="14">class::textinfo <b class="method">linepayloads</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd></dd> <dd></dd>
<dt><a name="14">class::textinfo <b class="method">chunkrange_to_linerange</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></dt> <dt><a name="15">class::textinfo <b class="method">chunkrange_to_linerange</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i></a></dt>
<dd></dd> <dd></dd>
<dt><a name="15">class::textinfo <b class="method">chunkrange_to_lineinfolist</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i> <span class="opt">?option value...?</span></a></dt> <dt><a name="16">class::textinfo <b class="method">chunkrange_to_lineinfolist</b> <i class="arg">chunkstart</i> <i class="arg">chunkend</i> <span class="opt">?option value...?</span></a></dt>
<dd><p>Return a list of dicts each with structure like the result of the <b class="method">lineinfo</b> method - but possibly with extra keys for truncation information if -show_truncated 1 is supplied</p> <dd><p>Return a list of dicts each with structure like the result of the <b class="method">lineinfo</b> method - but possibly with extra keys for truncation information if -show_truncated 1 is supplied</p>
<p>The truncation key in a lineinfo dict may be returned for first and/or last line in the resulting list.</p> <p>The truncation key in a lineinfo dict may be returned for first and/or last line in the resulting list.</p>
<p>truncation shows the shortened (missing bytes on left and/or right side) part of the entire line (potentially including line-ending or even partial line-ending)</p> <p>truncation shows the shortened (missing bytes on left and/or right side) part of the entire line (potentially including line-ending or even partial line-ending)</p>
<p>Note that this truncation info is only in the return value of this method - and will not be reflected in <b class="method">lineinfo</b> queries to the main chunk.</p></dd> <p>Note that this truncation info is only in the return value of this method - and will not be reflected in <b class="method">lineinfo</b> queries to the main chunk.</p></dd>
<dt><a name="16">class::textinfo <b class="method">numeric_linerange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="17">class::textinfo <b class="method">numeric_linerange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd><p>A helper to return any Tcl-style end end-x values given to startidx or endidx; converted to their specific values based on the current state of the underlying line data</p> <dd><p>A helper to return any Tcl-style end end-x values given to startidx or endidx; converted to their specific values based on the current state of the underlying line data</p>
<p>This is used internally by API functions such as <b class="method">line</b> to enable it to accept more expressive indices</p></dd> <p>This is used internally by API functions such as <b class="method">line</b> to enable it to accept more expressive indices</p></dd>
<dt><a name="17">class::textinfo <b class="method">numeric_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt> <dt><a name="18">class::textinfo <b class="method">numeric_chunkrange</b> <i class="arg">startidx</i> <i class="arg">endidx</i></a></dt>
<dd><p>A helper to return any Tcl-style end end-x entries supplied to startidx or endidx; converted to their specific values based on the current state of the underlying chunk data</p></dd> <dd><p>A helper to return any Tcl-style end end-x entries supplied to startidx or endidx; converted to their specific values based on the current state of the underlying chunk data</p></dd>
<dt><a name="18">class::textinfo <b class="method">normalize_indices</b> <i class="arg">startidx</i> <i class="arg">endidx</i> <i class="arg">max</i></a></dt> <dt><a name="19">class::textinfo <b class="method">normalize_indices</b> <i class="arg">startidx</i> <i class="arg">endidx</i> <i class="arg">max</i></a></dt>
<dd><p>A utility to convert some of the of Tcl-style list-index expressions such as end, end-1 etc to valid indices in the range 0 to the supplied max</p> <dd><p>A utility to convert some of the of Tcl-style list-index expressions such as end, end-1 etc to valid indices in the range 0 to the supplied max</p>
<p>Basic addition and subtraction expressions such as 4-1 5+2 are accepted</p> <p>Basic addition and subtraction expressions such as 4-1 5+2 are accepted</p>
<p>startidx higher than endidx is allowed</p> <p>startidx higher than endidx is allowed</p>
<p>Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max</p></dd> <p>Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max</p></dd>
<dt><a name="20">class::textinfo <b class="method">regenerate_lines</b></a></dt>
<dd><p>generate a list of lines from the current state of the stored raw data chunk and keep a map of line-endings indexed by lineindex</p>
<p>This is called automatically by the Constructor during object creation</p>
<p>It is exposed in the API experimentally - as chunk and line manipulation functions are considered.</p>
<p>TODO - review whether such manual control will be necessary/desirable</p></dd>
</dl> </dl>
</li> </li>
</ol> </ol>
</div> </div>
<div id="subsection5" class="doctools_subsection"><h3><a name="subsection5">Namespace punk::fileline</a></h3> <div id="subsection6" class="doctools_subsection"><h3><a name="subsection6">Namespace punk::fileline</a></h3>
<p>Core API functions for punk::fileline</p> <p>Core API functions for punk::fileline</p>
<dl class="doctools_definitions"> <dl class="doctools_definitions">
</dl> </dl>
</div> </div>
<div id="subsection6" class="doctools_subsection"><h3><a name="subsection6">Namespace punk::fileline::lib</a></h3> <div id="subsection7" class="doctools_subsection"><h3><a name="subsection7">Namespace punk::fileline::lib</a></h3>
<p>Secondary functions that are part of the API</p> <p>Secondary functions that are part of the API</p>
<dl class="doctools_definitions"> <dl class="doctools_definitions">
<dt><a name="19"><b class="function">lib::range_spans_chunk_boundaries</b> <i class="arg">start</i> <i class="arg">end</i> <i class="arg">chunksize</i></a></dt> <dt><a name="21"><b class="function">lib::range_spans_chunk_boundaries</b> <i class="arg">start</i> <i class="arg">end</i> <i class="arg">chunksize</i></a></dt>
<dd><p>Takes start and end offset, generally representing bytes or character indices, and computes a list of boundaries at multiples of the chunksize that are spanned by the start and end range.</p> <dd><p>Takes start and end offset, generally representing bytes or character indices, and computes a list of boundaries at multiples of the chunksize that are spanned by the start and end range.</p>
<dl class="doctools_arguments"> <dl class="doctools_arguments">
@ -313,9 +339,21 @@ or
</div> </div>
</div> </div>
<div id="section4" class="doctools_section"><h2><a name="section4">Internal</a></h2> <div id="section4" class="doctools_section"><h2><a name="section4">Internal</a></h2>
<div id="subsection7" class="doctools_subsection"><h3><a name="subsection7">Namespace punk::fileline::system</a></h3> <div id="subsection8" class="doctools_subsection"><h3><a name="subsection8">Namespace punk::fileline::system</a></h3>
<p>Internal functions that are not part of the API</p> <p>Internal functions that are not part of the API</p>
</div> </div>
<div id="subsection9" class="doctools_subsection"><h3><a name="subsection9">Namespace punk::fileline::ansi</a></h3>
<p>These are ansi functions imported from punk::ansi - or no-ops if that package is unavailable</p>
<p>See <b class="package">punk::ansi</b> for documentation</p>
<dl class="doctools_definitions">
<dt><a name="22"><b class="function">ansi::a</b></a></dt>
<dd></dd>
<dt><a name="23"><b class="function">ansi::a+</b></a></dt>
<dd></dd>
<dt><a name="24"><b class="function">ansi::stripansi</b></a></dt>
<dd></dd>
</dl>
</div>
</div> </div>
<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2> <div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2>
<p><a href="../../../index.html#file">file</a>, <a href="../../../index.html#module">module</a>, <a href="../../../index.html#parse">parse</a>, <a href="../../../index.html#text">text</a></p> <p><a href="../../../index.html#file">file</a>, <a href="../../../index.html#module">module</a>, <a href="../../../index.html#parse">parse</a>, <a href="../../../index.html#text">text</a></p>

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

@ -325,7 +325,12 @@ namespace eval punk::ansi {
set res [list] set res [list]
foreach i [split $code ";"] { foreach i [split $code ";"] {
set ix [lsearch -exact $SGR_map $i] set ix [lsearch -exact $SGR_map $i]
if {$ix>-1} {lappend res [lindex $SGR_map [incr ix -1]]} if {[string is digit -strict $code]} {
if {$ix>-1} {lappend res [lindex $SGR_map [incr ix -1]]}
} else {
#reverse lookup code from name
if {$ix>-1} {lappend res [lindex $SGR_map [incr ix]]}
}
} }
set res set res
} }

537
src/modules/punk/fileline-999999.0a1.0.tm

@ -55,19 +55,38 @@
#*** !doctools #*** !doctools
#[subsection dependencies] #[subsection dependencies]
#[para] packages used by punk::fileline #[para] packages needed by punk::fileline
#[list_begin itemized] #[list_begin itemized]
package require Tcl 8.6 package require Tcl 8.6
#*** !doctools
#[item] [package {Tcl 8.6}]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools #*** !doctools
#[item] [package {Tcl 8.6}] #[list_end] [comment {- end dependencies list -}]
#*** !doctools
#[subsection {optional dependencies}]
#[para] packages that add functionality but aren't strictly required
#[list_begin itemized]
#*** !doctools
#[item] [package {punk::ansi}]
#[para] - recommended for class::textinfo [method chunk_boundary_display]
#[item] [package {punk::char}]
#[para] - recommended for class::textinfo [method chunk_boundary_display]
#[item] [package {overtype}]
#[para] - recommended for class::textinfo [method chunk_boundary_display]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools #*** !doctools
#[list_end] #[list_end] [comment {- end optional dependencies list -}]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -130,6 +149,15 @@ namespace eval punk::fileline::class {
# set chunkdata [lb]fileutil::cat <filename> -translation binary[rb] # set chunkdata [lb]fileutil::cat <filename> -translation binary[rb]
#[example_end] #[example_end]
#[para] when loading the data #[para] when loading the data
namespace eval [namespace current] {
set nspath [namespace path]
foreach p [list ::punk::fileline ::punk::fileline::ansi] {
if {$p ni $nspath} {
lappend nspath $p
}
}
namespace path $nspath
}
set o_chunk $datachunk set o_chunk $datachunk
set crlf_lf_placeholders [list \uFFFF \uFFFE] ;#defaults - if already exist in file - error out with message set crlf_lf_placeholders [list \uFFFF \uFFFE] ;#defaults - if already exist in file - error out with message
set defaults [dict create\ set defaults [dict create\
@ -193,6 +221,307 @@ namespace eval punk::fileline::class {
#[para] Number of bytes/characters in the raw data of the file #[para] Number of bytes/characters in the raw data of the file
return [string length $o_chunk] return [string length $o_chunk]
} }
method chunk_boundary_display {chunkstart chunkend chunksize args} {
#*** !doctools
#[call class::textinfo [method chunk_boundary_display]]
#[para]Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend
#[para]Defaults to using ansi colour if punk::ansi module is available. Use -ansi 0 to disable colour
set defaults [dict create\
-ansi $::punk::fileline::ansi::enabled\
-offset 0\
-displaybytes 200\
-truncatedmark "..."\
-completemark "---"\
-moremark " + "\
-continuemark " > "\
-linemaxwidth 100\
-linebase 0\
-limit -1\
-boundaries {}\
-showconfig 0\
-boundaryheader {Boundary %i% at %b%}\
]
set known_opts [dict keys $defaults]
foreach {k v} $args {
if {$k ni $known_opts} {
error "[self]::chunk_boundary error: unknown option '$k'. Known options: $known_opts"
}
}
set opts [dict merge $defaults $args]
# -- --- --- --- --- ---
set opt_ansi [dict get $opts -ansi]
set opt_offset [dict get $opts -offset]
set opt_displaybytes [dict get $opts -displaybytes]
set opt_tmark [dict get $opts -truncatedmark]
set opt_cmark [dict get $opts -completemark]
set opt_linemax [dict get $opts -linemaxwidth]
set opt_linebase [dict get $opts -linebase]
set opt_linebase [string map [list _ ""] $opt_linebase]
set opt_limit [dict get $opts -limit] ;#limit number of boundaries to display
set opt_boundaries [dict get $opts -boundaries] ;#use pre-calculated boundaries if supplied
set opt_showconfig [dict get $opts -showconfig]
set opt_boundaryheader [dict get $opts -boundaryheader]
# -- --- --- --- --- ---
package require overtype
# will require punk::char and punk::ansi
if {"::punk::fileline::ansi::stripansi" ne [info commands ::punk::fileline::ansi::stripansi]} {
namespace eval ::punk::fileline::ansi {
namespace import ::punk::ansi::*
}
}
#This mechanism for enabling/disabling ansi is a bit clumsy - prone to errors with regard to keeping in sync with any api changes in punk ansi
#It's done here to allow this to be used without the full set of punk modules and/or shell - REVIEW
#risk of failing to reset on error
set pre_ansi_enabled $::punk::fileline::ansi::enabled
if {$opt_ansi} {
set ::punk::fileline::ansi::enabled 1
} else {
set ::punk::fileline::ansi::enabled 0
}
if {"::punk::fileline::stripansi" ne [info commands ::punk::fileline::stripansi]} {
proc ::punk::fileline::a {args} {
if {$::punk::fileline::ansi::enabled} {
tailcall ::punk::fileline::ansi::a {*}$args
} else {
return ""
}
}
proc ::punk::fileline::a+ {args} {
if {$::punk::fileline::ansi::enabled} {
tailcall ::punk::fileline::ansi::a+ {*}$args
} else {
return ""
}
}
proc ::punk::fileline::stripansi {str} {
if {$::punk::fileline::ansi::enabled} {
tailcall ::punk::fileline::ansi::stripansi $str
} else {
return $str
}
}
}
set maxline [lindex [my chunkrange_to_linerange $chunkend $chunkend] 0]
set minline [lindex [my chunkrange_to_linerange $chunkstart $chunkstart] 0]
#suport simple end+-int (+-)start(+-)int to set linebase to line corresponding to chunkstart or chunkend
#also simple int+int and int-int - nothing more complicated (similar to Tcl lrange etc in that regard)
#commonly this will be something like -start or -end
if {![string is integer -strict $opt_linebase]} {
set sign ""
set errunrecognised "unrecognised -linebase value '$opt_linebase'. Expected positive or negative integer or -start -start-int -start+int -end -end-int -end+int or -eof (where leading - is optional but probably desirable) "
if {[string index $opt_linebase 0] eq "-"} {
set sign -
set tail [string range $opt_linebase 1 end]
} else {
set tail [string trimleft $opt_linebase +];#ignore +
}
if {[string match eof* $tail]} {
set endmath [string range $tail 3 end]
#todo endmath?
if {$tail eq "eof"} {
set lastline [lindex [my chunkrange_to_linerange end end] 0]
set linebase ${sign}$lastline
} else {
error $errunrecognised
}
} elseif {[string match end* $tail]} {
set endmath [string range $tail 3 end]
if {[string length $endmath]} {
set op [string index $endmath 0]
if {$op in {+ -}} {
set operand [string range $endmath 1 end]
if {[string is integer -strict $operand]} {
if {$op eq "+"} {
set linebase [expr {$maxline + $operand}]
} else {
set linebase [expr {$maxline - $operand}]
}
} else {
error $errunrecognised
}
} else {
error $errunrecognised
}
} else {
set linebase $maxline
}
set linebase ${sign}$linebase
} elseif {[string match start* $tail]} {
set endmath [string range $tail 5 end]
if {[string length $endmath]} {
set op [string index $endmath 0]
if {$op in {+ -}} {
set operand [string range $endmath 1 end]
if {[string is integer -strict $operand]} {
if {$op eq "+"} {
set linebase [expr {$minline + $operand}]
} else {
set linebase [expr {$minline - $operand}]
}
} else {
error $errunrecognised
}
} else {
error $errunrecognised
}
} else {
set linebase $minline
}
set linebase ${sign}$linebase
} elseif {[string match *-* $tail]} {
set extras [lassign [split $tail -] int1 int2]
if {[llength $extras]} {
error $errunrecognised
}
if {![string is integer -strict $int1] || ![string is integer -strict $int2]} {
error $errunrecognised
}
set linebase [expr {$int1 - $int2}]
set linebase ${sign}$linebase
} elseif {[string match *+* $tail]} {
set extras [lassign [split $tail +] int1 int2]
if {[llength $extras]} {
error $errunrecognised
}
if {![string is integer -strict $int1] || ![string is integer -strict $int2]} {
error $errunrecognised
}
set linebase [expr {$int1 + $int2}]
set linebase ${sign}$linebase
} else {
error $errunrecognised
}
} else {
set linebase $opt_linebase
}
lassign [my numeric_chunkrange $chunkstart $chunkend] chunkstart chunkend
if {![llength $opt_boundaries]} {
set binfo [lib::range_spans_chunk_boundaries $chunkstart $chunkend $chunksize -offset $opt_offset]
set boundaries [dict get $binfo boundaries]
} else {
set boundaries [list]
foreach b $opt_boundaries {
if {$chunkstart <= $b && $chunkend >= $b} {
lappend boundaries [expr {$b + $opt_offset}]
}
}
}
if {![llength $boundaries]} {
return "No boundaries found between $chunkstart and $chunkend for chunksize $chunksize (when offset $opt_offset)"
}
if {$opt_showconfig} {
set result "chunk range $chunkstart $chunkend line range $minline $maxline linebase $linebase limit $opt_limit\n"
} else {
set result ""
}
set pre_bytes [expr {$opt_displaybytes /2}]
set post_bytes $pre_bytes
set max_bytes [expr {[my chunklen] -1}]
if {$opt_limit > 0} {
set boundaries [lrange $boundaries[unset boundaries] 0 $opt_limit-1]
}
set i 0
foreach b $boundaries {
if {$opt_boundaryheader ne ""} {
set j [expr {$i+1}]
append result [string map [list %b% $b %i% $i %j% $j] $opt_boundaryheader] \n
}
set low [expr {max(($b - $pre_bytes),0)}]
set high [expr {min(($b + $post_bytes),$max_bytes)}]
set lineinfolist [my chunkrange_to_lineinfolist $low $high -show_truncated 1]
set le_map [list \r\n <crlf> \r <cr> \n <lf>]
set result_list [list]
foreach lineinfo $lineinfolist {
set lineidx [dict get $lineinfo lineindex]
set linenum [expr {$lineidx + $linebase}]
set s [dict get $lineinfo start]
set e [dict get $lineinfo end]
set boundarymarker ""
set displayidx ""
set linenum_display $linenum
if {$s <= $b && $e >= $b} {
set idx [expr {$b - $s}] ;#index into whole position in whole line - not so useful if we're viewing a small section of a line
set char [string index [my line $lineidx] $idx]
set char_display [string map [list \r <CR> \n <LF>] $char]
if {[dict get $lineinfo is_truncated]} {
set tside [dict get $lineinfo truncatedside]
set truncated [dict get $lineinfo truncated]
set tlen [string length $truncated]
if {"left" in $tside} {
set tleft [dict get $lineinfo truncatedleft]
set tleftlen [string length $tleft]
set displayidx [expr {$idx - $tleftlen}]
} elseif {"right" in $tside} {
set displayidx $idx
}
} else {
set displayidx $idx
}
set boundarymarker "'[a+ green bold]$char_display[a]'@$displayidx"
set linenum_display ${linenum_display},$idx
}
set lhs_status $opt_cmark ;#default
set rhs_status $opt_cmark ;#default
if {[dict get $lineinfo is_truncated]} {
set line [dict get $lineinfo truncated]
set tside [dict get $lineinfo truncatedside]
if {"left" in $tside && "right" in $tside } {
set lhs_status $opt_tmark
set rhs_status $opt_tmark
} elseif {"left" in $tside} {
set lhs_status $opt_tmark
} elseif {"right" in $tside} {
set rhs_status $opt_tmark
}
} else {
set line [my line $lineidx]
}
if {$displayidx ne ""} {
set line [string replace $line $displayidx $displayidx [a+ White green bold]$char_display[a]]
}
set displayline [string map $le_map $line]
lappend result_list [list $linenum_display $boundarymarker $lhs_status $displayline $rhs_status]
}
set title_linenum "LNUM"
set linenums [lsearch -index 0 -all -inline -subindices $result_list *]
set markers [lsearch -index 1 -all -inline -subindices $result_list *]
set lines [lsearch -index 3 -all -inline -subindices $result_list *]
set title_marker ""
set title_line "Line"
#todo - use punk::char for unicode support of wide chars etc?
set widest_linenum [tcl::mathfunc::max {*}[lmap v [concat [list $title_linenum] $linenums] {string length $v}]]
set widest_marker [tcl::mathfunc::max {*}[lmap v [concat [list $title_marker] $markers] {string length [stripansi $v]}]]
set widest_status [expr {max([string length $opt_cmark], [string length $opt_tmark])}]
set widest_line [tcl::mathfunc::max {*}[lmap v [concat [list $title_line] $lines] {string length $v}]]
foreach row $result_list {
lassign $row linenum marker lhs_status line rhs_status
append result [format " %-*s " $widest_linenum $linenum]
append result [format " %-*s " $widest_marker $marker]
append result [format " %-*s " $widest_status $lhs_status]
append result [format " %-*s " $widest_line $line]
append result [format " %-*s " $widest_status $rhs_status] \n
}
incr i
}
set ::punk::fileline::ansi::enabled $pre_ansi_enabled
return $result
}
method linecount {} { method linecount {} {
#*** !doctools #*** !doctools
#[call class::textinfo [method linecount]] #[call class::textinfo [method linecount]]
@ -369,6 +698,15 @@ namespace eval punk::fileline::class {
########################### ###########################
set first [dict create lineindex $start_lineindex {*}[dict get $o_linemap $start_lineindex] payload [lindex $o_payloadlist $start_lineindex]] set first [dict create lineindex $start_lineindex {*}[dict get $o_linemap $start_lineindex] payload [lindex $o_payloadlist $start_lineindex]]
set start_info [dict get $o_linemap $start_lineindex] set start_info [dict get $o_linemap $start_lineindex]
if {$chunkstart > [dict get $start_info start]} {
dict set first is_truncated 1
dict set first truncatedside [list left] ;#truncatedside is a list which may have 'right' added if last line is same as first line
} else {
dict set first is_truncated 0
}
if {$opt_show_truncated} { if {$opt_show_truncated} {
#line1 #line1
if {$chunkstart > [dict get $start_info start]} { if {$chunkstart > [dict get $start_info start]} {
@ -382,11 +720,7 @@ namespace eval punk::fileline::class {
set lhs [string range $payload_and_le 0 $split-1] set lhs [string range $payload_and_le 0 $split-1]
dict set first truncated $truncated dict set first truncated $truncated
dict set first truncatedside [list left] ;#truncatedside is a list which may have 'right' added if last line is same as first line
dict set first truncatedleft $lhs dict set first truncatedleft $lhs
dict set first is_truncated 1
} else {
dict set first is_truncated 0
} }
} }
########################### ###########################
@ -410,35 +744,45 @@ namespace eval punk::fileline::class {
if {$end_lineindex == $start_lineindex} { if {$end_lineindex == $start_lineindex} {
#same record #same record
set end_info $start_info set end_info $start_info
if {$chunkend < [dict get $end_info end]} {
#there is rhs truncation
if {[dict get $first is_truncated]} {
dict set first truncatedside [list left right]
} else {
dict set first is_truncated 1
dict set first truncatedside [list right]
}
}
if {$opt_show_truncated} { if {$opt_show_truncated} {
if {$chunkend < [dict get $end_info end]} { if {$chunkend < [dict get $end_info end]} {
#lhere is rhs truncation #there is rhs truncation and we need to return the splits
if {[dict get $first is_truncated]} {
dict set first truncatedside [list left right]
} else {
dict set first is_truncated 1
dict set first truncatedside [list right]
}
#do rhs truncation - possibly in addition to existing lhs truncation #do rhs truncation - possibly in addition to existing lhs truncation
# ... # ...
set payload [lindex $o_payloadlist $end_lineindex]
set line_start [dict get $end_info start]
set le_chars [dict get [dict create lf \n crlf \r\n none ""] [dict get $end_info le]]
set payload_and_le "${payload}${le_chars}"
set split [expr {$chunkend - $line_start}]
set truncated [string range $payload_and_le 0 $split]
set rhs [string range $payload_and_le $split+1 end]
dict set first truncatedright $rhs
if {"left" ni [dict get $first truncatedside]} { if {"left" ni [dict get $first truncatedside]} {
#rhs truncation only #rhs truncation only
set payload [lindex $o_payloadlist $end_lineindex]
set line_start [dict get $end_info start]
set le_chars [dict get [dict create lf \n crlf \r\n none ""] [dict get $end_info le]]
set payload_and_le "${payload}${le_chars}"
puts "payload_and_le: $payload_and_le" puts "payload_and_le: $payload_and_le"
puts "LENGHT: [string length $payload_and_le]" puts "LENGTH: [string length $payload_and_le]"
#--- #---
set split [expr {$chunkend - $line_start}]
set truncated [string range $payload_and_le 0 $split]
set rhs [string range $payload_and_le $split+1 end]
#--- #---
dict set first truncated $truncated dict set first truncated $truncated
dict set first truncatedside [list right] dict set first truncatedside [list right]
dict set first truncatedright $rhs
} else { } else {
#truncated on both sides #truncated on both sides
set lhslen [string length [dict get $first truncatedleft]]
#re-truncate the truncation to reapply the original lhs truncation
set truncated [string range $truncated $lhslen end]
dict set first truncated $truncated
} }
} }
} }
@ -447,10 +791,18 @@ namespace eval punk::fileline::class {
} else { } else {
set last [dict create lineindex $end_lineindex {*}[dict get $o_linemap $end_lineindex] payload [lindex $o_payloadlist $end_lineindex]] set last [dict create lineindex $end_lineindex {*}[dict get $o_linemap $end_lineindex] payload [lindex $o_payloadlist $end_lineindex]]
set end_info [dict get $o_linemap $end_lineindex] set end_info [dict get $o_linemap $end_lineindex]
if {$chunkend < [dict get $end_info end]} {
dict set last is_truncated 1
dict set last truncatedside [list right]
} else {
dict set last is_truncated 0
}
if {$opt_show_truncated} { if {$opt_show_truncated} {
if {$chunkend < [dict get $end_info end]} { if {$chunkend < [dict get $end_info end]} {
#there is rhs truncation - and last line in range is a different line to first one #there is rhs truncation - and last line in range is a different line to first one
dict set last is_truncated 1
set payload [lindex $o_payloadlist $end_lineindex] set payload [lindex $o_payloadlist $end_lineindex]
set line_start [dict get $end_info start] set line_start [dict get $end_info start]
set line_end [dict get $end_info end] set line_end [dict get $end_info end]
@ -464,7 +816,6 @@ namespace eval punk::fileline::class {
set rhs [string range $payload_and_le $split+1 end] set rhs [string range $payload_and_le $split+1 end]
dict set last truncated $truncated dict set last truncated $truncated
dict set last truncatedside [list right]
dict set last truncatedright $rhs dict set last truncatedright $rhs
#this has the effect that truncating the rhs by 1 can result in truncated being larger than original payload for crlf lines - as payload now sees the cr #this has the effect that truncating the rhs by 1 can result in truncated being larger than original payload for crlf lines - as payload now sees the cr
#this is a bit unintuitive - but probably best reflects the reality. The truncated value is the truncated 'line' rather than the truncated 'payload' #this is a bit unintuitive - but probably best reflects the reality. The truncated value is the truncated 'line' rather than the truncated 'payload'
@ -479,12 +830,15 @@ namespace eval punk::fileline::class {
lappend infolist $last lappend infolist $last
} }
########################### ###########################
#assert all records have is_truncated key.
#assert if is_truncated == 1 truncatedside should contain a list of either left, right or both left and right
#assert If not opt_show_truncated - then truncated records will not have truncated,truncatedleft,truncatedright keys.
return $infolist return $infolist
} }
#need to check truncations so that any split \r\n is counted precisely todo
method chunk_le_counts {chunkstart chunkend} { method chunk_le_counts {chunkstart chunkend} {
set infolines [my chunkrange_to_lineinfolist $chunkstart $chunkend] set infolines [my chunkrange_to_lineinfolist $chunkstart $chunkend -show_truncated 1]
set lf_count 0 set lf_count 0
set crlf_count 0 set crlf_count 0
set none_count 0 set none_count 0
@ -498,7 +852,33 @@ namespace eval punk::fileline::class {
incr none_count incr none_count
} }
} }
return [dict create lf $lf_count crlf $crlf_count unterminated $none_count] #even without split crlf - this can overcount by counting the lf or crlf in a line which had an ending not in the chunk range specified
#check first and last infoline for truncations
#Also check if the truncation is directly between an crlf
#both an lhs split and an rhs split could land between cr and lf
#to be precise - we should presumably count the part within our chunk as either a none for cr or an lf
#This means a caller counting chunk by chunk using this method will sometimes get the wrong answer depending on where crlfs lie relative to their chosen chunk size
#This is presumably ok - as it should be a well known thing to watch out for.
#If we're only receiving chunk by chunk we can't reliably detect splits vs lone <cr>s in the data
#There are surely more efficient ways for a caller to count line-endings in the way that makes sense for them
#but we should makes things as easy as possible for users of this line/chunk structure anyway.
set first [lindex $infolines 0]
if {[dict get $first is_truncated]} {
#could be the only line - and truncated at one or both ends.
#both a left and a right truncation could split a crlf
}
set last [lindex $infolines end]
if {[dict get $first lineindex] != [dict get $last lineindex]} {
#only need to process last if it is a different line
#if so - then split can only be left side
}
return [dict create lf $lf_count crlf $crlf_count unterminated $none_count warning line_ending_splits_unimplemented]
} }
#todo - test last line and merge as necessary with first line from new chunk - generate line data only for appended chunk #todo - test last line and merge as necessary with first line from new chunk - generate line data only for appended chunk
@ -571,7 +951,7 @@ namespace eval punk::fileline::class {
error "Bad start index '$original_startidx'. $startidx out of bounds 0 - $max" error "Bad start index '$original_startidx'. $startidx out of bounds 0 - $max"
} }
if {$endidx < 0 || $endidx > $max} { if {$endidx < 0 || $endidx > $max} {
error "Bad end index '$original_endidx'. $endidx out of bounds 0 - $max" error "Bad end index '$original_endidx'. $endidx out of bounds 0 - $max (try $max or end)"
} }
return [list $startidx $endidx] return [list $startidx $endidx]
} }
@ -704,8 +1084,31 @@ namespace eval punk::fileline {
#[para] Core API functions for punk::fileline #[para] Core API functions for punk::fileline
#[list_begin definitions] #[list_begin definitions]
proc file_textinfo {filename} {
set fd [open $filename r] ;#open gives a good enough error message if file not readable
fconfigure $fd -translation binary
set rawfiledata [read $fd]
close $fd
set textobj [class::textinfo new $rawfiledata]
puts stdout "Bytes loaded : [$textobj chunklen]"
puts stdout "Lines recognised : [$textobj linecount]"
set leinfo [$textobj chunk_le_counts 0 end]
puts stdout "crlf endings (windows) : [dict get $leinfo crlf]"
puts stdout "lf endings (unix) : [dict get $leinfo crlf]"
puts stdout "unterminated lines : [dict get $leinfo unterminated]"
return $textobj
}
proc file_boundary_display {filename startbyte endbyte chunksize args} {
set fd [open $filename r] ;#use default error if file not readable
fconfigure $fd -translation binary
set rawfiledata [read $fd]
close $fd
set textobj [class::textinfo new $rawfiledata]
set result [$textobj chunk_boundary_display $startbyte $endbyte $chunksize {*}$args]
$textobj destroy
return $result
}
@ -728,7 +1131,7 @@ namespace eval punk::fileline::lib {
proc range_spans_chunk_boundaries {start end chunksize} { proc range_spans_chunk_boundaries {start end chunksize args} {
#*** !doctools #*** !doctools
#[call [fun lib::range_spans_chunk_boundaries] [arg start] [arg end] [arg chunksize]] #[call [fun lib::range_spans_chunk_boundaries] [arg start] [arg end] [arg chunksize]]
#[para]Takes start and end offset, generally representing bytes or character indices, and computes a list of boundaries at multiples of the chunksize that are spanned by the start and end range. #[para]Takes start and end offset, generally representing bytes or character indices, and computes a list of boundaries at multiples of the chunksize that are spanned by the start and end range.
@ -751,12 +1154,12 @@ namespace eval punk::fileline::lib {
#[para] This function automatically uses lseq (if Tcl >= 8.7) when number of boundaries spanned is approximately greater than 75 #[para] This function automatically uses lseq (if Tcl >= 8.7) when number of boundaries spanned is approximately greater than 75
if {[catch {package require Tcl 8.7}]} { if {[catch {package require Tcl 8.7}]} {
#only one implementation available for older Tcl #only one implementation available for older Tcl
tailcall punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize tailcall punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize {*}$args
} }
if {(($end - $start) / $chunksize) < 75} { if {(($end - $start) / $chunksize) < 75} {
tailcall punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize tailcall punk::fileline::system::_range_spans_chunk_boundaries_tcl $start $end $chunksize {*}$args
} else { } else {
tailcall punk::fileline::system::_range_spans_chunk_boundaries_lseq $start $end $chunksize tailcall punk::fileline::system::_range_spans_chunk_boundaries_lseq $start $end $chunksize {*}$args
} }
} }
@ -779,8 +1182,22 @@ namespace eval punk::fileline::system {
#for 8.7+ using lseq #for 8.7+ using lseq
#much faster when resultant boundary size is large #much faster when resultant boundary size is large (at least when offset 0)
proc _range_spans_chunk_boundaries_lseq {start end chunksize} { proc _range_spans_chunk_boundaries_lseq {start end chunksize args} {
set defaults [dict create\
-offset 0\
]
set known_opts [dict keys $defaults]
foreach {k v} $args {
if {$k ni $known_opts} {
error "unknown option '$k'. Known options: $known_opts"
}
}
set opts [dict merge $defaults $args]
# -- --- --- ---
set opt_offset [dict get $opts -offset]
# -- --- --- ---
set smod [expr {$start % $chunksize}] set smod [expr {$start % $chunksize}]
if {$smod != 0} { if {$smod != 0} {
set start [expr {$start + ($chunksize - $smod)}] set start [expr {$start + ($chunksize - $smod)}]
@ -789,12 +1206,30 @@ namespace eval punk::fileline::system {
} }
} }
set boundaries [lseq $start to $end $chunksize] set boundaries [lseq $start to $end $chunksize]
if {$opt_offset} {
set boundaries [lap v $boundaries[unset boundaries] {expr {$v + $opt_offset}}]
}
return [list is_span [expr {[llength $boundaries]>0}] boundaries $boundaries] return [list is_span [expr {[llength $boundaries]>0}] boundaries $boundaries]
} }
#faster than lseq for small number of resultant boundaries (~< 75) (which is a common use case) #faster than lseq for small number of resultant boundaries (~< 75) (which is a common use case)
#gets very slow (comparitively) with large resultsets #gets very slow (comparitively) with large resultsets
proc _range_spans_chunk_boundaries_tcl {start end chunksize} { proc _range_spans_chunk_boundaries_tcl {start end chunksize args} {
set defaults [dict create\
-offset 0\
]
set known_opts [dict keys $defaults]
foreach {k v} $args {
if {$k ni $known_opts} {
error "unknown option '$k'. Known options: $known_opts"
}
}
set opts [dict merge $defaults $args]
# -- --- --- ---
set opt_offset [dict get $opts -offset]
# -- --- --- ---
set is_span 0 set is_span 0
set smod [expr {$start % $chunksize}] set smod [expr {$start % $chunksize}]
if {$smod != 0} { if {$smod != 0} {
@ -802,9 +1237,9 @@ namespace eval punk::fileline::system {
} }
set boundaries [list] set boundaries [list]
for {set b $start} {$b <= $end} {incr b $chunksize} { for {set b $start} {$b <= $end} {incr b $chunksize} {
lappend boundaries $b lappend boundaries [expr {$b + $opt_offset}]
} }
return [list is_span [expr {[llength $boundaries]>0}] boundaries $boundaries] return [list is_span [expr {[llength $boundaries]>0}] boundaries $boundaries offset $opt_offset]
} }
proc _range_spans_chunk_boundaries_TIMEIT {start end chunksize {repeat 1}} { proc _range_spans_chunk_boundaries_TIMEIT {start end chunksize {repeat 1}} {
@ -815,6 +1250,22 @@ namespace eval punk::fileline::system {
} }
} }
} }
namespace eval punk::fileline::ansi {
#*** !doctools
#[subsection {Namespace punk::fileline::ansi}]
#[para]These are ansi functions imported from punk::ansi - or no-ops if that package is unavailable
#[para]See [package punk::ansi] for documentation
#[list_begin definitions]
variable enabled 1
#*** !doctools
#[call [fun ansi::a]]
#[call [fun ansi::a+]]
#[call [fun ansi::stripansi]]
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::fileline::ansi ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready ## Ready
package provide punk::fileline [namespace eval punk::fileline { package provide punk::fileline [namespace eval punk::fileline {

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

@ -419,7 +419,7 @@ namespace eval punk::mix::commandset::loadedlib {
if {![file exists $source_file]} { if {![file exists $source_file]} {
error "Unable to verify source file existence at: $source_file" error "Unable to verify source file existence at: $source_file"
} }
set source_data [fcat $source_file -translation binary] set source_data [fcat -translation binary $source_file]
if {![string match "*package provide*" $source_data]} { if {![string match "*package provide*" $source_data]} {
puts stderr "Sorry - unable to verify source file contains 'package provide' statement of some sort - copy manually" puts stderr "Sorry - unable to verify source file contains 'package provide' statement of some sort - copy manually"
return false return false

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

@ -116,7 +116,11 @@ namespace eval punk::mix::commandset::scriptwrap {
#It is more likely to catch issues if adjustments are made to the initial batch-script code in a template. #It is more likely to catch issues if adjustments are made to the initial batch-script code in a template.
# #
#cmd allows labels at call sites to span lines with line continuation character ^ #cmd allows labels at call sites to span lines with line continuation character ^
#target labels can't span lines with ^ - cmd doesn't recognise them. #target labels can't span lines with ^ - cmd doesn't recognise them (They possibly do span in a way - but but the newlines may be included in the label - so they may be hard/impossible to call).
#Note that we can't filter obviously non-batch-script lines before processing - as the way batch label-scanning works it scans in chunks of 512 bytes so all lines are relevant.
#This means label-like things could be incorrectly found in other script data - that's partly the point of this check
#Note that we can't filter obviously non-batch-script lines before processing - as the way batch label-scanning works it scans in chunks of 512 bytes so all lines are relevant.
#This means label-like things could be incorrectly found in other script data - that's partly the point of this check.
proc checkoutput {filepath args} { proc checkoutput {filepath args} {
if {![file exists $filepath]} { if {![file exists $filepath]} {
error "punk::mix::commandset:scriptwrap error cannot find file '$filepath'" error "punk::mix::commandset:scriptwrap error cannot find file '$filepath'"
@ -142,8 +146,8 @@ namespace eval punk::mix::commandset::scriptwrap {
# -- --- --- --- --- --- --- # -- --- --- --- --- --- ---
# #### load file #### # #### load file ####
##set raw_filedata [fcat $filepath -translation binary] ##set raw_filedata [fcat -translation binary $filepath]
#don't use fcat/fileutil::cat - as we may need to look at data beyond a ctrl-z (\x1A) section # - as we may need to look at data beyond a ctrl-z (\x1A) section
set fd [open $filepath r] set fd [open $filepath r]
fconfigure $fd -translation binary fconfigure $fd -translation binary
set raw_filedata [read $fd] set raw_filedata [read $fd]
@ -198,124 +202,304 @@ namespace eval punk::mix::commandset::scriptwrap {
puts stdout "[a+ yellow bold]WARNING: More than one unterminated line reported - seems fishy[a]" puts stdout "[a+ yellow bold]WARNING: More than one unterminated line reported - seems fishy[a]"
} }
puts "Checking line based labels and 512 byte boundaries from call sites for possible labels and code execution points." puts "Checking line based labels and 512 byte boundaries from call sites for possible labels and code execution points."
set result ""
set line_count [$objFile linecount] set line_count [$objFile linecount]
set callid 0 ;#id for callsite and objects created set callid 0 ;#id for callsite and objects created
set file_offset 0 set file_offset 0
set error_labels [list] set error_labels [list]
set warning_labels [list] set warning_labels [list]
for {set lineindex 0} {$lineindex < $line_count} {incr lineindex} { set call_labels_found [dict create]
set lineinfo [$objFile lineinfo $lineindex] set target_labels_found [dict create]
set ln [dict get $lineinfo payload] set possible_target_labels_found [dict create]
set linenum [expr {$lineindex + 1}] set warning_target_labels_found [dict create]
for {set callingline_index 0} {$callingline_index < $line_count} {incr callingline_index} {
set callingline_info [$objFile lineinfo $callingline_index]
set callingline_payload [dict get $callingline_info payload]
set callingline_len [dict get $callingline_info linelen]
set callingline_num [expr {$callingline_index + 1}]
set callposn -1 set callposn -1
set trimln [string trim $ln] set trimln [string trim $callingline_payload]
if {[string match "rem *" $trimln] || [string match "@rem *" $trimln] || [string match "REM *" $trimln] || [string match "@REM *" $trimln]} { if {[string match "rem *" $trimln] || [string match "@rem *" $trimln] || [string match "REM *" $trimln] || [string match "@REM *" $trimln]} {
#ignore things that look like a call that are beind a REM #ignore things that look like a call that are beind a REM
} else { } else {
foreach search_regex [list {(.*\s+|^)(@*call\s*:)(\S.*)} {(.*\s+|^)(@*CALL\s*:)(\S.*)} {(.*\s+|^)(@*goto\s*:)(\S.*)} {(.*\s+|^)(@*GOTO\s*:)(\S.*)}] {
if {[regexp $search_regex $ln _m precall call labelplus]} { #todo - better callsite analysis. There can be data between @GOTO or @CALL and : other than just whitespace!
set callposn [expr {$file_offset + [string length $ln]}] ;#take callposn as end of line .. review - multiline statements?
#todo - allow analysis of colon-less call. May need to check list of internal commands - but what about external ones?
#foreach search_regex [list {(.*\s+|^)(@*call\s*:*)(\S.*)} {(.*\s+|^)(@*CALL\s*:*)(\S.*)} {(.*\s+|^)(@*goto\s*:*)(\S.*)} {(.*\s+|^)(@*GOTO\s*:*)(\S.*)}] {}
foreach search_regex [list {(.*\s+|^)(@*call\s*:)(\S.*)} {(.*\s+|^)(@*CALL\s*:)(\S.*)} {(.*\s+|^)(@*goto\s*:)(\S.*)} {(.*\s*|.*\s+|^)(@*GOTO\s*:)(\S.*)} {(.*\|\|.*)(@*GOTO\s*:)(\S.*)}] {
if {[regexp $search_regex $callingline_payload _m precall call labelplus]} {
#todo further checks to see if it's actually a batch script line
# - - - - work out what cmd.exe considers start of 512B boundaries when scanning from a callsite
#callposn affected by newlines? #callposn affected by newlines?
#set callposn [expr {$file_offset + [string length $callingline_payload]}] ;#take callposn as end of line .. review - multiline statements?
set callposn [expr {$file_offset + $callingline_len}]
#Note there are anomalies around target labels in bracketed sections such as IF blocks
#this is bad practice - as it can lead to unbalanced braces - but batch files can still work under cmd.exe with them in some cases
#e.g unbalanced trailing bracket may be ignored.
#A working script with target-labels in braces can fail due to boundary issues we don't detect (callsite for boundary counting may need to be at end of entire multiline if block??)
#For now - just make sure punk templates don't do this - but it would be nice to be able to detect.
#set callposn $file_offset
#set callposn [expr {$file_offset + [string length $precall]}]
# - - - -
break break
} }
} }
#todo - multiple calls on one line. - also - determine what cmd considers the starting point for forward scanning when call is in a structure such as an if statement. set callsite_labelfound 0 ;#until proven
if {$callposn != -1} { if {$callposn != -1} {
puts stdout "[a+ bold cyan]CALLSITE on line $linenum ending at byte $callposn[a]" set callposn_lineindex [lindex [$objFile chunkrange_to_linerange $callposn $callposn] 0]
#the line represented by callposn may actually be beyond the calling_line_index
set labelinfo [batchlib::get_callsite_label $labelplus]
if {[dict get $labelinfo labelfound]} {
set callsite_labelfound 1
set label [dict get $labelinfo label]
set call_label_record [list label $label line $callingline_num]
dict lappend call_labels_found $label $call_label_record
} else {
puts stderr "[a+ yellow bold]WARNING - apparent callsite $callposn but couldn't verify label[a]"
puts stderr "Line:\n$trimln"
}
}
#todo - multiple calls on one line. - also - determine what cmd considers the starting point for forward scanning when call is in a structure such as an if statement.
if {$callsite_labelfound} {
puts stdout "[a+ bold cyan]CALLSITE on line $callingline_num ending at byte $callposn[a]"
set callsummary [string range "${call}${labelplus}" 0 100] set callsummary [string range "${call}${labelplus}" 0 100]
if {[string length $callsummary] < [string length ${call}${labelplus}]} { if {[string length $callsummary] < [string length ${call}${labelplus}]} {
puts stdout " CALLSITE: $callsummary (truncated to 100 bytes)" puts stdout " CALLSITE: $callsummary (truncated to 100 bytes)"
} else { } else {
puts stdout " CALLSITE: '${call}${labelplus}'" puts stdout " CALLSITE: '${call}${labelplus}'"
} }
puts stdout " [a+ cyan]FULLINE: $ln[a]" puts stdout " [a+ cyan]FULLINE: $callingline_payload[a]"
################################## ##################################
set labelpluswords [regexp -inline -all {\S+} $labelplus] ;#don't assume labelplus can be treated as Tcl list - use regexp to split #set labelpluswords [regexp -inline -all {\S+} $labelplus] ;#don't assume labelplus can be treated as Tcl list - use regexp to split
#NOTE it is invalid to assume label always terminated by space - pair of % characters (variable substitution) can contain a space without terminating label #NOTE it is invalid to assume label always terminated by space - pair of % characters (variable substitution) can contain a space without terminating label
#set word1 [lindex $labelpluswords 0]
set word1 [lindex $labelpluswords 0]
set word1len [string length $word1]
set labeltail [string range $labelplus $word1len end]
if {[string index $word1 end] eq "^"} {
if {![string length $labeltail]} {
#label
}
} else {
}
#todo batchlib::get_callsite_label $labelplus
################################## ##################################
set label $word1
set labelsize [string length $label] set labelsize [string length $label]
#scan forward for labels at boundaries #scan forward for labels at boundaries
set forward_chunk [$objFile chunk $callposn end] set forward_chunk [$objFile chunk $callposn end]
set forward_chunk_base $callposn ;#name for clarity
incr callid incr callid
set callvar "call-${callid}_fromline-${linenum}" set callvar "call-${callid}_fromline-${callingline_num}"
upvar 0 $callvar objForwardScan upvar 0 $callvar objForwardScan
set objForwardScan [fileline::textinfo new $forward_chunk] set objForwardScan [fileline::textinfo new $forward_chunk]
##################################################################################################################################
#Forward scan 1 - check at normal line boundaries - and see if collides with a chunk boundary - and if the label is obscured or ok #Forward scan 1 - check at normal line boundaries - and see if collides with a chunk boundary - and if the label is obscured or ok
set dsize [$objForwardScan chunklen] set dsize [$objForwardScan chunklen]
set num_boundaries [expr {$dsize / 512} ] set num_boundaries [expr {$dsize / 512} ]
puts "scanning $dsize forward bytes in file for labels - num_boundaries: $num_boundaries" puts "scanning $dsize forward bytes in file starting at $forward_chunk_base for label '$label' - num_boundaries: $num_boundaries"
set scan_offset 0
set total_offset $file_offset set total_offset $file_offset
set found_forward_label 0 set found_forward_label 0
foreach scanlineinfo [$objForwardScan lineinfolist 0 end] { foreach scanlineinfo [$objForwardScan lineinfolist 0 end] {
set line_bytes [dict get $scanlineinfo linelen] set scanline_start [dict get $scanlineinfo start]
set scanline_bytes [dict get $scanlineinfo linelen]
set scanline [dict get $scanlineinfo payload] set scanline [dict get $scanlineinfo payload]
set scanline_relstart [dict get $scanlineinfo start]
set line_global_start $total_offset set line_start_global [expr {$forward_chunk_base + $scanline_start}]
set line_global_end [expr {$total_offset + $line_bytes}] set line_index_global [lindex [$objFile chunkrange_to_linerange $line_start_global $line_start_global] 0]
set line_num_global [expr {$line_index_global + 1}]
set trimscanline [string trim $scanline] set trimscanline [string trim $scanline]
if {[string match ":$label*" $trimscanline]} {
incr found_forward_label set found_targetlabel_at_line 0 ;# until disproven
set label_posn_in_line [string first : $scanline] if {[string first : $scanline] >= 0} {
set labelposn [expr {$scan_offset + $label_posn_in_line}] set labelinfo [batchlib::get_target_label_from_line $scanline]
#we only really care about exactly landing on a boundary or else the next 512 byte boundaries above the labelposn if {[dict get $labelinfo labelfound] && [dict get $labelinfo label] eq $label} {
if {($labelposn % 512) == 0} { #add to target_labels_found record below
set ubound [expr {($labelposn / 512) * 512}] set scan_target_label_record [list label $label line $line_num_global]
} else { set found_targetlabel_at_line 1
set ubound [expr {(($labelposn / 512)+1) * 512}]
} }
set lbound [expr {$ubound - $labelsize}] }
if {($labelposn >= $lbound) && ($labelposn <= $ubound)} {
lappend error_labels [list label $label call_offset_bytes $labelposn callsite [list call ${call}${labelplus} call_linenum $linenum]] if {$found_targetlabel_at_line} {
puts stdout "[a+ bold red]ERROR: label $trimscanline at offset from callsite: $labelposn total offset: $total_offset[a]" set scan_target_label_same_line_seen false
puts stdout "[a+ bold red] This label appears to span the 512byte boundary at byte $ubound[a] [a+ yellow bold]from callsite.[a]" if {[dict exists $target_labels_found $label]} {
set thislabel_records [dict get $target_labels_found $label]
foreach previous $thislabel_records {
if {[dict get $previous line] eq $line_num_global} {
set scan_target_label_same_line_seen true
}
}
}
incr found_forward_label
if {!$scan_target_label_same_line_seen} {
set label_posn_in_line [string first : $scanline]
set labelposn [expr {$scanline_start + $label_posn_in_line}]
#we only really care about exactly landing on a boundary or else the next 512 byte boundaries above the labelposn
if {($labelposn % 512) == 0} {
set ubound [expr {($labelposn / 512) * 512}]
} else {
set ubound [expr {(($labelposn / 512)+1) * 512}]
}
set lbound [expr {$ubound - $labelsize}]
if {($labelposn >= $lbound) && ($labelposn <= $ubound)} {
dict set scan_target_label_record error linestart_and_call_offset_bytes
lappend error_labels [list label $label linestart_and_call_offset_bytes $labelposn callsite [list call ${call}${labelplus} call_linenum $callingline_num] bad_target_line $line_num_global]
puts stdout "[a+ bold red]ERROR: file line: $line_num_global target-label $trimscanline at line-beginning and with byte offset from callsite: $labelposn offset in file: $line_start_global[a]"
puts stdout "[a+ bold red] This target-label appears to span the 512byte boundary at byte $ubound[a] [a+ yellow bold]from callsite.[a]"
puts [$objForwardScan chunk_boundary_display [dict get $scanlineinfo start] [dict get $scanlineinfo end] 512 -linebase $callposn_lineindex+1 -limit 1] ;#+1 on callposn_linindex to do editor-style linenums
} else {
dict set scan_target_label_record ok 1
puts stdout "[a+ bold green]OK: file line: $line_num_global target-label $trimscanline at line-beginning and with byte offset from callsite: $labelposn offset in file: $line_start_global[a]"
}
dict lappend target_labels_found $label $scan_target_label_record
} else { } else {
puts stdout "[a+ bold green]OK: label $trimscanline at offset from callsite: $labelposn total offset: $total_offset[a]" puts stdout "OK - seen label $label on $line_num_global before"
} }
} }
incr total_offset $line_bytes incr total_offset $scanline_bytes
incr scan_offset $line_bytes
} }
##################################################################################################################################
#todo #todo
#forward scan 2 - check any boundaries missed above because the label isn't at the begining of a line #forward scan 2 - check any boundaries missed above because the label isn't at the begining of a line
#these are potentially hidden labels that could activate without requiring the label be at the beginning of a line #these are potentially hidden labels that could activate without requiring the label be at the beginning of a line
#check boundary spans relative to start of this objForwardScan chunk #check boundary spans relative to start of this objForwardScan chunk
set forward_spaninfo [fileline::range_spans_chunk_boundaries {*}[$objForwardScan numeric_chunkrange 0 end] 512]
if {[dict get $forward_spaninfo is_span]} { #adjust boundary-search by resetting counter each time crlf encountered
set boundaries [dict get $forward_spaninfo boundaries] set forward_lines [$objForwardScan chunkrange_to_lineinfolist 0 end]
if {[llength $boundaries] > 1} { set boundary_positions [list 0]
puts stdout "line $linenum scan from call label $label at $callposn. Callsite-relative boundaries crossed: [lrange $boundaries 1 end]" set scanner_offset 0
set scanner_position 0
foreach forwardbline_info $forward_lines {
#review - do we need to check the payload in case we have configured the textinfo object to split the file only on lf - (not true by default)
set forwardbline_len [dict get $forwardbline_info linelen]
set forwardbline_spaninfo [fileline::range_spans_chunk_boundaries [expr {$scanner_position + $scanner_offset}] [expr {$scanner_position + $scanner_offset + $forwardbline_len}] 512]
set forwardbline_boundaries [dict get $forwardbline_spaninfo boundaries]
foreach b $forwardbline_boundaries {
set relb [expr $b + $scanner_offset]
if {$relb <= [dict get $forwardbline_info end]} {
lappend boundary_positions $relb
} else {
#leave it for the next line - as we may need to adjust offset anyway
break
}
} }
if {[dict get $forwardbline_info le] eq "crlf"} {
set scanner_offset [expr {[dict get $forwardbline_info end] - [lindex $boundary_positions end]}] ;#reset on crlf
#puts "+++++ set scanner_offset $scanner_offset"
}
set scanner_position [dict get $forwardbline_info end]
} }
set boundary_positions [lsearch -all -not -inline $boundary_positions 0]
if {[llength $boundary_positions]} {
puts stdout "[a+ blue bold]----> [llength $forward_lines] forward lines, boundaries (possibly with offsets) to check $boundary_positions[a]"
} else {
puts stdout "[a+ blue bold]----> [llength $forward_lines] forward lines, No boundaries to check (generally expected for files with crlf line endings and no extremely long lines)[a]"
}
if {[llength $boundary_positions]} {
puts stdout "line $callingline_num scan from call label $label ending at position $callposn. Next Callsite-relative boundary [lindex $boundary_positions 0]"
for {set i 0} {$i < [llength $boundary_positions]} {incr i} {
set b [lindex $boundary_positions $i]
if {$i < [llength $boundary_positions]-1} {
set nextb [lindex $boundary_positions $i+1]
set top $nextb
} else {
set top end
}
set forwardbline_infolist [$objForwardScan chunkrange_to_lineinfolist $b $top -show_truncated 1]
set forwardbline_info [lindex $forwardbline_infolist 0]
if {[dict get $forwardbline_info is_truncated]} {
set payload_from_boundary [dict get $forwardbline_info truncated]
} else {
set payload_from_boundary [dict get $forwardbline_info payload]
}
set forwardbline_len [dict get $forwardbline_info linelen]
set forwardbline_index [dict get $forwardbline_info lineindex]
set forwardbline_start [dict get $forwardbline_info start]
set forwardbline_start_global [expr {$forward_chunk_base + $forwardbline_start}]
set forwardbline_index_global [lindex [$objFile chunkrange_to_linerange $forwardbline_start_global $forwardbline_start_global] 0]
set forwardbline_num_global [expr {$forwardbline_index_global + 1}]
set found_targetlabel_at_boundary 0
if {[string first : $payload_from_boundary] >= 0} {
#puts stdout "Possible label at boundary $b - testing"
set labelinfo [batchlib::get_target_label_from_line $payload_from_boundary]
if {[dict get $labelinfo labelfound] && [dict get $labelinfo label] eq $label} {
incr found_forward_label
set found_targetlabel_at_boundary 1
} elseif {[dict get $labelinfo labelfound]} {
set unsearched_label [dict get $labelinfo label]
puts stderr "[a+ cyan]Line $forwardbline_num_global: Found an item that cmd may interpret as a target label because of its location at a boundary $b - but it doesn't seem to be the one we are looking for. Looking for '$label' Found: '[dict get $labelinfo label]'[a]"
puts stderr "[a+ yellow]Warning - if the label '$unsearched_label' on line $forwardbline_num_global isn't meant to be a target - it may be safest to make sure batch script isn't using CALL or GOTO with target :$unsearched_label"
puts stdout "linedata:\n"
#puts stdout "'$payload_from_boundary'"
puts [$objForwardScan chunk_boundary_display [dict get $forwardbline_info start] [dict get $forwardbline_info end] 0 -boundaries $b -linebase $callposn_lineindex+1 -limit 1]
#dubious value to check call_labels_found - as we didn't run through and find all call labels first!
if {$unsearched_label in [dict keys $call_labels_found]} {
set boundary_target_label_record [list label $unsearched_label line $forwardbline_num_global error found_via_boundary_check_on_a_different_call_label]
dict lappend warning_target_labels_found $unsearched_label $boundary_target_label_record
} else {
set possible_target_label_record [list label $unsearched_label line $forwardbline_num_global]
dict lappend possible_target_labels_found $unsearched_label $possible_target_label_record
}
} else {
set note ""
if {[dict exists $labelinfo note]} {
set note [dict get $labelinfo note]
}
if {$note ne "prefix_fail"} {
puts stdout "no label detected at boundary $b - probably ok. Note from target-label scanner: $note"
}
}
if {$found_targetlabel_at_boundary} {
set target_label_record [list label $label line $forwardbline_num_global error call_offset_bytes]
dict lappend target_labels_found $label $target_label_record
set note "possibly unreliable or dangerous target-label at line $forwardbline_num_global may execute line [expr {$forwardbline_num_global +1}].\n"
append note "Target label not at line start but was found by scanning 512byte chunks from callsite with count resets at any crlf encountered\n"
append note "Adjust spacing between line $callingline_num and $forwardbline_num_global to avoid the 512 boundary - and re-test for other boundary problems"
lappend error_labels [list label $label call_offset_bytes $b callsite [list call ${call}${labelplus} call_linenum $callingline_num] note $note]
puts stdout "[a+ bold red]ERROR: line $forwardbline_num_global target-label [dict get $labelinfo rawlabel] found at boundary and with byte offset from callsite: $b [a]"
puts stdout "[a+ bold red] This target-label appears to fall at or just after the 512byte boundary at byte $b[a] [a+ yellow bold]from callsite.[a]"
puts stdout "[a+ bold yellow]Code may execute at line [expr {$forwardbline_num_global + 1}] (or at next 512Byte boundary in some circumstances)[a]"
puts stdout "[a+ bold yellow]Recommend adjusting spacing between line $callingline_num and $forwardbline_num_global[a]"
puts stdout [$objForwardScan chunk_boundary_display [dict get $forwardbline_info start] [dict get $forwardbline_info end] 0 -boundaries $b -linebase $callposn_lineindex+1 -limit 1]
}
#if found any label - peek at next boundary
if {[dict get $labelinfo labelfound] && $i+1 < [llength $boundary_positions]} {
set next_lineinfolist [$objForwardScan chunkrange_to_lineinfolist $nextb end -show_truncated 1]
set next_lineinfo [lindex $next_lineinfolist 0]
puts "peek next boundary data - line [expr {$forwardbline_num_global + 1}]:"
#if {[dict get $next_lineinfo is_truncated]} {
# puts [dict get $next_lineinfo truncated]
#} else {
# puts [dict get $next_lineinfo payload]
#}
puts [$objForwardScan chunk_boundary_display [dict get $next_lineinfo start] [dict get $next_lineinfo end] 0 -boundaries $nextb -linebase $callposn_lineindex+1 -limit 1]
}
}
}
}
$objForwardScan destroy
#scan behind for labels at boundaries - using offset from start of file #scan behind for labels at boundaries - using offset from start of file
#we do a backward scan even if a forward label has been found, so that we can warn of duplicate labels. #we do a backward scan even if a forward label has been found, so that we can warn of duplicate labels.
set prior_start 0 set prior_start 0
set prior_end $lineindex ;#only scan from file start to call-site set prior_end $callingline_index ;#only scan from file start to call-site
set prior_total_offset 0 set pline_begin 0
set found_backward_label 0 set found_backward_label 0
set p_linenum 0 set p_linenum 0
for {set pidx $prior_start} {$pidx <= $prior_end} {incr pidx} { for {set pidx $prior_start} {$pidx <= $prior_end} {incr pidx} {
@ -323,36 +507,71 @@ namespace eval punk::mix::commandset::scriptwrap {
set pline [dict get $plineinfo payload] set pline [dict get $plineinfo payload]
incr p_linenum incr p_linenum
set pline_bytes [dict get $plineinfo linelen] ;#includes lf or crlf ending bytes set pline_bytes [dict get $plineinfo linelen] ;#includes lf or crlf ending bytes
set pline_start $prior_total_offset set pline_start $pline_begin
if {$pline_start != [dict get $plineinfo start]} { if {$pline_start != [dict get $plineinfo start]} {
error "checkoutput error: line $p_linenum - calculated start $pline_start not equal to stored start [dict get $plineinfo start]" error "checkoutput error: line $p_linenum - calculated start $pline_start not equal to stored start [dict get $plineinfo start]"
} }
set pline_end [expr {$prior_total_offset + $pline_bytes -1}] set pline_end [expr {$pline_begin + $pline_bytes -1}]
if {$pline_end != [dict get $plineinfo end]} { if {$pline_end != [dict get $plineinfo end]} {
error "checkoutput error: line $p_linenum - calculated end $pline_end not equal to stored end [dict get $plineinfo end]" error "checkoutput error: line $p_linenum - calculated end $pline_end not equal to stored end [dict get $plineinfo end]"
} }
set trimpline [string trim $pline] set trimpline [string trim $pline]
#callsite labels appear to be literal - not subject to % expansion and escaping for example. #todo - process leading part of line before :
if {[string match ":$label*" $trimpline]} { #e.g the following are valid (leading # is not part of the examples)
incr found_backward_label # ====== : label
set prior_label_posn_in_line [string first : $pline] # also
set prior_label_posn [expr {$prior_total_offset + $prior_label_posn_in_line}] #%=== == : label
if {($prior_label_posn % 512) == 0} { # also
set p_ubound [expr {($prior_label_posn / 512) * 512}] #%= ,,,, ;;; = : label
} else {
set p_ubound [expr {(($prior_label_posn /512) +1) * 512}] #these token delimiters (; , = 0x0B ox0C 0xFF <space> <tab>)
} #can also occur after the colon e.g
set p_lbound [expr {$p_ubound - $labelsize}] #: ;label
if {($prior_label_posn >= $p_lbound) && ($prior_label_posn <= $p_ubound)} {
lappend error_labels [list label $label file_offset_bytes $prior_label_posn callsite [list call ${call}${labelplus} call_linenum $linenum]] #the following is a valid target for @GOTO :#something
puts stdout "[a+ bold red]ERROR: label '$trimpline' at line $p_linenum and offset from file start: $prior_label_posn total offset: $prior_total_offset[a]" #: ;#something
puts stdout "[a+ bold red] This label appears to span the 512byte boundary at byte $p_ubound[a] [a+ yellow bold]from file start[a]"
} else { #It is possible for closing bracket ) to also be invisible if there is no open ( active
puts stdout "[a+ bold green]OK: prior label '$trimpline' at offset from file start: $prior_label_posn total offset: $prior_total_offset[a]" #This only seems to work for a single ) at beggining of the line multiple ) even separated by spaces or ; etc seem to stop the target being found.
#The lone unbalanced ) can act like a comment in other contexts - and can appear multiple times, but only if first ) on the line is followed by a delimiter
#Essentially all characters following the first ) are ignored - but if the first is something like )) then cmd tries to interpret that as a command and fails
# e.g
#) ignored
#);)))) ignored
#)) causes error as cmd tries to run "))" as a command.
#This is a reason why *target* labels shouldn't appear in bracketed blocks - as code jumps to a point where ( ) will be unbalanced
#target labels are literal with regards to % ie not subject to % expansion - but ^ must still be processed
if {[string first : $pline] >= 0} {
#space (and some other chars) allowed between colon and label at target - (but not at callsite)
set labelinfo [batchlib::get_target_label_from_line $pline]
if {[dict get $labelinfo labelfound] && [dict get $labelinfo label] eq $label} {
set target_label_record [list label $label line $p_linenum]
puts stdout "$labelinfo"
incr found_backward_label
set prior_label_posn_in_line [string first : $pline]
set prior_label_posn [expr {$pline_begin + $prior_label_posn_in_line}]
if {($prior_label_posn % 512) == 0} {
set p_ubound [expr {($prior_label_posn / 512) * 512}]
} else {
set p_ubound [expr {(($prior_label_posn /512) +1) * 512}]
}
set p_lbound [expr {$p_ubound - $labelsize}]
if {($prior_label_posn >= $p_lbound) && ($prior_label_posn <= $p_ubound)} {
dict set target_label_record error linestart_and_overlap
lappend error_labels [list label $label linestart_and_overlap $prior_label_posn callsite [list call ${call}${labelplus} call_linenum $callingline_num]]
puts stdout "[a+ bold red]ERROR: target-label '$trimpline' at line $p_linenum and offset from file start: $prior_label_posn line start: $pline_begin[a]"
puts stdout "[a+ bold red] This target-label appears to span the 512byte boundary at byte $p_ubound[a] [a+ yellow bold]from file start[a]"
puts [$objFile chunk_boundary_display [dict get $plineinfo start] [dict get $plineinfo end] 512 -linebase 1 -limit 1]
} else {
dict set target_label_record ok 1
puts stdout "[a+ bold green]OK: file line: $p_linenum target-label '$trimpline' before call from line $callingline_num. Target is at offset from file start: $prior_label_posn line start: $pline_begin[a]"
}
dict lappend call_labels_found $label $target_label_record
} }
#else - label we weren't searching for - even if at file boundary it should be picked up when actually searched? review
} }
set spaninfo [fileline::range_spans_chunk_boundaries $pline_start $pline_end 512] set spaninfo [fileline::range_spans_chunk_boundaries $pline_start $pline_end 512]
if {[dict get $spaninfo is_span]} { if {[dict get $spaninfo is_span]} {
@ -365,44 +584,78 @@ namespace eval punk::mix::commandset::scriptwrap {
continue continue
} }
#overlap test is just a warning - we have a label-like thing overlapping the boundary #overlap test is just a warning - we have a label-like thing overlapping the boundary
#todo - take account of fact that target label can be ": <whitespace or label-ignorable chars> labelname" - so using just labelsize won't detect all overlaps
#The label could even be at the end of a long line that appears at first to be a comment e.g something like
# : whatever : sneakylabel
# or
#@REM ============================================================================================================================================================ : sneakylabel
#The fact that it overlaps - means it's probably not being found with lf line-endings - and only the label :whatever should be found with crlf endings
#- but we won't always catch that something's fishy
#review
set overlaptail [string range $pline [expr {$b - $labelsize}] [expr {($b + $labelsize) -1}]] ;#subtracting labelsize gives earliest possible overlap set overlaptail [string range $pline [expr {$b - $labelsize}] [expr {($b + $labelsize) -1}]] ;#subtracting labelsize gives earliest possible overlap
if {[string match "*:$label *" $overlaptail] } { if {[string match "*:$label *" $overlaptail] } {
lappend warning_labels [list label $label warning label_spanning callsite [list call ${call}${labelplus} call_linenum $linenum]] lappend warning_labels [list label $label warning label_spanning callsite [list call ${call}${labelplus} call_linenum $callingline_num]]
puts stdout "[a+ bold yellow] WARNING: possible label $label spans boundary $b from start of file" puts stdout "[a+ bold yellow] WARNING: possible label $label spans boundary $b from start of file"
} }
set pline_tail [string range $pline $b end] set pline_tail [string range $pline $b end]
#if {[string match ":$label *" $pline_tail]} {}
set re1 {\s*:%lbl%[\s|^|=].*} if {[string first : $pline_tail] >= 0} {
set re1 [string map [list %lbl% $label] $re1] set labelinfo [batchlib::get_target_label_from_line $pline_tail]
set re2 {\s*:%lbl%$} set labelfound 0
set re2 [string map [list %lbl% $label] $re2] if {[dict get $labelinfo labelfound] && [dict get $labelinfo label] eq $label} {
if {[regexp $re1 $pline_tail] || [regexp $re2 $pline_tail]} { set labelfound 1
lappend error_labels [list label $label file_offset_bytes $b note "label at boundary but no preceeding newline - cmd may interpret as label and execute following line or code at next boundary" callsite [list call ${call}${labelplus} call_linenum $linenum]] } elseif {[dict get $labelinfo labelfound]} {
puts stdout "[a+ bold red]ERROR: *possible* label '$label' at line $p_linenum and offset from file start: $b total offset: $prior_total_offset[a]" puts stdout "Note: detected target label [dict get $labelinfo label] at file offset $b at boundary with no preceeding newline - but it's not the one we're currently scanning for"
puts stdout "[a+ bold red] This label with no preceeding newline appears to span the 512byte boundary at byte $b[a] [a+ yellow bold]from file start[a]" }
puts stdout "[a+ bold yellow] label starting at $b : $pline_tail[a]" if {$labelfound} {
set tail_start $b set label_found_name [dict get $labelinfo label]
set tail_end [expr {$b + [string length $pline_tail]}] incr found_backward_label
set tail_spaninfo [fileline::range_spans_chunk_boundaries $tail_start $tail_end 512]
if {[dict get $tail_spaninfo is_span]} { lappend error_labels [list label $label_found_name file_offset_bytes $b note "label at boundary but no preceeding newline - cmd may interpret as label and execute following line or code at next boundary" callsite [list call ${call}${labelplus} call_linenum $callingline_num]]
set tail_boundaries [dict get $tail_spaninfo boundaries]
set extra_tail_boundaries [lsearch -all -inline -not $tail_boundaries $b] puts stdout "[a+ bold red]ERROR: *possible* label '$label_found_name' at line $p_linenum and offset from file start: $b line start: $pline_begin[a]"
if {[llength $extra_tail_boundaries]} { puts stdout "[a+ bold red] This label with no preceeding newline appears to span the 512byte boundary at byte $b[a] [a+ yellow bold]from file start[a]"
puts "Line $p_linenum also spans additional boundaries: $extra_tail_boundaries" puts stdout "[a+ bold red] cmd.exe may find this label - but it probably shouldn't be relied upon[a]"
set next_boundary [lindex $extra_tail_boundaries 0] puts stdout "[a+ bold yellow] label starting at $b : $pline_tail[a]"
set next_boundary_data [string range $pline [expr {$prior_total_offset + $next_boundary}] end]
puts "Line $p_linenum data at next boundary: [a+ yellow bold]$next_boundary_data[a]" set target_label_record [list label $label_found_name line $p_linenum]
puts "[a+ yellow bold]NOTE: cmd may attempt to treat this data as code[a]" if {$label_found_name in [dict keys $call_labels_found]} {
dict set target_label_record error "called_label_at_file_offset_boundary"
dict lappend target_labels_found $label_found_name $target_label_record
} else {
#review - we need to get better at finding all calls!
dict set target_label_record error "uncalled_label_at_file_offset_boundary"
dict lappend possible_target_labels_found $label_found_name $target_label_record
} }
} else {
if {$pidx+1 < [$objFile linecount]} {
set nextlineinfo [$objFile lineinfo $pidx+1] set tail_start $b
set nextpayload [dict get $nextlineinfo payload] set tail_end [expr {$b + [string length $pline_tail]}]
puts "Line $p_linenum + 1 has data: [a+ yellow bold]$nextpayload[a]" set tail_spaninfo [fileline::range_spans_chunk_boundaries $tail_start $tail_end 512]
puts "[a+ yellow bold]NOTE: cmd may attempt to treat this data as code[a]" if {[dict get $tail_spaninfo is_span]} {
set tail_boundaries [dict get $tail_spaninfo boundaries]
set extra_tail_boundaries [lsearch -all -inline -not $tail_boundaries $b]
if {[llength $extra_tail_boundaries]} {
puts "Line $p_linenum also spans additional boundaries: $extra_tail_boundaries"
set next_boundary [lindex $extra_tail_boundaries 0]
#boundary doesn't reset if no crlf - we are still within the line - so can calc from line beginning
set next_boundary_data [string range $pline [expr {$pline_begin + $next_boundary}] end]
puts "Line $p_linenum data at next boundary: [a+ yellow bold]$next_boundary_data[a]"
puts [$objFile chunk_boundary_display [dict get $plineinfo start] [dict get $plineinfo end] 0 -boundaries $next_boundary -linebase 1 -limit 1]
puts "[a+ yellow bold]NOTE: cmd may attempt to treat this data as code[a]"
}
} else { } else {
#EOF reached if {$pidx+1 < [$objFile linecount]} {
set nextlineinfo [$objFile lineinfo $pidx+1]
set nextpayload [dict get $nextlineinfo payload]
puts "Line $p_linenum + 1 has data: [a+ yellow bold]$nextpayload[a]"
puts "[a+ yellow bold]NOTE: cmd may attempt to treat this data as code[a]"
} else {
#EOF reached
}
} }
} }
} }
@ -410,29 +663,74 @@ namespace eval punk::mix::commandset::scriptwrap {
} }
} }
incr prior_total_offset $pline_bytes incr pline_begin $pline_bytes
} }
if {$found_forward_label == 0} { if {$found_forward_label == 0} {
if {[string toupper $label] eq "EOF"} { if {[string toupper $label] eq "EOF"} {
#EOF/eof label is special - it doesn't have to exist - but if it does - it probably shouldn't be on a boundary #EOF/eof label is special - it doesn't have to exist - but if it does - it probably shouldn't be spanning a boundary
puts stdout "[a+ bold green]OK: label :$label doesn't exist - but it's not required. callsite: [list call ${call}${labelplus} call_linenum $linenum] [a]" puts stdout "[a+ bold green]OK: label :$label doesn't exist - but it's usually not meant to. callsite: [list call ${call}${labelplus} call_linenum $callingline_num] [a]"
} else { } else {
if {$found_backward_label == 0} { if {$found_backward_label == 0} {
lappend warning_labels [list label $label warning label_not_found callsite [list call ${call}${labelplus} call_linenum $linenum]] lappend warning_labels [list label $label warning label_not_found callsite [list call ${call}${labelplus} call_linenum $callingline_num]]
puts stdout "[a+ bold yellow]WARNING: label :$label not found (in forward or backward scan)[a]" puts stdout "[a+ bold yellow]WARNING: label :$label not found (in forward or backward scan)[a]"
} }
} }
} }
if {($found_forward_label + $found_backward_label) > 1} { if {($found_forward_label + $found_backward_label) > 1} {
lappend warning_labels [list label $label warning multiple_labels_found callsite [list call ${call}${labelplus} call_linenum $linenum]] #puts "target_labels_found: $target_labels_found"
puts stdout "[a+ bold yellow]WARNING: label :$label seems to appear multiple times[a]" dict for {targetkey targethits} $target_labels_found {
set targetlines [list]
foreach record $targethits {
lappend targetlines [dict get $record line]
}
set remaining [list]
set previous "" ;
foreach lnum [lsort -integer -increasing $targetlines] {
if {$previous eq ""} {
lappend remaining $lnum
} else {
if {$lnum-1 == $previous} {
puts stdout "[a+ green bold]OK[a] - target-label $targetkey appears on immediately adjacent lines $previous and $lnum - assuming it is a boundary-avoidance tactic rather than an inadvertent duplicate"
set remaining [lrange $remaining 0 end-1];#retain latest - we will allow a run of targets on subsequent lines
}
lappend remaining $lnum
}
set previous [lindex $remaining end]
}
if {[llength $remaining] > 1} {
lappend warning_labels [list label $label warning multiple_target_labels_found callsite [list call ${call}${labelplus} call_linenum $callingline_num]]
puts stdout "[a+ bold yellow]WARNING: label :$label seems to appear multiple times[a]"
}
}
} }
} }
} }
incr file_offset [string length $ln] incr file_offset $callingline_len ;#including per-line stored line-ending
incr file_offset ;# for unix nl }
if {[dict size $possible_target_labels_found] > 0} {
#puts stdout "Possibly bogus target-labels: [dict keys $possible_target_labels_found]"
set bogus_summary [list]
foreach pb [dict keys $possible_target_labels_found] {
if {$pb in [dict keys $call_labels_found]} {
puts stdout "[a+ yellow bold]Warning - target for label $pb was found with a record as being possibly bogus. record: [dict get $possible_target_labels_found $pb][a]"
puts stdout "[a+ yellow bold]Consider moving this target-label and re-checking[a]"
puts stdout "[a+ yellow bold]It may be a call label line that was found by boundary scanning - which shouldn't really happen[a]"
puts stdout "Call record [dict get $call_labels_found $pb]"
lappend warning_labels [list label $pb warning possibly_bogus_target list_of_target_hits [dict get $possible_target_labels_found $pb]]
}
set records [dict get $possible_target_labels_found $pb]
set blines [list]
foreach rec $records {
lappend blines [dict get $rec line]
}
lappend bogus_summary [list label $pb found_on_lines $blines]
}
puts stdout "[a+ cyan]Possibly bogus target-labels: $bogus_summary[a]"
puts stdout "These are usually nothing to be concerned about. Some will almost always turn up in a polyglot script that contains batch script."
puts stdout "If some of the label names appear to contain newlines, or are prefixes of or exact matches with legitimate labels - you might consider adjusting the boundary spacing with whitespace or comments to get a different result."
} }
set result ""
if {[llength $warning_labels]} { if {[llength $warning_labels]} {
append result "WARNING:" \n append result "WARNING:" \n
append result "The following labels had warnings" \n append result "The following labels had warnings" \n
@ -450,6 +748,15 @@ namespace eval punk::mix::commandset::scriptwrap {
append result " [a+ bold red]$err[a]" \n append result " [a+ bold red]$err[a]" \n
} }
} }
if {[dict size $warning_target_labels_found] > 0} {
puts stdout "target-labels with minor warnings: [dict keys $warning_target_labels_found]"
}
append result "call-labels-found: [dict keys $call_labels_found]" \n
append result "target-labels-found: [dict keys $target_labels_found]" \n
if {![llength $warning_labels] && ![llength $error_labels]} {
puts stderr \n
puts stderr "[a+ green bold]OK No warnings or errors considered major enough to return in result.[a]"
}
return $result return $result
} }
#specific filepath to just wrap one script at the tcl-payload or xxx-payload-pre-tcl site #specific filepath to just wrap one script at the tcl-payload or xxx-payload-pre-tcl site
@ -459,6 +766,7 @@ namespace eval punk::mix::commandset::scriptwrap {
-askme 1\ -askme 1\
-outputfolder "\uFFFF"\ -outputfolder "\uFFFF"\
-template "\uFFFF"\ -template "\uFFFF"\
-returnextra 0\
] ]
set known_opts [dict keys $defaults] set known_opts [dict keys $defaults]
dict for {k v} $args { dict for {k v} $args {
@ -481,6 +789,7 @@ namespace eval punk::mix::commandset::scriptwrap {
set opt_askme [dict get $opts -askme] set opt_askme [dict get $opts -askme]
set opt_template [dict get $opts -template] set opt_template [dict get $opts -template]
set opt_outputfolder [dict get $opts -outputfolder] set opt_outputfolder [dict get $opts -outputfolder]
set opt_returnextra [dict get $opts -returnextra]
# -- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- ---
@ -794,6 +1103,10 @@ namespace eval punk::mix::commandset::scriptwrap {
set check_result [checkoutput $output_file] set check_result [checkoutput $output_file]
set with_errors "" set with_errors ""
set with_warnings "" set with_warnings ""
set call_labels [list]
set target_labels [list]
set errorlist [list]
set warninglist [list]
if {$check_result ne ""} { if {$check_result ne ""} {
puts stdout $check_result puts stdout $check_result
set check_lines [split $check_result \n] set check_lines [split $check_result \n]
@ -801,18 +1114,40 @@ namespace eval punk::mix::commandset::scriptwrap {
set trimcl [string trim $cl] set trimcl [string trim $cl]
if {[string match "ERROR:*" $trimcl]} { if {[string match "ERROR:*" $trimcl]} {
set with_errors "[a+ bold red]with errors[a]" set with_errors "[a+ bold red]with errors[a]"
lappend errorlist $trimcl
} }
if {[string match "WARNING:*" $trimcl]} { if {[string match "WARNING:*" $trimcl]} {
set with_warnings "[a+ bold yellow] with warnings[a]" set with_warnings "[a+ bold yellow] with warnings[a]"
lappend errorlist $trimcl
}
if {[string match "call-labels-found:*" $trimcl]} {
set call_labels [string trim [string range $trimcl [string length "call-labels-found:"] end]]
}
if {[string match "target-labels-found:*" $trimcl]} {
set target_labels [string trim [string range $trimcl [string length "target-labels-found:"] end]]
} }
} }
} else {
puts stderr "Expected output from checkoutput - but got none"
} }
#even though chmod might exist on windows - we will leave permissions alone #even though chmod might exist on windows - we will leave permissions alone
if {$::tcl_platform(platform) ne "windows"} { if {$::tcl_platform(platform) ne "windows"} {
catch {exec chmod +x $output_file} catch {exec chmod +x $output_file}
} }
puts stdout "-done- $with_errors $with_warnings" puts stdout "-done- $with_errors $with_warnings"
return $output_file if {$opt_returnextra} {
set result [list filename $output_file batch_call_labels $call_labels batch_target_labels $target_labels]
if {[llength $warninglist]} {
dict set result warnings $warninglist
}
if {[llength $errorlist]} {
dict set result errors $errorlist
}
} else {
set result [list filename $output_file]
}
return $result
} }
namespace eval lib { namespace eval lib {
@ -1027,10 +1362,31 @@ namespace eval punk::mix::commandset::scriptwrap {
} }
namespace eval batchlib { namespace eval batchlib {
proc get_callsite_label {labelplus} { #
#see also: https://www.dostips.com/forum/viewtopic.php?t=3803 'Rules for label names vs GOTO and CALL
# review - we may need different get_callsite_label functions?
proc get_callsite_label {labelstart} {
#labelstart is the character immediately following the colon (which is optional at callsite) - a label such as ::label doesn't seem valid at call or target sites
#e.g for @goto %= possible comment=% :mylabe%%l etc
#we would expect to be passed only "mylabe%%1 etc"
#It is up to the caller to determine where a callsite label begins.
#note that:
#@REM -----
#@goto ^
#:label
#@REM-----
# is a valid callsite - but doesn't appear to be found by the label scanner as it's own target label even though :label is on it's own line from non-batch perspective
# so the caller will have to do some batch-style line processing to find all call sites
#Also, for the following 2 lines
#@REM ^
#:label
# the label will be found - yet if the :label was a command such as @GOTO - it would not be run as a callsite
#a quick'n'dirty fix for some ways various escapes are handled within labels at callsite. #a quick'n'dirty fix for some ways various escapes are handled within labels at callsite.
#There seem to be very different rules for labels at target site - presumably because they are not part of a command #There seem to be very different rules for labels at target site - presumably because they are not part of a command
# Mostly it seems target labels are more literal # Mostly it seems target labels are more literal with regards to % chars - but ^ are processed the same way at target label
#some rules.. #some rules..
#callsite labels can't have space between : and label - but target labels can #callsite labels can't have space between : and label - but target labels can
#label terminated by =,: even if prefixed by ^ and even if in squotes or dquotes #label terminated by =,: even if prefixed by ^ and even if in squotes or dquotes
@ -1038,46 +1394,203 @@ namespace eval punk::mix::commandset::scriptwrap {
#may resolve variables within the label - but characters from variable value can terminate. #may resolve variables within the label - but characters from variable value can terminate.
#as we don't have access to the variable values - we should normalize %varname% to empty string at callsite - but perhaps emit warning somewhere #as we don't have access to the variable values - we should normalize %varname% to empty string at callsite - but perhaps emit warning somewhere
# The target labels don't seem to # The target labels don't seem to
#a single % resolves to empty #a single % resolves to empty - depending. (starts invar processing - and decides if it was a var depending on whether it was closed?)
#sequences of % don't begin a var - number of % in labelname = number of %s divided by 2 and rounded down. ie 1->0 2->1 3-> 1 4->2 5->2 6->3 etc #sequences of % don't begin a var - number of % in labelname = number of %s divided by 2 and rounded down. ie 1->0 2->1 3-> 1 4->2 5->2 6->3 etc
#spaces in % wrapped var names don't terminate label #spaces in % wrapped var names don't terminate label
#spaces aren't escaped by ^ or quoting #spaces aren't escaped by ^ or quoting
#sequences of ^ seem to follow same counting rule as % #sequences of ^ seem to follow same counting rule as %
#e.g @goto :la%path%bel where path begins with C:\Program Files.. becomes label :laC #e.g @goto :la%path%bel where path begins with C:\Program Files.. becomes label :laC
if {[string index $labelstart 0] in [list : " " \t = {;}]} {
#return everything as tail - nothing was consumed
return [list labelfound 0 note "invalid first character for callsite label" tail $labelstart]
}
#The due to whitespace and most chars except : and % being alowed inside vars - it seems the best first step #The due to whitespace and most chars except : and % being alowed inside vars - it seems the best first step
# -------------- start % handling % # -------------- start % handling %
set chars [split $labelplus ""] set inputchars [split $labelstart ""]
set percentrun 0 set percentrun 0 ;#0|1 because we use invar-toggling rather than running total of number of percents in a sequence
set invar 0 set invar 0
set output "" set labelout ""
set varsfound [list]
foreach c $chars { set varterminals [list :]
set labelterminals [list + , {;} = " " \t]
set varname ""
set caretseq 0
set inputconsumed 0
foreach c $inputchars {
if {!$invar} { if {!$invar} {
if {$c ne "%"} { if {$c eq "%"} {
append output [string repeat % [expr {$percentrun / 2}]] $c set caretseq 0
set percentrun 0 set lookahead [lrange $inputchars $inputconsumed+1 end]
if {"%" in $lookahead} {
set invar 1
incr percentrun
} else {
incr percentrun
}
} elseif {$c eq "^"} {
if {$caretseq} {
set caretseq 0
append labelout "^" ;#for every pair encountered in direct sequence - second gets included in label
} else {
set caretseq 1
}
} else { } else {
set caretseq 0
if {$percentrun && ($c in [list 0 1 2 3 4 5 6 7 8 9])} {
#subst %i with value - here we have no way of getting that - so use blank - user will get warning that target not found
set percentrun 0
} else {
append labelout [string repeat % [expr {$percentrun / 2}]]
set percentrun 0
if {$c in $labelterminals} {
break
}
append labelout $c
}
} }
} else { } else {
#in var #in var - don't do anything with carets(?)
if {$c eq "%" && $percentrun == 0} { if {$c eq "%" && $percentrun == 1} {
set invar 1 #double percent - rather than just an empty var - emit one %
} elseif {$c eq "%"} append labelout %
set invar 0
set percentrun 0
} elseif {$c eq "%"} {
#presume percentrun is 0
set invar 0
lappend varsfound $varname; set varname ""
} elseif {$c in $varterminals} {
set invar 0
lappend varsfound $varname; set varname ""
} else { } else {
append varname $c if {$percentrun && ($c in [list 0 1 2 3 4 5 6 7 8 9])} {
#review - seems to terminate var - and substitute?
#this branch untested - case where we have %i and further % - what if it was %1var% ? does %1 get substituted ? or %1var% - test
set invar 0
append varname $c
} else {
append varname $c
}
set percentrun 0
} }
} }
incr inputconsumed
} }
# -------------- end % handling % # -------------- end % handling %
set tail [string range $labelstart $inputconsumed end]
#caret -- etc #caret -- etc
if {$labelout eq ""} {
set resultdict [dict create labelfound 0]
if {[llength $varsfound]} {
dict set resultdict vars $varsfound
dict set resultdict note "empty label but vars exist - may be legit"
} else {
dict set resultdict note "empty label - no vars"
}
dict set resultdict tail $tail
return $resultdict
}
return [list labelfound 1 label $labelout tail $tail]
}
proc get_target_label_from_line {labelline} {
#scan a whole line - or a 'line' starting at some chunk boundary we found for a label
#caller should resolve any trailing caret and subsequent line and include them in the call
#note that we may be scanning all sorts of things in a polyglot file - but we're interested in seeing if cmd.exe might interpret it as a label
#target labels don't have %var% processing - they will be literal
set firstcolon [string first : $labelline]
if {$firstcolon == -1} {
return [list labelfound 0 note "no_colon"]
}
set prefixpart [string range $labelline 0 $firstcolon-1]
set targetpart [string range $labelline $firstcolon+1 end]
set prefixok 1;#default assumption
set invisible_prefix_chars [list {;} , = " " \t]
set prefixchars [split $prefixpart ""]
# % and ^ in the prefix - whether doubled etc or not - will stop label being found
#ANY first char seems to be allowed in prefixpart (it won't be colon, because we already split on that)
#perhaps this is done by cmd.exe to reduce off-by-one errors?? weird...
# but it does allow labels to be found in certain # tcl/bashsh comment lines, which could be both dangerous and ...useful.
#start prefix check at char 1 instead of 0
foreach pchar [lrange $prefixchars 1 end] {
if {$pchar ni $invisible_prefix_chars} {
set prefixok 0
break
}
}
if {!$prefixok} {
return [list labelfound 0 note "prefix_fail"]
}
#no problems before colon - now see if targetpart can be interpreted as a label
#we again have some potential invisible chars before label begins.
set charindex [expr {$firstcolon +1}] ;#track position so we can return index of where we believe label begins
set targetchars [split $targetpart ""]
set inlabel 0
set labelposn -1
# ---
set inlabel_terminals [list : + " " \t \r \n] ;# , ; = don't seem to terminate a target label, but do terminate a calling label
# + and whitespace terminate caller and target
# ---
# consider:
#@goto :14^
# :14^
#caller is searching for label "14" but won't match - presumably target scanner has escaped the trailing space
set label ""
set rawlabel ""
set caretseq 0 ;# 0|1
foreach tchar $targetchars {
if {$tchar in [list + :]} {
break
}
if {!$inlabel} {
if {$tchar ni $invisible_prefix_chars} {
#beginning of target label
set labelposn $charindex
set inlabel 1
append rawlabel $tchar
if {$tchar eq "^"} {
set caretseq 1
} else {
append label $tchar
}
}
} else {
if {$tchar in $inlabel_terminals} {
#caret stops them from terminating
if {$caretseq} {
set caretseq 0
append label $tchar
append rawlabel $tchar
} else {
break
}
} else {
append rawlabel $tchar
if {$tchar eq "^"} {
if {$caretseq} {
set caretseq 0
append label "^" ;#for every pair encountered in direct sequence - second gets included in label
} else {
set caretseq 1
}
} else {
set caretseq 0
append label $tchar ;#for target labels - all including %var% is directly part of the label target
}
}
}
incr charindex
}
if {$labelposn == -1} {
return [list labelfound 0 note "no_label_found_after_colon"]
}
return [list label $label tail $tail] #return rawlabel so we can see it as it appears in the data - as opposed to how it is interpreted as a label by cmd.exe
return [list labelfound 1 label $label rawlabel $rawlabel]
} }
} }

80
src/modules/punk/mix/templates/utility/scriptappwrappers/punk-multishell.cmd

@ -18,26 +18,30 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
@REM On unix-like systems, call with sh, bash or tclsh. (powershell untested on unix - and requires wscript if security elevation is used) @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 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 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.
@SET "validshells=pwsh,sh,bash,tclsh" @SETLOCAL EnableExtensions EnableDelayedExpansion
@SET shells[10]="pwsh" @SET "validshells= ^(10^) 'pwsh' ^(11^) 'sh' (^12^) 'bash' (^13^) 'tclsh'"
@SET shells[11]="sh" @SET "shells[10]=pwsh"
@set shells[12]="bash" @SET "shells[11]=sh"
@SET shells[13]="tclsh" @set "shells[12]=bash"
@SET "shells[13]=tclsh"
: <nextshell> : <nextshell>
@SET "nextshell=tclsh" @SET "nextshell=13"
: </nextshell> : </nextshell>
@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). @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).
: <asadmin> : <asadmin>
@SET "asadmin=0" @SET "asadmin=0"
: </asadmin> : </asadmin>
@REM nextshell set to pwsh,sh,bash or tclsh @REM nextshell set to index for validshells .eg 10 for pwsh
@REM @ECHO nextshell is %nextshell% @REM @ECHO nextshell is %nextshell%
@CALL SET keyRemoved=%%validshells:%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 Note that 'powershell' e.g v5 is just a fallback for when pwsh is not available
@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### @REM ## ### ### ### ### ### ### ### ### ### ### ### ### ###
@REM -- cmd/batch file section (ignored on unix) @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 -- 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 is useful, but is probably the least expressive language and most error prone. @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 -- 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 -- 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 -- See also: https://stackoverflow.com/questions/4094699/how-does-the-windows-command-interpreter-cmd-exe-parse-scripts/4095133#4095133
@ -59,7 +63,6 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
@REM ############################################################################################################################ @REM ############################################################################################################################
@REM -- custom windows payloads should be in powershell,tclsh (or sh/bash if available) code sections @REM -- custom windows payloads should be in powershell,tclsh (or sh/bash if available) code sections
@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### @REM ## ### ### ### ### ### ### ### ### ### ### ### ### ###
@SETLOCAL EnableExtensions EnableDelayedExpansion
@SET "winpath=%~dp0" @SET "winpath=%~dp0"
@SET "fname=%~nx0" @SET "fname=%~nx0"
@REM @ECHO fname %fname% @REM @ECHO fname %fname%
@ -67,36 +70,35 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
@REM @ECHO commandlineascalled %0 @REM @ECHO commandlineascalled %0
@REM @ECHO commandlineresolved %~f0 @REM @ECHO commandlineresolved %~f0
@CALL :getNormalizedScriptTail nftail @CALL :getNormalizedScriptTail nftail
@ECHO normalizedscripttail %nftail% @REM @ECHO normalizedscripttail %nftail%
@CALL :getFileTail %0 clinetail @CALL :getFileTail %0 clinetail
@ECHO clinetail %clinetail% @REM @ECHO clinetail %clinetail%
@CALL :stringToUpper %~nx0 capscripttail @CALL :stringToUpper %~nx0 capscripttail
@ECHO capscriptname: %capscripttail% @REM @ECHO capscriptname: %capscripttail%
@CALL :isNumeric "blah"
@CALL :isNumeric etc
@CALL :isNumeric 3
@CALL :isNumeric 6
@IF %nftail%==%capscripttail% ( @IF "%nftail%"=="%capscripttail%" (
@ECHO forcing asadmin=1 due to file name on filesystem being uppercase @ECHO forcing asadmin=1 due to file name on filesystem being uppercase
@SET "asadmin=1" @SET "asadmin=1"
) else ( ) else (
@CALL :stringToUpper %clinetail% capcmdlinetail @CALL :stringToUpper %clinetail% capcmdlinetail
@ECHO capcmdlinetail %capcmdlintetail% @REM @ECHO capcmdlinetail !capcmdlinetail!
IF %clinetail%==%capcmdlinetail% ( IF "%clinetail%"=="!capcmdlinetail!" (
@ECHO forcing asadmin=1 due to cmdline scriptname in uppercase @ECHO forcing asadmin=1 due to cmdline scriptname in uppercase
@set "asadmin=1" @set "asadmin=1"
) )
) )
@SET "vbsGetPrivileges=%temp%\punk_bat_elevate_%fname%.vbs" @SET "vbsGetPrivileges=%temp%\punk_bat_elevate_%fname%.vbs"
@SET arglist=%* @SET arglist=%*
@IF "%1"=="PUNK-ELEVATED" (
GOTO :gotPrivileges
)
@IF !asadmin!==1 ( @IF !asadmin!==1 (
net file 1>NUL 2>NUL net file 1>NUL 2>NUL
@IF '!errorlevel!'=='0' ( GOTO gotPrivileges ) else ( GOTO getPrivileges ) @IF '!errorlevel!'=='0' ( GOTO :gotPrivileges ) else ( GOTO :getPrivileges )
) )
@GOTO skip_privileges @GOTO skip_privileges
:getPrivileges :getPrivileges
@IF '%1'=='PUNK-ELEVATED' (echo PUNK-ELEVATED & shift /1 & goto gotPrivileges) @IF '%1'=='PUNK-ELEVATED' (echo PUNK-ELEVATED & shift /1 & goto :gotPrivileges )
@ECHO Set UAC = CreateObject^("Shell.Application"^) > "%vbsGetPrivileges%" @ECHO Set UAC = CreateObject^("Shell.Application"^) > "%vbsGetPrivileges%"
@ECHO args = "PUNK-ELEVATED " >> "%vbsGetPrivileges%" @ECHO args = "PUNK-ELEVATED " >> "%vbsGetPrivileges%"
@ECHO For Each strArg in WScript.Arguments >> "%vbsGetPrivileges%" @ECHO For Each strArg in WScript.Arguments >> "%vbsGetPrivileges%"
@ -111,7 +113,7 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
@REM setlocal & pushd . @REM setlocal & pushd .
@PUSHD . @PUSHD .
@cd /d %~dp0 @cd /d %~dp0
@IF '%1'=='PUNK-ELEVATED' ( @IF "%1"=="PUNK-ELEVATED" (
@DEL "%vbsGetPrivileges%" 1>nul 2>nul @DEL "%vbsGetPrivileges%" 1>nul 2>nul
@SET arglist=%arglist:~14% @SET arglist=%arglist:~14%
) )
@ -125,17 +127,17 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
fc "%~dp0%~n0.cmd" "%~dp0%~n0.ps1" >nul || goto different fc "%~dp0%~n0.cmd" "%~dp0%~n0.ps1" >nul || goto different
@REM @ECHO "files same" @REM @ECHO "files same"
@SET need_ps1=0 @SET need_ps1=0
@GOTO :pscontinue
:different
@REM @ECHO "files differ"
@SET need_ps1=1
) )
@GOTO :pscontinue
:different
@REM @ECHO "files differ"
@SET need_ps1=1
:pscontinue :pscontinue
@IF !need_ps1!==1 ( @IF !need_ps1!==1 (
COPY "%~dp0%~n0.cmd" "%~dp0%~n0.ps1" >NUL COPY "%~dp0%~n0.cmd" "%~dp0%~n0.ps1" >NUL
) )
@REM avoid using CALL to launch pwsh,tclsh etc - it will intercept some args such as /? @REM avoid using CALL to launch pwsh,tclsh etc - it will intercept some args such as /?
@IF %nextshell%==pwsh ( @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 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 REM test availability of preferred option of powershell7+ pwsh
pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; write-host "statusmessage: pwsh-found" >NUL pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; write-host "statusmessage: pwsh-found" >NUL
@ -151,18 +153,18 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
SET task_exitcode=!errorlevel! SET task_exitcode=!errorlevel!
) )
) ELSE ( ) ELSE (
IF %nextshell%==bash ( IF "!shells[%nextshell%]!"=="bash" (
CALL :getWslPath %winpath% wslpath CALL :getWslPath %winpath% wslpath
REM ECHO wslfullpath "!wslpath!%fname%" REM ECHO wslfullpath "!wslpath!%fname%"
%nextshell% "!wslpath!%fname%" %arglist% & SET task_exitcode=!errorlevel! !shells[%nextshell%]! "!wslpath!%fname%" %arglist% & SET task_exitcode=!errorlevel!
) ELSE ( ) ELSE (
REM probably tclsh or sh REM probably tclsh or sh
IF NOT "x%keyRemoved%"=="x%validshells%" ( 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 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 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
%nextshell% "%~dp0%fname%" %arglist% & SET task_exitcode=!errorlevel! !shells[%nextshell%]! "%~dp0%fname%" %arglist% & SET task_exitcode=!errorlevel!
) ELSE ( ) ELSE (
ECHO %fname% has invalid nextshell value %nextshell% valid options are %validshells% ECHO %fname% has invalid nextshell value ^(%nextshell%^) !shells[%nextshell%]! valid options are %validshells%
SET task_exitcode=66 SET task_exitcode=66
GOTO :exit_multishell GOTO :exit_multishell
) )
@ -170,6 +172,7 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
) )
@REM batch file library functions @REM batch file library functions
@GOTO :endlib @GOTO :endlib
:getWslPath :getWslPath
@SETLOCAL @SETLOCAL
@SET "_path=%~p1" @SET "_path=%~p1"
@ -223,7 +226,7 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
) )
) )
@EXIT /B @EXIT /B
@REM boundary padding
:getNormalizedScriptTail :getNormalizedScriptTail
@SETLOCAL @SETLOCAL
@SET "result=%~nx0" @SET "result=%~nx0"
@ -240,6 +243,8 @@ set -- "$@" "a=[list shebangless punk MULTISHELL tclsh sh bash cmd pwsh powershe
:getNormalizedFileTailFromPath :getNormalizedFileTailFromPath
@REM warn via echo, and do not set return variable if path not found @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 note that %~nx1 does not preserve case of provided path - hence the name 'normalized'
@REM boundary padding
@REM boundary padding
@SETLOCAL @SETLOCAL
@CALL :stringContains %~1 "\" hasBackSlash @CALL :stringContains %~1 "\" hasBackSlash
@CALL :stringContains %~1 "/" hasForwardSlash @CALL :stringContains %~1 "/" hasForwardSlash
@ -403,7 +408,7 @@ shift && set -- "${@:1:$#-1}"
# -- This if block only needed if Tcl didn't exit or return above. # -- This if block only needed if Tcl didn't exit or return above.
if false==false # else { if false==false # else {
then then
: : #
# ## ### ### ### ### ### ### ### ### ### ### ### ### ### # ## ### ### ### ### ### ### ### ### ### ### ### ### ###
# -- sh/bash script section # -- sh/bash script section
# -- leave as is if all that is required is launching the Tcl payload" # -- leave as is if all that is required is launching the Tcl payload"
@ -487,12 +492,13 @@ $1 = @'
' '
: comment end hide powershell-block from Tcl \ : comment end hide powershell-block from Tcl \
# This comment with closing brace should stay in place whether 'if' commented or not } # This comment with closing brace should stay in place whether 'if' commented or not }
: multishell cmd exit label - return exitcode : multishell doubled-up cmd exit label - return exitcode
:exit_multishell
:exit_multishell :exit_multishell
: \ : \
@REM @ECHO exitcode: !task_exitcode! @REM @ECHO exitcode: !task_exitcode!
: \ : \
@IF '%asadmin%'=='1' (echo. & @cmd /k echo elevated prompt: type exit to quit) @IF "%1"=="PUNK-ELEVATED" (echo. & @cmd /k echo elevated prompt: type exit to quit)
: \ : \
@EXIT /B !task_exitcode! @EXIT /B !task_exitcode!
# cmd has exited # cmd has exited

19
src/modules/punk/mix/util-999999.0a1.0.tm

@ -35,13 +35,10 @@ namespace eval punk::mix::util {
namespace export * namespace export *
#NOTE fileutil::cat seems to silently ignore options if passed at end instead of before file!
proc fcat {args} { proc fcat {args} {
variable has_winpath variable has_winpath
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set knownopts [list -eofchar -translation -encoding --] set knownopts [list -eofchar -translation -encoding --]
set last_opt 0 set last_opt 0
@ -73,7 +70,21 @@ namespace eval punk::mix::util {
if {![llength $paths]} { if {![llength $paths]} {
error "Unable to find file in the supplied arguments: $args. Ensure options are all -opt val pairs and that file name(s) follow" error "Unable to find file in the supplied arguments: $args. Ensure options are all -opt val pairs and that file name(s) follow"
} }
#puts stderr "opts: $opts paths: $paths" #puts stderr "opts: $opts paths: $paths"
#let's proceed, but warn the user if an apparent option is in paths
foreach opt [list -encoding -eofchar -translation] {
if {$opt in $paths} {
puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
}
}
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set finalpaths [list] set finalpaths [list]
foreach p $paths { foreach p $paths {
if {$has_winpath && [punk::winpath::illegalname_test $p]} { if {$has_winpath && [punk::winpath::illegalname_test $p]} {

15
src/scriptapps/punk.tcl

@ -0,0 +1,15 @@
#puts stdout "launching punk87"
set dirname [file dirname [file normalize [info script]]]
if {[file tail $dirname] eq "bin"} {
if {[file exists [file join $dirname ../src/punk86.vfs/main.tcl]]} {
#tclsh [file join $dirname ../src/punk86.vfs/main.tcl] {*}$::argv
source [file join $dirname ../src/punk86.vfs/main.tcl]
} else {
puts stderr "Unable to locate punk87 entry-point main.tcl"
}
} else {
puts stderr "punk87 launch script must be run from the punk bin folder"
}
#puts stdout "-done-"
Loading…
Cancel
Save