tldm-universe/Ardent/UV/BP/FORMAT.B

242 lines
6.8 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
*******************************************************************************
*
* uniVerse FORMAT.VERB and FANCY.FORMAT 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.
*
*******************************************************************************
*
* Maintenance log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 10/14/98 23801 SAP Change copyrights.
* 01/08/92 10848 PVW Problem when explicit id or * on command line.
* 12/11/92 10708 PVW Open and close VOC here rather than in UV.COM
* 12/02/92 10666 PVW Change UVPRINTMSG to *UVPRINTMSG
* 11/11/92 10666 PVW Replace old call to editor with new verb.
*
*******************************************************************************
$OPTIONS INFORMATION
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
$INCLUDE UNIVERSE.INCLUDE UV.COM
$INCLUDE UNIVERSE.INCLUDE FORMAT.OPTS.H
OPEN "VOC" TO DEVSYS.VOC.FILE ELSE
CALL *UVPRINTMSG(001720,"")
STOP
END
PROMPT ' '
FORMAT.BASIC = '-FORMAT.BASIC'
SENTENCE = @SENTENCE
SENTENCE = TRIM(SENTENCE)
CONVERT ' ' TO @FM IN SENTENCE
*
if SENTENCE<1> = "RUN" or SENTENCE<1> = "RAID" then
SENTENCE = DELETE(SENTENCE,1,0,0)
SENTENCE = DELETE(SENTENCE,1,0,0)
end
*
* extract verb name
*
VERB.NAME = SENTENCE<1>
READV FORMAT.TYPE FROM DEVSYS.VOC.FILE,VERB.NAME,5
ELSE
FORMAT.TYPE = 'FORMAT'
END
SENTENCE = DELETE(SENTENCE,1,0,0)
*
* extract -LIST token
*
LOCATE('-LIST',SENTENCE;POS) THEN
SENTENCE = DELETE(SENTENCE,POS,0,0)
PRINT.FLAG = TRUE
END ELSE
PRINT.FLAG = FALSE
END
*
* see if file name entered
*
FILE.NAME = ''
NUMBER.OF.TOKENS = DCOUNT(SENTENCE,@FM)
IF NUMBER.OF.TOKENS THEN
FILE.NAME = SENTENCE<1>
SENTENCE = DELETE(SENTENCE,1,0,0)
END
FILE.INPUT = FALSE
FILE.VALID = FALSE
LOOP
IF FILE.NAME = '' THEN
FILE.INPUT = TRUE
CALL *UVPRINTMSG(001018,"")
INPUT FILE.NAME
IF FILE.NAME = '' THEN GOTO EXIT.PROGRAM
END
OPENCHECK FILE.NAME TO FILE.VAR THEN
FILE.VALID = TRUE
END
UNTIL FILE.VALID DO
CALL *UVPRINTMSG(020141,FILE.NAME)
FILE.NAME = ''
REPEAT
*
* extract * token
*
ALL.TOKEN = FALSE
LOCATE('*',SENTENCE;POS) THEN
ALL.TOKEN = TRUE
CALL *UVPRINTMSG(001295,"")
SELECT FILE.VAR
SENTENCE = ''
END
*
* if select list active
*
SELECT.ACTIVE = FALSE
EXPLICIT.ID = FALSE
ZERO.ID = FALSE
MANY.ID = FALSE
READLIST RECORD.LIST
THEN
CONVERT @IM TO @FM IN RECORD.LIST
SELECT.ACTIVE = TRUE
IF NOT(FILE.INPUT) AND NOT(ALL.TOKEN) THEN
CALL *UVPRINTMSG(001018,"")
PRINT FILE.NAME
END
END ELSE
RECORD.LIST = SENTENCE
RECORD.COUNT = DCOUNT(RECORD.LIST,@FM)
BEGIN CASE
CASE RECORD.COUNT = 0
ZERO.ID = TRUE
IF NOT(FILE.INPUT) THEN
CALL *UVPRINTMSG(001018,"")
PRINT FILE.NAME
END
CASE RECORD.COUNT = 1
EXPLICIT.ID = TRUE
CASE 1
MANY.ID = TRUE
END CASE
END
*
* prompt for print option
*
IF EXPLICIT.ID OR SELECT.ACTIVE OR MANY.ID ELSE
IF NOT(PRINT.FLAG) THEN
CALL *UVPRINTMSG(001293,"")
INPUT PRINTFLAG,1
IF UPCASE(PRINTFLAG) = "Y" THEN
PRINT.FLAG = TRUE
END
END
END
*
* process items
*
LOOP
RECORD.ID = RECORD.LIST<1>
IF NOT(SELECT.ACTIVE) OR (SELECT.ACTIVE AND ALL.TOKEN) THEN
IF RECORD.ID = '' THEN
IF NOT(ZERO.ID) AND NOT(EXPLICIT.ID) THEN
PRINT
CALL *UVPRINTMSG(001018,"")
PRINT FILE.NAME
END
ZERO.ID = FALSE
END
IF RECORD.ID = '' THEN
IF NOT(EXPLICIT.ID) THEN
CALL *UVPRINTMSG(001290,'')
INPUT RECORD.ID
SELECT.ACTIVE = FALSE
RECORD.LIST<1> = RECORD.ID
END
END
END
UNTIL RECORD.ID = '' DO
IF SELECT.ACTIVE OR MANY.ID THEN
CALL *UVPRINTMSG(001292,RECORD.ID)
END
READU RECORD FROM FILE.VAR,RECORD.ID
LOCKED
TRYAGAIN = ''
CALL *UVPRINTMSG(001191,RECORD.ID)
INPUT TRYAGAIN,1
IF UPCASE(TRYAGAIN) = "Y" ELSE
RECORD.LIST = DELETE(RECORD.LIST,1,0,0)
END
END
THEN
NUMBER.OF.LINES = DCOUNT(RECORD,@FM)
CALL *UVPRINTMSG(001207,NUMBER.OF.LINES)
CALL *UVPRINTMSG(001208,RECORD.ID)
GOSUB FORMAT
WRITE RECORD ON FILE.VAR,RECORD.ID
IF PRINT.FLAG THEN
PRINT
EXECUTE "SPOOL ":FILE.NAME:" ":RECORD.ID
END
RECORD.LIST = DELETE(RECORD.LIST,1,0,0)
END ELSE
RELEASE FILE.VAR,RECORD.ID
CALL *UVPRINTMSG(001205,RECORD.ID)
PRINT
RECORD.LIST = DELETE(RECORD.LIST,1,0,0)
END
REPEAT
EXIT.PROGRAM:
IF ASSIGNED(DEVSYS.VOC.FILE) THEN
CLOSE DEVSYS.VOC.FILE
END
IF ASSIGNED(FILE.VAR) THEN
CLOSE FILE.VAR
END
STOP
***** subroutines follow ******************************************************
*
* This subroutine sets the format parameters and does the format.
*
FORMAT:
IF FORMAT.TYPE = "FORMAT" THEN
MAT FORMAT.OPTIONS = ''
FORMAT.MARGIN = 6
FORMAT.INDENT = 3
FORMAT.CASE = 'MCU'
FORMAT.LABELS = 0
FORMAT.COMMENT = 0
FORMAT.BRIEF = 0
FORMAT.SURROUND = 0
FORMAT.ALIGN = 0
END ELSE
MAT FORMAT.OPTIONS = ''
FORMAT.MARGIN = 6
FORMAT.INDENT = 3
FORMAT.CASE = 'MCU'
FORMAT.LABELS = 1
FORMAT.COMMENT = 1
FORMAT.BRIEF = 0
FORMAT.SURROUND = 1
FORMAT.ALIGN = 0
END
CALL @FORMAT.BASIC(RECORD, NUMBER.OF.LINES, MAT FORMAT.OPTIONS)
NUMBER.OF.LINES = DCOUNT(RECORD,@FM)
RETURN
END