diff options
Diffstat (limited to 'tcllib/modules/term/ansi')
| -rw-r--r-- | tcllib/modules/term/ansi/code.tcl | 56 | ||||
| -rw-r--r-- | tcllib/modules/term/ansi/code/attr.tcl | 108 | ||||
| -rw-r--r-- | tcllib/modules/term/ansi/code/ctrl.tcl | 270 | ||||
| -rw-r--r-- | tcllib/modules/term/ansi/code/macros.tcl | 93 | ||||
| -rw-r--r-- | tcllib/modules/term/ansi/ctrlunix.tcl | 91 | ||||
| -rw-r--r-- | tcllib/modules/term/ansi/send.tcl | 92 |
6 files changed, 710 insertions, 0 deletions
diff --git a/tcllib/modules/term/ansi/code.tcl b/tcllib/modules/term/ansi/code.tcl new file mode 100644 index 0000000..a8f7d3e --- /dev/null +++ b/tcllib/modules/term/ansi/code.tcl @@ -0,0 +1,56 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI +## Generic commands to define commands for code sequences. + +# ### ### ### ######### ######### ######### +## Requirements + +namespace eval ::term::ansi::code {} + +# ### ### ### ######### ######### ######### +## API. Escape clauses, plain and bracket +## Used by 'define'd commands. + +proc ::term::ansi::code::esc {str} {return \033$str} +proc ::term::ansi::code::escb {str} {esc \[$str} + +# ### ### ### ######### ######### ######### +## API. Define command for named control code, or constant. +## (Simple definitions without arguments) + +proc ::term::ansi::code::define {name escape code} { + proc [Qualified $name] {} [list ::term::ansi::code::$escape $code] +} + +proc ::term::ansi::code::const {name code} { + proc [Qualified $name] {} [list return $code] +} + +# ### ### ### ######### ######### ######### +## Internal helper to construct fully-qualified names. + +proc ::term::ansi::code::Qualified {name} { + if {![string match ::* $name]} { + # Get the caller's namespace; append :: if it is not the + # global namespace, for separation from the actual name. + set ns [uplevel 2 [list namespace current]] + if {$ns ne "::"} {append ns ::} + set name $ns$name + } + return $name +} + +# ### ### ### ######### ######### ######### + +namespace eval ::term::ansi::code { + namespace export esc escb define const +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::code 0.2 + +## +# ### ### ### ######### ######### ######### diff --git a/tcllib/modules/term/ansi/code/attr.tcl b/tcllib/modules/term/ansi/code/attr.tcl new file mode 100644 index 0000000..842beda --- /dev/null +++ b/tcllib/modules/term/ansi/code/attr.tcl @@ -0,0 +1,108 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI - Attribute codes + +# ### ### ### ######### ######### ######### +## Requirements + +package require term::ansi::code ; # Constants + +namespace eval ::term::ansi::code::attr {} + +# ### ### ### ######### ######### ######### +## API. Symbolic names. + +proc ::term::ansi::code::attr::names {} { + variable attr + return $attr +} + +proc ::term::ansi::code::attr::import {{ns attr} args} { + if {![llength $args]} {set args *} + set args ::term::ansi::code::attr::[join $args " ::term::ansi::code::attr::"] + uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]] + return +} + +# ### ### ### ######### ######### ######### +## Internal - Setup + +proc ::term::ansi::code::attr::DEF {name value} { + variable attr + const $name $value + lappend attr $name + namespace export $name + return +} + +proc ::term::ansi::code::attr::INIT {} { + # ### ### ### ######### ######### ######### + ## + + # Colors. Foreground <=> Text + DEF fgblack 30 ; # Black + DEF fgred 31 ; # Red + DEF fggreen 32 ; # Green + DEF fgyellow 33 ; # Yellow + DEF fgblue 34 ; # Blue + DEF fgmagenta 35 ; # Magenta + DEF fgcyan 36 ; # Cyan + DEF fgwhite 37 ; # White + DEF fgdefault 39 ; # Default (Black) + + # Colors. Background. + DEF bgblack 40 ; # Black + DEF bgred 41 ; # Red + DEF bggreen 42 ; # Green + DEF bgyellow 43 ; # Yellow + DEF bgblue 44 ; # Blue + DEF bgmagenta 45 ; # Magenta + DEF bgcyan 46 ; # Cyan + DEF bgwhite 47 ; # White + DEF bgdefault 49 ; # Default (Transparent) + + # Non-color attributes. Activation. + DEF bold 1 ; # Bold + DEF dim 2 ; # Dim + DEF italic 3 ; # Italics + DEF underline 4 ; # Underscore + DEF blink 5 ; # Blink + DEF revers 7 ; # Reverse + DEF hidden 8 ; # Hidden + DEF strike 9 ; # StrikeThrough + + # Non-color attributes. Deactivation. + DEF nobold 22 ; # Bold + DEF nodim __ ; # Dim + DEF noitalic 23 ; # Italics + DEF nounderline 24 ; # Underscore + DEF noblink 25 ; # Blink + DEF norevers 27 ; # Reverse + DEF nohidden 28 ; # Hidden + DEF nostrike 29 ; # StrikeThrough + + # Remainder + DEF reset 0 ; # Reset + + ## + # ### ### ### ######### ######### ######### + return +} + +# ### ### ### ######### ######### ######### +## Data structures. + +namespace eval ::term::ansi::code::attr { + namespace import ::term::ansi::code::const + variable attr {} +} + +::term::ansi::code::attr::INIT + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::code::attr 0.1 + +## +# ### ### ### ######### ######### ######### diff --git a/tcllib/modules/term/ansi/code/ctrl.tcl b/tcllib/modules/term/ansi/code/ctrl.tcl new file mode 100644 index 0000000..167ae80 --- /dev/null +++ b/tcllib/modules/term/ansi/code/ctrl.tcl @@ -0,0 +1,270 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI - Control codes + +## References +# [0] Google: ansi terminal control +# [1] http://vt100.net/docs/vt100-ug/chapter3.html +# [2] http://www.termsys.demon.co.uk/vtansi.htm +# [3] http://rrbrandt.dyndns.org:60000/docs/tut/redes/ansi.php +# [4] http://www.dee.ufcg.edu.br/~rrbrandt/tools/ansi.html +# [5] http://www.ecma-international.org/publications/standards/Ecma-048.htm + +# ### ### ### ######### ######### ######### +## Requirements + +package require term::ansi::code +package require term::ansi::code::attr + +namespace eval ::term::ansi::code::ctrl {} + +# ### ### ### ######### ######### ######### +## API. Symbolic names. + +proc ::term::ansi::code::ctrl::names {} { + variable ctrl + return $ctrl +} + +proc ::term::ansi::code::ctrl::import {{ns ctrl} args} { + if {![llength $args]} {set args *} + set args ::term::ansi::code::ctrl::[join $args " ::term::ansi::code::ctrl::"] + uplevel 1 [list namespace eval $ns [linsert $args 0 namespace import]] + return +} + +# ### ### ### ######### ######### ######### + +## TODO = symbolic key codes for skd. + +# ### ### ### ######### ######### ######### +## Internal - Setup + +proc ::term::ansi::code::ctrl::DEF {name esc value} { + variable ctrl + define $name $esc $value + lappend ctrl $name + namespace export $name + return +} + +proc ::term::ansi::code::ctrl::DEFC {name arguments script} { + variable ctrl + proc $name $arguments $script + lappend ctrl $name + namespace export $name + return +} + +proc ::term::ansi::code::ctrl::INIT {} { + # ### ### ### ######### ######### ######### + ## + + # Erasing + + DEF eeol escb K ; # Erase (to) End Of Line + DEF esol escb 1K ; # Erase (to) Start Of Line + DEF el escb 2K ; # Erase (current) Line + DEF ed escb J ; # Erase Down (to bottom) + DEF eu escb 1J ; # Erase Up (to top) + DEF es escb 2J ; # Erase Screen + + # Scrolling + + DEF sd esc D ; # Scroll Down + DEF su esc M ; # Scroll Up + + # Cursor Handling + + DEF ch escb H ; # Cursor Home + DEF sc escb s ; # Save Cursor + DEF rc escb u ; # Restore Cursor (Unsave) + DEF sca esc 7 ; # Save Cursor + Attributes + DEF rca esc 8 ; # Restore Cursor + Attributes + + # Tabbing + + DEF st esc H ; # Set Tab (@ current position) + DEF ct escb g ; # Clear Tab (@ current position) + DEF cat escb 3g ; # Clear All Tabs + + # Device Introspection + + DEF qdc escb c ; # Query Device Code + DEF qds escb 5n ; # Query Device Status + DEF qcp escb 6n ; # Query Cursor Position + DEF rd esc c ; # Reset Device + + # Linewrap on/off + + DEF elw escb 7h ; # Enable Line Wrap + DEF dlw escb 7l ; # Disable Line Wrap + + # Graphics Mode (aka use alternate font on/off) + + DEF eg esc F ; # Enter Graphics Mode + DEF lg esc G ; # Exit Graphics Mode + + ## + # ### ### ### ######### ######### ######### + + # ### ### ### ######### ######### ######### + ## Complex, parameterized codes + + # Select Character Set + # Choose which char set is used for default and + # alternate font. This does not change whether + # default or alternate font are used + + DEFC scs0 {tag} {esc ($tag} ; # Set default character set + DEFC scs1 {tag} {esc )$tag} ; # Set alternate character set + + # tags in A : United Kingdom Set + # B : ASCII Set + # 0 : Special Graphics + # 1 : Alternate Character ROM Standard Character Set + # 2 : Alternate Character ROM Special Graphics + + # Set Display Attributes + + DEFC sda {args} {escb [join $args \;]m} + + # Force Cursor Position (aka Go To) + + DEFC fcp {r c} {escb ${r}\;${c}f} + + # Cursor Up, Down, Forward, Backward + + DEFC cu {{n 1}} {escb [expr {$n == 1 ? "A" : "${n}A"}]} + DEFC cd {{n 1}} {escb [expr {$n == 1 ? "B" : "${n}B"}]} + DEFC cf {{n 1}} {escb [expr {$n == 1 ? "C" : "${n}C"}]} + DEFC cb {{n 1}} {escb [expr {$n == 1 ? "D" : "${n}D"}]} + + # Scroll Screen (entire display, or between rows start end, inclusive). + + DEFC ss {args} { + if {[llength $args] == 0} {return [escb r]} + if {[llength $args] == 2} {foreach {s e} $args break ; return [escb ${s};${e}r]} + return -code error "wrong\#args" + } + + # Set Key Definition + + DEFC skd {code str} {escb $code\;\"$str\"p} + + # Terminal title + + DEFC title {str} {esc \]0\;$str\007} + + # Switch to and from character/box graphics. + + DEFC gron {} {return \016} + DEFC groff {} {return \017} + + # Character graphics, box symbols + # - 4 corners, 4 t-junctions, + # one 4-way junction, 2 lines + + DEFC tlc {} {return [gron]l[groff]} ; # Top Left Corner + DEFC trc {} {return [gron]k[groff]} ; # Top Right Corner + DEFC brc {} {return [gron]j[groff]} ; # Bottom Right Corner + DEFC blc {} {return [gron]m[groff]} ; # Bottom Left Corner + + DEFC ltj {} {return [gron]t[groff]} ; # Left T Junction + DEFC ttj {} {return [gron]w[groff]} ; # Top T Junction + DEFC rtj {} {return [gron]u[groff]} ; # Right T Junction + DEFC btj {} {return [gron]v[groff]} ; # Bottom T Junction + + DEFC fwj {} {return [gron]n[groff]} ; # Four-Way Junction + + DEFC hl {} {return [gron]q[groff]} ; # Horizontal Line + DEFC vl {} {return [gron]x[groff]} ; # Vertical Line + + # Optimize character graphics. The generator commands above create + # way to many superfluous commands shifting into and out of the + # graphics mode. The command below removes all shifts which are + # not needed. To this end it also knows which characters will look + # the same in both modes, to handle strings created outside this + # package. + + DEFC groptim {string} { + variable grforw + variable grback + while {![string equal $string [set new [string map \ + [list \017\016 {} \016\017 {}] [string map \ + $grback [string map \ + $grforw $string]]]]]} { + set string $new + } + return $string + } + + ## + # ### ### ### ######### ######### ######### + + # ### ### ### ######### ######### ######### + ## Higher level operations + + # Clear screen <=> CursorHome + EraseDown + # Init (Fonts): Default ASCII, Alternate Graphics + # Show a block of text at a specific location. + + DEFC clear {} {return [ch][ed]} + DEFC init {} {return [scs0 B][scs1 0]} + + DEFC showat {r c text} { + if {![string length $text]} {return {}} + return [fcp $r $c][sca][join \ + [split $text \n] \ + [rca][cd][sca]][rca][cd] + } + + ## + # ### ### ### ######### ######### ######### + + # ### ### ### ######### ######### ######### + ## Attribute control (single attributes) + + foreach a [::term::ansi::code::attr::names] { + DEF sda_$a escb [::term::ansi::code::attr::$a]m + } + + ## + # ### ### ### ######### ######### ######### + return +} + +# ### ### ### ######### ######### ######### +## Data structures. + +namespace eval ::term::ansi::code::ctrl { + namespace import ::term::ansi::code::define + namespace import ::term::ansi::code::esc + namespace import ::term::ansi::code::escb + + variable grforw + variable grback + variable _ + + foreach _ { + ! \" # $ % & ' ( ) * + , - . / + 0 1 2 3 4 5 6 7 8 9 : ; < = > + ? @ 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 [ ^ + \\ ] + } { + lappend grforw \016$_ $_\016 + lappend grback $_\017 \017$_ + } + unset _ +} + +::term::ansi::code::ctrl::INIT + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::code::ctrl 0.2 + +## +# ### ### ### ######### ######### ######### diff --git a/tcllib/modules/term/ansi/code/macros.tcl b/tcllib/modules/term/ansi/code/macros.tcl new file mode 100644 index 0000000..1f1d47d --- /dev/null +++ b/tcllib/modules/term/ansi/code/macros.tcl @@ -0,0 +1,93 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI - Higher level macros + +# ### ### ### ######### ######### ######### +## Requirements + +package require textutil::repeat +package require textutil::tabify +package require term::ansi::code::ctrl + +namespace eval ::term::ansi::code::macros {} + +# ### ### ### ######### ######### ######### +## API. Symbolic names. + +proc ::term::ansi::code::macros::import {{ns macros} args} { + if {![llength $args]} {set args *} + set args ::term::ansi::code::macros::[join $args " ::term::ansi::code::macros::"] + uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]] + return +} + +# ### ### ### ######### ######### ######### +## Higher level operations + +# Format a menu / framed block of text + +proc ::term::ansi::code::macros::menu {menu} { + # Menu = dict (label => char) + array set _ {} + set shift 0 + foreach {label c} $menu { + if {[string first $c $label] < 0} { + set shift 1 + break + } + } + set max 0 + foreach {label c} $menu { + set pos [string first $c $label] + if {$shift || ($pos < 0)} { + set xlabel "$c $label" + set pos 0 + } else { + set xlabel $label + } + set len [string length $xlabel] + if {$len > $max} {set max $len} + set _($label) " [string replace $xlabel $pos $pos \ + [cd::sda_fgred][cd::sda_bold][string index $xlabel $pos][cd::sda_reset]]" + } + + append ms [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]\n + foreach {l c} $menu {append ms $_($l)\n} + append ms [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc] + + return [cd::groptim $ms] +} + +proc ::term::ansi::code::macros::frame {string} { + set lines [split [textutil::tabify::untabify2 $string] \n] + set max 0 + foreach l $lines { + if {[set len [string length $l]] > $max} {set max $len} + } + append fs [cd::tlc][textutil::repeat::strRepeat [cd::hl] $max][cd::trc]\n + foreach l $lines { + append fs [cd::vl]${l}[textutil::repeat::strRepeat " " [expr {$max-[string length $l]}]][cd::vl]\n + } + append fs [cd::blc][textutil::repeat::strRepeat [cd::hl] $max][cd::brc] + return [cd::groptim $fs] +} + +## +# ### ### ### ######### ######### ######### + +# ### ### ### ######### ######### ######### +## Data structures. + +namespace eval ::term::ansi::code::macros { + term::ansi::code::ctrl::import cd + + namespace export menu frame +} + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::code::macros 0.1 + +## +# ### ### ### ######### ######### ######### diff --git a/tcllib/modules/term/ansi/ctrlunix.tcl b/tcllib/modules/term/ansi/ctrlunix.tcl new file mode 100644 index 0000000..675348c --- /dev/null +++ b/tcllib/modules/term/ansi/ctrlunix.tcl @@ -0,0 +1,91 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI - Control operations +## (Unix specific implementation). + +## This was originally taken from page 11820 (Pure Tcl Console Editor) +## of the Tcler's Wiki, however page 14693 (Reading a single character +## ...) is the same in a more self-contained manner. + +# ### ### ### ######### ######### ######### +## Requirements + +namespace eval ::term::ansi::ctrl::unix {} + +# ### ### ### ######### ######### ######### +## Make command easily available + +proc ::term::ansi::ctrl::unix::import {{ns ctrl} args} { + if {![llength $args]} {set args *} + set args ::term::ansi::ctrl::unix::[join $args " ::term::ansi::ctrl::unix::"] + uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]] + return +} + +# ### ### ### ######### ######### ######### +## API + +# We use the <@stdin because stty works out what terminal to work with +# using standard input on some platforms. On others it prefers +# /dev/tty instead, but putting in the redirection makes the code more +# portable + +proc ::term::ansi::ctrl::unix::raw {} { + variable stty + exec $stty raw -echo <@stdin + return +} + +proc ::term::ansi::ctrl::unix::cooked {} { + variable stty + exec $stty -raw echo <@stdin + return +} + +proc ::term::ansi::ctrl::unix::columns {} { + variable tput + return [exec $tput cols <@stdin] +} + +proc ::term::ansi::ctrl::unix::rows {} { + variable tput + return [exec $tput lines <@stdin] +} + +# ### ### ### ######### ######### ######### +## Package setup + +proc ::term::ansi::ctrl::unix::INIT {} { + variable tput [auto_execok tput] + variable stty [auto_execok stty] + + if {($stty eq "/usr/ucb/stty") && + ($::tcl_platform(os) eq "SunOS")} { + set stty /usr/bin/stty + } + + if {($tput eq "") || ($stty eq "")} { + return -code error \ + "The external requirements for the \ + use of this package (tput, stty in \ + \$PATH) are not met." + } + return +} + +namespace eval ::term::ansi::ctrl::unix { + variable tput {} + variable stty {} + + namespace export columns rows raw cooked +} + +::term::ansi::ctrl::unix::INIT + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::ctrl::unix 0.1.1 + +## +# ### ### ### ######### ######### ######### diff --git a/tcllib/modules/term/ansi/send.tcl b/tcllib/modules/term/ansi/send.tcl new file mode 100644 index 0000000..d47f834 --- /dev/null +++ b/tcllib/modules/term/ansi/send.tcl @@ -0,0 +1,92 @@ +# -*- tcl -*- +# ### ### ### ######### ######### ######### +## Terminal packages - ANSI - Control codes + +# ### ### ### ######### ######### ######### +## Requirements + +package require Tcl 8.4 +package require term::send +package require term::ansi::code::ctrl + +namespace eval ::term::ansi::send {} + +# ### ### ### ######### ######### ######### +## Make command easily available + +proc ::term::ansi::send::import {{ns send} args} { + if {![llength $args]} {set args *} + set args ::term::ansi::send::[join $args " ::term::ansi::send::"] + uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]] + return +} + +# ### ### ### ######### ######### ######### +## Internal - Setup. + +proc ::term::ansi::send::ChName {n} { + if {![string match *-* $n]} { + return ${n}ch + } + set nl [split $n -] + set stem [lindex $nl 0] + set sfx [join [lrange $nl 1 end] -] + return ${stem}ch-$sfx +} + +proc ::term::ansi::send::Args {n -> arv achv avv} { + upvar 1 $arv a $achv ach $avv av + set code ::term::ansi::code::ctrl::$n + set a [info args $code] + set av [expr { + [llength $a] + ? " \$[join $a { $}]" + : $a + }] + foreach a1 $a[set a {}] { + if {[info default $code $a1 default]} { + lappend a [list $a1 $default] + } else { + lappend a $a1 + } + } + set ach [linsert $a 0 ch] + return $code +} + +proc ::term::ansi::send::INIT {} { + foreach n [::term::ansi::code::ctrl::names] { + set nch [ChName $n] + set code [Args $n -> a ach av] + + if {[lindex $a end] eq "args"} { + # An args argument requires more care, and an eval + set av [lrange $av 0 end-1] + if {$av ne {}} {set av " $av"} + set gen "eval \[linsert \$args 0 $code$av\]" + #8.5: (written for clarity): set gen "$code$av {*}\$args" + } else { + set gen $code$av + } + + proc $n $a "wr \[$gen\]" ; namespace export $n + proc $nch $ach "wrch \$ch \[$gen\]" ; namespace export $nch + } + return +} + +namespace eval ::term::ansi::send { + namespace import ::term::send::wr + namespace import ::term::send::wrch + namespace export wr wrch +} + +::term::ansi::send::INIT + +# ### ### ### ######### ######### ######### +## Ready + +package provide term::ansi::send 0.2 + +## +# ### ### ### ######### ######### ######### |