perm filename COMMD.MAX[PUB,TES] blob
sn#146873 filedate 1975-02-19 generic text, type T, neo UTF8
00100 BEGOF("COMMD")
00200 COMMENT
00300
00400 A command name may be one or two words., if two words, they are
00500 concatenated together to form the full name. Thus, NO FILL = NOFILL
00600 and TURN ON = TURNON. The COMMAND processor simply dispatches on the
00700 command number associated with each name to a procedure to execute
00800 the command. Note that COMMAND does not PASS over the command name,
00900 so the called routine must do that (once, even for a two-word name).
01000
01100 The PARAMS routine is a general parser for command parameters like
01200 LINES 4 TO 52 and PRINTING "!-1". The parameters may appear in any
01300 order, and the cue words may even be omitted if the standard order is
01400 used (this is not mentioned in the manual, but users have been
01500 observed to permute the parameters and to spell two word command
01600 names as one word., in these things at least, PUB is forgiving).
01700
01800 ;
01900
02000 PRELOAD!WITH
02100 "ADJUST",
02200 "AFTER",
02300 "APART",
02400 "AREA",
02500 "AT",
02600 "BEFORE",
02700 "BEGIN",
02800 "BLANKPAGE",
02900 "BREAK",
03000 "BURP",
03100 "CENTER",
03200 "CLOSE",
03300 "COMMANDCHARACTER",
03400 "COMMENT",
03500 "COMPACT",
03600 "CONTINUE",
03700 "COUNT",
03800 "CRBREAK",
03900 "CRSPACE",
04000 "DDT",
04100 "DEVICE",
04200 "DONE",
04300 "END",
04400 "FILL",
04500 "FLUSHLEFT",
04600 "FLUSHRIGHT",
04700 "FONT",
04800 "GROUP",
04900 "GROUPSKIP",
05000 "IF",
05100 "INDENT",
05200 "INSERT",
05300 "JUSTJUST",
05400 "MACRO",
05500 "NARROW",
05600 "NEXT",
05700 "NOFILL",
05800 "NOJUST",
05900 "ONCE",
06000 "PAGEFRAME",
06100 "PICHAR",
06200 "PLACE",
06300 "PORTION",
06400 "PREFACE",
06500 "PROCEDURE",
06600 "PUB!DEBUG",
06700 "RECEIVE",
06800 "RECURSIVEMACRO",
06900 "REPEAT",
07000 "REQUIRE",
07100 "RETAIN",
07200 "RETURN",
07300 "SELECT",
07400 "SEND",
07500 "SKIP",
07600 "SNEAK",
07700 "SPACING",
07800 "START",
07900 "SUPERIMPOSE",
08000 "TABS",
08100 "TEXTAREA",
08200 "TITLEAREA",
08300 "TURNOFF",
08400 "TURNON",
08500 "USERERR",
08600 "VARIABLE",
08700 "VERBATIM",
08800 "WIDEN",
08900 NULL ;
09000 OWN STRING ARRAY CMDNAME[0:68] ;
09100 comment, Only first words of commands are reserved ;
09200
09300 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE COMMD! ;$"#
00200 BEGIN "COMMD!"
00300 DEPTH ← 0 ;
00400 FOR I ← 0 STEP 1 WHILE FULSTR(CMDNAME[I]) DO
00500 BIND(DECLARE(SYMNUM(CMDNAME[I]), CMDTYPE), I) ;
00600 DEPTH ← 2 ;
00700 !COMMAND!CHARACTER! ← "." ;
00800 IXCOMMENT ← LDB(IXN(SYMNUM("COMMENT"))) ;
00900 END "COMMD!" ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE COMMAND ;$"#
00200 BEGIN
00300 DEFINE DB(WHAT) = [BEGIN IF ON THEN WHAT; PASS END],
00400 BDB(WHAT)= [BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END];
00500 IF THATISID AND SYMLOOK(THISWD&THATWD) AND LDB(TYPEN(SYMBOL))=CMDTYPE THEN
00600 BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← CMDTYPE ;
00700 IX ← LDB(IXN(SYMB)) ; RDENTITY ; END
00800 ELSE IF THISTYPE NEQ CMDTYPE THEN RETURN(FALSE) ;
00900 CASE IX OF
01000 BEGIN COMMENT COMMANDS ; comment THISWD is command word.;
01100 COMMENT ADJUST ; BDB(JUSTM←1) ;
01200 COMMENT AFTER ; DRESPONSE(2) ;
01300 COMMENT APART ; BEGIN DAPART ; PASS END ;
01400 COMMENT AREA ; DAREA(FALSE) ;
01500 COMMENT AT ; DRESPONSE(1) ;
01600 COMMENT BEFORE ; DRESPONSE(0) ;
01700 COMMENT BEGIN ; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 AND ON THEN -1 ELSE 1,
01800 IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
01900 COMMENT BLANK PAGE; DBLANKPAGE ;
02000 COMMENT BREAK ; BEGIN DBREAK ; PASS END ;
02100 COMMENT BURP ; DBURP ; TES 8/19/74 BURP OUT STATE INFO ;
02200 COMMENT CENTER ; BDB(BREAKM←4) ;
02300 COMMENT CLOSE ; DCLOSE ;
02400 COMMENT COMMAND CHARACTER ; DCOMMANDCHARACTER ;
02500 COMMENT COMMENT ; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
02600 COMMENT COMPACT ; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
02700 COMMENT CONTINUE; BDB(NOPGPH ← 1) ;
02800 COMMENT COUNT ; DCOUNT ;
02900 COMMENT CRBREAK ; DB(CRBM←1) ;
03000 COMMENT CRSPACE ; DB(CRBM←0) ;
03100 COMMENT DDT ; BEGIN REPORT(0, "DDT", "D") ; PASS END ;
03200 COMMENT DEVICE ; DDEVICE ;
03300 COMMENT DONE ; DDONE(FALSE) ; TES 8/14/74 AND 8/19/74 ;
03400 COMMENT END ; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN ENDSTART; ENDBEGIN; ENDONCE; ENDRESP END ;
03500 COMMENT FILL ; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
03600 COMMENT FLUSH LEFT; BDB(BREAKM←2) ;
03700 COMMENT FLUSH RIGHT; BDB(BREAKM←3) ;
03800 COMMENT FONT ; DFONT(FALSE);
03900 COMMENT GROUP ; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
04000 COMMENT GROUP SKIP; DSKIP(TRUE) ;
04100 COMMENT IF ; DCONDITIONAL ;
04200 COMMENT INDENT ; DINDENT ;
04300 COMMENT INSERT ; DINSERT ;
04400 COMMENT JUSTJUST; BDB(BREAKM←1) ;
04500 COMMENT MACRO ; DMACRO(1) ;
04600 COMMENT NARROW ; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
04700 COMMENT NEXT ; BEGIN PASS ; DNEXT END ;
04800 COMMENT NOFILL ; BDB(BREAKM←7) ;
04900 COMMENT NOJUST ; BDB(JUSTM←0) ;
05000 COMMENT ONCE ; BEGIN IF ON AND ENDCASE NEQ 2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
05100 BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
05200 COMMENT PAGE FRAME; DFRAME(FALSE) ;
05300 COMMENT PICHAR ; DPICHAR ;
05400 COMMENT PLACE ; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
05500 COMMENT PORTION ; DPORTION ;
05600 COMMENT PREFACE ; DPREFACE ; TES 11/2/74 ;
05700 COMMENT PROCEDURE; DMACRO(2) ; TES 8/19/74 ;
05800 COMMENT PUB!DEBUG; DPUB!DEBUG ; TES 8/21/74 ;
05900 COMMENT RECEIVE ; DRECEIVE ;
06000 COMMENT RECURSIVE MACRO ; DMACRO(0) ;
06100 COMMENT REPEAT ; DREPEAT ;
06200 COMMENT REQUIRE ; DREQUIRE ;
06300 COMMENT RETAIN ; DB(SPACEM←0) ;
06400 COMMENT RETURN ; DDONE(TRUE) ; TES 8/19/74 ;
06500 COMMENT SELECT ; DFONT(TRUE) ;
06600 COMMENT SEND ; DSEND ;
06700 COMMENT SKIP ; DSKIP(FALSE) ;
06725 COMMENT SNEAK ; DSNEAK ;
06750 COMMENT SPACING ; DSPACING ; TES 11/2/74 ;
06800 COMMENT START ; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
06900 COMMENT SUPERIMPOSE; DSUPERIMPOSE ;
07000 COMMENT TABS ; DTABS ;
07100 COMMENT TEXT AREA; DAREA(FALSE) ;
07200 COMMENT TITLE AREA; DAREA(TRUE) ;
07300 COMMENT TURN OFF; DTURN(0) ;
07400 COMMENT TURN ON ; DTURN(-1) ;
07500 COMMENT USERERR ; DUSERERR ; RKJ: 1-9-74;
07600 COMMENT VARIABLE; DVARIABLE ;
07700 COMMENT VERBATIM; BDB(BREAKM←6) ;
07800 COMMENT WIDEN ; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
07900 END ; COMMENT COMMANDS ;
08000 IF ITSCH(;) THEN PASS ;
08100 RETURN(TRUE) ;
08200 END ;
00100 PRIVATE SIMPLE PROCEDURE DCOMMANDCHARACTER ;$"#
00200 BEGIN
00300 INTEGER X ;
00400 INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
00500 PASS ; X ← SIMPAR ;
00600 IF LENGTH(X) NEQ 1 THEN WARN("=",<"COMMAND CHARACTER must be a single character, not '"&X&"'">)
00700 ELSE IF ON THEN !COMMAND!CHARACTER! ← X ;
00800 PASS ; PASS ; PASS ;
00900 END "DCOMMANDCHARACTER" ;
00100 PUBLIC RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST) ;$"#
00200 BEGIN comment, Reads arguments for various commands;
00300 INTEGER I, PREWD, SOFAR ; STRING EXPR ;
00400 LABEL RDPAR, SETPAR ;
00500 BOOLEAN GOT ; DEFINE FIND = [FOR I ← 1 THRU MOST DO IF];
00600 SOFAR ← I ← GOT ← 0 ;
00700 WHILE SOFAR<MOST AND THISTYPE NEQ -TERQ AND THISTYPE NEQ CMDTYPE DO
00800 BEGIN "PARAMETER"
00900 IF THISISID THEN
01000 BEGIN "IDENTIFIER"
01100 IF ITS(TO) AND I<MOST AND ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
01200 FIND ITSV(PRE[I]) OR ITSV(PRE[I]&"S") THEN
01300 BEGIN "PRE WORD"
01400 PASS ; IF GOT LAND TWO(I) THEN WARN("=",PRE[I]&" Twice") ;
01500 GO TO RDPAR ;
01600 END "PRE WORD" ;
01700 END "IDENTIFIER" ;
01800 FIND NOT GOT LAND TWO(I) AND NULSTR(PRE[I]) AND (I=1 OR NULSTR(PRE[I-1]) OR GOT LAND TWO((I-1))) THEN GO TO RDPAR ;
01900 DONE ;
02000 RDPAR:
02100 PREWD ← I ;
02200 EXPR ← IF EQU(PRE[I],"IN") AND FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
02300 ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
02400 ELSE E(NULL,IF I=MOST OR FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
02500 IF FULSTR(POST[I]) THEN
02600 IF ITSV(POST[I]) THEN PASS
02700 ELSE BEGIN "GUESSED WRONG"
02800 FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
02900 FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
03000 WARN("=",POST[PREWD] & "Missed.") ;
03100 DONE ;
03200 END "GUESSED WRONG" ;
03300 SETPAR:
03400 IF PRE[I] NEQ PRE[PREWD] THEN WARN("=",<(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.">) ;
03500 IF GOT LAND TWO(I) THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
03600 ELSE SOFAR ← SOFAR + 1 ;
03700 GOT ← GOT LOR TWO(I) ;
03800 PAR[I] ← EXPR ;
03900 IF ITSCH(<,>) THEN PASS ;
04000 END "PARAMETER" ;
04100 END "PARAMS" ;
00100 PUBLIC RECURSIVE STRING PROCEDURE SIMPAR ;$"#
00200 RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
00100 FINISHED
00200
00300 ENDOF("COMMD")