PROC FSEEDIT;
BEGIN
#
*** FSEEDIT - FULL SCREEN EDITOR AND SCREEN MGT FACILITY.
*
* COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
#
DEF LISTCON #0#;
CONTROL EJECT; # UNIVERSAL DEFINITIONS #
*IFCALL SINGLE,COMFSGL
*IFCALL ONLY,COMFONL
*IFCALL MULTI,COMFMLT
*CALL COMFFSE
# EXTERNAL REF'S AND DEF'S #
CONTROL IFEQ MULTI,1;
XREF ARRAY RENTSTK [1:MAXREENT]; # SUBROUTINE STACK #
BEGIN
ITEM RSTK;
END
XREF ITEM RSTKPTR;
CONTROL FI;
CONTROL IFEQ MULTI,1;
XREF PROC VOLUNTEER; # OFFER TO SURRENDER SUBTASK #
XREF PROC CLEARINT; # PROCLAIM WE SAW USRBRK #
XREF PROC FATALTRAP; # MONITOR PROCESSING FOR EDITOR TROUBLE #
XREF PROC CLEARQUE; # MONITOR NO LONGER NEEDS TASKREQUE BIT #
CONTROL IFEQ METERING,1;
XREF PROC BGNMETER; # ISSUE START-OF-SESSION STATS #
CONTROL FI;
CONTROL FI;
XDEF
BEGIN
*CALL COMFXED
END
XREF
BEGIN
*CALL COMFXSB
*CALL COMFXTI
*CALL COMFXFO
*CALL COMFXSC
*CALL COMFXWK
*CALL COMFXVT
END
CONTROL IFEQ SINGLE,1;
XREF
BEGIN
*CALL COMFXCM
END
CONTROL FI;
XREF
BEGIN
CONTROL IFEQ SINGLE,1;
*CALL COMFXFL
CONTROL FI;
END
XREF # XTRNL CIO PROCS #
BEGIN
PROC READ; # ALL SAME AS #
PROC READC; # CORRESPONDING MACROS #
PROC WRITE;
PROC WRITEF;
PROC WRITER;
PROC WRITEC;
CONTROL IFEQ SINGLE,1;
PROC EVICT;
PROC RETERN;
PROC REWIND;
PROC RECALL;
CONTROL FI;
END
XREF # XTRNL MISCELLANEOUS #
BEGIN
PROC DISSJ; # DISABLE/ENABLE SSJ= #
PROC VDTGTN;
PROC VDTGTO;
PROC EXCHWD;
PROC MOVEWD;
PROC ZEROWD;
FUNC FASTFND B; # OPTIMIZED STRING SEARCH #
FUNC FASTLNB; # FIND LAST NON-BLANK #
FUNC LENGTH; # LENGTH OF INTERNAL LINE #
FUNC LINESZ;
FUNC FIXCTL B; # FIX UNWANTED CONTROL BYTES #
CONTROL IFEQ SINGLE,1;
PROC MESSAGE; # MESSAGE MACRO #
PROC DISTCON; # DISABLE TERMINAL CONTROL #
PROC ABORT; # ABORT MACRO #
PROC SYSREQ;
PROC ROLLTE;
PROC TSTATUS;
CONTROL FI;
END
# COMMON DATA AREAS #
*CALL COMFDS1
*CALL COMFVD2
*CALL COMFDS2
# EDITOR SYNTAX TABLES #
*CALL COMFTAB
PAGE # VARIOUS USEFUL LITTLE ROUTINES #
PROC DSPLCOD(WORD);
BEGIN
#
** DSPLCOD - CONVERT ONE CHARACTER TO LOWER CASE OR DISPLAY.
*
* DSPLCOD SUPPRESSES CASE OF INTERNAL CHARACTERS. IT IS
* ALSO DEFINED TO CONVERT FROM INTERNAL CHARACTER SET TO
* DISPLAY. THUS THE FIRST 64 CHARACTERS OF INTERNAL MUST
* EQUAL DISPLAY CODE. WE ENFORCE THIS WITH COMPILE-TIME
* CHECKS FOR "A", "Z", AND SEMICOLON.
*
* ENTRY WORD - INTERNAL CHARSET VALUE TO CONVERT.
*
* EXIT WORD - CONVERTED.
#
CONTROL IFNQ CLETTERA,1; ERROR; CONTROL FI;
CONTROL IFNQ CLETTERZ,26; ERROR; CONTROL FI;
CONTROL IFNQ CSEMCOLON,O"77"; ERROR; CONTROL FI;
ITEM WORD;
WORD=XLTINTDSP[WORD];
END # OF DSPLCOD #
PROC SQUELCH(TEXTLIN);
BEGIN
#
** SQUELCH - SUPPRESS LOWER-CASE FOR LINE IMAGE.
*
* ENTRY TEXTLIN - INTERNAL CHARSET LINE IMAGE.
*
* EXIT TEXTLIN - ALL ALPHABETICS ARE UPPER CASE.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS DSPLCOD, LENGTH.
#
ARRAY TEXTLIN[0:99]; ITEM TEXTLINE;
ITEM TMP1, TMP2;
FOR TMP1=0 STEP 1 UNTIL LENGTH(TEXTLIN) DO
BEGIN
GETCHAR(TEXTLINE,TMP1,TMP2);
DSPLCOD(TMP2);
SETCHAR(TEXTLINE,TMP1,TMP2);
END
END # OF SQUELCH #
PROC HALT(STR);
IOBEGIN(HALT)
#
** HALT - SET WARNING MESSAGE AND FLAG COMMAND SHUTDOWN.
*
* ENTRY STR - ERROR MESSAGE, DISPLAY WITH DOLLAR SIGN.
*
* EXIT ERRSTRING - EQUAL TO STR.
* FOUND - FALSE.
* LINCTR - INFINITE.
#
ITEM STR C(80);
FOUND=FALSE;
LINCTR=LARGENUM;
ERRSTRING=STR;
IOEND # OF HALT #
CONTROL IFEQ MULTI,1;
PROC CHKVICTIM;
IOBEGIN(CHKVICTIM)
#
** CHKVICTIM - CHECK FOR SMFEX-IMPOSED SESSION ABORT.
*
* CHKVICTIM LOOKS FOR SMFEX-DETECTED CATASTROPHES. THIS
* CURRENTLY INCLUDES ONLY UNRECOVERABLE ECS PARITY ERRORS.
*
* ENTRY SMFVICTIM - FLAG.
*
* EXIT VIA FATAL IF NEED TO ABORT.
*
* CALLS FATAL.
#
IF SMFVICTIM THEN FATAL(ERRSTRING);
IOEND # OF CHKVICTIM #
CONTROL FI;
PROC CONCAT(LIN1,LIN2);
BEGIN
#
** CONCAT - CONCATENATE TWO INTERNAL LINE IMAGES.
*
* ENTRY LIN1, LIN2 - THE LINE IMAGES IN INTERNAL CHARSET.
*
* EXIT LIN1 - HAS LIN2 APPENDED TO IT.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LENGTH.
#
ARRAY LIN1; ITEM LINE1;
ARRAY LIN2; ITEM LINE2;
ITEM TMP1, TMP2, TMP3, TMP4;
TMP1=LENGTH(LIN1);
TMP2=LENGTH(LIN2);
FOR TMP3=0 STEP 1 WHILE TMP3 LQ TMP2 AND TMP1+TMP3 LQ BUFCM1 DO
BEGIN
GETCHAR(LINE2,TMP3,TMP4);
SETCHAR(LINE1,TMP1+TMP3,TMP4);
END
SETCHAR(LINE1,TMP1+TMP3,CENDLINE);
END # OF CONCAT #
PROC NOPOP; # LIKE POP BUT DONT MOVE #
BEGIN
#
** NOPOP - POP POSITION STACK WITHOUT USING IT.
*
* NOPOP DIFFERS FROM POP IN THAT WHILE BOTH POP THE LEVEL
* OF THE POSITIONING STACK, NOPOP DISCARDS THE STACK VALUES
* WHILE POP REPOSITIONS TO THE SAVED LOCATION IN THE FILE.
*
* ENTRY POSITIONING STACK PREVIOUSLY PUSHED.
*
* EXIT STACKPTR DECREMENTED.
*
* CALLS FATAL.
#
IF STACKPTR LS 0 THEN
BEGIN
FATAL(" FILE POSITION STACK UNDERFLOWED (2).$");
END
STACKPTR=STACKPTR-1;
END # OF NOPOP #
PROC WINDOLIN(LINEPARM,FILEPARM);
BEGIN
#
** WINDOLIN - FORCE ADDRESS INTO FILE IMAGE.
*
* WINDOLIN FORCES LINEPARM TO BE IN BOUNDS FOR THE FILEPARM.
*
* ENTRY LINEPARM - LINE ADDRESS.
* FILEPARM - BRACKET NUMBER FOR FILE.
* TOPF(FILEPARM), BOTF(FILEPARM) - BOUNDS.
*
* EXIT LINEPARM - IN BOUNDS.
* FOUND - TRUE OR FALSE FOR VALIDITY OF ORIGINAL VALUE.
#
ITEM LINEPARM, FILEPARM;
FOUND=FALSE;
IF TOPF(FILEPARM) EQ BOTF(FILEPARM)-1 THEN LINEPARM=TOPF(FILEPARM);
ELSE IF LINEPARM LQ TOPF(FILEPARM) THEN LINEPARM=TOPF(FILEPARM)+1;
ELSE IF LINEPARM GQ BOTF(FILEPARM) THEN LINEPARM=BOTF(FILEPARM)-1;
ELSE FOUND=TRUE;
END # OF WINDOLIN #
PROC WINDOPOS(LINEPARM,FILEPARM);
BEGIN
#
** WINDOPOS - VALIDATE POSITION WITHIN FILE.
*
* WINDOPOS IS LIKE WINDOLIN EXCEPT THAT IT ALLOWS THE
* POSITION TO BE JUST ABOVE THE TOP OF THE FILE.
*
* ENTRY LINEPARM - AS WINDOLIN.
* FILEPARM - AS WINDOLIN.
* TOPF(), BOTF() - AS WINDOLIN.
*
* EXIT LINEPARM - AS WINDOLIN.
* FOUND - AS WINDOLIN.
#
ITEM LINEPARM, FILEPARM;
FOUND=FALSE;
IF TOPF(FILEPARM) EQ BOTF(FILEPARM)-1 THEN LINEPARM=TOPF(FILEPARM);
IF LINEPARM LS TOPF(FILEPARM) THEN LINEPARM=TOPF(FILEPARM);
ELSE IF LINEPARM GQ BOTF(FILEPARM) THEN LINEPARM=BOTF(FILEPARM)-1;
ELSE FOUND=TRUE;
END # OF WINDOPOS #
PROC FWDNUM;
IOBEGIN(FWDNUM)
#
** FWDNUM - MOVE FORWARDS UNTIL NUMBERED LINE FOUND.
*
* FWDNUM ADVANCES THE CURRENT POSITION IN THE WORKFILE
* UNTIL A NUMBERED LINE IS FOUND. NOTE THAT WE ASSUME THE
* CALLER HAS VERIFIED THAT WE EXPECT NUMBERED LINES.
*
* ENTRY CURRENT, CURFILE - WHERE WE ARE.
* BOTF(CURFILE) - BOUNDS.
* USRBRK - CONTINUOUSLY CHECKED.
*
* EXIT CURRENT - UPDATED.
*
* MACROS MOD.
*
* CALLS FWDZ, GETLNUM, VOLUNTEER(MULTI).
*
* USES LINENO, WIDTHFOUND, DORNGCTR.
#
LINENO=NINES;
WIDTHFOUND=0;
FOR DORNGCTR=1 STEP 1 WHILE WIDTHFOUND EQ 0 AND
CURRENT LS BOTF(CURFILE)-1 AND USRBRK EQ 0 DO
BEGIN
FWDZ;
GETLNUM;
IF WIDTHFOUND EQ 0 THEN LINENO=NINES;
CONTROL IFEQ MULTI,1;
IF MOD(DORNGCTR,VOLLINES) EQ 0 THEN VOLUNTEER;
CONTROL FI;
END
IOEND # OF FWDNUM #
PROC BAKNUM;
IOBEGIN(BAKNUM)
#
** BAKNUM - BACK UP IN FILE UNTIL NUMBERED LINE.
*
* BAKNUM IS LIKE FWDNUM EXCEPT OPPOSITE DIRECTION.
*
* ENTRY CURRENT, CURFILE - WHERE WE ARE.
* TOPF(CURFILE) - BOUNDS.
* USRBRK - CONTINUOUSLY CHECKED.
*
* EXIT CURRENT - UPDATED.
*
* MACROS MOD.
*
* CALLS BAKZ, GETLNUM, VOLUNTEER(MULTI).
*
* USES LINENO, WIDTHFOUND, DORNGCTR.
#
LINENO=0;
WIDTHFOUND=0;
FOR DORNGCTR=1 STEP 1 WHILE WIDTHFOUND EQ 0 AND
CURRENT GR TOPF(CURFILE)+1 AND USRBRK EQ 0 DO
BEGIN
BAKZ;
GETLNUM;
CONTROL IFEQ MULTI,1;
IF MOD(DORNGCTR,VOLLINES) EQ 0 THEN VOLUNTEER;
CONTROL FI;
END
IOEND # OF BAKNUM #
PROC POSN;
IOBEGIN(POSN)
#
** POSN - POSITION TO LINE WITH DESIRED SEQUENCE NUMBER.
*
* POSN MOVES FORWARDS OR BACKWARDS AS NEEDED TO GET TO
* THE NEAREST LINE WITH THE RIGHT SEQUENCE NUMBER. WE
* ASSUME THE CALLER HAS VERIFIED WE EXPECT NUMBERS.
*
* ENTRY LINNUM1 - DESIRED SEQUENCE NUMBER.
* CURFILE, CURF(CURFILE) - STARTING LOCATION.
* TOPF(CURFILE), BOTF(CURFILE) - BOUNDS.
* USRBRK - CONTINUOUSLY CHECKED.
*
* EXIT CURRENT - UPDATED.
*
* MACROS MOD.
*
* CALLS POSZ, GETLNUM, BAKZ, VOLUNTEER(MULTI), FWDZ, BAKNUM.
*
* USES DORNGCTR, LINENO.
#
POSZ(CURF(FILNUM));
GETLNUM;
FOR DORNGCTR=1 STEP 1 WHILE CURRENT GR TOPF(FILNUM) AND
(LINENO GR LINNUM1 OR WIDTHFOUND EQ 0) AND USRBRK EQ 0 DO
BEGIN
BAKZ;
GETLNUM;
CONTROL IFEQ MULTI,1;
IF MOD(DORNGCTR,VOLLINES) EQ 0 THEN VOLUNTEER;
CONTROL FI;
END
FOR DORNGCTR=1 STEP 1 WHILE CURRENT LS BOTF(FILNUM)-1 AND
(LINENO LS LINNUM1) AND USRBRK EQ 0 DO
BEGIN
FWDZ;
GETLNUM;
CONTROL IFEQ MULTI,1;
IF MOD(DORNGCTR,VOLLINES) EQ 0 THEN VOLUNTEER;
CONTROL FI;
END
IF LINENO GR LINNUM1 THEN BAKNUM;
IOEND # OF POSN #
PROC FITNUM;
IOBEGIN(FITNUM)
#
** FITNUM - CHECK SEQUENCING GAP AND SELECT INCREMENT.
*
* FITNUM IS USED WITH SEQUENCE NUMBERED FILES TO SEE IF
* THERE IS AN ADEQUATE GAP IN VALUES OF ADJACENT SEQUENCE
* NUMBERS TO FIT IN AS MANY LINES AS WE WISH. AN INCREMENT
* IS CHOSEN FOR NUMBERING OF THE LINES TO BE ADDED.
*
* ENTRY CURFILE - WHICH FILE BRACKET.
* NUMBERED[CURFILE] - WHETHER TO DO ANYTHING.
* CURRENT - LINE AFTER WHICH TO ADD BLOCK.
* DINCR - DEFAULT NUMBERING INCREMENT.
* LINPTR3 - TARGET, SHOULD EQUAL CURRENT.
* LINPTR1, LINPTR2 - INDICATE SIZE OF BLOCK.
* LIMIT - ALSO INDICATES SIZE OF BLOCK.
* LINNUM3 - SEQUENCE VALUE AT TARGET.
* BOTF(CURFILE) - BOUNDS.
*
* EXIT VIA ERRJUMP IF IT CANNOT BE DONE.
* INCR - NEW SEQUENCING INCREMENT.
* LINENO - FIRST SEQUENCE MINUS INCR.
*
* CALLS GETLNUM, PUSH, FWDNUM, POP, MIN, MAX.
*
* USES LINNUM1, LINNUM2, LCOUNT.
#
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
GETLNUM;
IF WIDTHFOUND LQ 0 THEN
BEGIN
PUSH;
BAKNUM;
POP;
END
LINNUM1=MIN(LINNUM3,NINES);
LINNUM1=MAX(LINNUM1,LINENO);
IF CURRENT GQ BOTF(CURFILE)-1 THEN LINNUM2=NINES;
ELSE
BEGIN
PUSH;
FWDNUM;
LINNUM2=LINENO;
POP;
END
LINNUM2=MAX(LINNUM2,LINNUM1+1);
LINNUM2=MIN(LINNUM2,NINES+1);
LCOUNT=MIN(LIMIT,ABS(LINPTR2-LINPTR1)+1); # NEEDED #
GETLNUM;
IF LINNUM1 GR LINENO THEN # USER SPECIFIED START #
BEGIN
IF LCOUNT GR LINNUM2-LINNUM1
THEN ERRJUMP("NOT ENOUGH ROOM FOR INSERTION$");
INCR=(LINNUM2-LINNUM1)/LCOUNT;
INCR=MAX(INCR,1);
INCR=MIN(INCR,DINCR);
LINENO=LINNUM1-INCR;
END
ELSE # COMPUTED START #
BEGIN
IF LCOUNT GQ LINNUM2-LINNUM1
THEN ERRJUMP("NOT ENOUGH ROOM FOR INSERTION$");
INCR=(LINNUM2-LINNUM1)/(LCOUNT+1);
INCR=MAX(INCR,1);
INCR=MIN(INCR,DINCR);
LINENO=LINNUM1;
END
END
IOEND # OF FITNUM #
PROC SPLICE;
IOBEGIN(SPLICE)
#
** SPLICE - SPLICE PORTIONS OF LINES IN WORKFILE.
*
* SPLICE CONCATENATES TWO ADJACENT LINES IN THE FILE. THIS
* ROUTINE IS DESIGNED TO BE EXECUTED AFTER DORANGE PROCESSING,
* AS IT NO-OPS FOR ONE-LINE RANGES. IT ALSO DELETES IN THE
* CASE THAT THE SPLICED LINE PAIR IS OF ZERO LENGTH.
*
* ENTRY LIN - LINE IMAGE FOR SECOND LINE.
* CURFILE, CURRENT - ADDRESS OF SECOND LINE.
* CHRPTR3 - IGNORED.
* FIRSTRANGE, LASTRANGE - WHETHER AT BOUNDS OF RANGE.
* (AS LEFT OVER FROM DORANGE)
*
* EXIT CHRPTR3 - UNCHANGED.
*
* CALLS BAKZ, PUSHTEMP, POPTEMP, DOJOIN, DELX, LENGTH.
*
* USES (WITH RESTORATION) - TEMP, CHRPTR3.
#
IF NOT (FIRSTRANGE AND LASTRANGE) THEN
BEGIN # MULTIPLE STUBS TO MERGE #
BAKZ; # TO CUT-DOWN FIRST LINE #
PUSHTEMP;
TEMP=CHRPTR3;
CHRPTR3=0; # ASSURE DOJOIN IS SIMPLE #
DOJOIN(0); # ADD ON CUT-DOWN LAST LINE #
CHRPTR3=TEMP; # RESTORE CHRPTR3 #
POPTEMP;
END
# DELETE MERGED LINE-PAIR IFF TOTALLY CUT DOWN #
IF LENGTH(LIN) EQ 0 THEN
BEGIN
DELX;
IF CURRENT GR TOPF(CURFILE) THEN BAKZ;
END
IOEND # OF SPLICE #
PROC MAKEPAGE(PAGSIZ,FILEPARM); # COMPUTE PAGE BOUNDARIES #
BEGIN
#
** MAKEPAGE - COMPUTE BOUNDS FOR SECTION OF FILE.
*
* MAKEPAGE IS USED BY THE VIEW COMMAND IN LINE MODE TO
* DETERMINE THE SECTION OF THE FILE TO BE PRINTED, BASED
* ON RECENT USAGE OF VIEW COMMANDS. THE SCANNER IS CALLED
* BEFORE MAKEPAGE.
*
* ENTRY LINCTR - NOMINAL ADDRESS TO PRINT.
* PAGSIZ - DESIRED SIZE OF VIEW AREA.
* FILEPARM - WHICH FILE BRACKET.
* FORWARD, BACKWARD - FROM SCANNER.
* PAGELAST - WHETHER LAST COMMAND WAS VIEW ALSO.
* REGLINE[RNGTOPREG], REGLINE[RNGBOTREG] - LAST RANGE
* PRINTED IF PAGELAST IS TRUE.
*
* EXIT LINPTR1, LINPTR2 - COMPUTED BOUNDARIES.
* LINCTR - FORCED TO FIT IF NOT ALREADY.
*
* CALLS WINDOLIN.
#
ITEM PAGSIZ, FILEPARM;
IF FORWARD THEN
BEGIN
IF PAGELAST THEN LINPTR1=REGLINE[RNGBOTREG];
ELSE LINPTR1=LINCTR;
END
ELSE IF BACKWARD THEN
BEGIN
IF PAGELAST THEN LINPTR1=REGLINE[RNGTOPREG]-PAGSIZ+1;
ELSE LINPTR1=LINCTR-PAGSIZ+1;
END
ELSE LINPTR1=LINCTR-(PAGSIZ/2);
WINDOLIN(LINPTR1,FILEPARM); # TO KEEP IN BOUNDS #
LINPTR2=LINPTR1+PAGSIZ-1;
WINDOLIN(LINPTR2,FILEPARM); # TO KEEP IN BOUNDS #
IF LINCTR LS LINPTR1 OR LINCTR GR LINPTR2 THEN
BEGIN
IF BACKWARD THEN LINCTR=LINPTR1;
ELSE LINCTR=LINPTR2;
END
WINDOLIN(LINCTR,FILEPARM); # MERELY AS STANDARD FOR CMD SKIP #
END # OF MAKEPAGE #
PROC SETMARK(POSITION,CURSOR);
BEGIN # START OF SETMARK #
#
** SETMARK - SET BOTH OR SECOND MARKER REGISTERS.
*
* SETMARK IS CALLED TO SET MARKER REGISTERS. IF NO OR BOTH
* MARKERS ARE ALREADY FILLED, WE START OVER AND SET THE
* FIRST ONE. IF THE FIRST HAS BEEN PREVIOUSLY SET, WE
* SET THE SECOND ONE. IF THE FILE ASSOCIATION HAS CHANGED
* BETWEEN SETTING THE FIRST AND SECOND, WE START OVER AND
* SET THE FIRST ONE. ANY TIME WE SET THE FIRST ONE, WE
* ALSO DEFAULT THE SECOND ONE TO MATCH THE FIRST.
*
* ENTRY POSITION - LINE ADDRESS TO MARK.
* CURSOR - HORIZONTAL CURSOR POSITION TO MARK.
* NUMMARKS - NUMBER OF PREVIOUS MARKS.
* CURFILE - FILE BRACKET FOR POSITION AND CURSOR.
* FDLF(CURFILE) - SETUP.
* MRKFILE[0] - SETUP IF NUMMARKS IS ONE.
*
* EXIT NUMMARKS - UPDATED.
* REGLINE[MARKREG] - SETUP IF FIRST MARK SET.
* REGLINE[MARKREG+1] - SETUP IF SECOND MARK SET.
* MRKFILE[1-2] - SETUP.
* MRKCHAR[1-2] - SETUP.
*
* CALLS PAINTMARKS.
#
ITEM POSITION, CURSOR;
IF (NUMMARKS GQ 2) OR
(NUMMARKS EQ 1 AND MRKFILE[0] NQ FDLF(CURFILE)) THEN
BEGIN
PAINTMARKS(3);
NUMMARKS=0;
END
REGLINE[MARKREG+NUMMARKS]=POSITION;
REGLINE[MARKTOP+NUMMARKS]=TOPF(CURFILE);
MRKFILE[NUMMARKS]=FDLF(CURFILE);
MRKCHAR[NUMMARKS]=CURSOR;
NUMMARKS=NUMMARKS+1;
IF NUMMARKS EQ 2 THEN
BEGIN
IF REGLINE[MARKREG] GR POSITION
OR (REGLINE[MARKREG] EQ POSITION AND MRKCHAR[0] GR CURSOR) THEN
BEGIN
REGLINE[MARKREG] = = REGLINE[MARKREG+1];
REGLINE[MARKTOP] = = REGLINE[MARKTOP+1];
MRKFILE[0] = = MRKFILE[1];
MRKCHAR[0] = = MRKCHAR[1];
END
END
ELSE
BEGIN
REGLINE[MARKREG+1]=REGLINE[MARKREG];
REGLINE[MARKTOP+1]=REGLINE[MARKTOP];
MRKFILE[1]=MRKFILE[0];
MRKCHAR[1]=MRKCHAR[0];
END
PAINTMARKS(1);
END # OF SETMARK #
PROC FORCEFILE;
IOBEGIN(FORCEFILE)
#
** FORCEFILE - GET FILE INTO SOME BRACKET.
*
* FORCE FILE SPECIFIED BY READNAM TO BE OPEN FOR SYNTAX
* SCANNERS WHICH NEED TO STUDY ITS BRACKETING. RETURN
* FILNUM AS THE BRACKET IN WHICH THE FILE IS OPEN. WE USE
* CURFILE AS THE BRACKET ONLY IF THE CURRENT FILE IS ONE AND
* THE SAME AS THE REQUESTED FILE. IN ALL OTHER CASES WE USE
* THE OPPOSITE BRACKET NUMBER.
*
* ENTRY CURFILE - BRACKET WHICH CANNOT BE DISTURBED.
* READNAM - FILE WE MUST GET OPENED.
*
* EXIT FILNUM - THE BRACKET INTO WHICH READNAM IS OPEN.
*
* CALLS PUSH, OPENFILE, POP.
*
* USES CHARPARM, GETPARM.
#
FILNUM=CURFILE;
IF READNAM EQ PADNAME(FILENAM[FILNUM]) THEN IORET
FILNUM=FILNUM LXR 3; # FLIP BRACKET AND RESCAN #
IF READNAM NQ PADNAME(FILENAM[FILNUM]) THEN
BEGIN # OPEN INTO OTHER BRACKET #
CHARPARM=0;
GETPARM=0;
PUSH;
OPENFILE;
POP;
END
IOEND # OF FORCEFILE #
PROC REL2ABS(LINEPTR,FILEPTR);
BEGIN
#
** REL2ABS - CONVERT RELATIVE LINE ADDRESS TO ABSOLUTE.
*
* REL2ABS TAKES A LINE ADDRESS WHICH IS RELATIVE TO ITS
* WORKFILE FILE IMAGE, AND CONVERTS TO AN ABSOLUTE WORKFILE
* LINE ADDRESS, FOR ONE OF THE CURRENTLY BRACKETED FILES.
*
* ENTRY LINEPTR - RELATIVE LINE ADDRESS.
* FILEPTR - WHICH BRACKET.
* CURFILE - WHICH BRACKET IF FILEPTR IS ZERO.
* TOPF() - SETUP.
*
* EXIT LINEPTR - CONVERTED.
#
ITEM LINEPTR, FILEPTR;
IF LINEPTR LS 0 THEN RETURN;
IF FILEPTR EQ 0 THEN LINEPTR=LINEPTR+TOPF(CURFILE);
ELSE LINEPTR=LINEPTR+TOPF(FILEPTR);
END # OF REL2ABS #
PROC CHECKFILPTR;
IOBEGIN(CHECKFILPTR)
#
** CHECKFILPTR - CONVERT DIRECTORY ADDRESS TO BRACKET.
*
* CHECKFILPTR CONVERTS (MATCHES) A FILE DIRECTORY LINE
* ADDRESS INTO A BRACKET NUMBER. IT IS A NO-OP FOR
* ANY PARAMETER VALUE OF ZERO. IT OPENS THE FILE INTO
* THE NON-CURRENT BRACKET IF NOT ALREADY BRACKETED.
*
* ENTRY FILPTR1 - FDLF POINTER OR ZERO.
* FDLF(1-2) - SETUP.
* CURFILE - CURRENT (NON-PREFERRED) BRACKET.
*
* EXIT FILPTR1 - CONVERTED TO BRACKET ORDINAL.
*
* CALLS PUSH, POSZ, SCANFDL, FORCEFILE, POP.
*
* USES READNAM, FILNUM.
#
IF FILPTR1 EQ 0 THEN IORET
ELSE IF FILPTR1 EQ FDLF(1) AND FILPTR1 EQ FDLF(2)
THEN FILPTR1=CURFILE;
ELSE IF FILPTR1 EQ FDLF(1) THEN FILPTR1=1;
ELSE IF FILPTR1 EQ FDLF(2) THEN FILPTR1=2;
ELSE
BEGIN
PUSH;
POSZ(FILPTR1);
SCANFDL(READNAM);
FORCEFILE;
FILPTR1=FILNUM;
POP;
END
IOEND # OF CHECKFILPTR #
PROC EXTENDFILE(BOOL);
BEGIN
#
* EXTENDFILE - EXTEND FILE FOR INSERT/COPY/MOVE.
*
* ENTRY EXTENDSIZE - HOW MUCH CURSOR BEYOND END OF FILE.
* PROCESSNDX - WHETHER/WHICH INSERT/COPY/MOVE.
* BOTF(FILNUM), FILNUM - END OF FILE.
* LINPTR1, LINPTR2 - RANGE BOUNDARIES.
* BOOL - WHETHER LINPTR1, LINPTR2 SHOULD RELOCATE.
*
* EXIT EXTENDSIZE - ZERO IF FILE EXTENDED.
* THISEXTEND - FORMER VALUE OF EXTENDSIZE.
* LINPTR1, LINPTR2, BOTF(FILNUM) - RELOCATED.
*
* CALLS INSX, POSZ.
*
* USES CURFILE(RESTORED).
*
* NOTE EXTENDFILE IS OPERATIVE ONLY IN SINGLE USER VERSION.
* FOR MULTI, SCANNER MUST ASSURE THIS IS NO-OP.
#
ITEM BOOL B;
CONTROL IFEQ SINGLE,1;
IF EXTENDSIZE GR 0 THEN
BEGIN
IF PROCESSNDX EQ KEYST"CCMD" OR PROCESSNDX EQ KEYST"ICMD"
OR PROCESSNDX EQ KEYST"MCMD" THEN
BEGIN # EXTEND FILE TO TARGET #
CURFILE = = FILNUM; # PRESERVE AND FLIPFLOP #
POSZ(BOTF(CURFILE)-1);
LINE[0]=NULLIN;
FOR LINCTR=1 STEP 1 UNTIL EXTENDSIZE DO
BEGIN # EXTEND FILE TO TARGET ADDR #
# MANUALLY RELOCATE LINPTR1, LINPTR2 AS NEEDED #
IF BOOL THEN
BEGIN
IF CURRENT LS LINPTR1 THEN LINPTR1=LINPTR1+1;
IF CURRENT LS LINPTR2 THEN LINPTR2=LINPTR2+1;
END
INSX; # EXTEND FILE #
END
CURF(CURFILE)=CURRENT;
THISEXTEND=EXTENDSIZE;
EXTENDSIZE=0;
CURFILE = = FILNUM;
END
END
CONTROL FI;
END # OF EXTENDFILE #
PAGE # TOKEN -- SCANS COMMAND SYNTAX #
PROC TOKEN;
BEGIN
#
** TOKEN - LOOK FOR NEXT SYNTAX ELEMENT.
*
* TOKEN SCANS THE COMMAND TEXT FROM SOME CURRENT POSITION
* UNTIL SOMETHING IS SEEN. WE EAT BLANKS, AND MUST
* EVENTUALLY REACH SOME DELIMITER OR A CONSTANT (INTEGER) OR
* A KEYWORD. IF IT IS A CONSTANT, WE DECODE ITS WHOLE VALUE
* AND LEAVE THE CURRENT POSITION JUST AFTER THE LAST DIGIT.
* IF IT IS A KEYWORD, WE GATHER UP ITS WHOLE TEXT, LEAVE THE
* CURRENT POSITION JUST AFTER THE LAST LETTER, AND SEARCH
* THE COMMAND TABLES FOR A MATCH, SETTING VARIOUS VARIABLES
* TO SHOW THE RESULT OF THE MATCH.
*
* WE ARE CALLED BY THE OUTER LOGIC OF PROCESS TO GLEAN OUT
* COMMAND KEYWORDS. WE ARE CALLED BY ALL SORTS OF PEOPLE,
* INCLUDING A VARIETY OF COMMAND PROCESSING ROUTINES, TO
* ADVANCE THE SYNTAX SCAN TO COMPLETE THE COMMAND.
*
* ENTRY SCANPOS - WHERE TO SCAN IN CMDLIN.
* CMDLIN - COMMAND TEXT, INTERNAL LINE IMAGE.
* SEARCHTYPE - WHICH IF ANY KEYWORD TABLE TO MATCH.
*
* EXIT TOKENPOS - WHERE WE FOUND SOMETHING.
* TOKENTYPE - CLASSIFICATION OF TOKEN.
* TOKENVAL - BINARY VALUE IF NUMERIC.
* TOKENSYM - KEYWORD IF ALPHA.
* TOKENCHAR - FIRST OR ONLY CHARACTER OF TOKEN.
* TOKENLEN - NUMBER OF CHARACTERS IN TOKEN.
* KEYWDNDX - WHICH KEYWORD MATCHED IT.
* SCANPOS - INCREMENTED BEYOND TOKEN.
* CMDLIN - ANY MICROS ARE EXPANDED.
*
* MACROS GETCHAR.
*
* CALLS LENGTH, EXPAND, DSPLCOD.
#
ITEM TMP1, TMP2, TMP3;
ITEM QUIT B;
ITEM CMDLEN;
# TOKENSW MUST MATCH TYPST #
SWITCH TOKENSW TKDIGIT, TKPLUS, TKMINUS, TKDELIMIT,
TKCOLON, TKPAREN,
TKEQUAL, TKLETTER, TKSEMI, TKEOL, TKOTHER, TKCONTROL;
# ALPHANUM MUST MATCH KEYWDTYPE VALUES #
ITEM ALPHANUM=O"42000000000000000000"; # WHICH TYPES ALLOW DIGITS #
PAGE # START OF TOKEN #
TOKENSTART: # FIRST EAT ANY BLANKS #
CMDLEN=LENGTH(CMDLIN);
GETCHAR(CMDLINE,SCANPOS,TMP1);
WHYLE TMP1 EQ CBLANK DO
BEGIN
SCANPOS=SCANPOS+1;
GETCHAR(CMDLINE,SCANPOS,TMP1);
END
# EAT ONE COMMA #
IF TMP1 EQ CCOMMA THEN SCANPOS=SCANPOS+1;
GETCHAR(CMDLINE,SCANPOS,TMP1);
WHYLE TMP1 EQ CBLANK DO # EAT ADDITIONAL BLANKS #
BEGIN
SCANPOS=SCANPOS+1;
GETCHAR(CMDLINE,SCANPOS,TMP1);
END
# SET UP TOKEN DESCRIPTORS #
# DISPATCH FOR TOKEN #
TOKENPOS=SCANPOS;
TOKENCHAR=TMP1;
IF SCANPOS GQ CMDLEN OR TMP1 EQ CCOMMA THEN TOKENCHAR=CENDLINE;
TOKENTYPE=TYPE[TOKENCHAR];
SCANPOS=SCANPOS+1;
GOTO TOKENSW[TOKENTYPE];
# END-OF-LINE AND NULL CASES #
TKEOL: TKEQUAL: TKPLUS: TKSEMI:
TKCOLON: TKDELIMIT: TKPAREN:
TKOTHER: TKCONTROL:
RETURN;
TKMINUS: # HYPHEN IS SELF IF ALONE, COMMENT IF DOUBLE #
GETCHAR(CMDLINE,TOKENPOS+1,TMP1);
IF TMP1 EQ CMINUS THEN
BEGIN
TOKENTYPE=TYPST"EOL";
TOKENCHAR=CENDLINE;
TOKENPOS=LENGTH(CMDLIN);
SCANPOS=TOKENPOS;
END
RETURN;
# NUMERIC CONSTANT #
TKDIGIT:
IF B<KEYWDTYPE,1>ALPHANUM NQ 0 THEN GOTO TKLETTER;
TOKENVAL=TOKENCHAR-CDIGIT0;
QUIT=FALSE;
WHYLE NOT QUIT DO
BEGIN
GETCHAR(CMDLINE,SCANPOS,TMP1);
IF TYPE[TMP1] EQ TYPST"DIGIT" AND SCANPOS-TOKENPOS LQ 10 THEN
BEGIN
TOKENVAL=TOKENVAL*10+TMP1-CDIGIT0;
SCANPOS=SCANPOS+1;
END
ELSE QUIT=TRUE;
END
RETURN;
# ALPHABETIC KEYWORD #
TKLETTER:
# GATHER UP KEYWORD, SUPPRESS CASE AND USE REGULAR CHAR #
TMP1=TOKENCHAR;
TOKENLEN=0;
QUIT=FALSE;
WHYLE NOT QUIT DO
BEGIN
DSPLCOD(TMP1);
IF TOKENLEN LS 10 THEN
BEGIN
C<TOKENLEN,10-TOKENLEN>TOKENSYM=C<9,1>TMP1;
TOKENLEN=TOKENLEN+1;
END
GETCHAR(CMDLINE,SCANPOS,TMP1);
IF TYPE[TMP1] NQ TYPST"LETTER" THEN
BEGIN
IF TYPE[TMP1] NQ TYPST"DIGIT" OR
B<KEYWDTYPE,1>ALPHANUM EQ 0 THEN
BEGIN
QUIT=TRUE;
TEST;
END
END
SCANPOS=SCANPOS+1;
END
# KEYWORD SEARCH #
KEYWDNDX=-1;
IF KEYWDTYPE EQ 0 THEN RETURN;
MATCHKEY(TMP3);
IF KEYWDNDX LS 0 THEN RETURN;
TMP3=MIN(TMP3,TOKENLEN);
SCANPOS=TOKENPOS+TMP3;
TOKENLEN=TMP3;
END # OF TOKEN #
PAGE # SCANNER - UNIVERSAL SYNTAX DRIVER #
PROC SCANNER;
IOBEGIN(SCANNER)
#
** SCANNER - MASTER COMMAND SYNTAX SCANNER/DEFAULTER.
*
* SCANNER DRIVES ALL SYNTAX SCANNING FOR THOSE COMMANDS
* WHICH HAVE FAIRLY STANDARD SYNTACTICAL RULES AND SEMANTIC
* ELEMENTS. THIS CATEGORY OF COMMANDS INCLUDES ALL WHICH
* USE RANGES, LINES, POSITIONS, LIMITS, AND TABS. OTHER
* SYNTAXES SUPPORTED BY SCANNER INCLUDE "FORWARD" AND
* "BACKWARD" KEYWORD, I.E., DIRECTION/DEFAULT-RANGE, AND
* CHARACTER STRINGS. ON THE OTHER HAND, SCANNER IS NOT
* DESIGNED TO SUPPORT PARSING OF COMMANDS SUCH AS "SET"
* WHICH REQUIRE SPECIAL KEYWORDS, ARBITRARY SYMBOL NAMES, OR
* INTEGER PARAMETERS.
*
* SCANNER OPERATES AS A LOOP UNTIL END OF COMMAND LINE OR
* END OF COMMAND DELIMITER (SEMICOLON), BRANCHING OUT ON A
* CASE STATEMENT FOR EACH TOKEN ENCOUNTERED. VARIOUS SCAN
* SUBROUTINES ARE USED HEAVILY.
*
* ENTRY COMMAND VERB SCANNED, TOKEN ADVANCED.
* TOKENPOS - SETUP.
* THE FOLLOWING MUST BE DEFAULTED BY CALLER -
* NONDEFAULT, TXTINCMD, BACKWARD, FORWARD,
* FOUND, CURRENT, CURFILE, CURSPLIT.
* LIMIT - DEFAULT LIMIT COUNT. USUALLY -1 TO SHOW
* THAT NORMAL DEFAULTS CAN APPLY. CAN ALSO BE
* -2 TO SHOW NO DEFAULTS TO BE SUPPLIED.
* WHICHLIN - WHICH LINE POINTER VARIABLE EXPECTED.
* WHICHSTR - WHICH STRING VARIABLE EXPECTED.
* CURCURSOR, OLDCURSOR - RESIDUAL CURSOR POSITIONS.
* OLDLINPTR - RESIDUAL LINE POINTER.
* EXECNDX - WHICH COMMAND WE ARE PROCESSING.
* NUMMARKS - HOW MANY MARKS ARE AVAILABLE.
* SCREENMODE - WHETHER SCREEN OR LINE.
* TOPF(), TOPS(), BOTS(), ASCII[] - SETUP.
* BOTF(), FDLF() - SETUP.
*
* EXIT LINPTR1,2,3 - SOURCE AND TARGET ADDRESSES.
* FILPTR1,2,3 - SOURCE AND TARGET FILE BRACKETS.
* CHRPTR1,2,3 - SOURCE AND TARGET CURSORS.
* LINNUM1,2,3 - SOURCE AND TARGET SEQUENCES.
* LIMIT - REPEAT COUNT. UNCHANGED IF NO EXPLICIT SYNTAX
* AND DEFAULT WAS -2.
* SCANBLOCK, SCANWORD, SCANUPPER - SPECIAL OPTIONS.
* SCANHOME - SPECIAL OPTION.
* NONDEFAULT - TRUE IF SOMETHING SCANNED.
* SCANPOS - ADVANCED BEYOND LAST RECOGNIZABLE SYNTAX.
* BACKWARD, FORWARD - POSSIBLY SET.
* CHARRANGE - CHARACTER/LINE RANGE BOUNDS.
* TXTINCMD - POSSIBLY TRUE.
* FOUND - WHETHER SOURCE/TARGET IN BOUNDS.
* FDLF(1-2) - DIFFERENT FILES MAY BE OPEN.
* CURFILE - FILE TO PROCESS FOR SOURCE RANGE.
* PROMPTING - POSSIBLY SET.
* LOCSTRING1, LOCSTRING2, CHGSTRING, TTYLIN - POSSIBLY
* FILLED WITH CHARACTER STRINGS IN INTERNAL FORMAT.
* TABVECTOR - POSSIBLY REDEFINED.
* FIELDNDX, FIELDFLG, FIELDTARGET - POSSIBLY SET.
* NUMMARKS - POSSIBLY CLEARED.
* EXECNDX - CERTAIN CHANGES POSSIBLE.
*
* USES ALL TOKENXXXX VARIABLES, WHICHLIN, WHICHDGT, WHICHSTR,
* FILNUM, FORCEFIELD, READNAM, FOUNDOTHER.
*
* CALLS TOKEN, SCNTAB, MAX, SCNLIN, ERRJUMP, SCANSTR,
* SCNFILE, FORCEFILE, GETMARK, PAINTMARKS, SCNEOC,
* CHECKFILPTR, REL2ABS, WINDOPOS, WINDOLIN, SQUELCH.
#
XREF LABEL QQSINGLE;
# SCANSW MUST MATCH TYPST #
SWITCH SCANSW SCDIGIT, SCPLUS, SCMINUS, SCDELIMIT,
SCCOLON,
SCPAREN, SCEQUAL, SCALPHA,
SCSEMI, SCEOL, SCOTHER, SCCTRL;
# KEYMATCH ARRAY MUST MATCH SECTION OF KEYSTR TABLE #
# MUST ALSO MATCH SCANKEYSW. #
DEF NUMSCANKEYS #20#;
ARRAY MATCHKEYS [0:NUMSCANKEYS]; ITEM KEYMATCH C(0,0,10) = [
"ALL", "BLANK", "CURRENT", "END", "FIRST", "HOME",
"IN", "LAST", "MARK", "NEXT", "PREVIOUS", "QUIET",
"REPEAT", "SCREEN", "TO", "UPPER", "WORD", "X", "Y", "Z" ];
SWITCH SCANKEYSW SKALL, SKBLOCK, SKCURRENT, SKEND, SKFIRST,
SKHOME, SKIN, SKLAST, SKMARK, SKNEXT, SKPREVIOUS, SKQUIET,
SKREPEAT, SKSCREEN, SKTO, SKUPPER, SKWORD, SKX, SKY, SKZ;
# FOLLOWING TEMPORARIES MUST BE USED ONLY INSTANTANEOUSLY #
ITEM TMP1, TMP2, BOOL B;
PROC GETMARK(WHICH,LINPARM,FILPARM,CHRPARM);
BEGIN
#
** GETMARK - GET DATA FOR A MARKER.
*
* ENTRY WHICH - WHICH MARKER, 1 OR 2.
*
* EXIT LINPARM, FILPARM, CHRPARM - MARKER VALUES.
* CHARRANGE - FORCED TRUE AS NEEDED.
#
ITEM WHICH, LINPARM, FILPARM, CHRPARM;
LINPARM=REGLINE[MARKREG-1+WHICH]-REGLINE[MARKTOP-1+WHICH];
FILPARM=MRKFILE[WHICH-1];
CHRPARM=MRKCHAR[WHICH-1];
IF CHRPARM GQ 0 THEN CHARRANGE=TRUE;
END # OF GETMARK #
PAGE # SCANNER - MAIN CODE #
CHRPTR1=-1;
CHRPTR2=-1;
CHRPTR3=-1;
LINPTR1=-1;
LINPTR2=-1;
LINPTR3=-1;
FILPTR1=0;
FILPTR2=0;
FILPTR3=0;
LINNUM1=-1;
LINNUM2=-1;
LINNUM3=-1;
SCANBLOCK=FALSE;
SCANWORD=FALSE;
SCANUPPER=FALSE;
SCANHOME=FALSE;
SCANMARK = FALSE;
SCANSFILE = FALSE;
SCANTO = FALSE;
SCNLINX = FALSE;
SCNLINY = FALSE;
SCNLINZ = FALSE;
SCNONCE = FALSE;
SCHSTRSPEC=FALSE;
WHICHDGT=WHICHLIN;
KEYWDTYPE=2;
SCANPOS=TOKENPOS;
FORCEFIELD=FALSE;
FIELDTARGET=0;
# FILE EXTENSION IS ONLY ALLOWED IN SINGLE USER VERSION #
# FOR THREE SPECIFIC COMMAND TYPES #
IF EXTENDSIZE NQ 0 THEN
BEGIN
IF OKEXTEND[PROCESSNDX] THEN
BEGIN
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
END
ELSE
BEGIN
EXTENDSIZE=0;
END
END
PAGE # MAIN SCANNER LOOP STARTS HERE #
SCANTOKEN:
TOKEN;
SCANLOOP:
GOTO SCANSW[TOKENTYPE];
SCDIGIT:
IF WHICHDGT EQ DIGITST"LIMIT" THEN
BEGIN
LIMIT=MAX(TOKENVAL,1);
NONDEFAULT=TRUE;
TOKEN;
WHICHDGT=WHICHLIN;
END
ELSE SCNLIN;
GOTO SCANLOOP;
SCPLUS: SCMINUS:
SCNLIN;
GOTO SCANLOOP;
SCCOLON:
WHICHLIN=2;
WHICHDGT=2;
GOTO SCANTOKEN;
SCPAREN:
SCNLIN;
GOTO SCANLOOP;
SCDELIMIT:
IF WHICHSTR LQ 0 THEN ERRJUMP("STRING NOT ALLOWED$");
IF NOT FORCEFIELD THEN
BEGIN
FIELDFLG=FALSE; FIELDNDX=0;
END
SCANSTR;
GOTO SCANLOOP;
SKALL:
IF WHICHDGT EQ DIGITST"LIMIT" THEN
BEGIN
LIMIT=LARGENUM;
TOKEN;
END
ELSE
BEGIN
IF LINPTR1 NQ -1 OR LINPTR2 NQ -1 THEN
BEGIN
ERRJUMP("ONLY ONE RANGE ALLOWED$");
END
FILNUM=CURFILE;
TOKEN;
IF TOKENTYPE EQ TYPST"PAREN" THEN
BEGIN
SCNFILE(READNAM);
SCANSFILE = TRUE; # NOTE THAT WE HAVE SCANNED #
FORCEFILE;
END
LINPTR1=1;
LINPTR2=BOTF(FILNUM)-1-TOPF(FILNUM);
FILPTR1=FDLF(FILNUM);
WHICHLIN=3;
WHICHDGT=WHICHLIN;
NONDEFAULT=TRUE;
END
GOTO SCANLOOP;
SKBLOCK:
SCANBLOCK=TRUE;
GOTO SCANTOKEN;
SKEND:
IF OKEND[PROCESSNDX] THEN EXECNDX=EXECST"APPEND";
ELSE ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
GOTO SCANTOKEN;
SKHOME:
IF OKHOME[PROCESSNDX] THEN SCANHOME=TRUE;
ELSE ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
GOTO SCANTOKEN;
SKPREVIOUS:
IF OKMOVE[PROCESSNDX] AND WHICHLIN GR 3 THEN
BEGIN
# NOTE "TO PREVIOUS" IS A SPECIAL CASE FOR COPY/MOVE WITH NO #
# ADDITIONAL SYNTAX ALLOWED, AND SEMANTICS DETERMINED BY #
# CHARACTER VERSUS LINE BOUNDARIES FOR SOURCE RANGE #
IF NOT CHARRANGE THEN
BEGIN
FILNUM=CURFILE;
EXTENDFILE(FALSE);
LINPTR3=CURRENT-TOPF(CURFILE)-1;
END
END
ELSE
BEGIN
IF FORWARD OR BACKWARD THEN ERRJUMP("ONLY ONE RANGE ALLOWED$");
WHICHDGT=DIGITST"LIMIT";
NONDEFAULT=TRUE;
IF LIMIT EQ -1 THEN LIMIT=1;
BACKWARD=TRUE;
FORWARD=FALSE;
END
GOTO SCANTOKEN;
SKCURRENT: SKFIRST: SKLAST: SKX: SKY: SKZ:
# NOTE SCNLIN CAN ENABLE CHARRANGE FOR X,Y,Z #
SCNLIN;
GOTO SCANLOOP;
SKMARK:
SCANMARK = TRUE;
IF CMDWASDLTE[0] THEN
BEGIN # IF COMMAND WAS "DELETE" #
KILLMARKS = TRUE; # KILL THE MARKS #
FORCEAUTOP[0] = FALSE;
FORCEAUTOR[0] = FALSE;
END
IF NUMMARKS NQ 0 THEN
BEGIN
# NOTE GETMARK ROUTINE CAN ENABLE CHARRANGE #
IF WHICHLIN EQ 3 THEN GETMARK(1,LINPTR3,FILPTR3,CHRPTR3);
ELSE
BEGIN
GETMARK(1,LINPTR1,FILPTR1,CHRPTR1);
GETMARK(2,LINPTR2,FILPTR2,CHRPTR2);
END
NONDEFAULT=TRUE;
NUMMARKS = 2;
END
WHICHLIN=3;
WHICHDGT=WHICHLIN;
IF NOT FORCEFIELD THEN
BEGIN # IF NO *IN* OPTION ON THIS COMMAND #
FIELDNDX = 0; # ELIMINATE TAB FIELD RESTRICTION #
FIELDFLG = FALSE;
END
GOTO SCANTOKEN;
SKNEXT:
IF OKMOVE[PROCESSNDX] AND WHICHLIN GR 3 THEN
BEGIN
# NOTE "TO NEXT" IS A SPECIAL CASE FOR COPY/MOVE WITH NO #
# ADDITIONAL SYNTAX ALLOWED, AND SEMANTICS DETERMINED BY #
# CHARACTER VERSUS LINE BOUNDARIES FOR SOURCE RANGE #
IF NOT CHARRANGE THEN
BEGIN
FILNUM=CURFILE;
EXTENDFILE(FALSE);
LINPTR3=CURRENT-TOPF(CURFILE);
END
END
ELSE
BEGIN
IF FORWARD OR BACKWARD THEN ERRJUMP("ONLY ONE RANGE ALLOWED$");
WHICHDGT=DIGITST"LIMIT";
IF LIMIT EQ -1 THEN LIMIT=1;
FORWARD=TRUE;
BACKWARD=FALSE;
NONDEFAULT=TRUE;
END
GOTO SCANTOKEN;
SKQUIET:
DONTPRINT=TRUE;
GOTO SCANTOKEN;
SKREPEAT:
NONDEFAULT=TRUE;
IF LIMIT EQ -1 THEN LIMIT=1;
WHICHDGT=DIGITST"LIMIT";
GOTO SCANTOKEN;
SKSCREEN:
IF LINPTR1 NQ -1 OR LINPTR2 NQ -1 THEN
BEGIN
ERRJUMP("ONLY ONE RANGE ALLOWED$");
END
IF SCREENMODE THEN
BEGIN
LINPTR1=TOPS(CURSPLIT)+1-TOPF(CURFILE);
LINPTR2=BOTS(CURSPLIT)-1-TOPF(CURFILE);
IF WHICHLIN GQ 3 THEN
BEGIN
LINPTR3=LINPTR2;
IF BACKWARD THEN LINPTR3=LINPTR1;
END
NONDEFAULT=TRUE;
DONTPRINT=TRUE;
END
ELSE ERRJUMP("SCREEN MODE REQUIRED$");
WHICHLIN=3;
WHICHDGT=WHICHLIN;
GOTO SCANTOKEN;
SKIN:
WHICHDGT=DIGITST"TAB";
TOKEN; # ADVANCE NEXT SYNTAX #
SCNTAB; # ANALYZE AND SET *IN* MARGINS #
GOTO SCANLOOP;
SKTO:
IF NOT OKTARGET[PROCESSNDX] THEN
BEGIN
ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
END
SCANTO = TRUE;
SCNONCE = FALSE;
WHICHLIN=4;
WHICHDGT=WHICHLIN;
NONDEFAULT=TRUE;
GOTO SCANTOKEN;
SKWORD:
SCANWORD=TRUE;
GOTO SCANTOKEN;
SKUPPER:
SCANUPPER=TRUE;
IF NOT OKUPPER[PROCESSNDX] THEN
BEGIN
ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
END
GOTO SCANTOKEN;
SCALPHA:
FOR TMP1=0 STEP 1 WHILE KEYWDNDX GQ 0 AND TMP1 LQ NUMSCANKEYS DO
BEGIN
IF KEYMATCH[TMP1] EQ KEYWORD[KEYWDNDX]
THEN GOTO SCANKEYSW[TMP1];
END
ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
SCSEMI: SCEOL: SCOTHER: SCCTRL: SCEQUAL:
# VERIFY END OF SYNTAX #
SCNEOC;
# VERIFY SOURCE RANGE WITHIN ONE FILE, AND CONVERT FILE SELECTIONS #
# FROM FILE DIRECTORY IDS INTO OPEN BRACKET ORDINALS #
IF FILPTR2 NQ 0 THEN
BEGIN
IF FILPTR1 NQ 0 AND FILPTR1 NQ FILPTR2
THEN ERRJUMP("RANGE MUST BE IN SAME FILE$");
FILPTR1=FILPTR2;
END
CHECKFILPTR; # CONVERT FILPTR1 #
FILPTR2=FILPTR1; # AND FILPTR2 ALSO #
# VERIFY THAT BOTH FILES FOR A DUAL-FILE OPERATION CAN BE #
# OPENED INTO THE TWO BRACKETS, AND CONVERT TARGET FILE SELECTION #
# FROM FILE DIRECTORY ID INTO OPEN BRACKET ORDINAL #
IF FILPTR1 NQ 0 AND FILPTR3 NQ 0 AND FILPTR1 NQ FILPTR3
THEN CURFILE=FILPTR1; # ASSURE NEEDED FILES AVAIL #
FILPTR1 = = FILPTR3;
CHECKFILPTR; # CONVERT FILPTR3 #
FILPTR3 = = FILPTR1;
IF FILPTR3 EQ 0 THEN FILPTR3=CURFILE;
# CONVERT LINPTRS TO ABSOLUTE WORKFILE ORDINALS #
REL2ABS(LINPTR1,FILPTR1);
REL2ABS(LINPTR2,FILPTR2);
REL2ABS(LINPTR3,FILPTR3);
# NOW FILL IN DEFAULTS #
IF LIMIT EQ -1 THEN
BEGIN
IF LINPTR2 EQ -1 THEN LIMIT=1;
ELSE LIMIT=LARGENUM;
END
IF LINPTR1 EQ -1 THEN
BEGIN
CHRPTR1=0;
IF FORWARD AND NOT OKSEARCH[PROCESSNDX] THEN LINPTR1=CURRENT+1;
ELSE IF BACKWARD THEN
BEGIN
IF OKSEARCH[PROCESSNDX] THEN
BEGIN
LINPTR1=CURRENT;
IF CURCURSOR GR 0 THEN CHRPTR1=CURCURSOR-1;
ELSE
BEGIN
CHRPTR1=BUFCM1;
LINPTR1=CURRENT-1;
END
END
ELSE LINPTR1=CURRENT-1;
END
ELSE
BEGIN
LINPTR1=CURRENT;
IF SCANWORD OR CHARRANGE THEN CHRPTR1=CURCURSOR;
IF OKSEARCH[PROCESSNDX] THEN
BEGIN
CHRPTR1=CURCURSOR;
IF LASTPROCESS EQ PROCESSNDX
AND (NOT(SCHSTRSPEC) OR FORWARD)
AND CURCURSOR EQ OLDCURSOR
AND LINPTR1 EQ OLDLINPTR
THEN CHRPTR1=CHRPTR1+STRINGLEN;
END
END
FILPTR1=CURFILE;
END
IF LINPTR2 EQ -1 THEN
BEGIN
FILNUM=FILPTR1;
IF FILNUM EQ 0 THEN FILNUM=CURFILE;
IF BACKWARD THEN LINPTR2=TOPF(FILNUM)+1;
ELSE LINPTR2=BOTF(FILNUM)-1;
END
IF LINPTR3 EQ -1 THEN
BEGIN
FILNUM=FILPTR3;
EXTENDFILE(TRUE);
LINPTR3=CURRENT;
CHRPTR3=CURCURSOR;
END
IF OKSEARCH[PROCESSNDX] AND (BACKWARD OR LINPTR1 GR LINPTR2) THEN
BEGIN
IF CHRPTR1 LS 0 THEN CHRPTR1=BUFCM1;
IF CHRPTR2 LS 0 THEN CHRPTR2=0;
END
CHRPTR1=MAX(CHRPTR1,0);
IF CHRPTR2 LS 0 THEN CHRPTR2=BUFCM1;
IF CHRPTR2 EQ 0 AND NOT (CHARRANGE OR OKSEARCH[PROCESSNDX])
THEN CHRPTR2=BUFCM1;
IF CHRPTR3 LS 0 THEN
BEGIN
IF CHARRANGE THEN CHRPTR3=CURCURSOR;
ELSE CHRPTR3=0;
END
WINDOPOS(LINPTR3,FILPTR3);
# SINGLE USER VERSION ONLY MUST MAKE FILE EXTENSION EXACT #
CONTROL IFEQ SINGLE,1;
IF THISEXTEND NQ 0 THEN
BEGIN
PUSH;
CURFILE=FILPTR3;
WHYLE LINPTR3 LS BOTF(FILPTR3)-1 AND THISEXTEND GR 0 DO
BEGIN
POSZ(BOTF(FILPTR3)-1);
DELX;
THISEXTEND=THISEXTEND-1;
IF CURRENT LS LINPTR1 THEN LINPTR1=LINPTR1-1;
IF CURRENT LS LINPTR2 THEN LINPTR2=LINPTR2-1;
END
POP;
END
WINDOPOS(LINPTR3,FILPTR3);
CONTROL FI;
IF FILPTR1 EQ 0 THEN FILPTR1=CURFILE;
CURFILE=FILPTR1;
WINDOLIN(LINPTR1,CURFILE);
FOUNDOTHER=FOUND;
WINDOLIN(LINPTR2,CURFILE);
FOUND=FOUND AND FOUNDOTHER;
IF LINPTR1 GR LINPTR2
OR (LINPTR1 EQ LINPTR2 AND CHRPTR1 GR CHRPTR2) THEN
BEGIN
BACKWARD=TRUE;
LINPTR1 = = LINPTR2;
CHRPTR1 = = CHRPTR2;
END
IF BACKWARD AND NOT OKREVERSE[PROCESSNDX] THEN
BEGIN
BACKWARD=FALSE;
IF LIMIT LS LARGENUM
THEN LINPTR1=MAX(LINPTR1,LINPTR2-MAX(LIMIT,1)+1);
END
IF WHICHSTR NQ 0 AND ASCII[CURFILE] LQ 1 THEN
BEGIN
SQUELCH(LOCSTRING1);
SQUELCH(LOCSTRING2);
SQUELCH(CHGSTRING1);
SQUELCH(TTYLIN);
END
IOEND # OF SCANNER #
PAGE # SCAN STUFF -- SCNLIN #
PROC SCNLIN;
IOBEGIN(SCNLIN)
#
** SCNLIN - SCAN LINE ADDRESS SYNTAX.
*
* SCNLIN IS CAPABLE OF PARSING ONE LINE ADDRESS EXPRESSION.
* IT IS INTENDED TO BE CALLED ONLY BY SCANNER. SCNLIN
* ASSUMES THE CALLER HAS POSITIONED THE TOKEN AT A
* GENUINE LINE ADDRESS EXPRESSION.
*
* ENTRY WHICHLIN - WHICH LINE PARAMETER TO SET.
* LINPTR1,2,3 - POSSIBLE PARAMETERS.
* CHRPTR1,2,3 - DITTO.
* FILPTR1,2,3 - DITTO.
* LINNUM1,2,3 - DITTO.
* CURFILE - DEFAULT FILE BRACKET.
* TOKENPOS, SCANPOS - BRACKET CURRENT SYNTAX.
* CURF(), TOPF(), BOTF() - SETUP.
* NUMBERED[] - SETUP.
* REGLINE[XYZREG], REGLINE[XYZTOP] - SETUP.
* XYZCHAR[], XYZFILE[] - SETUP.
*
* EXIT ONE SET OF LINPTRX, CHRPTRX, FILPTRX, LINNUMX -
* DESCRIBE SCANNED EXPRESSION.
* OTHER SETS OF LINPTRX, CHRPTRX, FILPTRX, LINNUMX -
* USED TEMPORARILY THEN RESTORED.
* IF FILPTRX SET, IN FDLF FORMAT NOT BRACKET.
* FILE BRACKETS POSSIBLY RE-OPENED.
* CHARRANGE - CAN BE FORCED TRUE FOR X,Y,Z.
* PAGELAST - FALSE.
* NONDEFAULT - TRUE.
* WHICHLIN - INCREMENTED.
* WHICHDGT - MATCHES WHICHLIN.
* SCANPOS, TOKENPOS - ADVANCED BEYOND SYNTAX.
*
* USES READNAM, FILNUM, ORIGSCNLIN, TEMP(RESTORES),
* ALL TOKENXXXX VARIABLES.
*
* CALLS PUSHTEMP, MIN, SCNFILE, ERRJUMP, FORCEFILE,
* TOKEN, PUSH, POSN, POP, POPTEMP.
#
# SCNLINSW MUST MATCH TYPST. SLKEYSW MATCHES LINEKEYWD. #
SWITCH SCNLINSW SLDIGIT, SLPLUS, SLMINUS, SLDELIMIT,
SLCOLON,
SLPAREN, SLEQUAL, SLLETTER, SLSEMI,
SLEOL, SLOTHER, SLCONTROL;
SWITCH SLKEYSW SLCURRENT, SLFIRST, SLLAST, SLX, SLY, SLZ;
ARRAY LINEKEYS[0:5]; ITEM LINEKEYWD C(0,0,10) = [ "CURRENT",
"FIRST", "LAST", "X", "Y", "Z" ];
ITEM TMP1; # CAN BE USED ONLY INSTANTANEOUSLY #
WHICHLIN=MIN(WHICHLIN,3);
IF WHICHLIN NQ 2 THEN ORIGSCNLIN=TOKENPOS;
FILNUM=CURFILE;
NONDEFAULT=TRUE;
PAGELAST=FALSE; # SINCE NON-DEFAULT USED #
PUSHTEMP; # ALLOCATE TEMP VARIABLE FOR SCRATCH #
IF WHICHLIN EQ 2 THEN
BEGIN
IF FILPTR1 NQ 0 AND FDLF(CURFILE) NQ FILPTR1
THEN FILNUM=CURFILE LXR 3;
LINPTR1 == LINPTR2;
FILPTR1 == FILPTR2;
LINNUM1 == LINNUM2;
CHRPTR1 == CHRPTR2;
END
ELSE IF WHICHLIN EQ 3 THEN
BEGIN
LINPTR1 == LINPTR3;
FILPTR1 == FILPTR3;
LINNUM1 == LINNUM3;
CHRPTR1 == CHRPTR3;
END
CHRPTR1=0; # DEFAULT CHARACTER POINTERS #
IF WHICHLIN EQ 2 THEN CHRPTR1=BUFCM1;
SCNLINLOOP: # THIS IS THE MAIN LOOP #
GOTO SCNLINSW[TOKENTYPE]; # DISPATCH BY SYNTAX #
SLDELIMIT: SLCOLON:
SLSEMI: SLEOL: SLOTHER: SLCONTROL: SLEQUAL:
GOTO SLDONE;
SLPAREN:
# SCAN FILE NAME. IF MATCHES CURRENT FILE, WE CAN CONTINUE #
# SCANNING. IF NOT, WE MUST ACCESS FILE AND RE-START ENTIRE#
# SCAN SO THAT RELOCATABLE VALUES WILL BE FRESH. #
IF SCANSFILE THEN
BEGIN # IF ALREADY SCANNED SOURCE #
IF NOT SCANTO THEN
BEGIN # IF NO *TO* #
ERRJUMP ("*TO* REQUIRED BEFORE DESTINATION FILE$");
END
END
SCNFILE(READNAM);
IF READNAM NQ PADNAME(FILENAM[FILNUM]) THEN
BEGIN
IF WHICHLIN EQ 2 THEN
BEGIN
WHICHLIN=1;
LINPTR2=-1;
FILPTR2=0;
LINNUM2=-1;
CHRPTR2=-1;
END
FORCEFILE;
LINPTR1=CURF(FILNUM)-TOPF(FILNUM);
FILPTR1=FDLF(FILNUM); # ASSURE ONLY ONE MORE TRY #
IF SCNONCE THEN
BEGIN # IF ERROR IN SYNTAX #
TMP1 = 0;
IF SCNLINZ THEN TMP1 = O"32";
IF SCNLINY THEN TMP1 = O"31";
IF SCNLINX THEN TMP1 = O"30";
IF TMP1 EQ 0 THEN
BEGIN # IF NOT *XYZ* ERROR #
TOKENPOS = ORIGSCNLIN;
ERRJUMP ("ONLY ONE RANGE ALLOWED$");
END
GOTO SLERROR;
END
SCNONCE = TRUE;
SCANPOS=ORIGSCNLIN; # FORCE ENTIRE EXPRESSION RESCAN #
TOKEN;
GOTO SCNLINLOOP;
END
ELSE
BEGIN
SCANSFILE = TRUE;
IF NOT SCANTO THEN
BEGIN # IF NOT TARGET FILE #
TMP1 = 0;
IF SCNLINZ AND XYZFILE[2] NQ FDLF(FILNUM) THEN TMP1 = O"32";
IF SCNLINY AND XYZFILE[1] NQ FDLF(FILNUM) THEN TMP1 = O"31";
IF SCNLINX AND XYZFILE[0] NQ FDLF(FILNUM) THEN TMP1 = O"30";
IF TMP1 NQ 0 THEN GOTO SLERROR;
END
END
GOTO SLDONE;
SLCURRENT:
IF WHICHLIN EQ 3 THEN EXTENDFILE(FALSE);
LINPTR1=CURF(FILNUM)-TOPF(FILNUM);
SLCUR2:
FILPTR1=FDLF(FILNUM);
SLCUR3:
TOKEN; # TO GLEAN OUT MORE #
SLCUR4:
IF TOKENTYPE EQ TYPST"PLUS" THEN GOTO SLPLUS2;
IF TOKENTYPE EQ TYPST"MINUS" THEN GOTO SLMINUS2;
GOTO SLDONE;
SLFIRST:
LINPTR1=1;
GOTO SLCUR2; # MORE SYNTAX?? #
SLLAST:
LINPTR1=BOTF(FILNUM)-1-TOPF(FILNUM);
GOTO SLCUR2; # MORE SYNTAX?? #
SLPLUS:
IF WHICHLIN EQ 3 THEN EXTENDFILE(FALSE);
LINPTR1=CURF(FILNUM)-TOPF(FILNUM);
FILPTR1=FDLF(FILNUM);
SLPLUS2:
TEMP=1;
SLPLUS3:
TOKEN;
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN
LINPTR1=LINPTR1+TEMP*TOKENVAL;
TOKEN;
END
ELSE LINPTR1=LINPTR1+TEMP;
LINNUM1=-1;
GOTO SLCUR4;
SLMINUS:
IF WHICHLIN EQ 3 THEN EXTENDFILE(FALSE);
LINPTR1=CURF(FILNUM)-TOPF(FILNUM);
FILPTR1=FDLF(FILNUM);
SLMINUS2:
TEMP=-1;
GOTO SLPLUS3;
SLX:
SCNLINX = TRUE;
TEMP=0;
SLX2:
LINPTR1=REGLINE[XYZREG+TEMP]-REGLINE[XYZTOP+TEMP];
FILPTR1=XYZFILE[TEMP];
CHRPTR1=XYZCHAR[TEMP];
IF CHRPTR1 GQ 0 THEN CHARRANGE=TRUE;
GOTO SLCUR3;
SLY:
SCNLINY = TRUE;
TEMP=1;
GOTO SLX2;
SLZ:
SCNLINZ = TRUE;
TEMP=2;
GOTO SLX2;
SLDIGIT:
IF NUMBERED[FILNUM] NQ 0 THEN
BEGIN
LINNUM1=TOKENVAL;
PUSH; # REMEMBER WHERE WE ARE #
POSN; # SEARCH FOR THAT LINE #
LINPTR1=CURRENT-TOPF(FILNUM);
POP;
END
ELSE LINPTR1=TOKENVAL;
GOTO SLCUR2; # FOR MORE SYNTAX #
SLLETTER:
FOR TMP1=0 STEP 1 UNTIL 5 DO
BEGIN
IF KEYWORD[KEYWDNDX] EQ LINEKEYWD[TMP1]
THEN GOTO SLKEYSW[TMP1];
END
SLDONE:
IF TOKENTYPE EQ TYPST"PAREN" THEN GOTO SLPAREN;
POPTEMP;
IF WHICHLIN EQ 2 THEN
BEGIN
CHRPTR1 == CHRPTR2;
LINPTR1 == LINPTR2;
FILPTR1 == FILPTR2;
LINNUM1 == LINNUM2;
END
ELSE IF WHICHLIN EQ 3 THEN
BEGIN
CHRPTR1 == CHRPTR3;
LINPTR1 == LINPTR3;
FILPTR1 == FILPTR3;
LINNUM1 == LINNUM3;
END
WHICHLIN=WHICHLIN+1;
WHICHDGT=WHICHLIN;
IORET;
SLERROR:
ERRSTRING = " POINTER NOT SET IN FILE ";
C<26,07>ERRSTRING = C<0,7>READNAM;
C<00,01>ERRSTRING = TMP1;
C<33,01>ERRSTRING = "$";
TOKENPOS = ORIGSCNLIN;
ERRJUMP (ERRSTRING);
IOEND # OF SCNLIN #
PAGE # SCANSET - FOR "SET" COMMAND #
PROC SCANSET;
IOBEGIN(SCANSET)
#
** SCANSET - SCAN SYNTAX OF SET SUBCOMMANDS.
*
* SCANSET IS CALLED WHEN THE SET COMMAND VERB HAS BEEN
* RECOGNIZED. THIS ROUTINE DETERMINES THE SUBCOMMAND, THEN
* SCANS SUB-SYNTAX AS APPROPRIATE AND PERFORMS ALL
* SUBCOMMAND EXECUTION.
*
* ENTRY SCANPOS, TOKENPOS - IDENTIFY SUBCOMMAND SYNTAX.
*
* EXIT COMMAND FULLY EXECUTED.
* VIA QQSINGLE IN MULTI-USER VERSION FOR TRANSITION
* TO SINGLE-USER WITH RE-EXECUTION.
* SCANPOS, TOKENPOS - ADVANCED BEYOND END OF COMMAND.
* SCANNER MAY BE CALLED FOR SOME SUBCOMMANDS.
* SETMARK POSSIBLY CALLED.
* SCREEN MODE INITIALIZATION POSSIBLE.
* TABVECTOR POSSIBLY SETUP.
* X,Y,Z REGISTER POSSIBLY SETUP.
* CURRENT FILE POSSIBLY RENAMED.
* TABCHAR POSSIBLY SETUP.
* INCR, DINCR - POSSIBLY SETUP.
* SCANKEY POSSIBLY CALLED.
* FLOAT, NUMBERED[CURFILE] - POSSIBLY REDEFINED.
* FKEYNUMROW - POSSIBLY REDEFINED.
* CHARRANGE - POSSIBLY DEFINED.
* AUDITOFF - POSSIBLY REDEFINED.
* USRUMLIN, USRNUMCOL, EDITFIELD, USRSPLTSIZ -
* POSSIBLY REDEFINED.
* WIDTH - POSSIBLY REDEFINED.
*
* CALLS AUDITEND, CLEARSCREEN, COPYTABS, ERRJUMP, FSEEDIT,
* MIN, MAX, PAINTALL, SCANFUNC, SCANNER, SCNCHAR,
* SCNEOC, SCNEQNAM, SCNEQVAL, SCNLSTCOL, SCNONOFF,
* SETMARK, SETUPSCREEN, TOKEN, TTSYNC, VDTGTA,
* VDTSTD, VDTSTM.
*
* USES KEYWDTYPE, ALL TOKENXXXX VARIABLES, LINPTR1,
* LINPTR2, LINCTR, VTMODEL, LINPTR3, LINNUM1, LINNUM2,
* READNAM, KEYWDNDX, WHICHDGT.
#
CONTROL IFEQ MULTI,1;
XREF LABEL QQSINGLE;
CONTROL FI;
ITEM TMP1, TMP2, BOOL B, TMPNAM C(7);
DEF NUMSETKEYS #21#;
ARRAY SETKEYS[0:NUMSETKEYS]; ITEM SETKEY C(0,0,10) = [
"ANNOUNCE", "CHAR", "DCOLON", "ECHO", "FILENAME",
"HEADER", "INCREMENT", "JUMP", "KEY", "LINE", "MARK",
"NUMBER", "PROMPT", "REWRITE", "SCREEN", "TABS",
"UNDO", "VIEW", "WORD", "X", "Y", "Z" ];
SWITCH SETSW SSANNOUNCE, SSCHAR, SSDORAC, SSECHO, SSFILE,
SSHEADER, SSINCR, SSJUMP, SSKEY, SSLINE, SSMARK,
SSNUMBER, SSPROMPT, SSREWRITE, SSSCREEN, SSTABS,
SSUNDO, SSVIEW, SSWORD, SSX, SSY, SSZ;
KEYWDTYPE=3;
SCANPOS=TOKENPOS;
TOKEN;
IF TOKENTYPE NQ TYPST"LETTER" THEN
BEGIN
ERRJUMP("KEYWORD MUST FOLLOW SET$");
END
TMP1=-1;
FOR TMP2=0 STEP 1 UNTIL NUMSETKEYS DO
BEGIN
IF KEYWORD[KEYWDNDX] EQ SETKEY[TMP2] THEN TMP1=TMP2;
END
IF TMP1 LS 0 THEN ERRJUMP("KEYWORD MUST FOLLOW SET$");
TOKEN;
GOTO SETSW[TMP1];
SSDORAC: # *DC* OR ASCII COLONS ON EXIT #
SCNONOFF(BOOL);
SCNEOC;
ZEROCOLOUT = BOOL; # DO AS USER ASKS #
ZEROCOLASK = TRUE; # COLON QUESTION "ASKED" #
GOTO SSDONE;
SSECHO: # SET ECHO ON OR OFF #
SCNONOFF(BOOL);
SCNEOC;
ECHOOFF = NOT BOOL; # SET ECHO ON OR OFF #
GOTO SSDONE;
SSJUMP: # AUTO INDENT, BLOCK LANGUAGES #
SCNONOFF(BOOL);
SCNEOC;
AUTOINDENT = BOOL; # DO AS USER ASKS #
GOTO SSDONE;
SSREWRITE: # SET REWRITE (CHANGED FLAG) #
SCNONOFF(BOOL);
SCNEOC;
IF LOCKED[CURFILE] EQ 0 THEN
BEGIN # IF FILE IS NOT LOCKED #
IF BOOL THEN
BEGIN # IF USER WANTS CHANGED #
CHANGED[CURFILE] = 1;
IF FILENAM[1] EQ FILENAM[2] THEN
BEGIN # IF SAME FILE IN BOTH SPLITS #
CHANGED[1] = 1;
CHANGED[2] = 1;
END
END
ELSE
BEGIN # CLEAR CHANGED STATUS #
CHANGED[CURFILE] = 0;
IF FILENAM[1] EQ FILENAM[2] THEN
BEGIN # IF SAME FILE IN BOTH SPLITS #
CHANGED[1] = 0;
CHANGED[2] = 0;
END
END
END
ELSE
BEGIN # LOCKED FILE, REJECT CHANGE #
IF BOOL THEN ERRJUMP("CANNOT CHANGE READ-ONLY FILE$");
END
GOTO SSDONE;
SSMARK:
SCANNER;
LINPTR2=MIN(LINPTR2,LINPTR1+LIMIT-1);
IF SCANWORD THEN
BEGIN
SETMARK(LINPTR1,CHRPTR1);
NEWCURSOR=CURCURSOR+1;
IF WHICHLIN GR 2 THEN
BEGIN
SETMARK(LINPTR2,CHRPTR2);
NEWCURSOR=CHRPTR2+1;
END
END
ELSE
BEGIN
SETMARK(LINPTR1,-1);
IF WHICHLIN GR 2 THEN
BEGIN
SETMARK(LINPTR2,-1);
LINPTR1=LINPTR2;
END
POSZ(LINPTR1);
IF SCREENMODE THEN
BEGIN # IF SCREENMODE #
IF CURRENT EQ TOPS(CURSPLIT) + NUMROWS[CURSPLIT] THEN
BEGIN # IF LAST LINE IN SPLIT #
FORCEAUTOP[0] = TRUE;
END
ELSE
BEGIN # CHECK FOR LAST LINE IN FILE #
IF CURRENT + 1 EQ BOTS(CURSPLIT) THEN FORCEAUTOR[0] = TRUE;
END
END
IF (SCREENMODE AND CURRENT+1 LS BOTS(CURSPLIT))
OR (CURRENT+1 LS BOTF(CURFILE) AND NOT SCREENMODE) THEN
BEGIN
FWDZ;
NEWCURSOR=0;
END
END
GOTO SSDONE;
SSTABS:
SCNLSTCOL;
IF SCREENMODE THEN COPYTABS;
GOTO SSDONE;
SSX:
LINCTR=0;
SSX2:
SCANNER;
IF SCANWORD THEN XYZCHAR[LINCTR]=CHRPTR1;
ELSE XYZCHAR[LINCTR]=-1;
REGLINE[XYZREG+LINCTR]=LINPTR1;
REGLINE[XYZTOP+LINCTR]=TOPF(CURFILE);
XYZFILE[LINCTR]=FDLF(CURFILE);
GOTO SSDONE;
SSY:
LINCTR=1;
GOTO SSX2;
SSZ:
LINCTR=2;
GOTO SSX2;
CONTROL IFEQ MULTI,1;
SSANNOUNCE: SSCHAR: SSFILE: SSHEADER: SSINCR: SSKEY: SSLINE:
SSNUMBER: SSPROMPT: SSSCREEN: SSUNDO: SSVIEW: SSWORD:
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
SSANNOUNCE:
WHICHSTR=1;
TTYLINE[0]=NULLIN;
IF TOKENTYPE EQ TYPST"DELIMIT" THEN SCANSTR;
SCNEOC;
LINPTR3=1;
C<0,1>ERRSTRING=" ";
FOR LINPTR1=0 STEP 1 UNTIL MIN(LENGTH(TTYLIN)-1,77) DO
BEGIN
GETCHAR(TTYLINE,LINPTR1,LINPTR2);
DSPLCOD(LINPTR2);
C<LINPTR1,1>ERRSTRING=LINPTR2;
LINPTR3=LINPTR1+1;
END
IF LINPTR3 LAN 1 EQ 0 THEN C<LINPTR3,1>ERRSTRING="$";
ELSE C<LINPTR3,2>ERRSTRING=" $";
GOTO SSDONE;
SSCHAR:
TMP1 = 0; # SET *SET CHAR TAB* FLAG #
IF TOKENTYPE EQ TYPST"LETTER" THEN
BEGIN
KEYWDTYPE = 10;
SCANPOS = TOKENPOS;
TOKEN;
IF KEYWDNDX NQ KEYST"CTAB" THEN
BEGIN # IF NOT *SET CHAR TAB* #
IF KEYWDNDX EQ KEYST"CCTL" THEN
BEGIN # IF *SET CHAR CONTROL* #
TMP1 = 1; # SET *SET CHAR CONTROL* FLAG #
END
ELSE
BEGIN # IF NOT *SET CHAR CONTROL* #
SCANPOS = TOKENPOS; # SET UP TAB CHARACTER RESCAN #
END
END
KEYWDTYPE = 0;
TOKEN;
END
SCNCHAR;
IF TMP1 NQ 0 THEN
BEGIN # IF *SET CHAR CONTROL* #
IF LINPTR1 EQ CNOTHING THEN LINPTR1 = CBLANK;
IF LINPTR1 NQ UNPRINT THEN
BEGIN # IF CHARACTER CHANGED #
UNPRINT = LINPTR1;
IF SCREENMODE THEN
BEGIN # IF SCREEN MODE #
FOR LINPTR1 = TITLEROW[1] + 1 STEP 1 UNTIL
TITLEROW[1] + NUMROWS[1] DO ROWPAINT[LINPTR1] = TRUE;
IF SPLITFILE[2] NQ 0 THEN
BEGIN # IF SPLIT SCREEN #
FOR LINPTR1 = TITLEROW[2] + 1 STEP 1 UNTIL
TITLEROW[2] + NUMROWS[2] DO ROWPAINT[LINPTR1] = TRUE;
END
END
END
END
ELSE TABCHAR = LINPTR1; # IF *SET CHAR TAB* #
SCNEOC;
GOTO SSDONE;
SSFILE:
SCNEQNAM(READNAM);
SCNEOC;
IF READNAM EQ PADNAME(WORKORG) THEN
BEGIN # IF SAME AS WORKFILE NAME #
ERRJUMP("FILE NAME IN USE$");
END
FOR FILNUM=1 STEP 1 UNTIL 2 DO
BEGIN # ASSURE DIRECTORY UPTODATE #
IF PADNAME(FILENAM[FILNUM]) NQ " " THEN CLOSEFILE;
END
PUSH;
POSZ(TOPC(FILECTL)+1);
WHYLE CURRENT LS BOTC(FILECTL) DO
BEGIN # VERIFY UNIQUE NAME #
SCANFDL(LINPTR1);
IF READNAM EQ C<0,7>LINPTR1 AND READNAM NQ "ZZZNULL"
AND CURRENT NQ FDLF(CURFILE) THEN
BEGIN # IF FILE NAME IN USE #
POP;
ERRJUMP("FILE NAME IN USE$");
END
FWDZ;
END
POP;
TMPNAM=TRIMNAME(READNAM);
FOR FILNUM=1 STEP 1 UNTIL 2 DO
BEGIN
IF FDLF(FILNUM) EQ FDLF(CURFILE) THEN
BEGIN
IF SPLITFILE[1] EQ FILNUM THEN LASTNAME[1]=TMPNAM;
IF SPLITFILE[2] EQ FILNUM THEN LASTNAME[2]=TMPNAM;
FILENAM[FILNUM]=TMPNAM;
CHANGED[FILNUM]=1;
LOCKED[FILNUM]=0;
IF NOT WRITEABLE(READNAM) OR
READNAM EQ "ZZZNULL" THEN LOCKED[FILNUM]=1;
END
END
FOR FILNUM=1 STEP 1 UNTIL 2 DO
BEGIN # ASSURE DIRECTORY UPTODATE #
IF PADNAME(FILENAM[FILNUM]) NQ " " THEN CLOSEFILE;
END
GOTO SSDONE;
SSHEADER:
SCNONOFF(BOOL);
SCNEOC;
IF BOOL THEN SHORTTITLE=FALSE;
ELSE SHORTTITLE=TRUE;
IF SCREENMODE THEN
BEGIN
ROWPAINT[TITLEROW[1]]=TRUE;
IF SPLITFILE[2] NQ 0 THEN ROWPAINT[TITLEROW[2]]=TRUE;
END
GOTO SSDONE;
SSINCR:
SCNEQVAL;
SCNEOC;
IF LINPTR1 LQ 0 OR LINPTR1 GQ NINES
THEN ERRJUMP("LINE INCREMENT VALUE TOO LARGE$");
INCR=LINPTR1;
DINCR=LINPTR1;
GOTO SSDONE;
SSKEY:
SCANFUNC;
GOTO SSDONE;
SSLINE:
SCNEOC;
CLEARSCREEN;
GOTO SSDONE;
SSNUMBER:
KEYWDTYPE=8;
SCANPOS=TOKENPOS;
TOKEN;
KEYWDTYPE=0;
TOKEN;
SCNEOC;
IF KEYWDNDX EQ KEYST"NBAS" OR KEYWDNDX EQ KEYST"NFOR" THEN
BEGIN
FLOAT=FALSE;
IF KEYWDNDX EQ KEYST"NBAS" THEN BLANKS=1;
ELSE BLANKS=0;
NUMWIDBLK=NUMWIDTH+BLANKS;
FOR TMP1 = 1 STEP 1 UNTIL 2 DO # IF SPLIT IS USED THEN RESET #
BEGIN
IF FDLF(TMP1) EQ FDLF(CURFILE) THEN NUMBERED[TMP1]=1;
END
END
ELSE IF KEYWDNDX EQ KEYST"NAUT" THEN
BEGIN
FLOAT=TRUE;
FOR TMP1 = 1 STEP 1 UNTIL 2 DO # IF SPLIT IS USED THEN RESET #
BEGIN
IF FDLF(TMP1) EQ FDLF(CURFILE) THEN NUMBERED[TMP1]=0;
END
END
ELSE IF KEYWDNDX EQ KEYST"NONE" THEN
BEGIN
FLOAT=FALSE;
FOR TMP1 = 1 STEP 1 UNTIL 2 DO # IF SPLIT IS USED THEN RESET #
BEGIN
IF FDLF(TMP1) EQ FDLF(CURFILE) THEN NUMBERED[TMP1]=0;
END
END
ELSE ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
GOTO SSDONE;
SSPROMPT:
LINPTR1=1;
WHYLE TOKENTYPE EQ TYPST"DIGIT" OR TOKENTYPE EQ TYPST"LETTER" DO
BEGIN
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN # IF SET PROMPT 1/2/3 #
SCNEQVAL;
FKEYNUMROW=MIN(MAX(LINPTR1,0),3);
END
ELSE
BEGIN # IF SET PROMPT SHIFT/NOSHIFT #
KEYWDTYPE = 11;
SCANPOS = TOKENPOS;
TOKEN;
KEYWDTYPE = 3;
IF KEYWDNDX EQ KEYST"PYDK" THEN SFKEYSHOW = 1;
ELSE IF KEYWDNDX EQ KEYST"PNDK" THEN SFKEYSHOW = 0;
ELSE ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
TOKEN;
LINPTR1 = FKEYNUMROW; # PRESERVE CURRENT PROMPT ROWS #
END
END
SCNEOC;
LINPTR2=FKEYROW;
FKEYNUMROW=MIN(MAX(LINPTR1,0),3);
IF SCREENMODE THEN
BEGIN # IF SCREEN MODE #
IF SPLITFILE[2] NQ 0 THEN SETUPSCREEN(1,2,USRSPLTSZ);
ELSE SETUPSCREEN(1,0,0);
IF FKEYROW NQ LINPTR2 THEN
BEGIN # IF THERE WAS A CHANGE #
IF TABATTRCHR[0] AND NUMMARKS NQ 0 THEN
PAINTREST(MIN(FKEYROW,LINPTR2)-1);
ELSE
PAINTREST(MIN(FKEYROW,LINPTR2));
END
END
GOTO SSDONE;
SSSCREEN:
IF SYNTAXCHAR[TOKENCHAR] THEN # IF MODEL SPECIFIED #
BEGIN
IF SCREENMODE THEN CLEARSCREEN;
TTLIN("YOU CANNOT SPECIFY A MODEL ON THE$");
TTLIN("*SET SCREEN* EDITOR COMMAND. YOU$");
TTLIN("SHOULD USE THE *QUIT* COMMAND TO$");
TTLIN("END THIS EDIT SESSION, THEN USE THE$");
TTLIN("*SCREEN* COMMAND TO DEFINE YOUR$");
TTLIN("TERMINAL MODEL. THEN YOU CAN START$");
TTLIN("THE EDITOR AGAIN.$");
ERRJUMP(" $");
END
ELSE # MODEL NOT SPECIFIED #
BEGIN
SCNEOC;
IF NOT INTERACT THEN GOTO SSDONE; # IF BATCH MODE #
IF NOT SCREENMODE THEN # IF LINE MODE #
BEGIN
TTSYNC;
VDTSTM(1,TMP1); # SET SCREEN MODE #
END
FKEYCHARS=6;
FKEYSHOW=8;
END
IF SCREENMODE THEN # IF SCREEN MODE #
BEGIN
SCRNSIZES; # SET SCREEN SIZE VALUES #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TYPE TERMINAL #
SINGLEONLY = TRUE; # DO NOT CONNECT TO MULTI #
IF USRNUMCOL GR 1 THEN
BEGIN # IF NOT FIRST SET UP OF SCREEN #
USRNUMCOL = MIN(USRNUMCOL,VTXMAX-1);
END
ELSE
BEGIN # FIRST SET UP OF SCREEN #
USRNUMCOL = VTXMAX - 1;
END
END
ELSE
BEGIN # CHARACTER MODE TYPE #
IF USRNUMCOL GR 1 THEN
BEGIN # IF NOT FIRST SET UP OF SCREEN #
USRNUMCOL = MIN(USRNUMCOL,VTXMAX);
END
ELSE
BEGIN # NOT FIRST SET UP OF SCREEN #
USRNUMCOL = VTXMAX;
END
END
IF USRNUMLIN GR 1 THEN
BEGIN # IF NOT FIRST SET UP OF SCREEN #
USRNUMLIN = MIN(USRNUMLIN,VTYMAX);
END
ELSE
BEGIN # NOT FIRST SET UP OF SCREEN #
USRNUMLIN = VTYMAX;
END
IF SPLITFILE[2] NQ 0 THEN SETUPSCREEN(1,2,USRSPLTSZ);
ELSE SETUPSCREEN(1,0,0);
COPYTABS;
PAINTALL;
END
GOTO SSDONE;
SSUNDO:
SCNONOFF(BOOL);
SCNEOC;
IF BOOL THEN AUDITOFF=FALSE;
ELSE
BEGIN
AUDITEND;
AUDITOFF=TRUE;
END
GOTO SSDONE;
SSVIEW:
SCANVIEW;
GOTO SSDONE;
SSWORD:
KEYWDTYPE=4;
SCANPOS=TOKENPOS;
KEYWDNDX=-1;
TOKEN;
IF KEYWDNDX EQ KEYST"XFIL" THEN
BEGIN
KEYWDTYPE=1;
TOKEN;
SCNEQVAL;
FILLLEFT=MAX(MIN(LINPTR1-1,BUFCHAR-2),0);
FILLFIRST=FILLLEFT;
IF SYNTAXCHAR[TOKENCHAR] THEN
BEGIN
SCNEQVAL;
FILLRIGHT=MAX( MIN(LINPTR1-1,BUFCM1), FILLLEFT+1);
END
ELSE
BEGIN
FILLRIGHT=FILLLEFT;
FILLLEFT=0;
FILLFIRST=FILLLEFT;
END
IF SYNTAXCHAR[TOKENCHAR] THEN
BEGIN
SCNEQVAL;
FILLFIRST=MAX(MIN(LINPTR1-1,BUFCHAR-2),0);
END
IF SYNTAXCHAR[TOKENCHAR] THEN
BEGIN # IF SOMETHING ELSE SPECIFIED #
IF(C<0,1>TOKENSYM EQ "Y" AND TOKENLEN EQ 1) OR
(C<0,3>TOKENSYM EQ "YES" AND TOKENLEN EQ 3) THEN
BEGIN # IF RIGHT JUSTIFY REQUESTED #
RIGHTJUST[0] = TRUE;
END
ELSE
BEGIN # CHECK FOR NO RIGHT JUSTIFY #
IF(C<0,1>TOKENSYM EQ "N" AND TOKENLEN EQ 1) OR
(C<0,2>TOKENSYM EQ "NO" AND TOKENLEN EQ 2) THEN
BEGIN # IF NOT REQUESTED #
RIGHTJUST[0] = FALSE;
END
ELSE
BEGIN # SOMETHING, BUT NOT YES OR NO #
ERRJUMP("MUST SPECIFY YES OR NO$");
END
END
TOKEN;
END
SCNEOC;
END
ELSE IF KEYWDNDX EQ KEYST"XCHA" THEN
BEGIN
TOKEN;
SCNCHAR;
SCNEOC;
B<LINPTR1 LAN 31,1>WORDFLAG[LINPTR1/32]=B<LINPTR1 LAN 31,1>
WORDFLAG[LINPTR1/32] LXR 1;
IF B<LINPTR1 LAN 31,1>WORDFLAG[LINPTR1/32] EQ 0 THEN
BEGIN
ERRSTRING="CHARACTER DEFINED AS PUNCTUATOR$";
END
ELSE
BEGIN
ERRSTRING="CHARACTER DEFINED AS ALPHANUMERIC$";
END
END
ELSE ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
GOTO SSDONE;
CONTROL FI;
SSDONE:
IOEND # OF SCANSET #
PAGE # SCANVIEW - SET VIEW COMMANDS #
PROC SCANVIEW;
BEGIN
#
** SCANVIEW - SCAN PARAMETERS OF "SET VIEW" COMMAND.
*
* ENTRY SCANPOS, TOKENPOS - BRACKET TOKEN AFTER VIEW.
*
* EXIT ONE OR MORE OF FOLLWING SETUP -
* USRNUMLIN, USRNUMCOL, USRSPLTSZ, EDITFIELD, WIDTH.
* LINPTR2 - NEGATIVE IF NO SCREEN REDEFINE NEEDED.
* POSITIVE DENOTES VTMODEL TO REDEFINE.
* SCANPOS, TOKENPOS - ADVANCED TO END OF COMMAND.
*
* CALLS TOKEN, SCNEQVAL, ERRJUMP, MIN, SCNEOC.
*
* USES LINPTR1, ALL TOKENXXXX VARIABLES, WHICHDGT,
* KEYWDTYPE, KEYWDNDX, LINPTR3.
#
DEF MAXVIEWNDX #6#;
ARRAY VIEWCONTROL [0:MAXVIEWNDX];
BEGIN
ITEM VIEWKEY U(0,00,30)=[ KEYST"VCOL", KEYST"VLIN", KEYST"VOFF",
KEYST"VSPL", KEYST"VEDI", KEYST"VWAR", KEYST"VIN" ];
ITEM VIEWNDX U(0,30,30)=[ 1, 0, 3, 2, 4, 5 ,6 ];
END
SWITCH SCANVIEWSW SVNUMLIN, SVNUMCOL, SVSPLTSZ, SVOFFSET,
SVEDTFLD, SVWIDTH, SVINFLD;
PROC FRMTSCR;
# TITLE FRMTSCR - FORMAT THE SCREEN. #
BEGIN # FRMTSCR #
#
** FRMTSCR - FORMAT THE SCREEN FOR THE "SET VIEW" COMMAND.
*
* ENTRY SCREENMODE - SETUP.
* USRNUMCOL - SETUP.
* USRNUMLIN - SETUP.
*
* EXIT USRNUMLIN - SETUP.
* USRNUMCOL - SETUP.
* USRSPLTSZ - SETUP.
*
* CALLS COPYTABS, PAINTALL, SETUPSCREEN, VDTSTD.
*
* USES SPLITFILE.
#
IF SCREENMODE THEN # IF SCREEN MODE #
BEGIN
SCRNSIZES; # SET SCREEN SIZE VALUES #
IF TABLOCKMDE[0] THEN
BEGIN # IF BLOCK MODE TYPE TERMINAL #
USRNUMCOL = MIN(USRNUMCOL,VTXMAX-1);
END
ELSE
BEGIN # CHARACTER MODE TYPE #
USRNUMCOL = MIN(USRNUMCOL,VTXMAX);
END
USRNUMLIN = MIN(USRNUMLIN,VTYMAX);
IF SPLITFILE[2] NQ 0 THEN SETUPSCREEN(1,2,USRSPLTSZ);
ELSE SETUPSCREEN(1,0,0);
COPYTABS;
PAINTALL;
END
END # FRMTSCR #
# MAIN CODE STARTS HERE. #
WHICHDGT=0;
WHYLE TOKENTYPE EQ TYPST"DIGIT" OR TOKENTYPE EQ
TYPST"LETTER" DO
BEGIN
IF TOKENTYPE EQ TYPST"LETTER" THEN
BEGIN
KEYWDTYPE=5;
SCANPOS=TOKENPOS;
KEYWDNDX=-1;
WHICHDGT=-1;
TOKEN;
FOR LINPTR3=0 STEP 1 UNTIL MAXVIEWNDX DO
BEGIN
IF KEYWDNDX EQ VIEWKEY[LINPTR3]
THEN WHICHDGT=VIEWNDX[LINPTR3];
END
IF WHICHDGT LS 0 THEN
BEGIN
ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
END
TOKEN;
END
IF TOKENTYPE EQ TYPST"DIGIT" OR TOKENTYPE EQ TYPST"EQUAL" THEN
BEGIN
SCNEQVAL;
IF WHICHDGT GR MAXVIEWNDX THEN ERRJUMP("TOO MANY PARAMETERS$");
GOTO SCANVIEWSW[WHICHDGT];
SVNUMLIN:
IF USRNUMLIN NQ MAX(9,LINPTR1 - 1) THEN
BEGIN # IF REAL CHANGE #
IF SCREENMODE AND LINPTR1 - 1 LS USRNUMLIN THEN VDTCLS;
USRNUMLIN = MAX(9,LINPTR1 - 1);
FRMTSCR; # FORMAT THE SCREEN #
END
XSHIFT[1] = MIN(XSHIFT[1],BUFCHAR-(VTXMAX+1+ATTCOUNT));
XSHIFT[2] = MIN(XSHIFT[2],BUFCHAR-(VTXMAX+1+ATTCOUNT));
GOTO SVNEXT;
SVNUMCOL:
IF USRNUMCOL NQ MAX(9,LINPTR1 - 1) THEN
BEGIN # IF REAL CHANGE #
IF TABVTSCLRS[0] OR LINPTR1 GR USRNUMCOL THEN
BEGIN # IF SCREEN NEEDS REPAINTING #
USRNUMCOL = MAX(9,LINPTR1 - 1);
FRMTSCR; # FORMAT THE SCREEN #
END
ELSE
BEGIN # SCREEN DOES NOT NEED REPAINT #
IF SCREENMODE THEN
BEGIN # IF IN SCREEN MODE #
USRNUMCOL = MAX(9,LINPTR1 - 1);
SCRNSIZES; # SET SCREEN SIZE VALUES #
USRNUMCOL = MIN(USRNUMCOL,VTXMAX);
USRNUMLIN = MIN(USRNUMLIN,VTYMAX);
COPYTABS;
IF FKEYNUMROW GR 0 THEN
BEGIN # IF PROMPTS MUST BE REPAINTED #
PAINTREST(FKEYROW);
END
END
END
END
XSHIFT[1] = MIN(XSHIFT[1],BUFCHAR-(VTXMAX+1+ATTCOUNT));
XSHIFT[2] = MIN(XSHIFT[2],BUFCHAR-(VTXMAX+1+ATTCOUNT));
GOTO SVNEXT;
SVSPLTSZ:
IF USRSPLTSZ NQ LINPTR1 THEN
BEGIN # IF REAL CHANGE #
SCRNPT1 = MAX(0,FKEYNUMROW*(2+SHIFTFKEY)-1);
USRSPLTSZ = MIN(MAX(LINPTR1,1),(USRNUMLIN-(SCRNPT1+4)));
IF SCREENMODE THEN
BEGIN # IF SCREEN MODE #
IF SPLITFILE[2] NQ 0 THEN
BEGIN # IF SPLIT SCREEN MODE #
SETUPSCREEN(1,2,USRSPLTSZ);
FOR LINPTR1 = USRNUMLIN-(USRSPLTSZ-1) STEP 1 UNTIL SCRNPT1 DO
BEGIN # UNTIL DONE FOR SPLIT AREA #
ROWPAINT[SCRNPT1]= TRUE;
END
END
END
END
GOTO SVNEXT;
SVOFFSET:
IF XSHIFT[CURSPLIT] NQ MAX(LINPTR1-1,0) THEN
BEGIN # IF REAL CHANGE #
XSHIFT[CURSPLIT] = MIN(MAX(LINPTR1-1,0),
BUFCHAR-(VTXMAX+1+ATTCOUNT));
IF SCREENMODE THEN
BEGIN # IF SCREEN MODE #
FOR LINPTR1 = TITLEROW[CURSPLIT] STEP 1 UNTIL
TITLEROW[CURSPLIT] + NUMROWS[CURSPLIT] DO
ROWPAINT[LINPTR1] = TRUE;
END
END
GOTO SVNEXT;
SVEDTFLD:
EDITFIELD=MIN(LINPTR1,BUFCHAR);
GOTO SVNEXT;
SVWIDTH:
WIDTH=MIN(LINPTR1,BUFCHAR);
GOTO SVNEXT;
SVINFLD:
DFINFIELD=MAX(0,MIN(LINPTR1,BUFCHAR));
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN # IF SECOND VALUE SUPPLIED #
SCNEQVAL;
DFINBGN = DFINEND;
DFINEND = MAX(0,MIN(LINPTR1,BUFCHAR));
END
IF DFINEND EQ 0 THEN DFINEND=BUFCHAR;
IF DFINBGN GR DFINEND THEN DFINBGN==DFINEND;
DFINBGN=MAX(1,DFINBGN);
GOTO SVNEXT;
SVNEXT:
WHICHDGT=WHICHDGT+1;
END
END
SCNEOC;
END # OF SCANVIEW #
PAGE # SCRNSIZES - SET SCREEN SIZES #
PROC SCRNSIZES;
BEGIN
#
** SCRNSIZES - SET SIZE VALUES ASSOCIATED WITH SCREEN.
*
* SETS SCREEN ROWS, COLUMNS AND LABEL LINE AND PADDING SIZES.
*
* ENTRY USRNUMCOL = SPECIFIED NUMBER OF COLUMNS - 1.
* USRNUMLIN = SPECIFIED NUMBER OF LINES - 1.
*
* EXIT VTXMAX = MAXIMUM COLUMN NUMBER FOR SELECTED FORMAT.
* VTYMAX = MAXIMUM ROW NUMBER FOR SELECTED FORMAT.
* FKEYLEN = LENGTH OF FUNCTION KEY LABEL LINES.
* FKEYPAD = NUMBER OF BLANKS TO BE ADDED BEFORE AND
* AFTER EACH FUNCTION KEY LABEL BLOCK.
*
* CALLS VTDSTD.
*
* USES FKEYLEN, FKEYPAD.
#
VDTSTD(USRNUMCOL+1,USRNUMLIN+1);
FKEYPAD = (VTXMAX+1-(FKEYCHARS+4)*FKEYSHOW)/(FKEYSHOW*2);
FKEYLEN = (2*FKEYPAD+FKEYCHARS+4)*FKEYSHOW-1;
END # END OF SCRNSIZES #
PAGE # SCANFUNC - SCAN "FUNCTION" CMD #
CONTROL IFEQ SINGLE,1;
PROC SCANFUNC;
BEGIN
#
** SCANFUNC - SCAN/EXECUTE SET KEY COMMAND.
*
* SCANFUNC IS INTENDED TO BE CALLED ONLY BY SCANSET.
* SCANFUNC HANDLES FUNCTION KEY REDEFINITION. THIS
* ROUTINE COMPLETES SYNTAX SCAN AND EXECUTES THE COMMAND.
*
* ENTRY TOKENPOS - POINTS AFTER "SET KEY".
* FKEYNUMROW - WHETHER TO SET ROWPAINT.
*
* EXIT TOKENPOS, SCANPOS - ADVANCED TO END OF COMMAND.
* FKEYNAME[ANY,ANY] - REDEFINED.
* ROWPAINT[] - SET IF NEEDED.
*
* USES ALL TOKENXXXX VARIABLES, FKEYNDX, KEYWDTYPE,
* TTYLIN, WHICHSTR, LINCTR, LINPTR1, LINNUM1, TMPLIN.
*
* MACROS GETCHAR.
*
* CALLS DSPLCOD, SCANSTR, SETSCREEN, TOKEN.
#
BASED ARRAY KEYLIN[0:99]; ITEM KEYLINE;
ITEM EXPECT; # 0=CONTENT, 1=LABEL #
ITEM WEDIDIT B;
ITEM KEY, SHIFT;
EXPECT=0;
SHIFT=1;
WEDIDIT=FALSE;
KEY=1;
KEYWDTYPE=7;
SCANPOS=TOKENPOS;
SFLOOP:
TOKEN;
SFLOOP2:
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN
KEY=MIN(MAX(TOKENVAL,1),POSFKEYS);
GOTO SFLOOP;
END
IF TOKENTYPE EQ TYPST"LETTER" THEN
BEGIN
IF KEYWDNDX EQ KEYST"KSHI" THEN
BEGIN # SHIFT KEYWORD #
SHIFT=-1;
GOTO SFLOOP;
END
ELSE IF KEYWDNDX EQ KEYST"KLAB" THEN
BEGIN # LABEL KEYWORD #
EXPECT=1;
GOTO SFLOOP;
END
ELSE
BEGIN
IF SCREENMODE THEN
BEGIN # IF SCREEN SETUP NEEDED #
IF SPLITFILE[2] EQ 0 THEN SETUPSCREEN(1,0,0);
ELSE SETUPSCREEN(1,2,USRSPLTSZ);
IF FKEYNUMROW NQ 0 THEN PAINTREST(FKEYROW);
END
ERRJUMP("CHARACTER SEQUENCE NOT RECOGNIZED$");
END
END
IF TOKENTYPE EQ TYPST"DELIMIT" THEN
BEGIN
WEDIDIT=TRUE;
TTYLINE[0]=NULLIN;
WHICHSTR=1;
SCANSTR; # PUTS INTO TTYLIN #
# ALWAYS SET LABEL #
FKEYNAME[KEY*SHIFT]=" ";
LINCTR=LENGTH(TTYLIN);
FOR LINPTR1=0 STEP 1 UNTIL MIN(5,LINCTR-1) DO
BEGIN
GETCHAR(TTYLINE,LINPTR1,LINNUM1);
DSPLCOD(LINNUM1);
C<LINPTR1,1>FKEYNAME[KEY*SHIFT]=LINNUM1;
END
IF EXPECT EQ 0 THEN # SET CONTENT IF NOT EXPLICIT LABEL #
BEGIN
EXPECT=1;
P<KEYLIN>=LOC(FKEYSTRING[KEY*SHIFT]);
FKEYSTRING[KEY*SHIFT]=NULLIN;
FOR LINPTR1=0 STEP 1 UNTIL MIN(14,LINCTR-1) DO
BEGIN
GETCHAR(TTYLINE,LINPTR1,LINNUM1);
SETCHAR(KEYLINE,LINPTR1,LINNUM1);
SETCHAR(KEYLINE,LINPTR1+1,CENDLINE);
END
IF LINCTR GQ 14 THEN
BEGIN
PUSH;
POSZ(TOPK(FKEYS)+KEY*SHIFT+POSFKEYS);
FOR LINPTR1=0 STEP 1 UNTIL LINCTR-1 DO
BEGIN
GETCHAR(TTYLINE,LINPTR1,LINNUM1);
SETCHAR(LINE,LINPTR1,LINNUM1);
SETCHAR(LINE,LINPTR1+1,CENDLINE);
END
REPY;
POP;
END
END
GOTO SFLOOP2;
END
SCNEOC;
IF SCREENMODE THEN
BEGIN # IF SCREEN SETUP NEEDED #
IF SPLITFILE[2] EQ 0 THEN SETUPSCREEN(1,0,0);
ELSE SETUPSCREEN(1,2,USRSPLTSZ);
IF FKEYNUMROW NQ 0 THEN PAINTREST(FKEYROW);
END
END # OF SCANFUNC #
CONTROL FI;
PAGE # MISCELLANEOUS SCANNERS #
PROC SCNTAB;
BEGIN
#
** SCNTAB - PARSE SYNTAX FOR *IN* FIELD REFERENCE.
*
* ENTRY SCANNER ADVANCED TO TOKEN AFTER *IN* KEYWORD.
* FORCEFIELD - WHETHER YET INITIALIZED FIELD.
* WHICHLIN - WHETHER SET FIELDNDX OR FIELDTARGET.
* WHICHDGT - INDICATES TAB FIELD EXPECTED.
*
* EXIT FORCEFIELD - TRUE.
* TOKEN ADVANCED PAST NUMERIC SYNTAX.
* FIELDNDX, FIELDTARGET - ONE OF THESE IS SETUP.
* WHICHDGT - EQUAL TO WHICHLIN.
*
* CALLS TOKEN, ERRJUMP.
#
ITEM TMP1, TMP2;
IF NOT FORCEFIELD THEN
BEGIN
FIELDNDX=0;
FIELDTARGET=0;
END
FORCEFIELD=TRUE;
FIELDFLG=TRUE;
WHICHDGT=WHICHLIN;
IF TOKENTYPE NQ TYPST"DIGIT" THEN
BEGIN # IF *IN* ALONE, DEFAULT COLUMNS #
INFLDBGN=MAX(0,DFINBGN-1);
INFLDEND=MAX(0,DFINEND-1);
IF WHICHLIN LS 4 THEN FIELDNDX=-1; ELSE FIELDTARGET=-1;
END
ELSE
BEGIN # IF ONE OR MORE VALUES #
TMP1=TOKENVAL;
TOKEN; # ADVANCE NEXT SYNTAX #
IF TOKENTYPE NQ TYPST"DIGIT" THEN
BEGIN # IF TAB FIELD INSTEAD OF COLUMNS #
IF TMP1 LQ 0 THEN ERRJUMP("TAB FIELD ORDINAL OUT OF BOUNDS$");
IF WHICHLIN LS 4 THEN FIELDNDX=TMP1; ELSE FIELDTARGET=TMP1;
END
ELSE
BEGIN # IF COLUMNS INSTEAD OF TAB FIELD #
TMP2=TOKENVAL;
TOKEN; # ADVANCE NEXT SYNTAX #
IF TMP2 EQ 0 THEN TMP2=BUFCHAR;
INFLDBGN=MAX(0,MIN(BUFCM1,TMP1-1));
INFLDEND=MAX(0,MIN(BUFCM1,TMP2-1));
IF INFLDEND LS INFLDBGN THEN INFLDBGN==INFLDEND;
IF WHICHLIN LS 4 THEN FIELDNDX=-1; ELSE FIELDTARGET=-1;
END
END
END # OF SCNTAB #
PROC SCANSTR;
BEGIN
#
** SCANSTR - PARSE CHARACTER STRING SYNTAX.
*
* SCANSTR IS CALLED BY SCANNER WHEN SCANNER DETECTS ONE
* OF THE STRING DELIMITER PUNTUATION MARKS. SCANSTR ANALYSES
* THE ENTIRE REMAINDER OF THE COMMAND LINE, THEN DETERMINES
* WHAT PORTION OF THE COMMAND LINE REALLY PROVIDES STRINGS
* FOR THE CURRENT COMMAND, AND LEAVES FOR SCANNER ANY
* PARAMETERS BEYOND THE STRINGS OR ANY ADDITIONAL COMMANDS
* BEYOND THE STRINGS.
*
* ALLOWABLE SYNTAX COMBINATIONS FOR "LOCATE" COMMAND -
*
* /TEXT
* /TEXT/MORE STUFF
* /TEXT1/./TEXT2 (ELLIPSIS)
* /TEXT1/./TEXT2/MORE STUFF
*
* ALLOWABLE SYNTAX COMBINATIONS FOR "REPLACE" COMMAND -
*
* /OLD// (REPLACE WITH NULL)
* /OLD/NEW
* /OLD/NEW/MORE STUFF
* //NEW (USE PREVIOUS SEARCH)
* //NEW/MORE STUFF
* /// (PREVIOUS SEARCH, NULL REPLACE)
* /OLD1/./OLD2// (ELLIPSIS VARIATIONS)
* /OLD1/./OLD2/NEW
* /OLD1/./OLD2/NEW/MORE STUFF
*
* ALLOWABLE SYNTAX FOR "INSERT", "ALTER", "SET KEY" -
*
* /TEXT
* /TEXT/MORE STUFF
*
* ENTRY SCANPOS, TOKENPOS BRACKET INITIAL DELIMETER.
* WHICHSTR - 1=COMMAND IS "INSERT" , "ALTER", "SK".
* 2=COMMAND IS "LOCATE".
* 3=COMMAND IS "REPLACE".
* TOKENCHAR - THE PUNCTUATION MARK USED AS DELIMITER.
*
* EXIT SCANPOS, TOKENPOS - ADVANCED FOR SCANNER TO CONTINUE.
* ELLIPSIS, TXTINCMD - MODE FLAGS.
* WORDSEARCH, UPPERSEARCH - FALSE FOR LOCATE, REPLACE.
* WHICHSTR - SET TO MINUS ONE.
* LOCSTRING1, LOCSTRING2 - ONE OR BOTH SET FOR "L", "R".
* CHGSTRING1 - SET FOR "R".
* LOCSTRLEN1, LOCSTRLEN2, CHGSTRLEN1 - SET PER STRINGS.
* TTYLIN - SET FOR "I", "A".
* SCHSTRSPEC - SET FOR REPEATED LOCATE/REPLACE.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS MOVESTR(INTERNAL), TOKEN, ERRJUMP.
*
* USES ALL TOKENXXXX VARIABLES.
#
ITEM TMP1,TMP2,TMP3;
ITEM NUMSTRING, POINTER, DELIM, CHAR, NONDOT B;
ARRAY STRINGCTL [1:5];
BEGIN
ITEM CTLWORD U(0,0,60); # USED TO CLEAR ALL FIELDS #
ITEM ALLDOTS B(0,0,1);
ITEM CLOSED B(0,1,1);
ITEM TEXTPOS U(0,12,12);
ITEM TEXTLEN U(0,24,12);
ITEM AFTERPOS U(0,36,12);
END
PROC MOVESTR(WHICH,BUF,LEN,MAXLEN);
# TITLE MOVESTR - MOVE STRING. #
BEGIN # MOVESTR #
#
* MOVESTR - MOVE STRING.
*
* *MOVESTR* MOVES A STRING FROM THE COMMAND LINE TO THE
* LINE BUFFER.
*
* PROC MOVESTR(WHICH,BUF,LEN,MAXLEN)
*
* ENTRY WHICH - TYPE OF STRING.
* BUF - LINE BUFFER TO UPDATE.
* LEN - LINE BUFFER LENGTH.
* MAXLEN - MAXIMUM STRING LENGTH.
*
* EXIT STRING MOVED TO LINE BUFFER.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS ERRJUMP.
#
ARRAY BUF[0:99];
BEGIN # ARRAY BUF #
ITEM LINEBUF I; # LINE BUFFER #
END # ARRAY BUF #
ITEM WHICH I; # TYPE OF STRING #
ITEM LEN I; # LINE BUFFER LENGTH #
ITEM MAXLEN I; # MAXIMUM STRING LENGTH #
ITEM TMP1 I; # TEMPORARY STORAGE #
IF TEXTLEN[WHICH] GR MAXLEN THEN # IF STRING TOO LARGE #
BEGIN
ERRJUMP("STRING GREATER THAN 80 CHARACTERS$");
END
LEN=TEXTLEN[WHICH];
LINEBUF[0]=NULLIN;
FOR TMP1=1 STEP 1 UNTIL LEN DO # MOVE STRING #
BEGIN
GETCHAR(CMDLINE,TEXTPOS[WHICH]+TMP1-1,TMP2);
SETCHAR(LINEBUF,TMP1-1,TMP2);
END
SETCHAR(LINEBUF,LEN,CENDLINE);
SCHSTRSPEC=TRUE; # SEARCH STRING SPECIFIED #
END # MOVESTR #
# MAIN CODE STARTS HERE #
NUMSTRING=0;
POINTER=TOKENPOS;
DELIM=TOKENCHAR;
LOOP:
NUMSTRING=NUMSTRING+1;
CTLWORD[NUMSTRING]=0;
TEXTPOS[NUMSTRING]=POINTER+1;
NONDOT=FALSE;
TMP1=-1;
FOR TMP2=POINTER+1 STEP 1 WHILE TMP2 LS LENGTH(CMDLIN)
AND TMP1 LS 0 DO
BEGIN
GETCHAR(CMDLINE,TMP2,TMP3);
IF TMP3 NQ DELIM AND TMP3 NQ CPERIOD THEN NONDOT=TRUE;
IF TMP3 EQ DELIM THEN TMP1=TMP2;
END
IF TMP1 GQ 0 THEN
BEGIN
CLOSED[NUMSTRING]=TRUE;
TEXTLEN[NUMSTRING]=TMP1-TEXTPOS[NUMSTRING];
IF TEXTLEN[NUMSTRING] GR 0 AND NOT NONDOT
THEN ALLDOTS[NUMSTRING]=TRUE;
AFTERPOS[NUMSTRING]=TMP1+1;
POINTER=TMP1;
IF NUMSTRING LQ 4 THEN GOTO LOOP;
END
ELSE
BEGIN
TEXTLEN[NUMSTRING]=LENGTH(CMDLIN)-TEXTPOS[NUMSTRING];
AFTERPOS[NUMSTRING]=LENGTH(CMDLIN);
#GOTO PHASE2#
END
PHASE2:
IF WHICHSTR EQ 1 THEN # INSERT, ALTER, SET KEY #
BEGIN
MOVESTR(1,TTYLIN,TMP1,BUFCM1);
TXTINCMD=TRUE;
SCANPOS=AFTERPOS[1];
END
ELSE IF WHICHSTR EQ 2 THEN # LOCATE #
BEGIN
WORDSEARCH=FALSE;
UPPERSEARCH=FALSE;
IF ALLDOTS[2] AND NUMSTRING GQ 3 THEN
BEGIN
ELLIPSIS=TRUE;
IF TEXTLEN[1] NQ 0 THEN MOVESTR(1,LOCSTRING1,LOCSTRLEN1,80);
IF TEXTLEN[3] NQ 0 THEN MOVESTR(3,LOCSTRING2,LOCSTRLEN2,80);
SCANPOS=AFTERPOS[3];
END
ELSE
BEGIN
IF TEXTLEN[1] NQ 0 THEN MOVESTR(1,LOCSTRING1,LOCSTRLEN1,80);
ELLIPSIS=FALSE;
SCANPOS=AFTERPOS[1];
END
END
ELSE IF WHICHSTR EQ 3 THEN # REPLACE #
BEGIN
WORDSEARCH=FALSE;
UPPERSEARCH=FALSE;
IF ALLDOTS[2] AND NUMSTRING GQ 4 THEN
BEGIN
IF TEXTLEN[4] EQ 0 AND NOT CLOSED[4]
THEN ERRJUMP("MISSING REPLACEMENT STRING$");
ELLIPSIS=TRUE;
IF TEXTLEN[1] NQ 0 THEN MOVESTR(1,LOCSTRING1,LOCSTRLEN1,80);
IF TEXTLEN[3] NQ 0 THEN MOVESTR(3,LOCSTRING2,LOCSTRLEN2,80);
MOVESTR(4,CHGSTRING1,CHGSTRLEN1,80);
SCANPOS=AFTERPOS[4];
END
ELSE IF NUMSTRING GQ 2 THEN
BEGIN
IF TEXTLEN[2] EQ 0 AND NOT CLOSED[2]
THEN ERRJUMP("MISSING REPLACEMENT STRING$");
IF TEXTLEN[1] NQ 0 THEN
BEGIN
MOVESTR(1,LOCSTRING1,LOCSTRLEN1,80);
ELLIPSIS=FALSE;
END
MOVESTR(2,CHGSTRING1,CHGSTRLEN1,80);
SCANPOS=AFTERPOS[2];
END
END
WHICHSTR=-1;
TOKEN;
END # OF SCANSTR #
PROC SCNEOC;
BEGIN
#
** SCNEOC - VERIFY END OF COMMAND.
*
* SCNEOC IS CALLED TO MAKE SURE THERE IS NO UNSCANNED
* SYNTAX LEFT IN THE CURRENT COMMAND.
*
* ENTRY SCANPOS, TOKENPOS BRACKET CURRENT SYNTAX.
* TOKENCHAR IS CURRENT CHARACTER.
*
* CALLS ERRJUMP.
#
IF SYNTAXCHAR[TOKENCHAR] THEN ERRJUMP("TOO MANY PARAMETERS$");
END # OF SCNEOC #
PROC SCNONOFF(BOOL);
BEGIN
#
** SCNONOFF - PARSE YES/NO SYNTAX.
*
* SCNONOFF RECOGNIZES YES/NO KEYWORDS AND TELLS THE CALLER
* WHICH WAS FOUND. SCNONOFF IS CALLED WHEN A YES/NO
* KEYWORD IS EXPECTED BUT HAS NOT YET BEEN ENCOUNTERED.
* THUS SCNONOFF VERIFIES THAT ONE OF THESE WORDS IS NEXT.
*
* ENTRY SCANPOS, TOKENPOS - BRACKET NEXT TOKEN.
* TOKENTYPE, KEYWDNDX - WHAT THE NEXT TOKEN IS.
*
* EXIT BOOL - WHICH KEYWORD.
* VIA ERRJUMP IF NEITHER.
* TOKENPOS, SCANPOS - ADVANCED TO NEXT TOKEN.
*
* CALLS TOKEN, ERRJUMP.
#
ITEM BOOL B;
SCANPOS=TOKENPOS;
KEYWDTYPE=3;
TOKEN;
IF TOKENTYPE EQ TYPST"LETTER" AND C<0,1>KEYWORD[KEYWDNDX] EQ "Y"
THEN BOOL=TRUE;
ELSE IF TOKENTYPE EQ TYPST"LETTER" AND C<0,1>KEYWORD[KEYWDNDX]
EQ "N" THEN BOOL=FALSE;
ELSE ERRJUMP("MUST SPECIFY YES OR NO$");
TOKEN;
END # OF SCNONOFF #
PROC SCNEQVAL; # SCAN "=VALUE" #
BEGIN
#
** SCNEQVAL - PARSE NUMERIC SYNTAX PARAMETER.
*
* SCNEQVAL IS USED BY COMMAND SCANNERS OTHER THAN "SCANNER"
* ITSELF. (SCANNER ITSELF HANDLES OR ROUTES TREATMENT OF
* NUMERIC PARAMETERS ON ITS OWN) SCNEQVAL IS USED BY COMMAND
* SCANNERS THAT EXPECT/DEMAND A NUMERIC VALUE. AN EQUAL
* SIGN IS ALLOWED TO PRECEED THE PARAMETER.
*
* ENTRY SCANPOS, TOKENPOS - BRACKET NEXT TOKEN.
* TOKENTYPE, TOKENVAL - DESCRIBE NEXT TOKEN.
*
* EXIT LINPTR1 - VALUE OF NUMBER.
* VIA ERRJUMP IF NO NUMBER FOUND.
* SCANPOS, TOKENPOS - ADVANCED TO NEXT TOKEN.
*
* CALLS TOKEN, ERRJUMP.
#
IF TOKENTYPE EQ TYPST"EQUAL" THEN TOKEN;
IF TOKENTYPE NQ TYPST"DIGIT" THEN ERRJUMP("VALUE MUST BE NUMERIC$");
LINPTR1=TOKENVAL;
TOKEN; # ADVANCE TO NEXT SYNTAX #
END # OF SCNEQVAL #
PROC SCNEQNAM(NAME);
BEGIN
#
** SCNEQNAM - PARSE ARBITRARY ALPHANUMERIC WORD.
*
* SCNEQNAM SCANS AN ARBITRARY ALPHANUMERIC WORD, POSSIBLY
* PRECEEDED BY AN EQUAL SIGN.
*
* ENTRY TOKENPOS, SCANPOS - BRACKET CURRENT SYNTAX.
* TOKENTYPE - DESCRIBES CURRENT SYNTAX.
*
* EXIT NAME - THE WORD SCANNED.
* SCANPOS, TOKENPOS - ADVANCED.
* SCNNAMPTR - POINTS TO WORD.
*
* CALLS TOKEN, ERRJUMP.
*
* USES ALL TOKENXXXX VARIABLES, KEYWDTYPE.
#
ITEM NAME C(7), TMP1;
IF TOKENTYPE EQ TYPST"EQUAL" THEN TOKEN;
IF TOKENTYPE NQ TYPST"LETTER" AND TOKENTYPE NQ TYPST"DIGIT"
THEN ERRJUMP("MUST SPECIFY FILE NAME$");
ELSE
BEGIN
TMP1=KEYWDTYPE;
KEYWDTYPE=0; # ENABLE MIXED LETTERS DIGITS #
SCANPOS=TOKENPOS; # SET FOR RESCAN #
TOKEN; # RESCAN THE CURRENT SYNTAX #
KEYWDTYPE=TMP1;
NAME=C<0,7>TOKENSYM;
SCNNAMPTR=SCANPOS;
TOKEN; # NEXT SYNTAX #
END
END # OF SCNEQNAM #
PROC SCNFILE(NAME);
BEGIN
#
** SCNFILE - SCAN PARENTHESIZED FILENAME.
*
* SCNFILE IS CALLED WHEN AN OPENING PARENTHESIS HAS BEEN
* DETECTED, AND PARSES OUT THE FILENAME AND ADVANCES THE
* SYNTAX BEYOND THE CLOSING PARENTHESIS.
*
* ENTRY SCANPOS, TOKENPOS - BRACKET CURRENT SYNTAX.
* TOKENCHAR - CURRENT CHARACTER.
*
* EXIT NAME - THE ARBITRARY ALPHANUMERIC WORD.
* SCANPOS, TOKENPOS - ADVANCED TO NEXT SYNTAX.
*
* CALLS TOKEN, SCNEQNAM.
*
* USES SCNNAMPTR, ALL TOKENXXXX VARIABLES.
#
ITEM NAME C(7);
SCNNAMPTR=TOKENPOS;
IF TOKENCHAR EQ CLPAREN THEN
BEGIN
TOKEN;
SCNEQNAM(NAME);
SCNNAMPTR=TOKENPOS;
IF TOKENCHAR EQ CRPAREN THEN SCNNAMPTR=TOKENPOS+1;
END
SCANPOS=SCNNAMPTR;
TOKEN;
END # OF SCNFILE #
PROC SCNCHAR;
BEGIN
#
** SCNCHAR - PARSE ARBITRARY PUNCTUATION OR ALTERNATE NAME.
*
* SCNCHAR IS CALLED WHEN WE EXPECT AN ARBITRARY PUNCTUATION
* MARK AS THE NEXT SYNTAX, OR AN ALTERNATE KEYWORD FOR
* BLANK OR SEMICOLON.
*
* ENTRY SCANPOS, TOKENPOS - BRACKET CURRENT SYNTAX.
* TOKENCHAR - CURRENT CHARACTER.
*
* EXIT LINPTR1 - THE CHARACTER. CONVERTED TO ACTUAL
* CHARACTER IF ALTERNATE KEYWORD WAS USED.
* SCANPOS, TOKENPOS - ADVANCED TO NEXT SYNTAX.
*
* MACROS GETCHAR.
*
* CALLS TOKEN.
*
* USES ALL TOKENXXXX VARIABLES, KEYWDTYPE(RESTORED).
#
ITEM TMP1;
IF NOT SYNTAXCHAR[TOKENCHAR] THEN LINPTR1=CNOTHING;
ELSE
BEGIN
TMP1=KEYWDTYPE;
KEYWDTYPE=0; # ENABLE MIXED LETTERS DIGITS #
SCANPOS=TOKENPOS; # SET FOR RESCAN #
TOKEN; # RESCAN THE CURRENT SYNTAX #
IF TOKENTYPE EQ TYPST"LETTER" AND C<0,7>TOKENSYM EQ "BLANK"
THEN LINPTR1=CBLANK;
ELSE IF TOKENTYPE EQ TYPST"LETTER" AND C<0,7>TOKENSYM EQ "SEMI"
THEN LINPTR1=CSEMCOLON;
ELSE
BEGIN
GETCHAR(CMDLINE,TOKENPOS,LINPTR1);
SCANPOS=TOKENPOS+1;
END
KEYWDTYPE=TMP1;
TOKEN;
END
END # OF SCNCHAR #
PROC SCNLSTCOL;
BEGIN
#
** SCNLSTCOL - PARSE A LIST OF NUMBERS INTO TAB VECTOR.
*
* SCNLSTCOL IS CALLED WHEN A LIST OF NUMBERS IS EXPECTED.
* WE DECODE EACH NUMBER AND PACK UP TO 20 OF THEM INTO
* EIGHT-BIT FIELDS IN A THREE-WORD VECTOR. THIS IS CURRENTLY
* NEEDED ONLY FOR THE "SET TABS" COMMAND.
*
* ENTRY TOKENPOS, SCANPOS - BRACKET FIRST NUMBER.
* TOKENVAL - VALUE OF FIRST NUMBER.
*
* EXIT TABVECTOR - ZEROED OR FILLED WITH PACKED LIST.
* TOKENPOS, SCANPOS - ADVANCED TO END OF COMMAND.
*
* CALLS TOKEN, ERRJUMP, SCNEOC.
*
* USES LINPTR1, LINPTR2, LINNUM1, LINNUM2, ALL TOKENXXXX.
#
ARRAY TEMPTABS [1:TABWORDS];
BEGIN
ITEM TMPTABWRD;
END
FOR LINPTR1=1 STEP 1 UNTIL TABWORDS DO
BEGIN
TMPTABWRD[LINPTR1]=0;
END
LINPTR2=0;
LINPTR1=1; # FIRST LEGAL COLUMN #
WHYLE TOKENTYPE EQ TYPST"DIGIT" AND LINPTR2 LS USERTABS DO
BEGIN
IF TOKENVAL LS LINPTR1 OR TOKENVAL GR BUFCHAR
THEN ERRJUMP("TAB STOP OUT OF BOUNDS$");
IF TOKENVAL GR 1 THEN
BEGIN
LINNUM1=LINPTR2/7;
LINNUM2=MOD(LINPTR2,7);
B<LINNUM2*8,8>TMPTABWRD[LINNUM1+1]=TOKENVAL-1;
LINPTR2=LINPTR2+1;
END
LINPTR1=TOKENVAL+1;
TOKEN;
END
SCNEOC;
MOVEWD(TABWORDS,TEMPTABS,TABVECTOR);
END # OF SCNLSTCOL #
PROC SCNFILOPT;
BEGIN
#
** SCNFILOPT - SCAN OPTIONS ALLOWABLE ON "FSE" COMMAND.
*
* SCNFILOPT PROVIDES ALL SCANNING FOR THE
* "FSE" COMMAND ONCE THE COMMAND VERB HAS BEEN RECOGNIZED.
* THE CALLER IS RESPONSIBLE TO CALL SCNEOC AFTER SCNFILOPT.
*
* ENTRY TOKENPOS, SCANPOS - BRACKET FIRST SYNTAX AFTER VERB.
*
* EXIT TOKENPOS, SCANPOS - BRACKET LAST KNOWN SYNTAX.
* GETPARM, CHARPARM - SET PER SYNTAX.
* FILNUM - 1 OR 2 PER "SPLIT" KEYWORD.
* SCREENMODE - ELIGIBLE TO USE "SPLIT" KEYWORD.
*
* CALLS SCNEQNAM, ERRJUMP, TOKEN.
*
* USES KEYWDTYPE, ALL TOKENXXXX VARIABLES.
#
DEF SFOMAXOPT #7#;
DEF SFOMAXLBL #5#;
STATUS SFOST
CSET1,
CSET2,
CSET3,
GET,
SPLIT,
READ;
SWITCH SFOLABELS SFOCS1, SFOCS2, SFOCS3, SFOGET, SFOSPLIT, SFOREAD;
ARRAY SFOMATCHES [0:SFOMAXOPT];
BEGIN
ITEM SFOKEY U(0,0,30) = [KEYST"XDIS", KEYST"XNOR",
KEYST"XASC", KEYST"XASC8", KEYST"XA8", KEYST"XGET",
KEYST"XSPL", KEYST"XREA" ];
ITEM SFOLBL U(0,30,30) = [ SFOST"CSET1", SFOST"CSET1",
SFOST"CSET2", SFOST"CSET3", SFOST"CSET3", SFOST"GET",
SFOST"SPLIT", SFOST"READ" ];
END
ITEM TMP1, TMP2;
SCNEQNAM(READNAM);
GETPARM=0;
CHARPARM=0;
FILNUM=1;
KEYWDTYPE=4;
SCANPOS=TOKENPOS;
KEYWDNDX=-1;
TOKEN;
WHYLE TOKENTYPE EQ TYPST"LETTER" OR TOKENTYPE EQ TYPST"DIGIT" DO
BEGIN
TMP2=-1;
FOR TMP1=0 STEP 1 UNTIL SFOMAXOPT DO IF SFOKEY[TMP1] EQ
KEYWDNDX THEN TMP2=SFOLBL[TMP1];
IF TMP2 LS 0 THEN
BEGIN
ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
END
GOTO SFOLABELS[TMP2];
SFOCS1:
CHARPARM=1;
GOTO SFODONE;
SFOCS2:
CHARPARM=2;
GOTO SFODONE;
SFOCS3:
CHARPARM=3;
GOTO SFODONE;
SFOGET:
GETPARM=2;
GOTO SFODONE;
SFOSPLIT:
FILNUM=2;
IF NOT SCREENMODE THEN ERRJUMP("SCREEN MODE REQUIRED$");
GOTO SFODONE;
SFOREAD:
GETPARM=3;
GOTO SFODONE;
SFODONE:
KEYWDNDX=-1;
TOKEN;
END
END # OF SCNFILOPT #
PAGE # MICRO EXPANSION #
PROC EXPANDCMDS;
BEGIN
#
** EXPANDCMDS - EXPAND MICROS FROM IN COMMAND LINE.
*
* EXPANDCMDS IS CALLED WHEN THE MAIN PROCESS DRIVER FINDS
* THAT THE MAIN SCREEN PROMPT FOR COMMANDS YIELDED ONE OR
* MORE MICROS (AMPERSAND SYMBOLS) SPECIFICALLY IN THE
* CONVERSION OF FUNCTION KEY STRIKES INTO COMMAND TEXT,
* OR IN FETCHING OF COMMAND LINES FROM PROCEDURES.
*
* ENTRY CMDLIN - COMMAND STRING CONTAINING MICROS.
* EXPANDAT - POINTS TO FIRST AMPERSAND.
* PROCACTIVE - MUST BE TRUE IF FORCED FALSE, OTHERWISE
* TREAT CALL AS NO-OP.
* CURFILE - CURRENT FILE BRACKET.
* FILENAM[CURFILE] - CURRENT FILE NAME.
* CURRENT - CURRENT LINE ADDRESS.
* TOPF(CURFILE) - UPPER BOUND FOR FILE.
* CURCURSOR - CURRENT CHARACTER POSITION IN FILE.
* LIN - TEXT OF CURRENT FILE LINE.
* ERRSTRING - USER'S ANNOUNCEMENT FOR "&?".
*
* EXIT CMDLIN - EXPANDED.
* &C REPLACED WITH CURRENT COLUMN.
* &F REPLACED WITH CURRENT FILENAME.
* &L REPLACED WITH CURRENT LINE ORDINAL.
* &P REPLACED WITH CURRENT PROCEDURE FILE NAME.
* &T REPLACED WITH CURRENT TERMINAL.
* &W REPLACED WITH CURRENT TEXT WORD.
* &Z REPLACED WITH CURRENT WORKFILE.
* &DIGIT REPLACED WITH PROC PARAMETER.
* &? REPLACED WITH INTERACTIVE INPUT.
* && REPLACED WITH &.
* EXPANDAT - DESTROYED.
*
* MACROS GETCHAR, SETCHAR, MOD.
*
* CALLS EXPANDNUM(INTERNAL), DSPLCOD, MIN, LSHIFT, RSHIFT,
* LENGTH, PROCPARM, ASKUSER.
#
ITEM TMP1;
ITEM I,J,K,L,M;
ITEM MSG C(80);
ITEM INCR;
PROC EXPANDNAME(NAME);
BEGIN
#
* EXPANDNAME - GENERATE NAME SPECIFIED IN PARAMETER.
#
ITEM NAME;
L=7;
FOR I=6 STEP -1 UNTIL 0 DO
BEGIN
K=B<I*6,6>NAME;
CONTROL IFNQ CBLANK,O"55"; ERROR; CONTROL FI;
IF K EQ CBLANK OR K EQ 0 THEN L=I;
END
L=MIN(L,BUFCM1-EXPANDAT); # ASSURE IT FITS #
LSHIFT(CMDLIN,EXPANDAT+2,2); # REMOVE &F #
RSHIFT(CMDLIN,EXPANDAT,L); # MAKE ROOM FOR NAME #
FOR I=0 STEP 1 UNTIL L-1 DO
BEGIN
# NEXT CODE REQUIRES INTERNAL CHARSET MAPS ON DISPLAY CODE #
CONTROL IFNQ CLETTERA,1; ERROR; CONTROL FI;
K=B<I*6,6>NAME;
SETCHAR(CMDLINE,J,K); # STORE NAME #
J=J+1;
END
INCR=L;
END # EXPANDNAME #
PROC EXPANDNUM;
BEGIN
#
** EXPANDNUM - GENERATE NUMBER SPECIFIED BY L.
*
* ENTRY L - NUMBER TO ENCODE.
* CMDLIN - LINE IMAGE.
* POSITION - CHARACTER LOCATION OF AMPERSAND.
*
* EXIT CMDLIN - UPDATED.
* INCR - INCREMENTED
* L - DESTROYED.
*
* USES I, K.
*
* NOTE SEE HEADER DOCUMENTATION FOR EXPAND.
#
LSHIFT(CMDLIN,EXPANDAT+1,1);
I=0;
INCR=1;
WHYLE L NQ 0 OR I EQ 0 DO
BEGIN
K=MOD(L,10)+CDIGIT0;
SETCHAR(CMDLINE,EXPANDAT,K);
L=L/10;
I=I+1;
IF L NQ 0 THEN
BEGIN
RSHIFT(CMDLIN,EXPANDAT,1);
INCR=INCR+1;
END
END
END # OF EXPANDNUM #
# MAIN CODE OF EXPAND STARTS HERE #
WHYLE EXPANDAT LS LENGTH(CMDLIN) DO
BEGIN
GETCHAR(CMDLINE,EXPANDAT,TMP1);
IF TMP1 NQ CAMPER THEN EXPANDAT=EXPANDAT+1;
ELSE
BEGIN
INCR=1;
J=EXPANDAT;
GETCHAR(CMDLINE,EXPANDAT+1,K);
DSPLCOD(K); # MAKE UPPER CASE #
IF K EQ CLETTERF THEN # &F = FILENAME #
BEGIN
EXPANDNAME(FILENAM[CURFILE]);
END
ELSE IF K EQ CLETTERW THEN # &W = CURRENT WORD #
BEGIN
L=0; # LENGTH OF WORD #
IF CURCURSOR LS LENGTH(LIN) THEN # MUST MEASURE #
BEGIN
J=CURCURSOR;
GETCHAR(LINE,J,K);
IF K EQ CBLANK THEN
BEGIN
WHYLE K EQ CBLANK DO
BEGIN
J=J+1;
GETCHAR(LINE,J,K);
END
END
IF K EQ CENDLINE THEN J=J-1;
IF B<K LAN 31,1>WORDFLAG[K/32] EQ 0 THEN J=J-1;
WHYLE J GQ 0 AND B<K LAN 31,1>WORDFLAG[K/32] EQ 1 DO
BEGIN
J=J-1;
GETCHAR(LINE,J,K);
END
I=J+1;
GETCHAR(LINE,I,K);
WHYLE K NQ CENDLINE AND B<K LAN 31,1>WORDFLAG[K/32] EQ 1 DO
BEGIN
I=I+1;
GETCHAR(LINE,I,K);
L=L+1;
END
END
L=MAX(L,1);
L=MIN(L,BUFCM1-EXPANDAT); # ASSURE FITS #
LSHIFT(CMDLIN,EXPANDAT+2,2); # EXTRACT &W #
RSHIFT(CMDLIN,EXPANDAT,L);
FOR I=1 STEP 1 UNTIL L DO # INSERT WORD #
BEGIN
GETCHAR(LINE,J+I,K);
SETCHAR(CMDLINE,EXPANDAT+I-1,K);
END
INCR=L;
END
ELSE IF K EQ CLETTERL THEN
BEGIN
L=CURRENT-TOPF(CURFILE);
EXPANDNUM;
END
ELSE IF K EQ CLETTERC THEN
BEGIN
L=CURCURSOR+1;
EXPANDNUM;
END
ELSE IF K EQ CLETTERP THEN
BEGIN # &P = PROCEDURE FILE NAME #
EXPANDNAME(PROCNAM);
END
ELSE IF K EQ CLETTERZ THEN
BEGIN
EXPANDNAME(WORKORG);
END
ELSE IF K EQ CLETTERT THEN
BEGIN
IF SCREENMODE THEN
BEGIN
C<00,07>M=TABMODNAME[0]; # TERMINAL PROCEDURE #
EXPANDNAME(M);
END
ELSE
BEGIN
M="LINE "; # LINE PROCEDURE #
EXPANDNAME(M);
END
END
ELSE IF K GR CDIGIT0 AND K LQ CDIGIT9 AND PROCACTIVE THEN
BEGIN
K=K-CDIGIT0; # PARAMETER NUMBER #
CONTROL IFEQ SINGLE,1;
PROCPARM(CMDLIN,J,K,BUFCM1,INCR);
CONTROL FI;
END
ELSE IF K EQ CAMPER THEN LSHIFT(CMDLIN,EXPANDAT+1,1);
ELSE IF K EQ CQUESTION THEN
BEGIN
MSG=ERRSTRING; # PRESERVE ANNOUNCEMENT #
IF MSG EQ " $" THEN MSG="ENTER TEXT$";
ASKUSER(MSG,QCCKWRD);
LSHIFT(CMDLIN,EXPANDAT+2,2); # KILL MICRO #
L=LENGTH(TTYLIN);
RSHIFT(CMDLIN,EXPANDAT,L);
FOR I=0 STEP 1 UNTIL L-1 DO
BEGIN
GETCHAR(TTYLINE,I,J);
SETCHAR(CMDLINE,EXPANDAT+I,J);
END
INCR=L;
END
EXPANDAT=EXPANDAT+INCR;
END
END
END # EXPANDCMDS #
CONTROL IFEQ SINGLE,1;
PROC PROCPARM(TXTLIN,POS,NDX,MAXPOS,INCR);
BEGIN
#
** PROCPARM - EXPAND MICRO FOR PROCEDURE PARAMETERS.
*
* PROCPARM IS CALLED BY EXPAND TO EXPAND ONE PROC PARAMETER
* MICRO, WHICH CONSISTS OF AN AMPERSAND FOLLOWED BY A DIGIT
* REPRESENTING THE PARAMETER ORDINAL. IF THERE ARE NOT
* ENOUGH PARAMETERS PROVIDED, THEN NULL OUT THE MICRO.
*
* ENTRY TXTLIN - INTERNAL LINE IMAGE PROVIDING TEXT.
* POS - WHERE THE MICRO IS IN TXTLIN.
* NDX - WHICH PARAMETER IS REQUESTED BY THE MICRO.
* MAXPOS - MAX CHARACTER CAPACITY IN TXTLIN.
*
* EXIT TXTLIN - UPDATED.
* POS - INCREMENTED PAST EXPANSION.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LSHIFT, RSHIFT.
#
ARRAY TXTLIN [0:99]; ITEM TXTLINE;
ITEM POS,NDX,MAXPOS,INCR;
ITEM TMP1,TMP2,TMP3,TMP4,TMP5,TMP6;
# FIRST SKIP PREVIOUS PARAMETERS AND BRACKET DESIRED PARM #
TMP1=PARMPTR;
FOR TMP2=1 STEP 1 UNTIL NDX DO
BEGIN
GETCHAR(PARMLINE,TMP1,TMP3);
# SKIP LEADING BLANKS #
WHYLE TMP3 EQ CBLANK DO
BEGIN
TMP1=TMP1+1;
GETCHAR(PARMLINE,TMP1,TMP3);
END
IF TMP3 EQ CCOMMA THEN TMP1=TMP1+1; # SKIP LEAD COMMA #
GETCHAR(PARMLINE,TMP1,TMP3);
WHYLE TMP3 EQ CBLANK DO # SKIP FURTHER BLANKS #
BEGIN
TMP1=TMP1+1;
GETCHAR(PARMLINE,TMP1,TMP3);
END
TMP4=TMP1; # SAVE START #
IF TMP3 NQ CCOMMA THEN # NOT SKIPPED PARAMETER #
BEGIN
# SKIP TO NEXT DELIMETER #
TMP5=CBLANK; # TWO NORMAL DELIMITERS #
TMP6=CCOMMA;
IF TYPE[TMP3] EQ TYPST"DELIMIT" THEN
BEGIN # STRING NEEDS EXACT DELIMIT #
TMP5=TMP3;
TMP6=TMP3;
END
IF TMP3 NQ CENDLINE THEN TMP3=-1;
WHYLE TMP3 NQ TMP5 AND TMP3 NQ TMP6 AND TMP3 NQ CENDLINE DO
BEGIN # LOOK FOR EITHER DELIM OR EOL #
TMP1=TMP1+1;
GETCHAR(PARMLINE,TMP1,TMP3);
END
# IF STOPPED DUE TO STRING END, ADVANCE PAST IT #
IF TMP3 EQ TMP5 AND TMP5 NQ CBLANK THEN TMP1=TMP1+1;
END
END
TMP1=TMP1-TMP4; # LENGTH #
TMP1=MIN(TMP1,MAXPOS-LENGTH(TXTLIN));
LSHIFT(TXTLIN,POS+2,2); # KILL @DIGIT #
RSHIFT(TXTLIN,POS,TMP1); # MAKE ROOM #
FOR TMP2=0 STEP 1 UNTIL TMP1-1 DO
BEGIN # COPY THE PARAMETER #
GETCHAR(PARMLINE,TMP4+TMP2,TMP3);
SETCHAR(TXTLINE,POS+TMP2,TMP3);
END
POS=POS+TMP1; # ADVANCE PAST EXPANSION #
INCR=TMP1;
END # OF PROCPARM #
CONTROL FI;
PAGE # UTILITY ROUTINES ONLY FOR EXEC #
FUNC FINDER(POS,LEN) B;
# TITLE FINDER - SEARCH CURRENT LINE OF TEXT IN ONE OF EIGHT WAYS. #
BEGIN # FINDER #
#
** FINDER - SEARCH CURRENT LINE OF TEXT IN ONE OF EIGHT WAYS.
*
* FUNC FINDER(POS,LEN)
*
* ENTRY FINDCONTROL - WHICH MANNER OF SEARCH.
* 0 = SIMPLE TEXT SEARCH.
* NONZERO = COMPLEX SEARCH.
* LIN - LINE OF TEXT TO SEARCH.
* LOCSTRING1, LOCSTRING2 - ONE OR BOTH STRINGS TO MATCH.
* LOCSTRLEN1, LOCSTRLEN2 - LENGTHS OF STRINGS.
* FIELDFLG, FIELDBGN, FIELDEND - COLUMN MODE, LIMITS.
* WORDSEARCH - MODE.
* UPPERSEARCH - MODE.
* ELLIPSIS - MODE.
* BACKWARD - MODE.
*
* EXIT FINDER - SUCCESS OR FAILURE.
* POS - CHARACTER POSITION WHERE WE MATCHED.
* LEN - LENGTH OF TOTAL MATCHED AREA.
*
* MACROS GETCHAR.
*
* CALLS FASTFND, FASTLNB, FIND, LENGTH.
*
* NOTE FINDCONTROL VALUES ARE DESIGNED TO FUNCTION AS
* INDEPENDENT BITS.
#
ITEM BOOL B; # FOUND FLAG #
ITEM FIRSTPOS I; # FIRST CHARACTER POSITION #
ITEM LASTPOS I; # LAST CHARACTER POSITION #
ITEM LEN I; # LENGTH OF MATCHED AREA #
ITEM LINLEN I; # LINE LENGTH #
ITEM LOOPINDEX1 I; # LOOP INDEX #
ITEM POS I; # CHARACTER POSITION OF MATCH #
ITEM QUIT B; # QUIT FLAG #
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
ITEM TMP3 I; # TEMPORARY STORAGE #
ITEM TMP4 I; # TEMPORARY STORAGE #
ITEM TMP5 I; # TEMPORARY STORAGE #
DEF BOTHCASE #O"03760 00000 00000 00000"#;
DEF CASELESS #O"01760 00000 00000 00000"#;
FUNC FIND(STRING,STRLEN,SLWOTS,POSITION) B;
# TITLE FIND - FIND STRING. #
BEGIN # FIND #
#
** FIND - FIND STRING.
*
* THE FIND ROUTINE IS DEPENDENT ON THE INTERNAL
* CHARACTER SET WORD FORMATTING.
*
* FUNC FIND(STRING,STRLEN,SLWOTS,POSITION)
*
* ENTRY POSITION - POSITION IN STRING.
* STRING - STRING TO SEARCH.
* STRLEN - STRING LENGTH.
* SLWOTS - STRING LENGTH WITHOUT TRAILING SPACES.
*
* EXIT BOOL - SUCCESS OR FAILURE.
*
* MACROS DSPLCOD, GETCHAR.
*
* CALLS DSPLCOD, FASTFND.
#
CONTROL IFNQ CLETTERA,1; BAD; CONTROL FI;
CONTROL IFNQ CLOWERA,65; BAD; CONTROL FI;
ARRAY STRING [0:99] P(1);
BEGIN # ARRAY STRING #
ITEM STRINGWORD I; # STRING WORD #
END # ARRAY STRING #
ITEM LOOPINDEX2 I; # LOOP INDEX #
ITEM POSITION I; # POSITION IN STRING #
ITEM STRLEN I; # STRING LENGTH #
ITEM SLWOTS I; # STRING LENGTH W/O TRAIL SPACES #
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
ITEM TMP3 I; # TEMPORARY STORAGE #
ITEM TMP4 I; # TEMPORARY STORAGE #
ITEM TMP5 I; # TEMPORARY STORAGE #
ITEM TMP6 I; # TEMPORARY STORAGE #
LOOPINDEX2=0;
BOOL=FALSE;
IF FIELDFLG THEN
SLWOTS=MAX(SLWOTS,MIN(STRLEN,STRLEN-FIELDEND+LASTPOS));
WHYLE (NOT BOOL) AND (FIRSTPOS LQ LASTPOS)
AND (LOOPINDEX2 LQ BUFCHAR) DO
BEGIN
LOOPINDEX2=LOOPINDEX2+1;
IF UPPERSEARCH THEN
BEGIN
POSITION=FIRSTPOS;
WHYLE (NOT BOOL) AND (POSITION LQ LASTPOS-SLWOTS+1) DO
BEGIN
TMP6=MIN(STRLEN,LASTPOS-POSITION+1);
GETCHAR(LINE,POSITION,TMP2);
GETCHAR(STRINGWORD,0,TMP3);
TMP4=TMP2;
TMP5=TMP3;
DSPLCOD(TMP4);
DSPLCOD(TMP5);
IF B<TMP2 LAN 31,1>WORDFLAG[TMP2/32] EQ 1 AND
B<TMP4 LAN 31,1>WORDFLAG[TMP4/32] EQ 1 THEN TMP2=TMP4;
IF B<TMP3 LAN 31,1>WORDFLAG[TMP3/32] EQ 1 AND
B<TMP5 LAN 31,1>WORDFLAG[TMP5/32] EQ 1 THEN TMP3=TMP5;
IF TMP2 EQ TMP3 THEN
BEGIN
BOOL=TRUE;
FOR TMP1=1 STEP 1 WHILE BOOL AND TMP1 LS TMP6 DO
BEGIN
GETCHAR(LINE,POSITION+TMP1,TMP2);
GETCHAR(STRINGWORD,TMP1,TMP3);
TMP4=TMP2;
TMP5=TMP3;
DSPLCOD(TMP4);
DSPLCOD(TMP5);
IF B<TMP2 LAN 31,1>WORDFLAG[TMP2/32] EQ 1 AND
B<TMP4 LAN 31,1>WORDFLAG[TMP4/32] EQ 1 THEN TMP2=TMP4;
IF B<TMP3 LAN 31,1>WORDFLAG[TMP3/32] EQ 1 AND
B<TMP5 LAN 31,1>WORDFLAG[TMP5/32] EQ 1 THEN TMP3=TMP5;
IF TMP2 NQ TMP3 THEN BOOL=FALSE;
END
END
IF NOT BOOL THEN POSITION=POSITION+1;
END
END
ELSE BOOL=FASTFND(LIN,LASTPOS,FIRSTPOS,STRING,STRLEN-1,SLWOTS-1,
POSITION,BOTHCASE);
IF BOOL AND WORDSEARCH THEN
BEGIN
IF POSITION NQ MIN(FIELDBGN,FIELDEND) THEN
BEGIN
GETCHAR(LINE,POSITION-1,TMP5);
IF B<TMP5 LAN 31,1>WORDFLAG[TMP5/32] EQ 1 THEN BOOL=FALSE;
END
IF BOOL AND POSITION+STRLEN LS MAX(FIELDBGN,FIELDEND) THEN
BEGIN
GETCHAR(LINE,POSITION+STRLEN,TMP5);
IF B<TMP5 LAN 31,1>WORDFLAG[TMP5/32] EQ 1 THEN BOOL=FALSE;
END
END
IF NOT BOOL THEN
BEGIN
FIRSTPOS=1+MAX(FIRSTPOS,POSITION);
IF NOT (WORDSEARCH OR UPPERSEARCH) THEN FIRSTPOS=LARGENUM;
END
END
FIND=BOOL;
END # FIND #
# MAIN FINDER CODE STARTS HERE #
LINLEN=LENGTH(LIN);
LASTPOS=LINLEN-1;
FINDER=FALSE;
IF LASTPOS LS NUMWIDBLK THEN RETURN;
IF FINDCONTROL EQ 0 THEN
BEGIN
BOOL=FASTFND(LIN,LASTPOS,FIELDBGN,LOCSTRING1,LOCSTRLEN1-1,
FASTLNB(LOCSTRING1)-1,TMP2,BOTHCASE);
IF BOOL THEN
BEGIN
POS=TMP2;
LEN=LOCSTRLEN1;
END
FINDER=BOOL;
RETURN;
END
# ELSE NEED COMPLEX SEARCH ALGORITHM #
FIRSTPOS=MIN(FIELDBGN,FIELDEND);
LASTPOS=MAX(FIELDBGN,FIELDEND);
IF FIELDFLG THEN
BEGIN
IF BACKWARD THEN
BEGIN
IF (FIELDEND GQ LINLEN AND FIELDEND LS BUFCM1)
OR FIELDEND GR FIELDBGN THEN RETURN;
END
ELSE
BEGIN
IF (FIELDBGN GQ LINLEN AND FIELDBGN LS BUFCM1)
OR FIELDBGN GR FIELDEND THEN RETURN;
END
END
ELSE
BEGIN
IF (NOT BACKWARD) AND FIELDBGN GQ FIELDEND THEN LASTPOS=BUFCM1;
END
FIRSTPOS=MIN(FIRSTPOS,LINLEN-1);
LASTPOS=MIN(LASTPOS,LINLEN-1);
LOOPINDEX1=0;
QUIT=FALSE;
WHYLE NOT QUIT DO
BEGIN
LOOPINDEX1=LOOPINDEX1+1;
TMP2=FIRSTPOS;
IF ELLIPSIS THEN
BOOL=FIND(LOCSTRING1,LOCSTRLEN1,LOCSTRLEN1,TMP1);
ELSE
BOOL=FIND(LOCSTRING1,LOCSTRLEN1,FASTLNB(LOCSTRING1),TMP1);
TMP3=TMP1;
TMP4=LOCSTRLEN1;
IF ELLIPSIS AND BOOL THEN
BEGIN
FIRSTPOS=TMP3+TMP4;
IF FIRSTPOS LS LINLEN THEN
BOOL=FIND(LOCSTRING2,LOCSTRLEN2,FASTLNB(LOCSTRING2),TMP1);
ELSE BOOL=FALSE;
TMP4=TMP1+LOCSTRLEN2-TMP3;
END
IF BOOL THEN
BEGIN
FINDER=TRUE;
POS=TMP3;
LEN=TMP4;
FIRSTPOS=TMP2+1;
END
ELSE QUIT=TRUE;
IF (NOT BACKWARD) OR FIRSTPOS GQ LINLEN THEN QUIT=TRUE;
IF LOOPINDEX1 GQ BUFCHAR THEN QUIT=TRUE;
END
END # FINDER #
PROC SUBST;
# TITLE SUBST - TEXT SUBSTITUTION FOR REPLACE COMMAND. #
BEGIN # SUBST #
#
** SUBST - TEXT SUBSTITUTION FOR REPLACE COMMAND.
*
* THE SUBST ROUTINE IS CRUCIAL TO THE S COMMAND. IT DOES THE
* ACTUAL SEARCHING AND ALTERATION WITHIN THE CURRENT LINE.
* WE USE THE FINDER FUNCTION. OUR OUTER LOOP JUST KEEPS
* LOOKING FOR MORE AND MORE TARGET STRINGS ACROSS THE LINE.
* FOR EACH OF THEM, WE SUBSTITUTE, BUT ONLY AFTER WE HAVE
* ACCOUNTED FOR CHANGES IN LENGTH THAT CAN SHUFFLE TRAILING
* TEXT. TO ACCOMODATE FIELD-ORIENTATION, WE KEEP A COPY OF
* THE ORIGINAL TEXT AND REBUILD THE FINAL PART.
*
* PROC SUBST
*
* ENTRY LIN - INTERNAL LINE IMAGE TO SEARCH/CHANGE.
* LOCSTRING1, LOCSTRING2 - SEARCH KEY(S).
* CHGSTRING1 - REPLACEMENT TEXT.
* LOCSTRLEN1, LOCSTRLEN2, CHGSTRLEN1 - LENGTHS.
* FINDCONTROL - PER "FINDER" HEADER DOCUMENTATION.
* FIELDFLG, FIELDBGN, FIELDEND - PER FINDER.
* ELLIPSIS, WORDSEARCH, UPPERSEARCH - PER FINDER.
* SUBSTONCE - LOOP ONCE OR TO EXHAUSTION.
*
* EXIT LIN - CHANGED IF SEARCH SUCCEEDED.
* FOUND - WHETHER SEARCH SUCCEEDED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LENGTH, MOVEWD, FINDER, TRIMPAD.
*
* USES FIELDBGN WITH RESTORATION.
#
ITEM DELTA I; # CHANGE REQUESTED #
ITEM FINDBGN I; # BEGINNING OF FIELD #
ITEM FINDLEN I; # LENGTH OF FIELD #
ITEM HOLDBGN I; # HOLD BEGINNING OF FIELD #
ITEM HOLDEND I; # HOLD ENDING OF FIELD #
ITEM LINLEN I; # LINE LENGTH #
ITEM LOOPINDEX I; # LOOP INDEX #
ITEM QUIT B; # COMPLETE FLAG #
ITEM SUMDELTA I; # TOTAL CHANGE REQUESTED #
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
FOUND=FALSE;
IF NOT FINDER(FINDBGN,FINDLEN) THEN RETURN;
HOLDBGN=FIELDBGN; # MODIFY FIELD AND RESTORE #
HOLDEND=FIELDEND;
LINLEN=LENGTH(LIN);
SUMDELTA=0;
LOOPINDEX=0;
FOR TMP1=LINLEN+1 STEP 1 UNTIL BUFCM1 DO SETCHAR(LINE,TMP1,CBLANK);
MOVEWD(BUFWIDP1,LIN,TMPLIN);
QUIT=FALSE;
WHYLE FINDER(FINDBGN,FINDLEN) AND NOT QUIT DO
BEGIN
LINLEN=MAX(LINLEN,FINDBGN+FINDLEN);
LOOPINDEX=LOOPINDEX+1;
FOUND=TRUE;
NEWCURSOR=FINDBGN;
STRINGLEN=CHGSTRLEN1;
DELTA=FINDLEN-CHGSTRLEN1;
SUMDELTA=SUMDELTA+DELTA;
IF DELTA GR 0 THEN # SHRINK FIELD #
BEGIN
FOR TMP1=FINDBGN+FINDLEN STEP 1 UNTIL LINLEN DO
BEGIN
GETCHAR(LINE,TMP1,TMP2);
SETCHAR(LINE,TMP1-DELTA,TMP2);
END
END
ELSE IF DELTA LS 0 THEN # FIELD GROWS #
BEGIN
FOR TMP1=LINLEN STEP -1 UNTIL FINDBGN+FINDLEN DO
BEGIN
IF TMP1-DELTA LQ BUFCM1 THEN
BEGIN
GETCHAR(LINE,TMP1,TMP2);
SETCHAR(LINE,TMP1-DELTA,TMP2);
END
END
END
FOR TMP1=FINDBGN STEP 1 UNTIL FINDBGN+CHGSTRLEN1-1 DO
BEGIN
IF TMP1 LQ BUFCM1 THEN
BEGIN
GETCHAR(CHGSTR1,TMP1-FINDBGN,TMP2);
SETCHAR(LINE,TMP1,TMP2);
END
END
SETCHAR(LINE,BUFCHAR,CENDLINE);
LINLEN=LENGTH(LIN);
IF BACKWARD THEN
BEGIN
FIELDBGN=FINDBGN-1;
IF FIELDBGN LS FIELDEND THEN QUIT=TRUE;
END
ELSE
BEGIN
IF FIELDEND GR FINDBGN THEN FIELDEND=FIELDEND-DELTA;
FIELDBGN=FINDBGN+CHGSTRLEN1;
IF FIELDFLG AND FIELDBGN GR FIELDEND THEN QUIT=TRUE;
IF FIELDBGN GQ LINLEN THEN QUIT=TRUE;
END
IF SUBSTONCE THEN QUIT=TRUE;
IF LOOPINDEX GQ BUFCHAR THEN QUIT=TRUE;
END
IF NOT FOUND THEN RETURN;
FIELDBGN=HOLDBGN; # RESTORE FIELD #
FIELDEND=HOLDEND;
IF FIELDNDX GR 0 THEN
BEGIN
FIELDEND=MAX(FIELDBGN,FIELDEND);
FOR TMP1=LINLEN STEP 1 UNTIL FIELDEND DO SETCHAR(LINE,TMP1,CBLANK);
FOR TMP1=1 STEP 1 UNTIL SUMDELTA DO
BEGIN
SETCHAR(LINE,FIELDEND-TMP1+1,CBLANK);
END
FOR TMP1=FIELDEND+1 STEP 1 UNTIL BUFCM1 DO
BEGIN
GETCHAR(TMPLINE,TMP1,TMP2);
SETCHAR(LINE,TMP1,TMP2);
END
END
SETCHAR(LINE,BUFCHAR,CENDLINE);
TRIMPAD; # REMOVE BLANKS #
END # SUBST #
PROC XSHOW;
IOBEGIN(XSHOW)
#
** XSHOW - DISPLAY LINE AND TEST WIDTH.
*
* ENTRY LIN - LINE OF TEXT.
* DONTPRINT, SCREENMODE - CONTROL DISPLAY.
*
* CALLS CHECKWIDE, YSHOW.
#
YSHOW;
CHECKWIDE;
IOEND # OF XSHOW #
PROC YSHOW;
IOBEGIN(YSHOW)
#
** YSHOW - DISPLAY LINE.
*
* ENTRY LIN - TEXT TO DISPLAY.
* DONTPRINT, SCREENMODE - CONTROL DISPLAY.
* LCOUNT - EXISTING WORK ACCOUNTING.
*
* EXIT LCOUNT - INCREMENTED.
*
* CALLS PRINTL.
#
IF NOT (DONTPRINT OR SCREENMODE) THEN PRINTL;
LCOUNT=LCOUNT+1; # ACCURATE COUNT #
IOEND # OF YSHOW #
PROC PRINTL;
IOBEGIN(PRINTL)
#
** PRINTL - PRINT LINE.
*
* PRINTL PRINTS AN INTERNAL LINE IMAGE IN LINE MODE. FLOAT
* LINE ORDINALS ARE PRINTED FOR CERTAIN CONDTIONS.
*
* ENTRY SCREENMODE - SHOULD NOT BE CALLED UNLESS OFF.
* LIN - INTERNAL LINE IMAGE TO PRINT.
* FLOAT - MODE FOR DISPLAY OF ORDINALS.
* CURRENT, CURFILE - WHERE WE ARE IN FILES.
* TOPF(CURFILE) - BOUNDS/RELOCATION FACTOR.
* NUMBERED[CURFILE] - OVERRIDES FLOAT IF NON-ZERO.
* USRNUMCOL - NQ 1, IF SET BY *SET VIEW COLUMNS*.
*
* CALLS PUSHTEMP, CONVOUT, TTLPAD, TTSTR, TTSYNC, VDTWTC,
* VDTWTO, POPTEMP. FORMERLY ALSO FIXCTL.
*
* USES TEMP WITH RESTORATION.
*
* NOTE SINCE FSE ALWAYS DRIVES TERMINAL IN EITHER 6/12
* ASCII OR 8/12 TRANSPARENT MODES, WE CAN COMMENT-OUT
* LOGIC USING FIXCTL TO SUPPRESS ACCIDENTAL/MALICIOUS
* ISSUANCE OF NOS CONTROL BYTES. THIS OLD LOGIC
* SHOULD BE RE-ENABLED IF THE EDITOR IS MODIFIED
* TO DRIVE THE TERMINAL IN SIMPLE DISPLAY CODE.
* PRINTL PLACES AN END OF LINE CHARACTER (INTERNAL)
* INTO THE INTERNAL LINE IMAGE BEFORE TRANSLATION
* AND THEN RESTORES THE ACTUAL CHARACTER. THIS
* ALLOWS THE USE OF *SET VIEW COLUMNS* IN LINE MODE.
* USRNUMCOL IS OFFSET BY FIVE TO PREVENT AUTOMATIC
* TERMINAL WRAPPING AND CORRECT FOR LINE NUMBERS
* FROM 1 TO 9999. FOR LINES PAST 9999 THE USER
* SHOULD DO A SET VIEW COLUMNS TO A SMALLER VALUE.
#
PUSHTEMP;
IF USRNUMCOL NQ 1 THEN
BEGIN # IF USER HAS SET COLUMNS #
GETCHAR(LINE,USRNUMCOL-5,TEMP);
SETCHAR(LINE,USRNUMCOL-5,CENDLINE);
END
CONTROL IFEQ SINGLE,1;
IF TTYOUTPUT OR ASCII[CURFILE] GQ 2 THEN CONVOUT(LIN,2);
ELSE CONVOUT(LIN,1);
CONTROL FI;
CONTROL IFEQ MULTI,1;
CONVOUT(LIN,2);
CONTROL FI;
IF USRNUMCOL NQ 1 THEN
BEGIN # IF USER HAS SET COLUMNS #
SETCHAR(LINE,USRNUMCOL-5,TEMP);
END
#IF FIXCTL(BUFWID2P1,TMPLIN) THEN TTLIN(APPROPO WARNING)#
IF FLOAT AND NUMBERED[CURFILE] EQ 0 THEN
BEGIN
CONTROL IFEQ SINGLE,1;
TEMP=CURRENT-TOPF(CURFILE);
IF TTYOUTPUT THEN
BEGIN
IF TEMP GR 9999 THEN TTLPAD(TEMP,8," ");
ELSE TTLPAD(TEMP,4," ");
TTSTR(BLANKWRD);
END
ELSE
BEGIN
ITEM POS, BUFF C(10);
BUFF=" ";
POS=7;
WHYLE TEMP NQ 0 DO
BEGIN
C<POS,1>BUFF=O"33"+MOD(TEMP,10);
POS=POS-1;
TEMP=TEMP/10;
END
VDTWTO(BUFF);
END
CONTROL FI;
CONTROL IFEQ MULTI,1;
TEMP=CURRENT-TOPF(CURFILE);
IF TEMP GR 9999 THEN TTLPAD(TEMP,8," ");
ELSE TTLPAD(TEMP,4," ");
TTSTR(BLANKWRD);
CONTROL FI;
END
TTSYNC;
VDTWTC(TMPLIN);
POPTEMP;
IOEND # OF PRINTL #
PROC CHECKWIDE;
IOBEGIN(CHECKWIDE)
#
** CHECKWIDE - CHECK LINE FOR EXCESS WIDTH.
*
* CHECKWIDE ENFORCES THE "SET VIEW WARN" PARAMETER BY
* TESTING LINE IMAGE LENGTH AND FOR OVERSIZE LINE, WE
* SET UP THE WARNING MESSAGE AND TRIGGER SHUTDOWN OF
* DORANGE PROCESSING.
*
* ENTRY LIN - INTERNAL LINE IMAGE TO TEST.
* WIDTH - THRESHHOLD.
* NUMWIDBLK - FOR SEQUENCED FILES, NUMBER OF DIGITS.
*
* EXIT ERRSTRING - SET VIA "HALT" IF WIDE.
* LINCTR - LARGENUM IF WIDE TO STOP DORANGE.
*
* CALLS LENGTH, HALT.
#
IF LENGTH(LIN) GR WIDTH+NUMWIDBLK
AND PROCESSNDX NQ KEYST"DCMD"
AND PROCESSNDX NQ KEYST"HCMD" THEN
BEGIN
HALT("WIDE LINE$");
LINCTR=LARGENUM;
END
IOEND # OF CHECKWIDE #
PROC GETMOD;
IOBEGIN(GETMOD)
#
** GETMOD - PROMPT FOR ALTERATION MASK.
*
* GETMOD IS CALLED ANYTIME THE ALTER COMMAND REQUIRES
* ADDITIONAL INTERACTION WITH THE USER TO OBTAIN THE
* CHARACTER STRING WHICH WILL MASK THE ALTERATIONS.
*
* ENTRY LINPTR1 - LINE ADDRESS FOR START OF RANGE.
* FLOAT - CONTROLS PROMPT ALIGNMENT FOR LINEMODE.
* SCREENMODE - SHOULD BE OFF IF THIS ROUTINE CALLED.
* CURFILE - WHICH FILE BRACKET IS TO BE ALTERED.
* NUMBERED[CURFILE] - CONTROL PROMPTS ALIGNMENT.
* ASCII[CURFILE] - CONTROLS LOWERCASE SUPPRESSION.
*
* EXIT TTYLIN - CONTAINS ALTERATION MASK.
*
* CALLS PUSHTEMP, TTST, POSZ, PRINTL, PROMPT, CONVIN, TRIM,
* SQUELCH, POPTEMP.
*
* USES TEMP WITH RESTORATION, LIN, CURRENT.
#
PUSHTEMP;
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT THEN
BEGIN
PROMPT(NULLWRD);
GOTO GETMOD2;
END
CONTROL FI;
IF FLOAT OR NUMBERED[CURFILE] NQ 0 THEN TEMP=0;
ELSE TEMP=4;
TTST(" ",TEMP);
POSZ(LINPTR1);
PRINTL;
IF NUMBERED[CURFILE] NQ 0 THEN TEMP=NUMWIDBLK-4;
ELSE IF FLOAT AND CURRENT-TOPF(CURFILE) GR 9999 THEN TEMP=5;
ELSE IF FLOAT THEN TEMP=1;
ELSE TEMP=0;
TTST(" ",TEMP);
IF TEMP LAN 1 EQ 1 THEN PROMPT(AQCCKWRD);
ELSE PROMPT(AQCKWRD);
GETMOD2:
CONVIN(TTYLIN,2);
TRIM(TTYLIN,1);
IF ASCII[CURFILE] LQ 1 THEN SQUELCH(TTYLIN);
POPTEMP;
IOEND # OF GETMOD #
PROC APPEND;
BEGIN
#
** APPEND - APPEND TTYLIN ONTO LIN.
*
* APPEND MERGES TWO INTERNAL LINE IMAGES WITH SOFT-TABS
* INTERPRETED AS NEEDED.
*
* ENTRY LIN - INTERNAL LINE IMAGE TO APPEND ONTO.
* TTYLIN - INTERNAL LINE IMAGE TO APPEND.
*
* ENTRY LIN - UPDATED.
* TMPLIN - POSSIBLY DESTROYED.
*
* CALLS TRIMPAD, CONCAT, EXCHWD, DOTAB.
#
ITEM TMP1;
TRIMPAD;
TMP1=LENGTH(LIN);
CONCAT(LIN,TTYLIN);
EXCHWD(BUFWIDP1,LIN,TTYLIN); # SO DOTAB WORKS #
DOTAB(TMP1,TMP1,NUMWIDBLK);
EXCHWD(BUFWIDP1,TTYLIN,LIN);
END # OF APPEND #
PROC STRETCH;
BEGIN
#
** STRETCH - ADD BLANKS INSIDE A LINE IMAGE.
*
* STRETCH ADDS 30 BLANKS INSIDE A LINE WITH ATTENTION
* TO THE EDITFIELD RESTRICTION.
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* CURCURSOR - WHERE TO ADD 30 BLANKS.
*
* EXIT LIN - UPDATED.
*
* MACROS SETCHAR.
*
* CALLS SAVEPROT, LENGTH, RSHIFT, TRIMPAD, MERGEPROT.
*
* USES PROTLIN.
#
ITEM TMP1, TMP2;
TMP1=CURCURSOR;
SAVEPROT;
IF TMP1 LS LENGTH(LIN) THEN
BEGIN
RSHIFT(LIN,TMP1,30);
FOR TMP2=TMP1 STEP 1 UNTIL
TMP1+29 DO SETCHAR(LINE,TMP2,CBLANK);
END
TRIMPAD;
MERGEPROT;
END # OF STRETCH #
PROC SQUEEZE;
# TITLE SQUEEZE - REMOVE BLANKS THEN NONBLANKS THEN BLANKS. #
BEGIN # SQUEEZE #
#
** SQUEEZE - REMOVE BLANKS THEN NONBLANKS THEN BLANKS.
*
* PROC SQUEEZE
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* CURCURSOR - WHERE IN LIN TO UPDATE.
*
* EXIT LIN - UPDATED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LENGTH, LSHIFT, MERGEPROT, SAVEPROT, TRIMPAD.
*
* USES PROTLIN.
#
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
ITEM TMP3 I; # TEMPORARY STORAGE #
TMP1=CURCURSOR;
SAVEPROT;
IF TMP1 LS LENGTH(LIN) THEN
BEGIN
TMP2=TMP1;
GETCHAR(LINE,TMP2,TMP3);
IF TMP3 EQ CBLANK THEN
BEGIN
WHYLE TMP3 EQ CBLANK DO
BEGIN
TMP2=TMP2+1;
GETCHAR(LINE,TMP2,TMP3);
END
END
ELSE
BEGIN
IF B<TMP3 LAN 31,1>WORDFLAG[TMP3/32] EQ 0 THEN TMP2=TMP2+1;
ELSE
BEGIN
WHYLE B<TMP3 LAN 31,1>WORDFLAG[TMP3/32] EQ 1 DO
BEGIN
TMP2=TMP2+1;
GETCHAR(LINE,TMP2,TMP3);
END
WHYLE TMP3 EQ CBLANK DO
BEGIN
TMP2=TMP2+1;
GETCHAR(LINE,TMP2,TMP3);
END
END
END
LSHIFT(LIN,TMP2,TMP2-TMP1);
END
TRIMPAD;
MERGEPROT;
END # SQUEEZE #
CONTROL IFEQ SINGLE,1;
PROC DOCENTER;
BEGIN
#
** DOCENTER - ALIGN TEXT IN CENTER OF MARGINS.
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* FILLEFT, FILLRIGHT - MARGINS.
* CURFILE, NUMBERED[CURFILE] - CONTROL TEXT ALIGNMENT.
*
* EXIT LIN - UPDATED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS GETLNUM, LSHIFT, RSHIFT, TRIM, LENGTH, SETLNUM.
*
* USES LINENO, WIDTHFOUND.
#
ITEM TMP1, TMP2, TMP3, TMP4;
# FIND FIRST NON-BLANK #
TMP1=-1;
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
GETLNUM;
LSHIFT(LIN,NUMWIDBLK,NUMWIDBLK);
END
TRIM(LIN,0);
TMP4=LENGTH(LIN);
FOR TMP2=0 STEP 1 UNTIL TMP4 DO
BEGIN
GETCHAR(LINE,TMP2,TMP3);
IF TMP3 NQ CBLANK AND TMP1 LS 0 THEN TMP1=TMP2;
END
# CENTER LINE ONLY IF NON-NULL AND NOT TOO LARGE #
TMP4=TMP4-TMP1;
IF TMP1 GQ 0 AND TMP4 LQ FILLRIGHT-FILLLEFT+1 THEN
BEGIN
# ELIMINATE LEADING BLANKS #
LSHIFT(LIN,TMP1,TMP1);
# COMPUTE PADDING FACTOR AND REALIGN #
TMP2=(FILLRIGHT-FILLLEFT+1)-TMP4; # NUMBER OF XTRA BLANKS #
TMP2=TMP2/2; # SPLIT THE DIFFERENCE #
TMP2=TMP2+FILLLEFT; # ADD FIELD START POINT #
RSHIFT(LIN,0,TMP2);
FOR TMP1=1 STEP 1 UNTIL TMP2 DO SETCHAR(LINE,TMP1-1,CBLANK);
END
# RESTORE SEQUENCE NUMBER #
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
RSHIFT(LIN,0,NUMWIDTH+BLANKS);
FOR TMP1=1 STEP 1 UNTIL NUMWIDTH DO SETCHAR(LINE,TMP1-1,CDIGIT0);
SETLNUM;
END
END # OF DOCENTER #
CONTROL FI;
PROC DOMOD;
BEGIN
#
** DOMOD - PERFORM MASKED ALTERATIONS ON LINE IMAGE.
*
* DOMOD IMPLEMENTS THE TEXT PROCESSING FOR THE ALTER
* COMMAND. WE SCAN THE TTYLIN, AND ACT UPON EACH CHARACTER
* ALTERING LIN. THE CALLER IS RESPONSIBLE FOR HONORING THE
* EDITFIELD RESTRICTION.
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* TTYLIN - ALTERATION MASK.
* COPCHAR, BLKCHAR, DELCHAR, INSCHAR, TRNCHAR -
* ACTION SYMBOLS.
*
* EXIT LIN - UPDATED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS PAD, MOVEWD, LENGTH, TRIMPAD.
*
* USES TMPLIN.
#
ITEM TMP1,TMP2,TMP3;
ITEM NEWPOS,TTYCHAR;
ITEM LINLEN, TTYLEN;
ITEM LINPOS,TTYPOS;
LINLEN=LENGTH(LIN);
TTYLEN=LENGTH(TTYLIN);
PAD(LIN);
MOVEWD(BUFWIDP1,LIN,TMPLIN);
LINPOS=NUMWIDBLK;
TTYPOS=0;
NEWPOS=LINPOS;
WHYLE TTYPOS LS TTYLEN AND LINPOS LQ BUFCM1 AND
NEWPOS LQ BUFCM1 DO
BEGIN
GETCHAR(TTYLINE,TTYPOS,TTYCHAR);
IF TTYCHAR EQ COPCHAR THEN # COPY 1 CHAR #
BEGIN
GETCHAR(TMPLINE,NEWPOS,TMP2);
SETCHAR(LINE,LINPOS,TMP2);
NEWPOS=NEWPOS+1;
TTYPOS=TTYPOS+1;
LINPOS=LINPOS+1;
END
ELSE IF TTYCHAR EQ BLKCHAR THEN # GEN A BLANK #
BEGIN
SETCHAR(LINE,LINPOS,CBLANK);
NEWPOS=NEWPOS+1;
TTYPOS=TTYPOS+1;
LINPOS=LINPOS+1;
END
ELSE IF TTYCHAR EQ DELCHAR THEN # DELETE A BUNCH #
BEGIN
# FIND OUT HOW MANY #
TMP2=0;
FOR TMP1=TTYPOS STEP 1 UNTIL TTYLEN DO
BEGIN
GETCHAR(TTYLINE,TMP1,TMP3);
IF TMP2 EQ 0 AND TMP3 NQ DELCHAR THEN TMP2=TMP1;
END
# TMP2 GUARANTEED #
TMP2=TMP2-TTYPOS; # NOW LENGTH OF DELETION #
TTYPOS=TTYPOS+TMP2;
NEWPOS=NEWPOS+TMP2;
END
ELSE IF TTYCHAR EQ INSCHAR THEN # INSERT A BUNCH #
BEGIN
# SCAN FOR ENTIRE INSERT #
TMP2=0;
FOR TMP1=TTYPOS+1 STEP 1 UNTIL TTYLEN DO
BEGIN
GETCHAR(TTYLINE,TMP1,TMP3);
IF TMP2 EQ 0 AND TMP3 EQ DELCHAR THEN TMP2=TMP1;
END
# TMP2 NOT GUARANTEED #
IF TMP2 EQ 0 THEN TMP2=TTYLEN;
# NOW COPY INSERTED SECTION #
FOR TMP1=TTYPOS+1 STEP 1 WHILE TMP1 LS TMP2
AND LINPOS LQ BUFCM1 DO
BEGIN
GETCHAR(TTYLINE,TMP1,TMP3);
SETCHAR(LINE,LINPOS,TMP3);
LINPOS=LINPOS+1;
END
# NOW COPY TYPED-OVER SECTION #
FOR TMP1=0 STEP 1 UNTIL TMP2-TTYPOS DO
BEGIN
IF LINPOS GQ BUFCHAR OR NEWPOS GQ BUFCHAR THEN TEST;
GETCHAR(TMPLINE,NEWPOS,TMP3);
SETCHAR(LINE,LINPOS,TMP3);
NEWPOS=NEWPOS+1;
LINPOS=LINPOS+1;
END
TTYPOS=MIN(TMP2+1,TTYLEN);
END
ELSE IF TTYCHAR EQ TRNCHAR THEN # TRUNCATE SOURCE #
BEGIN
FOR TMP1=NEWPOS STEP 1 UNTIL BUFCM1
DO SETCHAR(TMPLINE,TMP1,CBLANK);
TTYPOS=TTYPOS+1;
END
ELSE # JUST OVERSTRIKE #
BEGIN
SETCHAR(LINE,LINPOS,TTYCHAR);
TTYPOS=TTYPOS+1;
NEWPOS=NEWPOS+1;
LINPOS=LINPOS+1;
END
END # OF LOOP #
# FINALLY COPY BACK ANY TRAILING PART FROM TMPLIN #
TMP3=LINPOS;
FOR TMP1=NEWPOS STEP 1 UNTIL BUFCM1 DO
BEGIN
GETCHAR(TMPLINE,TMP1,TMP2);
IF TMP3 LQ BUFCM1 THEN
BEGIN
SETCHAR(LINE,TMP3,TMP2);
TMP3=TMP3+1;
END
END
SETCHAR(LINE,TMP3,CENDLINE);
TRIMPAD;
END # OF DOMOD #
CONTROL IFEQ MULTI,1;
PROC MULTMOV;
IOBEGIN(MULTMOV)
#
** MULTMOV - COPY/MOVE COMMANDS, EASY CONDITIONS.
*
* MULTMOV PERFORMS THE COPY AND MOVE COMMANDS IN MULTI-USER
* MODE UNDER EASY CONDITIONS - LESS THAN 40 LINES IN THE
* SOURCE BLOCK AND LINE BOUNDARIES AS OPPOSED TO CHARACTER
* BOUNDARIES.
*
* ENTRY COMMAND PROCESSOR HAS RECOGNIZED VERB.
* TOKEN ADVANCED BUT NO OTHER SCANNING DONE.
* TOKENTYPE, SCANPOS, TOKENPOS, ETC - AS ABOVE.
* CURFILE, CURSPLIT, CURRENT - DEFAULT ADDRESS.
* CHARRANGE - CHARACTER OR LINE RANGE BOUNDS.
* SCREENMODE - FINAL POSITIONING/PRINTING.
* WIDTH - THIS SETTING WILL BE IGNORED.
* BLANKS - THIS SETTING WILL BE IGNORED.
*
* EXIT CURFILE, CURRENT - FINAL RESTING PLACE.
* (ANOTHER FILE MAY HAVE BEEN OPENED)
*
* CALLS DOSEGMENT(INTERNAL), MIN, POSZ, PUSH, SQUELCH,
* SETLNUM, TRIMPAD, INSX, DORANGE, POP, DELX, FWDZ,
* SCANNER, FITNUM, HALT, VFYLOCK.
*
* USES LINPTR1-3, CHRPTR1-3, FILPTR1-3, LINNUM1-3,
* LINCTR, LIMIT, LINENO, P<LINEBUF>, LCOUNT,
* REGLINE[RNGTOPREG], REGLINE[RNGBOTREG], FOUND.
#
XREF LABEL QQSINGLE;
PROC DOSEGMENT;
IOBEGIN(DOSEGMENT)
#
** DOSEGMENT - MULTMOV INTERNAL ALGORITHM.
*
* DOSEGMENT EXISTS BECAUSE THE MAJOR ALGORITHM OF MULTMOV
* MUST BE EXECUTED TWICE - THUS THIS ROUTINE CONSOLIDATES
* CODE. THE ALGORITHM MUST OPERATE ON (POTENTIALLY) TWO
* SEGMENTS TO PREVENT AN INFINITE DUPLICATION OF FILE
* CONTENT FOR A COPY TO A TARGET WITHIN THE SOURCE RANGE.
*
* ENTRY LINPTR1, LINPTR2 - FIRST AND LAST LINES OF SOURCE.
* LIMIT - NUMBER OF LINES IN SOURCE.
* LINPTR3 - TARGET ADDRESS TO INSERT AFTER.
* FILPTR1, FILPTR3 - FILE ASSOCIATIONS.
* TWO LEVELS OF POSITIONING STACK - USED TO PRESERVE
* SECOND SEGMENT BOUNDS WHILE PROCESSING FIRST.
*
* EXIT TWO LEVELS OF STACK - RELOCATED PROPERLY.
* LINPTR1, LINPRT2, LINPTR3 - POSSIBLY DESTROYED.
* LCOUNT - NUMBER OF LINES PROCESSED IS INCREMENTED.
*
* USES LINCTR, REGLINE[RNGTOPREG].
*
* NOTE SEE HEADER FOR MULTMOV.
#
# POSITION TO SOURCE AND PROCESS SEGMENT #
POSZ(LINPTR1);
FOR LINPTR3=1 STEP 1 WHILE LINPTR3 LQ LIMIT AND USRBRK EQ 0 DO
BEGIN
PUSH; # KEEP TRACK OF SOURCE POSITION #
P<LINEBUF>=0; # SUPPRESS WORKIO LINE BUFFER READOUT #
POSZ(REGLINE[RNGTOPREG]); # GET TO TARGET ADDRESS #
P<LINEBUF>=LOC(LIN); # RESTORE NORMAL WORKIO FUNCTION #
CURFILE=FILPTR3;
IF ASCII[FILPTR1] GQ 2 AND ASCII[FILPTR3] LQ 1
THEN SQUELCH(LIN); # FIX UP TEXT OF LINE #
LINENO=LINENO+INCR;
SETLNUM;
SETCHAR(LINE,EDITFIELD,CENDLINE); # CLEAR TO END OF LINE #
TRIMPAD;
INSX; # COPY ONE LINE #
REGLINE[RNGTOPREG]=CURRENT; # UPDATE TARGET ADDRESS #
POP; # BACK TO SOURCE RANGE #
IF FILCMDNDX EQ FILCMDST"MOVE" THEN DELX;
LCOUNT=LCOUNT+1; # ADJUST OFFICIAL WORK COUNT #
FWDZ; # ADVANCE WITHIN RANGE #
END
IOEND # OF DOSEGMENT #
# MULTMOV ACTUAL CODE STARTS HERE #
LCOUNT=TOKENPOS; # TEMPORARY MECHANISM FOR SNGLMOV #
SCANNER; # GET ALL ADDRESSES #
IF EXECNDX EQ EXECST"MOVE" THEN
BEGIN # IF MOVE COMMAND #
VFYLOCK;
IF SCANMARK THEN KILLMARKS = TRUE;
END
CURFILE = = FILPTR3;
VFYLOCK;
CURFILE = = FILPTR3;
IF TOPF(CURFILE) EQ BOTF(CURFILE)-1 THEN
BEGIN
HALT("EMPTY FILE$");
END
ELSE IF NOT FOUND THEN
BEGIN
HALT("OUT OF BOUNDS$");
END
IF NOT FOUND THEN IORET
LINPTR2=MIN(LINPTR2,LINPTR1+LIMIT-1); # TIGHTEN BOUNDS #
LIMIT=LINPTR2-LINPTR1+1;
IF LIMIT GQ 40 OR CHARRANGE OR FIELDTARGET NQ 0
THEN GOTO QQSINGLE;
# TEST THAT LINE NUMBERS CAN BE FITTED IF NEEDED #
POSZ(LINPTR3);
FITNUM;
NUMWIDBLK=0;
IF NUMBERED[FILPTR3] NQ 0 THEN NUMWIDBLK=NUMWIDTH+BLANKS;
# CHECK FOR INCOMPATIBLE CHARACTER SETS. IF TARGET FILE IS #
# EMPTY, WE CHANGE ITS CHARACTER SET. OTHERWISE, DOSEGMENT #
# WILL SUPPRESS CASE OF TEXT. #
IF ASCII[FILPTR1] GQ 2 AND ASCII[FILPTR3] EQ 0
AND BOTF(FILPTR3)-TOPF(FILPTR3)-1 EQ THISEXTEND
THEN ASCII[FILPTR3]=ASCII[FILPTR1];
# CHECK FOR TARGET INSIDE RANGE. STORE ON STACK THE (FIRST) AND #
# (LAST) LINES TO BE PROCESSED AS SECOND SEGMENT. #
IF LINPTR3 GQ LINPTR1 AND LINPTR3 LS LINPTR2 THEN
BEGIN
POSZ(LINPTR3+1);
PUSH;
POSZ(LINPTR2);
PUSH;
LINPTR2=LINPTR3; # CUT OFF FIRST SEGMENT #
LIMIT=LINPTR2-LINPTR1+1;
END
ELSE
BEGIN
POSZ(0); # INDICATE NO SECOND SEGMENT #
PUSH;
PUSH;
END
# STORE TARGET ADDRESS IN RELOCATABLE REGISTER #
REGLINE[RNGTOPREG]=LINPTR3;
LCOUNT=0; # INITIALIZE ACTUAL LINE COUNT #
DOSEGMENT;
# NOW RETRIEVE BOUNDS FOR SECOND SEGMENT #
POP;
LINPTR2=CURRENT;
POP;
LINPTR1=CURRENT;
LIMIT=LINPTR2-LINPTR1+1;
IF CURRENT GR 0 THEN DOSEGMENT;
CURFILE=FILPTR3;
# FINAL POSITIONING AND PRINTING #
IF SCREENMODE THEN POSZ(REGLINE[RNGTOPREG]-LCOUNT+1);
ELSE
BEGIN
POSZ(REGLINE[RNGTOPREG]);
IF NOT DONTPRINT THEN
BEGIN
LINPTR1=CURRENT-LCOUNT+1;
LINPTR2=BOTF(FILPTR3)-1;
LIMIT=LCOUNT;
EXECNDX=EXECST"TYPE";
DORANGE;
END
END
IOEND # OF MULTMOV #
CONTROL FI;
PROC SAVEPROT;
BEGIN
#
** SAVEPROT - SAVE COPY OF LINE IMAGE FOR EDITFIELD.
*
* SAVEPROT IS ONE OF THE MAJOR INTERFACES BY WHICH EDITING
* CODE CAN COMPLY WITH EDITFIELD RESTRICTIONS. SAVEPROT
* COPIES THE LINE IMAGE INTO PROTLIN AND TRUNCATES ORIGINAL.
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* EDITFIELD - START COLUMN FOR PROTECTED FIELD.
*
* EXIT PROTLIN - COPY OF ORIGINAL LIN CONTENT.
* LIN - TRUNCATED AT EDITFIELD TO HIDE FIELD.
*
* MACROS SETCHAR.
*
* CALLS COPYLIN, TRIMPAD.
#
IF EDITFIELD GQ BUFCM1 THEN RETURN;
COPYLIN(LIN,PROTLIN);
SETCHAR(LINE,EDITFIELD,CENDLINE);
TRIMPAD;
END # OF SAVEPROT #
PROC MERGEPROT;
# TITLE MERGEPROT - MERGE MODIFIED LINE WITH PROTECTED FIELD. #
BEGIN # MERGEPROT #
#
** MERGEPROT - MERGE MODIFIED LINE WITH PROTECTED FIELD.
*
* MERGEPROT IS ONE OF THE MAJOR INTERFACES WITH WHICH
* EDITING CODE CAN COMPLY WITH EDITFIELD RESTRICTIONS.
*
* PROC MERGEPROT
*
* ENTRY LIN - MODIFIED INTERNAL LINE IMAGE.
* PROTLIN - UNMODIFIED VERSION OF SAME LINE.
* EDITFIELD - SHOWS WHICH FIELDS TO MERGE.
*
* EXIT LIN - PARTIALLY DE-MODIFIED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS EXTENDC, TRIMPAD.
#
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
IF EDITFIELD GQ BUFCM1 THEN RETURN;
IF LENGTH(PROTLIN) LQ EDITFIELD THEN RETURN;
EXTENDC(LIN,EDITFIELD);
FOR TMP1=EDITFIELD STEP 1 UNTIL BUFCHAR DO
BEGIN
GETCHAR(PROTLINE,TMP1,TMP2);
SETCHAR(LINE,TMP1,TMP2);
END
SETCHAR(LINE,BUFCHAR,CENDLINE);
TRIMPAD;
END # MERGEPROT #
PROC SETFIELD;
BEGIN
#
** SETFIELD - ESTABLISH TAB-FIELD RESTRICTIONS.
*
* SETFIELD IS CALLED TO SET UP THOSE VARIABLES WHICH CAN
* CONTROL LIMITATIONS ON TEXT MANIPULATION BY TAB-FIELD
* COLUMNS. NOTE THAT ACTUAL COMPLIANCE WITH SUCH
* RESTRICTIONS IS LEFT TO THE ACTUAL MANIPULATORS.
*
* ENTRY FIELDNDX - SHOWS WHICH FIELD IF ANY.
* NUMWIDBLK - OFFSET TO IGNORE SEQUENCE NUMBERS.
*
* EXIT FIELDFLG - WHETHER RESTRICTIONS APPLICABLE.
* FIELDBGN, FIELDEND - FIELDNDX CONVERTED TO COLUMNS.
*
* CALLS TABFN.
#
ITEM TMP1 I; # TEMPORARY STORAGE #
ITEM TMP2 I; # TEMPORARY STORAGE #
IF FIELDNDX NQ 0 THEN
BEGIN
FIELDFLG=TRUE;
IF FIELDNDX GR 0 THEN
BEGIN # IF USING TAB FIELDS #
TMP1 = NUMWIDBLK+TABFN(FIELDNDX-1);
TMP2 = NUMWIDBLK+TABFN(FIELDNDX)-1;
END
ELSE
BEGIN # IF USING DIRECT COLUMNS #
TMP1 = INFLDBGN;
TMP2 = INFLDEND;
END
IF TMP2 LS TMP1 THEN TMP2 = BUFCM1;
IF BACKWARD THEN
BEGIN
IF NOT (FIRSTRANGE AND (FIELDBGN LS TMP2)) THEN FIELDBGN = TMP2;
FIELDEND = TMP1;
END
ELSE
BEGIN
IF NOT (FIRSTRANGE AND (FIELDBGN GR TMP1)) THEN FIELDBGN = TMP1;
FIELDEND = TMP2;
END
END
END # OF SETFIELD #
PROC SETFIRST;
BEGIN
#
** SETFIRST - SET PARAMETERS FOR FIRST LINE OF RANGE.
*
* SETFIRST IS USED BY DORANGE TO INDICATE WHEN WE ARE
* PROCESSING THE FIRST LINE OF A RANGE, (BY CHRONOLOGY
* RATHER THAN POSITION), AND ALSO SETS UP THE VARIABLES
* WHICH NORMALLY CONTROL TAB FIELD LIMITATIONS SO AS TO
* LIMIT MANIPULATIONS TO OCCUR NO EARLIER THAN A CURSOR
* POSITION. THIS CONVERTS SOME OPERATIONS INTO CHARACTER-
* MODE IN PLACE OF RANGE MODE. NOTE THAT ACTUAL COMPLIANCE
* WITH FIELD LIMITATIONS IS LEFT TO THE MANIPULATORS.
*
* ENTRY CHRPTR1 - FIRST COLUMN OF STREAM.
*
* EXIT FINDCONTROL - BOTTOM BIT IS FORCED ON.
* FIELDFLG - FORCED TRUE.
* FIELDBGN, FIELDEND - BRACKET SECOND HALF OF LINE.
*
* CALLS MAX.
#
FIRSTRANGE=TRUE;
FINDCONTROL=FINDCONTROL LOR 1;
FIELDFLG=TRUE;
FIELDBGN=MAX(CHRPTR1,NUMWIDBLK);
IF NOT BACKWARD THEN FIELDEND=BUFCM1;
END
PROC SETLAST;
BEGIN
#
** SETLAST - SET PARAMETERS FOR LAST LINE OF RANGE.
*
* SETLAST IS SIMILAR TO SETFIRST EXCEPT THAT IT INDICATES
* THE RANGE IS ALMOST DONE AND BRACKETS THE FIRST HALF
* INSTEAD OF THE SECOND HALF OF THE LINE FOR CHARACTER-
* STREAM ORIENTATION.
*
* ENTRY CHRPTR2 - LAST EDITABLE COLUMN OF STREAM.
*
* EXIT LASTRANGE - FORCED TRUE.
* FINDCONTROL - BOTTOM BIT FORCE ON.
* FIELDFLG - FORCED TRUE.
* FIELDEND - BRACKET END OF STREAM.
*
* CALLS MAX.
#
LASTRANGE=TRUE;
FINDCONTROL=FINDCONTROL LOR 1;
FIELDFLG=TRUE;
FIELDEND=MAX(CHRPTR2,NUMWIDBLK);
END
PAGE # EXEC ROUTINE #
PROC EXEC;
IOBEGIN(EXEC)
#
** EXEC - FAN-OUT TO TEXT MANIPULATOR FOR ONE LINE OF RANGE.
*
* THE EXEC ROUTINE CONTAINS CHUNKS OF CODE THAT NEED TO BE
* EXECUTED ONCE PER LINE FOR THOSE COMMANDS THAT WORK ON
* RANGES OF LINES. THIS IS A MEDIUM-SIZED SUBSET OF ALL
* CMDS. THE COMMAND HANDLING ROUTINES IN PROCESS MUST SELECT
* THEIR BROTHER HERE IN EXEC BY SETTING EXECNDX TO THE RIGHT
* STATUS VALUE BEFORE CALLING EXEC. EXEC WILL DO A SWITCH
* GOTO ON THE BASIS OF EXECNDX.
*
* THE CASE HANDLERS IN EXEC ARE ALLOWED TO EXECUTE
* NON-REENTRANT CODE SEQUENCES FOR THE PURPOSE OF TEXT
* MANIPULATION. THESE SEQUENCES CAN USE GLOBAL STORAGE.
* TERMINAL OR FILE OPERATIONS HOWEVER MUST FOLLOW REENTRANT
* CODING PRINCIPLES.
*
* THE LINCTR VARIABLE IS THE CRUCIAL LINK BETWEEN DORANGE AND
* EXEC. IT IS THE COUNTER FOR USER LIMITS. THE OUTER LOGIC
* ALWAYS INCREMENTS IT AS A WISEST ASSUMPTION. THE FIND AND
* SUBSTITUTE COMMAND HANDLERS THEN MUST DECREMENT IT UPON
* FAILURE SO AS IT KEEP IT CONSTANT. NOTE THAT DORANGE KNOWS
* HOW MANY TIMES TO CALL US WITH REGARD TO THE NUMBER OF
* LINES IN THE RANGE.
*
* EXEC IS ALSO OBLIGATED TO CHECK FOR INTERRUPT CONDITIONS
* WHICH MUST TERINATE RANGE PROCESSING, AND TO SET LINCTR
* UPON INTERRUPTS TO SIGNAL SHUTDOWN TO DORANGE.
*
* ENTRY LIN - CURRENT INTERNAL LINE IMAGE.
* CURRENT, CURFILE, CURSPLIT - WHERE WE ARE IN FILE.
* FIELDNDX - DEFINES TAB-FIELD LIMITATIONS.
* FIELDFLG, FIELDBGN, FIELDEND - MAY HAVE FIELD LIMITS.
* CHARRANGE - MODE.
* FIRSTRANGE, LASTRANGE - WHETHER AT BOUNDS OF RANGE.
* FORCEFIELD - EXPLICIT FIELD CONSTRAINT IN SYNTAX.
* LINPTR1 - SAME AS CURRENT.
* LINPTR2 - ORIGINAL LINE ADDRESS FOR END OF RANGE.
* CHRPTR1, CHRPTR2 - CHARACTER BOUNDARIES IF ANY.
* USRBRK - USER INTERRUPT.
* LINCTR - COUNTER AGAINST LIMIT.
* LIMIT - LIMIT ON RANGE ITERATION.
* EXECNDX - WHICH CODE IN EXEC TO EXECUTE.
* LCOUNT - ACCURATE COUNT OF LINES PROCESSED.
* CANINTER - CONTROLS INTERRUPTABILITY OF COMMANDS.
* DONTPRINT - CONTROL PRINTOUT.
* SCREENMODE - ALSO CONTROLS PRINTOUT.
*
* EXIT LINCTR - INCREMENTED TOWARDS LIMIT.
* (NOT INCREMENTED FOR MISSED SEARCH)
* (LARGENUM FOR ANY TYPE OF FORCED SHUTDOWN)
* LCOUNT - INCREMENTED.
* FIELDFLG, FIELDBGN, FIELDEND - POSSIBLY DESTROYED.
* LIN - UPDATED AND TRANSMITTED INTO FILE.
* DONTPRINT - POSSIBLY DESTROYED IF INTERRUPTED.
* NEWCURSOR - CURSOR AFTER SEARCH.
* STRINGLEN - LENGTH OF SEARCHED STRING.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS SETCHRPTR(INTERNAL), DODELETE(INTERNAL),
* SETFIELD, TRIMPAD, MERGEPROT, REPX, DELX,
* CHKVICTIM(MULTI), CLEARQUE(MULTI),
* SAVEPROT, APPEND, XSHOW, XFRCMOUT, FINDER, NOPOP,
* GLOBALLOCATE, PUSH, DOMOD, DOCENTER, GLOBALCHANGE,
* SUBST, LENGTH.
*
* USES CHRPTR1, CHRPTR2.
#
# EXECSW MUST MATCH EXECST #
SWITCH EXECSW XXAPPEND, XXCENTER, XXCOPY, XXDELETE, XXLOCATE,
XXMODIFY, XXMOVE, XXREPLACE, XXTYPE;
# INTERNAL PROCEDURES #
PROC SETCHRPTR;
BEGIN
#
** SETCHRPTR - SETUP CHARACTER POINTERS.
*
* SETCHRPTR IS AN INTERNAL ALGORITHM TO CONSOLIDATE CODE
* FREQUENTLY USED WITHIN THE EXEC ROUTINE. SETCHRPTR
* SETS UP THE CHRPTR1 AND CHRPTR2 VARIABLES BASED ON
* ANY FIELD RESTRICTIONS.
*
* ENTRY FIELDBGN, FIELDEND - POSSIBLY SETUP BY SETFIRST
* OR SETLAST.
* FORCEFIELD - WHETHER EXPLICIT FIELD SYNTAX.
* FIELDNDX - WHICH TAB FIELD.
* NUMWIDBLK - SETUP PER SEQUENCE MODE AND LINE CONTENT.
*
* EXIT FIELDBGN, FIELDEND - POSSIBLY SETUP BY SETFIELD.
* CHRPTR1, CHRPTR2 - POSSIBLY MATCH FIELDBGN, FIELDEND.
* FIELDFLG - POSSIBLY SETUP BY SETFIELD.
*
* CALLS SETFIELD.
#
SETFIELD;
IF FORCEFIELD AND FIELDNDX NQ 0 THEN
BEGIN
CHRPTR1=FIELDBGN;
CHRPTR2=FIELDEND;
END
END # OF SETCHRPTR #
PROC DODELETE;
IOBEGIN(DODELETE)
#
** DODELETE - ACTUAL LINE/STRING REMOVAL.
*
* DODELETE DELETES AN ENTIRE LINE WHEN APPROPRIATE, AND
* REPLACES A LINE WITH A STRING DELETED OTHERWISE.
*
* DODELETE IS OBLIGATED TO EXECUTE INSTANTLY UNTIL ANY NEED
* FOR MERGEPROT IS DONE OR GONE.
*
* ENTRY LIN - INTERNAL LINE IMAGE.
* CURRENT, CURFILE, CURSPLIT - WHERE WE ARE.
* FORCEFIELD - WHETHER EXPLICIT SYNTAX.
* CHARRANGE - CHARACTER/LINE BOUNDARY MODE.
* FIRSTRANGE, LASTRANGE - WHETHER AT BOUNDS.
* FIELDBGN, FIELDEND - POSSIBLY SET BY SETFIRST
* OR SETLAST.
* FIELDNDX - WHICH TAB FIELD.
*
* EXIT LIN - UPDATED IF STRING EXTRACTION.
* FILE UPDATED.
* CURRENT - POSSIBLY DECREMENTED IF LINE DELETE.
* FIELDBGN, FIELDEND - POSSIBLY SET BY SETFIELD.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS SETFIELD, LENGTH, TRIMPAD, MERGEPROT, REPX, DELX.
#
ITEM TMP1, TMP2;
IF FORCEFIELD OR (CHARRANGE AND (FIRSTRANGE OR LASTRANGE)) THEN
BEGIN # REPLACE LINE, STRING DELETED #
SETFIELD;
IF FIELDEND GQ LENGTH(LIN) THEN SETCHAR(LINE,FIELDBGN,CENDLINE);
# START INSTANTANEOUS CALCULATION #
FOR TMP1=FIELDEND+1 STEP 1 UNTIL LENGTH(LIN) DO
BEGIN
GETCHAR(LINE,TMP1,TMP2);
SETCHAR(LINE,FIELDBGN+TMP1-(FIELDEND+1),TMP2);
END
# END INSTANTANEOUS CALCULATION #
IF NOT (CHARRANGE AND FIRSTRANGE) THEN TRIMPAD;
MERGEPROT;
REPX;
END
ELSE DELX; # DELETE WHOLE LINE #
# NOTE MERGEPROT NOT NEEDED FOR LINE DELETION #
IOEND # OF DODELETE #
# EXEC MAIN CODE STARTS HERE #
CONTROL IFEQ MULTI,1;
# CHECK FOR SMFEX CAUSING US GRIEF #
CHKVICTIM;
CONTROL FI;
IF USRBRK NQ 0 OR ESCAPE THEN
BEGIN
IF CANINTER THEN
BEGIN
LINCTR=LARGENUM;
IORET
END
DONTPRINT=TRUE;
END
CONTROL IFEQ MULTI,1;
CLEARQUE;
CONTROL FI;
LINCTR=LINCTR+1; # ASSUME INCR AGAINST LIMIT #
GOTO EXECSW[EXECNDX];
PAGE # EXEC COMMAND HANDLERS #
XXAPPEND: # A COMMAND #
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
APPEND;
MERGEPROT;
XSHOW;
REPX;
GOTO EXECDONE;
CONTROL IFEQ SINGLE,1;
XXCOPY:
SETCHRPTR;
LCOUNT=LCOUNT+1; # ACCURATE WORK ACCOUNTING #
XFRCMOUT;
GOTO EXECDONE;
XXCENTER:
SAVEPROT;
DOCENTER;
TRIMPAD;
MERGEPROT;
XSHOW;
REPX;
GOTO EXECDONE;
CONTROL FI;
XXDELETE:
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
SETCHRPTR;
LCOUNT=LCOUNT+1;
DODELETE; # THIS ACCOMODATES MERGEPROT #
GOTO EXECDONE;
XXLOCATE:
SETFIELD;
FOUND=FINDER(NEWCURSOR,STRINGLEN);
IF FOUND THEN
BEGIN
YSHOW;
GLOBALLOCATE;
CHECKWIDE;
NOPOP; # TO COME BACK HERE #
PUSH;
END
ELSE LINCTR=LINCTR-1;
GOTO EXECDONE;
XXMODIFY:
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
DOMOD;
TRIMPAD;
MERGEPROT;
XSHOW;
REPX;
GLOBALCHANGE;
GOTO EXECDONE;
XXTYPE:
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
MERGEPROT; # SO FIELD IS PRINTABLE #
XSHOW;
GOTO EXECDONE;
XXREPLACE:
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
SETFIELD;
SUBST;
IF FOUND THEN
BEGIN
MERGEPROT;
YSHOW;
REPX;
GLOBALCHANGE;
CHECKWIDE;
NOPOP; # SET UP HERE AS ... #
PUSH; # ... PLACE TO COME BACK TO #
END
ELSE LINCTR=LINCTR-1;
GOTO EXECDONE;
CONTROL IFEQ SINGLE,1;
XXMOVE:
SAVEPROT; # MUST EXECUTE INSTANTLY UNTIL MERGEPROT #
SETCHRPTR;
LCOUNT=LCOUNT+1; # ACCURATE WORK ACCOUNTING #
XFRCMOUT;
DODELETE; # THIS ACCOMODATES MERGEPROT #
GOTO EXECDONE;
CONTROL FI;
CONTROL IFEQ MULTI,1;
XXCENTER: XXCOPY: XXMOVE: # DROP INTO EXECDONE #
CONTROL FI;
EXECDONE:
IOEND # OF EXEC #
PAGE # UTILITIES FOR EXEC-LIKE STUFF #
PROC GETESCAPE;
IOBEGIN(GETESCAPE)
#
** GETESCAPE - DETERMINE IF INPUT DATA AT/NEAR END.
*
* GETESCAPE RECOGNIZES IMMEDIATE END OF INPUT DATA, WHICH
* IS A NULL INPUT, AND UPCOMING END OF INPUT DATA, WHICH IS
* A TRAILING SOFT-TAB CHARACTER ON A NON-NULL INPUT.
*
* ENTRY TTYLIN - INTERNAL LINE IMAGE OF TERMINAL INPUT.
* TXTINCMD - WHETHER TTYLIN EXTRACTED FROM COMMAND.
*
* EXIT ESCAPE - TRUE FOR IMMEDIATE END OF INPUT.
* NXTESCAPE - TRUE FOR UPCOMING ESCAPE.
* TTLIN - TRAILING TAB CONVERTED TO BLANK.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LENGTH, TRIM.
#
ITEM TMP1, TMP2;
CONTROL IFEQ SINGLE,1; # IF NOT MULTI USER FSE #
IF NOT INTERACT AND NOT TXTINCMD THEN
BEGIN # IF BATCH MODE INSERTION #
TRIM(TTYLIN,0); # TRIM TRAILING BLANKS #
END
CONTROL FI; # END OF NOT MULTI USER FSE #
TMP2=LENGTH(TTYLIN);
IF TMP2 EQ 0 THEN ESCAPE=TRUE;
ELSE
BEGIN
GETCHAR(TTYLINE,TMP2-1,TMP1);
IF TMP1 EQ TABCHAR THEN
BEGIN
SETCHAR(TTYLINE,TMP2-1,CBLANK);
TRIM(TTYLIN,1);
IF LENGTH(TTYLIN) EQ 0 THEN ESCAPE=TRUE;
ELSE NXTESCAPE=TRUE;
END
END
IF TXTINCMD THEN NXTESCAPE=TRUE;
IOEND # OF GETESCAPE #
PROC DOTAB(OFFSETI,OFFSETO,OFFSETTAB);
BEGIN
#
** DOTAB - EXPAND SOFT-TABS.
*
* DOTAB EXPANDS TABS WITHIN TTYLIN, USING TMPLIN AS A SCRATCH
* BUFFER. FOR THE BENEFIT OF NUMBERS THE CALLER HAS GIVEN US
* AN OFFSET TO WORK AGAINST.
*
* ENTRY TTYLIN - INTERNAL LINE IMAGE OF TEXT TO EXPAND.
* OFFSETI - OFFSET TO START LOOKING IN TTYLIN.
* OFFSETO - OFFSET TO START EXPANDING IN TTYLIN.
* OFFSETTAB - OFFSET FOR TABS.
* TABCHAR - SOFT-TAB CHARACTER VALUE.
* TABVECTOR - SETUP.
*
* EXIT TTYLIN - UPDATED.
*
* MACROS GETCHAR, SETCHAR.
*
* CALLS LENGTH, COPYLIN, TABFN, TRIM.
*
* USES TMPLIN.
#
ITEM OFFSETI,OFFSETO,OFFSETTAB;
ITEM TMP1, TMP2, TMP3, TMP4;
COPYLIN(TTYLIN,TMPLIN);
FOR TMP1=OFFSETI STEP 1 UNTIL OFFSETO-1
DO SETCHAR(TMPLINE,TMP1,CBLANK);
TMP2=OFFSETO;
FOR TMP1=OFFSETI STEP 1 WHILE TMP1 LS LENGTH(TTYLIN) AND
TMP2 LS BUFCHAR DO
BEGIN
GETCHAR(TTYLINE,TMP1,TMP3);
IF TMP3 NQ TABCHAR OR TABVCTWRD[1] EQ 0 THEN
BEGIN
SETCHAR(TMPLINE,TMP2,TMP3);
TMP2=TMP2+1;
END
ELSE # IT IS TAB #
BEGIN
TMP3=0;
FOR TMP4=1 STEP 1 UNTIL USERTABS DO
BEGIN
IF TMP3 EQ 0 AND TABFN(TMP4) GR (TMP2-OFFSETTAB)
THEN TMP3=TABFN(TMP4)-(TMP2-OFFSETTAB);
END
IF TMP3 EQ 0 THEN TMP3=1;
# TMP3=NUMBER OF BLANKS TO GENERATE #
FOR TMP4=1 STEP 1 WHILE TMP4 LQ TMP3 AND TMP2 LS BUFCHAR DO
BEGIN
SETCHAR(TMPLINE,TMP2,CBLANK);
TMP2=TMP2+1;
END
END
END # OF LOOP #
SETCHAR(TMPLINE,MIN(TMP2,BUFCHAR),CENDLINE);
COPYLIN(TMPLIN,TTYLIN);
TRIM(TTYLIN,MAX(OFFSETO,1));
END # OF DOTAB #
PAGE # EXEC-LIKE STUFF. EXECINS #
PROC EXECINS;
IOBEGIN(EXECINS)
#
** EXECINS - PROCESS ONE ONE LINE OF LINE-MODE INPUT.
*
* THE INSERT COMMAND IS NOT IMPLEMENTED THRU DORANGE AND EXEC
* AS IT WORKS ON A LINE POSITION, NOT A RANGE OF LINES. THE
* PROCESS COMMAND HANDLER FOR INSERT WILL REPEATEDLY CALL
* EXECINS. EXECINS WORKS IN THE AREA OF ESCAPE SEQUENCING
* PLUS DRIVING OF PARSING OUT TEXT ON THE COMMAND LINE PLUS
* PROMPTING AND GENERATION OF LINE NUMBER TEXT. EXECINS IS
* ONLY RELEVANT TO LINE-MODE AND SHOULD NOT BE CALLED WHEN
* IN SCREEN-MODE.
*
* ENTRY NXTESCAPE - WHETHER UPCOMING END OF INPUT.
* TXTINCMD - WHETHER TEXT ALREADY IN TTYLIN FROM CMD.
* CURRENT, CURFILE - WHERE WE ARE IN FILE.
* NUMBERED[CURFILE] - CONTROL PROMPTING AND SEQUENCING.
* LINENO - SEQUENCE NUMBER FOR NEW LINE.
* NUMWIDBLK - STANDARD SEQUENCING OFFSET.
* BLANKS - WHETHER TO ADD BLANK AFTER SEQUENCE NUMBER.
* TOPF(CURFILE) - RELOCATION FACTOR AND BOUNDS.
* ASCII[CURFILE] - CONTROLS LOWERCASE SUPPRESSION.
*
* EXIT LIN - INPUT LINE READY TO GO INTO FILE.
* NXTESCAPE, ESCAPE - UPDATED.
*
* MACROS SETCHAR.
*
* CALLS PUSHTEMP, POPTEMP, TTLPAD, TTSTR, TTST, TTLIN, TTBRK,
* PROMPT, CONVIN, TRIM, SQUELCH, GETESCAPE, DOTAB,
* COPYLIN, SETLNUM, TRIMPAD, CHECKWIDE, CHKVICTIM(MULTI)
*
* USES TTYLIN, TMPLIN, TEMP(RESTORED), DUMB.
#
PUSHTEMP;
IF NXTESCAPE THEN
BEGIN
ESCAPE=TRUE;
GOTO EXINSDONE;
END
IF NOT TXTINCMD THEN
BEGIN
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT THEN GOTO EXECINS2;
CONTROL FI;
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
TTLPAD(LINENO,NUMWIDTH,"0");
TEMP=NUMWIDBLK;
IF B<59,1>TEMP NQ 0 THEN TTSTR(BLANKWRD);
TEMP=BLANKS;
TTST(" ",TEMP);
TTLIN(CKWRD);
END
ELSE IF FLOAT THEN
BEGIN
TEMP=CURRENT-TOPF(CURFILE)+1;
IF TEMP GR 9999 THEN TTLPAD(TEMP,8," ");
ELSE TTLPAD(TEMP,4," ");
TTLIN(BCCKWRD);
END
ELSE TTBRK;
EXECINS2:
PROMPT(NULLWRD);
CONVIN(TTYLIN,2);
TRIM(TTYLIN,1);
IF ASCII[CURFILE] LQ 1 THEN SQUELCH(TTYLIN);
END
GETESCAPE; # DETERMINES UPCOMING ESCAPE #
IF ESCAPE THEN GOTO EXINSDONE;
DOTAB(0,NUMWIDBLK,NUMWIDBLK);
COPYLIN(TTYLIN,LIN);
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
FOR DUMB=1 STEP 1 UNTIL NUMWIDTH DO SETCHAR(LINE,DUMB-1,CDIGIT0);
SETLNUM;
END
TRIMPAD;
CHECKWIDE;
EXINSDONE:
POPTEMP;
CONTROL IFEQ MULTI,1;
CHKVICTIM; # SEE IF SMFEX IN TROUBLE #
CONTROL FI;
IOEND # OF EXECINS #
PAGE # DORANGE ROUTINE #
PROC DORANGE;
IOBEGIN(DORANGE)
#
** DORANGE - PROCESS RANGE OF LINES FOR COMMAND.
*
* DORANGE IS USED TO MOVE THRU THE FILE ONE LINE AT A TIME
* CALLING EXEC EACH TIME. WE ARE THUS USED ONLY AND ALWAYS
* BY THOSE PROCESS COMMAND HANDLERS WHO DEAL WITH RANGES OF
* LINES. REMEMBER EXEC SUPPLIES THE PER-LINE GOODIES. WE
* ASSUME THAT OUR PROCESS ROUTINE HAS ALREADY SET UP EXECNDX,
* WHICH WILL TELL EXEC WHICH COMMAND IS ALIVE. WE ASSUME
* THAT THE PROCESS ROUTINE EITHER KNOWS THE RANGE IMPLICITLY
* OR HAS CALLED SCANNER, THUS LINPTR1 AND LINPTR2 GIVE THE
* RANGE. EXEC WILL DEAL ALSO WITH LINCTR AND LCOUNT.
*
* ENTRY BACKWARD - DIRECTION OF RANGE.
* LINPTR1 - TOP ADDRESS OF RANGE.
* LINPTR2 - BOTTOM ADDRESS OF RANGE.
* CURFILE, CURSPLIT - CURRENT FILE.
* ELLIPSIS, WORDSEARCH, UPPERSEARCH - SEARCH MODES.
* FIELDNDX - WHETHER/WHICH TAB FIELD LIMIT.
* LIMIT - MAXIMUM ITERATIONS.
* TOPF(CURFILE), BOTF(CURFILE) - BOUNDS.
* FOUND - WHETHER SYNTAX GAVE VALID BOUNDS.
* PROCESSNDX - WHICH COMMAND.
* EXECNDX - WHICH EXEC PROCESSOR.
* NUMBERED[CURFILE] - SEQUENCING MODE.
*
* EXIT LINPTR1, LINPTR2 - DESTROYED.
* LASTPROCESS - INDICATES TYPE OF COMMAND EXECUTED.
* NEWCURSOR - ZEROED.
*
* CALLS EXECONE(INTERNAL), GETLNUM, SETFIRST, SETLAST,
* EXEC, VOLUNTEER(MULTI), HALT, POSZ, MIN, FWDZ,
* BAKZ, MAX.
*
* USES LINPTR1, LINENO, WIDTHFOUND, FIELDFLG, FIELDBGN,
* FIELDEND, FINDCONTROL, LINPTR2, FIRSTRANGE, LASTRANGE,
* DORNGCTR, LCOUNT, LINCTR, YCURSOR, DELETEDONE,
* REGLINE[RNGTOPREG], REGLINE[RNGBOTREG], DELETCTL.
#
PROC EXECONE(FIRST,LAST);
IOBEGIN(EXECONE)
#
** EXECONE - EXECUTE COMMAND PROCESSOR FOR ONE LINE.
*
* EXECONE IS AN INTERNAL ALGORITHM OF DORANGE WHICH
* EXISTS TO CONSOLIDATE CODE. INTERFACE TO EXEC ROUTINE.
*
* ENTRY FIRST - LINE ADDRESS FOR FIRST LINE OF RANGE.
* LAST - LINE ADDRESS FOR LAST LINE OF RANGE.
* (FIRST, LAST ARE IN CHRONOLOGICAL ORDER)
* CURRENT, CURFILE, CURSPLIT - LINE TO PROCESS.
* LIN - TEXT OF LINE TO PROCESS.
* NUMBERED[CURFILE] - MODE.
*
* EXIT CONDITIONS AS LEFT BY EXEC ROUTINE.
*
* USES FIELDFLG, FIELDBGN, FIELDEND, NUMWIDBLK, DELETEDONE.
*
* CALLS EXEC, SETFIRST, SETLAST, GETLNUM.
*
* NOTE THIS ROUTINE IS REENTRANT AND HAS PARAMETERS. IT
* MUST EXECUTE NON-REENTRANTLY UNTIL PARAMETER
* ARE COMPLETE AND CANNOT ALTER THE PARAMETERS.
#
ITEM FIRST, LAST;
DELETEDONE=FALSE;
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
GETLNUM;
NUMWIDBLK=WIDTHFOUND+BLANKS;
END
FIELDFLG=FALSE;
FIELDBGN=NUMWIDBLK;
IF BACKWARD THEN FIELDBGN=BUFCM1;
FIELDEND=BUFCM1;
IF BACKWARD THEN FIELDEND=NUMWIDBLK;
FINDCONTROL=FINDCONTROL LAN 2;
FIRSTRANGE=FALSE;
LASTRANGE=FALSE;
IF CURRENT EQ FIRST THEN SETFIRST;
IF CURRENT EQ LAST THEN SETLAST;
# END PARAMETERS #
EXEC;
LINPTR1=CURRENT;
CONTROL IFEQ MULTI,1;
IF MOD(DORNGCTR,VOLLINES) EQ 0 THEN VOLUNTEER;
CONTROL FI;
IOEND # OF EXECONE #
# MAIN CODE OF DORANGE STARTS HERE #
LCOUNT=0; # DEFAULT WORK ACCOMPLISHED #
LINCTR=0;
LASTPROCESS=PROCESSNDX;
YCURSOR=-1; # TO RE-ADDRESS CURSOR #
NEWCURSOR=0;
FINDCONTROL=0; # SET TEXT SEARCH OPTIONS #
IF ELLIPSIS OR WORDSEARCH OR UPPERSEARCH
OR BACKWARD OR FIELDNDX NQ 0 THEN FINDCONTROL=2;
IF BACKWARD THEN
BEGIN
LINPTR1 = = LINPTR2;
CHRPTR1 = = CHRPTR2;
END
IF TOPF(CURFILE) EQ BOTF(CURFILE)-1 THEN
BEGIN
HALT("EMPTY FILE$");
END
ELSE IF NOT FOUND THEN
BEGIN
HALT("OUT OF BOUNDS$");
END
IF NOT FOUND THEN IORET # IF HALT CALLED #
POSZ(LINPTR1); # POSITION START OF RANGE #
DELETEDONE=TRUE; # TO TRICK FIRST PASS #
IF LINPTR1 LQ LINPTR2 THEN
BEGIN
IF EXECNDX NQ EXECST"LOCATE" AND EXECNDX NQ EXECST"REPLACE"
THEN LINPTR2=MIN(LINPTR2,LINPTR1+LIMIT-1);
DELETCTL=1;
REGLINE[RNGTOPREG]=LINPTR1-1;
REGLINE[RNGBOTREG]=LINPTR2+1;
FOR DORNGCTR=1 STEP 1 WHILE LINPTR1 GR REGLINE[RNGTOPREG] AND
LINPTR1 LS REGLINE[RNGBOTREG] AND LINCTR LS LIMIT DO
BEGIN
IF NOT DELETEDONE THEN
BEGIN
LINPTR1=LINPTR1+1;
IF LINPTR1 LS REGLINE[RNGBOTREG] THEN FWDZ;
ELSE TEST;
END
ELSE IF DELETCTL EQ 0 THEN
BEGIN
LINCTR=LARGENUM;
TEST;
END
EXECONE(REGLINE[RNGTOPREG]+1,REGLINE[RNGBOTREG]-1);
END
IF DELETEDONE AND DELETCTL EQ 1 THEN BAKZ;
END
ELSE
BEGIN
IF EXECNDX NQ EXECST"LOCATE" AND EXECNDX NQ EXECST"REPLACE"
THEN LINPTR1=MAX(LINPTR1,LINPTR2-LIMIT+1);
DELETCTL=0;
REGLINE[RNGTOPREG]=LINPTR2-1;
REGLINE[RNGBOTREG]=LINPTR1+1;
FOR DORNGCTR=1 STEP 1 WHILE LINPTR1 GR REGLINE[RNGTOPREG] AND
LINPTR1 LS REGLINE[RNGBOTREG] AND LINCTR LS LIMIT DO
BEGIN
IF NOT DELETEDONE THEN
BEGIN
LINPTR1=LINPTR1-1;
IF LINPTR1 GR REGLINE[RNGTOPREG] THEN BAKZ;
ELSE TEST;
END
EXECONE(REGLINE[RNGBOTREG]-1,REGLINE[RNGTOPREG]+1);
END
END
IOEND # OF DORANGE #
PAGE # PROGRAM INTERPRETATION CONTROL #
CONTROL IFEQ SINGLE,1;
FUNC COMPARLIN(TEXTLIN,KEYWORD,ABBREV) B;
BEGIN
#
** COMPARLIN - COMPARE INTERNAL LINE TO DISPLAY KEYWORD.
*
* COMPARLIN COMPARES A LINE IMAGE (INTERNAL CHARACTER SET)
* TO A KEYWORD (DISPLAY CODE). THE KEYWORD IS VARIABLE IN
* LENGTH UP TO TEN CHARACTERS. THE LINE MUST EXACTLY
* EQUAL THE KEYWORD IN LENGTH AND CONTENT, EXCEPT THAT THE
* CASE OF LETTERS DOES NOT MATTER.
*
* ENTRY TEXTLIN, KEYWORD - WHAT WE COMPARE.
* ABBREV - WHETHER ABBREVIATIONS ARE PERMISSIBLE.
*
* EXIT COMPARLIN - RESULT OF COMPARISON.
*
* CALLS LENGTH, DSPLCOD.
#
ARRAY TEXTLIN[0:99]; ITEM TEXTLINE;
ITEM KEYWORD;
ITEM ABBREV B;
ITEM TMP1, TMP2, TMP3, TMP4, TMP5, TMP6, TMP7, TMP8, BOOL B;
PROC CHECKWORD(LEN);
BEGIN
ITEM LEN;
# ENTRY - TMP1=KEYWORD POSITION (ALREADY SCANNED) #
# TMP2=TEXTLINE POSITION (NEEDS SCAN) #
# TMP3=LENGTH OF WORD - NOT USED HERE #
# LEN=HOW MANY CHARACTERS TO CHECK #
# EXIT - BOOL=RESULT OF COMPARE #
# TMP4=POSITION AT WHICH TEXTLINE HAD THE WORD #
# TMP5=LENGTH PARAMETER #
BOOL=FALSE;
TMP4=TMP2;
GETCHAR(TEXTLINE,TMP4,TMP5);
WHYLE TMP4 LS LENGTH(TEXTLIN) AND TMP5 EQ CBLANK DO
BEGIN # FIND START OF WORD #
TMP4=TMP4+1;
GETCHAR(TEXTLINE,TMP4,TMP5);
END
IF TMP4 GQ LENGTH(TEXTLIN) THEN RETURN; # NO WORDS AVAIL #
TMP5=TMP4+1;
GETCHAR(TEXTLINE,TMP5,TMP6);
WHYLE TMP6 NQ CBLANK AND TMP6 NQ CENDLINE DO
BEGIN # LOOK FOR END OF WORD #
TMP5=TMP5+1;
GETCHAR(TEXTLINE,TMP5,TMP6);
END
TMP5=TMP5-TMP4; # LENGTH OF WORD #
IF TMP5 GQ LEN THEN # WORD MIGHT MATCH #
BEGIN
FOR TMP6=0 STEP 1 UNTIL LEN-1 DO
BEGIN
GETCHAR(TEXTLINE,TMP4+TMP6,TMP7);
DSPLCOD(TMP7);
TMP8=C<TMP1+TMP6,1>KEYWORD;
IF TMP7 NQ TMP8 THEN RETURN;
END
TMP5=LEN;
BOOL=TRUE;
END
END # OF CHECKWORD #
# MAIN COMPARLIN CODE STARTS HERE #
COMPARLIN=FALSE;
IF ABBREV THEN
BEGIN
TMP1=0; # KEYWORD POSITION #
TMP2=0; # TEXTLINE POSITION #
BOOL=FALSE;
WHYLE TMP1 LQ 9 DO
BEGIN
IF C<TMP1,1>KEYWORD EQ " " OR C<TMP1,1>KEYWORD EQ 0
THEN TMP1=TMP1+1; # KEEP LOOKING FOR WORD #
ELSE # WORD FOUND #
BEGIN
TMP3=TMP1+1; # END OF WORD #
WHYLE TMP3 LQ 9 AND C<TMP3,1>KEYWORD NQ " "
AND C<TMP3,1>KEYWORD NQ 0 DO TMP3=TMP3+1;
TMP3=TMP3-TMP1; # LENGTH OF WORD #
CHECKWORD(TMP3); # TEST ALL POSSIBLE ABBREV-S #
IF (NOT BOOL) AND (TMP3 GR 3) THEN CHECKWORD(3);
IF (NOT BOOL) AND (TMP3 GR 1) THEN CHECKWORD(1);
IF BOOL THEN # PREPARE TO CHECK NEXT WORD #
BEGIN
TMP1=TMP1+TMP3;
TMP2=TMP4+TMP5;
END
ELSE TMP1=10; # IMMEDIATE FAILURE #
END
END
IF BOOL THEN
BEGIN
GETCHAR(TEXTLINE,TMP2,TMP5);
WHYLE TMP5 EQ CBLANK DO # LOOK FOR EOL OR SURPLUS TEXT #
BEGIN
TMP2=TMP2+1;
GETCHAR(TEXTLINE,TMP2,TMP5);
END
IF TMP5 EQ CENDLINE THEN COMPARLIN=TRUE;
END
END
ELSE
BEGIN
TMP1=9;
BOOL=FALSE;
FOR TMP2=9 STEP -1 WHILE TMP2 GQ 0 AND NOT BOOL DO
BEGIN
IF C<TMP2,1>KEYWORD EQ " " OR C<TMP2,1>KEYWORD EQ 0
THEN TMP1=TMP2;
ELSE BOOL=TRUE;
END
IF TMP1 EQ LENGTH(TEXTLIN) THEN
BEGIN
FOR TMP2=0 STEP 1 UNTIL TMP1-1 DO
BEGIN
GETCHAR(TEXTLINE,TMP2,TMP3);
DSPLCOD(TMP3);
TMP4=C<TMP2,1>KEYWORD;
IF TMP3 NQ TMP4 THEN RETURN;
END
COMPARLIN=TRUE;
END
END
END # OF COMPARLIN #
PROC GETPROCNXT;
BEGIN
#
** GETPROCNXT - GET NEXT COMMAND LINE FROM PROCEDURE.
*
* ENTRY CURP(PROCCTL) - PREVIOUS PROCEDURE ADDRESS.
* BOTP(PROCCTL) - BOUNDS ON PROC FILE.
* PROCACTIVE - SHOULD BE TRUE.
*
* EXIT CMDLIN - NEW COMMAND LINE IF NOT END OF PROC.
* CURP(PROCCTL) - INCREMENTED.
* PROCACTIVE - FORCED FALSE IF END OF PROC.
* SCANPOS, TOKENPOS, KEYWDTYPE - RE-INITIALIZED.
*
* CALLS CLEARPROC, COMPARLIN, PUSH, POP, STARTCMD.
*
* USES P<LINEBUF> (RESTORED TO LOC(LIN)).
#
CURP(PROCCTL)=CURP(PROCCTL)+1;
IF CURP(PROCCTL) GQ BOTP(PROCCTL) THEN CLEARPROC;
ELSE
BEGIN
PUSH;
P<LINEBUF>=LOC(CMDLIN);
POSZ(CURP(PROCCTL));
P<LINEBUF>=LOC(LIN);
POP;
STARTCMD;
IF COMPARLIN(CMDLIN,EORCON,FALSE) THEN CLEARPROC;
IF COMPARLIN(CMDLIN,EOFCON,FALSE) THEN CLEARPROC;
EXPANDAT=0;
EXPANDCMDS;
END
END # OF GETPROCNXT #
PROC CLEARPROC;
BEGIN
#
** CLEARPROC - GET OUT OF PROCEDURE EXECUTION MODE.
*
* EXIT PROCACTIVE - FALSE.
* CMDLIN - NULL.
*
* CALLS STARTCMD.
#
PROCACTIVE=FALSE;
CMDLINE[0]=NULLIN;
STARTCMD;
END # OF CLEARPROC #
CONTROL FI;
PAGE # SINGLE/MULTI CONNECTION #
CONTROL IFEQ SINGLE,1;
CONTROL IFEQ NEVERMULTI,1;
PROC CONNECT; BEGIN END
PROC PRECONNECT; BEGIN END
PROC POSTCONNECT; BEGIN END
CONTROL FI;
CONTROL IFEQ NEVERMULTI,0;
PROC PRECONNECT;
BEGIN
#
** PRECONNECT - FIRST STEP IN CONNECTING TO MULTI-USER EDITOR.
*
* PRECONNECT DETERMINES WHETHER CONNECTION SHOULD BE ATTEMPTED.
* IF CONNECTION SHOULD PROCEED, PRECONNECT SIGNALS THIS
* WITH THE CONNECTED FLAG AND CHECKPOINTS THE WORKFILE.
* THE WORKFILE CARRIES THE SMFINCTL FLAG SO WE CAN TELL
* WHETHER SMFEX REACHES A NORMAL END OF SESSION, AS OPPOSED
* TO A RECOVERY SITUATION.
*
* ENTRY SINGLEONLY - WHETHER CONNECTION SHOULD PROCEED.
*
* EXIT CONNECTED - WHETHER CONNECTION SHOULD PROCEED.
* SMFINCTL - SET INTO WORKFILE IF CONNECTED.
* CMDLIN - NULLED OUT IF CONNECTED.
* WORKFILE CHECKPOINTED IF CONNECTED.
*
* CALLS CHECKIO, VDTEOO, TTSYNC, VDTCLO.
#
IF NOT SINGLEONLY THEN
BEGIN
CONNECTED=TRUE;
SMFINCTL=TRUE; # SO WE WILL KNOW IF RCVCRY #
IF SCREENMODE THEN VDTEOO;
ELSE TTSYNC;
VDTCLO(1);
CHECKIO; # DE-INTERLOCK FILE #
END
END # OF PRECONNECT #
PROC CONNECT;
BEGIN
#
** CONNECT - ACTUAL ATTEMPT TO CONNECT TO MULTI.
*
* CONNECT ACTUALLY ATTEMPTS TO CONNECT TO THE MULTI-USER
* EDITING SUBSYSTEM, SMFEX. CONNECT SHOULD BE CALLED ONLY
* IF PRECONNECT RETURNED A POSITIVE RESULT. CONNECT FIRST
* FLUSHES ANY PENDING TERMINAL OUTPUT.
*
* ENTRY SCREENMODE - CONTROL MANNER OF OUTPUT FLUSH.
* FETFNT - NEGATIVE FIELD LENGTH ADDR OF WORKFILE.
* CONNECTED - SHOULD BE TRUE.
*
* EXIT CONNECTED - FORCED FALSE IF ATTEMPT FAILED.
*
* CALLS DISSJ, POSZ, RESUMIO, SYSREQ(TLX).
#
ARRAY XFRVECTOR;
BEGIN
ITEM XFRWORD;
ITEM XFRFNTR U(0,0,12)=[0];
ITEM XFRFNTS U(0,12,12)=[0];
ITEM XFRSSID U(0,24,12)=[SMFSSID];
ITEM XFRFILL U(0,36,12)=[0];
ITEM XFRSTAT U(0,48,11)=[0];
ITEM XFRCOMP U(0,59,1)=[0];
END
XFRFNTS=FETFNT;
XFRCOMP=0;
DISSJ(3); # ENABLE SSJ= #
SYSREQ("TLX",1,LOC(XFRWORD),TLXFUNC*64);
DISSJ(2); # DISABLE SSJ= #
IF XFRSTAT NQ 0 THEN
BEGIN
RESUMIO; # RE-INTERLOCK FILE #
POSZ(SAVECURL);
CONNECTED=FALSE; # INDICATE NO CONNECT OCCURRED #
SINGLEONLY=TRUE;
END
END # OF CONNECT #
PROC POSTCONNECT;
# TITLE POSTCONNECT - VERIFY REVIVAL OF SINGLE-USER EDITOR. #
BEGIN # POSTCONNECT #
#
** POSTCONNECT - VERIFY REVIVAL OF SINGLE-USER EDITOR.
*
* POSTCONNECT REVIVES THE SINGLE-USER EDITOR AFTER AN
* ATTEMPT TO CONNECT TO THE MULTI-USER VERSION OF THE
* FULL SCREEN EDITOR. IF THE CONNECTION ATTEMPT WAS NOT
* SUCCESSFUL, THEN POSTCONNECT SERVES ONLY TO INDICATE
* THAT NO FUTURE CONNECTIONS SHOULD BE ATTEMPTED. FOR A
* NORMAL CONNECTION, POSTCONNECT RESUMES WORKFILE CONTENT
* INTO WORK STORAGE AND INITIALIZES THE SYNTAX SCANNER TO
* USE THE COMMAND STRING RETURNED BY SMFEX.
*
* PROC POSTCONNECT
*
* EXIT CONNECTED - FALSE.
* PAINTAGAIN - FORCED TRUE IF NO CONNECTION.
* SINGLEONLY - FORCED TRUE IF NO CONNECTION.
* SCANPOS - SET ACCORDING TO START OF COMMAND.
* ENTIRE DATA SEGMENT AND ARRAY SEGMENT - PER SMFEX.
*
* CALLS FATAL, PAINTALL, POSZ, RESUMIO, STARTCMD.
#
RESUMIO; # GET SMF RESULT AND INTERLOCK #
IF NOT IORESUMED THEN
BEGIN
FATAL(" WORKFILE IS NOT IN A RESUMEABLE STATE.$");
END
CONNECTED=FALSE;
SCANPOS=CMDMARKER; # LOOK BACK TO CMD START #
BUILDCIO=0;
IF FORCENULL OR SMFINCTL THEN
BEGIN
FORCENULL=FALSE;
SMFINCTL=FALSE;
SINGLEONLY=TRUE;
CMDLINE[0]=NULLIN;
ERRSTRING="SYSTEM INTERRUPT, PROCEED NOW$";
STARTCMD;
PAINTALL;
PAINTAGAIN=TRUE; # SET PAINT AGAIN FLAG #
END
POSZ(SAVECURL);
END # POSTCONNECT #
CONTROL FI;
CONTROL FI;
PAGE # UTILITIES ONLY USED BY PROCESS #
PROC ERRJUMP(STR);
BEGIN
#
** ERRJUMP - ISSUE ERROR MESSAGE AND JUMP TO FRESH COMMANDS.
*
* ERRJUMP PROCESSES ERROR MESSAGES FOR SYNTAX ERRORS IN
* COMMAND PROCESSORS. ERRJUMP THEN IGNORES THE SUBROUTINE
* CALLING CHAIN AND BRANCHES DIRECTLY TO THE MAIN COMMAND
* SEQUENCING LOOP. THUS, ERRJUMP CAN ONLY BE CALLED BY
* ROUTINES WHICH WERE THEMSELVES CALLED BY THE MAIN COMMAND
* SEQUENCING LOOP. NOTE THAT IN THE MULTI-USER VERSION OF
* THE EDITOR, THE CODE AT LABEL "PRERROR" WILL BE EXPECTED
* TO RESET ALL STRUCTURES HAVING TO DO WITH REENTRANT
* SUBROUTINE CALLING CHAINS.
*
* ENTRY STR - MESSAGE TO BE PRINTED.
* SCREENMODE - MODE.
* TOKENPOS - WHERE ERROR WAS DETECTED.
* COMMANDROW - SETUP.
* PROCACTIVE - MODE.
* CURP(PROCCTL) - WHERE WE ARE IN PROC IF ANY.
* CURPROCNAM - NAME OF CURRENT PROC.
* USRSPLTSZ - SETUP.
* CMDLIN - BAD COMMAND TEXT.
*
* EXIT VIA LABEL "PRERROR".
* ERRSTRING - COPY OF THE MESSAGE.
* ERRCURSOR, YCURSOR - POINT TO SYNTAX ERROR.
* SCREEN FORMATTED TO DISPLAY SOURCE OF ERROR.
* CMDLIN - NULLED OUT UNDER CERTAIN CONDITIONS.
* CURFILE, CURSPLIT - MAY BE OPENED INTO PROC.
*
* CALLS OPENFILE, POSZ, SETUPSCREEN, TTBRK, TTLIN, TTSTR,
* CONVOUT, VDTWTC.
*
* USES TMPLIN, FILNUM, GETPARM, CHARPARM, CURF(2),
* CURFILE, CURSPLIT, CURRENT, LIN, LINCTR.
#
ITEM STR C(40);
XREF LABEL PRERROR;
ERRSTRING=STR;
ERRCURSOR=TOKENPOS;
IF SCREENMODE THEN
BEGIN
IF TOKENPOS GQ 0 THEN YCURSOR=COMMANDROW;
CONTROL IFEQ SINGLE,1;
IF PROCACTIVE THEN
BEGIN
READNAM=CURPROCNAM;
FILNUM=2;
GETPARM=0;
CHARPARM=0;
OPENFILE;
CURF(2)=CURP(PROCCTL);
POSZ(CURF(2));
CURFILE=2;
CURSPLIT=2;
SETUPSCREEN(1,2,USRSPLTSZ);
YCURSOR=LTOY(CURRENT,2);
CMDLINE[0]=NULLIN;
END
CONTROL FI;
END
ELSE # LINE MODE #
BEGIN
CONTROL IFEQ SINGLE,1;
IF PROCACTIVE THEN
BEGIN
IF INTERACT THEN
BEGIN # IF INTERACTIVE PROCEDURE ERROR #
TTBRK;
TTLIN("ERROR IN THIS PROCEDURE LINE: $");
TTSTR(" $");
TTSYNC;
CONVOUT(CMDLIN,2);
VDTWTC(TMPLIN);
END
END
CONTROL FI;
CMDLINE[0]=NULLIN;
IF C<0,2>ERRSTRING NQ " $" THEN
BEGIN
TTBRK;
FOR LINCTR=1 STEP 1 UNTIL TOKENPOS+3 DO TTSTR(BLANKWRD);
TTSTR("!$");
TTBRK;
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT AND PROCACTIVE THEN
BEGIN # IF BATCH PROCEDURE ERROR #
TTLIN(" ERROR IN PROCEDURE LINE ABOVE WAS: $");
END
CONTROL FI;
END
END
GOTO PRERROR;
END # OF ERRJUMP #
PROC VFYLOCK;
BEGIN
#
** VFYLOCK - VERIFY PERMISSION TO CHANGE CURRENT FILE.
*
* ENTRY CURFILE - CURRENT FILE.
* LOCKED[CURFILE] - TRUE IF READ-ONLY FILE.
*
* EXIT VIA ERRJUMP IF NOT VALIDATED.
#
IF LOCKED[CURFILE] NQ 0 THEN
BEGIN
ERRJUMP("CANNOT CHANGE READ-ONLY FILE$");
END
END # OF VFYLOCK #
PAGE # FILE ASSIGNMENT HISTORY #
PROC PUSHBACK;
BEGIN
#
** PUSHBACK - PUSH CURRENT FILES AND SPLITS ONTO BACKSTACK.
*
* ENTRY FILENAM[1-2] CONTAIN CURRENT OPEN FILES.
* NUMROWS[2] HAS SPLITSIZE.
*
* EXIT BACKIN (AND MAYBE BACKOUT) INCREMENTED.
* BACKSTACK[BACKIN] CONTAINS FILES,SPLITS.
*
* CALLS INCR(INTERNAL).
#
PROC INCR(I);
BEGIN
# INCR - INCREMENT BACK POINTER #
ITEM I;
I=I+1;
IF I GR BACKMAX THEN I=0;
END # OF INCR #
INCR(BACKIN);
BACKFIL1[BACKIN]=FDLF(1);
BACKFIL2[BACKIN]=FDLF(2);
BACKSPL2[BACKIN]=SPLITFILE[2];
BACKSPLN[BACKIN]=NUMROWS[2];
IF BACKIN EQ BACKOUT THEN INCR(BACKOUT);
END # OF PUSHBACK #
FUNC SAMEBACK B;
BEGIN
#
** SAMEBACK - TEST WHETHER FILES/SPLITS CHANGED.
*
* SAMEBACK ALLOWS THE CALLER TO KNOW WHETHER THE FILE
* BRACKETS HAVE CHANGED IN FILE CHOICE OR IN SPLIT
* DISPLAY DIMENSIONS, SINCE THE LAST CALL TO PUSHBACK.
*
* ENTRY FILENAM[1-2], SPLITFILE[2], NUMROWS[2] - SETUP.
* BACKIN - AS LEFT BY PUSHBACK.
* BACKSTACK[BACKIN] - AS LEFT BY PUSHBACK.
*
* EXIT SAMEBACK - RESULT OF COMPARISON.
#
SAMEBACK=TRUE;
IF BACKFIL1[BACKIN] NQ FDLF(1)
OR BACKFIL2[BACKIN] NQ FDLF(2)
OR BACKSPL2[BACKIN] NQ SPLITFILE[2]
OR BACKSPLN[BACKIN] NQ NUMROWS[2] THEN SAMEBACK=FALSE;
END # OF SAMEBACK #
PROC DECRBACK;
BEGIN
#
** DECRBACK - DECREMENT FILE SELECTION QUEUE.
*
* DECRBACK BACKS UP THE CIRCULAR QUEUE OF FILE SELECTIONS.
*
* ENTRY BACKIN - POINTER TO BE BACKED AROUND CIRCLE.
*
* EXIT BACKIN - DECREMENTED OR RECIRCULATED.
#
IF BACKIN NQ BACKOUT THEN
BEGIN
BACKIN=BACKIN-1;
IF BACKIN LS 0 THEN BACKIN=BACKMAX;
END
END # OF DECRBACK #
PROC RESTSAVPOS;
IOBEGIN(RESTSAVPOS)
#
** RESTSAVPOS - RESTORE SAVED POSITION.
*
* RESTSAVPOS ACCOMPLISHES THE FILE SWITCHING OF THE
* BACK DIRECTIVE EXCHANGE OPERATION.
* IT IS CALLED TO SET UP THE FILE POSITION IN EFFECT
* WHEN THE LAST BACK OR DATA DIRECTIVE WAS EXECUTED.
*
* ENTRY FILNUM - INDICATES WHICH SPLIT IS BEING ACTIVATED.
* BKSPLIT2[BACKIND] - INDICATES SINGLE FILE IS ACTIVE.
* CURSPLIT - RECENT HISTORY OF FILE SELECTION.
* REGSTCLIN(BCKCURLIN) - REGISTER STACK LINE POINTER.
*
* EXIT DESIGNATED FILE OPENED AND POSSIBLY POINTING
* TO THE EXACT WORKING LINE.
*
* CALLS OPENFILE, POSZ, SCANFDL.
*
* USES CHARPARM, CURF(FILNUM), CURRENT, GETPARM,
* LINCTR, READNAM.
#
CHARPARM = 0;
GETPARM = 0;
IF (FILNUM EQ 1) THEN
POSZ(BKFDLFF1[BACKIND]);
ELSE
POSZ(BKFDLFF2[BACKIND]);
SCANFDL(READNAM); # RETRIEVE FILE NAME FROM FDL #
OPENFILE; # ACCESS THE FILE #
IOEND # OF RESTSAVPOS #
PROC EXCHSAVPOS;
IOBEGIN(EXCHSAVPOS)
#
** EXCHSAVPOS - EXCHANGE CURRENT POSITION WITH SAVED POSITION.
* EXCHSAVPOS COMPRISES THE FUNCTIONAL OPERATION OF THE
* BACK DIRECTIVE EXCHANGE OPERATION.
* IT IS CALLED BY THE BACK DIRECTIVE TO ACCOMPLISH THE
* SWITCH BETWEEN THE CURRENT POSITION ON THE SCREEN
* WITH THE POSITION IN EFFECT AFTER THE MOST RECENT BACK
* OR EDIT DIRECTIVE.
* EXCHSAVPOS FIRST SAVES THE CURRENT FILE(S), SPLIT LOGIC,
* ACTIVE LINE, AND CURSOR POSITION IN TEMPORARY STORAGE.
* THE PREVIOUSLY STORED POSITION IS THEN RECALLED, AND THE
* TEMPORARY VALUES ARE THEN SAVED IN PERMANENT STORAGE.
*
* EXIT BACKSTORE ARRAY CONTAINS NEW POSITION.
* FILE(S) AND SCREEN UPDATED TO REFLECT PREVIOUSLY
* STORED POSITION.
*
* CALLS POP, PUSH, RESTSAVPOS.
*
* USES BACKSTORE, CURSPLIT, FILNUM, LINPTR1, LINPTR2,
* NEWCURSOR, REGSTCLIN, TEMPCURLIN, YCURSOR.
*
#
LINPTR1 = 0;
LINPTR2 = 0;
# PLACE CURRENT SCREEN POSITION INTO TEMPORARY STORAGE. #
PUSH;
BKFDLFF1[TEMPIND] = FDLF(1);
BKFDLFF2[TEMPIND] = FDLF(2);
BKSPLIT2[TEMPIND] = SPLITFILE[2];
BKNROWS1[TEMPIND] = NUMROWS[1];
BKNROWS2[TEMPIND] = NUMROWS[2];
BKWHCHSP[TEMPIND] = CURSPLIT;
IF ( CURSPLIT EQ 1 ) THEN
TEMPCURLIN = CURF(1);
ELSE
TEMPCURLIN = CURF(2);
BKCURSOR[TEMPIND] = CURCURSOR;
POP;
# RETRIEVE STORED POSITION. #
CURSPLIT = BKWHCHSP[BACKIND];
IF (BKSPLIT2[BACKIND] EQ 0) THEN # SINGLE FILE, NO SPLIT #
BEGIN
FILNUM = 1;
RESTSAVPOS; # RESTORE SINGLE FILE #
END
ELSE
BEGIN # SPLIT FILES #
IF (CURSPLIT NQ 1) THEN
BEGIN # TOP FIRST, THEN BOTTOM #
FILNUM = 1;
RESTSAVPOS;
FILNUM = 2;
RESTSAVPOS; # RESTORE SPLIT FILE #
END
ELSE
BEGIN # BOTTOM FIRST, THEN TOP #
FILNUM = 2;
RESTSAVPOS; # RESTORE SPLIT FILE #
FILNUM = 1;
RESTSAVPOS; # RESTORE TOP FILE #
END
END
LINPTR1 = BKSPLIT2[BACKIND];
LINPTR2 = BKNROWS2[BACKIND];
YCURSOR = -1;
NEWCURSOR = BKCURSOR[BACKIND];
# MOVE CURRENT POSITION FROM TEMPORARY TO PERMANENT STORAGE. #
BKFDLFF1[BACKIND] = BKFDLFF1[TEMPIND];
BKFDLFF2[BACKIND] = BKFDLFF2[TEMPIND];
BKSPLIT2[BACKIND] = BKSPLIT2[TEMPIND];
BKNROWS1[BACKIND] = BKNROWS1[TEMPIND];
BKNROWS2[BACKIND] = BKNROWS2[TEMPIND];
BKWHCHSP[BACKIND] = BKWHCHSP[TEMPIND];
REGSTCLIN(BCKCURLIN) = TEMPCURLIN;
BKCURSOR[BACKIND] = BKCURSOR[TEMPIND];
IOEND # OF EXCHSAVPOS #
PROC STORCURPOS;
IOBEGIN(STORCURPOS)
#
** STORCURPOS - STORE CURRENT POSITION.
*
* STORCURPOS PLACES THE CURRENT SCREEN AND FILE POSITIONS
* INTO PERMANENT STORAGE, FOR LATER RECALL BY THE BACK
* DIRECTIVE. A FLAG IS SET TO INDICATE THAT THE STORAGE
* HAS TAKEN PLACE.
*
* EXIT CURRENT FILE(S) AND SCREEN POSITION STORED IN
* BACKSTORE.
*
* CALLS POP, PUSH.
*
* USES BACKSTORE[BACKIND], REGSTCLIN.
*
#
# STORE CURRENT POSITION FOR LATER RECALL BY BACK DIRECTIVE.#
PUSH;
BKFDLFF1[BACKIND] = FDLF(1);
BKFDLFF2[BACKIND] = FDLF(2);
BKSPLIT2[BACKIND] = SPLITFILE[2];
BKNROWS1[BACKIND] = NUMROWS[1];
BKNROWS2[BACKIND] = NUMROWS[2];
BKWHCHSP[BACKIND] = CURSPLIT;
IF ( CURSPLIT EQ 1 ) THEN
REGSTCLIN(BCKCURLIN) = CURF(1);
ELSE
REGSTCLIN(BCKCURLIN) = CURF(2);
BKCURSOR[BACKIND] = CURCURSOR;
POP;
IOEND # OF STORCURPOS #
PROC DOBACK;
IOBEGIN(DOBACK)
#
** DOBACK - REVERT TO EARLIER FILE SELECTION.
*
* DOBACK CONSTITUTES THE ESSENTIAL FUNCTION OF THE BACK
* COMMAND, WHICH IS TO CHANGE THE EDITORS SELECTION OF
* ONE OR TWO OPEN FILE BRACKETS TO THE SELECTION IN
* EFFECT ONE CHRONOLOGICAL UNIT EARLIER.
*
* ENTRY BACKIN, BACKOUT - CIRCULAR POINTERS FOR QUEUE.
* BACKSTACK - RECENT HISTORY OF FILE SELECTION.
*
* EXIT ONE OR BOTH FILE BRACKETS OPENED.
* BACKIN - CIRCULARLY DECREMENTED.
* LINPTR1, LINPTR2 - INDICATE SCREEN FORMATTING.
*
* CALLS PADNAME, OPENFILE, DECRBACK, SCANFDL.
*
* USES READNAM, FILNUM, CHARPARM, GETPARM.
#
LINPTR1=0;
LINPTR2=0;
DECRBACK;
IF BACKIN NQ BACKOUT THEN
BEGIN
POSZ(BACKFIL1[BACKIN]);
SCANFDL(READNAM);
FILNUM=1;
CHARPARM=0;
GETPARM=0;
OPENFILE;
IF BACKSPL2[BACKIN] NQ 0 THEN
BEGIN
POSZ(BACKFIL2[BACKIN]);
SCANFDL(READNAM);
FILNUM=2;
OPENFILE;
END
LINPTR1=BACKSPL2[BACKIN];
LINPTR2=BACKSPLN[BACKIN];
DECRBACK;
END
IOEND # OF DOBACK #
PROC MAKENONTRIV;
IOBEGIN(MAKENONTRIV)
#
* MAKENONTRIV - MAKE FILE SELECTION NON-TRIVIAL.
*
* MAKENONTRIV IS RESPONSIBLE TO TRY TO AVOID SHOWING THE
* THE USER ANY DISCARDED FILE IMAGES, WHICH HAVE FILE NAMES
* OF ZZZNULL. THIS IS DONE BY CHECKING FOR THAT RESERVED
* FILE NAME, AND WHEN IT APPEARS, THE ALGORITHM ATTEMPTS TO
* SELECT A BETTER FILE USING THE "LAST NON-TRIVIAL FILE CLOSED"
* INFORMATION WHICH WAS MAINTAINED BY THE CLOSEFILE ROUTINE.
*
* ENTRY FILENAM[1-2] - CURRENT FILE NAMES.
* FILEFILE[2 - WHETHER SECOND FILE BRACKET ACTIVE.
* NONTRIVFILE[ALL] - RECENT VALID FILES.
*
* EXIT ONE OR BOTH FILE IMAGES POSSIBLY RE-OPENED.
*
* CALLS OPENFILE, SCANFDL, PICKFILE(INTERNAL), POSZ.
*
* USES READNAM, FILNUM, GETPARM, CHARPARM, LINENO.
#
PROC PICKFILE;
IOBEGIN(PICKFILE)
#
* PICKFILE - INTERNAL ALGORITHM FOR MAKENONTRIV.
*
* NOTE SEE HEADER DOCUMENTATION FOR MAKENONTRIV.
#
POSZ(LINENO);
SCANFDL(READNAM);
GETPARM=0;
CHARPARM=0;
OPENFILE;
IF FILNUM EQ CURFILE AND NOT SCREENMODE THEN
BEGIN
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT THEN TTSTR(" $");
CONTROL FI;
TTSTR("EDIT: $");
TTLFN(FILENAM[FILNUM]);
TTBRK;
END
IOEND # OF PICKFILE #
# MAKENONTRIV MAIN ALGORITHM STARTS HERE #
PUSHTEMP;
IF SPLITFILE[2] NQ 0 AND FILENAM[2] EQ "ZZZNULL" THEN
BEGIN
FILNUM=2;
LINENO=FDLF(2);
IF FILENAM[1] NQ "ZZZNULL" THEN LINENO=FDLF(1);
ELSE
BEGIN
FOR TEMP=4 STEP -1 UNTIL 1 DO
BEGIN
IF NONTRIVFILE[2,TEMP] NQ 0 THEN LINENO=NONTRIVFILE[2,TEMP];
END
END
PICKFILE;
END
IF FILENAM[1] EQ "ZZZNULL" THEN
BEGIN
FILNUM=1;
LINENO=FDLF(1);
IF SPLITFILE[2] NQ 0 AND FILENAM[2] NQ "ZZZNULL"
THEN LINENO=FDLF(2);
ELSE
BEGIN
FOR TEMP=4 STEP -1 UNTIL 1 DO
BEGIN
IF NONTRIVFILE[1,TEMP] NQ 0 THEN LINENO=NONTRIVFILE[1,TEMP];
END
END
PICKFILE;
END
POPTEMP;
IOEND # OF MAKENONTRIV #
PAGE # GLOBAL PROMPTING #
PROC CHECKGLOBAL;
BEGIN
#
** CHECKGLOBAL - SEE IF GLOBAL SEARCH/CHANGE IN EFFECT.
*
* CHECKGLOBAL TESTS WHETHER THE PROMPTING FLAG SHOULD BE SET
* FOR GLOBAL LOCATE/CHANGE MENU PROMPTS. THE DECISION
* REQUIRES SCREEN MODE, LARGE LIMIT IN THE COMMAND RANGE,
* LACK OF QUIET MODE, LACK OF COMMAND PROCEDURE, AT LEAST ONE
* RANGE BOUNDARY OFF-SCREEN.
*
* ENTRY LIMIT, SCREENMODE, DONTPRINT - MODES.
* LINPTR1, LINPTR2 - RANGE BOUNDS.
* CURSPLIT, TOPS(CURSPLIT), BOTS(CURSPLIT) - BOUNDS.
*
* EXIT PROMPTING - FORCED TRUE IF RIGHT CONDITIONS.
* ROWSUSED - FORCED ZERO SAME CONDITIONS.
#
IF LIMIT GR 1
AND SCREENMODE
AND ( NOT DONTPRINT )
AND ( LINPTR1 LQ TOPS(CURSPLIT)
OR LINPTR1 GQ BOTS(CURSPLIT)
OR LINPTR2 LQ TOPS(CURSPLIT)
OR LINPTR2 GQ BOTS(CURSPLIT)
OR (LINPTR1 EQ TOPF(CURFILE)+1 AND LINPTR2 EQ BOTF(CURFILE)-1) )
THEN
BEGIN
PROMPTING=TRUE;
ROWSUSED=0;
END
END # OF CHECKGLOBAL #
PROC LASTGLOBAL;
IOBEGIN(LASTGLOBAL)
#
** LASTGLOBAL - DETERMINE IF LAST ITERATION OF CHANGE.
*
* LASTGLOBAL DETERMINES WHETHER A RECENTLY COMPLETED
* ALTER OR REPLACE COMMAND NEEDS ONE LAST GLOBAL CHANGE
* MENU DISPLAY.
*
* ENTRY PROMPTING - WHETHER IN GLOBVAL DISPLAY MODE.
* ROWSUSED - HOW MANY MENU ITEMS PENDING USER PROMPT.
*
* EXIT LINCTR - POSSIBLY LARGENUM.
* CMDLIN - POSSIBLY CONTAINS UNDO COMMAND.
*
* CALLS GLOBALCHANGE.
#
IF PROMPTING THEN
BEGIN
LINCTR=LARGENUM; # FOR FINAL PROMPT #
IF ROWSUSED NQ 0 THEN GLOBALCHANGE;
END
IOEND # OF LASTGLOBAL #
PROC ASKUSER(STR1,STR2);
IOBEGIN(ASKUSER);
#
** ASKUSER - ASK QUESTION EITHER SCREEN OR LINE.
*
* ASKUSER IS ABLE TO INQUIRE OF THE USER FOR EXTRA INSTRUCTIONS
* USING EITHER THE SCREEN DISPLAY OR BY PROMPTING ON A LINE
* MODE TERMINAL.
*
* ENTRY STR1 - PROMPT STRING FOR SCREEN DEVICE.
* STR2 - PROMPT STRING FOR LINE DEVICE.
* SCREENMODE - WHICH MODE IS IN EFFECT.
* COMMANDROW - WHERE TO PUT STR1.
* CURFILE, ASCII[CURFILE] - LOWERCASE SUPPRESSION.
*
* EXIT TTYLIN - USER'S REPLY.
* PROMPTING - FORCED FALSE ON RETURN.
* ERRSTRING - FORCED BLANK ON RETURN.
* ROWPAINT[COMMANDROW] - FORCED TRUE.
* FOUND - FALSE FOR FUNCTION KEY COMMAND OVERRIDE.
* ESCAPE - TRUE FOR FUNCTION OVERRIDE.
* CMDLIN - IF OVERRIDE, FUNCTION COMMAND.
* SCANPOS, TOKENPOS - ZEROED FOR OVERRIDE.
*
* CALLS COPYLIN, PUSH, PAINTSCREEN, DOSCREEN, POP, STARTCMD,
* EXCHWD, TTSTR, PROMPT, CONVIN, TRIM, SQUELCH,
* PUSHTEMP, POPTEMP.
*
* USES TEMP, TMPLIN, XCURSOR, YCURSOR.
#
ITEM STR1 C(80);
ITEM STR2 C(10);
CONTROL IFEQ SINGLE,1;
ARRAY CMDTEMP[0:BUFWID]; # SAVE COMMAND LINE #
BEGIN
ITEM CMDLINSAVE = [BUFWIDP1(NULLIN)];
END
CONTROL FI;
IF SCREENMODE THEN
BEGIN
CONTROL IFEQ SINGLE,1;
COPYLIN(CMDLIN,CMDTEMP); # SAVE #
CONTROL FI;
CONTROL IFEQ MULTI,1;
COPYLIN(CMDLIN,TTYLIN); # SAVE #
CONTROL FI;
CMDLINE[0]=NULLIN;
PUSH;
PUSHTEMP;
TEMP=CURCURSOR;
IF ERRSTRING NQ " $" AND ERRSTRING NQ STR1 THEN
BEGIN # IF UNIQUE ERRSTRING PRESENT #
XCURSOR = 0; # MERGE WITH PROMPT #
YCURSOR = 0;
WHYLE C<XCURSOR,1>ERRSTRING NQ "$" DO XCURSOR = XCURSOR + 1;
C<XCURSOR,2>ERRSTRING = ", ";
XCURSOR = XCURSOR + 2;
WHYLE XCURSOR LQ 77 AND C<YCURSOR,1>STR1 NQ "$" DO
BEGIN
C<XCURSOR,1>ERRSTRING = C<YCURSOR,1>STR1;
XCURSOR = XCURSOR + 1;
YCURSOR = YCURSOR + 1;
END
C<XCURSOR,1>ERRSTRING = "$";
END
ELSE
BEGIN # NO UNIQUE ERRSTRING YET #
ERRSTRING = STR1; # SET TO PROMPT #
END
XCURSOR=0;
YCURSOR=COMMANDROW;
PROMPTING=TRUE; # RESTRICT KEYBOARD TRICKS #
PAINTSCREEN;
DOSCREEN;
PROMPTING=FALSE;
ROWPAINT[COMMANDROW]=TRUE;
CURCURSOR=TEMP;
POPTEMP;
POP;
IF ESCAPE THEN
BEGIN
MOVEWD(BUFWIDP1,CMDLIN,TTYLIN);
STARTCMD;
END
CONTROL IFEQ SINGLE,1;
ELSE
BEGIN # RESTORE #
COPYLIN(CMDLIN,TTYLIN);
COPYLIN(CMDTEMP,CMDLIN);
END
CONTROL FI;
CONTROL IFEQ MULTI,1;
ELSE EXCHWD(BUFWIDP1,CMDLIN,TTYLIN); # RESTORE #
CONTROL FI;
END
ELSE
BEGIN
ERRSTRING=STR2;
TTSTR(STR1);
PROMPT(ERRSTRING);
CONVIN(TTYLIN,2);
TRIM(TTYLIN,1);
END
IF ASCII[CURFILE] LQ 1 THEN SQUELCH(TTYLIN);
ERRSTRING=" $";
IOEND # OF ASKUSER #
PAGE # PROCESS ROUTINE #
PROC PROCESS;
IOBEGIN(PROCESS)
#
** PROCESS - STEADY-STATE MAIN PROCESS OF EDITOR.
*
* PROCESS PROVIDES THE MAIN LOOP FOR EDITOR EXECUTION IN THE
* STEADY STATE, (I.E. AFTER INITIALIZE AND BEFORE
* TERMINATE), AND DRIVES THE SCANNING AND EXECUTION OF EACH
* OF THE COMMANDS. THE MAIN LOOP OF PROCESS IS BROKEN IN THE
* FOLLOWING LABELED SECTIONS --
*
* "PRCLEAR" - THIS SECTION DRIVES INTERACTION WITH THE
* TERMINAL TO OBTAIN NEW COMMANDS. SINCE PRCLEAR MAY BE
* ACTIVATED BEFORE THE PREVIOUS COMMAND SEQUENCE CLEANLY
* TERMINATED, (I.E. AFTER TERMINAL INTERRUPT OR SYNTAX
* ERROR), LOGIC IS PROVIDED TO CLEAN UP ANY CLUTTER. THE
* FETCHING OF COMMANDS MAY OCCUR VIA GETPROCNXT, GETCMD,
* DOSCREEN, OR VIA CONNECTION FROM THE SINGLE-USER EDITOR TO
* THE MULTI-USER EDITOR.
*
* GETPROCNXT AND GETCMD SIMPLY OBTAIN ONE LINE OF COMMAND
* TEXT FROM EITHER AN ACTIVE EDITOR PROCEDURE OR FROM A
* LINE-MODE TERMINAL. DOSCREEN OBTAIN COMMANDS FROM A SCREEN
* TERMINAL, AND MAY PERFORM ANY FILE MANIPULATIONS OFF THE
* KEYBOARD BEFORE IDENTIFYING A COMMAND STRING. BEFORE
* CALLING DOSCREEN, PRCLEAR MUST CALL PAINTSCREEN TO BRING
* THE SCREEN DISPLAY UP TO DATE WITH RESULTS OF THE PREVIOUS
* COMMAND SEQUENCE. CONNECTION TO MULTI MAY CAUSE ANY AMOUNT
* OF EDITING TO BE DONE BEFORE THE MULTI-USER EDITOR RETURNS
* A COMMAND STRING WHICH IT DOES NOT KNOW HOW TO EXECUTE.
*
* "PRNEXT" CONTINUES AFTER PRCLEAR BY INITIALIZING THE SYNTAX
* SCANNER TO THE BEGINNING OF A STRING OF SEVERAL COMMANDS.
* THE PROCESS ROUTINE IS ALLOWED TO SKIP PRCLEAR AND START
* WITH THE PRNEXT SECTION SHOULD A COMMAND STRING BE
* AVAILABLE AS A RESULT OF EDITOR INITIALIZATION.
*
* "PRMORE" CONTINUES SYNTAX SCAN FOR EACH COMMAND VERB.
* PRMORE RE-DEFAULTS A NUMBER OF EDITOR VARIABLES RELATED TO
* SYNTAX OPTIONS THEN IDENTIFIES THE COMMAND VERB AND FANS
* OUT TO THE APPROPRIATE PROCESSING LABEL. THERE IS ONE
* PROCESSING LABEL FOR EACH COMMAND VERB (LABELS "PPXXXX")
* PLUS A NUMBER OF PROCESSING LABELS FOR QUASI COMMANDS.
* (LABELS "QQXXXX")
*
* "PREND" IS THE RETURN POINT FOR COMMANDS THAT COMPLETE
* NORMALLY. IT SIMPLY DETERMINES WHETHER TO GO TO PRMORE FOR
* EXECUTION OF ADDITIONAL COMMAND VERBS FROM THE SAME COMMAND
* STRING, OR TO GO TO PRCLEAR TO RESET THE TERMINAL AND
* PROMPT FOR MORE COMMANDS.
*
* "PRERROR" IS THE RETURN POINT FOR COMMANDS THAT CANNOT
* COMPLETE THEIR NORMAL FUNCTION DUE TO A USER'S ERROR. FOR
* THE MULTI-USER VERSION OF THE EDITOR, PRERROR MUST
* RE-DEFAULT THE SUBROUTINE CALLING LINKAGE TO KEEP
* REENTRANCY WORKING CORRECTLY.
*
* THERE IS ONLY ONE MECHANISM TO RETURN OUT OF THE PROCESS
* ROUTINE - THE "QQEXIT" LABELED SECTION.
*
* ENTRY WHEN PROCESS IS ENTERED, ALL THAT IS EXPECTED IS
* THERE IS A VALID WORKFILE WITH A FILE DIRECTORY
* BRACKET, ONE OR MORE FILE IMAGE BRACKETS, AND AN
* AUDIT TRAIL BRACKET. THE RELOCATION VECTOR MUST
* CONTAIN VALID BRACKET POINTERS FOR THESE SECTIONS.
* THE INPUT AND OUTPUT FILES MUST BE READY TO BE USED.
*
* EXIT WHEN PROCESS COMPLETES, ALL COMMANDS HAVE BEEN
* PROCESSED IN THE CASE OF THE SINGLE-USER VERSION, OR
* CMDLIN CONTAINS AN UNEXECUTABLE COMMAND IN THE CASE
* OF THE MULTI-USER VERSION. AFTER PROCESS COMPLETES,
* THE MULTI-USER VERSION IS EXPECTED TO CHECKPOINT AND
* RE-TRANSFER THE WORKFILE. THE SINGLE-USER VERSION
* IS EXPECTED TO RE-BUILD FILES ACCORDING TO THE
* ATTRIBUTES IN THE FILE DIRECTORY.
#
XDEF LABEL PRERROR;
CONTROL IFEQ MULTI,1;
XDEF LABEL QQSINGLE;
CONTROL FI;
SWITCH PROCESSSW
PPALTER,
PPBACK,
PPCOPY,
PPDELETE,
PPDATA,
PPEDIT,
PPFSE,
PPGET,
PPHELP,
PPINSERT,
PPLOCATE,
PPMOVE,
PPPRINT,
PPQUIT,
PPREPLACE,
PPSET,
PPTEACH,
PPUNDO,
PPVIEW;
PAGE # OUTER LOGIC OF PROCESS #
ORIGSTKPTR=STACKPTR;
STARTCMD;
GOTO PRNEXT; # CTL CARD HAS 1ST CMD #
PRCLEAR: # NEW INTERACTION #
CURF(CURFILE)=MIN(MAX(CURRENT,TOPF(CURFILE)),BOTF(CURFILE));
IF USRBRK NQ 0 THEN
BEGIN
USRBRK=0;
TTINIT;
VDTFLS; # THROW AWAY INCOMPLETE I/O #
VDTDRN;
CONTROL IFEQ MULTI,1;
CLEARINT; # CLEAR SMFEX INTRPT, REQUE #
CONTROL FI;
CONTROL IFEQ SINGLE,1;
IF PROCACTIVE THEN CLEARPROC;
CONTROL FI;
CMDLINE[0]=LINECMD; # SET LINE #
CMDLINE[1]=NULLIN;
STARTCMD;
GOTO PRNEXT;
END
FORWARD=FALSE;
BACKWARD=FALSE;
PROMPTING=FALSE;
NUMWIDBLK=NUMWIDTH+BLANKS;
IF NUMBERED[CURFILE] EQ 0 THEN NUMWIDBLK=0;
CONTROL IFEQ SINGLE,1;
# NOTE - MUST TEST VDTAPS BEFORE PROCACTIVE. IF VDTAPS, JUMP #
# FORWARD TO AVOID PROCACTIVE TEST. #
IF NOT APSTRREAD[0] THEN
BEGIN # IF APPLICATION STRING NOT READ #
VDTAPS("FSEKEYS",CMDLIN,LINPTR1,LINPTR2);
IF LINPTR2 EQ 0 THEN # GOT A COMMAND #
BEGIN
IF LINPTR1 LQ BUFCM1 THEN
BEGIN # IF TDU STRING IS SMALL ENOUGH #
FOR LINPTR3=0 STEP 1 UNTIL LINPTR1-1 DO
BEGIN # TRANSLATE COMMAND #
GETCHAR(CMDLINE,LINPTR3,LINPTR2);
LINPTR2=XLTXPINT[LINPTR2];
SETCHAR(CMDLINE,LINPTR3,LINPTR2);
END
SETCHAR(CMDLINE,LINPTR1,CENDLINE);
END
ELSE
BEGIN # TDU FSEKEYS STRING IS TOO LONG #
CMDLINE[0]=NULLIN; # NULL COMMAND #
ERRSTRING = "FSEKEYS IN TDU DEFINITION TOO LONG$";
END
STARTCMD;
GOTO PRNEXT;
END
ELSE # END OF COMMANDS #
BEGIN
IF SCREENMODE THEN APSTRREAD[0] = TRUE;
END
END
# NOTE - MUST TEST PROCACTIVE BEFORE CTLCDCMD. IF PROCACTIVE, #
# JUMP FORWARD TO AVOID CTLCDCMD TEST. SINCE GETPROCNXT MIGHT #
# TURN PROCACTIVE OFF, THE CODE CANNOT USE IF/ELSE LOGIC BUT #
# MUST TEST THE FLAG TWICE. #
IF PROCACTIVE THEN GETPROCNXT; # MUST TEST TWICE #
IF PROCACTIVE THEN GOTO PRNEXT; # CANNOT USE "ELSE" #
# NOTE - MUST TEST CTLCDCMD BEFORE READING A COMMAND BUFFER FROM #
# THE TERMINAL. IF CTLCDCMD, JUMP FORWARD TO AVOID TERMINAL IO. #
IF CTLCDCMD THEN # FETCH CTL CARD CMDS #
BEGIN
P<FROM>=CCDR;
MOVEWD(8,FROM,TMPLIN);
CONVIN(CMDLIN,1);
LINPTR3=-1;
FOR LINPTR1=0 STEP 1 WHILE LINPTR3 LS 0 DO
BEGIN
GETCHAR(CMDLINE,LINPTR1,LINPTR2);
IF LINPTR2 EQ CPERIOD OR LINPTR2 EQ CRPAREN
THEN LINPTR3=LINPTR1+1;
IF LINPTR2 EQ CENDLINE THEN LINPTR3=LINPTR1;
END
FOR LINPTR1=LINPTR3 STEP 1 UNTIL LENGTH(CMDLIN) DO
BEGIN
GETCHAR(CMDLINE,LINPTR1,LINPTR2);
SETCHAR(CMDLINE,LINPTR1-LINPTR3,LINPTR2);
END
CTLCDCMD=FALSE; # ASSURE NO FURTHER USAGE #
STARTCMD;
IF LENGTH(CMDLIN) NQ 0 THEN GOTO PRNEXT;
END
CONTROL FI;
AUDITCHECK; # SINCE THIS IS NEW TRANSACTION CYCLE #
IF CURFILE EQ 2 AND SPLITFILE[2] EQ 0 THEN
BEGIN # MUST GET CURRENT FILE INTO BRACKET 1 #
CURF(2)=MIN(MAX(CURRENT,TOPF(2)),BOTF(2));
READNAM=PADNAME(FILENAM[2]);
FILNUM=1;
CHARPARM=0;
GETPARM=0;
OPENFILE;
END
MAKENONTRIV; # MAKE FILE SELECT NONTRIVIAL #
IF ERRCURSOR LS 0 THEN CMDLINE[0]=NULLIN;
IF SCREENMODE THEN
BEGIN
IF FORCEDHOME THEN # IF HOME REQUESTED #
BEGIN
FORCEDHOME=FALSE;
XCURSOR=0;
YCURSOR=COMMANDROW;
END
PAINTSCREEN;
IF PAINTAGAIN THEN # IF SCREEN SHOULD BE PAINTED #
BEGIN
PAINTALL; # SET PAINT SCREEN BITS #
PAINTAGAIN=FALSE; # RESET PAINT FLAG #
END
END
ELSE
BEGIN # LINE MODE #
IF ERRSTRING NQ " $" THEN
BEGIN # IF MESSAGE TO OUTPUT #
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT THEN TTSTR(" $");
CONTROL FI;
TTLIN(ERRSTRING);
END
END
IF ERRSTRING NQ " $" THEN
BEGIN # IF MESSAGE TO CLEAR #
ROWPAINT[RESPONSEROW] = TRUE;
ERRSTRING = " $";
END
ERRCURSOR=-1;
STARTCMD;
CONTROL IFEQ SINGLE,1;
IF LENGTH(CMDLIN) EQ 0 THEN PRECONNECT;
IF CONNECTED THEN CONNECT; # MUST TEST TWICE #
IF CONNECTED THEN POSTCONNECT; # CANNOT USE *ELSE* HERE #
ELSE # BUT MUST USE *ELSE* HERE #
BEGIN
PUSH;
IF NULLINPUT THEN
BEGIN
CMDLINE[0]=NULLIN;
GOTO QQEXIT;
END
IF SCREENMODE THEN DOSCREEN;
ELSE GETCMD;
NOPOP;
END
IF EXPANDAT GQ 0 THEN EXPANDCMDS;
CONTROL FI;
CONTROL IFEQ MULTI,1;
PUSH;
IF SCREENMODE THEN DOSCREEN;
ELSE GETCMD;
NOPOP;
IF EXPANDAT GQ 0 THEN EXPANDCMDS;
CONTROL FI;
PRNEXT: # DROP THRU OR SKIP AT START #
CONTROL IFEQ SINGLE,1;
IF NOT (ECHOOFF OR INTERACT) THEN
BEGIN # IF NOT INTERACTIVE #
IF LENGTH(CMDLIN) NQ 0 THEN
BEGIN # IF COMMAND, ECHO #
TTSTR(" $");
SCRNPT3 = LENGTH(CMDLIN);
FOR SCRNPT5 = 0 STEP 1 UNTIL SCRNPT3 - 1 DO
BEGIN
GETCHAR(CMDLINE,SCRNPT5,SCRNPT4);
SCRNPT4 = XLTINTDSP[SCRNPT4];
TTCHR(SCRNPT4);
END
TTBRK;
END
END
CONTROL FI;
KEYWDTYPE=1;
TOKEN;
PRMORE: # CONTINUE MULTI-CMD LINE #
CONTROL IFEQ MULTI,1;
CHKVICTIM; # IN CASE SMFEX PROBLEM #
RSTKSAVE=RSTKPTR; # IN CASE SYNTAX ERROR #
OLDCURFIL=CURFILE; # IN CASE CHANGE OF FILE ... #
OLDFDLF1=FDLF(1); # ... SELECTION IN SWITCH ... #
OLDFDLF2=FDLF(2); # ... MULTI TO SINGLE. #
CONTROL FI;
DATAPTR=-1; # ASSURE CLEAN DATA STACK #
CMDMARKER=TOKENPOS; # REMEMBER BEFORE PREFICES #
DELETCTL=0;
NONDEFAULT=FALSE;
TXTINCMD=FALSE;
BACKWARD=FALSE;
FORWARD=FALSE;
CHARRANGE=FALSE;
NUMWIDBLK=NUMWIDTH+BLANKS;
IF NUMBERED[CURFILE] EQ 0 THEN NUMWIDBLK=0;
DONTPRINT=FALSE;
FOUND=TRUE;
LIMIT=-1;
WHICHLIN=1;
WHICHSTR=0;
FILNUM=0;
CURF(CURFILE)=MIN(MAX(CURRENT,TOPF(CURFILE)),BOTF(CURFILE));
NEWCURSOR=CURCURSOR;
ESCAPE=FALSE;
NXTESCAPE=FALSE;
THISEXTEND=0;
CMDWASDLTE[0] = FALSE;
FORCEAUTOP[0] = FALSE;
FORCEAUTOR[0] = FALSE;
IF USRBRK NQ 0 THEN GOTO PRCLEAR;
CANINTER=TRUE;
PUSH; # REMEMBER CURRENT #
PUSHBACK;
CONTROL IFEQ MULTI,1;
IF FORCESINGLE THEN
BEGIN
FORCESINGLE=FALSE;
TOKEN;
GOTO QQSINGLE;
END
CONTROL FI;
PROCESSNDX=-1; # DEFAULT IS BAD CMD #
IF NOT SYNTAXCHAR[TOKENCHAR] THEN
BEGIN
IF TOKENCHAR EQ CSEMCOLON
AND NOT SCREENMODE THEN TTLIN(" $");
GOTO PREND2;
END
IF TOKENCHAR EQ CSLASH THEN GOTO QQNOS;
ELSE IF TOKENCHAR EQ CPERIOD THEN GOTO QQWORD;
ELSE IF TOKENCHAR EQ CMINUS THEN GOTO QQXECUTE;
ELSE IF TOKENTYPE EQ TYPST"LETTER" THEN PROCESSNDX=KEYWDNDX;
IF PROCESSNDX EQ -1 THEN ERRJUMP("UNKNOWN DIRECTIVE$");
TOKEN;
GOTO PROCESSSW[PROCESSNDX];
PREND: # RESUME HERE AFTER COMMAND #
PAGELAST=FALSE;
PREND1: # RESUME HERE AFTER VIEW COMMAND #
OLDLINPTR=CURRENT;
OLDCURSOR=NEWCURSOR;
CURCURSOR=NEWCURSOR;
XCURSOR=NEWCURSOR-XSHIFT[CURSPLIT];
YCURSOR=-1;
PREND2: # RESUME HERE FOR NULL CMD LINE, PROC CALL #
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT AND PROCACTIVE AND ERRSTRING NQ " $" THEN
BEGIN # IF BATCH PROCEDURE ERRSTRING #
TTSTR(" $");
TTLIN(ERRSTRING);
ERRSTRING = " $";
END
CONTROL FI;
IF KILLMARKS THEN
BEGIN
KILLMARKS=FALSE;
PAINTMARKS(3);
NUMMARKS=0;
END
NOPOP; # COMMAND DID POS #
IF SAMEBACK THEN DECRBACK;
IF ESCAPE THEN GOTO PRNEXT;
IF NOT FOUND THEN GOTO PRCLEAR;
KEYWDTYPE=1;
TOKEN;
IF TOKENTYPE EQ TYPST"EOL" THEN GOTO PRCLEAR;
GOTO PRMORE;
PRERROR: # RESUME HERE AFTER ERROR #
CONTROL IFEQ MULTI,1;
RSTKPTR=RSTKSAVE; # SINCE ERROR COULD BE NESTED #
CONTROL FI;
CONTROL IFEQ SINGLE,1;
IF PROCACTIVE THEN CLEARPROC;
CONTROL FI;
POP; # RESTORES CURRENT #
IF SAMEBACK THEN DECRBACK;
CONTROL IFEQ SINGLE,1;
IF NOT INTERACT THEN
BEGIN
TTSTR(" $");
TTLIN(ERRSTRING);
MORTAL(" BATCH JOBS MUST BE ERROR FREE.$");
END
CONTROL FI;
GOTO PRCLEAR;
PAGE # PROCESS COMMAND HANDLERS #
PPALTER:
TTYLINE[0]=NULLIN;
WHICHSTR=1;
EXECNDX=EXECST"MODIFY";
SCANNER;
VFYLOCK;
IF EXECNDX EQ EXECST"APPEND" THEN GOTO QQAPPEND;
IF NOT TXTINCMD THEN
BEGIN
IF SCREENMODE THEN ASKUSER("ALTER WHAT ?$",CKWRD);
ELSE GETMOD;
END
CONTROL IFEQ MULTI,1;
IF SCREENMODE THEN
BEGIN # IF SCREEN MODE #
CONTROL FI;
CONTROL IFEQ SINGLE,1;
IF SCREENMODE OR NOT INTERACT THEN
BEGIN # IF SCREEN OR BATCH MODE #
CONTROL FI;
DOTAB(0,XSHIFT[CURSPLIT],0);
END
ELSE
BEGIN # INTERACTIVE LINE MODE #
DOTAB(0,0,0);
END
CHECKGLOBAL;
DORANGE;
LASTGLOBAL;
GOTO PREND;
PPBACK:
SCNEOC;
IF DATAKEYPRS[0] THEN
BEGIN
SCNEOC;
EXCHSAVPOS; # EXCHANGE WITH STORED SCREEN #
SETUPSCREEN(1,LINPTR1,LINPTR2);
END
ELSE
BEGIN
ERRSTRING = "NO FILE DATA STORED WITH 'DATA'$";
END
GOTO PREND;
PPCOPY:
FILCMDNDX=FILCMDST"COPY";
EXECNDX=EXECST"COPY";
PPCOPY2:
NEWCURSOR=0;
CONTROL IFEQ SINGLE,1;
SNGLMOV;
CONTROL FI;
CONTROL IFEQ MULTI,1;
MULTMOV;
CONTROL FI;
GOTO PREND;
PPDELETE:
CMDWASDLTE[0] = TRUE;
SCANNER;
VFYLOCK;
IF SCANBLOCK THEN GOTO QQCLOSE;
IF SCANWORD THEN GOTO QQSQUEEZE;
IF NOT (SCREENMODE OR DONTPRINT) THEN
BEGIN
EXECNDX=EXECST"TYPE";
DORANGE;
IF NOT FOUND THEN GOTO PREND;
LINPTR1=REGLINE[RNGTOPREG]+1;
LINPTR2=REGLINE[RNGBOTREG]-1;
END
EXECNDX=EXECST"DELETE";
DORANGE;
IF CHARRANGE THEN
BEGIN
SPLICE;
NEWCURSOR=CHRPTR3;
END
IF CURRENT LQ TOPF(CURFILE) THEN FWDZ; # IF FIRST LINE DELETED #
GOTO PREND;
PPDATA:
SCNEOC; # SCAN TO END OF COMMAND #
STORCURPOS; # STORE CURRENT POSITION #
DATAKEYPRS[0] = TRUE; # SET FLAG REFERENCE BY BACK #
ERRSTRING = "FILE DATA STORED FOR USE WITH 'BACK'$";
GOTO PREND;
PPEDIT:
SCNEOC; # SCAN TO END OF COMMAND #
IF SPLITFILE[2] NQ 0 THEN
BEGIN # IF IN SPLIT SCREEN MODE #
SETUPSCREEN(1,0,0); # EDIT THE TOP SPLIT ONLY #
CURFILE = 1;
POSZ(CURF(1));
END
ELSE
BEGIN # NOT IN SPLIT SCREEN MODE #
IF INITFILE[1] EQ 0 THEN
BEGIN # IF CURRENT FILE NOT FIRST #
PUSH;
POSZ(TOPC(FILECTL)+1);
SCNFDINIT = 0;
WHYLE SCNFDINIT EQ 0 AND CURRENT NQ BOTC(FILECTL) DO
BEGIN
SCANFDL(LINPTR1);
FWDZ;
END
POP;
FILNUM = 1;
CLOSEFILE; # CLOSE CURRENT FILE #
READNAM = C<0,7>LINPTR1; # OPEN INITIAL FILE #
CHARPARM = 0;
GETPARM = 0;
FILNUM = 1;
OPENFILE;
ERRSTRING = "EDITING INITIAL FILE$";
END
ELSE # CURRENT FILE IS INITIAL #
BEGIN
ERRSTRING = "CURRENT FILE IS INITIAL FILE$";
END
END
GOTO PREND;
PPFSE:
SCNFILOPT;
SCNEOC;
OPENFILE;
IF FILNUM EQ 2 THEN SETUPSCREEN(1,2,USRSPLTSZ);
ELSE SETUPSCREEN(1,0,0);
NEWCURSOR=0;
GOTO PREND;
PPGET:
SCNEQNAM(READNAM);
SCNEOC;
IF C<0,1>READNAM EQ "S" THEN GOTO QQSTATUS; # "GET STATUS" #
IF C<0,1>READNAM EQ "A" THEN GOTO QQPSCALE; # "GET ALIGN" #
CONTROL IFEQ MULTI,1;
CONTROL IFEQ METERING,1;
IF C<0,1>READNAM EQ "D" THEN # "GET DATA" #
BEGIN
FOR LINPTR1=LOC(BGNSTATS) STEP 1 UNTIL LOC(ENDSTATS) DO
BEGIN
FOR LINPTR2=0 STEP 1 UNTIL 19 DO
BEGIN
SETCHAR(LINE,LINPTR2,CDIGIT0+B<LINPTR2*3,3>MEM[LINPTR1]);
END
SETCHAR(LINE,20,CENDLINE);
INSX;
END
END
CONTROL FI;
CONTROL FI;
GOTO PREND;
PPHELP:
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
HELPCMD;
NEWCURSOR=0;
GOTO PREND;
CONTROL FI;
PPINSERT:
TTYLINE[0]=NULLIN;
LIMIT=-2;
WHICHSTR=1;
WHICHLIN=4;
SCANNER;
VFYLOCK;
IF FORWARD THEN LINPTR3=LINPTR3+1;
ELSE IF BACKWARD THEN LINPTR3=LINPTR3-1;
WINDOPOS(LINPTR3,FILPTR3);
IF NOT FOUND THEN
BEGIN
HALT("OUT OF BOUNDS$");
GOTO PREND;
END
IF SCANBLOCK THEN GOTO QQOPEN;
IF SCANWORD THEN GOTO QQSTRETCH;
IF NOT TXTINCMD AND SCREENMODE THEN
BEGIN
ASKUSER("INSERT WHAT ?$",CKWRD);
IF NOT FOUND THEN GOTO PREND;
TXTINCMD=TRUE;
END
POSZ(LINPTR3); # TARGET FOR INSERTION #
CURFILE=FILPTR3;
LIMIT=1; # INDICATE ONE LINE MUST FIT #
FITNUM;
LINCTR=0;
WHYLE NOT ESCAPE DO
BEGIN
IF NUMBERED[CURFILE] NQ 0 THEN
BEGIN
LINENO=LINENO+INCR;
IF LINENO GQ LINNUM2 OR LINENO GR NINES THEN
BEGIN
ESCAPE=TRUE;
TEST; # THIS KILLS LOOP #
END
END
EXECINS; # PROCESSES ESCAPE, READS TTY #
IF ESCAPE THEN TEST; # AND KILL LOOP #
INSX; # FINALLY GOT A LINE #
LINCTR=LINCTR+1;
END # OF EVERYTHING LOOP #
NEWCURSOR=0;
ESCAPE=FALSE;
GOTO PREND;
PPLOCATE:
EXECNDX=EXECST"LOCATE";
WHICHSTR=2;
PPLOCATE2:
SCANNER;
IF EXECNDX EQ EXECST"REPLACE" THEN VFYLOCK;
IF SCANWORD THEN WORDSEARCH=TRUE;
IF SCANUPPER THEN UPPERSEARCH=TRUE;
IF LIMIT EQ 1 THEN SUBSTONCE=TRUE;
ELSE SUBSTONCE=FALSE;
IF LOCSTRLEN1 EQ 0 THEN # NEED STRING #
BEGIN
ASKUSER("LOCATE WHAT?$",CKWRD);
IF LENGTH(TTYLIN) GR 0 THEN MOVEWD(STRWID,TTYLIN,LOCSTRING1);
SETCHAR(LOCSTR1,80,CENDLINE); # ASSURE TERMINATED #
LOCSTRLEN1=LENGTH(LOCSTRING1);
ELLIPSIS=FALSE;
END
CHECKGLOBAL;
PUSH; # REMEMBER WHERE WE ARE #
FOUNDOTHER=FOUND; # REMEMBER WHETHER IN BOUNDS #
DORANGE;
FOUND=FOUNDOTHER;
IF FOUND AND (LINCTR EQ 0 OR (LINCTR LS LIMIT AND LIMIT LS LARGENUM))
THEN
BEGIN # IF IN BOUNDS BUT TOO FEW HITS #
IF SCHSTRSPEC AND SCREENMODE AND NOT PROCACTIVE THEN
BEGIN # IF NEED TO PRESERVE COMMAND LINE #
POP;
ERRJUMP("NOT FOUND$");
END
HALT("NOT FOUND$");
END
IF EXECNDX EQ EXECST"REPLACE" THEN LASTGLOBAL;
IF PROMPTING AND EXECNDX EQ EXECST"LOCATE" THEN
BEGIN
LINCTR=LARGENUM; # FOR FINAL PROMPT #
IF ROWSUSED NQ 0 THEN # FORCE FINAL PROMPT #
BEGIN
POP; # GET TO LAST FOUND LINE #
PUSH; # SAME STACK DEPTH #
GLOBALLOCATE;
NOPOP; # HOLD THIS POSITION #
PUSH; # GET THIS LINE ONTO STACK #
END
END
POP; # GO TO LAST LINE FOUND, OR OLD CURRENT IF NONE FOUND #
IF PROMPTING THEN NEWCURSOR=0;
GOTO PREND;
PPMOVE:
FILCMDNDX=FILCMDST"MOVE";
EXECNDX=EXECST"MOVE";
GOTO PPCOPY2;
PPPRINT:
EXECNDX=EXECST"TYPE";
SCANNER;
LASTPROCESS=PROCESSNDX;
IF SCREENMODE AND LIMIT EQ 1 THEN POSZ(LINPTR1);
ELSE DORANGE;
NEWCURSOR=CHRPTR1;
GOTO PREND;
PPQUIT:
GOTO QQEXIT;
PPREPLACE:
EXECNDX=EXECST"REPLACE";
WHICHSTR=3;
GOTO PPLOCATE2;
PPSET:
SCANSET;
GOTO PREND;
PPTEACH:
GOTO PPHELP;
PPUNDO:
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
UNDOCMD;
GOTO PREND;
CONTROL FI;
PPVIEW:
WHICHLIN=3;
SCANNER;
LINCTR=LINPTR3; # SELECT CENTER LINE #
IF SCREENMODE THEN
BEGIN
IF SCANHOME THEN # SPECIAL - ONLY MOVE CURSOR #
BEGIN
FORCEDHOME=TRUE; # PUT CURSOR AT HOME POSITION #
GOTO PREND2;
END
IF FORWARD THEN
BEGIN
TOPS(CURSPLIT)=LINCTR-1;
END
ELSE IF BACKWARD THEN
BEGIN
TOPS(CURSPLIT)=LINCTR-NUMROWS[CURSPLIT];
END
ELSE
BEGIN
TOPS(CURSPLIT)=LINCTR-(NUMROWS[CURSPLIT]/2)-1;
END
SETTOPS(CURSPLIT);
SETBOTS(CURSPLIT);
IF FORWARD OR BACKWARD THEN
BEGIN
LINCTR=TOPS(CURSPLIT)+(NUMROWS[CURSPLIT]/2+1);
END
LINCTR=MAX(LINCTR,TOPF(CURFILE)+1);
LINCTR=MIN(LINCTR,BOTF(CURFILE)-1);
POSZ(LINCTR);
END
ELSE
BEGIN
MAKEPAGE(GROUPSIZ,CURFILE);
BACKWARD=FALSE;
LIMIT=LARGENUM;
EXECNDX=EXECST"TYPE";
DORANGE;
END
PAGELAST=TRUE;
GOTO PREND1;
PAGE # ADDITIONAL PROCESSORS #
QQABORT:
TOKEN;
SCNEOC;
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
IF SCREENMODE THEN CLEARSCREEN;
EVICT(FET,1); # ASSURE NO RESUMED EDIT #
ABORT;
CONTROL FI;
QQAPPEND:
IF NOT TXTINCMD THEN ASKUSER("APPEND WHAT?$",CKWRD);
DORANGE;
GOTO PREND;
QQCLOSE:
POSZ(LINPTR1);
IF LINPTR1 LQ TOPF(CURFILE) THEN FWDZ;
WHYLE CURRENT LS BOTF(CURFILE) AND NOTEXT DO
BEGIN
DELETCTL=1;
DELX;
POSZ(CURRENT);
END
NEWCURSOR=0;
GOTO PREND;
QQEXIT:
EXITFLAGS=0;
WHYLE TOKENTYPE EQ TYPST"LETTER" DO
BEGIN
KEYWDNDX=-1;
KEYWDTYPE=9;
SCANPOS=TOKENPOS;
TOKEN;
IF TOKENSYM EQ "UNDO" THEN GOTO QQABORT;
ELSE IF KEYWDNDX EQ KEYST"QPRO" THEN GOTO QQQUITPROC;
ELSE IF KEYWDNDX EQ KEYST"QREP" THEN EXITSAVE=TRUE;
ELSE IF KEYWDNDX EQ KEYST"QQUI" THEN DONTPRINT=TRUE;
ELSE ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
TOKEN;
END
IF TOKENTYPE NQ TYPST"DELIMIT" THEN SCNEOC;
QQNOS:
TOKEN;
KEYWDTYPE=0;
SCANPOS=TOKENPOS;
TOKEN;
EXITCMD=TRUE;
CONTROL IFEQ SINGLE,1;
IF SCREENMODE THEN
BEGIN
CLEARSCREEN;
END
IF TOKENTYPE NQ TYPST"EOL" THEN # USER WANTS EXCST #
BEGIN
TTYLINE[0]=NULLIN; # COPY CONTROL STATEMENT #
LINPTR2=0;
LINNUM1=0;
FOR LINPTR1=TOKENPOS STEP 1 UNTIL LENGTH(CMDLIN) DO
BEGIN
GETCHAR(CMDLINE,LINPTR1,LINCTR);
SETCHAR(TTYLINE,LINPTR2,LINCTR);
LINPTR2=LINPTR2+1;
IF LINCTR EQ CPERIOD OR LINCTR EQ CRPAREN THEN LINNUM1=1;
IF LINCTR NQ CBLANK AND LINCTR NQ CENDLINE THEN EXITEXCST=TRUE;
END
IF LINNUM1 EQ 0 THEN # NEEDS PUNCTUATION HELP #
BEGIN
SETCHAR(TTYLINE,LINPTR2-1,CPERIOD);
SETCHAR(TTYLINE,LINPTR2,CENDLINE);
END
END
PROCACTIVE=FALSE;
CONTROL FI;
CONTROL IFEQ MULTI,1;
IF TOKENTYPE NQ TYPST"EOL" THEN EXITCMD=FALSE;
QQSINGLE:
IF CURFILE NQ OLDCURFIL OR FDLF(1) NQ OLDFDLF1
OR FDLF(2) NQ OLDFDLF2 THEN
BEGIN
# RESTORE FILE SELECTION IN EFFECT AT START OF COMMAND #
# SINCE COMMAND WILL BE RESTARTED IN SINGLE. #
PUSH;
POSZ(OLDFDLF1);
SCANFDL(READNAM);
FILNUM=1;
GETPARM=0;
CHARPARM=0;
OPENFILE;
IF OLDFDLF2 NQ 0 THEN
BEGIN
POSZ(OLDFDLF2);
SCANFDL(READNAM);
FILNUM=2;
GETPARM=0;
CHARPARM=0;
OPENFILE;
END
POP;
CURFILE=OLDCURFIL;
END
CONTROL FI;
STACKPTR=ORIGSTKPTR; # UNDOES PUSH IN PROCESS MAIN LOOP #
IORET # THIS IS ONLY RETURN FROM PROCESS #
QQOPEN:
POSZ(LINPTR3);
IF LIMIT NQ -2 THEN LINCTR=MIN(100,LIMIT);
ELSE
BEGIN
LINCTR=GROUPSIZ;
IF SCREENMODE THEN
BEGIN
LINCTR=NUMROWS[CURSPLIT]-4;
LINPTR1=CURRENT-2;
IF NUMROWS[CURSPLIT] LQ 8 THEN
BEGIN
LINCTR=LINCTR+2;
LINPTR1=CURRENT-1;
END
IF NUMROWS[CURSPLIT] LQ 2 THEN
BEGIN
LINCTR=1;
LINPTR1=CURRENT;
END
TOPS(CURSPLIT)=LINPTR1;
SETTOPS(CURSPLIT);
SETBOTS(CURSPLIT);
END
END
FOR LINPTR2=1 STEP 1 UNTIL LINCTR DO
BEGIN
LINE[0]=NULLIN;
INSX;
END;
POSZ(CURRENT-LINCTR+1);
NEWCURSOR=0;
GOTO PREND;
QQPSCALE:
SCNEOC;
IF SCREENMODE THEN
BEGIN
ROWCOLUM[LTOY(CURRENT,CURSPLIT)]=TRUE;
ROWPAINT[LTOY(CURRENT,CURSPLIT)]=TRUE;
GOTO PREND;
END
IF NUMBERED[CURFILE] NQ 0 THEN LINPTR1=NUMWIDBLK;
ELSE IF FLOAT THEN LINPTR1=5;
ELSE LINPTR1=0;
TTST(" ",LINPTR1);
FOR LINCTR=1 STEP 1 UNTIL WIDTH DO
BEGIN
LINNUM2=MOD(LINCTR,10);
TTDEC(LINNUM2);
END
TTBRK;
GOTO PREND;
QQQUITPROC:
CONTROL IFEQ SINGLE,1;
TOKEN;
IF NOT SYNTAXCHAR[TOKENCHAR] THEN CLEARPROC;
SCANNER;
SCNEOC;
IF BACKWARD OR NOT FOUND THEN CLEARPROC;
CONTROL FI;
GOTO PREND;
QQSQUEEZE:
POSZ(LINPTR1);
SQUEEZE;
REPX;
GOTO PREND;
QQSTATUS:
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
GETSTATUS;
GOTO PREND;
CONTROL FI;
QQSTRETCH:
POSZ(LINPTR3);
STRETCH;
REPX;
GOTO PREND;
QQWORD:
TOKEN;
SCANPOS=TOKENPOS; # RESTART SCAN ON SUBCOMMAND #
KEYWDTYPE=6;
TOKEN;
KEYWDTYPE=0;
IF KEYWDNDX LS 0 THEN
BEGIN
ERRJUMP("PARAMETER NOT VALID FOR THIS DIRECTIVE$");
END
IF KEYWDNDX EQ KEYST"WINC" THEN
BEGIN
VFYLOCK;
TOKEN;
SETCHAR(TTYLINE,0,CBLANK);
SETCHAR(TTYLINE,1,CENDLINE);
IF TOKENTYPE EQ TYPST"DELIMIT" THEN
BEGIN
WHICHSTR=1;
SCANSTR;
END
SCNEOC;
SAVEPROT;
RSHIFT(LIN,CURCURSOR,LENGTH(TTYLIN)); # MAKE ROOM #
FOR LINPTR1=0 STEP 1 UNTIL LENGTH(TTYLIN)-1 DO
BEGIN # INSERT STRING #
GETCHAR(TTYLINE,LINPTR1,LINPTR2);
SETCHAR(LINE,CURCURSOR+LINPTR1,LINPTR2);
END
MERGEPROT;
REPX;
GOTO PREND;
END
ELSE IF KEYWDNDX EQ KEYST"WDLC" THEN
BEGIN
VFYLOCK;
TOKEN;
SCNEOC;
SAVEPROT;
LSHIFT(LIN,CURCURSOR+1,1);
MERGEPROT;
REPX;
GOTO PREND;
END
ELSE IF KEYWDNDX EQ KEYST"WEND" THEN
BEGIN
TOKEN;
SCNEOC;
NEWCURSOR=LENGTH(LIN);
IF NEWCURSOR GR USRNUMCOL+XSHIFT[CURSPLIT]
THEN ERRSTRING="END OF LINE BEYOND EDGE OF SCREEN$";
GOTO PREND;
END
ELSE IF KEYWDNDX EQ KEYST"WPOS" THEN
BEGIN
KEYWDTYPE=2;
TOKEN;
LINPTR1=CURCURSOR;
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN
SCNEQVAL;
LINPTR1=LINPTR1-1;
END
IF KEYWDNDX EQ KEYST"XPRM" OR KEYWDNDX EQ KEYST"YPRM"
OR KEYWDNDX EQ KEYST"ZPRM" THEN
BEGIN
# NOTE - CODE ASSUMES X, Y, Z ARE CONSECUTIVE IN TABLES #
LINPTR1=XYZCHAR[KEYWDNDX-KEYST"XPRM"];
TOKEN;
END
LINPTR2=0;
IF TOKENTYPE EQ TYPST"PLUS" THEN LINPTR2=1;
ELSE IF TOKENTYPE EQ TYPST"MINUS" THEN LINPTR2=-1;
LINPTR3=1;
IF LINPTR2 NQ 0 THEN
BEGIN
TOKEN;
IF TOKENTYPE EQ TYPST"DIGIT" THEN
BEGIN
LINPTR3=TOKENVAL;
TOKEN;
END
LINPTR1=LINPTR1+LINPTR2*LINPTR3;
END
NEWCURSOR=MAX(LINPTR1,0);
IF NEWCURSOR GR BUFCM1 THEN
BEGIN # IF BEYOND MAXIMUM LINE LENGTH #
NEWCURSOR = BUFCM1;
ERRSTRING = "POSITION REQUESTED EXCEEDS MAXIMUM LINE LENGTH$";
END
SCNEOC;
GOTO PREND;
END
ELSE IF KEYWDNDX EQ KEYST"WJOI" THEN
BEGIN
TOKEN; # ADVANCE TO NEXT SYNTAX #
WHICHLIN=3;
CHARRANGE=TRUE;
SCANNER;
VFYLOCK;
IF NOT FOUND THEN GOTO PREND; # OUT OF BOUNDS #
POSZ(LINPTR3);
CURFILE=FILPTR3;
DOJOIN(1);
GOTO PREND;
END
ELSE IF KEYWDNDX EQ KEYST"WSPL" THEN
BEGIN
TOKEN; # ADVANCE TO NEXT SYNTAX #
WHICHLIN=3;
CHARRANGE=TRUE;
SCANNER;
VFYLOCK;
IF NOT FOUND THEN GOTO PREND; # OUT OF BOUNDS #
POSZ(LINPTR3);
CURFILE=FILPTR3;
DOSPLIT(2);
IF SCREENMODE AND CURRENT EQ BOTS(CURSPLIT) THEN
FORCEAUTOP[0] = TRUE;
NEWCURSOR=0;
GOTO PREND;
END
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
WORDCMD;
GOTO PREND;
CONTROL FI;
QQXECUTE:
TOKEN;
CONTROL IFEQ MULTI,1;
GOTO QQSINGLE;
CONTROL FI;
CONTROL IFEQ SINGLE,1;
SCNEQNAM(PROCREC); # RECORD NAME #
PARMPTR=SCNNAMPTR; # REMEMBER WHERE PARMS START #
READNAM=PROCNAM; # DEFAULT PROC FILE #
IF TOKENCHAR EQ CLPAREN THEN # USER HAS FILE NAME #
BEGIN
SCNFILE(READNAM);
PARMPTR=SCNNAMPTR;
END
CURPROCNAM=READNAM;
IF NOT PROCACTIVE THEN
BEGIN
EXPANDAT=PARMPTR;
EXPANDCMDS; # EXPAND PARAMETER REFERENCES #
END
COPYLIN(CMDLIN,PARMLIN); # SAVE FOR PARAMETER REFERENCES #
IF READNAM EQ "0" THEN GOTO PREND; # IF NO FILE #
IF PROCACTIVE THEN # DETERMINE IF LOOPING #
BEGIN
IF PROCREC EQ OLDPROCREC AND READNAM EQ OLDPROCFIL THEN
BEGIN # LOOPING ON SAME PROC #
CURP(PROCCTL)=TOPP(PROCCTL);
GOTO QQXECUTE2; # CAN BYPASS FILE SEARCH #
END
END
OLDPROCREC=PROCREC; # SAVE FOR POSSIBLE LOOP #
OLDPROCFIL=READNAM;
PUSH; # SAVE FILE/LINE WHILE OPENING..#
CURFILE=2; # ..PROCEDURE FILE, .. #
POSZ(CURF(2)); # FOR CURRENT FILE AND FILE 2 #
PUSH;
PUSHBACK; # SAVE FILE CHOICES ALSO #
FILNUM=2; # ACCESS THE FILE #
CHARPARM=0;
GETPARM=1;
OPENFILE;
LINENO=1; # 1=NEED RECORDNAME, 2=NEED EOR, 0=FOUND #
POSZ(TOPF(2)+1);
WHYLE CURRENT LS BOTF(2) AND LINENO NQ 0 AND USRBRK EQ 0 DO
BEGIN
TRIMPAD;
IF LINENO EQ 1 THEN
BEGIN
IF COMPARLIN(LIN,PROCREC,FALSE) THEN LINENO=0;
ELSE IF COMPARLIN(LIN," ",FALSE) THEN LINENO=1;
ELSE LINENO=2;
END
IF LINENO EQ 2 THEN
BEGIN
IF COMPARLIN(LIN,"QUIT PROC",TRUE) THEN LINENO=1;
ELSE IF COMPARLIN(LIN,EORCON,FALSE) THEN LINENO=1;
ELSE IF COMPARLIN(LIN,EOFCON,FALSE) THEN LINENO=1;
END
IF LINENO NQ 0 THEN FWDZ;
END
IF LINENO NQ 0 AND PROCREC NQ "STARTUP" AND NOT PROCACTIVE THEN
BEGIN # IF ERROR DISPLAY NEEDED #
IF SCREENMODE THEN
BEGIN # IF NEED TO PRESERVE COMMAND #
DOBACK;
POP;
CURF(CURFILE)=CURRENT;
POP;
ERRJUMP("PROCEDURE NOT FOUND$");
END
HALT("PROCEDURE NOT FOUND$");
END
TOPP(PROCCTL)=CURRENT;
CURP(PROCCTL)=CURRENT;
BOTP(PROCCTL)=BOTF(2);
PROCACTIVE=TRUE;
DOBACK;
POP; # RESTORE CURRENT FILE/LINE #
CURF(CURFILE)=CURRENT;
POP;
QQXECUTE2:
CMDLINE[0]=NULLIN;
STARTCMD;
GOTO PREND2;
CONTROL FI;
IOEND # OF PROCESS, FINALLY #
PAGE # EDTINIT, EDTTERM - MAIN PGM #
PROC EDTINIT;
IOBEGIN(EDTINIT)
CONTROL IFEQ MULTI,1;
RESUMIO; # GETS DATA SEGMENT, CHECKS FILE #
IF NOT IORESUMED THEN
BEGIN
FATAL(" PREVIOUS VERSION OF WORKFILE.$");
END
POSZ(SAVECURL);
CONTROL IFEQ METERING,1;
BGNMETER;
CONTROL FI;
CONTROL FI;
IOEND # OF EDTINIT #
PROC EDTTERM;
IOBEGIN(EDTTERM)
CONTROL IFEQ MULTI,1;
SMFINCTL=FALSE; # SHOW NORMAL NOT RCVRY #
USRBRK=0;
CHECKIO; # CHECKPOINTS EDIT #
# NOTE WE ROLLIN SINGLE-USER JOB TO DO FILREBUILD #
CONTROL FI;
CONTROL IFEQ SINGLE,1;
PAUSEIO; # FOR OTHER OVL'S BUFFERS #
CONTROL FI;
IOEND # OF EDTTERM #
END TERM