tldm-universe/Ardent/UV/APP.PROGS/COMO
2024-09-09 17:51:08 -04:00

86 lines
2.6 KiB
Plaintext
Executable File

********************************************************************************
*
* 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