tldm-universe/Ardent/UV/BP/COMO_VERB

******************************************************************************
*
*	Divert output into a COMmand Output file
*
*	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 10401 WLG Fix prompt logic to save/restore prompt character
*	07/25/88   -    -  Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************

$OPTIONS DEFAULT

	equ ncode to 7, nfile to 99

	dim code(6)

	oldprompt = SYSTEM(26)
	prompt " "

	cmdline = @sentence

	code(0) = "ON"
	code(1) = "OFF"
	code(2) = "DELETE"
	code(3) = "SPOOL"
	code(4) = "LIST"
	code(5) = "Q"
	code(6) = "QUIT"

	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"
			prompt oldprompt
			stop
		end
	end

	null
	if status() # 1 and status() # 19 then
		@SYSTEM.RETURN.CODE = -1
		print "'&COMO&' must be a type 1 or type 19 file"
		prompt oldprompt
		stop
	end

	equ action to line(2)
	equ file   to line(3)
	equ param  to line(4)

	dim line(4),cfiles(nfile)
	matparse line from trim(cmdline) , " "

	cflg = (action = "")
	if cflg then
geta:		file = ""
getb:		print "Enter action (ON, OFF, DELETE, LIST, SPOOL, QUIT) =":
		@SYSTEM.RETURN.CODE = 0
		input action
		if action = "" then prompt oldprompt; stop
	end
	action = upcase(action)

	acode = -1; i = 0
	loop
		if action = code(i) then acode = i
	while acode = -1 do
		i += 1
	while i < ncode do
	repeat


	if acode<0 then 
		print "Illegal option '":action:"'"
		print "Type ON, OFF, DELETE, LIST, SPOOL or QUIT."
		@SYSTEM.RETURN.CODE = -1
		if cflg then goto geta; else prompt oldprompt; stop
	end

	if acode = 0 or acode = 2 or acode = 3 then
		if file = "" then
			if cflg then
				print "Enter COMO file name =":
				input file
				if file = "" then goto geta
			end else
				print "Required file name missing from your command."
				@SYSTEM.RETURN.CODE = 0
				prompt oldprompt;
			 	stop
			end
		end
	end

	begin case
	case acode = 0					; * ON
		hush = 0
		if cflg then
			print "Terminal display on? (Y/N) =":
			input param
			if upcase(param[1,1]) = "N" then hush = 1
		end else
			if upcase(param) = "HUSH" then hush = 1
		end

		cmd = "DIVERT.OUT ON &COMO& ":file
		if hush then cmd:=" TTY.OFF"
		cmd := " TRUNCATE"
		execute cmd returning stat

		@SYSTEM.RETURN.CODE = stat
		if stat = 0 then print "COMO ":file:" established ":timedate()
		if cflg then goto geta; else prompt oldprompt; stop
	case acode = 1					; * OFF
		print "COMO completed. ":timedate()
		execute "DIVERT.OUT OFF"
		if cflg then goto geta; else prompt oldprompt; stop
	case acode = 2					; * DELETE
		if file = "*" then
		   execute "CLEAR.FILE &COMO&"
		end else
		  delete f.como,file
		  print "COMO ":file:" deleted."
		end
		if cflg then goto geta; else prompt oldprompt; stop
	case acode = 3					; * SPOOL
		lines = 0

		openseq	"&COMO&",file to f.scomo else
			print "Unable to open '":file:"'"
			@SYSTEM.RETURN.CODE = -1
			if cflg then goto geta; else prompt oldprompt; stop
		end
		if cflg then
			print "Enter 'T' for Terminal, or Null for Line Printer = ":
			input param
		end
		if upcase(param) # "T" then printer on

		lwid = system(2)
loop:		readseq text from f.scomo then
			if text[1] = char(13) then text = text[1,len(text)-1]
			tlen = len(text)
			bpos = 1
			loop while tlen >= 0
				pline = text[bpos,bpos+lwid-1]
				print pline
				bpos += lwid
				tlen -= lwid
				lines += 1
			repeat
			goto loop
		end
		closeseq f.scomo

		printer close
		printer off
		print; print "COMO ":file:", ":lines:" lines ":timedate()
		if cflg then goto geta; else prompt oldprompt; stop
	case acode = 4					; * LIST
		heading "COMO file listing 'TL'"

		kount = 0
		select f.como
sloop:		readnext id then
			kount += 1
			cfiles(kount) = id
			print fmt(kount,"r%2"):" ":id
			goto sloop
		end
		print "Enter number of file to be selected =":
		input selfile
		if selfile # '' and selfile>0 and selfile<=kount then
			file = cfiles(selfile)
		end
		cflg = 1;
		goto getb
	case acode = 5						; * Q
		prompt oldprompt
		stop
	case acode = 6						; * QUIT
		prompt oldprompt
		stop
	end case