MONDAY, MARCH 22,1976 FM+6D.22H.2M.17S. LISP 1130 - GLS & JONL -
[1] (STATUS XUNAME) AND (STATUS XJNAME) NOW EXIST.
[2] FUNNY FORMAT DEFUN ALLOWS ARBITRARY PROPERTY NAMES
[3] PRIN1 DOES VERTICAL BAR AND LOOKAHEAD CLEVERNESS
[4] BREAK MAY TAKE ONE ARGUMENT, DEFAULTING THE SECOND TO T
[5] VALUE OF $P IS THE $P ATOM (NIL => NONE)
[6] *NOPOINT CONTROLS OUTPUT OF LEADING SUPRA-DECIMAL +
THE FOLLOWING CHANGES APPLY TO NEWIO ONLY:
[A] OPENI, OPENO, OPENA HAVE GONE AWAY
[B] (STATUS FILEMODE) RETURNS NIL IF GIVEN A CLOSED FILE.
[C] CLI-MESSAGE INTERRUPT HANDLER
[D] NEW FUNCTIONS: ALLFILES AND FRIENDS
[E] WHO-LINE STATUS CALLS
[F] (STATUS TTYTYPE <OUTPUT-TTY>) RETURNS TCTYP
[G] EXAMPLES OF KEYBOARD PRE-SCAN FUNCTIONS
----------------------------------------------------------------
[1] (STATUS XUNAME) AND (STATUS XJNAME) WERE ADDED AS AN
AUGMENTATION TO (STATUS UNAME) AND (STATUS JNAME).
[2] THE "FUNCTION NAME" IN A DEFUN FORM MAY BE A 3-LIST;
THE FIRST ELEMENT IS THE NAME, THE SECOND THE "EXPR"
PROPERTY NAME, AND THE THIRD THE "SUBR" PROPERTY NAME.
THAT IS, INSTEAD OF USING THE PROPERTY NAME "EXPR"
(OR "FEXPR"), THE INTERPRETER WILL USE THE PROPERTY NAME
WHICH IS THE SECOND ELEMENT, AND THE COMPILER WILL USE
THAT WHICH IS THE THIRD NAME. THE TYPE OF THE FUNCTION
IS STILL DETERMINED BY THE OPTIONAL FLAG "FEXPR"
AND WHETHER THE LAMBDA VARIABLE LIST IS ATOMIC.
EXAMPLE:
(DEFUN (FOO QEXPR QSUBR) (A B) ...)
IN THE INTERPRETER PUTS A LAMBDA EXPRESSION UNDER
THE "QEXPR" PROPERTY OF "FOO", AND IN THE COMPILER
COMPILES A SUBR OF TWO ARGUMENTS HEADED BY THE
LAP STATEMENT (LAP FOO QSUBR) INSTEAD OF
(LAP FOO SUBR).
[3] MOSTLY FOR AESTHETIC REASONS, PRIN1 IS NOW MORE CLEVER
ABOUT PRINTING ATOMS:
(A) IF PRIN1 THINKS VERTICAL BARS WILL LOOK NICER
THAN SLASHES, IT WILL USE THEM.
(B) IF IT LOOKS LIKE THE NEXT ATOM TO PRINT WILL
NOT FIT ON THE LINE, PRIN1 TRIES TO GET
A TERPRI IN BEFORE THE ATOM, THUS AVOIDING
SPLITTING AN ATOM ACROSS A NEWLINE.
THESE HEURISTICS MAY BECOME EVEN MORE CLEVER IN THE FUTURE.
PRINC DOES NOT USE ANY OF THESE HACKS. FLATSIZE USES
THE FIRST, BUT NOT THE SECOND.
[4] THE FORM (BREAK FOO) IS NOW THE SAME AS (BREAK FOO T).
[5] THE BREAK LOOP NO LONGER LOOKS FOR THE ATOM P.
INSTEAD, IT LOOKS FOR THE ATOM WHICH IS THE VALUE
OF THE ATOM P, WHICH IS INITIALLY SET TO 'P, SO IT
WORKS AS BEFORE BHY DEFAULT. IF P IS NIL, THEN NO
ATOM WILL SERVE THE P FUNCTION.
[6] IF BASE IS GREATER THAN 10., *NOPOINT IF NON-NIL
WILL SUPPRESS THE + WHICH NORMALLY PRECEDES POSITIVE
SUPRA-DECIMAL NUMBERS. FOR BASE = 10., *NOPOINT
STILL SUPPRESSES THE TRAILING DECIMALLL POINT.
THE FOLLOWING CHANGES APPLY TO NEWIO ONLY:
[A] OPENI, OPENO, OPENA HAVE GONE AWAY. USE OPEN
WITH THE "IN", "OUT", OR "APPEND" OPTION IN THE
SECOND ARGUMENT.
[B] (STATUS FILEMODE <FILE>) RETURNS NIL FOR A CLOSED FILE.
FOR OPEN FILES, IT OPERATES AS IT ALWAYS HAS.
FOR A NON-FILE, IT GIVES A WRNG-TYPE-ARG ERROR.
[C] THE ATOM "CLI-MESSAGE" HAS AS ITS VALUE THE USER
INTERRUPT FUNCTION FOR THE CLI DEVICE INTERRUPT.
THE FUNCTION GETS A SINGLE ARGUMENT OF NIL.
IT SHOULD OPEN THE "CLA:" DEVICE IN RESPONSE TO
THE INTERRUPT IN ORDER TOP READ THE MESSAGE.
ONE OF THE OPTIONS IN OPEN'S SECOND ARGUMENT SHOULD
BE "CLA" (AS OPPOSED TO "DSK" OR "TTY"); THIS CAUSES
OPEN TO READ THE FIRST TWO WORDS OF THE FILE AND USE
THEM AS THE FILE NAMES FOR THE TRUENAME FUNCTION. THE
CLA: FILE SHOULD BE OPENED IN BLOCK MODE FOR THIS PURPOSE.
THE DEFAULT CLI-MESSAGE FUNCTION IS NIL, I.E. IGNORE
THE INTERRUPTS.
[D] FOUR NEW FUNCTIONS (AUTOLOADABLE) NOW EXIST FOR LOOKING
AT FILE DIRECTORIES: ALLFILES, DIRECTORY, MAPALLFILES,
AND MAPDIRECTORY.
(ALLFILES X) TAKES A LIST OF NAMELISTS (AND NAMESTRINGS) X AND RETURNS A LIST
OF NAMELISTS IN THE FILE SYSTEM WHICH MATCH ELEMENTS OF X.
THERE IS NO GUARANTEE AS TO THE ORDERING OF THE FILES IN
THE RETURNED LIST. IF A SORTED LIST IS DESIRED, THE SORTCAR
FUNCTION SHOULD BE USED WITH AN APPROPRIATE PREDICATE.
NOTE WELL THAT X IS A *LIST* OF NAMELISTS, AND NOT JUST
A SINGLE NAMELIST; THIS IS AN INCOMPATIBILITY WITH THE ALLFILES
FUNCTION DESCRIBED IN THE MOONUAL.
EXAMPLE: (ALLFILES '(|GLS;ALLFIL| ((DSK TGQ) * SONG) |* BIN|))
RETURNS DESCRIPTORS FOR ALL FILES ON GLS'S DIRECTORY WITH
FIRST NAME "ALLFIL", ALL SONGS ON TGQ, AND ALL DSK FILES IN
ANY DIRECTORY WITH SECOND NAME "BIN".
(DIRECTORY X) IS LIKE (ALLFILES X), BUT INSTEAD OF
NAMELISTS IT RETURNS A LIST OF FILE DESCRIPTORS, WHERE
EACH DESCRIPTOR HAS A NAMELIST IN THE CAR AND A
PROPERTY LIST IN THE CDR. TYPICAL PROPERTIES ARE:
WORDS SIZE OF FILE IN PDP-10 WORDS
CHARACTERS SIZE OF FILE IN ASCII CHARACTERS
BITS SIZE IN BITS (TO BE IMPLEMENTED WHEN ITS SUPPORTS IT)
CREDATE DATE OF CREATION
CRETIME TIME OF CREATION
REFDATE DATE OF MOST RECENT REFERENCE
LINK NAME LINKED TO
PACK PACK NUMBER
UNDUMPED T IF FILE NOT YET BACKED UP ON MAGTAPE
NOREAP T IF NO REAP BIT IS SET
(DIRECTORY X PROPS) IS SIMILAR, BUT INCLUDES ONLY
THE PROPERTIES MENTIONED IN "PROPS" FOR EFFICIENCY.
AS A SPECIAL CASE, OMITTING "LINK" CAUSES LINKS NOT
TO BE INCLUDED AT ALL.
(MAPALLFILES FN X) IS LIKE (MAPC FN (ALLFILES X))
BUT DOESN'T HAVE TO CONS UP THE WHOLE LIST AT ONCE.
(MAPDIRECTORY FN X) AND (MAPDIRECTORY FN X PROPS)
ARE SIMILAR.
MATCHING:
AT PRESENT, THE ONLY MATCHING CAPABILITIES IN ALLFILES
ARE DIRECT NAME EQUALITY AND *, WHICH MATCHES ANYTHING.
* AS A DEVICE NAME IMPLIES DSK.
* AS A DIRECTORY NAME USES ALL DIRECTORIES FOR DSK,
AND THE DEFAULT DIRECTORY FOR ALL OTHER DEVICES.
IN THIS CONTEXT, AI, ML, MC, AND DM ARE *NOT* CONSIDERED
TO BE DSK DEVICES; BUT IN OTHER CONTEXTS THEY ARE.
[E] (SSTATUS WHO1 A B C D) SETS THE .WHO1 USER VARIABLE TO
<.BYTE 8 ? A ? B ? C ? D>
IN MIDAS TERMINOLOGY. A AND C MUST BE FIXNUMS; B AND D
MUST BE FIXNUMS WITH ASCII VALUES, OR CHARACTER OBJECTS.
(SSTATUS WHO2 X) AND (SSTATUS WHO3 X) SET THE .WHO2 AND
.WHO3 USER VARIABLES. X MAY BE A FIXNUM OR A SYMBOL;
IN THE LATTER CASE THE FIRST SIX CHARACTERS ARE USED TO
FORM A SIXBIT WORD.
THE .WHON USER VARIABLES CAUSE INFORMATION TO BE DISPLAYED
IN THE TERMINAL'S WHO-LINE.
THE MEANING OF A, B, C, AND D IS AS FOLLOWS:
VAR BITS MEANING
A 200 IF 1, SUPPRESS ENTIRE WHO-LINE
100 SUPPRESS SPACE BETWEEN HALVES OF .WHO2
70 MODE FOR PRINTING LEFT HALF OF .WHO2
0 DO NOT PRINT
1 DATE IN PACKED FORM:
774000 YEAR MOD 100.
3600 MONTH (1=JANUARY)
174 DAY OF MONTH
2 TIME IN FORTIETHS OF A SECOND,
PRINTED AS HH:MM:SS.T
3 TIME IN HALF-SECONDS,
PRINTED AS HH:MM:SS
4 OCTAL HALFWORD
5 DECIMAL HALFWORD (NO . SUPPLIED)
6 THREE SIXBIT CHARACTERS
7 UNUSED
7 MODE FOR RIGHT HALF OF .WHO2
B 177 IF NON-ZERO, PRINT BETWEEN HALVES OF
.WHO2 AS AN ASCII CHARACTER
200 IF 1, PRINT CHAR TWICE
C 200 IF 1, SUPPRESS SPACE BETWEEN .WHO2
PRINTOUT AND .WHO3 PRINTOUT
OTHERWISE LIKE A, BUT FOR .WHO3.
D LIKE B, BUT FOR .WHO3.
THAT IS, IF THE WHO-LINE IS PRINTED AT ALL, WHAT APPEARS
AT THE END IS THE CHARACTERS:
IIIIXX-JJJJ=KKKKYY+LLLL
WHERE:
IIII IS THE RESULT OF PRINTING THE LEFT HALF
OF .WHO2 AS SPECIFIED BY A'S 70 BITS.
JJJJ RIGHT HALF OF .WHO2, BY A'S 7 BITS.
KKKK LEFT HALF OF .WHO3, BY C'S 70 BITS.
LLLL RIGHT HALF OF .WHO3, BY C'S 7 BITS.
XX ZERO TO TWO CHARACTERS, SPECIFIED BY B.
YY ZERO TO TWO CHARACTERS, SPECIFIED BY D.
- SPACE, UNLESS A'S 100 BIT IS 1.
= SPACE, UNLESS C'S 200 BIT IS 1.
+ SPACE, UNLESS C'S 100 BIT IS 1.
EXAMPLE:
(SSTATUS WHO1 166 0 144 '/!)
(SSTATUS WHO2 'FOOBAR)
(SSTATUS WHO3 (+ (LSH 1234 22) 3456))
CAUSES "FOOBAR 1234!5678" TO APPEAR IN THE WHO-LINE.
THE STATUS FORMS ARE AS FOLLOWS:
(STATUS WHO1) RETURNS A LIST OF FOUR FIXNUMS.
(STATUS WHO2) AND (STATUS WHO3) RETURN FIXNUMS.
[F] (STATUS TTYTYPE <OUTPUT-TTY>) RETURNS THE TCTYP VARIABLE
FOR THE SPECIFIED OUTPUT TTY (IF OMITTED, THIS DEFAULTS
TO T, THE STANDARD OUTPUT TTY). THIS IS THE EXTENSION
IN NEWIO TO OLDIO'S SETTING OF THE VARIABLE "TTY".
FOR COMPATIBILITY, WHEN IT STARTS UP, NEWIO LISP DOES
(SETQ TTY (STATUS TTYTYPE T)).
POSSIBLE VALUES ARE:
0 PRINTING CONSOLE
1 GOOD DATAPOINT
2 "LOSER" DATAPOINT
3 IMLAC
4 TEKTRONIX 4000 SERIES (FORMERLY ARDS)
5 PDP-11 (KNIGHT) TV DISPLAY
6 MEMOREX (FORMERLY HORIZONTAL ARDS)
7 SOFTWARE TTY
10 TERMINET
11 TTY USING ASCII STANDARD DISPLAY SEQUENCES
IN GENERAL, IT IS BETTER NOT TO USE THIS STATUS FUNCTION,
BUT RATHER TO SAY (STATUS FILEMODE <OUTPUT-TTY>) AND
LOOK FOR FLAGS SUCH AS "RUBOUT" AND "CURSORPOS".
[G] EXAMPLES OF KEYBOARD PRE-SCAN FUNCTIONS.
(1) THE KEYBOARD PRE-SCAN FUNCTION IS THE ONE SET BY
(SSTATUS TTYSCAN ...). IT IS THE FUNCTION WHICH HANDLES
RUBOUT AND ^L PROCESSING. AS AN EXAMPLE, THE FUNCTION
GIVEN HERE IS A VERY CLOSE APPROXIMATION TO THE DEFAULT
PROVIDED BY LISP.
------------------------------------------------------------
SAMPLE TTY PRESCAN FUNCTION -- APPROXIMATELY THE ONE IN LISP
------------------------------------------------------------
(DECLARE (MAPEX))
(DEFUN CONSTANT MACRO (X)
(LIST 'DEFUN (CADR X) 'MACRO '(X) (LIST 'QUOTE (CADDR X))))
(DEFUN LOGAND MACRO (X) (CONS 'BOOLE (CONS '1 (CDR X))))
(DEFUN LOGOR MACRO (X) (CONS 'BOOLE (CONS '7 (CDR X))))
(DEFUN LOGCLR MACRO (X) (CONS 'BOOLE (CONS '4 (CDR X))))
(DEFUN PUSH MACRO (X) (LIST 'SETQ (CADDR X) (LIST 'CONS (CADR X) (CADDR X))))
(DEFUN POP MACRO (X)
(LIST 'PROG2 NIL
(LIST 'CAR (CADR X))
(LIST 'SETQ (CADR X) (LIST 'CDR (CADR X)))))
(CONSTANT TOP 4000) ;NAMES OF BITS FOR KNIGHT KEYBOARDS
(CONSTANT SHIFTLOCK 2000)
(CONSTANT SHIFT 1000)
(CONSTANT META 400)
(CONSTANT CTRL 200)
(CONSTANT ASCII-BITS 177)
(CONSTANT ^K 13) ;VARIOUS ASCII CHARACTERS
(CONSTANT ^L 14)
(CONSTANT ^M 15)
(CONSTANT SPACE 40)
(CONSTANT OPEN-PAREN 50)
(CONSTANT VERTICAL-BAR 174)
(CONSTANT PSEUDOSPACE 203) ;A FAKE SPACE (INTERNAL TO LISP)
(CONSTANT SLASH-SYNTAX 2000) ;BITS IN READER SYNTAX TABLE
(CONSTANT ALTERNATE-SYNTAX 40)
(CONSTANT OPEN-SYNTAX 40000)
(CONSTANT CLOSE-SYNTAX 10000)
(CONSTANT RUBOUT-SYNTAX 1000)
(CONSTANT FORCE-FEED 1000) ;WITH ALTERNATE-SYNTAX
(CONSTANT SPACE-SYNTAX 100000)
(CONSTANT SINGLE-SYNTAX 200000)
(CONSTANT MACRO-SYNTAX 4000)
(CONSTANT WORTHY-SYNTAX 277237) ;"WORTHY" CHARACTERS
(CONSTANT SLASH-FLAG 400000)
(CONSTANT STRING-BEGIN-FLAG 200000)
(CONSTANT STRING-END-FLAG 100000)
(DEFUN TYI7 (IFILE)
((LAMBDA (CH)
(COND ((ZEROP (LOGAND (CTRL) CH)) CH)
((= CH (+ (CTRL) 177)) 177)
(T (LOGAND CH 37))))
(LOGCLR (TYI IFILE) (LOGOR (TOP) (SHIFTLOCK) (SHIFT) (META)))))
(DEFUN REPRINT (CHARS COUNT POS OFILE)
(DECLARE (FIXNUM COUNT))
(COND (OFILE
(AND POS (CURSORPOS (CAR POS) (CDR POS) OFILE))
(AND (PLUSP COUNT)
(DO ((I 0 (1+ I)))
((= I COUNT) (TYO (SPACE) OFILE))
(DECLARE (FIXNUM I))
(TYO (OPEN-PAREN) OFILE)))
(MAPCAR '(LAMBDA (CH) (TYO (LOGAND CH (ASCII-BITS)) OFILE)) CHARS))))
(DEFUN TTY-PRESCAN (IFILE FN PARENSCOUNT)
(DECLARE (FIXNUM PARENSCOUNT))
(PROG (USEFUL STARTPOS OFILE STRING-END BUFFER CH SYNTAX LINMODE TTYREAD COUNT)
(DECLARE (FIXNUM STRING-END CH SYNTAX COUNT))
(AND (SETQ OFILE (STATUS TTYCONS IFILE))
(SETQ STARTPOS (CURSORPOS OFILE)))
(SETQ LINMODE (STATUS LINMODE IFILE))
(SETQ TTYREAD (STATUS TTYREAD IFILE))
(SETQ COUNT PARENSCOUNT)
(SETQ STRING-END -1)
LOOP (SETQ SYNTAX (STATUS SYNTAX (SETQ CH (TYI7 IFILE))))
(COND ((= CH (^M))
(COND ((EQ FN 'READLINE) (GO DONE))
(LINMODE
(OR (MINUSP STRING-END) (PUSH (PSEUDOSPACE) BUFFER))
(GO DONE)))))
(COND ((OR (= CH (^K)) (= CH (^L)))
(COND ((NULL OFILE) (GO LOOP))
(T (COND ((AND (= CH (^L)) STARTPOS)
(CURSORPOS 'C OFILE))
(T (TERPRI OFILE)))
(SETQ STARTPOS (CURSORPOS OFILE))
(REPRINT (REVERSE BUFFER) PARENSCOUNT NIL OFILE)
(GO LOOP))))
((AND (NOT (EQ FN 'READLINE))
(PLUSP (LOGAND SYNTAX (SLASH-SYNTAX))))
(PUSH CH BUFFER)
(PUSH (LOGOR (SLASH-FLAG) (TYI7)) BUFFER)
(SETQ USEFUL T)
(GO LOOP))
((AND (PLUSP (LOGAND SYNTAX (RUBOUT-SYNTAX)))
(ZEROP (LOGAND SYNTAX (ALTERNATE-SYNTAX))))
(COND (BUFFER
(AND OFILE
(OR (RUBOUT (LOGCLR (SETQ CH (POP BUFFER))
(LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG)))
OFILE)
(REPRINT (REVERSE BUFFER) PARENSCOUNT STARTPOS OFILE)))
(COND ((PLUSP (LOGAND CH (SLASH-FLAG)))
(AND OFILE
(OR (RUBOUT (POP BUFFER) OFILE)
(REPRINT (REVERSE BUFFER) PARENSCOUNT STARTPOS OFILE))))
((NOT (MINUSP STRING-END))
(AND (PLUSP (LOGAND CH (STRING-BEGIN-FLAG)))
(SETQ STRING-END -1)))
((PLUSP (LOGAND CH (STRING-END-FLAG)))
(SETQ STRING-END (LOGAND CH (ASCII-BITS))))
((PLUSP (LOGAND (SETQ SYNTAX
(STATUS SYNTAX
(LOGCLR CH
(LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG)))))
(OPEN-SYNTAX)))
(SETQ COUNT (- COUNT 1)))
((PLUSP (LOGAND SYNTAX (CLOSE-SYNTAX)))
(SETQ COUNT (+ COUNT 1)))))
(T (AND OFILE (TERPRI OFILE))))
(GO LOOP))
((EQ FN 'READLINE)
(PUSH CH BUFFER)
(GO LOOP))
((NOT (MINUSP STRING-END))
(COND ((= CH STRING-END)
(PUSH (LOGOR CH (STRING-END-FLAG)) BUFFER)
(SETQ STRING-END -1))
(T (PUSH CH BUFFER)))
(GO LOOP))
((AND (PLUSP (LOGAND SYNTAX (FORCE-FEED)))
(PLUSP (LOGAND SYNTAX (ALTERNATE-SYNTAX))))
(GO DONE))
((PLUSP (LOGAND SYNTAX (SPACE-SYNTAX)))
(COND ((OR (PLUSP COUNT) (NOT USEFUL) LINMODE (NOT TTYREAD))
(PUSH CH BUFFER)
(GO LOOP))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (SINGLE-SYNTAX)))
(COND ((OR (PLUSP COUNT) LINMODE (NOT TTYREAD))
(SETQ USEFUL T)
(PUSH CH BUFFER)
(GO LOOP))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (MACRO-SYNTAX)))
((LAMBDA (MAC)
(COND ((EQ MAC '+INTERNAL-/;-MACRO)
(PUSH (LOGOR CH (STRING-BEGIN-FLAG)) BUFFER)
(SETQ STRING-END (^M)))
((EQ MAC '+INTERNAL-/|-MACRO)
(PUSH (LOGOR CH (STRING-BEGIN-FLAG)) BUFFER)
(SETQ STRING-END (VERTICAL-BAR)))
(T (PUSH CH BUFFER))))
(CAR (STATUS MACRO (+ CH 0))))
(SETQ USEFUL T)
(GO LOOP))
((PLUSP (LOGAND SYNTAX (OPEN-SYNTAX)))
(SETQ COUNT (+ COUNT 1))
(SETQ USEFUL T)
(PUSH CH BUFFER)
(GO LOOP))
((PLUSP (LOGAND SYNTAX (CLOSE-SYNTAX)))
(COND ((OR (PLUSP COUNT) (NOT USEFUL) LINMODE (NOT TTYREAD))
(COND ((PLUSP (SETQ COUNT (- COUNT 1)))
(PUSH CH BUFFER)
(GO LOOP))
(T (GO DONE))))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (WORTHY-SYNTAX)))
(PUSH CH BUFFER)
(SETQ USEFUL T)
(GO LOOP))
(T (PUSH CH BUFFER) (GO LOOP)))
DONE (AND OFILE
((LAMBDA (POS)
(LINENUM OFILE (CAR POS))
(CHARPOS OFILE (CDR POS)))
(CURSORPOS OFILE)))
(PUSH CH BUFFER)
(SETQ BUFFER (NREVERSE BUFFER))
(MAP '(LAMBDA (X)
(AND (PLUSP (LOGAND (CAR X) (LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG))))
(RPLACA X (LOGCLR (CAR X) (LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG))))))
BUFFER)
(RETURN BUFFER)))
AS AN EXAMPLE OF HOW YOU MIGHT CHANGE THIS, HERE IS A SLIGHT
MODIFICATION TO GIVE ONE THE "PARENS BALANCE WINDOW" PROPOSED
BY GREENBLATT:
-------------------------------------------------
TTY PRESCAN FUNCTION WITH PARENS BALANCING WINDOW
-------------------------------------------------
(DECLARE (ARGS 'CURSORPOS '(0 . 3))
(SPECIAL IFILE OFILE)
(DEFPROP TTYRE A STATUS)
(DEFPROP TTYSI A STATUS)
(DEFPROP TTYCO A STATUS)
(DEFPROP LINMO A STATUS)) ;FIX NCOMPL BUGS
(DECLARE (MAPEX T) (NEWIO T))
(DEFUN CONSTANT MACRO (X)
(LIST 'DEFUN (CADR X) 'MACRO '(X) (LIST 'QUOTE (CADDR X))))
(DEFUN LOGAND MACRO (X) (CONS 'BOOLE (CONS '1 (CDR X))))
(DEFUN LOGOR MACRO (X) (CONS 'BOOLE (CONS '7 (CDR X))))
(DEFUN LOGCLR MACRO (X) (CONS 'BOOLE (CONS '4 (CDR X))))
(DEFUN PUSH MACRO (X) (LIST 'SETQ (CADDR X) (LIST 'CONS (CADR X) (CADDR X))))
(DEFUN POP MACRO (X)
(LIST 'PROG2 NIL
(LIST 'CAR (CADR X))
(LIST 'SETQ (CADR X) (LIST 'CDR (CADR X)))))
(CONSTANT TOP 4000) ;NAMES OF BITS FOR KNIGHT KEYBOARDS
(CONSTANT SHIFTLOCK 2000)
(CONSTANT SHIFT 1000)
(CONSTANT META 400)
(CONSTANT CTRL 200)
(CONSTANT ASCII-BITS 177)
(CONSTANT ^K 13) ;VARIOUS ASCII CHARACTERS
(CONSTANT ^L 14)
(CONSTANT ^M 15)
(CONSTANT SPACE 40)
(CONSTANT OPEN-PAREN 50)
(CONSTANT VERTICAL-BAR 174)
(CONSTANT PSEUDOSPACE 203) ;A FAKE SPACE (INTERNAL TO LISP)
(CONSTANT SLASH-SYNTAX 2000) ;BITS IN READER SYNTAX TABLE
(CONSTANT ALTERNATE-SYNTAX 40)
(CONSTANT OPEN-SYNTAX 40000)
(CONSTANT CLOSE-SYNTAX 10000)
(CONSTANT RUBOUT-SYNTAX 1000)
(CONSTANT FORCE-FEED 1000) ;WITH ALTERNATE-SYNTAX
(CONSTANT SPACE-SYNTAX 100000)
(CONSTANT SINGLE-SYNTAX 200000)
(CONSTANT MACRO-SYNTAX 4000)
(CONSTANT WORTHY-SYNTAX 277237) ;"WORTHY" CHARACTERS
(CONSTANT SLASH-FLAG 400000)
(CONSTANT STRING-BEGIN-FLAG 200000)
(CONSTANT STRING-END-FLAG 100000)
(DECLARE (FIXNUM (TYI7 NIL)))
(DEFUN TYI7 (IFILE)
((LAMBDA (CH)
(COND ((ZEROP (LOGAND (CTRL) CH)) CH)
((= CH (+ (CTRL) 177)) 177)
(T (LOGAND CH 37))))
(LOGCLR (TYI IFILE) (LOGOR (TOP) (SHIFTLOCK) (SHIFT) (META)))))
(DEFUN REPRINT (CHARS COUNT POS OFILE)
(DECLARE (FIXNUM COUNT))
(COND (OFILE
(AND POS (CURSORPOS (CAR POS) (CDR POS) OFILE))
(AND (PLUSP COUNT)
(DO ((I 0 (1+ I)))
((= I COUNT) (TYO (SPACE) OFILE))
(DECLARE (FIXNUM I))
(TYO (OPEN-PAREN) OFILE)))
(MAPCAR '(LAMBDA (CH) (TYO (LOGAND CH (ASCII-BITS)) OFILE)) CHARS))))
(DEFUN PROMPTER (BUFFER SIZE OFILE)
(AND OFILE
((LAMBDA (CHARS POS HAUMANY)
(CURSORPOS 0 (- (CDR SIZE) HAUMANY 5) OFILE)
(CURSORPOS 'L OFILE)
(DO ((I 0 (1+ I))
(L CHARS (CDR L)))
((OR (NULL L)
(= (CAR L) (^M))
(= I HAUMANY)))
(DECLARE (FIXNUM I))
(TYO (LOGAND (CAR L) (ASCII-BITS))))
(CURSORPOS (CAR POS) (CDR POS) OFILE))
(DO ((X BUFFER (CDR X))
(N 0 ((LAMBDA (SYNTAX)
(COND (STRING N)
((PLUSP (LOGAND SYNTAX (OPEN-SYNTAX)))
(- N 1))
((PLUSP (LOGAND SYNTAX (CLOSE-SYNTAX)))
(+ N 1))
(T N)))
(STATUS SYNTAX (LOGAND (CAR X) (ASCII-BITS)))))
(STRING NIL (COND ((PLUSP (LOGAND (CAR X) (STRING-BEGIN-FLAG))) NIL)
((PLUSP (LOGAND (CAR X) (STRING-END-FLAG))) T)
(T STRING)))
(CHARS NIL (CONS (CAR X) CHARS)))
((OR (MINUSP N) (NULL X)) CHARS)
(DECLARE (FIXNUM N)))
(CURSORPOS OFILE)
(// (CDR SIZE) 2))))
(DEFUN TTY-PRESCAN (IFILE FN PARENSCOUNT)
(DECLARE (FIXNUM PARENSCOUNT))
(PROG (USEFUL STARTPOS OFILE STRING-END BUFFER CH SYNTAX LINMODE TTYREAD COUNT SIZE)
(DECLARE (FIXNUM STRING-END CH SYNTAX COUNT))
(COND ((SETQ OFILE (STATUS TTYCONS IFILE))
(SETQ STARTPOS (CURSORPOS OFILE))
(SETQ SIZE (STATUS TTYSIZE OFILE))))
(SETQ LINMODE (STATUS LINMODE IFILE))
(SETQ TTYREAD (STATUS TTYREAD IFILE))
(SETQ COUNT PARENSCOUNT)
(SETQ STRING-END -1)
LOOP (SETQ SYNTAX (STATUS SYNTAX (SETQ CH (TYI7 IFILE))))
(COND ((= CH (^M))
(COND ((EQ FN 'READLINE) (GO DONE))
(LINMODE
(OR (MINUSP STRING-END) (PUSH (PSEUDOSPACE) BUFFER))
(GO DONE)))))
(COND ((OR (= CH (^K)) (= CH (^L)))
(COND ((NULL OFILE) (GO LOOP))
(T (COND ((AND (= CH (^L)) STARTPOS)
(CURSORPOS 'C OFILE))
(T (TERPRI OFILE)))
(SETQ STARTPOS (CURSORPOS OFILE))
(REPRINT (REVERSE BUFFER) PARENSCOUNT NIL OFILE)
(PROMPTER BUFFER SIZE OFILE)
(GO LOOP))))
((AND (NOT (EQ FN 'READLINE))
(PLUSP (LOGAND SYNTAX (SLASH-SYNTAX))))
(PUSH CH BUFFER)
(PUSH (LOGOR (SLASH-FLAG) (TYI7 IFILE)) BUFFER)
(SETQ USEFUL T)
(GO LOOP))
((AND (PLUSP (LOGAND SYNTAX (RUBOUT-SYNTAX)))
(ZEROP (LOGAND SYNTAX (ALTERNATE-SYNTAX))))
(COND (BUFFER
(AND OFILE
(OR (RUBOUT (LOGCLR (SETQ CH (POP BUFFER))
(LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG)))
OFILE)
(REPRINT (REVERSE BUFFER) PARENSCOUNT STARTPOS OFILE)))
(COND ((PLUSP (LOGAND CH (SLASH-FLAG)))
(AND OFILE
(OR (RUBOUT (POP BUFFER) OFILE)
(REPRINT (REVERSE BUFFER) PARENSCOUNT STARTPOS OFILE))))
((NOT (MINUSP STRING-END))
(AND (PLUSP (LOGAND CH (STRING-BEGIN-FLAG)))
(SETQ STRING-END -1)))
((PLUSP (LOGAND CH (STRING-END-FLAG)))
(SETQ STRING-END (LOGAND CH (ASCII-BITS))))
((PLUSP (LOGAND (SETQ SYNTAX
(STATUS SYNTAX
(LOGCLR CH
(LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG)))))
(OPEN-SYNTAX)))
(PROMPTER BUFFER SIZE OFILE)
(SETQ COUNT (- COUNT 1)))
((PLUSP (LOGAND SYNTAX (CLOSE-SYNTAX)))
(PROMPTER BUFFER SIZE OFILE)
(SETQ COUNT (+ COUNT 1)))))
(T (AND OFILE (TERPRI OFILE))))
(GO LOOP))
((EQ FN 'READLINE)
(PUSH CH BUFFER)
(GO LOOP))
((NOT (MINUSP STRING-END))
(COND ((= CH STRING-END)
(PUSH (LOGOR CH (STRING-END-FLAG)) BUFFER)
(SETQ STRING-END -1))
(T (PUSH CH BUFFER)))
(GO LOOP))
((AND (PLUSP (LOGAND SYNTAX (FORCE-FEED)))
(PLUSP (LOGAND SYNTAX (ALTERNATE-SYNTAX))))
(GO DONE))
((PLUSP (LOGAND SYNTAX (SPACE-SYNTAX)))
(COND ((OR (PLUSP COUNT) (NOT USEFUL) LINMODE (NOT TTYREAD))
(PUSH CH BUFFER)
(PROMPTER BUFFER SIZE OFILE)
(GO LOOP))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (SINGLE-SYNTAX)))
(COND ((OR (PLUSP COUNT) LINMODE (NOT TTYREAD))
(SETQ USEFUL T)
(PUSH CH BUFFER)
(GO LOOP))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (MACRO-SYNTAX)))
((LAMBDA (MAC)
(COND ((EQ MAC '+INTERNAL-/;-MACRO)
(PUSH (LOGOR CH (STRING-BEGIN-FLAG)) BUFFER)
(SETQ STRING-END (^M)))
((EQ MAC '+INTERNAL-/|-MACRO)
(PUSH (LOGOR CH (STRING-BEGIN-FLAG)) BUFFER)
(SETQ STRING-END (VERTICAL-BAR)))
(T (PUSH CH BUFFER))))
(CAR (STATUS MACRO (+ CH 0))))
(SETQ USEFUL T)
(GO LOOP))
((PLUSP (LOGAND SYNTAX (OPEN-SYNTAX)))
(SETQ COUNT (+ COUNT 1))
(SETQ USEFUL T)
(PUSH CH BUFFER)
(PROMPTER BUFFER SIZE OFILE)
(GO LOOP))
((PLUSP (LOGAND SYNTAX (CLOSE-SYNTAX)))
(COND ((OR (PLUSP COUNT) (NOT USEFUL) LINMODE (NOT TTYREAD))
(COND ((PLUSP (SETQ COUNT (- COUNT 1)))
(PUSH CH BUFFER)
(PROMPTER BUFFER SIZE OFILE)
(GO LOOP))
(T (GO DONE))))
(T (GO DONE))))
((PLUSP (LOGAND SYNTAX (WORTHY-SYNTAX)))
(PUSH CH BUFFER)
(SETQ USEFUL T)
(GO LOOP))
(T (PUSH CH BUFFER) (GO LOOP)))
DONE (AND OFILE
((LAMBDA (POS)
(LINENUM OFILE (CAR POS))
(CHARPOS OFILE (CDR POS)))
(CURSORPOS OFILE)))
(PUSH CH BUFFER)
(SETQ BUFFER (NREVERSE BUFFER))
(MAP '(LAMBDA (X)
(AND (PLUSP (LOGAND (CAR X) (LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG))))
(RPLACA X (LOGCLR (CAR X) (LOGOR (SLASH-FLAG)
(STRING-BEGIN-FLAG)
(STRING-END-FLAG))))))
BUFFER)
(PROMPTER NIL SIZE OFILE)
(RETURN BUFFER)))
(SSTATUS TTYSCAN 'TTY-PRESCAN)