From cf62cebc8b838fa08d16d5613895f1fe4761bfd0 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 25 Oct 2025 18:34:24 +1100 Subject: [PATCH] punk::args example fixes, grepstr fixes, more tclcore docs --- src/modules/punk-0.1.tm | 253 +- src/modules/punk/args-999999.0a1.0.tm | 245 +- .../args/moduledoc/tclcore-999999.0a1.0.tm | 2301 ++++++++++++++--- .../args/moduledoc/tkcore-999999.0a1.0.tm | 34 +- src/modules/punk/imap4-999999.0a1.0.tm | 98 +- src/modules/punk/ns-999999.0a1.0.tm | 3 +- 6 files changed, 2327 insertions(+), 607 deletions(-) diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index e05e1d42..1a642c70 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -564,14 +564,15 @@ namespace eval punk { "Grep for regex pattern in plaintext of supplied (possibly ANSI) string."\ -help\ "The grepstr command can find strings in ANSI text even if there are interspersed - ANSI colour codes etc. Even if a word has different coloured/styled letters, the + ANSI colour codes etc. Even if a word has different coloured/styled letters, the regex can match the plaintext. (Search is performed on ansistripped text, and then the matched sections are highlighted and overlayed on the original styled/colourd input. + If the input string has ANSI movement codes - the resultant text may not be directly searchable because the parts of a word may be separated by various codes and other plain text. To search such an input string, the string should first be 'rendered' to - a form where the ANSI only represents SGR styling (and perhaps other non-movement + a form where the ANSI only represents SGR styling (and perhaps other non-movement codes) using something like overtype::renderline or overtype::rendertext." @leaders -min 0 -max 0 @@ -589,7 +590,7 @@ namespace eval punk { except that when instead using -returnlines all with --line-number, the * indicator after the linenumber will only be highlighted for lines with matches, and the following matchcount will indicate zero for non-matching lines." - } + } -B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num -C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\ "Print num lines of leading and trailing context surrounding each match." @@ -628,7 +629,10 @@ namespace eval punk { -- -type none @values pattern -type string -help\ - "regex pattern to match in plaintext portion of ANSI string" + "regex pattern to match in plaintext portion of ANSI string + The pattern may contain bracketed capturing groups, which + will be highlighted (todo) in the result. If there is no capturing + group, the entire match will be highlighted." string -type string } proc grepstr {args} { @@ -670,40 +674,117 @@ namespace eval punk { } set data [string map {\r\n \n} $data] - if {![punk::ansi::ta::detect $data]} { + if {[punk::ansi::ta::detect $data]} { + set raw_has_ansi 1 + set plain [punk::ansi::ansistrip $data] + } else { + set raw_has_ansi 0 + set plain $data + } + set plainlines [split $plain \n] set lines [split $data \n] - set matches [lsearch -all {*}$nocase -regexp $lines $pattern] - set result "" + set matched_line_indices [lsearch -all {*}$nocase -regexp $plainlines $pattern] if {$opt_returnlines eq "all"} { set returnlines [punk::lib::range 0 [llength $lines]-1] } else { - #matches|breaksandmatches - set returnlines $matches + set returnlines $matched_line_indices } set max [lindex $returnlines end] if {[string is integer -strict $max]} { + #if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary. incr max } set w1 [string length $max] - #lineindex is zero based - display of linenums is 1 based + set result "" + set placeholder \UFFEF ;#review set resultlines [dict create] foreach lineindex $returnlines { - set ln [lindex $lines $lineindex] - set col1 "" - if {$do_linenums} { - set col1 [format "%${w1}s " [expr {$lineindex+1}]] + set ln [lindex $lines $lineindex] + set col1 "" + if {$do_linenums} { + set col1 [format "%${w1}s " [expr {$lineindex+1}]] + } + if {$lineindex in $matched_line_indices} { + set plain_ln [lindex $plainlines $lineindex] + #first test the regexp with a single match to determine number of capturing groups + set matchparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup... + set numgroups [expr {[llength $matchparts] -1}] + + set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln] + #allparts includes each full match as well as each capturing group + #early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now. + set matchcount [expr {[llength $allparts] / ($numgroups + 1)}] + #set matchcount [llength $allparts] + + if {$matchcount == 0} { + #This probably can't happen (?) + #If it does.. it's more likely to be an issue with our line index than with regexp + puts stderr "Unexpected regex mismatch in grepstr (shouldn't happen) regex: $pattern lineindex: $lineindex" + set matchshow "??? $ln" + dict set resultlines $lineindex $matchshow + continue } - if {$lineindex in $matches} { - set ln [regsub -all {*}$nocase -- $pattern $ln $H&$R] ;#n - set matchcount [regexp -all {*}$nocase -- $pattern $ln] - if {$do_linenums} { - append col1 $H*$R[format %03s $matchcount] + + # ------------------------------------ + if {$numgroups > 0} { + # restrict ourself to just the capture groups, excluding the full match (if there are capture groups) + set highlight_ranges [list] + set i 0 + foreach range $allparts { + if {($i % ($numgroups+1)) != 0} { + lappend highlight_ranges $range + } + incr i } } else { - if {$do_linenums} { - append col1 "*000" + #No capture group in the regex, each index range is just a full match + set highlight_ranges $allparts + } + # ------------------------------------ + + #puts stderr "numgroups : $numgroups" + #puts stderr "grepstr pattern : $pattern" + #puts stderr "grepstr allparts: $allparts" + #puts stderr "highlight_ranges: $highlight_ranges" + if {$do_linenums} { + append col1 $H*$R[format %03s $matchcount] + } + + if {$raw_has_ansi} { + set overlay "" + set i 0 + foreach hrange $highlight_ranges { + lassign $hrange s e + set prelen [expr {$s - $i}] + #append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R + append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e] + set i [expr {$e + 1}] + } + set tail [string range $plain_ln $e+1 end] + append overlay [string repeat $placeholder [string length $tail]] + #puts "$overlay" + #puts "$ln" + #set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay] + set rendered [overtype::renderspace -transparent $placeholder -insert_mode 0 $ln $overlay] + } else { + set rendered "" + set i 0 + foreach hrange $highlight_ranges { + lassign $hrange s e + set prelen [expr {$s - $i}] + #append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e] + append rendered [string range $plain_ln $i $s-1] $H [string range $plain_ln $s $e] $R + set i [expr {$e + 1}] } + append rendered [string range $plain_ln $e+1 end] + } + + if {$do_linenums} { + set matchshow "$col1 $rendered" + } else { + set matchshow $rendered } + #--------------------------------------------------------------- set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1] set s [expr {$lineindex-$beforecontext-1}] @@ -721,12 +802,7 @@ namespace eval punk { } } #--------------------------------------------------------------- - if {$do_linenums} { - set show "$col1 $ln" - } else { - set show $ln - } - dict set resultlines $lineindex $show + dict set resultlines $lineindex $matchshow #--------------------------------------------------------------- set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext] set s $lineindex @@ -742,109 +818,16 @@ namespace eval punk { } } #--------------------------------------------------------------- - - } - } else { - set plain [punk::ansi::ansistrip $data] - set plainlines [split $plain \n] - set lines [split $data \n] - set matches [lsearch -all {*}$nocase -regexp $plainlines $pattern] - if {$opt_returnlines eq "all"} { - set returnlines [punk::lib::range 0 [llength $lines]-1] } else { - set returnlines $matches - } - set max [lindex $returnlines end] - if {[string is integer -strict $max]} { - #if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary. - incr max - } - set w1 [string length $max] - set result "" - set placeholder \UFFEF ;#review - set resultlines [dict create] - foreach lineindex $returnlines { - set ln [lindex $lines $lineindex] - set col1 "" if {$do_linenums} { - set col1 [format "%${w1}s " [expr {$lineindex+1}]] - } - if {$lineindex in $matches} { - set plain_ln [lindex $plainlines $lineindex] - set parts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln] - set matchcount [llength $parts] - if {$do_linenums} { - append col1 $H*$R[format %03s $matchcount] - } - if {[llength $parts] == 0} { - #This probably can't happen (?) - #If it does.. it's more likely to be an issue with our line index than with regexp - puts stderr "Unexpected regex mismatch in grepstr - line marked with ??? (shouldn't happen)" - set matchshow "??? $ln" - #dict set resultlines $lineindex $show - } else { - set overlay "" - set i 0 - foreach prange $parts { - lassign $prange s e - set prelen [expr {$s - $i}] - append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R - set i [expr {$e + 1}] - } - set tail [string range $plain_ln $e+1 end] - append overlay [string repeat $placeholder [string length $tail]] - #puts "$overlay" - #puts "$ln" - set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay] - if {$do_linenums} { - set matchshow "$col1 $rendered" - } else { - set matchshow $rendered - } - } - #--------------------------------------------------------------- - set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1] - set s [expr {$lineindex-$beforecontext-1}] - if {$s < -1} {set s -1} - foreach p $prelines { - incr s - #append result "[format %${w1}s [expr {$s+1}]]- " " " $p \n - if {![dict exists $resultlines $s]} { - if {$do_linenums} { - set show "[format "%${w1}s " [expr {$s+1}]]- $p" - } else { - set show $p - } - dict set resultlines $s $show - } - } - #--------------------------------------------------------------- - dict set resultlines $lineindex $matchshow - #--------------------------------------------------------------- - set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext] - set s $lineindex - foreach p $postlines { - incr s - if {![dict exists $resultlines $s]} { - if {$do_linenums} { - set show "[format "%${w1}s " [expr {$s+1}]]- $p" - } else { - set show $p - } - dict set resultlines $s $show - } - } - #--------------------------------------------------------------- + append col1 "*000" + set show "$col1 $ln" } else { - if {$do_linenums} { - append col1 "*000" - set show "$col1 $ln" - } else { - set show $ln - } - dict set resultlines $lineindex $show + set show $ln } + dict set resultlines $lineindex $show } + } set ordered_resultlines [lsort -integer [dict keys $resultlines]] set result "" @@ -7828,6 +7811,7 @@ namespace eval punk { lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"] + lappend cmdinfo [list eg "cmd ?subcommand...?" "Show example from manpage"] lappend cmdinfo [list ./ "?subdir?" "view/change directory"] lappend cmdinfo [list ../ "" "go up one directory"] lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] @@ -7884,12 +7868,19 @@ namespace eval punk { append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/1095bf7f75]" append warningblock [a] } - if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} { - set indent " " - append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n - append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n - append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]" - append warningblock [a] + if {[catch {lsearch -stride 2 {a b} b}]} { + set indent " " + append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n + append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n + append warningblock [a] + } else { + if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} { + set indent " " + append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n + append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n + append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]" + append warningblock [a] + } } if {[punk::lib::check::has_tclbug_list_quoting_emptyjoin]} { set indent " " diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 17da1346..1a08e77d 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -270,6 +270,165 @@ tcl::namespace::eval punk::args::register { tcl::namespace::eval ::punk::args {} +tcl::namespace::eval ::punk::args::helpers { + variable PUNKARGS + namespace export * + #proc B {} {return \x1b\[1m} ;#a+ bold + #proc N {} {return \x1b\[22m} ;#a+ normal + #proc I {} {return \x1b\[3m} ;#a+ italic + #proc NI {} {return \x1b\[23m} ;#a+ noitalic + proc I {} {punk::ansi::a+ italic} + proc B {} {punk::ansi::a+ bold} + proc N {} {punk::ansi::a+ normal} + proc NI {} {punk::ansi::a+ italic} + lappend PUNKARGS [list { + @id -id ::punk::args::helpers::example + @cmd -name punk::args::helpers::example\ + -summary\ + {Display formatting for argdoc example text}\ + -help\ + {Wrap } + @opts + -padright -type integer -default 2 -help\ + {Number of padding spaces to add on RHS of text block} + -syntax -type string -default tcl -choices {none tcl} -choicelabels { + tcl\ + " Very basic tcl syntax highlighting + of braces,square brackets and comments." + } + text -type string + }] + proc example {args} { + #only use punk::args::parse on the unhappy path + if {[llength $args] == 0} { + punk::args::parse $args withid ::punk::args::helpers::example + return + } + set str [lindex $args end] + set optlist [lrange $args 0 end-1] + if {[llength $optlist] %2 != 0} { + punk::args::parse $args withid ::punk::args::helpers::example + return + } + set defaults [dict create\ + -padright 2\ + -syntax tcl\ + ] + dict for {o v} $optlist { + switch -- $o { + -padright - -syntax {} + default { + punk::args::parse $args withid ::punk::args::helpers::example + return + } + } + } + set opts [dict merge $defaults $optlist] + set opt_padright [dict get $opts -padright] + set opt_syntax [dict get $opts -syntax] + + if {[string index $str 0] eq "\n"} { + set str [string range $str 1 end] + } + if {[string index $str end] eq "\n"} { + set str [string range $str 0 end-1] + } + #example is intended to run from a source doc that has already been dedented appropriately based on context + # - we don't want to further undent, hence -undent 0 + set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]] + #puts stderr ------------------- + #puts $str + #puts stderr ------------------- + if {$opt_padright > 0} { + set str [textblock::join -- $str [string repeat " " $opt_padright]] + } + set str [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] + #puts stderr ------------------- + #puts $str + #puts stderr ------------------- + + #rudimentary colourising (not full tcl syntax parsing) + #highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments + switch -- $opt_syntax { + tcl { + #result lines often indicated in examples by \u2192 → + #however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?) + set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one + set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {;\s*(#.*)} $str] + #TODO - fix grepstr highlighting (bg issues - why?) + set str [punk::grepstr -return all -highlight {Web-gray term-darkblue} {\{|\}} $str] + set str [punk::grepstr -return all -highlight {Web-gray term-orange1} {\[|\]} $str] + #puts stderr ------------------- + #puts $str + #puts stderr ------------------- + } + } + + set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"] + return $result + } + lappend PUNKARGS [list { + @id -id ::punk::args::helpers::strip_nodisplay_comments + @cmd -name punk::args::helpers::strip_nodisplay_comments\ + -summary\ + "strip # lines."\ + -help\ + "Strip lines beginning with # from the supplied text. + Whitespace prior to # is ignored, and ANSI is stripped + prior to examining each line for the # tag." + @values -min 1 -max 1 + text -optional 0 -help\ + "punk::args::define scripts must have properly balanced braces etc + as per Tcl rules. + Sometimes it is desired to display help text or examples demonstrating + unbalanced braces etc, but without escaping it in a way that shows the + escaping backslash in the help text. This balancing requirement includes + curly braces in comments. eg + ${[punk::args::helpers::example { + proc bad_syntax {args} { + #eg this is an unbalanced left curly brace { + # balancing right curly brace } + return $args + } + }]} + There is a second comment line in the above proc which begins + with # and contains the balancing right curly brace. + This shouldn't show in the example above. + The actual text is in a placeholder call to punk::args::helpers::example + to provide basic syntax highlighting and box background, and looks like + the following, but without the left-hand side pipe symbols. + ${[punk::args::helpers::example -syntax none { + | proc bad_syntax {args} { + | #eg this is an unbalanced left curly brace { + | # balancing right curly brace } + | return $args + | } + }]} + + A # comment can also be used just for commenting the help + source inline. + + The ${[B]}strip_nodisplay_comments${[N]} function is called automatically + by the help text generators in punk::args, and generally shouldn't need + to be used directly, but nevertheless resides in in punk::args::helpers + alongside the ${[B]}example${[N]} function which is intended for writers + of punk::args::define scripts (command documentors) to use. + " + }] + proc strip_nodisplay_comments {text} { + set display "" + foreach ln [split $text \n] { + if {![string match "#*" [string trimleft [punk::ansi::ansistrip $ln]]]} { + append display $ln \n + } + } + if {[string index $display end] eq "\n"} { + set display [string range $display 0 end-1] + } + return $display + } +} + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -624,8 +783,15 @@ tcl::namespace::eval punk::args { -maxsize (type dependant) -range (type dependant - only valid if -type is a single item) -typeranges (list with same number of elements as -type) - - + -help + for the @cmd directive - this is the main multiline description. + For an argument is the multi-line help that displays in the Help + column. + For the @examples directive this is the text for examples as + displayed with 'eg ' + For cases where unbalanced braces, double quotes are to + be displayed to the user without visible backslash escapes, + see 'i ::punk::args::helpers::strip_nodisplay_comments' " -dynamic -type boolean -default 0 -help\ "If -dynamic is true, tstr interpolations of the form \$\{\$var\} @@ -649,7 +815,7 @@ tcl::namespace::eval punk::args { from existing definitions (by id) for re-use of argument specifications and help text) e.g the following definition passes 2 blocks as text arguments - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[punk::args::helpers::example { punk::args::define { @id -id ::myns::myfunc @cmd -name myns::myfunc -help\ @@ -955,6 +1121,8 @@ tcl::namespace::eval punk::args { set LVL 2 if {!$is_dynamic} { + #todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved! + #(e.g example blocks will still have colour if previously resolved) if {[tcl::dict::exists $argdata_cache $cache_key]} { return [tcl::dict::get $argdata_cache $cache_key] } @@ -1082,6 +1250,19 @@ tcl::namespace::eval punk::args { set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record foreach rawline $linelist { #puts stderr "$record_line $rawline" + #XXX + #set rawtrimmed [string trim $rawline] + #if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} { + # regexp {(\s*).*} $rawline _ rawline_indent + # if {[string length $rawline_indent] <= [string length $record_base_indent]} { + # lappend records $linebuild + # set linebuild "" + # #prep for next record + # set in_record_continuation 0 + # incr record_id + # set record_line 0 + # } + #} set record_so_far [tcl::string::cat $linebuild $rawline] #ansi colours can stop info complete from working (contain square brackets) #review - when exactly are ansi codes allowed/expected in record lines. @@ -1174,6 +1355,10 @@ tcl::namespace::eval punk::args { set record_line 0 } } + if {$in_record_continuation} { + puts stderr "punk::args::resolve incomplete record:" + puts stderr "$linebuild" + } #puts stderr 1[lindex $records 1] #puts stderr 4[lindex $records 4] #puts stderr 5[lindex $records 5] @@ -1212,6 +1397,13 @@ tcl::namespace::eval punk::args { "" - # {continue} } incr record_number + if {[catch {lassign $trimrec firstword}]} { + puts stdout "----------------------------------------------" + puts stderr "rec: $rec" + set ::testrecord $rec + puts "records: $records" + puts stdout "----------------------------------------------" + } set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict if {[llength $record_values] % 2 != 0} { #todo - avoid raising an error - store invalid defs keyed on id @@ -3671,6 +3863,7 @@ tcl::namespace::eval punk::args { lappend blank_header_col "" #set cmdhelp_display [a+ brightwhite]$cmdhelp[a] #set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)] + set cmdhelp [punk::args::helpers::strip_nodisplay_comments $cmdhelp] set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp] } else { set cmdhelp_display "" @@ -4055,6 +4248,7 @@ tcl::namespace::eval punk::args { } set unindentedfields [Dict_getdef $arginfo -unindentedfields {}] set help [Dict_getdef $arginfo -help ""] + set help [punk::args::helpers::strip_nodisplay_comments $help] set allchoices_originalcase [list] set choices [Dict_getdef $arginfo -choices {}] set choicegroups [Dict_getdef $arginfo -choicegroups {}] @@ -4656,7 +4850,7 @@ tcl::namespace::eval punk::args { lappend PUNKARGS [list { @id -id ::punk::args::parse @cmd -name punk::args::parse -help\ - "parse and validate command arguments based on a definition. + {parse and validate command arguments based on a definition. In the 'withid' form the definition is a pre-existing record that has been created with ::punk::args::define, or indirectly by adding a definition to @@ -4673,23 +4867,25 @@ tcl::namespace::eval punk::args { Returns a dict of information regarding the parsed arguments example of basic usage for single option only: - punk::args::define { - @id -id ::myns::myfunc - @cmd -name myns::myfunc - @leaders -min 0 -max 0 - @opts - -configfile -type existingfile - #type none makes it a solo flag - -verbose -type none - @values -min 0 -max 0 - } - proc myfunc {args} { - set argd [punk::args::parse $args withid ::myns::myfunc] - lassign [dict values $argd] leaders opts values received solos - if {[dict exists $received] -configfile} { - puts \"have option for existing file [dict get $opts -configfile]\" - } - } + ${[punk::args::helpers::example { + punk::args::define { + @id -id ::myns::myfunc + @cmd -name myns::myfunc + @leaders -min 0 -max 0 + @opts + -configfile -type existingfile + #type none makes it a solo flag + -verbose -type none + @values -min 0 -max 0 + } + proc myfunc {args} { + set argd [punk::args::parse $args withid ::myns::myfunc] + lassign [dict values $argd] leaders opts values received solos + if {[dict exists $received] -configfile} { + puts "have option for existing file [dict get $opts -configfile]" + } + } + }]} The leaders, opts, values keys in the parse result dict are proper dicts. The received key is dict-like but can have repeated keys for arguments than can accept multiples. The value for each received element is the ordinal position. @@ -4698,7 +4894,7 @@ tcl::namespace::eval punk::args { to another procedure which also requires solos, because the opts dict contains solo flags with a 1 value or a list of 1's if it was a solo with -multiple true specified. - " + } @form -form {withid withdef} @leaders -min 1 -max 1 arglist -type list -optional 0 -help\ @@ -9152,7 +9348,8 @@ tcl::namespace::eval punk::args { return } if {[dict exists $spec examples_info -help]} { - return [dict get $spec examples_info -help] + set egdata [dict get $spec examples_info -help] + return [punk::args::helpers::strip_nodisplay_comments $egdata] } else { return "no @examples defined for $id" } @@ -10807,7 +11004,7 @@ tcl::namespace::eval punk::args::package { # set PUNKARGS "" #} -lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package +lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools diff --git a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm index d8f9971c..f90afc36 100644 --- a/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/moduledoc/tclcore-999999.0a1.0.tm @@ -124,14 +124,46 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { set NI [a+ noitalic] set B [a+ bold] set N [a+ normal] + set T [a+ bold underline] + set NT [a+ normal nounderline] + set LC \u007b ;#left curly brace + set RC \u007d ;#right curly brace # -- --- --- --- --- - proc example {str} { - set str [string trimleft $str \n] - set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] - set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"] - #puts $result - return $result - } + + namespace import ::punk::args::helpers::* + + #proc example {str} { + # if {[string index $str 0] eq "\n"} { + # set str [string range $str 1 end] + # } + # if {[string index $str end] eq "\n"} { + # set str [string range $str 0 end-1] + # } + # #example is intended to run from a source doc that has already been dedented appropriately based on context + # # - we don't want to further undent, hence -undent 0 + # set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]] + # #puts stderr ------------------- + # #puts $str + # #puts stderr ------------------- + + # set str [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] + # #puts stderr ------------------- + # #puts $str + # #puts stderr ------------------- + + # #rudimentary colourising (not full tcl syntax parsing) + # #highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments + # set str [punk::grepstr -return all -highlight {Web-gray term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one + # #TODO - fix grepstr highlighting (bg issues - why?) + # set str [punk::grepstr -return all -highlight {Web-gray term-darkblue} {\{|\}} $str] + # set str [punk::grepstr -return all -highlight {Web-gray term-orange1} {\[|\]} $str] + # #puts stderr ------------------- + # #puts $str + # #puts stderr ------------------- + + # set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"] + # return $result + #} } @@ -158,7 +190,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { namespace eval argdoc { lappend PUNKARGS [list { @id -id ::parray - @cmd -name "Autoloading Built-in: parray" -help\ + @cmd -name "Autoloading Built-in: parray"\ + -summary\ + "Display array on stdout"\ + -help\ "Prints on standard output the names and values of all the elements in the array arrayName, or just the names that match pattern (using the matching rules of string_match) and their values if pattern is given. @@ -170,8 +205,15 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "variable name of an array" pattern -type string -optional 1 -help\ "Match pattern possibly containing glob characters" - } "@doc -name Manpage: -url [manpage_tcl library]" ] - + } "@doc -name Manpage: -url [manpage_tcl library]"\ + { + @examples -help { + To print the contents of the ${$B}tcl_platform${$N} array, do: + ${[example { + ${$B}parray${$N} ::tcl_platform + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::foreachLine @@ -1283,47 +1325,48 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -unnamed true } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl encoding]"\ - {@examples -help { + { + @examples -help { These examples use the utility proc below that prints the Unicode code points comprising a Tcl string. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc codepoints s {join [lmap c [split $s {}] { - string cat U+ [format %.6X [scan $c %c]]}] + string cat U+ [format %.6X [scan $c %c]]}] } }]} Example 1: convert a byte sequence in Japanese euc-jp encoding to a TCL string: - ${[punk::args::moduledoc::tclcore::argdoc::example { - % codepoints [encoding convertfrom euc-jp "\xA4\xCF"] + ${[example { + % codepoints [encoding convertfrom euc-jp "\xA4\xCF"] U+00306F }]} The result is the unicode codepoint “\u306F”, which is the Hiragana letter HA. Example 2: Error handling based on profiles: The letter A is Unicode character U+0041 and the byte "\x80" is invalid in ASCII encoding. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { % codepoints [encoding convertfrom -profile tcl8 ascii A\x80] U+000041 U+000080 - % codepoints [encoding convertfrom -profile replace ascii A\x80] + % codepoints [encoding convertfrom -profile replace ascii A\x80] U+000041 U+00FFFD % codepoints [encoding convertfrom -profile strict ascii A\x80] unexpected byte sequence starting at index 1: '\x80' }]} Example 3: Get partial data and the error location: - ${[punk::args::moduledoc::tclcore::argdoc::example { - % codepoints [encoding convertfrom -profile strict -failindex idx ascii AB\x80] + ${[example { + % codepoints [encoding convertfrom -profile strict -failindex idx ascii AB\x80] U+000041 U+000042 % set idx 2 }]} Example 4: Encode a character that is not representable in ISO8859-1: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { % encoding convertto iso8859-1 A\u0141 A? % encoding convertto -profile strict iso8859-1 A\u0141 unexpected character at index 1: 'U+000141' - % encoding convertto -profile strict -failindex idx iso8859-1 A\u0141 + % encoding convertto -profile strict -failindex idx iso8859-1 A\u0141 A % set idx 1 @@ -1484,6 +1527,117 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } "@doc -name Manpage: -url [manpage_tcl chan]" ] + lappend PUNKARGS [list { + @id -id ::tcl::chan::copy + @cmd -name "Built-in: tcl::chan::copy"\ + -summary\ + "Read from one channel and write to another."\ + -help\ + "Reads characters from ${$I}inputChan${$NI} and writes them to ${$I}outputChan${$NI} until all characters are copied, + blocking until the copy is complete and returning the number of characters copied. Leverages + internal buffers to avoid extra copies and to avoid buffering too much data in main memory when + copying large files to slow destinations like network sockets. + + ${$B}-size${$N} limits the number of characters copied + + If ${$B}-command${$N} is given, ${$B}chan copy${$N} returns immediately, works in the background, and calls + ${$I}callback${$NI} when the copy completes, providing as an additional argument the number of characters + written to ${$I}outputChan${$NI}. If an error occurs during the background copy, another argument provides + message for the error. ${$I}inputChan${$NI} and ${$I}outputChan${$NI} are automatically configured for non-blocking + mode if needed. Background copying only works correctly if events are being processed, + e.g. via vwait or Tk. + + During a background copy no other read operation may be performed on ${$I}inputChan${$NI}, and no write + operation may be performed on ${$I}outputChan${$NI}. However, write operations may by performed on + ${$I}inputChan${$NI} and read operations may be performed on ${$I}outputChan${$NI}, as exhibited by the bidirectional + copy example below. + + If either ${$I}inputChan${$NI} or ${$I}outputChan${$NI} is closed while the copy is in progress, copying ceases and + no callback is made. If ${$I}inputChan${$NI} is closed all data already queued is written to ${$I}outputChan${$NI}. + + There should be no event handler established for ${$I}inputChan${$NI} because it may become readable + during a background copy. An attempt to read or write from within an event handler results + in the error, “channel busy”. Any wrong-sided I/O attempted (by a ${$B}chan event${$N} handler or + otherwise) results in a “channel busy” error." + @leaders + inputChan -type string + outputChan -type string + @opts + -size -type integer -typesynopsis {${$I}size${$NI}} + -command -type string -typesynopsis {${$I}callback${$NI}} + @values -min 0 -max 0 + } "@doc -name Manpage: -url [manpage_tcl chan]"\ + { + @examples -help { + The first example transfers the contents of one channel exactly to another. Note that when copying one file to another, + it is better to use file copy which also copies file metadata (e.g. the file access permissions) where possible. + ${[example { + ${$B}chan configure${$N} $in -translation binary + ${$B}chan configure${$N} $out -translation binary + ${$B}chan copy${$N} $in $out + }]} + This second example shows how the callback gets passed the number of bytes transferred. It also uses vwait to put the + application into the event loop. Of course, this simplified example could be done without the command callback. + ${[example { + proc Cleanup {in out bytes {error {}}} { + global total + set total $bytes + ${$B}chan close${$N} $in + ${$B}chan close${$N} $out + if {$error ne ""} { + # error occurred during the copy + } + } + + set in [open $file1] + set out [socket $server $port] + ${$B}chan copy${$N} $in $out -command [list Cleanup $in $out] + vwait total + }]} + The third example copies in chunks and tests for end of file in the command callback. + ${[example { + proc CopyMore {in out chunk bytes {error {}}} { + global total done + incr total $bytes + if {($error ne "") || [${$B}chan eof${$N} $in]} { + set done $total + ${$B}chan close${$N} $in + ${$B}chan close${$N} $out + } else { + ${$B}chan copy${$N} $in $out -size $chunk \ + -command [list CopyMore $in $out $chunk] + } + } + + set in [open $file1] + set out [socket $server $port] + set chunk 1024 + set total 0 + ${$B}chan copy${$N} $in $out -size $chunk \ + -command [list CopyMore $in $out $chunk] + vwait done + }]} + The fourth example starts an asynchronous, bidirectional copy between two sockets. Those could also be pipes + from two bidirectional pipelines (e.g., [open "|hal 9000" r+]); the conversation will remain essentially + secret to the script, since all four ${$B}chan event${$N} slots are busy, though any transforms that are ${$B}chan pushed${$N} + on the channels will be able to observe the passing traffic. + ${[example { + proc Done {dir args} { + global flows done + ${$B}chan puts${$N} "$dir is over." + incr flows -1 + if {$flows <= 0} { + set done 1 + } + } + + set flows 2 + ${$B}chan copy${$N} $sok1 $sok2 -command [list Done UP] + ${$B}chan copy${$N} $sok2 $sok1 -command [list Done DOWN] + vwait done + }]} + } + }] lappend PUNKARGS [list { @id -id ::tcl::chan::eof @@ -1653,47 +1807,48 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "In the first form, the result will be the next numChars characters read from the channel named channel; if numChars is omitted, all characters up to the point when the channel would signal a failure (whether an end-of-file, blocked or other error condition) are read. In the second form - (i.e. when numChars has been omitted) the flag -nonewline may be given to indicate that any + (i.e. when numChars has been omitted) the flag ${$B}-nonewline${$N} may be given to indicate that any trailing newline in the string that has been read should be trimmed. - If channel is in non-blocking mode, chan read may not read as many characters as requested: once + If channel is in non-blocking mode, ${$B}chan read${$N} may not read as many characters as requested: once all available input has been read, the command will return the data that is available rather than blocking for more input. If the channel is configured to use a multi-byte encoding, then there may actually be some bytes remaining in the internal buffers that do not form a complete character. These bytes will not be returned until a complete character is available or end-of-file - is reached. The -nonewline switch is ignored if the command returns before reaching the end of the + is reached. The ${$B}-nonewline${$N} switch is ignored if the command returns before reaching the end of the file. - Chan read translates end-of-line sequences in the input into newline characters according to the - -translation option for the channel (see chan configure above for a discussion on the ways in + ${$B}Chan read${$N} translates end-of-line sequences in the input into newline characters according to the + -translation option for the channel (see ${$B}chan configure${$N} for a discussion on the ways in which chan configure will alter input). When reading from a serial port, most applications should configure the serial port channel to be non-blocking, like this: - chan configure channel -blocking 0 + ${$B}chan configure${$N} channel ${$B}-blocking${$N} 0 - Then chan read behaves much like described above. Note that most serial ports are comparatively - slow; it is entirely possible to get a readable event for each character read from them. Care - must be taken when using chan read on blocking serial ports: + Then ${$B}chan read${$N} behaves much like described above. Note that most serial ports are comparatively + slow; it is entirely possible to get a ${$B}readable${$N} event for each character read from them. Care + must be taken when using ${$B}chan read${$N} on blocking serial ports: - chan read channel numChars - In this form chan read blocks until numChars have been received from the serial port. - chan read channel - In this form chan read blocks until the reception of the end-of-file character, see - chan configure -eofchar. If there no end-of-file character has been configured for the - channel, then chan read will block forever. + ${$B}chan read${$N} channel numChars + In this form ${$B}chan read${$N} blocks until numChars have been received from the serial port. + ${$B}chan read${$N} channel + In this form ${$B}chan read${$N} blocks until the reception of the end-of-file character, see + ${$B}chan configure${$N} ${$B}-eofchar${$N}. If there no end-of-file character has been configured for the + channel, then ${$B}chan${$N} read will block forever. - If the encoding profile strict is in effect for the channel, the command will raise an exception - with the POSIX error code EILSEQ if any encoding errors are encountered in the channel input data. + If the encoding profile ${$B}strict${$N} is in effect for the channel, the command will raise an exception + with the POSIX error code ${$B}EILSEQ${$N} if any encoding errors are encountered in the channel input data. If the channel is in blocking mode, the error is thrown after advancing the file pointer to the beginning of the invalid data. The successfully decoded leading portion of the data prior to the - error location is returned as the value of the -data key of the error option dictionary. If the + error location is returned as the value of the ${$B}-data${$N} key of the error option dictionary. If the channel is in non-blocking mode, the successfully decoded portion of data is returned by the command without an error exception being raised. A subsequent read will start at the invalid data - and immediately raise a EILSEQ POSIX error exception. Unlike the blocking channel case, the -data + and immediately raise a ${$B}EILSEQ${$N} POSIX error exception. Unlike the blocking channel case, the ${$B}-data${$N} key is not present in the error option dictionary. In the case of exception thrown due to encoding errors, it is possible to introspect, and in some cases recover, by changing the encoding in use. - See ENCODING ERROR EXAMPLES later." + See ${$B}ENCODING ERROR EXAMPLES${$N} from 'eg chan'." + #todo @form -form readchars @values -min 1 -max 2 @@ -1783,6 +1938,9 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { length -optional 1 -type integer } "@doc -name Manpage: -url [manpage_tcl chan]" ] + #todo ::chan base ensemble definition + + #@examples (include: see 'eg chan read') # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #dict @@ -1924,7 +2082,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { arguments as second (and possibly subsequent) arguments. This facilitates lookups in nested dictionaries. For example, the following two commands are equivalent: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { dict get $dict foo bar spong dict get [dict get [dict get $dict foo] bar] spong\ } @@ -2049,7 +2207,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { dictionaryVariable -type dict key -type any value -type any -multiple 1 -optional 1 - } "@doc -name Manpage: -url [manpage_tcl dict]" ] + } "@doc -name Manpage: -url [manpage_tcl dict]"] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -2269,7 +2427,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { proc dict_subcommands {} { dict set groups "scriptable" {filter for map update with} - return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 2 dict] + return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 1 dict] } set DICT_SUBCOMMANDS {${[punk::args::moduledoc::tclcore::argdoc::dict_subcommands]}} lappend PUNKARGS [list { @@ -2298,72 +2456,92 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { { @examples -help { Basic dictionary usage: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { # Make a dictionary to map extensions to descriptions - set filetypes [dict create .txt "Text File" .tcl "Tcl File"] + set filetypes [${$B}dict create${$N} .txt "Text File" .tcl "Tcl File"] # Add/update the dictionary - dict set filetypes .tcl "Tcl Script" - dict set filetypes .tm "Tcl Module" - dict set filetypes .gif "GIF Image" - dict set filetypes .png "PNG Image" + ${$B}dict set${$N} filetypes .tcl "Tcl Script" + ${$B}dict set${$N} filetypes .tm "Tcl Module" + ${$B}dict set${$N} filetypes .gif "GIF Image" + ${$B}dict set${$N} filetypes .png "PNG Image" # Simple read from the dictionary set ext ".tcl" - set desc [dict get $filetypes $ext] + set desc [${$B}dict get${$N} $filetypes $ext] puts "$ext is for a $desc" # Somewhat more complex, with existence test foreach filename [glob *] { set ext [file extension $filename] - if {[dict exists $filetypes $ext]} { - puts "$filename is a [dict get $filetypes $ext]" + if {[${$B}dict exists${$N} $filetypes $ext]} { + puts "$filename is a [${$B}dict get${$N} $filetypes $ext]" } } }]} Constructing and using nested dictionaries: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { # Data for one employee - dict set employeeInfo 12345-A forenames "Joe" - dict set employeeInfo 12345-A surname "Schmoe" - dict set employeeInfo 12345-A street "147 Short Street" - dict set employeeInfo 12345-A city "Springfield" - dict set employeeInfo 12345-A phone "555-1234" + ${$B}dict set${$N} employeeInfo 12345-A forenames "Joe" + ${$B}dict set${$N} employeeInfo 12345-A surname "Schmoe" + ${$B}dict set${$N} employeeInfo 12345-A street "147 Short Street" + ${$B}dict set${$N} employeeInfo 12345-A city "Springfield" + ${$B}dict set${$N} employeeInfo 12345-A phone "555-1234" # Data for another employee - dict set employeeInfo 98372-J forenames "Anne" - dict set employeeInfo 98372-J surname "Other" - dict set employeeInfo 98372-J street "32995 Oakdale Way" - dict set employeeInfo 98372-J city "Springfield" - dict set employeeInfo 98372-J phone "555-8765" + ${$B}dict set${$N} employeeInfo 98372-J forenames "Anne" + ${$B}dict set${$N} employeeInfo 98372-J surname "Other" + ${$B}dict set${$N} employeeInfo 98372-J street "32995 Oakdale Way" + ${$B}dict set${$N} employeeInfo 98372-J city "Springfield" + ${$B}dict set${$N} employeeInfo 98372-J phone "555-8765" # The above data probably ought to come from a database... # Print out some employee info set i 0 - puts "There are [dict size $employeeInfo] employees" - dict for {id info} $employeeInfo { + puts "There are [${$B}dict size${$N} $employeeInfo] employees" + ${$B}dict for${$N} {id info} $employeeInfo { puts "Employee #[incr i]: $id" - dict with info { + ${$B}dict with${$N} info { puts " Name: $forenames $surname" puts " Address: $street, $city" puts " Telephone: $phone" } } # Another way to iterate and pick out names... - foreach id [dict keys $employeeInfo] { - puts "Hello, [dict get $employeeInfo $id forenames]!" + foreach id [${$B}dict keys${$N} $employeeInfo] { + puts "Hello, [${$B}dict get${$N} $employeeInfo $id forenames]!" + } + }]} + + A localizable version of string toupper: + ${[example { + # Set up the basic C locale + set capital [${$B}dict create${$N} C [${$B}dict create${$N}]] + foreach c [split {abcdefghijklmnopqrstuvwxyz} ""] { + ${$B}dict set${$N} capital C $c [string toupper $c] } + + # English locales can luckily share the "C" locale + dict set capital en [${$B}dict get${$N} $capital C] + dict set capital en_US [${$B}dict get${$N} $capital C] + dict set capital en_GB [${$B}dict get${$N} $capital C] + + # ... and so on for other supported languages ... + + # Now get the mapping for the current locale and use it. + set upperCaseMap [${$B}dict get${$N} $capital $env(LANG)] + set upperCase [string map $upperCaseMap $string] }]} - Showing the detail of dict with: - ${[punk::args::moduledoc::tclcore::argdoc::example { + Showing the detail of ${$B}dict with${$N}: + ${[example { proc sumDictionary {varName} { upvar 1 $varName vbl - foreach key [dict keys $vbl] { + foreach key [${$B}dict keys${$N} $vbl] { # Manufacture an entry in the subdictionary - dict set vbl $key total 0 + ${$B}dict set${$N} vbl $key total 0 # Add the values and remove the old - dict with vbl $key { + ${$B}dict with${$N} vbl $key { set total [expr {$x + $y + $z}] unset x y z } @@ -2383,10 +2561,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { # prints: dictionary is now "a {total 6} b {total 15}" }]} - When dict with is used with a key that clashes with the name of the dictionary variable: - ${[punk::args::moduledoc::tclcore::argdoc::example { + When ${$B}dict with${$N} is used with a key that clashes with the name of the dictionary variable: + ${[example { set foo {foo {a b} bar 2 baz 3} - dict with foo {} + ${$B}dict with${$N} foo {} puts $foo # prints: a b foo {a b} bar 2 baz 3 }]} @@ -2400,11 +2578,32 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #file # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::tcl::file::atime + @cmd -name "Built-in: tcl::file::atime"\ + -summary\ + "Get/set file last access time."\ + -help\ + "Returns a decimal string giving the time at which file name was last accessed. + If time is specified, it is an access time to set for the file. The time is measured in the + standard POSIX fashion as seconds from a fixed starting time (often January 1, 1970). + If the file does not exist or its access time cannot be queried or set then an error is + generated. On Windows, FAT file systems do not support access time. On zipfs file systems, + access time is mapped to the modification time." + @opts -prefix 0 + @values -min 1 -max 2 + name -type string -optional 0 + time -type integer -optional 1 + } "@doc -name Manpage: -url [manpage_tcl file]" ] + lappend PUNKARGS [list { @id -id ::tcl::file::channels - @cmd -name "Built-in: tcl::file::channels" -help\ + @cmd -name "Built-in: tcl::file::channels"\ + -summary\ + "List open file channels."\ + -help\ "If ${$I}pattern${$NI} is not specified, returns a list of names of all - registered copen channels in this interpreter. If ${$I}pattern${$NI} is + registered open channels in this interpreter. If ${$I}pattern${$NI} is specified, only those names matching ${$I}pattern${$NI} are returned. Matching is determined using the same rules as for string match." @opts -prefix 0 @@ -2414,7 +2613,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { lappend PUNKARGS [list { @id -id ::tcl::file::delete - @cmd -name "Built-in: tcl::file::delete" -help\ + @cmd -name "Built-in: tcl::file::delete"\ + -summary\ + "Delete file or directory"\ + -help\ "Removes the file or directory specified by each ${$I}pathname${$NI} argument. Non-empty directories will be removed only if the ${$B}-force${$N} option is specified. When operating on symbolic links, the links themselves will be @@ -2436,7 +2638,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { lappend PUNKARGS [list { @id -id ::tcl::file::copy - @cmd -name "Built-in: tcl::file::copy" -help\ + @cmd -name "Built-in: tcl::file::copy"\ + -summary\ + "Copy file or directory"\ + -help\ "The first form makes a copy of the file or directory ${$I}source${$NI} under the pathname ${$I}target${$NI}. If ${$I}target${$NI} is an existing directory then the second form is used. The second form makes a copy inside ${$I}targetDir${$NI} of each ${$I}source${$NI} file listed. @@ -2470,7 +2675,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { lappend PUNKARGS [list { @id -id ::tcl::file::executable - @cmd -name "Built-in: tcl::file::executable" -help\ + @cmd -name "Built-in: tcl::file::executable"\ + -summary\ + "Test executable status of file"\ + -help\ "Returns ${$B}1${$N} if file ${$I}name${$NI} is executable by the current user, ${$B}0${$N} otherwise. On Windows, which does not have an executable attribute, the command treats all directories and any files with extensions ${$B}exe${$N}, ${$B}com${$N}, ${$B}cmd${$N} or ${$B}bat${$N} as executable." @@ -2480,7 +2688,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { lappend PUNKARGS [list { @id -id ::tcl::file::exists - @cmd -name "Built-in: tcl::file::exists" -help\ + @cmd -name "Built-in: tcl::file::exists"\ + -summary\ + "Test if file/directory exists."\ + -help\ "Returns ${$B}1${$N} if the file ${$I}name${$NI} exists and the current user has search privileges for the directories leading to it, ${$B}0${$N} otherwise." @values -min 0 -max 1 @@ -2489,7 +2700,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { lappend PUNKARGS [list { @id -id ::tcl::file::extension - @cmd -name "Built-in: tcl::file::extension" -help\ + @cmd -name "Built-in: tcl::file::extension"\ + -summary\ + "Get file extension (including dot)"\ + -help\ "Returns all of the characters in ${$I}name${$NI} after and including the last dot in the last element of name. If there is no dot in the last element of ${$I}name${$NI} then returns the empty string." @@ -2583,6 +2797,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #tildeexpand #type #volumes + lappend PUNKARGS [list { @id -id ::tcl::file::writable @cmd -name "Built-in: tcl::file::writable" -help\ @@ -2591,8 +2806,82 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { name -optional 0 -type string } "@doc -name Manpage: -url [manpage_tcl file]"] + proc file_subcommands {} { + dict set groups "" "" + return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 2 file] + } + + set FILE_SUBCOMMANDS {${[punk::args::moduledoc::tclcore::argdoc::file_subcommands]}} + lappend PUNKARGS [list { + @dynamic + @id -id ::file + @cmd -name "Built-in ensemble: file"\ + -summary\ + "Manipulate file names and attributes"\ + -help\ + "This command provides several operations on a file's name or attributes. The name argument + is the name of a file in most cases. The option argument indicates what to do with the file + name. Any unique abbreviation for option is acceptable. + + ${$T}PORTABILITY ISSUES${$NT} + ${$B}Unix${$N} + These commands always operate using the real user and group identifiers, not the effective + ones. + ${$B}Windows${$N} + The ${$B}file owned${$N} subcommand uses the user identifier (SID) of the process token, not the + thread token which may be impersonating some other user" + #a root docid for an ensemble-like command must always specify a -max for @leaders + @leaders -min 1 -max 1 + ${$FILE_SUBCOMMANDS} + @values -unnamed true + + } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl file]"\ + { + @examples -help { + This procedure shows how to search for C files in a given directory that have a + correspondingly-named object file in the current directory: + ${[example { + proc findMatchingCFiles {dir} { + set files {} + switch $::tcl_platform(platform) { + windows { + set ext .obj + } + unix { + set ext .o + } + } + foreach file [glob -nocomplain -directory $dir *.c] { + set objectFile [${$B}file tail${$N} [${$B}file rootname${$N} $file]]$ext + if {[${$B}file exists${$N} $objectFile]} { + lappend files $file + } + } + return $files + } + }]} + + Rename a file and leave a symbolic link pointing from the old location to the new place: + ${[example { + set oldName foobar.txt + set newName foo/bar.txt + # Make sure that where we're going to move to exists... + if {![${$B}file isdirectory${$N} [${$B}file dirname${$N} $newName]]} { + file mkdir [${$B}file dirname $newName] + } + ${$B}file rename${$N} $oldName $newName + ${$B}file link${$N} -symbolic $oldName $newName + }]} + On Windows, a file can be “started” easily enough (equivalent to double-clicking on it in + the Explorer interface) but the name passed to the operating system must be in native format: + ${[example { + exec {*}[auto_execok start] {} [${$B}file nativename${$N} C:/Users/fred/example.txt] + }]} + } + }] } + namespace eval argdoc { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -3135,10 +3424,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -unnamed true } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl namespace]"\ - {@examples -help { + { + @examples -help { Create two ensembles, one with the default name and one with a specified name. Then call through the ensembles. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace eval foo { namespace ensemble create namespace ensemble create -command ::foobar @@ -3170,9 +3460,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -unnamed true } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl namespace]"\ - {@examples -help { + { + @examples -help { Create a namespace containing a variable and an exported command: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace eval foo { variable bar 0 proc grill {} { @@ -3184,7 +3475,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} Call the command defined in the previous example in various ways. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { # Direct call ::foo::grill @@ -3209,18 +3500,18 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} Look up where the command imported in the previous example came from: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { puts "grill came from [namespace origin grill]" }]} Remove all imported commands from the current namespace: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace forget {*}[namespace import] }]} Create an ensemble for simple working with numbers, using the -parameters option to allow the operator to be put between the first and second arguments. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace eval do { namespace export * namespace ensemble create -parameters x @@ -3312,9 +3603,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -unnamed true } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl prefix]" \ - {@examples -help { + { + @examples -help { Basic use: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace import ::tcl::prefix prefix match {apa bepa cepa} apa @@ -3332,7 +3624,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} Simplifying option matching: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { array set opts {-apa 1 -bepa "" -cepa 0} foreach {arg val} $args { set opts([prefix match {-apa -bepa -cepa} $arg]) $val @@ -3340,7 +3632,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} Creating a switch that supports prefixes: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { switch [prefix match {apa bepa cepa} $arg] { apa { } bepa { } @@ -3505,7 +3797,20 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 varName -optional 0 value -type string -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl append]" ] + } "@doc -name Manpage: -url [manpage_tcl append]"\ + { + @examples -help { + Building a string of comma-separated numbers piecemeal using a loop. + ${[example { + set var 0 + for {set i 1} {$i<=10} {incr i} { + append var "," $i + } + puts $var + # Prints 0,1,2,3,4,5,6,7,8,9,10 + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -3539,11 +3844,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { namespace even if its name does not start with “::”. The semantics of ${$B}apply${$N} can also be described by approximately this: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc apply {fun args} { set len [llength $fun] if {($len < 2) || ($len > 3)} { - error "can't interpret \"$fun\" as anonymous function" + error "can't interpret \"$fun\" as anonymous function" } lassign $fun argList body ns set name ::$ns::[getGloballyUniqueName] @@ -3553,7 +3858,8 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { proc $name $argList ${body0}$body set code [catch {uplevel 1 $name $args} res opt] return -options $opt $res - }}]} + } + }]} } @values -min 1 @@ -3561,15 +3867,15 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { arg -type any -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl append]"\ + } "@doc -name Manpage: -url [manpage_tcl apply]"\ { @examples -help { This shows how to make a simple general command that applies a transformation to each element of a list. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc map {lambda list} { set result {} foreach item $list { - lappend result [apply $lambda $item] + lappend result [${$B}apply${$N} $lambda $item] } return $result } @@ -3580,9 +3886,9 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} The apply command is also useful for defining callbacks for use in the trace command: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set vbl "123abc" - trace add variable vbl write {apply {{v1 v2 op} { + trace add variable vbl write {${$B}apply${$N} {{v1 v2 op} { upvar 1 $v1 v puts "updated variable to \"$v\"" }}} @@ -3593,28 +3899,6 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - #categorise array subcommands based on currently known groupings. - #we do this dynamically because Tcl ensembles (even some core ones) can have subcommands added at runtime. - proc array_subcommands {} { - #dict set groups "" {bogus names} ;#test adding both existant and nonexistant to the default group - dict set groups "search" {startsearch anymore nextelement donesearch} - return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 2 array] - } - lappend PUNKARGS [list { - @dynamic - @id -id ::array - @cmd -name "Built-in: array"\ - -summary\ - "Manipulate array variables"\ - -help\ - "This command performs one of several operations on the variable given by - arrayName. Unless otherwise specified for individual commands below, - arrayName must be the name of an existing array variable. The subcommand - argument determines what action is carried out by the command." - @leaders - ${[punk::args::moduledoc::tclcore::argdoc::array_subcommands]} - @values -unnamed true - } "@doc -name Manpage: -url [manpage_tcl array]" ] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -3673,7 +3957,106 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } "@doc -name Manpage: -url [manpage_tcl array]" ] + + lappend PUNKARGS [list { + @id -id ::tcl::array::get + @cmd -name "Built-in: array get"\ + -summary\ + "get array key val list"\ + -help\ + "Returns a list containing pairs of elements. The first element in each pair + is the name of an element in ${$I}arrayName${$NI} and the second element of each pair is + the value of the array element. The order of the pairs is undefined. If + pattern is not specified, then all of the elements of the array are included + in the result. If pattern is specified, then only those elements whose names + match pattern (using the matching rules of ${$B}string match${$N}) are included. If + arrayName is not the name of an array variable, or if the array contains no + elements, then an empty list is returned. If traces on the array modify the + list of elements, the elements returned are those that exist both before and + after the call to ${$B}array get${$N}." + @leaders + @values -min 1 -max -1 + arrayName -type string + pattern -type string -multiple 1 -optional 1 + + } "@doc -name Manpage: -url [manpage_tcl array]"] + + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + #categorise array subcommands based on currently known groupings. + #we do this dynamically because Tcl ensembles (even some core ones) can have subcommands added at runtime. + proc array_subcommands {} { + #dict set groups "" {bogus names} ;#test adding both existant and nonexistant to the default group + dict set groups "search" {startsearch anymore nextelement donesearch} + return [punk::args::ensemble_subcommands_definition -groupdict $groups -columns 2 array] + } + lappend PUNKARGS [list { + @dynamic + @id -id ::array + @cmd -name "Built-in: array"\ + -summary\ + "Manipulate array variables"\ + -help\ + "This command performs one of several operations on the variable given by + arrayName. Unless otherwise specified for individual commands below, + arrayName must be the name of an existing array variable. The subcommand + argument determines what action is carried out by the command." + @leaders + ${[punk::args::moduledoc::tclcore::argdoc::array_subcommands]} + @values -unnamed true + } "@doc -name Manpage: -url [manpage_tcl array]"\ + { + @examples -help { + ${[example { + ${$B}array set${$N} colorcount { + red 1 + green 5 + blue 4 + white 9 + } + + foreach {color count} [${$B}array get${$N} colorcount] { + puts "Color: $color Count: $count" + } + → Color: blue Count: 4 + Color: white Count: 9 + Color: green Count: 5 + Color: red Count: 1 + + foreach color [${$B}array names${$N} colorcount] { + puts "Color: $color Count: $colorcount($color)" + } + → Color: blue Count: 4 + Color: white Count: 9 + Color: green Count: 5 + Color: red Count: 1 + + foreach color [lsort [${$B}array names${$N} colorcount]] { + puts "Color: $color Count: $colorcount($color)" + } + → Color: blue Count: 4 + Color: green Count: 5 + Color: red Count: 1 + Color: white Count: 9 + + ${$B}array statistics${$N} colorcount + → 4 entries in table, 4 buckets + number of buckets with 0 entries: 1 + number of buckets with 1 entries: 2 + number of buckets with 2 entries: 1 + number of buckets with 3 entries: 0 + number of buckets with 4 entries: 0 + number of buckets with 5 entries: 0 + number of buckets with 6 entries: 0 + number of buckets with 7 entries: 0 + number of buckets with 8 entries: 0 + number of buckets with 9 entries: 0 + number of buckets with 10 or more entries: 0 + average search distance for entry: 1.2 + }]} + } + }] } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -3695,7 +4078,20 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { situations, such as the ${$B}catch${$N} command, Tk event bindings, and the outermost scripts of procedure bodies." @values -min 0 -max 0 - } "@doc -name Manpage: -url [manpage_tcl break]" ] + } "@doc -name Manpage: -url [manpage_tcl break]"\ + { + @examples -help { + Print a line for each of the integers from 0 to 5: + ${[example { + for {set x 0} {$x<10} {incr x} { + if {$x > 5} { + ${$B}break${$N} + } + puts "x is $x" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -3773,7 +4169,19 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { resultVarName -type string -optional 1 optionsVarName -type string -optional 1 - } "@doc -name Manpage: -url [manpage_tcl catch]" ] + } "@doc -name Manpage: -url [manpage_tcl catch]"\ + { + @examples -help { + The ${$B}catch${$N} command may be used in an ${$B}if${$N} to branch based on the success of a script. + ${[example { + if { [${$B}catch${$N} {open $someFile w} fid] } { + puts stderr "Could not open $someFile for writing\n$fid" + exit 1 + } + }]} + There are more complex examples of ${$B}catch${$N} usage in the documentation for the ${$B}return${$N} command. + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #TODO - add CLOCK_ARITHMETIC documentation @@ -3995,7 +4403,20 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { situations, such as the ${$B}catch${$N} command and the outermost scripts of procedure bodies." @values -min 0 -max 0 - } "@doc -name Manpage: -url [manpage_tcl continue]" ] + } "@doc -name Manpage: -url [manpage_tcl continue]"\ + { + @examples -help { + Print a line for each of the integers from 0 to 10 except 5: + ${[example { + for {set x 0} {$x<10} {incr x} { + if {$x == 5} { + ${$B}continue${$N} + } + puts "x is $x" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -4034,14 +4455,14 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { Historically, this feature had been most useful in conjunction with the catch command: if a caught error cannot be handled successfully, info can be used to return a stack trace reflecting the original point of occurrence of the error: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { catch {...} errMsg - set savedInfo $::errorInfo + set savedInfo $::errorInfo ... error $errMsg $savedInfo }]} When working with Tcl 8.5 or later, the following code should be used intead: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { catch {...} errMsg options ... return -options $options $errMsg @@ -4085,13 +4506,13 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { with extra values appended. This technique is used in a number of places throughout the Tcl core (e.g. in ${$B}fcopy${$N}, ${$B}lsort${$N} and ${$B}trace${$N} command callbacks). This example shows how to do this using core Tcl commands: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set script { puts "logging now" lappend $myCurrentLogVar } set myCurrentLogVar log1 - # Set up a switch of logging variable part way through! + # Set up a switch of logging variable part way through! after 20000 set myCurrentLogVar log2 for {set i 0} {$i<10} {incr i} { @@ -4106,22 +4527,22 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { pattern. It is less general than the eval command, and hence easier to make robust in practice. The following procedure acts in a way that is analogous to the lappend command, except it inserts the argument values at the start of the list in the variable: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc lprepend {varName args} { upvar 1 $varName var - # Ensure that the variable exists and contains a list + # Ensure that the variable exists and contains a list lappend var # Now we insert all the arguments in one go set var [eval [list linsert $var 0] $args] } }]} However, the last line would now normally be written without eval, like this: - ${[punk::args::moduledoc::tclcore::argdoc::example { - set var [linsert $var 0 {*}$args] + ${[example { + set var [linsert $var 0 {*}$args] }]} Or indeed like this: - ${[punk::args::moduledoc::tclcore::argdoc::example { - set var [list {*}$args {*}$var] + ${[example { + set var [list {*}$args {*}$var] }]} } }] @@ -4137,11 +4558,12 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 0 -max 1 returnCode -type integer -default 0 -optional 1 } "@doc -name Manpage: -url [manpage_tcl exit]"\ - {@examples -help { + { + @examples -help { Since non-zero exit codes are usually interpreted as error cases by the calling process, the exit command is an important part of signaling that something fatal has gone wrong. This code fragment is useful in scripts to act as a general problem trap: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc main {} { # ... put the real main code in here ... } @@ -4260,9 +4682,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } @values -min 0 -max 0 } "@doc -name Manpage: -url [manpage_tcl buildinfo]"\ - {@examples -help { + { + @examples -help { These show the use of ::tcl::build-info. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { ::tcl::build-info → 9.0.2+af16c07b81655fabde8028374161ad54b84ef9956843c63f49976b4ef601b611.gcc-1204 ::tcl::build-info commit @@ -4388,7 +4811,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { next -type script body -type script -help\ "Tcl script" - } "@doc -name Manpage: -url [manpage_tcl for]" ] + } "@doc -name Manpage: -url [manpage_tcl for]"\ + { + @examples -help { + Print a line for each of the integers from 0 to 9: + ${[example { + ${$B}for${$N} {set x 0} {$x<10} {incr x} { + puts "x is $x" + } + }]} + Either loop infinitely or not at all because the expression being evaluated is actually the constant, + or even generate an error! + The actual behaviour will depend on whether the variable x exists before the for command is run and + whether its value is a value that is less than or greater than/equal to ten, and this is because the + expression will be substituted before the for command is executed. + ${[example { + ${$B}for${$N} {set x 0} $x<10 {incr x} { + puts "x is $x" + } + }]} + Print out the powers of two from 1 to 1024: + ${[example { + ${$B}for${$N} {set x 1} {$x<=1024} {set x [expr {$x * 2}]} { + puts "x is $x" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::foreach @@ -4420,7 +4869,46 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "varlist list" -type {list list} -typesynopsis {varlist list} -multiple 1 -optional 0 body -type string -optional 0 -help\ "Tcl script" - } "@doc -name Manpage: -url [manpage_tcl foreach]" ] + } "@doc -name Manpage: -url [manpage_tcl foreach]"\ + { + @examples -help { + This loop prints every value in a list together with the square and cube of the value: + ${[example { + set values {1 3 5 7 2 4 6 8} ;# Odd numbers first, for fun! + puts "Value\tSquare\tCube" ;# Neat-looking header + ${$B}foreach${$N} x $values { ;# Now loop and print... + puts " $x\t [expr {$x**2}]\t [expr {$x**3}]" + } + }]} + The following loop uses i and j as loop variables to iterate over pairs of elements of a single list. + ${[example { + set x {} + ${$B}foreach${$N} {i j} {a b c d e f} { + lappend x $j $i + } + # The value of x is "b a d c f e" + # There are 3 iterations of the loop + }]} + The next loop uses i and j to iterate over two lists in parallel. + ${[example { + set x {} + ${$B}foreach${$N} i {a b c} j {d e f g} { + lappend x $i $j + } + # The value of x is "a d b e c f {} g" + # There are 4 iterations of the loop. + }]} + The two forms are combined in the following example. + ${[example { + set x {} + ${$B}foreach${$N} i {a b c} {j k} {d e f g} { + lappend x $i $j $k + } + # The value of x is "a d e b f g c {} {}" + # There are 3 iterations of the loop. + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::gets @@ -4488,10 +4976,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { The two forms may be mixed, so -types {d f r w} will find all regular files OR directories that have both read AND write permissions. The following are equivalent: - ${[punk::args::moduledoc::tclcore::argdoc::example { - glob -type d * - glob */} - ]} + ${[example { + glob -type d * + glob */ + }]} except that the first case doesn't return the trailing “/” and is more platform independent." -- -type none -help\ "Marks the end of switches. The argument following this one will be treated as a pattern even if it @@ -4588,7 +5076,44 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #todo - punk::args variable-length striding by use of ?name? in -type list "elseif_clause" -type {literal(elseif) expr ?literal(then)? script} -optional 1 -multiple 1 "else_clause" -type {?literal(else)? script} -optional 1 -multiple 0 - } "@doc -name Manpage: -url [manpage_tcl if]"] + } "@doc -name Manpage: -url [manpage_tcl if]"\ + { + @examples -help { + A simple conditional: + ${[example { + ${$B}if${$N} {$vbl == 1} { puts "vbl is one" } + }]} + With an ${$B}else${$N}-clause: + ${[example { + ${$B}if${$N} {$vbl == 1} { + puts "vbl is one" + } ${$B}else${$N} { + puts "vbl is not one" + } + }]} + With an ${$B}elseif${$N}-clause too: + ${[example { + ${$B}if${$N} {$vbl == 1} { + puts "vbl is one" + } ${$B}elseif${$N} {$vbl == 2} { + puts "vbl is two" + } ${$B}else${$N} { + puts "vbl is not one or two" + } + }]} + Remember, expressions can be multi-line, but in that case it can be a good idea + to use the optional then keyword for clarity: + ${[example { + ${$B}if${$N} { + $vbl == 1 + || $vbl == 2 + || $vbl == 3 + } ${$B}then${$N} { + puts "vbl is one, two or three" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -4611,7 +5136,29 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max 2 varName -type string increment -type integer -optional 1 - } "@doc -name Manpage: -url [manpage_tcl incr]"] + } "@doc -name Manpage: -url [manpage_tcl incr]"\ + { + @examples -help { + Add one to the contents of the variable x: + ${[example { + ${$B}incr${$N} x + }]} + Add 42 to the contents of the variable x: + ${[example { + ${$B}incr${$N} x 42 + }]} + Add the contents of the variable y to the contents of the variable x: + ${[example { + ${$B}incr${$N} x $y + }]} + Add nothing at all to the variable x (often useful for checking whether + an argument to a procedure is actually integral and generating an error + if it is not): + ${[example { + ${$B}incr${$N} x 0 + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -4629,7 +5176,23 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { list -type list joinString -type string -default " " -optional 1 - } "@doc -name Manpage: -url [manpage_tcl concat]" ] + } "@doc -name Manpage: -url [manpage_tcl concat]"\ + { + @examples -help { + Making a comma-separated list: + ${[example { + set data {1 2 3 4 5} + ${$B}join${$N} $data ", " + → 1, 2, 3, 4, 5 + }]} + Using ${$B}join${$N} to flatten a list by a single level: + ${[example { + set data {1 {2 3} 4 {5 {6 7} 8}} + ${$B}join${$N} $data + → 1 2 3 4 5 {6 7} 8 + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::lappend @@ -4637,11 +5200,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { -summary\ "Append list elements onto a variable."\ -help\ - "This command treats the variable given by ${$I}listVar${$NI} as a list and + "This command treats the variable given by ${$I}varName${$NI} as a list and appends each of the ${$I}value${$NI} arguments to that list as a separate - element, with spaces between elements. If ${$I}listVar${$NI} does not exist, + element, with spaces between elements. If ${$I}varName${$NI} does not exist, it is created as a list with elements given by the value arguments. If - ${$I}listVar${$NI} indicates an element that does not exist of an array that + ${$I}varName${$NI} indicates an element that does not exist of an array that has a default value set, a list that is comprised of the default value with all the ${$I}value${$NI} arguments appended as elements will be stored in the array element. ${$I}Lappend${$NI} is similar to ${$I}append${$NI} except that the @@ -4650,10 +5213,23 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { ${$B}\"lappend a $b\"${$N} is much more efficient than ${$B}\"set a [concat $a [list $b]]\"${$N} when ${$B}$a${$N} is long." @values -min 1 -max -1 - listVar -type string -help\ + varName -type string -help\ "Existing list variable name" value -type any -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl lappend]"] + } "@doc -name Manpage: -url [manpage_tcl lappend]"\ + { + @examples -help { + Using ${$B}lappend${$N} to build up a list of numbers. + ${[example { + % set var 1 + 1 + % ${$B}lappend${$N} var 2 + 1 2 + % ${$B}lappend${$N} var 3 4 5 + 1 2 3 4 5 + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -4673,7 +5249,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { list -type list -help\ "tcl list as a value" varName -type any -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl lassign]"] + } "@doc -name Manpage: -url [manpage_tcl lassign]"\ + { + @examples -help { + An illustration of how multiple assignment works, and what happens when + there are either too few or too many elements. + ${[example { + ${$B}lassign${$N} {a b c} x y z ;# Empty return + puts $x ;# Prints "a" + puts $y ;# Prints "b" + puts $z ;# Prints "c" + + ${$B}lassign${$N} {d e} x y z ;# Empty return + puts $x ;# Prints "d" + puts $y ;# Prints "e" + puts $z ;# Prints "" + + ${$B}lassign${$N} {f g h i} x y ;# Returns "h i" + puts $x ;# Prints "f" + puts $y ;# Prints "g" + }]} + The ${$B}lassign${$N} command has other uses. It can be used to create the analogue + of the “shift” command in many shell languages like this: + ${[example { + set ::argv [${$B}lassign${$N} $::argv argumentToReadOff] + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -4718,30 +5320,31 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { last -type indexexpression value -type any -optional 1 -multiple 1 } "@doc -name Manpage: -url [manpage_tcl ledit]"\ - {@examples -help { + { + @examples -help { Prepend to a list. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set lst {c d e f g} - -> c d e f g - ledit lst -1 -1 a b - -> a b c d e f g + → c d e f g + ${$B}ledit${$N} lst -1 -1 a b + → a b c d e f g }]} Append to the list. - ${[punk::args::moduledoc::tclcore::argdoc::example { - ledit lst end+1 end+1 h i - -> a b c d e f g h i + ${[example { + ${$B}ledit${$N} lst end+1 end+1 h i + → a b c d e f g h i }]} Delete the third and fourth elements. - ${[punk::args::moduledoc::tclcore::argdoc::example { - ledit lst 2 3 - -> a b e f g h i + ${[example { + ${$B}ledit${$N} lst 2 3 + → a b e f g h i }]} Replace two elements with three. - ${[punk::args::moduledoc::tclcore::argdoc::example { - ledit lst 2 3 x y z - -> a b x y z g h i + ${[example { + ${$B}ledit${$N} lst 2 3 x y z + → a b x y z g h i set lst - -> a b x y z g h i + → a b x y z g h i }]} } } @@ -4783,8 +5386,48 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { list -type list -help\ "tcl list as a value" index -type indexexpression -multiple 1 -optional 1 - } "@doc -name Manpage: -url [manpage_tcl lindex]" - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + } "@doc -name Manpage: -url [manpage_tcl lindex]"\ + { + @examples -help { + Lists can be indexed into from either end: + ${[example { + ${$B}lindex${$N} {a b c} 0 + → a + ${$B}lindex${$N} {a b c} 2 + → c + ${$B}lindex${$N} {a b c} end + → c + ${$B}lindex${$N} {a b c} end-1 + → b + }]} + Lists or sequences of indices allow selection into lists of lists: + ${[example { + ${$B}lindex${$N} {a b c} + → a b c + ${$B}lindex${$N} {a b c} {} + → a b c + ${$B}lindex${$N} {{a b c} {d e f} {g h i}} 2 1 + → h + ${$B}lindex${$N} {{a b c} {d e f} {g h i}} {2 1} + → h + ${$B}lindex${$N} {{{a b} {c d}} {{e f} {g h}}} 1 1 0 + → g + ${$B}lindex${$N} {{{a b} {c d}} {{e f} {g h}}} {1 1 0} + → g + }]} + List indices may also perform limited computation, adding or subtracting fixed + amounts from other indices: + ${[example { + set idx 1 + ${$B}lindex${$N} {a b c d e f} $idx+2 + → d + set idx 3 + ${$B}lindex${$N} {a b c d e f} $idx+2 + → f + }]} + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -4812,7 +5455,23 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { index -type indexexpression element -type any -optional 1 -multiple 1 @seealso -commands {list list lappend lassign ledit lindex llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} - } "@doc -name Manpage: -url [manpage_tcl linsert]" + } "@doc -name Manpage: -url [manpage_tcl linsert]"\ + { + @examples -help { + Putting some values into a list, first indexing from the start and + then indexing from the end, and then chaining them together: + ${[example { + set oldList {the fox jumps over the dog} + set midList [${$B}linsert${$N} $oldList 1 quick] + → the quick fox jumps over the dog + set newList [${$B}linsert${$N} $midList end-1 lazy] + → the quick fox jumps over the lazy dog + # The old lists still exist though... + set newerList [${$B}linsert${$N} [${$B}linsert${$N} $oldList end-1 quick] 1 lazy] + → the lazy fox jumps over the quick dog + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -4832,7 +5491,23 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { while list works directly from the original arguments." @values -min 0 -max -1 arg -type any -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl list]" + } "@doc -name Manpage: -url [manpage_tcl list]"\ + { + @examples -help { + The command + ${[example { + ${$B}list${$N} a b "c d e " " f {g h}" + }]} + will return + ${[example { + a b {c d e } { f {g h}} + }]} + while ${$B}concat${$N} with the same arguments will return + ${[example { + a b c d e f {g h} + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -4846,7 +5521,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max 1 list -type list -help\ "tcl list as a value" - } "@doc -name Manpage: -url [manpage_tcl llength]" + } "@doc -name Manpage: -url [manpage_tcl llength]"\ + { + @examples -help { + The result is the number of elements: + ${[example { + % ${$B}llength${$N} {a b c d e} + 5 + % ${$B}llength${$N} {a b c} + 3 + % ${$B}llength${$N} {} + 0 + }]} + Elements are not guaranteed to be exactly words in a dictionary sense of course, + especially when quoting is used: + ${[example { + % ${$B}llength${$N} {a b {c d} e} + 4 + % ${$B}llength${$N} {a b { } c d e} + 6 + }]} + An empty list is not necessarily an empty string: + ${[example { + % set var { }; puts "[string length $var],[${$B}llength${$N} $var]" + 1,0 + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @@ -4884,7 +5585,36 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "varlist list" -type {list list} -typesynopsis {varlist list} -multiple 1 -optional 0 body -type string -optional 0 -help\ "Tcl script" - } "@doc -name Manpage: -url [manpage_tcl lmap]" ] + } "@doc -name Manpage: -url [manpage_tcl lmap]"\ + { + @examples -help { + Zip lists together: + ${[example { + set list1 {a b c d} + set list2 {1 2 3 4} + set zipped [${$B}lmap${$N} a $list1 b $list2 {list $a $b}] + # The value of zipped is "{a 1} {b 2} {c 3} {d 4}" + }]} + Filter a list to remove odd values: + ${[example { + set values {1 2 3 4 5 6 7 8} + proc isEven {n} {expr {($n % 2) == 0}} + set goodOnes [${$B}lmap${$N} x $values {expr { + [isEven $x] ? $x : [continue] + }}] + # The value of goodOnes is "2 4 6 8" + }]} + Take a prefix from a list based on the contents of the list: + ${[example { + set values {8 7 6 5 4 3 2 1} + proc isGood {counter} {expr {$n > 3}} + set prefix [${$B}lmap${$N} x $values {expr { + [isGood $x] ? $x : [break] + }}] + # The value of prefix is "8 7 6 5 4" + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -4901,16 +5631,59 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { listVar -type string -help\ "Existing list variable name" index -type indexexpression -default end -optional 1 -multiple 1 -help\ - "When presented with a single index, the lpop command addresses - the index'th element in it, removes it from the list and returns - the element. - If index is negative or greater or equal than the number of - elements in the list in the variable ${$I}listVar${$NI}, an error occurs. - If addition index arguments are supplied, then each argument is used - in turn to address an element within a sublist designated by the - previous indexing operation, allowing the script to remove elements - in sublists, similar to lindex and lset." - } "@doc -name Manpage: -url [manpage_tcl lpop]" + "When presented with a single index, the lpop command addresses + the index'th element in it, removes it from the list and returns + the element. + + If index is negative or greater or equal than the number of + elements in the list in the variable ${$I}listVar${$NI}, an error occurs. + + If addition index arguments are supplied, then each argument is used + in turn to address an element within a sublist designated by the + previous indexing operation, allowing the script to remove elements + in sublists, similar to lindex and lset. + ${[example { + ${$B}lpop${$N} a 1 2 + }]} + gets and removes element 2 of sublist 1." + } "@doc -name Manpage: -url [manpage_tcl lpop]"\ + { + @examples -help { + In each of these examples, the initial value of x is: + ${[example { + set x [list [list a b c] [list d e f] [list g h i]] + → {a b c} {d e f} {g h i} + }]} + The indicated value becomes the new value of x (except in the last case, + which is an error which leaves the value of x unchanged.) + ${[example { + ${$B}lpop${$N} x 0 + → {d e f} {g h i} + ${$B}lpop${$N} x 2 + → {a b c} {d e f} + ${$B}lpop${$N} x end + → {a b c} {d e f} + ${$B}lpop${$N} x end-1 + → {a b c} {g h i} + ${$B}lpop${$N} x 2 1 + → {a b c} {d e f} {g i} + ${$B}lpop${$N} x 2 3 + → list index out of range + }]} + + In the following examples, the initial value of x is: + ${[example { + set x [list [list [list a b] [list c d]] \ + [list [list e f] [list g h]]] + → {{a b} {c d}} {{e f} {g h}} + }]} + The indicated value becomes the new value of x. + ${[example { + ${$B}lpop${$N} x 1 1 0 + → {{a b} {c d}} {{e f} h} + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -4933,7 +5706,35 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "index expression for first element" last -type indexexpression -help\ "index expression for last element" - } "@doc -name Manpage: -url [manpage_tcl lrange]" + } "@doc -name Manpage: -url [manpage_tcl lrange]"\ + { + @examples -help { + Selecting the first two elements: + ${[example { + % ${$B}lrange${$N} {a b c d e} 0 1 + a b + }]} + Selecting the last three elements: + ${[example { + % ${$B}lrange${$N} {a b c d e} end-2 end + c d e + }]} + Selecting everything except the first and last element: + ${[example { + % ${$B}lrange${$N} {a b c d e} 1 end-1 + b c d + }]} + Selecting a single element with ${$B}lrange${$N} is not the same as doing so with ${$B}lindex${$N}: + ${[example { + % set var {some {elements to} select} + some {elements to} select + % lindex $var 1 + elements to + % ${$B}lrange${$N} $var 1 1 + {elements to} + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -4949,7 +5750,21 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max -1 count -type integer -range {0 ""} element -type string -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl lrepeat]" + } "@doc -name Manpage: -url [manpage_tcl lrepeat]"\ + { + @examples -help { + ${[example { + ${$B}lrepeat${$N} 3 a + → a a a + ${$B}lrepeat${$N} 3 [${$B}lrepeat${$N} 3 0] + → {0 0 0} {0 0 0} {0 0 0} + ${$B}lrepeat${$N} 3 a b c + → a b c a b c a b c + ${$B}lrepeat${$N} 3 [${$B}lrepeat${$N} 2 a] b c + → {a a} b c {a a} b c {a a} b c + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -4987,7 +5802,45 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { first -type indexexpression last -type indexexpression element -type string -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl lreplace]" + } "@doc -name Manpage: -url [manpage_tcl lreplace]"\ + { + @examples -help { + Replacing an element of a list with another: + ${[example { + % ${$B}lreplace${$N} {a b c d e} 1 1 foo + a foo c d e + }]} + Replacing two elements of a list with three: + ${[example { + % ${$B}lreplace${$N} {a b c d e} 1 2 three more elements + a three more elements d e + }]} + Deleting the last element from a list in a variable: + ${[example { + % set var {a b c d e} + a b c d e + % set var [${$B}lreplace${$N} $var end end] + a b c d + }]} + A procedure to delete a given element from a list: + ${[example { + proc lremove {listVariable value} { + upvar 1 $listVariable var + set idx [lsearch -exact $var $value] + set var [${$B}lreplace${$N} $var $idx $idx] + } + }]} + Appending elements to the list; note that ${$B}end+2${$N} will initially be treated + as if it is ${$B}6${$N} here, but both that and ${$B}12345${$N} are greater than the index of + the final item so they behave identically: + ${[example { + % set var {a b c d e} + a b c d e + % set var [${$B}lreplace${$N} $var 12345 end+2 f g h i] + a b c d e f g h i + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -5011,7 +5864,26 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { index -type indexexpression -multiple 1 -optional 1 @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} - } "@doc -name Manpage: -url [manpage_tcl lremove]" + } "@doc -name Manpage: -url [manpage_tcl lremove]"\ + { + @examples -help { + Removing the third element of a list: + ${[example { + % ${$B}lremove${$N} {a b c d e} 2 + a b d e + }]} + Removing two elements from a list: + ${[example { + % ${$B}lremove${$N} {a b c d e} end-1 1 + a c e + }]} + Removing the same element indicated in two different ways: + ${[example { + % ${$B}lremove${$N} {a b c d e} 2 end-2 + a b d e + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -5026,9 +5898,130 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max 1 list -type list -help\ "tcl list as a value" - } "@doc -name Manpage: -url [manpage_tcl lreverse]" + } "@doc -name Manpage: -url [manpage_tcl lreverse]"\ + { + @examples -help { + ${[example { + lreverse {a a b c} + → c b a a + lreverse {a b {c d} e f} + → f e {c d} b a + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lseq + @cmd -name "Built-in: lseq"\ + -summary\ + "Build a numeric sequence returned as a list."\ + -help\ + "The ${$B}lseq${$N} command creates a sequence of numeric values using the given + parameters ${$I}start${$NI}, ${$I}end${$NI} and ${$I}step${$NI}. The ${$I}operation${$NI} + argument \"..\" or \"${$B}to${$N}\" defines the range. The \"${$B}count${$N}\" option is + used to defina a count of the number of elements in the list. A short form use of the + command, with a single ${$I}count${$NI} value, will creat a range from 0 to ${$I}count-1${$NI}. + The ${$B}lseq${$N} command can produce both increasing and decreasing sequences. + When both ${$I}start${$NI} and ${$I}end${$NI} are provided without a ${$I}step${$NI} value, + then if ${$I}start${$NI} <= ${$I}end${$NI}, the sequence will be increasing and if + ${$I}start${$NI} > ${$I}end${$NI} it will be decreasing. If a ${$I}step${$NI} value is + included, it's sign should agree with the direction of the sequence + (descending -> negative and ascending -> positive), otherwise an empty list is returned. + For example: + ${[example { + % lseq 1 to 5 ;#increasing + → 1 2 3 4 5 + + % lseq 5 to 1 ;#decreasing + → 5 4 3 2 1 + + % lseq 6 to 1 by 2 ;#decreasing, step wrong sign, empty list + + % lseq 1 5 by 0 ;#all step sizes of 0 produce an empty list + }]} + + The numeric arguments ${$I}start${$NI}, ${$I}end${$NI}, ${$I}step${$NI} and ${$I}count${$NI}, may + also be a valid expression. The expression will be evaluated and the numeric result will + be used. An expression that does not evaluate to a number will produce an invalid argument error. + ${$I}Start${$NI} defines the initial value and ${$I}end${$NI} defines the limit, not necessarily + the last value. ${$B}lseq${$N} produces a list with ${$B}count${$N} elements and if ${$B}count${$N} + is not supplied, it is computed as: + count = int( (end - start + step) / step) + " + @form -form range + @leaders -min 0 -max 0 + @values -min 2 -max 5 + start -type number|expr + ..|to -type string -choices {.. to} -optional 1 + end -type number|expr + "by step" -type {literal(by) number|expr} -optional 1 + + @form -form start_count + @leaders -min 0 -max 0 + @values -min 3 -max 5 + start -type number|expr + count -type literal + countelements -type number|expr + "by step" -type {literal(by) number|expr} -optional 1 + + @form -form count + @leaders -min 0 -max 0 + @values -min 1 -max 3 + countelements -type number|expr + "by step" -type {literal(by) number|expr} -optional 1 + + } "@doc -name Manpage: -url [manpage_tcl lseq]"\ + { + @examples -help { + ${[example { + ${$B}lseq${$N} 3 + → 0 1 2 + + ${$B}lseq${$N} 3 0 + → 3 2 1 0 + + ${$B}lseq${$N} 10 .. 1 by -2 + → 10 8 6 4 2 + + set l [${$B}lseq${$N} 0 -5] + → 0 -1 -2 -3 -4 -5 + + foreach i [${$B}lseq${$N} [llength $l]] { + puts l($i)=[lindex $l $i] + } + → l(0)=0 + → l(1)=-1 + → l(2)=-2 + → l(3)=-3 + → l(4)=-4 + → l(5)=-5 + + foreach i [${$B}lseq${$N} {[llength $l]-1} 0] { + puts l($i)=[lindex $l $i] + } + → l(5)=-5 + → l(4)=-4 + → l(3)=-3 + → l(2)=-2 + → l(1)=-1 + → l(0)=0 + + set i 17 + → 17 + if {$i in [${$B}lseq${$N} 0 50]} { # equivalent to: (0 <= $i && $i <= 50) + puts "Ok" + } else { + puts "outside :(" + } + → Ok + + set sqrs [lmap i [${$B}lseq${$N} 1 10] { expr {$i*$i} }] + → 1 4 9 16 25 36 49 64 81 100 + }]} + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lset @@ -5081,7 +6074,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { the current end). If an index is outside the permitted range, an error is reported." @form -form index @leaders -min 1 -max -1 - listVar -type string -help\ + varName -type string -help\ "Existing list variable name" index -type indexexpression -multiple 1 @values -min 1 -max 1 @@ -5089,79 +6082,61 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @form -form indexlist @leaders -min 2 -max 2 - listVar -type string -help\ + varName -type string -help\ "Existing list variable name" indexList -type list -optional 1 -multiple 0 @values -min 1 -max 1 newValue -type any - } "@doc -name Manpage: -url [manpage_tcl lset]" - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - punk::args::define { - @id -id ::lseq - @cmd -name "Built-in: lseq"\ - -summary\ - "Build a numeric sequence returned as a list."\ - -help\ - "The ${$B}lseq${$N} command creates a sequence of numeric values using the given - parameters ${$I}start${$NI}, ${$I}end${$NI} and ${$I}step${$NI}. The ${$I}operation${$NI} - argument \"..\" or \"${$B}to${$N}\" defines the range. The \"${$B}count${$N}\" option is - used to defina a count of the number of elements in the list. A short form use of the - command, with a single ${$I}count${$NI} value, will creat a range from 0 to ${$I}count-1${$NI}. - The ${$B}lseq${$N} command can produce both increasing and decreasing sequences. - When both ${$I}start${$NI} and ${$I}end${$NI} are provided without a ${$I}step${$NI} value, - then if ${$I}start${$NI} <= ${$I}end${$NI}, the sequence will be increasing and if - ${$I}start${$NI} > ${$I}end${$NI} it will be decreasing. If a ${$I}step${$NI} value is - included, it's sign should agree with the direction of the sequence - (descending -> negative and ascending -> positive), otherwise an empty list is returned. - For example: - ${[punk::args::moduledoc::tclcore::argdoc::example { - % lseq 1 to 5 ;#increasing - -> 1 2 3 4 5 - - % lseq 5 to 1 ;#decreasing - -> 5 4 3 2 1 - - % lseq 6 to 1 by 2 ;#decreasing, step wrong sign, empty list - - % lseq 1 5 by 0 ;#all step sizes of 0 produce an empty list - }]} - - The numeric arguments ${$I}start${$NI}, ${$I}end${$NI}, ${$I}step${$NI} and ${$I}count${$NI}, may - also be a valid expression. The expression will be evaluated and the numeric result will - be used. An expression that does not evaluate to a number will produce an invalid argument error. - ${$I}Start${$NI} defines the initial value and ${$I}end${$NI} defines the limit, not necessarily - the last value. ${$B}lseq${$N} produces a list with ${$B}count${$N} elements and if ${$B}count${$N} - is not supplied, it is computed as: - count = int( (end - start + step) / step) - " - @form -form range - @leaders -min 0 -max 0 - @values -min 2 -max 5 - start -type number|expr - ..|to -type string -choices {.. to} -optional 1 - end -type number|expr - "by step" -type {literal(by) number|expr} -optional 1 - - @form -form start_count - @leaders -min 0 -max 0 - @values -min 3 -max 5 - start -type number|expr - count -type literal - countelements -type number|expr - "by step" -type {literal(by) number|expr} -optional 1 - - @form -form count - @leaders -min 0 -max 0 - @values -min 1 -max 3 - countelements -type number|expr - "by step" -type {literal(by) number|expr} -optional 1 - - } "@doc -name Manpage: -url [manpage_tcl lreverse]" + } "@doc -name Manpage: -url [manpage_tcl lset]"\ + { + @examples -help { + In each of these examples, the initial value of x is: + ${[example { + set x [list [list a b c] [list d e f] [list g h i]] + → {a b c} {d e f} {g h i} + }]} + The indicated return value also becomes the new value of x + (except in the last case, which is an error which leaves the value of x unchanged.) + ${[example { + ${$B}lset${$N} x {j k l} + → j k l + ${$B}lset${$N} x {} {j k l} + → j k l + ${$B}lset${$N} x 0 j + → j {d e f} {g h i} + ${$B}lset${$N} x 2 j + → {a b c} {d e f} j + ${$B}lset${$N} x end j + → {a b c} {d e f} j + ${$B}lset${$N} x end-1 j + → {a b c} j {g h i} + ${$B}lset${$N} x 2 1 j + → {a b c} {d e f} {g j i} + ${$B}lset${$N} x {2 1} j + → {a b c} {d e f} {g j i} + ${$B}lset${$N} x {2 3} j + → {a b c} {d e f} {g h i j} + ${$B}lset${$N} x {2 4} j + → list index out of range + }]} + In the following examples, the initial value of x is: + ${[example { + set x [list [list [list a b] [list c d]] \ + [list [list e f] [list g h]]] + → {{a b} {c d}} {{e f} {g h}} + }]} + The indicated return value also becomes the new value of x. + ${[example { + ${$B}lset${$N} x 1 1 0 j + → {{a b} {c d}} {{e f} {j h}} + ${$B}lset${$N} x {1 1 0} j + → {{a b} {c d}} {{e f} {j h}} + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - punk::args::define { @id -id ::lsearch @cmd -name "Built-in: lsearch"\ @@ -5264,7 +6239,49 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 2 -max 2 list -type list pattern -type string - } "@doc -name Manpage: -url [manpage_tcl lsearch]" + } "@doc -name Manpage: -url [manpage_tcl lsearch]"\ + { + @examples -help { + Basic searching: + ${[example { + ${$B}lsearch${$N} {a b c d e} c + → 2 + ${$B}lsearch${$N} -all {a b c a b c} c + → 2 5 + }]} + Using ${$B}lsearch${$N} to filter lists: + ${[example { + ${$B}lsearch${$N} -inline {a20 b35 c47} b* + → b35 + ${$B}lsearch${$N} -inline -not {a20 b35 c47} b* + → a20 + ${$B}lsearch${$N} -all -inline -not {a20 b35 c47} b* + → a20 c47 + ${$B}lsearch${$N} -all -not {a20 b35 c47} b* + → 0 2 + }]} + This can even do a “set-like” removal operation: + ${[example { + ${$B}lsearch${$N} -all -inline -not -exact {a b c a d e a f g a} a + → b c d e f g + }]} + Searching may start part-way through the list: + ${[example { + ${$B}lsearch${$N} -start 3 {a b c a b c} c + → 5 + }]} + It is also possible to search inside elements: + ${[example { + ${$B}lsearch${$N} -index 1 -all -inline {{abc abc} {abc bcd} {abc cde}} *bc* + → {abc abc} {abc bcd} + }]} + The same thing for a flattened list: + ${[example { + ${$B}lsearch${$N} -stride 2 -index 1 -all -inline {abc abc abc bcd abc cde} *bc* + → abc abc abc bcd + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -5323,20 +6340,23 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { sublist (as if the overall element and the indexList were passed to lindex) and sort based on the given element. For example, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { lsort -integer -index 1 \ - {{First 24} {Second 18} {Third 30}} }]} + {{First 24} {Second 18} {Third 30}} + }]} returns ${$B}{Second 18} {First 24} {Third 30}${$N}, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { lsort -index end-1 \ - {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}} }]} + {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}} + }]} returns ${$B}{c 4 5 6 d h} {a 1 e i} {b 2 3 f 5}${$N}, and - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { lsort -index {0 1} { - {{b i g} 12345} - {{d e m o} 34512} - {{c o d e} 54321} - }}]} + {{b i g} 12345} + {{d e m o} 34512} + {{c o d e} 54321} + } + }]} returns ${$B}{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}${$N} (because e sorts before i which sorts before o.) This option is much more efficient than using ${$B}-command${$N} to achieve the same effect.} @@ -5350,11 +6370,13 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { The list length must be an integer multiple of the strideLength, which in turn must be at least 2. For example, - ${[punk::args::moduledoc::tclcore::argdoc::example { - lsort -stride 2 {carrot 10 apple 50 banana 25} }]} + ${[example { + lsort -stride 2 {carrot 10 apple 50 banana 25} + }]} returns "apple 50 banana 25 carrot 10", and - ${[punk::args::moduledoc::tclcore::argdoc::example { - lsort -stride 2 -index 1 -integer {carrot 10 apple 50 banana 25} }]} + ${[example { + lsort -stride 2 -index 1 -integer {carrot 10 apple 50 banana 25} + }]} returns "carrot 10 banana 25 apple 50".} -nocase -type none -help\ "Causes comparisons to be handled in a case-insensitive manner. Has no @@ -5371,7 +6393,80 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { list -type list -help\ "tcl list as a value" - } "@doc -name Manpage: -url [manpage_tcl lsort]" + } "@doc -name Manpage: -url [manpage_tcl lsort]"\ + { + @examples -help { + Sorting a list using ASCII sorting: + ${[example { + % ${$B}lsort${$N} {a10 B2 b1 a1 a2} + B2 a1 a10 a2 b1 + }]} + Sorting a list using Dictionary sorting: + ${[example { + % ${$B}lsort${$N} -dictionary {a10 B2 b1 a1 a2} + a1 a2 a10 b1 B2 + }]} + Sorting lists of integers: + ${[example { + % ${$B}lsort${$N} -integer {5 3 1 2 11 4} + 1 2 3 4 5 11 + % ${$B}lsort${$N} -integer {1 2 0x5 7 0 4 -1} + -1 0 1 2 4 0x5 7 + }]} + Sorting lists of floating-point numbers: + ${[example { + % ${$B}lsort${$N} -real {5 3 1 2 11 4} + 1 2 3 4 5 11 + % ${$B}lsort${$N} -real {.5 0.07e1 0.4 6e-1} + 0.4 .5 6e-1 0.07e1 + }]} + Sorting using indices: + ${[example { + % # Note the space character before the c + % ${$B}lsort${$N} {{a 5} { c 3} {b 4} {e 1} {d 2}} + { c 3} {a 5} {b 4} {d 2} {e 1} + % ${$B}lsort${$N} -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}} + {a 5} {b 4} { c 3} {d 2} {e 1} + % ${$B}lsort${$N} -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}} + {e 1} {d 2} { c 3} {b 4} {a 5} + }]} + Sorting a dictionary: + ${[example { + % set d [dict create c d a b h i f g c e] + c e a b h i f g + % ${$B}lsort${$N} -stride 2 $d + a b c e f g h i + }]} + Sorting using striding and multiple indices: + ${[example { + % # Note the first index value is relative to the group + % ${$B}lsort${$N} -stride 3 -index {0 1} \ + {{Bob Smith} 25 Audi {Jane Doe} 40 Ford} + {{Jane Doe} 40 Ford {Bob Smith} 25 Audi} + }]} + Stripping duplicate values using sorting: + ${[example { + % ${$B}lsort${$N} -unique {a b c a b c a b c} + a b c + }]} + More complex sorting using a comparison function: + ${[example { + % proc compare {a b} { + set a0 [lindex $a 0] + set b0 [lindex $b 0] + if {$a0 < $b0} { + return -1 + } elseif {$a0 > $b0} { + return 1 + } + return [string compare [lindex $a 1] [lindex $b 1]] + } + % ${$B}lsort${$N} -command compare \ + {{3 apple} {0x2 carrot} {1 dingo} {2 banana}} + {1 dingo} {2 banana} {0x2 carrot} {3 apple} + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } @@ -5720,18 +6815,19 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { -choiceinfo {${$PACKAGE_CHOICEINFO}} @values -unnamed true } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl package]"\ - {@examples -help { + { + @examples -help { To state that a Tcl script requires the Tk and http packages, put this at the top of the script: - ${[punk::args::moduledoc::tclcore::argdoc::example { - package require Tk - package require http + ${[example { + ${$B}package require${$N} Tk + ${$B}package require${$N} http }]} To test to see if the Snack package is available and load if it is (often useful for optional enhancements to programs where the loss of the functionality is not critical) do this: - ${[punk::args::moduledoc::tclcore::argdoc::example { - if {[catch {package require Snack}]} { + ${[example { + if {[catch {${$B}package require${$N} Snack}]} { # Error thrown - package not found. - # Set up a dummy interface to work around the absence + # Set up a dummy interface to work around the absence } else { # We have the package, configure the app to use it } @@ -5804,7 +6900,37 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { #todo - list elements must be length 1 or length 2 args -type list body -type script - } "@doc -name Manpage: -url [manpage_tcl proc]" + } "@doc -name Manpage: -url [manpage_tcl proc]"\ + { + @examples -help { + This is a procedure that takes two arguments and prints both their sum and their product. + It also returns the string “OK” to the caller as an explicit result. + ${[example { + ${$B}proc${$N} printSumProduct {x y} { + set sum [expr {$x + $y}] + set prod [expr {$x * $y}] + puts "sum is $sum, product is $prod" + return "OK" + } + }]} + This is a procedure that accepts arbitrarily many arguments and prints them out, one by one. + ${[example { + ${$B}proc${$N} printArguments args { + foreach arg $args { + puts $arg + } + } + }]} + This procedure is a bit like the ${$B}incr${$N} command, except it multiplies the contents of the + named variable by the value, which defaults to ${$B}2${$N}: + ${[example { + ${$B}proc${$N} mult {varName {multiplier 2}} { + upvar 1 $varName var + set var [expr {$var * $multiplier}] + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -5837,8 +6963,8 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { in the directory that it was started in (unless the user specifies otherwise) since that minimizes user confusion. The way to do this is to save the current directory while the external command is being run: - ${[punk::args::moduledoc::tclcore::argdoc::example { - set tarFile [file normalize somefile.tar] + ${[example { + set tarFile [file normalize somefile.tar] set savedDir [pwd] cd /tmp exec tar -xf $tarFile @@ -5847,20 +6973,21 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @leaders -min 0 -max 0 @values -min 0 -max 0 } "@doc -name Manpage: -url [manpage_tcl pwd]"\ - {@examples -help { - Sometimes it is useful to change to a known directory when running some external - command using exec, but it is important to keep the application usually running - in the directory that it was started in (unless the user specifies otherwise) - since that minimizes user confusion. The way to do this is to save the current - directory while the external command is being run: - ${[punk::args::moduledoc::tclcore::argdoc::example { - set tarFile [file normalize somefile.tar] - set savedDir [pwd] - cd /tmp - exec tar -xf $tarFile - cd $savedDir - }]} - } + { + @examples -help { + Sometimes it is useful to change to a known directory when running some external + command using exec, but it is important to keep the application usually running + in the directory that it was started in (unless the user specifies otherwise) + since that minimizes user confusion. The way to do this is to save the current + directory while the external command is being run: + ${[example { + set tarFile [file normalize somefile.tar] + set savedDir [pwd] + cd /tmp + exec tar -xf $tarFile + cd $savedDir + }]} + } } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -6083,7 +7210,75 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { result -form * -type string -optional 1 - } "@doc -name Manpage: -url [manpage_tcl return]" + } "@doc -name Manpage: -url [manpage_tcl return]"\ + { + @examples -help { + First, a simple example of using ${$B}return${$N} to return from a procedure, interrupting the procedure body. + ${[example { + proc printOneLine {} { + puts "line 1" ;# This line will be printed. + ${$B}return${$N} + puts "line 2" ;# This line will not be printed. + } + }]} + Next, an example of using ${$B}return${$N} to set the value returned by the procedure. + ${[example { + proc returnX {} {${$B}return${$N} X} + puts [returnX] ;# prints "X" + }]} + Next, a more complete example, using ${$B}return -code error${$N} to report invalid arguments. + ${[example { + proc factorial {n} { + if {![string is integer $n] || ($n < 0)} { + ${$B}return${$N} -code error \ + "expected non-negative integer,\ + but got \"$n\"" + } + if {$n < 2} { + ${$B}return${$N} 1 + } + set factor [factorial [expr {$n - 1}]] + set product [expr {$n * $factor}] + ${$B}return${$N} $product + } + }]} + Next, a procedure replacement for ${$B}break${$N}. + ${[example { + proc myBreak {} { + ${$B}return${$N} -code break + } + }]} + With the ${$B}-level 0 option, ${$B}return${$N} itself can serve as a replacement for ${$B}break${$N}, with the help of ${$B}interp alias${$N}. + ${[example { + interp alias {} Break {} ${$B}return${$N} -level 0 -code break + }]} + An example of using ${$B}catch${$N} and ${$B}return${$N} ${$B}-options${$N} to re-raise a caught error: + ${[example { + proc doSomething {} { + set resource [allocate] + catch { + # Long script of operations + # that might raise an error + } result options + deallocate $resource + ${$B}return${$N} -options $options $result + } + }]} + Finally an example of advanced use of the ${$B}return${$N} options to create a procedure replacement for ${$B}return${$N} itself: + ${[example { + proc myReturn {args} { + set result "" + if {[llength $args] % 2} { + set result [lindex $args end] + set args [lrange $args 0 end-1] + } + set options [dict merge {-level 1} $args] + dict incr options -level + ${$B}return${$N} -options $options $result + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -6125,7 +7320,33 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { set myarray(data,0) {a b c} see the dict command for an alternative datastructure." value -type any -optional 1 - } "@doc -name Manpage: -url [manpage_tcl set]" + } "@doc -name Manpage: -url [manpage_tcl set]"\ + { + @examples -help { + Store a random number in the variable r: + ${[example { + ${$B}set${$N} r [expr {rand()}] + }]} + Store a short message in an array element: + ${[example { + ${$B}set${$N} anAry(msg) "Hello, World!" + }]} + Store a short message in an array element specified by a variable: + ${[example { + ${$B}set${$N} elemName "msg" + ${$B}set${$N} anAry($elemName) "Hello, World!" + }]} + Copy a value into the variable ${$I}out${$NI} from a variable whose name is stored in the ${$I}vbl${$NI} + (note that it is often easier to use arrays in practice instead of doing + double-dereferencing): + ${[example { + ${$B}set${$N} in0 "small random" + ${$B}set${$N} in1 "large random" + ${$B}set${$N} vbl in[expr {rand() >= 0.5}] + ${$B}set${$N} out [${$B}set${$N} $vbl] + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -6294,28 +7515,31 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "port number or service name" } "@doc -name Manpage: -url [manpage_tcl socket]"\ - {@examples -help { + { + @examples -help { Here is a very simple time server: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc Server {startTime channel clientaddr clientport} { puts "Connection from $clientaddr registered" set now [clock seconds] puts $channel [clock format $now] - puts $channel "[expr {$now - $startTime}] since start" + puts $channel "[expr {$now - $startTime}] since start" close $channel } - socket -server [list Server [clock seconds]] 9900 - vwait forever}]} + ${$B}socket${$N} -server [list Server [clock seconds]] 9900 + vwait forever + }]} And here is the corresponding client to talk to the server and extract some information: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set server localhost - set sockChan [socket $server 9900] + set sockChan [${$B}socket${$N} $server 9900] gets $sockChan line1 gets $sockChan line2 close $sockChan puts "The time on $server is $line1" - puts "That is [lindex $line2 0]s since the server started" }]} + puts "That is [lindex $line2 0]s since the server started" + }]} }} # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @@ -6350,21 +7574,35 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { fileName } "@doc -name Manpage: -url [manpage_tcl source]"\ - {@examples -help { + { + @examples -help { Run the script in the file ${$B}foo.tcl${$N} and then the script in ${$B}bar.tcl${$N}: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { source foo.tcl - source bar.tcl }]} + source bar.tcl + }]} Alternatively: - ${[punk::args::moduledoc::tclcore::argdoc::example { - foreach scriptFile {foo.tcl bar.tcl} { + ${[example { + foreach scriptFile {foo.tcl bar.tcl} { source $scriptFile - }}]} + } + }]} }} # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + set split_example_unbalanced {${[punk::args::helpers::example -syntax none " + split \"Example with \{unbalanced brace character\" + → Example with \\\{unbalanced brace character" + ]}} + set split_example_unbalanced { + ${[punk::args::helpers::example -syntax none { + split "Example with \{unbalanced brace character" + → Example with \\\{unbalanced brace character + }]} + } punk::args::define { + @dynamic @id -id ::split @cmd -name "Built-in: split"\ -summary\ @@ -6382,7 +7620,56 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max 2 string -type string splitChars -type string -optional 1 - } "@doc -name Manpage: -url [manpage_tcl split]" + } "@doc -name Manpage: -url [manpage_tcl split]"\ + { + @examples -help { + Divide up a USENET group name into its hierarchical components: + ${[example { + split "comp.lang.tcl" . + → comp lang tcl + }]} + See how the split command splits on every character in splitChars, which + can result in information loss if you are not careful: + ${[example { + split "alpha beta gamma" "temp" + → al {ha b} {} {a ga} {} a + }]} + Extract the list words from a string that is not a well-formed list: + ${[punk::args::helpers::example -syntax none { + split "Example with {unbalanced brace character" + → Example with \{unbalanced brace character + # balancing brace needed in define script } + }]} + Split a string into its constituent characters + ${[example { + split "Hello world" {} + → H e l l o { } w o r l d + }]} + ${$T}PARSING RECORD ORIENTED FILES${$NT} + Parse a Unix /etc/passwd file, which consists of one entry per line, + with each line consisting of a colon-separated list of fields: + ${[example { + ## Read the file + set fid [open /etc/passwd] + set content [read $fid] + close $fid + + ## Split into records on newlines + set records [split $content "\n"] + + ## Iterate over the records + foreach rec $records { + + ## Split into fields on colons + set fields [split $rec ":"] + + ## Assign fields to variables and print some out... + lassign $fields \ + userName password uid grp longName homeDir shell + puts "$longName uses [file tail $shell] for a login shell" + } + }]} + }} # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } @@ -6440,8 +7727,8 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "If -nocase is specified, then the strings are compared in a case insensitive manner." -length -type integer -help\ - "If -length is specified, then only the first length characters are used in the comparison. - If -length is negative, it is ignored." + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." @values -min 2 -max 2 string1 -type string @@ -6457,10 +7744,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { specified (in any of the forms described in STRING_INDICES), then the search is constrained to start with the character in ${$I}haystackString${$NI} specified by the index. For Example, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string first a 0a23456789abcdef 5 }]} will return ${$B}10${$N}, but - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string first a 0a23456789abcdef 11 }]} will return ${$B}-1${$N}. " @@ -6512,10 +7799,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { specified (in any of the forms described in STRING_INDICES), then only the characters in ${$I}haystackString${$NI} at or before the specified lastIndex will be considered by the search. For example, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string last a 0a23456789abcdef 15 }]} will return ${$B}10${$N}, but - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string last a 0a23456789abcdef 9 }]} will return ${$B}1${$N}." @values -min 1 -max 3 @@ -6547,12 +7834,12 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { key appearing first in the list will be checked first, and so on. ${$I}string${$NI} is only iterated over once, so earlier key replacements will have no affect for later key matches. For example, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc }]} will return the string ${$B}01321221${$N}. Note that if an earlier key is a prefix of a later one, it will completely mask the later one, So if the previous example were reordered like this, - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { string map {1 0 ab 2 a 3 abc 1} 1abcaababcabababc }]} it will return the string ${$B}02c322c222c${$N}. " @@ -7086,7 +8373,55 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { "{pattern body ?pattern body?...}" -form block -type dict - } "@doc -name Manpage: -url [manpage_tcl switch]" + } "@doc -name Manpage: -url [manpage_tcl switch]"\ + { + @examples -help { + The ${$B}switch${$N} command can match against variables and not just literals, as shown here (the result is 2): + ${[example { + set foo "abc" + ${$B}switch${$N} abc a - b {expr {1}} $foo {expr {2}} default {expr {3}} + }]} + Using glob matching and the fall-through body is an alternative to writing regular expressions with alternations, + as can be seen here (this returns 1): + ${[example { + ${$B}switch${$N} -glob aaab { + a*b - + b {expr {1}} + a* {expr {2}} + default {expr {3}} + } + }]} + Whenever nothing matches, the ${$B}default${$N} clause (which must be last) is taken. This example has a result of 3: + ${[example { + ${$B}switch${$N} xyz { + a - + b { + # Correct Comment Placement + expr {1} + } + c { + expr {2} + } + default { + expr {3} + } + } + }]} + When matching against regular expressions, information about what exactly matched is easily obtained + using the ${$B}-matchvar${$N} option: + ${[example { + ${$B}switch${$N} -regexp -matchvar foo -- $bar { + a(b*)c { + puts "Found [string length [lindex $foo 1]] 'b's" + } + d(e*)f(g*)h { + puts "Found [string length [lindex $foo 1]] 'e's and\ + [string length [lindex $foo 2]] 'g's" + } + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::tailcall @@ -7099,15 +8434,43 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { which will have ${$I}arg${$NI} ... passed as arguments if they are supplied, will be looked up in the current namespace context, not in the caller's. Apart from that difference in resolution, it is equivalent to: - ------------------------------------------------ - return [uplevel 1 [list ${$I}command ?${$I}arg${$NI} ...?]] - ------------------------------------------------ + ${[example { + return [uplevel 1 [list ${$I}command ?${$I}arg${$NI} ...?]] + }]} This command may not be invoked from within an ${$I}uplevel${$NI} into a procedure or insida a ${$B}catch${$N} inside a procedure or lambda." @values -min 1 -max -1 command -type string arg -optional 1 -multiple 1 - } "@doc -name Manpage: -url [manpage_tcl tailcall]" + } "@doc -name Manpage: -url [manpage_tcl tailcall]"\ + { + @examples -help { + Compute the factorial of a number. + ${[example { + proc factorial {n {accum 1}} { + if {$n < 2} { + return $accum + } + ${$B}tailcall${$N} factorial [expr {$n - 1}] [expr {$accum * $n}] + } + }]} + Print the elements of a list with alternating lines having different indentations. + ${[example { + proc printList {theList} { + if {[llength $theList]} { + puts "> [lindex $theList 0]" + ${$B}tailcall${$N} printList2 [lrange $theList 1 end] + } + } + proc printList2 {theList} { + if {[llength $theList]} { + puts "< [lindex $theList 0]" + ${$B}tailcall${$N} printList [lrange $theList 1 end] + } + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::throw @@ -7133,7 +8496,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { ${$B}EXAMPLES${$N} The following produces an error that is identical to that produced by expr when trying to divide a value by zero. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { throw {ARITH DIVZERO {divide by zero}} {divide by zero} }]}" @values -min 2 -max 2 @@ -7614,10 +8977,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { finally -optional 1 -optional 1 -type {literal(finally) script} } "@doc -name Manpage: -url [manpage_tcl try]"\ - {@examples -help { + { + @examples -help { Ensure that a file is closed no matter what: - ${[punk::args::moduledoc::tclcore::argdoc::example { - set f [open /some/file/name a] + ${[example { + set f [open /some/file/name a] try { puts $f "some message" # ... @@ -7626,11 +8990,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } }]} Handle different reasons for a file to not be openable for reading: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { try { set f [open /some/file/name r] } trap {POSIX EISDIR} {} { - puts "failed to open /some/file/name: it's a directory" + puts "failed to open /some/file/name: it's a directory" } trap {POSIX ENOENT} {} { puts "failed to open /some/file/name: it doesn't exist" } @@ -7639,11 +9003,11 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { The file is closed in success and error case by the finally clause. It is allowed to call return within the try block. Remark that with tcl 9, the read command may also throw utf-8 conversion errors: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc readfile {filename} { set f [open $filename r] try { - fconfigure $f -encoding utf-8 -profile strict + fconfigure $f -encoding utf-8 -profile strict return [read $f] } finally { close $f @@ -7712,7 +9076,41 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 1 -max 1 name -optional 0 - } "@doc -name Manpage: -url [manpage_tcl variable]" + } "@doc -name Manpage: -url [manpage_tcl variable]"\ + { + @examples -help { + Create a variable in a namespace: + ${[example { + namespace eval foo { + ${$B}variable${$N} bar 12345 + } + }]} + Create an array in a namespace: + ${[example { + namespace eval someNS { + ${$B}variable${$N} someAry + array set someAry { + someName someValue + otherName otherValue + } + } + }]} + Access variables in namespaces from a procedure: + ${[example { + namespace eval foo { + proc spong {} { + # Variable in this namespace + ${$B}variable${$N} bar + puts "bar is $bar" + + # Variable in another namespace + ${$B}variable${$N} ::someNS::someAry + parray someAry + } + } + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::vwait @@ -7796,14 +9194,15 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl vwait]"\ - {@examples -help { - Run the event-loop continually until some event calls exit. (You can use any variable not mentioned elsewhere, + { + @examples -help { + Run the event-loop continually until some event calls ${$B}exit${$N}. (You can use any variable not mentioned elsewhere, but the name forever reminds you at a glance of the intent.) - ${[punk::args::moduledoc::tclcore::argdoc::example { - vwait forever + ${[example { + ${$B}vwait${$N} forever }]} Wait five seconds for a connection to a server socket, otherwise close the socket and continue running the script: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { # Initialise the state after 5000 set state timeout set server [socket -server accept 12345] @@ -7814,7 +9213,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { } # Wait for something to happen - vwait state + ${$B}vwait${$N} state # Clean up events that could have happened close $server @@ -7833,7 +9232,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { }]} A command that will wait for some time delay by waiting for a namespace variable to be set. Includes an interlock to prevent nested waits. - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { namespace eval example { variable v done proc wait {delay} { @@ -7841,22 +9240,42 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { if {$v ne "waiting"} { set v waiting after $delay [namespace code {set v done}] - vwait [namespace which -variable v] + ${$B}vwait${$N} [namespace which -variable v] } return $v } } }]} + When running inside a ${$B}coroutine${$N}, an alternative to using ${$B}vwait${$N} is to ${$B}yield${$N} to an outer event loop and to get + recommenced when the variable is set, or at an idle moment after that. + ${[example { + coroutine task apply {{} { + # simulate [after 1000] + after 1000 [info coroutine] + yield + + # schedule the setting of a global variable, as normal + after 2000 {set var 1} + + # simulate [${$B}vwait${$N} var] + proc updatedVar {task args} { + after idle $task + trace remove variable ::var write "updatedVar $task" + } + trace add variable ::var write "updatedVar [info coroutine]" + yield + }} + }]} ${$B}NESTED VWAITS BY EXAMPLE${$N} - This example demonstrates what can happen when the vwait command is nested. The script will never finish because - the waiting for the a variable never finishes; that vwait command is still waiting for a script scheduled with - after to complete, which just happens to be running an inner vwait (for b) even though the event that the outer - vwait was waiting for (the setting of a) has occurred. - ${[punk::args::moduledoc::tclcore::argdoc::example { + This example demonstrates what can happen when the ${$B}vwait${$N} command is nested. The script will never finish because + the waiting for the a variable never finishes; that ${$B}vwait${$N} command is still waiting for a script scheduled with + ${$B}after${$N} to complete, which just happens to be running an inner ${$B}vwait${$N} (for b) even though the event that the outer + ${$B}vwait${$N} was waiting for (the setting of a) has occurred. + ${[example { after 500 { puts "waiting for b" - vwait b + ${$B}vwait${$N} b puts "b was set" } after 1000 { @@ -7864,27 +9283,27 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { set a 10 } puts "waiting for a" - vwait a + ${$B}vwait${$N} a puts "a was set" puts "setting b" set b 42 }]} If you run the above code, you get this output: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { waiting for a waiting for b setting a }]} - The script will never print “a was set” until after it has printed “b was set” because of the nesting of vwait - commands, and yet b will not be set until after the outer vwait returns, so the script has deadlocked. The only + The script will never print “a was set” until after it has printed “b was set” because of the nesting of ${$B}vwait${$N} + commands, and yet b will not be set until after the outer ${$B}vwait${$N} returns, so the script has deadlocked. The only ways to avoid this are to either structure the overall program in continuation-passing style or to use coroutine to make the continuations implicit. The first of these options would be written as: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { after 500 { puts "waiting for b" trace add variable b write {apply {args { global a b - trace remove variable ::b write \ + trace remove variable ::b write \ [lrange [info level 0] 0 1] puts "b was set" set ::done ok @@ -7902,15 +9321,15 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { puts "setting b" set b 42 }}} - vwait done + ${$B}vwait${$N} done }]} - The second option, with coroutine and some helper procedures, is done like this: - ${[punk::args::moduledoc::tclcore::argdoc::example { + The second option, with ${$B}coroutine${$N} and some helper procedures, is done like this: + ${[example { # A coroutine-based wait-for-variable command proc waitvar globalVar { - trace add variable ::$globalVar write \ + trace add variable ::$globalVar write \ [list apply {{v c args} { - trace remove variable $v write \ + trace remove variable $v write \ [lrange [info level 0] 0 3] after 0 $c }} ::$globalVar [info coroutine]] @@ -7941,7 +9360,7 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { puts "setting a" set a 10 } - vwait done + ${$B}vwait${$N} done }]} }} @@ -7977,7 +9396,31 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { -- -type none @values -min 0 -max -1 name -type string -multiple 1 -optional 1 - } "@doc -name Manpage: -url [manpage_tcl upvar]" ] + } "@doc -name Manpage: -url [manpage_tcl upvar]"\ + { + @examples -help { + Create an array containing a mapping from some numbers to their squares + and remove the array elements for non-prime numbers: + ${[example { + array set squares { + 1 1 6 36 + 2 4 7 49 + 3 9 8 64 + 4 16 9 81 + 5 25 10 100 + } + + puts "The squares are:" + parray squares + + ${$B}unset${$N} squares(1) squares(4) squares(6) + ${$B}unset${$N} squares(8) squares(9) squares(10) + + puts "The prime squares are:" + parray squares + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- lappend PUNKARGS [list { @id -id ::update @@ -8010,9 +9453,10 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @values -min 0 -max 1 idletasks -type literalprefix(idletasks) -optional 1 } "@doc -name Manpage: -url [manpage_tcl update]"\ - {@examples -help { + { + @examples -help { Run computations for about a second and then finish: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set x 1000 set done 0 after 1000 set done 1 @@ -8056,12 +9500,12 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { The uplevel command causes the invoking procedure to disappear from the procedure calling stack while the command is being executed. In the above example, suppose c invokes the command: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { uplevel 1 {set x 43; d}}]} where d is another Tcl procedure. The set command will modify the variable x in b's context, and d will execute at level 3, as if called from b. If it in turn executes the command: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { uplevel 1 {set x 42}}]} then the set command will modify the same variable x in b's context: the procedure c does not appear to be on the call stack when d is executing. @@ -8110,11 +9554,12 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { calling and also makes it easier to build new control constructs as Tcl procedures. For example, consider the following procedure: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { proc add2 name { upvar $name x set x [expr {$x + 2}] - }}]} + } + }]} If add2 is invoked with an argument giving the name of a variable, it adds two to the value of that variable. Although add2 could have been implemented using ${$B}uplevel${$N} instead of ${$B}upvar${$N}, ${$B}upvar${$N} makes it simpler for add2 to access the @@ -8174,19 +9619,31 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { evaluated (before each loop iteration), so changes in the variables will be visible. For an example, try the following script with and without the braces around ${$B}$x<10:${$N} - ${[punk::args::moduledoc::tclcore::argdoc::example { - set x 0 - while {$x<10} { - puts "x is $x" - incr x - } + ${[example { + set x 0 + ${$B}while${$N} {$x<10} { + puts "x is $x" + incr x + } }]} } @values -min 2 -max 2 test -type expr body -type script -help\ "Tcl script" - } "@doc -name Manpage: -url [manpage_tcl while]" ] + } "@doc -name Manpage: -url [manpage_tcl while]"\ + { + @examples -help { + Read lines from a channel until we get to the end of the stream, + and print them out with a line-number prepended: + ${[example { + set lineCount 0 + ${$B}while${$N} {[gets $chan line] >= 0} { + puts "[incr lineCount]: $line" + } + }]} + } + }] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } @@ -8509,18 +9966,18 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @examples -help { To compress a Tcl string, it should be first converted to a particular charset encoding since the zlib command always operates on binary strings. - ${[punk::args::moduledoc::tclcore::argdoc::example { - set binData [encoding convertto utf-8 $string] + ${[example { + set binData [encoding convertto utf-8 $string] set compData [zlib compress $binData] }]} When converting back, it is also important to reverse the charset encoding: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set binData [zlib decompress $compData] - set string [encoding convertfrom utf-8 $binData] + set string [encoding convertfrom utf-8 $binData] }]} The compression operation from above can also be done with streams, which is especially helpful when you want to accumulate the data by stages: - ${[punk::args::moduledoc::tclcore::argdoc::example { + ${[example { set strm [zlib stream compress] $strm put [encoding convertto utf-8 $string] # ... @@ -8528,7 +9985,8 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { set compData [$strm get] $strm close }]} - }} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -8562,7 +10020,74 @@ tcl::namespace::eval punk::args::moduledoc::tclcore { @leaders -min 1 -max 1 ${$DYN_ZIPFS_SUBCOMMANDS} @values -unnamed true - } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl zipfs]" + } "@doc -name Manpage: -url [punk::args::moduledoc::tclcore::manpage_tcl zipfs]"\ + { + @examples -help { + Mounting a ZIP archive as an application directory and running code out of it before unmounting it again: + ${[example { + set zip myApp.zip + set base [file join [${$B}zipfs root${$N}] myApp] + + ${$B}zipfs mount${$N} $zip $base + # $base now has the contents of myApp.zip + + source [file join $base app.tcl] + # use the contents, load libraries from it, etc... + + ${$B}zipfs unmount${$N} $base + }]} + Creating a ZIP archive, given that a directory exists containing the content to put in the archive. + Note that the source directory is given twice, in order to strip the exterior directory name from each + filename in the archive. + ${[example { + set sourceDirectory [file normalize myApp] + set targetZip myApp.zip + + ${$B}zipfs mkzip${$N} $targetZip $sourceDirectory $sourceDirectory + }]} + Encryption can be applied to ZIP archives by providing a password when building the ZIP and when mounting it + ${[example { + set zip myApp.zip + set sourceDir [file normalize myApp] + set password "hunter2" + set base [file join [${$B}zipfs root${$N}] myApp] + + # Create with password + ${$B}zipfs mkzip${$N} $targetZip $sourceDir $sourceDir $password + + # Mount with password + ${$B}zipfs mount${$N} $zip $base $password + }]} + The following example creates an executable application by appending a ZIP archive to the tclsh file it was + called from and storing the resulting executable in the file “myApp.bin”. When creating an executable image + with a password, the password is placed within the executable in a shrouded form so that the application can + read files inside the embedded ZIP archive yet casual inspection cannot read it. + ${[example { + set appDir [file normalize myApp] + set img "myApp.bin" + set password "hunter2" + + # Create some simple content to define a basic application + file mkdir $appDir + set f [open $appDir/main.tcl w] + puts $f { + puts "Hi. This is [info script]" + } + close $f + + # Create the executable application + ${$B}zipfs mkimg${$N} $img $appDir $appDir $password + + # remove the now obsolete temporary appDir folder + file delete -force $appDir + + # Launch the executable, printing its output to stdout + exec $img >@stdout + # prints the following line assuming [zipfs root] returns "//zipfs:/": + # Hi. This is //zipfs:/app/main.tcl + }]} + } + } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::tcl::zipfs::canonical diff --git a/src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm b/src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm index 2f39eb79..8d6d3e6e 100644 --- a/src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm +++ b/src/modules/punk/args/moduledoc/tkcore-999999.0a1.0.tm @@ -21,7 +21,7 @@ #[manpage_begin punkshell_module_punk::args::moduledoc::tkcore 0 999999.0a1.0] #[copyright "2025"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] -#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] #[require punk::args::moduledoc::tkcore] #[keywords module] #[description] @@ -112,13 +112,15 @@ tcl::namespace::eval punk::args::moduledoc::tkcore { set B [a+ bold] set N [a+ normal] # -- --- --- --- --- - proc example {str} { - set str [string trimleft $str \n] - set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] - set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"] - #puts $result - return $result - } + namespace import ::punk::args::helpers::* + + #proc example {str} { + # #sample override of punk::args::helpers::example (without highlighting and inner placeholder processing) + # set str [string trimleft $str \n] + # set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]] + # set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"] + # return $result + #} } @@ -459,15 +461,15 @@ tcl::namespace::eval punk::args::moduledoc::tkcore { { @examples -help { This is the classic Tk “Hello, World!” demonstration: - ${[punk::args::moduledoc::tclcore::argdoc::example { - button .b -text "Hello, World!" -command exit + ${[example { + ${$B}button${$N} .b -text "Hello, World!" -command exit pack .b }]} This example demonstrates how to handle button accelerators: - ${[punk::args::moduledoc::tclcore::argdoc::example { - button .b1 -text Hello -underline 0 - button .b2 -text World -underline 0 + ${[example { + ${$B}button${$N} .b1 -text Hello -underline 0 + ${$B}button .b2${$N} -text World -underline 0 bind . {.b1 flash; .b1 invoke} bind . {.b2 flash; .b2 invoke} pack .b1 .b2 @@ -557,9 +559,9 @@ tcl::namespace::eval punk::args::moduledoc::tkcore::lib { -# == === === === === === === === === === === === === === === +# == === === === === === === === === === === === === === === # Sample 'about' function with punk::args documentation -# == === === === === === === === === === === === === === === +# == === === === === === === === === === === === === === === tcl::namespace::eval punk::args::moduledoc::tkcore { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase variable PUNKARGS @@ -582,7 +584,7 @@ tcl::namespace::eval punk::args::moduledoc::tkcore { set about_topics [list] foreach f $topic_funs { set tail [namespace tail $f] - lappend about_topics [string range $tail [string length get_topic_] end] + lappend about_topics [string range $tail [string length get_topic_] end] } #Adjust this function or 'default_topics' if a different order is required return [lsort $about_topics] diff --git a/src/modules/punk/imap4-999999.0a1.0.tm b/src/modules/punk/imap4-999999.0a1.0.tm index ac73a3bc..7bc6bb3e 100644 --- a/src/modules/punk/imap4-999999.0a1.0.tm +++ b/src/modules/punk/imap4-999999.0a1.0.tm @@ -1481,53 +1481,55 @@ tcl::namespace::eval punk::imap4 { - - lappend PUNKARGS [list { - @id -id ::punk::imap4::CONNECT - @cmd -name punk::imap4::CONNECT -help\ - "Open a new IMAP connection and initialise the handler. - Returns the Tcl channel to use in subsequent calls to - the API. Other API commands will return zero on success. - e.g - ${[punk::args::moduledoc::tclcore::argdoc::example { - % set chan [CONNECT mail.example.com] - sock123aaa456789 - % AUTH_PLAIN $chan user pass - 0 - ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ... - % LOGOUT $chan - 0}]}" - @leaders -min 0 -max 0 - -debug -type boolean -default 0 -help\ - "Display some of the cli/server interaction on stdout - during commands. This can be set or queried using - the 'debugchan $chan ?bool?' command." - -security -nocase 1 -choices {None TLS/SSL STARTTLS} -help\ - "Connection security. - TLS/SSL is recommended (implicit TLS). - - If port is 143 and -security is omitted, then it will - default to STARTTLS. - For any other port, or omitted port, the default for - -security is TLS/SSL. - ie if no channel security is wanted, then -security - should be explicitly set to None." - @values -min 1 -max 2 - hostname -optional 0 -help\ - "Host/IP Address of server. - port may optionally be specified at tail of hostname - after a colon, but not if the following optional port - argument to the command is also supplied and is non-zero. - e.g - server.example.com:143 - [::1]::993 - " - port -optional 1 -type integer -help\ - "Port to connect to. - If port is omitted: - defaults to 143 when -security None or STARTTLS - defaults to 993 when -security TLS/SSL or -security is omitted." - }] + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::imap4::CONNECT + @cmd -name punk::imap4::CONNECT -help\ + "Open a new IMAP connection and initialise the handler. + Returns the Tcl channel to use in subsequent calls to + the API. Other API commands will return zero on success. + e.g + ${[example { + % set chan [${[B]}CONNECT${[N]} mail.example.com] + sock123aaa456789 + % AUTH_PLAIN $chan user pass + 0 + # ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ... + % LOGOUT $chan + 0 + }]}" + @leaders -min 0 -max 0 + -debug -type boolean -default 0 -help\ + "Display some of the cli/server interaction on stdout + during commands. This can be set or queried using + the 'debugchan $chan ?bool?' command." + -security -nocase 1 -choices {None TLS/SSL STARTTLS} -help\ + "Connection security. + TLS/SSL is recommended (implicit TLS). + + If port is 143 and -security is omitted, then it will + default to STARTTLS. + For any other port, or omitted port, the default for + -security is TLS/SSL. + ie if no channel security is wanted, then -security + should be explicitly set to None." + @values -min 1 -max 2 + hostname -optional 0 -help\ + "Host/IP Address of server. + port may optionally be specified at tail of hostname + after a colon, but not if the following optional port + argument to the command is also supplied and is non-zero. + e.g + server.example.com:143 + [::1]::993 + " + port -optional 1 -type integer -help\ + "Port to connect to. + If port is omitted: + defaults to 143 when -security None or STARTTLS + defaults to 993 when -security TLS/SSL or -security is omitted." + }] + } proc CONNECT {args} { set argd [punk::args::parse $args withid ::punk::imap4::CONNECT] lassign [dict values $argd] leaders opts values received @@ -4231,6 +4233,8 @@ tcl::namespace::eval punk::imap4 { namespace eval argdoc { #namespace for custom argument documentation + namespace import ::punk::args::helpers::* + proc package_name {} { return punk::imap4 } diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 2341838d..919484dd 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -5256,7 +5256,8 @@ tcl::namespace::eval punk::ns { basic { #rudimentary colourising only set argl [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $argl] - set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one. + set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one. + set body [punk::grepstr -return all -highlight green {;\s*(#.*)} $body] ;#treat as tail comment only if preceeded by semicolon set body [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $body] set body [punk::grepstr -return all -highlight tk-orange {\[|\]} $body] #ansi colourised items in list format may not always have desired string representation (list escaping can occur)