1 files changed, 92 insertions, 0 deletions
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
+
+##
+# ### ### ### ######### ######### #########