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

154 lines
4.4 KiB
Plaintext
Executable File

$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
******************************************************************************
*
* Catalog all BASIC programs
*
* 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.
* 05/13/91 8345 DTM changed print to tprint
* 3/14/91 7673 DTM Made changes to CHOICE.BOX.B
* 1/13/91 7673 DTM Put in final changes
* 12/17/90 7673 DTM Added motif menuing, initial programming
*
*******************************************************************************
* This subroutine will accept as an argument the value of the operation
* to perform. It can perform the following functions on spooler jobs:
******************************************************************************
id = "%W%"
******************************************************************************
* Various Prompts and Help string values
*****************************************************************************
equ PRMPT.LOC to 2
equ SHRT.HELP to 4
equ LONG.HELP to 5
******************************************************************************
* Various other variables
******************************************************************************
equ Clear.Screen to TPRINT @(-1)
equ Yes to 1
equ No to 0
******************************************************************************
* Strings from help messages and such
******************************************************************************
GOSUB init.messages ;* initialize all messages
GOSUB init.files ;* Initialize /usr/spool/uv/sp.config
******************************************************************************
* In this section, we draw the first screen, print the menu bar and help
* areas, and put up the first title and form to fill out.
******************************************************************************
ID="CATALOG.PGMS"
SOURCE.MACHINE=NULL
Q=NULL
REC=NULL
CALL *GET.PGMS(ID,Q,fvsavedlists,fvvoc,REC,SOURCE.MACHINE)
Clear.Screen
IF Q="XX" OR Q="xx" OR Q=-1 THEN STOP
CALL *DRAW.SCRN.B(UVREADMSG(073701,""),1)
TYPE=NULL
DO.INDIVIDUAL.PGMS=No
CAT.STYLE=NULL
READV CAT.STYLE FROM fvvoc, "CATALOG", 6 ELSE CAT.STYLE="I"
CAT.STYLE=CAT.STYLE[1,1]
IF CAT.STYLE="I" THEN
Q=NULL
GOSUB catalog.type
BEGIN CASE
CASE TYPE="N"
TYPE=NULL
CASE TYPE="G"
DO.INDIVIDUAL.PGMS=Yes
CASE TYPE="L"
TYPE="LOCAL"
END CASE
END
PARAGRAPH=NULL
PARAGRAPH<1>="PA"
NEXT.LINE=2
NBR.PROGRAMS=DCOUNT(REC,@AM)
FOR I=1 TO NBR.PROGRAMS
IF DO.INDIVIDUAL.PGMS THEN
OPEN "",REC<I> TO fvjunk ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,REC<I>),2)
GOTO end.for
END
SELECT fvjunk
EOF=No
LOOP
READNEXT PGM.ID ELSE EOF=Yes
UNTIL EOF DO
PARAGRAPH<NEXT.LINE>=msg3:SPACE:REC<I>:msg4:PGM.ID:msg5
NEXT.LINE += 1
REPEAT
END ELSE
PARAGRAPH<NEXT.LINE>=msg3:SPACE:REC<I>:msg4:SPACE:TYPE
NEXT.LINE += 1
END
end.for:
NEXT I
WRITE PARAGRAPH ON fvvoc,"CATALOG.ALL.PGMS"
CALL *HELP.PRINT.B(UVREADMSG(073702,"CATALOG.ALL.PGMS"),2)
EXECUTE "PHANTOM CATALOG.ALL.PGMS" CAPTURING error
SLEEP 2
IF error # NULL THEN
CALL *HELP.PRINT.B(NULL,3)
count=DCOUNT(error,@FM)+1
FOR i=1 TO count
IF error<i> # NULL THEN CALL *HELP.PRINT.B(error<i>,2)
NEXT i
END
SLEEP 3
STOP @(-1)
catalog.type:
s.val=1
CALL *CHOICE.BOX.B(8,4,50,UVREADMSG(073703,""),UVREADMSG(073700,""),s.val,UVREADMSG(073704,""))
BEGIN CASE
CASE s.val=-1
SLEEP 1
STOP @(-1)
CASE s.val=0
Q="G"
CASE s.val=1
Q="N"
CASE s.val=2
Q="L"
END CASE
TYPE=Q
RETURN
init.messages:
scratch=UVREADMSG(073705,"")
msg3=scratch<1>
msg4=scratch<2>
msg5=scratch<3>
RETURN
init.files:
OPEN "","&SAVEDLISTS&" TO fvsavedlists ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,"&SAVEDLISTS&"),2)
SLEEP 3
STOP @(-1)
END
OPEN "","VOC" TO fvvoc ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,"VOC"),2)
SLEEP 3
STOP @(-1)
END
RETURN
STOP @(-1)
END