(FILECREATED "12-Sep-86 13:51:10" {ERIS}<TEDIT>TEDITCOMMAND.;17 45168
changes to: (VARS TEDITCOMMANDCOMS)
(FNS \TEDIT.READTABLE)
previous date: " 4-Aug-86 15:20:00" {ERIS}<TEDIT>TEDITCOMMAND.;16)
(* Copyright (c) 1983, 1984, 1985, 1986 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITCOMMANDCOMS)
(RPAQQ TEDITCOMMANDCOMS [(FNS \TEDIT.INSERT.TTY.BUFFER \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE
\TEDIT.MARKINACTIVE \PNC \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.RESET.SETUP
)
[INITVARS (TEDIT.INTERRUPTS (QUOTE ((2 BREAK)
(5 ERROR)
(7 HELP)
(20 CONTROL-T]
(VARS (TEDIT.COPY.PENDING NIL)
(TEDIT.COPYLOOKS.PENDING NIL)
(TEDIT.MOVE.PENDING NIL)
(TEDIT.DEL.PENDING NIL)
(TEDIT.BLUEPENDINGDELETE NIL))
(GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING
TEDIT.DEL.PENDING TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \INSERT\TTY\BUFFER \TEDIT.MOUSESTATE
\TEDIT.CHECK))
(COMS (* Read-table Utilities)
(FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX
TEDIT.SETSYNTAX TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET
TEDIT.WORDSET)
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (
\TEDIT.READTABLE
))
(TEDIT.WORDBOUND.READTABLE (
\TEDIT.WORDBOUND.READTABLE
]
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TEDITTERMCODE))
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (NONE.TTC 0)
(CHARDELETE.TTC 1)
(WORDDELETE.TTC 2)
(DELETE.TTC 3)
(FUNCTIONCALL.TTC 4)
(REDO.TTC 5)
(UNDO.TTC 6)
(CMD.TTC 7)
(NEXT.TTC 8)
(EXPAND.TTC 9)
(PUNCT.TTC 20)
(TEXT.TTC 21)
(WHITESPACE.TTC 22)))
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (MSPACE 153)
(NSPACE 152)
(THINSPACE 159)
(FIGSPACE 154])
(DEFINEQ
(\TEDIT.INSERT.TTY.BUFFER
[LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* jds
" 9-Feb-86 15:23")
(* * OBSOLETE 2/9/86 ?? JDS)
(HELP)
(* (PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH)))
(COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached,
insert them in the text object and clear the cache.)
(replace (STRINGP OFFST) of SCRATCH with 0)
(replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN)
(replace (STRINGP LENGTH) of PASS with TLEN)
(TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN)))))
])
(\TEDIT.INTERRUPT.SETUP
[LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36")
(* Disarm any inconvenient interrupts, and save
re-arming info on the window.)
[PROG [(TEXTOBJ (AND (PROCESSPROP PROC (QUOTE WINDOW))
(WINDOWPROP (PROCESSPROP PROC (QUOTE WINDOW))
(QUOTE TEXTOBJ))
(TEXTOBJ (PROCESSPROP PROC (QUOTE WINDOW]
(UNINTERRUPTABLY
[COND
((AND FORCEOFF (PROCESSPROP PROC (QUOTE TEDIT.INTERRUPTS)))
(* There are disarmed interrupts;
re-arm them.)
(RESET.INTERRUPTS (PROCESSPROP PROC (QUOTE TEDIT.INTERRUPTS)))
(PROCESSPROP PROC (QUOTE TEDIT.INTERRUPTS)
NIL))
([AND (NOT FORCEOFF)
(NOT (PROCESSPROP PROC (QUOTE TEDIT.INTERRUPTS]
(* There aren't any interrupts disarmed;
go do it.)
(PROCESSPROP PROC (QUOTE TEDIT.INTERRUPTS)
(RESET.INTERRUPTS (OR (AND TEXTOBJ (TEXTPROP TEXTOBJ (QUOTE INTERRUPTS)
))
TEDIT.INTERRUPTS)
T])]
PROC])
(\TEDIT.MARKACTIVE
[LAMBDA (TEXTOBJ) (* jds "17-NOV-83 14:31")
(replace EDITOPACTIVE of TEXTOBJ with T)
TEXTOBJ])
(\TEDIT.MARKINACTIVE
[LAMBDA (TEXTOBJ) (* jds "17-NOV-83 14:32")
(replace EDITOPACTIVE of TEXTOBJ with NIL)
TEXTOBJ])
(\PNC
[LAMBDA (CH STR) (* jds " 7-JUN-82 14:03")
(PROG ((LEN (fetch (STRINGP LENGTH) of STR))
(OFFST (fetch (STRINGP OFFST) of STR)))
(COND
((ZEROP LEN)
(ERROR "NO ROOM LEFT IN STRING TO PUT CHARACTER"))
(T (UNINTERRUPTABLY
(\PUTBASEBYTE (fetch (STRINGP BASE) of STR)
OFFST CH)
(replace (STRINGP OFFST) of STR with (ADD1 OFFST))
(replace (STRINGP LENGTH) of STR with (SUB1 LEN)))])
(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* jds "17-Oct-85 17:37")
(* Main command loop for the TEDIT editor.
Includes keyboard polling and command dispatch)
(PROG ((TEXTOBJ (COND
((type? STREAM STREAM)
(fetch (TEXTSTREAM TEXTOBJ) of STREAM))
(T STREAM)))
(ISCRSTRING (ALLOCSTRING \SCRATCHLEN " "))
SEL WINDOW LINES IPASSSTRING TTYWINDOW)
(SETQ SEL (fetch SEL of TEXTOBJ))
(SETQ WINDOW (fetch \WINDOW of TEXTOBJ))
(SETQ LINES (fetch LINES of TEXTOBJ))
(SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1))
(* Used inside \INSERT\TTY\BUFFER)
(SETQ RTBL (OR RTBL (fetch TXTRTBL of TEXTOBJ)
TEDIT.READTABLE)) (* Used to derive command characters from type-in)
(for WW inside WINDOW do (WINDOWPROP WW (QUOTE PROCESS)
(THIS.PROCESS)))
(* And the window to this process)
(while (NOT (TTY.PROCESSP))
do (* Wait until we really have the TTY before
proceeding.)
(DISMISS 250))
(RESETLST
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ WINDOW)
T))
(PROG (CH FN TCH (DIRTY NIL)
(BLANKSEEN NIL)
INSCH#
(CRSEEN NIL)
TLEN CHNO (READSA (fetch READSA of #CURRENTRDTBL#))
(TERMSA (OR (fetch TXTTERMSA of TEXTOBJ)
\PRIMTERMSA))
(TEDITSA (fetch READSA of RTBL))
(TEDITFNHASH (fetch READMACRODEFS of RTBL))
(LOOPFN (TEXTPROP TEXTOBJ (QUOTE LOOPFN)))
(CHARFN (TEXTPROP TEXTOBJ (QUOTE CHARFN)))
COMMANDFN)
(while (NOT (fetch EDITFINISHEDFLG of TEXTOBJ))
do
(ERSETQ
(PROGN (\WAITFORSYSBUFP 25)
(* Await type-in or mouse action)
(while (OR TEDIT.SELPENDING (fetch EDITOPACTIVE
of TEXTOBJ))
do (* Don't do anything while he's selecting or one of
the lock-out ops is active.)
[COND
((EQ TEDIT.SELPENDING TEXTOBJ)
(* (OR (EQ TEDIT.SELPENDING TEXTOBJ)
(fetch TCUP of (fetch CARET of TEXTOBJ))))
(* If this TEdit is the one being selected in, or the
caret is explicitly visible, flash it)
(TEDIT.FLASHCARET (fetch CARET of TEXTOBJ]
(BLOCK))
[COND
((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ))
(T (COND
((fetch TXTNEEDSUPDATE of TEXTOBJ)
(* We got here somehow with the window not in sync
with the text. Run an update.)
(\SHOWSEL SEL NIL NIL)
(TEDIT.UPDATE.SCREEN TEXTOBJ NIL T)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T)))
(TEDIT.FLASHCARET (fetch CARET of TEXTOBJ))
(* Flash the caret periodically
(BUT not while we're here only to cleanup and quit.))
(replace EDITOPACTIVE of TEXTOBJ with T)
(* Before starting to work, note that we're doing
something.)
(AND LOOPFN (ERSETQ (APPLY* LOOPFN STREAM)))
(* If the guy wants control during the loop, give it
to him.)
(* Process any pending selections)
[ERSETQ (COND
(TEDIT.COPY.PENDING
(* Have to copy the shifted SEL to caret.)
(SETQ TEDIT.COPY.PENDING
NIL)
(\COPYSEL
TEDIT.SHIFTEDSELECTION
(fetch
SHIFTEDSEL
of TEXTOBJ)
)
(TEDIT.COPY (fetch
SHIFTEDSEL
of
TEXTOBJ)
(fetch
SEL
of
TEXTOBJ))
(replace SET
of
TEDIT.SHIFTEDSELECTION
with NIL)
(replace L1 of
TEDIT.SHIFTEDSELECTION
with NIL)
(replace LN of
TEDIT.SHIFTEDSELECTION
with NIL)
(\COPYSEL
TEDIT.SHIFTEDSELECTION
(fetch
SHIFTEDSEL
of TEXTOBJ)
))
(TEDIT.COPYLOOKS.PENDING
(* Have to copy the shifted SEL to caret.)
(SETQ TEDIT.COPYLOOKS.PENDING NIL)
(\COPYSEL TEDIT.COPYLOOKSSELECTION
(fetch SHIFTEDSEL of TEXTOBJ))
[COND
((EQ (QUOTE PARA)
(fetch SELKIND
of (fetch SHIFTEDSEL
of TEXTOBJ)))
(* copy the paragraph looks, since the source
selection type was paragraph)
(TEDIT.COPY.PARALOOKS TEXTOBJ
(fetch
SHIFTEDSEL
of TEXTOBJ)
(fetch SEL
of TEXTOBJ)))
(T
(* copy the character looks)
(TEDIT.COPY.LOOKS TEXTOBJ
(fetch SHIFTEDSEL
of TEXTOBJ)
(fetch SEL
of TEXTOBJ]
(\SHOWSEL (fetch SHIFTEDSEL of TEXTOBJ)
NIL NIL)
(replace SET of TEDIT.COPYLOOKSSELECTION
with NIL)
(replace L1 of TEDIT.COPYLOOKSSELECTION
with NIL)
(replace LN of TEDIT.COPYLOOKSSELECTION
with NIL)
(\COPYSEL TEDIT.COPYLOOKSSELECTION
(fetch SHIFTEDSEL of TEXTOBJ))
)
(TEDIT.MOVE.PENDING
(* Have to move the ctrl-shift SEL to caret.)
(SETQ TEDIT.MOVE.PENDING
NIL)
(\COPYSEL
TEDIT.MOVESELECTION
(fetch
MOVESEL
of TEXTOBJ)
)
(
TEDIT.DO.BLUEPENDINGDELETE
SEL TEXTOBJ)
(TEDIT.MOVE (fetch
MOVESEL
of
TEXTOBJ)
(fetch
SEL
of
TEXTOBJ))
(replace SET
of TEDIT.MOVESELECTION
with NIL)
(replace L1 of
TEDIT.MOVESELECTION
with NIL)
(replace LN of
TEDIT.MOVESELECTION
with NIL)
(\COPYSEL
TEDIT.MOVESELECTION
(fetch
MOVESEL
of TEXTOBJ)
))
(TEDIT.DEL.PENDING
(* Delete the current selection.)
(SETQ TEDIT.DEL.PENDING NIL)
(* Above all, reset the demand flag first)
(COND
((fetch SET of TEDIT.DELETESELECTION)
(* Only try the deletion if he really set the
selection.)
(\SHOWSEL (fetch DELETESEL
of TEXTOBJ)
NIL NIL)
(* Turn off the selection highlights)
(\SHOWSEL (fetch SEL of TEXTOBJ)
NIL NIL)
(replace SET
of (fetch DELETESEL of TEXTOBJ)
with NIL)
(\COPYSEL TEDIT.DELETESELECTION
(fetch SEL of TEXTOBJ))
(\TEDIT.SET.SEL.LOOKS (fetch SEL
of TEXTOBJ)
(QUOTE NORMAL))
(* Grab the selection we're to use)
(\TEDIT.DELETE (fetch SEL
of TEXTOBJ)
(fetch \TEXTOBJ
of (fetch SEL
of TEXTOBJ))
NIL)
(replace L1 of TEDIT.DELETESELECTION
with NIL)
(replace LN of TEDIT.DELETESELECTION
with NIL]
(UNINTERRUPTABLY
(replace (STRINGP OFFST) of ISCRSTRING
with 0)
(replace (STRINGP LENGTH) of ISCRSTRING
with \SCRATCHLEN))
(ERSETQ (while (\SYSBUFP)
do
(* Handle user type-in)
(SETQ CH (\GETKEY))
(COND
(CHARFN
(* Give the OEM user control for each character
typed.)
(SETQ TCH
(APPLY* CHARFN STREAM CH))
(OR (EQ TCH T)
(SETQ CH TCH))
(* And let him return one of NIL for
"ignore this char", T for "leave it be" or a new charcode.)
))
(SELECTC
(AND CH (\SYNCODE TEDITSA CH))
(CHARDELETE.TTC
(* Backspace handler: Remove the character just before
SEL:CH#.)
(\TEDIT.CHARDELETE
TEXTOBJ ISCRSTRING
SEL)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(WORDDELETE.TTC (\TEDIT.WORDDELETE
TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(DELETE.TTC
(* DEL Key handler: Delete the selected characters)
(\TEDIT.DELETE SEL
TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(UNDO.TTC
(* He hit the CANCEL key, so go UNDO something)
(TEDIT.UNDO TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(REDO.TTC
(* He hit the REDO key, so go REDO something)
(TEDIT.REDO TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
[FUNCTIONCALL.TTC
(* This is a special character -- it calls a function)
(COND
((SETQ FN (GETHASH CH
TEDITFNHASH))
(* There IS a command function to be called.)
(APPLY* FN
(fetch STREAMHINT
of TEXTOBJ)
TEXTOBJ SEL)
(* do it)
(\SHOWSEL SEL NIL NIL)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL)
(* After a user function, no more blue-pending-delete)
(\SHOWSEL SEL NIL T)
(* And forget any pending deletion.)
]
(NEXT.TTC
(* Move to the next blank to fill in.
For now, blanks are delimited by >>...<<)
(TEDIT.NEXT TEXTOBJ))
(EXPAND.TTC
(* EXPAND AN ABBREVIATION)
(\TEDIT.ABBREV.EXPAND
(fetch STREAMHINT
of TEXTOBJ)))
(SELECTC (AND TERMSA CH
(fetch TERMCLASS
of (\SYNCODE
TERMSA CH)))
(CHARDELETE.TC
(* Backspace handler: Remove the character just before
SEL:CH#.)
(
\TEDIT.CHARDELETE
TEXTOBJ
ISCRSTRING SEL)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(WORDDELETE.TC
(* Back-WORD handler)
(
\TEDIT.WORDDELETE
TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(LINEDELETE.TC
(* DEL Key handler: Delete the selected characters)
(
\TEDIT.DELETE
SEL TEXTOBJ)
(
TEDIT.RESET.EXTEND.PENDING.DELETE
SEL))
(COND
(CH
(* Any other key was hit: Just insert the character.)
(
TEDIT.DO.BLUEPENDINGDELETE
SEL TEXTOBJ)
(* Handle blue pending delete, if there is one.)
(TEDIT.\INSERT
CH SEL TEXTOBJ
BLANKSEEN CRSEEN]
(replace EDITOPACTIVE of TEXTOBJ with NIL)))
(replace EDITOPACTIVE of TEXTOBJ with NIL])
(\TEDIT.COMMAND.RESET.SETUP
[LAMBDA (TEXT&WIND STARTING) (* jds "31-Jul-86 17:18")
(* If STARTING is T, set up the
reset-driven connections and values
for editing; otherwise, break links
and reset values for non-editing)
(PROG ((TEXTOBJ (CAR TEXT&WIND))
(WINDOW (CADR TEXT&WIND))
(OTTYWINDOW (CADDR TEXT&WIND))
(OTTYENTRYFN (CADDDR TEXT&WIND))
(OTTYEXITFN (CAR (CDDDDR TEXT&WIND)))
(OWINDOW (CADR (CDDDDR TEXT&WIND)))
TTYWINDOW)
[COND
[STARTING (* We're going INTO the command loop.
Set up all the stuff)
(SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
(QUOTE WINDOW)
(CAR WINDOW))) (* Attach the process to this window.)
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* Disarm all interrupt chars, re-arm
them when we leave the edit)
(SETQ OTTYEXITFN (PROCESSPROP (THIS.PROCESS)
(QUOTE TTYEXITFN)
(QUOTE \TEDIT.PROCEXITFN)))
(* Set up functions for getting in and
out of the edit process)
(SETQ OTTYENTRYFN (PROCESSPROP (THIS.PROCESS)
(QUOTE TTYENTRYFN)
(QUOTE \TEDIT.PROCENTRYFN)))
(COND
((NEQ (TEXTPROP TEXTOBJ (QUOTE TTYWINDOW))
(QUOTE DON'T)) (* He can suppress the ability to
copy-select things into this window if
he wants....)
(SETQ TTYWINDOW (OR (TEXTPROP TEXTOBJ (QUOTE TTYWINDOW))
(CREATEW DEFAULTTTYREGION "TTY Window for TEdit" NIL T)))
(SETQ OTTYWINDOW (TTYDISPLAYSTREAM TTYWINDOW))
(PROCESSPROP (THIS.PROCESS)
(QUOTE TEDITTTYWINDOW)
TTYWINDOW)
(WINDOWPROP TTYWINDOW (QUOTE PROCESS)
NIL)
[WINDOWPROP TTYWINDOW (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WW)
(WINDOWPROP WW (QUOTE PROCESS)
NIL] (* So that there isn't a circularity
in the PROCESS -> TTYWINDOW -> PROCESS)
(WINDOWPROP TTYWINDOW (QUOTE COPYINSERTFN)
(FUNCTION \TEDIT.COPYINSERTFN))
(WINDOWPROP TTYWINDOW (QUOTE MAINWINDOW)
(CAR WINDOW]
(T (* Coming OUT OF the command loop --
reset everything)
(PROCESSPROP (THIS.PROCESS)
(QUOTE WINDOW)
(CAR WINDOW)) (* Detach the window from the edit
process, to prevent circularity there)
(WINDOWPROP (CAR WINDOW)
(QUOTE PROCESS)
NIL)
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)
T) (* Re-arm the interrupts we turned off
coming in.)
(COND
((AND (TXTFILE TEXTOBJ)
(NOT (WINDOWPROP (CAR WINDOW)
(QUOTE TEDIT-CLOSING-FILE)
T))) (* Remember to close the file we were
editing (Only if the window function
isn't closing it.))
(CLOSEF? (TXTFILE TEXTOBJ))
(WINDOWPROP (CAR WINDOW)
(QUOTE TEDIT-CLOSING-FILE)
NIL) (* And let anyone else who wants to
try closing the file do so.)
))
(PROCESSPROP (THIS.PROCESS)
(QUOTE TTYEXITFN)
OTTYEXITFN)
(PROCESSPROP (THIS.PROCESS)
(QUOTE TTYENTRYFN)
OTTYENTRYFN)
(replace TXTHISTORY of TEXTOBJ with NIL) (* To prevent circularities arising
from the need to remember textobjs in
the history list.)
(replace SELWINDOW of TEXTOBJ with NIL) (* To prevent a circularity thru the
window back to the textobj.)
(COND
((NEQ (TEXTPROP TEXTOBJ (QUOTE TTYWINDOW))
(QUOTE DON'T)) (* He can suppress the ability to
copy-select things into this window if
he wants....)
(TTYDISPLAYSTREAM OTTYWINDOW)
(PROCESSPROP (THIS.PROCESS)
(QUOTE TEDITTTYWINDOW)
NIL]
(RETURN (LIST TEXTOBJ WINDOW OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
)
(RPAQ? TEDIT.INTERRUPTS (QUOTE ((2 BREAK)
(5 ERROR)
(7 HELP)
(20 CONTROL-T))))
(RPAQQ TEDIT.COPY.PENDING NIL)
(RPAQQ TEDIT.COPYLOOKS.PENDING NIL)
(RPAQQ TEDIT.MOVE.PENDING NIL)
(RPAQQ TEDIT.DEL.PENDING NIL)
(RPAQQ TEDIT.BLUEPENDINGDELETE NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING TEDIT.DEL.PENDING
TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \INSERT\TTY\BUFFER MACRO (NIL (\TEDIT.INSERT.TTY.BUFFER ISCRSTRING IPASSSTRING TEXTOBJ SEL)
))
[PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down.
DOES NOT call GETMOUSESTATE, so the mouse-button info is
the same as the last time it WAS called.)
(SELECTQ (CAR BUTTON)
(LEFT (QUOTE (IEQP LASTMOUSEBUTTONS 4)))
(MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1)))
(RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2)))
(SHOULDNT]
[PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND [(AND (BOUNDP (QUOTE CHECK))
CHECK)
(CONS (QUOTE PROGN)
(for I in ARGS as J on ARGS when (NOT (STRINGP I))
collect
(LIST (QUOTE OR)
I
(LIST (QUOTE HELP)
"TEdit consistency-check failure [RETURN to continue]: "
(COND ((STRINGP (CADR J)))
(T (KWOTE I]
(T (CONS COMMENTFLG ARGS]
)
)
(* Read-table Utilities)
(DEFINEQ
(\TEDIT.READTABLE
[LAMBDA NIL (* jds "12-Sep-86 13:48")
(* Create a TEdit read-table, to
control which characters have what
functions and call which commands.)
(PROG [(RTBL (create READTABLEP
READMACRODEFS ← (HASHARRAY 50]
(for CH in (CHARCODE (BS ↑A ↑W DEL #A #B #C ESC)) as CL
in (LIST CHARDELETE.TTC CHARDELETE.TTC WORDDELETE.TTC DELETE.TTC UNDO.TTC NEXT.TTC
CMD.TTC REDO.TTC) do (* Set up the default syntax classes
for command characters)
(\SETSYNCODE (fetch READSA of RTBL)
CH CL))
(for CH in (CHARCODE (↑X)) as FN in (QUOTE (\TEDIT.ABBREV.EXPAND))
do (* Set up the default function-calling
characters (↑X to expand abbrevs for
now))
(\SETSYNCODE (fetch READSA of RTBL)
CH FUNCTIONCALL.TTC)
(PUTHASH CH FN (fetch READMACRODEFS of RTBL)))
(TEDIT.SETFUNCTION (CHARCODE ↑O)
(FUNCTION GET.OBJ.FROM.USER)
RTBL) (* And for image object capture)
(RETURN RTBL])
(\TEDIT.WORDBOUND.READTABLE
[LAMBDA NIL (* jds "28-APR-83 17:28")
(* Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of
the adjacent characters is different)
(PROG [(RTBL (create READTABLEP
READMACRODEFS ←(HARRAY 50]
(for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL)
CH PUNCT.TTC))
(* By default, every character except those noted below
is a punctuation character)
(for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* Upper case alpha)
(for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* Lower case alpha)
(for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL)
CH TEXT.TTC))
(* And digits are text characters)
(for CH in (CHARCODE (CR SPACE TAB ↑L)) do (\SETSYNCODE (fetch READSA of RTBL)
CH WHITESPACE.TTC))
(* And these are white space)
(for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE) do (\SETSYNCODE (fetch READSA
of RTBL)
CH TEXT.TTC))
(RETURN RTBL])
(TEDIT.GETSYNTAX
[LAMBDA (CH TABLE) (* jds
" 5-Feb-86 14:18")
(* Find TEdit's
interpretation of a
given character)
(SELECTC (\SYNCODE [fetch READSA of (COND
((type? TEXTOBJ TABLE) (* If given a TEXTOBJ
in place of a read
table, coerce it to the
read table for that
edit session)
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
TEDIT.READTABLE))
((type? STREAM TABLE) (* If given a TEXTOBJ
in place of a read
table, coerce it to the
read table for that
edit session)
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM
TEXTOBJ)
of TABLE))
TEDIT.READTABLE))
(T (OR TABLE TEDIT.READTABLE]
(COND
((LITATOM CH)
(APPLY* (QUOTE CHARCODE)
CH))
(T CH)))
(WORDDELETE.TTC
(QUOTE WORDDELETE))
(CHARDELETE.TTC
(QUOTE CHARDELETE))
(DELETE.TTC (QUOTE DELETE))
(UNDO.TTC (QUOTE UNDO))
(REDO.TTC (QUOTE REDO))
(FUNCTIONCALL.TTC
(QUOTE FN))
(CMD.TTC (QUOTE CMD))
(NEXT.TTC (QUOTE NEXT))
(EXPAND.TTC (QUOTE EXPAND))
NIL])
(TEDIT.SETSYNTAX
[LAMBDA (CHAR CLASS TABLE) (* jds
" 5-Feb-86 14:19")
(* SETS TEDIT-STYLE
SYNTAX BITS IN A
TERMTABLE)
(PROG1 (TEDIT.GETSYNTAX (SETQ CHAR (COND
((LITATOM CHAR)
(APPLY* (QUOTE CHARCODE)
CHAR))
(T CHAR)))
TABLE)
(\SETSYNCODE [fetch READSA of (COND
((type? TEXTOBJ TABLE) (* If given a TEXTOBJ
in place of a read
table, coerce it to the
read table for that
edit session)
(OR (fetch (TEXTOBJ TXTRTBL) of TABLE)
TEDIT.READTABLE))
((type? STREAM TABLE) (* If given a TEXTOBJ
in place of a read
table, coerce it to the
read table for that
edit session)
(OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM
TEXTOBJ)
of TABLE))
TEDIT.READTABLE))
(T (OR TABLE TEDIT.READTABLE]
CHAR
(SELECTQ CLASS
(CHARDELETE CHARDELETE.TTC)
(WORDDELETE WORDDELETE.TTC)
((DELETE LINEDELETE)
DELETE.TTC)
(UNDO UNDO.TTC)
(REDO REDO.TTC)
(CMD CMD.TTC)
(FN FUNCTIONCALL.TTC)
(NEXT NEXT.TTC)
(EXPAND EXPAND.TTC)
NONE.TTC])
(TEDIT.GETFUNCTION
[LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06")
(* Gets the FN that is called when CH is hit inside
TEDIT.)
[SETQ TABLE (COND
((type? TEXTOBJ TABLE) (* If given a TEXTOBJ in place of a read table, coerce
it to the read table for that edit session)
(fetch (TEXTOBJ TXTRTBL) of TABLE))
((type? STREAM TABLE) (* If given a TEXTOBJ in place of a read table, coerce
it to the read table for that edit session)
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE)))
(T (OR TABLE TEDIT.READTABLE]
(SETQ CHARCODE (COND
((LITATOM CHARCODE)
(APPLY* (QUOTE CHARCODE)
CHARCODE))
(T CHARCODE)))
(AND TABLE (type? READTABLEP TABLE)
(IEQP FUNCTIONCALL.TTC (\SYNCODE (fetch READSA of TABLE)
CHARCODE))
(fetch READMACRODEFS of TABLE)
(GETHASH CHARCODE (fetch READMACRODEFS of TABLE])
(TEDIT.SETFUNCTION
[LAMBDA (CHARCODE FN RTBL) (* jds "19-Sep-85 17:05")
(* Set TEDITs (read) table so that FN is called
whenever CHARCODE is typed.)
(* If FN is NIL, make the character be normal again.)
[SETQ RTBL (COND
((type? TEXTOBJ RTBL) (* If given a TEXTOBJ in place of a read table, coerce
it to the read table for that edit session)
(fetch (TEXTOBJ TXTRTBL) of RTBL))
((type? STREAM RTBL) (* If given a TEXTOBJ in place of a read table, coerce
it to the read table for that edit session)
(fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL)))
(T (OR RTBL TEDIT.READTABLE]
(\SETSYNCODE (fetch READSA of RTBL)
(SETQ CHARCODE (COND
((LITATOM CHARCODE)
(APPLY* (QUOTE CHARCODE)
CHARCODE))
(T CHARCODE)))
(COND
(FN (* He gave us a function to call.
Set up the syntax so it IS called.)
FUNCTIONCALL.TTC)
(T (* He gave us a function of NIL, meaning "turn it off".
Cause this character to become normal.)
NONE.TTC))) (* Mark the character as invoking a function)
(OR (fetch READMACRODEFS of RTBL)
(replace READMACRODEFS of RTBL with (HARRAY 50))) (* Make sure there's a hash table to store the function
in.)
(PUTHASH CHARCODE FN (fetch READMACRODEFS of RTBL])
(TEDIT.WORDGET
[LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24")
(\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
(COND
((SMALLP CH))
(T (CHCON1 CH])
(TEDIT.WORDSET
[LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23")
(* SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE)
(\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE))
(COND
((SMALLP CHARCODE))
(T (CHCON1 CHARCODE)))
(COND
((FIXP CLASS))
(T (SELECTQ CLASS
(PUNCTUATION PUNCT.TTC)
(WHITESPACE WHITESPACE.TTC)
(TEXT TEXT.TTC)
TEXT.TTC])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE))
(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224))
(TTDECODE (LOGAND DATUM 31))))
]
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ NONE.TTC 0)
(RPAQQ CHARDELETE.TTC 1)
(RPAQQ WORDDELETE.TTC 2)
(RPAQQ DELETE.TTC 3)
(RPAQQ FUNCTIONCALL.TTC 4)
(RPAQQ REDO.TTC 5)
(RPAQQ UNDO.TTC 6)
(RPAQQ CMD.TTC 7)
(RPAQQ NEXT.TTC 8)
(RPAQQ EXPAND.TTC 9)
(RPAQQ PUNCT.TTC 20)
(RPAQQ TEXT.TTC 21)
(RPAQQ WHITESPACE.TTC 22)
(CONSTANTS (NONE.TTC 0)
(CHARDELETE.TTC 1)
(WORDDELETE.TTC 2)
(DELETE.TTC 3)
(FUNCTIONCALL.TTC 4)
(REDO.TTC 5)
(UNDO.TTC 6)
(CMD.TTC 7)
(NEXT.TTC 8)
(EXPAND.TTC 9)
(PUNCT.TTC 20)
(TEXT.TTC 21)
(WHITESPACE.TTC 22))
)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ MSPACE 153)
(RPAQQ NSPACE 152)
(RPAQQ THINSPACE 159)
(RPAQQ FIGSPACE 154)
(CONSTANTS (MSPACE 153)
(NSPACE 152)
(THINSPACE 159)
(FIGSPACE 154))
)
)
(PUTPROPS TEDITCOMMAND COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4079 28271 (\TEDIT.INSERT.TTY.BUFFER 4089 . 4845) (\TEDIT.INTERRUPT.SETUP 4847 . 6084)
(\TEDIT.MARKACTIVE 6086 . 6274) (\TEDIT.MARKINACTIVE 6276 . 6468) (\PNC 6470 . 7020) (
\TEDIT.COMMAND.LOOP 7022 . 21674) (\TEDIT.COMMAND.RESET.SETUP 21676 . 28269)) (30710 43678 (
\TEDIT.READTABLE 30720 . 32519) (\TEDIT.WORDBOUND.READTABLE 32521 . 34329) (TEDIT.GETSYNTAX 34331 .
36939) (TEDIT.SETSYNTAX 36941 . 39799) (TEDIT.GETFUNCTION 39801 . 40994) (TEDIT.SETFUNCTION 40996 .
42856) (TEDIT.WORDGET 42858 . 43107) (TEDIT.WORDSET 43109 . 43676)))))
STOP