3912 lines
148 KiB
Plaintext
3912 lines
148 KiB
Plaintext
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* uniVerse PI/open EDITOR
|
||
|
|
*
|
||
|
|
* 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.
|
||
|
|
* 07/30/96 18933 ALC Corrected fix below, it had quoting problems
|
||
|
|
* 06/10/96 18598 PEJ Modified create.file &ED& for NT
|
||
|
|
* 04/12/96 18194 KAM Disallow VOC Fptr changes if MODFPTRS tunable set
|
||
|
|
* 03/13/96 17797 AGM Replace 'SH -c' with OS.EXEC
|
||
|
|
* 10/27/95 17576 LDG If NLS on, check ^ mode display for invalid UTF.
|
||
|
|
* 06/28/95 16793 LDG Hide NLS functionality until after 8.3.3
|
||
|
|
* 05/18/95 15741 EAP Added error message for NLS write errors
|
||
|
|
* 05/16/95 15741 EAP Added error message for NLS unmappable Ids
|
||
|
|
* 05/03/95 16475 LDG Only display record ID in ^ mode if ^ or ^X is
|
||
|
|
* actually on if NLS is enabled.
|
||
|
|
* 04/28/95 16433 LDG Changed ^X handling of char 128 (SQL NULL)
|
||
|
|
* 04/26/95 16433 LDG Changed ^X handling of chars 248 thru 250.
|
||
|
|
* 03/09/95 13096 SAP Fixed problem with SPOOL command core dumping.
|
||
|
|
* 02/07/95 16092 LDG Added ^X for Unicode UP ARROW mode, plus ability to
|
||
|
|
* input all Unicode characters via ^X.
|
||
|
|
* 12/07/94 15420 PVW Fix error handling on opens
|
||
|
|
* 11/08/94 13738 JSM Change definition of non-printing characters to be
|
||
|
|
* compatible with release 6 editor
|
||
|
|
* 03/15/94 12299 LA Replaced calls to PRINTER.IO to reset terminal and/or
|
||
|
|
* printer with PRINTER CLOSE and PRINTER RESET
|
||
|
|
* statements to make sure printer buffer is flushed.
|
||
|
|
* 02/16/94 12267 FTW Allow nulls to be edited in all cases.
|
||
|
|
* 02/11/94 12101 FTW Fixed several lock releasing problems.
|
||
|
|
* 01/24/94 12516 KAM Fixed LOOP functionality for prestored commands.
|
||
|
|
* 11/05/93 11751 WLG Fixed to recognize difference between "" and no
|
||
|
|
* Record-id being supplied.
|
||
|
|
* 10/28/93 11751 WLG Fixed to allow null record-ids.
|
||
|
|
* 08/18/93 12082 PVW Changed message 970012 and added message 970013
|
||
|
|
* 07/07/93 11317 PVW Fix problem with SPOOL command
|
||
|
|
* 07/07/93 11762 PVW Save and Restore all COMMON variables
|
||
|
|
* 06/29/93 11742 PVW Handle SQL Integrity Constraint Violations
|
||
|
|
* 06/29/93 11762 PVW Clear COMMON variables before exiting ED
|
||
|
|
* 06/01/93 11645 PVW Remove DEVSYS.STRIPSTRS.MODE from code
|
||
|
|
* 03/18/93 11152 WLG Fixed non-existent error to use message 20141
|
||
|
|
* 02/23/93 11109 PVW Fix handling of sql null when inserting.
|
||
|
|
* 02/19/93 10797 PVW Check status() before writing out to another record
|
||
|
|
* for part files.
|
||
|
|
* 02/02/93 10955 PVW Fixed editor error messages if DICT file.
|
||
|
|
* 02/01/93 10966 PVW Allow SQL NULL as element in multivalued data.
|
||
|
|
* 01/25/93 10716 LPC Enforce data restrictions for partfiles.
|
||
|
|
* 01/21/93 10797 LPC Check for invalid partfiles
|
||
|
|
* 01/21/93 10908 PVW Fix problem with I types.
|
||
|
|
* 01/06/93 10826 PVW Change the way the LOOP handles start command.
|
||
|
|
* 01/06/93 10785 PVW Make 'FI file item' behave as 'FILE file item'
|
||
|
|
* 01/05/93 10812 PVW Fix problem when line = char(128) in ^ mode.
|
||
|
|
* 01/05/93 10757 PVW Correct permissions handling for the new editor
|
||
|
|
* 12/31/92 10793 PVW Set DEVSYS.STRIPSTRS.MODE to "Editor".
|
||
|
|
* 12/30/92 10757 PVW Changed handling for Pnn,"-",and "+".
|
||
|
|
* 12/18/92 10757 PVW Change special character handling.
|
||
|
|
* 12/17/92 10214 PVW Further changes to merge the two editors.
|
||
|
|
* 12/17/92 10692 PVW Show char 128 in up arrow mode.
|
||
|
|
* 12/11/92 10708 PVW Open and close DEVSYS.VOC.FILE within ED.
|
||
|
|
* 12/09/92 10214 PVW Help Message added.
|
||
|
|
* 12/07/92 10214 PVW More formatting problems.
|
||
|
|
* 12/03/92 10214 PVW Fixed miscellaneous problems regarding QA.
|
||
|
|
* 11/11/92 10214 PVW Port PI/open EDITOR to replace uniVerse EDITOR.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS INFORMATION
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE VERBINSERT.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UV.COM
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE FORMAT.OPTS.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE GETPU.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE UVNLS.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* The following lines of code are included to setup this program
|
||
|
|
* with then same input as the PI/open ED.B subroutine receives
|
||
|
|
* from the PI/open command line processor PERFORM.B.
|
||
|
|
*
|
||
|
|
* SUBROUTINE ED (SENTENCE, MAT SYMBOLS)
|
||
|
|
*
|
||
|
|
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE SYMBOL.TBL.H
|
||
|
|
|
||
|
|
OPEN "VOC" TO DEVSYS.VOC.FILE ELSE
|
||
|
|
CALL *UVPRINTMSG(001752,"")
|
||
|
|
STOP
|
||
|
|
END
|
||
|
|
|
||
|
|
DIM SYMBOLS (VALSTART + MAXTOKENS)
|
||
|
|
|
||
|
|
MAT SYMBOLS = ''
|
||
|
|
|
||
|
|
SYMBOLS (NEXT.TKN.VALUE) = VALSTART
|
||
|
|
SYMBOLS (ORIGINAL.SENTENCE) = @SENTENCE
|
||
|
|
SENTENCE = TRIMF(@SENTENCE)
|
||
|
|
|
||
|
|
CHECK.TOKEN = FIELD(SENTENCE," ",1)
|
||
|
|
IF CHECK.TOKEN = "RUN" OR CHECK.TOKEN = "RAID" THEN
|
||
|
|
SENTENCE = FIELD(SENTENCE," ",2,9999)
|
||
|
|
SENTENCE = TRIMF(SENTENCE)
|
||
|
|
SENTENCE = FIELD(SENTENCE," ",2,9999)
|
||
|
|
END
|
||
|
|
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
*
|
||
|
|
*---- EQU's and DIMensions.
|
||
|
|
EQU IntegrityViolation TO -3
|
||
|
|
EQU OBJ.FMC TO 19
|
||
|
|
EQU VOC.K.CODE.DICT TO 20
|
||
|
|
EQU LINES.PER.CELL TO 40 ; * LINES PER CELL OF MEMORY MATRIX
|
||
|
|
EQU STARS LIT 'STR("*", 5)'
|
||
|
|
|
||
|
|
SETPU = '!SETPU'
|
||
|
|
GETPU = '!GETPU'
|
||
|
|
MATBLOCK = '-MATBLOCK'
|
||
|
|
GET.FILE.NAME = '-GET.FILE.NAME' ; * To get file name from command line.
|
||
|
|
STRIPSTRINGS = '-STRIPSTRINGS'
|
||
|
|
FORMAT.BASIC = '-FORMAT.BASIC'
|
||
|
|
PERMISSIONS = '-PERMISSIONS'
|
||
|
|
SQLINTCHK = '-SQLINTCHK'
|
||
|
|
OpenError = '-OpenError'
|
||
|
|
|
||
|
|
*---- Define vital elements of blocked memory (see GET.LINE comments).
|
||
|
|
@SYSTEM.SET = 0
|
||
|
|
MEMORY.DIM = 100 ; * Initial size of memory matrix.
|
||
|
|
|
||
|
|
DIM MEMORY (MEMORY.DIM)
|
||
|
|
DIM LPC (MEMORY.DIM)
|
||
|
|
DIM PRIOR.MEMORY (MEMORY.DIM)
|
||
|
|
DIM PRIOR.LPC (MEMORY.DIM)
|
||
|
|
DIM SAVED.MEMORY (MEMORY.DIM)
|
||
|
|
DIM SAVED.LPC (MEMORY.DIM)
|
||
|
|
NEW.MEMORY.DIM = 20 ; * INITIAL SIZE OF NEW.MEMORY MATRICES
|
||
|
|
DIM NEW.MEMORY (NEW.MEMORY.DIM)
|
||
|
|
DIM NEW.LPC (NEW.MEMORY.DIM)
|
||
|
|
GOSUB CLEAR.NEW.MEMORY ; * CLEAR MATRICES AND INITIALIZE VARIABLES
|
||
|
|
DIM CMD.STACK (101), CMD.NAME (5)
|
||
|
|
MAT CMD.STACK = ''
|
||
|
|
DIM ED.CMD.STRING (1)
|
||
|
|
|
||
|
|
*---- Initialize for this EDIT session.
|
||
|
|
OVERFLOW.FLAG = 0 ; * SJE 23 Apr 84
|
||
|
|
ABORT.FLAG = ''
|
||
|
|
STACK.MODE = FALSE ; * indicates if stack processor mode
|
||
|
|
INPUT.MODE = FALSE ; * indicates if prompt is '=' or ':'
|
||
|
|
INPUT.LINE = ''
|
||
|
|
BLOCK.VERIFY.FLAG = TRUE
|
||
|
|
RECORD.NAME.LOCKED = FALSE
|
||
|
|
PROMPT ' ' ; AT.LIST = '' ; AT.SUB = '' ; HELP.RECORD = ''
|
||
|
|
X = '@FILE' ; Y = ''
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@ID' ; Y = ''
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@LINE' ; Y = ''
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@IM' ; Y = @IM
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@VM' ; Y = @VM
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@SM' ; Y = @SM
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@COMMAND' ; Y = @COMMAND
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@PARASENTENCE' ; Y = @PARASENTENCE
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@SENTENCE' ; Y = @SENTENCE
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@LEVEL' ; Y = @LEVEL
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@LOGNAME' ; Y = @LOGNAME
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@WHO' ; Y = @WHO
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@USERNO' ; Y = @USERNO
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@TIME' ; Y = OCONV(@TIME, 'MTHS')
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@DATE' ; Y = OCONV(@DATE, 'D4')
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@MONTH' ; Y = @MONTH
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@DAY' ; Y = @DAY
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@YEAR' ; Y = @YEAR
|
||
|
|
GOSUB AT.INSERT
|
||
|
|
X = '@TM' ; Y = @TM ; * 007
|
||
|
|
GOSUB AT.INSERT ; * 007
|
||
|
|
LINES.MESSAGE = @SYS.BELL:'Number of lines to print must be a'
|
||
|
|
PRE.STORE = 'Pre-stored command'
|
||
|
|
REC = 'record'
|
||
|
|
UREC = 'Record'
|
||
|
|
ENABLED = 'enabled'
|
||
|
|
DISABLED = 'disabled'
|
||
|
|
UNICODE = '+Unicode' ;* NLS, for when ^X enabled, not just ^
|
||
|
|
IN.FILE = ' in file "'
|
||
|
|
DUMMY = @(0) ; * TURN OFF CRT PAGING ON DISPLAY
|
||
|
|
FIRST.RECORD = TRUE
|
||
|
|
APPEND = '' ; * APPEND STRING
|
||
|
|
CMD = '' ; * COMMAND LINE
|
||
|
|
CMD.STACK (1) = '$' ; * END OF STACK INDICATOR
|
||
|
|
CMD.STRING = '' ; * CMD STACK DUMPED INTO HERE BEFORE BEING SAVED (.S)
|
||
|
|
COMMA = FALSE ; * FOR ANALYZING SAVE (.S) COMMAND
|
||
|
|
CURR.CMD.NAME = '' ; * INIT VARIABLE
|
||
|
|
DELIM.STRING = '!"#$%&()*+,-./:=@[\]_`{|}':"'"
|
||
|
|
ED.CMD.STRING (1) = '$' ; * INIT END OF PRE-STORED COMMAND STRING INDICATOR
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE ; * FLAG TRUE IF A CMD STRING IS BEING EXECUTED
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE ; * FLAG TRUE IF AN EXECUTING COMMAND STRING IS IN 'PAUSE' MODE
|
||
|
|
END.STACK = 1 ; * POINTER TO THE END OF STACK INDICATOR
|
||
|
|
L.SELECT.FLAG = FALSE ; * FLAG TRUE IF CMD STRING RECORD NAMES SELECTED FROM A FILE
|
||
|
|
LOOP.FLAG = FALSE ; * FLAG TRUE IF CMD STRING IS BEING REPEATED BY A 'LOOP' COMMAND
|
||
|
|
NULL.CTR = 0 ; * COUNTER FOR SUCCESSIVE NULL COMMANDS
|
||
|
|
STACK.LIMIT = 100 ; * MAX NR OF STACK COMMANDS IS 99
|
||
|
|
UNLOAD.FLAG = FALSE ; * FLAG TRUE IF USING STRING.WRITE SUBR TO UNLOAD LINES
|
||
|
|
UPCMD = '' ; * INIT VARIABLE
|
||
|
|
UPCMD4 = '' ; * INIT VARIABLE
|
||
|
|
ERROR.COND = CHAR(0):@IM:CHAR(0) ; * ERROR INDICATOR
|
||
|
|
FIND.STRING = '' ; * 'FIND' STRING
|
||
|
|
FLEN = 0 ; * LENGTH OF FIND.STRING
|
||
|
|
ST.COLUMN = 1 ; * STARTING COLUMN (FIND COMMAND)
|
||
|
|
LOCATE.STRING = '' ; * LOCATE SEARCH STRING
|
||
|
|
MATCH.STRING = '' ; * 'MATCH' STRING
|
||
|
|
OLD.CHANGE.CMD = '' ; * PREVIOUS CHANGE COMMAND
|
||
|
|
PNUM = @CRTHIGH - 2 ; * LAST NUMBER OF LINES PRINTED
|
||
|
|
REPLACE.STRING = '' ; * PREVIOUS REPLACE COMMAND STRING
|
||
|
|
UP.ARROW = '^' ; * DEFINE UP ARROW CHARACTER
|
||
|
|
UP.ARROW.FLAG = FALSE ; * DISPLAY SPECIAL CHAR AS !XXX, FLAG
|
||
|
|
UP.ARROW.UNIC = '^x' ; * NLS up arrow mode that uses Unicode
|
||
|
|
UP.ARROW.UNIC.UP = UPCASE(UP.ARROW.UNIC) ;* used frequently
|
||
|
|
LEN.UP.ARROW.UNIC = LEN(UP.ARROW.UNIC) ;* ...ditto
|
||
|
|
UP.ARROW.UNIC.FLAG = FALSE ; * (display chars as ^xhhhh) in hex
|
||
|
|
NLS.ON.FLAG = SYSTEM(NLS$ON) ; * Set to 1 if NLS support switched on
|
||
|
|
PP.LINES = 20 ; * Default line count for PP command.
|
||
|
|
PL.LINES = 20 ; * Default line count for PL command.
|
||
|
|
NUM.REMAINING = '' ; * to control null editing
|
||
|
|
*---- Get CRT line width for folding.
|
||
|
|
CRT.WIDTH = @CRTWIDE
|
||
|
|
IF CRT.WIDTH < 1 OR CRT.WIDTH > 132 THEN CRT.WIDTH = 80
|
||
|
|
*---- Parse command sentence for file and record names.
|
||
|
|
SENT = TRIMF(FIELD(SENTENCE, ' ', 2, 9999))
|
||
|
|
INPUT.FILENAME:
|
||
|
|
PROMPT.FOR.FILE = TRUE ; NO.SELECT.LIST = TRUE
|
||
|
|
SINGLE.FILE.ONLY = TRUE ; ONLY.ONE.RECORD.FLAG = FALSE
|
||
|
|
FILE.NAME = '' ; DICT = ''
|
||
|
|
CALL @GET.FILE.NAME (NO.SELECT.LIST, SENT, DICT, FILE.NAME,
|
||
|
|
PROMPT.FOR.FILE, SINGLE.FILE.ONLY)
|
||
|
|
IF DICT = '' THEN DICT.TEXT = '' ELSE DICT.TEXT = DICT:' '
|
||
|
|
IF LEN(FILE.NAME) = 0 OR FILE.NAME # FILE.NAME <1> THEN GOTO STOP
|
||
|
|
*
|
||
|
|
* Open the file to be edited. Carry on if partially successful open
|
||
|
|
* of distributed file.
|
||
|
|
*
|
||
|
|
TEMP.SENTENCE = ''
|
||
|
|
FILE.NAME.VALID = FALSE
|
||
|
|
LOOP
|
||
|
|
UNTIL FILE.NAME.VALID DO
|
||
|
|
IF FILE.NAME = '' THEN
|
||
|
|
CALL @GET.FILE.NAME(NO.SELECT.LIST,TEMP.SENTENCE,DICT,FILE.NAME,PROMPT.FOR.FILE,SINGLE.FILE.ONLY)
|
||
|
|
END
|
||
|
|
IF DICT = '' THEN DICT.TEXT = '' ELSE DICT.TEXT = DICT:' '
|
||
|
|
IF LEN(FILE.NAME) = 0 OR FILE.NAME # FILE.NAME<1> THEN GOTO STOP
|
||
|
|
|
||
|
|
OPENCHECK DICT, FILE.NAME TO EDIT.FILE THEN
|
||
|
|
FILE.TYPE = STATUS()
|
||
|
|
FILE.NAME.VALID = TRUE
|
||
|
|
EDIT.READ.ONLY = FALSE
|
||
|
|
EDIT.PERM.MODE = 1
|
||
|
|
EDIT.PERM.IN = 6
|
||
|
|
EDIT.PERM.OUT = ''
|
||
|
|
CALL @PERMISSIONS(EDIT.FILE,EDIT.PERM.MODE,EDIT.PERM.IN,EDIT.PERM.OUT)
|
||
|
|
IF NOT(EDIT.PERM.OUT) THEN
|
||
|
|
EDIT.READ.ONLY = TRUE
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,FILE.NAME THEN
|
||
|
|
IF DICT = "" THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
END ELSE
|
||
|
|
PathName = FileRec<3>
|
||
|
|
END
|
||
|
|
RELEASE DEVSYS.VOC.FILE,FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
IF DICT = "" THEN
|
||
|
|
FileName = FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
FileName = "DICT,":FILE.NAME
|
||
|
|
END
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
DICT = '' ; FILE.NAME = ''
|
||
|
|
END
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
X = '@FILE' ; Y = FILE.NAME ; GOSUB AT.INSERT
|
||
|
|
IF TRIM(SENT) = '""' OR TRIM(SENT) = "''" THEN
|
||
|
|
NULL.ID = TRUE
|
||
|
|
END ELSE NULL.ID = FALSE
|
||
|
|
IF INDEX(SENT, "'", 1) + INDEX(SENT, '"', 1) THEN
|
||
|
|
CALL @STRIPSTRINGS(SENT, MAT SYMBOLS)
|
||
|
|
END ELSE SENT = TRIM(SENT)
|
||
|
|
IF SENT = '*' THEN
|
||
|
|
CALL *UVPRINTMSG(001295,"")
|
||
|
|
SELECT EDIT.FILE
|
||
|
|
SENT = ''
|
||
|
|
END
|
||
|
|
|
||
|
|
SELECT.LIST.FLAG = FALSE
|
||
|
|
READLIST RECORD.LIST
|
||
|
|
THEN
|
||
|
|
CONVERT @IM TO @FM IN RECORD.LIST
|
||
|
|
SELECT.LIST.FLAG = TRUE
|
||
|
|
NUM.REMAINING=DCOUNT(RECORD.LIST,@FM)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
RECORD.LIST = ''
|
||
|
|
END
|
||
|
|
|
||
|
|
IF LEN(SENT) # 0 THEN
|
||
|
|
IF COUNT(SENT, ' ') = 0 AND NOT(SELECT.LIST.FLAG) THEN ONLY.ONE.RECORD.FLAG = TRUE
|
||
|
|
NUMSENT=COUNT(SENT,' ')+1
|
||
|
|
SENT.AVAIL=NUMSENT
|
||
|
|
NUM.REMAINING=NUMSENT
|
||
|
|
LOOP
|
||
|
|
RECORD.NAME = FIELD(SENT, ' ', 1)
|
||
|
|
IF RECORD.NAME [1, 1] = CHAR(LITERAL) THEN
|
||
|
|
RECORD.NAME = SYMBOLS(RECORD.NAME [2, 999])
|
||
|
|
END
|
||
|
|
SENT = SENT [COL2() + 1, 999999]
|
||
|
|
WHILE SENT.AVAIL GT 0
|
||
|
|
SENT.AVAIL=SENT.AVAIL-1
|
||
|
|
RECORD.LIST<NUMSENT-SENT.AVAIL>=RECORD.NAME
|
||
|
|
REPEAT
|
||
|
|
END
|
||
|
|
IF COUNT(RECORD.LIST, @FM) THEN SELECT.LIST.FLAG = TRUE
|
||
|
|
|
||
|
|
GET.NEXT.RECORD: ; * Get the next record.
|
||
|
|
GOSUB GET.RECORD
|
||
|
|
GOSUB OOPS.INITIAL.SAVE ; * SET UP FOR OOPS <====
|
||
|
|
|
||
|
|
GET.CMD: ; * Get next command from user.
|
||
|
|
* Set up to save record prior to change for 'OOPS'.
|
||
|
|
IF CHANGE.FLAG OR CHANGE.DURING.CMD.STRING THEN
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN
|
||
|
|
GOSUB OOPS.AFTER.CHANGE.CMD ; * SET UP FOR OOPS <====
|
||
|
|
CHANGE.DURING.CMD.STRING = FALSE
|
||
|
|
END ELSE CHANGE.DURING.CMD.STRING = TRUE
|
||
|
|
END
|
||
|
|
|
||
|
|
GET.CMD.0:
|
||
|
|
IF CHANGE.FLAG THEN RECORD.CHANGE.FLAG = TRUE
|
||
|
|
IF BOT = 0 THEN LNUM = 0 ; * BOT=0 MEANS RECORD IS NULL
|
||
|
|
IF BOT THEN GOSUB GET.LINE ; * GET LINE IF RECORD IS NOT NULL
|
||
|
|
ELSE IF CHANGE.FLAG THEN CHANGE.FLAG = FALSE ; RECORD.CHANGE.FLAG = TRUE
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN
|
||
|
|
IF LNUM => BOT AND BOT > 0 THEN
|
||
|
|
CALL *UVPRINTMSG(001209,BOT)
|
||
|
|
END
|
||
|
|
CALL *UVPRINTMSG(001210,"")
|
||
|
|
END ELSE
|
||
|
|
IF ED.CMD.STRING.SUSPENDED THEN
|
||
|
|
CALL *UVPRINTMSG(001242,"")
|
||
|
|
CALL *UVPRINTMSG(001210,"")
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
|
||
|
|
GET.CMD.1:
|
||
|
|
COMMAND.SUCCESSFUL = TRUE
|
||
|
|
STACK.MODE = FALSE
|
||
|
|
CMD = INPUT.LINE
|
||
|
|
ORIGINAL.CMD = CMD
|
||
|
|
IF CMD = '.?' THEN CMD = 'HELP .'
|
||
|
|
IF CMD # '?' AND CMD [LEN(CMD), 1] = '?' THEN
|
||
|
|
CMD = CMD [1, LEN(CMD) - 1] ; GOSUB STASH.IT ; GOTO GET.CMD
|
||
|
|
END
|
||
|
|
CMD = REPLACE(CMD, 1, 1, 1, TRIMF(CMD <1, 1, 1>))
|
||
|
|
GOSUB PUT.ON.STACK
|
||
|
|
|
||
|
|
GET.CMD.2:
|
||
|
|
IF LEN(CMD) = 0 THEN
|
||
|
|
IF BOT = 0 THEN GOTO GET.CMD ; * BOT = 0 MEANS RECORD IS NULL
|
||
|
|
LNUM = IF LNUM < BOT THEN LNUM + 1 ELSE 0
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END
|
||
|
|
NULL.CTR = 0
|
||
|
|
IF NUM(CMD) THEN GOTO SET.LNUM
|
||
|
|
IF CMD = "-" OR CMD = "+" THEN GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
*---- Convert lower case to upper case for command processing.
|
||
|
|
UPCMD = UPCASE(CMD) ;
|
||
|
|
|
||
|
|
*---- Look for 'OOPS' command to restore; else, save record if necessary.
|
||
|
|
IF UPCMD = 'OOPS' THEN
|
||
|
|
IF ED.CMD.STRING.ACTIVE THEN
|
||
|
|
J = 0 ; * KILL ACTIVE CMD STRING
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE
|
||
|
|
IF CHANGE.DURING.CMD.STRING THEN
|
||
|
|
GOSUB OOPS.AFTER.CHANGE.CMD
|
||
|
|
CHANGE.DURING.CMD.STRING = FALSE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF LEN(SAVED.CMD) = 0 THEN
|
||
|
|
CALL *UVPRINTMSG(001249,"")
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
J = 0 ; * KILL ANY ACTIVE EDIT CMD STRING
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
GOSUB OOPS.RESTORE ; * SET UP FOR OOPS <====
|
||
|
|
GOTO END.CMD
|
||
|
|
END ELSE
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN GOSUB OOPS.BEFORE.EACH.CMD ; * SET UP FOR OOPS <====
|
||
|
|
END
|
||
|
|
CMDN = 1
|
||
|
|
|
||
|
|
*---- Look for 1-letter commands.
|
||
|
|
IF LEN(UPCMD) = 1 THEN
|
||
|
|
CMDX = INDEX('ABCDFILMNPQRTX<>^?', UPCMD, 1)
|
||
|
|
ON CMDX + 1 GOTO CMD.ERR, A, B, C, D, F, I, L, M, N, P, QUIT, R,
|
||
|
|
T, X, MFROM, MTHRU, UP.ARROW.TOGGLE, QUESTION.MARK
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Look for a letter and a space, followed by any string.
|
||
|
|
IF UPCMD MATCHES '1A" "0X' THEN
|
||
|
|
ANY = CMD [3, 9999]
|
||
|
|
CMDX = INDEX('ABCFILMR', UPCMD [1, 1], 1)
|
||
|
|
ON CMDX + 1 GOTO CMD.ERR, A.ANY, B.ANY, C.ANY, F.ANY,
|
||
|
|
I.ANY, L.ANY, M.ANY, R.ANY
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Look for 'Fnnn' --- a column-restricted FIND.
|
||
|
|
IF UPCMD [1, 1] = "F" THEN
|
||
|
|
IF CMD [2, 9999] MATCHES '0N" "0X' THEN
|
||
|
|
ST.COLUMN = FIELD(CMD [2, 9999], " ", 1)
|
||
|
|
ANY = CMD [LEN(ST.COLUMN) + 3, 9999]
|
||
|
|
GO TO F.COL
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Look for a letter followed by a number.
|
||
|
|
IF UPCMD MATCHES '1A0N' THEN
|
||
|
|
CMDN = CMD [2, 99]
|
||
|
|
IF CMDN > BOT THEN CMDN = BOT
|
||
|
|
CMDX = INDEX('DGLP', UPCMD [1, 1], 1)
|
||
|
|
ON CMDX + 1 GOTO CMD.ERR, D, G.N, P.N, P.N
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Look for command words.
|
||
|
|
UPCMD1 = UPCMD [1, 1] ; UPCMD2 = UPCMD [1, 2]
|
||
|
|
UPCMD3 = UPCMD [1, 3] ; UPCMD4 = UPCMD [1, 4]
|
||
|
|
UPCMD5 = UPCMD [1, 5] ; UPCMD6 = UPCMD [1, 6]
|
||
|
|
UPCMD8 = UPCMD [1, 8]
|
||
|
|
IF UPCMD = 'ABORT' THEN GOTO ABORT:
|
||
|
|
IF UPCMD = 'BLOCK' THEN GOTO BLOCK.VERIFY:
|
||
|
|
IF UPCMD3 = 'CAT' THEN GOTO CAT.ANY:
|
||
|
|
IF UPCMD = 'COL' THEN GOTO COL:
|
||
|
|
IF UPCMD = 'COPY' THEN GOTO COPY:
|
||
|
|
IF UPCMD = 'DELETE' THEN GOTO DELETE:
|
||
|
|
IF UPCMD2 = 'DE' THEN GOTO DE.N:
|
||
|
|
IF UPCMD = 'DROP' THEN GOTO DROP:
|
||
|
|
IF UPCMD3 = 'DUP' THEN GOTO DUP.ANY:
|
||
|
|
IF UPCMD = 'EX' THEN GOTO QUIT:
|
||
|
|
IF UPCMD = 'FD' THEN GOTO DELETE:
|
||
|
|
IF UPCMD = 'FI' THEN GOTO FILE.ANY:
|
||
|
|
IF UPCMD = 'FILE' THEN GOTO FILE.ANY:
|
||
|
|
* GTAR 10785
|
||
|
|
* Fake editor into thich user typed 'FILE file record'
|
||
|
|
*
|
||
|
|
IF UPCMD3 = 'FI ' THEN
|
||
|
|
CMD = 'FILE ':CMD[4,9999]
|
||
|
|
UPCMD = UPCASE(CMD)
|
||
|
|
UPCMD3 = UPCMD[1,3]
|
||
|
|
UPCMD4 = UPCMD[1,4]
|
||
|
|
UPCMD5 = UPCMD[1,5]
|
||
|
|
UPCMD6 = UPCMD[1,6]
|
||
|
|
UPCMD7 = UPCMD[1,7]
|
||
|
|
UPCMD8 = UPCMD[1,8]
|
||
|
|
GOTO FILE.ANY
|
||
|
|
END
|
||
|
|
IF UPCMD5 = 'FILE ' THEN GOTO FILE.ANY:
|
||
|
|
IF UPCMD = 'FORMAT' THEN FORMAT.TYPE = TRUE ; GOTO FORMAT:
|
||
|
|
IF UPCMD = 'FANCY.FORMAT' THEN FORMAT.TYPE = FALSE ; GOTO FORMAT:
|
||
|
|
IF UPCMD = 'G<' THEN GOTO G.BEGIN.BLOCK:
|
||
|
|
IF UPCMD = 'G>' THEN GOTO G.END.BLOCK:
|
||
|
|
IF UPCMD4 = 'HELP' THEN GOTO HELP.ANY:
|
||
|
|
IF UPCMD2 = 'IB' THEN GOTO I.BEFORE
|
||
|
|
IF UPCMD5 = 'LOAD ' THEN GOTO LOAD.ANY:
|
||
|
|
IF UPCMD = 'MOVE' THEN GOTO MOVE:
|
||
|
|
IF UPCMD = 'PB' THEN GOTO PRINT.BLOCK:
|
||
|
|
IF UPCMD2 = 'PL' THEN GOTO PL.CMD:
|
||
|
|
IF UPCMD2 = 'PO' THEN GOTO PO.N:
|
||
|
|
IF UPCMD2 = 'PP' THEN GOTO PP.CMD:
|
||
|
|
IF UPCMD = 'QUIT' THEN GOTO QUIT:
|
||
|
|
IF UPCMD = 'RELEASE' THEN GOTO RELEASE:
|
||
|
|
IF UPCMD = 'SAVE' THEN GOTO SAVE.ANY:
|
||
|
|
IF UPCMD5 = 'SAVE ' THEN GOTO SAVE.ANY:
|
||
|
|
IF UPCMD3 = 'SEQ' THEN GOTO SEQ.ANY:
|
||
|
|
IF UPCMD = 'SIZE' THEN COMMAND.SUCCESSFUL = FALSE ; DISPLAY.CURRENT.LINE = FALSE ; GOTO SIZE:
|
||
|
|
IF UPCMD = 'SPOOLHELP' THEN GOTO SPOOL.HELP:
|
||
|
|
IF UPCMD5 = 'SPOOL' THEN GOTO SPOOL.N:
|
||
|
|
IF UPCMD5 = 'STAMP' THEN GOTO STAMP:
|
||
|
|
IF UPCMD6 = 'UNLOAD' THEN GOTO UNLOAD.ANY:
|
||
|
|
IF UPCMD4 = 'XEQ ' THEN GOTO XEQ.ANY:
|
||
|
|
IF UPCMD3 = 'PE ' THEN GOTO XEQ.ANY:
|
||
|
|
IF UPCMD8 = 'PERFORM ' THEN GOTO XEQ.ANY:
|
||
|
|
IF UPCMD = "<>" THEN GOTO MFROM:
|
||
|
|
IF UPCMD = UP.ARROW.UNIC.UP THEN GOTO UP.ARROW.TOGGLE ;* NLS Unicode ^x cmd
|
||
|
|
|
||
|
|
*---- Look for EDITOR STACK and STRING commands.
|
||
|
|
IF UPCMD1 = '.' OR UPCMD4 = 'LOOP' OR UPCMD5 = 'PAUSE' THEN GOTO STACK.PROCESSOR:
|
||
|
|
IF UPCMD1 = 'C' OR UPCMD1 = 'R' THEN GOTO C.ANY: ; * CHANGE command.
|
||
|
|
|
||
|
|
CMD.ERR:
|
||
|
|
UNLOAD.FLAG = FALSE ; * RESET FLAGS ON LOAD/UNLOAD ERROR CONDITIONS
|
||
|
|
L.SELECT.FLAG = FALSE
|
||
|
|
* IF UPCMD4 = 'LOOP' THEN ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
* ELSE
|
||
|
|
IF NOT(ED.CMD.STRING.SUSPENDED) AND ED.CMD.STRING.ACTIVE THEN
|
||
|
|
CALL *UVPRINTMSG(001272,J:@FM:ED.CMD.STRING (J))
|
||
|
|
CALL *UVPRINTMSG(001273,"")
|
||
|
|
ERROR.FORMAT = TRUE
|
||
|
|
GOSUB PRINT.CMD.STRING
|
||
|
|
MSG.TEXT = UVREADMSG(001274,"")
|
||
|
|
IF NOT(@SYS.BELL) THEN
|
||
|
|
MSG.TEXT = CONVERT(CHAR(07),"",MSG.TEXT)
|
||
|
|
END
|
||
|
|
PRINT MSG.TEXT<1>
|
||
|
|
PRINT
|
||
|
|
CALL *UVPRINTMSG(001275,"")
|
||
|
|
CALL *UVPRINTMSG(001276,"")
|
||
|
|
INPUT COMMAND ; ANS = COMMAND ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Q' THEN
|
||
|
|
ED.CMD.STRING (J) = COMMAND
|
||
|
|
J -= 1
|
||
|
|
END ELSE ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
* END
|
||
|
|
IF NOT(STACK.MODE) THEN CALL *UVPRINTMSG(001245,"")
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
NUMBER.ERR:
|
||
|
|
PRINT 'A non-numeric parameter was encountered where a number was expected.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
|
||
|
|
END.NOCHANGE: ; * End of command that did not change record.
|
||
|
|
CHANGE.FLAG = FALSE
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
END.CHANGE: ; * End of command that changed record.
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
|
||
|
|
END.CMD: ; * Set up to save record prior to change for 'OOPS'.
|
||
|
|
IF CHANGE.FLAG OR CHANGE.DURING.CMD.STRING THEN
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN
|
||
|
|
GOSUB OOPS.AFTER.CHANGE.CMD ; * SET UP FOR OOPS <====
|
||
|
|
CHANGE.DURING.CMD.STRING = FALSE
|
||
|
|
END ELSE CHANGE.DURING.CMD.STRING = TRUE
|
||
|
|
END
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD.0
|
||
|
|
|
||
|
|
DONE.WITH.RECORD:
|
||
|
|
IF RECORD.NAME.LOCKED THEN
|
||
|
|
RELEASE EDIT.FILE, RECORD.NAME ; * RELEASE RECORD LOCK
|
||
|
|
RECORD.NAME.LOCKED = FALSE
|
||
|
|
END
|
||
|
|
IF ONLY.ONE.RECORD.FLAG THEN GOTO STOP ELSE GOTO GET.NEXT.RECORD
|
||
|
|
|
||
|
|
!
|
||
|
|
* Command processing routines.
|
||
|
|
!
|
||
|
|
|
||
|
|
*---- Conventions used in command processors:
|
||
|
|
*
|
||
|
|
* 1. Entered from a 'GOTO' in the routine 'GET.CMD'.
|
||
|
|
*
|
||
|
|
* 2. Exit with a 'GOTO' to one of the following labels:
|
||
|
|
* A. 'GET.CMD', to get the next command.
|
||
|
|
* B. 'END.CMD', to print the current line before going to 'GET.CMD'.
|
||
|
|
* C. 'END.CHANGE' to set 'CHANGE.FLAG' to 'TRUE' after changing
|
||
|
|
* the record; control proceeds through 'END.CMD', to print
|
||
|
|
* the current line before going to 'GET.CMD'.
|
||
|
|
* D. 'CMD.ERR', to print standard error message.
|
||
|
|
*
|
||
|
|
* 3. Use these standard 'GOSUB' routines:
|
||
|
|
* A. 'GET.LINE', to get the line numbered 'LNUM' into 'LINE'.
|
||
|
|
* B. 'PRINT.LINE', to print the string in 'LINE'.
|
||
|
|
* C. 'INPUT.LINE', to input a line of text from the CRT.
|
||
|
|
*
|
||
|
|
* 4. Each processor should maintain these variables as necessary:
|
||
|
|
* A. 'MEMORY' matrix contains 'LPC' lines of record in each cell.
|
||
|
|
* B. 'LNUM' is the line number being displayed/processed.
|
||
|
|
* C. 'LINE' contains the current line from record at line 'LNUM'.
|
||
|
|
* D. 'LPC' matrix defines number of lines per cell in 'MEMORY'.
|
||
|
|
* E. 'CELL' is the cell number in 'MEMORY' containing line 'LNUM'.
|
||
|
|
* F. 'CELL.FIRST.LINE' is the real line number of the first
|
||
|
|
* line of the current cell.
|
||
|
|
* G. 'CHANGE.FLAG' must be set to 'TRUE' if record is changed.
|
||
|
|
* H. 'BOT' should be set to the bottom line number if
|
||
|
|
* the number of lines is changed.
|
||
|
|
|
||
|
|
A.ANY: ; * APPEND command.
|
||
|
|
APPEND = ANY
|
||
|
|
|
||
|
|
A:
|
||
|
|
IF LNUM < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(970007,LNUM)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LINE := APPEND
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINE)
|
||
|
|
GOTO END.CHANGE
|
||
|
|
|
||
|
|
ABORT: ; * Toggle command ABORT flag.
|
||
|
|
ABORT.FLAG = NOT(ABORT.FLAG)
|
||
|
|
IF ABORT.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001267,ENABLED)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001267,DISABLED)
|
||
|
|
END
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
BLOCK.VERIFY: ; * Toggle command BLOCK.VERIFY flag.
|
||
|
|
BLOCK.VERIFY.FLAG = NOT(BLOCK.VERIFY.FLAG)
|
||
|
|
IF BLOCK.VERIFY.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001268,ENABLED)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001268,DISABLED)
|
||
|
|
END
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
B.ANY: ; * Break a line into two lines.
|
||
|
|
IF LNUM < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(970008,LNUM)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
X = INDEX(LINE, ANY, 1)
|
||
|
|
IF X = 0 THEN GOTO CMD.ERR
|
||
|
|
X += LEN(ANY)
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINE [1, X - 1]:@FM:LINE [X, 999999])
|
||
|
|
LPC (CELL) += 1 ; BOT += 1
|
||
|
|
BLOCK.TRACK.LNUM = LNUM + 1 ; BLOCK.TRACK.CHANGE = 1 ; GOSUB BLOCK.TRACK
|
||
|
|
GOTO END.CHANGE
|
||
|
|
|
||
|
|
B: ; * Go to BOTTOM of record.
|
||
|
|
LNUM = BOT ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
CAT.ANY: ; * Catenate two lines together.
|
||
|
|
IF LNUM < 1 OR LNUM = BOT THEN
|
||
|
|
CALL *UVPRINTMSG(970006,LNUM)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LINEX = LINE
|
||
|
|
LNUM += 1
|
||
|
|
GOSUB GET.LINE ; * GET NEXT LINE
|
||
|
|
LINEY = LINE
|
||
|
|
NUM.OF.LINES.TO.DELETE = 1
|
||
|
|
GOSUB DELETE.MEMORY
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINEX:CMD [5, 99]:LINEY)
|
||
|
|
BLOCK.TRACK.LNUM = LNUM ; BLOCK.TRACK.CHANGE = -1 ; GOSUB BLOCK.TRACK
|
||
|
|
GOTO END.CHANGE
|
||
|
|
|
||
|
|
COL: ; * Column display command.
|
||
|
|
CALL *UVPRINTMSG(001212,"")
|
||
|
|
CALL *UVPRINTMSG(001213,"")
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
C: ; * Change command.
|
||
|
|
CMD = OLD.CHANGE.CMD
|
||
|
|
IF LEN(CMD) = 0 THEN
|
||
|
|
PRINT 'No previous CHANGE command in effect ; must have parameters.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
|
||
|
|
C.ANY: ; * Look for first non-space, non-alphanumeric character as delimiter.
|
||
|
|
X = 2
|
||
|
|
LOOP DELIM = CMD [X, 1] WHILE DELIM = ' ' DO X += 1 REPEAT
|
||
|
|
IF NOT(INDEX(DELIM.STRING, DELIM, 1)) THEN
|
||
|
|
PRINT 'Valid delimiters are ':DELIM.STRING
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF COUNT(CMD, DELIM) > 3 THEN
|
||
|
|
PRINT 'Too many delimiters (3 max.).' ; GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
OLD.CHANGE.CMD = CMD
|
||
|
|
FROM.FIELD = FIELD(CMD, DELIM, 2)
|
||
|
|
LEN.FROM.FIELD = LEN(FROM.FIELD)
|
||
|
|
TO.FIELD = FIELD(CMD, DELIM, 3)
|
||
|
|
IF COL2() = 0 THEN
|
||
|
|
PRINT 'Missing required TO field (for "CHANGE/FROM/TO").'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
GLOBAL = FIELD(CMD, DELIM, 4) ; GLOBAL = UPCASE(GLOBAL) ; GLOBAL.FLAG = FALSE
|
||
|
|
IF GLOBAL [1, 1] = 'G' THEN GLOBAL = GLOBAL [2, 99] ; GLOBAL.FLAG = TRUE
|
||
|
|
IF GLOBAL [LEN(GLOBAL), 1] = 'G' THEN GLOBAL = GLOBAL [1, LEN(GLOBAL) - 1] ; GLOBAL.FLAG = TRUE
|
||
|
|
BLOCK.LOGIC = FALSE
|
||
|
|
IF GLOBAL = 'B' THEN
|
||
|
|
IF MFROM # 0 AND MTHRU # 0 THEN LNUM = MFROM ; * IF BLOCK SET, MOVE LNUM TO FRONT OF BLOCK
|
||
|
|
GOSUB BLOCK.CHECK
|
||
|
|
BLOCK.LOGIC = TRUE
|
||
|
|
END
|
||
|
|
N = IF NUM(GLOBAL) AND GLOBAL => 1 THEN GLOBAL ELSE 1
|
||
|
|
IF LNUM <= 0 THEN LNUM = 1
|
||
|
|
IF BLOCK.LOGIC THEN LNUM = MFROM ; LEND = MTHRU ; N = LEND - LNUM + 1
|
||
|
|
ELSE LEND = LNUM + N - 1 ; IF LEND > BOT THEN LEND = BOT
|
||
|
|
X.CHANGE.FLAG = FALSE ; * RESET LOCAL CHANGE FLAG
|
||
|
|
FOR LNUM = LNUM TO LEND
|
||
|
|
GOSUB GET.LINE
|
||
|
|
IF LEN(FROM.FIELD) = 0 THEN LINE = TO.FIELD:LINE ; GOTO C.REPLACE.LINE
|
||
|
|
X = INDEX(LINE, FROM.FIELD, 1)
|
||
|
|
IF X = 0 THEN GOTO C.NEXT.LINE
|
||
|
|
NEW.LINE = ''
|
||
|
|
LOOP
|
||
|
|
NEW.LINE := LINE [1, X - 1] :TO.FIELD
|
||
|
|
LINE = LINE [X + LEN.FROM.FIELD, 999999]
|
||
|
|
X = INDEX(LINE, FROM.FIELD, 1)
|
||
|
|
WHILE GLOBAL.FLAG AND X DO REPEAT
|
||
|
|
LINE = NEW.LINE:LINE
|
||
|
|
|
||
|
|
C.REPLACE.LINE:
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINE)
|
||
|
|
GOSUB PRINT.LINE
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
X.CHANGE.FLAG = TRUE ; * SET LOCAL CHANGE FLAG
|
||
|
|
|
||
|
|
C.NEXT.LINE:
|
||
|
|
GOSUB ABORT.CHECK
|
||
|
|
IF ABORT = 'Q' THEN
|
||
|
|
CALL *UVPRINTMSG(001228,"")
|
||
|
|
GOTO C.ABORT
|
||
|
|
END
|
||
|
|
NEXT LNUM
|
||
|
|
|
||
|
|
C.ABORT:
|
||
|
|
IF LNUM = 0 THEN CALL *UVPRINTMSG(001190,"")
|
||
|
|
ELSE IF N > 1 AND LNUM # BOT THEN PRINT 'At line ':LNUM
|
||
|
|
CHANGE.FLAG = X.CHANGE.FLAG ; * SET UP FLAG FOR OOPS SINCE GET.LINE
|
||
|
|
; * COULD HAVE RESET IT AFTER LAST LINE ACTUALLY CHANGED
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
COPY: ; * Copy a BLOCK (i.e., duplicate the lines).
|
||
|
|
MOVE.FLAG = FALSE ; GOTO MOVE.COPY
|
||
|
|
|
||
|
|
DELETE: ; * Delete the entire record from the file.
|
||
|
|
IF (NOT(SYSTEM(62)) AND (EDITING.VOC.FPTR))
|
||
|
|
THEN
|
||
|
|
CALL *UVPRINTMSG(020553,"")
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
|
||
|
|
CALL *UVPRINTMSG(001214,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Y' THEN CALL *UVPRINTMSG(001215,"") ; GOTO GET.CMD
|
||
|
|
DELETE EDIT.FILE, RECORD.NAME ELSE
|
||
|
|
|
||
|
|
* DELETEU EDIT.FILE, RECORD.NAME ON ERROR
|
||
|
|
PRINT @SYS.BELL:'Failed to delete "':DISPLAY.RECORD.NAME:'" from file "':DICT:FILE.NAME:'". STATUS = ':STATUS()
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
CALL *UVPRINTMSG(001246,DISPLAY.RECORD.NAME)
|
||
|
|
CALL *UVPRINTMSG(001286,DICT.TEXT:FILE.NAME)
|
||
|
|
GOTO DONE.WITH.RECORD
|
||
|
|
|
||
|
|
DE.N: ; * Delete a line or lines.
|
||
|
|
CMDN = CMD [3, 99]
|
||
|
|
IF NOT(NUM(CMDN)) THEN
|
||
|
|
PRINT 'Command requires number of lines to DELETE.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF CMDN <= 0 THEN CMDN = 1
|
||
|
|
|
||
|
|
D:
|
||
|
|
IF LNUM <= 0 THEN LNUM = 1
|
||
|
|
IF CMDN > (BOT - LNUM + 1) THEN CMDN = BOT - LNUM + 1
|
||
|
|
NUM.OF.LINES.TO.DELETE = CMDN
|
||
|
|
GOSUB DELETE.MEMORY
|
||
|
|
BLOCK.TRACK.LNUM = LNUM ; BLOCK.TRACK.CHANGE = -CMDN ; GOSUB BLOCK.TRACK
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
DROP: ; * Delete a BLOCK of lines.
|
||
|
|
IF MFROM # 0 AND MTHRU # 0 THEN LNUM = MFROM ; * IF BLOCK SET, MOVE LNUM TO FRONT OF BLOCK
|
||
|
|
GOSUB BLOCK.CHECK ; GOSUB GET.LINE
|
||
|
|
NUM.OF.LINES.TO.DELETE = MTHRU - MFROM + 1
|
||
|
|
GOSUB DELETE.MEMORY
|
||
|
|
MTHRU = 0 ; * KILL BLOCK POINTERS
|
||
|
|
MFROM = 0
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
DUP.ANY: ; * Duplicate the current line.
|
||
|
|
IF LNUM < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(970009,LNUM)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
CMDN = CMD [4, 99]
|
||
|
|
IF NOT(NUM(CMDN)) THEN
|
||
|
|
PRINT 'Command requires number of lines to DUPLICATE.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF CMDN <= 0 THEN CMDN = 1
|
||
|
|
IF CMDN = 1 THEN
|
||
|
|
* LNUM += 1
|
||
|
|
* MEMORY (CELL) = INSERT(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINE)
|
||
|
|
* The following code replaces the above 2 lines, which fail when
|
||
|
|
* inserting data before the last field if the last field is null.
|
||
|
|
X = LNUM - CELL.FIRST.LINE
|
||
|
|
IF X < 0 THEN
|
||
|
|
IF LEN(MEMORY (CELL)) = 0 THEN MEMORY (CELL) = LINE
|
||
|
|
ELSE MEMORY (CELL) = LINE:@FM:MEMORY (CELL)
|
||
|
|
END ELSE
|
||
|
|
Y = FIELD(MEMORY (CELL), @FM, 1, X + 1):@FM:LINE
|
||
|
|
X = MEMORY (CELL) [COL2(), 99999999]
|
||
|
|
IF LEN(X) = 0 THEN MEMORY (CELL) = Y
|
||
|
|
ELSE MEMORY (CELL) = Y:X
|
||
|
|
END
|
||
|
|
LNUM += 1
|
||
|
|
*---- End of special code.
|
||
|
|
LPC (CELL) += 1 ; BOT += 1 ; CHANGE.FLAG = TRUE
|
||
|
|
END ELSE
|
||
|
|
NEW.MEMORY.LINE = LINE
|
||
|
|
FOR X = 1 TO CMDN ; * BUILD A BLOCK OF NEW LINES
|
||
|
|
GOSUB APPEND.NEW.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
NEXT X
|
||
|
|
GOSUB INSERT.MEMORY ; * INSERT THE NEW BLOCK
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
GOSUB CLEAR.NEW.MEMORY
|
||
|
|
LNUM += 1
|
||
|
|
END
|
||
|
|
BLOCK.TRACK.LNUM = LNUM ; BLOCK.TRACK.CHANGE = CMDN ; GOSUB BLOCK.TRACK
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
FILE.ANY: ; * File the record; finished with it.
|
||
|
|
GOSUB FILE.IT
|
||
|
|
IF WRITEERROR THEN GOTO END.NOCHANGE ; *026
|
||
|
|
GOTO DONE.WITH.RECORD
|
||
|
|
|
||
|
|
F.COL: ; * A column-restricted FIND.
|
||
|
|
FIND.STRING = ANY ; GO TO F
|
||
|
|
|
||
|
|
F.ANY: ; * Find a line starting with string 'any'.
|
||
|
|
FIND.STRING = ANY ; ST.COLUMN = 1
|
||
|
|
|
||
|
|
F:
|
||
|
|
FLEN = LEN(FIND.STRING) ; SEARCH.X = 1 ; GOTO L.AGAIN
|
||
|
|
|
||
|
|
FORMAT: ; * Format INFO/BASIC program.
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
IF BOT = 0 THEN GOTO END.NOCHANGE ; * EXIT IF NO LINES TO FORMAT
|
||
|
|
*
|
||
|
|
* Move the current lines of the program into the PROGRAM array ready
|
||
|
|
* for formatting, 1 line per field.
|
||
|
|
*
|
||
|
|
PROGRAM = ''
|
||
|
|
FOR LNUM = 1 TO BOT
|
||
|
|
GOSUB GET.LINE ; PROGRAM<-1> = LINE
|
||
|
|
NEXT LNUM
|
||
|
|
BOTX = BOT ; * SAVE BOT
|
||
|
|
LNUM = 1
|
||
|
|
GOSUB GET.LINE
|
||
|
|
NUM.OF.LINES.TO.DELETE = BOT
|
||
|
|
GOSUB DELETE.MEMORY ; * CLEAR ALL OF MEMORY, RETURN DMR SPACE
|
||
|
|
BOT = BOTX ; * RESTORE BOT WHICH WAS RESET BY DELETE.MEMORY
|
||
|
|
*
|
||
|
|
* Now do the actual format of this record.
|
||
|
|
* Depending on the value of FORMAT.TYPE do a FORMAT or FANCY.FORMAT
|
||
|
|
*
|
||
|
|
IF FORMAT.TYPE THEN
|
||
|
|
MAT FORMAT.OPTIONS = '' ; * Initialize the default FORMAT
|
||
|
|
FORMAT.MARGIN = 6 ; * options.
|
||
|
|
FORMAT.INDENT = 3 ; *
|
||
|
|
FORMAT.CASE = 'MCU' ; * Treat all keywords in upper case
|
||
|
|
FORMAT.LABELS = 0 ; * Do not place labels on a separate line
|
||
|
|
FORMAT.COMMENT = 0 ; * Do not format comments
|
||
|
|
FORMAT.BRIEF = 0 ; * Indicate progess with *'s
|
||
|
|
FORMAT.SURROUND = 0 ; * Do not surround special characters
|
||
|
|
FORMAT.ALIGN = 0 ; * Do not align within statements
|
||
|
|
END ELSE
|
||
|
|
MAT FORMAT.OPTIONS = '' ; * Initialize the default FORMAT
|
||
|
|
FORMAT.MARGIN = 6 ; * options.
|
||
|
|
FORMAT.INDENT = 3 ; *
|
||
|
|
FORMAT.CASE = 'MCU' ; * Treat all keywords in upper case
|
||
|
|
FORMAT.LABELS = 1 ; * Do not place labels on a separate line
|
||
|
|
FORMAT.COMMENT = 1 ; * Do not format comments
|
||
|
|
FORMAT.BRIEF = 0 ; * Indicate progess with *'s
|
||
|
|
FORMAT.SURROUND = 1 ; * Do not surround special characters
|
||
|
|
FORMAT.ALIGN = 0 ; * Do not align within statements
|
||
|
|
END
|
||
|
|
CALL @FORMAT.BASIC(PROGRAM, BOT, MAT FORMAT.OPTIONS)
|
||
|
|
*
|
||
|
|
X = INT((BOT - 1) / LINES.PER.CELL) ; * DETERMINE NUMBER OF FULL CELLS
|
||
|
|
LNUM = 0
|
||
|
|
PROGRAM = PROGRAM ; * Reset remove pointer
|
||
|
|
FOR XX = 1 TO X
|
||
|
|
LPC (XX) = LINES.PER.CELL
|
||
|
|
LNUM += 1
|
||
|
|
PROGRAM.LINE = ''
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE.SEGMENT FROM PROGRAM SETTING LINE.SEGMENT.MARK
|
||
|
|
UNTIL(LINE.SEGMENT.MARK = 2 OR LINE.SEGMENT.MARK = 0) DO
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT:CHAR(256 - LINE.SEGMENT.MARK)
|
||
|
|
REPEAT
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT
|
||
|
|
MEMORY (XX) = PROGRAM.LINE
|
||
|
|
FOR XXX = 2 TO LINES.PER.CELL ; * MOVE LINES INTO CELL
|
||
|
|
LNUM += 1
|
||
|
|
PROGRAM.LINE = ''
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE.SEGMENT FROM PROGRAM SETTING LINE.SEGMENT.MARK
|
||
|
|
UNTIL(LINE.SEGMENT.MARK = 2 OR LINE.SEGMENT.MARK = 0) DO
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT:CHAR(256 - LINE.SEGMENT.MARK)
|
||
|
|
REPEAT
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT
|
||
|
|
MEMORY (XX) := @FM:PROGRAM.LINE
|
||
|
|
NEXT XXX
|
||
|
|
NEXT XX
|
||
|
|
XX = X + 1 ; * CELL NUMBER OF LAST CELL
|
||
|
|
X = MOD(BOT - 1, LINES.PER.CELL) + 1 ; * DETERMINE NUM OF LINES IN LAST CELL
|
||
|
|
IF X THEN
|
||
|
|
LPC (XX) = X
|
||
|
|
LNUM += 1
|
||
|
|
PROGRAM.LINE = ''
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE.SEGMENT FROM PROGRAM SETTING LINE.SEGMENT.MARK
|
||
|
|
UNTIL(LINE.SEGMENT.MARK = 2 OR LINE.SEGMENT.MARK = 0) DO
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT:CHAR(256 - LINE.SEGMENT.MARK)
|
||
|
|
REPEAT
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT
|
||
|
|
MEMORY (XX) = PROGRAM.LINE
|
||
|
|
FOR XXX = 2 TO X ; * MOVE LINES INTO LAST CELL
|
||
|
|
LNUM += 1
|
||
|
|
PROGRAM.LINE = ''
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE.SEGMENT FROM PROGRAM SETTING LINE.SEGMENT.MARK
|
||
|
|
UNTIL(LINE.SEGMENT.MARK = 2 OR LINE.SEGMENT.MARK = 0) DO
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT:CHAR(256 - LINE.SEGMENT.MARK)
|
||
|
|
REPEAT
|
||
|
|
IF ISNULL(LINE.SEGMENT) THEN LINE.SEGMENT = @NULL.STR
|
||
|
|
PROGRAM.LINE := LINE.SEGMENT
|
||
|
|
MEMORY (XX) := @FM:PROGRAM.LINE
|
||
|
|
NEXT XXX
|
||
|
|
END
|
||
|
|
LAST.CELL = XX
|
||
|
|
CELL.FIRST.LINE = 1 ; CELL = 1 ; LNUM = 0
|
||
|
|
PROGRAM = '' ; * RETURN DMR STRING SPACE
|
||
|
|
GOTO END.CHANGE
|
||
|
|
|
||
|
|
G.N: ; * Goto a line (by number).
|
||
|
|
LNUM = CMDN ; GOTO CK.NUM
|
||
|
|
|
||
|
|
G.BEGIN.BLOCK: ; * 'G<': goto beginning of a BLOCK.
|
||
|
|
IF MFROM = 0 THEN GOSUB BLOCK.CHECK
|
||
|
|
LNUM = MFROM ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
G.END.BLOCK: ; * 'G>': goto end of a BLOCK.
|
||
|
|
IF MTHRU = 0 THEN GOSUB BLOCK.CHECK
|
||
|
|
LNUM = MTHRU ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
HELP.ANY: ; * Display HELP information.
|
||
|
|
GOSUB READ.HELP.RECORD
|
||
|
|
ANY = UPCMD [5, 99]
|
||
|
|
IF LEN(ANY) = 0 THEN
|
||
|
|
CALL *UVPRINTMSG(001248,"")
|
||
|
|
GOSUB INPUT.LINE ; ANY = INPUT.LINE
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Upcase the keywords or letter.
|
||
|
|
ANY = TRIM(ANY) ; ANY = UPCASE(ANY) ; XX = 0 ; PRINT
|
||
|
|
HELP.COUNT = COUNT(HELP.RECORD, @FM) + 1
|
||
|
|
FOR X = 1 TO HELP.COUNT
|
||
|
|
LINEX = HELP.RECORD <X>
|
||
|
|
IF (IF LEN(ANY) # 1 THEN INDEX(LINEX, ANY, 1) ELSE LINEX [1, 1] = ANY) THEN
|
||
|
|
LOOP
|
||
|
|
REMOVE LINEXX FROM LINEX SETTING DELIM
|
||
|
|
PRINT LINEXX ; XX += 1
|
||
|
|
IF XX => (@CRTHIGH - 2) THEN
|
||
|
|
CALL *UVPRINTMSG(001142,"")
|
||
|
|
INPUT Q, 1 ; Q = UPCASE(Q)
|
||
|
|
IF Q = 'Q' THEN GOTO HELP.END
|
||
|
|
XX = 0 ; PRINT
|
||
|
|
END
|
||
|
|
WHILE DELIM
|
||
|
|
REPEAT
|
||
|
|
END
|
||
|
|
NEXT X
|
||
|
|
|
||
|
|
HELP.END:
|
||
|
|
LINEX = '' ; PRINT ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
I.ANY: ; * Insert a new line of text.
|
||
|
|
IF ANY = ' ' THEN ANY = ' ' ; * ANY = ''
|
||
|
|
* LNUM += 1
|
||
|
|
* MEMORY (CELL) = INSERT(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, ANY)
|
||
|
|
* The following code replaces the above 2 lines, which fail when
|
||
|
|
* inserting data before the last field if the last field is null.
|
||
|
|
X = LNUM - CELL.FIRST.LINE
|
||
|
|
IF X < 0 THEN
|
||
|
|
IF LEN(MEMORY (CELL)) = 0 THEN MEMORY (CELL) = ANY
|
||
|
|
ELSE MEMORY (CELL) = ANY:@FM:MEMORY (CELL)
|
||
|
|
END ELSE
|
||
|
|
Y = FIELD(MEMORY (CELL), @FM, 1, X + 1):@FM:ANY
|
||
|
|
X = MEMORY (CELL) [COL2(), 99999999]
|
||
|
|
IF LEN(X) = 0 THEN MEMORY (CELL) = Y
|
||
|
|
ELSE MEMORY (CELL) = Y:X
|
||
|
|
END
|
||
|
|
LNUM += 1
|
||
|
|
*---- End of special code.
|
||
|
|
LPC (CELL) += 1
|
||
|
|
IF BOT = 0 THEN LAST.CELL = 1
|
||
|
|
BOT += 1
|
||
|
|
BLOCK.TRACK.LNUM = LNUM ; BLOCK.TRACK.CHANGE = 1 ; GOSUB BLOCK.TRACK
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
I.BEFORE: ; * Insert before current line.
|
||
|
|
ANY = CMD [4, 9999]
|
||
|
|
LNUM -= 1 ; * Back up one line.
|
||
|
|
IF LNUM < 0 THEN LNUM = 0
|
||
|
|
IF ANY THEN GOTO I.ANY ELSE GOTO I
|
||
|
|
|
||
|
|
I: ; * Put editor into INPUT mode.
|
||
|
|
LNUM.INPUT = LNUM
|
||
|
|
LNUM += 1
|
||
|
|
PRINT STR('0', 4 - LEN(LNUM)):LNUM:'=':
|
||
|
|
LOOP
|
||
|
|
INPUT.MODE = TRUE
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
IF LEN(INPUT.LINE) = 0 THEN
|
||
|
|
LNUM = LNUM.INPUT
|
||
|
|
GOSUB INSERT.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO GET.CMD ; * SJE 23 Apr 84
|
||
|
|
LNUM = LNUM.INPUT + NEW.BOT
|
||
|
|
BLOCK.TRACK.LNUM = LNUM ; BLOCK.TRACK.CHANGE = NEW.BOT ; GOSUB BLOCK.TRACK
|
||
|
|
GOSUB CLEAR.NEW.MEMORY
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
LNUM += 1 ; * PRINT NEXT LINE NUM ASAP
|
||
|
|
PRINT STR('0', 4 - LEN(LNUM)):LNUM:'=':
|
||
|
|
IF INPUT.LINE = ' ' THEN INPUT.LINE = '' ; * INPUT A NULL LINE
|
||
|
|
NEW.MEMORY.LINE = INPUT.LINE
|
||
|
|
GOSUB APPEND.NEW.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO GET.CMD ; * SJE 23 Apr 84
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
L.ANY: ; * Locate a line containing the string 'any'.
|
||
|
|
LOCATE.STRING = ANY
|
||
|
|
|
||
|
|
L:
|
||
|
|
SEARCH.X = 2
|
||
|
|
|
||
|
|
L.AGAIN:
|
||
|
|
IF LNUM => BOT THEN LNUM = 0
|
||
|
|
|
||
|
|
L.NEXT:
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
GOSUB ABORT.CHECK
|
||
|
|
IF ABORT = 'Q' THEN
|
||
|
|
CALL *UVPRINTMSG(001228,"")
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END
|
||
|
|
LNUM += 1
|
||
|
|
IF LNUM > BOT THEN LNUM = BOT ; GOTO END.NOCHANGE
|
||
|
|
GOSUB GET.LINE
|
||
|
|
ON SEARCH.X GOTO FINDX, LOCATEX, MATCHX
|
||
|
|
|
||
|
|
FINDX:
|
||
|
|
IF LINE [ST.COLUMN, FLEN] = FIND.STRING THEN
|
||
|
|
COMMAND.SUCCESSFUL = TRUE
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END ELSE
|
||
|
|
GOTO L.NEXT
|
||
|
|
END
|
||
|
|
|
||
|
|
LOCATEX:
|
||
|
|
IF INDEX(LINE, LOCATE.STRING, 1) THEN
|
||
|
|
COMMAND.SUCCESSFUL = TRUE
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END ELSE
|
||
|
|
GOTO L.NEXT
|
||
|
|
END
|
||
|
|
|
||
|
|
MATCHX:
|
||
|
|
IF LEN(LINE) => 188 THEN
|
||
|
|
PRINT 'Line ':LNUM:' is longer than 188 characters, MATCH NOT DONE, line skipped.'
|
||
|
|
GOTO L.NEXT
|
||
|
|
END
|
||
|
|
IF LINE MATCHES MATCH.STRING THEN
|
||
|
|
COMMAND.SUCCESSFUL = TRUE
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END ELSE
|
||
|
|
GOTO L.NEXT
|
||
|
|
END
|
||
|
|
|
||
|
|
LOAD.ANY: ; * Load lines from another record.
|
||
|
|
IF UPCMD1 = '.' THEN SENT = TRIM(CMD [4, 99])
|
||
|
|
ELSE SENT = TRIM(CMD [6, 99])
|
||
|
|
IF COUNT(SENT, ' ') > 2 THEN
|
||
|
|
PRINT 'Too many parameters. Expected (at most) a file name and record name.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF COUNT(SENT, ' ') THEN
|
||
|
|
PROMPT.FOR.FILE = FALSE ; NO.SELECT.LIST = TRUE ; SINGLE.FILE.ONLY = TRUE
|
||
|
|
LOAD.FILE.NAME = '' ; LOAD.DICT = '' ; LOAD.DICT.TEXT = ''
|
||
|
|
CALL @GET.FILE.NAME (NO.SELECT.LIST, SENT, LOAD.DICT,
|
||
|
|
LOAD.FILE.NAME, PROMPT.FOR.FILE, SINGLE.FILE.ONLY)
|
||
|
|
IF LOAD.DICT = '' ELSE LOAD.DICT.TEXT = LOAD.DICT:' '
|
||
|
|
IF LEN(LOAD.FILE.NAME) = 0 OR LOAD.FILE.NAME # LOAD.FILE.NAME <1> THEN
|
||
|
|
PRINT 'Invalid file name (not found in VOC, or not FILE DEFINITION record).'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LOAD.REC.NAME = SENT
|
||
|
|
*
|
||
|
|
* Open file to load data from. Carry on if partially successful open
|
||
|
|
* of distributed file.
|
||
|
|
*
|
||
|
|
OPENCHECK LOAD.DICT, LOAD.FILE.NAME TO LOAD.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,LOAD.FILE.NAME THEN
|
||
|
|
IF LOAD.DICT = "" THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
END ELSE
|
||
|
|
PathName = FileRec<3>
|
||
|
|
END
|
||
|
|
RELEASE DEVSYS.VOC.FILE,LOAD.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
IF LOAD.DICT = "" THEN
|
||
|
|
FileName = LOAD.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
FileName = "DICT,":LOAD.FILE.NAME
|
||
|
|
END
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
LOAD.FILE.NAME = FILE.NAME ; LOAD.DICT = DICT ; LOAD.FILE = EDIT.FILE
|
||
|
|
LOAD.DICT.TEXT = DICT.TEXT
|
||
|
|
IF UPCMD1 = '.' THEN
|
||
|
|
IF L.SELECT.FLAG AND LEN(SENT) # 0 THEN
|
||
|
|
OPENCHECK '', SENT TO LOAD.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec from DEVSYS.VOC.FILE,SENT THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
RELEASE DEVSYS.VOC.FILE,SENT
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
FileName = SENT
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LOAD.FILE.NAME = SENT ; GOTO SL.3
|
||
|
|
END
|
||
|
|
LOAD.FILE.NAME = '&ED&'
|
||
|
|
LOAD.DICT = '' ; LOAD.DICT.TEXT = ''
|
||
|
|
OPENCHECK LOAD.DICT,LOAD.FILE.NAME TO LOAD.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,LOAD.FILE.NAME THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
RELEASE DEVSYS.VOC.FILE,LOAD.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
FileName = LOAD.FILE.NAME
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
END
|
||
|
|
LOAD.REC.NAME = SENT
|
||
|
|
END
|
||
|
|
IF L.SELECT.FLAG THEN GOTO SL.3
|
||
|
|
IF LEN(SENT) = 0 THEN GOTO CMD.ERR
|
||
|
|
IF UPCMD1 = '.' THEN GOTO READ.1
|
||
|
|
IF ED.CMD.STRING.ACTIVE THEN
|
||
|
|
PRINT STARS:' Loading "':LOAD.DICT.TEXT:LOAD.FILE.NAME:'" "':LOAD.REC.NAME:'"':'.'
|
||
|
|
END
|
||
|
|
CALL *UVPRINTMSG(001193,"")
|
||
|
|
GOSUB INPUT.LINE ; START = INPUT.LINE
|
||
|
|
IF NOT(NUM(START)) THEN
|
||
|
|
PRINT 'Starting line/field must be numeric ; you entered "':START:'".'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF START < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(001231,"")
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
CALL *UVPRINTMSG(001195,"")
|
||
|
|
GOSUB INPUT.LINE ; ENDING = INPUT.LINE
|
||
|
|
IF NOT(NUM(ENDING)) THEN
|
||
|
|
PRINT 'Ending line/field must be numeric ; you entered "':ENDING:'".'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF ENDING < START THEN
|
||
|
|
CALL *UVPRINTMSG(001233,ENDING:@FM:START)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
|
||
|
|
READ.1:
|
||
|
|
READ BLOCK FROM LOAD.FILE, LOAD.REC.NAME
|
||
|
|
ELSE
|
||
|
|
* Record %s does not exist
|
||
|
|
|
||
|
|
IF STACK.MODE THEN
|
||
|
|
CALL *UVPRINTMSG(970004,LOAD.REC.NAME:@FM:LOAD.FILE.NAME)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001196,LOAD.REC.NAME)
|
||
|
|
END
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF UPCMD1 = '.' THEN GOTO GET.CMD.FROM.BLOCK
|
||
|
|
IF ENDING - START + 1 > 32767 THEN ; *015
|
||
|
|
FIELDS = 32767 ; *015
|
||
|
|
BLOCK1 = FIELD(BLOCK, @FM, START, FIELDS) ; *015
|
||
|
|
LOOP ; *015
|
||
|
|
START += 32767 ; *015
|
||
|
|
IF ENDING - START + 1 <= 32767 THEN ; *015
|
||
|
|
FIELDS = ENDING - START + 1 ; *015
|
||
|
|
END ; *015
|
||
|
|
WHILE FIELDS > 0 DO ; *015
|
||
|
|
TEMPBLOCK = FIELD(BLOCK, @FM, START, FIELDS) ; *015
|
||
|
|
IF TEMPBLOCK # '' THEN ; *015
|
||
|
|
BLOCK1 = BLOCK1:@FM:TEMPBLOCK ; *015
|
||
|
|
END ELSE ; *015
|
||
|
|
START = ENDING + 1 ; *015
|
||
|
|
END ; *015
|
||
|
|
REPEAT ; *015
|
||
|
|
BLOCK = BLOCK1 ; *015
|
||
|
|
END ELSE ; *015
|
||
|
|
BLOCK = FIELD(BLOCK, @FM, START, ENDING - START + 1)
|
||
|
|
END ; *015
|
||
|
|
LINES.READ = IF LEN(BLOCK) = 0 THEN 0 ELSE COUNT(BLOCK, @FM) + 1
|
||
|
|
IF LINES.READ = 0 THEN GOTO LOAD.3
|
||
|
|
X = INT((LINES.READ - 1) / LINES.PER.CELL) ; * DETERMINE NUM OF CELLS REQUIRED
|
||
|
|
IF X + 1 > NEW.MEMORY.DIM THEN
|
||
|
|
NEW.MEMORY.DIM = X + 10
|
||
|
|
DIM NEW.MEMORY (NEW.MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
DIM NEW.LPC (NEW.MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- The following code sets up
|
||
|
|
* to make a BLOCK of each element of the array. The size of the
|
||
|
|
* BLOCK is defined by LINES.PER.CELL.
|
||
|
|
|
||
|
|
*** MATBLOCK NEW.MEMORY FROM BLOCK, @FM, LINES.PER.CELL
|
||
|
|
CALL @MATBLOCK(MAT NEW.MEMORY,BLOCK,@FM,LINES.PER.CELL)
|
||
|
|
FOR XX = 1 TO X
|
||
|
|
NEW.LPC (XX) = LINES.PER.CELL
|
||
|
|
NEXT XX
|
||
|
|
NEW.LAST.CELL = X + 1
|
||
|
|
NEW.LPC (NEW.LAST.CELL) = MOD(LINES.READ - 1, LINES.PER.CELL) + 1
|
||
|
|
NEW.BOT = LINES.READ
|
||
|
|
GOSUB INSERT.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
GOSUB CLEAR.NEW.MEMORY
|
||
|
|
LNUM += 1
|
||
|
|
BLOCK = '' ; * RETURN STRING SPACE
|
||
|
|
|
||
|
|
LOAD.3:
|
||
|
|
* %i lines/fields loaded.
|
||
|
|
CALL *UVPRINTMSG(001280,LINES.READ)
|
||
|
|
BLOCK.TRACK.LNUM = LNUM + LINES.READ - 1
|
||
|
|
BLOCK.TRACK.CHANGE = LINES.READ ; GOSUB BLOCK.TRACK
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
M.ANY: ; * Locate a line that matches pattern 'any'.
|
||
|
|
MATCH.STRING = ANY
|
||
|
|
|
||
|
|
M:
|
||
|
|
SEARCH.X = 3 ; GOTO L.AGAIN
|
||
|
|
|
||
|
|
MOVE: ; * Move a BLOCK of lines (deleting source lines).
|
||
|
|
MOVE.FLAG = TRUE
|
||
|
|
|
||
|
|
MOVE.COPY:
|
||
|
|
GOSUB BLOCK.CHECK
|
||
|
|
INSERT.LNUM = LNUM ; * SAVE LNUM
|
||
|
|
FOR LNUM = MFROM TO MTHRU ; * COPY THE DESIRED LINES INTO NEW MEMORY
|
||
|
|
GOSUB GET.LINE
|
||
|
|
NEW.MEMORY.LINE = LINE
|
||
|
|
GOSUB APPEND.NEW.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
NEXT LNUM
|
||
|
|
IF MOVE.FLAG THEN
|
||
|
|
LNUM = MFROM
|
||
|
|
GOSUB GET.LINE
|
||
|
|
NUM.OF.LINES.TO.DELETE = MTHRU - MFROM + 1
|
||
|
|
GOSUB DELETE.MEMORY ; * DELETE THE BLOCK IF CMD IS A MOVE
|
||
|
|
LNUM = INSERT.LNUM ; * RESTORE LNUM
|
||
|
|
IF LNUM => MTHRU THEN LNUM -= MTHRU - MFROM + 1
|
||
|
|
MTHRU += LNUM - MFROM + 1
|
||
|
|
MFROM = LNUM + 1
|
||
|
|
END ELSE
|
||
|
|
LNUM = INSERT.LNUM ; * RESTORE LNUM
|
||
|
|
IF LNUM < MFROM THEN
|
||
|
|
X = MTHRU - MFROM + 1 ; MTHRU += X ; MFROM += X
|
||
|
|
END
|
||
|
|
END
|
||
|
|
GOSUB INSERT.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO END.CMD ; * SJE 23 Apr 84
|
||
|
|
GOSUB CLEAR.NEW.MEMORY
|
||
|
|
LNUM += 1
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
N: ; * Move on to next record (if SELECT list is active).
|
||
|
|
IF SELECT.LIST.FLAG THEN
|
||
|
|
IF NOT(RECORD.CHANGE.FLAG) THEN GOTO DONE.WITH.RECORD
|
||
|
|
* Record changed --- OK to go to next record (Y)
|
||
|
|
CALL *UVPRINTMSG(001222,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS = 'Y' THEN GOTO DONE.WITH.RECORD
|
||
|
|
ELSE GOTO END.NOCHANGE
|
||
|
|
END ELSE GOTO X.2
|
||
|
|
|
||
|
|
P: ; * Print lines on the CRT.
|
||
|
|
CMDN = PNUM ; GOTO P.N.1
|
||
|
|
|
||
|
|
P.N:
|
||
|
|
CMDN = CMD [2, 99] ; * GET ORIGINAL NUMBER
|
||
|
|
|
||
|
|
P.N.1:
|
||
|
|
IF LNUM <= 0 THEN LNUM = 1
|
||
|
|
LINE1 = LNUM
|
||
|
|
IF CMDN > 1 AND UPCMD[1,1] = "P" THEN PNUM = CMDN
|
||
|
|
LINE2 = LNUM + CMDN - 1
|
||
|
|
IF LINE2 > BOT THEN LINE2 = BOT
|
||
|
|
GOSUB PRINT.GROUP
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
PRINT.BLOCK: ; * Print BLOCK on the CRT.
|
||
|
|
IF MFROM = 0 OR MTHRU = 0 THEN
|
||
|
|
* BLOCK not set up.
|
||
|
|
CALL *UVPRINTMSG(001219,"")
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF MFROM > MTHRU THEN
|
||
|
|
* BLOCK from %i through %i is in the wrong order.
|
||
|
|
CALL *UVPRINTMSG(001201,MFROM:@FM:MTHRU)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LINE1 = MFROM ; LINE2 = MTHRU ; LNUMX = LNUM
|
||
|
|
GOSUB PRINT.GROUP
|
||
|
|
LNUM = LNUMX ; PRINT ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
PRINT.GROUP: ; * GOSUB routine for above PRINT routines.
|
||
|
|
FOR LNUM = LINE1 TO LINE2
|
||
|
|
GOSUB GET.LINE ; GOSUB PRINT.LINE
|
||
|
|
GOSUB ABORT.CHECK
|
||
|
|
IF ABORT = 'Q' THEN
|
||
|
|
CALL *UVPRINTMSG(001228,"")
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
NEXT LNUM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PO.N: ; * Set line number pointer to line 'n'.
|
||
|
|
CMD = CMD [3, 99]
|
||
|
|
IF NOT(NUM(CMD)) THEN
|
||
|
|
PRINT 'A line number is required ; you entered ':CMD:'.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
GOTO SET.LNUM
|
||
|
|
|
||
|
|
QUIT: ; * Quit this edit session.
|
||
|
|
* IF SELECT.LIST.FLAG THEN
|
||
|
|
* CALL *UVPRINTMSG(001216,"")
|
||
|
|
* PRINT 'Use "X" to exit EDITOR or "N" to see next selected ':REC:'.'
|
||
|
|
* GOTO CMD.ERR
|
||
|
|
* END
|
||
|
|
IF NOT(RECORD.CHANGE.FLAG) THEN GOTO DONE.WITH.RECORD
|
||
|
|
* Record changed, OK to Quit (Y)
|
||
|
|
CALL *UVPRINTMSG(001218,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS = 'Y' THEN GOTO DONE.WITH.RECORD
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
QUESTION.MARK: ; * '?': display current STATUS.
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
CALL *UVPRINTMSG(970011,@ACCOUNT)
|
||
|
|
CALL *UVPRINTMSG(001262,"")
|
||
|
|
PRINT DICT.TEXT:FILE.NAME:
|
||
|
|
IF EDIT.READ.ONLY THEN CALL *UVPRINTMSG(001263,"")
|
||
|
|
PRINT
|
||
|
|
LINEX = DISPLAY.RECORD.NAME
|
||
|
|
IF NLS.ON.FLAG AND UP.ARROW.FLAG THEN ;* in NLS mode, only display ID
|
||
|
|
GOSUB CONV.LINEX.TO.UP.ARROW ;* as ^xxx if ^ mode is on
|
||
|
|
END
|
||
|
|
CALL *UVPRINTMSG(001264,LINEX) ;* record name = nnnnnn
|
||
|
|
CALL *UVPRINTMSG(001265,LNUM)
|
||
|
|
IF UP.ARROW.FLAG THEN
|
||
|
|
IF UP.ARROW.UNIC.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001266,ENABLED:UNICODE) ;* NLS Unicode ^x mode on
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001266,ENABLED) ;* standard ^ mode on
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001266,DISABLED)
|
||
|
|
END
|
||
|
|
IF ABORT.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001267,ENABLED)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001267,DISABLED)
|
||
|
|
END
|
||
|
|
IF BLOCK.VERIFY.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001268,ENABLED)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001268,DISABLED)
|
||
|
|
END
|
||
|
|
IF MTHRU = 0 OR MFROM = 0 THEN
|
||
|
|
* No BLOCK currently defined.
|
||
|
|
CALL *UVPRINTMSG(001269,"")
|
||
|
|
IF MFROM # 0 THEN
|
||
|
|
* Block FROM set to line %i.
|
||
|
|
CALL *UVPRINTMSG(001226,MFROM)
|
||
|
|
END
|
||
|
|
IF MTHRU # 0 THEN
|
||
|
|
* Block THROUGH set to line %i.
|
||
|
|
CALL *UVPRINTMSG(001225,MTHRU)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
* BLOCK is from line %i through %i.
|
||
|
|
CALL *UVPRINTMSG(001270,MFROM:@FM:MTHRU)
|
||
|
|
END
|
||
|
|
IF CURR.CMD.NAME THEN
|
||
|
|
PRINT 'Last Pre-store executed = "':CURR.CMD.NAME:'".':
|
||
|
|
IF ED.CMD.STRING.SUSPENDED THEN PRINT ' Command is at a PAUSE.'
|
||
|
|
ELSE PRINT ' Command is not active.'
|
||
|
|
END ELSE
|
||
|
|
PRINT 'No ':PRE.STORE:' has been executed this session.'
|
||
|
|
END
|
||
|
|
RESTORE.CMD = IF ED.CMD.STRING.ACTIVE AND CHANGE.DURING.CMD.STRING THEN PRIOR.CMD ELSE SAVED.CMD
|
||
|
|
IF RESTORE.CMD THEN
|
||
|
|
CALL *UVPRINTMSG(001271,RESTORE.CMD)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001249,"")
|
||
|
|
END
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
R.ANY: ; * Replace line with new text.
|
||
|
|
REPLACE.STRING = CMD [3, 999999]
|
||
|
|
|
||
|
|
R:
|
||
|
|
IF LNUM < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(970010,LNUM)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, REPLACE.STRING)
|
||
|
|
GOTO END.CHANGE
|
||
|
|
|
||
|
|
RELEASE: ; * Release record lock.
|
||
|
|
IF RECORD.NAME.LOCKED THEN
|
||
|
|
RELEASE EDIT.FILE, RECORD.NAME
|
||
|
|
RECORD.NAME.LOCKED = FALSE
|
||
|
|
CALL *UVPRINTMSG(001252,"")
|
||
|
|
END ELSE PRINT UREC:' was not locked.'
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SAVE.ANY: ; * Save a copy of this record.
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
IF RECORD.CHANGE.FLAG OR UPCMD # 'SAVE' THEN
|
||
|
|
GOSUB FILE.IT
|
||
|
|
IF NOT(WRITEERROR) THEN RECORD.CHANGE.FLAG = FALSE ; * RESET ;*026
|
||
|
|
END ELSE
|
||
|
|
PRINT UREC:' has not been changed, or you already have done a SAVE.'
|
||
|
|
END
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SEQ.ANY: ; * Generate a sequential number.
|
||
|
|
X = 4
|
||
|
|
LOOP DELIM = CMD [X, 1] WHILE DELIM = ' ' DO X += 1 REPEAT
|
||
|
|
IF NOT(INDEX(DELIM.STRING, DELIM, 1)) THEN
|
||
|
|
PRINT 'Valid delimiters are ':DELIM.STRING
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF COUNT(CMD, DELIM) > 4 THEN
|
||
|
|
PRINT 'Too many delimiters (4 maximum).'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
FROM.FIELD = FIELD(CMD, DELIM, 2)
|
||
|
|
LEN.FROM.FIELD = LEN(FROM.FIELD)
|
||
|
|
TO.FIELD = FIELD(CMD, DELIM, 3)
|
||
|
|
INC.FIELD = FIELD(CMD, DELIM, 5)
|
||
|
|
IF NOT(NUM(INC.FIELD)) OR LEN(TO.FIELD) = 0 OR NOT(NUM(TO.FIELD)) THEN
|
||
|
|
GOTO NUMBER.ERR
|
||
|
|
END
|
||
|
|
IF LEN(INC.FIELD) = 0 THEN INC.FIELD = 1
|
||
|
|
EXTEND = 0
|
||
|
|
N = FIELD(CMD, DELIM, 4)
|
||
|
|
N = UPCASE(N)
|
||
|
|
IF N = 'B' THEN
|
||
|
|
GOSUB BLOCK.CHECK ; LNUM = MFROM ; LEND = MTHRU
|
||
|
|
END ELSE
|
||
|
|
IF LEN(N) = 0 OR NOT(NUM(N)) THEN GOTO NUMBER.ERR
|
||
|
|
IF LNUM <= 0 THEN LNUM = 1
|
||
|
|
LEND = LNUM + N - 1
|
||
|
|
EXTEND = 0
|
||
|
|
IF FROM.FIELD THEN
|
||
|
|
IF LEND > BOT THEN LEND = BOT
|
||
|
|
END ELSE
|
||
|
|
IF LEND > BOT THEN EXTEND = LEND ; LEND = BOT
|
||
|
|
END
|
||
|
|
END
|
||
|
|
X.CHANGE.FLAG = FALSE ; * RESET LOCAL CHANGE FLAG
|
||
|
|
FOR LNUM = LNUM TO LEND
|
||
|
|
GOSUB GET.LINE
|
||
|
|
IF LEN(FROM.FIELD) = 0 THEN LINE = TO.FIELD:LINE ; GOTO S.REPLACE.LINE
|
||
|
|
X = INDEX(LINE, FROM.FIELD, 1)
|
||
|
|
IF X = 0 THEN GOTO S.NEXT.LINE
|
||
|
|
LINE = LINE [1, X - 1]:TO.FIELD:LINE [X + LEN.FROM.FIELD, 999999]
|
||
|
|
|
||
|
|
S.REPLACE.LINE:
|
||
|
|
MEMORY (CELL) = REPLACE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0, LINE)
|
||
|
|
GOSUB PRINT.LINE
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
X.CHANGE.FLAG = TRUE ; * SET LOCAL CHANGE FLAG
|
||
|
|
TO.FIELD += INC.FIELD
|
||
|
|
|
||
|
|
S.NEXT.LINE:
|
||
|
|
NEXT LNUM
|
||
|
|
IF EXTEND THEN
|
||
|
|
FOR LNUM = BOT + 1 TO EXTEND
|
||
|
|
LINE = TO.FIELD
|
||
|
|
GOSUB PRINT.LINE
|
||
|
|
NEW.MEMORY.LINE = LINE
|
||
|
|
GOSUB APPEND.NEW.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO GET.CMD ; * SJE 23 Apr 84
|
||
|
|
TO.FIELD += INC.FIELD
|
||
|
|
NEXT LNUM
|
||
|
|
LNUM = BOT
|
||
|
|
GOSUB INSERT.MEMORY
|
||
|
|
IF OVERFLOW.FLAG THEN GOTO GET.CMD ; * SJE 23 Apr 84
|
||
|
|
GOSUB CLEAR.NEW.MEMORY
|
||
|
|
LNUM = EXTEND
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
CHANGE.FLAG = X.CHANGE.FLAG ; * SET UP FLAG FOR OOPS SINCE GET.LINE
|
||
|
|
; * COULD HAVE RESET IT AFTER LAST LINE ACTUALLY CHANGED
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
SIZE: ; * Display information about SIZE of record.
|
||
|
|
LENGTH = 0
|
||
|
|
FOR X = 1 TO LAST.CELL
|
||
|
|
LENGTH += LEN(MEMORY (X)) ; * ADD LENGTH OF LINES
|
||
|
|
NEXT X
|
||
|
|
IF LAST.CELL > 1 THEN LENGTH += LAST.CELL - 1
|
||
|
|
CALL *UVPRINTMSG(001255,DISPLAY.RECORD.NAME:@FM:BOT:@FM:LENGTH)
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SPOOL.HELP: ; * Spool the HELP file on line printer.
|
||
|
|
GOSUB READ.HELP.RECORD
|
||
|
|
PRINTER ON
|
||
|
|
HEADING 'EDITOR H E L P LIST OF COMMANDS ':TIMEDATE():"'LLL'"
|
||
|
|
LOOP
|
||
|
|
REMOVE LINEX FROM HELP.RECORD SETTING DELIM
|
||
|
|
PRINT LINEX ; PRINT ' '
|
||
|
|
WHILE DELIM REPEAT
|
||
|
|
PRINTER OFF
|
||
|
|
DUMMY = @(0) ; * TURN OFF CRT PAGING
|
||
|
|
PRINT 'HELP listing spooled to printer.'
|
||
|
|
GOTO HELP.END
|
||
|
|
|
||
|
|
SPOOL.N: ; * Spool the record on line printer.
|
||
|
|
CMDN = CMD [6, 99]
|
||
|
|
IF NOT(NUM(CMDN)) THEN GOTO NUMBER.ERR
|
||
|
|
IF CMDN > 0 THEN
|
||
|
|
IF LNUM <= 0 THEN LNUM = 1
|
||
|
|
IF LNUM + CMDN - 1 > BOT THEN CMDN = BOT - LNUM + 1
|
||
|
|
LEND = LNUM + CMDN - 1
|
||
|
|
END ELSE LNUM = 1 ; LEND = BOT
|
||
|
|
BREAK KEY OFF
|
||
|
|
PRINTER ON ;* send output to lptr 0 via channel 0.
|
||
|
|
LPTR.WIDTH = @LPTRWIDE
|
||
|
|
LPTR.MODE = 0 ; CODE = 0
|
||
|
|
CALL @GETPU(PU$MODE,0,LPTR.MODE,CODE)
|
||
|
|
IF LPTR.MODE # 3 THEN
|
||
|
|
* save banner
|
||
|
|
LPTR.BANNER = SPACE(32)
|
||
|
|
CODE = 0
|
||
|
|
CALL @GETPU(PU$BANNER,0,LPTR.BANNER,CODE)
|
||
|
|
* set banner
|
||
|
|
RECORD.BANNER = FMT(DISPLAY.RECORD.NAME, 'L#32')
|
||
|
|
CALL @SETPU(PU$BANNER,0,RECORD.BANNER,CODE)
|
||
|
|
END
|
||
|
|
HEADING UREC:' - ':DISPLAY.RECORD.NAME:' File - ':FILE.NAME:' Account - ':@ACCOUNT:' ':TIMEDATE():"'LL'"
|
||
|
|
LINE.LENGTH = LPTR.WIDTH - 7
|
||
|
|
FOR LNUM = LNUM TO LEND
|
||
|
|
GOSUB GET.LINE ; GOSUB PRINT.LINE
|
||
|
|
NEXT LNUM
|
||
|
|
PRINTER CLOSE ;* Flush printer buffer (GTAR 12556)
|
||
|
|
PRINTER OFF
|
||
|
|
PRINTER CLOSE
|
||
|
|
IF LPTR.MODE # 3 THEN
|
||
|
|
* reset banner
|
||
|
|
PRINTER ON
|
||
|
|
CALL @SETPU(PU$BANNER,0,LPTR.BANNER,CODE)
|
||
|
|
PRINTER CLOSE ;* Flush printer buffer (GTAR 12556)
|
||
|
|
PRINTER OFF
|
||
|
|
END
|
||
|
|
BREAK KEY ON
|
||
|
|
DUMMY = @(0) ; * TURN OFF CRT PAGING
|
||
|
|
LINE.LENGTH = CRT.WIDTH - 7
|
||
|
|
IF CMDN > 0 THEN PRINT 'Lines ':LEND - CMDN + 1:' to ':LEND:' of ':
|
||
|
|
PRINT '"':DISPLAY.RECORD.NAME:'" spooled to the printer.'
|
||
|
|
|
||
|
|
T: ; * Goto TOP of record.
|
||
|
|
LNUM = 0 ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
STAMP:
|
||
|
|
CMD = 'I '
|
||
|
|
BEGIN CASE
|
||
|
|
CASE RECORD.NAME [4] = '.CBL' OR RECORD.NAME [6] = '.COBOL'
|
||
|
|
CMD := SPACE(6):'*'
|
||
|
|
CASE RECORD.NAME [4] = '.CPL'
|
||
|
|
CMD := '/*'
|
||
|
|
CASE RECORD.NAME [4] = '.F77' OR RECORD.NAME [4] = '.FTN'
|
||
|
|
CMD := 'C'
|
||
|
|
CASE RECORD.NAME [7] = '.PASCAL'
|
||
|
|
CMD := '{'
|
||
|
|
CASE RECORD.NAME [4] = '.PL1' OR RECORD.NAME [5] = '.PL1G' OR RECORD.NAME [4] = '.PLP' OR RECORD.NAME [4] = '.SPL'
|
||
|
|
CMD := '/*'
|
||
|
|
CASE RECORD.NAME [5] = '.RUNI'
|
||
|
|
CMD := '.*'
|
||
|
|
CASE TRUE
|
||
|
|
CMD := '*'
|
||
|
|
END CASE
|
||
|
|
CMD := ' Last updated by ':@WHO
|
||
|
|
IF @WHO # @LOGNAME THEN CMD := ' (':@LOGNAME:')'
|
||
|
|
CMD := ' at ':OCONV(TIME(), 'MTS')
|
||
|
|
CMD := ' on ':OCONV(DATE(), 'D4/'):'.'
|
||
|
|
BEGIN CASE
|
||
|
|
CASE RECORD.NAME [7] = '.PASCAL'
|
||
|
|
CMD := ' }'
|
||
|
|
CASE RECORD.NAME [4] = '.PL1' OR RECORD.NAME [5] = '.PL1G' OR RECORD.NAME [4] = '.PLP' OR RECORD.NAME [4] = '.SPL'
|
||
|
|
CMD := ' */'
|
||
|
|
CASE TRUE
|
||
|
|
NULL
|
||
|
|
END CASE
|
||
|
|
STACK.MODE = FALSE
|
||
|
|
GOTO GET.CMD.2
|
||
|
|
|
||
|
|
UNLOAD.ANY: ; * Unload lines to another record.
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
SV.LNUM = LNUM ; UNLOAD.FLAG = TRUE
|
||
|
|
GOSUB STRING.WRITE
|
||
|
|
UNLOAD.FLAG = FALSE ; LNUM = SV.LNUM
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SET.LNUM: ; * '+n', '-n', 'n': set line number.
|
||
|
|
IF CMD [1, 1] = '+' OR CMD [1, 1] = '-' THEN LNUM += INT(CMD)
|
||
|
|
ELSE LNUM = INT(CMD)
|
||
|
|
|
||
|
|
CK.NUM:
|
||
|
|
IF LNUM < 0 THEN LNUM = 0
|
||
|
|
IF LNUM > BOT THEN LNUM = BOT ; COMMAND.SUCCESSFUL = FALSE
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
MFROM: ; * '<': set BLOCK 'from' pointer.
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
IF LNUM = 0 THEN
|
||
|
|
|
||
|
|
CLEAR.BLOCK:
|
||
|
|
MFROM = 0 ; MTHRU = 0
|
||
|
|
* The current BLOCK pointers have been cleared.
|
||
|
|
CALL *UVPRINTMSG(001224,"")
|
||
|
|
END ELSE
|
||
|
|
MFROM = LNUM
|
||
|
|
* Block FROM set to line %i.
|
||
|
|
CALL *UVPRINTMSG(001226,MFROM)
|
||
|
|
END
|
||
|
|
IF UPCMD # '<>' OR LNUM = 0 THEN GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
MTHRU: ; * '>': set BLOCK 'to' pointer.
|
||
|
|
COMMAND.SUCCESSFUL = FALSE
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
IF LNUM = 0 THEN GOTO CLEAR.BLOCK
|
||
|
|
MTHRU = LNUM
|
||
|
|
* Block THROUGH set to line %i.
|
||
|
|
CALL *UVPRINTMSG(001225,MTHRU)
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
UP.ARROW.TOGGLE: ; * '^': Up arrow display mode toggle.
|
||
|
|
* Controls the display/printing of special characters.
|
||
|
|
* There are two modes:
|
||
|
|
* - Straight '^' mode, in which unprintable characters are displayed as
|
||
|
|
* ^ddd (3-digit decimals) (UP.ARROW.FLAG AND NOT(UP.ARROW.UNIC.FLAG))
|
||
|
|
* unless the characters is > 255, in which case same as ^X mode.
|
||
|
|
* - NLS '^X' mode, in which unprintable characters are displayed as
|
||
|
|
* ^hhhh (4-digit hex) (UP.ARROW.FLAG AND UP.ARROW.UNIC.FLAG).
|
||
|
|
|
||
|
|
IF UPCMD = UP.ARROW.UNIC.UP THEN
|
||
|
|
* ^X means force Unicode ^ mode on regardless of previous state, but
|
||
|
|
* is only recognized if Unicode (NLS) mode is on:
|
||
|
|
IF NOT(NLS.ON.FLAG) THEN
|
||
|
|
* 'The %s command is not allowed unless NLS support is ON.'
|
||
|
|
* CALL *UVPRINTMSG('970014',UP.ARROW.UNIC.UP)
|
||
|
|
GOSUB PRINT.INVALID.UP.ARROW ;* replace with line above after 8.3.3
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
END
|
||
|
|
UP.ARROW.UNIC.FLAG = TRUE
|
||
|
|
UP.ARROW.FLAG = TRUE
|
||
|
|
END ELSE
|
||
|
|
* ^ on its own toggles standard mode, always sets Unicode ^ mode off:
|
||
|
|
UP.ARROW.FLAG = NOT(UP.ARROW.FLAG)
|
||
|
|
UP.ARROW.UNIC.FLAG = FALSE
|
||
|
|
END
|
||
|
|
IF UP.ARROW.FLAG THEN
|
||
|
|
IF UP.ARROW.UNIC.FLAG THEN
|
||
|
|
CALL *UVPRINTMSG(001266,ENABLED:UNICODE) ;* NLS Unicode ^x mode on
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001266,ENABLED) ;* standard ^ mode on
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001266,DISABLED)
|
||
|
|
END
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
***********************************************************************
|
||
|
|
* exit edit session and close common VOC file.
|
||
|
|
*
|
||
|
|
STOP:
|
||
|
|
IF ASSIGNED(DEVSYS.VOC.FILE) THEN
|
||
|
|
CLOSE DEVSYS.VOC.FILE
|
||
|
|
END
|
||
|
|
DEVSYS.DICT.SWITCH = 0
|
||
|
|
IF ASSIGNED(DEVSYS.DICT.FILE) THEN
|
||
|
|
CLOSE DEVSYS.DICT.FILE
|
||
|
|
END
|
||
|
|
DEVSYS.DICT.FILE.NAME = ""
|
||
|
|
IF ASSIGNED(DEVSYS.DATA.FILE) THEN
|
||
|
|
CLOSE DEVSYS.DATA.FILE
|
||
|
|
END
|
||
|
|
DEVSYS.DATA.FILE.NAME = ""
|
||
|
|
IF ASSIGNED(DEVSYS.R.FILE) THEN
|
||
|
|
CLOSE DEVSYS.R.FILE
|
||
|
|
END
|
||
|
|
DEVSYS.R.FILE.NAME = ""
|
||
|
|
PRINT:
|
||
|
|
|
||
|
|
STOP.POP:
|
||
|
|
RETURN TO STOP.POP
|
||
|
|
|
||
|
|
X: ; * Exit from editor when SELECT list is active.
|
||
|
|
IF SELECT.LIST.FLAG THEN
|
||
|
|
*---- PCC was here 11/04/83. Now releases locked record before stoppping.
|
||
|
|
IF RECORD.CHANGE.FLAG THEN
|
||
|
|
*------- See if we want to file first.
|
||
|
|
* Record changed --- OK to EXIT (Y)
|
||
|
|
CALL *UVPRINTMSG(001223,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Y' THEN GOTO END.NOCHANGE ; * file it maybe
|
||
|
|
END
|
||
|
|
*------- We're stopping, but first may need to release current record.
|
||
|
|
IF RECORD.NAME.LOCKED THEN
|
||
|
|
RELEASE EDIT.FILE, RECORD.NAME ; * RELEASE RECORD LOCK
|
||
|
|
RECORD.NAME.LOCKED = FALSE
|
||
|
|
END
|
||
|
|
GOTO STOP
|
||
|
|
END
|
||
|
|
|
||
|
|
X.2:
|
||
|
|
* This command can only be used when a SELECT list is active.
|
||
|
|
CALL *UVPRINTMSG(001221,"")
|
||
|
|
GOTO CMD.ERR
|
||
|
|
*
|
||
|
|
* 007 - This section of code has replaced the old section completely.
|
||
|
|
* Note: the @variable @LINE is a special case, as it is the current
|
||
|
|
* line being edited, and must be allocated dynamically as
|
||
|
|
* the xeq sentence is being 'parsed';
|
||
|
|
* Note: tokens are strings delimited by blanks, thus to pass a legal
|
||
|
|
* @variable name to xeq without replacing it, the sentence must
|
||
|
|
* be of the form:
|
||
|
|
* XEQ ..... '@variable' ..... or
|
||
|
|
* XEQ ..... "@variable" .....
|
||
|
|
*
|
||
|
|
* Note the blanks before and after the dots
|
||
|
|
*
|
||
|
|
XEQ.ANY: ; * 007 Execute any PERFORM statement.
|
||
|
|
NEW.XEQ=''
|
||
|
|
*
|
||
|
|
* Get the PERFORM sentence to execute
|
||
|
|
*
|
||
|
|
XEQ.POS = INDEX(CMD, ' ', 1)
|
||
|
|
XEQ = CMD[XEQ.POS+1, 999999]
|
||
|
|
*
|
||
|
|
BLK=' '
|
||
|
|
XEQ.LEN=LEN(XEQ)
|
||
|
|
IF XEQ.LEN > 0 THEN ; * if there is anything after XEQ
|
||
|
|
|
||
|
|
NT=COUNT(XEQ,BLK)+1 ; * COUNT NUMBER OF TOKENS(>0)
|
||
|
|
FOR I=1 TO NT
|
||
|
|
TOKEN=FIELD(XEQ,BLK,I) ; * EXTRACT CURRENT TOKEN
|
||
|
|
|
||
|
|
C1=TOKEN[1,1]
|
||
|
|
C2='' ; * 013
|
||
|
|
IF C1 = '*' OR C1 = '-' THEN ; * 013
|
||
|
|
C2=C1 ; * 013
|
||
|
|
TOKEN=TOKEN[2,999999] ; * 013
|
||
|
|
C1=TOKEN[1,1] ; * 013
|
||
|
|
END ; * 013
|
||
|
|
|
||
|
|
L.TOK=LEN(TOKEN)
|
||
|
|
CL=TOKEN[L.TOK,1]
|
||
|
|
IF C1 = '@' THEN ; * CHECK FOR LEGAL @VARIABLE NAME
|
||
|
|
|
||
|
|
LOCATE TOKEN IN AT.LIST <1> BY 'AL' SETTING AT.LOC ELSE AT.LOC=''
|
||
|
|
|
||
|
|
IF AT.LOC THEN ; * LEGAL NAME FOUND,SPEC.CASE FOR @LINE
|
||
|
|
|
||
|
|
IF TOKEN='@LINE' THEN AT.SUB=REPLACE(AT.SUB,AT.LOC,0,0,LINE)
|
||
|
|
TOKEN = AT.SUB <AT.LOC>
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
IF TOKEN = '@FM' THEN TOKEN = @FM ; * CONVERT @FM TO ~
|
||
|
|
*
|
||
|
|
* NOW PROCESS QUOTED STRINGS, CHECKING THAT DATA INSIDE QUOTES IS A LEGAL
|
||
|
|
* @ VARIABLE NAME. NOTE THAT WE DO NOT NEED A SPECIAL CASE FOR @LINE, BUT
|
||
|
|
* THAT WE DO NEED ONE FOR @FM AS IT IS NOT IN AT.SUB
|
||
|
|
* SUB.TOKEN IS TOKEN STRIPPED OF QUOTES
|
||
|
|
*
|
||
|
|
IF (C1=CHAR(34) OR C1=CHAR(39)) AND CL = C1 THEN
|
||
|
|
|
||
|
|
SUB.TOKEN = TOKEN[2,L.TOK-2]
|
||
|
|
LOCATE SUB.TOKEN IN AT.LIST <1> BY 'AL' SETTING AT.LOC ELSE AT.LOC=''
|
||
|
|
IF AT.LOC OR SUB.TOKEN='@FM' THEN TOKEN=SUB.TOKEN
|
||
|
|
END
|
||
|
|
*
|
||
|
|
*IN ALL CASES ADD WHATEVER IS IN TOKEN TO NEW.XEQ
|
||
|
|
*
|
||
|
|
NEW.XEQ=NEW.XEQ:C2:TOKEN:BLK ; * 013 ;* ADD TOKEN TO NEW.XEQ IN ALL CASES
|
||
|
|
NEXT I ; * END OF DO LOOP
|
||
|
|
END ; * END OF IF PRECEEDING DO LOOP
|
||
|
|
|
||
|
|
NEW.XEQ = NEW.XEQ[1,LEN(NEW.XEQ)-1] ; * 014 ;* 018
|
||
|
|
|
||
|
|
CALL *UVPRINTMSG(001259,NEW.XEQ)
|
||
|
|
*
|
||
|
|
* (GTAR 12556) Reset terminal using uniVerse PRINTER RESET
|
||
|
|
*
|
||
|
|
PFLAG = SYSTEM(1)
|
||
|
|
IF PFLAG THEN PRINTER OFF
|
||
|
|
PRINTER RESET
|
||
|
|
IF PFLAG THEN PRINTER ON
|
||
|
|
|
||
|
|
SAVE.DEVSYS.VOC.FILE = DEVSYS.VOC.FILE
|
||
|
|
SAVE.DEVSYS.DICT.SWITCH = DEVSYS.DICT.SWITCH
|
||
|
|
SAVE.DEVSYS.DICT.FILE = DEVSYS.DICT.FILE
|
||
|
|
SAVE.DEVSYS.DICT.FILE.NAME = DEVSYS.DICT.FILE.NAME
|
||
|
|
SAVE.DEVSYS.DATA.FILE = DEVSYS.DATA.FILE
|
||
|
|
SAVE.DEVSYS.DATA.FILE.NAME = DEVSYS.DATA.FILE.NAME
|
||
|
|
SAVE.DEVSYS.R.FILE = DEVSYS.R.FILE
|
||
|
|
SAVE.DEVSYS.R.FILE.NAME = DEVSYS.R.FILE.NAME
|
||
|
|
|
||
|
|
EXECUTE NEW.XEQ ; * EXECUTE THE COMMAND LINE
|
||
|
|
|
||
|
|
DEVSYS.VOC.FILE = SAVE.DEVSYS.VOC.FILE
|
||
|
|
DEVSYS.DICT.SWITCH = SAVE.DEVSYS.DICT.SWITCH
|
||
|
|
DEVSYS.DICT.FILE = SAVE.DEVSYS.DICT.FILE
|
||
|
|
DEVSYS.DICT.FILE.NAME = SAVE.DEVSYS.DICT.FILE.NAME
|
||
|
|
DEVSYS.DATA.FILE = SAVE.DEVSYS.DATA.FILE
|
||
|
|
DEVSYS.DATA.FILE.NAME = SAVE.DEVSYS.DATA.FILE.NAME
|
||
|
|
DEVSYS.R.FILE = SAVE.DEVSYS.R.FILE
|
||
|
|
DEVSYS.R.FILE.NAME = SAVE.DEVSYS.R.FILE.NAME
|
||
|
|
|
||
|
|
PRINTER CLOSE ;* Flush printer buffer (GTAR 12556)
|
||
|
|
DUMMY = @(0) ; * DISABLE CRT PAGING AGAIN
|
||
|
|
CALL *UVPRINTMSG(001260,"")
|
||
|
|
PROMPT ' '
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
!
|
||
|
|
* General GOSUB routines.
|
||
|
|
!
|
||
|
|
|
||
|
|
GET.LINE: ; * Get specified line from record. GOSUB routine.
|
||
|
|
*---- The record being editted is maintained in a matrix called MEMORY.
|
||
|
|
* Each element of the matrix contains NUMBER.LINES.PER.CELL of source
|
||
|
|
* lines when the record is originally read into MEMORY.
|
||
|
|
* The actual number of lines in each cell is kept in a parallel matrix
|
||
|
|
* called LPC (Lines Per Cell).
|
||
|
|
|
||
|
|
*---- As MEMORY is modified, LPC must also be changed to reflect the correct
|
||
|
|
* number of lines in the changed cells. The current line, called LNUM,
|
||
|
|
* is in the current cell called CELL. The effective line number of the
|
||
|
|
* first line in the current cell is called CELL.FIRST.LNUM. The last
|
||
|
|
* line number is called BOT (bottom) and is in the last active cell
|
||
|
|
* called LAST.CELL. The variable LNUM.SAVE is used to indicate the
|
||
|
|
* previous line number that was being pointed to.
|
||
|
|
|
||
|
|
*---- The primary goal of the MEMORY accessing is speed. It is necessary
|
||
|
|
* to know if the current cell has been changed (since this reset any
|
||
|
|
* REMOVE pointers). The variable CHANGE.FLAG must be set to TRUE by any
|
||
|
|
* routine that changes any cell of MEMORY. If a cell has been changed
|
||
|
|
* then the REMOVE pointers must be rescanned.
|
||
|
|
|
||
|
|
*---- When accessing a line, the logic will determine if the line LNUM is
|
||
|
|
* in the current cell. If so, then it determines if the remove pointers
|
||
|
|
* can be used or if they have to be reset. If the line is not in the
|
||
|
|
* current cell, then the logic determines the fastest access
|
||
|
|
* to one of the four possible quadrants of MEMORY by
|
||
|
|
* scanning LPC forward from the first cell or the current cell or by
|
||
|
|
* scanning LPC backward from the last cell or the current cell.
|
||
|
|
* Once the correct cell is located, the desired line is REMOVEd.
|
||
|
|
* Subsequent accesses to get the next sequential line will use the REMOVE
|
||
|
|
* pointers until either a line is changed or the next line is in the
|
||
|
|
* next cell.
|
||
|
|
|
||
|
|
*---- GET.LINE should not be called with LNUM <= 0 or LNUM > BOT, or when the memory
|
||
|
|
* matrix is null !!!
|
||
|
|
|
||
|
|
*---- BOT line number of the last line (bottom)
|
||
|
|
* CELL current cell of MEMORY containing line LNUM
|
||
|
|
* CELL.FIRST.LINE line number of first line in this cell
|
||
|
|
* CHANGE.FLAG set to TRUE whenever a routine changes MEMORY (set by user)
|
||
|
|
* LAST.CELL last cell (matrix element) used in MEMORY and LPC
|
||
|
|
* LINE text line from record at line number LNUM
|
||
|
|
* LNUM line number of current line (set by user)
|
||
|
|
* LNUM.SAVE line number of previously accessed line
|
||
|
|
* LPC matrix, number of Lines Per Cell in MEMORY (set by user)
|
||
|
|
* MEMORY matrix of record being editted, LPC lines in each cell (set by user)
|
||
|
|
|
||
|
|
IF CHANGE.FLAG THEN
|
||
|
|
CHANGE.FLAG = FALSE ; RECORD.CHANGE.FLAG = TRUE
|
||
|
|
END ELSE
|
||
|
|
IF LNUM = LNUM.SAVE + 1 THEN
|
||
|
|
IF LNUM < CELL.FIRST.LINE + LPC (CELL) THEN GOTO GET.LINE.7 ; * GET NEXT SEQUENTIAL LINE
|
||
|
|
ELSE GOTO GET.LINE.2 ; * MUST GOTO TO NEXT CELL
|
||
|
|
END
|
||
|
|
IF (LNUM => CELL.FIRST.LINE) AND (LNUM < LPC (CELL) + CELL.FIRST.LINE) THEN
|
||
|
|
IF LNUM = LNUM.SAVE THEN RETURN ; * ALREADY HAVE IT
|
||
|
|
IF LNUM > LNUM.SAVE THEN GOTO GET.LINE.6 ; * IN THIS CELL AFTER LNUM.SAVE
|
||
|
|
ELSE GOTO GET.LINE.5 ; * IN THIS CELL BEFORE LNUM.SAVE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Not in current cell, or cell changed; find cell containing LNUM.
|
||
|
|
IF LNUM => CELL.FIRST.LINE THEN
|
||
|
|
IF LNUM > (CELL.FIRST.LINE + BOT) / 2 THEN GOTO GET.LINE.3 ; * SCAN BACK FROM BOT
|
||
|
|
ELSE GOTO GET.LINE.2 ; * SCAN UP FROM CELL
|
||
|
|
END ELSE
|
||
|
|
IF LNUM > CELL.FIRST.LINE / 2 THEN GOTO GET.LINE.4 ; * SCAN BACK FROM CELL
|
||
|
|
ELSE GOTO GET.LINE.1 ; * SCAN UP FROM START (TOP)
|
||
|
|
END
|
||
|
|
|
||
|
|
GET.LINE.1: ; * Initialize scan forward from first line.
|
||
|
|
CELL = 1 ; CELL.FIRST.LINE = 1
|
||
|
|
IF LNUM = 0 THEN
|
||
|
|
LINE = '' ; LNUM.SAVE = 0
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) ; * RESET REMOVE POINTER, DO NOT REMOVE !!!
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
GET.LINE.2: ; * Scan forward to locate desired cell containing line LNUM.
|
||
|
|
LOOP WHILE LNUM => CELL.FIRST.LINE + LPC (CELL)
|
||
|
|
CELL.FIRST.LINE += LPC (CELL)
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) ; * RESET REMOVE POINTER, DO NOT REMOVE !!!
|
||
|
|
CELL += 1
|
||
|
|
REPEAT
|
||
|
|
GOTO GET.LINE.5:
|
||
|
|
|
||
|
|
GET.LINE.3: ; * Initialize to scan backward from last cell.
|
||
|
|
CELL = LAST.CELL
|
||
|
|
CELL.FIRST.LINE = BOT + 1 - LPC (CELL)
|
||
|
|
|
||
|
|
GET.LINE.4: ; * Scan backward to locate desired cell containing line LNUM.
|
||
|
|
LOOP WHILE LNUM < CELL.FIRST.LINE
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) ; * RESET REMOVE POINTER, DO NOT REMOVE !!!
|
||
|
|
CELL -= 1 ; CELL.FIRST.LINE -= LPC (CELL)
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
GET.LINE.5: ; * Reset to start remove from first line of cell.
|
||
|
|
LNUM.SAVE = CELL.FIRST.LINE - 1
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) ; * RESET REMOVE POINTER, KEEP THIS LINE !!!
|
||
|
|
|
||
|
|
GET.LINE.6: ; * Remove lines up to the line before the desired one.
|
||
|
|
FOR X = LNUM.SAVE TO LNUM - 2
|
||
|
|
LOOP
|
||
|
|
REMOVE LINE FROM MEMORY (CELL) SETTING DX
|
||
|
|
UNTIL DX = 2 OR DX = 0 REPEAT
|
||
|
|
NEXT X
|
||
|
|
|
||
|
|
GET.LINE.7: ; * Remove the desired line.
|
||
|
|
LNUM.SAVE = LNUM
|
||
|
|
REMOVE LINE FROM MEMORY (CELL) SETTING DX
|
||
|
|
IF ISNULL(LINE) THEN LINE = @NULL.STR
|
||
|
|
IF DX = 2 OR DX = 0 THEN RETURN
|
||
|
|
LOOP
|
||
|
|
LINE := CHAR(256 - DX)
|
||
|
|
REMOVE LX FROM MEMORY (CELL) SETTING DX
|
||
|
|
IF ISNULL(LX) THEN LX = @NULL.STR
|
||
|
|
LINE := LX
|
||
|
|
UNTIL DX = 2 OR DX = 0 REPEAT
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
DELETE.MEMORY: ; * Delete 1 or more lines from record memory. GOSUB routine.
|
||
|
|
*---- This subroutine deletes lines from the blocked memory. It is assumed
|
||
|
|
* that GET.LINE has been called with LNUM set to the first line to be
|
||
|
|
* deleted (this sets up variables used here). Also, the variable
|
||
|
|
* NUM.OF.LINES.TO.DELETE should be set by the caller to the number of lines to
|
||
|
|
* be deleted.
|
||
|
|
* It is assumed that LNUM + NUM.OF.LINES.TO.DELETE - 1 is not greater than BOT.
|
||
|
|
* If during the deleting process, one or more cells of memory are
|
||
|
|
* completely cleared (LPC (CELL) = 0), then they will be squeezed out of
|
||
|
|
* the matrices MEMORY and LPC.
|
||
|
|
* The most probable delete case is to delete a single line. This case
|
||
|
|
* is optimized to be the fastest. When deleting lines out of a cell
|
||
|
|
* the logic will check to see if the entire cell will be cleared so that
|
||
|
|
* it may be squeezed out of the matrices. If two cells are partially
|
||
|
|
* deleted, they will not be recombined.
|
||
|
|
* The subroutine exits with MEMORY and LPC set up to reflect the new
|
||
|
|
* record content. CHANGE.FLAG will be set, LNUM will be backed up
|
||
|
|
* one line, and BOT and LAST.CELL will be properly adjusted.
|
||
|
|
* Two variables, CELLX and CELLY are used to count the cell to squeeze.
|
||
|
|
* CELLX points to the first cell that may be squeezable.
|
||
|
|
* CELLY points to the cell after the last one that may be squeezed.
|
||
|
|
|
||
|
|
*---- Initialize:
|
||
|
|
IF NUM.OF.LINES.TO.DELETE = 0 THEN RETURN
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
BOT -= NUM.OF.LINES.TO.DELETE
|
||
|
|
|
||
|
|
*---- Check if first cell will be totally deleted; if so, squeeze out cell.
|
||
|
|
IF LNUM = CELL.FIRST.LINE AND NUM.OF.LINES.TO.DELETE => LPC (CELL) THEN
|
||
|
|
CELLX = CELL ; GOTO DELETE.MEMORY.1
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Check if only one line (but not all of cell) to be deleted.
|
||
|
|
IF NUM.OF.LINES.TO.DELETE = 1 THEN
|
||
|
|
MEMORY (CELL) = DELETE(MEMORY (CELL), LNUM - CELL.FIRST.LINE + 1, 0, 0)
|
||
|
|
LPC (CELL) -= 1
|
||
|
|
GOTO DELETE.MEMORY.2
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Determine number of lines to delete from the first cell.
|
||
|
|
NUM.TO.DELETE = IF LNUM + NUM.OF.LINES.TO.DELETE > CELL.FIRST.LINE + LPC (CELL)
|
||
|
|
THEN LPC (CELL) - (LNUM-CELL.FIRST.LINE)
|
||
|
|
ELSE NUM.OF.LINES.TO.DELETE
|
||
|
|
|
||
|
|
*---- Delete some lines from the current cell.
|
||
|
|
SENT = FIELD(MEMORY (CELL), @FM, LNUM - CELL.FIRST.LINE + 1, NUM.TO.DELETE) ; * SET COL1() AND COL2()
|
||
|
|
SENT = '' ; * RETURN DMR SPACE
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) [1, COL1() - 1]:MEMORY (CELL) [COL2() + IF COL1() THEN 0 ELSE 1, 999999]
|
||
|
|
LPC (CELL) -= NUM.TO.DELETE
|
||
|
|
|
||
|
|
*---- Check if all done; if not, go to next cell.
|
||
|
|
IF NUM.TO.DELETE = NUM.OF.LINES.TO.DELETE THEN GOTO DELETE.MEMORY.2
|
||
|
|
CELLX = CELL + 1
|
||
|
|
NUM.OF.LINES.TO.DELETE -= NUM.TO.DELETE
|
||
|
|
|
||
|
|
DELETE.MEMORY.1: ; * Scan cell line count to see if they can be squeezed.
|
||
|
|
CELLY = CELLX
|
||
|
|
LOOP WHILE IF CELLY <= LAST.CELL THEN NUM.OF.LINES.TO.DELETE => LPC (CELLY) ELSE 0
|
||
|
|
NUM.OF.LINES.TO.DELETE -= LPC (CELLY)
|
||
|
|
CELLY += 1 ; * ON EXIT, CELLY CONTAINS FIRST LINE AFTER DELETED BLOCK
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
*---- Calculate number of cells to shift and abandon.
|
||
|
|
XX = CELLY - CELLX ; * XX IS THE NUMBER OF CELLS TO SQUEEZE OUT
|
||
|
|
IF XX THEN
|
||
|
|
|
||
|
|
*---- Shift end of memory down unless there are no cells left to shift.
|
||
|
|
IF CELLY <= LAST.CELL THEN
|
||
|
|
FOR X = CELLX TO LAST.CELL-XX
|
||
|
|
MEMORY (X) = MEMORY (CELLY)
|
||
|
|
LPC (X) = LPC (CELLY)
|
||
|
|
CELLY += 1
|
||
|
|
NEXT X
|
||
|
|
END
|
||
|
|
LAST.CELL -= XX ; * SET UP LAST.CELL TO CORRECT FINAL VALUE
|
||
|
|
|
||
|
|
*---- Clear out abandoned cells.
|
||
|
|
FOR X = LAST.CELL + 1 TO LAST.CELL + XX
|
||
|
|
MEMORY (X) = '' ; LPC (X) = 0
|
||
|
|
NEXT X
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Delete unwanted lines from next cell, if any.
|
||
|
|
IF NUM.OF.LINES.TO.DELETE THEN
|
||
|
|
MEMORY (CELLX) = FIELD(MEMORY (CELLX), @FM, NUM.OF.LINES.TO.DELETE+1, 999999)
|
||
|
|
LPC (CELLX) -= NUM.OF.LINES.TO.DELETE
|
||
|
|
END
|
||
|
|
|
||
|
|
DELETE.MEMORY.2: ; * Exit with LNUM backed up one line.
|
||
|
|
IF LNUM = CELL.FIRST.LINE THEN
|
||
|
|
IF LNUM # 1 THEN
|
||
|
|
CELL -= 1 ; * BACKUP TO LAST LINE OF PREVIOUS CELL
|
||
|
|
CELL.FIRST.LINE -= LPC (CELL)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
LNUM -= 1
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
INSERT.MEMORY:
|
||
|
|
* Insert a new block into record memory. GOSUB routine.
|
||
|
|
* This subroutine inserts blocks of lines into the blocked record memory.
|
||
|
|
* New lines from NEW.MEMORY will be inserted after the current line LNUM.
|
||
|
|
* The block of new lines is contained in matrices called NEW.MEMORY
|
||
|
|
* and NEW.LPC in the same format as the main matrices MEMORY and LPC.
|
||
|
|
* They contain the number of lines specified by NEW.BOT (new bottom)
|
||
|
|
* and contain NEW.LAST.CELL active cells (matrix elements).
|
||
|
|
* The strategy of insertion is to push the new memory cells into the
|
||
|
|
* memory matrices without altering or combining any cells. If the
|
||
|
|
* insertion requires splitting the current cell (that is, the current
|
||
|
|
* line LNUM is not the last line of the cell) then that cell will
|
||
|
|
* be split into two cells and the new memory cells will be pushed
|
||
|
|
* in between.
|
||
|
|
* If LNUM=0 then insertion will be made in front of all lines.
|
||
|
|
* The new memory matrices and associated variables will not be altered.
|
||
|
|
* The subroutine exits with all key memory variables correctly set up.
|
||
|
|
IF NEW.BOT = 0 THEN RETURN
|
||
|
|
GOSUB GET.LINE ; * INITIALIZE POINTERS TO MEMORY FOR CURRENT LNUM
|
||
|
|
CHANGE.FLAG = TRUE
|
||
|
|
IF BOT = 0 THEN LAST.CELL = 0 ; * RESET IF RECORD IS NULL
|
||
|
|
BOT += NEW.BOT
|
||
|
|
|
||
|
|
*---- Check size of memory matrices & re-dimension if necessary.
|
||
|
|
IF NEW.LAST.CELL + LAST.CELL + 1 > MEMORY.DIM THEN
|
||
|
|
MEMORY.DIM = NEW.LAST.CELL + LAST.CELL + 20
|
||
|
|
DIM MEMORY (MEMORY.DIM) ; * RE-DIMEMSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM LPC (MEMORY.DIM) ; * RE-DIMEMSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM PRIOR.MEMORY (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM PRIOR.LPC (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM SAVED.MEMORY (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM SAVED.LPC (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
FOR X = LAST.CELL + 1 TO MEMORY.DIM
|
||
|
|
MEMORY (X) = '' ; * INITIALIZE MEMORY
|
||
|
|
LPC (X) = 0 ; * INITIALIZE LINES.PER.CELL MATRIX
|
||
|
|
PRIOR.MEMORY (X) = '' ; SAVED.LPC (X) = 0
|
||
|
|
PRIOR.LPC (X) = 0 ; SAVED.MEMORY (X) = ''
|
||
|
|
NEXT X
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Is insert at front (LNUM = 0).
|
||
|
|
IF LNUM = 0 THEN
|
||
|
|
START.CELL = 1
|
||
|
|
CELLX = LAST.CELL + NEW.LAST.CELL
|
||
|
|
GOTO INSERT.MEMORY.1
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Is insert after end (LNUM = BOT).
|
||
|
|
IF LNUM = BOT THEN
|
||
|
|
CELLX = LAST.CELL + NEW.LAST.CELL
|
||
|
|
GOTO INSERT.MEMORY.2
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Set up to insert after the current cell.
|
||
|
|
START.CELL = CELL + 1
|
||
|
|
|
||
|
|
*---- Allow 1 extra if splitting current cell (LNUM not at cell end
|
||
|
|
* and LNUM # 0).
|
||
|
|
CELLX = LAST.CELL + NEW.LAST.CELL + ((LNUM < CELL.FIRST.LINE + LPC (CELL) - 1) AND LNUM # 0)
|
||
|
|
|
||
|
|
INSERT.MEMORY.1: ; * Spread memory cells to allow for new cells.
|
||
|
|
CELLY = CELLX ; * SAVE NEW LAST.CELL
|
||
|
|
FOR X = LAST.CELL TO START.CELL STEP -1
|
||
|
|
MEMORY (CELLX) = MEMORY (X)
|
||
|
|
LPC (CELLX) = LPC (X)
|
||
|
|
CELLX -= 1
|
||
|
|
NEXT X
|
||
|
|
|
||
|
|
*---- Split cell into two if LNUM not at cell end and LNUM # 0.
|
||
|
|
IF LNUM THEN
|
||
|
|
X = LPC (CELL) - (LNUM - CELL.FIRST.LINE + 1)
|
||
|
|
IF X THEN
|
||
|
|
MEMORY (CELLX) = FIELD(MEMORY (CELL), @FM, LNUM - CELL.FIRST.LINE + 2, X)
|
||
|
|
LPC (CELLX) = X
|
||
|
|
MEMORY (CELL) = MEMORY (CELL) [1, COL1() - 1]
|
||
|
|
LPC (CELL) -= X
|
||
|
|
CELLX -= 1 ; * SKIP OVER EXTRA CELL
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
INSERT.MEMORY.2: ; * Insert the cells of the new memory blocks.
|
||
|
|
FOR X = NEW.LAST.CELL TO 1 STEP -1
|
||
|
|
MEMORY (CELLX) = NEW.MEMORY (X)
|
||
|
|
LPC (CELLX) = NEW.LPC (X)
|
||
|
|
CELLX -= 1
|
||
|
|
NEXT X
|
||
|
|
LAST.CELL = CELLY
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
APPEND.NEW.MEMORY: ; * Append new line to memory.
|
||
|
|
* This routine will append the line in NEW.MEMORY.LINE to the end of
|
||
|
|
* the NEW.MEMORY matrix. This routine will leave all key new memory
|
||
|
|
* variables set up for a subsequent call to INSERT.MEMORY.
|
||
|
|
NEW.BOT += 1
|
||
|
|
NEW.LAST.CELL = INT((NEW.BOT - 1) / LINES.PER.CELL) + 1
|
||
|
|
IF NEW.LAST.CELL > NEW.MEMORY.DIM THEN
|
||
|
|
NEW.MEMORY.DIM += 10
|
||
|
|
DIM NEW.MEMORY (NEW.MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM NEW.LPC (NEW.MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
FOR Y = NEW.MEMORY.DIM-9 TO NEW.MEMORY.DIM
|
||
|
|
NEW.MEMORY (Y) = '' ; * CLEAR NEW MEMORY
|
||
|
|
NEW.LPC (Y) = 0
|
||
|
|
NEXT Y
|
||
|
|
END
|
||
|
|
NEW.MEMORY (NEW.LAST.CELL) := (IF NEW.LPC (NEW.LAST.CELL) THEN @FM ELSE '') :NEW.MEMORY.LINE
|
||
|
|
NEW.LPC (NEW.LAST.CELL) += 1
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
CLEAR.NEW.MEMORY: ; * Clear out new memory variables.
|
||
|
|
MAT NEW.MEMORY = '' ; MAT NEW.LPC = 0
|
||
|
|
NEW.BOT = 0 ; NEW.LAST.CELL = 0
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
OOPS.INITIAL.SAVE: ; * Memory restore routines: for OOPS command.
|
||
|
|
PRIOR.BLOCK.MFROM = MFROM ; PRIOR.BLOCK.MTHRU = MTHRU
|
||
|
|
PRIOR.BOT = BOT ; PRIOR.CELL = CELL
|
||
|
|
PRIOR.CELL.FIRST.LINE = CELL.FIRST.LINE
|
||
|
|
PRIOR.LAST.CELL = LAST.CELL ; PRIOR.LNUM = LNUM
|
||
|
|
MAT PRIOR.LPC = MAT LPC ; MAT PRIOR.MEMORY = MAT MEMORY
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
OOPS.BEFORE.EACH.CMD:
|
||
|
|
PRIOR.BLOCK.MFROM = MFROM ; PRIOR.BLOCK.MTHRU = MTHRU
|
||
|
|
PRIOR.CELL = CELL ; PRIOR.CMD = CMD
|
||
|
|
IF CMD.STACK (1) = 'STAMP' THEN PRIOR.CMD = CMD.STACK (1)
|
||
|
|
PRIOR.CELL.FIRST.LINE = CELL.FIRST.LINE
|
||
|
|
PRIOR.LNUM = LNUM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
OOPS.AFTER.CHANGE.CMD:
|
||
|
|
SAVED.BLOCK.MFROM = PRIOR.BLOCK.MFROM
|
||
|
|
SAVED.BLOCK.MTHRU = PRIOR.BLOCK.MTHRU
|
||
|
|
SAVED.BOT = PRIOR.BOT ; SAVED.CELL = PRIOR.CELL
|
||
|
|
SAVED.CELL.FIRST.LINE = PRIOR.CELL.FIRST.LINE
|
||
|
|
SAVED.LAST.CELL = PRIOR.LAST.CELL
|
||
|
|
SAVED.LNUM = PRIOR.LNUM ; SAVED.CMD = PRIOR.CMD
|
||
|
|
MAT SAVED.LPC = MAT PRIOR.LPC
|
||
|
|
MAT SAVED.MEMORY = MAT PRIOR.MEMORY
|
||
|
|
PRIOR.BLOCK.MFROM = MFROM ; PRIOR.BLOCK.MTHRU = MTHRU
|
||
|
|
PRIOR.BOT = BOT ; PRIOR.LAST.CELL = LAST.CELL
|
||
|
|
MAT PRIOR.LPC = MAT LPC ; MAT PRIOR.MEMORY = MAT MEMORY
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
OOPS.RESTORE:
|
||
|
|
MFROM = SAVED.BLOCK.MFROM ; MTHRU = SAVED.BLOCK.MTHRU
|
||
|
|
BOT = SAVED.BOT ; CELL = SAVED.CELL
|
||
|
|
CELL.FIRST.LINE = SAVED.CELL.FIRST.LINE
|
||
|
|
LAST.CELL = SAVED.LAST.CELL ; LNUM = SAVED.LNUM
|
||
|
|
MAT LPC = MAT SAVED.LPC ; MAT MEMORY = MAT SAVED.MEMORY
|
||
|
|
* Record restored to condition prior to Command %s.
|
||
|
|
OLD.LINEX = LINEX
|
||
|
|
LINEX = SAVED.CMD
|
||
|
|
GOSUB CONV.LINEX.TO.UP.ARROW
|
||
|
|
CALL *UVPRINTMSG(001250,LINEX)
|
||
|
|
LINEX = OLD.LINEX
|
||
|
|
PRIOR.CMD = '' ; CHANGE.FLAG = TRUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
BLOCK.TRACK: ; * Move BLOCK pointers.
|
||
|
|
*---- Entered with the following variables set up:
|
||
|
|
* BLOCK.TRACK.LNUM (line before lines deleted, or last line inserted)
|
||
|
|
* BLOCK.TRACK.CHANGE (+lines inserted, or -lines deleted)
|
||
|
|
* Check if deletion crossed BLOCK pointer.
|
||
|
|
IF BLOCK.TRACK.CHANGE < 0 THEN
|
||
|
|
BLOCK.TRACK.END = BLOCK.TRACK.LNUM - BLOCK.TRACK.CHANGE
|
||
|
|
IF MFROM => BLOCK.TRACK.LNUM + 1 AND MFROM <= BLOCK.TRACK.END THEN GOTO BLOCK.KILL
|
||
|
|
IF MTHRU => BLOCK.TRACK.LNUM + 1 AND MTHRU <= BLOCK.TRACK.END THEN GOTO BLOCK.KILL
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- If an INSERT, calculate line before doing inserts.
|
||
|
|
IF BLOCK.TRACK.CHANGE > 0 THEN BLOCK.TRACK.LNUM -= BLOCK.TRACK.CHANGE
|
||
|
|
|
||
|
|
*---- Check if change affects both pointers.
|
||
|
|
IF BLOCK.TRACK.LNUM < MFROM THEN
|
||
|
|
MFROM += BLOCK.TRACK.CHANGE ; MTHRU += BLOCK.TRACK.CHANGE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Check if change affects just MTHRU (change inside BLOCK).
|
||
|
|
IF BLOCK.TRACK.LNUM < MTHRU THEN
|
||
|
|
MTHRU += BLOCK.TRACK.CHANGE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Change must have been after BLOCK; no effect on pointers.
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
BLOCK.KILL: ; * Kill BLOCK pointers.
|
||
|
|
MFROM = 0 ; MTHRU = 0 ; RETURN
|
||
|
|
|
||
|
|
BLOCK.CHECK: ; * Check BLOCK pointers ('<' and '>').
|
||
|
|
IF MFROM = 0 OR MTHRU = 0 THEN
|
||
|
|
* BLOCK not set up
|
||
|
|
CALL *UVPRINTMSG(001219,"")
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF UPCMD1 = "G" THEN RETURN ; * DO NOT DISPLAY MESSAGE ON 'G< OR G>' COMMAND
|
||
|
|
IF MTHRU < MFROM THEN
|
||
|
|
* BLOCK from %i through %i is in the wrong order.
|
||
|
|
CALL *UVPRINTMSG(001201,MFROM:@FM:MTHRU)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF MFROM < LNUM AND LNUM < MTHRU THEN
|
||
|
|
PRINT ' encloses the destination line.'
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF MTHRU > BOT THEN
|
||
|
|
PRINT ' extends beyond the bottom.'
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF BLOCK.VERIFY.FLAG THEN
|
||
|
|
* BLOCK from %i through %i. OK (Y)
|
||
|
|
CALL *UVPRINTMSG(001202,MFROM:@FM:MTHRU)
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Y' THEN
|
||
|
|
* Command not done!^G\n\r
|
||
|
|
CALL *UVPRINTMSG(001203,"")
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
* BLOCK from %i through %i.
|
||
|
|
CALL *UVPRINTMSG(001204,MFROM:@FM:MTHRU)
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
INPUT.LINE: ; * Input a line, convert '^' to character.
|
||
|
|
IF ED.CMD.STRING.ACTIVE AND NOT(ED.CMD.STRING.SUSPENDED) THEN
|
||
|
|
GOSUB ABORT.CHECK
|
||
|
|
IF ABORT = 'Q' THEN
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
J = 0
|
||
|
|
PRINT STARS:' Aborted ':PRE.STORE:' execution.'
|
||
|
|
PRINT
|
||
|
|
RETURN TO END.CMD
|
||
|
|
END
|
||
|
|
J += 1
|
||
|
|
IF ED.CMD.STRING (J) = '$' THEN
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
J = 0
|
||
|
|
CALL *UVPRINTMSG(001227,"")
|
||
|
|
RETURN TO END.CMD
|
||
|
|
END
|
||
|
|
INPUT.LINE = ED.CMD.STRING (J)
|
||
|
|
END ELSE
|
||
|
|
IF INPUT.LINE = ERROR.COND THEN
|
||
|
|
PRINT STR('0',4 - LEN(LNUM)):LNUM:'=':
|
||
|
|
INPUT.LINE = ''
|
||
|
|
END
|
||
|
|
INPUT INPUT.LINE
|
||
|
|
END
|
||
|
|
GOSUB CONV.FROM.UP.ARROW
|
||
|
|
IF INPUT.LINE = ERROR.COND THEN GOTO INPUT.LINE
|
||
|
|
INPUT.MODE = FALSE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
CONV.FROM.UP.ARROW: ; * Convert 'INPUT.LINE' from '^' to the specified characters.
|
||
|
|
X = INDEX(INPUT.LINE, UP.ARROW, 1)
|
||
|
|
IF X = 0 THEN RETURN
|
||
|
|
IF LEN(INPUT.LINE) =< LEN.UP.ARROW.UNIC THEN
|
||
|
|
IF INPUT.LINE = UP.ARROW OR UPCASE(INPUT.LINE) = UP.ARROW.UNIC.UP THEN
|
||
|
|
* Allow ^ and ^X through if in command mode (for speed, don't
|
||
|
|
* UPCASE the line unless a possible match is there):
|
||
|
|
IF INPUT.MODE = TRUE THEN
|
||
|
|
GOSUB PRINT.INVALID.UP.ARROW ;* error message
|
||
|
|
INPUT.LINE = ERROR.COND
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
II = INPUT.LINE [1, X - 1]
|
||
|
|
LOOP
|
||
|
|
X += 1
|
||
|
|
IF INPUT.LINE [X, 1] = UP.ARROW THEN
|
||
|
|
* ^^ replaced by single ^:
|
||
|
|
II := UP.ARROW
|
||
|
|
X += 1
|
||
|
|
END ELSE
|
||
|
|
IF UPCASE(INPUT.LINE[X - 1, 2]) = UP.ARROW.UNIC.UP THEN
|
||
|
|
* Attempt to enter 4-digit hex unicode string - check it's allowed:
|
||
|
|
IF NOT(NLS.ON.FLAG) THEN
|
||
|
|
* '%s UP ARROW mode is not allowed unless NLS support is ON.'
|
||
|
|
* CALL *UVPRINTMSG('970015',UP.ARROW.UNIC.UP)
|
||
|
|
GOSUB PRINT.INVALID.UP.ARROW ;* replace with line above after 8.3.3
|
||
|
|
GOTO CONV.FROM.UP.ARROW.ERR.EXIT
|
||
|
|
END
|
||
|
|
* Check 4 hex digits actually entered:
|
||
|
|
X += 1
|
||
|
|
CX = INPUT.LINE[X, 4]
|
||
|
|
DEC.CX = ICONV(CX, 'MX')
|
||
|
|
IF STATUS() # 0 OR LEN(CX) # 4 OR DEC.CX = UNI$FM THEN
|
||
|
|
* '%s must be followed by 4 hex digits.'
|
||
|
|
* Also, can't allow field mark though (equivalent to ^254).
|
||
|
|
CALL *UVPRINTMSG('970016',UP.ARROW.UNIC.UP)
|
||
|
|
GOTO CONV.FROM.UP.ARROW.ERR.EXIT
|
||
|
|
END
|
||
|
|
* Convert character to UTF and insert back into line:
|
||
|
|
II := UNICHAR(DEC.CX)
|
||
|
|
X += 4
|
||
|
|
END ELSE
|
||
|
|
CX = INPUT.LINE [X, 3]
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Old code read as follows:
|
||
|
|
*---------- PCC. Make sure we get ALL numbers!
|
||
|
|
* IF NOT(NUM(CX)) OR CX<0 OR CX>255 OR CX = 254 OR LEN(CX) NE 3 THEN
|
||
|
|
* Changed to check for '3N' to not allow things like '^-001' to pass the
|
||
|
|
* NUM() test.
|
||
|
|
*******************************************************************************
|
||
|
|
IF NOT(CX MATCHES '3N') OR CX>255 OR CX = 254 THEN
|
||
|
|
GOSUB PRINT.INVALID.UP.ARROW
|
||
|
|
GOTO CONV.FROM.UP.ARROW.ERR.EXIT
|
||
|
|
END
|
||
|
|
* In NLS mode, note that ^248-^250 go in as the pseudo-mark
|
||
|
|
* characters below @TM, which is what CHAR(248) etc. returns.
|
||
|
|
* If you want to enter the Unicode characters with values
|
||
|
|
* >= 248 decimal, you must use ^X00F8 etc.
|
||
|
|
II := CHAR(CX)
|
||
|
|
X += 3
|
||
|
|
END
|
||
|
|
END
|
||
|
|
INPUT.LINE = INPUT.LINE [X, 999999]
|
||
|
|
X = INDEX(INPUT.LINE, UP.ARROW, 1)
|
||
|
|
IF X = 0 THEN
|
||
|
|
INPUT.LINE = II:INPUT.LINE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
II := INPUT.LINE [1, X - 1]
|
||
|
|
REPEAT
|
||
|
|
* Never falls through!
|
||
|
|
CONV.FROM.UP.ARROW.ERR.EXIT: ;* common way out of above routine with error
|
||
|
|
IF INPUT.MODE THEN
|
||
|
|
INPUT.LINE = ERROR.COND ; * SET ERROR CONDITIONS
|
||
|
|
END ELSE
|
||
|
|
INPUT.LINE = ''
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.INVALID.UP.ARROW: ;* Message about use of "^" command
|
||
|
|
* (Illegal up-arrow character code. )
|
||
|
|
* (Range is "000" through "255", excluding "254".)
|
||
|
|
MSG.TEXT = UVREADMSG(001192,"")
|
||
|
|
IF NOT(@SYS.BELL) THEN
|
||
|
|
MSG.TEXT = CONVERT(CHAR(7),"",MSG.TEXT)
|
||
|
|
END
|
||
|
|
PRINT MSG.TEXT<1>
|
||
|
|
PRINT MSG.TEXT<2>
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.LINE: ; * Print the current line.
|
||
|
|
LINEX = LINE
|
||
|
|
IF UP.ARROW.FLAG THEN GOSUB CONV.LINEX.TO.UP.ARROW
|
||
|
|
IF LEN(LINEX) <= LINE.LENGTH THEN
|
||
|
|
PRINT STR('0', 4 - LEN(LNUM)):LNUM:': ':LINEX
|
||
|
|
END ELSE
|
||
|
|
PRINT STR('0', 4 - LEN(LNUM)):LNUM:': ':
|
||
|
|
PRINT LINEX [1, LINE.LENGTH]
|
||
|
|
LOOP
|
||
|
|
LINEX = LINEX [LINE.LENGTH + 1, 999999]
|
||
|
|
UNTIL LEN(LINEX) = 0
|
||
|
|
PRINT ' ':LINEX [1, LINE.LENGTH]
|
||
|
|
REPEAT
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PL.CMD:
|
||
|
|
IF LEN(UPCMD) > 2 THEN
|
||
|
|
X = TRIM(UPCMD [3, 9999])
|
||
|
|
IF NOT(NUM(X)) THEN GOTO PL.ERROR
|
||
|
|
IF X # INT(X) THEN GOTO PL.ERROR
|
||
|
|
PL.LINES = X
|
||
|
|
END ELSE X = PL.LINES ; * Use last value for PL command.
|
||
|
|
IF X > 0 THEN
|
||
|
|
LINE1 = LNUM
|
||
|
|
LINE2 = LNUM + X
|
||
|
|
IF LINE2 > BOT THEN LINE2 = BOT
|
||
|
|
END ELSE
|
||
|
|
LINE1 = LNUM + X
|
||
|
|
IF LINE1 < 1 THEN LINE1 = 1
|
||
|
|
LINE2 = LNUM
|
||
|
|
END
|
||
|
|
LNUMX = LNUM
|
||
|
|
GOSUB PRINT.GROUP ; PRINT
|
||
|
|
LNUM = LNUMX
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
PL.ERROR:
|
||
|
|
PRINT LINES.MESSAGE:'n integer.'
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
PP.CMD: ; * Print a page enclosing current line.
|
||
|
|
IF LEN(UPCMD) > 2 THEN
|
||
|
|
X = TRIM(UPCMD [3, 9999])
|
||
|
|
IF NOT(NUM(X)) THEN GOTO PP.ERROR
|
||
|
|
IF X # INT(X) THEN GOTO PP.ERROR
|
||
|
|
IF X < 1 THEN GOTO PP.ERROR
|
||
|
|
PP.LINES = X
|
||
|
|
END ELSE X = PP.LINES ; * Use last value for PP command.
|
||
|
|
IF MOD(X, 2) # 0 THEN X += 1
|
||
|
|
LINE1 = LNUM - (X / 2)
|
||
|
|
IF LINE1 < 1 THEN LINE1 = 1
|
||
|
|
LINE2 = LNUM + (X / 2)
|
||
|
|
IF LINE2 > BOT THEN LINE2 = BOT
|
||
|
|
LNUMX = LNUM
|
||
|
|
GOSUB PRINT.GROUP ; PRINT
|
||
|
|
LNUM = LNUMX
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
PP.ERROR:
|
||
|
|
PRINT LINES.MESSAGE:' positive integer.'
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
CONV.LINEX.TO.UP.ARROW: ; * Convert 'LINEX' to '^' format.
|
||
|
|
LL = '' ; X = 0
|
||
|
|
|
||
|
|
* In NLS mode, check all characters on line are valid UTF, otherwise
|
||
|
|
* you can't trust the ^nnnn output (usually see ^x0000 for bad UTF):
|
||
|
|
IF NLS.ON.FLAG THEN
|
||
|
|
BAD.CHARS.IN.LINEX = FALSE
|
||
|
|
DUMMY = OCONV(LINEX, 'NLSUTF8')
|
||
|
|
IF STATUS() # 0 THEN
|
||
|
|
* WARNING: Line has invalid internal characters, and may
|
||
|
|
* display incorrectly.
|
||
|
|
CALL *UVPRINTMSG(970017,'')
|
||
|
|
BAD.CHARS.IN.LINEX = TRUE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
IF LINEX = @NULL.STR THEN
|
||
|
|
* Print line as ^128 on its own:
|
||
|
|
LINEX = UP.ARROW:SEQ(@NULL.STR)
|
||
|
|
END ELSE
|
||
|
|
LOOP
|
||
|
|
X += 1
|
||
|
|
CX = LINEX [X, 1]
|
||
|
|
UNTIL LEN(CX) = 0 AND NOT(ISNULL(CX)) DO
|
||
|
|
IF NLS.ON.FLAG THEN
|
||
|
|
* Don't convert unless ^ mode is actually set - may be displayable:
|
||
|
|
IF NOT(UP.ARROW.FLAG)
|
||
|
|
THEN RETURN
|
||
|
|
* In NLS mode:
|
||
|
|
* - The "^" character and the marks 248-255 always print as ^ddd.
|
||
|
|
* - If Unicode ^x mode is on, all non-ASCII-printable chars
|
||
|
|
* (127 upwards) will print as ^xhhhh.
|
||
|
|
* - If Unicode ^x mode is off, 127-247 print as ^ddd,
|
||
|
|
* 248 upwards print as ^xhhhh (but note that single-byte
|
||
|
|
* marks 248-255 are still printed as ^xxx).
|
||
|
|
* Note that a null line already got printed as ^128 above.
|
||
|
|
BEGIN CASE
|
||
|
|
CASE CX = UP.ARROW ;* "^"
|
||
|
|
GOSUB PRINT.UP.ARROW.DEC
|
||
|
|
CASE UNISEQ(CX) = UNI$SQLNULL OR (UNISEQ(CX) >= UNI$SYSDEL AND UNISEQ(CX) =< UNI$IM) ;* 128, 248-255
|
||
|
|
* Check whether it's really a mark, or the Unicode value
|
||
|
|
* that UNISEQ returns for a mark - note we can't use SEQ()
|
||
|
|
* for this, as it may give a runtime warning with NLS on:
|
||
|
|
IF BYTELEN(CX) = 1 THEN
|
||
|
|
GOSUB PRINT.UP.ARROW.DEC ;* genuinely a mark
|
||
|
|
END ELSE
|
||
|
|
GOSUB PRINT.UP.ARROW.HEX ;* actually Unicode F8Fx char
|
||
|
|
END
|
||
|
|
CASE UNISEQ(CX) < 32 OR UNISEQ(CX) > 126 ;* non-ASCII-printing chars
|
||
|
|
BAD.CHAR.IN.LINEX.FOUND = FALSE
|
||
|
|
IF BAD.CHARS.IN.LINEX THEN
|
||
|
|
* NLS mode - check if we got an invalid character here,
|
||
|
|
* which SEQ() cannot print - display something else instead:
|
||
|
|
DUMMY = OCONV(CX, 'NLSUTF8')
|
||
|
|
IF STATUS() # 0
|
||
|
|
THEN BAD.CHAR.IN.LINEX.FOUND = TRUE
|
||
|
|
END
|
||
|
|
BEGIN CASE
|
||
|
|
CASE BAD.CHAR.IN.LINEX.FOUND
|
||
|
|
GOSUB PRINT.UP.ARROW.BAD.UTF
|
||
|
|
CASE UP.ARROW.UNIC.FLAG OR UNISEQ(CX) > 247
|
||
|
|
GOSUB PRINT.UP.ARROW.HEX
|
||
|
|
CASE 1
|
||
|
|
GOSUB PRINT.UP.ARROW.DEC
|
||
|
|
END CASE
|
||
|
|
END CASE
|
||
|
|
END ELSE
|
||
|
|
|
||
|
|
***************************************************************************
|
||
|
|
*
|
||
|
|
* THIS WAS THE OLD DEFINITION OF NON-PRINTING CHARACTERS UNDER PI
|
||
|
|
*
|
||
|
|
* A non-printing char is defined as:
|
||
|
|
* - char in C0 set excluding the 5 chars where the displaced
|
||
|
|
* graphics (clashed with the mark chars) are mapped to.
|
||
|
|
* ( CX < CHAR(28) AND CX # CHAR(26))
|
||
|
|
* - the DEL char ( CHAR(127) ) or chars in C1 set.
|
||
|
|
* ( CX > CHAR(126) AND CX < CHAR(160) )
|
||
|
|
* - the 5 mark chars or the up arrow
|
||
|
|
* ( CX >= @TM )
|
||
|
|
*
|
||
|
|
* NON.PRINTING = ((CX < CHAR(28) AND CX # CHAR(26)) OR (CX >= @TM) OR (CX = UP.ARROW) OR (CX > CHAR(126) AND CX < CHAR(160)))
|
||
|
|
*
|
||
|
|
***************************************************************************
|
||
|
|
*
|
||
|
|
* THIS HAS BEEN CHANGED TO BE COMPATIBLE WITH THE RELEASE 6
|
||
|
|
* VERSION OF THE UNIVERSE EDITOR
|
||
|
|
* (Change was agreed to by Len Greenwood and Jim T.)
|
||
|
|
*
|
||
|
|
* A non-printing character is defined as:
|
||
|
|
* - CHAR(0) thru CHAR(31)
|
||
|
|
* - CHAR(127) thru CHAR(255), but not CHAR(254) or UP.ARROW
|
||
|
|
*
|
||
|
|
* NON.PRINTING = (CX < CHAR(32)) OR (CX > CHAR(126))
|
||
|
|
* Note: don't compare CHARs, since may be localized - use SEQs instead.
|
||
|
|
*
|
||
|
|
***************************************************************************
|
||
|
|
NON.PRINTING = (SEQ(CX) < 32) OR (SEQ(CX) > 126) OR (CX = UP.ARROW)
|
||
|
|
IF NON.PRINTING THEN
|
||
|
|
GOSUB PRINT.UP.ARROW.DEC
|
||
|
|
END
|
||
|
|
END
|
||
|
|
REPEAT
|
||
|
|
LINEX = LL:LINEX
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.UP.ARROW.BAD.UTF:
|
||
|
|
* No input: always print a recognizable string for a "bad" utf character:
|
||
|
|
LL := LINEX[1, X - 1]:UP.ARROW:'!!!!'
|
||
|
|
LINEX = LINEX [X + 1, 999999]
|
||
|
|
X = 0
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.UP.ARROW.DEC:
|
||
|
|
* Input: CX is character to be printed
|
||
|
|
CX = SEQ(CX)
|
||
|
|
LL := LINEX [1, X - 1] :UP.ARROW:STR('0', 3 - LEN(CX)) :CX
|
||
|
|
LINEX = LINEX [X + 1, 999999]
|
||
|
|
X = 0
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.UP.ARROW.HEX:
|
||
|
|
* Input: CX is character to be printed
|
||
|
|
HEX.CX = OCONV(UNISEQ(CX), 'MX')
|
||
|
|
LL := LINEX [1, X - 1] :UP.ARROW.UNIC:STR('0', 4 - LEN(HEX.CX)) :HEX.CX
|
||
|
|
LINEX = LINEX [X + 1, 999999]
|
||
|
|
X = 0
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
GET.RECORD: ; * Get record name and read the record.
|
||
|
|
RECORD.NAME = RECORD.LIST <1>
|
||
|
|
RECORD.LIST = DELETE(RECORD.LIST, 1, 0, 0)
|
||
|
|
IF RECORD.NAME = '' AND NUM.REMAINING NE '' AND NUM.REMAINING GT 0 THEN NULL.ID.INLIST=TRUE ELSE NULL.ID.INLIST=FALSE
|
||
|
|
IF NUM.REMAINING # '' THEN NUM.REMAINING=NUM.REMAINING-1
|
||
|
|
IF (LEN(RECORD.NAME) # 0 OR (NULL.ID.INLIST) OR (FIRST.RECORD AND (NULL.ID OR SELECT.LIST.FLAG))) THEN
|
||
|
|
LINEX = RECORD.NAME
|
||
|
|
GOSUB CONV.LINEX.TO.UP.ARROW
|
||
|
|
DISPLAY.RECORD.NAME = LINEX
|
||
|
|
IF SELECT.LIST.FLAG AND NOT(ONLY.ONE.RECORD.FLAG) THEN
|
||
|
|
CALL *UVPRINTMSG(001291,DISPLAY.RECORD.NAME)
|
||
|
|
END
|
||
|
|
GOTO INITIALIZE
|
||
|
|
END
|
||
|
|
SELECT.LIST.FLAG = FALSE
|
||
|
|
ONLY.ONE.RECORD.FLAG = FALSE
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE
|
||
|
|
J = 0
|
||
|
|
IF NOT(FIRST.RECORD) THEN
|
||
|
|
PRINT
|
||
|
|
CALL *UVPRINTMSG(001018,"")
|
||
|
|
PRINT DICT.TEXT:FILE.NAME
|
||
|
|
END
|
||
|
|
FIRST.RECORD = FALSE
|
||
|
|
CALL *UVPRINTMSG(001290,"")
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
FIRST.CHAR = INPUT.LINE [1, 1]
|
||
|
|
IF FIRST.CHAR = '"' OR FIRST.CHAR = "'" THEN
|
||
|
|
INPUT.LINE = INPUT.LINE [2, INDEX(INPUT.LINE, FIRST.CHAR, 2) - 2]
|
||
|
|
END ELSE
|
||
|
|
INPUT.LINE = TRIM(INPUT.LINE)
|
||
|
|
END
|
||
|
|
RECORD.NAME = INPUT.LINE
|
||
|
|
LINEX = RECORD.NAME
|
||
|
|
GOSUB CONV.LINEX.TO.UP.ARROW
|
||
|
|
DISPLAY.RECORD.NAME = LINEX
|
||
|
|
IF LEN(RECORD.NAME) = 0 THEN GOTO STOP
|
||
|
|
|
||
|
|
INITIALIZE: ; * Initialize for each record.
|
||
|
|
FIRST.RECORD = FALSE
|
||
|
|
X = '@ID' ; Y = RECORD.NAME ; GOSUB AT.INSERT
|
||
|
|
BLOCK.LOGIC = FALSE ; * BLOCK LOGIC FLAG
|
||
|
|
BOT = 0 ; * BOTTOM LINE NUMBER
|
||
|
|
CELL = 1 ; * CURRENT CELL OF MEMORY
|
||
|
|
CELL.FIRST.LINE = 1 ; * LINE NUM OF 1ST LINE IN CURRENT CELL
|
||
|
|
CHANGE.FLAG = FALSE ; * RECORD CHANGED FLAG
|
||
|
|
CHANGE.DURING.CMD.STRING = FALSE ; * RECORD CHANGED DURING CMD STRING XEQ
|
||
|
|
LAST.CELL = 0 ; * LAST ACTIVE CELL IN MEMORY
|
||
|
|
LINE = '' ; * CURRENT LINE
|
||
|
|
LINE.LENGTH = CRT.WIDTH - 7 ; * LENGTH OF LINE TO FOLD ON
|
||
|
|
LNUM = 0 ; * CURRENT LINE NUMBER
|
||
|
|
LNUM.SAVE = 0 ; * SAVE OF LNUM
|
||
|
|
MAT LPC = 0 ; * MATRIX OF LINES PER CELL OF MEMORY
|
||
|
|
MAT MEMORY = '' ; * BLOCKED MEMORY OF RECORD BEING EDITTED
|
||
|
|
MAT PRIOR.MEMORY = '' ; * OOPS MEMORY
|
||
|
|
MAT PRIOR.LPC = 0 ; * OOPS MEMORY
|
||
|
|
MAT SAVED.MEMORY = '' ; * OOPS MEMORY
|
||
|
|
MAT SAVED.LPC = 0 ; * OOPS MEMORY
|
||
|
|
MFROM = 0 ; * BLOCK 'FROM' POINTER
|
||
|
|
MTHRU = 0 ; * BLOCK 'THRU' POINTER
|
||
|
|
RECORD.CHANGE.FLAG = FALSE ; * SET TO TRUE IF RECORD CHANGED
|
||
|
|
SAVED.CMD = '' ; * LAST CMD THAT CHANGED THE RECORD
|
||
|
|
GOSUB CLEAR.NEW.MEMORY ; * CLEAR NEW MEMORY AND KEY VARIABLES
|
||
|
|
I.TYPE.EXPR = ''
|
||
|
|
|
||
|
|
READ.2: ; * Try to read record from file.
|
||
|
|
RECORD.NAME.LOCKED = TRUE
|
||
|
|
EDITING.VOC.FPTR = FALSE
|
||
|
|
READU RECORD FROM EDIT.FILE, RECORD.NAME
|
||
|
|
* ON ERROR
|
||
|
|
* CALL *UVPRINTMSG(STATUS(),"")
|
||
|
|
* RETURN TO DONE.WITH.RECORD
|
||
|
|
* END
|
||
|
|
LOCKED
|
||
|
|
RECORD.NAME.LOCKED = FALSE
|
||
|
|
CALL *UVPRINTMSG(001191,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS = 'Y' THEN GOTO READ.2 ELSE RETURN TO DONE.WITH.RECORD
|
||
|
|
END
|
||
|
|
THEN
|
||
|
|
IF EDIT.READ.ONLY THEN
|
||
|
|
CALL *UVPRINTMSG(001398,DICT.TEXT:FILE.NAME)
|
||
|
|
END
|
||
|
|
ELSE IF ((FILE.NAME = 'VOC') AND (RECORD[1,1]='F' OR RECORD[1,1]='f'))
|
||
|
|
THEN
|
||
|
|
EDITING.VOC.FPTR = TRUE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
DF.ERROR = STATUS()
|
||
|
|
IF DF.ERROR = 1 OR DF.ERROR = 2 THEN
|
||
|
|
STATUS TEMP.INFO FROM EDIT.FILE ELSE TEMP.INFO = ""
|
||
|
|
IF TEMP.INFO<21> = 27 THEN
|
||
|
|
CALL *UVPRINTMSG(970013,RECORD.NAME)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(970012,RECORD.NAME)
|
||
|
|
END
|
||
|
|
RETURN TO DONE.WITH.RECORD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 3 THEN
|
||
|
|
CALL *UVPRINTMSG(47007,RECORD.NAME)
|
||
|
|
RETURN TO DONE.WITH.RECORD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 4 THEN
|
||
|
|
* Warning message already issued - no need to repeat ourselves
|
||
|
|
* CALL *UVPRINTMSG(47006,RECORD.NAME)
|
||
|
|
RETURN TO DONE.WITH.RECORD
|
||
|
|
END
|
||
|
|
|
||
|
|
IF EDIT.READ.ONLY THEN
|
||
|
|
CALL *UVPRINTMSG(001396,DICT.TEXT:FILE.NAME:@FM:RECORD.NAME)
|
||
|
|
RETURN TO DONE.WITH.RECORD
|
||
|
|
END ELSE
|
||
|
|
GOTO NEW.RECORD
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Check if reading an I-TYPE record from a DICTIONARY.
|
||
|
|
IF DICT AND RECORD [1, 1] = 'I' THEN
|
||
|
|
I.TYPE.EXPR = RECORD <2>
|
||
|
|
I.TYPE.DATE = OCONV(RECORD <OBJ.FMC - 2>, 'D2/')
|
||
|
|
IF LEN(I.TYPE.DATE) # 0 THEN
|
||
|
|
PRINT 'This is a Type "I" Descriptor last compiled on ':
|
||
|
|
PRINT I.TYPE.DATE:' at ':OCONV(RECORD <OBJ.FMC - 1>, 'MT:'):'.'
|
||
|
|
END ELSE PRINT 'This Type "I" Descriptor must be compiled before use.'
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- Record already exists.
|
||
|
|
BOT = IF LEN(RECORD) = 0 THEN 0 ELSE COUNT(RECORD, @FM) + 1
|
||
|
|
X = INT((BOT - 1) / LINES.PER.CELL) ; * DETERMINE NUM OF FULL CELLS REQUIRED
|
||
|
|
IF X + 1 > MEMORY.DIM THEN
|
||
|
|
MEMORY.DIM = X + 20
|
||
|
|
DIM MEMORY (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM LPC (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM PRIOR.MEMORY (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM PRIOR.LPC (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM SAVED.MEMORY (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
DIM SAVED.LPC (MEMORY.DIM) ; * RE-DIMENSION
|
||
|
|
IF INMAT() THEN RECORD = '' ; GOSUB OVERFLOW ; RETURN ; * SJE 23 Apr 84
|
||
|
|
FOR XX = MEMORY.DIM - 19 TO MEMORY.DIM
|
||
|
|
SAVED.LPC (XX) = 0 ; MEMORY (XX) = '' ;
|
||
|
|
LPC (XX) = 0 ; PRIOR.LPC (XX) = 0
|
||
|
|
PRIOR.MEMORY (XX) = '' ; SAVED.MEMORY (XX) = ''
|
||
|
|
NEXT XX
|
||
|
|
END
|
||
|
|
|
||
|
|
*---- The following code sets up
|
||
|
|
* to make a BLOCK of each element of the array. The size of the
|
||
|
|
* BLOCK is defined by LINES.PER.CELL.
|
||
|
|
|
||
|
|
*** MATBLOCK MEMORY FROM RECORD, @FM, LINES.PER.CELL
|
||
|
|
CALL @MATBLOCK(MAT MEMORY,RECORD,@FM,LINES.PER.CELL)
|
||
|
|
FOR XX = 1 TO X
|
||
|
|
LPC (XX) = LINES.PER.CELL
|
||
|
|
NEXT XX
|
||
|
|
LAST.CELL = X + (BOT > 0) ; * =0 IF BOT = 0
|
||
|
|
IF LAST.CELL > 0 THEN
|
||
|
|
LPC (LAST.CELL) = MOD(BOT - 1, LINES.PER.CELL) + 1
|
||
|
|
END
|
||
|
|
RECORD = '' ; * RETURN DMR SPACE
|
||
|
|
* %i lines long
|
||
|
|
CALL *UVPRINTMSG(001207,BOT)
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
NEW.RECORD:
|
||
|
|
* New record.
|
||
|
|
CALL *UVPRINTMSG(001206,"")
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
FILE.IT: ; * File the record. GOSUB routine.
|
||
|
|
WRITEERROR = FALSE ; *026
|
||
|
|
OUT.DICT = DICT ; OUT.FILE.NAME = FILE.NAME ; OUT.FILE = EDIT.FILE
|
||
|
|
|
||
|
|
IF (NOT(SYSTEM(62)) AND (EDITING.VOC.FPTR))
|
||
|
|
THEN
|
||
|
|
CALL *UVPRINTMSG(020553,"")
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
|
||
|
|
************************************************************************
|
||
|
|
* 'READU LOCK.AGAIN FROM EDIT.FILE,RECORD.NAME THEN NULL' BELOW IS DONE
|
||
|
|
* TO RESET READLOCK INITIALLY SET BY FIRST TCL EDIT. THIS IS IN PLACE TO
|
||
|
|
* FIX PROBLEM OF LOCK BEING RELEASED WHEN ACTIVE FILE VARIABLE 'OUT.FILE'
|
||
|
|
* GETS REASSIGNED MULTIPLE TIMES (ABOVE).
|
||
|
|
************************************************************************
|
||
|
|
READU LOCK.AGAIN FROM EDIT.FILE,RECORD.NAME
|
||
|
|
* ON ERROR
|
||
|
|
* CALL *UVPRINTMSG(STATUS(),"")
|
||
|
|
* RETURN TO GET.CMD
|
||
|
|
* END
|
||
|
|
THEN
|
||
|
|
NULL ;*SEE ABOVE
|
||
|
|
END
|
||
|
|
OUT.DICT.TEXT = DICT.TEXT
|
||
|
|
IF LEN(CMD [6, 99]) = 0 THEN
|
||
|
|
OUT.REC.NAME = RECORD.NAME
|
||
|
|
IF EDIT.READ.ONLY THEN
|
||
|
|
CALL *UVPRINTMSG(001398,OUT.DICT.TEXT:OUT.FILE.NAME)
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
SENT = TRIM(CMD [6,99])
|
||
|
|
IF COUNT(SENT, ' ') > 2 THEN RETURN TO CMD.ERR
|
||
|
|
IF COUNT(SENT, ' ') THEN
|
||
|
|
PROMPT.FOR.FILE = FALSE ; NO.SELECT.LIST = TRUE
|
||
|
|
OUT.FILE.NAME = '' ; OUT.DICT = '' ; OUT.DICT.TEXT = ''
|
||
|
|
SINGLE.FILE.ONLY = TRUE
|
||
|
|
CALL @GET.FILE.NAME (NO.SELECT.LIST, SENT, OUT.DICT,
|
||
|
|
OUT.FILE.NAME, PROMPT.FOR.FILE, SINGLE.FILE.ONLY)
|
||
|
|
IF OUT.DICT = '' ELSE OUT.DICT.TEXT = OUT.DICT:' '
|
||
|
|
IF LEN(OUT.FILE.NAME) = 0 THEN RETURN TO CMD.ERR
|
||
|
|
IF OUT.FILE.NAME # OUT.FILE.NAME <1> THEN RETURN TO CMD.ERR
|
||
|
|
OUT.REC.NAME = SENT
|
||
|
|
OPENCHECK OUT.DICT, OUT.FILE.NAME TO OUT.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,OUT.FILE.NAME THEN
|
||
|
|
IF OUT.DICT = "" THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
END ELSE
|
||
|
|
PathName = FileRec<3>
|
||
|
|
END
|
||
|
|
RELEASE DEVSYS.VOC.FILE,OUT.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
IF OUT.DICT = "" THEN
|
||
|
|
FileName = OUT.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
FileName = "DICT,":OUT.FILE.NAME
|
||
|
|
END
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
END ELSE OUT.REC.NAME = FIELD(SENT, ' ', 1)
|
||
|
|
IF LEN(OUT.REC.NAME) = 0 THEN
|
||
|
|
PRINT 'Too many parameters. Expected (at most) a file name and record name.'
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
|
||
|
|
READ.3:
|
||
|
|
OUT.PERM.MODE = 1
|
||
|
|
OUT.PERM.IN = 6
|
||
|
|
OUT.PERM.OUT = ''
|
||
|
|
CALL @PERMISSIONS(OUT.FILE,OUT.PERM.MODE,OUT.PERM.IN,OUT.PERM.OUT)
|
||
|
|
IF NOT(OUT.PERM.OUT) THEN
|
||
|
|
CALL *UVPRINTMSG(001398,OUT.DICT.TEXT:OUT.FILE.NAME)
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
|
||
|
|
READU SENT FROM OUT.FILE, OUT.REC.NAME
|
||
|
|
* ON ERROR
|
||
|
|
* CALL *UVPRINTMSG(STATUS(),"")
|
||
|
|
* GOTO GET.CMD
|
||
|
|
* END
|
||
|
|
LOCKED
|
||
|
|
CALL *UVPRINTMSG(001191,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS = 'Y' THEN GOTO READ.3 ELSE GOTO GET.CMD
|
||
|
|
END ELSE
|
||
|
|
DF.ERROR = STATUS()
|
||
|
|
IF DF.ERROR = 1 OR DF.ERROR = 2 THEN
|
||
|
|
STATUS TEMP.INFO FROM OUT.FILE ELSE TEMP.INFO = ""
|
||
|
|
IF TEMP.INFO<21> = 27 THEN
|
||
|
|
CALL *UVPRINTMSG(970013,OUT.REC.NAME)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(970012,OUT.REC.NAME)
|
||
|
|
END
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 3 THEN
|
||
|
|
CALL *UVPRINTMSG(47007,OUT.REC.NAME)
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 4 THEN
|
||
|
|
* Warning message already issued - no need to repeat ourselves
|
||
|
|
* CALL *UVPRINTMSG(47006,OUT.REC.NAME)
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
GOTO FILE.IT.2
|
||
|
|
END
|
||
|
|
SENT = '' ; * RETURN DMR STRING SPACE
|
||
|
|
* already exists
|
||
|
|
IF STACK.MODE THEN
|
||
|
|
CALL *UVPRINTMSG(001197,"")
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001110,"")
|
||
|
|
END
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Y' THEN
|
||
|
|
CALL *UVPRINTMSG(001220,"")
|
||
|
|
GOSUB RELEASE.IF.OK
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
FILE.IT.2:
|
||
|
|
LNUMX = LNUM ; * SAVE LNUM
|
||
|
|
LINE1 = '' ; LINE2 = '' ; LINE.OBJ.FMC = ''
|
||
|
|
IF BOT => 1 THEN
|
||
|
|
LNUM = 1 ; GOSUB GET.LINE ; LINE1 = LINE
|
||
|
|
END
|
||
|
|
IF BOT => 2 THEN
|
||
|
|
LNUM = 2 ; GOSUB GET.LINE ; LINE2 = LINE
|
||
|
|
END
|
||
|
|
IF BOT => OBJ.FMC THEN
|
||
|
|
LNUM = OBJ.FMC ; GOSUB GET.LINE ; LINE.OBJ.FMC = LINE
|
||
|
|
END
|
||
|
|
IF OUT.DICT AND LINE1 [1, 1] = 'I' AND (I.TYPE.EXPR # LINE2 OR LEN(LINE.OBJ.FMC) = 0) THEN
|
||
|
|
IF BOT => OBJ.FMC - 4 THEN
|
||
|
|
LNUM = OBJ.FMC - 4 ; * DELETE EXPRESSION OBJECT CODE
|
||
|
|
GOSUB GET.LINE
|
||
|
|
NUM.OF.LINES.TO.DELETE = BOT - LNUM + 1
|
||
|
|
GOSUB DELETE.MEMORY
|
||
|
|
END
|
||
|
|
PRINT 'This Type "I" Descriptor must be compiled before use.'
|
||
|
|
END
|
||
|
|
|
||
|
|
SQL.ERROR = FALSE
|
||
|
|
NLS.ERROR = FALSE
|
||
|
|
MATWRITEU MEMORY ON OUT.FILE, OUT.REC.NAME ON ERROR
|
||
|
|
WRITEERROR = TRUE
|
||
|
|
STATUS.CODE = STATUS()
|
||
|
|
IF STATUS.CODE = 47006 OR STATUS.CODE = 47007 THEN
|
||
|
|
CALL *UVPRINTMSG(STATUS.CODE,OUT.REC.NAME)
|
||
|
|
NLS.ERROR = TRUE
|
||
|
|
END
|
||
|
|
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
WRITEERROR = TRUE ;
|
||
|
|
STATUS.CODE = STATUS()
|
||
|
|
IF STATUS.CODE = IntegrityViolation THEN
|
||
|
|
SQL.ERROR = TRUE
|
||
|
|
IO.VAR = 2
|
||
|
|
MATBUILD DYN.ARRAY FROM MEMORY
|
||
|
|
CALL @SQLINTCHK(DYN.ARRAY,OUT.FILE,OUT.REC.NAME,OUT.DICT.TEXT:OUT.FILE.NAME,IO.VAR)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF NOT(WRITEERROR) AND (UPCMD4 <> 'SAVE' OR LEN(CMD [6, 99]) <> 0) THEN ; *026
|
||
|
|
GOSUB RELEASE.IF.OK ; *REPLACED *026 UNCONDITIONAL RELEASE
|
||
|
|
*
|
||
|
|
* Convert numeric string to character to prevent the problem
|
||
|
|
* when the key string is 15+ byte numeric.
|
||
|
|
*
|
||
|
|
TEMP.OUT.REC.NAME = 'N':OUT.REC.NAME
|
||
|
|
TEMP.RECORD.NAME = 'N':RECORD.NAME
|
||
|
|
IF TEMP.OUT.REC.NAME = TEMP.RECORD.NAME THEN RECORD.NAME.LOCKED = FALSE
|
||
|
|
*
|
||
|
|
END ; *026
|
||
|
|
LINEX = OUT.REC.NAME
|
||
|
|
GOSUB CONV.LINEX.TO.UP.ARROW
|
||
|
|
|
||
|
|
IF WRITEERROR THEN ; *026
|
||
|
|
IF NOT(SQL.ERROR) AND NOT(NLS.ERROR) THEN
|
||
|
|
PRINT @SYS.BELL:'Failed to file "':LINEX:'"':IN.FILE:OUT.DICT.TEXT:OUT.FILE.NAME:'". STATUS = ':STATUS.CODE
|
||
|
|
END
|
||
|
|
END ELSE ; *026
|
||
|
|
CALL *UVPRINTMSG(001238,LINEX)
|
||
|
|
CALL *UVPRINTMSG(001286,OUT.DICT.TEXT:OUT.FILE.NAME)
|
||
|
|
END ; *026
|
||
|
|
LNUM = LNUMX ; * RESTORE LNUM
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
RELEASE.IF.OK:
|
||
|
|
IF UPCMD5 = 'SAVE ' AND (OUT.REC.NAME = RECORD.NAME) AND (OUT.DICT = DICT) THEN
|
||
|
|
REL.OUTREC=0
|
||
|
|
IF OUT.FILE.NAME # '' AND OUT.FILE.NAME # FILE.NAME THEN
|
||
|
|
STATUS OUTFLSTAT FROM OUT.FILE THEN
|
||
|
|
STATUS ORIGFLSTAT FROM EDIT.FILE THEN
|
||
|
|
IF (OUTFLSTAT<10> = ORIGFLSTAT<10>) AND (OUTFLSTAT<11> = ORIGFLSTAT<11>) THEN NULL ELSE REL.OUTREC=1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF REL.OUTREC THEN RELEASE OUT.FILE, OUT.REC.NAME
|
||
|
|
END ELSE
|
||
|
|
RELEASE OUT.FILE, OUT.REC.NAME
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
!
|
||
|
|
* Command stack and pre-stored command routines.
|
||
|
|
!
|
||
|
|
|
||
|
|
STACK.PROCESSOR:
|
||
|
|
STACK.MODE = TRUE
|
||
|
|
SV.CMD = CMD
|
||
|
|
CMD = TRIM(CMD)
|
||
|
|
IF UPCMD3 = '.XK' OR UPCMD3 = '.XR' THEN GOTO STACK.EXECUTE
|
||
|
|
IF UPCMD4 = 'LOOP' THEN GOTO STRING.LOOP
|
||
|
|
IF UPCMD5 = 'PAUSE' THEN GOTO STRING.PAUSE
|
||
|
|
TOKEN1 = FIELD(CMD, ' ', 2)
|
||
|
|
TOKEN2 = FIELD(CMD, ' ', 3)
|
||
|
|
TOKEN3 = FIELD(CMD, ' ', 4)
|
||
|
|
TOKEN4 = FIELD(CMD, ' ', 5)
|
||
|
|
GOSUB SET.UP.NN
|
||
|
|
IF UPCMD2 = '.A' THEN GOTO STACK.APPEND
|
||
|
|
IF UPCMD2 = '.C' THEN GOTO STACK.CHANGE
|
||
|
|
IF UPCMD2 = '.D' THEN GOTO STACK.DELETE
|
||
|
|
IF UPCMD2 = '.X' THEN GOTO STACK.EXECUTE
|
||
|
|
IF UPCMD2 = '.I' THEN GOTO STACK.INSERT
|
||
|
|
IF UPCMD2 = '.L' THEN GOTO STACK.LIST
|
||
|
|
IF UPCMD2 = '.R' THEN GOTO STACK.RECALL
|
||
|
|
IF UPCMD2 = '.S' THEN GOTO STACK.SAVE
|
||
|
|
IF UPCMD2 = '.U' THEN GOTO STACK.UPCASE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
|
||
|
|
DISPLAY.CURRENT.LINE:
|
||
|
|
IF UNASSIGNED(DISPLAY.CURRENT.LINE) THEN DISPLAY.CURRENT.LINE = TRUE
|
||
|
|
IF UNASSIGNED(COMMAND.SUCCESSFUL) THEN COMMAND.SUCCESSFUL = TRUE
|
||
|
|
IF DISPLAY.CURRENT.LINE OR COMMAND.SUCCESSFUL THEN
|
||
|
|
IF LNUM = 0 THEN
|
||
|
|
CALL *UVPRINTMSG(001190,"")
|
||
|
|
END ELSE
|
||
|
|
IF BOT THEN
|
||
|
|
GOSUB GET.LINE
|
||
|
|
IF COMMAND.SUCCESSFUL THEN
|
||
|
|
GOSUB PRINT.LINE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
DISPLAY.CURRENT.LINE = TRUE
|
||
|
|
COMMAND.SUCCESSFUL = TRUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
STACK.APPEND: ; * '.A': append to a stack command.
|
||
|
|
CMD.STACK (NN) := SV.CMD [INDEX(SV.CMD, ' ', 1) + 1, 9999]
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.CHANGE: ; * '.C': change a stack command.
|
||
|
|
DELIM = CMD [LEN(NN) + 3, 1]
|
||
|
|
FROM.STRING = FIELD(SV.CMD [2, 9999], DELIM, 2)
|
||
|
|
LEN.FROM = LEN(FROM.STRING)
|
||
|
|
TO.STRING = FIELD(SV.CMD [2, 9999], DELIM, 3)
|
||
|
|
IF COL2() = 0 THEN
|
||
|
|
PRINT 'Missing required TO field (for "CHANGE/FROM/TO").'
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF LEN(FROM.STRING) = 0 THEN
|
||
|
|
CMD.STACK (NN) = TO.STRING:CMD.STACK (NN)
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
GLOBAL = FIELD(SV.CMD[2,9999], DELIM, 4) ; GLOBAL = UPCASE(GLOBAL) ; GLOBAL.FLAG = FALSE
|
||
|
|
IF GLOBAL[1,1] = "G" THEN GLOBAL = GLOBAL[2,99] ; GLOBAL.FLAG = TRUE
|
||
|
|
STACK.CHANGED = FALSE
|
||
|
|
STACK.CHANGE.1:
|
||
|
|
START.POS = INDEX(CMD.STACK (NN), FROM.STRING, 1)
|
||
|
|
IF START.POS NE 0 THEN
|
||
|
|
STACK.CHANGED = TRUE
|
||
|
|
CMD.STACK (NN) [START.POS, LEN.FROM] = ''
|
||
|
|
CMD.STACK (NN) = CMD.STACK (NN) [1, START.POS - 1]:TO.STRING:CMD.STACK (NN) [START.POS + LEN.FROM, 9999]
|
||
|
|
IF GLOBAL.FLAG THEN GOTO STACK.CHANGE.1
|
||
|
|
END
|
||
|
|
IF STACK.CHANGED THEN
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
END
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.DELETE: ; * '.D': delete a stack command or a pre-stored command string.
|
||
|
|
IF TOKEN1 THEN GOTO STRING.DELETE
|
||
|
|
CALL *UVPRINTMSG(001077,NN)
|
||
|
|
PRINT
|
||
|
|
NN -= 1
|
||
|
|
GOSUB PUSH.DOWN
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STRING.DELETE:
|
||
|
|
GOSUB STRING.WRITE
|
||
|
|
|
||
|
|
SD.1:
|
||
|
|
IF REC.TYPE.CODE # 'E' THEN
|
||
|
|
CALL *UVPRINTMSG(001108,WRITE.REC.NAME)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
DELETE WRITE.FILE, WRITE.REC.NAME
|
||
|
|
CALL *UVPRINTMSG(970003,WRITE.REC.NAME:@FM:WRITE.FILE.DICT:WRITE.FILE.NAME)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.EXECUTE: ; * '.X': execute one stack command, or load (not into the stack) and
|
||
|
|
* execute a pre-stored string.
|
||
|
|
IF UPCMD3 = '.XK' THEN
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN GOTO CMD.ERR
|
||
|
|
ED.CMD.STRING.ACTIVE = FALSE
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE
|
||
|
|
J = 0
|
||
|
|
ED.CMD.STRING (1) = '$'
|
||
|
|
GOTO GET.CMD
|
||
|
|
END
|
||
|
|
IF UPCMD3 = '.XR' THEN
|
||
|
|
IF ED.CMD.STRING.SUSPENDED THEN
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE
|
||
|
|
GOTO GET.CMD
|
||
|
|
END ELSE GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF TOKEN1 THEN GOTO STRING.EXECUTE
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (NN + 1)
|
||
|
|
INPUT.LINE = CMD.STACK (NN + 1)
|
||
|
|
IF NN = 1 THEN
|
||
|
|
FOR IJ = 1 TO 2
|
||
|
|
NN = 0
|
||
|
|
GOSUB PUSH.DOWN
|
||
|
|
NEXT IJ
|
||
|
|
END ELSE
|
||
|
|
NN = 0
|
||
|
|
GOSUB PUSH.DOWN
|
||
|
|
END
|
||
|
|
GOTO GET.CMD.1
|
||
|
|
|
||
|
|
STRING.EXECUTE:
|
||
|
|
J = 0
|
||
|
|
IF ED.CMD.STRING.SUSPENDED THEN
|
||
|
|
IF CHANGE.DURING.CMD.STRING THEN
|
||
|
|
GOSUB OOPS.AFTER.CHANGE.CMD
|
||
|
|
CHANGE.DURING.CMD.STRING = FALSE
|
||
|
|
END
|
||
|
|
GOSUB OOPS.BEFORE.EACH.CMD
|
||
|
|
ED.CMD.STRING.SUSPENDED = FALSE
|
||
|
|
END
|
||
|
|
MAT ED.CMD.STRING = '$'
|
||
|
|
GOTO LOAD.ANY
|
||
|
|
|
||
|
|
STACK.INSERT: ; * '.I': insert one or more commands into the stack.
|
||
|
|
IF TOKEN1 OR LEN(SV.CMD) > 4 THEN GOTO SI.3
|
||
|
|
NUM.CMDS = 0 ; NEW.CMD = ''
|
||
|
|
|
||
|
|
SI.1:
|
||
|
|
PRINT ' =':
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
ED.CMD = INPUT.LINE
|
||
|
|
IF LEN(ED.CMD) = 0 THEN GOTO SI.2
|
||
|
|
IF ED.CMD = ' ' THEN ED.CMD = ''
|
||
|
|
NEW.CMD := ED.CMD:@FM
|
||
|
|
NUM.CMDS += 1
|
||
|
|
IF NN + NUM.CMDS => STACK.LIMIT THEN
|
||
|
|
PRINT @SYS.BELL:'Can only accept 99 commands.'
|
||
|
|
GOTO SI.2
|
||
|
|
END
|
||
|
|
GOTO SI.1
|
||
|
|
|
||
|
|
SI.2:
|
||
|
|
BLOCK.END = NN
|
||
|
|
GOSUB POP.UP
|
||
|
|
FIELD.CTR = 1
|
||
|
|
FOR I = NN + NUM.CMDS - 1 TO NN STEP -1
|
||
|
|
CMD.STACK (I) = FIELD(NEW.CMD, @FM, FIELD.CTR)
|
||
|
|
FIELD.CTR += 1
|
||
|
|
NEXT I
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
SI.3:
|
||
|
|
BLOCK.END = NN
|
||
|
|
NUM.CMDS = 1
|
||
|
|
GOSUB POP.UP
|
||
|
|
IF LEN(TOKEN1) = 0 THEN
|
||
|
|
IF SV.CMD [LEN(NN) + 4, 9999] = ' ' THEN
|
||
|
|
CMD.STACK (NN) = ''
|
||
|
|
END ELSE
|
||
|
|
CMD.STACK (NN) = SV.CMD [LEN(NN) + 4, 9999]
|
||
|
|
END
|
||
|
|
END ELSE CMD.STACK (NN) = SV.CMD [INDEX(SV.CMD, ' ', 1) + 1, 9999]
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK(NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.LIST: ; * '.L': list all or part of the stack, pre-stored string, or
|
||
|
|
* pre-stored record names.
|
||
|
|
IF TOKEN1 THEN GOTO STRING.LIST
|
||
|
|
IF NN => END.STACK THEN NN = END.STACK - 1
|
||
|
|
NUM.LINES = 0
|
||
|
|
FOR I = NN TO 1 STEP -1
|
||
|
|
PRINT I "R%2":" ":CMD.STACK (I)
|
||
|
|
GOSUB PN.1
|
||
|
|
NEXT I
|
||
|
|
PRINT
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
STRING.LIST:
|
||
|
|
LEN.CMD = LEN(CMD)
|
||
|
|
IF CMD [LEN.CMD - 1, 2] = ' *' THEN GOTO SL.2
|
||
|
|
GOTO LOAD.ANY
|
||
|
|
|
||
|
|
SL.1:
|
||
|
|
PRINT
|
||
|
|
PRINT SPACE(5):LOAD.REC.NAME
|
||
|
|
ERROR.FORMAT = FALSE
|
||
|
|
GOSUB PRINT.CMD.STRING
|
||
|
|
PRINT
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SL.2:
|
||
|
|
L.SELECT.FLAG = TRUE
|
||
|
|
CMD = CMD [1, LEN.CMD - 2]
|
||
|
|
GOTO LOAD.ANY
|
||
|
|
|
||
|
|
SL.3:
|
||
|
|
L.SELECT.FLAG = FALSE
|
||
|
|
MAT CMD.NAME = ''
|
||
|
|
SELECT LOAD.FILE
|
||
|
|
NUM.LINES = 0
|
||
|
|
PRINT ; PRINT 'File is "':DICT:LOAD.FILE.NAME:'".' ; PRINT
|
||
|
|
|
||
|
|
SL.3A:
|
||
|
|
FOR K = 1 TO 5
|
||
|
|
|
||
|
|
SL.3B:
|
||
|
|
READNEXT CMD.NAME (K) ELSE GOTO SL.4
|
||
|
|
READ COMMAND.RECORD FROM LOAD.FILE, CMD.NAME (K) ELSE
|
||
|
|
PRINT 'Selected ':REC:' "':CMD.NAME (K):'"':IN.FILE:DICT:LOAD.FILE.NAME:'" not found.'
|
||
|
|
GOTO SL.3B
|
||
|
|
END
|
||
|
|
IF COMMAND.RECORD <1> [1, 1] # 'E' THEN GOTO SL.3B
|
||
|
|
NEXT K
|
||
|
|
GOSUB PRINT.NAMES
|
||
|
|
GOTO SL.3A
|
||
|
|
|
||
|
|
SL.4:
|
||
|
|
GOSUB PRINT.NAMES ; GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
STACK.RECALL: ; * '.R': recall a stack command to the bottom of the stack.
|
||
|
|
; * or load a pre-stored string into the stack.
|
||
|
|
IF TOKEN1 THEN GOTO LOAD.ANY
|
||
|
|
IF END.STACK = 1 THEN
|
||
|
|
CALL *UVPRINTMSG(001071,1)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
BLOCK.END = 1 ; NUM.CMDS = 1
|
||
|
|
GOSUB POP.UP
|
||
|
|
CMD.STACK (1) = CMD.STACK (NN + 1)
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (1)
|
||
|
|
** retain copy of command
|
||
|
|
** GOSUB PUSH.DOWN
|
||
|
|
PRINT
|
||
|
|
GOTO END.NOCHANGE
|
||
|
|
|
||
|
|
SR.1:
|
||
|
|
FWD.PTR = 1 ; BLOCK.END = 1
|
||
|
|
NUM.CMDS = BOT.STRING - 2
|
||
|
|
GOSUB POP.UP
|
||
|
|
FOR I = NUM.CMDS TO 1 STEP -1
|
||
|
|
CMD.STACK (I) = ED.CMD.STRING (FWD.PTR)
|
||
|
|
FWD.PTR += 1
|
||
|
|
NEXT I
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.SAVE: ; * '.S': save one or more commands as a pre-stored string.
|
||
|
|
IF LEN(CMD) = 2 THEN
|
||
|
|
CALL *UVPRINTMSG(020072,"")
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF END.STACK = 1 THEN
|
||
|
|
CALL *UVPRINTMSG(001071,1)
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
COMMA = INDEX(CMD, ',', 1)
|
||
|
|
IF COMMA THEN
|
||
|
|
IF COUNT(CMD, ' ') < 2 THEN
|
||
|
|
CALL *UVPRINTMSG(020073,"")
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
FIRST.CMD = CMD [COMMA-2, 2]
|
||
|
|
IF NOT(NUM(FIRST.CMD)) THEN
|
||
|
|
CALL *UVPRINTMSG(020073,"")
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
LAST.CMD = CMD [COMMA + 1, 2]
|
||
|
|
IF NOT(NUM(LAST.CMD)) THEN
|
||
|
|
CALL *UVPRINTMSG(020073,"")
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF FIRST.CMD < LAST.CMD THEN
|
||
|
|
SWAP.CMD = FIRST.CMD
|
||
|
|
FIRST.CMD = LAST.CMD
|
||
|
|
LAST.CMD = SWAP.CMD
|
||
|
|
END
|
||
|
|
CMD = CMD [1, COMMA-3]
|
||
|
|
END ELSE FIRST.CMD = NN ; LAST.CMD = 1
|
||
|
|
GOSUB STRING.WRITE
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STACK.UPCASE:
|
||
|
|
CMD.STACK (NN) = UPCASE( CMD.STACK (NN) )
|
||
|
|
PRINT NN "R%2":" ":CMD.STACK (NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STRING.LOOP: ; * LOOP: loop within a pre-stored command string.
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN GOTO CMD.ERR ; * DON'T TAKE 'LOOP' FROM KEYBOARD
|
||
|
|
IF LOOP.FLAG THEN GOTO TEST.LOOP.CTR
|
||
|
|
|
||
|
|
SETUP.LOOP:
|
||
|
|
SAVE.J = J
|
||
|
|
LOOP.FLAG = TRUE
|
||
|
|
STMT.NR = FIELD(TRIM(UPCMD), ' ', 2)
|
||
|
|
IF STMT.NR = '' THEN STMT.NR = 1
|
||
|
|
IF NOT(NUM(STMT.NR)) THEN
|
||
|
|
LOOP.FLAG = FALSE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
STMT.NR = STMT.NR - 1
|
||
|
|
IF STMT.NR < 0 OR STMT.NR > SAVE.J - 1 THEN
|
||
|
|
LOOP.FLAG = FALSE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
NR.TIMES = FIELD(TRIM(UPCMD), ' ', 3)
|
||
|
|
IF NR.TIMES = '' THEN NR.TIMES = 1
|
||
|
|
IF NOT(NUM(NR.TIMES)) THEN
|
||
|
|
LOOP.FLAG = FALSE
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF NR.TIMES < 1 THEN NR.TIMES = 1
|
||
|
|
IF STMT.NR > 0 THEN STMT.NR = STMT.NR - 1
|
||
|
|
J = STMT.NR
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
TEST.LOOP.CTR:
|
||
|
|
NR.TIMES -= 1
|
||
|
|
IF NR.TIMES = 0 THEN
|
||
|
|
LOOP.FLAG = FALSE ; J = SAVE.J ; GOTO GET.CMD
|
||
|
|
END
|
||
|
|
J = STMT.NR
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
STRING.PAUSE: ; * PAUSE: suspend execution of a pre-stored command string.
|
||
|
|
IF ED.CMD.STRING (1) = '$' THEN GOSUB SP.2 ; GOTO END.CMD
|
||
|
|
IF NOT(ED.CMD.STRING.ACTIVE) THEN GOTO CMD.ERR
|
||
|
|
ED.CMD.STRING.SUSPENDED = TRUE
|
||
|
|
CALL *UVPRINTMSG(001261,J)
|
||
|
|
GOTO END.CMD
|
||
|
|
|
||
|
|
!
|
||
|
|
* Command stack and pre-stored command subroutines.
|
||
|
|
!
|
||
|
|
|
||
|
|
GET.CMD.FROM.BLOCK: ; * Get pre-stored commands from record block into string.
|
||
|
|
IF BLOCK <1> [1, 1] = 'E' AND UPCMD2 # '.L' THEN
|
||
|
|
BLOCK = DELETE(BLOCK, 1, 0, 0)
|
||
|
|
END ELSE
|
||
|
|
IF UPCMD2 # '.L' THEN
|
||
|
|
CALL *UVPRINTMSG(001108,LOAD.REC.NAME)
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
END
|
||
|
|
DIM.SIZE = COUNT(BLOCK, @FM)
|
||
|
|
DIM ED.CMD.STRING (DIM.SIZE + 2)
|
||
|
|
IF INMAT() THEN GOSUB OVERFLOW ; GOTO GET.CMD ; * SJE 23 Apr 84
|
||
|
|
MATPARSE ED.CMD.STRING FROM BLOCK, @FM
|
||
|
|
ED.CMD.STRING (INMAT() + 1) = '$'
|
||
|
|
BOT.STRING = INMAT() + 2
|
||
|
|
BLOCK = ''
|
||
|
|
IF UPCMD2 = '.L' THEN GOTO SL.1
|
||
|
|
IF INMAT() > 99 THEN
|
||
|
|
PRINT 'This ':PRE.STORE:' string exceeds 99 commands.'
|
||
|
|
GOTO CMD.ERR
|
||
|
|
END
|
||
|
|
IF UPCMD2 = '.R' THEN
|
||
|
|
PRINT ; PRINT STARS:' Loaded ':INMAT():' command(s).' ; PRINT
|
||
|
|
GOTO SR.1
|
||
|
|
END
|
||
|
|
CURR.CMD.NAME = LOAD.REC.NAME
|
||
|
|
ED.CMD.STRING.ACTIVE = TRUE
|
||
|
|
GOTO GET.CMD
|
||
|
|
|
||
|
|
POP.UP: ; * Move stack commands up a given number of slots.
|
||
|
|
IF END.STACK + NUM.CMDS > 100 THEN
|
||
|
|
END.STACK = 100
|
||
|
|
ES = 101-NUM.CMDS
|
||
|
|
CMD.STACK (END.STACK) = '$'
|
||
|
|
END ELSE
|
||
|
|
ES = END.STACK
|
||
|
|
END.STACK = END.STACK + NUM.CMDS
|
||
|
|
END
|
||
|
|
FOR I = ES TO BLOCK.END STEP -1
|
||
|
|
CMD.STACK (I + NUM.CMDS) = CMD.STACK (I)
|
||
|
|
NEXT I
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PRINT.CMD.STRING: ; * Print a pre-stored string on the CRT.
|
||
|
|
JJ = 1 ; KK = 20
|
||
|
|
|
||
|
|
SP.1:
|
||
|
|
FOR INDEX = JJ TO KK UNTIL ED.CMD.STRING (INDEX) = '$'
|
||
|
|
IF ERROR.FORMAT THEN
|
||
|
|
PRINT " ":INDEX "R%2":": ":ED.CMD.STRING(INDEX)
|
||
|
|
END ELSE
|
||
|
|
PRINT FMT(INDEX, 'R%3'):' ':ED.CMD.STRING (INDEX)
|
||
|
|
END
|
||
|
|
NEXT INDEX
|
||
|
|
IF ED.CMD.STRING (1) # '$' THEN GOTO SP.3
|
||
|
|
|
||
|
|
SP.2: ; * NOTE: 'SP.2' also used via GOSUB.
|
||
|
|
PRINT STARS:'The ':PRE.STORE:' string is empty.'
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
SP.3:
|
||
|
|
IF ED.CMD.STRING (INDEX) = '$' THEN
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
JJ += 20 ; KK += 20
|
||
|
|
CALL *UVPRINTMSG(001142,"")
|
||
|
|
INPUT Q, 1 ; Q = UPCASE(Q)
|
||
|
|
IF Q = 'Q' THEN RETURN
|
||
|
|
GOTO SP.1
|
||
|
|
|
||
|
|
PRINT.NAMES: ; * Print pre-stored record names in a given file.
|
||
|
|
PRINT CMD.NAME (1), CMD.NAME (2), CMD.NAME (3), CMD.NAME (4), CMD.NAME (5)
|
||
|
|
MAT CMD.NAME = ''
|
||
|
|
|
||
|
|
PN.1:
|
||
|
|
NUM.LINES += 1
|
||
|
|
IF NUM.LINES > (@CRTHIGH - 4) THEN
|
||
|
|
NUM.LINES = 0
|
||
|
|
CALL *UVPRINTMSG(001142,"")
|
||
|
|
INPUT Q, 1 ; Q = UPCASE(Q)
|
||
|
|
IF Q = 'Q' THEN RETURN TO END.NOCHANGE
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PUSH.DOWN: ; * Push stack commands down a given number of slots.
|
||
|
|
FOR I = NN + 1 TO END.STACK
|
||
|
|
CMD.STACK (I) = CMD.STACK (I + 1)
|
||
|
|
NEXT I
|
||
|
|
END.STACK -= 1
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
PUT.ON.STACK: ; * Put commands onto the command stack.
|
||
|
|
IF LEN(CMD) = 0 AND NULL.CTR THEN
|
||
|
|
NULL.CTR += 1
|
||
|
|
CMD.STACK (1) = '+':NULL.CTR
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF UPCASE(CMD [1, 3]) = '.XR' THEN RETURN
|
||
|
|
IF UPCASE(CMD [1, 3]) = '.XK' THEN RETURN
|
||
|
|
IF UPCASE(CMD [1, 2]) = '.X' THEN GOTO STASH.IT
|
||
|
|
IF UPCASE(CMD [1, 4]) = 'HELP' THEN RETURN
|
||
|
|
IF CMD [1, 1] = '.' THEN RETURN
|
||
|
|
IF CMD [1, 1] = '?' THEN RETURN
|
||
|
|
IF ED.CMD.STRING.ACTIVE AND NOT(ED.CMD.STRING.SUSPENDED) THEN RETURN
|
||
|
|
|
||
|
|
STASH.IT:
|
||
|
|
NUM.CMDS = 1 ; BLOCK.END = 1
|
||
|
|
GOSUB POP.UP
|
||
|
|
IF LEN(CMD) = 0 THEN NULL.CTR = 1 ; CMD.STACK (1) = '+':1
|
||
|
|
ELSE CMD.STACK (1) = ORIGINAL.CMD
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
SET.UP.NN: ; * Find which stack command is to be operated on.
|
||
|
|
MATCH.CHAR = MATCHFIELD(UPCMD [3, 1], '1N', 1)
|
||
|
|
IF LEN(MATCH.CHAR) # 0 THEN
|
||
|
|
NN = UPCMD [3, 1]
|
||
|
|
MATCH.CHAR = MATCHFIELD(UPCMD [4, 1], '1N', 1)
|
||
|
|
IF LEN(MATCH.CHAR) # 0 THEN
|
||
|
|
NN := UPCMD [4, 1]
|
||
|
|
MATCH.CHAR = MATCHFIELD(UPCMD [5, 1], '1N', 1)
|
||
|
|
IF LEN(MATCH.CHAR) # 0 THEN NN := UPCMD [5, 1]
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IF UPCMD2 # '.C' THEN
|
||
|
|
IF CMD [3, 1] # ' ' AND LEN(CMD [3, 1]) # 0 THEN RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF UPCMD2 = '.L' THEN NN = 9 ELSE NN = 1
|
||
|
|
IF UPCMD2 = '.C' THEN CMD = CMD [1, 2]:1:CMD [3, 9999]
|
||
|
|
IF UPCMD2 = '.I' THEN SV.CMD = SV.CMD [1, 2]:1:SV.CMD [3, 9999]
|
||
|
|
IF END.STACK = 1 THEN
|
||
|
|
IF UPCMD2 = '.D' AND TOKEN1 THEN RETURN
|
||
|
|
IF UPCMD2 = '.I' OR UPCMD2 = '.R' OR UPCMD2 = '.X' THEN RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF NN = 0 THEN RETURN TO CMD.ERR
|
||
|
|
IF NN => END.STACK - 1 AND UPCMD2 = '.X' AND NOT(TOKEN1) THEN
|
||
|
|
CALL *UVPRINTMSG(001071,NN)
|
||
|
|
PRINT
|
||
|
|
NN = 0
|
||
|
|
GOSUB PUSH.DOWN
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF NN = STACK.LIMIT AND UPCMD2 # '.L' THEN RETURN TO CMD.ERR
|
||
|
|
IF NN = END.STACK AND UPCMD2 = '.I' THEN RETURN
|
||
|
|
IF NN => END.STACK AND UPCMD2 # '.L' THEN
|
||
|
|
CALL *UVPRINTMSG(001071,NN)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
STRING.WRITE: ; * Write stack to a pre-stored command record, or unload lines.
|
||
|
|
WRITE.FILE.DICT = ''
|
||
|
|
IF NOT(COUNT(CMD, ' ')) THEN RETURN TO CMD.ERR
|
||
|
|
SENT = TRIM(CMD [INDEX(CMD, ' ', 1) + 1, 99])
|
||
|
|
IF COUNT(SENT, ' ') > 2 THEN RETURN TO CMD.ERR
|
||
|
|
IF COUNT(SENT, ' ') THEN
|
||
|
|
PROMPT.FOR.FILE = FALSE ; NO.SELECT.LIST = TRUE
|
||
|
|
WRITE.FILE.NAME = '' ; WRITE.FILE.DICT = ''
|
||
|
|
SINGLE.FILE.ONLY = TRUE
|
||
|
|
CALL @GET.FILE.NAME (NO.SELECT.LIST, SENT, WRITE.FILE.DICT,
|
||
|
|
WRITE.FILE.NAME, PROMPT.FOR.FILE, SINGLE.FILE.ONLY)
|
||
|
|
IF LEN(WRITE.FILE.NAME) = 0 THEN RETURN TO CMD.ERR
|
||
|
|
IF WRITE.FILE.NAME # WRITE.FILE.NAME <1> THEN RETURN TO CMD.ERR
|
||
|
|
LOAD.REC.NAME = SENT
|
||
|
|
OPENCHECK WRITE.FILE.DICT, WRITE.FILE.NAME TO WRITE.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,WRITE.FILE.NAME THEN
|
||
|
|
IF WRITE.FILE.DICT = "" THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
END ELSE
|
||
|
|
PathName = FileRec<3>
|
||
|
|
END
|
||
|
|
RELEASE DEVSYS.VOC.FILE,WRITE.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
IF WRITE.FILE.DICT = "" THEN
|
||
|
|
FileName = WRITE.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
FileName = "DICT,":WRITE.FILE.NAME
|
||
|
|
END
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
WRITE.REC.NAME = SENT
|
||
|
|
END ELSE
|
||
|
|
IF UNLOAD.FLAG THEN
|
||
|
|
WRITE.FILE.NAME = FILE.NAME ; WRITE.FILE.DICT = DICT
|
||
|
|
WRITE.FILE = EDIT.FILE
|
||
|
|
END ELSE
|
||
|
|
WRITE.FILE.NAME = '&ED&' ; WRITE.FILE.DICT = ''
|
||
|
|
OPENCHECK WRITE.FILE.DICT, WRITE.FILE.NAME TO WRITE.FILE ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,WRITE.FILE.NAME THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
RELEASE DEVSYS.VOC.FILE,WRITE.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
IF ErrorCode = -1 THEN
|
||
|
|
AcctFlavor = SYSTEM(1001)
|
||
|
|
IF AcctFlavor = 2 OR AcctFlavor = 8 OR AcctFlavor = 16 THEN
|
||
|
|
CreateArgs = "1,1,3 1,1,1"
|
||
|
|
END ELSE
|
||
|
|
CreateArgs ="1 0 0"
|
||
|
|
END
|
||
|
|
EXECUTE "CREATE-FILE &ED& ":CreateArgs
|
||
|
|
|
||
|
|
OPENCHECK WRITE.FILE.DICT, WRITE.FILE.NAME TO WRITE.FILE THEN
|
||
|
|
GOTO WRITE.OKAY
|
||
|
|
END ELSE
|
||
|
|
ErrorCode = STATUS()
|
||
|
|
READL FileRec FROM DEVSYS.VOC.FILE,WRITE.FILE.NAME THEN
|
||
|
|
PathName = FileRec<2>
|
||
|
|
RELEASE DEVSYS.VOC.FILE,WRITE.FILE.NAME
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
PathName = ""
|
||
|
|
END
|
||
|
|
END
|
||
|
|
FileName = WRITE.FILE.NAME
|
||
|
|
CALL @OpenError(ErrorCode,FileName,PathName)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
END
|
||
|
|
WRITE.OKAY:
|
||
|
|
WRITE.REC.NAME = FIELD(SENT, ' ', 1)
|
||
|
|
END
|
||
|
|
IF LEN(SENT) = 0 THEN RETURN TO CMD.ERR
|
||
|
|
IF LEN(WRITE.REC.NAME) = 0 THEN RETURN TO CMD.ERR
|
||
|
|
IF UNLOAD.FLAG THEN
|
||
|
|
* Starting line/field number -
|
||
|
|
CALL *UVPRINTMSG(001193,"")
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
START = INPUT.LINE
|
||
|
|
IF NOT(NUM(START)) THEN
|
||
|
|
PRINT 'Starting line/field must be numeric ; you entered "':START:'".'
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF START < 1 THEN
|
||
|
|
CALL *UVPRINTMSG(001231,"")
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF START > BOT THEN
|
||
|
|
CALL *UVPRINTMSG(001230,BOT:@FM:START)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
* Ending line/field number -
|
||
|
|
CALL *UVPRINTMSG(001195,"")
|
||
|
|
GOSUB INPUT.LINE
|
||
|
|
ENDING = INPUT.LINE
|
||
|
|
IF NOT(NUM(ENDING)) THEN
|
||
|
|
PRINT 'Ending line/field must be numeric ; you entered "':ENDING:'".'
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
IF ENDING < START THEN
|
||
|
|
CALL *UVPRINTMSG(001233,ENDING:@FM:START)
|
||
|
|
RETURN TO CMD.ERR
|
||
|
|
END
|
||
|
|
END
|
||
|
|
|
||
|
|
CHECK.FOR.LOCK:
|
||
|
|
READU COMMAND.RECORD FROM WRITE.FILE, WRITE.REC.NAME
|
||
|
|
* ON ERROR
|
||
|
|
* CALL *UVPRINTMSG(STATUS(),"")
|
||
|
|
* RETURN TO GET.CMD
|
||
|
|
* END
|
||
|
|
LOCKED
|
||
|
|
CALL *UVPRINTMSG(001191,"")
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS = 'Y' THEN GOTO CHECK.FOR.LOCK ELSE RETURN TO GET.CMD
|
||
|
|
END ELSE
|
||
|
|
IF UPCMD2 = '.D' THEN
|
||
|
|
CALL *UVPRINTMSG(970004,WRITE.REC.NAME:@FM:WRITE.FILE.DICT:WRITE.FILE.NAME)
|
||
|
|
PRINT
|
||
|
|
GOSUB DISPLAY.CURRENT.LINE
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
DF.ERROR = STATUS()
|
||
|
|
IF DF.ERROR = 1 OR DF.ERROR = 2 THEN
|
||
|
|
STATUS TEMP.INFO FROM WRITE.FILE ELSE TEMP.INFO = ""
|
||
|
|
IF TEMP.INFO<21> = 27 THEN
|
||
|
|
CALL *UVPRINTMSG(970013,WRITE.REC.NAME)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(970012,WRITE.REC.NAME)
|
||
|
|
END
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 3 THEN
|
||
|
|
CALL *UVPRINTMSG(47007,WRITE.REC.NAME)
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
ELSE IF DF.ERROR = 4 THEN
|
||
|
|
* Warning message already issued - no need to repeat ourselves
|
||
|
|
* CALL *UVPRINTMSG(47006,WRITE.REC.NAME)
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
GOTO WRITE.IT.OUT
|
||
|
|
END
|
||
|
|
REC.TYPE.CODE = COMMAND.RECORD <1> [1, 1]
|
||
|
|
COMMAND.RECORD = '' ; * RETURN STRING SPACE
|
||
|
|
IF UPCMD2 = '.D' THEN RETURN TO SD.1
|
||
|
|
* already exists overwrite
|
||
|
|
IF STACK.MODE THEN
|
||
|
|
CALL *UVPRINTMSG(001110,"")
|
||
|
|
CALL *UVPRINTMSG(001200,"")
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001197,"")
|
||
|
|
END
|
||
|
|
GOSUB INPUT.LINE ; ANS = INPUT.LINE ; ANS = UPCASE(ANS)
|
||
|
|
IF ANS # 'Y' THEN
|
||
|
|
IF STACK.MODE THEN
|
||
|
|
CALL *UVPRINTMSG(001111,WRITE.REC.NAME)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001198,"")
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
WRITE.IT.OUT:
|
||
|
|
|
||
|
|
WRITE.PERM.MODE = 1
|
||
|
|
WRITE.PERM.IN = 2
|
||
|
|
WRITE.PERM.OUT = ''
|
||
|
|
CALL @PERMISSIONS(WRITE.FILE,WRITE.PERM.MODE,WRITE.PERM.IN,WRITE.PERM.OUT)
|
||
|
|
IF NOT(WRITE.PERM.OUT) THEN
|
||
|
|
CALL *UVPRINTMSG(001398,WRITE.FILE.DICT:WRITE.FILE.NAME)
|
||
|
|
RETURN TO GET.CMD
|
||
|
|
END
|
||
|
|
|
||
|
|
IF UNLOAD.FLAG THEN GOTO UNLOAD
|
||
|
|
CMD.STRING = UVREADMSG(010239,"")
|
||
|
|
CMD.STRING = 'E':CMD.STRING:TIMEDATE():@FM
|
||
|
|
IF NN = 1 AND NOT(COMMA) THEN LAST.CMD = 1
|
||
|
|
ELSE
|
||
|
|
IF CMD.STACK (FIRST.CMD) [1, 1] = 'E' THEN CMD.STRING = '' ; * USER PUT OWN 'E' FIELD
|
||
|
|
FOR JJ = FIRST.CMD TO LAST.CMD + 1 STEP -1
|
||
|
|
CMD.STRING := CMD.STACK (JJ):@FM
|
||
|
|
NEXT JJ
|
||
|
|
END
|
||
|
|
CMD.STRING := CMD.STACK (LAST.CMD)
|
||
|
|
WRITE CMD.STRING TO WRITE.FILE, WRITE.REC.NAME ELSE
|
||
|
|
WRITE.STATUS = STATUS()
|
||
|
|
IF WRITE.STATUS = IntegrityViolation THEN
|
||
|
|
IO.VAR = 2
|
||
|
|
CALL @SQLINTCHK(CMD.STRING,WRITE.FILE,WRITE.REC.NAME,WRITE.FILE.DICT:" ":WRITE.FILE.NAME,IO.VAR)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001236,WRITE.STATUS)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF STACK.MODE THEN
|
||
|
|
CALL *UVPRINTMSG(970005,WRITE.REC.NAME:@FM:WRITE.FILE.DICT:WRITE.FILE.NAME)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001112,WRITE.REC.NAME)
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
UNLOAD:
|
||
|
|
IF ENDING > BOT THEN ENDING = BOT
|
||
|
|
UN.RECORD = ''
|
||
|
|
FOR LNUM = START TO ENDING - 1
|
||
|
|
GOSUB GET.LINE
|
||
|
|
UN.RECORD := LINE:@FM
|
||
|
|
NEXT LNUM
|
||
|
|
LNUM = ENDING
|
||
|
|
GOSUB GET.LINE
|
||
|
|
UN.RECORD := LINE
|
||
|
|
WRITE UN.RECORD TO WRITE.FILE, WRITE.REC.NAME
|
||
|
|
ELSE
|
||
|
|
WRITE.STATUS = STATUS()
|
||
|
|
IF WRITE.STATUS = IntegrityViolation THEN
|
||
|
|
IO.VAR = 2
|
||
|
|
CALL @SQLINTCHK(UN.RECORD,WRITE.FILE,WRITE.REC.NAME,WRITE.FILE.DICT:" ":WRITE.FILE.NAME,IO.VAR)
|
||
|
|
END ELSE
|
||
|
|
CALL *UVPRINTMSG(001236,WRITE.STATUS)
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
* IF STACK.MODE THEN
|
||
|
|
* CALL *UVPRINTMSG(970005,WRITE.REC.NAME:@FM:WRITE.FILE.DICT:WRITE.FILE.NAME)
|
||
|
|
* END
|
||
|
|
UN.RECORD = ''
|
||
|
|
* %i lines/fields unloaded.
|
||
|
|
CALL *UVPRINTMSG(001199,ENDING - START + 1)
|
||
|
|
DISPLAY.CURRENT.LINE = FALSE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
READ.HELP.RECORD:
|
||
|
|
IF LEN(HELP.RECORD) = 0 THEN
|
||
|
|
READ HELP.RECORD FROM SYS.MESSAGE,970000 ELSE
|
||
|
|
CALL *UVPRINTMSG(970002,"")
|
||
|
|
RETURN TO HELP.END
|
||
|
|
END
|
||
|
|
READ HELP.RECORD.2 FROM SYS.MESSAGE,970001 ELSE
|
||
|
|
CALL *UVPRINTMSG(970002,"")
|
||
|
|
RETURN TO HELP.END
|
||
|
|
END
|
||
|
|
HELP.RECORD = HELP.RECORD:@FM:HELP.RECORD.2
|
||
|
|
HELP.RECORD = CHANGE(HELP.RECORD,'_':@FM,@VM)
|
||
|
|
|
||
|
|
* Ignore standard header (top three lines) of help file.
|
||
|
|
* HELP.RECORD = FIELD(HELP.RECORD, @FM, 4, 9999) ;* not on uniVerse!
|
||
|
|
|
||
|
|
* Following code to be removed post-8.3.3.
|
||
|
|
* Remove references to NLS and Unicode functionality if NLS mode is off.
|
||
|
|
NUM.HELP.LINES = DCOUNT(HELP.RECORD, @FM)
|
||
|
|
HELP.RECORD.ORIG = HELP.RECORD
|
||
|
|
HELP.RECORD = ''
|
||
|
|
SKIP.HELP.LINE = @FALSE
|
||
|
|
FOR N = 1 TO NUM.HELP.LINES
|
||
|
|
HELP.LINE = HELP.RECORD.ORIG<N>
|
||
|
|
IF NLS.ON.FLAG THEN ;* just remove the NLS marker lines
|
||
|
|
IF HELP.LINE[1,3] # 'NLS'
|
||
|
|
THEN HELP.RECORD<-1> = HELP.LINE
|
||
|
|
END ELSE ;* remove all lines between as well
|
||
|
|
BEGIN CASE
|
||
|
|
CASE HELP.LINE = 'NLSBEGIN'
|
||
|
|
SKIP.HELP.LINE = @TRUE
|
||
|
|
CASE HELP.LINE = 'NLSEND'
|
||
|
|
SKIP.HELP.LINE = @FALSE
|
||
|
|
CASE SKIP.HELP.LINE = @FALSE
|
||
|
|
HELP.RECORD<-1> = HELP.LINE
|
||
|
|
END CASE
|
||
|
|
END
|
||
|
|
NEXT N
|
||
|
|
* End 8.3.3 special - remove NLSBEGIN/NLSEND lines from messages 970000/970001
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
ABORT.CHECK:
|
||
|
|
ABORT = FALSE
|
||
|
|
IF NOT(ABORT.FLAG) THEN RETURN
|
||
|
|
INPUT ABORT, -1
|
||
|
|
IF NOT(ABORT) THEN RETURN
|
||
|
|
INPUT ABORT, 1
|
||
|
|
ABORT = UPCASE(ABORT)
|
||
|
|
IF ABORT = 'Q' THEN RETURN
|
||
|
|
* Stopped at line %i
|
||
|
|
CALL *UVPRINTMSG(001229,LNUM)
|
||
|
|
INPUT ABORT, 1
|
||
|
|
ABORT = UPCASE(ABORT)
|
||
|
|
IF ABORT = 'Q' THEN RETURN
|
||
|
|
ABORT = FALSE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
AT.INSERT:
|
||
|
|
LOCATE X IN AT.LIST <1> BY 'AL' SETTING AT.LOC ELSE
|
||
|
|
AT.LIST = INSERT(AT.LIST, AT.LOC, 0, 0, X)
|
||
|
|
AT.SUB = INSERT(AT.SUB, AT.LOC, 0, 0, Y)
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
AT.SUB = REPLACE(AT.SUB, AT.LOC, 0, 0, Y)
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
* SJE SPARs 3002891 and 3004396 23 Apr 84
|
||
|
|
* Give warning message and return to caller who will return to GET.CMD ASAP.
|
||
|
|
OVERFLOW:
|
||
|
|
PRINT
|
||
|
|
PRINT @SYS.BELL:'Memory overflow, one line of data may be lost. FILE as soon'
|
||
|
|
PRINT 'as possible to prevent further loss and re-EDit.'
|
||
|
|
OVERFLOW.FLAG = 1
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
|
||
|
|
END
|