342 lines
8.3 KiB
Plaintext
342 lines
8.3 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* PTERM_VERB
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 01/05/96 17705 PGW MS Windows changes, and removed previous fix
|
||
|
|
* 05/15/95 16523 SJM Added 'unsupported option' code
|
||
|
|
* 07/26/90 6272 JWT Add U6072 & U9072 per Ken Pike of Ultimate
|
||
|
|
* 04/09/90 6997 JWT fix PTERM syntax
|
||
|
|
* 11/13/89 6543 JWT Fix LPTR syntax error bug
|
||
|
|
* 02/03/89 5736 PHH Defaults for control characters
|
||
|
|
* 02/01/89 5718 GPS Correct file names that can't be opened
|
||
|
|
* 12/08/88 5005 PHH Allow leading dash on command tokens.
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$include UNIVERSE.INCLUDE TTY
|
||
|
|
$include UNIVERSE.INCLUDE MACHINE.NAME
|
||
|
|
|
||
|
|
printer off
|
||
|
|
|
||
|
|
open "PTERM.FILE,COMM" to f.cmd else stop "Can't open the 'PTERM.FILE,COMM' file."
|
||
|
|
open "PTERM.FILE,DISP" to f.dis else stop "Can't open the 'PTERM.FILE,DISP' file."
|
||
|
|
open "PTERM.FILE,BAUD" to f.bau else stop "Can't open the 'PTERM.FILE,BAUD' file."
|
||
|
|
|
||
|
|
cmd = trim(@SENTENCE)
|
||
|
|
cnt = dcount(cmd, " ")
|
||
|
|
dim tok(cnt)
|
||
|
|
|
||
|
|
|
||
|
|
matparse tok from cmd," "
|
||
|
|
ptr = 2
|
||
|
|
dis = 0
|
||
|
|
|
||
|
|
if ptr > cnt then goto helpem
|
||
|
|
token = upcase(tok(ptr))
|
||
|
|
begin case
|
||
|
|
case token = "LPTR"
|
||
|
|
ptr += 1
|
||
|
|
if ptr > cnt then goto skiptok
|
||
|
|
mode = 1;
|
||
|
|
if (num(tok(ptr)))
|
||
|
|
then
|
||
|
|
unit = tok(ptr)
|
||
|
|
ptr += 1
|
||
|
|
end
|
||
|
|
else
|
||
|
|
unit = 0
|
||
|
|
end
|
||
|
|
|
||
|
|
case token = "MTU"
|
||
|
|
ptr += 1
|
||
|
|
if ptr > cnt then goto skiptok
|
||
|
|
mode = 2;
|
||
|
|
if (num(tok(ptr)))
|
||
|
|
then
|
||
|
|
unit = tok(ptr)
|
||
|
|
ptr += 1
|
||
|
|
end
|
||
|
|
else
|
||
|
|
unit = 0
|
||
|
|
end
|
||
|
|
|
||
|
|
case token = "DEVICE"
|
||
|
|
ptr += 1
|
||
|
|
if ptr > cnt then goto skiptok
|
||
|
|
mode = 4
|
||
|
|
unit = tok(ptr)
|
||
|
|
ptr += 1
|
||
|
|
|
||
|
|
case 1
|
||
|
|
mode = 3
|
||
|
|
end case
|
||
|
|
|
||
|
|
skiptok:
|
||
|
|
|
||
|
|
begin case
|
||
|
|
case mode = 1
|
||
|
|
TTYGET tty$ FROM LPTR unit ELSE goto badtty
|
||
|
|
device.letter = "S" ;* serial device
|
||
|
|
case mode = 2
|
||
|
|
TTYGET tty$ FROM MTU unit ELSE goto badtty
|
||
|
|
device.letter = "M" ;* not supported - TTYGET will fail
|
||
|
|
case mode = 3
|
||
|
|
TTYGET tty$ ELSE goto badtty
|
||
|
|
if @TTY[1,6] = "telnet" then
|
||
|
|
device.letter = "T"
|
||
|
|
end else
|
||
|
|
* assume it's a console window
|
||
|
|
device.letter = "C"
|
||
|
|
end
|
||
|
|
case mode = 4
|
||
|
|
OPENDEV unit TO dev.file ELSE
|
||
|
|
STOP "PTERM: cannot open device ":unit
|
||
|
|
END
|
||
|
|
TTYGET tty$ FROM dev.file ELSE goto badtty
|
||
|
|
device.letter = "S" ;* serial device
|
||
|
|
end case
|
||
|
|
|
||
|
|
loop:
|
||
|
|
loop
|
||
|
|
while ptr <= cnt do
|
||
|
|
opt.in.error = tok(ptr)
|
||
|
|
token = upcase(tok(ptr))
|
||
|
|
try:
|
||
|
|
read ctrl from f.cmd, token
|
||
|
|
else
|
||
|
|
if token[1,1] = "-" then
|
||
|
|
token = token[2,999]
|
||
|
|
goto try
|
||
|
|
end else
|
||
|
|
stop "Unidentified Token ":quote(token):"."
|
||
|
|
end
|
||
|
|
end
|
||
|
|
ptr += 1
|
||
|
|
|
||
|
|
type = ctrl<1>
|
||
|
|
begin case
|
||
|
|
case type = "$C"
|
||
|
|
if ptr > cnt then goto notok
|
||
|
|
opt.in.error := " ":tok(ptr)
|
||
|
|
val = tok(ptr); ptr += 1
|
||
|
|
begin case
|
||
|
|
case upcase(val) = "ON" ; val = ctrl<3>
|
||
|
|
case upcase(val) = "OFF"; val = -1
|
||
|
|
case val = "^?" ; val = 127
|
||
|
|
case val[1,1] = "^" ; val = seq(upcase(val[2,1]))-seq("A")+1
|
||
|
|
case 1 ; val = seq(val)
|
||
|
|
end case
|
||
|
|
sel = 1
|
||
|
|
case type = "$N"
|
||
|
|
if ptr > cnt then goto notok
|
||
|
|
opt.in.error := " ":tok(ptr)
|
||
|
|
val = tok(ptr); ptr += 1
|
||
|
|
sel = 1
|
||
|
|
case type = "$D"
|
||
|
|
dis = 1
|
||
|
|
sel = 1
|
||
|
|
case type = "$B"
|
||
|
|
sel = 1
|
||
|
|
if ptr > cnt then goto notok
|
||
|
|
opt.in.error := " ":tok(ptr)
|
||
|
|
val = tok(ptr); ptr += 1
|
||
|
|
sselect f.bau to 1
|
||
|
|
loop
|
||
|
|
while readnext baud from 1
|
||
|
|
read rec from f.bau, baud then
|
||
|
|
locate val in rec setting loc then
|
||
|
|
val = baud
|
||
|
|
goto ok
|
||
|
|
end
|
||
|
|
end
|
||
|
|
repeat
|
||
|
|
stop "Illegal BAUD rate: '":val:"'"
|
||
|
|
case type = ""
|
||
|
|
val = ""
|
||
|
|
sel = 1
|
||
|
|
case 1
|
||
|
|
if ptr > cnt then
|
||
|
|
if type<1,1> = "" then
|
||
|
|
sel = 1; goto ok
|
||
|
|
end else
|
||
|
|
goto notok
|
||
|
|
end
|
||
|
|
end
|
||
|
|
opt.in.error := " ":tok(ptr)
|
||
|
|
nxt = upcase(tok(ptr)); ptr += 1
|
||
|
|
nty = dcount(type, @VM)
|
||
|
|
val = ""
|
||
|
|
for sel = 1 to nty
|
||
|
|
if nxt = type<1,sel> then
|
||
|
|
if nxt = "" then ptr -= 1
|
||
|
|
goto ok
|
||
|
|
end
|
||
|
|
next
|
||
|
|
stop "Unknown value ":quote(nxt):" used with ":quote(token):"."
|
||
|
|
end case
|
||
|
|
|
||
|
|
ok:
|
||
|
|
action = ctrl<2,sel>
|
||
|
|
nact = dcount(action,@SVM)
|
||
|
|
for i = 1 to nact
|
||
|
|
act = action<1,1,i>
|
||
|
|
if index(act,"=",1) then
|
||
|
|
var = field(act,"=",1)
|
||
|
|
num = field(act,"=",2)
|
||
|
|
end else
|
||
|
|
var = act
|
||
|
|
num = val
|
||
|
|
end
|
||
|
|
|
||
|
|
read disp from f.dis,var
|
||
|
|
else stop "Unknown Variable ":quote(var):"."
|
||
|
|
|
||
|
|
if disp<6> # "" and index(disp<6>, device.letter, 1) = 0 then
|
||
|
|
if len(opt.in.error) > 0 then
|
||
|
|
print "Warning: option ":quote(opt.in.error):
|
||
|
|
print " is not supported for this device."
|
||
|
|
opt.in.error = "" ;* Don't complain twice
|
||
|
|
end
|
||
|
|
goto next.action
|
||
|
|
end
|
||
|
|
|
||
|
|
if disp<5> = "$S"
|
||
|
|
then assign tty$<disp<1>,disp<2>> to status()
|
||
|
|
|
||
|
|
tty$<disp<1>,disp<2>> = num
|
||
|
|
next.action:
|
||
|
|
next i
|
||
|
|
repeat
|
||
|
|
|
||
|
|
if dis then
|
||
|
|
|
||
|
|
HUSH ON
|
||
|
|
PERFORM "SSELECT PTERM.FILE,DISP BY FMC BY VMC"
|
||
|
|
HUSH OFF
|
||
|
|
|
||
|
|
cw = @CRTWIDE
|
||
|
|
class = ""
|
||
|
|
loop
|
||
|
|
readnext id else exit
|
||
|
|
read item from f.dis,id else item = ""
|
||
|
|
|
||
|
|
if item<5> = "$E" and MODE.TYPE # MODE$EMULATE then goto rep
|
||
|
|
if item<5> = "$C" and MODE.TYPE # MODE$CHAR then goto rep
|
||
|
|
if item<6> # "" and index(item<6>, device.letter, 1) = 0 then
|
||
|
|
goto rep
|
||
|
|
end
|
||
|
|
|
||
|
|
data = tty$<item<1>,item<2>>
|
||
|
|
code = item<3>
|
||
|
|
text = item<4>
|
||
|
|
|
||
|
|
begin case
|
||
|
|
case code = "C"
|
||
|
|
begin case
|
||
|
|
case data = -1; ans=text:"OFF"
|
||
|
|
case data < 32; ans=text:"^":char(data+64):" "
|
||
|
|
case data < 127; ans=text:char(data):" "
|
||
|
|
case data = 127; ans=text:"DEL"
|
||
|
|
case 1; ans=text:oconv(data,"mo") "R\\%3"
|
||
|
|
end case
|
||
|
|
case code = "N"
|
||
|
|
ans = text:data
|
||
|
|
case code = "T"
|
||
|
|
ans = text<1,data+1>
|
||
|
|
case code = "-"
|
||
|
|
if data then ans = text else ans = "-":text
|
||
|
|
case code = "O"
|
||
|
|
if data then ans = text:"ON" else ans = text:"OFF"
|
||
|
|
case code = "Y"
|
||
|
|
if data then ans = text:"YES" else ans = text:"NO"
|
||
|
|
case code = "B"
|
||
|
|
readv ans from f.bau,data,1 else ans = "Unknown"
|
||
|
|
ans = text:ans
|
||
|
|
case 1
|
||
|
|
ans = text
|
||
|
|
end case
|
||
|
|
|
||
|
|
c = field(id,".",1)
|
||
|
|
if c # class then
|
||
|
|
if class # "" then print
|
||
|
|
print c "l#15 ":
|
||
|
|
class = c
|
||
|
|
l = 16
|
||
|
|
end
|
||
|
|
if l + len(ans) + 1 >= cw then
|
||
|
|
print; print space(16):
|
||
|
|
l = 16;
|
||
|
|
end
|
||
|
|
print ans:" ":
|
||
|
|
l += len(ans)+1
|
||
|
|
rep:
|
||
|
|
repeat
|
||
|
|
print
|
||
|
|
|
||
|
|
end
|
||
|
|
|
||
|
|
begin case
|
||
|
|
case mode = 1
|
||
|
|
TTYSET tty$ ON LPTR unit ELSE goto badtty
|
||
|
|
case mode = 2
|
||
|
|
TTYSET tty$ ON MTU unit ELSE goto badtty
|
||
|
|
case mode = 3
|
||
|
|
TTYSET tty$ ELSE goto badtty
|
||
|
|
case mode = 4
|
||
|
|
TTYSET tty$ ON dev.file ELSE goto badtty
|
||
|
|
CLOSE dev.file
|
||
|
|
end case
|
||
|
|
|
||
|
|
stop
|
||
|
|
|
||
|
|
badtty:
|
||
|
|
stop "PTERM: Not a terminal!"
|
||
|
|
|
||
|
|
notok:
|
||
|
|
stop "PTERM: Option '":token:"' requires an argument"
|
||
|
|
|
||
|
|
helpem:
|
||
|
|
print "PTERM options are:"
|
||
|
|
|
||
|
|
print "ERASE char | ON | OFF KILL char | ON | OFF"
|
||
|
|
print "WERASE char | ON | OFF RPRNT char | ON | OFF"
|
||
|
|
print "INTR char | ON | OFF QUIT char | ON | OFF"
|
||
|
|
print "EOF char | ON | OFF EOL char | ON | OFF"
|
||
|
|
print "EOL2 char | ON | OFF LCONT char | ON | OFF"
|
||
|
|
print "FMC char | ON | OFF VMC char | ON | OFF"
|
||
|
|
print "SMC char | ON | OFF"
|
||
|
|
print
|
||
|
|
print "BAUD 50 - 9600"
|
||
|
|
print "BREAK ON | OFF | INTR | IGNORE | NUL"
|
||
|
|
print "BSDELAY ON | OFF"
|
||
|
|
print "CASE INVERT | NOINVERT | LC-IN | LC-OUT | UC-IN | UC-OUT | XCASE | NOXCASE"
|
||
|
|
print "CRMODE INLCR | -INLCR | IGNCR | -IGNCR | ICRNL | -OICRNL |"
|
||
|
|
print " ONLCR | -ONLCR | OCRNL | -CRNL | ONLRET | -ONLRET |"
|
||
|
|
print " ON | OFF"
|
||
|
|
print "DATABITS 5 - 8"
|
||
|
|
print "ECHO ON | OFF | CTRL | NOCTRL | FAST | MEDIUM | SLOW | LF | NOLF"
|
||
|
|
print "FFDELAY 0 - 3"
|
||
|
|
print "FILL ON | OFF | NUL | DEL"
|
||
|
|
print "INPUTCTL ON | OFF | TCL.RESET"
|
||
|
|
print "LFDELAY 0 - 8"
|
||
|
|
print "PARITY EVEN | ODD | NONE | ENABLE | DISABLE | ERR_IGN | ERR_MRK | ERR_NUL"
|
||
|
|
print "STOPBITS 1 - 2"
|
||
|
|
print "TABS ON | OFF"
|
||
|
|
print "VTDELAY ON | OFF"
|
||
|
|
print "XON ON | OFF | STARTANY | NOSTARTANY | TANDEM | NOTANDEM"
|
||
|
|
stop
|