(FILECREATED "30-May-86 16:31:44" {ERIS}<LISPCORE>SOURCES>TTYIN.;25 321055
changes to: (FNS TTED DO.EE TTYINEDIT)
previous date: "16-Apr-86 16:07:46" {ERIS}<LISPCORE>SOURCES>TTYIN.;24)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TTYINCOMS)
(RPAQQ TTYINCOMS [(FNS * TTYINFNS)
(FNS * TTDISPLAYFNS)
[COMS (* TTYINBUFFERSTREAM)
(FNS TTYINBUFFERDEVICE TTYINBUFFERSTREAM TTYINBUFFERBIN TTYINBUFFERPEEK
TTYINBUFFERREADP TTYINBUFFEREOFP TTYINBUFFERBACKPTR TTYINWORDRDTBL)
(DECLARE: DONTEVAL@LOAD DOCOPY (VARS (TTYINBUFFERDEVICE (TTYINBUFFERDEVICE))
(TTYINWORDRDTBL (TTYINWORDRDTBL]
(COMS (* Mouse handling)
(FNS DO.MOUSE DO.SHIFTED.SELECTION COPY.SEGMENT DELETE.LONG.SEGMENT
DELETE.LONG.SEGMENT1 INVERT.LONG.SEGMENT INVERT.SEGMENT
BRACKET.CURRENT.WORD TTBEFOREPOS TTNEXTPOS TTRACKMOUSE))
(COMS (* Support functions. These are all macros or for debugging)
(FNS * TTSUPPORTFNS))
[COMS (* Auxiliary fns. These are outside the TTYIN block, and are provided to aid
the outside world in special interfaces to TTYIN)
(FNS SETREADFN TTYINENTRYFN TTYINREADP TTYINREAD TTYINFIX CHARMACRO?
TTYINMETA \SET.TTYINBOLDFONT TTYIN.LASTINPUT)
(FNS TTED DO.EE TTYINEDIT SIMPLETEXTEDIT SET.TTYINEDIT.WINDOW TTYIN.PPTOFILE
TTYIN.SCRATCHFILE \TTYIN.RPEOF)
(USERMACROS EE ED BUF)
(LISPXMACROS TV BUF)
(INITVARS (TTYINEDITWINDOW)
(TTYINEDIT.SCRATCH)
(TTYINEDITPROMPT T)
(TTYINAUTOCLOSEFLG)
(TTYINPRINTFN)
(TTYIN?=FN))
(ADDVARS (AFTERSYSOUTFORMS (SETQ TTYINEDIT.SCRATCH NIL]
(DECLARE: DOEVAL@COMPILE DONTCOPY (COMS * TTCOMPILETIME))
(INITVARS (TTYINBUFFER)
(?ACTIVATEFLG T)
(EDITPREFIXCHAR)
(SHOWPARENFLG T)
(TTYINBSFLG T)
(TTYINFILLDEFAULT T)
(TTYINCOMPLETEFLG T)
(TTYINUSERFN)
(TYPEAHEADFLG T)
(null "")
(DEFAULTPROMPT "** ")
(TTYJUSTLENGTH -8)
(\INSIDE.TTYIN)
(TTYINERRORSETFLG)
(TTYINRAISEFLG T)
(TTYINAUTOFILLMARGIN 8)
(TTYINFIXLIMIT 50)
(TTYINDEBUGFLG)
(HISTSTR1 "from file:")
(TTYINCOMMENTCHAR))
(P (MOVD? (QUOTE NILL)
(QUOTE GUESTUSER?))
(MOVD? (QUOTE FIXSPELL)
(QUOTE FIXSPELL!!))
(MOVD? (QUOTE HELPSYS)
(QUOTE XHELPSYS))
[PUTDQ? SPRINTT (LAMBDA (X)
(PRIN1 X]
(MOVD? (QUOTE NILL)
(QUOTE WINDOWWORLD))
(MOVD? (QUOTE LISPXFIX)
(QUOTE NONTTYINLISPXFIX)))
(ADDVARS (TTYINREADMACROS)
(TTYINRESPONSES)
(LISPXCOMS (STOP . OK)))
(PROP VARTYPE TTYINREADMACROS)
[DECLARE: DONTEVAL@LOAD DOCOPY (P [COND ((CCODEP (QUOTE TTYIN))
(CHANGENAME (QUOTE PROMPTCHAR)
(QUOTE LISPXREADP)
(QUOTE TTYINREADP))
(SETREADFN)
(MOVD (QUOTE TTYINFIX)
(QUOTE LISPXFIX]
(\SET.TTYINBOLDFONT (DEFAULTFONT (QUOTE DISPLAY]
(GLOBALRESOURCES \TTWAITBOX)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA TTBOUTN TTBOUT)
(NLAML TTED CHARMACRO? CAPABILITY?)
(LAMA])
(RPAQQ TTYINFNS
(TTYIN TTYIN.SETUP TTYIN.CLEANUP TTYIN1 TTYIN1RESTART TTYIN.FINISH TTYIN.READ TTYIN.BALANCE
ADDCHAR TTMAKECOMPLEXCHAR ADDNAKEDCHAR TTADDTAB ADJUSTLINE ADJUSTLINE.AND.RESTORE
AT.END.OF.SCREEN AT.END.OF.TEXT AUTOCR? BACKSKREAD BACKWARD.DELETE.TO BREAKLINE
BUFTAILP CHECK.MARGIN CLEAR.LINE? CURRENT.WORD DELETE.TO.END DELETELINE DELETETO
DELETETO1 DO.EDIT.COMMAND DO.EDIT.PP DO?CMD TTYIN.PRINTARGS TTYIN.READ?=ARGS TTDOTABS
EDITCOLUMN EDITNUMBERP END.DELETE.MODE ENDREAD? FIND.LINE FIND.LINE.BREAK
FIND.MATCHING.QUOTE FIND.MATCHING.WORD FIND.NEXT.WORD FIND.NON.SPACE FIND.START.OF.WORD
FORWARD.DELETE.TO GO.TO.ADDRESSING GO.TO.FREELINE GO.TO.RELATIVE INIT.CURSOR
INSERT.NODE INSERTLINE KILL.LINES KILLSEGMENT L-CASECODE MOVE.BACK.TO MOVE.FORWARD.TO
MOVE.TO.LINE MOVE.TO.NEXT.LINE MOVE.TO.START.OF.WORD MOVE.TO.WHEREVER NTH.COLUMN.OF
NTH.RELATIVE.COLUMN.OF OVERFLOW? OVERFLOWLINE? PREVLINE PREVWORD PROPERTAILP
READFROMBUF RENUMBER.LINES RESTORE.CURSOR RESTOREBUF RETYPE.BUFFER SAVE.CURSOR SCANBACK
SCANFORWARD SCRATCHCONS SEGMENT.LENGTH SEGMENT.BIT.LENGTH SETLASTC SETTAIL?
SHOW.MATCHING.PAREN SKIP/ZAP START.NEW.LINE START.OF.PARAGRAPH? TTADJUSTWORD TTBIN
TTBITWIDTH TTCOMPLETEWORD TTCRLF TTCRLF.ACCOUNT TTDELETECHAR TTDELETELINE TTDELETEWORD
TTECHO.TO.FILE TTGIVEHELP TTGIVEHELP1 TTGIVEHELP2 TTLASTLINE TTLOADBUF TTNEXTLINE
TTNEXTNODE TTNLEFT TTNTH TTNTHLINE TTPRIN1 TTPRIN2 TTPROMPTCHAR TTRATOM TTREADLIST
TTRUBOUT TTSKIPSEPR TTSKREAD TTUNREADBUF TTWAITFORINPUT TTYINSTRING TYPE.BUFFER
U-CASECODE U/L-CASE WORD.MATCHES.BUFFER))
(DEFINEQ
(TTYIN
[LAMBDA (PROMPT SPLST HELP OPTIONS ECHOTOFILE TABS UNREADBUF RDTBL)
(* bvm: "11-Apr-86 11:25")
(DECLARE (SPECVARS SPLST HELP TABS UNREADBUF RDTBL ECHOTOFILE))
(* * TTYIN is a general input function. See TTYIN.DOC for details on the
arguments and use of this fn. TTYIN was designed and implemented by Bill van
Melle at Stanford.)
(* * Some implementation notes: The bulk of the code here is oriented toward
smart use on display terminals, specifically the datamedia.
If on a dm, TTYIN puts the terminal in binary mode so it can read the 200q bit
supplied by the EDIT key. Most of the cursor-moving commands from TVEDIT are
available or slightly modified, and a few extra are supplied as well.)
(* The text being typed in is represented as a list of character codes, with a
data structure on top of it which partitions it by line.
Thus, you can view the text as one string, or broken into lines, depending on
the function desired. \BUFFER is the pointer to the start of the buffer,
\ENDBUFFER points one past the end. TTYIN saves up cons cells between calls and
reuses them; \ENDBUFFER points to this list of free cells.
TTYINBUFFER is the master record, which keeps assorted global information about
where the cursor is, and saves some state info from one call to the next,
enabling the restore previous buffer command.
See BUFFIELDS for documentation of its fields;
the fields are accessed by the ! construct for efficiency.
One of the fields points to the LINE records which describe the two-dimensional
structure of the input. Each record points to the region of the buffer
containing the text for one line, and has fields indicating the first and last
columns, and a pointer to the next line record.
\ARROW always points to the current LINE record -
\CURSOR points to where in the buffer the cursor appears.
-
This representation is not terribly space-efficient for large buffers, but it
is easily manipulated, and fast. If there is a particularly long input, there
will be many cons cells tied up in TTYINBUFFER, so a good thing to do when
trying to free up space is reset TTYINBUFFER to NIL to force its regeneration
from scratch.)
(RESETLST (PROG ((\INSIDE.TTYIN T)
(\TTYINSTATE TTYINBUFFER)
(\DSP (TTYDISPLAYSTREAM))
(\AUTOFILL TTYINFILLDEFAULT)
(\RAISEINPUT (OR TTYINRAISEFLG (fetch RAISEFLG of \PRIMTERMTABLE)))
(\FIRSTTIME T)
(TYPEAHEAD TYPEAHEADFLG)
\RDTBLSA \INITPOS \BMARG \LMARG \RMARG \CHARWIDTH \CHARHEIGHT \DESCENT \FONT
\VARIABLEFONT \TEXTURE \TTPAGELENGTH \CURSORROW \CURSORCOL \HOMEROW \HOMECOL
\PROMPT1 \PROMPT2 \FIRSTLINE \LASTAIL \LASTAILCOL \LASTAILROW \FIX \LOC.ROW.0
\LASTCHAR \SPLSTFLG VALUE \BUFFER \ENDBUFFER \CURSOR \ARROW \DELETING
\DONTCOMPLETE \NOVALUE \NOFIXSPELL \STRINGVALUE \REPEAT \COMMAND \READING
\LISPXREADING DIRECTORY/FILE \NOPROMPT \FILLINGBUFFER \LAST.DELETION
\TTYINBUFFERSTREAM)
(SETQ TTYINBUFFER) (* Global resource. Any ttyin calls
while we are running need to create
their own)
[OR (LISTP \TTYINSTATE)
(SETQ \TTYINSTATE (create TTYINBUFFER
FIRSTLINE ← (create LINE
START ← (CONS 0)
ROW ← 0]
(TTYIN.SETUP)
[COND
((AND SPLST (NLISTP SPLST))
(SETQ SPLST (CONS SPLST]
(for OP inside OPTIONS do (SELECTQ OP
((NOFIXSPELL MUSTAPPROVE CRCOMPLETE)
(SETQ \NOFIXSPELL (SETQ \DONTCOMPLETE OP)))
(\NOVALUE (SETQ \NOVALUE OP))
(STRING (SETQ \STRINGVALUE OP))
(COMMAND (SETQ \COMMAND OP))
(REPEAT (SETQ \REPEAT OP))
(NORAISE (SETQ \RAISEINPUT))
(RAISE (SETQ \RAISEINPUT T))
(TEXT (SETQ \REPEAT (SETQ \NOVALUE (SETQ \AUTOFILL
OP)))
(SETQ \RAISEINPUT))
(FIX (SETQ \FIX OP))
(READ (SETQ \READING (SETQ \AUTOFILL OP)))
(LISPXREAD [SETQ TYPEAHEAD (SETQ \LISPXREADING
(SETQ \READING
(SETQ \AUTOFILL OP]
(SETQ \RAISEINPUT (fetch RAISEFLG
of \PRIMTERMTABLE)))
(EVALQT (* like LISPXREAD, but with added
proviso about checking for EVALQT
right-bracket hacks)
[SETQ TYPEAHEAD (SETQ \LISPXREADING
(SETQ \READING (SETQ
\AUTOFILL
OP]
(SETQ \RAISEINPUT (fetch RAISEFLG
of \PRIMTERMTABLE)))
((FILE DIRECTORY USER)
(SETQ DIRECTORY/FILE OP))
(TYPEAHEAD (SETQ TYPEAHEAD OP))
(FILLBUFFER (SETQ \FILLINGBUFFER OP))
(NOPROMPT (SETQ \NOPROMPT (SETQ \FIRSTTIME OP)))
NIL))
[SETQ \RDTBLSA (fetch READSA of (SETQ RDTBL (COND
((AND (NOT \READING)
(NULL RDTBL))
(* Use the word table, rather than a
Lispish table)
(\DTEST TTYINWORDRDTBL
(QUOTE READTABLEP)))
(T (\GTREADTABLE RDTBL]
[COND
((EQ PROMPT T)
(SETQ \PROMPT1 (SETQ \PROMPT2)))
(T [COND
((NOT PROMPT)
(SETQ PROMPT DEFAULTPROMPT))
[(LISTP PROMPT)
(COND
((NLISTP (CDR PROMPT)) (* User has already supplied us with a
dotted pair of prompts)
(SETQ \PROMPT1 (CAR PROMPT))
(SETQ \PROMPT2 (CDR PROMPT)))
(T (SETQ PROMPT (SUBSTRING PROMPT 2 -2]
((AND (NOT (STRINGP PROMPT))
(NOT (LITATOM PROMPT)))
(SETQ PROMPT (MKSTRING PROMPT]
(COND
((NLISTP PROMPT) (* Now create 2 prompts out of one)
(SETQ \PROMPT1 PROMPT)
(SETQ \PROMPT2 (COND
(\LISPXREADING NIL)
((AND \REPEAT (ILESSP (NCHARS PROMPT)
12))
(* Okay to use this short prompt as a
secondary prompt)
PROMPT)
(T (QUOTE ...]
(COND
((NOT SPLST)
(SETQ \DONTCOMPLETE T)))
(COND
(\READING (SETQ \REPEAT)))
(COND
((AND TTYINMAILFLG (NEQ \READING (QUOTE EVALQT))
(ILESSP \INITPOS 5))
(MAILWATCH)))
(COND
((NOT TYPEAHEAD)
(CLEARBUF T)))
LP (SETQ VALUE (NLSETQ (TTYIN1)))
(COND
((NOT VALUE) (* NLSETQ aborted. Try again.)
(COND
((OR (NOT TTYINERRORSETFLG)
\LISPXREADING) (* LISPXREAD is not
errorset-protected, so why should this
be?)
(COND
(\CURSORCOL (* If this is NIL, then we haven't
initialized enough to go anywhere)
(GO.TO.FREELINE)))
(RESTOREMOD)
(COND
((NEQ \BUFFER \ENDBUFFER)
(replace OLDTAIL of \TTYINSTATE with \ENDBUFFER)))
(ERROR!)))
(GO LP)))
(SELECTQ (SYSTEMTYPE)
(D (COND
((AND (NEQ \BUFFER \ENDBUFFER)
(IGREATERP (add (fetch STORAGECOUNTER of \TTYINSTATE)
1)
10)) (* Release some storage, since it
seems to accumulate and fragment)
(replace STORAGECOUNTER of \TTYINSTATE with 0)
(FRPLACD \ENDBUFFER))))
NIL)
(SETQ VALUE (CAR VALUE))
(POSITION T 0)
[COND
((AND CTRLUFLG (NEQ VALUE T)) (* user typed ↑U to edit input)
(SETQ CTRLUFLG)
(PROG ((\INSIDE.TTYIN))
(COND
((OR (LITATOM VALUE)
(GUESTUSER?)) (* guests may not edit)
)
((LISTP VALUE)
(EDITE VALUE))
(T (SETQ VALUE (CAR (EDITE (LIST VALUE)
(QUOTE (REPACK]
(COND
((AND TTYINMAILFLG (NEQ \READING (QUOTE EVALQT)))
(* Note time of last user input)
(MWNOTE)))
(RETURN VALUE])
(TTYIN.SETUP
[LAMBDA NIL (* kbr: "29-Jan-86 12:43")
(SETQ \DSP (TTYDISPLAYSTREAM)) (* Compute this afresh now in case it
changed by the creation of a new tty
window)
(* Disable buttons so we can do
selection)
[LET ((WINDOW (WFROMDS \DSP)))
(COND
(WINDOW (replace (TTYINBUFFER TTOLDRIGHTFN) of \TTYINSTATE with (WINDOWPROP WINDOW
(QUOTE
RIGHTBUTTONFN
)
(QUOTE TOTOPW)))
(replace (TTYINBUFFER TTOLDBUTTONFN) of \TTYINSTATE with (WINDOWPROP WINDOW
(QUOTE
BUTTONEVENTFN
)
(QUOTE TOTOPW)))
(replace (TTYINBUFFER TTOLDENTRYFN) of \TTYINSTATE with (WINDOWPROP WINDOW
(QUOTE
WINDOWENTRYFN
)
(QUOTE TTYINENTRYFN
)))
(replace (TTYINBUFFER TTYINWINDOW) of \TTYINSTATE with WINDOW)
(WINDOWPROP WINDOW (QUOTE TTYINSTATE)
(fetch (TTYINBUFFER TTYINWINDOWSTATE) of \TTYINSTATE))
(RESETSAVE NIL (LIST (FUNCTION TTYIN.CLEANUP)
\TTYINSTATE]
(COND
((OR (IMAGESTREAMTYPEP (TTYDISPLAYSTREAM)
(QUOTE TEXT))
(FMEMB (DSPDESTINATION NIL (TTYDISPLAYSTREAM))
\SCREENBITMAPS))
(SETQ \CHARWIDTH (CHARWIDTH (CHARCODE A)
\DSP))
(SETQ \FONT (DSPFONT NIL \DSP))
(SETQ \VARIABLEFONT (NEQ \CHARWIDTH (FCHARWIDTH (CHARCODE i)
\DSP)))
(SETQ \CHARHEIGHT (IMINUS (DSPLINEFEED NIL \DSP)))
(SETQ \DESCENT (FONTPROP \FONT (QUOTE DESCENT))) (* How many pixels below the baseline
this font goes)
(SETQ \TEXTURE (DSPTEXTURE NIL \DSP))
(SETQ \TTPAGELENGTH (PAGEHEIGHT NIL \DSP))
(SETQ \LMARG (DSPLEFTMARGIN NIL \DSP)) (* bit pos of left margin)
(SETQ \RMARG (DSPRIGHTMARGIN NIL \DSP)) (* bit pos of right margin, dsp
relative)
(SETQ \INITPOS (IDIFFERENCE (DSPXPOSITION NIL \DSP)
\LMARG])
(TTYIN.CLEANUP
[LAMBDA (\TTYINSTATE) (* bvm: "24-Aug-84 16:32")
(PROG ((WINDOW (fetch TTYINWINDOW of \TTYINSTATE)))
(COND
(WINDOW (WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(fetch (TTYINBUFFER TTOLDRIGHTFN) of \TTYINSTATE))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(fetch (TTYINBUFFER TTOLDBUTTONFN) of \TTYINSTATE))
(WINDOWPROP WINDOW (QUOTE WINDOWENTRYFN)
(fetch (TTYINBUFFER TTOLDENTRYFN) of \TTYINSTATE))
(WINDOWPROP WINDOW (QUOTE TTYINSTATE)
NIL)))
(SETQ TTYINBUFFER \TTYINSTATE])
(TTYIN1
[LAMBDA NIL (* bvm: "16-Apr-86 12:34")
(* * The main moby subfn of TTYIN. Is errorset protected in caller)
(PROG ((DRIBFL (DRIBBLEFILE))
CHAR MATCHED RESULT STARTOFWORD X TMP WASEDITCHAR SNX)
(COND
((SETQ CHAR (fetch (LINEBUFFER PEEKEDCHAR) of \LINEBUF.OFD))
(* Handle peeked char)
[COND
((AND (OR (NULL \PROMPT1)
(EQ \FIRSTTIME (QUOTE NOPROMPT)))
(OR T (fetch (LINEBUFFER PEEKEDECHOFLG) of \LINEBUF.OFD))
(IGEQ CHAR (CHARCODE SPACE)))
(* Want to avoid echoing peeked char twice.
Only feasible to do so if we were called with no prompt, implying that there is
some hope that the preceding char on the line is the peeked char)
(SETQ X (FCHARWIDTH CHAR \FONT))
(DSPBACKUP X \DSP)
(SETQ \INITPOS (IDIFFERENCE \INITPOS X]
(replace (LINEBUFFER PEEKEDCHAR) of \LINEBUF.OFD with NIL)))
(SETQ \LASTAIL)
RESTART
PROMPT0
(TTYIN1RESTART)
(COND
((NOT \FIRSTTIME) (* Space over to where we started)
(GO.TO.ADDRESSING \INITPOS 0)))
(SETQ RESULT NIL)
PROMPT1
(INIT.CURSOR \INITPOS)
(COND
[(AND (EQ \FIRSTTIME (QUOTE NOPROMPT))
\PROMPT1) (* Prompting has already happened;
account for it)
(COND
((ILESSP (SETQ X (IDIFFERENCE \INITPOS (STRINGWIDTH \PROMPT1 \FONT)))
0) (* Caller is consfused;
prompt couldn't have fit.
Typically happens when LISPXREAD is
called by other than LISPX)
(SETQ \PROMPT1))
(T (SETQ \INITPOS X]
(T (TTPROMPTCHAR \ARROW)))
(replace FIRSTCOL of \ARROW with (replace LASTCOL of \ARROW with \CURSORCOL))
[COND
([OR (NLISTP TABS)
(NOT (SMALLP (CAR TABS]
(SETQ TABS))
((NOT (IGREATERP (ITIMES (SUB1 (CAR TABS))
\CHARWIDTH)
\CURSORCOL)) (* Caller specified first tabstop as
the position of the first char;
we don't treat that as a tabstop, so
peel it off)
(SETQ TABS (CDR TABS]
[COND
[UNREADBUF (* something to preload buffer with)
(COND
((FIXP UNREADBUF)
(SETQ CHAR UNREADBUF) (* interpret number as character code
of something to type ahead, usually
altmode)
(SETQ UNREADBUF NIL)
(GO SELECTCHAR))
(T (TTLOADBUF (PROG1 UNREADBUF (SETQ UNREADBUF NIL]
(\FIRSTTIME
(* (for FORM in AFTERPROMPTCHARFORMS bind REFRESH when
(EVAL FORM) do (SETQ REFRESH T) (* User forms to do after prompt is printed but
before we do anything more. If one returns T, means it altered the display)
finally (COND (REFRESH (SETQ \FIRSTTIME)
(GO PROMPT1)))))
]
(SETQ \FIRSTTIME)
(COND
(CHAR (GO SELECTCHAR)))
CHAR
(AND CHAR (SETQ \LASTCHAR CHAR))
(SETQ CHAR (TTBIN))
SELECTCHAR
[COND
([AND (SETQ X (FASSOC CHAR TTYINREADMACROS))
(OR [NLISTP (SETQ X (CDR (SETQ TMP X]
(AND (COND
((EQ (CAR X)
T)
(EMPTY.BUFFER))
((LISTP (CAR X))
(EVAL (CAR X)))
(T (* Old style macros that worked only
at start of buffer)
(SETQ X TMP)
(EMPTY.BUFFER)))
(OR (NLISTP (SETQ X (CDR X)))
(SETQ X (EVAL X]
(* Simple read macros: if you type the char on a blank line, and the macro
returns something, use it as the value of the READ
(or whatever))
(COND
[(FIXP X) (* Special: means pretend this
CHARACTER code was typed)
(SELECTQ X
(0 (* No action)
(GO CHAR))
(-1 (* Means refresh line, because
terminal control was taken away)
(SETQ CHAR NIL)
(GO PROMPT1))
(COND
((METACHARP (SETQ CHAR X))
[COND
((EQ (NONMETACHARBITS X)
0) (* another way to get edit prefix)
(SETQ CHAR (METACHAR (TTBIN T]
T]
((EMPTY.BUFFER) (* For now I'm not handling funny
results in the middle)
(SETQ RESULT (OR (LISTP X)
(LIST X)))
(GO DOCRLF]
(COND
((NOT (METACHARP CHAR))
(SETQ WASEDITCHAR NIL))
([NOT (SETQ CHAR (DO.EDIT.COMMAND (NONMETACHARBITS CHAR]
(GO CHAR))
(T (* Fall thru if edit char gave us
something to chomp on)
(SETQ WASEDITCHAR T)))
[COND
((SELECTC (fetch TERMCLASS of (\SYNCODE \PRIMTERMSA CHAR))
(CHARDELETE.TC
(TTDELETECHAR)
T)
(LINEDELETE.TC
(TTDELETELINE)
T)
(WORDDELETE.TC
(TTDELETEWORD)
T)
(RETYPE.TC (* ↑R retype)
[RETYPE.BUFFER (COND
((OR (ON.FIRST.LINE)
(NOT (EMPTY.LINE)))
\ARROW)
(T (* If sitting on empty line, refresh
the previous line)
(PREVLINE \ARROW 1]
(COND
((EQ CHAR (SETQ CHAR (TTBIN)))
(* two ↑R's means retype whole buffer)
(OR DISPLAYTERMFLG (TTCRLF))(* set off full retype by double line)
(RETYPE.BUFFER \FIRSTLINE T))
(T (GO SELECTCHAR)))
T)
NIL))
((PROGN (SETQ SNX (\SYNCODE \RDTBLSA CHAR))
(AND \FILLINGBUFFER (EQ (fetch WAKEUP of SNX)
IMMEDIATE.RMW)
(AT.END.OF.TEXT \CURSOR))) (* Immediate read macro--return now)
(GO DOCRLF))
(T (COND
((AND (fetch STOPATOM of SNX)
(NOT \DONTCOMPLETE)) (* End of atom, try completion)
(TTCOMPLETEWORD T)))
(SELECTC SNX
((LIST RIGHTPAREN.RC RIGHTBRACKET.RC)
(* Right paren/bracket.
See if it terminates read.
Note that \READING is implicitly true
here, since there are no parens in the
word rdtbl)
(SETQ STARTOFWORD \CURSOR)
(ADDCHAR CHAR)
(COND
((ENDREAD?)
(GO DOCRLF))
((AND SHOWPARENFLG (CAPABILITY? \CURSOR)
(NOT (TYPEAHEAD?))) (* prime conditions for hack to show
which paren it matched)
(SHOW.MATCHING.PAREN STARTOFWORD))))
(SELECTC CHAR
((CHARCODE ESCAPE)
[COND
(SPLST (* try to complete from spelling list)
(OR (TTCOMPLETEWORD)
(BEEP)))
((TENEXCOMPLETE CHAR DIRECTORY/FILE)
(* altmode indicated file/directory
completion, done in TENEXCOMPLETE)
NIL)
((AND TTYINCOMPLETEFLG \LISPXREADING (COND
((SETQ STARTOFWORD (
CURRENT.WORD
))
(SETQ MATCHED
(FIND.MATCHING.WORD
USERWORDS
STARTOFWORD)))
((AND (NEQ TTYINCOMPLETEFLG 0
)
(NOT (EMPTY.BUFFER)))
(* naked altmode stands for LASTWORD.
Don't do this on empty buffer, so as
not to interfere with P.A.'s * command)
(SETQ MATCHED
(FRPLACA (CONSTANT (CONS))
LASTWORD))
LASTWORD)))
(* special option --
do altmode completion on USERWORDS, a
list of fns/vars referenced recently)
(SETQ CHAR DIDESCAPECODE) (* Kludge used by ? routine below)
(OR (TTCOMPLETEWORD NIL NIL MATCHED (OR STARTOFWORD \CURSOR))
(BEEP)))
(T (* no special significance)
(ADDNAKEDCHAR (CHARCODE ESCAPE])
((CHARCODE (%" *))
(ADDCHAR CHAR)
(TTDOTABS TABS))
((CHARCODE TAB)
(OR (TTDOTABS TABS)
(TTADDTAB)))
((CHARCODE SPACE)
(OR (AUTOCR?)
(ADDCHAR CHAR)))
((CHARCODE ?)
(* supply alternative completions)
[COND
([NOT (AND ?ACTIVATEFLG (OR SPLST (EQ \LASTCHAR DIDESCAPECODE))
(AT.END.OF.BUF)
(SETQ STARTOFWORD (CURRENT.WORD))
(NEQ (SETQ X (CAR (NLEFT STARTOFWORD 1 \ENDBUFFER)))
(CHARCODE ?))
(NEQ (\SYNCODE \RDTBLSA X)
ESCAPE.RC)
(NOT (PROGN (FRPLACA \ENDBUFFER (CHARCODE ?))
(FIND.MATCHING.WORD SPLST STARTOFWORD
(CDR \ENDBUFFER]
(* Cases where ? is not acted on: ?ACTIVATEFLG not set;
no spelling list; line is a comment; no word is in progress;
previous char is also a ? (allows ?? etc.) or %%;
or ? is a valid completion)
(ADDCHAR CHAR))
((NOT (SETQ MATCHED (FIND.MATCHING.WORD (OR SPLST USERWORDS)
STARTOFWORD)))
(BEEP) (* No match. Ring the bell, but accept
the ? as is)
(ADDCHAR CHAR))
((TTCOMPLETEWORD NIL T MATCHED STARTOFWORD)
(* there was a unique completion)
)
(T (SAVE.CURSOR)
(GO.TO.FREELINE)
(TTPRIN1 "one of ")
[do (TTPRIN1 (INPART (CAR MATCHED)))
(COND
((SETQ MATCHED (FIND.MATCHING.WORD (CDR MATCHED)
STARTOFWORD))
(TTPRIN1 ", "))
(T (RETURN]
(COND
(DISPLAYTERMFLG (RESTORE.CURSOR))
(T (RETYPE.BUFFER \ARROW])
((CHARCODE CR)
(* terminate line)
[COND
((NOT WASEDITCHAR) (* i.e. not edit-CR)
(* Check for ? and ?= macros)
(PROG ((START (fetch START of \ARROW))
TAIL)
(COND
((EQ \CURSOR START)
(RETURN)))
(SETQ TAIL (NLEFT START 1 \CURSOR))
(* Look at last char on line)
(SELCHARQ (CAR TAIL)
(? (COND
((AND (DEFINEDP (QUOTE XHELPSYS))
[OR (EQ TAIL START)
(BREAK.OR.SEPRP (FIRSTCHAR (NLEFT START 1
TAIL]
(DO?CMD (QUOTE ?)
TAIL))
(GO CHAR))))
(= (COND
((AND (NEQ TAIL START)
(EQ (CAR (SETQ TAIL (NLEFT START 1 TAIL)))
(CHARCODE ?))
[OR (EQ TAIL START)
(BREAK.OR.SEPRP (FIRSTCHAR (NLEFT START 1
TAIL]
(DO?CMD (QUOTE ?=)
TAIL))
(GO CHAR))))
NIL))
(COND
((NOT (AT.END.OF.TEXT \CURSOR))
(COND
((OR \REPEAT \READING)
(* Insert a <cr> and continue reading)
(BREAKLINE EOLCHARCODE)
(GO CHAR))
(T (* <cr> typed here would terminate, so
unread what's left)
(TTUNREADBUF]
(COND
[(NOT (AT.END.OF.BUF))
(COND
((ON.LAST.LINE)
(SETQ \CURSOR \ENDBUFFER))
((AND \READING (NOT \PROMPT2)
(AT.END.OF.TEXT (fetch END of \ARROW)))
(* Really the same condition as previous clause: there are lines after this
one, but they're blank, so it looks like we're on the last line)
(MOVE.FORWARD.TO (fetch END of \ARROW))
(* have to make the extra stuff go
away so the finishing routines are
happy)
(DELETE.TO.END))
(T (DO.EDIT.COMMAND (CHARCODE CR))
(* CR on other than last line just
means go down one)
(GO CHAR]
((OR (NOT \DONTCOMPLETE)
(EQ \DONTCOMPLETE (QUOTE CRCOMPLETE)))
(TTCOMPLETEWORD T)))
(COND
((COND
(\READING (TTSKREAD \BUFFER))
[\REPEAT (AND (ON.FIRST.LINE)
(OR (EQ (CAR \BUFFER)
TTYINCOMMENTCHAR)
(AND \COMMAND (EQ (FIND.NEXT.WORD (
FIND.NON.SPACE
\BUFFER))
\ENDBUFFER]
(T T)) (* Terminating conditions: no REPEAT,
or first line is a comment or has a
single command on it)
(SETQ CTRLVFLG (SETQ RESULT))
(SETQ CHAR (CHARCODE EOL)) (* Lisp likes to treat cr as
(choke) EOL)
(GO DOCRLF))
(T (START.NEW.LINE EOLCHARCODE))))
((CHARCODE ↑X)
(* Go to end of expression, return if
parens balance)
(COND
((TTYIN.BALANCE T)
(SETQ CHAR (CHARCODE EOL))
(GO DOCRLF))))
((CHARCODE ↑V)
(COND
[\READING (* Means enter control char)
(ADDNAKEDCHAR (SETQ CHAR (SELCHARQ (SETQ CHAR (TTBIN))
((RUBOUT ?)
(* DELETE is ↑?)
127)
(LOGAND CHAR 31]
((AND (EQ \REPEAT (QUOTE TEXT))
(AT.END.OF.BUF)) (* terminate multiline input and sets
special flag)
(SETQ CTRLVFLG T)
(TTBOUT ↑ V)
(GO DOCRLF))
(T (BEEP))))
((CHARCODE ↑Z)
(* ↑Z terminates multiline input)
(COND
((AND \REPEAT (AT.END.OF.BUF))
(TTBOUT ↑ Z)
(SETQ CTRLVFLG)
(GO DOCRLF))
(\READING (ADDNAKEDCHAR CHAR))
(T (BEEP))))
((CHARCODE ↑Y)
(* ↑Y invokes user exec)
(COND
((AND \READING (NOT WASEDITCHAR))
(* let ↑Y read macro work instead)
(ADDNAKEDCHAR CHAR))
((GUESTUSER?)
(BEEP))
(T (SETTAIL?)
(SAVE.CURSOR)
(GO.TO.FREELINE)
(COND
(DRIBFL (* Make typescript understandable)
(AND \PROMPT1 (PRIN1 \PROMPT1 DRIBFL))
(PRINT (QUOTE ↑Y)
DRIBFL)))
(PRIN1 "lisp:
" T)
(COND
(TTYINMAILFLG (MWNOTE)))
(RESTOREMOD)
(PROG ((\INSIDE.TTYIN))
(USEREXEC (QUOTE ←←)))
(GO RETYPEBUFFER))))
(0 (* ignore NULL))
((CHARCODE (↑A BS RUBOUT))
(TTDELETECHAR))
((CHARCODE (↑Q ↑U))
(* ↑Q delete line; ↑U on tops20)
(TTDELETELINE))
((CHARCODE ↑W)
(* ↑W delete last word)
(TTDELETEWORD))
(\RESTOREBUFCODES
(* Blank middle: restore buffer's
previous contents.)
(RESTOREBUF))
(COND
[(IGREATERP CHAR 32) (* not a control char)
(ADDCHAR (COND
(\RAISEINPUT (U-CASECODE CHAR))
(T CHAR]
(T (ADDNAKEDCHAR CHAR]
(GO CHAR)
RETYPEBUFFER
(RETYPE.BUFFER \FIRSTLINE T T)
(GO CHAR)
DOCRLF
(* * Come here when it is time to terminate line)
(COND
((EQ (SETQ RESULT (TTYIN.FINISH CHAR DRIBFL RESULT))
(QUOTE ABORT)) (* Aborted, try again)
(SETQ CHAR NIL)
(GO PROMPT0))
(T (RETURN RESULT])
(TTYIN1RESTART
[LAMBDA NIL (* bvm: "16-Apr-85 18:02")
(\RESETLINE) (* clear some terminal-related stuff,
including the info about where to hold
scroll)
(\SETEOFPTR \LINEBUF.OFD 0) (* Clear the line buffer)
(SETQ \ARROW (SETQ \FIRSTLINE (fetch FIRSTLINE of \TTYINSTATE)))
[replace END of \ARROW with (SETQ \CURSOR (SETQ \BUFFER (SETQ \ENDBUFFER (fetch START
of \ARROW]
[PROG ((MORELINES (fetch NEXTLINE of \ARROW)))
(COND
(MORELINES (* Return old line records to cons
pool)
(replace NEXTLINE of \ARROW with NIL)
(KILL.LINES MORELINES]
(SETQ \DELETING])
(TTYIN.FINISH
[LAMBDA (FINALCHAR DRIBFL RESULT) (* bvm: "16-Apr-86 15:11")
(PROG (WORD X ORIGBUFFER)
(SELECTQ (SYSTEMTYPE)
(TOPS20 (* Save this for funny tops20 check at
end)
(SETQ \LASTCHAR FINALCHAR))
NIL)
(TTCRLF)
(CLEAR.LINE? T)
[COND
((EQ FINALCHAR (CHARCODE EOL))
(bind TAIL (START ← (fetch START of \ARROW))
while (AND (NEQ START \ENDBUFFER)
(EQ (CAR (SETQ TAIL (TTNLEFT \ENDBUFFER 1 START)))
(CHARCODE SPACE))
(NEQ (\SYNCODE \RDTBLSA (FIRSTCHAR (TTNLEFT TAIL 1 START)))
ESCAPE.RC)) do
(* Strip blanks, e.g., resulting from escape completion, so that Lispx does not
do its silly ... thing. Be careful not to strip a quoted space)
(SETQ \ENDBUFFER TAIL]
(COND
(DRIBFL (* print answer on typescript file)
(TTECHO.TO.FILE DRIBFL T)))
(for X inside ECHOTOFILE do (TTECHO.TO.FILE X))
(COND
[(EMPTY.BUFFER) (* blank line. RESULT is NIL unless
set above by a read macro)
(COND
((OR RESULT (EQ FINALCHAR (CHARCODE EOL)))
(SETLASTC (CHARCODE EOL))
(RETURN RESULT]
((EQ (CAR \BUFFER)
TTYINCOMMENTCHAR) (* comment)
(RETURN (QUOTE ABORT)))
((AND (EQ (CDR \BUFFER)
\ENDBUFFER)
(EQ (CAR \BUFFER)
(CHARCODE ?))
(OR HELP (AND \NOVALUE \REPEAT))) (* a bare ?)
(TTGIVEHELP (OR HELP "Terminate text with control-Z."))
(RETURN (QUOTE ABORT)))
(T (* Save last buffer position for
posterity)
(replace OLDTAIL of \TTYINSTATE with \ENDBUFFER)))
[COND
[\READING (SETQ RESULT (COND
(\FILLINGBUFFER (TTYIN.READ FINALCHAR T \LINEBUF.OFD))
(T (TTYIN.READ FINALCHAR NIL (TTYIN.SCRATCHFILE]
(T
(SETQ ORIGBUFFER \BUFFER)
(SETQ WORD (TTRATOM))
[COND
((EQ (TTSKIPSEPR)
\ENDBUFFER) (* this was the only word in buffer)
(COND
((SELECTQ WORD
((? HELP)
(* Only special if HELP provided)
(AND HELP (TTGIVEHELP HELP)))
NIL) (* special response handled;
restart now)
(TERPRI T)
(RETURN (QUOTE ABORT]
[for RESPONSE in TTYINRESPONSES when (AND (EQMEMB WORD (CAR RESPONSE))
(OR (EQ \BUFFER \ENDBUFFER)
(CADDR RESPONSE)))
do
(* Process global user option. RESPONSE is a triple
(commands response-form rest-of-line-arg);
if user gives one of the commands, the response form is evaluated with \COMMAND
set to the command and LINE set to the remainder of the line;
the third component says how to compute LINE: as a STRING or as a LIST;
if NIL, means there should be nothing else on the line.
If the response form returns the atom IGNORE, the input is not considered to be
a special response and the normal computation proceeds;
otherwise it is assumed the response has been processed, and we return to the
original TTYIN prompt for more input. Response-form may be an atom, in which
case it is APPLYed to \COMMAND and LINE.)
(COND
((NEQ [PROG [(\COMMAND WORD)
(\BUFFER \BUFFER)
(LINE (COND
((EQ \BUFFER \ENDBUFFER)
NIL)
((EQ (CADDR RESPONSE)
(QUOTE STRING))
(TTYINSTRING \BUFFER))
(T (TTREADLIST]
(DECLARE (SPECVARS \COMMAND \BUFFER LINE))
(RETURN (COND
((LITATOM (CADR RESPONSE))
(APPLY* (CADR RESPONSE)
\COMMAND LINE))
(T (EVAL (CADR RESPONSE]
(QUOTE IGNORE))
(RETFROM (QUOTE TTYIN.FINISH)
(QUOTE ABORT)))
(T
(* That response was ignored. We could quit the iteration now, but continue in
case there is another entry with the same command.
I.e. user can "redefine" special responses this way, but still let the old
definition happen if the input looks wrong)
]
[SETQ WORD (COND
((TTADJUSTWORD WORD))
((AND (NULL WORD)
(NULL SPLST)) (* NIL is acceptable response, so
don't abort!)
NIL)
(T (RETURN (QUOTE ABORT]
[SETQ RESULT (COND
[(EQ \BUFFER \ENDBUFFER)
(COND
(\COMMAND (LIST WORD))
(\NOVALUE T)
(\STRINGVALUE
(* Can't just MKSTRING WORD here, since in the process of making the atom we
might have changed something, e.g. stripped leading zeros from a number, or
changed radix)
(TTYINSTRING ORIGBUFFER))
(T (LIST WORD]
[\STRINGVALUE (COND
(\COMMAND (CONS WORD (TTYINSTRING \BUFFER)))
(T (TTYINSTRING ORIGBUFFER]
(\NOVALUE (COND
(\COMMAND (CONS WORD T))
(T T)))
(T (SETQ RESULT (TTREADLIST))
(COND
((OR \COMMAND (NULL SPLST))
(* only check first word typed, or
nothing at all)
(CONS WORD RESULT))
(T (for TL on RESULT
do [RPLACA TL (COND
((TTADJUSTWORD (CAR TL)))
((AND (NULL (CAR TL))
(NULL \FIX))
(* NIL is acceptable response, so
don't abort!)
NIL)
(T (RETURN (QUOTE ABORT]
finally (RETURN (CONS WORD RESULT]
(SETLASTC FINALCHAR)
(PROGN (* All this nonsense is just to
convince prettyprint to keep the
indentation down to a reasonable
amount)
(PROGN
(PROGN
(PROGN
(PROGN
(PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN
NIL]
(* * We have now processed the line, with the relevant value being RESULT...)
[COND
((AND TTYINUSERFN (LISTP RESULT))
(COND
((EQ (SETQ X (APPLY* TTYINUSERFN RESULT))
T) (* Special response has been
processed; try again)
(RETURN (QUOTE ABORT)))
(X (* this is what we should return)
(RETURN X]
(SETQ \CURRENTDISPLAYLINE 0) (* get scrolling right
(again))
(* see system \CLOSELINE)
(RETURN RESULT])
(TTYIN.READ
[LAMBDA (FINALCHAR DONTREAD STREAM) (* bvm: "10-Apr-86 12:53")
(* * Process buffer for reading. FINALCHAR is what prompted us to terminate the
call to TTYIN and is not in the buffer. If DONTREAD is true, then STREAM is the
line buffer and we are acting as \FILLBUFFER --
otherwise, STREAM is our own scratch stream, with an eof fn that returns right
paren; we read the buffer and return a list of expressions)
(LET (LASTC BUTLASTC)
(while (NEQ \BUFFER \ENDBUFFER) do (SETQ BUTLASTC LASTC)
(* Fill the buffer)
(BOUTCCODE STREAM (SETQ LASTC (FIRSTCHAR \BUFFER)))
(SETQ \BUFFER (TTNEXTCHAR \BUFFER)))
(COND
((AND DONTREAD (SELCHARQ FINALCHAR
(EOL (SELECTC (\SYNCODE \RDTBLSA LASTC)
((LIST RIGHTPAREN.RC RIGHTBRACKET.RC)
(COND
((OR (NULL BUTLASTC)
(EQ (\SYNCODE \RDTBLSA BUTLASTC)
ESCAPE.RC))
(* If it ended in a quoted right
paren, then it's just like any other
character)
T)
((EQ (\SYNCODE \RDTBLSA (CHARCODE %]))
RIGHTBRACKET.RC)
(* Line ended in paren.
Change to right bracket so READLINE
doesn't get confused.
Only do this if %] really is right
bracket!)
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR
STREAM)
(STREAMBYTESPERCHAR
STREAM)))
(BOUTCCODE STREAM (CHARCODE %]))
NIL)))
T))
((%) %])
NIL)
T)) (* Print FINALCHAR unless terminator
was EOL and line already ended in a
closing paren or bracket)
(BOUTCCODE STREAM FINALCHAR)))
(\SETEOFPTR STREAM (\GETFILEPTR STREAM))
(\SETFILEPTR STREAM 0)
(COND
(DONTREAD (* STREAM = \LINEBUF.OFD and caller
will take care of reading buf)
(AND (EQ STREAM \LINEBUF.OFD)
(replace (LINEBUFFER LINEBUFSTATE) of STREAM with READING.LBS))
T)
(T (* Read from buffer until it's empty)
(PROG1 (bind TERM while [AND (SKIPSEPRS STREAM RDTBL)
(SETQ TERM (NLSETQ (READ STREAM RDTBL]
collect (CAR TERM))
(\SETFILEPTR STREAM 0) (* Now clear the stream so nobody
reads extra garbage after us)
(\SETEOFPTR STREAM 0])
(TTYIN.BALANCE
[LAMBDA (ERRORFLG) (* bvm: "16-Apr-86 12:35")
(LET ((X (TTSKREAD \BUFFER)))
(PROG1 (COND
[(OR (EQ X \ENDBUFFER)
(AND X (EQ (\SYNCODE \RDTBLSA (FIRSTCHAR X))
RIGHTBRACKET.RC)
(AT.END.OF.TEXT (CDR X]
(T (COND
((AND ERRORFLG (EQ \CURSOR (OR X \ENDBUFFER)))
(* Only beep if cursor won't move)
(BEEP)))
NIL))
(MOVE.TO.WHEREVER (OR X \ENDBUFFER])
(ADDCHAR
[LAMBDA (CHAR)
(DECLARE (USEDFREE \CURSORCOL \ARROW \RMARG \CURSOR \AUTOFILL))
(* bvm: "17-Apr-85 19:42")
(* * Add CHAR to buffer and print it, advancing cursor position appropriately)
(LET ([WIDTH (COND
((COMPLEXCHARP CHAR)
(fetch CPXWIDTH of CHAR))
(T (TTBITWIDTH CHAR]
(ENDP (AT.END.OF.LINE)))
(END.DELETE.MODE)
(OVERFLOW? WIDTH)
(COND
((NOT ENDP) (* Inserting in middle of line, so
make space)
(TTINSERTSECTION WIDTH)))
(COND
((COMPLEXCHARP CHAR)
(for PC in (fetch CPXPRINTCHARS of CHAR) do (TTBOUT PC)))
(T (TTBOUT CHAR)))
(INSERT.NODE \CURSOR)
(FRPLACA \CURSOR CHAR)
(SETQ \CURSOR (CDR \CURSOR))
(add \CURSORCOL WIDTH)
[COND
(ENDP (replace END of \ARROW with \CURSOR)
(replace LASTCOL of \ARROW with \CURSORCOL)(* If we just advanced past the last
column, do autofill stuff)
(OVERFLOW? 0))
(T (* Check to see if line got shoved
beyond right margin)
(LET ((OVFL (IDIFFERENCE (add (fetch LASTCOL of \ARROW)
WIDTH)
\RMARG)))
(COND
((OR (IGREATERP OVFL 0)
(AND (EQ OVFL 0)
\AUTOFILL))
(ADJUSTLINE (AND \AUTOFILL T))
(MOVE.TO.WHEREVER \CURSOR]
NIL])
(TTMAKECOMPLEXCHAR
[LAMBDA (REALCHAR PRINTCHARS) (* bvm: "16-Apr-85 16:50")
(LET ((WIDTH 0)
(NC 0))
(for C in PRINTCHARS do (add WIDTH (TTBITWIDTH C))
(add NC 1))
(create COMPLEXCHAR
CPXREALCHAR ← REALCHAR
CPXWIDTH ← WIDTH
CPXNCHARS ← NC
CPXPRINTCHARS ← PRINTCHARS])
(ADDNAKEDCHAR
[LAMBDA (CHAR NOAUTOFILL) (* bvm: "17-Apr-85 19:46")
(* * Adds CHAR with no special processing, e.g.
most control chars (except cr and lf, which I can't figure out yet) go thru ok.)
(COND
((AND (IGREATERP CHAR 32)
(NEQ CHAR 127))
(ADDCHAR CHAR))
(T (SELCHARQ CHAR
(CR (* CR can be attempted if at end)
(COND
((AT.END.OF.BUF)
(START.NEW.LINE EOLCHARCODE))
(T (BEEP))))
(SPACE (OR (AND (NOT NOAUTOFILL)
(AUTOCR?))
(ADDCHAR (CHARCODE SPACE))))
(ESCAPE (* Altmode will echo as $)
[ADDCHAR (TTMAKECOMPLEXCHAR CHAR (LIST (CHARCODE $])
(TAB (TTADDTAB))
(ADDCHAR (TTMAKECOMPLEXCHAR CHAR (LIST (CHARCODE ↑)
(COND
((EQ CHAR (CHARCODE DEL))
(* DELETE is represented as ↑?)
(CHARCODE ?))
(T (LOGOR CHAR 64])
(TTADDTAB
[LAMBDA NIL (* bvm: "16-Apr-85 17:59")
(* Represent <tab> in buffer as a tab with 128 bit on, followed by the
appropriate number of spaces, each with 256 bit on.
Tab is always self-inserting, i.e. it never overwrites anything
(except itself, as above))
(ADDCHAR (TTMAKECOMPLEXCHAR (CHARCODE TAB)
(from (LOGAND (IQUOTIENT (IDIFFERENCE \CURSORCOL (fetch FIRSTCOL of \ARROW))
\CHARWIDTH)
7) to 7 collect (CHARCODE SPACE])
(ADJUSTLINE
[LAMBDA (JUSTIFYING LINE) (* bvm: "16-Apr-85 18:56")
(* Handles patching up lines that are too long or short.
Assures that the current line, ARROW, is correct with regard to overflows.
If JUSTIFYING is true, it is a number specifying how many lines to "justify" ,
by which we mean moving text around so that each line has as many words as
possible for the linelength, but does not overflow.
We don't do anything very fancy with that, like take care of deleting extra
spaces.)
(PROG ([IDEALLENGTH (COND
((IGREATERP TTYJUSTLENGTH 0)
(IMIN \RMARG (ITIMES TTYJUSTLENGTH \CHARWIDTH)))
(T (* Relative to right margin)
(IMAX (IDIFFERENCE \RMARG (ITIMES (IMINUS TTYJUSTLENGTH)
\CHARWIDTH))
(LRSH \RMARG 1]
BREAK LASTCOL NEWENDLINE NEXTLINE OLDENDLINE OVFL START USECR ROW #BITS)
(OR LINE (SETQ LINE \ARROW))
(SETQ ROW (fetch ROW of LINE))
LP (SETQ NEXTLINE (fetch NEXTLINE of LINE))
(SETQ OVFL (OVERFLOWLINE? LINE))
(SETQ #BITS (IDIFFERENCE \RMARG (fetch LASTCOL of LINE)))
(SETQ USECR (SETQ BREAK NIL))
(SETQ START (fetch START of LINE))
(COND
((ILESSP #BITS 0) (* Too much on line;
need to break it somewhere, preferably
at a space if permissible.
If justifying, try to break at the
appropriate length)
(COND
([OR (AND JUSTIFYING (ILESSP (IPLUS (fetch FIRSTCOL of LINE)
IDEALLENGTH)
\RMARG)
(SETQ BREAK (FIND.LINE.BREAK START (NTH.RELATIVE.COLUMN.OF LINE
IDEALLENGTH)
T)))
(PROGN (SETQ NEWENDLINE (NTH.COLUMN.OF LINE \RMARG))
(AND (OR JUSTIFYING \AUTOFILL)
(SETQ BREAK (FIND.LINE.BREAK START NEWENDLINE T]
(SETQ USECR T))
(T (SETQ BREAK NEWENDLINE)))
(GO DOBREAK))
[(AND OVFL (NEQ #BITS 0)
(NEQ (SETQ NEWENDLINE (NTH.RELATIVE.COLUMN.OF NEXTLINE #BITS))
(fetch START of NEXTLINE)))
(* Line is too short, but is an overflow line, so text MUST be moved to fill
the gap; alternatively, if we are justifying, we could break the line sooner)
(* NEWENDLINE = where the line should
end, based on linelength)
(COND
([OR (EQ (fetch END of LINE)
NEWENDLINE)
(AND (OR \AUTOFILL JUSTIFYING)
(SETQ BREAK (FIND.LINE.BREAK (fetch END of LINE)
NEWENDLINE JUSTIFYING))
(SETQ NEWENDLINE BREAK))
(NOT JUSTIFYING)
(NOT (SETQ BREAK (FIND.LINE.BREAK START (fetch END of LINE)
T]
(GO DOJOIN))
(T (SETQ USECR T)
(GO DOBREAK]
((NOT JUSTIFYING)
(RETURN))
[(OR OVFL (AND (NEQ JUSTIFYING T)
(IGREATERP (IDIFFERENCE (fetch LASTCOL of LINE)
(fetch FIRSTCOL of LINE))
IDEALLENGTH))) (* line is longer than we'd like)
(COND
((SETQ BREAK (FIND.LINE.BREAK START (NTH.RELATIVE.COLUMN.OF LINE IDEALLENGTH)
T))
(SETQ USECR T)
(GO DOBREAK]
[[AND (NOT (EMPTY.LINE LINE))
(NOT (START.OF.PARAGRAPH? NEXTLINE))
(OR (NEQ JUSTIFYING T)
(EQ (CAR (fetch END of LINE))
(CHARCODE SPACE] (* Don't move up text from next line
if it is blank or starts with tab --
treat those as paragraph breaks)
(* Note that we are guaranteed at this point that LINE is not an overflow line,
so (fetch END of LINE) points at a space or cr)
(COND
((OR (EQ [SETQ BREAK (NTH.RELATIVE.COLUMN.OF
NEXTLINE
(SUB1 (IMIN (IDIFFERENCE (IPLUS IDEALLENGTH
(fetch FIRSTCOL of LINE))
(fetch LASTCOL of LINE))
#BITS]
(fetch END of NEXTLINE))
(SETQ BREAK (FIND.LINE.BREAK (fetch START of NEXTLINE)
BREAK T)))
(SETQ NEWENDLINE BREAK) (* At least one more word from next
line will fit up here)
(GO DOJOIN))
(T (* No text movement, but if line ended
in a real <cr>, make it a space)
(FRPLACA (fetch END of LINE)
(CHARCODE SPACE]
((EQ JUSTIFYING T) (* If this line is fine, quit)
))
(SETQ LINE NEXTLINE)
(GO BOTTOM)
DOJOIN
(* * Move text from next line up to this one.
NEWENDLINE is where line should end when done.
BREAK=NEWENDLINE if this new end line is a pseudo-cr break)
(COND
((EQ (SETQ OLDENDLINE (fetch END of LINE))
NEWENDLINE)
(SETQ #BITS 0))
(T (GO.TO.RELATIVE (fetch LASTCOL of LINE)
ROW)
(SETQ #BITS (SEGMENT.BIT.LENGTH OLDENDLINE NEWENDLINE))
(* # chars to delete from next line)
[COND
((NOT OVFL) (* Joining toa non-overflow line: turn
its cr into a space)
(FRPLACA OLDENDLINE (CHARCODE SPACE))
(while (AND (NEQ (CDR OLDENDLINE)
NEWENDLINE)
(EQ (CADR OLDENDLINE)
(CHARCODE SPACE))) do (* strip leading spaces from next line)
(KILLSEGMENT OLDENDLINE (CDR OLDENDLINE)))
(COND
((EQ (CAR (NLEFT (fetch START of LINE)
1 OLDENDLINE))
(CHARCODE %.)) (* LINE ends in period, so space twice)
(FRPLACA (INSERT.NODE OLDENDLINE)
(CHARCODE SPACE]
(TYPE.BUFFER OLDENDLINE NEWENDLINE)
(replace END of LINE with NEWENDLINE)
(replace LASTCOL of LINE with \CURSORCOL)))
(GO.TO.RELATIVE (QUOTE LINE)
NEXTLINE)
(replace START of NEXTLINE with (COND
(BREAK (FRPLACA BREAK (CHARCODE SPACE))
(* In case BREAK was at the CR turn it
into space)
(COND
(OVFL (add #BITS (TTBITWIDTH (CHARCODE SPACE))
)
(* will delete space also)
))
(CDR NEWENDLINE))
(T NEWENDLINE)))
(COND
((EQ (fetch END of NEXTLINE)
NEWENDLINE)
(DELETELINE NEXTLINE T) (* Nothing left here, so kill it)
[COND
(JUSTIFYING (* maybe we can move from next line,
too)
(COND
((AND (NEQ JUSTIFYING T)
(NEQ (SUB1VAR JUSTIFYING)
0))
(GO LP))
(T (RETURN]
(SETQ LINE (fetch NEXTLINE of LINE)))
(T (TTDELSECTION #BITS)
(replace LASTCOL of NEXTLINE with (IDIFFERENCE (fetch LASTCOL of NEXTLINE)
#BITS))
(SETQ LINE NEXTLINE)))
(GO BOTTOM)
DOBREAK
(* Break line at BREAK, moving excess down to next line or a new line.
USECR is true if break is to act like a cr;
otherwise we are breaking a too-long line at the right margin, so there is no
end of line place holder)
[replace LASTCOL of LINE with (SETQ LASTCOL (IPLUS (SEGMENT.BIT.LENGTH (fetch START
of LINE)
BREAK)
(fetch FIRSTCOL of LINE]
(* Column where break will occur)
[SETQ #BITS (SEGMENT.BIT.LENGTH BREAK (SETQ OLDENDLINE (fetch END of LINE]
(* length of segment being moved)
(COND
((NEQ LASTCOL \RMARG)
(GO.TO.RELATIVE LASTCOL ROW) (* Go wipe out what was there.
Don't need to do this if the break is
right at the margin)
(ERASE.TO.END.OF.LINE)))
(replace END of LINE with BREAK)
[COND
(USECR (* we have counted one char too many
above...)
[SETQ #BITS (IDIFFERENCE #BITS (TTBITWIDTH (CHARCODE SPACE]
(SETQ BREAK (CDR BREAK]
(COND
[[AND NEXTLINE (OR OVFL (AND (OR (SMALLP JUSTIFYING)
(AND (EQ (CAR OLDENDLINE)
(CHARCODE SPACE))
(ILESSP (IPLUS (fetch LASTCOL of NEXTLINE)
#BITS)
\RMARG)))
(NOT (START.OF.PARAGRAPH? NEXTLINE]
(* Insert the text on the next line, rather than starting new line, if
justifying, overflow (forced), or the text will fit, i.e.
not cause anything to be bumped off the next line)
(GO.TO.RELATIVE (QUOTE LINE)
(SETQ LINE NEXTLINE))
(COND
((NOT OVFL) (* Turn the terminating <cr> into
ordinary space; this space also needs
to be inserted and counted, of course)
(add #BITS (TTBITWIDTH (CHARCODE SPACE)))
(SETQ OLDENDLINE (CDR (FRPLACA OLDENDLINE (CHARCODE SPACE]
(T (SETQ LINE (INSERTLINE LINE))
(replace END of LINE with OLDENDLINE)))
(replace START of LINE with BREAK)
(INSERT.TEXT BREAK OLDENDLINE (fetch END of LINE))
(add (fetch LASTCOL of LINE)
#BITS)
BOTTOM
(COND
(LINE (ADD1VAR ROW)
(COND
((AND JUSTIFYING (NEQ JUSTIFYING T)
(EQ (SUB1VAR JUSTIFYING)
0))
(SETQ JUSTIFYING NIL)))
(GO LP])
(ADJUSTLINE.AND.RESTORE
[LAMBDA (JUSTIFYING) (* bvm: "19-MAR-81 11:55")
(SAVE.CURSOR)
(ADJUSTLINE JUSTIFYING)
(COND
((IGREATERP \HOMECOL (fetch LASTCOL of \ARROW)) (* Oops, cursor must have moved)
(MOVE.TO.WHEREVER \CURSOR))
(T (RESTORE.CURSOR])
(AT.END.OF.SCREEN
[LAMBDA NIL (* bvm: "11-Apr-85 14:58")
(OR (AT.END.OF.LINE)
(IGREATERP (IPLUS \CURSORCOL (SEGMENT.LENGTH \CURSOR (TTNEXTCHAR \CURSOR))
\CHARWIDTH)
\RMARG])
(AT.END.OF.TEXT
[LAMBDA (BUF) (* bvm: "11-Apr-85 15:00")
(* Checks that this is the last printing char in buffer.
Fancier than just checking that BUF = ENDBUFFER, since that would mess up if
user deletes a line and decides to terminate on previous line)
(for (X ← BUF) by (TTNEXTCHAR X) until (EQ X \ENDBUFFER) always (SPACEP (FIRSTCHAR X])
(AUTOCR?
[LAMBDA NIL (* bvm: "16-Apr-85 18:57")
(* Terminates line if near edge of
screen and in autofill mode)
(COND
((AND \AUTOFILL (IGREATERP (IPLUS \CURSORCOL TTYINAUTOFILLMARGIN)
\RMARG))
[COND
((AT.END.OF.LINE)
(START.NEW.LINE (CHARCODE SPACE)))
(T (BREAKLINE (CHARCODE SPACE]
T])
(BACKSKREAD
[LAMBDA (BUF NOTIFQUOTED) (* bvm: "15-Apr-86 23:04")
(* Returns buffer position of start of list containing cursor position BUF, or
start of buffer. If NOTIFQUOTED is true, then returns NIL if the paren/bracket
at BUF is quoted with the escape char or is inside a string.
Strategy: start at beginning of buffer and TTSKREAD forward
(much easier); if read ends at BUF, we win;
if ends before BUF, then resume reading there
(we skipped an internal list); otherwise if read did not end, BUF must be
inside a list, so scan ahead for start of an inner list, and repeat)
(PROG ((B \BUFFER)
(INNERMOSTLIST \BUFFER)
ESCAPED BRACKETFLG X)
LP [COND
((EQ B BUF) (* No list in buffer at all)
(RETURN (AND (OR (NOT NOTIFQUOTED)
(NOT ESCAPED))
INNERMOSTLIST]
[SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR B))
((LIST LEFTPAREN.RC LEFTBRACKET.RC)
(* open paren or bracket.
Try scanning this new internal list)
[COND
(ESCAPED (* Inside a multiple escape))
((EQ (SETQ X (TTSKREAD (CDR B)
BUF))
BUF)
(RETURN (OR BRACKETFLG B)))
(X (* Skip over internal list just
scanned)
(SETQ B X))
(T (* The TTSKREAD failed, so BUF must be
at least this deeply nested.
Save pointer here in case we abort
inside a string or such)
(SETQ INNERMOSTLIST B)
(COND
((AND (EQ (CAR B)
(CHARCODE %[))
(EQ (CAR BUF)
(CHARCODE %]))) (* Brackets may match;
save position of this open bracket.
Otherwise we'll return the innermost
list, rather than the start of the
bracket expression)
(SETQ BRACKETFLG B])
(ESCAPE.RC (* % to quote the next char)
[COND
((EQ (CDR B)
BUF) (* The char at BUF is quoted.
This is why TTSKREAD failed here.
Just return the list we're now inside)
(RETURN (AND (NOT NOTIFQUOTED)
INNERMOSTLIST)))
(T (* skip over escape char)
(SETQ B (CDR B])
(STRINGDELIM.RC
(* double-quote)
[COND
([AND (NOT ESCAPED)
(NOT (SETQ B (FIND.MATCHING.QUOTE (CDR B)
BUF] (* Termination analogous to previous
case)
(RETURN (AND (NOT NOTIFQUOTED)
INNERMOSTLIST])
(MULTIPLE-ESCAPE.RC
(SETQ ESCAPED (NOT ESCAPED)))
(OTHER.RC NIL)
(PROGN (COND
((AND (EQ (CAR B)
(CHARCODE ;))
(READTABLEPROP RDTBL (QUOTE COMMONLISP)))
(* Handle semicolon special)
(COND
([do (SETQ B (CDR B))
(COND
((EQ B BUF)
(RETURN T))
((EQ (FIRSTCHAR B)
(CHARCODE EOL))
(RETURN] (* Done inside a comment)
(RETURN (AND (NOT NOTIFQUOTED)
INNERMOSTLIST]
(SETQ B (CDR B))
(GO LP])
(BACKWARD.DELETE.TO
[LAMBDA (BUF) (* bvm: "19-MAR-81 11:55")
(FORWARD.DELETE.TO (PROG1 \CURSOR (MOVE.BACK.TO BUF])
(BREAKLINE
[LAMBDA (USECR STAY)
(DECLARE (USEDFREE \CURSOR \ARROW \CURSORCOL \CURSOR)) (* bvm: "16-SEP-82 11:52")
(* * Break current line at \CURSOR position, inserting a suitable <cr> if USECR
is given. If STAY is true, \CURSOR does not move;
otherwise cursor moves to first position of new line.)
(PROG ((OLDLINE \ARROW)
(OLDEND (fetch END of \ARROW)))
(replace END of \ARROW with \CURSOR) (* terminate current line at \CURSOR
position)
(replace LASTCOL of \ARROW with \CURSORCOL)
(ERASE.TO.END.OF.LINE)
(COND
(STAY (SAVE.CURSOR)))
(SETQ \ARROW (INSERTLINE \ARROW USECR))
(COND
((NOT STAY)
(SAVE.CURSOR)))
(replace END of \ARROW with OLDEND)
[COND
[(EQ \CURSOR OLDEND) (* cr was inserted at end of line.
Maybe this never happens)
(replace END of \ARROW with (SETQ \CURSOR (CDR OLDEND]
(T (TYPE.BUFFER (SETQ \CURSOR (fetch START of \ARROW))
OLDEND) (* Restore to screen what we erased
above)
(replace LASTCOL of \ARROW with \CURSORCOL)
(COND
((OVERFLOWLINE? \ARROW) (* the previous line overflowed, but
when we inserted a cr we added more
space on the line, so go fix it up)
(ADJUSTLINE]
[COND
(STAY (* Oh well, undo what we did to poor
\CURSOR)
(SETQ \CURSOR (fetch END of (SETQ \ARROW OLDLINE]
(RESTORE.CURSOR])
(BUFTAILP
[LAMBDA (TAIL START END) (* bvm: "23-JUN-81 15:48")
(do (COND
((EQ TAIL START)
(RETURN TAIL))
((OR (NOT START)
(EQ START END))
(RETURN)))
(SETQ START (CDR START])
(CHECK.MARGIN
[LAMBDA (BUF LINE) (* bvm: " 1-JUN-82 17:09")
(* * If BUF is the pseudo-cr at the end of this LINE, then back it up one,
since you can't let the cursor sit on it)
(COND
((AND (EQ (fetch END of LINE)
BUF)
(OR (EQ (fetch LASTCOL of LINE)
\RMARG)
(EQ (fetch START of (fetch NEXTLINE of LINE))
BUF)))
(TTNLEFT BUF 1 (fetch START of LINE)))
(T BUF])
(CLEAR.LINE?
[LAMBDA (FLG) (* bvm: "15-JUN-82 17:49")
(* If FLG true, erase lots)
(COND
((CAPABILITY? ERASE.TO.END)
(COND
(FLG (ERASE.TO.END.OF.PAGE))
(T (ERASE.TO.END.OF.LINE])
(CURRENT.WORD
[LAMBDA NIL (* bvm: "16-Apr-86 16:05")
(* Used by word-completion routines. Returns position in buffer of the start of
the current word, or NIL if no word is in progress, or \COMMAND is true and
this is not the first word, or the line is a comment.
Definition of "word" here is different from that of WORDSEPRP since we want
only words with respect to the reader, not with respect to text)
(COND
((AND (NOT (AT.START.OF.LINE))
(NEQ (CAR (fetch START of \ARROW))
TTYINCOMMENTCHAR))
(for (X ← (fetch START of \ARROW)) by (TTNEXTCHAR X) until (EQ X \CURSOR)
bind (NEW ← T)
SNX do (* NEW is true after we scan a break
character)
(SETQ SNX (\SYNCODE \RDTBLSA (FIRSTCHAR X)))
(COND
((COND
(NEW (* ANY funny character at start of
word considered sepr)
(NEQ SNX OTHER.RC))
(T (* If in middle of word, only
"terminating macros" stop word)
(fetch STOPATOM of SNX)))
(SETQ NEW T))
(NEW (* This is the start of a new word;
note it)
(COND
((AND $$VAL \COMMAND) (* Means this is second word)
(RETURN)))
(SETQ $$VAL X)
(SETQ NEW NIL))) finally (RETURN (AND (NOT NEW)
$$VAL])
(DELETE.TO.END
[LAMBDA NIL (* bvm: "19-MAR-81 11:56")
(* * Kills buffer from \CURSOR onward)
(SETTAIL? T)
(COND
(DISPLAYTERMFLG (ERASE.TO.END.OF.PAGE)))
(COND
((fetch NEXTLINE of \ARROW) (* There are lines after this, so
return them to garbage heap)
(KILL.LINES (fetch NEXTLINE of \ARROW))
(replace NEXTLINE of \ARROW with NIL)))
(replace END of \ARROW with (SETQ \ENDBUFFER \CURSOR))
(replace LASTCOL of \ARROW with \CURSORCOL])
(DELETELINE
[LAMBDA (LINE EMPTYLINE?) (* bvm: "20-FEB-82 22:20")
(* Deletes this LINE from buffer and screen;
assumes cursor is currently positioned somewhere on the line.
EMPTYLINE? is true on calls from ADJUSTLINE where the line is naked and hence
no text in the buffer needs to be killed.)
(PROG ((NEXTLINE (fetch NEXTLINE of LINE))
OLDSTART NEWSTART PREVLINE)
[COND
((AND (EQ LINE \ARROW)
(ON.FIRST.LINE))
(COND
((NOT NEXTLINE) (* Can't delete the only line)
(RETURN (BEEP)))
((NEQ \PROMPT1 \PROMPT2) (* tricky to delete first line, since
the correct prompt should be displayed)
(MOVE.BACK.TO \BUFFER)
(RETURN (FORWARD.DELETE.TO (fetch END of \ARROW]
(COND
(DISPLAYTERMFLG (DO.DELETE.LINES 1)))
(RENUMBER.LINES NEXTLINE (fetch ROW of LINE))
(replace NEXTLINE of (SETQ PREVLINE (PREVLINE LINE 1)) with NEXTLINE)
[COND
((NOT NEXTLINE) (* deleting last line: need to worry
about \ENDBUFFER and such)
(SETQ \ENDBUFFER (fetch END of PREVLINE)))
(T (replace NEXTLINE of LINE with NIL) (* in preparation for KILL.LINES below)
(COND
((NOT EMPTYLINE?)
(KILLSEGMENT (SETQ OLDSTART (fetch START of LINE))
(SETQ NEWSTART (fetch START of NEXTLINE)))
(* flush anything on the line.
PREVLINE pointers remain valid)
(COND
((EQ (fetch END of NEXTLINE)
NEWSTART)
(replace END of NEXTLINE with OLDSTART)))
(replace START of NEXTLINE with OLDSTART]
(KILL.LINES LINE) (* return to heap)
(COND
((EQ \ARROW LINE) (* if this is our home position,
adjust appropriately)
(SETQ \ARROW (SETQ LINE (OR NEXTLINE PREVLINE)))
(SETQ \CURSOR (fetch START of LINE))
(GO.TO.RELATIVE (QUOTE LINE)
LINE])
(DELETETO
[LAMBDA (TAIL) (* bvm: " 6-OCT-83 15:33")
(SETTAIL?)
(COND
((NEQ \CURSOR \ENDBUFFER) (* On other terminals also when Cursor
capable)
(BACKWARD.DELETE.TO TAIL))
(T [COND
[(NOT DISPLAYTERMFLG)
(COND
((NOT \DELETING) (* prefix deletions with backslash)
(COND
((NOT TTYINBSFLG) (* unless we are going to physically
backspace)
(TTBOUT \)))
(SETQ \DELETING 0)))
(DELETETO1 TAIL)
(COND
((EQ TAIL \BUFFER)
(END.DELETE.MODE]
(T (PROG ((N (SEGMENT.BIT.LENGTH TAIL \ENDBUFFER)))
(* need to kill the previous N chars)
(* (COND ((CAPABILITY? ERASE.TO.END T) (* Ah, all we need do is go back N and
erase to end) (DO.BACK N) (ERASE.TO.END.OF.LINE))
(T (* laborious technique for glass ttys: go back and wipe out each char one at
a time) (FRPTQ N (PROGN (DO.BACK 1) (* back up)
(TTBOUT SPACE) (* overwrite with space) (DO.BACK 1)
(* and back up again))))))
(DSPBACKUP N \DSP)
(SETQ \CURSORCOL (IDIFFERENCE \CURSORCOL N]
(replace END of \ARROW with (SETQ \CURSOR (SETQ \ENDBUFFER TAIL)))
(replace LASTCOL of \ARROW with \CURSORCOL])
(DELETETO1
[LAMBDA (TAIL) (* bvm: "16-Apr-85 16:58")
(* * Not used in Interlisp-D)
(* * on non-DMs: delete chars until we reach TAIL;
since we echo deleted chars in reverse order, this is most easily done
recursively)
[COND
((NEQ (CDR TAIL)
\ENDBUFFER)
(DELETETO1 (CDR TAIL]
(for CH inside (COND
((COMPLEXCHARP (CAR TAIL))
(fetch CPXPRINTCHARS of (CAR TAIL)))
(T (CAR TAIL))) do (SELECTQ TTYINBSFLG
(NIL (TTBOUT CH))
(LF
(* physically backspace, crossing out character.
LF means we will do a LF when ENDELETE happens.
If we don't LF, then best not to cross out chars)
(TTBOUT BS \ BS)
(ADD1VAR \DELETING))
(TTBOUT BS))) (* echo deleted char)
(SETQ \CURSORCOL (SUB1 \CURSORCOL])
(DO.EDIT.COMMAND
[LAMBDA (CHAR EDITARG) (* bvm: "18-Apr-85 14:31")
(* * Handles the various edit commands, which mostly move the cursor around in
the buffer, or kill pieces of it. CHAR is the character stripped of its
editbit. EDITARG is the argument, if any
(not set by type-in, but by program asking for a particular edit function)%.
If this routine returns something, it means process it like ordinary character
(this is how we can invoke non-editbit routines))
(PROG (EDITMINUS L X LASTSKIP)
[COND
((NOT EDITARG)
(SETQ EDITARG 1))
((MINUSP EDITARG)
(SETQ EDITMINUS T)
(SETQ EDITARG (IMINUS EDITARG]
LP [SELCHARQ (SETQ CHAR (U-CASECODE CHAR))
(CR
(* <edit>CR on empty buffer means get back last buffer;
in the middle of a buffer it is the same as normal CR, but also ends insert
mode)
[COND
((EMPTY.BUFFER)
(RESTOREBUF))
((ON.LAST.LINE)
(RETURN CHAR))
(T (MOVE.TO.LINE (TTNEXTLINE \ARROW EDITARG])
((SPACE >)
(* move right)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE DEL)) (* backward space is delete)
(GO NOMINUS))
((AT.END.OF.BUF)
(BEEP))
((AT.END.OF.SCREEN)
(MOVE.TO.NEXT.LINE))
(T (MOVE.FORWARD.TO (TTNTH \CURSOR EDITARG])
((DEL ↑A BS <)
(* back up)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE SPACE))
(* backward delete is space)
(GO NOMINUS))
((AT.START.OF.BUF)
(BEEP))
((AT.START.OF.LINE)
(MOVE.TO.LINE (SETQ X (PREVLINE \ARROW 1))
(fetch END of X)))
(T (MOVE.BACK.TO (TTNLEFT \CURSOR EDITARG])
(%( (* backs up one word)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE %)))
(GO NOMINUS))
(T (MOVE.BACK.TO (PREVWORD \CURSOR EDITARG])
(%) (* moves ahead one word)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE %())
(GO NOMINUS))
((AT.END.OF.SCREEN)
(BEEP))
(T (MOVE.FORWARD.TO (FIND.NEXT.WORD \CURSOR EDITARG])
(TAB (* go to end of line)
(MOVE.TO.LINE (SETQ X (TTNEXTLINE \ARROW (SUB1VAR EDITARG)))
(fetch END of X)))
(↑L (* go to start of line)
(MOVE.TO.LINE (PREVLINE \ARROW (SUB1VAR EDITARG))))
({ (* { goes to start of buffer, like
infinite FF)
(MOVE.TO.LINE \FIRSTLINE))
(} (* } goes to end of buffer, like
infinite TAB)
(MOVE.TO.LINE (SETQ X (TTLASTLINE))
(fetch END of X)))
(LF (* moves down)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE ↑))
(GO NOMINUS))
[(ON.LAST.LINE)
(COND
((EMPTY.BUFFER) (* Treat this the same as regular
linefeed, i.e. restore buffer)
(RETURN (CHARCODE LF)))
(T (BEEP]
(T (MOVE.TO.LINE (SETQ X (TTNEXTLINE \ARROW EDITARG))
(NTH.COLUMN.OF X (EDITCOLUMN])
(↑ (* moves up)
[COND
(EDITMINUS (SETQ CHAR (CHARCODE LF))
(GO NOMINUS))
((ON.FIRST.LINE)
(BEEP))
(T (MOVE.TO.LINE (SETQ X (PREVLINE \ARROW (IMIN (IPLUS \LOC.ROW.0 \CURSORROW)
EDITARG)))
(NTH.COLUMN.OF X (EDITCOLUMN])
(K (* kills one char)
[COND
((AT.END.OF.LINE)
(BEEP))
(T (FORWARD.DELETE.TO (TTNTH \CURSOR EDITARG])
((S Z B)
(* various skip or zap commands)
(SKIP/ZAP CHAR (TTBIN T)
EDITARG EDITMINUS))
(A (* repeat last S or Z)
(COND
((SETQ LASTSKIP (fetch LASTSKIP of \TTYINSTATE))
(SKIP/ZAP LASTSKIP (fetch LASTSKIPCHAR of \TTYINSTATE)
EDITARG EDITMINUS))
(T (BEEP))))
(L (* lowercase word)
(U/L-CASE EDITARG))
(U (* uppercase word)
(U/L-CASE EDITARG T))
(C (* capitalize word)
(U/L-CASE EDITARG 1))
(G (* grab a copy of Nth previous line)
(COND
((OR (ON.FIRST.LINE)
(NOT (AT.END.OF.LINE))
(EQ (SETQ X (NTH.COLUMN.OF (SETQ L (PREVLINE \ARROW EDITARG))
\CURSORCOL))
(fetch END of L))) (* nothing to copy)
(BEEP))
(T (READFROMBUF X (fetch END of L)
T))))
(%] (* Move to end of current expression)
[COND
((AT.END.OF.BUF)
(BEEP))
(T (MOVE.TO.WHEREVER (OR (TTSKREAD (TTNEXTCHAR \CURSOR))
\ENDBUFFER])
(%[ (* Move to start of current list
expression)
[COND
((AT.START.OF.BUF)
(BEEP))
(T (MOVE.TO.WHEREVER (BACKSKREAD \CURSOR])
(↑W (* delete back to start of current
word)
(TTDELETEWORD EDITARG))
(D (* Delete forward to end of word)
(COND
((AT.END.OF.LINE)
(BEEP))
(T (COND
((AND (NEQ (SETQ X (FIND.NEXT.WORD \CURSOR EDITARG T))
(fetch END of \ARROW))
(NOT (AT.START.OF.LINE))
[NOT (WORDSEPRP (FIRSTCHAR (TTNLEFT \CURSOR 1]
[SPACEP (FIRSTCHAR (SETQ L (TTNLEFT X 1 \CURSOR]
(NEQ L \CURSOR))
(* Don't want to delete all the way to start of new word, since we'd like a
little space in between. Simulating EMACS would probably be easier if we just
made FIND.NEXT.WORD stop at the intervening spaces rather than at the end)
(SETQ X L)))
(FORWARD.DELETE.TO X))))
((↑Q ↑U)
(* Delete line; ↑U for tops20 folk)
(COND
((EQ EDITARG 1000)
(DELETE.TO.END))
(T (DELETELINE \ARROW))))
(↑Y (* gets userexec)
(COND
((AND (EQ EDITARG 1000)
(NEQ \CURSOR \ENDBUFFER))
(TTUNREADBUF) (* Stuff what's ahead of cursor into
input buffer)
))
(RETURN CHAR))
(F (* accept tvedit's $$F to finish)
(COND
[(EQ EDITARG 1000)
(MOVE.TO.WHEREVER \ENDBUFFER)
(COND
((NEQ \CURSOR \ENDBUFFER) (* This is because the cursor mover
refuses to put me in column 80 of a
line, due to certain anomalies)
(add \CURSORCOL (SEGMENT.BIT.LENGTH \CURSOR \ENDBUFFER))
(SETQ \CURSOR \ENDBUFFER)
(OVERFLOW? 0)))
(RETURN (COND
(\REPEAT (* End with ↑Z)
(CHARCODE ↑Z))
(\READING (* End read with "]" ;
of course, this doesn't always "finish"
, but it's simple enough to remember
what this is)
(CHARCODE %]))
(T (CHARCODE CR]
(T (BEEP))))
(J (* Justify/fill line)
(ADJUSTLINE.AND.RESTORE EDITARG))
(- (* minus sign negates arg)
(SETQ EDITARG 0)
(SETQ EDITMINUS T)
(GO DONUMBERS))
(ESCAPE (* ESCAPE may modify next command)
[COND
((AND (EQ EDITARG 1000)
(EQ EDITPREFIXCHAR (CHARCODE ESCAPE)))
(* 3 escapes in a row is the way to
type a regular Escape when Escape is
the edit prefix. Better ways might be
forthcoming)
(RETURN (CHARCODE ESCAPE]
(SETQ EDITARG 1000) (* 1000 is an adequate infinity for
these purposes)
(SETQ EDITMINUS)
(SETQ CHAR (TTBIN T))
(GO LP))
((N ↑R)
(* refresh n lines, or whole buffer
for $$N)
[COND
((EQ EDITARG 1000)
(RETYPE.BUFFER \FIRSTLINE T))
(EDITMINUS (RETYPE.BUFFER (PREVLINE \ARROW EDITARG)
\ARROW))
(T (RETYPE.BUFFER \ARROW (TTNEXTLINE \ARROW EDITARG])
(T (* transpose chars. If at end of line,
do preceding two, else do the ones
before and after the cursor.)
[SETQ L (TTNLEFT \CURSOR (SETQ X (COND
((AT.END.OF.LINE)
2)
(T 1] (* start of swap)
[COND
((OR (EQ L \CURSOR)
(COMPLEXCHARP (CAR L))
(AND (EQ X 2)
(EQ (CDR L)
\CURSOR))
(COMPLEXCHARP (CADR L))) (* Complain if not enough chars to
swap, or one of them is a funny
multiple char (I'm lazy))
(BEEP))
(T [GO.TO.RELATIVE (IDIFFERENCE \CURSORCOL (SEGMENT.BIT.LENGTH
L
(NTH L (ADD1 X]
(* Back up to start of segment)
[FRPLACA L (PROG1 (CADR L)
(FRPLACA (CDR L)
(CAR L] (* Do the swap in the buffer)
(TYPE.BUFFER L (CDDR L)) (* Fix the display)
(COND
((EQ X 1) (* Were between two chars, so get back
there)
(GO.TO.RELATIVE (IDIFFERENCE \CURSORCOL (TTBITWIDTH (FIRSTCHAR
(CDR L])
(O (* Open line, i.e. insert <cr> but
stay here)
(BREAKLINE EOLCHARCODE T))
(← (* Special hack: says to add the word
before the cursor to USERWORDS, so I
can use altmode completion on it)
(COND
[(AND TTYINCOMPLETEFLG (SETQ X (CURRENT.WORD))
[SETQ X (PROG ((\BUFFER X))
(RETURN (TTRATOM]
(LITATOM X))
(COND
((EQ EDITARG 0) (* Means to remove! I don't know if
there's an "official" way to do this)
(DREMOVE X USERWORDS))
(T (ADDSPELL X 0]
(T (BEEP))))
(P (DO.EDIT.PP))
(COND
((SETQ CHAR (EDITNUMBERP CHAR))
(SETQ EDITARG CHAR)
(GO DONUMBERS))
(T (BEEP]
(SETQ \LASTCHAR CHAR)
(RETURN)
NOMINUS
(SETQ EDITMINUS)
(GO LP)
DONUMBERS
(* * scanning a numeric arg. EDITARG is its magnitude;
EDITMINUS set if negative. <edit>escape is treated as 1000, which is probably
big enough. Doesn't matter if any of the next chars has edit bit on, since once
we start a number, any other digits must be part of it, since numbers aren't
themselves commands)
(COND
([SETQ X (EDITNUMBERP (SETQ CHAR (TTBIN T]
[SETQ EDITARG (COND
((IGREATERP EDITARG 100) (* Limit numeric args to 1000 so small
number stuff works)
1000)
(T (IPLUS (ITIMES EDITARG 10)
X]
(GO DONUMBERS)))
(COND
((AND EDITMINUS (EQ EDITARG 0)) (* Happens if we get a "-" followed by
no number)
(SETQ EDITARG 1)))
(GO LP])
(DO.EDIT.PP
[LAMBDA NIL (* bvm: "15-Apr-85 15:05")
(COND
[\READING (PROG (LEFTOVER EXPRS (\BUFFER \BUFFER))
[COND
((NOT (TTYIN.BALANCE))
(COND
((NEQ \CURSOR \ENDBUFFER)
(SETQ LEFTOVER (COPY.SEGMENT \CURSOR \ENDBUFFER))
(SETQ \ENDBUFFER \CURSOR]
(SETQ \CURSOR \BUFFER)
[COND
((NEQ (TTSKIPSEPR)
\ENDBUFFER)
(SETQ EXPRS (CAR (OR (NLSETQ (TTYIN.READ 0 NIL (TTYIN.SCRATCHFILE)))
(PROGN (* Read failed, punt)
(TTYIN.BALANCE)
(RETURN (BEEP]
(MOVE.TO.LINE \FIRSTLINE)
(ERASE.TO.END.OF.PAGE)
(TTYIN1RESTART)
(replace FIRSTCOL of \ARROW with (replace LASTCOL of \ARROW with \CURSORCOL))
[COND
(EXPRS (TTLOADBUF (LIST HISTSTR1 (TTYIN.PPTOFILE EXPRS]
(COND
(LEFTOVER (BREAKLINE (CHARCODE EOL))
(READFROMBUF LEFTOVER]
(T (RETYPE.BUFFER \FIRSTLINE T])
(DO?CMD
[LAMBDA (CMD \?TAIL)
(DECLARE (SPECVARS \?TAIL \?PARAMS \BUFFER)) (* bvm: "16-Apr-86 15:36")
(* * Handles "read macros" ? and ?=. CMD is one of those.
Returns NIL if thinks it isn't. Saves current cursor location for later
restoration)
(PROG ((\BUFFER \BUFFER)
(START (BACKSKREAD \CURSOR))
FN FNSTART FNEND SPTAIL SAVE)
(SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR START))
((LIST LEFTPAREN.RC LEFTBRACKET.RC)
(COND
((AND (EQ (SCANFORWARD (CAR START)
(SETQ FNSTART \BUFFER))
START)
(PROGN (* START is the first paren in buffer,
so check and see if there's an atom
before it)
(SETQ FN (TTRATOM))
[COND
((OR (EQ FN (QUOTE E))
(AND (EQ \PROMPT1 (QUOTE *))
(FMEMB FN EDITCOMSL)))
(* What looks like a fn in apply
format is really a command, either E
or an editor command)
(SETQ FNSTART \BUFFER)
(SETQ FN (TTRATOM]
(SETQ FNEND \BUFFER)
(EQ (TTSKIPSEPR)
START))) (* This is first list on line,
preceded by FN in evalqt format)
)
(T (SETQ FNSTART (SETQ \BUFFER (CDR START)))
(* EVAL form: read fn)
(COND
((EQ (SETQ FN (TTRATOM))
CMD) (* Hasn't typed the fn name yet!)
(RETURN)))
(SETQ FNEND \BUFFER))))
(PROGN (* Not inside a list now, so no macro)
(RETURN)))
(SAVE.CURSOR)
(COND
[(NLSETQ (PROG ((\?PARAMS null)
STUFF)
(COND
((EQ CMD (QUOTE ?))
(XHELPSYS FN))
(T (GO.TO.FREELINE)
[COND
((EQ \BUFFER START) (* Apply format, skip over paren)
(SETQ \BUFFER (CDR START]
(COND
([OR (NOT TTYIN?=FN)
(NOT (SETQ STUFF (APPLY* TTYIN?=FN FN]
[SETQ STUFF (SMARTARGLIST FN T (SETQ SPTAIL (CONS FN]
(COND
((NEQ FN (SETQ FN (CAR SPTAIL)))
(* Fn was spelling corrected, so There
was an extra crlf involved in printing
the correction)
(TTCRLF.ACCOUNT))
(T (SETQ SPTAIL NIL)))
(TTYIN.PRINTARGS FN STUFF T))
((EQ (CAR (LISTP STUFF))
(QUOTE ARGS))
(TTYIN.PRINTARGS FN (CDR STUFF)
T))
((LISTP STUFF)
(TTPRIN2 STUFF))
((NEQ STUFF T)
(TTPRIN1 STUFF]
((BEEP) (* error occurred, probably undefined
fn.)
))
(SELECTQ CMD
(? (* now delete the ?)
(TTRUBOUT))
(?= (COND
[(CAPABILITY? MOVEMENT)
(RESTORE.CURSOR)
(BACKWARD.DELETE.TO \?TAIL)
(COND
(SPTAIL (* Fn was spelling corrected, so
replace it. There was also an extra
crlf involved in printing the
correction)
(SETQ SAVE \CURSOR)
(MOVE.TO.WHEREVER FNEND)
(BACKWARD.DELETE.TO FNSTART)
(READFROMBUF (CHCON FN))
(MOVE.TO.WHEREVER SAVE]
(T (BACKWARD.DELETE.TO \?TAIL) (* Delete BEFORE retyping, since we
can't erase ?= as above)
(RETYPE.BUFFER \ARROW))))
NIL)
(RETURN T])
(TTYIN.PRINTARGS
[LAMBDA (FN ARGS ACTUALS ARGTYPE) (* bvm: " 6-OCT-83 15:46")
(PROG (TYPE) (* Prints args to fn, mastching up
with ACTUALS, if supplied.
Do this in a way that lets us keep
track of where we are)
(TTPRIN1 (SELECTQ (SYSTEMTYPE)
(D (QUOTE %())
(QUOTE %[)))
(DSPFONT (PROG1 (DSPFONT [CDR (COND
((EQ (CAR TTYINBOLDFONT)
\FONT)
TTYINBOLDFONT)
(T (\SET.TTYINBOLDFONT \FONT]
\DSP) (* Make fn name boldface)
(TTPRIN1 FN))
\DSP)
[COND
((NOT ARGS))
((NLISTP ARGS)
(TTPRIN1 (QUOTE % ))
(TTPRIN1 ARGS)
(TTPRIN1 (QUOTE ...)))
(T [COND
((COND
((EQ ACTUALS T)
(SETQ ACTUALS (TTYIN.READ?=ARGS)))
(T ACTUALS))
[COND
((CDR ACTUALS)
(TTCRLF))
(T (TTPRIN1 (QUOTE % ]
(while ACTUALS do [TTPRIN2 (COND
(ARGS (OR (CAR (LISTP ARGS))
ARGS))
(T (QUOTE extra]
(TTPRIN1 " = ")
[COND
((LISTP ARGS)
(TTPRIN2 (CAR ACTUALS)
2 4)
(SETQ ARGS (CDR ARGS))
(SETQ ACTUALS (CDR ACTUALS)))
(T (TTPRIN2 ACTUALS 2 4)
(SETQ ARGS (SETQ ACTUALS]
(TTCRLF]
(while ARGS do (COND
((LISTP ARGS)
(TTPRIN1 (QUOTE % ))
(TTPRIN2 (CAR ARGS))
(SETQ ARGS (CDR ARGS)))
(T (TTPRIN1 " . ")
(TTPRIN2 ARGS)
(RETURN]
(TTPRIN1 (SELECTQ (SYSTEMTYPE)
(D (QUOTE %)))
(QUOTE %])))
(COND
((SETQ TYPE (SELECTQ (OR ARGTYPE (ARGTYPE FN))
(1 (QUOTE NL))
(3 (QUOTE NL*))
(2 (QUOTE L*))
NIL)) (* indicate arg type)
(TTPRIN1 " {")
(TTPRIN1 TYPE)
(TTPRIN1 (QUOTE }])
(TTYIN.READ?=ARGS
[LAMBDA NIL (* bvm: "15-Apr-85 16:13")
(COND
[(EQ \?PARAMS null)
(SETQ \?PARAMS (COND
((NEQ (TTSKIPSEPR \?TAIL)
\?TAIL)
(PROG ((FILE (TTYIN.SCRATCHFILE)))
(BOUTCCODE FILE (CHARCODE %())
(for (BUF ← \BUFFER) by (TTNEXTCHAR BUF)
until (EQ BUF \?TAIL) do (BOUTCCODE FILE (FIRSTCHAR BUF)))
(BOUTCCODE FILE (CHARCODE %)))
(SETFILEPTR FILE 0)
(RETURN (READ FILE RDTBL]
(T (LISTP \?PARAMS])
(TTDOTABS
[LAMBDA (TABS) (* bvm: "16-Apr-85 17:35")
(* * Tab to next tabstop in TABS, if any.
Represent pseudotabs as a complex space.
Return T if anything done)
(COND
((AND TABS (AT.END.OF.BUF))
(for TB in TABS bind SPACES when (AND (SMALLP TB)
(IGREATERP (SETQ SPACES (IDIFFERENCE (ITIMES TB
\CHARWIDTH)
\CURSORCOL))
\CHARWIDTH))
do (* Make pseudo-tab and echo as spaces)
[ADDCHAR (TTMAKECOMPLEXCHAR (CHARCODE SPACE)
(to (IQUOTIENT SPACES \CHARWIDTH) collect (CHARCODE SPACE]
(RETURN T])
(EDITCOLUMN
[LAMBDA NIL (* bvm: "24-AUG-81 23:17")
(* If last edit command moved up/down, then return the same column we were
using then; else use current cursor column, and record it as the "goal" column
for any future such commands)
(OR (SELCHARQ \LASTCHAR
((LF ↑)
\HOMECOL)
NIL)
(SETQ \HOMECOL \CURSORCOL])
(EDITNUMBERP
[LAMBDA (CHAR) (* bvm: "11-MAR-81 22:05")
(AND [NOT (MINUSP (SETQ CHAR (IDIFFERENCE CHAR (CONSTANT (CHCON1 0]
(NOT (IGREATERP CHAR 9))
CHAR])
(END.DELETE.MODE
[LAMBDA NIL (* bvm: "19-MAR-81 11:59")
(COND
(\DELETING (SELECTQ TTYINBSFLG
(NIL (TTBOUT \))
(LF (COND
((IGREATERP \DELETING 1) (* if more than one char x'd out, lf
to new line)
(DO.LF))))
NIL)
(SETQ \DELETING NIL])
(ENDREAD?
[LAMBDA NIL (* bvm: "10-Apr-86 14:21")
(* Return true if the paren/bracket just typed terminates the input.
It does if the right paren (or even one earlier in buffer) is in excess, i.e
unbalanced, or just balances and this is the only list on the line, or we are
doing a LISPX input and the input is in EVALQT form, with no space after the
first atom)
(LET (X)
(AND
(AT.END.OF.TEXT \CURSOR)
(SETQ X (TTSKREAD \BUFFER))
(OR
(NEQ X \ENDBUFFER)
(AND
[SELCHARQ (CAR (SETQ X (FIND.NON.SPACE \BUFFER)))
((%( %[)
(* OK, line started with paren/bracket)
T)
(AND
(EQ \READING (QUOTE EVALQT))
(NEQ \PROMPT1 (QUOTE *))
(while (NEQ X \ENDBUFFER) bind ESCAPED
do (* Skip over this first atom, to see
if input is in EVALQT form.
Prompt check is so we don't do this in
the editor)
(SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR X))
(SEPRCHAR.RC (* Space, etc: probably wants more on
line)
(OR ESCAPED (RETURN NIL)))
((LIST LEFTPAREN.RC LEFTBRACKET.RC)
(* Open paren/bracket: looks good)
[OR ESCAPED
(RETURN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN (PROGN
(* Prettyprint sucks again!)
T])
(ESCAPE.RC (* Skip over escape char)
(SETQ X (CDR X)))
(MULTIPLE-ESCAPE.RC
(* Multiple escape)
(SETQ ESCAPED (NOT ESCAPED)))
NIL)
(SETQ X (TTNEXTCHAR X]
(EQ (CDR (TTSKREAD (CDR X)))
\CURSOR])
(FIND.LINE
[LAMBDA (BUF)
(DECLARE (USEDFREE \FIRSTLINE)) (* bvm: "20-Mar-84 11:23")
(* * Returns the buffer LINE on which BUF, a cursor position, occurs)
(for (LINE ← (PROGN \FIRSTLINE)) do (COND
[(EQ BUF (fetch END of LINE))
(* Check this separately so next
BUFTAILP doesn't catch it)
(RETURN (COND
((OVERFLOWLINE? LINE)
(fetch NEXTLINE of LINE))
(T LINE]
((BUFTAILP BUF (fetch START of LINE)
(fetch END of LINE))
(RETURN LINE)))
(OR (SETQ LINE (fetch NEXTLINE of LINE))
(SHOULDNT])
(FIND.LINE.BREAK
[LAMBDA (START END USELAST) (* bvm: "20-FEB-82 22:35")
(* * Locates a place between START and END where line can be broken.
If USELAST is true, returns last such place, else first)
(while (NEQ START END) do [COND
((EQ (CAR START)
(CHARCODE SPACE))
(COND
(USELAST (SETQ $$VAL START))
(T (RETURN START]
(SETQ START (TTNEXTCHAR START])
(FIND.MATCHING.QUOTE
[LAMBDA (BUF END) (* bvm: "16-Apr-86 15:07")
(* * Searches BUF until END for a closing double-quote)
(while (NEQ BUF END) do (SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR BUF))
(STRINGDELIM.RC
(RETURN BUF))
(ESCAPE.RC (* "%%" quotes next char)
(COND
((EQ (SETQ BUF (CDR BUF))
END)
(RETURN))))
NIL)
(SETQ BUF (CDR BUF])
(FIND.MATCHING.WORD
[LAMBDA (WORDS START BUFTAIL) (* bvm: "20-FEB-82 22:34")
(* Find the first word in spelling list WORDS which matches the characters in
the buffer from START to BUFTAIL (or current cursor position), and return the
corresponding tail of WORDS)
(OR BUFTAIL (SETQ BUFTAIL \CURSOR))
(find TAIL on WORDS suchthat (WORD.MATCHES.BUFFER (INPART (CAR TAIL))
START BUFTAIL])
(FIND.NEXT.WORD
[LAMBDA (BUFTAIL N BACKUPFLG) (* bvm: "11-Apr-85 15:06")
(* * Return start of Nth word after BUFTAIL, or end of line if none.
BACKUPFLG means if you cross a paren getting to the Nth word, return the paren
rather than the word (used for smart word-delete))
(PROG ((END (fetch END of \ARROW)))
(COND
((EQ BUFTAIL END)
(RETURN END)))
(SETQ BUFTAIL (CDR BUFTAIL))
LP [COND
((EQ BUFTAIL END)
(RETURN END))
((WORDSEPRP (FIRSTCHAR BUFTAIL)) (* Found a space. Now scan for first
non-space, and return there)
[COND
(BACKUPFLG (SETQ BUFTAIL (SETQ BACKUPFLG (FIND.START.OF.WORD BUFTAIL END]
(while (AND (NEQ BUFTAIL END)
(WORDSEPRP (FIRSTCHAR BUFTAIL))) do (SETQ BUFTAIL (TTNEXTCHAR BUFTAIL)))
(COND
((OR (NOT N)
(EQ (SUB1VAR N)
0)
(EQ BUFTAIL END))
(RETURN (OR BACKUPFLG BUFTAIL]
(SETQ BUFTAIL (TTNEXTCHAR BUFTAIL))
(GO LP])
(FIND.NON.SPACE
[LAMBDA (BUF END) (* bvm: "11-Apr-85 15:07")
(OR END (SETQ END \ENDBUFFER))
(while (AND (NEQ BUF END)
(SPACEP (FIRSTCHAR BUF))) do (SETQ BUF (TTNEXTCHAR BUF)))
BUF])
(FIND.START.OF.WORD
[LAMBDA (BUF END) (* bvm: "11-Apr-85 15:07")
(* * Returns position of first word, i.e.
non-space, in BUF before END)
(OR END (SETQ END \ENDBUFFER))
(while (AND (NEQ BUF END)
(WORDSEPRP (FIRSTCHAR BUF))) do (SETQ BUF (TTNEXTCHAR BUF)))
BUF])
(FORWARD.DELETE.TO
[LAMBDA (BUFTAIL) (* bvm: " 1-JUN-82 17:16")
(* * Delete from \CURSOR to BUFTAIL. Cursor does not move)
[COND
((EQ BUFTAIL \CURSOR) (* Nothing to do)
)
((EQ BUFTAIL \ENDBUFFER) (* deleting to end is simple)
(ERASE.TO.END.OF.LINE)
(replace END of \ARROW with (SETQ \ENDBUFFER \CURSOR))
(replace LASTCOL of \ARROW with \CURSORCOL))
(T (PROG ((DELETEDWIDTH (SEGMENT.BIT.LENGTH \CURSOR BUFTAIL))
L)
(COND
((EQ BUFTAIL (fetch END of \ARROW)) (* End pointer is about to disappear
into free list, so move it back here)
(replace END of \ARROW with \CURSOR)
[COND
((EQ (fetch START of (SETQ L (fetch NEXTLINE of \ARROW)))
BUFTAIL)
(replace START of L with \CURSOR)
(COND
((EQ (fetch END of L)
BUFTAIL)
(replace END of L with \CURSOR]
(ERASE.TO.END.OF.LINE))
(T (TTDELSECTION DELETEDWIDTH)))
(KILLSEGMENT \CURSOR BUFTAIL)
(replace LASTCOL of \ARROW with (IDIFFERENCE (fetch LASTCOL of \ARROW)
DELETEDWIDTH))
(COND
((OVERFLOWLINE? \ARROW)
(ADJUSTLINE.AND.RESTORE]
\CURSOR])
(GO.TO.ADDRESSING
[LAMBDA (COL ROW) (* bvm: "20-Mar-84 14:50")
(* Regardless of where we are now, go
to logical position COL,ROW using
cursor addressing)
(PROG ((ABSROW (IPLUS \LOC.ROW.0 ROW)))
(TTSETCURSOR COL ABSROW)
(* Used to prohibit going above top, but that is ugly.
Better to go up there and be clipped out of existence by the display code.
Formerly: (COND ((ILESSP ABSROW 0) (* trying to go beyond top of screen;
ideally we should scroll, but for now just forbid it)
(SETQ ROW (IDIFFERENCE ROW ABSROW)) 0) (
(NOT (ILESSP ABSROW \TTPAGELENGTH)) (* This shouldn't happen at all until we
can scroll!) (SETQ ROW (IPLUS (IDIFFERENCE ROW ABSROW) \TTPAGELENGTH -1))
(SUB1 \TTPAGELENGTH)) (T ABSROW)))
(SETQ \CURSORROW ROW)
(SETQ \CURSORCOL COL])
(GO.TO.FREELINE
[LAMBDA NIL (* bvm: "30-MAR-82 14:54")
(* * Moves cursor to the first free line after the buffer, and clears it)
(GO.TO.RELATIVE NIL (fetch ROW of (TTLASTLINE))) (* Put the cursor on the last row of
buffer)
(TTCRLF) (* And down one more)
(COND
((CAPABILITY? ERASE.TO.END)
(ERASE.TO.END.OF.PAGE])
(GO.TO.RELATIVE
[LAMBDA (COL ROW) (* bvm: "21-APR-83 11:42")
(* * Moves cursor to indicated row/col. ROW arg may be omitted if the movement
is on the same row. If COL=LINE then ROW is interpreted as a LINE record, and
destination is the start of that line)
[PROG ((FROMROW \CURSORROW)
(FROMCOL \CURSORCOL))
(COND
((EQ COL (QUOTE LINE))
(SETQ COL (fetch FIRSTCOL of ROW))
(SETQ ROW (fetch ROW of ROW)))
((NOT COL)
(SETQ COL FROMCOL))
((NOT ROW)
(SETQ ROW FROMROW)))
(* (COND ((EQ FROMCOL \TTLINELENGTH) (SETQ FROMCOL 0)
(* Cursor is logically at the end of the line, but on a dm, an auto crlf has
occurred, so cursor is really at start of next line)
(DO.CRLF) (* This is supposed to work (i.e.
autocr means a crlf now is ignored), but what if something was sent between
then and now?) (ADD1VAR FROMROW))) (COND
((EQ COL \TTLINELENGTH) (* This shouldn't happen, but it can if there is a line
that fills the screen line but ends in a cr)
(SETQ COL 0) (ADD1VAR ROW))))
(RETURN (MOVETO (IPLUS COL \LMARG)
(IPLUS (ITIMES (SUB1 (IDIFFERENCE \TTPAGELENGTH (IPLUS \LOC.ROW.0 ROW)))
\CHARHEIGHT)
\BMARG)
\DSP))
(* (COND ((NOT DISPLAYTERMFLG) (* Can't actually move cursor)
(RETURN)) ((AND (CAPABILITY? \CURSOR T) (COND
((EQ ROW FROMROW) (IGREATERP (IABS (IDIFFERENCE COL FROMCOL)) 1))
((EQ COL FROMCOL) (IGREATERP (IABS (IDIFFERENCE ROW FROMROW)) 1))
(T T))) (* If moving very far, use cursor addressing)
(RETURN (GO.TO.ADDRESSING COL ROW))) ((ILESSP FROMCOL COL)
(* Only way to move forward is one position at a time)
(DO.FORWARD (IDIFFERENCE COL FROMCOL))) (
(ILESSP (IPLUS COL 2) (IDIFFERENCE FROMCOL COL))
(* Moving backward to a position which is closer to left margin than to the
current position, so do it by a CR first.
Note: this assumes that moving backward and moving forward are equally
expensive; probably terminal-dependent) (COND
((ILESSP FROMROW ROW) (* Already above where we are going, so CR will take us
down 1 row as well as putting us in col 0)
(ADD1VAR FROMROW)) (T (DO.UP 1))) (DO.CRLF)
(* actually, CR alone suffices, except that if the next char we output is a LF,
it will be ignored, so do the LF anyway to avoid confusion.
Besides, some clowns tried to simulate a datamedia and forgot this not very
desirable feature, and thus we will be able to work on those terminals, too)
(DO.FORWARD COL)) (T (DO.BACK (IDIFFERENCE FROMCOL COL))))
(COND ((EQ FROMROW ROW) (* No row adjustment))
((IGREATERP FROMROW ROW) (DO.UP (IDIFFERENCE FROMROW ROW)))
(T (DO.DOWN (IDIFFERENCE ROW FROMROW)))))
]
(SETQ \CURSORROW ROW)
(SETQ \CURSORCOL COL])
(INIT.CURSOR
[LAMBDA (COL) (* bvm: "23-MAR-83 15:31")
(* * Initializes cursor accounting; in Interlisp-10, this assumed/forced the
cursor to be in column COL of the bottom row of the screen)
(PROG ((YBOT (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL \DSP)))
INITY)
(SETQ INITY (IDIFFERENCE (DSPYPOSITION NIL \DSP)
YBOT))
[SETQ \LOC.ROW.0 (SUB1 (IDIFFERENCE \TTPAGELENGTH (IQUOTIENT INITY \CHARHEIGHT]
(* \LOC.ROW.0 is the number of the "line" of the first line of text, counting
from the top of the window. Instead, we really should count from the bottom and
fix everyone who cares)
(SETQ \BMARG (IPLUS YBOT (IREMAINDER INITY \CHARHEIGHT)))
(SETQ \CURSORROW 0)
(SETQ \CURSORCOL COL])
(INSERT.NODE
[LAMBDA (BUF) (* bvm: "20-FEB-82 22:34")
(* * Effectively does (ATTACH garbage BUF), but reuses from the garbage heap)
(COND
((EQ BUF \ENDBUFFER) (* Already at end, just push pointer)
(SETQ \ENDBUFFER (TTNEXTNODE \ENDBUFFER)))
(T (FRPLACD BUF (FRPLNODE2 (SCRATCHCONS)
BUF])
(INSERTLINE
[LAMBDA (OLDLINE USECR) (* bvm: "17-Apr-85 19:37")
(* Inserts a new line between OLDLINE and the next line, whose START is the END
of LINE; caller must fill in END if line is non-empty
(defaults to start); USECR, if supplied, is the <cr> char to end the previous
line with)
(PROG ((OLDEND (fetch END of OLDLINE))
(ROW (ADD1 (fetch ROW of OLDLINE)))
X NEWLINE)
[COND
(USECR (INSERT.NODE OLDEND)
(FRPLACA OLDEND USECR)
(SETQ OLDEND (CDR OLDEND]
(TTCRLF)
(COND
((NEQ OLDEND \ENDBUFFER) (* Not last line, so insert a line on
screen.)
(DO.INSERT.LINE 1)))
(TTPROMPTCHAR)
[replace NEXTLINE of OLDLINE with (SETQ NEWLINE
(create LINE
START ← OLDEND
END ← OLDEND
FIRSTCOL ← (SETQ X \CURSORCOL)
LASTCOL ← X
ROW ← ROW
NEXTLINE ← (fetch NEXTLINE of OLDLINE]
(RENUMBER.LINES NEWLINE ROW)
(RETURN NEWLINE])
(KILL.LINES
[LAMBDA (FIRSTLINE) (* bvm: " 2-JUN-82 15:46")
(* * Returns line records from FIRSTLINE onward to the heap)
[PROG NIL
LP (COND
(FIRSTLINE (SETQ FIRSTLINE (CDR (FRPLACA FIRSTLINE 0)))
(* Remove some of the circularity in
the buffer)
(GO LP]
(FRPLACD (FLAST \ENDBUFFER)
FIRSTLINE])
(KILLSEGMENT
[LAMBDA (START END) (* bvm: "25-AUG-81 17:25")
(* * Removes segment from START up to, but not including END.
When done, START contains the contents of former cell END.
I.e. any pointer to START is still valid;
any pointer to END should be reset to START.)
(COND
((EQ END \ENDBUFFER)
(SETQ \ENDBUFFER START))
(T (replace OLDTAIL of \TTYINSTATE with (SETQ \LASTAIL))
(* kill last buffer markers, as they
may be trashed)
(FRPLNODE START (CAR END)
(PROG1 (CDR END)
(FRPLACD END (CDR \ENDBUFFER)) (* Cell at END will point to free list)
(FRPLACD \ENDBUFFER (CDR START)) (* And this segment now is start of
free list)
])
(L-CASECODE
[LAMBDA (CHAR) (* bvm: "11-MAR-81 22:06")
(COND
([AND [NOT (ILESSP CHAR (CONSTANT (CHCON1 (QUOTE A]
(NOT (IGREATERP CHAR (CONSTANT (CHCON1 (QUOTE Z]
(LOGOR CHAR 32))
(T CHAR])
(MOVE.BACK.TO
[LAMBDA (BUFTAIL) (* bvm: " 1-JUN-82 18:10")
(GO.TO.RELATIVE (IDIFFERENCE \CURSORCOL (SEGMENT.BIT.LENGTH BUFTAIL \CURSOR)))
(SETQ \CURSOR BUFTAIL])
(MOVE.FORWARD.TO
[LAMBDA (BUFTAIL) (* bvm: " 1-JUN-82 18:03")
[GO.TO.RELATIVE (IPLUS \CURSORCOL (SEGMENT.BIT.LENGTH \CURSOR (SETQ BUFTAIL (CHECK.MARGIN BUFTAIL
\ARROW]
(SETQ \CURSOR BUFTAIL])
(MOVE.TO.LINE
[LAMBDA (NEWLINE BUFTAIL) (* bvm: " 1-JUN-82 17:56")
(* * Moves to indicated line at indicate buffer position
(default is START), resetting \ARROW etc appropriately.)
(PROG ((RELATIVE.POSITION 0))
[COND
[BUFTAIL (SETQ RELATIVE.POSITION (SEGMENT.BIT.LENGTH (fetch START of NEWLINE)
(SETQ BUFTAIL (CHECK.MARGIN BUFTAIL NEWLINE]
(T (SETQ BUFTAIL (fetch START of NEWLINE]
(GO.TO.RELATIVE (IPLUS (fetch FIRSTCOL of NEWLINE)
RELATIVE.POSITION)
(fetch ROW of NEWLINE))
(SETQ \CURSOR BUFTAIL)
(RETURN (SETQ \ARROW NEWLINE])
(MOVE.TO.NEXT.LINE
[LAMBDA NIL (* bvm: "20-FEB-82 22:20")
(GO.TO.RELATIVE (QUOTE LINE)
(SETQ \ARROW (fetch NEXTLINE of \ARROW)))
(SETQ \CURSOR (fetch START of \ARROW])
(MOVE.TO.START.OF.WORD
[LAMBDA NIL (* bvm: "20-FEB-82 22:34")
[COND
((AT.END.OF.LINE)
(MOVE.BACK.TO (PREVWORD \CURSOR)))
((SELCHARQ (CAR \CURSOR)
((%( %[)
NIL)
T)
(* Do nothing if sitting under an open paren/bracket, since otherwise the
PREVWORD below will go to the previous word, rather than selecting the "word"
which begins with the paren; in all other cases the PREVWORD will do the right
thing: if under the word, goes to its start
(ignoring parens), or if under a space goes to the start of the word before the
space)
(MOVE.BACK.TO (PREVWORD (TTNEXTCHAR \CURSOR]
NIL])
(MOVE.TO.WHEREVER
[LAMBDA (BUF) (* bvm: "24-Feb-80 00:28")
(* * Moves to BUF, wherever it may be.)
(MOVE.TO.LINE (FIND.LINE BUF)
BUF])
(NTH.COLUMN.OF
[LAMBDA (LINE N) (* bvm: "11-MAR-81 22:00")
(* * Returns buffer tail of LINE record which best approximates the Nth
printing column of that line)
(NTH.RELATIVE.COLUMN.OF LINE (IDIFFERENCE N (fetch FIRSTCOL of LINE])
(NTH.RELATIVE.COLUMN.OF
[LAMBDA (LINE N) (* bvm: "16-Apr-85 17:44")
(* Returns buffer tail in LINE which represents the Nth printing character on
the line. Returns start or end of buffer if out of range.
If the nth char is a pad char, returns the start of the pad char sequence)
(COND
((NOT (IGREATERP N 0))
(fetch START of LINE))
(T (for WIDTH CH (BUF ← (fetch START of LINE))
(END ← (fetch END of LINE))
do [COND
((EQ BUF END) (* Ran off the end, so quit)
(RETURN END))
(T (COND
([ILESSP N (SETQ WIDTH (COND
((COMPLEXCHARP (SETQ CH (CAR BUF)))
(fetch CPXWIDTH of CH))
(T (TTBITWIDTH CH]
(RETURN BUF)))
(SETQ N (IDIFFERENCE N WIDTH]
(SETQ BUF (CDR BUF])
(OVERFLOW?
[LAMBDA (WIDTH) (* bvm: "12-Apr-85 12:50")
(* If typing WIDTH more chars would
cause this line to overflow, starts
new line (or simply goes to next line
when N=0))
(COND
((NOT (ILESSP (IPLUS \CURSORCOL WIDTH)
\RMARG))
(COND
[(AT.END.OF.LINE)
(PROG ((OLDLINE \ARROW))
(START.NEW.LINE)
(COND
((AND \AUTOFILL DISPLAYTERMFLG) (* Hit the margin in the middle of a
word. Try to move that word intact to
the new line)
(ADJUSTLINE 1 OLDLINE)
(GO.TO.RELATIVE (fetch LASTCOL of \ARROW)
(fetch ROW of \ARROW]
((EQ WIDTH 0)
(MOVE.TO.NEXT.LINE))
(T (BREAKLINE])
(OVERFLOWLINE?
[LAMBDA (LINE) (* bvm: " 4-Aug-78 18:18")
(* * True if LINE overflows into next line, rather than ending in a cr)
(EQ (fetch END of LINE)
(fetch START of (fetch NEXTLINE of LINE])
(PREVLINE
[LAMBDA (LINE N) (* bvm: "12-Apr-85 12:50")
(* * Backs up N lines in buffer before LINE, as far as start of buffer.
i.e. an NLEFT on line records.)
(PROG ((X \FIRSTLINE)
(L \FIRSTLINE))
LP (* Advance X by N chars)
(COND
((EQ N 0)
(GO LP1))
((OR (EQ X LINE)
(NULL X)) (* The NULL case should never happen,
but better be safe)
(RETURN L)))
(SETQ X (fetch NEXTLINE of X))
(SUB1VAR N)
(GO LP)
LP1 (* Now advance X and L in parallel
until X reaches LINE, at which point L
is N before it)
(COND
((OR (EQ X LINE)
(NULL X))
(RETURN L)))
(SETQ X (fetch NEXTLINE of X))
(SETQ L (fetch NEXTLINE of L))
(GO LP1])
(PREVWORD
[LAMBDA (BUF N START) (* bvm: "12-Apr-85 12:50")
(OR START (SETQ START (fetch START of \ARROW)))
(for (X ← START)
(NEW ← T)
(#HITS ← 0) by (TTNEXTCHAR X) until (EQ X BUF) do
(* * Return start of the Nth word in line before BUF, or beginning of line if
no such word)
(COND
((WORDSEPRP (FIRSTCHAR X))
(* Space between words)
(SETQ NEW T))
(NEW (SETQ $$VAL X)
(* Start of new word)
(SETQ NEW NIL)
(ADD1VAR #HITS)))
finally (RETURN (COND
((OR (NOT N)
(EQ N 1)
(EQ #HITS 0))
(OR $$VAL START))
((ILESSP (SETQ N (IDIFFERENCE #HITS N))
0) (* N was greater than #words in buffer)
START)
((EQ N 0)
(FIND.START.OF.WORD START))
(T (FIND.NEXT.WORD (FIND.START.OF.WORD START)
N])
(PROPERTAILP
[LAMBDA (X Y) (* bvm: " 4-Aug-78 12:03")
(* * true if X is a PROPER tail of Y)
(AND X (NEQ X Y)
(BUFTAILP X Y])
(READFROMBUF
[LAMBDA (START END COPYFLG) (* bvm: "16-Apr-85 18:57")
(* Unreads the chars in the buffer from START to END.
The cells are returned to the free pool as they are used to reduce the storage
demands on large unreads. Multichar sequences in buffer are unread as just
their "real" characters)
(PROG (FIXUP CH)
[COND
([AND (NOT (AT.END.OF.LINE))
(for (BUF ← START) by (CDR BUF) until (EQ BUF END)
thereis (EQ (CAR BUF)
(CHARCODE EOL]
(* An insertion that contains a cr. This will look awful if we have to keep
shoving text in front of us, so break the line first, then unbreak it at end)
(BREAKLINE (CHARCODE SPACE)
(SETQ FIXUP T]
[until (EQ START END) do [COND
((COMPLEXCHARP (SETQ CH (CAR START)))
(SETQ CH (fetch CPXREALCHAR of CH]
(COND
((NEQ CH EOLCHARCODE)
(ADDNAKEDCHAR CH T))
((NOT (AT.END.OF.LINE))(* Insert EOL in middle of line)
(BREAKLINE EOLCHARCODE))
((OR (NEQ (CDR START)
END)
(NOT (AT.END.OF.TEXT \CURSOR)))
(* EOL. Start new line.
Ignore it if this is a terminating eol)
(START.NEW.LINE EOLCHARCODE)))
(SETQ START (PROG1 (CDR START)
(SELECTQ (SYSTEMTYPE)
(D (* Don't bother reclaiming)
NIL)
(OR COPYFLG (FRPLACD \ENDBUFFER
(FRPLACD START
(CDR \ENDBUFFER]
(COND
(FIXUP (* Kill the cr we inserted)
(MOVE.TO.WHEREVER (PROG1 \CURSOR (DELETE.LONG.SEGMENT1 \ARROW \CURSOR
(fetch NEXTLINE of \ARROW)
(TTNEXTCHAR \CURSOR])
(RENUMBER.LINES
[LAMBDA (LINE ROW) (* bvm: " 4-Aug-78 18:18")
(* * Renumbers lines from LINE onward, giving LINE the value ROW)
(while LINE do (replace ROW of LINE with ROW)
(ADD1VAR ROW)
(SETQ LINE (fetch NEXTLINE of LINE])
(RESTORE.CURSOR
[LAMBDA NIL (* bvm: "20-FEB-82 22:21")
(COND
((CAPABILITY? MOVEMENT)
(GO.TO.RELATIVE \HOMECOL \HOMEROW])
(RESTOREBUF
[LAMBDA NIL (* bvm: "27-JUL-82 14:50")
(* recover previous buffer, which extends to either our current LASTAIL, if
user has done deletions on this line, or previous LASTAIL, stored in the front
of the buffer. If neither, then recover last thing zapped with the mouse)
(PROG (TAIL)
(COND
([AND (AT.END.OF.BUF)
(SETQ TAIL (OR (AND \LASTAIL (IGEQ \LASTAILROW (fetch ROW of \ARROW))
(OR (IGREATERP \LASTAILCOL \CURSORCOL)
(IGREATERP \LASTAILROW (fetch ROW of \ARROW)))
(PROPERTAILP \LASTAIL \ENDBUFFER))
(PROPERTAILP (fetch OLDTAIL of \TTYINSTATE)
\ENDBUFFER]
(END.DELETE.MODE)
(READFROMBUF [CONS (CAR \ENDBUFFER)
(PROG1 (CDR \ENDBUFFER) (* now detach buffer from here to TAIL
to avoid conflict)
(FRPLNODE \ENDBUFFER 0 (CDR TAIL]
TAIL)
(SETQ \LASTAIL \ENDBUFFER)
(SETQ \LASTAILCOL \CURSORCOL)
(SETQ \LASTAILROW (fetch ROW of \ARROW))
(replace OLDTAIL of \TTYINSTATE with NIL))
(\LAST.DELETION (READFROMBUF \LAST.DELETION NIL T)
(ADJUSTLINE.AND.RESTORE T))
(T (* Can't find where buffer ended;
perhaps we have written past it)
(BEEP])
(RETYPE.BUFFER
[LAMBDA (LINE LASTLINE FROM.HERE) (* bvm: "12-Apr-85 12:50")
(* Refreshes buffer starting with LINE for one line, or going to LASTLINE,
where LASTLINE=T means end of buffer. Moves cursor to start of LINE
(based on where we think we might be now) unless FROM.HERE is set.
FROM.HERE is set when retyping whole buffer with the current cursor position
defined as 0,0; in this case, the cursor is restored on completion to wherever
it was last saved, rather than its current position)
(PROG (L (ROW (fetch ROW of LINE)))
(SETQ \DELETING)
(BINARY.MODE)
[COND
(FROM.HERE (INIT.CURSOR 0))
(T (SAVE.CURSOR)
(COND
[(CAPABILITY? MOVEMENT) (* position cursor at start of line)
(CANCEL.MODES) (* in case an funny terminal setting
occurred, say because of noise)
(COND
((CAPABILITY? \CURSOR T)
(GO.TO.ADDRESSING 0 ROW))
(T (DO.UP 1) (* Goto start of line by going up a
line and doing a crlf)
(DO.CRLF)
(SETQ \CURSORCOL 0]
(T (TTCRLF]
[COND
((EQ ROW 0) (* First line might be indented)
(SELECTQ (SYSTEMTYPE)
(D (RELMOVETO \INITPOS 0 \DSP))
(TTBOUTN (SETQ \CURSORCOL \INITPOS)
SPACE]
LP (TTPROMPTCHAR LINE)
(TYPE.BUFFER (fetch START of LINE)
(fetch END of LINE))
(COND
((AND LASTLINE (SETQ L (fetch NEXTLINE of LINE))
(NEQ L LASTLINE))
(SETQ LINE L)
(TTCRLF)
(ADD1VAR ROW)
(GO LP)))
(COND
((EQ LASTLINE T) (* kill any text that might be below
bottom line)
(ERASE.TO.END.OF.PAGE)))
(RESTORE.CURSOR])
(SAVE.CURSOR
[LAMBDA NIL (* bvm: "11-MAR-81 21:40")
(SETQ \HOMEROW \CURSORROW)
(SETQ \HOMECOL \CURSORCOL])
(SCANBACK
[LAMBDA (CHAR BUF N START) (* bvm: "12-Apr-85 12:50")
(* * Searches back for Nth previous occurrence of CHAR in buffer before BUF,
returning NIL if there are no occurrences.
Scan terminates at START, default is start of line;
default N is 1; if there are fewer than N occurrences, returns the earliest one
it can)
(for [X ← (OR START (SETQ START (fetch START of \ARROW]
(#HITS ← 0) by (TTNEXTCHAR X) until (EQ X BUF) do (COND
((EQ (U-CASECODE (FIRSTCHAR X))
CHAR)
(SETQ $$VAL X)
(ADD1VAR #HITS)))
finally (RETURN (COND
((OR (NOT N)
(EQ N 1)
(EQ #HITS 0)
(EQ #HITS 1))
$$VAL)
(T (* There are #HITS occurrences of
CHAR, and we want the Nth from the end)
(SCANFORWARD CHAR START (ADD1 (IMAX (IDIFFERENCE #HITS N)
0))
BUF])
(SCANFORWARD
[LAMBDA (CHAR BUF N END) (* bvm: "12-Apr-85 12:50")
(* * Finds Nth occurrence of CHAR in BUF before END.
Default END is end of current line; default N is 1;
CHAR should be uppercase if a letter)
(OR N (SETQ N 1))
(OR END (SETQ END (fetch END of \ARROW)))
(while (NEQ BUF END) do [COND
((EQ (U-CASECODE (FIRSTCHAR BUF))
CHAR)
(COND
((EQ (SUB1VAR N)
0)
(RETURN BUF))
(T (SETQ $$VAL BUF]
(SETQ BUF (TTNEXTCHAR BUF])
(SCRATCHCONS
[LAMBDA NIL (* bvm: "25-AUG-81 17:27")
(* * Returns a garbage cons from the heap at the end of the buffer, or a fresh
cons if none available)
(replace OLDTAIL of \TTYINSTATE with (SETQ \LASTAIL)) (* Wipe out last buffer ptrs, as this
may trash them)
(PROG1 (OR (CDR \ENDBUFFER)
(CONS))
(FRPLACD \ENDBUFFER (CDDR \ENDBUFFER])
(SEGMENT.LENGTH
[LAMBDA (START END) (* bvm: "16-Apr-85 16:59")
(* * Returns number of print positions in buffer from START to END)
(PROG ((N 0))
LP (COND
((EQ START END)
(RETURN N)))
(add N (COND
((COMPLEXCHARP (CAR START))
(fetch CPXNCHARS of (CAR START)))
(T 1)))
(SETQ START (CDR START))
(GO LP])
(SEGMENT.BIT.LENGTH
[LAMBDA (START END) (* bvm: "16-Apr-85 17:01")
(* * Returns number of print positions in bits in buffer from START to END)
(PROG ((N 0))
LP (COND
((EQ START END)
(RETURN N)))
(add N (COND
((COMPLEXCHARP (CAR START))
(fetch CPXWIDTH of (CAR START)))
(\VARIABLEFONT (FCHARWIDTH (CAR START)
\FONT))
(T \CHARWIDTH)))
(SETQ START (CDR START))
(GO LP])
(SETLASTC
[LAMBDA (CHAR) (* bvm: "10-APR-81 23:28")
(* Makes CHAR be LASTC for T.
This is a kludge; I should be
interfacing better with \LINEBUF.OFD
at a more fundamental level.)
(\BOUT \LINEBUF.OFD CHAR])
(SETTAIL?
[LAMBDA (EVEN.IF.NOT.THERE) (* bvm: "27-JUL-82 14:52")
(* If \ENDBUFFER is farther than we've been before, save this position on
LASTAIL. If EVEN.IF.NOT.THERE is set, do this even if cursor is not currently
at the end)
(COND
([AND (NOT \DELETING)
(NOT (EMPTY.BUFFER))
(OR EVEN.IF.NOT.THERE (EQ \CURSOR \ENDBUFFER))
(OR (NOT \LASTAIL)
(OR (ILESSP \LASTAILROW (fetch ROW of \ARROW))
(AND (ILESSP \LASTAILCOL \CURSORCOL)
(ILEQ \LASTAILROW (fetch ROW of \ARROW]
(SETQ \LASTAIL \ENDBUFFER)
(SETQ \LASTAILCOL \CURSORCOL)
(SETQ \LASTAILROW (fetch ROW of \ARROW])
(SHOW.MATCHING.PAREN
[LAMBDA (BUF) (* lmm " 3-May-84 10:32")
(* * Indicates parenthesis nesting by briefly moving the cursor to the paren
that matches the paren at BUF, if that position is still on the screen.
The cursor stays there for SHOWPARENFLG seconds, or until there is input from
the user. Assumes terminal has cursor addressability)
(PROG ((MATCHING (BACKSKREAD BUF T))
LINE ROW COL) (* MATCHING is the buffer position
that matches BUF, or NIL if this paren
was quoted somehow.)
(OR MATCHING (RETURN))
(SETQ LINE (FIND.LINE MATCHING)) (* The buffer LINE on which it appears)
(COND
((ILESSP (IPLUS (SETQ ROW (fetch ROW of LINE))
\LOC.ROW.0)
0) (* Not on screen, so forget it)
(RETURN)))
(SETQ COL (IPLUS (SEGMENT.BIT.LENGTH (fetch START of LINE)
MATCHING)
(fetch FIRSTCOL of LINE))) (* The absolute column position)
(COND
((TYPEAHEAD?)
(* After all this computation, there is now input waiting, so don't do
anything. Didn't do this earlier, since the SIBE itself takes time, and is
likely to fail when done immediately after reading the closing paren)
(RETURN)))
(SAVE.CURSOR)
(GO.TO.ADDRESSING COL ROW) (* Go to absolute coordinates of
matching paren)
(TTWAITFORINPUT (COND
((FIXP SHOWPARENFLG)
(ITIMES SHOWPARENFLG 1000))
(T 1000))) (* Wait a while to let user see it)
(\CHECKCARET \DSP) (* Tell background we moved the cursor)
(RESTORE.CURSOR) (* Put cursor back where it belongs)
])
(SKIP/ZAP
[LAMBDA (CMD CHAR N MINUS) (* bvm: "20-FEB-82 22:34")
(* Performs <edit>S or <edit>Z, i.e. skip or zap to character.
CMD is S, Z, B, or -Z (latter two are backward versions of the first two);
CHAR is the target character, N is a repeat arg and MINUS is its sign.
Last such operation is saved on LASTSKIP so that <edit>A can repeat it)
(SETQ CHAR (U-CASECODE CHAR)) (* Ignore case differences)
[COND
(MINUS (* invert command)
(SETQ CMD (SELECTC CMD
((CHARCODE S)
(CHARCODE B))
((CHARCODE B)
(CHARCODE S))
((CHARCODE Z)
(IMINUS (CHARCODE Z)))
((IMINUS (CHARCODE Z))
(CHARCODE Z))
(SHOULDNT]
(COND
([SETQ N (SELECTC CMD
((CHARCODE B)
(SCANBACK CHAR \CURSOR N))
((IMINUS (CHARCODE Z))
(SCANBACK CHAR (TTNLEFT \CURSOR 1)
N))
(AND (NOT (AT.END.OF.LINE))
(SCANFORWARD CHAR (TTNEXTCHAR \CURSOR)
N]
(SELECTC CMD
((CHARCODE S)
(* S)
(MOVE.FORWARD.TO N))
((CHARCODE Z)
(* Z)
(FORWARD.DELETE.TO N))
((CHARCODE B)
(* B)
(MOVE.BACK.TO N))
((IMINUS (CHARCODE Z))
(* -Z)
[FORWARD.DELETE.TO (PROG1 (COND
((AT.END.OF.LINE)
\CURSOR)
(T (TTNEXTCHAR \CURSOR)))
(MOVE.BACK.TO (TTNEXTCHAR N])
(SHOULDNT)))
(T (BEEP)))
(replace LASTSKIP of \TTYINSTATE with CMD)
(replace LASTSKIPCHAR of \TTYINSTATE with CHAR])
(START.NEW.LINE
[LAMBDA (USECR) (* bvm: "16-SEP-82 11:53")
(* * Handles moving to new line. USECR, if set, is the <cr> character that
should terminate current line)
(SETQ \CURSOR (fetch START of (SETQ \ARROW (INSERTLINE \ARROW USECR])
(START.OF.PARAGRAPH?
[LAMBDA (LINE) (* bvm: "16-Apr-85 16:51")
(OR (EQ (fetch END of LINE)
(SETQ LINE (fetch START of LINE)))
(AND (COMPLEXCHARP (CAR LINE))
(EQ (fetch CPXREALCHAR of (CAR LINE))
(CHARCODE TAB])
(TTADJUSTWORD
[LAMBDA (WORD) (* bvm: "16-SEP-82 12:14")
(* * Returns WORD, possibly corrected, according to the spelling list, if any.
Returns NIL if FIX was specified and the word fails.)
(PROG (X)
(RETURN (COND
((OR (NULL SPLST)
(FMEMB WORD (QUOTE (%( %) %[ %] %" ,)))
(FMEMB WORD SPLST))
WORD)
((AND WORD (SETQ X (FASSOC WORD SPLST)))(* Is synonym. FASSOC assumes car of
atom is NIL)
(CDR X))
([AND SPLST (LITATOM WORD)
(NEQ \NOFIXSPELL (QUOTE NOFIXSPELL))
(SETQ X (FIXSPELL WORD 70 SPLST (AND \NOFIXSPELL T)
NIL NIL NIL (NOT \SPLSTFLG]
(* respelled okay)
X)
(\FIX (TTPRIN1 WORD)
(TTPRIN1 (QUOTE ?))
(COND
(HELP (TTGIVEHELP HELP))
(T (TTPRIN1 " please try again.")))
(TTCRLF)
NIL)
(T WORD])
(TTBIN
[LAMBDA (NOMETA) (* bvm: "17-Apr-85 21:02")
(* * Read the next char from terminal, return its character code.
Sets \EDITBIT true or false according to whether char is meta.
If NOMETA is true, the meta bit is discarded)
(PROG ((CHAR (TTWAITFORINPUT NIL T)))
[COND
((EQ CHAR EDITPREFIXCHAR) (* edit prefix)
(SETQ CHAR (\GETKEY))
[COND
((EQ CHAR EDITPREFIXCHAR) (* Two edits in a row = Edit-Escape)
(SETQ CHAR (CHARCODE ESCAPE]
(SETQ CHAR (METACHAR CHAR]
[COND
((AND NOMETA (METACHARP CHAR)) (* Had meta key down, remove bit.
This is useful for inside Edit
commands)
(SETQ CHAR (NONMETACHARBITS CHAR]
(\CHECKCARET \DSP) (* Turn off the caret, since we will
probably move)
(RETURN CHAR])
(TTBITWIDTH
[LAMBDA (CHAR) (* bvm: " 6-JUN-82 18:06")
(COND
(\VARIABLEFONT (FCHARWIDTH CHAR \FONT))
(T \CHARWIDTH])
(TTCOMPLETEWORD
[LAMBDA (CAUTIOUS MUST.BE.UNIQUE FIRSTMATCH FIRSTCHAR) (* bvm: " 4-JUN-82 18:23")
(* Tries to complete the current word from members of SPLST.
Does nothing if no word in progress, or this is a comment line.
Returns true if some completion done. If CAUTIOUS, only complete if can do so
uniquely and caller permits fixspell; if MUST.BE.UNIQUE set, only do unique
completion. FIRSTMATCH, if supplied, is the first match in SPLST, and FIRSTCHAR
the start of the current word being worked on)
(PROG (TAIL FIRSTMATCHCHARS SUFFIXCHARS LASTCHAR NEXTCHAR I WORD (UNIQUE T))
(RETURN (COND
([AND [OR FIRSTCHAR (SETQ FIRSTCHAR (COND
((AT.START.OF.BUF)
(* Empty buffer. Allow altmode
completion on one-word splst here)
(AND (NOT CAUTIOUS)
\BUFFER))
(T (CURRENT.WORD]
(OR FIRSTMATCH (SETQ FIRSTMATCH (FIND.MATCHING.WORD SPLST FIRSTCHAR]
(* Completion may be possible. (CAR MATCH) is the first match in SPLST;
FIRSTCHAR is buffer tail where current word starts;
NEXTCHAR is the relative position of cursor in current word, i.e.
#chars in word + 1; LASTCHAR is the last char position in common among all
words which match. Now run through all other possible matches with the current
word, reducing LASTCHAR to indicate the largest segment in common.)
(SETQ NEXTCHAR (ADD1 (SEGMENT.LENGTH FIRSTCHAR \CURSOR)))
[SETQ LASTCHAR (NCHARS (SETQ FIRSTMATCH (INPART (CAR (SETQ TAIL FIRSTMATCH]
(COND
((OR CAUTIOUS (EQ (SUB1 NEXTCHAR)
LASTCHAR))
(* The latter case happens if the current word is exactly MATCH.
In this case, if there are any other matches they are with words containing
MATCH as initial substring, and thus no further completion is possible)
(SETQ MUST.BE.UNIQUE T)))
(SETQ SUFFIXCHARS (FNTH (SETQ FIRSTMATCHCHARS (DCHCON FIRSTMATCH CHCONLST1))
NEXTCHAR))
(* unpack FIRSTMATCH for faster tests below.
CHCONLST1 is Dwim's scratch list. If user often uses very long words, may want
to lengthen this list to reduce cons usage.)
(while (SETQ TAIL (FIND.MATCHING.WORD (CDR TAIL)
FIRSTCHAR \CURSOR))
do (COND
(MUST.BE.UNIQUE (RETURN)))
(SETQ UNIQUE)
(SETQ WORD (INPART (CAR TAIL)))
[COND
((find old I from NEXTCHAR to LASTCHAR as REFERENCE in SUFFIXCHARS
suchthat (NEQ (NTHCHARCODE WORD I)
REFERENCE))
(COND
((EQ I NEXTCHAR) (* No characters in common, so give up)
(RETURN))
(T (* reset LASTCHAR to last common
character)
(SETQ LASTCHAR (SUB1 I]
finally
(* * chars from NEXTCHAR to LASTCHAR are uniquely determined by prefix so far)
(END.DELETE.MODE)
[PROG ((BUF FIRSTCHAR)
RETYPEIT OLDLENGTH NEEDADJUST)
(SETQ I 1)
LP1
(* * Scan old part of string (part user has typed already) to make sure case is
correct)
(COND
[(EQ I NEXTCHAR) (* Done with first part now.
Before we go on, retype anything that
needed it)
[COND
((AND RETYPEIT DISPLAYTERMFLG)
(* If we're capable of backspacing, go
back and write over input with correct
case)
(GO.TO.RELATIVE (IDIFFERENCE \CURSORCOL OLDLENGTH))
[COND
(\VARIABLEFONT (SETQ NEEDADJUST
(TTADJUSTWIDTH (IDIFFERENCE
(SEGMENT.BIT.LENGTH
RETYPEIT \CURSOR)
OLDLENGTH)
\CURSOR]
(TYPE.BUFFER RETYPEIT \CURSOR)
(COND
(NEEDADJUST (ADJUSTLINE.AND.RESTORE]
(COND
((IGREATERP I LASTCHAR)
(* Happens when entire word is
complete as stands)
(RETURN]
(T [COND
((NEQ (CAR FIRSTMATCHCHARS)
(CAR BUF))
(* Case mismatch, want to fix)
(FRPLACA BUF (CAR FIRSTMATCHCHARS))
(COND
((NOT RETYPEIT)
(SETQ RETYPEIT BUF)
(SETQ OLDLENGTH (SEGMENT.BIT.LENGTH RETYPEIT
\CURSOR]
(SETQ FIRSTMATCHCHARS (CDR FIRSTMATCHCHARS))
(SETQ BUF (CDR BUF))
(ADD1VAR I)
(GO LP1)))
LP2 (* Now do second half, the completion
part: add new chars from NEXTCHAR thru
LASTCHAR)
(ADDCHAR (CAR FIRSTMATCHCHARS))
(COND
((NEQ I LASTCHAR)
(SETQ FIRSTMATCHCHARS (CDR FIRSTMATCHCHARS))
(ADD1VAR I)
(GO LP2]
[COND
((AND UNIQUE (NOT CAUTIOUS))
(* word is unique, so delimit as well)
(ADDCHAR (CHARCODE SPACE))
(COND
((AND \SPLSTFLG (NEQ NEXTCHAR 1))
(* Spelling list maintenance: user completed on this word, so move to front of
spelling list. Don't do it in the trivial case of filling in the entire word
uniquely (as when doing LASTWORD))
(MOVETOP FIRSTMATCH (OR SPLST USERWORDS]
(RETURN (OR (AND UNIQUE FIRSTMATCH)
T])
(TTCRLF
[LAMBDA NIL (* bvm: "12-MAR-81 16:35")
(* * Prints a crlf, updating cursor appropriately)
(DO.CRLF)
(TTCRLF.ACCOUNT])
(TTCRLF.ACCOUNT
[LAMBDA NIL (* bvm: "18-Apr-85 18:49")
(SETQ \CURSORROW (ADD1 \CURSORROW))
[COND
((EQ (IPLUS \LOC.ROW.0 \CURSORROW)
\TTPAGELENGTH) (* This crlf glitched the screen, so
row 0 has moved up one)
(SETQ \LOC.ROW.0 (SUB1 \LOC.ROW.0)) (* We are also now guaranteed to be on
the bottom row of the window)
(SETQ \BMARG (DSPYPOSITION NIL \DSP]
(SETQ \CURSORCOL 0])
(TTDELETECHAR
[LAMBDA NIL (* bvm: "16-Apr-85 18:04")
(COND
((AT.START.OF.BUF)
(BEEP))
[(AT.END.OF.LINE)
(COND
[(AT.START.OF.LINE) (* empty line: need to delete to
previous line)
(PROG ((PREV (PREVLINE \ARROW 1))
DODELETE)
(SETQ DODELETE (OVERFLOWLINE? PREV))
(DELETELINE \ARROW) (* get rid of this line)
(MOVE.TO.LINE PREV (fetch END of PREV)) (* go to end of previous line)
(COND
(DODELETE (* We were on overflow line, so have
to delete the last char, too)
(DELETETO (TTNLEFT \CURSOR 1)))
((NOT (CAPABILITY? MOVEMENT))
(RETYPE.BUFFER \ARROW]
(T (DELETETO (TTNLEFT \CURSOR 1]
(T (TTRUBOUT])
(TTDELETELINE
[LAMBDA NIL (* bvm: "16-Apr-85 18:03")
(COND
((EMPTY.BUFFER)
(BEEP))
[(EMPTY.LINE) (* Empty line: delete previous line if
at end)
(COND
((AT.END.OF.BUF)
(MOVE.TO.LINE (PREVLINE \ARROW 1))
(COND
((NOT DISPLAYTERMFLG)
(TTBOUT ←)
(DO.CRLF)))
(DELETE.TO.END))
(T (BEEP]
(T (SETTAIL? T)
(COND
((NOT DISPLAYTERMFLG)
(TTBOUT # #) (* On non-display just print ## and
return to initial position)
[replace END of \ARROW with (SETQ \CURSOR (SETQ \ENDBUFFER (fetch START of \ARROW]
(replace LASTCOL of \ARROW with (fetch FIRSTCOL of \ARROW))
(RETYPE.BUFFER \ARROW))
((AT.END.OF.LINE) (* kill back to start of line.
This can work on glass tty, too,
whereas next clause doesn't)
(DELETETO (fetch START of \ARROW)))
(T (* We're inside line, so go back to
start and then zap whole line)
(MOVE.BACK.TO (fetch START of \ARROW))
(FORWARD.DELETE.TO (fetch END of \ARROW])
(TTDELETEWORD
[LAMBDA (N) (* bvm: "18-Apr-85 17:24")
(COND
[(NOT (CAPABILITY? MOVEMENT)) (* Only easy ↑W allowed)
(COND
((OR (NOT (AT.END.OF.LINE))
(EMPTY.LINE))
(BEEP))
(T (DELETETO (PREVWORD \CURSOR]
((AT.START.OF.BUF)
(BEEP))
(T (LET ((TAIL (PREVWORD \CURSOR N))
PREVL START)
(SETTAIL?)
(COND
((EQ TAIL \CURSOR)
(DELETE.LONG.SEGMENT1 (SETQ PREVL (PREVLINE \ARROW 1))
(SETQ START (PREVWORD \CURSOR N (fetch START of PREVL)))
\ARROW \CURSOR)
(MOVE.TO.WHEREVER START))
(T (BACKWARD.DELETE.TO TAIL])
(TTECHO.TO.FILE
[LAMBDA (FILE DRIBBLING)
(DECLARE (USEDFREE \FIRSTLINE \PROMPT1 \PROMPT2 \ENDBUFFER))
(* bvm: "16-Apr-85 16:55")
(* * Echos input to FILE. If DRIBBLING is true, the prompts are also echoed)
(for (STREAM ← (GETSTREAM FILE (QUOTE OUTPUT)))
(LINE ← \FIRSTLINE)
(FIRSTIME ← T)
X CH END do (COND
([AND DRIBBLING (SETQ X (COND
(FIRSTIME (SETQ FIRSTIME NIL)
(AND (NOT \NOPROMPT)
\PROMPT1))
(T \PROMPT2]
(PRIN1 X FILE)))
(SETQ END (fetch END of LINE))
(SETQ X (fetch START of LINE))
(until (EQ X END) do [COND
([NOT (COMPLEXCHARP (SETQ CH (CAR X]
(BOUTCCODE STREAM CH))
[(EQ (fetch CPXREALCHAR of CH)
(CHARCODE SPACE))
(* pseudo-tab kludge: instead of
printing the "real" character, ignore
it and print only its padding spaces)
(FRPTQ (fetch CPXNCHARS of CH)
(BOUTCCODE STREAM (CHARCODE SPACE]
(T (BOUTCCODE STREAM (fetch CPXREALCHAR of CH]
(SETQ X (TTNEXTCHAR X)))
(SETQ LINE (fetch NEXTLINE of LINE))
(COND
((OR DRIBBLING (NEQ (fetch START of LINE)
END)) (* Don't terpri on overflow line,
since user didn't; except always do it
to dribblefile, since that's what's on
the screen)
(TERPRI FILE)))
repeatwhile (AND LINE (OR (EQ END \ENDBUFFER)
(PROGN (* Avoid echoing the terminating empty
line, except when it is an empty
overflow line)
(NEQ (fetch START of LINE)
\ENDBUFFER])
(TTGIVEHELP
[LAMBDA (HELPKEY) (* bvm: "12-Apr-85 12:50")
(RESETLST (PROG ((CTRLO! CTRLO!))
(RESETSAVE (OUTPUT T))
(COND
((AND (NOT CTRLO!)
(FGETD (QUOTE CTRLO!))) (* Enable ↑O interrupt unless already
done)
(RESETSAVE (INTERRUPTCHAR 15 (QUOTE (CTRLO!))
T))
(SETQ CTRLO! T)))
(TERPRI)
(COND
((EQ HELPKEY T)
(TTGIVEHELP1))
[(LISTP HELPKEY)
(COND
((EQ (CAR HELPKEY)
T) (* List SPLST first, then subsequent
blurb)
(TTGIVEHELP1 T)
(PRIN1 (QUOTE % ))
(TTGIVEHELP2 (CDR HELPKEY)
T))
((EQ (CDR HELPKEY)
T) (* Similar, but blurb first)
(TTGIVEHELP2 (CAR HELPKEY)
T)
[COND
((NEQ (POSITION)
0)
(PRIN1 (QUOTE % ]
(TTGIVEHELP1 T T))
(T (TTGIVEHELP2 HELPKEY]
(T (TTGIVEHELP2 HELPKEY)))
(COND
((NEQ (POSITION)
0)
(TERPRI)))
(TERPRI)
(RETURN T])
(TTGIVEHELP1
[LAMBDA (NO.OTHER NO.INTRO) (* bvm: "11-MAR-81 21:36")
(COND
(SPLST (OR NO.INTRO (PRIN1 "Please select from among "))
(for X on SPLST unless (OR (EQ X SPELLSTR1)
(EQ X SPELLSTR2)) do (PRIN1 (INPART (CAR X)))
(AND (CDR X)
(PRIN1 ", ")))
(COND
((NOT NO.OTHER)
(OR \FIX (PRIN1 ", or other"))
(TERPRI])
(TTGIVEHELP2
[LAMBDA (HELPKEY MIXED) (* bvm: " 8-Aug-80 00:14")
(COND
[[OR (LITATOM HELPKEY)
(AND (STRINGP HELPKEY)
(NOT (STRPOS (QUOTE % )
HELPKEY] (* Atom or spaceless string is a
hashfile key)
(COND
((NOT (DISPLAYHELP HELPKEY))
(OR MIXED (PRIN1 "Sorry, no help available."]
(T (SPRINTT HELPKEY (COND
(MIXED (* no extra space)
0)
(T 4))
4 0])
(TTLASTLINE
[LAMBDA NIL (* bvm: "11-MAR-81 21:37")
(* * Returns last LINE record in buffer)
(PROG ((LINE \FIRSTLINE)
L)
LP (COND
((SETQ L (fetch NEXTLINE of LINE))
(SETQ LINE L)
(GO LP)))
(RETURN LINE])
(TTLOADBUF
[LAMBDA (BUF) (* bvm: "16-Apr-86 15:40")
(* BUF is a list, a la READBUF, which is loaded into our character buffer,
using DCHCON to convert the s-expressions therein to char codes.
If we are READING, then uses PRIN2 pnames, i.e.
includes escape chars and such stuff. Alternatively, BUF may be a string, in
which case its contents are also loaded into the buffer, a la BKSYSBUF, and the
setting of \READING is irrelevant)
(COND
[(EQ (CAR (LISTP BUF))
HISTSTR1) (* read from file. BUF is
(<histstr1> (file start . end)))
(SETQ BUF (CADR BUF))
(SETFILEPTR (CAR BUF)
(CADR BUF))
(bind CHAR NEXTCH (STREAM ← (GETSTREAM (CAR BUF)
(QUOTE INPUT)))
(#CHARS ← (IDIFFERENCE (CDDR BUF)
(CADR BUF))) while (IGREATERP #CHARS 0)
do (add #CHARS -1)
(COND
((NEQ (SETQ CHAR (BINCCODE STREAM))
(CHARCODE CR))
(ADDNAKEDCHAR CHAR T))
(T (* eat up the lf after the cr)
(COND
([OR (EQ #CHARS 0)
(PROGN (SETQ NEXTCH (BINCCODE STREAM))
(AND (ILEQ (add #CHARS -1)
0)
(EQ NEXTCH (CHARCODE LF]
(* Ignore final CR)
(RETURN)))
(ADDNAKEDCHAR CHAR)
(COND
((NEQ NEXTCH (CHARCODE LF))
(ADDNAKEDCHAR NEXTCH]
(T (PROG (START END)
[COND
((AND (LISTP BUF)
(SETQ START (FMEMB HISTSTR0 BUF))) (* HISTSTR0 is a marker used by lispx
to denote end of line)
(FRPLACD (NLEFT BUF 1 START]
(SETQ START (DCHCON BUF (CDR \ENDBUFFER)
(AND (LISTP BUF)
\READING)
(OR RDTBL T))) (* Use our own buffer as a scratchlist
for DCHCON as long as it's lying
around anyway.)
[COND
((LISTP BUF) (* Remove the surrounding parens from
the outer list)
(SETQ END (NLEFT (SETQ START (CDR START))
1]
(* now detach the result from our buffer to avoid conflict of interest.
If DCHCON found our scratchlist inadequate, START will not be a tail of
\ENDBUFFER so the NLEFT below comes out NIL, which is also fine)
(FRPLACD (NLEFT \ENDBUFFER 1 START)) (* Now unread the CHCON list.)
(READFROMBUF START END])
(TTNEXTLINE
[LAMBDA (LINE N) (* bvm: "12-Apr-85 12:52")
(bind L while (AND (NEQ N 0)
(SETQ L (fetch NEXTLINE of LINE))) do (SETQ LINE L)
(SUB1VAR N) finally (RETURN LINE])
(TTNEXTNODE
[LAMBDA (BUF) (* bvm: " 2-JUN-82 15:44")
(* * Returns cdr of BUF, tacking on a new cons if the cdr was NIL)
(OR (CDR BUF)
(CDR (FRPLACD BUF (CONS 0])
(TTNLEFT
[LAMBDA (BUF N START) (* bvm: "12-Apr-85 12:52")
(* * Backs up N real characters in this line before BUF as far as START,
default being the current start of the line.
Assumes BUF is a tail of line and N is small)
(OR START (SETQ START (fetch START of \ARROW)))
(PROG ((X START)
(B START))
LP (* Advance X by N chars)
(COND
((EQ N 0)
(GO LP1))
((OR (EQ X BUF)
(NULL X)) (* The NULL case should never happen,
but better be safe)
(RETURN B)))
(SETQ X (TTNEXTCHAR X))
(SUB1VAR N)
(GO LP)
LP1 (* Now advance X and B in parallel
until X reaches BUF, at which point B
is N before it)
(COND
((OR (EQ X BUF)
(NULL X))
(RETURN B)))
(SETQ X (TTNEXTCHAR X))
(SETQ B (TTNEXTCHAR B))
(GO LP1])
(TTNTH
[LAMBDA (BUF N) (* bvm: "12-Apr-85 12:52")
(* * Advances N real characters in BUF as far as the end of the line)
(bind (END ← (fetch END of \ARROW)) while (AND (NEQ N 0)
(NEQ BUF END)) do (SETQ BUF (TTNEXTCHAR BUF))
(SUB1VAR N)
finally (RETURN BUF])
(TTNTHLINE
[LAMBDA (N)
(DECLARE (USEDFREE \FIRSTLINE)) (* bvm: " 1-JUN-82 14:29")
(for (LINE ← \FIRSTLINE) do (COND
((ILEQ N 0)
(RETURN LINE))
(T (SETQ N (SUB1 N))
(SETQ LINE (OR (fetch NEXTLINE of LINE)
(RETURN LINE])
(TTPRIN1
[LAMBDA (STR) (* bvm: " 2-JUN-82 00:41")
(* * PRIN1 of STR, atom or string, directly to the terminal, bypassing any
dribble file)
(PROG [(N (COND
(\VARIABLEFONT (STRINGWIDTH STR \FONT))
(T (ITIMES (NCHARS STR)
\CHARWIDTH]
(COND
((IGEQ (IPLUS \CURSORCOL N)
\RMARG)
(TTCRLF)))
[for I from 1 do (TTBOUT (OR (NTHCHARCODE STR I)
(RETURN]
(add \CURSORCOL N])
(TTPRIN2
[LAMBDA (EXPR CARLVL CDRLVL) (* bvm: "26-SEP-83 12:38")
(SELECTQ (TYPENAME EXPR)
(STRINGP (TTPRIN1 (QUOTE %"))
(TTPRIN1 EXPR)
(TTPRIN1 (QUOTE %")))
(LITATOM (TTPRIN1 EXPR))
(LISTP (OR CARLVL (SETQ CARLVL 10))
(OR CDRLVL (SETQ CDRLVL 10))
[COND
((ILEQ CARLVL 0)
(TTPRIN1 (QUOTE &)))
(T (TTPRIN1 (QUOTE %())
[do (TTPRIN2 (CAR EXPR)
(SUB1 CARLVL)
(SUB1 CDRLVL))
(COND
((NLISTP (SETQ EXPR (CDR EXPR)))
(COND
(EXPR (TTPRIN1 " . ")
(TTPRIN2 EXPR)))
(RETURN))
(T (TTPRIN1 (QUOTE % ))
(COND
((ILEQ (SETQ CDRLVL (SUB1 CDRLVL))
0)
(TTPRIN1 "--")
(RETURN]
(TTPRIN1 (QUOTE %)])
(MAPC (UNPACK EXPR T RDTBL)
(QUOTE TTPRIN1])
(TTPROMPTCHAR
[LAMBDA (LINE) (* bvm: "11-MAR-81 21:43")
(* * Prints the prompt for indicated LINE)
(CLEAR.LINE?)
(COND
((SETQ LINE (COND
((EQ LINE \FIRSTLINE)
\PROMPT1)
(T \PROMPT2)))
(TTPRIN1 LINE])
(TTRATOM
[LAMBDA NIL (* bvm: "11-Apr-86 11:45")
(* * Reads next atom from BUFFER, advancing it suitably)
(COND
((EQ (TTSKIPSEPR)
\ENDBUFFER)
null)
(T (LET ((STRM (TTYINBUFFERSTREAM \BUFFER)))
(PROG1 (RATOM STRM RDTBL)
(SETQ \BUFFER (fetch TTYINPUT of STRM])
(TTREADLIST
[LAMBDA NIL (* bvm: "11-Apr-86 11:43")
(* * Read a list of elements. OPENCHAR is the character that started the list
(paren or bracket) or NIL if none.)
(LET ((STRM (TTYINBUFFERSTREAM \BUFFER \ENDBUFFER)))
(while (SKIPSEPRS STRM RDTBL) collect (READ STRM RDTBL])
(TTRUBOUT
[LAMBDA NIL (* bvm: "18-Apr-85 17:30")
(* * Delete the previous character -- this is the interpretation of DELETE
while inserting)
(COND
((NOT (AT.START.OF.LINE))
(BACKWARD.DELETE.TO (TTNLEFT \CURSOR 1)))
((OR (NOT (CAPABILITY? MOVEMENT))
(AT.START.OF.BUF))
(BEEP))
(T (* At start of line, backspace deletes
previous cr or char at end of previous
overflow line, so have to compute more
here)
(LET ((PREVL (PREVLINE \ARROW 1))
START)
(DELETE.LONG.SEGMENT1 PREVL (SETQ START (TTNLEFT \CURSOR 1 (fetch START of PREVL)))
\ARROW \CURSOR)
(MOVE.TO.WHEREVER START])
(TTSKIPSEPR
[LAMBDA (END) (* bvm: "11-Apr-85 15:13")
(* * Skip \BUFFER over any separator chars, returning new value)
(while (AND (NEQ \BUFFER \ENDBUFFER)
(NEQ \BUFFER END)
(SPACEP (FIRSTCHAR \BUFFER))) do (SETQ \BUFFER (TTNEXTCHAR \BUFFER)))
\BUFFER])
(TTSKREAD
[LAMBDA (BUF END) (* bvm: "10-Apr-86 18:18")
(OR END (SETQ END \ENDBUFFER))
(bind X while (NEQ BUF END)
do (* * Simulates READLINE starting at BUF, returning tail of BUF where the read
would terminate, or NIL if the read does not terminate before END
(default \ENDBUFFER))
[SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR BUF))
((LIST LEFTPAREN.RC LEFTBRACKET.RC)
(* open paren/bracket)
(SETQ X (CAR BUF))
(COND
((OR (NOT (SETQ BUF (TTSKREAD (CDR BUF)
END)))
(EQ BUF END)) (* paren/bracket not closed)
(RETURN))
((AND (EQ (CAR BUF)
(CHARCODE %]))
(NEQ X (CHARCODE %[))) (* left paren terminated by right
bracket)
(RETURN BUF))))
((LIST RIGHTPAREN.RC RIGHTBRACKET.RC)
(* closing paren/bracket)
(RETURN BUF))
(STRINGDELIM.RC
(COND
((NOT (SETQ BUF (FIND.MATCHING.QUOTE (CDR BUF)
END)))
(RETURN))))
(ESCAPE.RC (* % skip over without looking)
(COND
((EQ (SETQ BUF (CDR BUF))
END)
(RETURN))))
(MULTIPLE-ESCAPE.RC
(* Look for matching multiple escape,
respecting only single escapes along
the way)
(OR (while (NEQ (SETQ BUF (CDR BUF))
END) do (SELECTC (\SYNCODE \RDTBLSA (FIRSTCHAR BUF))
(ESCAPE.RC (COND
((EQ (SETQ BUF (CDR BUF))
END)
(RETURN))))
(MULTIPLE-ESCAPE.RC
(RETURN BUF))
NIL))
(RETURN)))
(OTHER.RC NIL)
(PROGN (* Some sort of macro.
Most we don't care about, but
semicolon is nasty)
(COND
((AND (EQ (FIRSTCHAR BUF)
(CHARCODE ;))
(READTABLEPROP RDTBL (QUOTE COMMONLISP)))
(* Skip ahead to end of line)
(COND
([do (COND
((EQ (SETQ BUF (CDR BUF))
END)
(RETURN T))
((EQ (FIRSTCHAR BUF)
(CHARCODE EOL))
(RETURN] (* Ended inside this comment, so not
complete -- just as if escaped)
(RETURN]
(SETQ BUF (CDR BUF)) finally (RETURN BUF])
(TTUNREADBUF
[LAMBDA NIL
(DECLARE (USEDFREE \CURSOR \ENDBUFFER)) (* bvm: "11-Apr-85 15:13")
(* * Takes contents of buffer from \CURSOR onward and "unreads" it, i.e.
erases it and simulates terminal input, a la BKSYSBUF)
(for (X ← \CURSOR) by (TTNEXTCHAR X) until (EQ X \ENDBUFFER) do (BKSYSCHARCODE (FIRSTCHAR X)))
(DELETE.TO.END])
(TTWAITFORINPUT
[LAMBDA (MSECS RETKEYFLG) (* kbr: "29-Jan-86 12:46")
(* Waits for mouse or keystroke. If MSECS is non-NIL, waits a maximum of that
many milliseconds. If RETKEYFLG is true, returns the input
(if there is some), otherwise just T without reading input.
Mouse buttons are returned as funny codes)
(GLOBALRESOURCE (\TTWAITBOX)
(PROG ((NOW (\CLOCK0 \TTWAITBOX))
(REG (DSPCLIPPINGREGION NIL \DSP))
W X Y FN ABSY NEWMARG)
LP [COND
((\SYSBUFP)
(\BOXIPLUS (LOCF (fetch (MISCSTATS KEYBOARDWAITTIME) of \MISCSTATS))
(CLOCKDIFFERENCE NOW))
(RETURN (COND
(RETKEYFLG (\GETKEY))
(T T]
(GETMOUSESTATE)
[COND
((AND (LASTMOUSESTATE (OR RED YELLOW BLUE))
(IGEQ (SETQ X (LASTMOUSEX \DSP))
0)
(ILESSP X (fetch (REGION WIDTH) of REG))
(IGEQ (SETQ Y (IDIFFERENCE (SETQ ABSY (LASTMOUSEY \DSP))
(fetch (REGION BOTTOM) of REG)))
0)
(ILESSP Y (IPLUS (fetch (REGION HEIGHT) of REG)
\CHARHEIGHT))
(SETQ W (WHICHW LASTMOUSEX LASTMOUSEY))
(EQ (WINDOWPROP W (QUOTE DSP))
\DSP)) (* Bugged inside this window)
(* The IPLUS is a grotesque kludge to include the title bar.
Problem is that REG needs to be the clipping region, not the window region,
because we get mouse coordinates in DSP terms, not window terms.
Damn Dedit typein buffer)
(* * The WHICHW test is so that we don't fight the scrollbar handler, or anyone
else who happens to be on top of this window.
Really should have monitorlock on mouse)
(COND
[(AND (NOT (EMPTY.BUFFER))
(ILESSP ABSY (IPLUS \BMARG (ITIMES (IDIFFERENCE \TTPAGELENGTH
\LOC.ROW.0)
\CHARHEIGHT)))
(ILESSP Y (fetch (REGION HEIGHT) of REG))
(IGEQ Y (IDIFFERENCE (ITIMES (IDIFFERENCE \TTPAGELENGTH
(IPLUS \LOC.ROW.0
(fetch (LINE ROW)
of (TTLASTLINE))
1))
\CHARHEIGHT)
4)))
(* Pointing inside text region. The second ILESSP is in case the text region
overflows the window, we still want title bar to be for menu)
(\BOXIPLUS (LOCF (fetch (MISCSTATS KEYBOARDWAITTIME) of \MISCSTATS))
(CLOCKDIFFERENCE NOW))
(COND
((NOT RETKEYFLG)
(RETURN T))
(T (DO.MOUSE)
(GO LP]
([AND \WINDOWWORLD (SETQ FN (COND
((LASTMOUSESTATE (ONLY BLUE))
(OR (fetch (TTYINBUFFER TTOLDRIGHTFN)
of \TTYINSTATE)
(FUNCTION DOWINDOWCOM)))
(T (fetch (TTYINBUFFER TTOLDBUTTONFN)
of \TTYINSTATE]
(* Pointing in our window, but outside
text--do regular button stuff)
(ERSETQ (APPLY* FN (WHICHW)))
(COND
((NEQ \RMARG (SETQ NEWMARG (DSPRIGHTMARGIN NIL \DSP)))
(* Window was reshaped)
(COND
((GREATERP \RMARG (SETQ \RMARG NEWMARG))
(* Window got narrower, so reprint)
(DO.EDIT.PP)))
(SETQ REG (DSPCLIPPINGREGION NIL \DSP]
(COND
((AND (FIXP MSECS)
(IGREATERP (CLOCKDIFFERENCE NOW)
MSECS))
(\BOXIPLUS (LOCF (fetch (MISCSTATS KEYBOARDWAITTIME) of \MISCSTATS))
(CLOCKDIFFERENCE NOW))
(RETURN NIL)))
(\TTYBACKGROUND)
(GO LP])
(TTYINSTRING
[LAMBDA (BUF TAIL) (* bvm: "16-Apr-86 15:44")
(* * Returns a string consisting of the "real" chars in buffer from BUF to TAIL
or end of buffer. If BUF = TAIL returns a null string)
(OR TAIL (SETQ TAIL \ENDBUFFER))
(LET ((NC 0)
FATP RESULT CH)
[for (X ← BUF) by (TTNEXTCHAR X) until (EQ X TAIL)
do (* First scan to see how long string
needs to be)
[COND
((EQ (\SYNCODE \RDTBLSA (SETQ CH (FIRSTCHAR X)))
ESCAPE.RC) (* % to quote next char)
(SETQ CH (FIRSTCHAR (SETQ X (CDR X]
(add NC 1)
(COND
((\FATCHARCODEP CH)
(SETQ FATP T]
(SETQ RESULT (ALLOCSTRING NC NIL NIL FATP))
(for (X ← BUF) by (TTNEXTCHAR X) until (EQ X TAIL) as I from 1
do [COND
((EQ (\SYNCODE \RDTBLSA (SETQ CH (FIRSTCHAR X)))
ESCAPE.RC) (* % to quote next char)
(SETQ CH (FIRSTCHAR (SETQ X (CDR X]
(RPLCHARCODE RESULT I CH))
RESULT])
(TYPE.BUFFER
[LAMBDA (START END) (* bvm: "17-Apr-85 17:00")
(* * Types buffer from START to END, returning number of chars typed.
Assumes no CR's)
(bind ($$VAL ← 0)
WIDTH CH while (NEQ START END) do [SETQ WIDTH (COND
((COMPLEXCHARP (SETQ CH (CAR START)))
(for PC
in (fetch CPXPRINTCHARS of CH)
do (TTBOUT PC))
(fetch CPXWIDTH of CH))
(T (TTBOUT CH)
(TTBITWIDTH CH]
(add \CURSORCOL WIDTH)
(add $$VAL WIDTH)
(SETQ START (CDR START])
(U-CASECODE
[LAMBDA (CHAR) (* bvm: "11-MAR-81 22:06")
(COND
([AND [NOT (ILESSP CHAR (CONSTANT (CHCON1 (QUOTE a]
(NOT (IGREATERP CHAR (CONSTANT (CHCON1 (QUOTE z]
(LOGAND CHAR 95))
(T CHAR])
(U/L-CASE
[LAMBDA (N CAPFLG)
(DECLARE (USEDFREE \CURSOR \ARROW)) (* bvm: "16-Apr-85 17:04")
(* * UPPER or lower-case N words. CAPFLG=T for uppercase;
CAPFLG=1 for just capitalization)
(COND
((AND (EQ N 1000)
(AT.END.OF.LINE))
(* $U or $L at end of line means do it to the whole line.
This handles the common situation where you have typed several words in the
wrong case and want to fix them without backing up to the beginning)
(MOVE.BACK.TO (fetch START of \ARROW)))
(T (MOVE.TO.START.OF.WORD))) (* Go to start of current word)
(PROG ((NEXTWD (CHECK.MARGIN (FIND.NEXT.WORD \CURSOR N)))
NEEDADJUST OLDLENGTH)
[COND
(\VARIABLEFONT (* Notice how long it is now)
(SETQ OLDLENGTH (SEGMENT.BIT.LENGTH \CURSOR NEXTWD]
(for (BUF ← (PROGN \CURSOR))
CHAR until (EQ BUF NEXTWD) do [COND
((AND [NOT (COMPLEXCHARP (SETQ CHAR (CAR BUF]
(IGREATERP CHAR 64))
(FRPLACA BUF (COND
(CAPFLG (COND
((EQ CAPFLG 1)
(* only raise first char of word)
(SETQ CAPFLG NIL)))
(U-CASECODE CHAR))
(T (L-CASECODE CHAR]
(SETQ BUF (TTNEXTCHAR BUF)))
[COND
(\VARIABLEFONT (SETQ NEEDADJUST (TTADJUSTWIDTH (IDIFFERENCE (SEGMENT.BIT.LENGTH \CURSOR
NEXTWD)
OLDLENGTH)
NEXTWD]
(TYPE.BUFFER \CURSOR (SETQ \CURSOR NEXTWD))
(COND
(NEEDADJUST (ADJUSTLINE.AND.RESTORE])
(WORD.MATCHES.BUFFER
[LAMBDA (WORD START BUFTAIL) (* bvm: "16-Apr-86 15:45")
(* * True if WORD matches case-insensitively chars in buffer from START to
BUFTAIL)
(for I from 1 as (BTAIL ← START) by (TTNEXTCHAR BTAIL) bind CHAR until (EQ BTAIL BUFTAIL)
always (OR (EQ (SETQ CHAR (NTHCHARCODE WORD I))
(CAR BTAIL))
(AND CHAR (EQ (LOGXOR CHAR 32)
(CAR BTAIL))
(IGEQ CHAR (CHARCODE A))
(ILEQ CHAR (CHARCODE z])
)
(RPAQQ TTDISPLAYFNS
(&DISPLAYCOMMENT CAPABILITY? BEEP BITBLT.DELETE BITBLT.ERASE BITBLT.INSERT DO.CRLF
DO.DELETE.LINES DO.DOWN DO.INSERT.LINE DO.LF DO.UP ERASE.TO.END.OF.LINE
ERASE.TO.END.OF.PAGE INSERT.TEXT TTDELSECTION TTADJUSTWIDTH TTINSERTSECTION TTSETCURSOR
))
(DEFINEQ
(&DISPLAYCOMMENT
[LAMBDA NIL (* bvm: " 8-Mar-80 16:37")
(* The display-dependent functions follow.
These are the functions to change to add new terminal types.
You'll probably also want to change DISPLAYTERMP to include the new type, or at
least set DISPLAYTYPES correctly. The types that TTYIN currently knows about,
together with their internal codes (the value of DISPLAYTERMFLG) are -
1: Datamedia -- can do anything asked in this package -
2: Heath -- can display anything, but has no edit key -
0: glass tty -- any terminal capable of at least backspacing and overprinting,
so that the sequence BS, SPACE, BS will delete a character.)
(* * The main body of TTYIN relies only on certain primitive operations,
encoded according to terminal type in the functions that follow.
It uses the function CAPABILITY? to decide whether the terminal can perform a
function it is considering)
(* * The functions included herein assume you are running no faster than
2400-baud. Some functions need considerably more padding at 9600-baud, although
if you're on tops20 in page mode the Heath will send ↑S and ↑Q to survive
anyway. The main thing that taxes the Heath is ADJUSTLINE trying to justify
several lines at once. DM has biggest problem with Insert Line)
])
(CAPABILITY?
[NLAMBDA (TYPE ON.DISPLAY.FLG) (* bvm: "19-MAR-81 12:06")
(* * true if terminal has the indicated capability.
This is a compiler macro that tests for appropriate values of DISPLAYTERMFLG;
if ON.DISPLAY.FLG is true, the macro may assume that DISPLAYTERMFLG is already
non-NIL. TYPE may be -
ERASE.TO.END -- terminal can erase to end of line -
\CURSOR -- terminal has addressable cursor -
MOVEMENT -- terminal permits cursor to move freely about page
(up, down, left, right); \CURSOR is assumed to imply MOVEMENT -
EDIT -- terminal can send EDIT bit (128) -
I/D.CHAR -- terminal has insert/delete character ability -
-
This package currently assumes that if the terminal can "edit" , i.e.
get into the edit-character routines, then it has ERASE.TO.END, as well as
insert/delete line, and preferably \CURSOR as well.
For just "glass tty" operation, existence of ERASE.TO.END and \CURSOR are the
only relevant things; they may optimize large deletes
(↑Q and ↑W)%. Minimal display requirement is physical backspace;
otherwise DISPLAYTERMFLG must be NIL.)
(SELECTQ TYPE
(MOVEMENT T)
(ERASE.TO.END T)
(I/D.CHAR T)
(\CURSOR T)
NIL])
(BEEP
[LAMBDA (DS) (* bvm: "27-JUL-83 23:20")
(RESETFORM (VIDEOCOLOR (NOT (VIDEOCOLOR)))
(DISMISS 200])
(BITBLT.DELETE
[LAMBDA (X Y WIDTH) (* bvm: " 1-JUN-82 16:34")
(PROG ((MOVEDWIDTH (IDIFFERENCE (IDIFFERENCE \RMARG X)
WIDTH))) (* First move everything from the
right over to cursor pos)
(BITBLT \DSP (IPLUS X WIDTH)
Y \DSP X Y MOVEDWIDTH \CHARHEIGHT (QUOTE INPUT)
(QUOTE REPLACE)) (* then delete the last WIDTH
positions on the line.
May be unnecessary if they were
already blank, might want to check
LASTCOL)
(BITBLT.ERASE (IPLUS X MOVEDWIDTH)
Y WIDTH \CHARHEIGHT])
(BITBLT.ERASE
[LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* bvm: " 1-JUN-82 15:10")
(BITBLT NIL NIL NIL \DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
\TEXTURE])
(BITBLT.INSERT
[LAMBDA (X Y WIDTH) (* bvm: " 5-SEP-83 17:41")
(BITBLT \DSP X Y \DSP (IPLUS X WIDTH)
Y
(IDIFFERENCE (IDIFFERENCE \RMARG X)
WIDTH)
\CHARHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT.ERASE X Y WIDTH \CHARHEIGHT])
(DO.CRLF
[LAMBDA NIL (* bvm: " 2-MAR-82 22:38")
(SETQ \CURRENTDISPLAYLINE 0) (* Avoid stop scroll nonsense)
(\DSPPRINTCR/LF (CHARCODE CR)
\DSP])
(DO.DELETE.LINES
[LAMBDA (#LINES) (* bvm: "20-Mar-84 13:53")
(PROG ((TOTALHEIGHT (IDIFFERENCE (IPLUS (IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)
\CHARHEIGHT)
\BMARG))
(DELHEIGHT (ITIMES #LINES \CHARHEIGHT))) (* TOTALHEIGHT is distance from top of
current line to bottom of window.
DELHEIGHT is height of lines being
removed.)
[COND
((IGREATERP DELHEIGHT TOTALHEIGHT) (* Delete everything from here down)
(SETQ DELHEIGHT TOTALHEIGHT))
(T (BITBLT \DSP 0 \BMARG \DSP 0 (IPLUS \BMARG DELHEIGHT)
\RMARG
(IDIFFERENCE TOTALHEIGHT DELHEIGHT)
(QUOTE INPUT)
(QUOTE REPLACE]
(BITBLT.ERASE 0 \BMARG \RMARG DELHEIGHT])
(DO.DOWN
[LAMBDA (#LINES) (* bvm: "25-AUG-81 00:24")
(* LF works on all terminals I know
about)
(RELMOVETO 0 (IMINUS (ITIMES #LINES \CHARHEIGHT))
\DSP])
(DO.INSERT.LINE
[LAMBDA NIL (* bvm: "20-Mar-84 14:35")
(* * Inserts a new line on screen in front of current cursor row.
The trickiness here is that unless there are some blank lines at the bottom of
the screen, we actually have to scroll upwards before we can insert downwards,
lest we lose the bottom line. Leaves cursor at start of new blank line.)
(PROG ((DY (IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)))
[COND
((EQ (IPLUS \LOC.ROW.0 (fetch ROW of (TTLASTLINE))
1)
\TTPAGELENGTH) (* Bottom line is occupied, so scroll
stuff above us upward)
(add DY \CHARHEIGHT)
(MOVETO (DSPXPOSITION NIL \DSP)
(IPLUS DY \DESCENT)
\DSP)
(BITBLT \DSP 0 DY \DSP 0 (IPLUS DY \CHARHEIGHT)
\RMARG
(IDIFFERENCE (fetch (REGION TOP) of (DSPCLIPPINGREGION NIL \DSP))
(IPLUS DY \CHARHEIGHT))
(QUOTE INPUT)
(QUOTE REPLACE))
(SETQ \LOC.ROW.0 (SUB1 \LOC.ROW.0)) (* Top line of buffer has moved up one)
)
(T (* Shove everything at or below
current line down one)
(BITBLT \DSP 0 (IPLUS \BMARG \CHARHEIGHT)
\DSP 0 \BMARG \RMARG (IDIFFERENCE DY \BMARG)
(QUOTE INPUT)
(QUOTE REPLACE] (* and clear this line)
(BITBLT.ERASE 0 DY \RMARG \CHARHEIGHT])
(DO.LF
[LAMBDA NIL (* bvm: "25-AUG-81 00:25")
(\DSPPRINTCR/LF (CHARCODE LF)
\DSP])
(DO.UP
[LAMBDA (#LINES) (* bvm: "25-AUG-81 00:25")
(RELMOVETO 0 (ITIMES #LINES \CHARHEIGHT)
\DSP])
(ERASE.TO.END.OF.LINE
[LAMBDA NIL (* bvm: "25-AUG-81 00:27")
(PROG ((X (DSPXPOSITION NIL \DSP)))
(BITBLT.ERASE X (IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)
(IDIFFERENCE \RMARG X)
\CHARHEIGHT])
(ERASE.TO.END.OF.PAGE
[LAMBDA NIL (* bvm: "20-Mar-84 13:44")
(* * Erases from current cursor position to end of page.)
(ERASE.TO.END.OF.LINE)
(PROG ((BELOW (IDIFFERENCE (IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)
\BMARG)))
(COND
((IGREATERP BELOW 0)
(BITBLT.ERASE 0 \BMARG \RMARG BELOW])
(INSERT.TEXT
[LAMBDA (START END ENDOFLINE) (* bvm: " 4-JUN-82 13:43")
(* * Inserts on screen the contents of buffer from START to END.
Text from END to ENDOFLINE is the remainder of the line, in case it's more
economical to just retype the line than do the insertion)
(COND
((EQ END ENDOFLINE)
(TYPE.BUFFER START ENDOFLINE))
(T (TTINSERTSECTION (SEGMENT.BIT.LENGTH START END))
(TYPE.BUFFER START END])
(TTDELSECTION
[LAMBDA (WIDTH) (* bvm: " 1-JUN-82 16:43")
(* * Deletes WIDTH bits at current pos)
(BITBLT.DELETE (DSPXPOSITION NIL \DSP)
(IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)
WIDTH])
(TTADJUSTWIDTH
[LAMBDA (DELTA END) (* bvm: "12-Apr-85 12:52")
(* Expand or shrink line at current cursorpos by DELTA.
END, if supplied, is the end of the section being adjusted;
if it is the end of the current line, then it is assumed that expansion is
cheap. Returns true if anything was done)
(COND
((NEQ DELTA 0)
(COND
((ILESSP DELTA 0) (* Line has shrunk)
(TTDELSECTION (IMINUS DELTA)))
((NEQ END (fetch END of \ARROW)) (* Line has expanded, so need to
spread it if not at the end)
(TTINSERTSECTION DELTA)))
(add (fetch LASTCOL of \ARROW)
DELTA)
T])
(TTINSERTSECTION
[LAMBDA (WIDTH) (* bvm: " 1-JUN-82 14:15")
(* * Inserts WIDTH character positions, leaving cursor at start of insertion)
(BITBLT.INSERT (DSPXPOSITION NIL \DSP)
(IDIFFERENCE (DSPYPOSITION NIL \DSP)
\DESCENT)
WIDTH])
(TTSETCURSOR
[LAMBDA (COL ROW) (* bvm: " 1-JUN-82 22:56")
(* * Sets cursor to absolute screen position COL,ROW)
(MOVETO (IPLUS COL \LMARG)
(IPLUS (ITIMES (SUB1 (IDIFFERENCE \TTPAGELENGTH ROW))
\CHARHEIGHT)
\BMARG)
\DSP])
)
(* TTYINBUFFERSTREAM)
(DEFINEQ
(TTYINBUFFERDEVICE
[LAMBDA NIL (* bvm: "11-Apr-86 11:43")
(* * Defines a device for streams that read from the ttyin buffer.
Modeled after the null device except for the interesting parts)
(create FDEV
DEVICENAME ← (QUOTE TTYIN)
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
CLOSEFILE ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
OPENFILE ← (FUNCTION \NULL.OPENFILE)
REOPENFILE ← (FUNCTION \NULL.OPENFILE)
BIN ← (FUNCTION TTYINBUFFERBIN)
BOUT ← (FUNCTION NILL)
PEEKBIN ← (FUNCTION TTYINBUFFERPEEK)
READP ← (FUNCTION TTYINBUFFERREADP)
BACKFILEPTR ← (FUNCTION TTYINBUFFERBACKPTR)
EOFP ← (FUNCTION TTYINBUFFEREOFP)
RENAMEFILE ← (FUNCTION NILL)
GETFILENAME ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
BLOCKIN ← (FUNCTION \EOF.ACTION)
BLOCKOUT ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \NULLFILEGENERATOR)
GETFILEPTR ← (FUNCTION ZERO)
GETEOFPTR ← (FUNCTION ZERO)
SETFILEPTR ← (FUNCTION NILL)
GETFILEINFO ← (FUNCTION NILL)
SETFILEINFO ← (FUNCTION NILL)
SETEOFPTR ← (FUNCTION NILL])
(TTYINBUFFERSTREAM
[LAMBDA (BUF END EOFACTION) (* bvm: "11-Apr-86 11:43")
(LET [(STRM (OR \TTYINBUFFERSTREAM (SETQ \TTYINBUFFERSTREAM (create STREAM
DEVICE ← TTYINBUFFERDEVICE
ACCESS ← (QUOTE INPUT]
(replace TTYINPUT of STRM with BUF)
(replace TTYEOF of STRM with (OR END \ENDBUFFER))
(replace TTYEOFACTION of STRM with EOFACTION)
(replace TTYORIGINPUT of STRM with BUF)
STRM])
(TTYINBUFFERBIN
[LAMBDA (STRM) (* bvm: "11-Apr-86 11:46")
(LET ((BUF (fetch TTYINPUT of STRM)))
(COND
((EQ BUF (fetch TTYEOF of STRM)) (* Eof)
(\EOF.ACTION STRM))
(T (PROG1 (FIRSTCHAR BUF)
(replace TTYINPUT of STRM with (CDR BUF])
(TTYINBUFFERPEEK
[LAMBDA (STREAM NOERRORFLG) (* bvm: "11-Apr-86 11:46")
(LET ((BUF (fetch TTYINPUT of STREAM)))
(COND
((EQ BUF (fetch TTYEOF of STREAM)) (* Eof)
(AND (NOT NOERRORFLG)
(\EOF.ACTION STREAM)))
(T (FIRSTCHAR BUF])
(TTYINBUFFERREADP
[LAMBDA (STRM) (* bvm: "11-Apr-86 11:46")
(NEQ (fetch TTYINPUT of STRM)
(fetch TTYEOF of STRM])
(TTYINBUFFEREOFP
[LAMBDA (STRM) (* bvm: "11-Apr-86 11:46")
(EQ (fetch TTYINPUT of STRM)
(fetch TTYEOF of STRM])
(TTYINBUFFERBACKPTR
[LAMBDA (STRM) (* bvm: "11-Apr-86 11:43")
(* * Back up STRM one. Needed because of top-level READ.
What a kludge)
(replace TTYINPUT of STRM with (OR (NLEFT (fetch TTYORIGINPUT of STRM)
1
(fetch TTYINPUT of STRM))
(fetch TTYINPUT of STRM])
(TTYINWORDRDTBL
[LAMBDA NIL (* bvm: "11-Apr-86 11:22")
(* * Makes a table in which normal Lisp syntax characters are just break
characters. Additionally, comma is a break)
(LET [(TBL (COPYREADTABLE (QUOTE ORIG)))
(BREAKS (CHARCODE (%( %) %[ %] %" ,]
(SETSEPR (CHARCODE (SPACE TAB CR))
NIL TBL)
(SETSEPR BREAKS 1 TBL) (* Have to disable their regular
meanings before making them pure break
chars)
(SETBRK BREAKS NIL TBL)
(SETSYNTAX (CHARCODE %%)
(QUOTE OTHER)
TBL) (* No escape char)
TBL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ TTYINBUFFERDEVICE (TTYINBUFFERDEVICE))
(RPAQ TTYINWORDRDTBL (TTYINWORDRDTBL))
)
(* Mouse handling)
(DEFINEQ
(DO.MOUSE
[LAMBDA NIL (* bvm: "20-Apr-85 16:15")
(* Called when mouse is clicked down inside of our region;
performs it as an edit command, returning T, or returns NIL if it is not a
legal mouse call. The commands that actually change something display their
intent while the button is down and are not actually executed until button is
released.)
(COND
((OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))
(KEYDOWNP (QUOTE CTRL))
(KEYDOWNP (QUOTE MOVE))
(KEYDOWNP (QUOTE COPY)))
(DO.SHIFTED.SELECTION))
[(LASTMOUSESTATE (ONLY RED)) (* Position cursor)
(bind ROW/COL while (SETQ ROW/COL (TTRACKMOUSE ROW/COL)) when (LISTP ROW/COL)
do (\CHECKCARET \DSP)
(MOVE.TO.LINE (CAR ROW/COL)
(CDR ROW/COL]
[(LASTMOUSESTATE (ONLY YELLOW)) (* Position cursor by word)
(bind NEWPOS BUF COL LINE while (SETQ NEWPOS (TTRACKMOUSE NEWPOS)) when (LISTP NEWPOS)
do (\CHECKCARET \DSP)
[SETQ BUF (BRACKET.CURRENT.WORD (SETQ LINE (fetch ROWPOS of NEWPOS))
(SETQ COL (fetch COLPOS of NEWPOS]
(MOVE.TO.LINE LINE (COND
((IGREATERP (SEGMENT.BIT.LENGTH (CAR BUF)
COL)
(SEGMENT.BIT.LENGTH COL (CDR BUF)))
(CDR BUF))
(T (CAR BUF]
((LASTMOUSESTATE (ONLY BLUE)) (* zap from cursor to mouse location.)
(DO.SHIFTED.SELECTION (QUOTE DELETE])
(DO.SHIFTED.SELECTION
[LAMBDA (INITMODE) (* bvm: "20-Apr-85 16:14")
(bind START END SAVE EXTENDING MODE NEWSTART NEWEND COL NEWROW NEWMODE BUF NEWPOS WORDLEVEL
ENDLINE while (OR [SETQ NEWMODE (COND
((KEYDOWNP (QUOTE MOVE))
(QUOTE MOVE))
((KEYDOWNP (QUOTE COPY))
(QUOTE COPY))
[(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
(COND
((KEYDOWNP (QUOTE CTRL))
(QUOTE MOVE))
(T (QUOTE COPY]
((KEYDOWNP (QUOTE CTRL))
(QUOTE DELETE]
(LASTMOUSESTATE (NOT UP)))
do (SETQ NEWPOS (TTRACKMOUSE NEWPOS))
(\TTYBACKGROUND) (* Flash caret)
(COND
[(LASTMOUSESTATE (OR RED YELLOW)) (* Start new selection)
(COND
[(AND (LISTP NEWPOS)
(NEQ (SETQ COL (fetch COLPOS of NEWPOS))
\ENDBUFFER)) (* There is a selection)
(SETQ NEWSTART (create MOUSEPOS using NEWPOS))
(SETQ NEWROW (fetch ROWPOS of NEWPOS))
(COND
((OR (LASTMOUSESTATE (ONLY RED))
(EQ COL (fetch END of NEWROW))) (* Selection extends to next char)
(SETQ NEWEND (TTNEXTPOS NEWROW COL))
(SETQ WORDLEVEL NIL))
(T (* Selection is current "word")
(SETQ BUF (BRACKET.CURRENT.WORD NEWROW (fetch COLPOS of NEWSTART)))
(replace COLPOS of NEWSTART with (CAR BUF))
(* Start of previous word)
(SETQ NEWEND (create MOUSEPOS
ROWPOS ← NEWROW
COLPOS ← (CDR BUF)))
(SETQ WORDLEVEL T]
(T (SETQ NEWSTART NIL)))
(COND
((OR (NEQPOS START NEWSTART)
(NEQPOS END NEWEND)
(NEQ MODE NEWMODE))
(COND
(START (* turn off old selection)
(INVERT.LONG.SEGMENT START END MODE)))
(COND
((SETQ START NEWSTART)
(INVERT.LONG.SEGMENT START (SETQ END NEWEND)
(SETQ MODE NEWMODE]
[(LASTMOUSESTATE (ONLY BLUE)) (* Extend selection)
[COND
((NOT START) (* No selection, extend from cursor)
[SETQ NEWSTART (SETQ NEWEND (SETQ START (SETQ END
(create MOUSEPOS
ROWPOS ← \ARROW
COLPOS ← \CURSOR]
(SETQ WORDLEVEL (SETQ EXTENDING NIL))
(COND
(INITMODE (SETQ MODE INITMODE) (* E.g. in DO.MOUSE on BLUE)
(SETQ INITMODE))
(T (SETQ MODE NEWMODE]
(SETQ NEWROW (fetch ROWPOS of NEWPOS))
(COND
[(NLISTP NEWPOS) (* No selection; cancel any existing
extension)
(COND
(EXTENDING (COND
((NEQPOS START NEWSTART)
(INVERT.LONG.SEGMENT NEWSTART START MODE)
(SETQ NEWSTART START))
((NEQPOS END NEWEND)
(INVERT.LONG.SEGMENT END NEWEND MODE)
(SETQ NEWEND END)))
(SETQ EXTENDING NIL]
(T (COND
((TTBEFOREPOS NEWPOS START) (* Extending to left of original
selection)
(COND
((AND EXTENDING (NEQPOS END NEWEND))
(* We were extending to right, so
switch)
(INVERT.LONG.SEGMENT END NEWEND MODE)
(SETQ NEWEND END)))
(INVERT.LONG.SEGMENT NEWSTART (SETQ NEWSTART (create MOUSEPOS using NEWPOS))
MODE))
(T (* Extending to right)
(COND
((AND EXTENDING (NEQPOS START NEWSTART))
(* We were extending to left, so
switch)
(INVERT.LONG.SEGMENT START NEWSTART MODE)
(SETQ NEWSTART START)))
(INVERT.LONG.SEGMENT NEWEND (SETQ NEWEND (TTNEXTPOS NEWROW
(fetch COLPOS of NEWPOS)))
MODE)))
(SETQ EXTENDING T]
(EXTENDING (* End of extension, make NEWSTART/END
permanent)
(SETQ START NEWSTART)
(SETQ END NEWEND)
(SETQ EXTENDING NIL)))
finally (COND
(START (* There is a selection, so do it)
(\CHECKCARET \DSP)
(PROG ((STARTBUF (fetch COLPOS of START))
(ENDBUF (fetch COLPOS of END)))
(COND
[(EQ MODE (QUOTE COPY))
(INVERT.LONG.SEGMENT START END MODE)
(* Take it as typein)
(COND
((BEFOREBUF STARTBUF \CURSOR ENDBUF)
(* Can't just unread, because
structure will change as we do so)
(READFROMBUF (COPY.SEGMENT STARTBUF ENDBUF)))
(T (READFROMBUF STARTBUF ENDBUF T]
((AND (EQ MODE (QUOTE MOVE))
(BEFOREBUF STARTBUF \CURSOR ENDBUF))
(* Action overlaps cursor, so effect
is just to move cursor)
(INVERT.LONG.SEGMENT START END MODE)
(MOVE.TO.LINE (fetch ROWPOS of END)
ENDBUF))
(T
(* Delete or move selection, insert it as typein at cursor for the latter.
We save away the selection in \LAST.DELETION to be restored later if desired)
(SETQ SAVE (COND
((BEFOREBUF STARTBUF \CURSOR ENDBUF)
(* The delete will move \CURSOR into
trash heap)
STARTBUF)
(T \CURSOR)))
(SETQ \LAST.DELETION (SETQ BUF (COPY.SEGMENT STARTBUF ENDBUF)))
(* Save selection)
(DELETE.LONG.SEGMENT START END)
(MOVE.TO.WHEREVER SAVE) (* Come back to where cursor is
(may have moved))
(AND (EQ MODE (QUOTE MOVE))
(READFROMBUF BUF NIL T])
(COPY.SEGMENT
[LAMBDA (START END) (* bvm: " 4-DEC-81 17:04")
(for (TAIL ← START) by (CDR TAIL) until (EQ TAIL END) collect (CAR TAIL])
(DELETE.LONG.SEGMENT
[LAMBDA (START END) (* bvm: "15-JUN-82 17:59")
(DELETE.LONG.SEGMENT1 (fetch ROWPOS of START)
(fetch COLPOS of START)
(fetch ROWPOS of END)
(fetch COLPOS of END])
(DELETE.LONG.SEGMENT1
[LAMBDA (STARTLINE STARTCOL ENDLINE ENDCOL) (* bvm: "12-Apr-85 12:53")
(PROG (FIRSTLINE NEXTLINE NROWS)
(COND
((EQ (SETQ NROWS (IDIFFERENCE (fetch ROW of ENDLINE)
(fetch ROW of STARTLINE)))
0) (* All on one line)
(MOVE.TO.LINE STARTLINE STARTCOL)
(FORWARD.DELETE.TO ENDCOL))
(T (MOVE.TO.LINE (SETQ FIRSTLINE (fetch NEXTLINE of STARTLINE)))
(DO.DELETE.LINES NROWS) (* Delete excess lines)
(SETQ NEXTLINE (fetch NEXTLINE of ENDLINE))
(replace NEXTLINE of STARTLINE with NEXTLINE)
(RENUMBER.LINES NEXTLINE (ADD1 (fetch ROW of STARTLINE)))
[add (fetch LASTCOL of STARTLINE)
(IDIFFERENCE (SEGMENT.BIT.LENGTH ENDCOL (fetch END of ENDLINE))
(SEGMENT.BIT.LENGTH STARTCOL (fetch END of STARTLINE]
(replace END of STARTLINE with (fetch END of ENDLINE))
(COND
((EQ ENDCOL (fetch END of STARTLINE))
(replace END of STARTLINE with STARTCOL)))
(KILLSEGMENT STARTCOL ENDCOL)
(replace NEXTLINE of ENDLINE with NIL)
(KILL.LINES FIRSTLINE)
(MOVE.TO.LINE STARTLINE STARTCOL)
(ERASE.TO.END.OF.LINE)
(COND
((ILESSP (fetch LASTCOL of STARTLINE)
\RMARG)
(TYPE.BUFFER STARTCOL (fetch END of STARTLINE)))
(T (TYPE.BUFFER STARTCOL (NTH.COLUMN.OF STARTLINE \RMARG))
(ADJUSTLINE NIL STARTLINE])
(INVERT.LONG.SEGMENT
[LAMBDA (START END MODE) (* bvm: "25-FEB-82 15:57")
(COND
((NOT (EQPOS START END))
(OR (TTBEFOREPOS START END)
(swap START END))
(PROG ((COL (fetch COLPOS of START))
(ROW (fetch ROWPOS of START)))
(while (NEQ ROW (fetch ROWPOS of END)) do (INVERT.SEGMENT COL
(fetch START
of (fetch NEXTLINE of ROW))
ROW MODE T)
(SETQ ROW (fetch NEXTLINE of ROW))
(SETQ COL (fetch START of ROW)))
(INVERT.SEGMENT COL (fetch COLPOS of END)
ROW MODE T])
(INVERT.SEGMENT
[LAMBDA (START END LINE MODE NOSWAP)
(DECLARE (USEDFREE \ARROW \CHARWIDTH \LOC.ROW.0 \CHARHEIGHT \BMARG \LMARG))
(* bvm: "20-Apr-85 16:11")
(COND
((NEQ START END)
(OR LINE (SETQ LINE \ARROW))
(OR MODE (SETQ MODE (QUOTE DELETE)))
(OR NOSWAP (BEFOREBUF START END (fetch END of LINE))
(swap START END))
(PROG ((LEFT (IPLUS (fetch FIRSTCOL of LINE)
(SEGMENT.BIT.LENGTH (fetch START of LINE)
START)
\LMARG))
(BOTTOM (IPLUS (ITIMES (SUB1 (IDIFFERENCE (IDIFFERENCE \TTPAGELENGTH \LOC.ROW.0)
(fetch ROW of LINE)))
\CHARHEIGHT)
\BMARG
(IMINUS \DESCENT)))
(WIDTH (SEGMENT.BIT.LENGTH START END)))
(BITBLT NIL NIL NIL \DSP LEFT BOTTOM WIDTH (COND
((NEQ MODE (QUOTE COPY))
\CHARHEIGHT)
(T 2))
(QUOTE TEXTURE)
(QUOTE INVERT)
(COND
((NEQ MODE (QUOTE COPY))
BLACKSHADE)
(T DOTSHADE)))
(COND
((EQ MODE (QUOTE MOVE))
(BITBLT NIL NIL NIL \DSP LEFT BOTTOM WIDTH 2 (QUOTE TEXTURE)
(QUOTE INVERT)
DOTSHADE])
(BRACKET.CURRENT.WORD
[LAMBDA (LINE COL) (* bvm: "11-Apr-85 15:14")
(* * Return dotted pair of columns indicating start and end of "word"
containing buffer position COL of LINE)
(PROG ((INSPACES T)
(ENDLINE (fetch END of LINE))
(WSTART (fetch START of LINE))
FIRSTCOL LASTCOL)
(for (BUF ← WSTART) by (TTNEXTCHAR BUF) until (EQ BUF ENDLINE)
do [COND
([NEQ INSPACES (SETQ INSPACES (WORDSEPRP (FIRSTCHAR BUF]
(* Change of state)
(COND
(FIRSTCOL (* Done)
(RETURN (SETQ LASTCOL BUF)))
(T (* Still looking for COL, note start
of word)
(SETQ WSTART BUF]
(COND
((EQ BUF COL)
(SETQ FIRSTCOL WSTART))) finally (* Got to end before word ended)
(SETQ LASTCOL ENDLINE)
(OR FIRSTCOL (SETQ FIRSTCOL LASTCOL)))
(OR (BEFOREBUF FIRSTCOL COL LASTCOL)
(HELP))
(RETURN (CONS FIRSTCOL LASTCOL])
(TTBEFOREPOS
[LAMBDA (X Y) (* bvm: " 2-MAR-82 13:18")
(COND
[(EQ (fetch ROWPOS of X)
(fetch ROWPOS of Y))
(AND (NEQ (fetch COLPOS of X)
(fetch COLPOS of Y))
(BEFOREBUF (fetch COLPOS of X)
(fetch COLPOS of Y)
(fetch END of (fetch ROWPOS of X]
(T (ILESSP (fetch ROW of (fetch ROWPOS of X))
(fetch ROW of (fetch ROWPOS of Y])
(TTNEXTPOS
[LAMBDA (LINE COL) (* bvm: "25-FEB-82 16:04")
(* * Makes a MOUSEPOS out of the position, if any, immediately after COL of
LINE)
(COND
((AND (EQ COL (fetch END of LINE))
(NEQ COL \ENDBUFFER))
(create MOUSEPOS
ROWPOS ← (SETQ LINE (fetch NEXTLINE of LINE))
COLPOS ← (fetch START of LINE)))
(T (create MOUSEPOS
ROWPOS ← LINE
COLPOS ← (COND
((EQ COL \ENDBUFFER)
COL)
(T (TTNEXTCHAR COL])
(TTRACKMOUSE
[LAMBDA (OLDROW/COL) (* bvm: "16-Apr-85 17:07")
(DECLARE (USEDFREE \VARIABLEFONT \DSP \TTPAGELENGTH \LOC.ROW.0 \BMARG \CHARHEIGHT \LMARG \RMARG
\FONT))
(* Follows the mouse, returning whenever its row/col changes or the user lets
up the mouse buttons. Converts mouse coordinates into a dotted pair
(LINE . BUFPOS) indicating what char is being pointed at, or T if outside range
of text. Returns NIL when user lets go. OLDROW/COL is the previous value of
this routine, which we may smash.)
(PROG (OLDX OLDY ROW COL OLDROW OLDCOL CURSORPOS)
[COND
((LISTP OLDROW/COL)
(SETQ OLDROW (CAR OLDROW/COL))
(SETQ OLDCOL (CDR OLDROW/COL]
LP (COND
((MOUSESTATE UP) (* everything up)
(RETURN)))
(SETQ CURSORPOS (CURSORPOSITION NIL \DSP CURSORPOS))
[COND
((OR (NEQ (CAR CURSORPOS)
OLDX)
(NEQ (CDR CURSORPOS)
OLDY)) (* Cursor moved)
[SETQ ROW (SUB1 (IDIFFERENCE (IDIFFERENCE \TTPAGELENGTH \LOC.ROW.0)
(IQUOTIENT (IDIFFERENCE (SETQ OLDY (CDR CURSORPOS))
\BMARG)
\CHARHEIGHT]
(SETQ OLDX (CAR CURSORPOS))
(COND
[(AND (IGEQ OLDX \LMARG)
(ILESSP OLDX \RMARG)
(IGEQ ROW 0))
(SETQ ROW (TTNTHLINE ROW))
[SETQ COL (COND
(\VARIABLEFONT (SETQ COL (IDIFFERENCE (IDIFFERENCE OLDX \LMARG)
(fetch FIRSTCOL of ROW)))
(bind WIDTH CH (BUF ← (fetch START of ROW))
(END ← (fetch END of ROW)) while (NEQ BUF END)
do [SETQ WIDTH (COND
((COMPLEXCHARP (SETQ CH (CAR BUF)))
(fetch CPXWIDTH of CH))
(T (FCHARWIDTH CH \FONT]
(COND
((ILESSP COL (LRSH WIDTH 1))
(RETURN BUF)))
(SETQ COL (IDIFFERENCE COL WIDTH))
(SETQ BUF (TTNEXTCHAR BUF)) finally (RETURN BUF)))
(T (NTH.COLUMN.OF ROW (IDIFFERENCE OLDX \LMARG]
(COND
((OR (NEQ ROW OLDROW)
(NEQ COL OLDCOL))
(RETURN (COND
((LISTP OLDROW/COL)
(FRPLNODE OLDROW/COL ROW COL))
(T (CONS ROW COL]
(T (COND
((NEQ OLDROW/COL T)
(RETURN T]
(\TTYBACKGROUND)
(GO LP])
)
(* Support functions. These are all macros or for debugging)
(RPAQQ TTSUPPORTFNS (INPART TTBOUT TTBOUTN PR! PRALL PRBUF PRLINE))
(DEFINEQ
(INPART
[LAMBDA (X) (* bvm: " 3-Jul-78 12:27")
(* Given a "word" from the spelling list, returns that which would be input to
TTYIN, i.e. if a dotted synonym pair, its CAR, else the word itself)
(COND
((LISTP X)
(CAR X))
(T X])
(TTBOUT
[NLAMBDA CHARS (* bvm: "25-AUG-81 00:31")
(* Prints one or more characters to the terminal.
Arguments may be: a number, an atom on DMCHARCODES, or a single character;
any other arg is simply evaluated)
(for $CH in CHARS do (BLTCHAR (LOGAND (COND
((FIXP $CH)
$CH)
((CDR (FASSOC $CH DMCHARCODES)))
((EQ (NCHARS $CH)
1)
(CHCON1 $CH))
(T (EVAL $CH)))
127)
\DSP)
(COND
((FIXP TTCLOCK) (* Slows down transmission rate for
debugging)
(DISMISS TTCLOCK])
(TTBOUTN
[NLAMBDA $NCHARS (* bvm: " 4-Mar-80 01:35")
(FRPTQ (EVAL (CAR $NCHARS))
(APPLY (QUOTE TTBOUT)
(CDR $NCHARS])
(PR!
[LAMBDA NIL (* bvm: "17-Aug-78 01:23")
(for X in BUFFIELDS do (SPACES 2)
(PRIN1 (SETQ X (CAR X)))
(PRIN1 ": ")
(COND
((NLISTP (SETQ X (APPLY* (QUOTE !)
X)))
(PRINT X))
((SMALLP (CAR X))
(PRBUF X))
((LISTP (CAR X))
(PRLINE X))
(T (PRINT X))) when (IGREATERP (CADR X)
2])
(PRALL
[LAMBDA NIL
(DECLARE (USEDFREE \FIRSTLINE)) (* bvm: "19-MAR-81 12:45")
(for (LINE ← \FIRSTLINE) by (fetch NEXTLINE of LINE) while LINE do (PRLINE LINE)
(TERPRI])
(PRBUF
[LAMBDA (BUF END N) (* bvm: "16-Apr-85 17:43")
[OR N (SETQ N (COND
(END 82)
(T 15]
(PRIN1 (QUOTE {))
(for I from 1 to N while (AND BUF (NEQ BUF END)) bind X CH
do [COND
[[NOT (COMPLEXCHARP (SETQ CH (CAR BUF]
(PRIN1 (COND
((SMALLP CH)
(FCHARACTER CH))
(T (RETURN (PRINT (QUOTE garbage]
[[LISTP (CDR (LISTP (CDR CH]
(PRIN1 (QUOTE '))
[COND
((ILESSP (SETQ X (fetch CPXREALCHAR of CH))
(CHARCODE SPACE))
(PRIN1 (QUOTE ↑))
(SETQ X (LOGOR X 64]
(PRIN1 (FCHARACTER X))
(PRIN1 (QUOTE %"))
(for X in (fetch CPXPRINTCHARS of CH) do (PRIN1 (FCHARACTER X]
(T (RETURN (PRINT (QUOTE garbage]
(SETQ BUF (CDR BUF)) finally [COND
((AND BUF (NEQ BUF END))
(PRIN1 (QUOTE --]
(PRIN1 (QUOTE }))
(TERPRI])
(PRLINE
[LAMBDA (LINE) (* bvm: "25-AUG-81 17:29")
(PROG ((POS (POSITION T)))
(COND
((NOT LINE)
(SETQ LINE \ARROW)
(PRIN1 "(defaulting)
")))
(TAB POS T)
[PRIN1 (COND
((EQ LINE (EVALV (QUOTE \ARROW)))
(QUOTE ←))
(T (QUOTE % ]
(PRIN1 "Start: ")
(PRBUF (fetch START of LINE)
(fetch END of LINE))
(TAB POS T)
(PRIN1 " End: ")
(PRBUF (fetch END of LINE))
(TAB POS T)
(PRIN1 " First, last: ")
(PRIN2 (fetch FIRSTCOL of LINE))
(PRIN1 ", ")
(PRINT (fetch LASTCOL of LINE))
(TAB POS T)
(PRIN1 " Row: ")
(PRINT (fetch ROW of LINE))
(COND
((NEQ (fetch END of LINE)
(OR (LISTP (EVALV (QUOTE \ENDBUFFER)))
(fetch OLDTAIL of TTYINBUFFER)))
(TAB POS T)
(PRIN1 " Nextline: ")
(PRBUF (fetch START of (fetch NEXTLINE of LINE))
NIL 8])
)
(* Auxiliary fns. These are outside the TTYIN block, and are provided to aid the outside world
in special interfaces to TTYIN)
(DEFINEQ
(SETREADFN
[LAMBDA (FLG) (* bvm: "10-MAR-83 21:46")
(/SETATOMVAL (QUOTE LISPXREADFN)
(COND
((AND (NEQ FLG (QUOTE READ))
(OR FLG TTYINBSFLG (DISPLAYTERMP))
(FGETD (QUOTE TTYINREAD))
(DISPLAYSTARTEDP))
(QUOTE TTYINREAD))
(T (QUOTE READ])
(TTYINENTRYFN
[LAMBDA (WINDOW) (* bvm: "24-Aug-84 16:31")
(COND
((LASTMOUSESTATE (ONLY RIGHT))
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE TTYINSTATE]
(APPLY* (OR (AND STATE (fetch (TTYINWINDOWSTATE TTOLDRIGHTFN) of STATE))
(FUNCTION DOWINDOWCOM))
WINDOW)))
(T (GIVE.TTY.PROCESS WINDOW])
(TTYINREADP
[LAMBDA (FLG) (* bvm: "17-Apr-85 19:26")
(* * Intended to replace LISPXREADP. Does the right thing when READBUF has just
a <cr> in it)
(COND
(READBUF (OR (NEQ (CAR READBUF)
HISTSTR0)
FLG))
((NOT (EOFP \LINEBUF.OFD))
(OR FLG (NEQ (PEEKBINCCODE \LINEBUF.OFD)
(CHARCODE EOL])
(TTYINREAD
[LAMBDA (FILE RDTBL) (* lmm "30-Dec-85 18:03")
(COND
([OR (AND TTYINDEBUGFLG \INSIDE.TTYIN)
(NOT (DISPLAYSTREAMP (GETSTREAM T (QUOTE OUTPUT] (* If debugging and TTYIN breaks,
don't want to die)
(READ FILE RDTBL))
(T (PROG (X)
(RETURN (COND
((OR (SKIPSEPRS \LINEBUF.OFD RDTBL)
(EQ (SETQ X (TTYIN LISPXID NIL NIL (QUOTE (EVALQT FILLBUFFER NOPROMPT
))
NIL NIL NIL RDTBL))
T)) (* Don't call TTYIN if there's
something significant already in
buffer)
(* SKIPSEPRS used to be (do (COND ((EOFP \LINEBUF.OFD)
(* Nothing in buffer) (RETURN)) ((NEQ (PEEKBINCCODE \LINEBUF.OFD)
(CHARCODE EOL)) (* significant stuff) (RETURN T))
(T (BINCCODE \LINEBUF.OFD)))))
(READ \LINEBUF.OFD RDTBL))
(T (* indicate null input)
(SETQ READBUF (NCONC1 (CDR X)
HISTSTR0))
(CAR X])
(TTYINFIX
[LAMBDA (INPUT COMS) (* bvm: "14-Mar-86 14:59")
(LET (TAIL)
(COND
([OR COMS (NEQ LISPXREADFN (QUOTE TTYINREAD))
(IGEQ (COUNT INPUT)
TTYINFIXLIMIT)
(CDR (SETQ TAIL (MEMB HISTSTR0 INPUT]
(NONTTYINLISPXFIX INPUT COMS))
((for X in [COND
((EQ TAIL (CDR INPUT))
(CAR INPUT))
(T (OR (LISTP (CADR INPUT))
(CDR INPUT] thereis (LISTP X))
(TTYINEDIT (COND
(TAIL (LDIFF INPUT TAIL))
(T INPUT))
T
(QUOTE PRETTY)
LISPXID T))
(T (TTYIN LISPXID NIL NIL (QUOTE EVALQT)
NIL NIL INPUT T])
(CHARMACRO?
[NLAMBDA (MACRO)
(DECLARE (USEDFREE \READING LISPXID)) (* bvm: "19-MAR-81 12:15")
(* * For use in a TTYINREADMACRO. If we are reading inside the editor, clear
the output buffer and return MACRO)
(COND
((AND (EQ \READING (QUOTE EVALQT))
(EQ LISPXID (QUOTE *)))
(COND
((LISTP MACRO) (* a list of edit commands;
we'd better copy)
(APPEND MACRO))
(T MACRO])
(TTYINMETA
[LAMBDA (FLG) (* bvm: " 2-May-85 14:27")
(METASHIFT FLG])
(\SET.TTYINBOLDFONT
[LAMBDA (PLAINFONT) (* bvm: "17-AUG-83 12:31")
(SETQ TTYINBOLDFONT (CONS PLAINFONT (OR [CAR (NLSETQ (COND
((EQ (FONTPROP PLAINFONT (QUOTE WEIGHT))
(QUOTE BOLD))
(FONTCOPY PLAINFONT (QUOTE WEIGHT)
(QUOTE NORMAL)))
(T (FONTCOPY PLAINFONT (QUOTE WEIGHT)
(QUOTE BOLD]
PLAINFONT])
(TTYIN.LASTINPUT
[LAMBDA NIL (* bvm: " 9-NOV-82 14:56")
(PROG [(BUF (AND (LISTP TTYINBUFFER)
(fetch OLDTAIL of TTYINBUFFER]
(RETURN (AND BUF (TTYINSTRING (fetch START of (fetch FIRSTLINE of TTYINBUFFER))
BUF])
)
(DEFINEQ
(TTED
[NLAMBDA (FN C)
(DECLARE (USEDFREE COM)) (* bvm: "30-May-86 14:51")
(* Does the ED macro, returning a com to execute if there is any change to be
made. Can also be used for other types of editor escapes if FN is supplied.
FN{exprlist,com} is called to edit a list of expressions.
C is com)
(LET ((EXPR (##))
(TOP (## ↑))
UP NEW N)
(SETQ COM (OR C (QUOTE ED)))
[COND
((NEQ TOP EXPR) (* would generate error if at top)
(SETQ UP (## UP] (* in case of error, will print ED ?,
instead of some long edit macro body)
[COND
((NEQ UP EXPR) (* If current expression is not a
tail, pretend it is a list of one
expression)
(SETQ EXPR (LIST EXPR]
(COND
([NOT (SETQ NEW (COND
(FN (APPLY* FN EXPR C))
(T (TTYIN "** " NIL NIL (QUOTE LISPXREAD)
NIL NIL EXPR EDITRDTBL]
(* Replace with nothing?)
(ERROR!))
((EQUAL NEW EXPR)
(PRIN1 "(not changed)
" T)
NIL)
[(OR (EQ EXPR UP)
(AND (EQ (CAR EXPR)
TOP)
(PROGN [COND
((CDR NEW) (* Replacing the top-level expression
with more than one expression.
That is really an error, but this way
we at least avoid losing data)
(PRIN1 "(Note: replaced one expression with a list of several)
" T))
(T (SETQ NEW (CAR NEW]
T))) (* Current expression is the top or a
tail; can't use simple : command.)
(CONS (QUOTE REPLACE)
(CONS (QUOTE (1 TO))
(CONS (QUOTE WITH)
NEW]
([AND (LISTP (CAR NEW))
(NOT (CDR NEW))
(SETQ N (MEMB (CAR EXPR)
(SETQ UP (## 0]
(* replacing an element with a list: if we did a : command, the editor would
then be positioned at a tail, and even if we did a
(1 --) there would still be a tail in the edit chain.
Better way to do this is thus to go up a level and do the appropriate
(n --) command and come back down. I wish the editor had a command to do this.)
(LIST (QUOTE COMSQ)
0
(CONS [SETQ N (for ($$VAL ← 1) while (NEQ N UP) do (ADD1VAR $$VAL)
(SETQ UP (CDR UP]
NEW)
N))
(T
(* Simple replacement of one element. Could be fancier and leave the current
expression being the one just typed, but that seems like a lot of bother)
(COND
((AND (CDR NEW)
(NOT (CDR EXPR))) (* Warn that one expression became
several)
(PRIN1 "(new expressions spliced into parent)
" T)))
(CONS (QUOTE :)
NEW])
(DO.EE
[LAMBDA (EXPRS COM W) (* bvm: "30-May-86 14:47")
(TTYINEDIT EXPRS W NIL NIL EDITRDTBL])
(TTYINEDIT
[LAMBDA (EXPRS WINDOW PRINTFN PROMPT RDTBL) (* bvm: "30-May-86 14:44")
(OR PRINTFN (SETQ PRINTFN TTYINPRINTFN))
(RESETLST (SET.TTYINEDIT.WINDOW WINDOW)
(RESETSAVE (CURSOR T)) (* Make sure we have something to
point with)
(PROG1 (TTYIN (OR PROMPT TTYINEDITPROMPT)
NIL NIL (QUOTE LISPXREAD)
NIL NIL [COND
([OR (EQ PRINTFN T)
(AND (NULL PRINTFN)
(NULL (CDR EXPRS))
(STRINGP (CAR EXPRS]
(* Don't prettyprint it)
EXPRS)
(T (LIST HISTSTR1 (TTYIN.PPTOFILE EXPRS PRINTFN RDTBL]
RDTBL)
(COND
((AND TTYINAUTOCLOSEFLG WINDOW)
(CLOSEW WINDOW])
(SIMPLETEXTEDIT
[LAMBDA (FILE WINDOW) (* bvm: "18-JUN-82 14:29")
(RESETLST (PROG ([INPUTFILE (AND FILE (OPENFILE FILE (QUOTE INPUT]
SCRATCHOUT MAINOUTPUT)
(AND INPUTFILE (RESETSAVE NIL (LIST (QUOTE CLOSEF)
INPUTFILE)))
(SETQ SCRATCHOUT (TTYIN.SCRATCHFILE))
(SET.TTYINEDIT.WINDOW WINDOW)
(RETURN (COND
([TTYIN TTYINEDITPROMPT NIL NIL (QUOTE (TEXT NOVALUE))
SCRATCHOUT NIL (AND INPUTFILE
(LIST HISTSTR1 (CONS INPUTFILE
(CONS 0 (GETEOFPTR
INPUTFILE]
[repeatuntil (PROGN [SETQ MAINOUTPUT
(COND
(INPUTFILE (PROG1 (PACKFILENAME (QUOTE
VERSION
)
NIL
(QUOTE BODY)
INPUTFILE)
(SETQ INPUTFILE)))
(T (CAR (TTYIN "Output file: " NIL
"Name of file for edited output"
(QUOTE (NORAISE READ]
(NLSETQ (SETQ MAINOUTPUT (OPENFILE MAINOUTPUT
(QUOTE OUTPUT]
(COPYBYTES SCRATCHOUT MAINOUTPUT 0 (GETFILEPTR SCRATCHOUT))
(CLOSEF MAINOUTPUT])
(SET.TTYINEDIT.WINDOW
[LAMBDA (WINDOW) (* bvm: " 2-JUN-82 16:11")
(* Changes output to WINDOW, or the TTYIN edit window, returning the resulting
WINDOW, or NIL if there is no window change.
Caller must have RESETLST)
(COND
((EQ WINDOW T) (* Use current window)
NIL)
(T (SELECTQ (SYSTEMTYPE)
((ALTO D)
[OR WINDOW (SETQ WINDOW (OR TTYINEDITWINDOW (SETQ TTYINEDITWINDOW (CREATEW NIL
"Edit Work Area"
]
(CLEARW WINDOW)
[PROG [(OFFSET (IREMAINDER (WINDOWPROP WINDOW (QUOTE HEIGHT))
(IMINUS (DSPLINEFEED NIL WINDOW]
(COND
((NEQ OFFSET 0)
(* Window is not an integral number of lines, so start down a little, so that
bottom line will be correctly aligned (we count from bottom of screen))
(RELMOVETO 0 (IMINUS OFFSET)
WINDOW]
(RESETSAVE (TTYDISPLAYSTREAM WINDOW))
WINDOW)
NIL])
(TTYIN.PPTOFILE
[LAMBDA (EXPRS PRINTFN RDTBL) (* bvm: "14-Mar-86 15:02")
(DECLARE (GLOBALVARS TTYINEDIT.SCRATCH))
(* * Prettyprint each of EXPRS to a scratch file, returning
(scratchfile start . end), as TTYIN would like)
(TTYIN.SCRATCHFILE)
[RESETLST (RESETSAVE (OUTPUT TTYINEDIT.SCRATCH))
(LET [(LL (IDIFFERENCE (LINELENGTH NIL T)
(ADD1 (NCHARS TTYINEDITPROMPT]
(LINELENGTH LL TTYINEDIT.SCRATCH) (* Try to make comments print in
middle when linelength short)
(RESETSAVE PRETTYLCOM (IQUOTIENT LL 5)))
(RESETSAVE FONTCHANGEFLG NIL)
(AND RDTBL (RESETSAVE (SETREADTABLE RDTBL)))
(COND
((AND PRINTFN (NEQ PRINTFN (QUOTE PRETTY)))
(APPLY* (COND
((EQ PRINTFN T)
(QUOTE PRINT))
(T PRINTFN))
EXPRS
(OUTPUT)))
(T (AND CHANGESARRAY (RESETSAVE CHANGESARRAY))
[COND
((AND NIL (NEQ NORMALCOMMENTSFLG T)
(DEFINEDP (QUOTE GETCOMMENT))) (* If there are comments, force them
to be prettyprinted afresh at the new
linelength; ordinarily this won't
happen with file output)
(RESETSAVE PRETTYPRINTMACROS (CONS (QUOTE (* . GETCOMMENT))
PRETTYPRINTMACROS]
(PRINTDEF EXPRS NIL T T]
(CONS TTYINEDIT.SCRATCH (CONS 0 (GETFILEPTR TTYINEDIT.SCRATCH])
(TTYIN.SCRATCHFILE
[LAMBDA NIL
(DECLARE (GLOBALVARS TTYINEDIT.SCRATCH)) (* bvm: "15-Apr-85 15:10")
[COND
([OR (NOT TTYINEDIT.SCRATCH)
(NOT (OPENP TTYINEDIT.SCRATCH (QUOTE BOTH]
(SELECTQ (SYSTEMTYPE)
(D [SETQ TTYINEDIT.SCRATCH (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE OLD/NEW)
NIL
(CONSTANT (LIST (LIST (QUOTE ENDOFSTREAMOP)
(FUNCTION \TTYIN.RPEOF])
(PROGN (SETQ TTYINEDIT.SCRATCH (OPENSTREAM (QUOTE TTYINEDIT.SCRATCH;S)
(QUOTE BOTH)
(QUOTE OLD/NEW)))
(WHENCLOSE TTYINEDIT.SCRATCH (QUOTE CLOSEALL)
(QUOTE NO)
(QUOTE BEFORE)
[FUNCTION (LAMBDA NIL
(SETQ TTYINEDIT.SCRATCH NIL]
(QUOTE AFTER)
(QUOTE DELFILE]
(SETFILEPTR TTYINEDIT.SCRATCH 0)
TTYINEDIT.SCRATCH])
(\TTYIN.RPEOF
[LAMBDA (STREAM) (* bvm: "15-Apr-85 15:08")
(* End of stream op for ttyin scratch
file -- supplies as many closing
parens as needed)
(CHARCODE ")"])
)
(ADDTOVAR USERMACROS (EE (DUMMY)
(COMS (TTED DO.EE EE)))
(EE NIL (COMS (TTED DO.EE EE)))
(ED NIL (COMS (TTED)))
(BUF NIL (E [LISPXUNREAD (TTYIN (QUOTE *)
NIL NIL (QUOTE LISPXREAD)
NIL NIL (LIST (QUOTE E)
(##]
T)))
(ADDTOVAR EDITCOMSA EE ED BUF)
(ADDTOVAR EDITCOMSL EE)
(ADDTOVAR LISPXHISTORYMACROS [BUF NIL (TTYIN LISPXID NIL NIL (QUOTE EVALQT)
NIL NIL (LIST (COND (LISPXLINE (VALUOF LISPXLINE))
(T (CADDR (CAAR LISPXHISTORY])
(ADDTOVAR LISPXMACROS (TV (APPLY* (QUOTE EDITV)
(CAR LISPXLINE)
(QUOTE ED))))
(RPAQ? TTYINEDITWINDOW )
(RPAQ? TTYINEDIT.SCRATCH )
(RPAQ? TTYINEDITPROMPT T)
(RPAQ? TTYINAUTOCLOSEFLG )
(RPAQ? TTYINPRINTFN )
(RPAQ? TTYIN?=FN )
(ADDTOVAR AFTERSYSOUTFORMS (SETQ TTYINEDIT.SCRATCH NIL))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(RPAQQ TTCOMPILETIME
[(VARS TTYINBLOCKS)
(LOCALVARS . T)
(SPECVARS CTRLO! HELP SPLST \ARROW \AUTOFILL \BMARG \BUFFER \CHARHEIGHT \CHARWIDTH \COMMAND
\CURSOR \CURSORCOL \CURSORROW \DELETING \DESCENT \DSP \ENDBUFFER \FIRSTLINE \FIX
\HOMECOL \HOMEROW \INITPOS \LASTAIL \LASTCHAR \LMARG \LOC.ROW.0 \NOFIXSPELL \PROMPT1
\PROMPT2 \READING \REPEAT \RMARG \SPLSTFLG \INSIDE.TTYIN \TTYINSTATE \TTPAGELENGTH
\RAISEINPUT \FIRSTTIME \DONTCOMPLETE \NOVALUE \STRINGVALUE \LISPXREADING
\FILLINGBUFFER \RDTBLSA DIRECTORY/FILE \LAST.DELETION \NOPROMPT \FONT \VARIABLEFONT
\TEXTURE \LASTAILROW \LASTAILCOL \TTYINBUFFERSTREAM)
(GLOBALVARS ?ACTIVATEFLG BLACKSHADE BUFFIELDS CAR/CDRNIL CHANGESARRAY CHCONLST1 COMMENTFLG
CTRLUFLG CTRLVFLG DISPLAYTYPES DMCHARCODES EDITCOMSL EDITPREFIXCHAR EDITRDTBL
EOLCHARCODE FONTCHANGEFLG HISTSTR0 HISTSTR1 LASTMOUSEBUTTONS LASTWORD LISPXREADFN
PROMPTCHARFORMS SHOWPARENFLG SPELLSTR1 SPELLSTR2 TTCLOCK TTYINAUTOCLOSEFLG
TTYINBOLDFONT TTYINBSFLG TTYINBUFFER TTYINCOMMENTCHAR TTYINCOMPLETEFLG
TTYINEDIT.SCRATCH TTYINEDITPROMPT TTYINEDITWINDOW TTYINERRORSETFLG TTYINRAISEFLG
TTYINREADMACROS TTYINRESPONSES TTYINUSERFN TTYJUSTLENGTH TYPEAHEADFLG USERWORDS
WHITESHADE \FIXP \MISCSTATS \TTWAITBOX null TTYINAUTOFILLMARGIN TTYINPRINTFN TTYIN?=FN
TTYINFIXLIMIT TTYINDEBUGFLG)
(MACROS * TTYINMACROS)
(RECORDS LINE TTYINBUFFER TTYINWINDOWSTATE MOUSEPOS COMPLEXCHAR TTYINBUFFERSTREAM)
(VARS (TTCLOCK)
(CHANGESARRAY)
DMCHARCODES TTSUPPORTFNS)
(ADDVARS (DONTCOMPILEFNS &DISPLAYCOMMENT DELETETO1 DELNCHARS DO.BACK DO.DOWN DO.FORWARD
ADDSILENTCHAR INSERTSPACES))
(CONSTANTS (DISPLAYTERMFLG T)
(TTYINMAILFLG)
(CHECKNIL?)
(DIDESCAPECODE 283)
DOTSHADE BREAKCODES SEPRCODES \RESTOREBUFCODES)
(VARS TTNILFNS)
(MACROS * TTNILFNS)
(DECLARE: DONTEVAL@COMPILE (TEMPLATES TTBOUT TTBOUTN CAPABILITY?)
(LISPXMACROS ← ←B)
DONTEVAL@LOAD EVAL@COMPILE (VARS (DONTCOMPILEFNS (UNION (UNION TTYINMACROS
TTSUPPORTFNS)
DONTCOMPILEFNS])
(RPAQQ TTYINBLOCKS
((TTYIN TTYIN TTBIN TTCRLF TTCRLF.ACCOUNT SCANFORWARD TTNLEFT TTNTH TTPRIN1 TTPROMPTCHAR
TTRATOM TTREAD TTREADLIST TTSKIPSEPR TTSKREAD TTYINSTRING ADDCHAR ADDNAKEDCHAR AUTOCR?
BACKWARD.DELETE.TO BEEP BUFTAILP CLEAR.LINE? CREATE.LINE DELETE.TO.END DELETETO
DELETETO1 DELNCHARS TTECHO.TO.FILE END.DELETE.MODE ENDREAD? AT.END.OF.TEXT
FIND.START.OF.WORD TTADJUSTWORD FORWARD.DELETE.TO GO.TO.RELATIVE GO.TO.ADDRESSING
GO.TO.FREELINE INIT.CURSOR INSERT.CHAR.IN.BUF ADDCHARS.INSERTING INSERT.NODE TTRUBOUT
KILL.LINES KILLSEGMENT MOVE.BACK.TO MOVE.FORWARD.TO MOVE.TO.NEXT.LINE START.NEW.LINE
TTNEXTCHAR TTNEXTNODE OVERFLOW? PROPERTAILP RESTORE.CURSOR SAVE.CURSOR SCRATCHCONS
SETLASTC SETTAIL? SPACE/PARENP DO.EDIT.COMMAND ADDSILENTCHAR TTADDTAB AT.END.OF.SCREEN
SCANBACK BACKSKREAD BREAKLINE SEGMENT.LENGTH CHECK.MARGIN TTCOMPLETEWORD
FIND.MATCHING.WORD NTHCHARCODE DELETELINE DO?CMD TTDOTABS EDITCOLUMN FIND.LINE
FIND.LINE.BREAK ADJUSTLINE START.OF.PARAGRAPH? ADJUSTLINE.AND.RESTORE TTGIVEHELP
TTGIVEHELP1 TTGIVEHELP2 INSERTLINE TTLASTLINE TTLOADBUF MOVE.TO.LINE
MOVE.TO.START.OF.WORD MOVE.TO.WHEREVER TTNEXTLINE FIND.MATCHING.QUOTE FIND.NEXT.WORD
NTH.COLUMN.OF NTH.RELATIVE.COLUMN.OF OVERFLOWLINE? PREVLINE PREVWORD READFROMBUF
RENUMBER.LINES RESTOREBUF RETYPE.BUFFER SHOW.MATCHING.PAREN SKIP/ZAP SLEEP
CURRENT.WORD TYPE.BUFFER U/L-CASE TTUNREADBUF DO.BACK DO.DELETE.LINES DO.DOWN
DO.FORWARD DO.INSERT.LINE DO.UP ERASE.SCREEN ERASE.TO.END.OF.LINE ERASE.TO.END.OF.PAGE
INSERT.TEXT INSERTNCHARS TTSETCURSOR
(LOCALFREEVARS ARROW AUTOFILL BUFFER COMMAND CURSOR DELETING EDITBIT ENDBUFFER INITPOS
INSERTING NOFIXSPELL READING REPEAT)
(SPECVARS CTRLO!)
(LINKFNS . T)
(NOLINKFNS DISPLAYHELP DISPLAYTERMP EDITE ERROR! FIXSPELL!! GRIPE GUESTUSER? MAILWATCH
MWNOTE SETBACKSPACE SHOULDNT SMARTARGLIST SPRINTT STKEVAL STRPOS USEREXEC
XHELPSYS)
(BLKLIBRARY NLEFT))
(NIL TTYINREAD (LOCALVARS . T)
(LINKFNS TTYIN))
(NIL DISPLAYTERMP SETREADFN TTECHOMODE TTED TTYINPEEKC TTYINREADP TTYINREADPREP CHARMACRO?
(LOCALVARS . T))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS CTRLO! HELP SPLST \ARROW \AUTOFILL \BMARG \BUFFER \CHARHEIGHT \CHARWIDTH \COMMAND \CURSOR
\CURSORCOL \CURSORROW \DELETING \DESCENT \DSP \ENDBUFFER \FIRSTLINE \FIX \HOMECOL \HOMEROW
\INITPOS \LASTAIL \LASTCHAR \LMARG \LOC.ROW.0 \NOFIXSPELL \PROMPT1 \PROMPT2 \READING \REPEAT
\RMARG \SPLSTFLG \INSIDE.TTYIN \TTYINSTATE \TTPAGELENGTH \RAISEINPUT \FIRSTTIME \DONTCOMPLETE
\NOVALUE \STRINGVALUE \LISPXREADING \FILLINGBUFFER \RDTBLSA DIRECTORY/FILE \LAST.DELETION
\NOPROMPT \FONT \VARIABLEFONT \TEXTURE \LASTAILROW \LASTAILCOL \TTYINBUFFERSTREAM)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS ?ACTIVATEFLG BLACKSHADE BUFFIELDS CAR/CDRNIL CHANGESARRAY CHCONLST1 COMMENTFLG CTRLUFLG
CTRLVFLG DISPLAYTYPES DMCHARCODES EDITCOMSL EDITPREFIXCHAR EDITRDTBL EOLCHARCODE FONTCHANGEFLG
HISTSTR0 HISTSTR1 LASTMOUSEBUTTONS LASTWORD LISPXREADFN PROMPTCHARFORMS SHOWPARENFLG SPELLSTR1
SPELLSTR2 TTCLOCK TTYINAUTOCLOSEFLG TTYINBOLDFONT TTYINBSFLG TTYINBUFFER TTYINCOMMENTCHAR
TTYINCOMPLETEFLG TTYINEDIT.SCRATCH TTYINEDITPROMPT TTYINEDITWINDOW TTYINERRORSETFLG
TTYINRAISEFLG TTYINREADMACROS TTYINRESPONSES TTYINUSERFN TTYJUSTLENGTH TYPEAHEADFLG USERWORDS
WHITESHADE \FIXP \MISCSTATS \TTWAITBOX null TTYINAUTOFILLMARGIN TTYINPRINTFN TTYIN?=FN
TTYINFIXLIMIT TTYINDEBUGFLG)
)
(RPAQQ TTYINMACROS
(TYPEAHEAD? AT.END.OF.BUF AT.END.OF.LINE AT.START.OF.BUF AT.START.OF.LINE BEFOREBUF
BREAK.OR.SEPRP CAPABILITY? DISPLAYTERMP EMPTY.BUFFER EMPTY.LINE EQPOS NEQPOS INPART
ON.FIRST.LINE ON.LAST.LINE METACHARP NONMETACHARBITS METACHAR COMPLEXCHARP
STREAMBYTESPERCHAR SPACEP TTBOUT TTNEXTCHAR BOUTCCODE PEEKBINCCODE BINCCODE TTBOUTN
WORDSEPRP FCHARWIDTH FIRSTCHAR))
(DECLARE: EVAL@COMPILE
(PUTPROPS TYPEAHEAD? MACRO (NIL (\SYSBUFP)))
(PUTPROPS AT.END.OF.BUF MACRO (NIL (EQ \CURSOR \ENDBUFFER)))
(PUTPROPS AT.END.OF.LINE MACRO (NIL (EQ (fetch END of \ARROW)
\CURSOR)))
(PUTPROPS AT.START.OF.BUF MACRO (NIL (EQ \CURSOR \BUFFER)))
(PUTPROPS AT.START.OF.LINE MACRO (NIL (EQ (fetch START of \ARROW)
\CURSOR)))
(PUTPROPS BEFOREBUF MACRO ((THIS THAT END)
(BUFTAILP THAT THIS END)))
(PUTPROPS BREAK.OR.SEPRP MACRO ((C)
(SELECTC C ((APPEND SEPRCODES BREAKCODES)
T)
NIL)))
(PUTPROPS CAPABILITY? MACRO ((X Y)
T))
(PUTPROPS DISPLAYTERMP ALTOMACRO (NIL T))
(PUTPROPS EMPTY.BUFFER MACRO (NIL (EQ \BUFFER \ENDBUFFER)))
[PUTPROPS EMPTY.LINE MACRO (X (SUBST (OR (CAR X)
(QUOTE \ARROW))
(QUOTE \ARROW)
(QUOTE (EQ (fetch START of \ARROW)
(fetch END of \ARROW]
[PUTPROPS EQPOS MACRO ((X Y)
(AND (EQ (fetch COLPOS of X)
(fetch COLPOS of Y))
(EQ (fetch ROWPOS of X)
(fetch ROWPOS of Y]
[PUTPROPS NEQPOS MACRO ((X Y)
(NOT (EQPOS X Y]
[PUTPROPS INPART MACRO (OPENLAMBDA (X)
(COND ((LISTP X)
(CAR X))
(T X]
(PUTPROPS ON.FIRST.LINE MACRO (NIL (EQ \FIRSTLINE \ARROW)))
(PUTPROPS ON.LAST.LINE MACRO (NIL (EQ (fetch END of \ARROW)
\ENDBUFFER)))
(PUTPROPS METACHARP MACRO ((C)
(EQ (LRSH C 8)
1)))
(PUTPROPS NONMETACHARBITS MACRO ((C)
(LOGAND C 255)))
(PUTPROPS METACHAR MACRO ((C)
(LOGOR C 256)))
(PUTPROPS COMPLEXCHARP MACRO (= . LISTP))
[PUTPROPS STREAMBYTESPERCHAR MACRO ((STREAM)
(COND ((\RUNCODED STREAM)
1)
(T 2]
[PUTPROPS SPACEP MACRO ((CHAR)
(FMEMB CHAR (CHARCODE (SPACE TAB CR]
[PUTPROPS TTBOUT MACRO (X (CONS (QUOTE PROGN)
(for ARG in X collect (LIST (QUOTE BLTCHAR)
(OR (FIXP ARG)
(CDR (ASSOC ARG DMCHARCODES))
(AND (EQ (NCHARS ARG)
1)
(CHCON1 ARG))
ARG)
(QUOTE \DSP]
(PUTPROPS TTNEXTCHAR MACRO (= . CDR))
(PUTPROPS BOUTCCODE MACRO (OPENLAMBDA (STREAM CHAR)
(PRINTCCODE CHAR STREAM)))
(PUTPROPS PEEKBINCCODE MACRO (= . PEEKCCODE))
(PUTPROPS BINCCODE MACRO (= . READCCODE))
[PUTPROPS TTBOUTN MACRO ((X . Y)
(FRPTQ X (TTBOUT . Y]
[PUTPROPS WORDSEPRP DMACRO (OPENLAMBDA (X)
(OR (EQ (\SYNCODE \PRIMTERMSA X)
WORDSEPR.TC)
(fetch STOPATOM of (\SYNCODE \RDTBLSA X]
(PUTPROPS FCHARWIDTH MACRO (= . CHARWIDTH))
[PUTPROPS FIRSTCHAR MACRO ((BUF)
([LAMBDA (CH)
(DECLARE (LOCALVARS CH))
(COND ((COMPLEXCHARP CH)
(fetch CPXREALCHAR of CH))
(T CH]
(CAR BUF]
)
[DECLARE: EVAL@COMPILE
(RECORD LINE (START END FIRSTCOL LASTCOL ROW . NEXTLINE))
(RECORD TTYINBUFFER (FIRSTLINE OLDTAIL LASTSKIP LASTSKIPCHAR STORAGECOUNTER TTYINWINDOW . TTYINWINDOWSTATE
)
(SUBRECORD TTYINWINDOWSTATE)
STORAGECOUNTER ← 0)
(RECORD TTYINWINDOWSTATE (TTOLDBUTTONFN TTOLDRIGHTFN TTOLDENTRYFN))
(RECORD MOUSEPOS (ROWPOS . COLPOS))
(RECORD COMPLEXCHAR (CPXREALCHAR CPXWIDTH CPXNCHARS . CPXPRINTCHARS))
(ACCESSFNS TTYINBUFFERSTREAM ((TTYINPUT (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(TTYEOF (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(TTYEOFACTION (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE))
(TTYORIGINPUT (fetch (STREAM F4) of DATUM)
(replace (STREAM F4) of DATUM with NEWVALUE))))
]
(RPAQQ TTCLOCK NIL)
(RPAQQ CHANGESARRAY NIL)
(RPAQQ DMCHARCODES ((HOME . 2)
(BELL . 7)
(DELCH . 8)
(BS . 8)
(DOWN . 10)
(INSERT.LINE . 10)
(LF . 10)
(ADDR . 12)
(CR . 13)
(BLINKON . 14)
(INSERT/DELETE . 16)
(DLE . 16)
(ERASE.TO.END . 23)
(CANCEL . 24)
(UP . 26)
(DELETE.LINE . 26)
(ESC . 27)
(FORWARD . 28)
(ROLL . 29)
(ERASE . 30)
(CLEAR . 30)
(US . 31)
(SPACE . 32)))
(RPAQQ TTSUPPORTFNS (INPART TTBOUT TTBOUTN PR! PRALL PRBUF PRLINE))
(ADDTOVAR DONTCOMPILEFNS &DISPLAYCOMMENT DELETETO1 DELNCHARS DO.BACK DO.DOWN DO.FORWARD ADDSILENTCHAR
INSERTSPACES)
(DECLARE: EVAL@COMPILE
(RPAQQ DISPLAYTERMFLG T)
(RPAQQ TTYINMAILFLG NIL)
(RPAQQ CHECKNIL? NIL)
(RPAQQ DIDESCAPECODE 283)
(RPAQQ DOTSHADE 13260)
(RPAQQ BREAKCODES (40 41 44 91 93 34))
(RPAQQ SEPRCODES (32 9 13 31))
(RPAQQ \RESTOREBUFCODES (194 516 530))
(CONSTANTS (DISPLAYTERMFLG T)
(TTYINMAILFLG)
(CHECKNIL?)
(DIDESCAPECODE 283)
DOTSHADE BREAKCODES SEPRCODES \RESTOREBUFCODES)
)
(RPAQQ TTNILFNS (BINARY.MODE RESTOREMOD CANCEL.MODES TENEXCOMPLETE GUESTUSER?))
(RPAQQ TTNILFNS (BINARY.MODE RESTOREMOD CANCEL.MODES TENEXCOMPLETE GUESTUSER?))
(DECLARE: EVAL@COMPILE
(PUTPROPS BINARY.MODE MACRO (NIL NIL))
(PUTPROPS RESTOREMOD MACRO (NIL NIL))
(PUTPROPS CANCEL.MODES MACRO (NIL NIL))
(PUTPROPS TENEXCOMPLETE MACRO (X NIL))
(PUTPROPS GUESTUSER? MACRO (NIL NIL))
)
(DECLARE: DONTEVAL@COMPILE
[SETTEMPLATE (QUOTE TTBOUT)
(QUOTE (.. (IF [OR (LISTP EXPR)
(AND (NTHCHAR EXPR 2)
(NOT (ASSOC EXPR DMCHARCODES]
EVAL NIL]
[SETTEMPLATE (QUOTE TTBOUTN)
(QUOTE (MACRO (X . Y)
(FRPTQ X (TTBOUT . Y]
(SETTEMPLATE (QUOTE CAPABILITY?)
(QUOTE (NIL)))
DONTEVAL@LOAD EVAL@COMPILE
(RPAQ DONTCOMPILEFNS (UNION (UNION TTYINMACROS TTSUPPORTFNS)
DONTCOMPILEFNS))
)
)
(RPAQ? TTYINBUFFER )
(RPAQ? ?ACTIVATEFLG T)
(RPAQ? EDITPREFIXCHAR )
(RPAQ? SHOWPARENFLG T)
(RPAQ? TTYINBSFLG T)
(RPAQ? TTYINFILLDEFAULT T)
(RPAQ? TTYINCOMPLETEFLG T)
(RPAQ? TTYINUSERFN )
(RPAQ? TYPEAHEADFLG T)
(RPAQ? null "")
(RPAQ? DEFAULTPROMPT "** ")
(RPAQ? TTYJUSTLENGTH -8)
(RPAQ? \INSIDE.TTYIN )
(RPAQ? TTYINERRORSETFLG )
(RPAQ? TTYINRAISEFLG T)
(RPAQ? TTYINAUTOFILLMARGIN 8)
(RPAQ? TTYINFIXLIMIT 50)
(RPAQ? TTYINDEBUGFLG )
(RPAQ? HISTSTR1 "from file:")
(RPAQ? TTYINCOMMENTCHAR )
(MOVD? (QUOTE NILL)
(QUOTE GUESTUSER?))
(MOVD? (QUOTE FIXSPELL)
(QUOTE FIXSPELL!!))
(MOVD? (QUOTE HELPSYS)
(QUOTE XHELPSYS))
[PUTDQ? SPRINTT (LAMBDA (X)
(PRIN1 X]
(MOVD? (QUOTE NILL)
(QUOTE WINDOWWORLD))
(MOVD? (QUOTE LISPXFIX)
(QUOTE NONTTYINLISPXFIX))
(ADDTOVAR TTYINREADMACROS )
(ADDTOVAR TTYINRESPONSES )
(ADDTOVAR LISPXCOMS (STOP . OK))
(PUTPROPS TTYINREADMACROS VARTYPE ALIST)
(DECLARE: DONTEVAL@LOAD DOCOPY
[COND ((CCODEP (QUOTE TTYIN))
(CHANGENAME (QUOTE PROMPTCHAR)
(QUOTE LISPXREADP)
(QUOTE TTYINREADP))
(SETREADFN)
(MOVD (QUOTE TTYINFIX)
(QUOTE LISPXFIX]
(\SET.TTYINBOLDFONT (DEFAULTFONT (QUOTE DISPLAY)))
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \TTWAITBOX)
(QUOTE RESOURCES)
(QUOTE (NEW (CREATECELL \FIXP]
)
)
(/SETTOPVAL (QUOTE \\TTWAITBOX.GLOBALRESOURCE))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA TTBOUTN TTBOUT)
(ADDTOVAR NLAML TTED CHARMACRO? CAPABILITY?)
(ADDTOVAR LAMA )
)
(PUTPROPS TTYIN COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6745 238389 (TTYIN 6755 . 19934) (TTYIN.SETUP 19936 . 23626) (TTYIN.CLEANUP 23628 .
24400) (TTYIN1 24402 . 51701) (TTYIN1RESTART 51703 . 52854) (TTYIN.FINISH 52856 . 63229) (TTYIN.READ
63231 . 67574) (TTYIN.BALANCE 67576 . 68294) (ADDCHAR 68296 . 70394) (TTMAKECOMPLEXCHAR 70396 . 70862)
(ADDNAKEDCHAR 70864 . 72359) (TTADDTAB 72361 . 73045) (ADJUSTLINE 73047 . 87197) (
ADJUSTLINE.AND.RESTORE 87199 . 87564) (AT.END.OF.SCREEN 87566 . 87857) (AT.END.OF.TEXT 87859 . 88333)
(AUTOCR? 88335 . 88912) (BACKSKREAD 88914 . 94200) (BACKWARD.DELETE.TO 94202 . 94387) (BREAKLINE 94389
. 96665) (BUFTAILP 96667 . 96965) (CHECK.MARGIN 96967 . 97579) (CLEAR.LINE? 97581 . 97935) (
CURRENT.WORD 97937 . 100175) (DELETE.TO.END 100177 . 100903) (DELETELINE 100905 . 103787) (DELETETO
103789 . 105597) (DELETETO1 105599 . 106851) (DO.EDIT.COMMAND 106853 . 124838) (DO.EDIT.PP 124840 .
126430) (DO?CMD 126432 . 132429) (TTYIN.PRINTARGS 132431 . 135868) (TTYIN.READ?=ARGS 135870 . 136668)
(TTDOTABS 136670 . 137713) (EDITCOLUMN 137715 . 138198) (EDITNUMBERP 138200 . 138434) (END.DELETE.MODE
138436 . 138964) (ENDREAD? 138966 . 141726) (FIND.LINE 141728 . 142950) (FIND.LINE.BREAK 142952 .
143607) (FIND.MATCHING.QUOTE 143609 . 144405) (FIND.MATCHING.WORD 144407 . 144957) (FIND.NEXT.WORD
144959 . 146300) (FIND.NON.SPACE 146302 . 146574) (FIND.START.OF.WORD 146576 . 146967) (
FORWARD.DELETE.TO 146969 . 148836) (GO.TO.ADDRESSING 148838 . 150000) (GO.TO.FREELINE 150002 . 150585)
(GO.TO.RELATIVE 150587 . 154020) (INIT.CURSOR 154022 . 154966) (INSERT.NODE 154968 . 155440) (
INSERTLINE 155442 . 157052) (KILL.LINES 157054 . 157614) (KILLSEGMENT 157616 . 158716) (L-CASECODE
158718 . 159002) (MOVE.BACK.TO 159004 . 159236) (MOVE.FORWARD.TO 159238 . 159592) (MOVE.TO.LINE 159594
. 160427) (MOVE.TO.NEXT.LINE 160429 . 160696) (MOVE.TO.START.OF.WORD 160698 . 161533) (
MOVE.TO.WHEREVER 161535 . 161777) (NTH.COLUMN.OF 161779 . 162122) (NTH.RELATIVE.COLUMN.OF 162124 .
163320) (OVERFLOW? 163322 . 164607) (OVERFLOWLINE? 164609 . 164923) (PREVLINE 164925 . 166225) (
PREVWORD 166227 . 167923) (PROPERTAILP 167925 . 168151) (READFROMBUF 168153 . 171069) (RENUMBER.LINES
171071 . 171445) (RESTORE.CURSOR 171447 . 171655) (RESTOREBUF 171657 . 173557) (RETYPE.BUFFER 173559
. 176089) (SAVE.CURSOR 176091 . 176266) (SCANBACK 176268 . 177842) (SCANFORWARD 177844 . 178676) (
SCRATCHCONS 178678 . 179236) (SEGMENT.LENGTH 179238 . 179757) (SEGMENT.BIT.LENGTH 179759 . 180407) (
SETLASTC 180409 . 180938) (SETTAIL? 180940 . 181768) (SHOW.MATCHING.PAREN 181770 . 184214) (SKIP/ZAP
184216 . 186794) (START.NEW.LINE 186796 . 187144) (START.OF.PARAGRAPH? 187146 . 187492) (TTADJUSTWORD
187494 . 188942) (TTBIN 188944 . 190211) (TTBITWIDTH 190213 . 190404) (TTCOMPLETEWORD 190406 . 199410)
(TTCRLF 199412 . 199640) (TTCRLF.ACCOUNT 199642 . 200311) (TTDELETECHAR 200313 . 201512) (
TTDELETELINE 201514 . 203347) (TTDELETEWORD 203349 . 204255) (TTECHO.TO.FILE 204257 . 207299) (
TTGIVEHELP 207301 . 209279) (TTGIVEHELP1 209281 . 209919) (TTGIVEHELP2 209921 . 210656) (TTLASTLINE
210658 . 211028) (TTLOADBUF 211030 . 214560) (TTNEXTLINE 214562 . 214901) (TTNEXTNODE 214903 . 215161)
(TTNLEFT 215163 . 216539) (TTNTH 216541 . 217035) (TTNTHLINE 217037 . 217519) (TTPRIN1 217521 .
218187) (TTPRIN2 218189 . 219564) (TTPROMPTCHAR 219566 . 219947) (TTRATOM 219949 . 220384) (TTREADLIST
220386 . 220786) (TTRUBOUT 220788 . 221882) (TTSKIPSEPR 221884 . 222269) (TTSKREAD 222271 . 226346) (
TTUNREADBUF 226348 . 226786) (TTWAITFORINPUT 226788 . 232384) (TTYINSTRING 232386 . 233806) (
TYPE.BUFFER 233808 . 234963) (U-CASECODE 234965 . 235250) (U/L-CASE 235252 . 237738) (
WORD.MATCHES.BUFFER 237740 . 238387)) (238713 251091 (&DISPLAYCOMMENT 238723 . 240337) (CAPABILITY?
240339 . 241829) (BEEP 241831 . 242009) (BITBLT.DELETE 242011 . 243024) (BITBLT.ERASE 243026 . 243258)
(BITBLT.INSERT 243260 . 243623) (DO.CRLF 243625 . 243881) (DO.DELETE.LINES 243883 . 245071) (DO.DOWN
245073 . 245427) (DO.INSERT.LINE 245429 . 247385) (DO.LF 247387 . 247545) (DO.UP 247547 . 247716) (
ERASE.TO.END.OF.LINE 247718 . 248060) (ERASE.TO.END.OF.PAGE 248062 . 248555) (INSERT.TEXT 248557 .
249108) (TTDELSECTION 249110 . 249431) (TTADJUSTWIDTH 249433 . 250353) (TTINSERTSECTION 250355 .
250717) (TTSETCURSOR 250719 . 251089)) (251122 255770 (TTYINBUFFERDEVICE 251132 . 252487) (
TTYINBUFFERSTREAM 252489 . 253150) (TTYINBUFFERBIN 253152 . 253560) (TTYINBUFFERPEEK 253562 . 253934)
(TTYINBUFFERREADP 253936 . 254136) (TTYINBUFFEREOFP 254138 . 254335) (TTYINBUFFERBACKPTR 254337 .
254864) (TTYINWORDRDTBL 254866 . 255768)) (255926 278917 (DO.MOUSE 255936 . 257895) (
DO.SHIFTED.SELECTION 257897 . 267307) (COPY.SEGMENT 267309 . 267516) (DELETE.LONG.SEGMENT 267518 .
267826) (DELETE.LONG.SEGMENT1 267828 . 269848) (INVERT.LONG.SEGMENT 269850 . 270848) (INVERT.SEGMENT
270850 . 272632) (BRACKET.CURRENT.WORD 272634 . 274143) (TTBEFOREPOS 274145 . 274748) (TTNEXTPOS
274750 . 275461) (TTRACKMOUSE 275463 . 278915)) (279060 284455 (INPART 279070 . 279425) (TTBOUT 279427
. 280572) (TTBOUTN 280574 . 280780) (PR! 280782 . 281550) (PRALL 281552 . 281870) (PRBUF 281872 .
283175) (PRLINE 283177 . 284453)) (284592 290366 (SETREADFN 284602 . 285014) (TTYINENTRYFN 285016 .
285450) (TTYINREADP 285452 . 285928) (TTYINREAD 285930 . 287524) (TTYINFIX 287526 . 288461) (
CHARMACRO? 288463 . 289080) (TTYINMETA 289082 . 289213) (\SET.TTYINBOLDFONT 289215 . 289995) (
TTYIN.LASTINPUT 289997 . 290364)) (290367 303318 (TTED 290377 . 294482) (DO.EE 294484 . 294637) (
TTYINEDIT 294639 . 295792) (SIMPLETEXTEDIT 295794 . 298186) (SET.TTYINEDIT.WINDOW 298188 . 299640) (
TTYIN.PPTOFILE 299642 . 301586) (TTYIN.SCRATCHFILE 301588 . 302895) (\TTYIN.RPEOF 302897 . 303316))))
)
STOP