1# Copyright (c) 2000-2009, Paul Mattes.
2# All rights reserved.
3#
4# Redistribution and use in source and binary forms, with or without
5# modification, are permitted provided that the following conditions are met:
6#     * Redistributions of source code must retain the above copyright
7#       notice, this list of conditions and the following disclaimer.
8#     * Redistributions in binary form must reproduce the above copyright
9#       notice, this list of conditions and the following disclaimer in the
10#       documentation and/or other materials provided with the distribution.
11#     * Neither the names of Paul Mattes nor the names of his contributors
12#       may be used to endorse or promote products derived from this software
13#       without specific prior written permission.
14#
15# THIS SOFTWARE IS PROVIDED BY PAUL MATTES "AS IS" AND ANY EXPRESS OR IMPLIED
16# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
17# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
18# EVENT SHALL PAUL MATTES BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
19# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
20# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
21# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
22# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
23# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
24# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
25
26# Glue functions between 'expect' and x3270
27# Usage: source x3270_glue.expect
28
29namespace eval x3270 {
30	variable verbose 0
31	variable pid 0
32
33	# Start function: Start ?-nohup? ?program? ?options?
34	#
35	# Sets up the 'expect' environment correctly and spawns a 3270
36	# interface process.
37	#
38	# The 'program' and 'options' can be:
39	#  "x3270 -script" to drive an x3270 session
40	#  "s3270" to drive a displayless 3270 session
41	#  "x3270if -i" to run as a child script of x3270 (via the Script()
42	#   action)
43	#
44	# If "args" is empty, or starts with an option besides '-nohup',
45	#  guesses which process to start.
46	# It will only guess "x3270if -i" or "s3270"; if you want to start
47	#  x3270, you need to specify it explicitly.
48	#
49	# Returns the process ID of the spawned process.
50
51	proc Start {args} {
52		global stty_init timeout spawn_id env
53		variable verbose
54		variable pid
55
56		if {$pid != 0} {return -code error "Already started."}
57
58		# If the first argument is "-nohup", remember that as an
59		# argument to 'spawn'.
60		if {[lindex $args 0] == "-nohup"} {
61			set nohup {-ignore HUP}
62			set args [lrange $args 1 end]
63		} {
64			set nohup {}
65		}
66
67		# If there are no arguments, or the first argument is an
68		#  option, guess what to start.
69		# If X3270INPUT is defined in the environment, this must be a
70		#  child script; start x3270if.  Otherwise, this must be a peer
71		#  script; start s3270.
72		if {$args == {} || [string index [lindex $args 0] 0] == "-"} {
73			if {[info exists env(X3270INPUT)]} {
74				set args [concat x3270if -i $args]
75			} {
76				if {$::tcl_platform(platform) == "windows"} {
77					set args [concat ws3270 $args]
78				} {
79					set args [concat s3270 $args]
80				}
81			}
82		}
83
84		# Set up the pty initialization default.
85		set stty_init -echo
86
87		# Spawn the process.
88		if {$verbose} {
89			set pid [eval [concat spawn $nohup $args]]
90		} {
91			set pid [eval [concat spawn -noecho $nohup $args]]
92			log_user 0
93		}
94
95		# Set the 'expect' timeout.
96		set timeout -1
97
98		return $pid
99	}
100
101	# Basic interface command.  Used internally by the action functions
102	# below.
103	proc cmd {cmd} {
104		variable verbose
105		variable pid
106
107		if {$pid==0} { return -code error "Not started yet." }
108
109		if {$verbose} {puts "+$cmd"}
110
111		send "$cmd\r"
112		expect {
113			-re "data: (.*)\r?\n.*\r?\nok\r?\n$" {
114				set r $expect_out(buffer)
115			}
116			-re ".*ok\r?\n" { return {} }
117			-re "(.*)\r?\n.*?\r?\nerror\r?\n" {
118				return -code error "$expect_out(1,string)"
119			}
120			-re ".*error\r?\n" {
121				return -code error \
122					"$cmd failed: $expect_out(buffer)"
123			}
124			eof { set pid 0; error "process died" }
125		}
126
127		# Convert result to a list.
128		set ret {}
129		set iter 0
130		while {1} {
131			if {! [regexp "data: (.*?)\r?\n" $r dummy elt]} {break}
132			if {$iter==1} {set ret [list $ret]}
133			set r [string range $r [expr [string length $elt]+7] \
134				end]
135			if {$iter > 0} {
136				set ret [linsert $ret end $elt]
137			} {
138				set ret $elt
139			}
140			set iter [expr $iter + 1]
141		}
142		if {$verbose} {puts "ret $iter"}
143		return $ret
144	}
145
146	# Convert an argument list to a comma-separated list that x3270 will
147	# accept.
148	proc commafy {alist} {
149		set i 0
150		set a ""
151		while {$i < [llength $alist]} {
152			if {$i > 0} {
153				set a "$a,[lindex $alist $i]"
154			} {
155				set a [lindex $alist $i]
156			}
157			incr i
158		}
159		return $a
160	}
161
162	# Quote a text string into x3270-acceptable format.
163	proc stringify {text} {
164		set a "\""
165		set i 0
166		while {$i < [string len $text]} {
167			set c [string range $text $i $i]
168			switch -- $c {
169				"\n" { set a "$a\\n" }
170				"\r" { set a "$a\\r" }
171				" " { set a "$a\\ " }
172				"\"" { set a "$a\\\"" }
173				default { set a "$a$c" }
174			}
175			incr i
176		}
177		set a "$a\""
178		return $a
179	}
180
181	# User-accessible actions.
182	# Some of these apply only to x3270 and x3270if, and not to s3270.
183	proc AltCursor {} { return [cmd "AltCursor"] }
184	proc Ascii {args} { return [cmd "Ascii([commafy $args])"] }
185	proc AsciiField {} { return [cmd "AsciiField"] }
186	proc Attn {} { return [cmd "Attn"] }
187	proc BackSpace {} { return [cmd "BackSpace"] }
188	proc BackTab {} { return [cmd "BackTab"] }
189	proc CircumNot {} { return [cmd "CircumNot"] }
190	proc Clear {} { return [cmd "Clear"] }
191	proc CloseScript {} { return [cmd "CloseScript"] }
192	proc Cols {} { return [lindex [Status] 7] }
193	proc Compose {} { return [cmd "Compose"] }
194	proc Connect {host} { return [cmd "Connect($host)"] }
195	proc CursorSelect {} { return [cmd "CursorSelect"] }
196	proc Delete {} { return [cmd "Delete"] }
197	proc DeleteField {} { return [cmd "DeleteField"] }
198	proc DeleteWord {} { return [cmd "DeleteWord"] }
199	proc Disconnect {} { return [cmd "Disconnect"] }
200	proc Down {} { return [cmd "Down"] }
201	proc Dup {} { return [cmd "Dup"] }
202	proc Ebcdic {args} { return [cmd "Ebcdic([commafy $args])"] }
203	proc EbcdicField {} { return [cmd "EbcdicField"] }
204	proc Enter {} { return [cmd "Enter"] }
205	proc Erase {} { return [cmd "Erase"] }
206	proc EraseEOF {} { return [cmd "EraseEOF"] }
207	proc EraseInput {} { return [cmd "EraseInput"] }
208	proc FieldEnd {} { return [cmd "FieldEnd"] }
209	proc FieldMark {} { return [cmd "FieldMark"] }
210	proc FieldExit {} { return [cmd "FieldExit"] }
211	proc Flip {} { return [cmd "Flip"] }
212	proc HexString {x} { return [cmd "HexString($x)"] }
213	proc Home {} { return [cmd "Home"] }
214	proc Info {text} { return [cmd "Info([stringify $text])"] }
215	proc Insert {} { return [cmd "Insert"] }
216	proc Interrupt {} { return [cmd "Interrupt"] }
217	proc Key {k} { return [cmd "Key($k)"] }
218	proc Keymap {k} { return [cmd "Keymap($k)"] }
219	proc Left {} { return [cmd "Left"] }
220	proc Left2 {} { return [cmd "Left2"] }
221	proc MonoCase {} { return [cmd "MonoCase"] }
222	proc MoveCursor {r c} { return [cmd "MoveCursor($r,$c)"] }
223	proc Newline {} { return [cmd "Newline"] }
224	proc NextWord {} { return [cmd "NextWord"] }
225	proc PA {n} { return [cmd "PA($n)"] }
226	proc PF {n} { return [cmd "PF($n)"] }
227	proc PreviousWord {} { return [cmd "PreviousWord"] }
228	proc Quit {} { exit }
229	proc Reset {} { return [cmd "Reset"] }
230	proc Right {} { return [cmd "Right"] }
231	proc Right2 {} { return [cmd "Right2"] }
232	proc Rows {} { return [lindex [Status] 6] }
233	proc SetFont {font} { return [cmd "SetFont($font)"] }
234	proc Snap {args} { return [cmd "Snap([commafy $args])"] }
235	proc Status {} {
236		variable verbose
237		variable pid
238		if {$pid==0} { return -code error "Not started yet." }
239		if {$verbose} {puts "+(nothing)"}
240		send "\r"
241		expect {
242			-re ".*ok\r?\n" { set r $expect_out(buffer) }
243			eof { set pid 0; error "process died" }
244		}
245		return [string range $r 0 [expr [string length $r]-7]]
246	}
247	proc String {text} { return [cmd "String([stringify $text])"] }
248	proc SysReq {} { return [cmd "SysReq"] }
249	proc Tab {} { return [cmd "Tab"] }
250	proc ToggleInsert {} { return [cmd "ToggleInsert"] }
251	proc ToggleReverse {} { return [cmd "ToggleReverse"] }
252	proc TemporaryKeymap {args} { return [cmd "TemporaryKeymap($args)"] }
253	proc Transfer {args} { return [cmd "Transfer([commafy $args])"] }
254	proc Up {} { return [cmd "Up"] }
255	proc Wait {args} { return [cmd "Wait([commafy $args])"] }
256
257	# Extra function to toggle verbosity on the fly.
258	proc Setverbose {level} {
259		variable verbose
260		set verbose $level
261		return
262	}
263
264	# Export all the user-visible functions.
265	namespace export \[A-Z\]*
266}
267
268# Import all of the exported functions.
269namespace import x3270::*
270