41 changed files with 1925 additions and 11217 deletions
File diff suppressed because it is too large
Load Diff
@ -1,963 +0,0 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# 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) Julian Noble 2003-2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application overtype 1.5.1 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin overtype_module_overtype 0 1.5.1] |
||||
#[copyright "2024"] |
||||
#[titledesc {overtype text layout - ansi aware}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {overtype text layout}] [comment {-- Description at end of page heading --}] |
||||
#[require overtype] |
||||
#[keywords module text ansi] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of overtype |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by overtype |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6 |
||||
package require textutil |
||||
package require punk::ansi ;#required to detect, split, strip and calculate lengths |
||||
package require punk::char ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package textutil] |
||||
#[item] [package punk::ansi] |
||||
#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes |
||||
#[item] [package punk::char] |
||||
#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
|
||||
#Julian Noble <julian@precisium.com.au> - 2003 |
||||
#Released under standard 'BSD license' conditions. |
||||
# |
||||
#todo - ellipsis truncation indicator for center,right |
||||
|
||||
#v1.4 2023-07 - naive ansi color handling - todo - fix string range |
||||
# - need to extract and replace ansi codes? |
||||
|
||||
namespace eval overtype { |
||||
namespace export * |
||||
variable default_ellipsis_horizontal "..." ;#fallback |
||||
variable default_ellipsis_vertical "..." |
||||
namespace eval priv { |
||||
proc _init {} { |
||||
upvar ::overtype::default_ellipsis_horizontal e_h |
||||
upvar ::overtype::default_ellipsis_vertical e_v |
||||
set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis |
||||
set e_v [format %c 0x22EE] |
||||
#The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text |
||||
#Also - unicode ellipsis has semantic meaning that other processors can interpret |
||||
#unicode does also provide a midline horizontal ellipsis 0x22EF |
||||
|
||||
#set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz - Box Drawings Light Triple Dash Horizontal |
||||
#if {![catch {package require punk::char}]} { |
||||
# set e [punk::char::charshort boxd_ltdshhz] |
||||
#} |
||||
} |
||||
} |
||||
priv::_init |
||||
} |
||||
proc overtype::about {} { |
||||
return "Simple text formatting. Author JMN. BSD-License" |
||||
} |
||||
|
||||
namespace eval overtype { |
||||
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\\] ;#note mix of 1 and 2-byte terminals |
||||
|
||||
#self-contained 2 byte ansi escape sequences - review more? |
||||
variable ansi_2byte_codes_dict |
||||
set ansi_2byte_codes_dict [dict create\ |
||||
"reset_terminal" "\u001bc"\ |
||||
"save_cursor_posn" "\u001b7"\ |
||||
"restore_cursor_posn" "\u001b8"\ |
||||
"cursor_up_one" "\u001bM"\ |
||||
"NEL - Next Line" "\u001bE"\ |
||||
"IND - Down one line" "\u001bD"\ |
||||
"HTS - Set Tab Stop" "\u001bH"\ |
||||
] |
||||
|
||||
#debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. |
||||
# "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ |
||||
} |
||||
|
||||
|
||||
#proc overtype::stripansi {text} { |
||||
# variable escape_terminals ;#dict |
||||
# variable ansi_2byte_codes_dict |
||||
# #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway |
||||
# if {[string first \033 $text] <0 && [string first \009c $text] <0} { |
||||
# #\033 same as \x1b |
||||
# return $text |
||||
# } |
||||
# |
||||
# set text [convert_g0 $text] |
||||
# |
||||
# #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. |
||||
# #line endings can theoretically occur within an ansi escape sequence (review e.g title?) |
||||
# set inputlist [split $text ""] |
||||
# set outputlist [list] |
||||
# |
||||
# set 2bytecodes [dict values $ansi_2byte_codes_dict] |
||||
# |
||||
# set in_escapesequence 0 |
||||
# #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls |
||||
# set i 0 |
||||
# foreach u $inputlist { |
||||
# set v [lindex $inputlist $i+1] |
||||
# set uv ${u}${v} |
||||
# if {$in_escapesequence eq "2b"} { |
||||
# #2nd byte - done. |
||||
# set in_escapesequence 0 |
||||
# } elseif {$in_escapesequence != 0} { |
||||
# set escseq [dict get $escape_terminals $in_escapesequence] |
||||
# if {$u in $escseq} { |
||||
# set in_escapesequence 0 |
||||
# } elseif {$uv in $escseq} { |
||||
# set in_escapseequence 2b ;#flag next byte as last in sequence |
||||
# } |
||||
# } else { |
||||
# #handle both 7-bit and 8-bit CSI and OSC |
||||
# if {[regexp {^(?:\033\[|\u009b)} $uv]} { |
||||
# set in_escapesequence CSI |
||||
# } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} { |
||||
# set in_escapesequence OSC |
||||
# } elseif {$uv in $2bytecodes} { |
||||
# #self-contained e.g terminal reset - don't pass through. |
||||
# set in_escapesequence 2b |
||||
# } else { |
||||
# lappend outputlist $u |
||||
# } |
||||
# } |
||||
# incr i |
||||
# } |
||||
# return [join $outputlist ""] |
||||
#} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
proc overtype::string_columns {text} { |
||||
if {[punk::ansi::ta::detect $text]} { |
||||
error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length" |
||||
} |
||||
return [punk::char::string_width $text] |
||||
} |
||||
|
||||
|
||||
#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r |
||||
proc overtype::left {args} { |
||||
# @c overtype starting at left (overstrike) |
||||
# @c can/should we use something like this?: 'format "%-*s" $len $overtext |
||||
variable default_ellipsis_horizontal |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] underblock overblock |
||||
set defaults [dict create\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::left unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
set overlines [split $overblock \n] |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set undertext_printlen [punk::ansi::printing_length $undertext] |
||||
set overlen [punk::ansi::printing_length $overtext] |
||||
set diff [expr {$overlen - $colwidth}] |
||||
|
||||
#review |
||||
#append overtext "\033\[0m" |
||||
|
||||
if {$diff > 0} { |
||||
#background line is narrower |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext] |
||||
if {![dict get $opts -overflow]} { |
||||
#set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc |
||||
if {[dict get $opts -ellipsis]} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#we know overtext is shorter or equal |
||||
lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
|
||||
} |
||||
|
||||
namespace eval overtype::piper { |
||||
proc overcentre {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::centre {*}$argsflags $under $over |
||||
} |
||||
proc overleft {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::left {*}$argsflags $under $over |
||||
} |
||||
} |
||||
#todo - left-right ellipsis ? |
||||
proc overtype::centre {args} { |
||||
variable default_ellipsis_horizontal |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
|
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
set defaults [dict create\ |
||||
-bias left\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
set overlines [split $overblock \n] |
||||
set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
#set olen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
#review |
||||
#append overtext "\033\[0m" |
||||
|
||||
set under_exposed [expr {$colwidth - $overblock_width}] |
||||
if {$under_exposed > 0} { |
||||
#background block is wider |
||||
if {$under_exposed % 2 == 0} { |
||||
#even left/right exposure |
||||
set left_exposed [expr {$under_exposed / 2}] |
||||
} else { |
||||
set beforehalf [expr {$under_exposed / 2}] ;#1 less than half due to integer division |
||||
if {[string tolower [dict get $opts -bias]] eq "left"} { |
||||
set left_exposed $beforehalf |
||||
} else { |
||||
#bias to the right |
||||
set left_exposed [expr {$beforehalf + 1}] |
||||
} |
||||
} |
||||
|
||||
if 0 { |
||||
set rhs [expr {$diff - $half - 1}] |
||||
set lhs [expr {$half - 1}] |
||||
set rhsoffset [expr {$rhs +1}] |
||||
set a [string range $undertext 0 $lhs] |
||||
set background [string range $undertext $lhs+1 end-$rhsoffset] |
||||
set b [renderline -transparent $opt_transparent $background $overtext] |
||||
set c [string range $undertext end-$rhs end] |
||||
lappend outputlines $a$b$c |
||||
} |
||||
lappend outputlines [renderline -start $left_exposed -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
|
||||
} else { |
||||
#overlay wider or equal |
||||
set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] $undertext $overtext] |
||||
if {$under_exposed < 0} { |
||||
#overlay is wider - trim if overflow not specified in opts |
||||
if {![dict get $opts -overflow]} { |
||||
#lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]] |
||||
#set overtext [string range $overtext 0 $colwidth-1 ] |
||||
if {[dict get $opts -ellipsis]} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} else { |
||||
#zero under_exposed - widths match |
||||
} |
||||
lappend outputlines $rendered |
||||
#lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
proc overtype::right {args} { |
||||
variable default_ellipsis_horizontal |
||||
# @d !todo - implement overflow, length checks etc |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
set defaults [dict create\ |
||||
-bias left\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsis [dict get $opts -ellipsis] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
set overlines [split $overblock \n] |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set olen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
#review |
||||
#append overtext "\033\[0m" |
||||
|
||||
set overflowlength [expr {$olen - $colwidth}] |
||||
if {$overflowlength > 0} { |
||||
#overtext wider than undertext column |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -start 0 $undertext $overtext] |
||||
if {!$opt_overflow} { |
||||
if {$opt_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#lappend outputlines [string range $undertext 0 end-$olen]$overtext |
||||
lappend outputlines [renderline -transparent $opt_transparent -start [expr {$colwidth - $olen}] $undertext $overtext] |
||||
} |
||||
} |
||||
|
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
proc overtype::transparentline {args} { |
||||
foreach {under over} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
set defaults [dict create\ |
||||
-transparent 1\ |
||||
-exposed 1 " "\ |
||||
-exposed 2 " "\ |
||||
] |
||||
set newargs [dict merge $defaults $argsflags] |
||||
tailcall overtype::renderline {*}$newargs $under $over |
||||
} |
||||
#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway. |
||||
# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense. |
||||
#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines. |
||||
# |
||||
namespace eval overtype::piper { |
||||
proc renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
foreach {over under} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::renderline {*}$argsflags $under $over |
||||
} |
||||
} |
||||
interp alias "" piper_renderline "" overtype::piper::renderline |
||||
|
||||
#-returnextra to enable returning of overflow and length |
||||
# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation? |
||||
#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements |
||||
#todo - review transparency issues with single/double width characters! |
||||
proc overtype::renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] under over |
||||
if {[string first \n $under] >=0 || [string first \n $over] >= 0} { |
||||
error "overtype::renderline not allowed to contain newlines" |
||||
} |
||||
set defaults [dict create\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-start 0\ |
||||
-returnextra 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
#exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow |
||||
|
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::renderline unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_colstart [dict get $opts -start] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
if {$opt_transparent eq "0"} { |
||||
set do_transparency 0 |
||||
} else { |
||||
set do_transparency 1 |
||||
if {$opt_transparent eq "1"} { |
||||
set opt_transparent {[\s]} |
||||
} |
||||
} |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_returnextra [dict get $opts -returnextra] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
|
||||
#----- |
||||
# |
||||
if {[string first \t $under] >= 0} { |
||||
#set under [textutil::tabify::untabify2 $under] |
||||
set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review |
||||
} |
||||
set overdata $over |
||||
if {[string first \t $over] >= 0} { |
||||
#set overdata [textutil::tabify::untabify2 $over] |
||||
set overdata [textutil::tabify::untabifyLine $over 8] |
||||
} |
||||
#------- |
||||
|
||||
#ta_detect ansi and do simpler processing? |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
set undermap [punk::ansi::ta::split_codes_single $under] |
||||
set understacks [dict create] |
||||
|
||||
set i_u -1 |
||||
set i_o 0 |
||||
set out [list] |
||||
set u_codestack [list] |
||||
set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation |
||||
set remainder [list] ;#for returnextra |
||||
foreach {pt code} $undermap { |
||||
#pt = plain text |
||||
append pt_underchars $pt |
||||
foreach ch [split $pt ""] { |
||||
set width [punk::char::string_width $ch] |
||||
incr i_u |
||||
dict set understacks $i_u $u_codestack |
||||
lappend out $ch |
||||
if {$width > 1} { |
||||
#presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?) |
||||
incr i_u |
||||
dict set understacks $i_u $u_codestack |
||||
lappend out "" |
||||
} |
||||
} |
||||
#underlay should already have been rendered and not have non-sgr codes - but let's check for and not stack them if other codes are here |
||||
if {[priv::is_sgr $code]} { |
||||
if {[priv::has_sgr_leadingreset $code]} { |
||||
set u_codestack [list $code] |
||||
} else { |
||||
lappend u_codestack $code |
||||
} |
||||
} |
||||
#consider also other codes that should be stacked..? |
||||
} |
||||
#trailing codes in effect for underlay |
||||
if {[llength $undermap]} { |
||||
dict set understacks [expr {$i_u + 1}] $u_codestack |
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
#### |
||||
#if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns. |
||||
#this will be processed as transparent - and handle doublewidth underlay characters appropriately |
||||
set startpad [string repeat " " $opt_colstart] |
||||
append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency |
||||
set overmap [punk::ansi::ta::split_codes_single $startpad] |
||||
#### |
||||
|
||||
|
||||
|
||||
set overstacks [dict create] |
||||
set o_codestack [list] |
||||
set pt_overchars "" |
||||
foreach {pt code} $overmap { |
||||
append pt_overchars $pt |
||||
foreach ch [split $pt ""] { |
||||
dict set overstacks $i_o $o_codestack |
||||
incr i_o |
||||
} |
||||
if {[priv::is_sgr $code]} { |
||||
#only stack SGR (graphics rendition) codes - not title sets, cursor moves etc |
||||
if {[priv::has_sgr_leadingreset $code]} { |
||||
#m code which has sgr reset at start - no need to replay prior sgr codes |
||||
set o_codestack [list $code] |
||||
} else { |
||||
lappend o_codestack $code |
||||
} |
||||
} |
||||
} |
||||
# -- --- --- --- --- --- --- --- |
||||
|
||||
|
||||
|
||||
|
||||
set bs [format %c 0x08] |
||||
set idx 0 ;# line index (cursor - 1) |
||||
set idx_over -1 |
||||
foreach {pt code} $overmap { |
||||
set ptchars [split $pt ""] ;#for lookahead |
||||
#emit plaintext chars first using existing SGR codes from under/over stack as appropriate |
||||
#then check if the following code is a cursor movement within the line and adjust index if so |
||||
foreach ch $ptchars { |
||||
incr idx_over |
||||
if {$ch eq "\r"} { |
||||
set idx $opt_colstart |
||||
} elseif {$ch eq "\b"} { |
||||
#review - backspace effect on double-width chars |
||||
if {$idx > $opt_colstart} { |
||||
incr idx -1 |
||||
} |
||||
} elseif {($idx < $opt_colstart)} { |
||||
incr idx |
||||
} elseif {($do_transparency && [regexp $opt_transparent $ch])} { |
||||
#pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay) |
||||
set owidth [punk::char::string_width $ch] |
||||
if {$idx > [llength $out]-1} { |
||||
lappend out " " |
||||
dict set understacks $idx [list] ;#review - use idx-1 codestack? |
||||
incr idx |
||||
} else { |
||||
set uwidth [punk::char::string_width [lindex $out $idx]] |
||||
if {[lindex $out $idx] eq ""} { |
||||
#2nd col of 2-wide char in underlay |
||||
incr idx |
||||
} elseif {$uwidth == 0} { |
||||
#e.g combining diacritic |
||||
incr idx |
||||
} elseif {$uwidth == 1} { |
||||
incr idx |
||||
if {$owidth > 1} { |
||||
incr idx |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
if {[punk::char::string_width $ch] == 1} { |
||||
#normal singlewide transparency |
||||
set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay |
||||
if {$next_pt_overchar eq ""} { |
||||
#special-case trailing transparent - no next_pt_overchar |
||||
incr idx |
||||
} else { |
||||
if {[regexp $opt_transparent $next_pt_overchar]} { |
||||
incr idx |
||||
} else { |
||||
#next overlay char is not transparent.. first-half of underlying 2wide char is exposed |
||||
priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} |
||||
} else { |
||||
#2wide transparency over 2wide in underlay |
||||
incr idx |
||||
} |
||||
} |
||||
} |
||||
} else { |
||||
#non-transparent char in overlay |
||||
set owidth [punk::char::string_width $ch] |
||||
set uwidth [punk::char::string_width [lindex $out $idx]] |
||||
if {[lindex $out $idx] eq ""} { |
||||
#2nd col of 2wide char in underlay |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} elseif {$uwidth == 0} { |
||||
#e.g combining diacritic - increment before over char REVIEW |
||||
#arguably the previous overchar should have done this - ie lookahead for combiners? |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
|
||||
} elseif {$uwidth == 1} { |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} else { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over] |
||||
#don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char |
||||
} else { |
||||
#2wide over 2wide |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} |
||||
} |
||||
} |
||||
#check following code |
||||
if {![priv::is_sgr $code]} { |
||||
|
||||
} |
||||
} |
||||
|
||||
if {$opt_overflow == 0} { |
||||
#need to truncate to the width of the original undertext |
||||
#review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok? |
||||
set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars |
||||
} |
||||
|
||||
#coalesce and replay codestacks for out char list |
||||
set outstring "" |
||||
set remstring "" ;#remainder after overflow point reached |
||||
set i 0 |
||||
set cstack [list] |
||||
set prevstack [list] |
||||
set out_rawchars ""; #for overflow counting |
||||
set output_to "outstring" ;#var in effect depending on overflow |
||||
set in_overflow 0 ;#used to stop char-width scanning once in overflow |
||||
foreach ch $out { |
||||
append out_rawchars $ch |
||||
if {$opt_overflow == 0 && !$in_overflow} { |
||||
if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] < $num_under_columns} { |
||||
} else { |
||||
#todo - check if we overflowed with a double-width char ? |
||||
#store visualwidth which may be short |
||||
set in_overflow 1 |
||||
} |
||||
} |
||||
set cstack [dict get $understacks $i] |
||||
if {$cstack ne $prevstack} { |
||||
if {[llength $prevstack]} { |
||||
append $output_to \033\[m |
||||
} |
||||
foreach code $cstack { |
||||
append $output_to $code |
||||
} |
||||
} |
||||
append $output_to $ch |
||||
set prevstack $cstack |
||||
incr i |
||||
if {$in_overflow} { |
||||
set output_to "remstring" |
||||
} |
||||
} |
||||
if {[dict size $understacks] > 0} { |
||||
append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes |
||||
} |
||||
if {[string length $remstring]} { |
||||
#puts stderr "remainder:$remstring" |
||||
} |
||||
#pdict $understacks |
||||
if {$opt_returnextra} { |
||||
return [list $outstring $visualwidth [string length $outstring] $remstring] |
||||
} else { |
||||
return $outstring |
||||
} |
||||
#return [join $out ""] |
||||
} |
||||
proc overtype::test_renderline {} { |
||||
set t \uFF5E ;#2-wide tilde |
||||
set u \uFF3F ;#2-wide underscore |
||||
set missing \uFFFD |
||||
return [list $t $u A${t}B] |
||||
} |
||||
namespace eval overtype::priv { |
||||
#todo - move to punk::ansi::codetype |
||||
proc is_sgr {code} { |
||||
#SGR (Select Graphic Rendition) - codes ending in 'm' - e.g colour/underline |
||||
#we will accept and pass through the less common colon separator (ITU Open Document Architecture) |
||||
#Terminals should generally ignore it if they don't use it |
||||
regexp {\033\[[0-9;:]*m$} $code |
||||
} |
||||
proc is_cursor_move_in_line {code} { |
||||
#review - what about CSI n : m H where row n happens to be current line? |
||||
regexp {\033\[[0-9]*(:?C|D|G)$} |
||||
} |
||||
#pure SGR reset |
||||
proc is_sgr_reset {code} { |
||||
#todo 8-bit csi |
||||
regexp {\033\[0*m$} $code |
||||
} |
||||
#whether this code has 0 (or equivalently empty) parameter (but may set others) |
||||
#if an SGR code as a reset in it - we don't need to carry forward any previous SGR codes |
||||
#it generally only makes sense for the reset to be the first entry - otherwise the code has ineffective portions |
||||
#However - detecting zero or empty parameter in other positions requires knowing all other codes that may allow zero or empty params. |
||||
#We will only look at initial parameter as this is the well-formed normal case. |
||||
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg color twice in same code |
||||
proc has_sgr_leadingreset {code} { |
||||
set params "" |
||||
regexp {\033\[(.*)m} $code _match params |
||||
set plist [split $params ";"] |
||||
if {[string trim [lindex $plist 0] 0] eq ""} { |
||||
#e.g \033\[m \033\[0\;...m \033\[0000...m |
||||
return 1 |
||||
} else { |
||||
return 0 |
||||
} |
||||
} |
||||
#has_sgr_reset - rather than support this - create an sgr normalize function that removes dead params and brings reset to front of param list |
||||
proc render_addchar {i c stack} { |
||||
upvar out o |
||||
upvar understacks ustacks |
||||
set nxt [llength $o] |
||||
if {$i < $nxt} { |
||||
lset o $i $c |
||||
} else { |
||||
lappend o $c |
||||
} |
||||
dict set ustacks $i $stack |
||||
} |
||||
|
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
if 0 { |
||||
namespace eval overtype::ta { |
||||
namespace path ::overtype |
||||
# *based* on but not identical to: |
||||
#https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm |
||||
|
||||
#handle both 7-bit and 8-bit csi |
||||
#review - does codepage affect this? e.g ebcdic has 8bit csi in different position |
||||
|
||||
#CSI |
||||
#variable re_csi_open {(?:\033\[|\u009b)[0-9;]+} ;#too specific - doesn't detect \033\[m |
||||
variable re_csi_open {(?:\033\[|\u009b])} |
||||
|
||||
#colour and style |
||||
variable re_csi_colour {(?:\033\[|\u009b)[0-9;]*m} ;#e.g \033\[31m \033\[m \033\[0m \033\[m0000m |
||||
#single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~). |
||||
variable re_csi_code {(?:\033\[|\u009b])[0-9;]*[a-zA-Z\\@^_|~`]} |
||||
|
||||
#OSC - termnate with BEL (\a \007) or ST (string terminator \033\\) |
||||
#variable re_esc_osc1 {(?:\033\]|\u009c).*\007} |
||||
#variable re_esc_osc2 {(?:\033\]|\u009c).*\033\\} |
||||
|
||||
#test - non-greedy |
||||
variable re_esc_osc1 {(?:\033\]|\u009c).*?\007} |
||||
variable re_esc_osc2 {(?:\033\]|\u009c).*?\033\\} |
||||
|
||||
variable re_ansi_detect "${re_csi_open}|${re_esc_osc1}|${re_esc_osc2}" |
||||
|
||||
#detect any ansi escapes |
||||
#review - only detect 'complete' codes - or just use the opening escapes for performance? |
||||
#proc detect {text} { |
||||
# variable re_ansi_detect |
||||
# #variable re_csi_open |
||||
# #variable re_esc_osc1 |
||||
# #variable re_esc_osc2 |
||||
# #todo - other escape sequences |
||||
# #expr {[regexp $re_csi_open $text] || [regexp $re_esc_osc1 $text] || [regexp $re_esc_osc2 $text]} |
||||
# expr {[regexp $re_ansi_detect $text]} |
||||
#} |
||||
#not in perl ta |
||||
#proc detect_csi {text} { |
||||
# variable re_csi_colour |
||||
# expr {[regexp $re_csi_colour $text]} |
||||
#} |
||||
proc strip {text} { |
||||
tailcall punk::ansi::stripansi $text |
||||
} |
||||
#note this is character length after stripping ansi codes - not the printing length |
||||
proc length {text} { |
||||
string length [punk::ansi::stripansi $text] |
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- |
||||
#Split $text to a list containing alternating ANSI color codes and text. |
||||
#ANSI color codes are always on the second element, fourth, and so on. |
||||
#(ie plaintext on odd list-indices ansi on even indices) |
||||
# Example: |
||||
#ta_split_codes "" # => "" |
||||
#ta_split_codes "a" # => "a" |
||||
#ta_split_codes "a\e[31m" # => {"a" "\e[31m"} |
||||
#ta_split_codes "\e[31ma" # => {"" "\e[31m" "a"} |
||||
#ta_split_codes "\e[31ma\e[0m" # => {"" "\e[31m" "a" "\e[0m"} |
||||
#ta_split_codes "\e[31ma\e[0mb" # => {"" "\e[31m" "a" "\e[0m", "b"} |
||||
#ta_split_codes "\e[31m\e[0mb" # => {"" "\e[31m\e[0m" "b"} |
||||
# |
||||
#proc split_codes {text} { |
||||
# variable re_esc_osc1 |
||||
# variable re_esc_osc2 |
||||
# variable re_csi_code |
||||
# set re "(?:${re_csi_code}|${re_esc_osc1}|${re_esc_osc2})+" |
||||
# return [_perlish_split $re $text] |
||||
#} |
||||
##like split_codes - but each ansi-escape is split out separately (with empty string of plaintext between codes so odd/even plain ansi still holds) |
||||
#proc split_codes_single {text} { |
||||
# variable re_esc_osc1 |
||||
# variable re_esc_osc2 |
||||
# variable re_csi_code |
||||
# set re "${re_csi_code}|${re_esc_osc1}|${re_esc_osc2}" |
||||
# return [_perlish_split $re $text] |
||||
#} |
||||
|
||||
##review - tcl greedy expressions may match multiple in one element |
||||
#proc _perlish_split {re text} { |
||||
# if {[string length $text] == 0} { |
||||
# return {} |
||||
# } |
||||
# set list [list] |
||||
# set start 0 |
||||
# while {[regexp -start $start -indices -- $re $text match]} { |
||||
# lassign $match matchStart matchEnd |
||||
# lappend list [string range $text $start $matchStart-1] [string range $text $matchStart $matchEnd] |
||||
# set start [expr {$matchEnd+1}] |
||||
# } |
||||
# lappend list [string range $text $start end] |
||||
# return $list |
||||
#} |
||||
## -- --- --- --- --- --- |
||||
|
||||
} |
||||
} ;# end if 0 |
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
namespace eval overtype { |
||||
interp alias {} ::overtype::center {} ::overtype::centre |
||||
} |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide overtype [namespace eval overtype { |
||||
variable version |
||||
set version 1.5.1 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
File diff suppressed because it is too large
Load Diff
@ -1,928 +0,0 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# 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) Julian Noble 2003-2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application overtype 1.5.6 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin overtype_module_overtype 0 1.5.6] |
||||
#[copyright "2024"] |
||||
#[titledesc {overtype text layout - ansi aware}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {overtype text layout}] [comment {-- Description at end of page heading --}] |
||||
#[require overtype] |
||||
#[keywords module text ansi] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of overtype |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by overtype |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6 |
||||
package require textutil |
||||
package require punk::lib ;#required for lines_as_list |
||||
package require punk::ansi ;#required to detect, split, strip and calculate lengths |
||||
package require punk::char ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package textutil] |
||||
#[item] [package punk::ansi] |
||||
#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes |
||||
#[item] [package punk::char] |
||||
#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
|
||||
#Julian Noble <julian@precisium.com.au> - 2003 |
||||
#Released under standard 'BSD license' conditions. |
||||
# |
||||
#todo - ellipsis truncation indicator for center,right |
||||
|
||||
#v1.4 2023-07 - naive ansi color handling - todo - fix string range |
||||
# - need to extract and replace ansi codes? |
||||
|
||||
namespace eval overtype { |
||||
namespace export * |
||||
variable default_ellipsis_horizontal "..." ;#fallback |
||||
variable default_ellipsis_vertical "..." |
||||
namespace eval priv { |
||||
proc _init {} { |
||||
upvar ::overtype::default_ellipsis_horizontal e_h |
||||
upvar ::overtype::default_ellipsis_vertical e_v |
||||
set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis |
||||
set e_v [format %c 0x22EE] |
||||
#The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text |
||||
#Also - unicode ellipsis has semantic meaning that other processors can interpret |
||||
#unicode does also provide a midline horizontal ellipsis 0x22EF |
||||
|
||||
#set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz - Box Drawings Light Triple Dash Horizontal |
||||
#if {![catch {package require punk::char}]} { |
||||
# set e [punk::char::charshort boxd_ltdshhz] |
||||
#} |
||||
} |
||||
} |
||||
priv::_init |
||||
} |
||||
proc overtype::about {} { |
||||
return "Simple text formatting. Author JMN. BSD-License" |
||||
} |
||||
|
||||
namespace eval overtype { |
||||
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\\] ;#note mix of 1 and 2-byte terminals |
||||
|
||||
#self-contained 2 byte ansi escape sequences - review more? |
||||
variable ansi_2byte_codes_dict |
||||
set ansi_2byte_codes_dict [dict create\ |
||||
"reset_terminal" "\u001bc"\ |
||||
"save_cursor_posn" "\u001b7"\ |
||||
"restore_cursor_posn" "\u001b8"\ |
||||
"cursor_up_one" "\u001bM"\ |
||||
"NEL - Next Line" "\u001bE"\ |
||||
"IND - Down one line" "\u001bD"\ |
||||
"HTS - Set Tab Stop" "\u001bH"\ |
||||
] |
||||
|
||||
#debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. |
||||
# "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ |
||||
} |
||||
|
||||
|
||||
#proc overtype::stripansi {text} { |
||||
# variable escape_terminals ;#dict |
||||
# variable ansi_2byte_codes_dict |
||||
# #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway |
||||
# if {[string first \033 $text] <0 && [string first \009c $text] <0} { |
||||
# #\033 same as \x1b |
||||
# return $text |
||||
# } |
||||
# |
||||
# set text [convert_g0 $text] |
||||
# |
||||
# #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. |
||||
# #line endings can theoretically occur within an ansi escape sequence (review e.g title?) |
||||
# set inputlist [split $text ""] |
||||
# set outputlist [list] |
||||
# |
||||
# set 2bytecodes [dict values $ansi_2byte_codes_dict] |
||||
# |
||||
# set in_escapesequence 0 |
||||
# #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls |
||||
# set i 0 |
||||
# foreach u $inputlist { |
||||
# set v [lindex $inputlist $i+1] |
||||
# set uv ${u}${v} |
||||
# if {$in_escapesequence eq "2b"} { |
||||
# #2nd byte - done. |
||||
# set in_escapesequence 0 |
||||
# } elseif {$in_escapesequence != 0} { |
||||
# set escseq [dict get $escape_terminals $in_escapesequence] |
||||
# if {$u in $escseq} { |
||||
# set in_escapesequence 0 |
||||
# } elseif {$uv in $escseq} { |
||||
# set in_escapseequence 2b ;#flag next byte as last in sequence |
||||
# } |
||||
# } else { |
||||
# #handle both 7-bit and 8-bit CSI and OSC |
||||
# if {[regexp {^(?:\033\[|\u009b)} $uv]} { |
||||
# set in_escapesequence CSI |
||||
# } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} { |
||||
# set in_escapesequence OSC |
||||
# } elseif {$uv in $2bytecodes} { |
||||
# #self-contained e.g terminal reset - don't pass through. |
||||
# set in_escapesequence 2b |
||||
# } else { |
||||
# lappend outputlist $u |
||||
# } |
||||
# } |
||||
# incr i |
||||
# } |
||||
# return [join $outputlist ""] |
||||
#} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
proc overtype::string_columns {text} { |
||||
if {[punk::ansi::ta::detect $text]} { |
||||
#error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length" |
||||
set text [punk::ansi::stripansi $text] |
||||
} |
||||
return [punk::char::string_width $text] |
||||
} |
||||
|
||||
|
||||
#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r |
||||
proc overtype::left {args} { |
||||
# @c overtype starting at left (overstrike) |
||||
# @c can/should we use something like this?: 'format "%-*s" $len $overtext |
||||
variable default_ellipsis_horizontal |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] underblock overblock |
||||
set defaults [dict create\ |
||||
-bias ignored\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::left unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_exposed1 [dict get $opts -exposed1] ;#widechar_exposed_left - todo |
||||
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
set right_exposed $under_exposed_max |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set undertext_printlen [punk::ansi::printing_length $undertext] |
||||
if {$undertext_printlen < $colwidth} { |
||||
set udiff [expr {$colwidth - $undertext_printlen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
set overtext_printlen [punk::ansi::printing_length $overtext] |
||||
set overflowlength [expr {$overtext_printlen - $colwidth}] |
||||
|
||||
#review |
||||
#append overtext "\033\[0m" |
||||
|
||||
|
||||
if {$overflowlength > 0} { |
||||
#background line is narrower than data in line |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext] |
||||
if {![dict get $opts -overflow]} { |
||||
#set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc |
||||
if {[dict get $opts -ellipsis]} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#we know overtext data is shorter or equal (for this line) |
||||
lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
|
||||
} |
||||
|
||||
namespace eval overtype::piper { |
||||
proc overcentre {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::centre {*}$argsflags $under $over |
||||
} |
||||
proc overleft {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::left {*}$argsflags $under $over |
||||
} |
||||
} |
||||
#todo - left-right ellipsis ? |
||||
proc overtype::centre {args} { |
||||
variable default_ellipsis_horizontal |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
|
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
#todo - vertical vs horizontal overflow for blocks |
||||
set defaults [dict create\ |
||||
-bias left\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsis [dict get $opts -ellipsis] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
if {$under_exposed_max > 0} { |
||||
#background block is wider |
||||
if {$under_exposed_max % 2 == 0} { |
||||
#even left/right exposure |
||||
set left_exposed [expr {$under_exposed_max / 2}] |
||||
} else { |
||||
set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division |
||||
if {[string tolower [dict get $opts -bias]] eq "left"} { |
||||
set left_exposed $beforehalf |
||||
} else { |
||||
#bias to the right |
||||
set left_exposed [expr {$beforehalf + 1}] |
||||
} |
||||
} |
||||
} else { |
||||
set left_exposed 0 |
||||
} |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set overtext_datalen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
|
||||
set overflowlength [expr {$overtext_datalen - $colwidth}] |
||||
#review - right-to-left langs should elide on left! - extra option required |
||||
|
||||
if {$overflowlength > 0} { |
||||
#overlay line wider or equal |
||||
set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
#overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified |
||||
if {![dict get $opts -overflow]} { |
||||
#lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]] |
||||
#set overtext [string range $overtext 0 $colwidth-1 ] |
||||
if {$opt_ellipsis} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
#lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext] |
||||
} else { |
||||
#background block is wider than or equal to data for this line |
||||
lappend outputlines [renderline -start $left_exposed -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
proc overtype::right {args} { |
||||
#NOT the same as align-right - which should be done to the overblock first if required |
||||
variable default_ellipsis_horizontal |
||||
# @d !todo - implement overflow, length checks etc |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
set defaults [dict create\ |
||||
-bias ignored\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsis [dict get $opts -ellipsis] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
set left_exposed $under_exposed_max |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set overtext_datalen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
puts xxx |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
if {$overtext_datalen < $overblock_width} { |
||||
set odiff [expr {$overblock_width - $overtext_datalen}] |
||||
#padding always on right - if alignment is required it should be done to block beforehand - not here |
||||
set overtextpadding "$overtext[string repeat { } $odiff]" |
||||
} |
||||
|
||||
set overflowlength [expr {$overtext_datalen - $colwidth}] |
||||
if {$overflowlength > 0} { |
||||
#raw overtext wider than undertext column |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -start 0 $undertext $overtext] |
||||
if {!$opt_overflow} { |
||||
if {$opt_ellipsis} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#padded overtext |
||||
lappend outputlines [renderline -transparent $opt_transparent -start $left_exposed $undertext $overtext] |
||||
} |
||||
} |
||||
|
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
proc overtype::transparentline {args} { |
||||
foreach {under over} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
set defaults [dict create\ |
||||
-transparent 1\ |
||||
-exposed 1 " "\ |
||||
-exposed 2 " "\ |
||||
] |
||||
set newargs [dict merge $defaults $argsflags] |
||||
tailcall overtype::renderline {*}$newargs $under $over |
||||
} |
||||
#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway. |
||||
# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense. |
||||
#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines. |
||||
# |
||||
namespace eval overtype::piper { |
||||
proc renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
foreach {over under} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::renderline {*}$argsflags $under $over |
||||
} |
||||
} |
||||
interp alias "" piper_renderline "" overtype::piper::renderline |
||||
|
||||
#-returnextra to enable returning of overflow and length |
||||
# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation? |
||||
#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements |
||||
#todo - review transparency issues with single/double width characters! |
||||
proc overtype::renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] under over |
||||
#should also rule out \v |
||||
if {[string first \n $over] >=0 || [string first \n $under] >= 0} { |
||||
error "overtype::renderline not allowed to contain newlines" |
||||
} |
||||
set defaults [dict create\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-start 0\ |
||||
-returnextra 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
#exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow |
||||
|
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::renderline unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_colstart [dict get $opts -start] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
if {$opt_transparent eq "0"} { |
||||
set do_transparency 0 |
||||
} else { |
||||
set do_transparency 1 |
||||
if {$opt_transparent eq "1"} { |
||||
set opt_transparent {[\s]} |
||||
} |
||||
} |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_returnextra [dict get $opts -returnextra] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
|
||||
#----- |
||||
# |
||||
if {[string first \t $under] >= 0} { |
||||
#set under [textutil::tabify::untabify2 $under] |
||||
set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review |
||||
} |
||||
set overdata $over |
||||
if {[string first \t $over] >= 0} { |
||||
#set overdata [textutil::tabify::untabify2 $over] |
||||
set overdata [textutil::tabify::untabifyLine $over 8] |
||||
} |
||||
#------- |
||||
|
||||
#ta_detect ansi and do simpler processing? |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
set undermap [punk::ansi::ta::split_codes_single $under] |
||||
set understacks [dict create] |
||||
|
||||
set i_u -1 |
||||
set i_o 0 |
||||
set out [list] |
||||
set u_codestack [list] |
||||
set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation |
||||
set remainder [list] ;#for returnextra |
||||
foreach {pt code} $undermap { |
||||
#pt = plain text |
||||
append pt_underchars $pt |
||||
foreach grapheme [punk::char::grapheme_split $pt] { |
||||
set width [punk::char::string_width $grapheme] |
||||
incr i_u |
||||
dict set understacks $i_u $u_codestack |
||||
lappend out $grapheme |
||||
if {$width > 1} { |
||||
incr i_u |
||||
#presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?) |
||||
#but what about emoji combinations etc - can they be wider than 2? |
||||
dict set understacks $i_u $u_codestack |
||||
lappend out "" |
||||
} |
||||
} |
||||
|
||||
#underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here |
||||
|
||||
#only stack SGR (graphics rendition) codes - not title sets, cursor moves etc |
||||
#order of if-else based on assumptions: |
||||
# that pure resets are fairly common - more so than leading resets with other info |
||||
# that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all. |
||||
if {[punk::ansi::codetype::is_sgr_reset $code]} { |
||||
set u_codestack [list] |
||||
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
set u_codestack [list $code] |
||||
} elseif {[punk::ansi::codetype::is_sgr $code]} { |
||||
lappend u_codestack $code |
||||
} |
||||
#consider also if there are other codes that should be stacked..? |
||||
} |
||||
#trailing codes in effect for underlay |
||||
if {[llength $undermap]} { |
||||
dict set understacks [expr {$i_u + 1}] $u_codestack |
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
#### |
||||
#if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns. |
||||
#this will be processed as transparent - and handle doublewidth underlay characters appropriately |
||||
set startpad [string repeat " " $opt_colstart] |
||||
append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency |
||||
set overmap [punk::ansi::ta::split_codes_single $startpad] |
||||
#### |
||||
|
||||
#set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} |
||||
#as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes |
||||
|
||||
|
||||
set overstacks [dict create] |
||||
set o_codestack [list] |
||||
set pt_overchars "" |
||||
foreach {pt code} $overmap { |
||||
append pt_overchars $pt |
||||
foreach grapheme [punk::char::grapheme_split $pt] { |
||||
dict set overstacks $i_o $o_codestack |
||||
incr i_o |
||||
} |
||||
|
||||
if {[punk::ansi::codetype::is_sgr $code]} { |
||||
if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
#m code which has sgr reset at start - no need to replay prior sgr codes |
||||
set o_codestack [list $code] |
||||
} else { |
||||
lappend o_codestack $code |
||||
} |
||||
} |
||||
|
||||
#only stack SGR (graphics rendition) codes - not title sets, cursor moves etc |
||||
#order of if-else based on assumptions: |
||||
# that pure resets are fairly common - more so than leading resets with other info |
||||
# that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all. |
||||
if {[punk::ansi::codetype::is_sgr_reset $code]} { |
||||
set o_codestack [list] |
||||
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
set o_codestack [list $code] |
||||
} elseif {[punk::ansi::codetype::is_sgr $code]} { |
||||
lappend o_codestack $code |
||||
} |
||||
|
||||
} |
||||
# -- --- --- --- --- --- --- --- |
||||
|
||||
|
||||
#potential problem - combinining diacritics directly following control chars like \r \b |
||||
|
||||
set bs [format %c 0x08] |
||||
set idx 0 ;# line index (cursor - 1) |
||||
set idx_over -1 |
||||
foreach {pt code} $overmap { |
||||
#set ptchars [split $pt ""] ;#for lookahead |
||||
set graphemes [punk::char::grapheme_split $pt] |
||||
#emit plaintext chars first using existing SGR codes from under/over stack as appropriate |
||||
#then check if the following code is a cursor movement within the line and adjust index if so |
||||
foreach ch $graphemes { |
||||
incr idx_over |
||||
if {$ch eq "\r"} { |
||||
set idx $opt_colstart |
||||
} elseif {$ch eq "\b"} { |
||||
#review - backspace effect on double-width chars |
||||
if {$idx > $opt_colstart} { |
||||
incr idx -1 |
||||
} |
||||
} elseif {($idx < $opt_colstart)} { |
||||
incr idx |
||||
} elseif {($do_transparency && [regexp $opt_transparent $ch])} { |
||||
#pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay) |
||||
set owidth [punk::char::string_width $ch] |
||||
if {$idx > [llength $out]-1} { |
||||
lappend out " " |
||||
dict set understacks $idx [list] ;#review - use idx-1 codestack? |
||||
incr idx |
||||
} else { |
||||
set uwidth [punk::char::string_width [lindex $out $idx]] |
||||
if {[lindex $out $idx] eq ""} { |
||||
#2nd col of 2-wide char in underlay |
||||
incr idx |
||||
} elseif {$uwidth == 0} { |
||||
#e.g control char ? combining diacritic ? |
||||
incr idx |
||||
} elseif {$uwidth == 1} { |
||||
incr idx |
||||
if {$owidth > 1} { |
||||
incr idx |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
if {[punk::char::string_width $ch] == 1} { |
||||
#normal singlewide transparency |
||||
set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay |
||||
if {$next_pt_overchar eq ""} { |
||||
#special-case trailing transparent - no next_pt_overchar |
||||
incr idx |
||||
} else { |
||||
if {[regexp $opt_transparent $next_pt_overchar]} { |
||||
incr idx |
||||
} else { |
||||
#next overlay char is not transparent.. first-half of underlying 2wide char is exposed |
||||
priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} |
||||
} else { |
||||
#2wide transparency over 2wide in underlay |
||||
incr idx |
||||
} |
||||
} |
||||
} |
||||
} else { |
||||
#non-transparent char in overlay |
||||
set owidth [punk::char::string_width $ch] |
||||
set uwidth [punk::char::string_width [lindex $out $idx]] |
||||
if {[lindex $out $idx] eq ""} { |
||||
#2nd col of 2wide char in underlay |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} elseif {$uwidth == 0} { |
||||
#e.g combining diacritic - increment before over char REVIEW |
||||
#arguably the previous overchar should have done this - ie lookahead for combiners? |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
|
||||
} elseif {$uwidth == 1} { |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} else { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over] |
||||
#don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char |
||||
} else { |
||||
#2wide over 2wide |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
#cursor movement? |
||||
#if {![punk::ansi::codetype::is_sgr $code]} { |
||||
# |
||||
#} |
||||
} |
||||
|
||||
if {$opt_overflow == 0} { |
||||
#need to truncate to the width of the original undertext |
||||
#review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok? |
||||
set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars |
||||
} |
||||
|
||||
#coalesce and replay codestacks for out char list |
||||
set outstring "" |
||||
set remstring "" ;#remainder after overflow point reached |
||||
set i 0 |
||||
set cstack [list] |
||||
set prevstack [list] |
||||
set out_rawchars ""; #for overflow counting |
||||
set output_to "outstring" ;#var in effect depending on overflow |
||||
set in_overflow 0 ;#used to stop char-width scanning once in overflow |
||||
foreach ch $out { |
||||
append out_rawchars $ch |
||||
if {$opt_overflow == 0 && !$in_overflow} { |
||||
if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] < $num_under_columns} { |
||||
} else { |
||||
#todo - check if we overflowed with a double-width char ? |
||||
#store visualwidth which may be short |
||||
set in_overflow 1 |
||||
} |
||||
} |
||||
set cstack [dict get $understacks $i] |
||||
if {$cstack ne $prevstack} { |
||||
if {[llength $prevstack]} { |
||||
append $output_to \033\[m |
||||
} |
||||
foreach code $cstack { |
||||
append $output_to $code |
||||
} |
||||
} |
||||
append $output_to $ch |
||||
set prevstack $cstack |
||||
incr i |
||||
if {$in_overflow} { |
||||
set output_to "remstring" |
||||
} |
||||
} |
||||
if {[dict size $understacks] > 0} { |
||||
append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes |
||||
} |
||||
if {[string length $remstring]} { |
||||
#puts stderr "remainder:$remstring" |
||||
} |
||||
#pdict $understacks |
||||
if {$opt_returnextra} { |
||||
return [list $outstring $visualwidth [string length $outstring] $remstring] |
||||
} else { |
||||
return $outstring |
||||
} |
||||
#return [join $out ""] |
||||
} |
||||
proc overtype::test_renderline {} { |
||||
set t \uFF5E ;#2-wide tilde |
||||
set u \uFF3F ;#2-wide underscore |
||||
set missing \uFFFD |
||||
return [list $t $u A${t}B] |
||||
} |
||||
|
||||
#same as textblock::size - but we don't want that circular dependency |
||||
proc overtype::blocksize {textblock} { |
||||
if {$textblock eq ""} { |
||||
return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings |
||||
} |
||||
set textblock [textutil::tabify::untabify2 $textblock] |
||||
#stripansi on entire block in one go rather than line by line - result should be the same - review - make tests |
||||
set textblock [punk::ansi::stripansi $textblock] |
||||
if {[string first \n $textblock] >= 0} { |
||||
set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]] |
||||
} else { |
||||
set width [punk::char::string_width $textblock] |
||||
} |
||||
set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list |
||||
#our concept of block-height is likely to be different to other line-counting mechanisms |
||||
set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le |
||||
|
||||
return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height |
||||
} |
||||
|
||||
namespace eval overtype::priv { |
||||
|
||||
#is actually addgrapheme? |
||||
proc render_addchar {i c stack} { |
||||
upvar out o |
||||
upvar understacks ustacks |
||||
set nxt [llength $o] |
||||
if {$i < $nxt} { |
||||
lset o $i $c |
||||
} else { |
||||
lappend o $c |
||||
} |
||||
dict set ustacks $i $stack |
||||
} |
||||
|
||||
} |
||||
|
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
namespace eval overtype { |
||||
interp alias {} ::overtype::center {} ::overtype::centre |
||||
} |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide overtype [namespace eval overtype { |
||||
variable version |
||||
set version 1.5.6 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
@ -1,998 +0,0 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# 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) Julian Noble 2003-2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application overtype 1.5.7 |
||||
# Meta platform tcl |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin overtype_module_overtype 0 1.5.7] |
||||
#[copyright "2024"] |
||||
#[titledesc {overtype text layout - ansi aware}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {overtype text layout}] [comment {-- Description at end of page heading --}] |
||||
#[require overtype] |
||||
#[keywords module text ansi] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of overtype |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by overtype |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6 |
||||
package require textutil |
||||
package require punk::lib ;#required for lines_as_list |
||||
package require punk::ansi ;#required to detect, split, strip and calculate lengths |
||||
package require punk::char ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package textutil] |
||||
#[item] [package punk::ansi] |
||||
#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes |
||||
#[item] [package punk::char] |
||||
#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
|
||||
#Julian Noble <julian@precisium.com.au> - 2003 |
||||
#Released under standard 'BSD license' conditions. |
||||
# |
||||
#todo - ellipsis truncation indicator for center,right |
||||
|
||||
#v1.4 2023-07 - naive ansi color handling - todo - fix string range |
||||
# - need to extract and replace ansi codes? |
||||
|
||||
namespace eval overtype { |
||||
namespace export * |
||||
variable default_ellipsis_horizontal "..." ;#fallback |
||||
variable default_ellipsis_vertical "..." |
||||
namespace eval priv { |
||||
proc _init {} { |
||||
upvar ::overtype::default_ellipsis_horizontal e_h |
||||
upvar ::overtype::default_ellipsis_vertical e_v |
||||
set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis |
||||
set e_v [format %c 0x22EE] |
||||
#The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text |
||||
#Also - unicode ellipsis has semantic meaning that other processors can interpret |
||||
#unicode does also provide a midline horizontal ellipsis 0x22EF |
||||
|
||||
#set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz - Box Drawings Light Triple Dash Horizontal |
||||
#if {![catch {package require punk::char}]} { |
||||
# set e [punk::char::charshort boxd_ltdshhz] |
||||
#} |
||||
} |
||||
} |
||||
priv::_init |
||||
} |
||||
proc overtype::about {} { |
||||
return "Simple text formatting. Author JMN. BSD-License" |
||||
} |
||||
|
||||
namespace eval overtype { |
||||
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\\] ;#note mix of 1 and 2-byte terminals |
||||
|
||||
#self-contained 2 byte ansi escape sequences - review more? |
||||
variable ansi_2byte_codes_dict |
||||
set ansi_2byte_codes_dict [dict create\ |
||||
"reset_terminal" "\u001bc"\ |
||||
"save_cursor_posn" "\u001b7"\ |
||||
"restore_cursor_posn" "\u001b8"\ |
||||
"cursor_up_one" "\u001bM"\ |
||||
"NEL - Next Line" "\u001bE"\ |
||||
"IND - Down one line" "\u001bD"\ |
||||
"HTS - Set Tab Stop" "\u001bH"\ |
||||
] |
||||
|
||||
#debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. |
||||
# "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ |
||||
} |
||||
|
||||
|
||||
#proc overtype::stripansi {text} { |
||||
# variable escape_terminals ;#dict |
||||
# variable ansi_2byte_codes_dict |
||||
# #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway |
||||
# if {[string first \033 $text] <0 && [string first \009c $text] <0} { |
||||
# #\033 same as \x1b |
||||
# return $text |
||||
# } |
||||
# |
||||
# set text [convert_g0 $text] |
||||
# |
||||
# #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. |
||||
# #line endings can theoretically occur within an ansi escape sequence (review e.g title?) |
||||
# set inputlist [split $text ""] |
||||
# set outputlist [list] |
||||
# |
||||
# set 2bytecodes [dict values $ansi_2byte_codes_dict] |
||||
# |
||||
# set in_escapesequence 0 |
||||
# #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls |
||||
# set i 0 |
||||
# foreach u $inputlist { |
||||
# set v [lindex $inputlist $i+1] |
||||
# set uv ${u}${v} |
||||
# if {$in_escapesequence eq "2b"} { |
||||
# #2nd byte - done. |
||||
# set in_escapesequence 0 |
||||
# } elseif {$in_escapesequence != 0} { |
||||
# set escseq [dict get $escape_terminals $in_escapesequence] |
||||
# if {$u in $escseq} { |
||||
# set in_escapesequence 0 |
||||
# } elseif {$uv in $escseq} { |
||||
# set in_escapseequence 2b ;#flag next byte as last in sequence |
||||
# } |
||||
# } else { |
||||
# #handle both 7-bit and 8-bit CSI and OSC |
||||
# if {[regexp {^(?:\033\[|\u009b)} $uv]} { |
||||
# set in_escapesequence CSI |
||||
# } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} { |
||||
# set in_escapesequence OSC |
||||
# } elseif {$uv in $2bytecodes} { |
||||
# #self-contained e.g terminal reset - don't pass through. |
||||
# set in_escapesequence 2b |
||||
# } else { |
||||
# lappend outputlist $u |
||||
# } |
||||
# } |
||||
# incr i |
||||
# } |
||||
# return [join $outputlist ""] |
||||
#} |
||||
|
||||
|
||||
|
||||
|
||||
|
||||
proc overtype::string_columns {text} { |
||||
if {[punk::ansi::ta::detect $text]} { |
||||
#error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length" |
||||
set text [punk::ansi::stripansi $text] |
||||
} |
||||
return [punk::char::string_width $text] |
||||
} |
||||
|
||||
|
||||
#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r |
||||
proc overtype::left {args} { |
||||
# @c overtype starting at left (overstrike) |
||||
# @c can/should we use something like this?: 'format "%-*s" $len $overtext |
||||
variable default_ellipsis_horizontal |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] underblock overblock |
||||
set defaults [dict create\ |
||||
-bias ignored\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::left unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_exposed1 [dict get $opts -exposed1] ;#widechar_exposed_left - todo |
||||
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
set right_exposed $under_exposed_max |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set undertext_printlen [punk::ansi::printing_length $undertext] |
||||
if {$undertext_printlen < $colwidth} { |
||||
set udiff [expr {$colwidth - $undertext_printlen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
set overtext_printlen [punk::ansi::printing_length $overtext] |
||||
set overflowlength [expr {$overtext_printlen - $colwidth}] |
||||
|
||||
#review |
||||
#append overtext "\033\[0m" |
||||
|
||||
|
||||
if {$overflowlength > 0} { |
||||
#background line is narrower than data in line |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow [dict get $opts -overflow] $undertext $overtext] |
||||
if {![dict get $opts -overflow]} { |
||||
#set overtext [string range $overtext 0 $colwidth-1] ;#string range won't be correct e.g if contains ansi codes or leading \r or \b etc |
||||
if {[dict get $opts -ellipsis]} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#we know overtext data is shorter or equal (for this line) |
||||
lappend outputlines [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
|
||||
} |
||||
|
||||
namespace eval overtype::piper { |
||||
proc overcentre {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-bias left|right? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::centre {*}$argsflags $under $over |
||||
} |
||||
proc overleft {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-startcolumn <column>? ?-transparent [0|1|<regexp>]? ?-exposed1 <char>? ?-exposed2 <char>? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
lassign [lrange $args end-1 end] over under |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::left {*}$argsflags $under $over |
||||
} |
||||
} |
||||
#todo - left-right ellipsis ? |
||||
proc overtype::centre {args} { |
||||
variable default_ellipsis_horizontal |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-transparent [0|1]? ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
|
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
#todo - vertical vs horizontal overflow for blocks |
||||
set defaults [dict create\ |
||||
-bias left\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsis [dict get $opts -ellipsis] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
if {$under_exposed_max > 0} { |
||||
#background block is wider |
||||
if {$under_exposed_max % 2 == 0} { |
||||
#even left/right exposure |
||||
set left_exposed [expr {$under_exposed_max / 2}] |
||||
} else { |
||||
set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division |
||||
if {[string tolower [dict get $opts -bias]] eq "left"} { |
||||
set left_exposed $beforehalf |
||||
} else { |
||||
#bias to the right |
||||
set left_exposed [expr {$beforehalf + 1}] |
||||
} |
||||
} |
||||
} else { |
||||
set left_exposed 0 |
||||
} |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set overtext_datalen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
|
||||
set overflowlength [expr {$overtext_datalen - $colwidth}] |
||||
#review - right-to-left langs should elide on left! - extra option required |
||||
|
||||
if {$overflowlength > 0} { |
||||
#overlay line wider or equal |
||||
set rendered [renderline -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
#overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified |
||||
if {![dict get $opts -overflow]} { |
||||
#lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]] |
||||
#set overtext [string range $overtext 0 $colwidth-1 ] |
||||
if {$opt_ellipsis} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
#lappend outputlines [renderline -transparent $opt_transparent $undertext $overtext] |
||||
} else { |
||||
#background block is wider than or equal to data for this line |
||||
lappend outputlines [renderline -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] |
||||
} |
||||
} |
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
proc overtype::right {args} { |
||||
#NOT the same as align-right - which should be done to the overblock first if required |
||||
variable default_ellipsis_horizontal |
||||
# @d !todo - implement overflow, length checks etc |
||||
|
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
foreach {underblock overblock} [lrange $args end-1 end] break |
||||
|
||||
set defaults [dict create\ |
||||
-bias ignored\ |
||||
-ellipsis 0\ |
||||
-ellipsistext $default_ellipsis_horizontal\ |
||||
-ellipsiswhitespace 0\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::centre unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
set opt_ellipsis [dict get $opts -ellipsis] |
||||
set opt_ellipsistext [dict get $opts -ellipsistext] |
||||
set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- |
||||
|
||||
set norm [list \r\n \n] |
||||
set underblock [string map $norm $underblock] |
||||
set overblock [string map $norm $overblock] |
||||
|
||||
set underlines [split $underblock \n] |
||||
#set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $underblock] _w colwidth _h colheight |
||||
set overlines [split $overblock \n] |
||||
#set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] |
||||
lassign [blocksize $overblock] _w overblock_width _h overblock_height |
||||
set under_exposed_max [expr {$colwidth - $overblock_width}] |
||||
set left_exposed $under_exposed_max |
||||
|
||||
set outputlines [list] |
||||
foreach undertext $underlines overtext $overlines { |
||||
set overtext_datalen [punk::ansi::printing_length $overtext] |
||||
set ulen [punk::ansi::printing_length $undertext] |
||||
if {$ulen < $colwidth} { |
||||
set udiff [expr {$colwidth - $ulen}] |
||||
puts xxx |
||||
set undertext "$undertext[string repeat { } $udiff]" |
||||
} |
||||
if {$overtext_datalen < $overblock_width} { |
||||
set odiff [expr {$overblock_width - $overtext_datalen}] |
||||
#padding always on right - if alignment is required it should be done to block beforehand - not here |
||||
set overtextpadding "$overtext[string repeat { } $odiff]" |
||||
} |
||||
|
||||
set overflowlength [expr {$overtext_datalen - $colwidth}] |
||||
if {$overflowlength > 0} { |
||||
#raw overtext wider than undertext column |
||||
set rendered [renderline -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -startcolumn 1 $undertext $overtext] |
||||
if {!$opt_overflow} { |
||||
if {$opt_ellipsis} { |
||||
set show_ellipsis 1 |
||||
if {!$opt_ellipsiswhitespace} { |
||||
#we don't want ellipsis if only whitespace was lost |
||||
set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] |
||||
if {[string trim $lostdata] eq ""} { |
||||
set show_ellipsis 0 |
||||
} |
||||
} |
||||
if {$show_ellipsis} { |
||||
set rendered [overtype::right $rendered $opt_ellipsistext] |
||||
} |
||||
} |
||||
} |
||||
lappend outputlines $rendered |
||||
} else { |
||||
#padded overtext |
||||
lappend outputlines [renderline -transparent $opt_transparent -startcolumn [expr {$left_exposed + 1}] $undertext $overtext] |
||||
} |
||||
} |
||||
|
||||
return [join $outputlines \n] |
||||
} |
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
proc overtype::transparentline {args} { |
||||
foreach {under over} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
set defaults [dict create\ |
||||
-transparent 1\ |
||||
-exposed 1 " "\ |
||||
-exposed 2 " "\ |
||||
] |
||||
set newargs [dict merge $defaults $argsflags] |
||||
tailcall overtype::renderline {*}$newargs $under $over |
||||
} |
||||
#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway. |
||||
# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense. |
||||
#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines. |
||||
# |
||||
namespace eval overtype::piper { |
||||
proc renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-start <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? overtext pipelinedata} |
||||
} |
||||
foreach {over under} [lrange $args end-1 end] break |
||||
set argsflags [lrange $args 0 end-2] |
||||
tailcall overtype::renderline {*}$argsflags $under $over |
||||
} |
||||
} |
||||
interp alias "" piper_renderline "" overtype::piper::renderline |
||||
|
||||
#-returnextra to enable returning of overflow and length |
||||
# todo - use punk::ansi::ta::detect to short-circuit processing and do simple string calcs as an optimisation? |
||||
#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements |
||||
#todo - review transparency issues with single/double width characters! |
||||
#bidi - need a base direction and concept of directional runs for RTL vs LTR - may be best handled at another layer? |
||||
proc overtype::renderline {args} { |
||||
if {[llength $args] < 2} { |
||||
error {usage: ?-info 0|1? ?-startcolumn <int>? ?-transparent [0|1|<regexp>]? ?-overflow [1|0]? undertext overtext} |
||||
} |
||||
lassign [lrange $args end-1 end] under over |
||||
#should also rule out \v |
||||
if {[string first \n $over] >=0 || [string first \n $under] >= 0} { |
||||
error "overtype::renderline not allowed to contain newlines" |
||||
} |
||||
set defaults [dict create\ |
||||
-overflow 0\ |
||||
-transparent 0\ |
||||
-startcolumn 1\ |
||||
-info 0\ |
||||
-exposed1 \uFFFD\ |
||||
-exposed2 \uFFFD\ |
||||
] |
||||
#exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow |
||||
|
||||
set known_opts [dict keys $defaults] |
||||
set argsflags [lrange $args 0 end-2] |
||||
dict for {k v} $argsflags { |
||||
if {$k ni $known_opts} { |
||||
error "overtype::renderline unknown option '$k'. Known options: $known_opts" |
||||
} |
||||
} |
||||
set opts [dict merge $defaults $argsflags] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_overflow [dict get $opts -overflow] |
||||
set opt_colstart [dict get $opts -startcolumn] ;#start cursor column |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_transparent [dict get $opts -transparent] |
||||
if {$opt_transparent eq "0"} { |
||||
set do_transparency 0 |
||||
} else { |
||||
set do_transparency 1 |
||||
if {$opt_transparent eq "1"} { |
||||
set opt_transparent {[\s]} |
||||
} |
||||
} |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_returnextra [dict get $opts -info] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
set opt_exposed1 [dict get $opts -exposed1] |
||||
set opt_exposed2 [dict get $opts -exposed2] |
||||
# -- --- --- --- --- --- --- --- --- --- --- --- |
||||
|
||||
#----- |
||||
# |
||||
if {[string first \t $under] >= 0} { |
||||
#set under [textutil::tabify::untabify2 $under] |
||||
set under [textutil::tabify::untabifyLine $under 8] ;#8 is default for untabify2 - review |
||||
} |
||||
set overdata $over |
||||
if {[string first \t $over] >= 0} { |
||||
#set overdata [textutil::tabify::untabify2 $over] |
||||
set overdata [textutil::tabify::untabifyLine $over 8] |
||||
} |
||||
#------- |
||||
|
||||
#ta_detect ansi and do simpler processing? |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
set undermap [punk::ansi::ta::split_codes_single $under] |
||||
set understacks [dict create] |
||||
|
||||
set i_u -1 |
||||
set i_o 0 |
||||
set outcols [list] |
||||
set u_codestack [list] |
||||
set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation |
||||
set remainder [list] ;#for returnextra |
||||
foreach {pt code} $undermap { |
||||
#pt = plain text |
||||
append pt_underchars $pt |
||||
foreach grapheme [punk::char::grapheme_split $pt] { |
||||
set width [punk::char::string_width $grapheme] |
||||
incr i_u |
||||
dict set understacks $i_u $u_codestack |
||||
lappend outcols $grapheme |
||||
if {$width > 1} { |
||||
incr i_u |
||||
#presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?) |
||||
#but what about emoji combinations etc - can they be wider than 2? |
||||
dict set understacks $i_u $u_codestack |
||||
lappend outcols "" |
||||
} |
||||
} |
||||
|
||||
#underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here |
||||
|
||||
#only stack SGR (graphics rendition) codes - not title sets, cursor moves etc |
||||
#order of if-else based on assumptions: |
||||
# that pure resets are fairly common - more so than leading resets with other info |
||||
# that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all. |
||||
if {[punk::ansi::codetype::is_sgr_reset $code]} { |
||||
set u_codestack [list] |
||||
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
set u_codestack [list $code] |
||||
} elseif {[punk::ansi::codetype::is_sgr $code]} { |
||||
lappend u_codestack $code |
||||
} |
||||
#consider also if there are other codes that should be stacked..? |
||||
} |
||||
#trailing codes in effect for underlay |
||||
if {[llength $undermap]} { |
||||
dict set understacks [expr {$i_u + 1}] $u_codestack |
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- |
||||
#### |
||||
#if opt_colstart - we need to build a space (or any singlewidth char really) padding on the left of the right number of columns. |
||||
#this will be processed as transparent - and handle doublewidth underlay characters appropriately |
||||
set startpad [string repeat " " [expr {$opt_colstart -1}]] |
||||
append startpad $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency |
||||
set overmap [punk::ansi::ta::split_codes_single $startpad] |
||||
#### |
||||
set colcursor $opt_colstart |
||||
|
||||
#set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} |
||||
#as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes |
||||
|
||||
|
||||
set overstacks [dict create] |
||||
set o_codestack [list] |
||||
set pt_overchars "" |
||||
foreach {pt code} $overmap { |
||||
append pt_overchars $pt |
||||
foreach grapheme [punk::char::grapheme_split $pt] { |
||||
dict set overstacks $i_o $o_codestack |
||||
incr i_o |
||||
} |
||||
|
||||
if {[punk::ansi::codetype::is_sgr $code]} { |
||||
if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
#m code which has sgr reset at start - no need to replay prior sgr codes |
||||
set o_codestack [list $code] |
||||
} else { |
||||
lappend o_codestack $code |
||||
} |
||||
} |
||||
|
||||
#only stack SGR (graphics rendition) codes - not title sets, cursor moves etc |
||||
#order of if-else based on assumptions: |
||||
# that pure resets are fairly common - more so than leading resets with other info |
||||
# that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all. |
||||
if {[punk::ansi::codetype::is_sgr_reset $code]} { |
||||
set o_codestack [list] |
||||
} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { |
||||
set o_codestack [list $code] |
||||
} elseif {[punk::ansi::codetype::is_sgr $code]} { |
||||
lappend o_codestack $code |
||||
} |
||||
|
||||
} |
||||
# -- --- --- --- --- --- --- --- |
||||
|
||||
|
||||
#potential problem - combinining diacritics directly following control chars like \r \b |
||||
|
||||
set bs [format %c 0x08] |
||||
set idx 0 ;# line index (cursor - 1) |
||||
set idx_over -1 |
||||
foreach {pt code} $overmap { |
||||
#set ptchars [split $pt ""] ;#for lookahead |
||||
set overlay_graphemes [punk::char::grapheme_split $pt] |
||||
#emit plaintext chars first using existing SGR codes from under/over stack as appropriate |
||||
#then check if the following code is a cursor movement within the line and adjust index if so |
||||
foreach ch $overlay_graphemes { |
||||
set within_undercols [expr {$idx <= [llength $outcols]-1}] |
||||
incr idx_over |
||||
if {$ch eq "\r"} { |
||||
set idx [expr {$opt_colstart -1}] |
||||
} elseif {$ch eq "\b"} { |
||||
#review - backspace effect on double-width chars |
||||
if {$idx > ($opt_colstart -1)} { |
||||
incr idx -1 |
||||
} |
||||
} elseif {($idx < ($opt_colstart -1))} { |
||||
incr idx |
||||
} elseif {($do_transparency && [regexp $opt_transparent $ch])} { |
||||
#pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay) |
||||
if {$idx > [llength $outcols]-1} { |
||||
lappend outcols " " |
||||
dict set understacks $idx [list] ;#review - use idx-1 codestack? |
||||
incr idx |
||||
} else { |
||||
set uwidth [punk::char::string_width [lindex $outcols $idx]] |
||||
if {[lindex $outcols $idx] eq ""} { |
||||
#2nd col of 2-wide char in underlay |
||||
incr idx |
||||
} elseif {$uwidth == 0} { |
||||
#e.g control char ? combining diacritic ? |
||||
incr idx |
||||
} elseif {$uwidth == 1} { |
||||
set owidth [punk::char::string_width $ch] |
||||
incr idx |
||||
if {$owidth > 1} { |
||||
incr idx |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
if {[punk::char::string_width $ch] == 1} { |
||||
#normal singlewide transparency |
||||
set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay |
||||
if {$next_pt_overchar eq ""} { |
||||
#special-case trailing transparent - no next_pt_overchar |
||||
incr idx |
||||
} else { |
||||
if {[regexp $opt_transparent $next_pt_overchar]} { |
||||
incr idx |
||||
} else { |
||||
#next overlay char is not transparent.. first-half of underlying 2wide char is exposed |
||||
priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} |
||||
} else { |
||||
#2wide transparency over 2wide in underlay |
||||
incr idx |
||||
} |
||||
} |
||||
} |
||||
} else { |
||||
#non-transparent char in overlay |
||||
set uwidth [punk::char::string_width [lindex $outcols $idx]] |
||||
|
||||
if {$within_undercols && [lindex $outcols $idx] eq ""} { |
||||
#2nd col of 2wide char in underlay |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
#JMN - this has to expose if our startposn chopped an underlay - but not if we already overwrote the first half of the widechar underlay grapheme |
||||
#e.g renderline \uFF21\uFF21--- a\uFF23\uFF23 |
||||
#vs |
||||
# renderline -startcolumn 2 \uFF21---- \uFF23 |
||||
if {[lindex $outcols $idx-1] != ""} { |
||||
#verified it's an empty following a filled - so it's a legit underlay remnant |
||||
#reset previous to an exposed 1st-half - but leave understacks code as is |
||||
priv::render_addchar [expr {$idx-1}] $opt_exposed1 [dict get $understacks [expr {$idx-1}]] |
||||
} |
||||
incr idx |
||||
|
||||
} elseif {$uwidth == 0} { |
||||
if {$within_undercols} { |
||||
#e.g combining diacritic - increment before over char REVIEW |
||||
#arguably the previous overchar should have done this - ie lookahead for combiners? |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} else { |
||||
#overflow |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} |
||||
} elseif {$uwidth == 1} { |
||||
set owidth [punk::char::string_width $ch] |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
} else { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx "" [dict get $overstacks $idx_over] |
||||
#if next column in underlay empty - we've overwritten first half of underlying 2wide grapheme |
||||
#replace with rhs exposure in case there are no more overlay graphemes coming - use underlay's stack |
||||
if {[llength $outcols] >= [expr {$idx +2}] && [lindex $outcols $idx+1] eq ""} { |
||||
priv::render_addchar [expr {$idx+1}] $opt_exposed2 [dict get $understacks [expr {$idx+1}]] |
||||
} |
||||
incr idx |
||||
} |
||||
} elseif {$uwidth > 1} { |
||||
set owidth [punk::char::string_width $ch] |
||||
if {$owidth == 1} { |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx |
||||
priv::render_addchar $idx $opt_exposed2 [dict get $overstacks $idx_over] |
||||
#don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char |
||||
} else { |
||||
#2wide over 2wide |
||||
priv::render_addchar $idx $ch [dict get $overstacks $idx_over] |
||||
incr idx 2 |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
#cursor movement? |
||||
#if {![punk::ansi::codetype::is_sgr $code]} { |
||||
# |
||||
#} |
||||
if {[punk::ansi::codetype::is_cursor_move_in_line $code]} { |
||||
} |
||||
set re_col_move {\x1b\[([0-9]*)(C|D|G)} |
||||
if {[regexp $re_col_move $code _match num type]} { |
||||
if {$type eq "C"} { |
||||
#left-arrow/move-back |
||||
if {$num eq ""} {set num 1} |
||||
incr idx -$num |
||||
if {$idx < $opt_colstart} { |
||||
set idx $opt_colstart |
||||
} |
||||
} elseif {$type eq "D"} { |
||||
#right-arrow/move forward |
||||
if {$num eq ""} {set num 1} |
||||
if {!$opt_overflow || ($idx + $num) <= [llength $outcols]-1} { |
||||
incr idx $num |
||||
if {$idx > [llength $outcols]-1} { |
||||
set idx [llength $outcols] -1 |
||||
} |
||||
} else { |
||||
set idxstart $idx |
||||
set idxend [expr {[llength $outcols]-1}] |
||||
set moveend [expr {$idxend - $idxstart}] |
||||
incr idx $moveend |
||||
set stackinfo [dict get $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext |
||||
#pad outcols |
||||
set movemore [expr {$num - $moveend}] |
||||
#assert movemore always at least 1 or we wouldn't be in this branch |
||||
for {set m 1} {$m <= $movemore} {incr m} { |
||||
incr idx |
||||
priv::render_addchar $idx " " $stackinfo |
||||
} |
||||
} |
||||
} elseif {$type eq "G"} { |
||||
#move absolute column |
||||
#adjust to colstart - as column 1 is within overlay |
||||
#ie |
||||
set num [expr {$num + $opt_colstart}] |
||||
error "renderline absolute col move ESC G unimplemented" |
||||
} |
||||
|
||||
} |
||||
} |
||||
|
||||
if {$opt_overflow == 0} { |
||||
#need to truncate to the width of the original undertext |
||||
#review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok? |
||||
set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars |
||||
} |
||||
|
||||
#coalesce and replay codestacks for outcols grapheme list |
||||
set outstring "" |
||||
set remstring "" ;#remainder after overflow point reached |
||||
set i 0 |
||||
set cstack [list] |
||||
set prevstack [list] |
||||
set out_rawchars ""; #for overflow counting |
||||
set output_to "outstring" ;#var in effect depending on overflow |
||||
set in_overflow 0 ;#used to stop char-width scanning once in overflow |
||||
foreach ch $outcols { |
||||
append out_rawchars $ch |
||||
if {$opt_overflow == 0 && !$in_overflow} { |
||||
if {[set nextvisualwidth [punk::char::string_width $out_rawchars]] > $num_under_columns} { |
||||
#todo - check if we overflowed with a double-width char ? |
||||
#store visualwidth which may be short |
||||
set in_overflow 1 |
||||
} |
||||
} |
||||
if {$in_overflow} { |
||||
set output_to "remstring" |
||||
} |
||||
set cstack [dict get $understacks $i] |
||||
if {$cstack ne $prevstack} { |
||||
if {[llength $prevstack]} { |
||||
append $output_to \033\[m |
||||
} |
||||
foreach code $cstack { |
||||
append $output_to $code |
||||
} |
||||
} |
||||
append $output_to $ch |
||||
set prevstack $cstack |
||||
incr i |
||||
} |
||||
if {[dict size $understacks] > 0} { |
||||
append $output_to [join [dict get $understacks [expr {[dict size $understacks]-1}]] ""] ;#tail codes |
||||
} |
||||
if {[string length $remstring]} { |
||||
#puts stderr "remainder:$remstring" |
||||
} |
||||
#pdict $understacks |
||||
if {$opt_returnextra} { |
||||
set cursorinfo "" |
||||
return [list result $outstring visualwidth - stringlen [string length $outstring] remainder $remstring cursor [expr {$idx + 1}]] |
||||
} else { |
||||
return $outstring |
||||
} |
||||
#return [join $out ""] |
||||
} |
||||
proc overtype::test_renderline {} { |
||||
set t \uFF5E ;#2-wide tilde |
||||
set u \uFF3F ;#2-wide underscore |
||||
set missing \uFFFD |
||||
return [list $t $u A${t}B] |
||||
} |
||||
|
||||
#maintenance warning |
||||
#same as textblock::size - but we don't want that circular dependency |
||||
#block width and height can be tricky. e.g \v handled differently on different terminal emulators and can affect both |
||||
proc overtype::blocksize {textblock} { |
||||
if {$textblock eq ""} { |
||||
return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings |
||||
} |
||||
set textblock [textutil::tabify::untabify2 $textblock] |
||||
#stripansi on entire block in one go rather than line by line - result should be the same - review - make tests |
||||
set textblock [punk::ansi::stripansi $textblock] |
||||
if {[string first \n $textblock] >= 0} { |
||||
set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width $v}]] |
||||
} else { |
||||
set width [punk::char::string_width $textblock] |
||||
} |
||||
set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list |
||||
#our concept of block-height is likely to be different to other line-counting mechanisms |
||||
set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le |
||||
|
||||
return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height |
||||
} |
||||
|
||||
namespace eval overtype::priv { |
||||
|
||||
#is actually addgrapheme? |
||||
proc render_addchar {i c stack} { |
||||
upvar outcols o |
||||
upvar understacks ustacks |
||||
set nxt [llength $o] |
||||
if {$i < $nxt} { |
||||
lset o $i $c |
||||
} else { |
||||
lappend o $c |
||||
} |
||||
dict set ustacks $i $stack |
||||
} |
||||
|
||||
} |
||||
|
||||
|
||||
|
||||
# -- --- --- --- --- --- --- --- --- --- --- |
||||
namespace eval overtype { |
||||
interp alias {} ::overtype::center {} ::overtype::centre |
||||
} |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide overtype [namespace eval overtype { |
||||
variable version |
||||
set version 1.5.7 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,276 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2024 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application poshinfo 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_poshinfo 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 poshinfo] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of poshinfo |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by poshinfo |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
package require punk::config |
||||
package require json ;#tcllib |
||||
#toml, yaml? |
||||
|
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package {punk::config}] |
||||
#[item] [package {json}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# oo::class namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#tcl::namespace::eval poshinfo::class { |
||||
#*** !doctools |
||||
#[subsection {Namespace poshinfo::class}] |
||||
#[para] class definitions |
||||
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { |
||||
#*** !doctools |
||||
#[list_begin enumerated] |
||||
|
||||
# oo::class create interface_sample1 { |
||||
# #*** !doctools |
||||
# #[enum] CLASS [class interface_sample1] |
||||
# #[list_begin definitions] |
||||
|
||||
# method test {arg1} { |
||||
# #*** !doctools |
||||
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||
# #[para] test method |
||||
# puts "test: $arg1" |
||||
# } |
||||
|
||||
# #*** !doctools |
||||
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||
# } |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end class enumeration ---}] |
||||
#} |
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval poshinfo { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
#variable xyz |
||||
|
||||
#*** !doctools |
||||
#[subsection {Namespace poshinfo}] |
||||
#[para] Core API functions for poshinfo |
||||
#[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" |
||||
#} |
||||
|
||||
proc info_from_filename {fname} { |
||||
#string based filename processing: we are deliberately avoiding test of file existence etc here |
||||
if {$fname eq ""} { |
||||
error "poshinfo::info_from_filename unable to determine name from empty string" |
||||
} |
||||
if {[string first . $fname] < 0} { |
||||
#theoretically we could have a file without dots - but it's more likely an error in this context |
||||
error "poshinfo::info_from_filename supplied value '$fname' doesn't look like a filename. Cowardly refusing to guess a shortname." |
||||
} |
||||
set ftail [file tail $fname] |
||||
set rootname [file rootname $ftail] |
||||
set format [string trimleft [file extension $ftail] .] |
||||
set parts [split $rootname .] |
||||
if {[lindex $parts end] eq "omp"} { |
||||
set type omp |
||||
set shortname [join [lrange $parts 0 end-1] .] |
||||
} else { |
||||
if {$rootname eq "schema"} { |
||||
set type schema |
||||
} else { |
||||
set type unknown |
||||
} |
||||
set shortname $rootname |
||||
} |
||||
return [dict create shortname $shortname format $format type $type] |
||||
} |
||||
|
||||
proc themes_dict {{globfor *}} { |
||||
set running_config [punk::config::get running-config] |
||||
set posh_themes_path [tcl::dict::get $running_config posh_themes_path] |
||||
#posh_themes_path_extra ?? |
||||
|
||||
set themes [tcl::dict::create] |
||||
|
||||
if {[string length $posh_themes_path]} { |
||||
if {[file exists $posh_themes_path]} { |
||||
set files [glob -nocomplain -directory $posh_themes_path -tails $globfor] |
||||
foreach ftail $files { |
||||
set themeinfo [info_from_filename $ftail] |
||||
set shortname [dict get $themeinfo shortname] |
||||
dict set themeinfo path [file join $posh_themes_path $ftail] |
||||
if {![dict exists $themes $shortname]} { |
||||
dict set themes $shortname [list $themeinfo] |
||||
} else { |
||||
dict lappend themes $shortname $themeinfo |
||||
} |
||||
} |
||||
} |
||||
} |
||||
return $themes |
||||
} |
||||
proc themes {{globfor *}} { |
||||
set themes [themes_dict $globfor] |
||||
set posh_theme [file normalize [punk::config::get_running_global posh_theme]] |
||||
set t [textblock::class::table new "Posh Themes"] |
||||
$t configure -show_header 1 -show_hseps 0 |
||||
$t add_column -headers Shortname |
||||
$t add_column -headers Path |
||||
dict for {shortname themeinfolist} $themes { |
||||
#hack - support just one for now |
||||
set themeinfo [lindex $themeinfolist 0] |
||||
|
||||
set path [dict get $themeinfo path] |
||||
$t add_row [list $shortname $path] |
||||
set fg "" |
||||
set bg "" |
||||
switch -- [dict get $themeinfo type] { |
||||
schema { |
||||
set bg Web-orange |
||||
} |
||||
omp {} |
||||
unknown { |
||||
set bg Web-red |
||||
} |
||||
default { |
||||
#we shouldn't be getting other values |
||||
set bg Web-yellow |
||||
} |
||||
} |
||||
if {$posh_theme eq [file normalize $path]} { |
||||
set fg web-limegreen |
||||
} |
||||
if {"$fg$bg" ne ""} { |
||||
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ {*}$fg {*}$bg] |
||||
} |
||||
} |
||||
set result [$t print] |
||||
$t destroy |
||||
return $result |
||||
} |
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace poshinfo ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval poshinfo::lib { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
tcl::namespace::path [tcl::namespace::parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace poshinfo::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 poshinfo::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval poshinfo::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace poshinfo::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide poshinfo [tcl::namespace::eval poshinfo { |
||||
variable pkg poshinfo |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
@ -0,0 +1,3 @@
|
||||
0.1.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in new issue