conmux/drivers/x3270_glue.expect

   1 # Copyright 2000, 2004 by Paul Mattes.
   2 #  Permission to use, copy, modify, and distribute this software and its
   3 #  documentation for any purpose and without fee is hereby granted,
   4 #  provided that the above copyright notice appear in all copies and that
   5 #  both that copyright notice and this permission notice appear in
   6 #  supporting documentation.
   7 #
   8 # x3270, c3270, s3270 and tcl3270 are distributed in the hope that they will
   9 # be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file LICENSE
  11 # for more details.
  12
  13 # Glue functions between 'expect' and x3270
  14 # Usage: source x3270_glue.expect
  15
  16 namespace eval x3270 {
  17         variable verbose 0
  18         variable pid 0
  19
  20         # Start function: Start ?-nohup? ?program? ?options?
  21         #
  22         # Sets up the 'expect' environment correctly and spawns a 3270
  23         # interface process.
  24         #
  25         # The 'program' and 'options' can be:
  26         #  "x3270 -script" to drive an x3270 session
  27         #  "s3270" to drive a displayless 3270 session
  28         #  "x3270if -i" to run as a child script of x3270 (via the Script()
  29         #   action)
  30         #
  31         # If "args" is empty, or starts with an option besides '-nohup',
  32         #  guesses which process to start.
  33         # It will only guess "x3270if -i" or "s3270"; if you want to start
  34         #  x3270, you need to specify it explicitly.
  35         #
  36         # Returns the process ID of the spawned process.
  37
  38         proc Start {args} {
  39                 global stty_init timeout spawn_id env
  40                 variable verbose
  41                 variable pid
  42
  43                 if {$pid != 0} {return -code error "Already started."}
  44
  45                 # If the first argument is "-nohup", remember that as an
  46                 # argument to 'spawn'.
  47                 if {[lindex $args 0] == "-nohup"} {
  48                         set nohup {-ignore HUP}
  49                         set args [lrange $args 1 end]
  50                 } {
  51                         set nohup {}
  52                 }
  53
  54                 # If there are no arguments, or the first argument is an
  55                 #  option, guess what to start.
  56                 # If X3270INPUT is defined in the environment, this must be a
  57                 #  child script; start x3270if.  Otherwise, this must be a peer
  58                 #  script; start s3270.
  59                 if {$args == {} || [string index [lindex $args 0] 0] == "-"} {
  60                         if {[info exists env(X3270INPUT)]} {
  61                                 set args [concat x3270if -i $args]
  62                         } {
  63                                 set args [concat s3270 $args]
  64                         }
  65                 }
  66
  67                 # Set up the pty initialization default.
  68                 set stty_init -echo
  69
  70                 # Spawn the process.
  71                 if {$verbose} {
  72                         set pid [eval [concat spawn $nohup $args]]
  73                 } {
  74                         set pid [eval [concat spawn -noecho $nohup $args]]
  75                         log_user 0
  76                 }
  77
  78                 # Set the 'expect' timeout.
  79                 set timeout -1
  80
  81                 return $pid
  82         }
  83
  84         # Basic interface command.  Used internally by the action functions
  85         # below.
  86         proc cmd {cmd} {
  87                 variable verbose
  88                 variable pid
  89
  90                 if {$pid==0} { return -code error "Not started yet." }
  91
  92                 if {$verbose} {puts "+$cmd"}
  93
  94                 send "$cmd\r"
  95                 expect {
  96                         -re "data: (.*)\r\n.*\r\nok\r\n$" {
  97                                 set r $expect_out(buffer)
  98                         }
  99                         "*ok\r\n" { return {} }
 100                         -re "(.*)\r\n.*?\r\nerror\r\n" {
 101                                 return -code error "$expect_out(1,string)"
 102                         }
 103                         "*error\r\n" {
 104                                 return -code error \
 105                                         "$cmd failed: $expect_out(buffer)"
 106                         }
 107                         eof { set pid 0; error "process died" }
 108                 }
 109
 110                 # Convert result to a list.
 111                 set ret {}
 112                 set iter 0
 113                 while {1} {
 114                         if {! [regexp "data: (.*?)\r\n" $r dummy elt]} {break}
 115                         if {$iter==1} {set ret [list $ret]}
 116                         set r [string range $r [expr [string length $elt]+7] \
 117                                 end]
 118                         if {$iter > 0} {
 119                                 set ret [linsert $ret end $elt]
 120                         } {
 121                                 set ret $elt
 122                         }
 123                         set iter [expr $iter + 1]
 124                 }
 125                 if {$verbose} {puts "ret $iter"}
 126                 return $ret
 127         }
 128
 129         # Convert an argument list to a comma-separated list that x3270 will
 130         # accept.
 131         proc commafy {alist} {
 132                 set i 0
 133                 set a ""
 134                 while {$i < [llength $alist]} {
 135                         if {$i > 0} {
 136                                 set a "$a,[lindex $alist $i]"
 137                         } {
 138                                 set a [lindex $alist $i]
 139                         }
 140                         incr i
 141                 }
 142                 return $a
 143         }
 144
 145         # Quote a text string into x3270-acceptable format.
 146         proc stringify {text} {
 147                 set a "\""
 148                 set i 0
 149                 while {$i < [string len $text]} {
 150                         set c [string range $text $i $i]
 151                         switch -- $c {
 152                                 "\n" { set a "$a\\n" }
 153                                 "\r" { set a "$a\\r" }
 154                                 " " { set a "$a\\ " }
 155                                 "\"" { set a "$a\\\"" }
 156                                 default { set a "$a$c" }
 157                         }
 158                         incr i
 159                 }
 160                 set a "$a\""
 161                 return $a
 162         }
 163
 164         # User-accessible actions.
 165         # Some of these apply only to x3270 and x3270if, and not to s3270.
 166         proc AltCursor {} { return [cmd "AltCursor"] }
 167         proc Ascii {args} { return [cmd "Ascii([commafy $args])"] }
 168         proc AsciiField {} { return [cmd "AsciiField"] }
 169         proc Attn {} { return [cmd "Attn"] }
 170         proc BackSpace {} { return [cmd "BackSpace"] }
 171         proc BackTab {} { return [cmd "BackTab"] }
 172         proc CircumNot {} { return [cmd "CircumNot"] }
 173         proc Clear {} { return [cmd "Clear"] }
 174         proc CloseScript {} { return [cmd "CloseScript"] }
 175         proc Cols {} { return [lindex [Status] 7] }
 176         proc Compose {} { return [cmd "Compose"] }
 177         proc Connect {host} { return [cmd "Connect($host)"] }
 178         proc CursorSelect {} { return [cmd "CursorSelect"] }
 179         proc Delete {} { return [cmd "Delete"] }
 180         proc DeleteField {} { return [cmd "DeleteField"] }
 181         proc DeleteWord {} { return [cmd "DeleteWord"] }
 182         proc Disconnect {} { return [cmd "Disconnect"] }
 183         proc Down {} { return [cmd "Down"] }
 184         proc Dup {} { return [cmd "Dup"] }
 185         proc Ebcdic {args} { return [cmd "Ebcdic([commafy $args])"] }
 186         proc EbcdicField {} { return [cmd "EbcdicField"] }
 187         proc Enter {} { return [cmd "Enter"] }
 188         proc Erase {} { return [cmd "Erase"] }
 189         proc EraseEOF {} { return [cmd "EraseEOF"] }
 190         proc EraseInput {} { return [cmd "EraseInput"] }
 191         proc FieldEnd {} { return [cmd "FieldEnd"] }
 192         proc FieldMark {} { return [cmd "FieldMark"] }
 193         proc FieldExit {} { return [cmd "FieldExit"] }
 194         proc Flip {} { return [cmd "Flip"] }
 195         proc HexString {x} { return [cmd "HexString($x)"] }
 196         proc Home {} { return [cmd "Home"] }
 197         proc Info {text} { return [cmd "Info([stringify $text])"] }
 198         proc Insert {} { return [cmd "Insert"] }
 199         proc Interrupt {} { return [cmd "Interrupt"] }
 200         proc Key {k} { return [cmd "Key($k)"] }
 201         proc Keymap {k} { return [cmd "Keymap($k)"] }
 202         proc Left {} { return [cmd "Left"] }
 203         proc Left2 {} { return [cmd "Left2"] }
 204         proc MonoCase {} { return [cmd "MonoCase"] }
 205         proc MoveCursor {r c} { return [cmd "MoveCursor($r,$c)"] }
 206         proc Newline {} { return [cmd "Newline"] }
 207         proc NextWord {} { return [cmd "NextWord"] }
 208         proc PA {n} { return [cmd "PA($n)"] }
 209         proc PF {n} { return [cmd "PF($n)"] }
 210         proc PreviousWord {} { return [cmd "PreviousWord"] }
 211         proc Quit {} { exit }
 212         proc Reset {} { return [cmd "Reset"] }
 213         proc Right {} { return [cmd "Right"] }
 214         proc Right2 {} { return [cmd "Right2"] }
 215         proc Rows {} { return [lindex [Status] 6] }
 216         proc SetFont {font} { return [cmd "SetFont($font)"] }
 217         proc Snap {args} { return [cmd "Snap([commafy $args])"] }
 218         proc Status {} {
 219                 variable verbose
 220                 variable pid
 221                 if {$pid==0} { return -code error "Not started yet." }
 222                 if {$verbose} {puts "+(nothing)"}
 223                 send "\r"
 224                 expect {
 225                         "*ok\r\n" { set r $expect_out(buffer) }
 226                         eof { set pid 0; error "process died" }
 227                 }
 228                 return [string range $r 0 [expr [string length $r]-7]]
 229         }
 230         proc String {text} { return [cmd "String([stringify $text])"] }
 231         proc SysReq {} { return [cmd "SysReq"] }
 232         proc Tab {} { return [cmd "Tab"] }
 233         proc ToggleInsert {} { return [cmd "ToggleInsert"] }
 234         proc ToggleReverse {} { return [cmd "ToggleReverse"] }
 235         proc TemporaryKeymap {args} { return [cmd "TemporaryKeymap($args)"] }
 236         proc Transfer {args} { return [cmd "Transfer([commafy $args])"] }
 237         proc Up {} { return [cmd "Up"] }
 238         proc Wait {args} { return [cmd "Wait([commafy $args])"] }
 239
 240         # Extra function to toggle verbosity on the fly.
 241         proc Setverbose {level} {
 242                 variable verbose
 243                 set verbose $level
 244                 return
 245         }
 246
 247         # Export all the user-visible functions.
 248         namespace export \[A-Z\]*
 249 }
 250
 251 # Import all of the exported functions.
 252 namespace import x3270::*