86 lines
2.6 KiB
Plaintext
86 lines
2.6 KiB
Plaintext
|
********************************************************************************
|
||
|
|
*
|
||
|
|
* Support of PR1ME INFORMATION subroutine '!COMO'
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 03/17/93 9449 WLG Fixed comments, and logic when 16 bit is set
|
||
|
|
* so that bit 2 will turn TTY back on.
|
||
|
|
* Added create of &COMO& if it doesn't exist.
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS DEFAULT
|
||
|
|
|
||
|
|
subroutine PR1ME(key , filename)
|
||
|
|
|
||
|
|
*************************************************************************
|
||
|
|
* *
|
||
|
|
* Support of PR1ME INFORMATION subroutine !COMO *
|
||
|
|
* *
|
||
|
|
* key Action *
|
||
|
|
* *
|
||
|
|
* 1 Disable terminal output *
|
||
|
|
* 2 Enable terminal output *
|
||
|
|
* 8 Disable output to COMO file *
|
||
|
|
* 16 Enable output to COMO file *
|
||
|
|
* 32 Append to end of file if enabling COMO *
|
||
|
|
* Close file if disabling COMO *
|
||
|
|
* 64 Truncate file in enabling COMO *
|
||
|
|
* *
|
||
|
|
*************************************************************************
|
||
|
|
|
||
|
|
open "&COMO&" to f.como else
|
||
|
|
execute "CREATE.BFILE &COMO& 1,1 1,1 'used for COMO listings'"
|
||
|
|
open "&COMO&" to f.como else
|
||
|
|
@SYSTEM.RETURN.CODE = -1
|
||
|
|
print "Unable to create '&COMO&' file"
|
||
|
|
stop
|
||
|
|
end
|
||
|
|
end
|
||
|
|
|
||
|
|
if bitand(key,8) then
|
||
|
|
if bitand(key,32) then
|
||
|
|
execute "DIVERT.OUT OFF"
|
||
|
|
end else
|
||
|
|
execute "DIVERT.OUT FILE.OFF"
|
||
|
|
end
|
||
|
|
if bitand(key,1) then
|
||
|
|
execute "DIVERT.OUT TTY.OFF"
|
||
|
|
end
|
||
|
|
else if bitand(key,2) then
|
||
|
|
execute "DIVERT.OUT TTY.ON"
|
||
|
|
end
|
||
|
|
end
|
||
|
|
else if bitand(key,16) then
|
||
|
|
if filename = "" then
|
||
|
|
cmd = "DIVERT.OUT FILE.ON"
|
||
|
|
end else
|
||
|
|
cmd = "DIVERT.OUT ON &COMO& ":filename
|
||
|
|
end
|
||
|
|
if bitand(key,32) then cmd := " APPEND"
|
||
|
|
if bitand(key,64) then cmd := " TRUNCATE"
|
||
|
|
if bitand(key,2 ) then cmd := " TTY.ON"
|
||
|
|
if bitand(key,1 ) then cmd := " TTY.OFF"
|
||
|
|
execute cmd
|
||
|
|
end
|
||
|
|
else if bitand(key,1) then
|
||
|
|
execute "DIVERT.OUT TTY.OFF"
|
||
|
|
end
|
||
|
|
else if bitand(key,2) then
|
||
|
|
execute "DIVERT.OUT TTY.ON"
|
||
|
|
end
|
||
|
|
return
|