From ac5a496f92faf028b34f60ea3fde42a2e91ec0f0 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Fri, 14 Jun 2024 04:40:14 +1000 Subject: [PATCH] safe interp fixes --- src/modules/argparsingtest-999999.0a1.0.tm | 7 +- src/modules/canaryspace-999999.0a1.0.tm | 5 +- src/modules/natsort-0.1.1.6.tm | 35 +- src/modules/punk-0.1.tm | 47 +- src/modules/punk/ansi-999999.0a1.0.tm | 1539 +++++++++-------- src/modules/punk/args-999999.0a1.0.tm | 297 ++-- src/modules/punk/assertion-999999.0a1.0.tm | 118 +- .../cap/handlers/templates-999999.0a1.0.tm | 11 + src/modules/punk/char-999999.0a1.0.tm | 994 +++++------ src/modules/punk/config-0.1.tm | 65 +- src/modules/punk/experiment-999999.0a1.0.tm | 501 ++++++ src/modules/punk/experiment-buildversion.txt | 3 + src/modules/punk/lib-999999.0a1.0.tm | 163 +- src/modules/punk/ns-999999.0a1.0.tm | 12 + src/modules/punk/overlay-0.1.tm | 38 +- src/modules/punk/repl-0.1.tm | 46 +- src/modules/punkcheck-0.1.0.tm | 2 +- src/modules/shellfilter-0.1.9.tm | 48 +- src/modules/textblock-999999.0a1.0.tm | 115 +- 19 files changed, 2395 insertions(+), 1651 deletions(-) create mode 100644 src/modules/punk/experiment-999999.0a1.0.tm create mode 100644 src/modules/punk/experiment-buildversion.txt diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm index 044cf82..8e9720e 100644 --- a/src/modules/argparsingtest-999999.0a1.0.tm +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -46,8 +46,11 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args +package require struct::set #*** !doctools #[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -240,7 +243,7 @@ namespace eval argparsingtest { -3 -default 3 -type integer *values } $args] - return [dict get $argd opts] + return [tcl::dict::get $argd opts] } proc test1_punkargs_validate_without_ansi {args} { set argd [punk::args::get_dict { @@ -259,7 +262,7 @@ namespace eval argparsingtest { -3 -default 3 -type integer -validate_without_ansi true *values } $args] - return [dict get $argd opts] + return [tcl::dict::get $argd opts] } package require opt diff --git a/src/modules/canaryspace-999999.0a1.0.tm b/src/modules/canaryspace-999999.0a1.0.tm index 42184d4..80cee60 100644 --- a/src/modules/canaryspace-999999.0a1.0.tm +++ b/src/modules/canaryspace-999999.0a1.0.tm @@ -23,7 +23,10 @@ # Meta description and so may need to be comprised mainly of fully qualified commands. # @@ Meta End - +#usage example +#% use canaryspace +# using the repl, enter commands that may use the calling context and ensure there are no unexpected canaryspace emissions on stderr. +# (expect only a single CANARYSPACE output for entered command if it is at global level.) # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements diff --git a/src/modules/natsort-0.1.1.6.tm b/src/modules/natsort-0.1.1.6.tm index 9d4f8a9..d15015e 100644 --- a/src/modules/natsort-0.1.1.6.tm +++ b/src/modules/natsort-0.1.1.6.tm @@ -1427,24 +1427,27 @@ namespace eval natsort { return 0 } } - - set is_namematch [called_directly_namematch] - set is_inodematch [called_directly_inodematch] - #### - #review - reliability of mechanisms to determine direct calls - # we don't want application being called when being used as a library, but we need it to run if called directly or from symlinks etc - #-- choose a policy and leave the others commented. - #set is_called_directly $is_namematch - #set is_called_directly $is_inodematch - set is_called_directly [expr {$is_namematch || $is_inodematch}] - #set is_called_directly [expr {$is_namematch && $is_inodematch}] - ### - - - #puts stdout "called_directly_name: [called_directly_namematch] called_directly_inode: [called_directly_inodematch]" + if {![interp issafe]} { + set is_namematch [called_directly_namematch] + set is_inodematch [called_directly_inodematch] + #### + #review - reliability of mechanisms to determine direct calls + # we don't want application being called when being used as a library, but we need it to run if called directly or from symlinks etc + #-- choose a policy and leave the others commented. + #set is_called_directly $is_namematch + #set is_called_directly $is_inodematch + set is_called_directly [expr {$is_namematch || $is_inodematch}] + #set is_called_directly [expr {$is_namematch && $is_inodematch}] + ### + + + #puts stdout "called_directly_name: [called_directly_namematch] called_directly_inode: [called_directly_inodematch]" + } else { + #safe interp + set is_called_directly 0 + } - # proc test_pass_fail_message {pass {additional ""}} { diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index b5df54d..b2d70db 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -160,13 +160,6 @@ namespace eval punk { #variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$} - proc get_repl_runid {} { - if {[tsv::exists repl runid]} { - return [tsv::get repl runid] - } else { - return 0 - } - } #ordinary emission of chunklist when no repl proc emit_chunklist {chunklist} { @@ -1009,7 +1002,7 @@ namespace eval punk { } #set assigned [dict values $leveldata] set pairs [list] - dict for {k v} $leveldata {lappend pairs [list $k $v]} + tcl::dict::for {k v} $leveldata {lappend pairs [list $k $v]} set assigned [lindex [list $pairs [unset pairs]] 0] } elseif {[string is integer -strict $index]} { if {[catch {llength $leveldata} len]} { @@ -1696,7 +1689,7 @@ namespace eval punk { set action ?mismatch-not-a-dict } else { set pairs [list] - dict for {k v} $leveldata {lappend pairs [list $k $v]} + tcl::dict::for {k v} $leveldata {lappend pairs [list $k $v]} set assigned [lindex [list $pairs [unset pairs]] 0] } } @@ -4541,6 +4534,37 @@ namespace eval punk { } } + # --------------------------- + # commands that should be aliased in safe interps that need to use punk repl + # + proc get_repl_runid {} { + if {[interp issafe]} { + if {[info commands ::tsv::exists] eq ""} { + puts stderr "punk::get_repl_runid cannot operate directly in safe interp - install the appropriate punk aliases" + error "punk::get_repl_runid punk repl aliases not installed" + } + #if safe interp got here - there must presumably be a direct set of aliases on tsv::* commands + } + if {[tsv::exists repl runid]} { + return [tsv::get repl runid] + } else { + return 0 + } + } + #ensure we don't get into loop in unknown when in safe interp - which won't have tsv + proc set_repl_last_unknown {args} { + if {[interp issafe]} { + if {[info commands ::tsv::set] eq ""} { + puts stderr "punk::set_repl_last_unknown cannot operate directly in safe interp - install an alias to tsv::set repl last_unknown" + return + } + #tsv::* somehow working - possibly custom aliases for tsv functionality ? review + } + tsv::set repl last_unknown {*}$args + } + # --------------------------- + + proc configure_unknown {} { #----------------------------- #these are critical e.g core behaviour or important for repl displaying output correctly @@ -4557,7 +4581,8 @@ namespace eval punk { package require base64 #set ::punk::last_run_display [list] #set ::repl::last_unknown [lindex $args 0] ;#jn - tsv::set repl last_unknown [lindex $args 0] ;#REVIEW + #tsv::set repl last_unknown [lindex $args 0] ;#REVIEW + punk::set_repl_last_unknown [lindex $args 0] }][info body ::unknown] @@ -6229,7 +6254,7 @@ namespace eval punk { set script_extensions [list] set extension_lookup [dict create] - dict for {lang langinfo} $scriptconfig { + tcl::dict::for {lang langinfo} $scriptconfig { set extensions [dict get $langinfo extensions] lappend script_extensions {*}$extensions foreach e $extensions { diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 2a0cd5a..096c34d 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -68,8 +68,8 @@ package require punk::assertion #[section API] -namespace eval punk::ansi::class { - if {![llength [info commands class_ansi]]} { +tcl::namespace::eval punk::ansi::class { + if {![llength [tcl::info::commands class_ansi]]} { oo::class create class_ansi { variable o_ansistringobj @@ -141,27 +141,27 @@ namespace eval punk::ansi::class { if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" } - set opts [dict create\ + set opts [tcl::dict::create\ -dimensions 80x24\ -minus 0\ ] - dict for {k v} $arglist { + foreach {k v} $arglist { switch -- $k { -dimensions - -minus { - dict set opts $k $v + tcl::dict::set opts $k $v } default { puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x" } } } - set opt_dimensions [dict get $opts -dimensions] - set opt_minus [dict get $opts -minus] + set opt_dimensions [tcl::dict::get $opts -dimensions] + set opt_minus [tcl::dict::get $opts -minus] lassign [split $opt_dimensions x] w h - if {![string is integer -strict $w] || ![string is integer -strict $h] || $w < 1 || $h < 1} { + if {![tcl::string::is integer -strict $w] || ![tcl::string::is integer -strict $h] || $w < 1 || $h < 1} { puts stderr "render_to_input_line WxH width & height must be positive integer values usage: ?-dimensions WxH? ?-minus charcount? x" } - if {![string is integer -strict $opt_minus]} { + if {![tcl::string::is integer -strict $opt_minus]} { puts stderr "render_to_input_line -minus must be positive integer value representing number of chars to exclude from end. usage: ?-dimensions WxH? ?-minus charcount? x" } @@ -174,7 +174,7 @@ namespace eval punk::ansi::class { set chunk [::join $rlines \n] append chunk \n if {$opt_minus ne "0"} { - set chunk [string range $chunk 0 end-$opt_minus] + set chunk [tcl::string::range $chunk 0 end-$opt_minus] } set rendered [overtype::renderspace -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" $chunk] set marker "" @@ -190,12 +190,12 @@ namespace eval punk::ansi::class { ::append rendered \n $marker set xline [lindex $rlines $x]\n set xlinev [ansistring VIEWSTYLE $xline] - set xlinev [string map $maplf $xlinev] + set xlinev [tcl::string::map $maplf $xlinev] set xlinedisplay [overtype::renderspace -wrap 1 -width $w -height 1 "" $xlinev] ::append rendered \n $xlinedisplay set chunk [ansistring VIEWSTYLE $chunk] - set chunk [string map $maplf $chunk] + set chunk [tcl::string::map $maplf $chunk] #keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths set chunkdisplay [overtype::renderspace -wrap 1 -width 80 -height 1 "" $chunk] set renderheight [llength [split $rendered \n]] @@ -226,23 +226,23 @@ namespace eval punk::ansi::class { foreach {k v} $args { switch -- $k { -lf - -vt - -width { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "viewcodes unrecognised option '$k'. Known options [dict keys $defaults]" + error "viewcodes unrecognised option '$k'. Known options [tcl::dict::keys $defaults]" } } } - set opts_lf [dict get $opts -lf] - set opts_vt [dict get $opts -vt] - set opts_width [dict get $opts -width] + set opts_lf [tcl::dict::get $opts -lf] + set opts_vt [tcl::dict::get $opts -vt] + set opts_width [tcl::dict::get $opts -width] if {$opts_width eq ""} { return [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]] } elseif {$opts_width eq "auto"} { lassign [punk::console::get_size] _cols columns _rows rows set displaycols [expr {$columns -4}] ;#review return [overtype::renderspace -width $displaycols -wrap 1 "" [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]]] - } elseif {[string is integer -strict $opts_width] && $opts_width > 0} { + } elseif {[tcl::string::is integer -strict $opts_width] && $opts_width > 0} { return [overtype::renderspace -width $opts_width -wrap 1 "" [ansistring VIEWCODES -lf $opts_lf -vt $opts_vt [$o_ansistringobj get]]] } else { error "viewcodes unrecognised value for -width. Try auto or a positive integer" @@ -256,21 +256,21 @@ namespace eval punk::ansi::class { foreach {k v} $args { switch -- $k { -width { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "viewchars unrecognised option '$k'. Known options [dict keys $defaults]" + error "viewchars unrecognised option '$k'. Known options [tcl::dict::keys $defaults]" } } } - set opts_width [dict get $opts -width] + set opts_width [tcl::dict::get $opts -width] if {$opts_width eq ""} { return [punk::ansi::stripansiraw [$o_ansistringobj get]] } elseif {$opts_width eq "auto"} { lassign [punk::console::get_size] _cols columns _rows rows set displaycols [expr {$columns -4}] ;#review return [overtype::renderspace -width $displaycols -wrap 1 "" [punk::ansi::stripansiraw [$o_ansistringobj get]]] - } elseif {[string is integer -strict $opts_width] && $opts_width > 0} { + } elseif {[tcl::string::is integer -strict $opts_width] && $opts_width > 0} { return [overtype::renderspace -width $opts_width -wrap 1 "" [punk::ansi::stripansiraw [$o_ansistringobj get]]] } else { error "viewchars unrecognised value for -width. Try auto or a positive integer" @@ -284,21 +284,21 @@ namespace eval punk::ansi::class { foreach {k v} $args { switch -- $k { -width { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "viewstyle unrecognised option '$k'. Known options [dict keys $defaults]" + error "viewstyle unrecognised option '$k'. Known options [tcl::dict::keys $defaults]" } } } - set opts_width [dict get $opts -width] + set opts_width [tcl::dict::get $opts -width] if {$opts_width eq ""} { return [ansistring VIEWSTYLE [$o_ansistringobj get]] } elseif {$opts_width eq "auto"} { lassign [punk::console::get_size] _cols columns _rows rows set displaycols [expr {$columns -4}] ;#review return [overtype::renderspace -width $displaycols -wrap 1 "" [ansistring VIEWSTYLE [$o_ansistringobj get]]] - } elseif {[string is integer -strict $opts_width] && $opts_width > 0} { + } elseif {[tcl::string::is integer -strict $opts_width] && $opts_width > 0} { return [overtype::renderspace -width $opts_width -wrap 1 "" [ansistring VIEWSTYLE [$o_ansistringobj get]]] } else { error "viewstyle unrecognised value for -width. Try auto or a positive integer" @@ -321,7 +321,7 @@ namespace eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::ansi { +tcl::namespace::eval punk::ansi { #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -336,81 +336,81 @@ namespace eval punk::ansi { #by mapping these we can display regardless. #nul char - no cp437 image but commonly used as space in ansi graphics. #(This is a potential conflict because we use nul as a filler to mean empty column in overtype rendering) REVIEW - dict set cp437_map \u0000 " " ;#space - dict set cp437_map \u0001 \u263A ;#smiley - dict set cp437_map \u0002 \u263B ;#smiley-filled - dict set cp437_map \u0003 \u2665 ;#heart - dict set cp437_map \u0004 \u2666 ;#diamond - dict set cp437_map \u0005 \u2663 ;#club - dict set cp437_map \u0006 \u2660 ;#spade - dict set cp437_map \u0007 \u2022 ;#dot - dict set cp437_map \u0008 \u25D8 ;#square hollow dot - dict set cp437_map \u0009 \u25CB ;#hollow dot - dict set cp437_map \u000A \u25D9 ;#square and dot (\n) - dict set cp437_map \u000B \u2642 ;#male - dict set cp437_map \u000C \u2640 ;#female - dict set cp437_map \u000D \u266A ;#note1 (\r) - dict set cp437_map \u000E \u266B ;#note2 - dict set cp437_map \u000F \u263C ;#sun - dict set cp437_map \u0010 \u25BA ;#right arrow triangle - dict set cp437_map \u0011 \u25CA ;#left arrow triangle - dict set cp437_map \u0012 \u2195 ;#updown arrow - dict set cp437_map \u0013 \u203C ;#double bang - dict set cp437_map \u0014 \u00B6 ;#pilcrow (paragraph mark / blind P) - dict set cp437_map \u0015 \u00A7 ;#Section Sign - dict set cp437_map \u0016 \u25AC ;#Heavy horizontal? - dict set cp437_map \u0017 \u21A8 ;#updown arrow 2 ? - dict set cp437_map \u0018 \u2191 ;#up arrow - dict set cp437_map \u0019 \u2193 ;#down arrow - dict set cp437_map \u001A \u2192 ;#right arrow - dict set cp437_map \u001B \u2190 ;#left arrow - dict set cp437_map \u001C \u221F ;#bottom left corner - dict set cp437_map \u001D \u2194 ;#left-right arrow - dict set cp437_map \u001E \u25B2 ;#up arrow triangle - dict set cp437_map \u001F \u25BC ;#down arrow triangle + tcl::dict::set cp437_map \u0000 " " ;#space + tcl::dict::set cp437_map \u0001 \u263A ;#smiley + tcl::dict::set cp437_map \u0002 \u263B ;#smiley-filled + tcl::dict::set cp437_map \u0003 \u2665 ;#heart + tcl::dict::set cp437_map \u0004 \u2666 ;#diamond + tcl::dict::set cp437_map \u0005 \u2663 ;#club + tcl::dict::set cp437_map \u0006 \u2660 ;#spade + tcl::dict::set cp437_map \u0007 \u2022 ;#dot + tcl::dict::set cp437_map \u0008 \u25D8 ;#square hollow dot + tcl::dict::set cp437_map \u0009 \u25CB ;#hollow dot + tcl::dict::set cp437_map \u000A \u25D9 ;#square and dot (\n) + tcl::dict::set cp437_map \u000B \u2642 ;#male + tcl::dict::set cp437_map \u000C \u2640 ;#female + tcl::dict::set cp437_map \u000D \u266A ;#note1 (\r) + tcl::dict::set cp437_map \u000E \u266B ;#note2 + tcl::dict::set cp437_map \u000F \u263C ;#sun + tcl::dict::set cp437_map \u0010 \u25BA ;#right arrow triangle + tcl::dict::set cp437_map \u0011 \u25CA ;#left arrow triangle + tcl::dict::set cp437_map \u0012 \u2195 ;#updown arrow + tcl::dict::set cp437_map \u0013 \u203C ;#double bang + tcl::dict::set cp437_map \u0014 \u00B6 ;#pilcrow (paragraph mark / blind P) + tcl::dict::set cp437_map \u0015 \u00A7 ;#Section Sign + tcl::dict::set cp437_map \u0016 \u25AC ;#Heavy horizontal? + tcl::dict::set cp437_map \u0017 \u21A8 ;#updown arrow 2 ? + tcl::dict::set cp437_map \u0018 \u2191 ;#up arrow + tcl::dict::set cp437_map \u0019 \u2193 ;#down arrow + tcl::dict::set cp437_map \u001A \u2192 ;#right arrow + tcl::dict::set cp437_map \u001B \u2190 ;#left arrow + tcl::dict::set cp437_map \u001C \u221F ;#bottom left corner + tcl::dict::set cp437_map \u001D \u2194 ;#left-right arrow + tcl::dict::set cp437_map \u001E \u25B2 ;#up arrow triangle + tcl::dict::set cp437_map \u001F \u25BC ;#down arrow triangle variable map_special_graphics #DEC Special Graphics set https://en.wikipedia.org/wiki/DEC_Special_Graphics #AKA IBM Code page 1090 - dict set map_special_graphics _ \u00a0 ;#no-break space - dict set map_special_graphics "`" \u25c6 ;#black diamond - dict set map_special_graphics a \u2592 ;#shaded block (checkerboard stipple), medium shade - Block Elements - dict set map_special_graphics b \u2409 ;#symbol for HT - dict set map_special_graphics c \u240c ;#symbol for FF - dict set map_special_graphics d \u240d ;#symbol for CR - dict set map_special_graphics e \u240a ;#symbol for LF - dict set map_special_graphics f \u00b0 ;#degree sign - dict set map_special_graphics g \u00b1 ;#plus-minus sign - dict set map_special_graphics h \u2424 ;#symbol for NL - dict set map_special_graphics i \u240b ;#symbol for VT - dict set map_special_graphics j \u2518 ;#brc, light up and left - box drawing - dict set map_special_graphics k \u2510 ;#trc, light down and left - box drawing - dict set map_special_graphics l \u250c ;#tlc, light down and right - box drawing - dict set map_special_graphics m \u2514 ;#blc, light up and right - box drawing - dict set map_special_graphics n \u253c ;#light vertical and horizontal - box drawing - dict set map_special_graphics o \u23ba ;#horizontal scan line-1 - dict set map_special_graphics p \u23bb ;#horizontal scan line-3 - dict set map_special_graphics q \u2500 ;#light horizontal - box drawing - dict set map_special_graphics r \u23bc ;#horizontal scan line-7 - dict set map_special_graphics s \u23bd ;#horizontal scan line-9 - dict set map_special_graphics t \u251c ;#light vertical and right - box drawing - dict set map_special_graphics u \u2524 ;#light vertical and left - box drawing - dict set map_special_graphics v \u2534 ;#light up and horizontal - box drawing - dict set map_special_graphics w \u252c ;#light down and horizontal - box drawing - dict set map_special_graphics x \u2502 ;#light vertical - box drawing - dict set map_special_graphics y \u2264 ;#less than or equal - dict set map_special_graphics z \u2265 ;#greater than or equal - dict set map_special_graphics "\{" \u03c0 ;#greek small letter pi - dict set map_special_graphics "|" \u2260 ;#not equal to - dict set map_special_graphics "\}" \u00a3 ;#pound sign - dict set map_special_graphics ~ \u00b7 ;#middle dot + tcl::dict::set map_special_graphics _ \u00a0 ;#no-break space + tcl::dict::set map_special_graphics "`" \u25c6 ;#black diamond + tcl::dict::set map_special_graphics a \u2592 ;#shaded block (checkerboard stipple), medium shade - Block Elements + tcl::dict::set map_special_graphics b \u2409 ;#symbol for HT + tcl::dict::set map_special_graphics c \u240c ;#symbol for FF + tcl::dict::set map_special_graphics d \u240d ;#symbol for CR + tcl::dict::set map_special_graphics e \u240a ;#symbol for LF + tcl::dict::set map_special_graphics f \u00b0 ;#degree sign + tcl::dict::set map_special_graphics g \u00b1 ;#plus-minus sign + tcl::dict::set map_special_graphics h \u2424 ;#symbol for NL + tcl::dict::set map_special_graphics i \u240b ;#symbol for VT + tcl::dict::set map_special_graphics j \u2518 ;#brc, light up and left - box drawing + tcl::dict::set map_special_graphics k \u2510 ;#trc, light down and left - box drawing + tcl::dict::set map_special_graphics l \u250c ;#tlc, light down and right - box drawing + tcl::dict::set map_special_graphics m \u2514 ;#blc, light up and right - box drawing + tcl::dict::set map_special_graphics n \u253c ;#light vertical and horizontal - box drawing + tcl::dict::set map_special_graphics o \u23ba ;#horizontal scan line-1 + tcl::dict::set map_special_graphics p \u23bb ;#horizontal scan line-3 + tcl::dict::set map_special_graphics q \u2500 ;#light horizontal - box drawing + tcl::dict::set map_special_graphics r \u23bc ;#horizontal scan line-7 + tcl::dict::set map_special_graphics s \u23bd ;#horizontal scan line-9 + tcl::dict::set map_special_graphics t \u251c ;#light vertical and right - box drawing + tcl::dict::set map_special_graphics u \u2524 ;#light vertical and left - box drawing + tcl::dict::set map_special_graphics v \u2534 ;#light up and horizontal - box drawing + tcl::dict::set map_special_graphics w \u252c ;#light down and horizontal - box drawing + tcl::dict::set map_special_graphics x \u2502 ;#light vertical - box drawing + tcl::dict::set map_special_graphics y \u2264 ;#less than or equal + tcl::dict::set map_special_graphics z \u2265 ;#greater than or equal + tcl::dict::set map_special_graphics "\{" \u03c0 ;#greek small letter pi + tcl::dict::set map_special_graphics "|" \u2260 ;#not equal to + tcl::dict::set map_special_graphics "\}" \u00a3 ;#pound sign + tcl::dict::set map_special_graphics ~ \u00b7 ;#middle dot #see also ansicolour page on wiki https://wiki.tcl-lang.org/page/ANSI+color+control variable test "blah\033\[1;33mETC\033\[0;mOK" #Note that a? is actually a pattern. We can't explicitly match it without also matcing a+ ab etc. Presumably this won't matter here. - namespace export\ + tcl::namespace::export\ {a?} {a+} a \ ansistring\ convert*\ @@ -427,11 +427,11 @@ namespace eval punk::ansi { variable escape_terminals #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~). - dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"] - #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic - dict set escape_terminals OSC [list \007 \033\\ \u009c] ;#note mix of 1 and 2-byte terminals - dict set escape_terminals DCS [list \007 \033\\ \u009c] - dict set escape_terminals MISC [list \007 \033\\ \u009c] + tcl::dict::set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"] + #tcl::dict::set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic + tcl::dict::set escape_terminals OSC [list \007 \033\\ \u009c] ;#note mix of 1 and 2-byte terminals + tcl::dict::set escape_terminals DCS [list \007 \033\\ \u009c] + tcl::dict::set escape_terminals MISC [list \007 \033\\ \u009c] #NOTE - we are assuming an OSC or DCS started with one type of sequence (7 or 8bit) can be terminated by either 7 or 8 bit ST (or BEL e.g wezterm ) #This using a different type of ST to that of the opening sequence is presumably unlikely in the wild - but who knows? @@ -439,7 +439,7 @@ namespace eval punk::ansi { # https://espterm.github.io/docs/VT100%20escape%20codes.html #self-contained 2 byte ansi escape sequences - review more? - set ansi_2byte_codes_dict [dict create\ + set ansi_2byte_codes_dict [tcl::dict::create\ "reset_terminal" "\u001bc"\ "save_cursor_posn" "\u001b7"\ "restore_cursor_posn" "\u001b8"\ @@ -457,9 +457,9 @@ namespace eval punk::ansi { proc test_cat1 {ansi1 ansi2} { #make sure objects have splits set s1 [ansistring NEW $ansi1] - namespace eval [info object namespace $s1] {my MakeSplit} + tcl::namespace::eval [info object namespace $s1] {my MakeSplit} set s2 [ansistring NEW $ansi2] - namespace eval [info object namespace $s2] {my MakeSplit} + tcl::namespace::eval [info object namespace $s2] {my MakeSplit} #operation under test # -- @@ -474,9 +474,9 @@ namespace eval punk::ansi { proc test_cat2 {ansi1 ansi2} { #make sure objects have splits set s1 [ansistring NEW $ansi1] - namespace eval [info object namespace $s1] {my MakeSplit} + tcl::namespace::eval [info object namespace $s1] {my MakeSplit} set s2 [ansistring NEW $ansi2] - namespace eval [info object namespace $s2] {my MakeSplit} + tcl::namespace::eval [info object namespace $s2] {my MakeSplit} #operation under test # -- @@ -572,16 +572,16 @@ namespace eval punk::ansi { foreach f $fnames { if {![file exists $ansibase/$f]} { set p [overtype::left $missingbase "[a+ red bold]\nMissing file\n$ansibase/$f[a]"] - lappend pics [dict create filename $f pic $p status missing] + lappend pics [tcl::dict::create filename $f pic $p status missing] } else { set img [join [lines_as_list -line trimline -block trimtail [ansicat $ansibase/$f]] \n] - lappend pics [dict create filename $f pic $img status ok] + lappend pics [tcl::dict::create filename $f pic $img status ok] } } set termsize [punk::console:::get_size] set margin 4 - set freewidth [expr {[dict get $termsize columns]-$margin}] + set freewidth [expr {[tcl::dict::get $termsize columns]-$margin}] set per_row [expr {$freewidth / 80}] set rowlist [list] @@ -589,11 +589,11 @@ namespace eval punk::ansi { set i 1 foreach picinfo $pics { set subtitle "" - if {[dict get $picinfo status] ne "ok"} { - set subtitle [dict get $picinfo status] + if {[tcl::dict::get $picinfo status] ne "ok"} { + set subtitle [tcl::dict::get $picinfo status] } - set title [dict get $picinfo filename] - lappend row [textblock::frame -subtitle $subtitle -title $title [dict get $picinfo pic]] + set title [tcl::dict::get $picinfo filename] + lappend row [textblock::frame -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] if {$i % $per_row == 0} { lappend rowlist $row set row [list] @@ -692,7 +692,7 @@ namespace eval punk::ansi { set text [convert_g0 $text] - set text [string map $standalone_code_map $text] + set text [tcl::string::map $standalone_code_map $text] #e.g standalone 2 byte and 3 byte VT100(?) sequences - some of these work in wezterm #\x1b#3 double-height letters top half #\x1b#4 double-height letters bottom half @@ -720,7 +720,7 @@ namespace eval punk::ansi { #2nd byte - done. set in_escapesequence 0 } elseif {$in_escapesequence != 0} { - set endseq [dict get $escape_terminals $in_escapesequence] + set endseq [tcl::dict::get $escape_terminals $in_escapesequence] if {$u in $endseq} { set in_escapesequence 0 } elseif {$uv in $endseq} { @@ -776,14 +776,14 @@ namespace eval punk::ansi { #split for non graphics-set codes set othersplits [punk::ansi::ta::split_codes $other] ;#we don't need single codes here foreach {inner_plaintext inner_codes} $othersplits { - append out [string map $map_special_graphics $inner_plaintext] $inner_codes + append out [tcl::string::map $map_special_graphics $inner_plaintext] $inner_codes #Simplifying assumption: no mapping required on any inner_codes - ST codes, titlesets etc don't require/use g0 content } } else { append out $other ;#may be a mix of plaintext and other ansi codes - put it all through. } #trust our splitting regex has done the work to leave us with only \x1b\(0 or \x1b(B - test last char rather than use punk::ansi::codetype::is_gx_open/is_gx_close - switch -- [string index $g end] { + switch -- [tcl::string::index $g end] { 0 { set g0_on 1 } @@ -818,7 +818,7 @@ namespace eval punk::ansi { if {$g ne ""} { #puts --$g-- regexp $re2 $g _match contents - append out [string map $map $contents] + append out [tcl::string::map $map $contents] } } return $out @@ -835,7 +835,7 @@ namespace eval punk::ansi { #e.g "\033)X" - where X is any char other than 0 to reset ?? #return [convert_g0 $text] - return [string map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] + return [tcl::string::map [list "\x1b(0" "" \x1b(B" "" "\x1b)0" "" "\x1b)X" ""] $text] } @@ -857,7 +857,7 @@ brightblack 90 brightred 91 brightgreen 92 brightyellow 93 brightblu Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblue 104 Brightpurple 105 Brightcyan 106 Brightwhite 107 } variable SGR_map ;#public - part of interface - review - set SGR_map [dict merge $SGR_colour_map $SGR_setting_map] + set SGR_map [tcl::dict::merge $SGR_colour_map $SGR_setting_map] #we use prefixes e.g web-white and/or x11-white #Only a leading capital letter will indicate the colour target is background vs lowercase for foreground @@ -874,197 +874,197 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #css 1-2.0 HTML 3.2-4 Basic colours eg web-silver for fg Web-silver for bg # variable WEB_colour_map_basic - dict set WEB_colour_map_basic white 255-255-255 ;# #FFFFFF - dict set WEB_colour_map_basic silver 192-192-192 ;# #C0C0C0 - dict set WEB_colour_map_basic gray 128-128-128 ;# #808080 - dict set WEB_colour_map_basic black 0-0-0 ;# #000000 - dict set WEB_colour_map_basic red 255-0-0 ;# #FF0000 - dict set WEB_colour_map_basic maroon 128-0-0 ;# #800000 - dict set WEB_colour_map_basic yellow 255-255-0 ;# #FFFF00 - dict set WEB_colour_map_basic olive 128-128-0 ;# #808000 - dict set WEB_colour_map_basic lime 0-255-0 ;# #00FF00 - dict set WEB_colour_map_basic green 0-128-0 ;# #008000 - dict set WEB_colour_map_basic aqua 0-255-255 ;# #00FFFF - dict set WEB_colour_map_basic teal 0-128-128 ;# #008080 - dict set WEB_colour_map_basic blue 0-0-255 ;# #0000FF - dict set WEB_colour_map_basic navy 0-0-128 ;# #000080 - dict set WEB_colour_map_basic fuchsia 255-0-255 ;# #FF00FF - dict set WEB_colour_map_basic purple 128-0-128 ;# #800080 + tcl::dict::set WEB_colour_map_basic white 255-255-255 ;# #FFFFFF + tcl::dict::set WEB_colour_map_basic silver 192-192-192 ;# #C0C0C0 + tcl::dict::set WEB_colour_map_basic gray 128-128-128 ;# #808080 + tcl::dict::set WEB_colour_map_basic black 0-0-0 ;# #000000 + tcl::dict::set WEB_colour_map_basic red 255-0-0 ;# #FF0000 + tcl::dict::set WEB_colour_map_basic maroon 128-0-0 ;# #800000 + tcl::dict::set WEB_colour_map_basic yellow 255-255-0 ;# #FFFF00 + tcl::dict::set WEB_colour_map_basic olive 128-128-0 ;# #808000 + tcl::dict::set WEB_colour_map_basic lime 0-255-0 ;# #00FF00 + tcl::dict::set WEB_colour_map_basic green 0-128-0 ;# #008000 + tcl::dict::set WEB_colour_map_basic aqua 0-255-255 ;# #00FFFF + tcl::dict::set WEB_colour_map_basic teal 0-128-128 ;# #008080 + tcl::dict::set WEB_colour_map_basic blue 0-0-255 ;# #0000FF + tcl::dict::set WEB_colour_map_basic navy 0-0-128 ;# #000080 + tcl::dict::set WEB_colour_map_basic fuchsia 255-0-255 ;# #FF00FF + tcl::dict::set WEB_colour_map_basic purple 128-0-128 ;# #800080 # -- --- --- #Pink colours variable WEB_colour_map_pink - dict set WEB_colour_map_pink mediumvioletred 199-21-133 ;# #C71585 - dict set WEB_colour_map_pink deeppink 255-20-147 ;# #FF1493 - dict set WEB_colour_map_pink palevioletred 219-112-147 ;# #DB7093 - dict set WEB_colour_map_pink hotpink 255-105-180 ;# #FF69B4 - dict set WEB_colour_map_pink lightpink 255-182-193 ;# #FFB6C1 - dict set WEB_colour_map_pink pink 255-192-203 ;# #FFCOCB + tcl::dict::set WEB_colour_map_pink mediumvioletred 199-21-133 ;# #C71585 + tcl::dict::set WEB_colour_map_pink deeppink 255-20-147 ;# #FF1493 + tcl::dict::set WEB_colour_map_pink palevioletred 219-112-147 ;# #DB7093 + tcl::dict::set WEB_colour_map_pink hotpink 255-105-180 ;# #FF69B4 + tcl::dict::set WEB_colour_map_pink lightpink 255-182-193 ;# #FFB6C1 + tcl::dict::set WEB_colour_map_pink pink 255-192-203 ;# #FFCOCB # -- --- --- #Red colours variable WEB_colour_map_red - dict set WEB_colour_map_red darkred 139-0-0 ;# #8B0000 - dict set WEB_colour_map_red red 255-0-0 ;# #FF0000 - dict set WEB_colour_map_red firebrick 178-34-34 ;# #B22222 - dict set WEB_colour_map_red crimson 220-20-60 ;# #DC143C - dict set WEB_colour_map_red indianred 205-92-92 ;# #CD5C5C - dict set WEB_colour_map_red lightcoral 240-128-128 ;# #F08080 - dict set WEB_colour_map_red salmon 250-128-114 ;# #FA8072 - dict set WEB_colour_map_red darksalmon 233-150-122 ;# #E9967A - dict set WEB_colour_map_red lightsalmon 255-160-122 ;# #FFA07A + tcl::dict::set WEB_colour_map_red darkred 139-0-0 ;# #8B0000 + tcl::dict::set WEB_colour_map_red red 255-0-0 ;# #FF0000 + tcl::dict::set WEB_colour_map_red firebrick 178-34-34 ;# #B22222 + tcl::dict::set WEB_colour_map_red crimson 220-20-60 ;# #DC143C + tcl::dict::set WEB_colour_map_red indianred 205-92-92 ;# #CD5C5C + tcl::dict::set WEB_colour_map_red lightcoral 240-128-128 ;# #F08080 + tcl::dict::set WEB_colour_map_red salmon 250-128-114 ;# #FA8072 + tcl::dict::set WEB_colour_map_red darksalmon 233-150-122 ;# #E9967A + tcl::dict::set WEB_colour_map_red lightsalmon 255-160-122 ;# #FFA07A # -- --- --- #Orange colours variable WEB_colour_map_orange - dict set WEB_colour_map_orange orangered 255-69-0 ;# #FF4500 - dict set WEB_colour_map_orange tomato 255-99-71 ;# #FF6347 - dict set WEB_colour_map_orange darkorange 255-140-0 ;# #FF8C00 - dict set WEB_colour_map_orange coral 255-127-80 ;# #FF7F50 - dict set WEB_colour_map_orange orange 255-165-0 ;# #FFA500 + tcl::dict::set WEB_colour_map_orange orangered 255-69-0 ;# #FF4500 + tcl::dict::set WEB_colour_map_orange tomato 255-99-71 ;# #FF6347 + tcl::dict::set WEB_colour_map_orange darkorange 255-140-0 ;# #FF8C00 + tcl::dict::set WEB_colour_map_orange coral 255-127-80 ;# #FF7F50 + tcl::dict::set WEB_colour_map_orange orange 255-165-0 ;# #FFA500 # -- --- --- #Yellow colours variable WEB_colour_map_yellow - dict set WEB_colour_map_yellow darkkhaki 189-183-107 ;# #BDB76B - dict set WEB_colour_map_yellow gold 255-215-0 ;# #FFD700 - dict set WEB_colour_map_yellow khaki 240-230-140 ;# #F0E68C - dict set WEB_colour_map_yellow peachpuff 255-218-185 ;# #FFDAB9 - dict set WEB_colour_map_yellow yellow 255-255-0 ;# #FFFF00 - dict set WEB_colour_map_yellow palegoldenrod 238-232-170 ;# #EEE8AA - dict set WEB_colour_map_yellow moccasin 255-228-181 ;# #FFE4B5 - dict set WEB_colour_map_yellow papayawhip 255-239-213 ;# #FFEFD5 - dict set WEB_colour_map_yellow lightgoldenrodyeallow 250-250-210 ;# #FAFAD2 - dict set WEB_colour_map_yellow lemonchiffon 255-250-205 ;# #FFFACD - dict set WEB_colour_map_yellow lightyellow 255-255-224 ;# #FFFFE0 + tcl::dict::set WEB_colour_map_yellow darkkhaki 189-183-107 ;# #BDB76B + tcl::dict::set WEB_colour_map_yellow gold 255-215-0 ;# #FFD700 + tcl::dict::set WEB_colour_map_yellow khaki 240-230-140 ;# #F0E68C + tcl::dict::set WEB_colour_map_yellow peachpuff 255-218-185 ;# #FFDAB9 + tcl::dict::set WEB_colour_map_yellow yellow 255-255-0 ;# #FFFF00 + tcl::dict::set WEB_colour_map_yellow palegoldenrod 238-232-170 ;# #EEE8AA + tcl::dict::set WEB_colour_map_yellow moccasin 255-228-181 ;# #FFE4B5 + tcl::dict::set WEB_colour_map_yellow papayawhip 255-239-213 ;# #FFEFD5 + tcl::dict::set WEB_colour_map_yellow lightgoldenrodyeallow 250-250-210 ;# #FAFAD2 + tcl::dict::set WEB_colour_map_yellow lemonchiffon 255-250-205 ;# #FFFACD + tcl::dict::set WEB_colour_map_yellow lightyellow 255-255-224 ;# #FFFFE0 # -- --- --- #Brown colours #maroon as above variable WEB_colour_map_brown - dict set WEB_colour_map_brown brown 165-42-42 ;# #A52A2A - dict set WEB_colour_map_brown saddlebrown 139-69-19 ;# #8B4513 - dict set WEB_colour_map_brown sienna 160-82-45 ;# #A0522D - dict set WEB_colour_map_brown chocolate 210-105-30 ;# #D2691E - dict set WEB_colour_map_brown darkgoldenrod 184-134-11 ;# #B8860B - dict set WEB_colour_map_brown peru 205-133-63 ;# #CD853F - dict set WEB_colour_map_brown rosybrown 188-143-143 ;# #BC8F8F - dict set WEB_colour_map_brown goldenrod 218-165-32 ;# #DAA520 - dict set WEB_colour_map_brown sandybrown 244-164-96 ;# #F4A460 - dict set WEB_colour_map_brown tan 210-180-140 ;# #D2B48C - dict set WEB_colour_map_brown burlywood 222-184-135 ;# #DEB887 - dict set WEB_colour_map_brown wheat 245-222-179 ;# #F5DEB3 - dict set WEB_colour_map_brown navajowhite 255-222-173 ;# #FFDEAD - dict set WEB_colour_map_brown bisque 255-228-196 ;# #FFEfC4 - dict set WEB_colour_map_brown blanchedalmond 255-228-196 ;# #FFEfC4 - dict set WEB_colour_map_brown cornsilk 255-248-220 ;# #FFF8DC + tcl::dict::set WEB_colour_map_brown brown 165-42-42 ;# #A52A2A + tcl::dict::set WEB_colour_map_brown saddlebrown 139-69-19 ;# #8B4513 + tcl::dict::set WEB_colour_map_brown sienna 160-82-45 ;# #A0522D + tcl::dict::set WEB_colour_map_brown chocolate 210-105-30 ;# #D2691E + tcl::dict::set WEB_colour_map_brown darkgoldenrod 184-134-11 ;# #B8860B + tcl::dict::set WEB_colour_map_brown peru 205-133-63 ;# #CD853F + tcl::dict::set WEB_colour_map_brown rosybrown 188-143-143 ;# #BC8F8F + tcl::dict::set WEB_colour_map_brown goldenrod 218-165-32 ;# #DAA520 + tcl::dict::set WEB_colour_map_brown sandybrown 244-164-96 ;# #F4A460 + tcl::dict::set WEB_colour_map_brown tan 210-180-140 ;# #D2B48C + tcl::dict::set WEB_colour_map_brown burlywood 222-184-135 ;# #DEB887 + tcl::dict::set WEB_colour_map_brown wheat 245-222-179 ;# #F5DEB3 + tcl::dict::set WEB_colour_map_brown navajowhite 255-222-173 ;# #FFDEAD + tcl::dict::set WEB_colour_map_brown bisque 255-228-196 ;# #FFEfC4 + tcl::dict::set WEB_colour_map_brown blanchedalmond 255-228-196 ;# #FFEfC4 + tcl::dict::set WEB_colour_map_brown cornsilk 255-248-220 ;# #FFF8DC # -- --- --- #Purple, violet, and magenta colours variable WEB_colour_map_purple - dict set WEB_colour_map_purple indigo 75-0-130 ;# #4B0082 - dict set WEB_colour_map_purple purple 128-0-128 ;# #800080 - dict set WEB_colour_map_purple darkmagenta 139-0-139 ;# #8B008B - dict set WEB_colour_map_purple darkviolet 148-0-211 ;# #9400D3 - dict set WEB_colour_map_purple darkslateblue 72-61-139 ;# #9400D3 - dict set WEB_colour_map_purple blueviolet 138-43-226 ;# #8A2BE2 - dict set WEB_colour_map_purple darkorchid 153-50-204 ;# #9932CC - dict set WEB_colour_map_purple fuchsia 255-0-255 ;# #FF00FF - dict set WEB_colour_map_purple magenta 255-0-255 ;# #FF00FF - same as fuchsia - dict set WEB_colour_map_purple slateblue 106-90-205 ;# #6A5ACD - dict set WEB_colour_map_purple mediumslateblue 123-104-238 ;# #7B68EE - dict set WEB_colour_map_purple mediumorchid 186-85-211 ;# #BA5503 - dict set WEB_colour_map_purple mediumpurple 147-112-219 ;# #9370DB - dict set WEB_colour_map_purple orchid 218-112-214 ;# #DA70D6 - dict set WEB_colour_map_purple violet 238-130-238 ;# #EE82EE - dict set WEB_colour_map_purple plum 221-160-221 ;# #DDA0DD - dict set WEB_colour_map_purple thistle 216-191-216 ;# #D88FD8 - dict set WEB_colour_map_purple lavender 230-230-250 ;# #E6E6FA + tcl::dict::set WEB_colour_map_purple indigo 75-0-130 ;# #4B0082 + tcl::dict::set WEB_colour_map_purple purple 128-0-128 ;# #800080 + tcl::dict::set WEB_colour_map_purple darkmagenta 139-0-139 ;# #8B008B + tcl::dict::set WEB_colour_map_purple darkviolet 148-0-211 ;# #9400D3 + tcl::dict::set WEB_colour_map_purple darkslateblue 72-61-139 ;# #9400D3 + tcl::dict::set WEB_colour_map_purple blueviolet 138-43-226 ;# #8A2BE2 + tcl::dict::set WEB_colour_map_purple darkorchid 153-50-204 ;# #9932CC + tcl::dict::set WEB_colour_map_purple fuchsia 255-0-255 ;# #FF00FF + tcl::dict::set WEB_colour_map_purple magenta 255-0-255 ;# #FF00FF - same as fuchsia + tcl::dict::set WEB_colour_map_purple slateblue 106-90-205 ;# #6A5ACD + tcl::dict::set WEB_colour_map_purple mediumslateblue 123-104-238 ;# #7B68EE + tcl::dict::set WEB_colour_map_purple mediumorchid 186-85-211 ;# #BA5503 + tcl::dict::set WEB_colour_map_purple mediumpurple 147-112-219 ;# #9370DB + tcl::dict::set WEB_colour_map_purple orchid 218-112-214 ;# #DA70D6 + tcl::dict::set WEB_colour_map_purple violet 238-130-238 ;# #EE82EE + tcl::dict::set WEB_colour_map_purple plum 221-160-221 ;# #DDA0DD + tcl::dict::set WEB_colour_map_purple thistle 216-191-216 ;# #D88FD8 + tcl::dict::set WEB_colour_map_purple lavender 230-230-250 ;# #E6E6FA # -- --- --- #Blue colours variable WEB_colour_map_blue - dict set WEB_colour_map_blue midnightblue 25-25-112 ;# #191970 - dict set WEB_colour_map_blue navy 0-0-128 ;# #000080 - dict set WEB_colour_map_blue darkblue 0-0-139 ;# #00008B - dict set WEB_colour_map_blue mediumblue 0-0-205 ;# #0000CD - dict set WEB_colour_map_blue blue 0-0-255 ;# #0000FF - dict set WEB_colour_map_blue royalblue 65-105-225 ;# #4169E1 - dict set WEB_colour_map_blue steelblue 70-130-180 ;# #4682B4 - dict set WEB_colour_map_blue dodgerblue 30-144-255 ;# #1E90FF - dict set WEB_colour_map_blue deepskyblue 0-191-255 ;# #00BFFF - dict set WEB_colour_map_blue cornflowerblue 100-149-237 ;# #6495ED - dict set WEB_colour_map_blue skyblue 135-206-235 ;# #87CEEB - dict set WEB_colour_map_blue lightskyblue 135-206-250 ;# #87CEFA - dict set WEB_colour_map_blue lightsteelblue 176-196-222 ;# #B0C4DE - dict set WEB_colour_map_blue lightblue 173-216-230 ;# #ADD8E6 - dict set WEB_colour_map_blue powderblue 176-224-230 ;# #B0E0E6 + tcl::dict::set WEB_colour_map_blue midnightblue 25-25-112 ;# #191970 + tcl::dict::set WEB_colour_map_blue navy 0-0-128 ;# #000080 + tcl::dict::set WEB_colour_map_blue darkblue 0-0-139 ;# #00008B + tcl::dict::set WEB_colour_map_blue mediumblue 0-0-205 ;# #0000CD + tcl::dict::set WEB_colour_map_blue blue 0-0-255 ;# #0000FF + tcl::dict::set WEB_colour_map_blue royalblue 65-105-225 ;# #4169E1 + tcl::dict::set WEB_colour_map_blue steelblue 70-130-180 ;# #4682B4 + tcl::dict::set WEB_colour_map_blue dodgerblue 30-144-255 ;# #1E90FF + tcl::dict::set WEB_colour_map_blue deepskyblue 0-191-255 ;# #00BFFF + tcl::dict::set WEB_colour_map_blue cornflowerblue 100-149-237 ;# #6495ED + tcl::dict::set WEB_colour_map_blue skyblue 135-206-235 ;# #87CEEB + tcl::dict::set WEB_colour_map_blue lightskyblue 135-206-250 ;# #87CEFA + tcl::dict::set WEB_colour_map_blue lightsteelblue 176-196-222 ;# #B0C4DE + tcl::dict::set WEB_colour_map_blue lightblue 173-216-230 ;# #ADD8E6 + tcl::dict::set WEB_colour_map_blue powderblue 176-224-230 ;# #B0E0E6 # -- --- --- #Cyan colours #teal as above variable WEB_colour_map_cyan - dict set WEB_colour_map_cyan darkcyan 0-139-139 ;# #008B8B - dict set WEB_colour_map_cyan lightseagreen 32-178-170 ;# #20B2AA - dict set WEB_colour_map_cyan cadetblue 95-158-160 ;# #5F9EA0 - dict set WEB_colour_map_cyan darkturquoise 0-206-209 ;# #00CED1 - dict set WEB_colour_map_cyan mediumturquoise 72-209-204 ;# #48D1CC - dict set WEB_colour_map_cyan turquoise 64-224-208 ;# #40E0D0 - dict set WEB_colour_map_cyan aqua 0-255-255 ;# #00FFFF - dict set WEB_colour_map_cyan cyan 0-255-255 ;# #00FFFF - same as aqua - dict set WEB_colour_map_cyan aquamarine 127-255-212 ;# #7FFFD4 - dict set WEB_colour_map_cyan paleturquoise 175-238-238 ;# #AFEEEE - dict set WEB_colour_map_cyan lightcyan 224-255-255 ;# #E0FFFF + tcl::dict::set WEB_colour_map_cyan darkcyan 0-139-139 ;# #008B8B + tcl::dict::set WEB_colour_map_cyan lightseagreen 32-178-170 ;# #20B2AA + tcl::dict::set WEB_colour_map_cyan cadetblue 95-158-160 ;# #5F9EA0 + tcl::dict::set WEB_colour_map_cyan darkturquoise 0-206-209 ;# #00CED1 + tcl::dict::set WEB_colour_map_cyan mediumturquoise 72-209-204 ;# #48D1CC + tcl::dict::set WEB_colour_map_cyan turquoise 64-224-208 ;# #40E0D0 + tcl::dict::set WEB_colour_map_cyan aqua 0-255-255 ;# #00FFFF + tcl::dict::set WEB_colour_map_cyan cyan 0-255-255 ;# #00FFFF - same as aqua + tcl::dict::set WEB_colour_map_cyan aquamarine 127-255-212 ;# #7FFFD4 + tcl::dict::set WEB_colour_map_cyan paleturquoise 175-238-238 ;# #AFEEEE + tcl::dict::set WEB_colour_map_cyan lightcyan 224-255-255 ;# #E0FFFF # -- --- --- #Green colours variable WEB_colour_map_green - dict set WEB_colour_map_green darkgreen 0-100-0 ;# #006400 - dict set WEB_colour_map_green green 0-128-0 ;# #008000 - dict set WEB_colour_map_green darkolivegreen 85-107-47 ;# #55682F - dict set WEB_colour_map_green forestgreen 34-139-34 ;# #228B22 - dict set WEB_colour_map_green seagreen 46-139-87 ;# #2E8B57 - dict set WEB_colour_map_green olive 128-128-0 ;# #808000 - dict set WEB_colour_map_green olivedrab 107-142-35 ;# #6B8E23 - dict set WEB_colour_map_green mediumseagreen 60-179-113 ;# #3CB371 - dict set WEB_colour_map_green limegreen 50-205-50 ;# #32CD32 - dict set WEB_colour_map_green lime 0-255-0 ;# #00FF00 - dict set WEB_colour_map_green springgreen 0-255-127 ;# #00FF7F - dict set WEB_colour_map_green mediumspringgreen 0-250-154 ;# #00FA9A - dict set WEB_colour_map_green darkseagreen 143-188-143 ;# #8FBC8F - dict set WEB_colour_map_green mediumaquamarine 102-205-170 ;# #66CDAA - dict set WEB_colour_map_green yellowgreen 154-205-50 ;# #9ACD32 - dict set WEB_colour_map_green lawngreen 124-252-0 ;# #7CFC00 - dict set WEB_colour_map_green chartreuse 127-255-0 ;# #7FFF00 - dict set WEB_colour_map_green lightgreen 144-238-144 ;# #90EE90 - dict set WEB_colour_map_green greenyellow 173-255-47 ;# #ADFF2F - dict set WEB_colour_map_green palegreen 152-251-152 ;# #98FB98 + tcl::dict::set WEB_colour_map_green darkgreen 0-100-0 ;# #006400 + tcl::dict::set WEB_colour_map_green green 0-128-0 ;# #008000 + tcl::dict::set WEB_colour_map_green darkolivegreen 85-107-47 ;# #55682F + tcl::dict::set WEB_colour_map_green forestgreen 34-139-34 ;# #228B22 + tcl::dict::set WEB_colour_map_green seagreen 46-139-87 ;# #2E8B57 + tcl::dict::set WEB_colour_map_green olive 128-128-0 ;# #808000 + tcl::dict::set WEB_colour_map_green olivedrab 107-142-35 ;# #6B8E23 + tcl::dict::set WEB_colour_map_green mediumseagreen 60-179-113 ;# #3CB371 + tcl::dict::set WEB_colour_map_green limegreen 50-205-50 ;# #32CD32 + tcl::dict::set WEB_colour_map_green lime 0-255-0 ;# #00FF00 + tcl::dict::set WEB_colour_map_green springgreen 0-255-127 ;# #00FF7F + tcl::dict::set WEB_colour_map_green mediumspringgreen 0-250-154 ;# #00FA9A + tcl::dict::set WEB_colour_map_green darkseagreen 143-188-143 ;# #8FBC8F + tcl::dict::set WEB_colour_map_green mediumaquamarine 102-205-170 ;# #66CDAA + tcl::dict::set WEB_colour_map_green yellowgreen 154-205-50 ;# #9ACD32 + tcl::dict::set WEB_colour_map_green lawngreen 124-252-0 ;# #7CFC00 + tcl::dict::set WEB_colour_map_green chartreuse 127-255-0 ;# #7FFF00 + tcl::dict::set WEB_colour_map_green lightgreen 144-238-144 ;# #90EE90 + tcl::dict::set WEB_colour_map_green greenyellow 173-255-47 ;# #ADFF2F + tcl::dict::set WEB_colour_map_green palegreen 152-251-152 ;# #98FB98 # -- --- --- #White colours variable WEB_colour_map_white - dict set WEB_colour_map_white mistyrose 255-228-225 ;# #FFE4E1 - dict set WEB_colour_map_white antiquewhite 250-235-215 ;# #FAEBD7 - dict set WEB_colour_map_white linen 250-240-230 ;# #FAF0E6 - dict set WEB_colour_map_white beige 245-245-220 ;# #F5F5DC - dict set WEB_colour_map_white whitesmoke 245-245-245 ;# #F5F5F5 - dict set WEB_colour_map_white lavenderblush 255-240-245 ;# #FFF0F5 - dict set WEB_colour_map_white oldlace 253-245-230 ;# #FDF5E6 - dict set WEB_colour_map_white aliceblue 240-248-255 ;# #F0F8FF - dict set WEB_colour_map_white seashell 255-245-238 ;# #FFF5EE - dict set WEB_colour_map_white ghostwhite 248-248-255 ;# #F8F8FF - dict set WEB_colour_map_white honeydew 240-255-240 ;# #F0FFF0 - dict set WEB_colour_map_white floralwhite 255-250-240 ;# #FFFAF0 - dict set WEB_colour_map_white azure 240-255-255 ;# #F0FFFF - dict set WEB_colour_map_white mintcream 245-255-250 ;# #F5FFFA - dict set WEB_colour_map_white snow 255-250-250 ;# #FFFAFA - dict set WEB_colour_map_white ivory 255-255-240 ;# #FFFFF0 - dict set WEB_colour_map_white white 255-255-255 ;# #FFFFFF + tcl::dict::set WEB_colour_map_white mistyrose 255-228-225 ;# #FFE4E1 + tcl::dict::set WEB_colour_map_white antiquewhite 250-235-215 ;# #FAEBD7 + tcl::dict::set WEB_colour_map_white linen 250-240-230 ;# #FAF0E6 + tcl::dict::set WEB_colour_map_white beige 245-245-220 ;# #F5F5DC + tcl::dict::set WEB_colour_map_white whitesmoke 245-245-245 ;# #F5F5F5 + tcl::dict::set WEB_colour_map_white lavenderblush 255-240-245 ;# #FFF0F5 + tcl::dict::set WEB_colour_map_white oldlace 253-245-230 ;# #FDF5E6 + tcl::dict::set WEB_colour_map_white aliceblue 240-248-255 ;# #F0F8FF + tcl::dict::set WEB_colour_map_white seashell 255-245-238 ;# #FFF5EE + tcl::dict::set WEB_colour_map_white ghostwhite 248-248-255 ;# #F8F8FF + tcl::dict::set WEB_colour_map_white honeydew 240-255-240 ;# #F0FFF0 + tcl::dict::set WEB_colour_map_white floralwhite 255-250-240 ;# #FFFAF0 + tcl::dict::set WEB_colour_map_white azure 240-255-255 ;# #F0FFFF + tcl::dict::set WEB_colour_map_white mintcream 245-255-250 ;# #F5FFFA + tcl::dict::set WEB_colour_map_white snow 255-250-250 ;# #FFFAFA + tcl::dict::set WEB_colour_map_white ivory 255-255-240 ;# #FFFFF0 + tcl::dict::set WEB_colour_map_white white 255-255-255 ;# #FFFFFF # -- --- --- #Gray and black colours variable WEB_colour_map_gray - dict set WEB_colour_map_gray black 0-0-0 ;# #000000 - dict set WEB_colour_map_gray darkslategray 47-79-79 ;# #2F4F4F - dict set WEB_colour_map_gray dimgray 105-105-105 ;# #696969 - dict set WEB_colour_map_gray slategray 112-128-144 ;# #708090 - dict set WEB_colour_map_gray gray 128-128-128 ;# #808080 - dict set WEB_colour_map_gray lightslategray 119-136-153 ;# #778899 - dict set WEB_colour_map_gray darkgray 169-169-169 ;# #A9A9A9 - dict set WEB_colour_map_gray silver 192-192-192 ;# #C0C0C0 - dict set WEB_colour_map_gray lightgray 211-211-211 ;# #D3D3D3 - dict set WEB_colour_map_gray gainsboro 220-220-220 ;# #DCDCDC - - set WEB_colour_map [dict merge\ + tcl::dict::set WEB_colour_map_gray black 0-0-0 ;# #000000 + tcl::dict::set WEB_colour_map_gray darkslategray 47-79-79 ;# #2F4F4F + tcl::dict::set WEB_colour_map_gray dimgray 105-105-105 ;# #696969 + tcl::dict::set WEB_colour_map_gray slategray 112-128-144 ;# #708090 + tcl::dict::set WEB_colour_map_gray gray 128-128-128 ;# #808080 + tcl::dict::set WEB_colour_map_gray lightslategray 119-136-153 ;# #778899 + tcl::dict::set WEB_colour_map_gray darkgray 169-169-169 ;# #A9A9A9 + tcl::dict::set WEB_colour_map_gray silver 192-192-192 ;# #C0C0C0 + tcl::dict::set WEB_colour_map_gray lightgray 211-211-211 ;# #D3D3D3 + tcl::dict::set WEB_colour_map_gray gainsboro 220-220-220 ;# #DCDCDC + + set WEB_colour_map [tcl::dict::merge\ $WEB_colour_map_basic\ $WEB_colour_map_pink\ $WEB_colour_map_red\ @@ -1081,13 +1081,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #we should be able to use WEB_colour_map as a base and override only the conflicts for X11 colours ? Review - check if this is true variable X11_colour_map_diff ;#maintain the difference as a separate dict so we can display in a? x11 - dict set X11_colour_map_diff gray 190-190-190 ;# #BEBEBE - dict set X11_colour_map_diff green 0-255-0 ;# #00FF00 - dict set X11_colour_map_diff maroon 176-48-96 ;# #B03060 - dict set X11_colour_map_diff purple 160-32-240 ;# #A020F0 + tcl::dict::set X11_colour_map_diff gray 190-190-190 ;# #BEBEBE + tcl::dict::set X11_colour_map_diff green 0-255-0 ;# #00FF00 + tcl::dict::set X11_colour_map_diff maroon 176-48-96 ;# #B03060 + tcl::dict::set X11_colour_map_diff purple 160-32-240 ;# #A020F0 variable X11_colour_map - set X11_colour_map [dict merge $WEB_colour_map $X11_colour_map_diff] + set X11_colour_map [tcl::dict::merge $WEB_colour_map $X11_colour_map_diff] #Xterm colour names (256 colours) @@ -1369,21 +1369,21 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu grey93\ ] variable TERM_colour_map - set TERM_colour_map [dict create] + set TERM_colour_map [tcl::dict::create] variable TERM_colour_map_reverse - set TERM_colour_map_reverse [dict create] + set TERM_colour_map_reverse [tcl::dict::create] set cidx 0 foreach cname $xterm_names { - if {![dict exists $TERM_colour_map $cname]} { - dict set TERM_colour_map $cname $cidx - dict set TERM_colour_map_reverse $cidx $cname + if {![tcl::dict::exists $TERM_colour_map $cname]} { + tcl::dict::set TERM_colour_map $cname $cidx + tcl::dict::set TERM_colour_map_reverse $cidx $cname } else { set did_rename 0 #start suffixes at '-b'. The base name could be considered the '-a' version - but we don't create it. foreach {suffix} {b c} { - if {![dict exists $TERM_colour_map $cname-$suffix]} { - dict set TERM_colour_map $cname-$suffix $cidx - dict set TERM_colour_map_reverse $cidx $cname-$suffix + if {![tcl::dict::exists $TERM_colour_map $cname-$suffix]} { + tcl::dict::set TERM_colour_map $cname-$suffix $cidx + tcl::dict::set TERM_colour_map_reverse $cidx $cname-$suffix set did_rename 1 break } @@ -1405,7 +1405,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #dict for {k v} $WEB_colour_map { # set dectriple [split $v -] # set webhex [::join [format %02X%02X%02X {*}$dectriple] ;# e.g 808080, FFFFFF, 000000 - # dict set HEX_colour_map $webhex [join $dectriple {;}] + # tcl::dict::set HEX_colour_map $webhex [join $dectriple {;}] #} proc colour_hex2ansidec {hex6} { return [join [::scan $hex6 %2X%2X%2X] {;}] @@ -1415,11 +1415,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # eg dec-dec-dec <-> #HHHHHH #allow hex to be specified with or without leading # proc colour_hex2dec {hex6} { - set hex6 [string map [list # ""] $hex6] + set hex6 [tcl::string::map {# ""} $hex6] return [join [::scan $hex6 %2X%2X%2X] {-}] } proc colour_dec2hex {decimalcolourstring} { - set dec [string map [list {;} - , -] $decimalcolourstring] + set dec [tcl::string::map [list {;} - , -] $decimalcolourstring] set declist [split $dec -] set hex #[format %02X%02X%02X {*}$declist] } @@ -1434,19 +1434,19 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu foreach {k v} $args { switch -- $k { -bg - -forcecolour { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "colourmap1 unrecognised option $k. Known-options: [dict keys $opts] + error "colourmap1 unrecognised option $k. Known-options: [tcl::dict::keys $opts] } } } - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } else { set fc "" } - set bgname [dict get $opts -bg] + set bgname [tcl::dict::get $opts -bg] package require textblock set bg [textblock::block 33 3 "[a+ {*}$fc $bgname] [a]"] @@ -1461,12 +1461,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourmap2 {args} { set defaults {-forcecolour 0 -bg Web-white} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } - set bgname [dict get $opts -bg] + set bgname [tcl::dict::get $opts -bg] package require textblock set bg [textblock::block 39 3 "[a+ {*}$fc $bgname] [a]"] @@ -1485,9 +1485,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourtable_216 {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } package require textblock @@ -1513,9 +1513,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #1st 16 colours of 256 - match SGR colours proc colourblock_16 {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } set out "" @@ -1531,9 +1531,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourtable_16_names {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } variable TERM_colour_map_reverse @@ -1543,7 +1543,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set t [textblock::class::table new] $t configure -show_seps 0 -show_edge 0 for {set i 0} {$i <=15} {incr i} { - set cname [dict get $TERM_colour_map_reverse $i] ;#use term-$i etc instead of term-$name? + set cname [tcl::dict::get $TERM_colour_map_reverse $i] ;#use term-$i etc instead of term-$name? if {[llength $row]== 8} { lappend rows $row set row [list] @@ -1563,15 +1563,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out [$t print] $t destroy append out [a] - return [string trimleft $out \n] + return [tcl::string::trimleft $out \n] } #216 colours of 256 proc colourblock_216 {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } set out "" @@ -1590,18 +1590,18 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out "$br[a+ {*}$fc {*}$fg Term$i][format %3s $i] " } append out [a] - return [string trimleft $out \n] + return [tcl::string::trimleft $out \n] } #x6 is reasonable from a width (124 screen cols) and colour viewing perspective proc colourtable_216_names {args} { set defaults {-forcecolour 0 -columns 6} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } - set cols [dict get $opts -columns] + set cols [tcl::dict::get $opts -columns] set out "" #use the reverse lookup dict - the original xterm_names list has duplicates - we want the disambiguated (potentially suffixed) names @@ -1612,7 +1612,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set t [textblock::class::table new] $t configure -show_seps 0 -show_edge 0 for {set i 16} {$i <=231} {incr i} { - set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option + set cname [tcl::dict::get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option if {[llength $row]== $cols} { lappend rows $row set row [list] @@ -1633,13 +1633,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out [$t print] $t destroy append out [a] - return [string trimleft $out \n] + return [tcl::string::trimleft $out \n] } proc colourtable_term_pastel {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } set out "" @@ -1688,9 +1688,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourtable_term_rainbow {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } set out "" @@ -1756,9 +1756,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #24 greys of 256 proc colourblock_24 {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } @@ -1775,9 +1775,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourtable_24_names {args} { set defaults {-forcecolour 0} - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } @@ -1788,7 +1788,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set t [textblock::class::table new] $t configure -show_hseps 0 -show_edge 0 for {set i 232} {$i <=255} {incr i} { - set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option + set cname [tcl::dict::get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option if {[llength $row]== 8} { lappend rows $row set row [list] @@ -1805,10 +1805,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out [$t print] $t destroy append out [a] - return [string trimleft $out \n] + return [tcl::string::trimleft $out \n] } - #set WEB_colour_map [dict merge\ + #set WEB_colour_map [tcl::dict::merge\ # $WEB_colour_map_basic\ # $WEB_colour_map_pink\ # $WEB_colour_map_red\ @@ -1827,18 +1827,18 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu foreach {k v} $args { switch -- $k { -groups - -forcecolour { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "colourtable_web unrecognised option '$k'. Known-options: [dict keys $defaults]" + error "colourtable_web unrecognised option '$k'. Known-options: [tcl::dict::keys $defaults]" } } } set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } - set groups [dict get $opts -groups] + set groups [tcl::dict::get $opts -groups] #set all_groupnames [list basic pink red orange yellow brown purple blue cyan green white gray] set all_groupnames [list basic brown yellow red pink orange purple blue cyan green white gray] @@ -1875,7 +1875,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu variable WEB_colour_map_$g set t [textblock::class::table new] $t configure -show_edge 0 -show_seps 0 -show_header 1 - dict for {cname cdec} [set WEB_colour_map_$g] { + tcl::dict::for {cname cdec} [set WEB_colour_map_$g] { $t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec] if {$cname in $white_fg_list} { set fg "web-white" @@ -1886,7 +1886,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu $t configure_row [expr {[$t row_count]-1}] -ansibase [a+ {*}$fc $fg Web-$cname] } $t configure -frametype {} - $t configure_column 0 -headers [list "[string totitle $g] colours"] + $t configure_column 0 -headers [list "[tcl::string::totitle $g] colours"] $t configure_column 0 -header_colspans [list all] $t configure -ansibase_header [a+ {*}$fc web-black Web-white] lappend grouptables [$t print] @@ -1903,22 +1903,22 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc colourtable_x11diff {args} { variable X11_colour_map_diff variable WEB_colour_map - set opts [dict create\ + set opts [tcl::dict::create\ -forcecolour 0\ -return "string"\ ] foreach {k v} $args { switch -- $k { -return - -forcecolour { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "colourtable_x11diff unrecognised option '$k'. Known options [dict keys $opts]" + error "colourtable_x11diff unrecognised option '$k'. Known options [tcl::dict::keys $opts]" } } } set fc "" - if {[dict get $opts -forcecolour]} { + if {[tcl::dict::get $opts -forcecolour]} { set fc "forcecolour" } @@ -1927,7 +1927,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # -- --- --- set t [textblock::class::table new] $t configure -show_edge 0 -show_seps 0 -show_header 1 - dict for {cname cdec} [set X11_colour_map_diff] { + tcl::dict::for {cname cdec} [set X11_colour_map_diff] { $t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec] set fg "web-white" $t configure_row [expr {[$t row_count]-1}] -ansibase [a+ {*}$fc $fg X11-$cname] @@ -1940,15 +1940,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu $t destroy # -- --- --- - set WEB_map_subset [dict create] - dict for {k v} $X11_colour_map_diff { - dict set WEB_map_subset $k [dict get $WEB_colour_map $k] + set WEB_map_subset [tcl::dict::create] + tcl::dict::for {k v} $X11_colour_map_diff { + tcl::dict::set WEB_map_subset $k [tcl::dict::get $WEB_colour_map $k] } # -- --- --- set t [textblock::class::table new] $t configure -show_edge 0 -show_seps 0 -show_header 1 - dict for {cname cdec} [set WEB_map_subset] { + tcl::dict::for {cname cdec} [set WEB_map_subset] { $t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec] set fg "web-white" $t configure_row [expr {[$t row_count]-1}] -ansibase [a+ {*}$fc $fg Web-$cname] @@ -1964,7 +1964,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set displaytable [textblock::list_as_table 2 $comparetables -return object] $displaytable configure -show_header 0 -show_vseps 0 - if {[dict get $opts -return] eq "string"} { + if {[tcl::dict::get $opts -return] eq "string"} { set result [$displaytable print] $displaytable destroy return $result @@ -2006,7 +2006,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out "[a+ {*}$fc web-white]Standard SGR colours and attributes $RST" \n set settings_applied $SGR_setting_map set strmap [list] - dict for {k v} $SGR_setting_map { + #safe jumptable test + #dict for {k v} $SGR_setting_map {} + tcl::dict::for {k v} $SGR_setting_map { switch -- $k { bold - dim - italic - doubleunderline - blink - fastblink - strike - overline - framecircle { lappend strmap " $k " " [a+ $k]$k$RST " @@ -2021,13 +2023,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } } - set settings_applied [string trim $SGR_setting_map \n] + set settings_applied [tcl::string::trim $SGR_setting_map \n] try { package require overtype ;# circular dependency - many components require overtype. Here we only need it for nice layout in the a? query proc - so we'll do a soft-dependency by only loading when needed and also wrapping in a try package require textblock - append out [textblock::join $indent [string map $strmap $settings_applied]] \n - append out [textblock::join $indent [string trim $SGR_colour_map \n]] \n + append out [textblock::join $indent [tcl::string::map $strmap $settings_applied]] \n + append out [textblock::join $indent [tcl::string::trim $SGR_colour_map \n]] \n append out [textblock::join $indent "Example: \[a+ bold red White underline\]text\[a] -> [a+ bold red White underline]text[a]"] \n \n set bgname "Web-white" set map1 [colourmap1 -bg $bgname -forcecolour $opt_forcecolour] @@ -2045,7 +2047,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out [textblock::join $indent "Example: \[a+ term-lightsteelblue Term-gold1\]text\[a] -> [a+ {*}$fc term-lightsteelblue Term-gold1]text[a]"] \n append out \n append out "[a+ {*}$fc web-white]16 Million colours[a]" \n - #dict set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585 + #tcl::dict::set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585 append out [textblock::join $indent "Example: \[a+ rgb-199-21-133\]text\[a] -> [a+ {*}$fc rgb-199-21-133]text[a]"] \n append out [textblock::join $indent "Example: \[a+ Rgb#C71585\]text\[a] -> [a+ {*}$fc Rgb#C71585]text[a]"] \n append out [textblock::join $indent "Examine a sequence: a? bold rgb-46-139-87 Rgb#C71585 "] \n @@ -2060,7 +2062,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu append out "[a+ {*}$fc web-white]X11 colours[a] - mostly match Web colours" \n append out [textblock::join $indent "To see differences: a? x11"] \n - if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { + if {[tcl::info::exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { append out \n if {$fc ne ""} { append out "[a+ {*}$fc web-white]Colour is currently disabled - returning with colour anyway because 'forcecolour' argument was supplied[a]" \n @@ -2130,13 +2132,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set resultlist [list] foreach i $args { - set f4 [string range $i 0 3] + set f4 [tcl::string::range $i 0 3] set s [a+ {*}$fc $i]sample switch -- $f4 { web- - Web- - WEB- { - set tail [string tolower [string trim [string range $i 4 end] -]] - if {[dict exists $WEB_colour_map $tail]} { - set dec [dict get $WEB_colour_map $tail] + set tail [tcl::string::tolower [tcl::string::trim [tcl::string::range $i 4 end] -]] + if {[tcl::dict::exists $WEB_colour_map $tail]} { + set dec [tcl::dict::get $WEB_colour_map $tail] set hex [colour_dec2hex $dec] set descr "$hex $dec" } else { @@ -2145,17 +2147,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu $t add_row [list $i $descr $s [ansistring VIEW $s]] } term - Term - undt { - set tail [string trim [string range $i 4 end] -] - if {[string is integer -strict $tail]} { + set tail [tcl::string::trim [tcl::string::range $i 4 end] -] + if {[tcl::string::is integer -strict $tail]} { if {$tail < 256} { - set descr "[dict get $TERM_colour_map_reverse $tail]" + set descr "[tcl::dict::get $TERM_colour_map_reverse $tail]" } else { set descr "Invalid (> 255)" } } else { - set tail [string tolower $tail] - if {[dict exists $TERM_colour_map $tail]} { - set descr [dict get $TERM_colour_map $tail] + set tail [tcl::string::tolower $tail] + if {[tcl::dict::exists $TERM_colour_map $tail]} { + set descr [tcl::dict::get $TERM_colour_map $tail] } else { set descr "UNKNOWN colour for term" } @@ -2163,9 +2165,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu $t add_row [list $i $descr $s [ansistring VIEW $s]] } x11- - X11- { - set tail [string tolower [string trim [string range $i 4 end] -]] - if {[dict exists $X11_colour_map $tail]} { - set dec [dict get $X11_colour_map $tail] + set tail [tcl::string::tolower [tcl::string::trim [tcl::string::range $i 4 end] -]] + if {[tcl::dict::exists $X11_colour_map $tail]} { + set dec [tcl::dict::get $X11_colour_map $tail] set hex [colour_dec2hex $dec] set descr "$hex $dec" } else { @@ -2179,13 +2181,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 - rgb# - Rgb# - RGB# - und# - und- { - if {[string index $i 3] eq "#"} { - set tail [string range $i 4 end] + if {[tcl::string::index $i 3] eq "#"} { + set tail [tcl::string::range $i 4 end] set hex $tail set dec [colour_hex2dec $hex] set info $dec ;#show opposite type as first line of info col } else { - set tail [string trim [string range $i 3 end] -] + set tail [tcl::string::trim [tcl::string::range $i 3 end] -] set dec $tail set hex [colour_dec2hex $dec] set info $hex @@ -2226,12 +2228,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } } default { - if {[string is integer -strict $i]} { + if {[tcl::string::is integer -strict $i]} { set rmap [lreverse $SGR_map] - $t add_row [list $i "SGR [dict get $rmap $i]" $s [ansistring VIEW $s]] + $t add_row [list $i "SGR [tcl::dict::get $rmap $i]" $s [ansistring VIEW $s]] } else { - if {[dict exists $SGR_map $i]} { - $t add_row [list $i "SGR [dict get $SGR_map $i]" $s [ansistring VIEW $s]] + if {[tcl::dict::exists $SGR_map $i]} { + $t add_row [list $i "SGR [tcl::dict::get $SGR_map $i]" $s [ansistring VIEW $s]] } else { $t add_row [list $i UNKNOWN $s [ansistring VIEW $s]] } @@ -2247,7 +2249,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #lappend resultlist "RESULT: [a+ {*}$args]sample[a]" $t add_row [list RESULT "" $s [ansistring VIEW $s]] if {$ansi ne $merged} { - if {[string length $merged] < [string length $ansi]} { + if {[tcl::string::length $merged] < [tcl::string::length $ansi]} { #only refer to redundancies if shorter - merge may reorder - REVIEW set warning "[a+ web-red Web-yellow]REDUNDANCIES FOUND" } else { @@ -2271,7 +2273,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # On wezterm - we can get cells changing colour as we scroll after a pallette change - so something appears to be caching colours variable sgr_cache - set sgr_cache [dict create] + set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off proc sgr_cache {{action ""}} { @@ -2280,11 +2282,11 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu error "sgr_cache action '$action' not understood. Valid actions: clear" } if {$action eq "clear"} { - set sgr_cache [dict create] + set sgr_cache [tcl::dict::create] return "sgr_cache cleared" } if {[catch { - set termwidth [dict get [punk::console::get_size] columns] + set termwidth [tcl::dict::get [punk::console::get_size] columns] } errM]} { set termwidth 80 } @@ -2295,8 +2297,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set lines [list] set line "" #todo - terminal width? table? - dict for {key ansi} $sgr_cache { - set thislen [expr {[string length $key]+1}] + tcl::dict::for {key ansi} $sgr_cache { + set thislen [expr {[tcl::string::length $key]+1}] if {$linelen + $thislen >= $termwidth-1} { lappend lines $line set line "$ansi$key$RST " @@ -2306,7 +2308,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu incr linelen $thislen } } - if {[string length $line]} { + if {[tcl::string::length $line]} { lappend lines $line } return [join $lines \n] @@ -2325,8 +2327,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #function name part of cache-key because a and a+ return slightly different results (a has leading reset) variable sgr_cache set cache_key a+$args ;#ensure cache_key static - we may remove for example 'forcecolour' from args - but it needs to remain part of cache_key - if {[dict exists $sgr_cache $cache_key]} { - return [dict get $sgr_cache $cache_key] + if {[tcl::dict::exists $sgr_cache $cache_key]} { + return [tcl::dict::get $sgr_cache $cache_key] } #don't disable ansi here. @@ -2337,7 +2339,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set colour_disabled 0 #whatever function disables or re-enables colour should have made a call to punk::ansi::sgr_cache clear - if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { + if {[tcl::info::exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { set colour_disabled 1 } #allow a mechanism to override the colour_disabled terminal preference - for code that is generating colour for something else - don't let no_color ruin everything. @@ -2351,16 +2353,16 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set t [list] set e [list] ;#extended codes needing to go in own escape sequence foreach i $args { - set f4 [string range $i 0 3] + set f4 [tcl::string::range $i 0 3] switch -- $f4 { web- { #variable WEB_colour_map #upvar ::punk::ansi::WEB_colour_map WEB_colour_map #foreground web colour - set cname [string tolower [string range $i 4 end]] - if {[dict exists $WEB_colour_map $cname]} { - set rgbdash [dict get $WEB_colour_map $cname] - set rgb [string map { - ;} $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $WEB_colour_map $cname]} { + set rgbdash [tcl::dict::get $WEB_colour_map $cname] + set rgb [tcl::string::map { - ;} $rgbdash] lappend t "38;2;$rgb" } else { puts stderr "ansi web colour unmatched: '$i' in call 'a+ $args'" @@ -2370,9 +2372,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable WEB_colour_map #upvar ::punk::ansi::WEB_colour_map WEB_colour_map #background web colour - set cname [string tolower [string range $i 4 end]] - if {[dict exists $WEB_colour_map $cname]} { - lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]" + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $WEB_colour_map $cname]} { + lappend t "48;2;[tcl::string::map {- ;} [tcl::dict::get $WEB_colour_map $cname]]" } else { puts stderr "ansi Web colour unmatched: '$i' in call 'a+ $args'" } @@ -2510,12 +2512,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable TERM_colour_map #256 colour foreground by Xterm name or by integer #name is xterm name or colour index from 0 - 255 - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] & $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] & $cc < 256} { lappend t "38;5;$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend t "38;5;[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend t "38;5;[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi term colour unmatched: '$i' in call 'a+ $args'" } @@ -2524,12 +2526,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu Term - TERM { #variable TERM_colour_map #256 colour background by Xterm name or by integer - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] && $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] && $cc < 256} { lappend t "48;5;$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend t "48;5;[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend t "48;5;[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi Term colour unmatched: '$i' in call 'a+ $args'" } @@ -2538,38 +2540,38 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 { #decimal rgb foreground #allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {;} , {;}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {;} , {;}] $rgbspec] lappend t "38;2;$rgb" } Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 { #decimal rgb background - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {;} , {;}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {;} , {;}] $rgbspec] lappend t "48;2;$rgb" } "rgb#" { #hex rgb foreground - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {;}] lappend t "38;2;$rgb" } "Rgb#" - "RGB#" { #hex rgb background - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {;}] lappend t "48;2;$rgb" } und- - und0 - und1 - und2 - und3 - und4 - und5 - und6 - und7 - und8 - und9 { #decimal rgb underline #allow variants und-xxx-xxx-xxx and undxxx-xxx-xxx - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {:} , {:}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {:} , {:}] $rgbspec] lappend e "58:2::$rgb" } "und#" { #hex rgb underline - (e.g kitty, wezterm) - uses colons as separators - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {:}] lappend e "58:2::$rgb" } @@ -2577,12 +2579,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable TERM_colour_map #256 colour underline by Xterm name or by integer #name is xterm name or colour index from 0 - 255 - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] & $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] & $cc < 256} { lappend e "58:5:$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend e "58:5:[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend e "58:5:[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi term underline colour unmatched: '$i' in call 'a $args'" } @@ -2591,10 +2593,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu x11- { variable X11_colour_map #foreground X11 names - set cname [string tolower [string range $i 4 end]] - if {[dict exists $X11_colour_map $cname]} { - set rgbdash [dict get $X11_colour_map $cname] - set rgb [string map [list - {;}] $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $X11_colour_map $cname]} { + set rgbdash [tcl::dict::get $X11_colour_map $cname] + set rgb [tcl::string::map [list - {;}] $rgbdash] lappend t "38;2;$rgb" } else { puts stderr "ansi x11 colour unmatched: '$i' in call 'a+ $args'" @@ -2603,19 +2605,19 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu X11- { variable X11_colour_map #background X11 names - set cname [string tolower [string range $i 4 end]] - if {[dict exists $X11_colour_map $cname]} { - set rgbdash [dict get $X11_colour_map $cname] - set rgb [string map [list - {;}] $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $X11_colour_map $cname]} { + set rgbdash [tcl::dict::get $X11_colour_map $cname] + set rgb [tcl::string::map [list - {;}] $rgbdash] lappend t "48;2;$rgb" } else { puts stderr "ansi X11 colour unmatched: '$i'" } } default { - if {[string is integer -strict $i] || [string first ";" $i] > 0} { + if {[tcl::string::is integer -strict $i] || [tcl::string::first ";" $i] > 0} { lappend t $i - } elseif {[string first : $i] > 0} { + } elseif {[tcl::string::first : $i] > 0} { lappend e $i } else { puts stderr "ansi name unmatched: '$i' in call 'a+ $args' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-" @@ -2664,7 +2666,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set result "\x1b\[[join $t {;}]m\x1b\[[join $e {;}]m" } } - dict set sgr_cache $cache_key $result + tcl::dict::set sgr_cache $cache_key $result return $result } @@ -2682,8 +2684,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #It's important to put the functionname in the cache-key because a and a+ return slightly different results variable sgr_cache set cache_key a_$args - if {[dict exists $sgr_cache $cache_key]} { - return [dict get $sgr_cache $cache_key] + if {[tcl::dict::exists $sgr_cache $cache_key]} { + return [tcl::dict::get $sgr_cache $cache_key] } #don't disable ansi here. @@ -2693,7 +2695,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set colour_disabled 0 #whatever function disables or re-enables colour should have made a call to punk::ansi::sgr_cache clear - if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { + if {[tcl::info::exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} { set colour_disabled 1 } #allow a mechanism to override the colour_disabled terminal preference - for code that is generating colour for something else - don't let no_color ruin everything. @@ -2707,16 +2709,16 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set t [list] set e [list] ;#extended codes will suppress standard SGR colours and attributes if merged in same escape sequence foreach i $args { - set f4 [string range $i 0 3] + set f4 [tcl::string::range $i 0 3] switch -- $f4 { web- { #variable WEB_colour_map #upvar ::punk::ansi::WEB_colour_map WEB_colour_map #foreground web colour - set cname [string tolower [string range $i 4 end]] - if {[dict exists $WEB_colour_map $cname]} { - set rgbdash [dict get $WEB_colour_map $cname] - set rgb [string map { - ;} $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $WEB_colour_map $cname]} { + set rgbdash [tcl::dict::get $WEB_colour_map $cname] + set rgb [tcl::string::map { - ;} $rgbdash] lappend t "38;2;$rgb" } else { puts stderr "ansi web colour unmatched: '$i' in call 'a $args'" @@ -2726,9 +2728,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable WEB_colour_map #upvar ::punk::ansi::WEB_colour_map WEB_colour_map #background web colour - set cname [string tolower [string range $i 4 end]] - if {[dict exists $WEB_colour_map $cname]} { - lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]" + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $WEB_colour_map $cname]} { + lappend t "48;2;[tcl::string::map {- ;} [tcl::dict::get $WEB_colour_map $cname]]" } else { puts stderr "ansi Web colour unmatched: '$i' in call 'a $args'" } @@ -2863,12 +2865,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable TERM_colour_map #256 colour foreground by Xterm name or by integer #name is xterm name or colour index from 0 - 255 - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] & $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] & $cc < 256} { lappend t "38;5;$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend t "38;5;[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend t "38;5;[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi term colour unmatched: '$i' in call 'a $args'" } @@ -2877,12 +2879,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu Term - TERM { #variable TERM_colour_map #256 colour background by Xterm name or by integer - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] && $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] && $cc < 256} { lappend t "48;5;$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend t "48;5;[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend t "48;5;[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi Term colour unmatched: '$i' in call 'a $args'" } @@ -2891,38 +2893,38 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 { #decimal rgb foreground #allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {;} , {;}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {;} , {;}] $rgbspec] lappend t "38;2;$rgb" } Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 { #decimal rgb background - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {;} , {;}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {;} , {;}] $rgbspec] lappend t "48;2;$rgb" } "rgb#" { #hex rgb foreground - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {;}] lappend t "38;2;$rgb" } "Rgb#" - "RGB#" { #hex rgb background - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {;}] lappend t "48;2;$rgb" } und- - und0 - und1 - und2 - und3 - und4 - und5 - und6 - und7 - und8 - und9 { #decimal rgb underline #allow variants und-xxx-xxx-xxx and undxxx-xxx-xxx - set rgbspec [string trim [string range $i 3 end] -] - set rgb [string map [list - {:} , {:}] $rgbspec] + set rgbspec [tcl::string::trim [tcl::string::range $i 3 end] -] + set rgb [tcl::string::map [list - {:} , {:}] $rgbspec] lappend e "58:2::$rgb" } "und#" { #hex rgb underline - (e.g kitty, wezterm) - uses colons as separators - set hex6 [string trim [string range $i 4 end] -] + set hex6 [tcl::string::trim [tcl::string::range $i 4 end] -] set rgb [join [::scan $hex6 %2X%2X%2X] {:}] lappend e "58:2::$rgb" } @@ -2930,12 +2932,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #variable TERM_colour_map #256 colour underline by Xterm name or by integer #name is xterm name or colour index from 0 - 255 - set cc [string trim [string tolower [string range $i 4 end]] -] - if {[string is integer -strict $cc] & $cc < 256} { + set cc [tcl::string::trim [tcl::string::tolower [tcl::string::range $i 4 end]] -] + if {[tcl::string::is integer -strict $cc] & $cc < 256} { lappend e "58:5:$cc" } else { - if {[dict exists $TERM_colour_map $cc]} { - lappend e "58:5:[dict get $TERM_colour_map $cc]" + if {[tcl::dict::exists $TERM_colour_map $cc]} { + lappend e "58:5:[tcl::dict::get $TERM_colour_map $cc]" } else { puts stderr "ansi term underline colour unmatched: '$i' in call 'a $args'" } @@ -2944,10 +2946,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu x11- { variable X11_colour_map #foreground X11 names - set cname [string tolower [string range $i 4 end]] - if {[dict exists $X11_colour_map $cname]} { - set rgbdash [dict get $X11_colour_map $cname] - set rgb [string map [list - {;}] $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $X11_colour_map $cname]} { + set rgbdash [tcl::dict::get $X11_colour_map $cname] + set rgb [tcl::string::map [list - {;}] $rgbdash] lappend t "38;2;$rgb" } else { puts stderr "ansi x11 colour unmatched: '$i'" @@ -2956,19 +2958,19 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu X11- { variable X11_colour_map #background X11 names - set cname [string tolower [string range $i 4 end]] - if {[dict exists $X11_colour_map $cname]} { - set rgbdash [dict get $X11_colour_map $cname] - set rgb [string map [list - {;}] $rgbdash] + set cname [tcl::string::tolower [tcl::string::range $i 4 end]] + if {[tcl::dict::exists $X11_colour_map $cname]} { + set rgbdash [tcl::dict::get $X11_colour_map $cname] + set rgb [tcl::string::map [list - {;}] $rgbdash] lappend t "48;2;$rgb" } else { puts stderr "ansi X11 colour unmatched: '$i'" } } default { - if {[string is integer -strict $i] || [string first ";" $i] > 0} { + if {[tcl::string::is integer -strict $i] || [tcl::string::first ";" $i] > 0} { lappend t $i - } elseif {[string first : $i] > 0} { + } elseif {[tcl::string::first : $i] > 0} { lappend e $i } else { puts stderr "ansi name unmatched: '$i' in call 'a $args' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-" @@ -3008,7 +3010,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } else { set result "\x1b\[[join $t {;}]m\x1b\[[join $e {;}]m" } - dict set sgr_cache $cache_key $result + tcl::dict::set sgr_cache $cache_key $result return $result } @@ -3028,7 +3030,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set res [list] foreach i [split $code ";"] { set ix [lsearch -exact $SGR_map $i] - if {[string is digit -strict $code]} { + if {[tcl::string::is digit -strict $code]} { if {$ix>-1} {lappend res [lindex $SGR_map [incr ix -1]]} } else { #reverse lookup code from name @@ -3380,7 +3382,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #If the raw line is appended to another string without such processing - the backspaces & carriage returns can affect data prior to the start of the string. proc printing_length {line} { #string last faster than string first for long strings anyway - if {[string last \n $line] >= 0} { + if {[tcl::string::last \n $line] >= 0} { error "line_print_length must not contain newline characters" } #what if line has \v (vertical tab) ie more than one logical screen line? @@ -3406,8 +3408,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #for this reason - it would seem best to normalize the tabs to spaces prior to performing the backspace calculation - otherwise we won't account for the 'short' tabs it effectivley produces #normalize tabs to an appropriate* width #*todo - handle terminal/context where tabwidth != the default 8 spaces - if {[string last \t $line] >= 0} { - if {[info exists punk::console::tabwidth]} { + if {[tcl::string::last \t $line] >= 0} { + if {[tcl::info::exists punk::console::tabwidth]} { set tw $::punk::console::tabwidth } else { set tw 8 @@ -3420,8 +3422,8 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #This means for example that abc\b has a length of 3. Trailing or leading backslashes have no effect #set bs [format %c 0x08] - #set line [string map [list "\r\b" "\r"] $line] ;#backsp following a \r will have no effect - set line [string trim $line \b] ;#take off at start and tail only + #set line [tcl::string::map [list "\r\b" "\r"] $line] ;#backsp following a \r will have no effect + set line [tcl::string::trim $line \b] ;#take off at start and tail only #counterintuitively "x\b" still shows the x ie length is still one. The backspace just moves the position. There must be a char following \b for it to affect the length. #(we are not interested in the destructive backspace case present in editors,terminals etc - that is a different context) @@ -3489,7 +3491,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set currPos 0 while { 1 } { - set currPos [string first \t $line $currPos] + set currPos [tcl::string::first \t $line $currPos] if { $currPos == -1 } { # no more tabs break @@ -3498,7 +3500,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # how far is the next tab position ? set dist [expr {$num - ($currPos % $num)}] # replace '\t' at $currPos with $dist spaces - set line [string replace $line $currPos $currPos $Spaces($dist)] + set line [tcl::string::replace $line $currPos $currPos $Spaces($dist)] # set up for next round (not absolutely necessary but maybe a trifle # more efficient) @@ -3513,7 +3515,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[list_end] [comment {--- end definitions namespace punk::ansi ---}] } -namespace eval punk::ansi { +tcl::namespace::eval punk::ansi { # -- --- --- --- --- --- @@ -3546,7 +3548,7 @@ namespace eval punk::ansi { set payload [join $hexkeys ";"] return "\u0090+q$payload\u009c" } - namespace eval codetype { + tcl::namespace::eval codetype { #*** !doctools #[subsection {Namespace punk::ansi::codetype}] #[para] API functions for punk::ansi::codetype @@ -3569,9 +3571,9 @@ namespace eval punk::ansi { if {[regexp {\033\[[0-9]*(:?C|D|G)$} $code]} { return 1 } - if {[string is integer -strict $knownline]} { + if {[tcl::string::is integer -strict $knownline]} { #CSI n : m H where row n happens to be current line - review/test - set re [string map [list %n% $knownline] {\x1b\[%n%:[0-9]*H$}] + set re [tcl::string::map [list %n% $knownline] {\x1b\[%n%:[0-9]*H$}] if {[regexp $re $code]} { return 1 } @@ -3607,7 +3609,7 @@ namespace eval punk::ansi { if {[regexp {^\033\[([^m]*)m} $code _match params]} { #must match trailing m to be the type of reset we're looking for set plist [split $params ";"] - if {[string trim [lindex $plist 0] 0] eq ""} { + if {[tcl::string::trim [lindex $plist 0] 0] eq ""} { #e.g \033\[m \033\[0\;...m \033\[0000...m return 1 } else { @@ -3636,50 +3638,50 @@ namespace eval punk::ansi { #This is not order-preserving if non-sgr codes are present as they are tacked on to the end even if they initially were before all SGR codes variable codestate_empty - set codestate_empty [dict create] - dict set codestate_empty rst "" ;#0 (or empty) - dict set codestate_empty intensity "" ;#1 bold, 2 dim, 22 normal - dict set codestate_empty italic "" ;#3 on 23 off - dict set codestate_empty underline "" ;#4 on 24 off + set codestate_empty [tcl::dict::create] + tcl::dict::set codestate_empty rst "" ;#0 (or empty) + tcl::dict::set codestate_empty intensity "" ;#1 bold, 2 dim, 22 normal + tcl::dict::set codestate_empty italic "" ;#3 on 23 off + tcl::dict::set codestate_empty underline "" ;#4 on 24 off #nonstandard/extended 4:0,4:1,4:2,4:3,4:4,4:5 #4:1 single underline and 4:2 double underline deliberately kept separate to standard SGR versions #The extended codes are merged separately allowing fallback SGR to be specified for terminals which don't support extended underlines - dict set codestate_empty underextended "" ;#4:0 for no extended underline 4:1 etc for underline styles - #dict set codestate_empty undersingle "" - #dict set codestate_empty underdouble "" - #dict set codestate_empty undercurly "" - #dict set codestate_empty underdottedn "" - #dict set codestate_empty underdashed "" - - dict set codestate_empty blink "" ;#5 or 6 for slow/fast, 25 for off - dict set codestate_empty reverse "" ;#7 on 27 off - dict set codestate_empty hide "" ;#8 on 28 off - dict set codestate_empty strike "" ;#9 on 29 off - dict set codestate_empty font "" ;#10, 11-19 10 being primary - dict set codestate_empty gothic "" ;#20 - dict set codestate_empty doubleunderline "" ;#21 (standard SGR double as opposed to underdouble) - dict set codestate_empty proportional "" ;#26 - see note below - dict set codestate_empty frame_or_circle "" ;#51,52 on - 54 off (54 off) (not generally used - mintty has repurposed for emoji variation selector) + tcl::dict::set codestate_empty underextended "" ;#4:0 for no extended underline 4:1 etc for underline styles + #tcl::dict::set codestate_empty undersingle "" + #tcl::dict::set codestate_empty underdouble "" + #tcl::dict::set codestate_empty undercurly "" + #tcl::dict::set codestate_empty underdottedn "" + #tcl::dict::set codestate_empty underdashed "" + + tcl::dict::set codestate_empty blink "" ;#5 or 6 for slow/fast, 25 for off + tcl::dict::set codestate_empty reverse "" ;#7 on 27 off + tcl::dict::set codestate_empty hide "" ;#8 on 28 off + tcl::dict::set codestate_empty strike "" ;#9 on 29 off + tcl::dict::set codestate_empty font "" ;#10, 11-19 10 being primary + tcl::dict::set codestate_empty gothic "" ;#20 + tcl::dict::set codestate_empty doubleunderline "" ;#21 (standard SGR double as opposed to underdouble) + tcl::dict::set codestate_empty proportional "" ;#26 - see note below + tcl::dict::set codestate_empty frame_or_circle "" ;#51,52 on - 54 off (54 off) (not generally used - mintty has repurposed for emoji variation selector) #ideogram rarely supported - this implementation untested - each attribute kept separate as they presumably can be applied simultaneously - dict set codestate_empty ideogram_underline "" - dict set codestate_empty ideogram_doubleunderline "" - dict set codestate_empty ideogram_overline "" - dict set codestate_empty ideogram_doubleoverline "" - dict set codestate_empty ideogram_clear "" + tcl::dict::set codestate_empty ideogram_underline "" + tcl::dict::set codestate_empty ideogram_doubleunderline "" + tcl::dict::set codestate_empty ideogram_overline "" + tcl::dict::set codestate_empty ideogram_doubleoverline "" + tcl::dict::set codestate_empty ideogram_clear "" - dict set codestate_empty overline "" ;#53 on 55 off - probably not supported - pass through. Seem to be ok to merge with other SGR even if not supported. - dict set codestate_empty underlinecolour "" ;#58 - same arguments as 256colour and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2) + tcl::dict::set codestate_empty overline "" ;#53 on 55 off - probably not supported - pass through. Seem to be ok to merge with other SGR even if not supported. + tcl::dict::set codestate_empty underlinecolour "" ;#58 - same arguments as 256colour and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2) # -- mintty? - dict set codestate_empty superscript "" ;#73 - dict set codestate_empty subscript "" ;#74 - dict set codestate_empty nosupersub "" ;#75 + tcl::dict::set codestate_empty superscript "" ;#73 + tcl::dict::set codestate_empty subscript "" ;#74 + tcl::dict::set codestate_empty nosupersub "" ;#75 # -- - dict set codestate_empty fg "" ;#30-37 + 90-97 - dict set codestate_empty bg "" ;#40-47 + 100-107 + tcl::dict::set codestate_empty fg "" ;#30-37 + 90-97 + tcl::dict::set codestate_empty bg "" ;#40-47 + 100-107 #misnomer should have been sgr_merge_args ? :/ @@ -3708,18 +3710,19 @@ namespace eval punk::ansi { variable codestate_empty set othercodes [list] - set opts [dict create\ + set opts [tcl::dict::create\ -filter_fg 0\ -filter_bg 0\ -filter_reset 0\ ] - dict for {k v} $args { + #safe jumptable test + foreach {k v} $args { switch -- $k { -filter_fg - -filter_bg - -filter_reset { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "sgr_merge unknown option '$k'. Known options [dict keys $opts]" + error "sgr_merge unknown option '$k'. Known options [tcl::dict::keys $opts]" } } } @@ -3741,19 +3744,19 @@ namespace eval punk::ansi { foreach c $codelist { #normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes #.. but preserve original c - #set cnorm [string map [list \x9b {8[} ] $c] - #switch -- [string index $cnorm 1][string index $cnorm end] {} + #set cnorm [tcl::string::map [list \x9b {8[} ] $c] + #switch -- [tcl::string::index $cnorm 1][string index $cnorm end] {} # {[m} - set cnorm [string map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] - switch -- [string range $cnorm 0 3][string index $cnorm end] { + set cnorm [tcl::string::map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] + switch -- [tcl::string::range $cnorm 0 3][tcl::string::index $cnorm end] { 7CSIm - 8CSIm { - #set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m - set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m + #set params [tcl::string::range $cnorm 2 end-1] ;#strip leading esc lb and trailing m + set params [tcl::string::range $cnorm 4 end-1] ;#string leading XCSI and trailing m #some systems use colon for 256 colours or RGB or nonstandard subparameters #- it is therefore probably not ok to map to semicolon within SGR codes and treat the same. - # - will break mintty? set params [string map [list : {;}] $params] + # - will break mintty? set params [tcl::string::map [list : {;}] $params] set plist [split $params {;}] if {![llength $plist]} { #if there was nothing - it must be a reset - we need it in the list @@ -3772,10 +3775,10 @@ namespace eval punk::ansi { #review - what about \x1b\[000m #we need to accept/ignore leading zeros - we can't just pass to expr - as some tcl versions still see leading zero as octal - set codeint [string trimleft [lindex $paramsplit 0] 0] + set codeint [tcl::string::trimleft [lindex $paramsplit 0] 0] switch -- $codeint { "" - 0 { - if {![dict get $opts -filter_reset]} { + if {![tcl::dict::get $opts -filter_reset]} { set codestate $codestate_initial set did_reset 1 } @@ -3783,117 +3786,117 @@ namespace eval punk::ansi { 1 { #bold if {[llength $paramsplit] == 1} { - dict set codestate intensity $p + tcl::dict::set codestate intensity $p } else { if {[lindex $paramsplit 1] eq "2"} { - dict set codestate shadowed "1:2" ;#turn off also with 22 + tcl::dict::set codestate shadowed "1:2" ;#turn off also with 22 } } } 2 { #dim - dict set codestate intensity 2 + tcl::dict::set codestate intensity 2 } 3 { - dict set codestate italic 3 + tcl::dict::set codestate italic 3 } 4 { #REVIEW - merging extended (e.g 4:4) underline attributes suppresses all other SGR attributes on at least some terminals which don't support extended underlines if {[llength $paramsplit] == 1} { - dict set codestate underline 4 + tcl::dict::set codestate underline 4 } else { switch -- [lindex $paramsplit 1] { 0 { #no *extended* underline - #dict set codestate underline 24 - dict set codestate underextended 4:0 ;#will not turn off SGR standard underline if term doesn't support extended + #tcl::dict::set codestate underline 24 + tcl::dict::set codestate underextended 4:0 ;#will not turn off SGR standard underline if term doesn't support extended } 1 { - dict set codestate underextended 4:1 + tcl::dict::set codestate underextended 4:1 } 2 { - dict set codestate underextended 4:2 + tcl::dict::set codestate underextended 4:2 } 3 { - dict set codestate underextended "4:3" + tcl::dict::set codestate underextended "4:3" } 4 { - dict set codestate underextended "4:4" + tcl::dict::set codestate underextended "4:4" } 5 { - dict set codestate underextended "4:5" + tcl::dict::set codestate underextended "4:5" } } } } 5 - 6 { - dict set codestate blink $p + tcl::dict::set codestate blink $p } 7 { - dict set codestate reverse 7 + tcl::dict::set codestate reverse 7 } 8 { - dict set codestate hide 8 + tcl::dict::set codestate hide 8 } 9 { - dict set codestate strike 9 + tcl::dict::set codestate strike 9 } 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 { - dict set codestate font $p + tcl::dict::set codestate font $p } 20 { - dict set codestate gothic 20 + tcl::dict::set codestate gothic 20 } 21 { #ECMA-48 double underline - some terminals use as not-bold. For now we won't support that. - dict set codestate doubleunderline 21 + tcl::dict::set codestate doubleunderline 21 } 22 { #normal intensity - dict set codestate intensity 22 - dict set codestate shadowed "" + tcl::dict::set codestate intensity 22 + tcl::dict::set codestate shadowed "" } 23 { #? wikipedia mentions blackletter - review - dict set codestate italic 23 + tcl::dict::set codestate italic 23 } 24 { - dict set codestate underline 24 ;#off - dict set codestate underextended "4:0" ;#review + tcl::dict::set codestate underline 24 ;#off + tcl::dict::set codestate underextended "4:0" ;#review } 25 { - dict set codestate blink 25 ;#off + tcl::dict::set codestate blink 25 ;#off } 26 { #not known to be used in terminals.. could it be used with elastic tabstops? - review - dict set codestate proportional 26 + tcl::dict::set codestate proportional 26 } 27 { - dict set codestate reverse 27 ;#off + tcl::dict::set codestate reverse 27 ;#off } 28 { - dict set codestate hide 28 ;#reveal + tcl::dict::set codestate hide 28 ;#reveal } 29 { - dict set codestate strike 29;#off + tcl::dict::set codestate strike 29;#off } 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 { - dict set codestate fg $p ;#foreground colour + tcl::dict::set codestate fg $p ;#foreground colour } 38 { #256 colour or rgb #check if subparams supplied as colon separated - if {[string first : $p] < 0} { + if {[tcl::string::first : $p] < 0} { switch -- [lindex $plist $i+1] { 5 { #256 - 1 more param - dict set codestate fg "38\;5\;[lindex $plist $i+2]" + tcl::dict::set codestate fg "38\;5\;[lindex $plist $i+2]" incr i 2 } 2 { #rgb - dict set codestate fg "38\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" + tcl::dict::set codestate fg "38\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" incr i 4 } } @@ -3901,124 +3904,124 @@ namespace eval punk::ansi { #apparently subparameters can be left empty - and there are other subparams like transparency and colour-space #we should only need to pass it all through for the terminal to understand #review - dict set codestate fg $p + tcl::dict::set codestate fg $p } } 39 { - dict set codestate fg 39 ;#default foreground + tcl::dict::set codestate fg 39 ;#default foreground } 40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 { - dict set codestate bg $p ;#background colour + tcl::dict::set codestate bg $p ;#background colour } 48 { #256 colour or rgb - if {[string first : $p] < 0} { + if {[tcl::string::first : $p] < 0} { switch -- [lindex $plist $i+1] { 5 { #256 - 1 more param - dict set codestate bg "48\;5\;[lindex $plist $i+2]" + tcl::dict::set codestate bg "48\;5\;[lindex $plist $i+2]" incr i 2 } 2 { #rgb - dict set codestate bg "48\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" + tcl::dict::set codestate bg "48\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" incr i 4 } } } else { - dict set codestate bg $p + tcl::dict::set codestate bg $p } } 49 { - dict set codestate bg 49 ;#default background + tcl::dict::set codestate bg 49 ;#default background } 50 { - dict set codestate proportional 50 ;#off - see 26 + tcl::dict::set codestate proportional 50 ;#off - see 26 } 51 - 52 { - dict set codestate frame_or_circle 51 + tcl::dict::set codestate frame_or_circle 51 } 53 { - dict set codestate overline 53 ;#not supported in terminals? pass through anyway + tcl::dict::set codestate overline 53 ;#not supported in terminals? pass through anyway } 54 { - dict set codestate frame_or_circle 54 ;#off + tcl::dict::set codestate frame_or_circle 54 ;#off } 55 { - dict set codestate overline 55; #off + tcl::dict::set codestate overline 55; #off } 58 { #nonstandard #256 colour or rgb - if {[string first : $p] < 0} { + if {[tcl::string::first : $p] < 0} { switch -- [lindex $plist $i+1] { 5 { #256 - 1 more param - dict set codestate underlinecolour "58\;5\;[lindex $plist $i+2]" + tcl::dict::set codestate underlinecolour "58\;5\;[lindex $plist $i+2]" incr i 2 } 2 { #rgb - dict set codestate underlinecolour "58\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" + tcl::dict::set codestate underlinecolour "58\;2\;[lindex $plist $i+2]\;[lindex $plist $i+3]\;[lindex $plist $i+4]" incr i 4 } } } else { - dict set codestate underlinecolour $p + tcl::dict::set codestate underlinecolour $p } } 59 { #nonstandard - default underlinecolour - dict set codestate underlinecolour 59 + tcl::dict::set codestate underlinecolour 59 } 60 { - dict set codestate ideogram_underline 60 - dict set codestate ideogram_clear "" + tcl::dict::set codestate ideogram_underline 60 + tcl::dict::set codestate ideogram_clear "" } 61 { - dict set codestate ideogram_doubleunderline 61 - dict set codestate ideogram_clear "" + tcl::dict::set codestate ideogram_doubleunderline 61 + tcl::dict::set codestate ideogram_clear "" } 62 { - dict set codestate ideogram_overline 62 - dict set codestate ideogram_clear "" + tcl::dict::set codestate ideogram_overline 62 + tcl::dict::set codestate ideogram_clear "" } 63 { - dict set codestate ideogram_doubleoverline 63 - dict set codestate ideogram_clear "" + tcl::dict::set codestate ideogram_doubleoverline 63 + tcl::dict::set codestate ideogram_clear "" } 64 { - dict set codestate ideogram_stress 64 - dict set codestate ideogram_clear "" + tcl::dict::set codestate ideogram_stress 64 + tcl::dict::set codestate ideogram_clear "" } 65 { - dict set codestate ideogram_clear 65 + tcl::dict::set codestate ideogram_clear 65 #review - we still need to pass through the ideogram_clear in case something understands it - dict set codestate ideogram_underline "" - dict set codestate ideogram_doubleunderline "" - dict set codestate ideogram_overline "" - dict set codestate ideogram_doubleoverline "" + tcl::dict::set codestate ideogram_underline "" + tcl::dict::set codestate ideogram_doubleunderline "" + tcl::dict::set codestate ideogram_overline "" + tcl::dict::set codestate ideogram_doubleoverline "" } 73 { #mintty only? #can be combined with subscript - dict set codestate superscript 73 - dict set codestate nosupersub "" + tcl::dict::set codestate superscript 73 + tcl::dict::set codestate nosupersub "" } 74 { - dict set codestate subscript 74 - dict set codestate nosupersub "" + tcl::dict::set codestate subscript 74 + tcl::dict::set codestate nosupersub "" } 75 { - dict set codestate nosupersub 75 - dict set codestate superscript "" - dict set codestate subcript "" + tcl::dict::set codestate nosupersub 75 + tcl::dict::set codestate superscript "" + tcl::dict::set codestate subcript "" } 90 - 91 - 92 - 93 - 94 - 95 - 96 - 97 { - dict set codestate fg $p + tcl::dict::set codestate fg $p } 100 - 101 - 102 - 103 - 104 - 105 - 106 - 107 { - dict set codestate bg $p + tcl::dict::set codestate bg $p } } @@ -4033,20 +4036,22 @@ namespace eval punk::ansi { set codemerge "" set unmergeable "" ;# can merge with each other but not main set (for terminals not supporting extended codes) - if {[dict get $opts -filter_fg] || [dict get $opts -filter_bg]} { - dict for {k v} $codestate { + if {[tcl::dict::get $opts -filter_fg] || [tcl::dict::get $opts -filter_bg]} { + #safe jumptable test + #dict for {k v} $codestate {} + tcl::dict::for {k v} $codestate { switch -- $v { "" { } default { switch -- $k { bg { - if {![dict get $opts -filter_bg]} { + if {![tcl::dict::get $opts -filter_bg]} { append codemerge "${v}\;" } } fg { - if {![dict get $opts -filter_fg]} { + if {![tcl::dict::get $opts -filter_fg]} { append codemerge "${v}\;" } } @@ -4061,7 +4066,9 @@ namespace eval punk::ansi { } } } else { - dict for {k v} $codestate { + #safe jumptable test + #dict for {k v} $codestate {} + tcl::dict::for {k v} $codestate { switch -- $v { "" {} default { @@ -4086,9 +4093,9 @@ namespace eval punk::ansi { } #puts "+==> codelist:[ansistring VIEW $codelist] did_reset:$did_reset codemerge:[ansistring VIEW $codemerge] unmergeable:[ansistring VIEW $unmergeable]" if {$codemerge ne ""} { - set codemerge [string trimright $codemerge {;}] + set codemerge [tcl::string::trimright $codemerge {;}] if {$unmergeable ne ""} { - set unmergeable [string trimright $unmergeable {;}] + set unmergeable [tcl::string::trimright $unmergeable {;}] return "\x1b\[${codemerge}m\x1b\[${unmergeable}m[join $othercodes ""]" } else { return "\x1b\[${codemerge}m[join $othercodes ""]" @@ -4098,7 +4105,7 @@ namespace eval punk::ansi { #there were no SGR codes - not even resets return [join $othercodes ""] } else { - set unmergeable [string trimright $unmergeable {;}] + set unmergeable [tcl::string::trimright $unmergeable {;}] return "\x1b\[${unmergeable}m[join $othercodes ""]" } } @@ -4109,7 +4116,7 @@ namespace eval punk::ansi { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::ansi::codetype ---}] } - namespace eval sequence_type { + tcl::namespace::eval sequence_type { proc is_Fe {code} { # C1 control codes if {[regexp {^\033\[[\u0040-\u005F]}]} { @@ -4134,14 +4141,14 @@ namespace eval punk::ansi { } -namespace eval punk::ansi::ta { +tcl::namespace::eval punk::ansi::ta { #*** !doctools #[subsection {Namespace punk::ansi::ta}] #[para] text ansi functions #[para] based on but not identical to the Perl Text Ansi module: #[para] https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm #[list_begin definitions] - namespace path ::punk::ansi + tcl::namespace::path ::punk::ansi #handle both 7-bit and 8-bit csi #review - does codepage affect this? e.g ebcdic has 8bit csi in different position @@ -4270,7 +4277,7 @@ namespace eval punk::ansi::ta { #*** !doctools #[call [fun length] [arg text]] #[para]Return the character length after stripping ansi codes - not the printing length - string length [stripansi $text] + tcl::string::length [stripansi $text] } #todo - handle newlines #not in perl ta @@ -4315,7 +4322,7 @@ namespace eval punk::ansi::ta { #review - tcl greedy expressions may match multiple in one element proc _perlish_split {re text} { - if {[string length $text] == 0} { + if {[tcl::string::length $text] == 0} { return {} } set list [list] @@ -4326,26 +4333,26 @@ namespace eval punk::ansi::ta { lassign $match matchStart matchEnd #puts "->start $start ->match $matchStart $matchEnd" if {$matchEnd < $matchStart} { - lappend list [string range $text $start $matchStart-1] [string index $text $matchStart] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] incr start - if {$start >= [string length $text]} { + if {$start >= [tcl::string::length $text]} { break } continue } - lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] #? - if {$start >= [string length $text]} { + if {$start >= [tcl::string::length $text]} { break } } - return [lappend list [string range $text $start end]] + return [lappend list [tcl::string::range $text $start end]] } #experiment for coroutine generator proc _perlish_split_yield {re text} { - if {[string length $text] == 0} { + if {[tcl::string::length $text] == 0} { yield {} } set list [list] @@ -4356,27 +4363,27 @@ namespace eval punk::ansi::ta { lassign $match matchStart matchEnd #puts "->start $start ->match $matchStart $matchEnd" if {$matchEnd < $matchStart} { - yield [string range $text $start $matchStart-1] - yield [string index $text $matchStart] + yield [tcl::string::range $text $start $matchStart-1] + yield [tcl::string::index $text $matchStart] incr start - if {$start >= [string length $text]} { + if {$start >= [tcl::string::length $text]} { break } continue } - yield [string range $text $start $matchStart-1] - yield [string range $text $matchStart $matchEnd] + yield [tcl::string::range $text $start $matchStart-1] + yield [tcl::string::range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] #? - if {$start >= [string length $text]} { + if {$start >= [tcl::string::length $text]} { break } } - #return [lappend list [string range $text $start end]] - yield [string range $text $start end] + #return [lappend list [tcl::string::range $text $start end]] + yield [tcl::string::range $text $start end] } proc _perlish_split2 {re text} { - if {[string length $text] == 0} { + if {[tcl::string::length $text] == 0} { return {} } set list [list] @@ -4386,17 +4393,17 @@ namespace eval punk::ansi::ta { lassign $match matchStart matchEnd #puts "->start $start ->match $matchStart $matchEnd" if {$matchEnd < $matchStart} { - lappend list [string range $text $start $matchStart-1] [string index $text $matchStart] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] incr start } else { - lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] } - if {$start >= [string length $text]} { + if {$start >= [tcl::string::length $text]} { break } } - return [lappend list [string range $text $start end]] + return [lappend list [tcl::string::range $text $start end]] } proc _ws_split {text} { regexp -all -inline {(?:\S+)|(?:\s+)} $text @@ -4407,15 +4414,15 @@ namespace eval punk::ansi::ta { #[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] } # -- --- --- --- --- --- --- --- --- --- --- -namespace eval punk::ansi::class { +tcl::namespace::eval punk::ansi::class { #assertions specifically for punk::ansi::class namespace - if {![llength [info commands ::punk::ansi::class::assert]]} { - namespace import ::punk::assertion::assert + if {![llength [tcl::info::commands ::punk::ansi::class::assert]]} { + tcl::namespace::import ::punk::assertion::assert punk::assertion::active 1 } - namespace eval renderer { - if {[llength [info commands ::punk::ansi::class::renderer::base_renderer]]} { + tcl::namespace::eval renderer { + if {[llength [tcl::info::commands ::punk::ansi::class::renderer::base_renderer]]} { #Can happen if package forget was used and we're reloading (a possibly different version) ? review ::punk::ansi::class::renderer::base_renderer destroy ;#will automatically destroy other classes such as class_cp437 that use this as a superclass } @@ -4433,17 +4440,17 @@ namespace eval punk::ansi::class { #-- make assert available -- # By pointing it to the assert imported into ::punk::ansi::class # (we could alternatively import assert *directly* from ::punk::assertion::assert - but we can't chain imports as setting active flag renames the command, breaking chained imports) - set nspath [namespace path] + set nspath [tcl::namespace::path] if {"::punk::ansi::class" ni $nspath} { lappend nspath ::punk::ansi::class } - namespace path $nspath + tcl::namespace::path $nspath #-- -- if {[llength $args] < 2} { error {usage: ?-width ? ?-wrap [1|0]? ?-overflow [1|0]? from_ansistring to_ansistring} } lassign [lrange $args end-1 end] from_ansistring to_ansistring - set opts [dict create\ + set opts [tcl::dict::create\ -width \uFFEF\ -wrap 1\ -overflow 0\ @@ -4458,21 +4465,21 @@ namespace eval punk::ansi::class { foreach {k v} $argsflags { switch -- $k { -width - -wrap - -overflow - -appendlines - -looplimit - -experimental { - dict set opts $k $v + tcl::dict::set opts $k $v } default { #don't use [self class] - or we'll get the superclass - error "[info object class [self]] unknown option '$k'. Known options: [dict keys $opts]" + error "[info object class [self]] unknown option '$k'. Known options: [tcl::dict::keys $opts]" } } } - set o_width [dict get $opts -width] - set o_wrap [dict get $opts -wrap] - set o_overflow [dict get $opts -overflow] - set o_appendlines [dict get $opts -appendlines] - set o_looplimit [dict get $opts -looplimit] - set o_cursor_column [dict get $opts -cursor_column] - set o_cursor_row [dict get $opts -cursor_row] + set o_width [tcl::dict::get $opts -width] + set o_wrap [tcl::dict::get $opts -wrap] + set o_overflow [tcl::dict::get $opts -overflow] + set o_appendlines [tcl::dict::get $opts -appendlines] + set o_looplimit [tcl::dict::get $opts -looplimit] + set o_cursor_column [tcl::dict::get $opts -cursor_column] + set o_cursor_row [tcl::dict::get $opts -cursor_row] set o_from_ansistring $from_ansistring set o_ns_from [info object namespace $o_from_ansistring] @@ -4513,7 +4520,7 @@ namespace eval punk::ansi::class { #if {![llength $from_ansisplits]} {$o_from_ansistring eval_in {my MakeSplit}} ;#!!todo - a better way to keep this method semi hidden but call from a 'friend' if {![llength $from_ansisplits]} { - namespace eval $o_ns_from {my MakeSplit} + tcl::namespace::eval $o_ns_from {my MakeSplit} } set eidx [llength $o_rendereditems] @@ -4526,7 +4533,7 @@ namespace eval punk::ansi::class { } if {$eidx == [llength $from_elements]} { #nothing new available - return [dict create type "" rendercount 0 start_count_unrendered 0 end_count_unrendered 0] + return [tcl::dict::create type "" rendercount 0 start_count_unrendered 0 end_count_unrendered 0] } set start_elements_unrendered [expr {[llength $from_elements] - [llength $o_rendereditems]}] @@ -4577,7 +4584,7 @@ namespace eval punk::ansi::class { if 0 { while {[llength $inputchunks]} { set overtext [lpop inputchunks 0] - if {![string length $overtext]} { + if {![tcl::string::length $overtext]} { continue } #set rinfo [overtype::renderline -info 1 -insert_mode 0 -autowrap_mode 1 -width $o_width -overflow 0 -cursor_column $col -cursor_row $row $undertext $overtext] @@ -4586,7 +4593,7 @@ namespace eval punk::ansi::class { $o_to_ansistring append $newtext - return [dict create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered] + return [tcl::dict::create type $type_rendered rendercount $rendercount start_count_unrendered $start_elements_unrendered end_count_unrendered $end_elements_unrendered] } } @@ -4599,7 +4606,7 @@ namespace eval punk::ansi::class { } } - if {[llength [info commands ::punk::ansi::class::class_ansistring]]} { + if {[llength [tcl::info::commands ::punk::ansi::class::class_ansistring]]} { ::punk::ansi::class::class_ansistring destroy } #As this is intended for column-based terminals - it has a different notion of string length, string index etc than for a plain string. @@ -4635,11 +4642,11 @@ namespace eval punk::ansi::class { #-- make assert available -- # By pointing it to the assert imported into ::punk::ansi::class # (we could alternatively import assert *directly* from ::punk::assertion::assert - but we can't chain imports as setting active flag renames the command, breaking imports) - set nspath [namespace path] + set nspath [tcl::namespace::path] if {"::punk::ansi::class" ni $nspath} { lappend nspath ::punk::ansi::class } - namespace path $nspath + tcl::namespace::path $nspath #-- -- #we choose not to generate an internal split-state for the initial string - which may potentially be large. @@ -4691,14 +4698,14 @@ namespace eval punk::ansi::class { if {![llength $o_ansisplits]} { append result "No internal splits. " append result \n "has ansi : [my has_ansi]" - append result \n "Tcl string length raw string: [string length $o_string]" + append result \n "Tcl string length raw string: [tcl::string::length $o_string]" } else { append result \n "has ansi : [my has_ansi]" append result \n "ansisplit list len: [llength $o_ansisplits]" append result \n "plaintext list len: [llength $o_ptlist]" append result \n "cached count : $o_count" - append result \n "Tcl string length raw string : [string length $o_string]" - append result \n "Tcl string length plaintext parts: [string length [join $o_ptlist ""]]" + append result \n "Tcl string length raw string : [tcl::string::length $o_string]" + append result \n "Tcl string length plaintext parts: [tcl::string::length [join $o_ptlist ""]]" if {[llength $o_ansisplits] %2 == 0} { append result \n -------------------------------------------------- append result \n Warning - ansisplits appears to be invalid length @@ -4816,7 +4823,7 @@ namespace eval punk::ansi::class { set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} #we want length to return number of glyphs + normal controls such as newline.. not screen width. Has to be consistent with index function - return [string length [regsub -all $re_diacritics $plaintext ""]] + return [tcl::string::length [regsub -all $re_diacritics $plaintext ""]] } #This is the count of visible graphemes + non-ansi control chars. Not equal to column width or to the Tcl string length of the ansistripped string!!! @@ -4838,16 +4845,16 @@ namespace eval punk::ansi::class { if {[punk::ansi::ta::detect $o_string]} { my MakeSplit } else { - return [string length $o_string] + return [tcl::string::length $o_string] } } elseif {[llength $o_ansisplits] == 1} { #single split always means no ansi - return string length $o_string + return [tcl::string::length $o_string] } - return [string length [join $o_ptlist ""]] + return [tcl::string::length [join $o_ptlist ""]] } method length_raw {} { - return [string length $o_string] + return [tcl::string::length $o_string] } #channels for stream in/out.. these are vaguely analogous to the input/output between a shell and a PTY Slave - but this is not intended to be a full pseudoterminal @@ -4856,9 +4863,9 @@ namespace eval punk::ansi::class { #renderstream_from_render (public?) method rendertypes {} { - set classes [info commands ::punk::ansi::class::renderer::class_*] + set classes [tcl::info::commands ::punk::ansi::class::renderer::class_*] #strip off class_ - set ctypes [lmap v $classes {string range [namespace tail $v] 6 end}] + set ctypes [lmap v $classes {tcl::string::range [tcl::namespace::tail $v] 6 end}] } method rendertype {{rtype ""}} { if {$rtype eq ""} { @@ -4874,8 +4881,8 @@ namespace eval punk::ansi::class { } if {$o_renderer ne ""} { set oinfo [info object class $o_renderer] - set tail [namespace tail $oinfo] - set currenttype [string range $tail 6 end] + set tail [tcl::namespace::tail $oinfo] + set currenttype [tcl::string::range $tail 6 end] if {$rtype ne $currenttype} { puts "switch rendertype from $currenttype to $rtype - destroying renderer and creating a new one" $o_renderer destroy ;#what happens to data in target ansistring obj? when does it make sense to keep output and keep rendering vs clearing? @@ -4926,7 +4933,7 @@ namespace eval punk::ansi::class { if {$o_renderer eq ""} { error "No renderer. Call render methods first" } - return [dict create row [$o_renderer cursor_row] column [$o_renderer cursor_column]] + return [tcl::dict::create row [$o_renderer cursor_row] column [$o_renderer cursor_column]] } #--- @@ -4971,8 +4978,8 @@ namespace eval punk::ansi::class { #assertion - if o_ptlist is empty so is o_ansisplits lappend o_ansisplits $catstr } else { - lset o_ptlist end [string cat [lindex $o_ptlist end] $catstr] - lset o_ansisplits end [string cat [lindex $o_ansisplits end] $catstr] + lset o_ptlist end [tcl::string::cat [lindex $o_ptlist end] $catstr] + lset o_ansisplits end [tcl::string::cat [lindex $o_ansisplits end] $catstr] } set last_codestack [lindex $o_sgrstacks end] set last_gx0state [lindex $o_gx0states end] @@ -5046,9 +5053,9 @@ namespace eval punk::ansi::class { incr current_split_index ;#increment 2 of 2 } } - lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_pt_list 0]] + lset o_ptlist end [tcl::string::cat [lindex $o_ptlist end] [lindex $new_pt_list 0]] lappend o_ptlist {*}[lrange $new_pt_list 1 end] - lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $newsplits 0]] + lset o_ansisplits end [tcl::string::cat [lindex $o_ansisplits end] [lindex $newsplits 0]] lappend o_ansisplits {*}[lrange $newsplits 1 end] #if {$o_count eq ""} { @@ -5075,7 +5082,7 @@ namespace eval punk::ansi::class { upvar ${ns}::o_ansisplits new_ansisplits upvar ${ns}::o_count new_count if {![llength $new_ansisplits] || $new_count eq ""} { - namespace eval $ns {my MakeSplit} + tcl::namespace::eval $ns {my MakeSplit} } upvar ${ns}::o_ptlist new_ptlist upvar ${ns}::o_string new_string @@ -5084,9 +5091,9 @@ namespace eval punk::ansi::class { upvar ${ns}::o_gx0states new_gx0states upvar ${ns}::o_splitindex new_splitindex - lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $new_ansisplits 0]] + lset o_ansisplits end [tcl::string::cat [lindex $o_ansisplits end] [lindex $new_ansisplits 0]] lappend o_ansisplits {*}[lrange $new_ansisplits 1 end] - lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_ptlist 0]] + lset o_ptlist end [tcl::string::cat [lindex $o_ptlist end] [lindex $new_ptlist 0]] lappend o_ptlist {*}[lrange $new_ptlist 1 end] append o_string $new_string @@ -5124,7 +5131,7 @@ namespace eval punk::ansi::class { if {$o_string eq ""} { return "" } - #ansistring VIEW relies only on the raw ansi input as it is essentially just a string map. + #ansistring VIEW relies only on the raw ansi input as it is essentially just a tcl::string::map. #We don't need to force an ansisplit if we happen to have an unsplit initial string ansistring VIEW $o_string } @@ -5170,13 +5177,13 @@ namespace eval punk::ansi::class { append output [ansistring VIEW {*}$args $pt] #map DEC cursor_save/restore to CSI version - set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] + set code [tcl::string::map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] - set c1 [string index $code 0] - set c1c2 [string range $code 0 1] + set c1 [tcl::string::index $code 0] + set c1c2 [tcl::string::range $code 0 1] #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} - set leadernorm [string range [string map [list\ + set leadernorm [tcl::string::range [tcl::string::map [list\ \x1b\[ 7CSI\ \x9b 8CSI\ \x1b\] 7OSC\ @@ -5188,13 +5195,13 @@ namespace eval punk::ansi::class { #we leave the tail of the code unmapped for now switch -- $leadernorm { 7CSI - 7OSC { - set codenorm [string cat $leadernorm [string range $code 2 end]] + set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 7ESC { - set codenorm [string cat $leadernorm [string range $code 1 end]] + set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } 8CSI - 8OSC { - set codenorm [string cat $leadernorm [string range $code 1 end]] + set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } default { #we haven't made a mapping for this @@ -5204,9 +5211,9 @@ namespace eval punk::ansi::class { switch -- $leadernorm { {7CSI} - {8CSI} { - set param [string range $codenorm 4 end-1] - #puts stdout "--> CSI [string index $leadernorm 0] bit param:$param" - switch -- [string index $codenorm end] { + set param [tcl::string::range $codenorm 4 end-1] + #puts stdout "--> CSI [tcl::string::index $leadernorm 0] bit param:$param" + switch -- [tcl::string::index $codenorm end] { m { if {[punk::ansi::codetype::is_sgr_reset $code]} { set displaycode [ansistring VIEW $code] @@ -5215,8 +5222,8 @@ namespace eval punk::ansi::class { set displaycode [ansistring VIEW $code] if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { #highlight the esc & leftbracket in white as indication there is a leading reset - set cposn [string first ";" $displaycode] - append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST + set cposn [tcl::string::first ";" $displaycode] + append output ${whiteb}[tcl::string::range $displaycode 0 $cposn]$RST${greenb}[tcl::string::range $displaycode $cposn+1 end]$RST } else { append output ${greenb}$displaycode$RST } @@ -5225,18 +5232,18 @@ namespace eval punk::ansi::class { A - B { #row move set displaycode [ansistring VIEW $code] - set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode] + set displaycode [tcl::string::map [list A "A$arrow_up" B "B$arrow_down"] $displaycode] append output ${cyanb}$displaycode$RST } C - D - G { - #set num [string range $codenorm 4 end-1] + #set num [tcl::string::range $codenorm 4 end-1] set displaycode [ansistring VIEW $code] - set displaycode [string map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode] + set displaycode [tcl::string::map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode] append output ${cyanb}$displaycode$RST } H - f { - set params [string range $codenorm 4 end-1] + set params [tcl::string::range $codenorm 4 end-1] lassign [split $params {;}] row col #lassign $matchinfo _match row col set displaycode [ansistring VIEW $code] @@ -5247,7 +5254,7 @@ namespace eval punk::ansi::class { #row and col move set map [list H "H${arrow_lr}${arrow_du}" f "${arrow_lr}${arrow_du}"] } - set displaycode [string map $map $displaycode] + set displaycode [tcl::string::map $map $displaycode] append output ${cyanb}$displaycode$RST } s { @@ -5262,7 +5269,7 @@ namespace eval punk::ansi::class { } } 7GFX { - switch -- [string index $codenorm 4] { + switch -- [tcl::string::index $codenorm 4] { "0" { append output ${GX}GX+$RST } @@ -5333,7 +5340,7 @@ namespace eval punk::ansi::class { } } } -namespace eval punk::ansi::ansistring { +tcl::namespace::eval punk::ansi::ansistring { #*** !doctools #[subsection {Namespace punk::ansi::ansistring}] #[para]punk::ansi::ansistring ensemble - ansi-aware string operations @@ -5341,9 +5348,9 @@ namespace eval punk::ansi::ansistring { #[para]Just as working with other forms of markup such as HTML - you simply need to be aware of the tradeoffs and design accordingly. #[list_begin definitions] - namespace path [list ::punk::ansi ::punk::ansi::ta] - namespace ensemble create - namespace export length trim trimleft trimright INDEX COUNT VIEW VIEWCODES VIEWSTYLE INDEXABSOLUTE INDEXCOLUMNS COLUMNINDEX NEW + tcl::namespace::path [list ::punk::ansi ::punk::ansi::ta] + tcl::namespace::ensemble create + tcl::namespace::export length trim trimleft trimright INDEX COUNT VIEW VIEWCODES VIEWSTYLE INDEXABSOLUTE INDEXCOLUMNS COLUMNINDEX NEW #todo - expose _splits_ methods so caller can work efficiently with the splits themselves #we need to consider whether these can be agnostic towards splits from split_codes vs split_codes_single @@ -5461,14 +5468,14 @@ namespace eval punk::ansi::ansistring { #modern (c0 seem to have more terminal/font support - C1 can show 8bit c1 codes - but also seems to be limited support) #Goal is not to map every control character? - #Map of which elements we want to convert - done this way so we can see names of control's that are included: - ease of maintenance compared to just creating the string map directly + #Map of which elements we want to convert - done this way so we can see names of control's that are included: - ease of maintenance compared to just creating the tcl::string::map directly #ETX -ctrl-c #EOT ctrl-d (EOF?) #SYN ctrl-v #SUB ctrl-z #CAN ctrl-x #FS ctrl-\ (SIGQUIT) - set visuals_interesting [dict create\ + set visuals_interesting [tcl::dict::create\ NUL [list \x00 \u2400]\ ETX [list \x03 \u2403]\ EOT [list \x04 \u2404]\ @@ -5484,7 +5491,7 @@ namespace eval punk::ansi::ansistring { APC [list \x9f \ue03f]\ ] #it turns out we need pretty much everything for debugging - set visuals_c0 [dict create\ + set visuals_c0 [tcl::dict::create\ NUL [list \x00 \u2400]\ SOH [list \x01 \u2401]\ STX [list \x02 \u2402]\ @@ -5548,7 +5555,7 @@ namespace eval punk::ansi::ansistring { set obm \u27e6 ;set cbm \u27e7 ;#square double brackets from Miscellaneous Mathematical Symbols-A #this private range so rarely supported in fonts - and visuals are unknown, so we will make up some 2-letter codes for now - #set visuals_c1 [dict create\ + #set visuals_c1 [tcl::dict::create\ # BPH [list \x82 "${ob8}\ue022 $cb8"]\ # NBH [list \x83 "${ob8}\ue023 $cb8"]\ # IND [list \x84 "${ob8}\ue024 $cb8"]\ @@ -5582,7 +5589,7 @@ namespace eval punk::ansi::ansistring { #these 2 letter codes only need to disambiguate within the c1 set - they're not great. #these sit within the Latin-1 Supplement block - set visuals_c1 [dict create\ + set visuals_c1 [tcl::dict::create\ PAD [list \x80 "${ob8}PD$cb8"]\ HOP [list \x81 "${ob8}HP$cb8"]\ BPH [list \x82 "${ob8}BP$cb8"]\ @@ -5617,19 +5624,19 @@ namespace eval punk::ansi::ansistring { ] - set hack [dict create] - dict set hack BOM1 [list \uFEFF "${obm}\U1f4a3$cbm"] ;#byte order mark/ ZWNBSP (ZWNBSP usage generally deprecated) - a picture of a bomb(2wide glyph) + set hack [tcl::dict::create] + tcl::dict::set hack BOM1 [list \uFEFF "${obm}\U1f4a3$cbm"] ;#byte order mark/ ZWNBSP (ZWNBSP usage generally deprecated) - a picture of a bomb(2wide glyph) #review - other boms? Encoding dependent? - dict set hack DCS [list \x90 "${ob8}\u2328 $cb8"] ;#keyboard from Miscellaneous Technical - 1 wide + pad. - dict set hack SOS [list \x98 "${ob8}\u2380 $cb8"] ;#Insertion Symbol from Miscellaneous Technical - 1 wide + pad - dict set hack ST [list \x9c "${ob8}\u2383 $cb8"] ;#Emphasis Symbol from Miscellaneous Technical - 1 wide + pad (graphically related to \u2380) - dict set hack CSI [list \x9b "${ob8}\u2386 $cb8"] ;#Enter Symbol from Miscellaneous Technical - 1 wide + pad - dict set hack OSC [list \x9d "${ob8}\u2b55$cb8"] ;#bright red ring from Miscellaneous Symbols and Arrows - 2 wide (OSC could be used for clipboard or other potentially security sensitive functions) - dict set hack PM [list \x9e "${ob8}PM$cb8"] - dict set hack APC [list \x9f "${ob8}\U1f534$cb8"] ;#bright red ball from Miscellaneoust Symbols and Pictographs - 2 wide (APC also noted as a potential security risk) + tcl::dict::set hack DCS [list \x90 "${ob8}\u2328 $cb8"] ;#keyboard from Miscellaneous Technical - 1 wide + pad. + tcl::dict::set hack SOS [list \x98 "${ob8}\u2380 $cb8"] ;#Insertion Symbol from Miscellaneous Technical - 1 wide + pad + tcl::dict::set hack ST [list \x9c "${ob8}\u2383 $cb8"] ;#Emphasis Symbol from Miscellaneous Technical - 1 wide + pad (graphically related to \u2380) + tcl::dict::set hack CSI [list \x9b "${ob8}\u2386 $cb8"] ;#Enter Symbol from Miscellaneous Technical - 1 wide + pad + tcl::dict::set hack OSC [list \x9d "${ob8}\u2b55$cb8"] ;#bright red ring from Miscellaneous Symbols and Arrows - 2 wide (OSC could be used for clipboard or other potentially security sensitive functions) + tcl::dict::set hack PM [list \x9e "${ob8}PM$cb8"] + tcl::dict::set hack APC [list \x9f "${ob8}\U1f534$cb8"] ;#bright red ball from Miscellaneoust Symbols and Pictographs - 2 wide (APC also noted as a potential security risk) - set debug_visuals [dict merge $visuals_c0 $visuals_c1 $hack] + set debug_visuals [tcl::dict::merge $visuals_c0 $visuals_c1 $hack] #for repeated interaction with the same ANSI string - a mechanism to store state is more efficient proc NEW {string} { @@ -5650,7 +5657,7 @@ namespace eval punk::ansi::ansistring { } set string [lindex $args end] - set defaults [dict create\ + set defaults [tcl::dict::create\ -esc 1\ -cr 1\ -lf 0\ @@ -5661,57 +5668,57 @@ namespace eval punk::ansi::ansistring { ] set argopts [lrange $args 0 end-1] if {[llength $argopts] % 2 != 0} { - error "ansistring VIEW options must be option-value pairs, received '$argopts'. Known opts [dict keys $defaults]" + error "ansistring VIEW options must be option-value pairs, received '$argopts'. Known opts [tcl::dict::keys $defaults]" } - set opts [dict merge $defaults $argopts] + set opts [tcl::dict::merge $defaults $argopts] # -- --- --- --- --- - set opt_esc [dict get $opts -esc] - set opt_cr [dict get $opts -cr] - set opt_lf [dict get $opts -lf] - set opt_vt [dict get $opts -vt] - set opt_ht [dict get $opts -ht] - set opt_bs [dict get $opts -bs] - set opt_sp [dict get $opts -sp] + set opt_esc [tcl::dict::get $opts -esc] + set opt_cr [tcl::dict::get $opts -cr] + set opt_lf [tcl::dict::get $opts -lf] + set opt_vt [tcl::dict::get $opts -vt] + set opt_ht [tcl::dict::get $opts -ht] + set opt_bs [tcl::dict::get $opts -bs] + set opt_sp [tcl::dict::get $opts -sp] # -- --- --- --- --- - set visuals_opt [dict create] + set visuals_opt [tcl::dict::create] if {$opt_esc} { - dict set visuals_opt ESC [list \x1b \u241b] + tcl::dict::set visuals_opt ESC [list \x1b \u241b] } if {$opt_cr} { - dict set visuals_opt CR [list \x0d \u240d] + tcl::dict::set visuals_opt CR [list \x0d \u240d] } if {$opt_lf == 1} { - dict set visuals_opt LF [list \x0a \u240a] + tcl::dict::set visuals_opt LF [list \x0a \u240a] } if {$opt_lf == 2} { - dict set visuals_opt LF [list \x0a \u240a\n] + tcl::dict::set visuals_opt LF [list \x0a \u240a\n] } if {$opt_vt} { - dict set visuals_opt VT [list \x0b \u240b] + tcl::dict::set visuals_opt VT [list \x0b \u240b] } if {$opt_ht} { - dict set visuals_opt HT [list \x09 \u2409] + tcl::dict::set visuals_opt HT [list \x09 \u2409] } if {$opt_bs} { - dict set visuals_opt BS [list \x08 \u2408] + tcl::dict::set visuals_opt BS [list \x08 \u2408] } if {$opt_sp} { - dict set visuals_opt SP [list \x20 \u2420] + tcl::dict::set visuals_opt SP [list \x20 \u2420] } - set visuals [dict merge $visuals_opt $debug_visuals] + set visuals [tcl::dict::merge $visuals_opt $debug_visuals] set charmap [list] - dict for {nm chars} $visuals { + tcl::dict::for {nm chars} $visuals { lappend charmap {*}$chars } - return [string map $charmap $string] + return [tcl::string::map $charmap $string] #test of ISO2047 - 7bit - limited set, limited support, somewhat obscure glyphs - #return [string map [list \033 \U2296 \007 \U237E] $string] + #return [tcl::string::map [list \033 \U2296 \007 \U237E] $string] } #The implementation of viewcodes,viewstyle is more efficiently done in an object for the case where repeated calls of various methods can re-use the internal splits. @@ -5763,7 +5770,7 @@ namespace eval punk::ansi::ansistring { set string [regsub -all $re_diacritics $string ""] #we want length to return number of glyphs.. not screen width. Has to be consistent with index function - string length [stripansi $string] + tcl::string::length [stripansi $string] } #included as a test/verification - slightly slower. #grapheme split version may end up being used once it supports unicode grapheme clusters @@ -5773,7 +5780,7 @@ namespace eval punk::ansi::ansistring { } proc length {string} { - string length [stripansi $string] + tcl::string::length [stripansi $string] } proc _splits_trimleft {sclist} { @@ -5785,7 +5792,7 @@ namespace eval punk::ansi::ansistring { if {$pt eq "" || [regexp {^\s+$} $pt]} { lappend outlist "" $ansiblock } else { - lappend outlist [string trimleft $pt] $ansiblock + lappend outlist [tcl::string::trimleft $pt] $ansiblock set intext 1 } } else { @@ -5796,7 +5803,7 @@ namespace eval punk::ansi::ansistring { if {$pt eq "" || [regexp {^\s+$} $pt]} { lappend outlist "" } else { - lappend outlist [string trimleft $pt] + lappend outlist [tcl::string::trimleft $pt] set intext 1 } } else { @@ -5816,7 +5823,7 @@ namespace eval punk::ansi::ansistring { if {$pt eq "" || [regexp {^\s+$} $pt]} { lappend outlist "" $ansiblock } else { - lappend outlist [string trimright $pt] $ansiblock + lappend outlist [tcl::string::trimright $pt] $ansiblock set intext 1 } } else { @@ -5827,7 +5834,7 @@ namespace eval punk::ansi::ansistring { if {$pt eq "" || [regexp {^\s+$} $pt]} { lappend outlist "" } else { - lappend outlist [string trimright $pt] + lappend outlist [tcl::string::trimright $pt] set intext 1 } } else { @@ -5853,7 +5860,7 @@ namespace eval punk::ansi::ansistring { if {$pt eq "" || [regexp {^\s+$} $pt]} { append out $ansiblock } else { - append out [string trimleft $pt]$ansiblock + append out [tcl::string::trimleft $pt]$ansiblock set intext 1 } } else { @@ -5900,20 +5907,20 @@ namespace eval punk::ansi::ansistring { #todo - end-x +/-x+/-x etc set original_index $index - set index [string map [list _ ""] $index] + set index [tcl::string::map [list _ ""] $index] #short-circuit some trivial cases - if {[string is integer -strict $index]} { + if {[tcl::string::is integer -strict $index]} { if {$index < 0} {return ""} #this only short-circuits an index greater than length including ansi-chars #we don't want to spend cycles stripping ansi for this test so code below will still have to handle index just larger than content-length but still less than entire length - if {$index > [string length $string]} {return ""} + if {$index > [tcl::string::length $string]} {return ""} } else { - if {[string match end* $index]} { + if {[tcl::string::match end* $index]} { #for end- we will probably have to blow a few cycles stripping first and calculate the length if {$index ne "end"} { - set op [string index $index 3] - set offset [string range $index 4 end] - if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"} + set op [tcl::string::index $index 3] + set offset [tcl::string::range $index 4 end] + if {$op ni {+ -} || ![tcl::string::is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"} if {$op eq "+" && $offset != 0} { return "" } @@ -5934,7 +5941,7 @@ namespace eval punk::ansi::ansistring { } else { #we are trying to avoid evaluating unbraced expr of potentially insecure origin regexp {^([+-]{0,1})(.*)} $index _match sign tail ;#should always match - even empty string - if {[string is integer -strict $tail]} { + if {[tcl::string::is integer -strict $tail]} { #plain +- if {$op eq "-"} { #return nothing for negative indices as per Tcl's lindex etc @@ -5943,7 +5950,7 @@ namespace eval punk::ansi::ansistring { set index $tail } else { if {[regexp {(.*)([+-])(.*)} $index _match a op b]} { - if {[string is integer -strict $a] && [string is integer -strict $b]} { + if {[tcl::string::is integer -strict $a] && [tcl::string::is integer -strict $b]} { if {$op eq "-"} { set index [expr {$a - $b}] } else { @@ -5976,13 +5983,13 @@ namespace eval punk::ansi::ansistring { if {$pt ne ""} { set graphemes [punk::char::grapheme_split $pt] set low [expr {$high + 1}] ;#last high - #incr high [string length $pt] + #incr high [tcl::string::length $pt] incr high [llength $graphemes] } if {$pt ne "" && ($index >= $low && $index <= $high)} { set pt_found $pt_index - #set char [string index $pt $index-$low] + #set char [tcl::string::index $pt $index-$low] set char [lindex $graphemes $index-$low] break } @@ -6019,10 +6026,10 @@ namespace eval punk::ansi::ansistring { set payload_len -1 ;# -1 as token to indicate we haven't calculated it yet (only want to call it once at most) set testindices [list] foreach index $args { - if {[string is integer -strict $index]} { + if {[tcl::string::is integer -strict $index]} { if {$index < 0} { lappend testindices "" - } elseif {$index > [string length $string]} { + } elseif {$index > [tcl::string::length $string]} { #this only short-circuits an index greater than length including ansi-chars #we don't want to spend cycles stripping ansi for this test so code below will still have to handle index just larger than content-length but still less than entire length lappend testindices "" @@ -6030,12 +6037,12 @@ namespace eval punk::ansi::ansistring { lappend testindices $index } } else { - if {[string match end* $index]} { + if {[tcl::string::match end* $index]} { #for end- we will probably have to blow a few cycles stripping first and calculate the length if {$index ne "end"} { - set op [string index $index 3] - set offset [string range $index 4 end] - if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"} + set op [tcl::string::index $index 3] + set offset [tcl::string::range $index 4 end] + if {$op ni {+ -} || ![tcl::string::is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"} if {$op eq "+" && $offset != 0} { lappend testindices "" continue @@ -6060,7 +6067,7 @@ namespace eval punk::ansi::ansistring { } else { #we are trying to avoid evaluating unbraced expr of potentially insecure origin regexp {^([+-]{0,1})(.*)} $index _match sign tail ;#should always match - even empty string - if {[string is integer -strict $tail]} { + if {[tcl::string::is integer -strict $tail]} { #plain +- if {$op eq "-"} { #return nothing for negative indices as per Tcl's lindex etc @@ -6071,7 +6078,7 @@ namespace eval punk::ansi::ansistring { lappend testindices $index } else { if {[regexp {(.*)([+-])(.*)} $index _match a op b]} { - if {[string is integer -strict $a] && [string is integer -strict $b]} { + if {[tcl::string::is integer -strict $a] && [tcl::string::is integer -strict $b]} { if {$op eq "-"} { set index [expr {$a - $b}] } else { @@ -6199,7 +6206,7 @@ namespace eval punk::ansi::ansistring { set col2 "" foreach {pt code} $ansisplits { if {$pt ne ""} { - if {[string last \n $pt] < 0} { + if {[tcl::string::last \n $pt] < 0} { set graphemes [punk::char::grapheme_split $pt] set lowindex [expr {$highindex + 1}] ;#last high set lowc [expr {$highc + 1}] @@ -6238,7 +6245,7 @@ namespace eval punk::ansi::ansistring { #[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] } -namespace eval punk::ansi::internal { +tcl::namespace::eval punk::ansi::internal { proc splitn {str {len 1}} { #from textutil::split::splitn if {$len <= 0} { @@ -6248,11 +6255,11 @@ namespace eval punk::ansi::internal { return [split $str {}] } set result [list] - set max [string length $str] + set max [tcl::string::length $str] set i 0 set j [expr {$len -1}] while {$i < $max} { - lappend result [string range $str $i $j] + lappend result [tcl::string::range $str $i $j] incr i $len incr j $len } @@ -6261,10 +6268,10 @@ namespace eval punk::ansi::internal { proc splitx {str {regexp {[\t \r\n]+}}} { #from textutil::split::splitx # Bugfix 476988 - if {[string length $str] == 0} { + if {[tcl::string::length $str] == 0} { return {} } - if {[string length $regexp] == 0} { + if {[tcl::string::length $regexp] == 0} { return [::split $str ""] } if {[regexp $regexp {}]} { @@ -6278,13 +6285,13 @@ namespace eval punk::ansi::internal { foreach {matchStart matchEnd} $match break incr matchStart -1 incr matchEnd - lappend list [string range $str $start $matchStart] + lappend list [tcl::string::range $str $start $matchStart] if {$subStart >= $start} { - lappend list [string range $str $subStart $subEnd] + lappend list [tcl::string::range $str $subStart $subEnd] } set start $matchEnd } - lappend list [string range $str $start end] + lappend list [tcl::string::range $str $start end] return $list } @@ -6308,11 +6315,11 @@ namespace eval punk::ansi::internal { return $2hex } proc hex2str {2digithexchars} { - set 2digithexchars [string map [list _ ""] $2digithexchars] ;#compatibility with tcl tip 551 (compatibility in the sense that users might expect to be able to use underscores and it's nice to support the syntax here too - not that it's required) + set 2digithexchars [tcl::string::map [list _ ""] $2digithexchars] ;#compatibility with tcl tip 551 (compatibility in the sense that users might expect to be able to use underscores and it's nice to support the syntax here too - not that it's required) if {$2digithexchars eq ""} { return "" } - if {[string length $2digithexchars] % 2 != 0} { + if {[tcl::string::length $2digithexchars] % 2 != 0} { error "hex2str requires an even number of hex digits (2 per character)" } set 2str "" @@ -6325,7 +6332,7 @@ namespace eval punk::ansi::internal { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::ansi [namespace eval punk::ansi { +package provide punk::ansi [tcl::namespace::eval punk::ansi { variable version set version 999999.0a1.0 }] diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 71171ee..fffd3cf 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -186,11 +186,19 @@ ## Requirements # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#All ensemble commands are slower in a safe interp as they aren't compiled the same way +#https://core.tcl-lang.org/tcl/tktview/1095bf7f75 +#as this is needed in safe interps too, and the long forms tcl::dict::for tcl::string::map are no slower in a normal interp - we use the long form here. +#(As at 2024-06 There are many tcl8.6/8.7 interps in use which are affected by this and it's unknown when/whether it will be fixed) +#ensembles: array binary chan clock dict encoding info namespace string +#possibly file too, although that is generally hidden/modified in a safe interp + + #*** !doctools #[subsection dependencies] #[para] packages used by punk::args #[list_begin itemized] - package require Tcl 8.6- #*** !doctools #[item] [package {Tcl 8.6-}] @@ -210,11 +218,11 @@ package require Tcl 8.6- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::args::class { +tcl::namespace::eval punk::args::class { #*** !doctools #[subsection {Namespace punk::args::class}] #[para] class definitions - if {[info commands [namespace current]::interface_sample1] eq ""} { + if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { #*** !doctools #[list_begin enumerated] @@ -243,13 +251,13 @@ namespace eval punk::args::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::args { - namespace export {[a-z]*} +tcl::namespace::eval punk::args { + tcl::namespace::export {[a-z]*} variable argspec_cache variable argspecs variable id_counter - set argspec_cache [dict create] - set argspecs [dict create] + set argspec_cache [tcl::dict::create] + set argspecs [tcl::dict::create] set id_counter 0 #*** !doctools @@ -265,12 +273,12 @@ namespace eval punk::args { #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string set cache_key $optionspecs - if {[dict exists $argspec_cache $cache_key]} { - return [dict get $argspec_cache $cache_key] + if {[tcl::dict::exists $argspec_cache $cache_key]} { + return [tcl::dict::get $argspec_cache $cache_key] } - set optionspecs [string map [list \r\n \n] $optionspecs] - set optspec_defaults [dict create\ + set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + set optspec_defaults [tcl::dict::create\ -type string\ -optional 1\ -allow_ansi 1\ @@ -279,7 +287,7 @@ namespace eval punk::args { -nocase 0\ -multiple 0\ ] - set valspec_defaults [dict create\ + set valspec_defaults [tcl::dict::create\ -type string\ -optional 0\ -allow_ansi 1\ @@ -295,10 +303,10 @@ namespace eval punk::args { #todo - detect if anything in the spec uses -allow_ansi 0, -validate_without_ansi 1 or -strip_ansi 1 and set a flag indicating if punk::ansi::ta::detect should be run on the argslist set opt_required [list] set val_required [list] - set arg_info [dict create] - set opt_defaults [dict create] + set arg_info [tcl::dict::create] + set opt_defaults [tcl::dict::create] set opt_names [list] ;#defined opts - set val_defaults [dict create] + set val_defaults [tcl::dict::create] set opt_solos [list] #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end set val_names [list] @@ -309,21 +317,21 @@ namespace eval punk::args { set linelist [split $optionspecs \n] set lastindent "" foreach ln $linelist { - if {[string trim $ln] eq ""} {continue} + if {[tcl::string::trim $ln] eq ""} {continue} regexp {(\s*).*} $ln _all lastindent break ;#break at first non-empty } #puts "indent1:[ansistring VIEW $lastindent]" set in_record 0 foreach rawline $linelist { - set recordsofar [string cat $linebuild $rawline] - if {![info complete $recordsofar]} { + set recordsofar [tcl::string::cat $linebuild $rawline] + if {![tcl::info::complete $recordsofar]} { #append linebuild [string trimleft $rawline] \n if {$in_record} { - if {[string length $lastindent]} { + if {[tcl::string::length $lastindent]} { #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[string first $lastindent $rawline] == 0} { - set trimmedline [string range $rawline [string length $lastindent] end] + if {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] append linebuild $trimmedline \n } else { append linebuild $rawline \n @@ -340,10 +348,10 @@ namespace eval punk::args { } } else { set in_record 0 - if {[string length $lastindent]} { + if {[tcl::string::length $lastindent]} { #trim only the whitespace corresponding to last indent - not all whitespace on left - if {[string first $lastindent $rawline] == 0} { - set trimmedline [string range $rawline [string length $lastindent] end] + if {[tcl::string::first $lastindent $rawline] == 0} { + set trimmedline [tcl::string::range $rawline [tcl::string::length $lastindent] end] append linebuild $trimmedline } else { append linebuild $rawline @@ -361,19 +369,19 @@ namespace eval punk::args { set val_max -1 ;#-1 for no limit set spec_id "" foreach ln $records { - set trimln [string trim $ln] - switch -- [string index $trimln 0] { + set trimln [tcl::string::trim $ln] + switch -- [tcl::string::index $trimln 0] { "" - # {continue} } set linespecs [lassign $trimln argname] if {$argname ne "*id" && [llength $linespecs] %2 != 0} { error "punk::args::get_dict - bad optionspecs line for record '$argname' Remaining items on line must be in paired option-value format - received '$linespecs'" } - set firstchar [string index $argname 0] - set secondchar [string index $argname 1] + set firstchar [tcl::string::index $argname 0] + set secondchar [tcl::string::index $argname 1] if {$firstchar eq "*" && $secondchar ne "*"} { set starspecs $linespecs - switch -- [string range $argname 1 end] { + switch -- [tcl::string::range $argname 1 end] { id { #id line must have single entry - a unique id assigned by the user - an id will be allocated if no id line present or the value is "auto" if {[llength $starspecs] != 1} { @@ -398,10 +406,10 @@ namespace eval punk::args { } -minlen - -maxlen - -range - -choices - -choicelabels { #review - only apply to certain types? - dict set optspec_defaults $k $v + tcl::dict::set optspec_defaults $k $v } -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { - dict unset optspec_defaults $k + tcl::dict::unset optspec_defaults $k } -type - -optional - @@ -410,7 +418,7 @@ namespace eval punk::args { -strip_ansi - -multiple { #allow overriding of defaults for options that occur later - dict set optspec_defaults $k $v + tcl::dict::set optspec_defaults $k $v } default { error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" @@ -431,17 +439,17 @@ namespace eval punk::args { } -minlen - -maxlen - -range - -choices - -choicelabels { #review - only apply to certain types? - dict set valspec_defaults $k $v + tcl::dict::set valspec_defaults $k $v } -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { - dict unset valspec_defaults $k + tcl::dict::unset valspec_defaults $k } -type - -allow_ansi - -validate_without_ansi - -strip_ansi - -multiple { - dict set valspec_defaults $k $v + tcl::dict::set valspec_defaults $k $v } default { error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" @@ -457,16 +465,16 @@ namespace eval punk::args { continue } elseif {$firstchar eq "-"} { set argspecs $linespecs - dict set argspecs -ARGTYPE option + tcl::dict::set argspecs -ARGTYPE option lappend opt_names $argname set is_opt 1 } else { if {$firstchar eq "*"} { #allow basic ** escaping for literal argname that begins with * - set argname [string range $argname 1 end] + set argname [tcl::string::range $argname 1 end] } set argspecs $linespecs - dict set argspecs -ARGTYPE value + tcl::dict::set argspecs -ARGTYPE value lappend val_names $argname set is_opt 0 } @@ -478,20 +486,20 @@ namespace eval punk::args { switch -- $spec { -type { #normalize here so we don't have to test during actual args parsing in main function - switch -- [string tolower $specval] { + switch -- [tcl::string::tolower $specval] { int - integer { - dict set merged -type int + tcl::dict::set merged -type int } bool - boolean { - dict set merged -type bool + tcl::dict::set merged -type bool } char - character { - dict set merged -type char + tcl::dict::set merged -type char } "" - none { if {$is_opt} { - dict set merged -type none - dict set merged -default 0 ;#-default 0 can still be overridden if -default appears after -type - we'll allow it. + tcl::dict::set merged -type none + tcl::dict::set merged -default 0 ;#-default 0 can still be overridden if -default appears after -type - we'll allow it. lappend opt_solos $argname } else { #-solo only valid for flags @@ -499,12 +507,12 @@ namespace eval punk::args { } } default { - dict set merged -type [string tolower $specval] + tcl::dict::set merged -type [tcl::string::tolower $specval] } } } -default - -solo - -range - -choices - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -help - -ARGTYPE { - dict set merged $spec $specval + tcl::dict::set merged $spec $specval } default { set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -help] @@ -514,40 +522,40 @@ namespace eval punk::args { } set argspecs $merged #if {$is_opt} { - set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen #} else { - # set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + # set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen #} - dict set arg_info $argname $argspecs - dict set arg_checks $argname $argchecks - if {![dict get $argspecs -optional]} { + tcl::dict::set arg_info $argname $argspecs + tcl::dict::set arg_checks $argname $argchecks + if {![tcl::dict::get $argspecs -optional]} { if {$is_opt} { lappend opt_required $argname } else { lappend val_required $argname } } - if {[dict exists $argspecs -default]} { + if {[tcl::dict::exists $argspecs -default]} { if {$is_opt} { - dict set opt_defaults $argname [dict get $argspecs -default] + tcl::dict::set opt_defaults $argname [tcl::dict::get $argspecs -default] } else { - dict set val_defaults $argname [dict get $argspecs -default] + tcl::dict::set val_defaults $argname [tcl::dict::get $argspecs -default] } } } #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { - if {[dict get $arg_info $valname -multiple]} { + if {[tcl::dict::get $arg_info $valname -multiple]} { error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" } } - if {$spec_id eq "" || [string tolower $spec_id] eq "auto"} { + if {$spec_id eq "" || [tcl::string::tolower $spec_id] eq "auto"} { variable id_counter set spec_id "autoid_[incr id_counter]" } - set result [dict create\ + set result [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -566,28 +574,28 @@ namespace eval punk::args { valspec_defaults $valspec_defaults\ proc_info $proc_info\ ] - dict set argspec_cache $cache_key $result - dict set argspecs $spec_id $optionspecs + tcl::dict::set argspec_cache $cache_key $result + tcl::dict::set argspecs $spec_id $optionspecs return $result } proc get_spec {id} { variable argspecs - if {[dict exists $argspecs $id]} { - return [dict get $argspecs $id] + if {[tcl::dict::exists $argspecs $id]} { + return [tcl::dict::get $argspecs $id] } return } proc get_spec_ids {{match *}} { variable argspecs - return [dict keys $argspecs $match] + return [tcl::dict::keys $argspecs $match] } #for use within get_dict only #This mechanism gets less-than-useful results for oo methods #e.g {$obj} proc Get_caller {} { - set cmdinfo [dict get [info frame -3] cmd] + set cmdinfo [tcl::dict::get [tcl::info::frame -3] cmd] #puts "-->$cmdinfo" set caller [regexp -inline {\S+} $cmdinfo] if {$caller eq "namespace"} { @@ -681,7 +689,7 @@ namespace eval punk::args { set argspecs [Get_argspecs $optionspecs] - dict with argspecs {} ;#turn keys into vars + tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] @@ -692,12 +700,12 @@ namespace eval punk::args { set maxidx [expr {[llength $arglist]-1}] for {set i 0} {$i <= $maxidx} {incr i} { set a [lindex $arglist $i] - if {![string match -* $a]} { + if {![tcl::string::match -* $a]} { #we can't treat as first positional arg - as it comes before the eopt indicator -- error "punk::args::get_dict bad options for [Get_caller]. Expected flag (leading -) at position $i got:$rawargs" } #TODO! - if {[dict get $arg_info $a -type] ne "none"} { + if {[tcl::dict::get $arg_info $a -type] ne "none"} { if {[incr i] > $maxidx} { error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $a which is not marked with -solo 1" } @@ -714,20 +722,20 @@ namespace eval punk::args { set maxidx [expr {[llength $rawargs]-1}] for {set i 0} {$i <= $maxidx} {incr i} { set a [lindex $rawargs $i] - if {![string match -* $a]} { + if {![tcl::string::match -* $a]} { #assume beginning of positional args incr i -1 break } if {![catch {tcl::prefix match -message "options for %caller%. Unexpected option" $opt_names $a } fullopt]} { - if {[dict get $arg_info $fullopt -type] ne "none"} { + if {[tcl::dict::get $arg_info $fullopt -type] ne "none"} { #non-solo set flagval [lindex $rawargs $i+1] if {[dict get $arg_info $fullopt -multiple]} { - dict lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } else { - dict set opts $fullopt $flagval + tcl::dict::set opts $fullopt $flagval } #incr i to skip flagval if {[incr i] > $maxidx} { @@ -735,15 +743,15 @@ namespace eval punk::args { } } else { #type none (solo-flag) - if {[dict get $arg_info $fullopt -multiple]} { - if {[dict get $opts $fullopt] == 0} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $opts $fullopt] == 0} { #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified - dict set opts $fullopt 1 + tcl::dict::set opts $fullopt 1 } else { - dict lappend opts $fullopt 1 + tcl::dict::lappend opts $fullopt 1 } } else { - dict set opts $fullopt 1 + tcl::dict::set opts $fullopt 1 } } lappend flagsreceived $fullopt ;#dups ok @@ -751,12 +759,12 @@ namespace eval punk::args { if {$opt_any} { set newval [lindex $rawargs $i+1] #opt was unspecified but is allowed due to *opt -any 1 - 'adhoc/passthrough' option - dict set arg_info $a $optspec_defaults ;#use default settings for unspecified opt - if {[dict get $arg_info $a -type] ne "none"} { - if {[dict get $arg_info $a -multiple]} { - dict lappend opts $a $newval + tcl::dict::set arg_info $a $optspec_defaults ;#use default settings for unspecified opt + if {[tcl::dict::get $arg_info $a -type] ne "none"} { + if {[tcl::dict::get $arg_info $a -multiple]} { + tcl::dict::lappend opts $a $newval } else { - dict set opts $a $newval + tcl::dict::set opts $a $newval } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { @@ -764,19 +772,19 @@ namespace eval punk::args { } } else { #review -we can't provide a way to allow unspecified -type none flags through reliably/unambiguously unless all remaining unspecified options are -type none - if {[dict get $arg_info $a -multiple]} { - if {![dict exists $opts $a]} { - dict set opts $a 1 + if {[tcl::dict::get $arg_info $a -multiple]} { + if {![tcl::dict::exists $opts $a]} { + tcl::dict::set opts $a 1 } else { - dict lappend opts $a 1 + tcl::dict::lappend opts $a 1 } } else { - dict set opts $a 1 + tcl::dict::set opts $a 1 } } } else { #delay Get_caller so only called in the unhappy path - set errmsg [string map [list %caller% [Get_caller]] $fullopt] + set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] error $errmsg } } @@ -800,20 +808,20 @@ namespace eval punk::args { break } if {$valname ne ""} { - if {[dict get $arg_info $valname -multiple]} { - dict lappend values_dict $valname $val + if {[tcl::dict::get $arg_info $valname -multiple]} { + tcl::dict::lappend values_dict $valname $val set in_multiple $valname } else { - dict set values_dict $valname $val + tcl::dict::set values_dict $valname $val } lappend valnames_received $valname } else { if {$in_multiple ne ""} { - dict lappend values_dict $in_multiple $val + tcl::dict::lappend values_dict $in_multiple $val #name already seen } else { - dict set values_dict $validx $val - dict set arg_info $validx $valspec_defaults + tcl::dict::set values_dict $validx $val + tcl::dict::set arg_info $validx $valspec_defaults lappend valnames_received $validx } } @@ -844,6 +852,11 @@ namespace eval punk::args { #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true + + #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #example timing difference: + #struct::set difference {x} {a b} + #normal interp 0.18 u2 vs save interp 9.4us if {[llength [set missing [struct::set difference $opt_required $flagsreceived]]]} { error "Required option missing for [Get_caller]. missing flags $missing are marked with -optional false - so must be present in full-length form" } @@ -853,24 +866,24 @@ namespace eval punk::args { #todo - allow defaults outside of choices/ranges #check types,ranges,choices - set opts_and_values [dict merge $opts $values_dict] - #set combined_defaults [dict merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash + set opts_and_values [tcl::dict::merge $opts $values_dict] + #set combined_defaults [tcl::dict::merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash #puts "---opts_and_values:$opts_and_values" #puts "---arg_info:$arg_info" - dict for {argname v} $opts_and_values { - set thisarg [dict get $arg_info $argname] - #set thisarg_keys [dict keys $thisarg] - set thisarg_checks [dict get $arg_checks $argname] - set is_multiple [dict get $thisarg -multiple] - set is_allow_ansi [dict get $thisarg -allow_ansi] - set is_validate_without_ansi [dict get $thisarg -validate_without_ansi] - set is_strip_ansi [dict get $thisarg -strip_ansi] - set has_default [dict exists $thisarg -default] + tcl::dict::for {argname v} $opts_and_values { + set thisarg [tcl::dict::get $arg_info $argname] + #set thisarg_keys [tcl::dict::keys $thisarg] + set thisarg_checks [tcl::dict::get $arg_checks $argname] + set is_multiple [tcl::dict::get $thisarg -multiple] + set is_allow_ansi [tcl::dict::get $thisarg -allow_ansi] + set is_validate_without_ansi [tcl::dict::get $thisarg -validate_without_ansi] + set is_strip_ansi [tcl::dict::get $thisarg -strip_ansi] + set has_default [tcl::dict::exists $thisarg -default] if {$has_default} { - set defaultval [dict get $thisarg -default] + set defaultval [tcl::dict::get $thisarg -default] } - set type [dict get $thisarg -type] - set has_choices [dict exists $thisarg -choices] + set type [tcl::dict::get $thisarg -type] + set has_choices [tcl::dict::exists $thisarg -choices] if {$is_multiple} { set vlist $v @@ -916,20 +929,22 @@ namespace eval punk::args { switch -- $type { any {} string { - if {[dict size $thisarg_checks]} { + if {[tcl::dict::size $thisarg_checks]} { foreach e_check $vlist_check { - dict for {checkopt checkval} $thisarg_checks { + #safe jumptable test + #dict for {checkopt checkval} $thisarg_checks {} + tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { -minlen { # -1 for disable is as good as zero - if {[string length $e_check] < $checkval} { - error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[string length $e_check] value:'$e_check'" + if {[tcl::string::length $e_check] < $checkval} { + error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" } } -maxlen { if {$checkval ne "-1"} { - if {[string length $e_check] > $checkval} { - error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[string length $e_check] value:'$e_check'" + if {[tcl::string::length $e_check] > $checkval} { + error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" } } } @@ -942,10 +957,10 @@ namespace eval punk::args { package require ansi } int { - if {[dict exists $thisarg -range]} { - lassign [dict get $thisarg -range] low high + if {[tcl::dict::exists $thisarg -range]} { + lassign [tcl::dict::get $thisarg -range] low high foreach e $vlist e_check $vlist_check { - if {![string is integer -strict $e_check]} { + if {![tcl::string::is integer -strict $e_check]} { error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" } if {$e_check < $low || $e_check > $high} { @@ -954,7 +969,7 @@ namespace eval punk::args { } } else { foreach e_check $vlist_check { - if {![string is integer -strict $e_check]} { + if {![tcl::string::is integer -strict $e_check]} { error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" } } @@ -962,11 +977,13 @@ namespace eval punk::args { } double { foreach e $vlist e_check $vlist_check { - if {![string is double -strict $e_check]} { + if {![tcl::string::is double -strict $e_check]} { error "Option $argname for [Get_caller] requires type 'double'. Received: '$e'" } - if {[dict size $thisarg_checks]} { - dict for {checkopt checkval} $thisarg_checks { + if {[tcl::dict::size $thisarg_checks]} { + #safe jumptable test + #dict for {checkopt checkval} $thisarg_checks {} + tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { -range { #todo - small-value double comparisons with error-margin? review @@ -982,7 +999,7 @@ namespace eval punk::args { } bool { foreach e_check $vlist_check { - if {![string is boolean -strict $e_check]} { + if {![tcl::string::is boolean -strict $e_check]} { error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" } } @@ -1001,7 +1018,7 @@ namespace eval punk::args { wordchar - xdigit { foreach e $vlist e_check $vlist_check { - if {![string is $type $e_check]} { + if {![tcl::string::is $type $e_check]} { error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" } } @@ -1011,7 +1028,7 @@ namespace eval punk::args { existingfile - existingdirectory { foreach e $vlist e_check $vlist_check { - if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { + if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" } @@ -1032,7 +1049,7 @@ namespace eval punk::args { } char { foreach e $vlist e_check $vlist_check { - if {[string length $e_check] != 1} { + if {[tcl::string::length $e_check] != 1} { error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" } } @@ -1040,13 +1057,13 @@ namespace eval punk::args { } if {$has_choices} { #todo -choicelabels - set choices [dict get $thisarg -choices] - set nocase [dict get $thisarg -nocase] + set choices [tcl::dict::get $thisarg -choices] + set nocase [tcl::dict::get $thisarg -nocase] foreach e $vlist e_check $vlist_check { if {$nocase} { set casemsg "(case insensitive)" - set choices_test [string tolower $choices] - set v_test [string tolower $e_check] + set choices_test [tcl::string::tolower $choices] + set v_test [tcl::string::tolower $e_check] } else { set casemsg "(case sensitive)" set v_test $e_check @@ -1060,24 +1077,24 @@ namespace eval punk::args { } if {$is_strip_ansi} { set stripped_list [lmap e $vlist {punk::ansi::stripansi $e}] ;#no faster or slower, but more concise than foreach - if {[dict get $thisarg -multiple]} { - if {[dict get $thisarg -ARGTYPE] eq "option"} { - dict set opts $argname $stripped_list + if {[tcl::dict::get $thisarg -multiple]} { + if {[tcl::dict::get $thisarg -ARGTYPE] eq "option"} { + tcl::dict::set opts $argname $stripped_list } else { - dict set values_dict $argname $stripped_list + tcl::dict::set values_dict $argname $stripped_list } } else { - if {[dict get $thisarg -ARGTYPE] eq "option"} { - dict set opts $argname [lindex $stripped_list 0] + if {[tcl::dict::get $thisarg -ARGTYPE] eq "option"} { + tcl::dict::set opts $argname [lindex $stripped_list 0] } else { - dict set values_dict [lindex $stripped_list 0] + tcl::dict::set values_dict [lindex $stripped_list 0] } } } } #maintain order of opts $opts values $values as caller may use lassign. - return [dict create opts $opts values $values_dict] + return [tcl::dict::create opts $opts values $values_dict] } #proc sample1 {p1 args} { @@ -1099,9 +1116,9 @@ namespace eval punk::args { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::args::lib { - namespace export * - namespace path [namespace parent] +tcl::namespace::eval punk::args::lib { + tcl::namespace::export * + tcl::namespace::path [tcl::namespace::parent] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -1126,7 +1143,7 @@ namespace eval punk::args::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -namespace eval punk::args::system { +tcl::namespace::eval punk::args::system { #*** !doctools #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API @@ -1136,7 +1153,7 @@ namespace eval punk::args::system { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::args [namespace eval punk::args { +package provide punk::args [tcl::namespace::eval punk::args { variable pkg punk::args variable version set version 999999.0a1.0 diff --git a/src/modules/punk/assertion-999999.0a1.0.tm b/src/modules/punk/assertion-999999.0a1.0.tm index b7bcbed..d0d4c25 100644 --- a/src/modules/punk/assertion-999999.0a1.0.tm +++ b/src/modules/punk/assertion-999999.0a1.0.tm @@ -69,11 +69,11 @@ package require Tcl 8.6- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::assertion::class { +tcl::namespace::eval punk::assertion::class { #*** !doctools #[subsection {Namespace punk::assertion::class}] #[para] class definitions - if {[info commands [namespace current]::interface_sample1] eq ""} { + if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { #*** !doctools #[list_begin enumerated] @@ -100,16 +100,16 @@ namespace eval punk::assertion::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #keep 2 namespaces for assertActive and assertInactive so there is introspection available via namespace origin -namespace eval punk::assertion::primary { - - namespace export * +tcl::namespace::eval punk::assertion::primary { + #tcl::namespace::export {[a-z]*} + tcl::namespace::export assertActive assertInactive proc assertActive {expr args} { set code [catch {uplevel 1 [list expr $expr]} res] if {$code} { return -code $code $res } - if {![string is boolean -strict $res]} { + if {![tcl::string::is boolean -strict $res]} { return -code error "invalid boolean expression: $expr" } @@ -124,28 +124,40 @@ namespace eval punk::assertion::primary { upvar ::punk::assertion::CallbackCmd CallbackCmd # Might want to catch this - namespace eval :: $CallbackCmd [list $msg] + tcl::namespace::eval :: $CallbackCmd [list $msg] } proc assertInactive args {} } -namespace eval punk::assertion::secondary { - namespace export * +tcl::namespace::eval punk::assertion::secondary { + tcl::namespace::export * #we need to actually define these procs here, (not import then re-export) - or namespace origin will report the original source namespace - which isn't what we want. - proc assertActive {expr args} [info body ::punk::assertion::primary::assertActive] + proc assertActive {expr args} [tcl::info::body ::punk::assertion::primary::assertActive] proc assertInactive args {} } - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::assertion { +tcl::namespace::eval punk::assertion { variable CallbackCmd [list return -code error] - namespace import ::punk::assertion::primary::assertActive + + #puts --------AAA + #*very* slow in safe interp - why? + #tcl::namespace::import ::punk::assertion::primary::assertActive + + proc do_ns_import {} { + uplevel 1 [list tcl::namespace::import ::punk::assertion::primary::assertActive] + } + do_ns_import + #puts --------BBB rename assertActive assert - namespace export * +} + + +tcl::namespace::eval punk::assertion { + tcl::namespace::export * #variable xyz #*** !doctools @@ -177,7 +189,7 @@ namespace eval punk::assertion { set n [llength $args] if {$n > 1} { return -code error "wrong # args: should be\ - \"[lindex [info level 0] 0] ?command?\"" + \"[lindex [tcl::info::level 0] 0] ?command?\"" } if {$n} { set cb [lindex $args 0] @@ -187,41 +199,41 @@ namespace eval punk::assertion { } proc active {{on_off ""}} { - set nscaller [uplevel 1 [list namespace current]] - set which_assert [namespace eval $nscaller {namespace which assert}] + set nscaller [uplevel 1 [list tcl::namespace::current]] + set which_assert [tcl::namespace::eval $nscaller {tcl::namespace::which assert}] #puts "nscaller:'$nscaller'" #puts "which_assert: $which_assert" if {$on_off eq ""} { if {$which_assert eq ""} {return 0} - set assertorigin [namespace origin $which_assert] + set assertorigin [tcl::namespace::origin $which_assert] #puts "ns which assert: $which_assert" #puts "ns origin assert: $assertorigin" - return [expr {"assertActive" eq [namespace tail $assertorigin]}] + return [expr {"assertActive" eq [tcl::namespace::tail $assertorigin]}] } - if {![string is boolean -strict $on_off]} { + if {![tcl::string::is boolean -strict $on_off]} { error "invalid boolean value : $on_off" } else { - set info_command [namespace eval $nscaller {info commands assert}] + set info_command [tcl::namespace::eval $nscaller {tcl::info::commands assert}] if {$on_off} { #Enable it in calling namespace if {"assert" eq $info_command} { #There is an assert command reachable - due to namespace path etc, it could be in another namespace entirely - (not necessarily in an ancestor namespace of the namespace's tree structure) if {$which_assert eq [punk::assertion::system::nsjoin ${nscaller} assert]} { - namespace eval $nscaller { - set assertorigin [namespace origin assert] + tcl::namespace::eval $nscaller { + set assertorigin [tcl::namespace::origin assert] set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] switch -- $assertorigin_ns { ::punk::assertion { #original import - switch to primary origin rename assert {} - namespace import ::punk::assertion::primary::assertActive + tcl::namespace::import ::punk::assertion::primary::assertActive rename assertActive assert } ::punk::assertion::primary - ::punk::assertion::secondary { #keep using from same origin ns rename assert {} - namespace import ${assertorigin_ns}::assertActive + tcl::namespace::import ${assertorigin_ns}::assertActive rename assertActive assert } default { @@ -232,10 +244,10 @@ namespace eval punk::assertion { return 1 } else { #assert is available, but isn't in the calling namespace - we should enable it in a way that is distinguishable from case where assert was explicitly imported to this namespace - namespace eval $nscaller { - set assertorigin [namespace origin assert] - if {[string match ::punk::assertion::* $assertorigin]} { - namespace import ::punk::assertion::secondary::assertActive + tcl::namespace::eval $nscaller { + set assertorigin [tcl::namespace::origin assert] + if {[tcl::string::match ::punk::assertion::* $assertorigin]} { + tcl::namespace::import ::punk::assertion::secondary::assertActive rename assertActive assert } else { error "The reachable assert command at '$which_assert' is not from punk::assertion package. Import punk::assertion::assert - or use the enable mechanism from the package associated with $assertorigin" @@ -254,20 +266,20 @@ namespace eval punk::assertion { if {"assert" eq $info_command} { if {$which_assert eq [punk::assertion::system::nsjoin ${nscaller} assert]} { #assert is present in callers NS - namespace eval $nscaller { - set assertorigin [namespace origin assert] + tcl::namespace::eval $nscaller { + set assertorigin [tcl::namespace::origin assert] set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] switch -glob -- $assertorigin_ns { ::punk::assertion { #original import rename assert {} - namespace import punk::assertion::primary::assertInactive + tcl::namespace::import punk::assertion::primary::assertInactive rename assertInactive assert } ::punk::assertion::primary - ::punk::assertion::secondary { #keep using from same origin ns rename assert {} - namespace import ${assertorigin_ns}::assertInactive + tcl::namespace::import ${assertorigin_ns}::assertInactive rename assertInactive assert } default { @@ -278,11 +290,11 @@ namespace eval punk::assertion { return 0 } else { #assert not present in callers NS - first install of secondary (if assert is from punk::assertion::*) - namespace eval $nscaller { - set assertorigin [namespace origin assert] + tcl::namespace::eval $nscaller { + set assertorigin [tcl::namespace::origin assert] set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] - if {[string match ::punk::assertion::* $assertorigin]} { - namespace import ::punk::assertion::secondary::assertInactive + if {[tcl::string::match ::punk::assertion::* $assertorigin]} { + tcl::namespace::import ::punk::assertion::secondary::assertInactive rename assertInactive assert } else { error "The reachable assert command at '$which_assert' is not from punk::assertion package. Import punk::assertion::assert - or use the enable mechanism from the package associated with $assertorigin" @@ -310,9 +322,9 @@ namespace eval punk::assertion { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::assertion::lib { - namespace export * - namespace path [namespace parent] +tcl::namespace::eval punk::assertion::lib { + tcl::namespace::export * + tcl::namespace::path [tcl::namespace::parent] #*** !doctools #[subsection {Namespace punk::assertion::lib}] #[para] Secondary functions that are part of the API @@ -337,7 +349,7 @@ namespace eval punk::assertion::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] -namespace eval punk::assertion::system { +tcl::namespace::eval punk::assertion::system { #*** !doctools #[subsection {Namespace punk::assertion::system}] #[para] Internal functions that are not part of the API @@ -346,33 +358,33 @@ namespace eval punk::assertion::system { #nsprefix/nstail are string functions - they do not concern themselves with what namespaces are present in the system proc nsprefix {{nspath {}}} { #normalize the common case of :::: - set nspath [string map [list :::: ::] $nspath] - set rawprefix [string range $nspath 0 end-[string length [nstail $nspath]]] + set nspath [tcl::string::map [list :::: ::] $nspath] + set rawprefix [tcl::string::range $nspath 0 end-[tcl::string::length [nstail $nspath]]] if {$rawprefix eq "::"} { return $rawprefix } else { - if {[string match *:: $rawprefix]} { - return [string range $rawprefix 0 end-2] + if {[tcl::string::match *:: $rawprefix]} { + return [tcl::string::range $rawprefix 0 end-2] } else { return $rawprefix } - #return [string trimright $rawprefix :] + #return [tcl::string::trimright $rawprefix :] } } #see also punk::ns - keep in sync proc nstail {nspath args} { #normalize the common case of :::: - set nspath [string map [list :::: ::] $nspath] - set mapped [string map [list :: \u0FFF] $nspath] + set nspath [tcl::string::map [list :::: ::] $nspath] + set mapped [tcl::string::map [list :: \u0FFF] $nspath] set parts [split $mapped \u0FFF] set defaults [list -strict 0] - set opts [dict merge $defaults $args] - set strict [dict get $opts -strict] + set opts [tcl::dict::merge $defaults $args] + set strict [tcl::dict::get $opts -strict] if {$strict} { foreach p $parts { - if {[string match :* $p]} { + if {[tcl::string::match :* $p]} { error "nstail unpaired colon ':' in $nspath" } } @@ -381,7 +393,7 @@ namespace eval punk::assertion::system { return [lindex $parts end] } proc nsjoin {prefix name} { - if {[string match ::* $name]} { + if {[tcl::string::match ::* $name]} { if {"$prefix" ne ""} { error "nsjoin: won't join non-empty prefix to absolute namespace path '$name'" } @@ -400,7 +412,7 @@ namespace eval punk::assertion::system { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::assertion [namespace eval punk::assertion { +package provide punk::assertion [tcl::namespace::eval punk::assertion { variable pkg punk::assertion variable version set version 999999.0a1.0 diff --git a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm index 9646ed7..25ab3ed 100644 --- a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm +++ b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm @@ -85,8 +85,19 @@ namespace eval punk::cap::handlers::templates { module { set provide_statement [package ifneeded $pkg [package require $pkg]] set tmfile [lindex $provide_statement end] + if {[interp issafe]} { + #default safe interp can't use file exists/normalize etc.. but safe interp may have a policy/alias set allowing file access to certain paths - so test if file exists is usable + if {[catch {file exists $tmfile} tm_exists]} { + puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING (expected in most safe interps) - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" + flush stderr + return 0 + } + } else { + set tm_exists [file exists $tmfile] + } if {![file exists $tmfile]} { puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" + flush stderr return 0 } diff --git a/src/modules/punk/char-999999.0a1.0.tm b/src/modules/punk/char-999999.0a1.0.tm index 65be28a..9bf6ffa 100644 --- a/src/modules/punk/char-999999.0a1.0.tm +++ b/src/modules/punk/char-999999.0a1.0.tm @@ -71,10 +71,10 @@ package require textutil::wcswidth #Note that ansi escapes can begin with \033\[ (\u001b\[) or the single character "Control Sequence Introducer" 0x9b # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::char { - namespace export * +tcl::namespace::eval punk::char { + tcl::namespace::export * - variable grapheme_widths [dict create] + variable grapheme_widths [tcl::dict::create] # -- -------------------------------------------------------------------------- variable encmimens ;#namespace of mime package providing reversemapencoding and mapencoding functions #tcllib mime requires tcl::chan::memchan,events,core and/or Trf @@ -115,23 +115,23 @@ namespace eval punk::char { set out "" set i 1 append out " " - dict for {k v} $dict { + tcl::dict::for {k v} $dict { #single chars are wrapped with \033(0 and \033(B ie total length 7 - if {[string length $v] == 7} { + if {[tcl::string::length $v] == 7} { set v " $v " - } elseif {[string length $v] == 2} { + } elseif {[tcl::string::length $v] == 2} { set v "$v " - } elseif {[string length $v] == 0} { + } elseif {[tcl::string::length $v] == 0} { set v " " } append out "$k $v " if {$i > 0 && $i % 8 == 0} { - set out [string range $out 0 end-2] + set out [tcl::string::range $out 0 end-2] append out \n " " } incr i } - set out [string trimright $out " "] + set out [tcl::string::trimright $out " "] return $out } @@ -146,18 +146,18 @@ namespace eval punk::char { append out " " set i 1 - dict for {k charinfo} $unicode_dict { - set char [dict get $charinfo char] - if {[string length $char] == 0} { + tcl::dict::for {k charinfo} $unicode_dict { + set char [tcl::dict::get $charinfo char] + if {[tcl::string::length $char] == 0} { set displayv " " - } elseif {[string length $char] == 1} { + } elseif {[tcl::string::length $char] == 1} { set displayv " $char " } else { set displayv $char } append out "$k $displayv " if {$i > 0 && $i % 8 == 0} { - set out [string range $out 0 end-2] + set out [tcl::string::range $out 0 end-2] append out \n " " } incr i @@ -167,7 +167,7 @@ namespace eval punk::char { proc page_names {{search *}} { set all_names [list] set d [page_names_dict $search] - dict for {k v} $d { + tcl::dict::for {k v} $d { if {$k ni $all_names} { lappend all_names $k } @@ -183,7 +183,7 @@ namespace eval punk::char { set d [page_names_dict $namesearch] set out "" - dict for {k v} $d { + tcl::dict::for {k v} $d { append out "$k $v" \n } return [linesort $out] @@ -194,32 +194,32 @@ namespace eval punk::char { } set encnames [encoding names] foreach enc $encnames { - dict set d $enc [list] + tcl::dict::set d $enc [list] } variable encmimens set mimenames [array get ${encmimens}::reversemap] - dict for {mname encname} $mimenames { + tcl::dict::for {mname encname} $mimenames { if {$encname in $encnames} { - set enclist [dict get $d $encname] + set enclist [tcl::dict::get $d $encname] if {$mname ni $enclist} { - dict lappend d $encname $mname + tcl::dict::lappend d $encname $mname } } } foreach enc [lsort $encnames] { set mime_enc [${encmimens}::mapencoding $enc] if {$mime_enc ne ""} { - set enclist [dict get $d $enc] + set enclist [tcl::dict::get $d $enc] if {$mime_enc ni $enclist} { - dict lappend d $enc $mime_enc + tcl::dict::lappend d $enc $mime_enc } } } - set dresult [dict create] + set dresult [tcl::dict::create] if {$search ne "*"} { - dict for {k v} $d { - if {[string match -nocase $search $k] || ([lsearch -nocase $v $search]) >= 0} { - dict set dresult $k $v + tcl::dict::for {k v} $d { + if {[tcl::string::match -nocase $search $k] || ([lsearch -nocase $v $search]) >= 0} { + tcl::dict::set dresult $k $v } } } else { @@ -228,11 +228,11 @@ namespace eval punk::char { return $dresult } proc page8 {encname args} { - dict set args -cols 8 + tcl::dict::set args -cols 8 tailcall page $encname {*}$args } proc page16 {encname args} { - dict set args -cols 16 + tcl::dict::set args -cols 16 tailcall page $encname {*}$args } @@ -246,9 +246,9 @@ namespace eval punk::char { -range {0 256}\ -cols 16\ ] - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] # -- --- --- --- --- --- --- --- --- - set cols [dict get $opts -cols] + set cols [tcl::dict::get $opts -cols] # -- --- --- --- --- --- --- --- --- set d_bytedisplay [basedict_display] @@ -263,28 +263,28 @@ namespace eval punk::char { set out "" set i 1 append out " " - dict for {k rawchar} $d_page { + tcl::dict::for {k rawchar} $d_page { set num [expr {"0x$k"}] #see if ascii equivalent exists and has a name if {$rawchar eq $invalid} { set displayv "$invalid" } else { set bytedisplay "" - if {[dict exists $d_asciiposn $rawchar]} { - set asciiposn [dict get $d_asciiposn $rawchar] - set bytedisplay [dict get $d_bytedisplay $asciiposn] + if {[tcl::dict::exists $d_asciiposn $rawchar]} { + set asciiposn [tcl::dict::get $d_asciiposn $rawchar] + set bytedisplay [tcl::dict::get $d_bytedisplay $asciiposn] } if {$bytedisplay eq $invalid} { # set displayv " $rawchar " } else { - set displaylen [string length $bytedisplay] + set displaylen [tcl::string::length $bytedisplay] if {$displaylen == 2} { set displayv "$bytedisplay " } elseif {$displaylen == 3} { set displayv $bytedisplay } else { - if {[string length $rawchar] == 0} { + if {[tcl::string::length $rawchar] == 0} { set displayv " " } else { #presumed 1 @@ -296,12 +296,12 @@ namespace eval punk::char { append out "$k $displayv " if {$i > 0 && $i % $cols == 0} { - set out [string range $out 0 end-2] + set out [tcl::string::range $out 0 end-2] append out \n " " } incr i } - set out [string trimright $out " "] + set out [tcl::string::trimright $out " "] return $out } @@ -357,8 +357,8 @@ namespace eval punk::char { set out "" set mimenamesdict [page_names_dict] foreach encname [encoding names] { - if {[dict exists $mimenamesdict $encname]} { - set alt "([dict get $mimenamesdict $encname])" + if {[tcl::dict::exists $mimenamesdict $encname]} { + set alt "([tcl::dict::get $mimenamesdict $encname])" } else { set alt "" } @@ -383,43 +383,43 @@ namespace eval punk::char { proc pagedict_raw {encname} { variable invalid ;# ="???" set encname [encname $encname] - set d [dict create] + set d [tcl::dict::create] for {set i 0} {$i < 256} {incr i} { set k [format %02x $i] - #dict set d $k [encoding convertfrom $encname [format %c $i]] + #tcl::dict::set d $k [encoding convertfrom $encname [format %c $i]] set ch [format %c $i] ; #jmn if {[decodable $ch $encname]} { #set encchar [encoding convertto $encname $ch] - #dict set d $k [encoding convertfrom $encchar] - dict set d $k [encoding convertfrom $encname $ch] + #tcl::dict::set d $k [encoding convertfrom $encchar] + tcl::dict::set d $k [encoding convertfrom $encname $ch] } else { - dict set d $k $invalid ;#use replacement so we can detect difference from actual "?" + tcl::dict::set d $k $invalid ;#use replacement so we can detect difference from actual "?" } } return $d } proc asciidict {} { variable invalid - set d [dict create] + set d [tcl::dict::create] set a128 [asciidict128] for {set i 0} {$i < 256} {incr i} { set k [format %02x $i] if {$i <= 127} { - dict set d $k [dict get $a128 $k] + tcl::dict::set d $k [tcl::dict::get $a128 $k] } else { # - dict set d $k $invalid + tcl::dict::set d $k $invalid } if {$i <=32} { #no point emitting the lower control characters raw to screen - emit the short-names defined in the 'ascii' proc - dict set d $k [dict get $a128 $k] + tcl::dict::set d $k [tcl::dict::get $a128 $k] } else { if {$i == 0x9b} { - dict set d $k CSI ;#don't emit the ansi 'Control Sequence Introducer' - or it will be interpreted by the console and affect the layout. + tcl::dict::set d $k CSI ;#don't emit the ansi 'Control Sequence Introducer' - or it will be interpreted by the console and affect the layout. } else { - dict set d $k [format %c $i] + tcl::dict::set d $k [format %c $i] } } } @@ -427,22 +427,22 @@ namespace eval punk::char { } proc basedict_display {} { - set d [dict create] + set d [tcl::dict::create] set a128 [asciidict128] for {set i 0} {$i < 256} {incr i} { set k [format %02x $i] if {$i <=32} { #no point emitting the lower control characters raw to screen - emit the short-names defined in the 'ascii' proc - dict set d $k [dict get $a128 $k] + tcl::dict::set d $k [tcl::dict::get $a128 $k] } else { if {$i == 0x9b} { - dict set d $k CSI ;#don't emit the ansi 'Control Sequence Introducer' - or it will be interpreted by the console and affect the layout. + tcl::dict::set d $k CSI ;#don't emit the ansi 'Control Sequence Introducer' - or it will be interpreted by the console and affect the layout. } elseif {$i == 0x9c} { - dict set d $k OSC + tcl::dict::set d $k OSC } else { - #dict set d $k [encoding convertfrom [encoding system] [format %c $i]] + #tcl::dict::set d $k [encoding convertfrom [encoding system] [format %c $i]] #don't use encoding convertfrom - we want the value independent of the current encoding system. - dict set d $k [format %c $i] + tcl::dict::set d $k [format %c $i] } } } @@ -450,20 +450,20 @@ namespace eval punk::char { } proc basedict_encoding_system {} { #result depends on 'encoding system' currently in effect - set d [dict create] + set d [tcl::dict::create] for {set i 0} {$i < 256} {incr i} { set k [format %02x $i] - dict set d $k [encoding convertfrom [encoding system] [format %c $i]] + tcl::dict::set d $k [encoding convertfrom [encoding system] [format %c $i]] } return $d } proc basedict {} { #this gives same result independent of current value of 'encoding system' - set d [dict create] + set d [tcl::dict::create] for {set i 0} {$i < 256} {incr i} { set k [format %02x $i] - dict set d $k [format %c $i] + tcl::dict::set d $k [format %c $i] } return $d } @@ -474,22 +474,22 @@ namespace eval punk::char { -range {0 255}\ -charset ""\ ] - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- - set range [dict get $opts -range] - set charset [dict get $opts -charset] + set range [tcl::dict::get $opts -range] + set charset [tcl::dict::get $opts -charset] # -- --- --- --- --- --- --- --- --- --- if {$charset ne ""} { if {$charset ni [charset_names]} { error "unknown charset '$charset' - use 'charset_names' to get list" } - set setinfo [dict get $charsets $charset] - set ranges [dict get $setinfo ranges] - set charset_dict [dict create] + set setinfo [tcl::dict::get $charsets $charset] + set ranges [tcl::dict::get $setinfo ranges] + set charset_dict [tcl::dict::create] foreach r $ranges { - set start [dict get $r start] - set end [dict get $r end] - #set charset_dict [dict merge $charset_dict [char_range_dict $start $end]] + set start [tcl::dict::get $r start] + set end [tcl::dict::get $r end] + #set charset_dict [tcl::dict::merge $charset_dict [char_range_dict $start $end]] break } @@ -498,10 +498,10 @@ namespace eval punk::char { set end [lindex $range 1] } - set d [dict create] + set d [tcl::dict::create] for {set i $start} {$i <= $end} {incr i} { set k [format %02x $i] - dict set d $k [encoding convertfrom $encname [format %c $i]] + tcl::dict::set d $k [encoding convertfrom $encname [format %c $i]] } return $d } @@ -516,14 +516,14 @@ namespace eval punk::char { #review - use terminal to display actual supported DEC specials vs using dict at: punk::ansi::map_special_graphics which maps to known unicode equivalents proc asciidict2 {} { - set d [dict create] - dict for {k v} [basedict_display] { - if {[string length $v] == 1} { + set d [tcl::dict::create] + tcl::dict::for {k v} [basedict_display] { + if {[tcl::string::length $v] == 1} { set num [expr {"0x$k"}] - #dict set d $k "\033(0[subst \\u00$k]\033(B" - dict set d $k "\033(0[format %c $num]\033(B" + #tcl::dict::set d $k "\033(0[subst \\u00$k]\033(B" + tcl::dict::set d $k "\033(0[format %c $num]\033(B" } else { - dict set d $k $v + tcl::dict::set d $k $v } } return $d @@ -540,7 +540,7 @@ namespace eval punk::char { if {($encname eq "ascii")} { #8.6 fails to round-trip convert 0x7f del character despite it being in the ascii range (review Why?? what else doesn't round-trip but should?) #just strip it out of the string as we are only after a boolean answer and if s is only a single del char empty string will result in true - set s [string map [list [format %c 0x7f] ""] $s] + set s [tcl::string::map [list [format %c 0x7f] ""] $s] } string eq $s [encoding convertfrom $encname [encoding convertto $encname $s]] } @@ -630,14 +630,14 @@ namespace eval punk::char { # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # Unicode character sets - some hardcoded - some loadable from data files # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - variable charinfo [dict create] - variable charsets [dict create] + variable charinfo [tcl::dict::create] + variable charsets [tcl::dict::create] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # Aggregate character sets (ones that pick various ranges from underlying unicode ranges) # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "WGL4" [list altname "Windows Glyph List 4" ranges [list\ + tcl::dict::set charsets "WGL4" [list altname "Windows Glyph List 4" ranges [list\ {start 0 end 127 name "basic latin"}\ {start 128 end 255 name "latin-1 supplement"}\ {start 256 end 383 name "Latin Extended-A"}\ @@ -668,202 +668,202 @@ namespace eval punk::char { #The base page 0-256 8bit range - values don't have specific characters or descriptions - as they are codepage dependent #we will fill this here for completeness - but with placeholders # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "8bit" [list ranges [list {start 0 end 127 name ascii} {start 128 end 255 name 8bit-ascii}] description "8bit extended ascii range" settype "other"] + tcl::dict::set charsets "8bit" [list ranges [list {start 0 end 127 name ascii} {start 128 end 255 name 8bit-ascii}] description "8bit extended ascii range" settype "other"] for {set i 0} {$i < 256} {incr i} { - dict set charinfo $i [list desc "codepage-dependent" short "byte_[format %02x $i]"] + tcl::dict::set charinfo $i [list desc "codepage-dependent" short "byte_[format %02x $i]"] } # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # Unicode ranges # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "greek" [list ranges [list {start 880 end 1023} {start 7936 end 8191}] description "Greek and Coptic" settype "other"] + tcl::dict::set charsets "greek" [list ranges [list {start 880 end 1023} {start 7936 end 8191}] description "Greek and Coptic" settype "other"] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "Block Elements" [list ranges [list {start 9600 end 9631}] description "Block Elements" settype "other"] - dict set charinfo 9600 [list desc "Upper Half Block" short "blocke_up_half"] - dict set charinfo 9601 [list desc "Lower One Eighth Block" short "blocke_lw_1_8th"] - dict set charinfo 9602 [list desc "Lower One Quarter Block" short "blocke_lw_1_qtr"] + tcl::dict::set charsets "Block Elements" [list ranges [list {start 9600 end 9631}] description "Block Elements" settype "other"] + tcl::dict::set charinfo 9600 [list desc "Upper Half Block" short "blocke_up_half"] + tcl::dict::set charinfo 9601 [list desc "Lower One Eighth Block" short "blocke_lw_1_8th"] + tcl::dict::set charinfo 9602 [list desc "Lower One Quarter Block" short "blocke_lw_1_qtr"] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "Dingbats" [list ranges [list {start 9984 end 10175 }] description "Unicode Dingbats" settype "tcl_supplemented"] - dict set charinfo 9984 [list desc "Black Safety Scissors" short "dingbats_black_safety_scissors"] + tcl::dict::set charsets "Dingbats" [list ranges [list {start 9984 end 10175 }] description "Unicode Dingbats" settype "tcl_supplemented"] + tcl::dict::set charinfo 9984 [list desc "Black Safety Scissors" short "dingbats_black_safety_scissors"] #... - dict set charinfo 10175 [list desc "Double Curly Loop" short "dingbats_double_curly_loop"] + tcl::dict::set charinfo 10175 [list desc "Double Curly Loop" short "dingbats_double_curly_loop"] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #variation selectors 0xFe01 - 0xFE0F - dict set charsets "Variation Selectors" [list ranges [list {start 65024 end 65039}] description "Variation Selectors" note "combining character with previous char - variant glyph display" settype "tcl_supplemented"] - dict set charinfo 65024 [list desc "Variation Selector-1" short "VS1"] - dict set charinfo 65025 [list desc "Variation Selector-2" short "VS2"] - dict set charinfo 65026 [list desc "Variation Selector-3" short "VS3"] - dict set charinfo 65027 [list desc "Variation Selector-4" short "VS4"] - dict set charinfo 65027 [list desc "Variation Selector-5" short "VS5"] - dict set charinfo 65029 [list desc "Variation Selector-6" short "VS6"] - dict set charinfo 65030 [list desc "Variation Selector-7" short "VS7"] - dict set charinfo 65031 [list desc "Variation Selector-8" short "VS8"] - dict set charinfo 65032 [list desc "Variation Selector-9" short "VS9"] - dict set charinfo 65033 [list desc "Variation Selector-10" short "VS10"] - dict set charinfo 65034 [list desc "Variation Selector-11" short "VS11"] - dict set charinfo 65035 [list desc "Variation Selector-12" short "VS12"] - dict set charinfo 65036 [list desc "Variation Selector-13" short "VS13"] - dict set charinfo 65037 [list desc "Variation Selector-14" short "VS14"] - dict set charinfo 65038 [list desc "Variation Selector-15 text variation" short "VS15"] ;#still an image - just more suitable for text-presentation e.g word-processing doc - dict set charinfo 65039 [list desc "Variation Selector-16 emoji variation" short "VS16"] + tcl::dict::set charsets "Variation Selectors" [list ranges [list {start 65024 end 65039}] description "Variation Selectors" note "combining character with previous char - variant glyph display" settype "tcl_supplemented"] + tcl::dict::set charinfo 65024 [list desc "Variation Selector-1" short "VS1"] + tcl::dict::set charinfo 65025 [list desc "Variation Selector-2" short "VS2"] + tcl::dict::set charinfo 65026 [list desc "Variation Selector-3" short "VS3"] + tcl::dict::set charinfo 65027 [list desc "Variation Selector-4" short "VS4"] + tcl::dict::set charinfo 65027 [list desc "Variation Selector-5" short "VS5"] + tcl::dict::set charinfo 65029 [list desc "Variation Selector-6" short "VS6"] + tcl::dict::set charinfo 65030 [list desc "Variation Selector-7" short "VS7"] + tcl::dict::set charinfo 65031 [list desc "Variation Selector-8" short "VS8"] + tcl::dict::set charinfo 65032 [list desc "Variation Selector-9" short "VS9"] + tcl::dict::set charinfo 65033 [list desc "Variation Selector-10" short "VS10"] + tcl::dict::set charinfo 65034 [list desc "Variation Selector-11" short "VS11"] + tcl::dict::set charinfo 65035 [list desc "Variation Selector-12" short "VS12"] + tcl::dict::set charinfo 65036 [list desc "Variation Selector-13" short "VS13"] + tcl::dict::set charinfo 65037 [list desc "Variation Selector-14" short "VS14"] + tcl::dict::set charinfo 65038 [list desc "Variation Selector-15 text variation" short "VS15"] ;#still an image - just more suitable for text-presentation e.g word-processing doc + tcl::dict::set charinfo 65039 [list desc "Variation Selector-16 emoji variation" short "VS16"] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # emoticons https://www.unicode.org/charts/PDF/U1F600.pdf - dict set charsets "Emoticons" [list ranges [list {start 128512 end 128591}] description "Emoticons" settype "tcl_supplemented"] - dict set charinfo 128512 [list desc "Grinning Face" short "emoticon_gface"] - dict set charinfo 128513 [list desc "Grinning Face with Smiling Eyes" short "emoticon_gface_smile_eyes"] - dict set charinfo 128514 [list desc "Face with Tears of Joy" short "emoticon_face_tears_joy"] + tcl::dict::set charsets "Emoticons" [list ranges [list {start 128512 end 128591}] description "Emoticons" settype "tcl_supplemented"] + tcl::dict::set charinfo 128512 [list desc "Grinning Face" short "emoticon_gface"] + tcl::dict::set charinfo 128513 [list desc "Grinning Face with Smiling Eyes" short "emoticon_gface_smile_eyes"] + tcl::dict::set charinfo 128514 [list desc "Face with Tears of Joy" short "emoticon_face_tears_joy"] #todo - dict set charinfo 128590 [list desc "Person with Pouting Face" short "emoticon_person_pout"] + tcl::dict::set charinfo 128590 [list desc "Person with Pouting Face" short "emoticon_person_pout"] # -- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - dict set charsets "Box Drawing" [list ranges [list {start 9472 end 9599}] description "Box Drawing" settype "tcl_supplemented"] - dict set charinfo 9472 [list desc "Box Drawings Light Horizontal" short "boxd_lhz"] - dict set charinfo 9473 [list desc "Box Drawings Heavy Horizontal" short "boxd_hhz"] - dict set charinfo 9474 [list desc "Box Drawings Light Vertical" short "boxd_lv"] - dict set charinfo 9475 [list desc "Box Drawings Heavy Vertical" short "boxd_hv"] - dict set charinfo 9476 [list desc "Box Drawings Light Triple Dash Horizontal" short "boxd_ltdshhz"] - dict set charinfo 9477 [list desc "Box Drawings Heavy Triple Dash Horizontal" short "boxd_htdshhz"] - dict set charinfo 9478 [list desc "Box Drawings Light Triple Dash Vertical" short "boxd_ltdshv"] - dict set charinfo 9479 [list desc "Box Drawings Heavy Triple Dash Vertical" short "boxd_htdshv"] - dict set charinfo 9480 [list desc "Box Drawings Light Quadruple Dash Horizontal" short "boxd_lqdshhz"] - dict set charinfo 9481 [list desc "Box Drawings Heavy Quadruple Dash Horizontal" short "boxd_hqdshhz"] - dict set charinfo 9482 [list desc "Box Drawings Light Quadruple Dash Vertical" short "boxd_lqdshv"] - dict set charinfo 9483 [list desc "Box Drawings Heavy Quadruple Dash Vertical" short "boxd_hqdshv"] - dict set charinfo 9484 [list desc "Box Drawings Light Down and Right" short "boxd_ldr"] - dict set charinfo 9485 [list desc "Box Drawings Down Light and Right Heavy" short "boxd_dlrh"] - dict set charinfo 9486 [list desc "Box Drawings Down Heavy and Right Light" short "boxd_dhrl"] - dict set charinfo 9487 [list desc "Box Drawings Heavy Down and Right" short "boxd_hdr"] - dict set charinfo 9488 [list desc "Box Drawings Light Down and Left" short "boxd_ldl"] - dict set charinfo 9489 [list desc "Box Drawings Down Light and Left Heavy" short "boxd_dllh"] - dict set charinfo 9490 [list desc "Box Drawings Down Heavy and Left Light" short "boxd_dhll"] - dict set charinfo 9491 [list desc "Box Drawings Heavy Down and Left" short "boxd_hdl"] - dict set charinfo 9492 [list desc "Box Drawings Light Up and Right" short "boxd_lur"] - dict set charinfo 9493 [list desc "Box Drawings Up Light and Right Heavy" short "boxd_ulrh"] - dict set charinfo 9494 [list desc "Box Drawings Up Heavy and Right Light" short "boxd_uhrl"] - dict set charinfo 9495 [list desc "Box Drawings Heavy Up and Right" short "boxd_hur"] - dict set charinfo 9496 [list desc "Box Drawings Light Up and Left" short "boxd_lul"] - dict set charinfo 9497 [list desc "Box Drawings Up Light and Left Heavy" short "boxd_ullh"] - dict set charinfo 9498 [list desc "Box Drawings Up Heavy and Left Light" short "boxd_uhll"] - dict set charinfo 9499 [list desc "Box Drawings Heavy Up and Left" short "boxd_hul"] - dict set charinfo 9500 [list desc "Box Drawings Light Vertical and Right" short "boxd_lvr"] - dict set charinfo 9501 [list desc "Box Drawings Vertical Light and Right Heavy" short "boxd_vlrh"] - dict set charinfo 9502 [list desc "Box Drawings Up Heavy and Right Down Light" short "boxd_uhrdl"] - dict set charinfo 9503 [list desc "Box Drawings Down Heavy and Right Up Light" short "boxd_dhrul"] - dict set charinfo 9504 [list desc "Box Drawings Vertical Heavy and Right Light" short "boxd_vhrl"] - dict set charinfo 9505 [list desc "Box Drawings Down Light and Right Up Heavy" short "boxd_dlruh"] - dict set charinfo 9506 [list desc "Box Drawings Up Light and Right Down Heavy" short "boxd_ulrdh"] - dict set charinfo 9507 [list desc "Box Drawings Heavy Vertical and Right" short "boxd_hvr"] - dict set charinfo 9508 [list desc "Box Drawings Light Vertical and Left" short "boxd_lvl"] - dict set charinfo 9509 [list desc "Box Drawings Vertical Light and Left Heavy" short "boxd_vllh"] - dict set charinfo 9510 [list desc "Box Drawings Up Heavy and Let Down Light" short "boxd_uhldl"] - dict set charinfo 9511 [list desc "Box Drawings Down Heavy and Left Up Light" short "boxd_dhlul"] - dict set charinfo 9512 [list desc "Box Drawings Vertical Heavy and Left Light" short "boxd_vhll"] - dict set charinfo 9513 [list desc "Box Drawings Down Light and left Up Heavy" short "boxd_dlluh"] - dict set charinfo 9514 [list desc "Box Drawings Up Light and Left Down Heavy" short "boxd_ulldh"] - dict set charinfo 9515 [list desc "Box Drawings Heavy Vertical and Left" short "boxd_hvl"] - dict set charinfo 9516 [list desc "Box Drawings Light Down and Horizontal" short "boxd_ldhz"] - dict set charinfo 9517 [list desc "Box Drawings Left Heavy and Right Down Light" short "boxd_lhrdl"] - dict set charinfo 9518 [list desc "Box Drawings Right Heavy and Left Down Light" short "boxd_rhldl"] - dict set charinfo 9519 [list desc "Box Drawings Down Light and Horizontal Heavy" short "boxd_dlhzh"] - dict set charinfo 9520 [list desc "Box Drawings Down Heavy and Horizontal Light" short "boxd_dhhzl"] - dict set charinfo 9521 [list desc "Box Drawings Right Light and Left Down Heavy" short "boxd_rlldh"] - dict set charinfo 9522 [list desc "Box Drawings Left Light and Right Down Heavy" short "boxd_llrdh"] - dict set charinfo 9523 [list desc "Box Drawings Heavy Down and Horizontal" short "boxd_hdhz"] - dict set charinfo 9524 [list desc "Box Drawings Light Up and Horizontal" short "boxd_luhz"] - dict set charinfo 9525 [list desc "Box Drawings Left Heavy and Right Up Light" short "boxd_lhrul"] - dict set charinfo 9526 [list desc "Box Drawings Right Heavy and Left Up Light" short "boxd_rhlul"] - dict set charinfo 9527 [list desc "Box Drawings Up Light and Horizontal Heavy" short "boxd_ulhzh"] - dict set charinfo 9528 [list desc "Box Drawings Up Heavy and Horizontal Light" short "boxd_uhhzl"] - dict set charinfo 9529 [list desc "Box Drawings Right Light and Left Up Heavy" short "boxd_rlluh"] - dict set charinfo 9530 [list desc "Box Drawings Left Light and Right Up Heavy" short "boxd_llruh"] - dict set charinfo 9531 [list desc "Box Drawings Heavy Up and Horizontal" short "boxd_huhz"] - dict set charinfo 9532 [list desc "Box Drawings Light Vertical and Horizontal" short "boxd_lvhz"] - dict set charinfo 9533 [list desc "Box Drawings Left Heavy and Right Vertical Light" short "boxd_lhrvl"] - dict set charinfo 9534 [list desc "Box Drawings Right Heavy and Left Vertical Light" short "boxd_rhlvl"] - dict set charinfo 9535 [list desc "Box Drawings Vertical Light and Horizontal Heavy" short "boxd_vlhzh"] - dict set charinfo 9536 [list desc "Box Drawings Up Heavy and Down Horizontal Light" short "boxd_uhdhzl"] - dict set charinfo 9537 [list desc "Box Drawings Down Heavy and Up Horizontal Light" short "boxd_dhuhzl"] - dict set charinfo 9538 [list desc "Box Drawings Vertical Heavy and Horizontal Light" short "boxd_vhhzl"] - dict set charinfo 9539 [list desc "Box Drawings Left Up Heavy and Right Down Light" short "boxd_luhrdl"] - dict set charinfo 9540 [list desc "Box Drawings Right Up Heavy and Left Down Light" short "boxd_ruhldl"] - dict set charinfo 9541 [list desc "Box Drawings Left Down Heavy and Right Up Light" short "boxd_ldhrul"] - dict set charinfo 9542 [list desc "Box Drawings Right Down Heavy and Left Up Light" short "boxd_rdhlul"] - dict set charinfo 9543 [list desc "Box Drawings Down Light and Up Horizontal Heavy" short "boxd_dluhzh"] - dict set charinfo 9544 [list desc "Box Drawings Up Light and Down Horizontal Heavy" short "boxd_dldhzh"] - dict set charinfo 9545 [list desc "Box Drawings Right Light and Left Vertical Heavy" short "boxd_rllvh"] - dict set charinfo 9546 [list desc "Box Drawings Left Light and Right Vertical Heavy" short "boxd_llrvh"] - dict set charinfo 9547 [list desc "Box Drawings Heavy Vertical and Horizontal" short "boxd_hvhz"] - dict set charinfo 9548 [list desc "Box Drawings Light Double Dash Horizontal" short "boxd_lddshhz"] - dict set charinfo 9549 [list desc "Box Drawings Heavy Double Dash Horizontal" short "boxd_hddshhz"] - dict set charinfo 9550 [list desc "Box Drawings Light Double Dash Vertical" short "boxd_lddshv"] - dict set charinfo 9551 [list desc "Box Drawings Heavy Double Dash Vertical" short "boxd_hddshv"] - dict set charinfo 9552 [list desc "Box Drawings Double Horizontal" short "boxd_dhz"] - dict set charinfo 9553 [list desc "Box Drawings Double Vertical" short "boxd_dv"] - dict set charinfo 9554 [list desc "Box Drawings Down Single and Right Double" short "boxd_dsrd"] - dict set charinfo 9555 [list desc "Box Drawings Down Double and Right Single" short "boxd_ddrs"] - dict set charinfo 9556 [list desc "Box Drawings Double Down and Right" short "boxd_ddr"] - dict set charinfo 9557 [list desc "Box Drawings Down Single and Left Double" short "boxd_dsld"] - dict set charinfo 9558 [list desc "Box Drawings Down Double and Left Single" short "boxd_ddls"] - dict set charinfo 9559 [list desc "Box Drawings Double Down and Left" short "boxd_ddl"] - dict set charinfo 9560 [list desc "Box Drawings Up Single and Right Double" short "boxd_usrd"] - dict set charinfo 9561 [list desc "Box Drawings Up Double and Right Single" short "boxd_udrs"] - dict set charinfo 9562 [list desc "Box Drawings Double Up and Right" short "boxd_dur"] - dict set charinfo 9563 [list desc "Box Drawings Up Single and Left Double" short "boxd_usld"] - dict set charinfo 9564 [list desc "Box Drawings Up Double and Left Single" short "boxd_udls"] - dict set charinfo 9565 [list desc "Box Drawings Double Up and Left" short "boxd_dul"] - dict set charinfo 9566 [list desc "Box Drawings Vertical Single and Right Double" short "boxd_vsrd"] - dict set charinfo 9567 [list desc "Box Drawings Vertical Double and Right Single" short "boxd_vdrs"] - dict set charinfo 9568 [list desc "Box Drawings Double Vertical and Right" short "boxd_dvr"] - dict set charinfo 9569 [list desc "Box Drawings Vertical Single and Left Double" short "boxd_vsld"] - dict set charinfo 9570 [list desc "Box Drawings Vertical Double and Left Single" short "boxd_vdls"] - dict set charinfo 9571 [list desc "Box Drawings Double Vertical and Left" short "boxd_dvl"] - dict set charinfo 9572 [list desc "Box Drawings Down Single and Horizontal Double" short "boxd_dshzd"] - dict set charinfo 9573 [list desc "Box Drawings Down Double and Horizontal Single" short "boxd_ddhzs"] - dict set charinfo 9574 [list desc "Box Drawings Double Down and Horizontal" short "boxd_ddhz"] - dict set charinfo 9575 [list desc "Box Drawings Up Single and Horizontal Double" short "boxd_ushzd"] - dict set charinfo 9576 [list desc "Box Drawings Up Double and Horizontal Single" short "boxd_udhzs"] - dict set charinfo 9577 [list desc "Box Drawings Double Up and Horizontal" short "boxd_duhz"] - dict set charinfo 9578 [list desc "Box Drawings Vertical Single and Horizontal Double" short "boxd_vshzd"] - dict set charinfo 9579 [list desc "Box Drawings Vertical Double and Horizontal Single" short "boxd_vdhzs"] - dict set charinfo 9580 [list desc "Box Drawings Double Vertical and Horizontal" short "boxd_dvhz"] - dict set charinfo 9581 [list desc "Box Drawings Light Arc Down and Right" short "boxd_ladr"] - dict set charinfo 9582 [list desc "Box Drawings Light Arc Down and Left" short "boxd_ladl"] - dict set charinfo 9583 [list desc "Box Drawings Light Arc Up and Left" short "boxd_laul"] - dict set charinfo 9584 [list desc "Box Drawings Light Arc Up and Right" short "boxd_laur"] - dict set charinfo 9585 [list desc "Box Drawings Light Diagonal Upper Right To Lower Left" short "boxd_ldgurll"] - dict set charinfo 9586 [list desc "Box Drawings Light Diagonal Upper Left To Lower Right" short "boxd_ldgullr"] - dict set charinfo 9587 [list desc "Box Drawings Light Diagonal Cross" short "boxd_ldc"] - dict set charinfo 9588 [list desc "Box Drawings Light Left" short "boxd_ll"] - dict set charinfo 9589 [list desc "Box Drawings Light Up" short "boxd_lu"] - dict set charinfo 9590 [list desc "Box Drawings Light Right" short "boxd_lr"] - dict set charinfo 9591 [list desc "Box Drawings Light Down" short "boxd_ld"] - dict set charinfo 9592 [list desc "Box Drawings Heavy Left" short "boxd_hl"] - dict set charinfo 9593 [list desc "Box Drawings Heavy Up" short "boxd_hu"] - dict set charinfo 9594 [list desc "Box Drawings Heavy Right" short "boxd_hr"] - dict set charinfo 9595 [list desc "Box Drawings Heavy Down" short "boxd_hd"] - dict set charinfo 9596 [list desc "Box Drawings Light Left and Heavy Right" short "boxd_llhr"] - dict set charinfo 9597 [list desc "Box Drawings Light Up and Heavy Down" short "boxd_luhd"] - dict set charinfo 9598 [list desc "Box Drawings Heavy Left and Light Right" short "boxd_hllr"] - dict set charinfo 9599 [list desc "Box Drawings Heavy Up and Light Down" short "boxd_huld"] - - - dict set charsets "Halfwidth and Fullwidth Forms" [list ranges [list {start 65280 end 65519}] description "Halfwidth and Fullwidth Forms (variants)" settype "tcl_supplemental"] - dict set charsets "ascii_fullwidth" [list ranges [list {start 65281 end 65374}] description "Ascii 21 to 7E fullwidth" parentblock "halfwidth_and_fullwidth_forms" settype "other"] - - dict set charsets "Specials" [list ranges [list {start 65520 end 65535}] description "Specials" settype "tcl_supplemental"] - - dict set charsets "noncharacters" [list ranges [list\ + tcl::dict::set charsets "Box Drawing" [list ranges [list {start 9472 end 9599}] description "Box Drawing" settype "tcl_supplemented"] + tcl::dict::set charinfo 9472 [list desc "Box Drawings Light Horizontal" short "boxd_lhz"] + tcl::dict::set charinfo 9473 [list desc "Box Drawings Heavy Horizontal" short "boxd_hhz"] + tcl::dict::set charinfo 9474 [list desc "Box Drawings Light Vertical" short "boxd_lv"] + tcl::dict::set charinfo 9475 [list desc "Box Drawings Heavy Vertical" short "boxd_hv"] + tcl::dict::set charinfo 9476 [list desc "Box Drawings Light Triple Dash Horizontal" short "boxd_ltdshhz"] + tcl::dict::set charinfo 9477 [list desc "Box Drawings Heavy Triple Dash Horizontal" short "boxd_htdshhz"] + tcl::dict::set charinfo 9478 [list desc "Box Drawings Light Triple Dash Vertical" short "boxd_ltdshv"] + tcl::dict::set charinfo 9479 [list desc "Box Drawings Heavy Triple Dash Vertical" short "boxd_htdshv"] + tcl::dict::set charinfo 9480 [list desc "Box Drawings Light Quadruple Dash Horizontal" short "boxd_lqdshhz"] + tcl::dict::set charinfo 9481 [list desc "Box Drawings Heavy Quadruple Dash Horizontal" short "boxd_hqdshhz"] + tcl::dict::set charinfo 9482 [list desc "Box Drawings Light Quadruple Dash Vertical" short "boxd_lqdshv"] + tcl::dict::set charinfo 9483 [list desc "Box Drawings Heavy Quadruple Dash Vertical" short "boxd_hqdshv"] + tcl::dict::set charinfo 9484 [list desc "Box Drawings Light Down and Right" short "boxd_ldr"] + tcl::dict::set charinfo 9485 [list desc "Box Drawings Down Light and Right Heavy" short "boxd_dlrh"] + tcl::dict::set charinfo 9486 [list desc "Box Drawings Down Heavy and Right Light" short "boxd_dhrl"] + tcl::dict::set charinfo 9487 [list desc "Box Drawings Heavy Down and Right" short "boxd_hdr"] + tcl::dict::set charinfo 9488 [list desc "Box Drawings Light Down and Left" short "boxd_ldl"] + tcl::dict::set charinfo 9489 [list desc "Box Drawings Down Light and Left Heavy" short "boxd_dllh"] + tcl::dict::set charinfo 9490 [list desc "Box Drawings Down Heavy and Left Light" short "boxd_dhll"] + tcl::dict::set charinfo 9491 [list desc "Box Drawings Heavy Down and Left" short "boxd_hdl"] + tcl::dict::set charinfo 9492 [list desc "Box Drawings Light Up and Right" short "boxd_lur"] + tcl::dict::set charinfo 9493 [list desc "Box Drawings Up Light and Right Heavy" short "boxd_ulrh"] + tcl::dict::set charinfo 9494 [list desc "Box Drawings Up Heavy and Right Light" short "boxd_uhrl"] + tcl::dict::set charinfo 9495 [list desc "Box Drawings Heavy Up and Right" short "boxd_hur"] + tcl::dict::set charinfo 9496 [list desc "Box Drawings Light Up and Left" short "boxd_lul"] + tcl::dict::set charinfo 9497 [list desc "Box Drawings Up Light and Left Heavy" short "boxd_ullh"] + tcl::dict::set charinfo 9498 [list desc "Box Drawings Up Heavy and Left Light" short "boxd_uhll"] + tcl::dict::set charinfo 9499 [list desc "Box Drawings Heavy Up and Left" short "boxd_hul"] + tcl::dict::set charinfo 9500 [list desc "Box Drawings Light Vertical and Right" short "boxd_lvr"] + tcl::dict::set charinfo 9501 [list desc "Box Drawings Vertical Light and Right Heavy" short "boxd_vlrh"] + tcl::dict::set charinfo 9502 [list desc "Box Drawings Up Heavy and Right Down Light" short "boxd_uhrdl"] + tcl::dict::set charinfo 9503 [list desc "Box Drawings Down Heavy and Right Up Light" short "boxd_dhrul"] + tcl::dict::set charinfo 9504 [list desc "Box Drawings Vertical Heavy and Right Light" short "boxd_vhrl"] + tcl::dict::set charinfo 9505 [list desc "Box Drawings Down Light and Right Up Heavy" short "boxd_dlruh"] + tcl::dict::set charinfo 9506 [list desc "Box Drawings Up Light and Right Down Heavy" short "boxd_ulrdh"] + tcl::dict::set charinfo 9507 [list desc "Box Drawings Heavy Vertical and Right" short "boxd_hvr"] + tcl::dict::set charinfo 9508 [list desc "Box Drawings Light Vertical and Left" short "boxd_lvl"] + tcl::dict::set charinfo 9509 [list desc "Box Drawings Vertical Light and Left Heavy" short "boxd_vllh"] + tcl::dict::set charinfo 9510 [list desc "Box Drawings Up Heavy and Let Down Light" short "boxd_uhldl"] + tcl::dict::set charinfo 9511 [list desc "Box Drawings Down Heavy and Left Up Light" short "boxd_dhlul"] + tcl::dict::set charinfo 9512 [list desc "Box Drawings Vertical Heavy and Left Light" short "boxd_vhll"] + tcl::dict::set charinfo 9513 [list desc "Box Drawings Down Light and left Up Heavy" short "boxd_dlluh"] + tcl::dict::set charinfo 9514 [list desc "Box Drawings Up Light and Left Down Heavy" short "boxd_ulldh"] + tcl::dict::set charinfo 9515 [list desc "Box Drawings Heavy Vertical and Left" short "boxd_hvl"] + tcl::dict::set charinfo 9516 [list desc "Box Drawings Light Down and Horizontal" short "boxd_ldhz"] + tcl::dict::set charinfo 9517 [list desc "Box Drawings Left Heavy and Right Down Light" short "boxd_lhrdl"] + tcl::dict::set charinfo 9518 [list desc "Box Drawings Right Heavy and Left Down Light" short "boxd_rhldl"] + tcl::dict::set charinfo 9519 [list desc "Box Drawings Down Light and Horizontal Heavy" short "boxd_dlhzh"] + tcl::dict::set charinfo 9520 [list desc "Box Drawings Down Heavy and Horizontal Light" short "boxd_dhhzl"] + tcl::dict::set charinfo 9521 [list desc "Box Drawings Right Light and Left Down Heavy" short "boxd_rlldh"] + tcl::dict::set charinfo 9522 [list desc "Box Drawings Left Light and Right Down Heavy" short "boxd_llrdh"] + tcl::dict::set charinfo 9523 [list desc "Box Drawings Heavy Down and Horizontal" short "boxd_hdhz"] + tcl::dict::set charinfo 9524 [list desc "Box Drawings Light Up and Horizontal" short "boxd_luhz"] + tcl::dict::set charinfo 9525 [list desc "Box Drawings Left Heavy and Right Up Light" short "boxd_lhrul"] + tcl::dict::set charinfo 9526 [list desc "Box Drawings Right Heavy and Left Up Light" short "boxd_rhlul"] + tcl::dict::set charinfo 9527 [list desc "Box Drawings Up Light and Horizontal Heavy" short "boxd_ulhzh"] + tcl::dict::set charinfo 9528 [list desc "Box Drawings Up Heavy and Horizontal Light" short "boxd_uhhzl"] + tcl::dict::set charinfo 9529 [list desc "Box Drawings Right Light and Left Up Heavy" short "boxd_rlluh"] + tcl::dict::set charinfo 9530 [list desc "Box Drawings Left Light and Right Up Heavy" short "boxd_llruh"] + tcl::dict::set charinfo 9531 [list desc "Box Drawings Heavy Up and Horizontal" short "boxd_huhz"] + tcl::dict::set charinfo 9532 [list desc "Box Drawings Light Vertical and Horizontal" short "boxd_lvhz"] + tcl::dict::set charinfo 9533 [list desc "Box Drawings Left Heavy and Right Vertical Light" short "boxd_lhrvl"] + tcl::dict::set charinfo 9534 [list desc "Box Drawings Right Heavy and Left Vertical Light" short "boxd_rhlvl"] + tcl::dict::set charinfo 9535 [list desc "Box Drawings Vertical Light and Horizontal Heavy" short "boxd_vlhzh"] + tcl::dict::set charinfo 9536 [list desc "Box Drawings Up Heavy and Down Horizontal Light" short "boxd_uhdhzl"] + tcl::dict::set charinfo 9537 [list desc "Box Drawings Down Heavy and Up Horizontal Light" short "boxd_dhuhzl"] + tcl::dict::set charinfo 9538 [list desc "Box Drawings Vertical Heavy and Horizontal Light" short "boxd_vhhzl"] + tcl::dict::set charinfo 9539 [list desc "Box Drawings Left Up Heavy and Right Down Light" short "boxd_luhrdl"] + tcl::dict::set charinfo 9540 [list desc "Box Drawings Right Up Heavy and Left Down Light" short "boxd_ruhldl"] + tcl::dict::set charinfo 9541 [list desc "Box Drawings Left Down Heavy and Right Up Light" short "boxd_ldhrul"] + tcl::dict::set charinfo 9542 [list desc "Box Drawings Right Down Heavy and Left Up Light" short "boxd_rdhlul"] + tcl::dict::set charinfo 9543 [list desc "Box Drawings Down Light and Up Horizontal Heavy" short "boxd_dluhzh"] + tcl::dict::set charinfo 9544 [list desc "Box Drawings Up Light and Down Horizontal Heavy" short "boxd_dldhzh"] + tcl::dict::set charinfo 9545 [list desc "Box Drawings Right Light and Left Vertical Heavy" short "boxd_rllvh"] + tcl::dict::set charinfo 9546 [list desc "Box Drawings Left Light and Right Vertical Heavy" short "boxd_llrvh"] + tcl::dict::set charinfo 9547 [list desc "Box Drawings Heavy Vertical and Horizontal" short "boxd_hvhz"] + tcl::dict::set charinfo 9548 [list desc "Box Drawings Light Double Dash Horizontal" short "boxd_lddshhz"] + tcl::dict::set charinfo 9549 [list desc "Box Drawings Heavy Double Dash Horizontal" short "boxd_hddshhz"] + tcl::dict::set charinfo 9550 [list desc "Box Drawings Light Double Dash Vertical" short "boxd_lddshv"] + tcl::dict::set charinfo 9551 [list desc "Box Drawings Heavy Double Dash Vertical" short "boxd_hddshv"] + tcl::dict::set charinfo 9552 [list desc "Box Drawings Double Horizontal" short "boxd_dhz"] + tcl::dict::set charinfo 9553 [list desc "Box Drawings Double Vertical" short "boxd_dv"] + tcl::dict::set charinfo 9554 [list desc "Box Drawings Down Single and Right Double" short "boxd_dsrd"] + tcl::dict::set charinfo 9555 [list desc "Box Drawings Down Double and Right Single" short "boxd_ddrs"] + tcl::dict::set charinfo 9556 [list desc "Box Drawings Double Down and Right" short "boxd_ddr"] + tcl::dict::set charinfo 9557 [list desc "Box Drawings Down Single and Left Double" short "boxd_dsld"] + tcl::dict::set charinfo 9558 [list desc "Box Drawings Down Double and Left Single" short "boxd_ddls"] + tcl::dict::set charinfo 9559 [list desc "Box Drawings Double Down and Left" short "boxd_ddl"] + tcl::dict::set charinfo 9560 [list desc "Box Drawings Up Single and Right Double" short "boxd_usrd"] + tcl::dict::set charinfo 9561 [list desc "Box Drawings Up Double and Right Single" short "boxd_udrs"] + tcl::dict::set charinfo 9562 [list desc "Box Drawings Double Up and Right" short "boxd_dur"] + tcl::dict::set charinfo 9563 [list desc "Box Drawings Up Single and Left Double" short "boxd_usld"] + tcl::dict::set charinfo 9564 [list desc "Box Drawings Up Double and Left Single" short "boxd_udls"] + tcl::dict::set charinfo 9565 [list desc "Box Drawings Double Up and Left" short "boxd_dul"] + tcl::dict::set charinfo 9566 [list desc "Box Drawings Vertical Single and Right Double" short "boxd_vsrd"] + tcl::dict::set charinfo 9567 [list desc "Box Drawings Vertical Double and Right Single" short "boxd_vdrs"] + tcl::dict::set charinfo 9568 [list desc "Box Drawings Double Vertical and Right" short "boxd_dvr"] + tcl::dict::set charinfo 9569 [list desc "Box Drawings Vertical Single and Left Double" short "boxd_vsld"] + tcl::dict::set charinfo 9570 [list desc "Box Drawings Vertical Double and Left Single" short "boxd_vdls"] + tcl::dict::set charinfo 9571 [list desc "Box Drawings Double Vertical and Left" short "boxd_dvl"] + tcl::dict::set charinfo 9572 [list desc "Box Drawings Down Single and Horizontal Double" short "boxd_dshzd"] + tcl::dict::set charinfo 9573 [list desc "Box Drawings Down Double and Horizontal Single" short "boxd_ddhzs"] + tcl::dict::set charinfo 9574 [list desc "Box Drawings Double Down and Horizontal" short "boxd_ddhz"] + tcl::dict::set charinfo 9575 [list desc "Box Drawings Up Single and Horizontal Double" short "boxd_ushzd"] + tcl::dict::set charinfo 9576 [list desc "Box Drawings Up Double and Horizontal Single" short "boxd_udhzs"] + tcl::dict::set charinfo 9577 [list desc "Box Drawings Double Up and Horizontal" short "boxd_duhz"] + tcl::dict::set charinfo 9578 [list desc "Box Drawings Vertical Single and Horizontal Double" short "boxd_vshzd"] + tcl::dict::set charinfo 9579 [list desc "Box Drawings Vertical Double and Horizontal Single" short "boxd_vdhzs"] + tcl::dict::set charinfo 9580 [list desc "Box Drawings Double Vertical and Horizontal" short "boxd_dvhz"] + tcl::dict::set charinfo 9581 [list desc "Box Drawings Light Arc Down and Right" short "boxd_ladr"] + tcl::dict::set charinfo 9582 [list desc "Box Drawings Light Arc Down and Left" short "boxd_ladl"] + tcl::dict::set charinfo 9583 [list desc "Box Drawings Light Arc Up and Left" short "boxd_laul"] + tcl::dict::set charinfo 9584 [list desc "Box Drawings Light Arc Up and Right" short "boxd_laur"] + tcl::dict::set charinfo 9585 [list desc "Box Drawings Light Diagonal Upper Right To Lower Left" short "boxd_ldgurll"] + tcl::dict::set charinfo 9586 [list desc "Box Drawings Light Diagonal Upper Left To Lower Right" short "boxd_ldgullr"] + tcl::dict::set charinfo 9587 [list desc "Box Drawings Light Diagonal Cross" short "boxd_ldc"] + tcl::dict::set charinfo 9588 [list desc "Box Drawings Light Left" short "boxd_ll"] + tcl::dict::set charinfo 9589 [list desc "Box Drawings Light Up" short "boxd_lu"] + tcl::dict::set charinfo 9590 [list desc "Box Drawings Light Right" short "boxd_lr"] + tcl::dict::set charinfo 9591 [list desc "Box Drawings Light Down" short "boxd_ld"] + tcl::dict::set charinfo 9592 [list desc "Box Drawings Heavy Left" short "boxd_hl"] + tcl::dict::set charinfo 9593 [list desc "Box Drawings Heavy Up" short "boxd_hu"] + tcl::dict::set charinfo 9594 [list desc "Box Drawings Heavy Right" short "boxd_hr"] + tcl::dict::set charinfo 9595 [list desc "Box Drawings Heavy Down" short "boxd_hd"] + tcl::dict::set charinfo 9596 [list desc "Box Drawings Light Left and Heavy Right" short "boxd_llhr"] + tcl::dict::set charinfo 9597 [list desc "Box Drawings Light Up and Heavy Down" short "boxd_luhd"] + tcl::dict::set charinfo 9598 [list desc "Box Drawings Heavy Left and Light Right" short "boxd_hllr"] + tcl::dict::set charinfo 9599 [list desc "Box Drawings Heavy Up and Light Down" short "boxd_huld"] + + + tcl::dict::set charsets "Halfwidth and Fullwidth Forms" [list ranges [list {start 65280 end 65519}] description "Halfwidth and Fullwidth Forms (variants)" settype "tcl_supplemental"] + tcl::dict::set charsets "ascii_fullwidth" [list ranges [list {start 65281 end 65374}] description "Ascii 21 to 7E fullwidth" parentblock "halfwidth_and_fullwidth_forms" settype "other"] + + tcl::dict::set charsets "Specials" [list ranges [list {start 65520 end 65535}] description "Specials" settype "tcl_supplemental"] + + tcl::dict::set charsets "noncharacters" [list ranges [list\ {start 64976 end 65007 note "BMP FDD0..FDEF"}\ {start 65534 end 65535 note "BMP FFFE,FFFF"}\ {start 131070 end 131071 note "plane1 1FFFE,1FFFF"}\ @@ -888,18 +888,18 @@ namespace eval punk::char { variable charshort proc _build_charshort {} { variable charshort - set charshort [dict create] + set charshort [tcl::dict::create] variable charinfo - dict for {k v} $charinfo { - if {[dict exists $v short]} { - set sh [dict get $v short] - if {[dict exists $charshort $sh]} { + tcl::dict::for {k v} $charinfo { + if {[tcl::dict::exists $v short]} { + set sh [tcl::dict::get $v short] + if {[tcl::dict::exists $charshort $sh]} { puts stderr "_build_charshort WARNING character data load duplicate shortcode '$sh'" } - dict set charshort $sh [format %c $k] + tcl::dict::set charshort $sh [format %c $k] } } - return [dict size $charshort] + return [tcl::dict::size $charshort] } _build_charshort @@ -916,35 +916,35 @@ namespace eval punk::char { variable charset_extents_startpoints variable charset_extents_endpoints variable charset_extents_rangenames - set charset_extents_startpoints [dict create] - set charset_extents_endpoints [dict create] - set charset_extents_rangenames [dict create] - dict for {setname setinfo} $charsets { - set ranges [dict get $setinfo ranges] - if {[dict get $setinfo settype] eq "block"} { + set charset_extents_startpoints [tcl::dict::create] + set charset_extents_endpoints [tcl::dict::create] + set charset_extents_rangenames [tcl::dict::create] + tcl::dict::for {setname setinfo} $charsets { + set ranges [tcl::dict::get $setinfo ranges] + if {[tcl::dict::get $setinfo settype] eq "block"} { #unicode block must have a single range #we consider a char a member of the block even if unassigned/reserved (as per unicode documentation) - set start [dict get [lindex $ranges 0] start] - set end [dict get [lindex $ranges 0] end] - if {![dict exists $charset_extents_startpoints $start] || $end ni [dict get $charset_extents_startpoints $start]} { + set start [tcl::dict::get [lindex $ranges 0] start] + set end [tcl::dict::get [lindex $ranges 0] end] + if {![tcl::dict::exists $charset_extents_startpoints $start] || $end ni [tcl::dict::get $charset_extents_startpoints $start]} { #assertion if end wasn't in startpoits list - then start won't be in endpoints list - dict lappend charset_extents_startpoints $start $end - dict lappend charset_extents_endpoints $end $start + tcl::dict::lappend charset_extents_startpoints $start $end + tcl::dict::lappend charset_extents_endpoints $end $start } - dict lappend charset_extents_rangenames ${start},${end} [list $setname 1] + tcl::dict::lappend charset_extents_rangenames ${start},${end} [list $setname 1] } else { #multirange sets/scripts. have holes. Char not a member if it's not explicitly in a defined range. #They should be in order within a set - but we don't assume so set r 1 foreach range $ranges { - set start [dict get $range start] - set end [dict get $range end] - if {![dict exists $charset_extents_startpoints $start] || $end ni [dict get $charset_extents_startpoints $start]} { + set start [tcl::dict::get $range start] + set end [tcl::dict::get $range end] + if {![tcl::dict::exists $charset_extents_startpoints $start] || $end ni [tcl::dict::get $charset_extents_startpoints $start]} { #assertion if end wasn't in startpoits list - then start won't be in endpoints list - dict lappend charset_extents_startpoints $start $end - dict lappend charset_extents_endpoints $end $start + tcl::dict::lappend charset_extents_startpoints $start $end + tcl::dict::lappend charset_extents_endpoints $end $start } - dict lappend charset_extents_rangenames ${start},${end} [list $setname $r] + tcl::dict::lappend charset_extents_rangenames ${start},${end} [list $setname $r] incr r } } @@ -954,7 +954,7 @@ namespace eval punk::char { set charset_extents_startpoints [lsort -stride 2 -integer $charset_extents_startpoints] set charset_extents_endpoints [lsort -stride 2 -integer $charset_extents_endpoints] #no need to sort charset_extents_rangenames - lookup only done using dict methods - return [dict size $charset_extents_startpoints] + return [tcl::dict::size $charset_extents_startpoints] } _build_charset_extents ;#rebuilds for all charsets @@ -982,11 +982,11 @@ namespace eval punk::char { if {[file exists $fname]} { #puts stderr "load_nerdfonts loading $fname" set data [fileutil::cat -translation binary $fname] - set short_seen [dict create] - set current_set_range [dict create] + set short_seen [tcl::dict::create] + set current_set_range [tcl::dict::create] set filesets_loading [list] foreach ln [split $data \n] { - set ln [string trim $ln] + set ln [tcl::string::trim $ln] if {$ln eq ""} {continue} set desc [lassign $ln hex rawsetname] set hexnum 0x$hex @@ -994,36 +994,36 @@ namespace eval punk::char { set setname "nf_$rawsetname" ;#Ensure nerdfont set names are prefixed. if {$setname ni $filesets_loading} { - if {![dict exists $charsets $setname]} { + if {![tcl::dict::exists $charsets $setname]} { #set exists - but not in our filesets_loading list - therefore this set has been previously loaded, so clear old data first dict unset charset $setname } set newrange [list start $dec end $dec] - dict set current_set_range $setname $newrange - dict set charsets $setname [list ranges [list $newrange] description "nerd fonts $rawsetname" settype "nerdfonts privateuse"] + tcl::dict::set current_set_range $setname $newrange + tcl::dict::set charsets $setname [list ranges [list $newrange] description "nerd fonts $rawsetname" settype "nerdfonts privateuse"] lappend filesets_loading $setname } #expects ordered glyph list - set existing_range [dict get $current_set_range $setname] - set existing_end [dict get $existing_range end] + set existing_range [tcl::dict::get $current_set_range $setname] + set existing_end [tcl::dict::get $existing_range end] if {$dec - $existing_end == 1} { #part of current range - dict set current_set_range $setname end $dec + tcl::dict::set current_set_range $setname end $dec #overwrite last ranges element - set rangelist [lrange [dict get $charsets $setname ranges] 0 end-1] - lappend rangelist [dict get $current_set_range $setname] - dict set charsets $setname ranges $rangelist + set rangelist [lrange [tcl::dict::get $charsets $setname ranges] 0 end-1] + lappend rangelist [tcl::dict::get $current_set_range $setname] + tcl::dict::set charsets $setname ranges $rangelist } else { #new range for set - dict set current_set_range $setname start $dec - dict set current_set_range $setname end $dec - set rangelist [dict get $charsets $setname ranges] - lappend rangelist [dict get $current_set_range $setname] - dict set charsets $setname ranges $rangelist + tcl::dict::set current_set_range $setname start $dec + tcl::dict::set current_set_range $setname end $dec + set rangelist [tcl::dict::get $charsets $setname ranges] + lappend rangelist [tcl::dict::get $current_set_range $setname] + tcl::dict::set charsets $setname ranges $rangelist } - if {![dict exists $charinfo $dec]} { + if {![tcl::dict::exists $charinfo $dec]} { # -- --- #review set map [list beaufort bf gibbous gb crescent cr thunderstorm tstorm thermometer thermom] @@ -1042,16 +1042,16 @@ namespace eval punk::char { } set joined_desc [join $normdesc _] #map after join so we can normalize some underscored elements e.g creativecommons & creative_commons - set mapped_desc [string map $map $joined_desc] + set mapped_desc [tcl::string::map $map $joined_desc] set s nf_${rawsetname}_$mapped_desc - if {![dict exists $short_seen $s]} { - dict set short_seen $s {} + if {![tcl::dict::exists $short_seen $s]} { + tcl::dict::set short_seen $s {} } else { #duplicate in the data file (e.g 2023 weather night alt rain mix) set s ${s}_$hex } - dict set charinfo $dec [list desc "$desc" short $s] + tcl::dict::set charinfo $dec [list desc "$desc" short $s] } } _build_charshort @@ -1070,7 +1070,7 @@ namespace eval punk::char { set pkg_base [file dirname $tmfile] return $pkg_base } - namespace eval internal { + tcl::namespace::eval internal { proc unicode_folder {} { set parent [file join [punk::char::package_base] char] set candidates [glob -nocomplain -type d -dir $parent -tail unicode*] @@ -1086,8 +1086,8 @@ namespace eval punk::char { error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} } set keys [lrange $args 0 end-1] - if {[dict exists $dictValue {*}$keys]} { - return [dict get $dictValue {*}$keys] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] } else { return [lindex $args end] } @@ -1097,7 +1097,7 @@ namespace eval punk::char { #charsets structure - #dict set charsets "halfwidth_and_fullwidth_forms" [list ranges [list {start 65280 end 65519}] description "Halfwidth and Fullwidth Forms (variants) settype block"] + #tcl::dict::set charsets "halfwidth_and_fullwidth_forms" [list ranges [list {start 65280 end 65519}] description "Halfwidth and Fullwidth Forms (variants) settype block"] #unicode Blocks.txt #load the defined blocks into 'charsets' and mark as type 'block'. Unicode blocks have only one range - and don't overlap. @@ -1119,20 +1119,20 @@ namespace eval punk::char { close $fd set block_count 0 foreach ln [split $data \n] { - set ln [string trim $ln] - if {[string match #* $ln]} { + set ln [tcl::string::trim $ln] + if {[tcl::string::match #* $ln]} { continue } - if {[set pcolon [string first ";" $ln]] > 0} { - set lhs [string trim [string range $ln 0 $pcolon-1]] - set name [string trim [string range $ln $pcolon+1 end]] + if {[set pcolon [tcl::string::first ";" $ln]] > 0} { + set lhs [tcl::string::trim [tcl::string::range $ln 0 $pcolon-1]] + set name [tcl::string::trim [tcl::string::range $ln $pcolon+1 end]] set lhsparts [split $lhs .] set start [lindex $lhsparts 0] set end [lindex $lhsparts end] #puts "$start -> $end '$name'" set decimal_start [expr {"0x$start"}] set decimal_end [expr {"0x$end"}] - dict set charsets $name [list ranges [list [list start $decimal_start end $decimal_end note "unicode block $lhs"]] description "" settype block] + tcl::dict::set charsets $name [list ranges [list [list start $decimal_start end $decimal_end note "unicode block $lhs"]] description "" settype block] incr block_count } } @@ -1169,7 +1169,7 @@ namespace eval punk::char { proc charshort {shortname} { variable charshort - return [dict get $charshort $shortname] + return [tcl::dict::get $charshort $shortname] } proc box_drawing {args} { @@ -1180,8 +1180,8 @@ namespace eval punk::char { } proc char_info_hex {hex args} { - set hex [string map [list _ ""] $hex] - if {[string is xdigit -strict $hex]} { + set hex [tcl::string::map [list _ ""] $hex] + if {[tcl::string::is xdigit -strict $hex]} { #has no leading 0x set dec [expr {"0x$hex"}] } else { @@ -1193,19 +1193,19 @@ namespace eval punk::char { #Note - on some versions of Tcl -e.g 8.6 use could supply something like \U1f600 (smiley icon) but we receive fffd (replacement special) #there is no way to detect what the user intended ie we can't distinguish if they actually typed \UFFFD #we can test if such mapping happens in general - and warn if codepoint is FFFD in the result dict - set returninfo [dict create] - if {[string equal \UFFFD $char] && [string equal \U1F600 \UFFFD]} { - dict set returninfo WARNING "this tcl maps multiple to FFFD" + set returninfo [tcl::dict::create] + if {[tcl::string::equal \UFFFD $char] && [tcl::string::equal \U1F600 \UFFFD]} { + tcl::dict::set returninfo WARNING "this tcl maps multiple to FFFD" } lassign [scan $char %c%s] dec_char remainder - if {[string length $remainder]} { + if {[tcl::string::length $remainder]} { error "char_info requires a single character" } - set result [dict merge $returninfo [char_info_dec $dec_char {*}$args]] + set result [tcl::dict::merge $returninfo [char_info_dec $dec_char {*}$args]] } proc char_info_dec {dec args} { set dec_char [expr {$dec}] - set opts [dict create\ + set opts [tcl::dict::create\ -fields {default}\ -except {}\ ] @@ -1217,16 +1217,16 @@ namespace eval punk::char { foreach {k v} $args { switch -- $k { -fields - -except { - dict set opts $k $v + tcl::dict::set opts $k $v } default { - error "char_info unrecognised option '$k'. Known options:'[dict keys $opts]' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" + error "char_info unrecognised option '$k'. Known options:'[tcl::dict::keys $opts]' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" } } } # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_fields [dict get $opts -fields] - set opt_except [dict get $opts -except] + set opt_fields [tcl::dict::get $opts -fields] + set opt_except [tcl::dict::get $opts -except] # -- --- --- --- --- --- --- --- --- --- --- --- set initial_fields [list] if {"default" in $opt_fields} { @@ -1270,51 +1270,51 @@ namespace eval punk::char { variable charinfo variable charsets set hex_char [format %04x $dec_char] - set returninfo [dict create] + set returninfo [tcl::dict::create] foreach f $fields { switch -- $f { dec { - dict set returninfo dec $dec_char + tcl::dict::set returninfo dec $dec_char } hex { - dict set returninfo hex $hex_char + tcl::dict::set returninfo hex $hex_char } desc { - if {[dict exists $charinfo $dec_char desc]} { - dict set returninfo desc [dict get $charinfo $dec_char desc] + if {[tcl::dict::exists $charinfo $dec_char desc]} { + tcl::dict::set returninfo desc [tcl::dict::get $charinfo $dec_char desc] } else { - dict set returninfo desc "" + tcl::dict::set returninfo desc "" } } short { - if {[dict exists $charinfo $dec_char short]} { - dict set returninfo desc [dict get $charinfo $dec_char short] + if {[tcl::dict::exists $charinfo $dec_char short]} { + tcl::dict::set returninfo desc [tcl::dict::get $charinfo $dec_char short] } else { - dict set returninfo short "" + tcl::dict::set returninfo short "" } } testwidth { #todo - expectedwidth - lookup the printing width it is *supposed* to have from unicode tables #testwidth is one of the main ones likely to be worthwhile excluding as querying the console via ansi takes time set existing_testwidth "" - if {[dict exists $charinfo $dec_char testwidth]} { - set existing_testwidth [dict get $charinfo $dec_char testwidth] + if {[tcl::dict::exists $charinfo $dec_char testwidth]} { + set existing_testwidth [tcl::dict::get $charinfo $dec_char testwidth] } if {$existing_testwidth eq ""} { #no cached data - do expensive cursor-position test (Note this might not be 100% reliable - terminals lie e.g if ansi escape sequence has set to wide printing.) set char [format %c $dec_char] set chwidth [char_info_testwidth $char] - dict set returninfo testwidth $chwidth + tcl::dict::set returninfo testwidth $chwidth #cache it. todo - -verify flag to force recalc in case font/terminal changed in some way? - dict set charinfo $dec_char testwidth $chwidth + tcl::dict::set charinfo $dec_char testwidth $chwidth } else { - dict set returninfo testwidth $existing_testwidth + tcl::dict::set returninfo testwidth $existing_testwidth } } char { set char [format %c $dec_char] - dict set returninfo char $char + tcl::dict::set returninfo char $char } memberof { #memberof takes in the order of a few hundred microseconds if a simple scan of all ranges is taken - possibly worthwhile caching/optimising @@ -1323,17 +1323,17 @@ namespace eval punk::char { #We could potentially populate it using a side-thread - but it seems reasonable to just cache result after first use here. #some efficiency could also be gained by pre-calculating the extents for each charset which isn't a simple unicode block. (and perhaps sorting by max char) set memberof [list] - dict for {setname setinfo} $charsets { - foreach r [dict get $setinfo ranges] { - set s [dict get $r start] - set e [dict get $r end] + tcl::dict::for {setname setinfo} $charsets { + foreach r [tcl::dict::get $setinfo ranges] { + set s [tcl::dict::get $r start] + set e [tcl::dict::get $r end] if {$dec_char >= $s && $dec_char <= $e} { lappend memberof $setname break } } } - dict set returninfo memberof $memberof + tcl::dict::set returninfo memberof $memberof } } } @@ -1344,10 +1344,10 @@ namespace eval punk::char { proc _char_info_dec_memberof_scan {dec} { variable charsets set memberof [list] - dict for {setname setinfo} $charsets { - foreach r [dict get $setinfo ranges] { - set s [dict get $r start] - set e [dict get $r end] + tcl::dict::for {setname setinfo} $charsets { + foreach r [tcl::dict::get $setinfo ranges] { + set s [tcl::dict::get $r start] + set e [tcl::dict::get $r end] if {$dec >= $s && $dec <= $e} { lappend memberof $setname break @@ -1359,15 +1359,15 @@ namespace eval punk::char { proc range_split_info {dec} { variable charset_extents_startpoints variable charset_extents_endpoints - set skeys [dict keys $charset_extents_startpoints] - set ekeys [dict keys $charset_extents_endpoints] - set splen [dict size $charset_extents_startpoints] - set eplen [dict size $charset_extents_endpoints] + set skeys [tcl::dict::keys $charset_extents_startpoints] + set ekeys [tcl::dict::keys $charset_extents_endpoints] + set splen [tcl::dict::size $charset_extents_startpoints] + set eplen [tcl::dict::size $charset_extents_endpoints] set s [lsearch -bisect -integer $skeys $dec] set s_at_or_below [lrange $skeys 0 $s] set e_of_s [list] foreach sk $s_at_or_below { - lappend e_of_s {*}[dict get $charset_extents_startpoints $sk] + lappend e_of_s {*}[tcl::dict::get $charset_extents_startpoints $sk] } set e_of_s [lsort -integer $e_of_s] set splitposn [lsearch -bisect -integer $e_of_s $dec] @@ -1376,7 +1376,7 @@ namespace eval punk::char { set reduced_endpoints [lrange $e_of_s $splitposn end] set sps [list] foreach ep $reduced_endpoints { - lappend sps {*}[dict get $charset_extents_endpoints $ep] + lappend sps {*}[tcl::dict::get $charset_extents_endpoints $ep] } @@ -1386,14 +1386,14 @@ namespace eval punk::char { set e_at_or_above [lrange $ekeys $e end] set s_of_e [list] foreach ek $e_at_or_above { - lappend s_of_e {*}[dict get $charset_extents_endpoints $ek] + lappend s_of_e {*}[tcl::dict::get $charset_extents_endpoints $ek] } set startpoints_of_above [llength $s_of_e] set splitposn [lsearch -bisect -integer $s_of_e $dec] set reduced_startpoints [lrange $s_of_e 0 $splitposn] set eps [list] foreach sp $reduced_startpoints { - lappend eps {*}[dict get $charset_extents_startpoints $sp] + lappend eps {*}[tcl::dict::get $charset_extents_startpoints $sp] } } else { set s_of_e [list] @@ -1402,7 +1402,7 @@ namespace eval punk::char { } - return [dict create startpoints $splen endpoints $eplen midpoint [expr {floor($eplen/2)}] posn $e lhs_endpoints_to_check "[llength $reduced_endpoints]/[llength $e_of_s]=[llength $sps]ranges" rhs_startpoints_to_check "[llength $reduced_startpoints]/[llength $s_of_e]=[llength $eps]"] + return [tcl::dict::create startpoints $splen endpoints $eplen midpoint [expr {floor($eplen/2)}] posn $e lhs_endpoints_to_check "[llength $reduced_endpoints]/[llength $e_of_s]=[llength $sps]ranges" rhs_startpoints_to_check "[llength $reduced_startpoints]/[llength $s_of_e]=[llength $eps]"] } #for just a few extra sets such as wgl4 and unicode blocks loaded - this gives e.g 5x + better performance than the simple search above, and up to twice as slow for tcl 8.6 #performance biased towards lower numbered characters (which is not too bad in the context of unicode) @@ -1419,17 +1419,17 @@ namespace eval punk::char { #algorithm should theoretically be a little better with -stride set last_smaller_or_equal_startposn [lsearch -stride 2 -bisect -integer $charset_extents_startpoints $dec] set sets_starting_below [lrange $charset_extents_startpoints 0 $last_smaller_or_equal_startposn+1] ;#+1 to include 2nd element of stridden pair - set endpoints_of_starting_below [lsort -integer [concat {*}[dict values $sets_starting_below]]] + set endpoints_of_starting_below [lsort -integer [concat {*}[tcl::dict::values $sets_starting_below]]] } else { #no -stride available - set startkeys [dict keys $charset_extents_startpoints] + set startkeys [tcl::dict::keys $charset_extents_startpoints] set last_smaller_or_equal_startkeyposn [lsearch -bisect -integer $startkeys $dec] ;#assert will always return one of the keys if number >=0 supplied (last key if > all) #set startkey_found [lindex $startkeys $last_smaller_or_equal_startkeyposn] set start_below_keys [lrange $startkeys 0 $last_smaller_or_equal_startkeyposn] ;#These are the keys of sets which start at or below dec #puts "start_below_keys: '$start_below_keys'" set endpoints_of_starting_below [list] foreach belowkey $start_below_keys { - lappend endpoints_of_starting_below {*}[dict get $charset_extents_startpoints $belowkey] + lappend endpoints_of_starting_below {*}[tcl::dict::get $charset_extents_startpoints $belowkey] } set endpoints_of_starting_below [lsort -integer $endpoints_of_starting_below[unset endpoints_of_starting_below]] } @@ -1446,9 +1446,9 @@ namespace eval punk::char { #we have reduced our set of endpoints sufficiently (to those at or above dec) to run through and test each startpoint set ranges [list] foreach ep $reduced_opposite_limit { - foreach s [dict get $charset_extents_endpoints $ep] { + foreach s [tcl::dict::get $charset_extents_endpoints $ep] { if {$s <= $dec} { - lappend ranges [dict get $charset_extents_rangenames $s,$ep] + lappend ranges [tcl::dict::get $charset_extents_rangenames $s,$ep] } } } @@ -1459,7 +1459,7 @@ namespace eval punk::char { #with glob searching of description and short proc char_range_dict {start end args} { - if {![string is integer -strict $start] || ![string is integer -strict $end]} { + if {![tcl::string::is integer -strict $start] || ![tcl::string::is integer -strict $end]} { error "char_range_dict error start and end must be integers" } set and_globs [list] @@ -1474,32 +1474,32 @@ namespace eval punk::char { } } variable charinfo - set cdict [dict create] + set cdict [tcl::dict::create] set start [expr {$start}] ;#force string rep to decimal - otherwise first use of i as string could be hex or other rep whilst other i values will be decimal string rep due to incr for {set i $start} {$i <= $end} {incr i} { set hx [format %04x $i] set ch [format %c $i] - if {[dict exists $charinfo $i desc]} { - set d [dict get $charinfo $i desc] + if {[tcl::dict::exists $charinfo $i desc]} { + set d [tcl::dict::get $charinfo $i desc] } else { set d "" } - if {[dict exists $charinfo $i short]} { - set s [dict get $charinfo $i short] + if {[tcl::dict::exists $charinfo $i short]} { + set s [tcl::dict::get $charinfo $i short] } else { set s "" } set matchcount 0 foreach glob $and_globs { - if {[string match -nocase $glob $s] || [string match -nocase $glob $d]} { + if {[tcl::string::match -nocase $glob $s] || [tcl::string::match -nocase $glob $d]} { incr matchcount } } if {$matchcount == [llength $and_globs]} { - if {[dict exists $charinfo $i]} { - dict set cdict $hx [dict merge [dict create dec $i hex $hx char $ch] [dict get $charinfo $i]] + if {[tcl::dict::exists $charinfo $i]} { + tcl::dict::set cdict $hx [tcl::dict::merge [tcl::dict::create dec $i hex $hx char $ch] [tcl::dict::get $charinfo $i]] } else { - dict set cdict $hx [list dec $i hex $hx char $ch desc $d short $s] + tcl::dict::set cdict $hx [list dec $i hex $hx char $ch desc $d short $s] } } } @@ -1508,17 +1508,17 @@ namespace eval punk::char { #with glob searches of desc and short proc char_range {start end args} { package require overtype - if {![string is integer -strict $start] || ![string is integer -strict $end]} { + if {![tcl::string::is integer -strict $start] || ![tcl::string::is integer -strict $end]} { error "char_range error start and end must be integers" } set charset_dict [char_range_dict $start $end {*}$args] set out "" - set col3 [string repeat " " 12] - dict for {k inf} $charset_dict { + set col3 [tcl::string::repeat " " 12] + tcl::dict::for {k inf} $charset_dict { set s [internal::dict_getdef $inf short ""] set d [internal::dict_getdef $inf desc ""] set s_col [overtype::left $col3 $s] - append out "$k [dict get $inf dec] [dict get $inf char] $s_col $d" \n + append out "$k [tcl::dict::get $inf dec] [tcl::dict::get $inf char] $s_col $d" \n } return $out } @@ -1530,26 +1530,26 @@ namespace eval punk::char { #todo - more efficient datastructures? if {![regexp {[?*]} $name_or_glob]} { #no glob - just retrieve it - if {[dict exists $charsets $name_or_glob]} { - if {[dict get $charsets $name_or_glob settype] eq "block"} { - return [dict create $name_or_glob [dict get $charsets $name_or_glob]] + if {[tcl::dict::exists $charsets $name_or_glob]} { + if {[tcl::dict::get $charsets $name_or_glob settype] eq "block"} { + return [tcl::dict::create $name_or_glob [tcl::dict::get $charsets $name_or_glob]] } } #no exact match - try case insensitive.. - set name [lsearch -inline -nocase [dict keys $charsets] $name_or_glob] + set name [lsearch -inline -nocase [tcl::dict::keys $charsets] $name_or_glob] if {$name ne ""} { - if {[dict get $charsets $name settype] eq "block"} { - return [dict create $name [dict get $charsets $name]] + if {[tcl::dict::get $charsets $name settype] eq "block"} { + return [tcl::dict::create $name [tcl::dict::get $charsets $name]] } } } else { #build a subset - set charsets_block [dict create] - dict for {k v} $charsets { - if {[string match -nocase $name_or_glob $k]} { - if {[dict get $v settype] eq "block"} { - dict set charsets_block $k $v + set charsets_block [tcl::dict::create] + tcl::dict::for {k v} $charsets { + if {[tcl::string::match -nocase $name_or_glob $k]} { + if {[tcl::dict::get $v settype] eq "block"} { + tcl::dict::set charsets_block $k $v } } } @@ -1560,20 +1560,20 @@ namespace eval punk::char { variable charsets if {![regexp {[?*]} $name_or_glob]} { #no glob - just retrieve it - if {[dict exists $charsets $name_or_glob]} { + if {[tcl::dict::exists $charsets $name_or_glob]} { return [list $name_or_glob] } #no exact match - try case insensitive.. - set name [lsearch -inline -nocase [dict keys $charsets] $name_or_glob] + set name [lsearch -inline -nocase [tcl::dict::keys $charsets] $name_or_glob] if {$name ne ""} { return [list $name] } } else { if {$name_or_glob eq "*"} { - return [lsort [dict keys $charsets]] + return [lsort [tcl::dict::keys $charsets]] } - #dict keys $dict doesn't have option for case insensitive searches - return [lsort [lsearch -all -inline -nocase [dict keys $charsets] $name_or_glob]] + #tcl::dict::keys $dict doesn't have option for case insensitive searches + return [lsort [lsearch -all -inline -nocase [tcl::dict::keys $charsets] $name_or_glob]] } } @@ -1583,8 +1583,8 @@ namespace eval punk::char { proc charset_names2 {{namesearch *}} { variable charsets #dictionary sorting of the keys is slow! - we should obviously store it in sorted order instead of sorting entire list on retrieval - or just sort results - #set sortedkeys [lsort -increasing -dictionary [dict keys $charsets]] ;#NOTE must use -dictionary to use -sorted flag below - set sortedkeys [lsort -increasing [dict keys $charsets]] + #set sortedkeys [lsort -increasing -dictionary [tcl::dict::keys $charsets]] ;#NOTE must use -dictionary to use -sorted flag below + set sortedkeys [lsort -increasing [tcl::dict::keys $charsets]] if {$namesearch eq "*"} { return $sortedkeys } @@ -1602,7 +1602,7 @@ namespace eval punk::char { set charset_names [charset_names $namesearch] set settype_list [list] foreach setname $charset_names { - lappend settype_list [dict get $charsets $setname settype] + lappend settype_list [tcl::dict::get $charsets $setname settype] } set charset_names [linsert $charset_names 0 "Set Name"] @@ -1612,26 +1612,26 @@ namespace eval punk::char { } proc charset_defget {exactname} { variable charsets - return [dict get $charsets $exactname] + return [tcl::dict::get $charsets $exactname] } proc charset_defs {charsetname} { variable charsets set matches [charset_names $charsetname] set def_list [list] foreach setname $matches { - lappend def_list [dict create $setname [dict get $charsets $setname]] + lappend def_list [tcl::dict::create $setname [tcl::dict::get $charsets $setname]] } return [join $def_list \n] } proc charset_dictget {exactname} { variable charsets - set setinfo [dict get $charsets $exactname] - set ranges [dict get $setinfo ranges] - set charset_dict [dict create] + set setinfo [tcl::dict::get $charsets $exactname] + set ranges [tcl::dict::get $setinfo ranges] + set charset_dict [tcl::dict::create] foreach r $ranges { - set start [dict get $r start] - set end [dict get $r end] - set charset_dict [dict merge $charset_dict [char_range_dict $start $end]] + set start [tcl::dict::get $r start] + set end [tcl::dict::get $r end] + set charset_dict [tcl::dict::merge $charset_dict [char_range_dict $start $end]] } return $charset_dict } @@ -1643,7 +1643,7 @@ namespace eval punk::char { } set dict_list [list] foreach m $matches { - lappend dict_list [dict create $m [charset_dictget $m]] + lappend dict_list [tcl::dict::create $m [charset_dictget $m]] } #return $dict_list return [join $dict_list \n] @@ -1658,14 +1658,14 @@ namespace eval punk::char { if {![llength $matched_names]} { error "charset_page no charset matched pattern '$namesearch' - use 'charset_names' to get list" } - set defaults [dict create\ + set defaults [tcl::dict::create\ -ansi 0\ -lined 1\ ] - set opts [dict merge $defaults $args] + set opts [tcl::dict::merge $defaults $args] # -- --- --- --- - set opt_ansi [dict get $opts -ansi] - set opt_lined [dict get $opts -lined] + set opt_ansi [tcl::dict::get $opts -ansi] + set opt_lined [tcl::dict::get $opts -lined] # -- --- --- --- set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} @@ -1681,18 +1681,18 @@ namespace eval punk::char { append out $prefix foreach charsetname $matched_names { if {[llength $search_this_and_that]} { - set setinfo [dict get $charsets $charsetname] - set ranges [dict get $setinfo ranges] - set charset_dict [dict create] + set setinfo [tcl::dict::get $charsets $charsetname] + set ranges [tcl::dict::get $setinfo ranges] + set charset_dict [tcl::dict::create] foreach r $ranges { - set start [dict get $r start] - set end [dict get $r end] - set charset_dict [dict merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] + set start [tcl::dict::get $r start] + set end [tcl::dict::get $r end] + set charset_dict [tcl::dict::merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] } } else { set charset_dict [charset_dictget $charsetname] } - if {![dict size $charset_dict]} { + if {![tcl::dict::size $charset_dict]} { continue } set i 1 @@ -1701,12 +1701,12 @@ namespace eval punk::char { set marker_line $prefix set line $prefix - dict for {hex inf} $charset_dict { - set ch [dict get $inf char] + tcl::dict::for {hex inf} $charset_dict { + set ch [tcl::dict::get $inf char] set twidth "" set dec [expr {"0x$hex"}] - if {[dict exists $charinfo $dec testwidth]} { - set twidth [dict get $charinfo $dec testwidth] + if {[tcl::dict::exists $charinfo $dec testwidth]} { + set twidth [tcl::dict::get $charinfo $dec testwidth] } if {$twidth eq ""} { #set width [ansifreestring_width $ch] ;#based on unicode props @@ -1731,23 +1731,23 @@ namespace eval punk::char { set marker "__ " set displayv "${a1}$ch${a2} " } - set hexlen [string length $hex] - append marker_line "[string repeat " " $hexlen] $marker" + set hexlen [tcl::string::length $hex] + append marker_line "[tcl::string::repeat " " $hexlen] $marker" append line "$hex $displayv" - if {$i == [dict size $charset_dict] || $i % $cols == 0} { + if {$i == [tcl::dict::size $charset_dict] || $i % $cols == 0} { if {$opt_lined} { append out $marker_line \n } append out $line \n set marker_line $prefix set line $prefix - #set out [string range $out 0 end-2] + #set out [tcl::string::range $out 0 end-2] #append out \n " " } incr i } } - set out [string trimright $out " "] + set out [tcl::string::trimright $out " "] return $out } @@ -1765,13 +1765,13 @@ namespace eval punk::char { foreach charsetname $matched_names { if {[llength $search_this_and_that]} { - set setinfo [dict get $charsets $charsetname] - set ranges [dict get $setinfo ranges] - set charset_dict [dict create] + set setinfo [tcl::dict::get $charsets $charsetname] + set ranges [tcl::dict::get $setinfo ranges] + set charset_dict [tcl::dict::create] foreach r $ranges { - set start [dict get $r start] - set end [dict get $r end] - set charset_dict [dict merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] + set start [tcl::dict::get $r start] + set end [tcl::dict::get $r end] + set charset_dict [tcl::dict::merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] } } else { set charset_dict [charset_dictget $charsetname] @@ -1779,22 +1779,22 @@ namespace eval punk::char { set col_items_short [list] set col_items_desc [list] - dict for {k inf} $charset_dict { + tcl::dict::for {k inf} $charset_dict { lappend col_items_desc [internal::dict_getdef $inf desc ""] lappend col_items_short [internal::dict_getdef $inf short ""] } if {[llength $col_items_desc]} { - set widest3 [tcl::mathfunc::max {*}[lmap v $col_items_short {string length $v}]] + set widest3 [tcl::mathfunc::max {*}[lmap v $col_items_short {tcl::string::length $v}]] if {$widest3 == 0} { set col3 " " } else { - set col3 [string repeat " " $widest3] + set col3 [tcl::string::repeat " " $widest3] } - dict for {k inf} $charset_dict { + tcl::dict::for {k inf} $charset_dict { set s [internal::dict_getdef $inf short ""] set d [internal::dict_getdef $inf desc ""] set s_col [overtype::left $col3 $s] - append out "$k [dict get $inf char] $s_col $d" \n + append out "$k [tcl::dict::get $inf char] $s_col $d" \n } } } @@ -1812,44 +1812,44 @@ namespace eval punk::char { } set search_this_and_that $args set charcount 0 - set width_results [dict create] + set width_results [tcl::dict::create] puts stdout "calibrating using terminal cursor movements.." foreach charsetname $matched_names { if {[llength $search_this_and_that]} { - set setinfo [dict get $charsets $charsetname] - set ranges [dict get $setinfo ranges] - set charset_dict [dict create] + set setinfo [tcl::dict::get $charsets $charsetname] + set ranges [tcl::dict::get $setinfo ranges] + set charset_dict [tcl::dict::create] foreach r $ranges { - set start [dict get $r start] - set end [dict get $r end] - set charset_dict [dict merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] + set start [tcl::dict::get $r start] + set end [tcl::dict::get $r end] + set charset_dict [tcl::dict::merge $charset_dict [char_range_dict $start $end {*}$search_this_and_that]] } } else { set charset_dict [charset_dictget $charsetname] } - if {![dict size $charset_dict]} { + if {![tcl::dict::size $charset_dict]} { continue } - dict for {hex inf} $charset_dict { + tcl::dict::for {hex inf} $charset_dict { set ch [format %c 0x$hex] set twidth "" set dec [expr {"0x$hex"}] - if {[dict exists $charinfo $dec testwidth]} { - set twidth [dict get $charinfo $dec testwidth] + if {[tcl::dict::exists $charinfo $dec testwidth]} { + set twidth [tcl::dict::get $charinfo $dec testwidth] } if {$twidth eq ""} { #puts -nonewline stdout "." ;#this set width [char_info_testwidth $ch] ;#based on console test rather than unicode props - dict set charinfo $dec testwidth $width + tcl::dict::set charinfo $dec testwidth $width } else { set width $twidth } - dict incr width_results $width + tcl::dict::incr width_results $width incr charcount } } puts stdout "\ncalibration done - results cached in charinfo dictionary" - return [dict create charcount $charcount widths $width_results] + return [tcl::dict::create charcount $charcount widths $width_results] } #maint warning - also in overtype! @@ -1861,19 +1861,19 @@ namespace eval punk::char { proc grapheme_width_cached {ch {key ""}} { variable grapheme_widths #if key eq "*" - we won't be able to clear that cache individually. Perhaps that's ok - if {[dict exists $grapheme_widths $key $ch]} { - return [dict get $grapheme_widths $key $ch] + if {[tcl::dict::exists $grapheme_widths $key $ch]} { + return [tcl::dict::get $grapheme_widths $key $ch] } set width [punk::char::ansifreestring_width $ch] ;#review - can we provide faster version if we know it's a single grapheme rather than a string? (grapheme is still a string as it may have combiners/diacritics) - dict set grapheme_widths $key $ch $width + tcl::dict::set grapheme_widths $key $ch $width return $width } proc grapheme_width_cache_clear {key} { variable grapheme_widths if {$key eq "*} { - set grapheme_widths [dict create] + set grapheme_widths [tcl::dict::create] } else { - dict unset grapheme_widths $key + tcl::dict::unset grapheme_widths $key } return } @@ -1893,7 +1893,7 @@ namespace eval punk::char { if {[punk::ansi::ta::detect $text]} { puts stderr "string_width detected ANSI!" } - if {[string last \n $text] >= 0} { + if {[tcl::string::last \n $text] >= 0} { error "string_width accepts only a single line" } tailcall ansifreestring_width $text @@ -1901,7 +1901,25 @@ namespace eval punk::char { #faster than textutil::wcswidth (at least for string up to a few K in length) proc wcswidth {string} { - set codes [scan $string [string repeat %c [string length $string]]] + set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] + set width 0 + foreach c $codes { + if {$c <= 255} { + incr width + } else { + set w [textutil::wcswidth_char $c] + if {$w < 0} { + return -1 + } else { + incr width $w + } + } + } + return $width + } + #faster than textutil::wcswidth (at least for string up to a few K in length) + proc wcswidth1 {string} { + set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set width 0 foreach c $codes { set w [textutil::wcswidth_char $c] @@ -1914,7 +1932,7 @@ namespace eval punk::char { return $width } proc wcswidth2 {string} { - set codes [scan $string [string repeat %c [string length $string]]] + set codes [scan $string [tcl::string::repeat %c [tcl::string::length $string]]] set widths [lmap c $codes {textutil::wcswidth_char $c}] if {-1 in $widths} { return -1 @@ -1931,7 +1949,7 @@ namespace eval punk::char { #we can c0 control characters after or while processing ansi escapes. #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error - #if {[string first \033 $text] >= 0} { + #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first" #} @@ -1972,7 +1990,7 @@ namespace eval punk::char { #\uFFEFBOM/ ZWNBSP and others that should be zero width #todo - work out proper way to mark/group zero width. - set text [string map [list \u200b "" \u200c "" \u200d "" \uFFEF ""] $text] + set text [tcl::string::map [list \u200b "" \u200c "" \u200d "" \uFFEF ""] $text] # -- --- --- --- --- --- --- #we should only map control sequences to nothing after processing ones with length effects, such as \b (\x07f) or DEL \x1f @@ -1992,16 +2010,16 @@ namespace eval punk::char { #short-circuit basic cases #support tcl pre 2023-11 - see regexp bug below #if {![regexp {[\uFF-\U10FFFF]} $text]} { - # return [string length $text] + # return [tcl::string::length $text] #} if {![regexp "\[\uFF-\U10FFFF\]" $text]} { - return [string length $text] + return [tcl::string::length $text] } #split just to get the standalone character widths - and then scan for other combiners (?) - or scan for clusters first? #review - #set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + #set can_regex_high_unicode [tcl::string::match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] #tcl pre 2023-11 - braced high unicode regexes don't work #fixed in bug-4ed788c618 2023-11 #set uc_chars [regexp -all -inline "\[\u0100-\U10FFFF\]" $text] ;#e.g return list of chars in range only @@ -2013,7 +2031,7 @@ namespace eval punk::char { foreach {uc ascii} $uc_sequences { #puts "-ascii $ascii" #puts "-uc $uc" - incr len [string length $ascii] + incr len [tcl::string::length $ascii] #textutil::wcswidth uses unicode data #fall back to textutil::wcswidth (which doesn't for example handle diactricts/combiners so we can't use until these and other things such as \u200b and diacritics are already stripped/accounted for) #todo - find something that understands grapheme clusters - needed also for grapheme_split @@ -2035,7 +2053,7 @@ namespace eval punk::char { #we can c0 control characters after or while processing ansi escapes. #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error - #if {[string first \033 $text] >= 0} { + #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first" #} @@ -2078,10 +2096,10 @@ namespace eval punk::char { #short-circuit basic cases #support tcl pre 2023-11 - see regexp bug below #if {![regexp {[\uFF-\U10FFFF]} $text]} { - # return [string length $text] + # return [tcl::string::length $text] #} if {![regexp "\[\uFF-\U10FFFF\]" $text]} { - return [string length $text] + return [tcl::string::length $text] } #review - wcswidth should detect these @@ -2091,7 +2109,7 @@ namespace eval punk::char { set zerowidth_char_count 0 #split just to get the standalone character widths - and then scan for other combiners (?) #review - #set can_regex_high_unicode [string match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] + #set can_regex_high_unicode [tcl::string::match [regexp -all -inline {[\U80-\U0010FFFF]} \U0001F525] \U0001F525] #tcl pre 2023-11 - braced high unicode regexes don't work #fixed in bug-4ed788c618 2023-11 #set uc_sequences [regexp -all -inline -indices {[\u0100-\U10FFFF]} $text] @@ -2127,7 +2145,7 @@ namespace eval punk::char { } } #todo - work out what to do with anomalies like grave combiner which print at different lengths on different terminals (fonts?) and for which cursor-query escape sequence lies. - return [expr {[string length $text] + $doublewidth_char_count - $zerowidth_char_count}] + return [expr {[tcl::string::length $text] + $doublewidth_char_count - $zerowidth_char_count}] } #slow - textutil::wcswidth is slow with mixed ascii uc @@ -2139,7 +2157,7 @@ namespace eval punk::char { #we can c0 control characters after or while processing ansi escapes. #we need to map remaining control characters to zero-width (under assumption we're not using a font/codepage that displays them - review!) #anyway - we must allow things like raw ESC,DEL, NUL etc to pass through without error - #if {[string first \033 $text] >= 0} { + #if {[tcl::string::first \033 $text] >= 0} { # error "string_width doesn't accept ansi escape sequences. Use punk::ansi::stripansi first" #} @@ -2173,14 +2191,14 @@ namespace eval punk::char { #short-circuit basic cases #support tcl pre 2023-11 - see regexp bug below #if {![regexp {[\uFF-\U10FFFF]} $text]} { - # return [string length $text] + # return [tcl::string::length $text] #} if {![regexp "\[\uFF-\U10FFFF\]" $text]} { - return [string length $text] + return [tcl::string::length $text] } #slow when ascii mixed with unicode (but why?) - return [punk::wcswidth $text] + return [punk::char::wcswidth $text] } #This shouldn't be called on text containing ansi codes! proc strip_nonprinting_ascii {str} { @@ -2192,7 +2210,7 @@ namespace eval punk::char { \x07 ""\ \x7f ""\ ] - return [string map $map $str] + return [tcl::string::map $map $str] } @@ -2203,25 +2221,25 @@ namespace eval punk::char { # #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set graphemes [list] - if {[string length $text] == 0} { + if {[tcl::string::length $text] == 0} { return {} } set list [list] set start 0 - set strlen [string length $text] + set strlen [tcl::string::length $text] #make sure our regexes aren't non-greedy - or we may not have exit condition for loop #review while {$start < $strlen && [regexp -start $start -indices -- {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} $text match]} { lassign $match matchStart matchEnd #puts "->start $start ->match $matchStart $matchEnd" - lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart $matchEnd] set start [expr {$matchEnd+1}] - #if {$start >= [string length $text]} { + #if {$start >= [tcl::string::length $text]} { # break #} } - lappend list [string range $text $start end] + lappend list [tcl::string::range $text $start end] } #ZWJ ZWNJ ? @@ -2241,7 +2259,7 @@ namespace eval punk::char { foreach {pt combiners} [lrange $csplits 0 end-1] { set clist [split $pt ""] lappend graphemes {*}[lrange $clist 0 end-1] - lappend graphemes [string cat [lindex $clist end] $combiners] + lappend graphemes [tcl::string::cat [lindex $clist end] $combiners] } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { @@ -2253,14 +2271,14 @@ namespace eval punk::char { set graphemes [list] set csplits [combiner_split $text] foreach {pt combiners} [lrange $csplits 0 end-1] { - set pt_decs [scan $pt [string repeat %c [string length $pt]]] - set combiner_decs [scan $combiners [string repeat %c [string length $combiners]]] + set pt_decs [scan $pt [tcl::string::repeat %c [tcl::string::length $pt]]] + set combiner_decs [scan $combiners [tcl::string::repeat %c [tcl::string::length $combiners]]] lset pt_decs end [concat [lindex $pt_decs end] $combiner_decs] lappend graphemes {*}$pt_decs } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { - lappend graphemes {*}[scan [lindex $csplits end] [string repeat %c [string length [lindex $csplits end]]]] + lappend graphemes {*}[scan [lindex $csplits end] [tcl::string::repeat %c [tcl::string::length [lindex $csplits end]]]] } return $graphemes } @@ -2268,9 +2286,9 @@ namespace eval punk::char { set graphemes [list] set csplits [combiner_split $text] foreach {pt combiners} $csplits { - set pt_decs [scan $pt [string repeat %c [string length $pt]]] + set pt_decs [scan $pt [tcl::string::repeat %c [tcl::string::length $pt]]] if {$combiners ne ""} { - set combiner_decs [scan $combiners [string repeat %c [string length $combiners]]] + set combiner_decs [scan $combiners [tcl::string::repeat %c [tcl::string::length $combiners]]] lset pt_decs end [concat [lindex $pt_decs end] $combiner_decs] } lappend graphemes {*}$pt_decs @@ -2282,7 +2300,7 @@ namespace eval punk::char { set csplits [combiner_split $text] foreach {pt combiners} [lrange $csplits 0 end-1] { set clist [split $pt ""] - lappend graphemes {*}[lrange $clist 0 end-1] [string cat [lindex $clist end] $combiners] + lappend graphemes {*}[lrange $clist 0 end-1] [tcl::string::cat [lindex $clist end] $combiners] } #last csplit never has a combiner (_perlish_split style) - and may be empty - in which case we don't append it as a grapheme if {[lindex $csplits end] ne ""} { @@ -2303,12 +2321,12 @@ namespace eval punk::char { variable charinfo set dec [scan $char %c] set twidth "" - if {[dict exists $charinfo $dec testwidth]} { - set twidth [dict get $charinfo $dec testwidth] + if {[tcl::dict::exists $charinfo $dec testwidth]} { + set twidth [tcl::dict::get $charinfo $dec testwidth] } if {$twidth eq ""} { set width [char_info_testwidth $char] - dict set charinfo $dec testwidth $width + tcl::dict::set charinfo $dec testwidth $width return $width } else { return $twidth @@ -2316,7 +2334,7 @@ namespace eval punk::char { } proc char_info_is_testwidth_cached {char} { variable charinfo - return [dict exists $charinfo [scan $char %c] testwidth] + return [tcl::dict::exists $charinfo [scan $char %c] testwidth] } # -- --- --- --- --- @@ -2328,7 +2346,7 @@ namespace eval punk::char { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::char [namespace eval punk::char { +package provide punk::char [tcl::namespace::eval punk::char { variable version set version 999999.0a1.0 }] diff --git a/src/modules/punk/config-0.1.tm b/src/modules/punk/config-0.1.tm index d7562ff..bb7b237 100644 --- a/src/modules/punk/config-0.1.tm +++ b/src/modules/punk/config-0.1.tm @@ -1,10 +1,5 @@ -package provide punk::config [namespace eval punk::config { - variable version - set version 0.1 - -}] -namespace eval punk::config { +tcl::namespace::eval punk::config { variable loaded variable startup ;#include env overrides variable running @@ -33,38 +28,42 @@ namespace eval punk::config { #defaults - dict set startup configset .punkshell - dict set startup exec_unknown true ;#whether to use exec instead of experimental shellfilter::run - #dict set startup color_stdout [list cyan bold] ;#not a good idea to default - dict set startup color_stdout [list] + tcl::dict::set startup configset .punkshell + tcl::dict::set startup exec_unknown true ;#whether to use exec instead of experimental shellfilter::run + #tcl::dict::set startup color_stdout [list cyan bold] ;#not a good idea to default + tcl::dict::set startup color_stdout [list] #This wraps the stderr stream as it comes in with Ansi - probably best to default to empty.. but it's useful. - dict set startup color_stderr [list red bold] + tcl::dict::set startup color_stderr [list red bold] - dict set startup syslog_stdout "127.0.0.1:514" - dict set startup syslog_stderr "127.0.0.1:514" - dict set startup syslog_active 0 + tcl::dict::set startup syslog_stdout "127.0.0.1:514" + tcl::dict::set startup syslog_stderr "127.0.0.1:514" + tcl::dict::set startup syslog_active 0 #default file logs to logs folder at same location as exe if writable, or empty string - dict set startup logfile_stdout "" - dict set startup logfile_stderr "" - - set exename [info nameofexecutable] + tcl::dict::set startup logfile_stdout "" + tcl::dict::set startup logfile_stderr "" + set exename "" + catch { + #catch for safe interps + #safe base will return empty string, ordinary safe interp will raise error + set exename [tcl::info::nameofexecutable] + } if {$exename ne ""} { - set exefolder [file dirname [info nameofexecutable]] + set exefolder [file dirname $exename] set log_folder $exefolder/logs - dict set startup scriptlib $exefolder/scriptlib - dict set startup apps $exefolder/../../punkapps + tcl::dict::set startup scriptlib $exefolder/scriptlib + tcl::dict::set startup apps $exefolder/../../punkapps if {[file exists $log_folder]} { if {[file isdirectory $log_folder] && [file writable $log_folder]} { - dict set startup logfile_stdout $log_folder/repl-exec-stdout.txt - dict set startup logfile_stderr $log_folder/repl-exec-stderr.txt + tcl::dict::set startup logfile_stdout $log_folder/repl-exec-stdout.txt + tcl::dict::set startup logfile_stderr $log_folder/repl-exec-stderr.txt } } } else { #probably a safe interp - which cannot access info nameofexecutable even if access given to the location via punk::island #review - todo? - dict set startup scriptlib "" - dict set startup apps "" + tcl::dict::set startup scriptlib "" + tcl::dict::set startup apps "" } @@ -95,16 +94,20 @@ namespace eval punk::config { set f [set ::env($evar)] if {$f ne "default"} { #e.g PUNK_SCRIPTLIB -> scriptlib - set varname [string tolower [string range $evar 5 end]] - dict set startup $varname $f + set varname [tcl::string::tolower [tcl::string::range $evar 5 end]] + tcl::dict::set startup $varname $f } } } unset -nocomplain evar unset -nocomplain vars - set running [dict create] - set running [dict merge $running $startup] - - + set running [tcl::dict::create] + set running [tcl::dict::merge $running $startup] } + +package provide punk::config [tcl::namespace::eval punk::config { + variable version + set version 0.1 + +}] \ No newline at end of file diff --git a/src/modules/punk/experiment-999999.0a1.0.tm b/src/modules/punk/experiment-999999.0a1.0.tm new file mode 100644 index 0000000..70492f9 --- /dev/null +++ b/src/modules/punk/experiment-999999.0a1.0.tm @@ -0,0 +1,501 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2024 +# +# @@ Meta Begin +# Application punk::experiment 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::experiment 0 999999.0a1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::experiment] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::experiment +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::experiment +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::experiment::class { + #*** !doctools + #[subsection {Namespace punk::experiment::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::experiment { + namespace export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #*** !doctools + #[subsection {Namespace punk::experiment}] + #[para] Core API functions for punk::experiment + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + variable o_opts_table [dict create\ + ] + variable o_opts_table_defaults [dict create\ + -test 1\ + -test2 etc\ + -test3 333\ + -test4 444\ + ] + set topt_keys [dict keys $o_opts_table_defaults] + set topt_switchkeys [list -test - -test2 - -test3 - -test4] + + proc configure args [string map [list %topt_keys% $topt_keys %topt_switchkeys% $topt_switchkeys] { + variable o_opts_table + variable o_opts_table_defaults + if {![llength $args]} { + return $o_opts_table + } + if {[llength $args] == 1} { + if {[lindex $args 0] in [list %topt_keys%]} { + #query single option + set k [lindex $args 0] + set val [dict get $o_opts_table $k] + set returndict [dict create option $k value $val ansireset "\x1b\[m"] + set infodict [dict create] + switch -- $k { + -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder_body - -ansiborder_footer { + dict set infodict debug [ansistring VIEW $val] + } + -framemap_body - -framemap_header - -framelimits_body - -framelimits_header { + dict set returndict effective [dict get $o_opts_table_effective $k] + } + } + dict set returndict info $infodict + return $returndict + #return [dict create option $k value $val ansireset "\x1b\[m" info $infodict] + } else { + error "textblock::table configure - unrecognised option '[lindex $args 0]'. Known values [dict keys $o_opts_table_defaults]" + } + } + if {[llength $args] %2 != 0} { + error "[namespace current]::table configure - unexpected argument count. Require name value pairs" + } + foreach {k v} $args { + switch -- $k { + %topt_switchkeys% {} + default { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } + } + #if {$k ni [dict keys $o_opts_table_defaults]} { + # error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + #} + } + set checked_opts [list] + foreach {k v} $args { + switch -- $k { + -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder-body - -ansiborder_footer { + set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" + set ansi_codes [list] ; + foreach {pt code} $parts { + if {$pt ne ""} { + #we don't expect plaintext in an ansibase + error "Unable to interpret $k value as ansi SGR codes. Plaintext detected. Consider using for example: '\[punk::ansi::a+ green]' (or alias '\[a+ green]') to build ansi. debug view: [punk::ansi::ansistring VIEW $v]" + } + if {$code ne ""} { + lappend ansi_codes $code + } + } + set ansival [punk::ansi::codetype::sgr_merge_singles $ansi_codes] + lappend checked_opts $k $ansival + } + -frametype - -frametype_header - -frametype_body { + #frametype will raise an error if v is not a valid custom dict or one of the known predefined types such as light,heavy,double etc + lassign [textblock::frametype $v] _cat category _type ftype + lappend checked_opts $k $v + } + -framemap_body - -framemap_header { + #upvar ::textblock::class::opts_table_defaults tdefaults + #set default_bmap [dict get $tdefaults -framemap_body] + #todo - check keys and map + if {[llength $v] == 1} { + if {$v eq "default"} { + upvar ::textblock::class::opts_table_defaults tdefaults + set default_map [dict get $tdefaults $k] + lappend checked_opts $k $default_map + } else { + error "textblock::table::configure invalid $k value $v. Expected the value 'default' or a dict e.g topleft {hl *}" + } + } else { + foreach {subk subv} $v { + switch -- $subk { + topleft - topinner - topright - topsolo - middleleft - middleinner - middleright - middlesolo - bottomleft - bottominner - bottomright - bottomsolo - onlyleft - onlyinner - onlyright - onlysolo {} + default { + error "textblock::table::configure invalid $subk. Known values {topleft topinner topright topsolo middleleft middleinner middleright middlesolo bottomleft bottominner bottomright bottomsolo onlyleft onlyinner onlyright onlysolo}" + } + } + dict for {seg subst} $subv { + switch -- $seg { + hl - hlt - hlb - vl - vll - vlr - trc - tlc - blc - brc {} + default { + error "textblock::table::configure invalid $subk value $seg. Known values {hl hlt hlb vl vll vlr trc tlc blc brc}" + } + } + } + + } + lappend checked_opts $k $v + } + + } + -framelimits_body - -framelimits_header { + set specific_framelimits [list] + foreach fl $v { + switch -- $fl { + "default" { + lappend specific_framelimits trc hlt tlc vll blc hlb brc vlr + } + hl { + lappend specific_framelimits hlt hlb + } + vl { + lappend specific_framelimits vll vlr + } + hlt - hlb - vll - vlr - trc - tlc - blc - brc { + lappend specific_framelimits $fl + } + default { + error "textblock::table::configure invalid $k '$fl'. Known values {hl hlb hlt vl vll vlr trc tlc blc brc} (or default for all)" + } + } + } + lappend checked_opts $k $specific_framelimits + } + -ansireset { + if {$v eq "\uFFEF"} { + set RST "\x1b\[m" ;#[a] + lappend checked_opts $k $RST + } else { + error "textblock::table::configure -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" + } + } + -show_hseps { + if {![string is boolean $v]} { + error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" + } + lappend checked_opts $k $v + #these don't affect column width calculations + } + -show_edge { + if {![string is boolean $v]} { + error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" + } + lappend checked_opts $k $v + #these don't affect column width calculations - except if table -minwidth/-maxwidth come into play + set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed + } + -show_vseps { + #we allow empty string - so don't use -strict boolean check + if {![string is boolean $v]} { + error "textblock::table::configure invalid $k '$v'. Must be a boolean or empty string" + } + #affects width calculations + set o_calculated_column_widths [list] + lappend checked_opts $k $v + } + -minwidth - -maxwidth { + set o_calculated_column_widths [list] + lappend checked_opts $k $v + } + default { + lappend checked_opts $k $v + } + } + } + #all options checked - ok to update o_opts_table and o_opts_table_effective + + #set o_opts_table [dict merge $o_opts_table $checked_opts] + foreach {k v} $args { + #yes in safe + switch -- $k { + -framemap_header - -framemap_body { + #framemaps don't require setting every key to update. + #e.g configure -framemaps {topleft } + #needs to merge with existing unspecified keys such as topright middleleft etc. + if {$v eq "default"} { + dict set o_opts_table $k default + } else { + if {[dict get $o_opts_table $k] eq "default"} { + dict set o_opts_table $k $v + } else { + dict set o_opts_table $k [dict merge [dict get $o_opts_table $k] $v] + } + } + } + default { + dict set o_opts_table $k $v + } + } + } + #use values from checked_opts for the effective opts + dict for {k v} $checked_opts { + switch -- $k { + -framemap_body - -framemap_header { + set existing [dict get $o_opts_table_effective $k] + #set updated $existing + #dict for {subk subv} $v { + # dict set updated $subk $subv + #} + #dict set o_opts_table_effective $k $updated + dict set o_opts_table_effective $k [dict merge $existing $v] + } + -framelimits_body - -framelimits_header { + #my Set_effective_framelimits + dict set o_opts_table_effective $k $v + } + default { + dict set o_opts_table_effective $k $v + } + } + } + #ansireset exception + dict set o_opts_table -ansireset [dict get $o_opts_table_effective -ansireset] + return $o_opts_table + }] + + + + proc test1 {args} { + set result [list] + dict for {k v} $args { + switch -- $k { + -a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { + switch -- $k { + -a - -b - -c { + lappend result "dfor-switcharm1-switcharm1-$k" + } + default { + lappend result "dfor-switcharm1-switchdefault-$k" + } + } + } + default { + switch -- $k { + -1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { + lappend result "dfor-switchdefault-switcharm1-$k" + } + default { + lappend result "dfor-switchdefault-switchdefault-$k" + } + } + } + } + } + return $result + } + + proc test2 {args} { + set result [list] + foreach {k v} $args { + switch -- $k { + -a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { + switch -- $k { + -a - -b - -c { + lappend result "dfor-switcharm1-switcharm1-$k" + } + default { + lappend result "dfor-switcharm1-switchdefault-$k" + } + } + } + default { + switch -- $k { + -1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { + lappend result "dfor-switchdefault-switcharm1-$k" + } + default { + lappend result "dfor-switchdefault-switchdefault-$k" + } + } + } + } + } + return $result + } + + proc test3 {args} { + set result [list] + for {set i 0} {$i < [llength $args]} {incr i} { + set k [lindex $args $i] + switch -- $k { + -a - -b - -c - -d - -e - -f - -g - -h - -i - -j - -k - -l - -m - -n - -o - -p - -q - -r - -s - -t - -u - -v - -w - -x - -y - -z { + switch -- $k { + -a - -b - -c { + lappend result "dfor-switcharm1-switcharm1-$k" + } + default { + lappend result "dfor-switcharm1-switchdefault-$k" + } + } + } + default { + switch -- $k { + -1 - -2 - -3 - -4 - -5 - -6 - -7 - -8 - -9 { + lappend result "dfor-switchdefault-switcharm1-$k" + } + default { + lappend result "dfor-switchdefault-switchdefault-$k" + } + } + } + } + } + return $result + } + + oo::class create c1 { + method test1 args [info body ::punk::experiment::test1] + method test2 args [info body ::punk::experiment::test2] + method test3 args [info body ::punk::experiment::test2] + } + c1 create obj1 + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::experiment ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::experiment::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace punk::experiment::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::experiment::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval punk::experiment::system { + #*** !doctools + #[subsection {Namespace punk::experiment::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::experiment [namespace eval punk::experiment { + variable pkg punk::experiment + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/experiment-buildversion.txt b/src/modules/punk/experiment-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/punk/experiment-buildversion.txt @@ -0,0 +1,3 @@ +0.1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 004dd55..7194ccc 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -66,11 +66,11 @@ package require Tcl 8.6- # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::lib::class { +tcl::namespace::eval punk::lib::class { #*** !doctools #[subsection {Namespace punk::lib::class}] #[para] class definitions - if {[info commands [namespace current]::interface_sample1] eq ""} { + if {[info commands [tcl::namespace::current]::interface_sample1] eq ""} { #*** !doctools #[list_begin enumerated] @@ -96,46 +96,46 @@ namespace eval punk::lib::class { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::lib::ensemble { +tcl::namespace::eval punk::lib::ensemble { #wiki.tcl-lang.org/page/ensemble+extend # extend an ensemble-like routine with the routines in some namespace proc extend {routine extension} { if {![string match ::* $routine]} { - set resolved [uplevel 1 [list ::namespace which $routine]] + set resolved [uplevel 1 [list ::tcl::namespace::which $routine]] if {$resolved eq {}} { error [list {no such routine} $routine] } set routine $resolved } - set routinens [namespace qualifiers $routine] + set routinens [tcl::namespace::qualifiers $routine] if {$routinens eq {::}} { set routinens {} } - set routinetail [namespace tail $routine] + set routinetail [tcl::namespace::tail $routine] if {![string match ::* $extension]} { set extension [uplevel 1 [ - list [namespace which namespace] current]]::$extension + list [tcl::namespace::which namespace] current]]::$extension } - if {![namespace exists $extension]} { + if {![tcl::namespace::exists $extension]} { error [list {no such namespace} $extension] } - set extension [namespace eval $extension [ - list [namespace which namespace] current]] + set extension [tcl::namespace::eval $extension [ + list [tcl::namespace::which namespace] current]] - namespace eval $extension [ - list [namespace which namespace] export *] + tcl::namespace::eval $extension [ + list [tcl::namespace::which namespace] export *] while 1 { set renamed ${routinens}::${routinetail}_[info cmdcount] - if {[namespace which $renamed] eq {}} break + if {[tcl::namespace::which $renamed] eq {}} break } rename $routine $renamed - namespace eval $extension [ + tcl::namespace::eval $extension [ list namespace ensemble create -command $routine -unknown [ list apply {{renamed ensemble routine args} { list $renamed $routine @@ -147,7 +147,7 @@ namespace eval punk::lib::ensemble { } } -namespace eval punk::lib::compat { +tcl::namespace::eval punk::lib::compat { #*** !doctools #[subsection {Namespace punk::lib::compat}] #[para] compatibility functions for features that may not be available in earlier Tcl versions @@ -315,8 +315,8 @@ namespace eval punk::lib::compat { } # Bind [string insert] to [::tcl::string::insert]. - namespace ensemble configure string -map [dict replace\ - [namespace ensemble configure string -map]\ + tcl::namespace::ensemble configure string -map [tcl::dict::replace\ + [tcl::namespace::ensemble configure string -map]\ insert ::tcl::string::insert] } #*** !doctools @@ -327,7 +327,7 @@ namespace eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { - namespace export * + tcl::namespace::export * #variable xyz #*** !doctools @@ -368,29 +368,29 @@ namespace eval punk::lib { #capture - use uplevel 1 or namespace eval depending on context set capture [uplevel 1 { apply { varnames { - set capturevars [dict create] - set capturearrs [dict create] + set capturevars [tcl::dict::create] + set capturearrs [tcl::dict::create] foreach fullv $varnames { - set v [namespace tail $fullv] + set v [tcl::namespace::tail $fullv] upvar 1 $v var if {[info exists var]} { if {(![array exists var])} { - dict set capturevars $v $var + tcl::dict::set capturevars $v $var } else { - dict set capturearrs capturedarray_$v [array get var] + tcl::dict::set capturearrs capturedarray_$v [array get var] } } else { #A variable can show in the results for 'info vars' but still not 'exist'. e.g a 'variable x' declaration in the namespace where the variable has never been set } } - return [dict create vars $capturevars arrs $capturearrs] + return [tcl::dict::create vars $capturevars arrs $capturearrs] } } [info vars] } ] # -- --- --- - set cvars [dict get $capture vars] - set carrs [dict get $capture arrs] + set cvars [tcl::dict::get $capture vars] + set carrs [tcl::dict::get $capture arrs] set apply_script "" - foreach arrayalias [dict keys $carrs] { + foreach arrayalias [tcl::dict::keys $carrs] { set realname [string range $arrayalias [string first _ $arrayalias]+1 end] append apply_script [string map [list %realname% $realname %arrayalias% $arrayalias] { array set %realname% [set %arrayalias%][unset %arrayalias%] @@ -409,9 +409,9 @@ namespace eval punk::lib { foreach $varnames $list { lappend result {*}[apply\ [list\ - [concat $varnames [dict keys $cvars] [dict keys $carrs] ]\ + [concat $varnames [tcl::dict::keys $cvars] [tcl::dict::keys $carrs] ]\ $apply_script\ - ] {*}[subst $values] {*}[dict values $cvars] {*}[dict values $carrs] ] + ] {*}[subst $values] {*}[tcl::dict::values $cvars] {*}[tcl::dict::values $carrs] ] } return $result } @@ -456,8 +456,8 @@ namespace eval punk::lib { error {wrong # args: should be "dict_getdef dictValue ?key ...? key default"} } set keys [lrange $args -1 end-1] - if {[dict exists $dictValue {*}$keys]} { - return [dict get $dictValue {*}$keys] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] } else { return [lindex $args end] } @@ -566,7 +566,7 @@ namespace eval punk::lib { } else { #we still don't know the actual integer index for an index such as end-x or int-int without parsing and evaluating ourself. #we can return the value - but only in a way that won't collide with our -1 out-of-range indicator - return [dict create value [lindex $resultlist 0]] + return [tcl::dict::create value [lindex $resultlist 0]] } } @@ -661,17 +661,17 @@ namespace eval punk::lib { if {[llength $argopts]%2 !=0} { error "[namespace current]::hex2dec arguments prior to list_largeHex must be option/value pairs - received '$argopts'" } - set opts [dict create\ + set opts [tcl::dict::create\ -validate 1\ -empty_as_hex "INVALID set -empty_as_hex to a hex string e.g FF if empty values should be replaced"\ ] - set known_opts [dict keys $opts] + set known_opts [tcl::dict::keys $opts] foreach {k v} $argopts { - dict set opts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v + tcl::dict::set opts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v } # -- --- --- --- - set opt_validate [dict get $opts -validate] - set opt_empty [dict get $opts -empty_as_hex] + set opt_validate [tcl::dict::get $opts -validate] + set opt_empty [tcl::dict::get $opts -empty_as_hex] # -- --- --- --- set list_largeHex [lmap h $list_largeHex[unset list_largeHex] {string map [list _ ""] [string trim $h]}] @@ -710,21 +710,21 @@ namespace eval punk::lib { if {[llength $argopts]%2 !=0} { error "[namespace current]::dec2hex arguments prior to list_decimals must be option/value pairs - received '$argopts'" } - set defaults [dict create\ + set defaults [tcl::dict::create\ -width 1\ -case upper\ -empty_as_decimal "INVALID set -empty_as_decimal to a number if empty values should be replaced"\ ] - set known_opts [dict keys $defaults] - set fullopts [dict create] + set known_opts [tcl::dict::keys $defaults] + set fullopts [tcl::dict::create] foreach {k v} $argopts { - dict set fullopts [tcl::prefix match -message "options for [namespace current]::dec2hex. Unexpected option" $known_opts $k] $v + tcl::dict::set fullopts [tcl::prefix match -message "options for [tcl::namespace::current]::dec2hex. Unexpected option" $known_opts $k] $v } - set opts [dict merge $defaults $fullopts] + set opts [tcl::dict::merge $defaults $fullopts] # -- --- --- --- - set opt_width [dict get $opts -width] - set opt_case [dict get $opts -case] - set opt_empty [dict get $opts -empty_as_decimal] + set opt_width [tcl::dict::get $opts -width] + set opt_case [tcl::dict::get $opts -case] + set opt_empty [tcl::dict::get $opts -empty_as_decimal] # -- --- --- --- @@ -933,35 +933,35 @@ namespace eval punk::lib { proc sieve n { set primes [list] if {$n < 2} {return $primes} - set nums [dict create] + set nums [tcl::dict::create] for {set i 2} {$i <= $n} {incr i} { - dict set nums $i "" + tcl::dict::set nums $i "" } set next 2 set limit [expr {sqrt($n)}] while {$next <= $limit} { - for {set i $next} {$i <= $n} {incr i $next} {dict unset nums $i} + for {set i $next} {$i <= $n} {incr i $next} {tcl::dict::unset nums $i} lappend primes $next - dict for {next -} $nums break + tcl::dict::for {next -} $nums break } - return [concat $primes [dict keys $nums]] + return [concat $primes [tcl::dict::keys $nums]] } proc sieve2 n { set primes [list] if {$n < 2} {return $primes} - set nums [dict create] + set nums [tcl::dict::create] for {set i 2} {$i <= $n} {incr i} { - dict set nums $i "" + tcl::dict::set nums $i "" } set next 2 set limit [expr {sqrt($n)}] while {$next <= $limit} { - for {set i $next} {$i <= $n} {incr i $next} {dict unset nums $i} + for {set i $next} {$i <= $n} {incr i $next} {tcl::dict::unset nums $i} lappend primes $next #dict for {next -} $nums break set next [lindex $nums 0] } - return [concat $primes [dict keys $nums]] + return [concat $primes [tcl::dict::keys $nums]] } proc hasglobs {str} { @@ -1002,7 +1002,7 @@ namespace eval punk::lib { #[para]This function merges the two dicts whilst maintaining the key order of main followed by defaults. #1st merge (inner merge) with wrong values taking precedence - but right key-order - then (outer merge) restore values - return [dict merge [dict merge $main $defaults] $main] + return [tcl::dict::merge [tcl::dict::merge $main $defaults] $main] } proc askuser {question} { @@ -1044,7 +1044,7 @@ namespace eval punk::lib { set answer [gets stdin] } } finally { - fconfigure stdin -blocking [dict get $stdin_state -blocking] + fconfigure stdin -blocking [tcl::dict::get $stdin_state -blocking] } return $answer } @@ -1162,13 +1162,13 @@ namespace eval punk::lib { } proc list_as_lines2 {args} { #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible? - lassign [dict values [punk::args::get_dict { + lassign [tcl::dict::values [punk::args::get_dict { -joinchar -default \n *values -min 1 -max 1 } $args]] opts values puts "opts:$opts" puts "values:$values" - return [join [dict get $values 0] [dict get $opts -joinchar]] + return [join [tcl::dict::get $values 0] [tcl::dict::get $opts -joinchar]] } proc lines_as_list {args} { @@ -1189,7 +1189,7 @@ namespace eval punk::lib { } else { set opts [lrange $args 0 end-1] } - #set opts [dict merge {-block {}} $opts] + #set opts [tcl::dict::merge {-block {}} $opts] set bposn [lsearch $opts -block] if {$bposn < 0} { lappend opts -block {} @@ -1203,11 +1203,11 @@ namespace eval punk::lib { #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc #we don't have to decide what is an opt vs a value #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) - lassign [dict values [punk::args::get_dict { + lassign [tcl::dict::values [punk::args::get_dict { *opts -any 1 -block -default {} } $args]] opts valuedict - tailcall linelist {*}$opts {*}[dict values $valuedict] + tailcall linelist {*}$opts {*}[tcl::dict::values $valuedict] } # important for pipeline & match_assign @@ -1222,7 +1222,7 @@ namespace eval punk::lib { set text [string map [list \r\n \n] $text] ;#review - option? set arglist [lrange $args 0 end-1] - set opts [dict create\ + set opts [tcl::dict::create\ -block {trimhead1 trimtail1}\ -line {}\ -commandprefix ""\ @@ -1232,7 +1232,7 @@ namespace eval punk::lib { foreach {o v} $arglist { switch -- $o { -block - -line - -commandprefix - -ansiresets - -ansireplays { - dict set opts $o $v + tcl::dict::set opts $o $v } default { error "linelist: Unrecognized option '$o' usage:$usage" @@ -1240,7 +1240,7 @@ namespace eval punk::lib { } } # -- --- --- --- --- --- - set opt_block [dict get $opts -block] + set opt_block [tcl::dict::get $opts -block] if {[llength $opt_block]} { foreach bo $opt_block { switch -- $bo { @@ -1272,7 +1272,7 @@ namespace eval punk::lib { # -- --- --- --- --- --- - set opt_line [dict get $opts -line] + set opt_line [tcl::dict::get $opts -line] set tl_left 0 set tl_right 0 set tl_both 0 @@ -1299,11 +1299,11 @@ namespace eval punk::lib { set tl_both 1 } # -- --- --- --- --- --- - set opt_commandprefix [dict get $opts -commandprefix] + set opt_commandprefix [tcl::dict::get $opts -commandprefix] # -- --- --- --- --- --- - set opt_ansiresets [dict get $opts -ansiresets] + set opt_ansiresets [tcl::dict::get $opts -ansiresets] # -- --- --- --- --- --- - set opt_ansireplays [dict get $opts -ansireplays] + set opt_ansireplays [tcl::dict::get $opts -ansireplays] if {$opt_ansireplays} { if {$opt_ansiresets eq "auto"} { set opt_ansiresets 1 @@ -1604,8 +1604,29 @@ namespace eval punk::lib { } #we are interested in seeing jumpTable line and following lines up until next line starting with "Command" or bracketed number e.g (164) - proc show_jump_tables {procname} { - set data [tcl::unsupported::disassemble proc $procname] + proc show_jump_tables {args} { + #avoiding use of 'info cmdtype' as unavaliable in safe interps as at 2024-06. + if {[llength $args] == 1} { + set data [tcl::unsupported::disassemble proc [lindex $args 0]] + } elseif {[llength $args] == 2} { + #review - this looks for direct methods on the supplied object/class, and then tries to disassemble method on the supplied class or class of supplied object if it isn't a class itself. + #not sure if this handles more complex hierarchies or mixins etc. + lassign $args obj method + if {![info object isa object $obj]} { + error "show_jump_tables unable to examine '$args'. $obj is not an oo object" + } + #classes are objects too and can have direct methods + if {$method in [info object methods $obj]} { + set data [tcl::unsupported::disassemble objmethod $obj $method] + } else { + if {![info object isa class $obj]} { + set obj [info object class $obj] + } + set data [tcl::unsupported::disassemble method $obj $method] + } + } else { + error "show_jump_tables expected a procname or a class/object and method" + } set result "" set in_jt 0 foreach ln [split $data \n] { @@ -1888,7 +1909,7 @@ namespace eval punk::lib::system { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::lib [namespace eval punk::lib { +package provide punk::lib [tcl::namespace::eval punk::lib { variable pkg punk::lib variable version set version 999999.0a1.0 diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 48f0998..42f3f0a 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -994,7 +994,19 @@ namespace eval punk::ns { } #info cmdtype available in 8.7+ + #safe interps also seem to have it disabled for some reason proc cmdtype {cmd} { + if {[interp issafe]} { + if {[catch {::tcl::info::cmdtype $cmd} result]} { + if {[info commands ::cmdtype] ne ""} { + #hack - look for an alias that may have been specifically enabled to bring this back + tailcall ::cmdtype $cmd + } + return na + } else { + return $result + } + } if {[info commands ::tcl::info::cmdtype] ne ""} { tailcall info cmdtype $cmd } diff --git a/src/modules/punk/overlay-0.1.tm b/src/modules/punk/overlay-0.1.tm index eebf0e1..b11e8c5 100644 --- a/src/modules/punk/overlay-0.1.tm +++ b/src/modules/punk/overlay-0.1.tm @@ -41,41 +41,41 @@ namespace eval ::punk::overlay { #} namespace eval $routine [ - list namespace ensemble configure $routine -unknown [ - list apply {{base ensemble subcommand args} { - list ${base}::_redirected $ensemble $subcommand + ::list namespace ensemble configure $routine -unknown [ + ::list ::apply {{base ensemble subcommand args} { + ::list ${base}::_redirected $ensemble $subcommand }} $base ] ] punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util #namespace eval ${routine}::util { - #namespace import ::punk::mix::util::* + #::namespace import ::punk::mix::util::* #} punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib #namespace eval ${routine}::lib [string map [list $base] { - # namespace import ::lib::* + # ::namespace import ::lib::* #}] namespace eval ${routine}::lib [string map [list $base $routine] { - if {[namespace exists ::lib]} { - set current_paths [namespace path] + if {[::namespace exists ::lib]} { + ::set current_paths [namespace path] if {"" ni $current_paths} { - lappend current_paths + ::lappend current_paths } - namespace path $current_paths + ::namespace path $current_paths } }] namespace eval $routine { - set exportlist [list] - foreach cmd [info commands [namespace current]::*] { - set c [namespace tail $cmd] - if {![string match _* $c]} { - lappend exportlist $c + ::set exportlist [::list] + ::foreach cmd [::info commands [::namespace current]::*] { + ::set c [::namespace tail $cmd] + if {![::string match _* $c]} { + ::lappend exportlist $c } } - namespace export {*}$exportlist + ::namespace export {*}$exportlist } return $routine @@ -122,18 +122,18 @@ namespace eval ::punk::overlay { #let child namespace 'lib' resolve parent namespace and thus util::xxx namespace eval ${cmdnamespace}::lib [string map [list $cmdnamespace] { - set nspaths [namespace path] + ::set nspaths [::namespace path] if {"" ni $nspaths} { - lappend nspaths + ::lappend nspaths } - namespace path $nspaths + ::namespace path $nspaths }] set imported_commands [list] set nscaller [uplevel 1 [list namespace current]] if {[catch { #review - noclobber? - namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*] + namespace eval ${nscaller}::temp_import [list ::namespace import ${cmdnamespace}::*] foreach cmd [info commands ${nscaller}::temp_import::*] { set cmdtail [namespace tail $cmd] if {$cmdtail eq "_default"} { diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 6d0160f..ea77765 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -41,6 +41,7 @@ package require textblock + if {![info exists ::env(SHELL)]} { set ::env(SHELL) punk86 } @@ -1278,6 +1279,8 @@ proc repl::repl_handler {inputchan prompt_config} { #if it's been set to raw - assume it is deliberately done this way as the user could have alternatively called punk::mode raw or punk::console::enableVirtualTerminal #by not doing this automatically - we assume the caller has a reason. } else { + #JMN FIX! + #this returns 0 in rawmode on 8.6 after repl thread changes set rawmode [set ::punk::console::is_raw] } @@ -1332,9 +1335,10 @@ proc repl::repl_handler {inputchan prompt_config} { set cols 3 if {[string is integer -strict $rows]} { set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] - set msg "${RED}line-length Tcl windows channel bug? Hit enter to continue$RST" + set msg "${RED}fblocked $inputchan is true. (line-length Tcl windows channel bug?) Hit enter to continue$RST" set msglen [ansistring length $msg] - punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg + #punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg + puts stderr $msg } after 100 } @@ -2494,6 +2498,12 @@ namespace eval repl { #package require shellrun package require textblock + #md5 uses open so can't be directly called in a safe interp + #it will need to delegate to a call here in the main interp of the codethread using an installed alias + set md5version [package require md5] + #we also need to 'package provide md5 $md5version' in the safe interp itself so that it won't override + + #punk::configure_unknown ;#must be called because we hacked the tcl 'unknown' proc #child codethread (outside of code interp) needs to know details of the calling repl @@ -2534,6 +2544,28 @@ namespace eval repl { thread::send %replthread% [list punk::console::colour {*}$args] interp eval code [list punk::console::colour {*}$args] } + proc mode args { + thread::send %replthread% [list punk::console::mode {*}$args] + interp eval code [list ::punk::console::mode {*}$args] + } + proc cmdtype cmd { + code invokehidden tcl:info:cmdtype $cmd + } + + #punk repl tsv wrappers + proc set_repl_last_unknown args { + tsv::set repl last_unknown {*}$args + } + proc get_repl_runid args { + if {[tsv::exists repl runid]} { + return [tsv::get repl runid] + } else { + return 0 + } + } + proc md5 args { + ::md5::md5 {*}$args + } } namespace eval ::repl::interpextras { #install using safe::setLogCmd @@ -2633,6 +2665,7 @@ namespace eval repl { interp share {} [shellfilter::stack::item_tophandle stderr] code } + code alias ::md5::md5 ::repl::interphelpers::md5 code alias exit ::repl::interphelpers::quit } elseif {$safe == 2} { safe::interpCreate code -nested 1 @@ -2687,6 +2720,9 @@ namespace eval repl { #review - exit should do something slightly different # see ::safe::interpDelete code alias exit ::repl::interphelpers::quit + + code alias ::md5::md5 ::repl::interphelpers::md5 + interp eval code [list package provide md5 $md5version] } else { interp create code interp eval code { @@ -2706,8 +2742,14 @@ namespace eval repl { code alias quit ::repl::interphelpers::quit code alias editbuf ::repl::interphelpers::editbuf code alias colour ::repl::interphelpers::colour + code alias mode ::repl::interphelpers::mode #code alias after ::repl::interphelpers::do_after + code alias ::punk::set_repl_last_unknown ::repl::interphelpers::set_repl_last_unknown + code alias ::punk::get_repl_runid ::repl::interphelpers::get_repl_runid + + + code alias cmdtype ::repl::interphelpers::cmdtype #temporary debug aliases - deliberate violation of safety provided by safe interp code alias escapeeval ::repl::interphelpers::escapeeval diff --git a/src/modules/punkcheck-0.1.0.tm b/src/modules/punkcheck-0.1.0.tm index 8175ac0..fc2f950 100644 --- a/src/modules/punkcheck-0.1.0.tm +++ b/src/modules/punkcheck-0.1.0.tm @@ -1294,7 +1294,7 @@ namespace eval punkcheck { dict unset config -call-depth-internal dict unset config -max_depth dict unset config -subdirlist - dict for {k v} $config { + tcl::dict::for {k v} $config { if {$v eq "\uFFFF"} { dict unset config $k } diff --git a/src/modules/shellfilter-0.1.9.tm b/src/modules/shellfilter-0.1.9.tm index 079ce99..13981aa 100644 --- a/src/modules/shellfilter-0.1.9.tm +++ b/src/modules/shellfilter-0.1.9.tm @@ -329,11 +329,14 @@ namespace eval shellfilter::chan { } } method initialize {ch mode} { - return [list initialize finalize write] + return [list initialize finalize write flush clear] } method finalize {ch} { my destroy } + method clear {ch} { + return + } method watch {ch events} { # must be present but we ignore it because we do not # post any events @@ -341,6 +344,9 @@ namespace eval shellfilter::chan { #method read {ch count} { # return ? #} + method flush {ch} { + return "" + } method write {ch bytes} { set stringdata [encoding convertfrom $o_enc $bytes] foreach v $o_datavars { @@ -374,7 +380,7 @@ namespace eval shellfilter::chan { } } method initialize {transform_handle mode} { - return [list initialize read write finalize] + return [list initialize read drain write flush clear finalize] } method finalize {transform_handle} { ::shellfilter::log::close $o_logsource @@ -384,12 +390,21 @@ namespace eval shellfilter::chan { # must be present but we ignore it because we do not # post any events } + method clear {transform_handle} { + return + } + method drain {transform_handle} { + return "" + } method read {transform_handle bytes} { set logdata [encoding convertfrom $o_enc $bytes] #::shellfilter::log::write $o_logsource $logdata puts -nonewline $o_localchan $logdata return $bytes } + method flush {transform_handle} { + return "" + } method write {transform_handle bytes} { set logdata [encoding convertfrom $o_enc $bytes] #::shellfilter::log::write $o_logsource $logdata @@ -524,18 +539,27 @@ namespace eval shellfilter::chan { } } method initialize {transform_handle mode} { - return [list initialize read write finalize] + return [list initialize read write clear flush drain finalize] } method finalize {transform_handle} { my destroy } + method clear {transform_handle} { + return + } method watch {transform_handle events} { } + method drain {transform_handle} { + return "" + } method read {transform_handle bytes} { set instring [encoding convertfrom $o_enc $bytes] set outstring [punk::ansi::stripansi $instring] return [encoding convertto $o_enc $outstring] } + method flush {transform_handle} { + return "" + } method write {transform_handle bytes} { set instring [encoding convertfrom $o_enc $bytes] set outstring [punk::ansi::stripansi $instring] @@ -614,19 +638,33 @@ namespace eval shellfilter::chan { } } method initialize {transform_handle mode} { - return [list initialize write finalize] + return [list initialize write flush read drain clear finalize] } method finalize {transform_handle} { my destroy } method watch {transform_handle events} { } + method clear {transform_handle} { + return + } + method flush {transform_handle} { + return "" + } method write {transform_handle bytes} { set instring [encoding convertfrom $o_enc $bytes] set outstring "$o_do_colour$instring$o_do_normal" #set outstring ">>>$instring" return [encoding convertto $o_enc $outstring] } + method drain {transform_handle} { + return "" + } + method read {transform_handle bytes} { + set instring [encoding convertfrom $o_enc $bytes] + set outstring "$o_do_colour$instring$o_do_normal" + return [encoding convertto $o_enc $outstring] + } method meta_is_redirection {} { return $o_is_junction } @@ -2109,7 +2147,7 @@ namespace eval shellfilter { error "Trailing arguments after any positional arguments must be in pairs of the form -argname argvalue. Valid flags are:'$valid_flags'" } set invalid_flags [list] - dict for {k -} $args { + foreach {k -} $args { switch -- $k { -timeout - -outprefix - diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index bd6814a..0ed4fb1 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -184,13 +184,17 @@ namespace eval textblock { onlysolo [list]\ ] - + #ensembles seem to be not compiled in safe interp + #https://core.tcl-lang.org/tcl/tktview/1095bf7f75 + #as we want textblock to be usable in safe interps - use tcl::dict::for as a partial workaround + #This at least means the script argument, especially switch statements can get compiled. + #It does however affect all ensemble commands - so even 'dict get/set' etc won't be as efficient in a safe interp. #e.g $t configure -framemap_body [table_edge_map " "] proc table_edge_map {char} { variable table_edge_parts set map [list] - dict for {celltype parts} $table_edge_parts { + tcl::dict::for {celltype parts} $table_edge_parts { set tmap [list] foreach p $parts { dict set tmap $p $char @@ -202,7 +206,7 @@ namespace eval textblock { proc table_sep_map {char} { variable table_hseps set map [list] - dict for {celltype parts} $table_hseps { + tcl::dict::for {celltype parts} $table_hseps { set tmap [list] foreach p $parts { dict set tmap $p $char @@ -214,7 +218,7 @@ namespace eval textblock { proc header_edge_map {char} { variable header_edge_parts set map [list] - dict for {celltype parts} $header_edge_parts { + tcl::dict::for {celltype parts} $header_edge_parts { set tmap [list] foreach p $parts { dict set tmap $p $char @@ -522,14 +526,18 @@ namespace eval textblock { error "textblock::table::configure invalid $k value $v. Expected the value 'default' or a dict e.g topleft {hl *}" } } else { - dict for {subk subv} $v { + #safe jumptable test + #dict for {subk subv} $v {} + foreach {subk subv} $v { switch -- $subk { topleft - topinner - topright - topsolo - middleleft - middleinner - middleright - middlesolo - bottomleft - bottominner - bottomright - bottomsolo - onlyleft - onlyinner - onlyright - onlysolo {} default { error "textblock::table::configure invalid $subk. Known values {topleft topinner topright topsolo middleleft middleinner middleright middlesolo bottomleft bottominner bottomright bottomsolo onlyleft onlyinner onlyright onlysolo}" } } - dict for {seg subst} $subv { + #safe jumptable test + #dict for {seg subst} $subv {} + foreach {seg subst} $subv { switch -- $seg { hl - hlt - hlb - vl - vll - vlr - trc - tlc - blc - brc {} default { @@ -632,7 +640,10 @@ namespace eval textblock { } } #use values from checked_opts for the effective opts - dict for {k v} $checked_opts { + #safe jumptable test + #dict for {k v} $checked_opts {} + #foreach {k v} $checked_opts {} + tcl::dict::for {k v} $checked_opts { switch -- $k { -framemap_body - -framemap_header { set existing [dict get $o_opts_table_effective $k] @@ -687,7 +698,7 @@ namespace eval textblock { } $m add columns [dict size $o_columndata] $m add rows [dict size $o_rowdefs] - dict for {k v} $o_columndata { + tcl::dict::for {k v} $o_columndata { $m set column $k $v } return $m @@ -950,7 +961,7 @@ namespace eval textblock { if {$args_got_headers} { #if the headerlist length for this column has shrunk,and it was the longest - we may now have excess entries in o_headerstates set zero_heights [list] - dict for {hidx _v} $o_headerstates { + tcl::dict::for {hidx _v} $o_headerstates { #pass empty string for exclude_column so we don't exclude our own column if {[my header_height_calc $hidx ""] == 0} { lappend zero_heights $hidx @@ -974,7 +985,7 @@ namespace eval textblock { } method header_count_calc {} { set max_headers 0 - dict for {k cdef} $o_columndefs { + tcl::dict::for {k cdef} $o_columndefs { set num_headers [llength [dict get $cdef -headers]] set max_headers [expr {max($max_headers,$num_headers)}] } @@ -994,7 +1005,7 @@ namespace eval textblock { } else { set exclude_colidx [lindex [dict keys $o_columndefs] $exclude_column] } - dict for {cidx cdef} $o_columndefs { + tcl::dict::for {cidx cdef} $o_columndefs { if {$exclude_colidx == $cidx} { continue } @@ -1014,7 +1025,7 @@ namespace eval textblock { method header_colspans {} { set num_headers [my header_count_calc] set colspans_by_header [dict create] - dict for {cidx cdef} $o_columndefs { + tcl::dict::for {cidx cdef} $o_columndefs { set headerlist [dict get $cdef -headers] set colspans_for_column [dict get $cdef -header_colspans] for {set h 0} {$h < $num_headers} {incr h} { @@ -1076,7 +1087,7 @@ namespace eval textblock { set result [dict create] dict set result -colspans [dict get $colspans_by_header $hidx] set header_row_items [list] - dict for {cidx cdef} $o_columndefs { + tcl::dict::for {cidx cdef} $o_columndefs { set colheaders [dict get $cdef -headers] set relevant_header [lindex $colheaders $hidx] #The -headers element of the column def is allowed to have less elements than the total, even be empty. Number of headers is defined by the longest -header list in the set of columns @@ -1095,7 +1106,7 @@ namespace eval textblock { switch -- $k { -values { set header_row_items [list] - dict for {cidx cdef} $o_columndefs { + tcl::dict::for {cidx cdef} $o_columndefs { set colheaders [dict get $cdef -headers] set relevant_header [lindex $colheaders $hidx] #The -headers element of the column def is allowed to have less elements than the total, even be empty. Number of headers is defined by the longest -header list in the set of columns @@ -1127,14 +1138,16 @@ namespace eval textblock { if {[llength $args] %2 != 0} { error "textblock::table configure_header incorrect number of options following index_expression. Require name value pairs. Known options: [dict keys $o_opts_header_defaults]" } - dict for {k v} $args { + foreach {k v} $args { if {$k ni [dict keys $o_opts_header_defaults]} { error "[namespace current]::table configure_row unknown option '$k'. Known options: [dict keys $o_opts_header_defaults]" } } set checked_opts [list] - dict for {k v} $args { + #safe jumptable test + #dict for {k v} $args {} + foreach {k v} $args { switch -- $k { -ansibase { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -1248,8 +1261,10 @@ namespace eval textblock { } #configured opts all good - - dict for {k v} $checked_opts { + #safe jumptable test + #dict for {k v} $checked_opts {} + #foreach {k v} $checked_opts {} + tcl::dict::for {k v} $checked_opts { switch -- $k { -values { set c 0 @@ -1342,7 +1357,9 @@ namespace eval textblock { if {[llength $args] %2 !=0} { error "[namespace current]::table::add_row unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" } - dict for {k v} $args { + #safe jumptable test + #dict for {k v} $args {} + foreach {k v} $args { switch -- $k { -minheight - -maxheight - -ansibase - -ansireset {} default { @@ -1363,7 +1380,7 @@ namespace eval textblock { } } else { if {![llength $valuelist]} { - dict for {k coldef} $o_columndefs { + tcl::dict::for {k coldef} $o_columndefs { lappend valuelist [dict get $coldef -defaultvalue] } } @@ -1451,13 +1468,13 @@ namespace eval textblock { if {[llength $args] %2 != 0} { error "textblock::table configure_row incorrect number of options following index_expression. Require name value pairs. Known options: [dict keys $o_opts_row_defaults]" } - dict for {k v} $args { + foreach {k v} $args { if {$k ni [dict keys $o_opts_row_defaults]} { error "[namespace current]::table configure_row unknown option '$k'. Known options: [dict keys $o_opts_row_defaults]" } } set checked_opts [list] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -ansibase { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -1514,7 +1531,7 @@ namespace eval textblock { set o_rowdefs [dict create] set o_rowstates [dict create] #The data values are stored by column regardless of whether added row by row - dict for {cidx records} $o_columndata { + tcl::dict::for {cidx records} $o_columndata { dict set o_columndata $cidx [list] #reset only the body fields in o_columnstates dict set o_columnstates $cidx minwidthbodyseen 0 @@ -1587,7 +1604,7 @@ namespace eval textblock { -position "inner"\ -return "string"\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -position - -return { dict set opts $k $v @@ -2387,7 +2404,7 @@ namespace eval textblock { set defaults [dict create\ -usetables 1\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -usetables {} default { @@ -2403,13 +2420,13 @@ namespace eval textblock { #puts stdout "columndefs: $o_columndefs" puts stdout "columndefs:" if {!$opt_usetables} { - dict for {k v} $o_columndefs { + tcl::dict::for {k v} $o_columndefs { puts " $k $v" } } else { set t [textblock::class::table new] $t add_column -headers "Col" - dict for {col coldef} $o_columndefs { + tcl::dict::for {col coldef} $o_columndefs { foreach property [dict keys $coldef] { if {$property eq "-ansireset"} { continue @@ -2422,7 +2439,7 @@ namespace eval textblock { #build our inner tables first so we can sync widths set col_header_tables [dict create] set max_widths [dict create 0 0 1 0 2 0 3 0] ;#max inner table column widths - dict for {col coldef} $o_columndefs { + tcl::dict::for {col coldef} $o_columndefs { set row [list $col] set colheaders [dict get $coldef -headers] #inner table probably overkill here ..but just as easy @@ -2451,14 +2468,18 @@ namespace eval textblock { } } - dict for {col coldef} $o_columndefs { + #safe jumptable test + #dict for {col coldef} $o_columndefs {} + tcl::dict::for {col coldef} $o_columndefs { set row [list $col] - dict for {property val} $coldef { + #safe jumptable test + #dict for {property val} $coldef {} + tcl::dict::for {property val} $coldef { switch -- $property { -ansireset {continue} -headers { set htable [dict get $col_header_tables $col] - dict for {innercol maxw} $max_widths { + tcl::dict::for {innercol maxw} $max_widths { $htable configure_column $innercol -minwidth $maxw -blockalign left } lappend row [$htable print] @@ -2481,7 +2502,7 @@ namespace eval textblock { } puts stdout "columnstates: $o_columnstates" puts stdout "headerstates: $o_headerstates" - dict for {k coldef} $o_columndefs { + tcl::dict::for {k coldef} $o_columndefs { if {[dict exists $o_columndata $k]} { set headerlist [dict get $coldef -headers] set coldata [dict get $o_columndata $k] @@ -2732,7 +2753,7 @@ namespace eval textblock { -cached 1\ ] #-colspan is relevant to header/footer data only - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -headers - -footers - -colspan - -data - -cached { dict set opts $k $v @@ -2761,7 +2782,7 @@ namespace eval textblock { set colheaders [dict get $o_columndefs $cidx -headers] set all_colspans_by_header [my header_colspans] set hlist [list] - dict for {hrow cspans} $all_colspans_by_header { + tcl::dict::for {hrow cspans} $all_colspans_by_header { set s [lindex $cspans $cidx] #todo - map 'all' entries to a number? #we should build a version of header_colspans that does this @@ -2862,7 +2883,7 @@ namespace eval textblock { set colspace_added [dict create] set ordered_spans [dict create] - dict for {col spandata} [my spangroups] { + tcl::dict::for {col spandata} [my spangroups] { set dwidth [my column_datawidth $col -data 1 -headers 0 -footers 0 -cached 1] set minwidth [dict get $o_columndefs $col -minwidth] set maxwidth [dict get $o_columndefs $col -maxwidth] @@ -2892,8 +2913,10 @@ namespace eval textblock { } } } - - dict for {spanid spandata} $ordered_spans { + + #safe jumptable test + #dict for {spanid spandata} $ordered_spans {} + tcl::dict::for {spanid spandata} $ordered_spans { lassign [split $spanid ,] startcol hrow set memcols [dict get $spandata membercols] ;#dict with col and initial width - we ignore initial width, it's there in case we want to allocate space based on initial data width ratios set colids [dict keys $memcols] @@ -3045,7 +3068,7 @@ namespace eval textblock { set spaninfo [list] set numcols [dict size $o_columndefs] #note that 'all' can occur in positions other than column 0 - meaning all remaining - dict for {hrow rawspans} $spans_by_header { + tcl::dict::for {hrow rawspans} $spans_by_header { set thiscol_spanval [lindex $rawspans $cidx] if {$thiscol_spanval eq "all" || $thiscol_spanval > 0} { set spanstartcol $cidx ;#own column @@ -3080,7 +3103,7 @@ namespace eval textblock { set opts [dict create\ -algorithm $o_column_width_algorithm\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -algorithm { dict set opts $k $v @@ -3317,7 +3340,7 @@ namespace eval textblock { -compact 1\ -forcecolour 0\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -return - -compact - -forcecolour { dict set opts $k $v @@ -4131,7 +4154,7 @@ namespace eval textblock { #} #2 - the more useful one? - dict for {b bdict} $blockinfo { + tcl::dict::for {b bdict} $blockinfo { lappend r0 [dict get $blockinfo $b left0] [dict get $blockinfo $b right0] lappend r1 [dict get $blockinfo $b left1] [dict get $blockinfo $b right1] lappend r2 [dict get $blockinfo $b left2] [dict get $blockinfo $b right2] @@ -4145,7 +4168,7 @@ namespace eval textblock { set t [textblock::list_as_table [expr {1 + (2 * [dict size $blockinfo])}] $rows -return object] $t configure_column 0 -headers [list [dict get $opts -description] "within_ansi"] -ansibase $column_ansi set col 1 - dict for {b bdict} $blockinfo { + tcl::dict::for {b bdict} $blockinfo { if {[dict exists $bheaders $b]} { set hdr [dict get $bheaders $b] } else { @@ -5651,7 +5674,7 @@ namespace eval textblock { set termwidth 80 } - dict for {k v} $frame_cache { + tcl::dict::for {k v} $frame_cache { lassign $v _f frame _used used #set fwidth [textblock::widthtopline $frame] #review - are cached frames uniform width lines? @@ -5819,7 +5842,9 @@ namespace eval textblock { error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" } set is_boxmap_ok 1 - dict for {boxelement subst} $opt_boxmap { + #safe jumptable test + #dict for {boxelement subst} $opt_boxmap {} + tcl::dict::for {boxelement subst} $opt_boxmap { switch -- $boxelement { hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} default { @@ -6013,7 +6038,7 @@ namespace eval textblock { #puts "---> $opt_boxmap" #review - we handle double-wide in custom frames - what about for boxmaps? - dict for {boxelement sub} $opt_boxmap { + tcl::dict::for {boxelement sub} $opt_boxmap { if {$boxelement eq "vl"} { set vll $sub set vlr $sub