1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
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
##
# ### ### ### ######### ######### #########
|
