(FILECREATED "28-Nov-84 18:32:19" {IVY}<TEDIT>TEXTOFD.;7 113275 )
(* Copyright (c) 1983, 1984 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEXTOFDCOMS)
(RPAQQ TEXTOFDCOMS [(FILES TEDITSELECTION)
(RECORDS EDITMARK PIECE TEXTOBJ TEXTIMAGEDATA TEXTSTREAM)
(COMS (* Private data structures and constants)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\EditEOFChar# 1000000)
(\PCTBFreePieces 0)
(\PCTBLastPieceOffset 1)
(\FirstPieceOffset 2)
(\SecondPieceOffset 4)
(\EltsPerPiece 2))
(MACROS * TEXTOFDMACROS)
(GLOBALVARS \TEXTIMAGEOPS \TEXTOFD \TEXTFDEV)))
(FNS COPYTEXTSTREAM OPENTEXTSTREAM REOPENTEXTSTREAM TEDIT.STREAMCHANGEDP TEXTSTREAMP TXTFILE
\CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETECH \DELETEPIECE \FINDPIECE
\INSERTCH \INSERTCR \INSERTPIECE \MAKEPCTB \SETUPGETCH \TEDIT.REOPEN.STREAM \SPLITPIECE
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN \TEXTINIT \TEXTMARK \TEXTTTYBOUT)
(COMS (* Generic-IO type operations support)
(FNS \TEXTCLOSEF \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR \TEXTGETFILEPTR \TEXTOPENF
\TEXTOUTCHARFN \TEXTPEEKBIN \TEXTBACKFILEPTR \TEXTBIN \TEXTBOUT \TEXTSETEOF
\TEXTSETFILEPTR))
(COMS (* Support for TEXTPROP)
(FNS CGETTEXTPROP CTEXTPROP GETTEXTPROP PUTTEXTPROP TEXTPROP)
(MACROS TEXTPROP))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA TEXTPROP])
(FILESLOAD TEDITSELECTION)
[DECLARE: EVAL@COMPILE
(RECORD EDITMARK (PC PCOFF . PCNO))
(DATATYPE PIECE ( (* The piece describes either a string or part of a
file. , or a generalized OBJECT.)
PSTR (* The string where this piece's text resides, or NIL)
PFILE (* The file which contains this piece's text, or NIL)
PFPOS (* The FILEPTR of the start of the piece in the file)
PLEN (* Length of the piece, in characters.)
NEXTPIECE (* -> Next piece in this textobj.)
(PREVPIECE FULLXPOINTER) (* -> Prior piece in this text object.)
PLOOKS (* Formatting info and formatting events in this piece)
POBJ (* The OBJECT this piece describes)
PPARALAST (* This piece contains a paragraph break)
PPARALOOKS (* Paragraph looks for this piece)
PNEW (* This text is new here; used by the tentative edit
system, and anyone else interested.)
)
PSTR ← NIL PFILE ← NIL PFPOS ← 0 PLEN ← 0 PPARALOOKS ← TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ (PCTB (* The piece table)
\INSERTPC (* Piece to hold type-in)
\INSERTPCNO (* Piece # of the input piece)
\INSERTNEXTCH (* CH# of next char which is typed into that piece.)
\INSERTLEFT (* Space left in the type-in piece)
\INSERTLEN (* # of characters already in the piece.)
\INSERTSTRING (* The string which the piece describes.)
\INSERTFIRSTCH (* CH# of first char in the piece.)
\WINDOW (* The window where this textobj is displayed)
MOUSEREGION (* Section of the window the mouse is in.)
TEXTLEN (* # of chars in the text)
LINES (* -> to top of chain of line descriptors for displayed
text)
DS (* Display stream where this textobj is displayed)
SEL (* The current selection within the text)
SCRATCHSEL (* Scratch space for the selection code)
MOVESEL (* Source for the next MOVE of text)
SHIFTEDSEL (* Source for the next COPY)
DELETESEL (* Text to be deleted imminently)
WRIGHT (* Right edge of the window
(or subregion) where this is displayed)
WTOP (* Top of the window/region)
WBOTTOM (* Bottom of the window/region)
WLEFT (* Left edge of the window/region)
TXTFILE (* The original text file we're editing)
\DIRTY (* T => changed since last saved.)
(STREAMHINT FULLXPOINTER) (* -> the TEXTOFD stream which gives access to this
textobj)
EDITFINISHEDFLG (* T => The guy has asked the editor to go way)
CARET (* Describes the flashing caret for the editing window)
CARETLOOKS (* Font to be used for inserted text.)
WINDOWTITLE (* Original title for this window, of there was one.)
THISLINE (* Cache of line-related info, to speed up selection
&c)
MENUFLG (* T if this TEXTOBJ is a tedit-style menu)
FMTSPEC (* Default Formatting Spec to be used when formatting
paragraphs)
FORMATTEDP (* Flag for paragraph formatting.
T if this document is to contain paragraph formatting
information.)
TXTREADONLY (* This is only available for shift selection.)
TXTTERMSA (* Special instructions for displaying characters on
the screen)
EDITOPACTIVE (* T if there is an editing operation in progress.
Used to interlock the TEdit menu)
DEFAULTCHARLOOKS (* The default character looks -- if any -- to be
applied to characters coming into the file from
outside.)
TXTRTBL (* The READTABLE to be used by the command loop for
command dispatch)
TXTWTBL (* The READTABLE to be used to decide on word breaks)
EDITPROPS (* The PROPS that were passed into this edit session)
BLUEPENDINGDELETE (* T if the next insertion in this document is to be
preceded by a deletion of the then-current selection)
TXTHISTORY (* The history list for this edit session.)
(SELWINDOW FULLXPOINTER) (* The window in which the last "real" selection got
made for this edit; used to control caret placement)
PROMPTWINDOW (* A window to be used for unscheduled interactions;
normally a small window above the edit window)
LINECACHE (* A Bitmap used to cache line images for display)
LINECACHES (* A list of the line caches, because they're hooked
together by XPOINTERs.)
DISPLAYCACHE (* The bitmap to be used when building the image of a
line for display)
DISPLAYCACHEDS (* The DISPLAYSTREAM that is used to build line images)
TXTPAGEFRAMES (* A tree of page frames, specifying how the document
is to be laid out.)
)
SEL ←(create SELECTION)
SCRATCHSEL ←(create SELECTION)
MOVESEL ←(create SELECTION
HOW ← EDITMOVESHADE
HOWHEIGHT ← 32767
HASCARET ← NIL)
SHIFTEDSEL ←(create SELECTION
HOW ← COPYSELSHADE
HASCARET ← NIL)
DELETESEL ←(create SELECTION
HOW ← BLACKSHADE
HOWHEIGHT ← 32767
HASCARET ← NIL)
\INSERTNEXTCH ← -1 \INSERTPC ← NIL \INSERTLEFT ← 0 \INSERTLEN ← 0 \INSERTSTRING ←
NIL \INSERTFIRSTCH ← 1000000 TEXTLEN ← 0 WRIGHT ← 0 WTOP ← 0 WLEFT ← 0 WBOTTOM ← 0
TXTFILE ← NIL \DIRTY ← NIL MOUSEREGION ←(QUOTE TEXT)
THISLINE ←(create THISLINE)
MENUFLG ← NIL FMTSPEC ← TEDIT.DEFAULT.FMTSPEC FORMATTEDP ← NIL)
(DATATYPE TEXTIMAGEDATA (TICURPARALOOKS (* The current paragraph looks)
TICURIMAGESTREAM (* The image stream for this hardcopy transduction)
TILOOKSUPDATEFN (* The function to call to update looks for this
stream)
))
(ACCESSFNS TEXTSTREAM ((REALFILE (FETCH F1 OF DATUM)
(REPLACE F1 OF DATUM WITH NEWVALUE))
(* The real, underlying file behind the current piece)
(CHARSLEFT (FETCH F2 OF DATUM)
(REPLACE F2 OF DATUM WITH NEWVALUE))
(* The # of characters that will be left in the current
piece the next time its file crosses a page boundary)
(TEXTOBJ (FETCH F3 OF DATUM)
(REPLACE F3 OF DATUM WITH NEWVALUE))
(* The TEXTOBJ that is editing this text)
(PIECE (FETCH F5 OF DATUM)
(REPLACE F5 OF DATUM WITH NEWVALUE))
(* The PIECE we're currently fetching chars
from/putting chars into)
(PCNO (FETCH FW8 OF DATUM)
(REPLACE FW8 OF DATUM WITH NEWVALUE))
(* The position of that piece in the piece table)
(PCSTARTPG (FETCH FW6 OF DATUM)
(REPLACE FW6 OF DATUM WITH NEWVALUE))
(* The underlying file page# that this piece starts on)
(PCSTARTCH (FETCH FW7 OF DATUM)
(REPLACE FW7 OF DATUM WITH NEWVALUE))
(* The char within page of the underlying file that
this piece starts on -- for backbin & co)
(PCOFFSET (FETCH F4 OF DATUM)
(REPLACE F4 OF DATUM WITH NEWVALUE))
(* The offset into the current piece, as of the last
page cross.)
(CURRENTLOOKS (fetch F10 of DATUM)
(replace F10 of DATUM with NEWVALUE))
(* The CHARLOOKS that are currently applicable to
characters being taken from the stream.)
(CURRENTPARALOOKS (FETCH TICURPARALOOKS OF (fetch IMAGEDATA of DATUM))
(REPLACE TICURPARALOOKS OF (fetch IMAGEDATA of DATUM)
with NEWVALUE))
(* The FMTSPEC that is currently applicable to
characters being taken from the stream.)
(CURRENTIMAGESTREAM (FETCH TICURIMAGESTREAM OF (fetch IMAGEDATA of DATUM))
(REPLACE TICURIMAGESTREAM OF (fetch IMAGEDATA
of DATUM)
with NEWVALUE)
(* The image stream that this text is being put onto;
used for scaling decisions)
)
(LOOKSUPDATEFN (FETCH TILOOKSUPDATEFN OF (fetch IMAGEDATA of DATUM))
(REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA of DATUM)
with NEWVALUE)))
(CREATE (create STREAM using \TEXTOFD IMAGEDATA ←(create TEXTIMAGEDATA))))
]
(/DECLAREDATATYPE (QUOTE PIECE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER
POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE TEXTOBJ)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER
FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER FULLXPOINTER POINTER POINTER POINTER
POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE TEXTIMAGEDATA)
(QUOTE (POINTER POINTER POINTER)))
(* Private data structures and constants)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \EditEOFChar# 1000000)
(RPAQQ \PCTBFreePieces 0)
(RPAQQ \PCTBLastPieceOffset 1)
(RPAQQ \FirstPieceOffset 2)
(RPAQQ \SecondPieceOffset 4)
(RPAQQ \EltsPerPiece 2)
(CONSTANTS (\EditEOFChar# 1000000)
(\PCTBFreePieces 0)
(\PCTBLastPieceOffset 1)
(\FirstPieceOffset 2)
(\SecondPieceOffset 4)
(\EltsPerPiece 2))
)
(RPAQQ TEXTOFDMACROS (\EDITELT \GETCH \GETCHB \EDITSETA \WORDSETA))
(DECLARE: EVAL@COMPILE
(PUTPROPS \EDITELT DMACRO (OPENLAMBDA (ARR NO)
(* This is equivalent to ELT, but bypasses the checking, since
we "know" that ARR is an array. Hence, much faster.)
(GETBASEPTR (\ADDBASE2 (fetch (ARRAYP BASE)
of ARR)
NO)
0)))
(PUTPROPS \GETCH MACRO ((TEXTOBJ) (* jds "23-FEB-82 08:56")
(* Get the next available character from the text being
edited.)
(\BIN (fetch STREAMHINT of TEXTOBJ))))
(PUTPROPS \GETCHB MACRO ((TEXTOBJ) (* Get the next prior character in the text being
edited.)
(\BACKBIN (fetch STREAMHINT of TEXTOBJ))))
(PUTPROPS \EDITSETA DMACRO (OPENLAMBDA (ARR N VAL)
(* Equivalent to SETA (for pointer-type arrays)
, but bypasses the bounds and type checking. Hence MUCH
faster.)
(\RPLPTR (\ADDBASE2 (fetch (ARRAYP BASE)
of ARR)
N)
0 VAL)))
(PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V)
[CHECK (AND (ARRAYP A)
(ZEROP (fetch (ARRAYP ORIG)
of A))
(EQ \ST.POS16 (fetch (ARRAYP TYP)
of A]
(CHECK (IGREATERP (fetch (ARRAYP LENGTH)
of A)
J))
(\PUTBASE (fetch (ARRAYP BASE)
of A)
(IPLUS (fetch (ARRAYP OFFST)
of A)
J)
V)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TEXTIMAGEOPS \TEXTOFD \TEXTFDEV)
)
)
(DEFINEQ
(COPYTEXTSTREAM
[LAMBDA (ORIGINAL CROSSCOPY) (* jds " 2-May-84 13:35")
(* Given a stream, textobj or window, returns a new textstream with the same contents. If CROSSCOPY then strings
will really be allocated providing copies of the text else the fileptrs still will be aliases as in the rest of
TEDIT.)
(PROG ((TEXTOBJ (TEXTOBJ ORIGINAL))
TSEL PCTB PCLST NEWSTREAM NEWTEXTOBJ)
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ TSEL (fetch SCRATCHSEL of TEXTOBJ))
(SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (fetch EDITPROPS of TEXTOBJ)))
(* First create an empty textstream into which the
pieces can be hammered)
(SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM))
(replace CH# of TSEL with 1)
(replace CHLIM of TSEL with (fetch TEXTLEN of TEXTOBJ))
(replace DCH of TSEL with (fetch TEXTLEN of TEXTOBJ))
(SETQ PCLST (TEDIT.SELECTED.PIECES TEXTOBJ TSEL CROSSCOPY (FUNCTION
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN)
TEXTOBJ NEWTEXTOBJ))
(* now get a list of copies of the pieces to be inserted
into the empty textstream)
(\TEDIT.INSERT.PIECES NEWTEXTOBJ 1 PCLST (fetch TEXTLEN of TEXTOBJ)
NIL NIL CROSSCOPY)
(replace TEXTLEN of NEWTEXTOBJ with (fetch TEXTLEN of TEXTOBJ))
(replace MENUFLG of NEWTEXTOBJ with (fetch MENUFLG of TEXTOBJ))
(RETURN NEWSTREAM])
(OPENTEXTSTREAM
[LAMBDA (TEXT WINDOW START END PROPS) (* jds "13-Nov-84 15:05")
(* Create a text-type STREAM to describe TEXT.
Optionally, connect that to WINDOW for display.)
(PROG ([TEXTOBJ (COND
((AND (type? STREAM TEXT)
(type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT)))
(* If the guy gave us a text stream to edit, use its
TEXTOBJ as ours.)
(create TEXTOBJ reusing (fetch (TEXTSTREAM TEXTOBJ) of TEXT)
\INSERTFIRSTCH ← -1 \INSERTNEXTCH ← -1))
(T (create TEXTOBJ]
(TEDIT.GET.FINISHEDFORMS NIL)
(PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)))
FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP TEXTOBJ.WINDOW.VALID CLEARGET? PARALOOKS)
(SETQ TEXTOBJ.WINDOW.VALID (EQ WINDOW (\TEDIT.PRIMARYW TEXTOBJ)))
(* Remember if the textobj had a window already.)
(replace \WINDOW of TEXTOBJ with WINDOW) (* Necessary because some incoming object types depend
on knowing where the window is.)
[COND
((type? TEXTOBJ TEXT) (* If the old thing was a TEXTOBJ, go ahead and reuse
it.)
(SETQ TEXT (fetch STREAMHINT of TEXT]
[SETQ FONT (COND
((type? CHARLOOKS (LISTGET PROPS (QUOTE FONT)))
(LISTGET PROPS (QUOTE FONT)))
(T (\TEDIT.PARSE.CHARLOOKS.LIST (OR (LISTGET PROPS (QUOTE LOOKS))
(FONTCREATE (OR (LISTGET PROPS (QUOTE FONT))
DEFAULTFONT)))
NIL TEXTOBJ] (* Find the default font for this session -- either
what the guy tells us, or the global default font)
(SETQ PARALOOKS (LISTGET PROPS (QUOTE PARALOOKS)))
(* Get the default paragraph looks.
This must come before the first piece is created, so
its fields can be filled in right.)
[replace FMTSPEC of TEXTOBJ with (SETQ PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
(OR PARALOOKS (create FMTSPEC using
TEDIT.DEFAULT.FMTSPEC]
[COND
[[AND (type? STREAM TEXT)
(type? TEXTOBJ (SETQ OTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT]
(* We got a TEXTOFD stream to edit;
just use it)
(SETQ TEXTSTREAM TEXT)
(for SELN in (LIST (fetch SEL of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ)
(fetch SHIFTEDSEL of TEXTOBJ)
(fetch MOVESEL of TEXTOBJ)
(fetch DELETESEL of TEXTOBJ))
do (* Make all the selections point to the CURRENT
textobj!)
(COND
((EQ OTEXTOBJ (fetch \TEXTOBJ of SELN))
(replace \TEXTOBJ of SELN with TEXTOBJ))
(T (replace SET of SELN with NIL)))
(replace ONFLG of SELN with NIL))
(replace (TEXTSTREAM TEXTOBJ) of TEXTSTREAM with TEXTOBJ)
(replace STREAMHINT of TEXTOBJ with TEXTSTREAM)
(replace EDITFINISHEDFLG of TEXTOBJ with NIL)
(* Mark the edit incomplete.)
(replace \DIRTY of TEXTOBJ with NIL) (* And mark it not changed.)
(COND
(FONT (* If a new default font was specified, set it up.)
(replace DEFAULTCHARLOOKS of TEXTOBJ with FONT]
(T (* Otherwise, create a TEXTOFD to describe the text
we're editing.-)
(replace EDITPROPS of TEXTOBJ with (APPEND (COPY PROPS)
(fetch EDITPROPS of TEXTOBJ)))
(* Save the PROPS for later people who'd like to know
them)
(SETQ TEXTSTREAM (replace STREAMHINT of TEXTOBJ with (create TEXTSTREAM
TEXTOBJ ← TEXTOBJ)))
[replace PCTB of TEXTOBJ with (SETQ PCTB (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END FONT
PARALOOKS
(LISTGET PROPS
(QUOTE CLEARGET]
(SETQ PC (\EDITELT PCTB (ADD1 \FirstPieceOffset)))
(for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))
(replace TEXTLEN of TEXTOBJ with (SUB1 (\EDITELT PCTB (SUB1 (\EDITELT PCTB
\PCTBLastPieceOffset]
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
(replace DEFAULTCHARLOOKS
of TEXTOBJ with FONT)))
(replace CARET of TEXTOBJ with (create TEDITCARET
TCCARETDS ←(AND WINDOW (WINDOWPROP WINDOW
(QUOTE DSP)))
TCFORCEUP ← T))
(replace TXTREADONLY of TEXTOBJ with (LISTGET PROPS (QUOTE READONLY)))
(replace TXTTERMSA of TEXTOBJ with (AND (SETQ PROP (LISTGET PROPS (QUOTE TERMTABLE)))
(fetch TERMSA of PROP)))
(replace TXTRTBL of TEXTOBJ with (LISTGET PROPS (QUOTE READTABLE)))
(replace TXTWTBL of TEXTOBJ with (LISTGET PROPS (QUOTE BOUNDTABLE)))
(SETQ SEL (fetch SEL of TEXTOBJ))
(SETQ PROP (LISTGET PROPS (QUOTE SEL))) (* Initial Selection, if any.)
(COND
((type? SELECTION PROP) (* We came in with an explicit initial sel.
Set it up.)
(\COPYSEL PROP SEL)
(replace SET of SEL with T)
(replace \TEXTOBJ of SEL with TEXTOBJ))
((AND (fetch SET of SEL)
(NOT PROP)) (* If we came into this with a valid selection,
highlight it.)
(replace \TEXTOBJ of SEL with TEXTOBJ))
(T (* Starting without a selection;
let's start with a point selection before the first
character.)
(replace CH# of SEL with (COND
((FIXP PROP))
(PROP (CAR PROP))
(1)))
(replace CHLIM of SEL with (COND
((FIXP PROP))
[PROP (SUB1 (IPLUS (CAR PROP)
(CADR PROP]
(1)))
(replace DCH of SEL with (COND
((FIXP PROP)
0)
(PROP (CADR PROP))
(0)))
(replace (SELECTION DX) of SEL with 0)
(replace POINT of SEL with (QUOTE LEFT))
(replace SELKIND of SEL with (QUOTE CHAR))
(replace SET of SEL with (NOT (fetch TXTREADONLY of TEXTOBJ)))
(replace \TEXTOBJ of SEL with TEXTOBJ)))
[COND
((fetch SET of SEL) (* If there's an initial selection, it implies initial
caret looks, too.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL]
(COND
((AND WINDOW (NOT TEXTOBJ.WINDOW.VALID)) (* Only if there's a window to display it in:)
(\TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS)
(* Set up the window, and display the initial text.)
))
(\SETUPGETCH (create EDITMARK
PC ←(\EDITELT (fetch PCTB of TEXTOBJ)
(ADD1 \FirstPieceOffset))
PCOFF ← 0
PCNO ← \FirstPieceOffset)
TEXTOBJ) (* Set the file ptr to 0)
(RETURN TEXTSTREAM])
(REOPENTEXTSTREAM
[LAMBDA (STREAM) (* jds "25-Apr-84 14:41")
(replace ACCESS of STREAM with (QUOTE BOTH))
(replace BINABLE of STREAM with T)
(replace STRMBINFN of STREAM with (FUNCTION \TEXTBIN))
(replace STRMBOUTFN of STREAM with (FUNCTION \TEXTBOUT))
STREAM])
(TEDIT.STREAMCHANGEDP
[LAMBDA (STREAM RESET?) (* jds " 8-Feb-84 15:06")
(PROG1 (fetch \DIRTY of (TEXTOBJ STREAM))
(COND
(RESET? (replace \DIRTY of (TEXTOBJ STREAM) with NIL])
(TEXTSTREAMP
[LAMBDA (STREAM) (* jds " 3-Apr-84 14:34")
(* Returns the stream if it is a text stream, else NIL)
(AND (STREAMP STREAM)
(type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
STREAM])
(TXTFILE
[LAMBDA (TEXTOBJ) (* jds "30-AUG-82 14:59")
(* This function is for compiled access to the TXTFILE
field in RESETSAVE expressions)
(fetch TXTFILE of TEXTOBJ])
(\CHTOPC
[LAMBDA (CH# PCTB) (* jds "13-OCT-83 17:21")
(* Given a character # in a text object, and the object's piece table, return a pointer to the piece containing
that character, else NIL)
(\EDITELT PCTB (ADD1 (\CHTOPCNO CH# PCTB])
(\CHTOPCNO
[LAMBDA (CH# PCTB) (* jds " 7-APR-83 15:30")
(* Given a character # in a text object, and the object's piece table, return a pointer to the piece containing
that character, else NIL)
(DECLARE (LOCALVARS . T))
(PROG ((ARRBASE (fetch (ARRAYP BASE) of PCTB))
(LPROBE (LLSH (IDIFFERENCE \FirstPieceOffset 2)
1))
(PROBE (LOGAND (IPLUS \FirstPieceOffset (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)))
65532))
(HPROBE (LLSH (ADD1 (\EDITELT PCTB \PCTBLastPieceOffset))
1))
TRIALVALUE)
(SETQ TRIALVALUE (GETBASEPTR (\ADDBASE ARRBASE PROBE)
0)) (* Initial trial value for the search)
(RETURN (LRSH (do (COND
[(ILESSP TRIALVALUE CH#) (* If we're below the target ch#, then move upward half
the remaining unsearched table)
(COND
((IEQP (SETQ LPROBE PROBE)
(SETQ PROBE (LOGAND (LRSH (IPLUS PROBE HPROBE)
1)
65532)))
(RETURN PROBE]
[(IGREATERP TRIALVALUE CH#) (* If we're above the target ch#, move down half the
remaining distance)
(COND
((IEQP (SETQ HPROBE PROBE)
(SETQ PROBE (LOGAND (LRSH (IPLUS LPROBE PROBE)
1)
65532)))
(RETURN (IMAX PROBE \FirstPieceOffset]
(T (* If we hit the target directly, this is us.)
(RETURN PROBE)))
(SETQ TRIALVALUE (GETBASEPTR (\ADDBASE ARRBASE PROBE)
0)))
1])
(\CLEARPCTB
[LAMBDA (PCTB) (* jds "29-DEC-82 10:32")
(PROG ((OLASTPC (\EDITELT PCTB \PCTBLastPieceOffset)))
(\EDITSETA PCTB \FirstPieceOffset 1) (* Create the LASTPIECE pseudo-piece placeholder in the
first piece of the table)
(\EDITSETA PCTB (ADD1 \FirstPieceOffset)
(QUOTE LASTPIECE))
(for I from \SecondPieceOffset to OLASTPC
do (* Now remove the other pieces, setting them to NIL)
(\EDITSETA PCTB I NIL))
(\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 \FirstPieceOffset))
(* Fix up the last-piece pointer)
(\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces)
(LRSH (IDIFFERENCE OLASTPC (ADD1 \FirstPieceOffset))
1)))
(* And the free count of pieces.)
(RETURN PCTB])
(\CREATEPIECEORSTREAM
[LAMBDA (STRING LOOKS PARALOOKS START END) (* jds "18-Oct-84 16:12")
(* Given a source for text, build a PIECE to describe
it.)
(* HOWEVER-- if it's aformatted file, return the stream
for that file.)
(PROG (PC)
[SETQ PC
(COND
((STRINGP STRING) (* It's a string.)
(create PIECE
PSTR ← STRING
PFILE ← NIL
PLEN ←(NCHARS STRING)
PPARALAST ← NIL
PPARALOOKS ← PARALOOKS))
((NULL STRING) (* If it's NIL, use an empty string for the text.)
(create PIECE
PSTR ← ""
PFILE ← NIL
PLEN ← 0
PPARALAST ← NIL
PPARALOOKS ← PARALOOKS))
((ATOM STRING) (* An atom is a file name. Open it.)
(SETQ STRING (OPENSTREAM STRING (QUOTE INPUT)
(QUOTE OLD)))
(RETURN STRING))
[(STREAMP STRING)
(COND
[(EQ NoBits (fetch ACCESSBITS of STRING))
(* If the stream is no longer open, open it.)
(RETURN (OPENSTREAM STRING (QUOTE INPUT)
(QUOTE OLD]
(T (RETURN STRING]
((type? PIECE STRING)
STRING)
(T (* Anything else is coerced to a string first.)
(SETQ STRING (MKSTRING STRING))
(create PIECE
PSTR ← STRING
PFILE ← NIL
PLEN ←(NCHARS STRING)
PPARALAST ← NIL
PPARALOOKS ← PARALOOKS]
(replace PLOOKS of PC with (OR LOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)))
(replace PPARALOOKS of PC with (OR PARALOOKS (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)))
(RETURN PC])
(\DELETECH
[LAMBDA (CH# CHLIM LEN TEXTOBJ) (* jds "28-Nov-84 15:44")
(* Delete the indicated characters from the text object
represented by TEXTOBJ)
(PROG ((\INFIRSTCH (fetch \INSERTFIRSTCH of TEXTOBJ))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(PCTB (fetch PCTB of TEXTOBJ)))
(\TEDIT.CHECK (IGEQ LEN 0)
"LEN of delete must be >0.")
[\TEDIT.CHECK (IEQP LEN (ADD1 (IDIFFERENCE CHLIM CH#]
[COND
[(AND (IEQP CHLIM (SUB1 (fetch \INSERTNEXTCH of TEXTOBJ)))
(IGEQ CH# \INFIRSTCH)) (* The deletion is from the end of the most recent
type-in. Just adjust the buffer string.)
(freplace \INSERTLEN of TEXTOBJ with (replace PLEN of (fetch \INSERTPC of TEXTOBJ)
with (IDIFFERENCE CH# \INFIRSTCH)))
(* Cut back the length)
(freplace \INSERTNEXTCH of TEXTOBJ with (IPLUS (fetch \INSERTLEN of TEXTOBJ)
\INFIRSTCH))
(* and ch# of next insertion
(i.e., 1 past the top CH# in the insert piece.))
(replace THLEN of (fetch TXTHISTORY of TEXTOBJ)
with (IDIFFERENCE (fetch THLEN of (fetch TXTHISTORY of TEXTOBJ))
LEN)) (* Reduce the length of the insertion in the history
list, too.)
(for I from (IPLUS \EltsPerPiece (\CHTOPCNO CH# PCTB)) to (\EDITELT PCTB
\PCTBLastPieceOffset)
by \EltsPerPiece
do (\EDITSETA PCTB I (IDIFFERENCE (\EDITELT PCTB I)
LEN)) (* Adjust CH#s in the Piece Table.)
)
(COND
((ZEROP (fetch \INSERTLEN of TEXTOBJ)) (* He's completely emptied the type-in piece.
Remove it and force creation of a fresh one at next
type-in.)
(\DELETEPIECE (fetch \INSERTPC of TEXTOBJ)
PCTB)
(freplace \INSERTNEXTCH of TEXTOBJ with -1]
((ILEQ CH# TEXTLEN) (* General case of deletion: Remove pieces as needed to
do it.)
(PROG ((PCNO1 (\CHTOPCNO CH# PCTB))
PCN PC1 PCNON PCSOUT (HIPC NIL)
HI LO)
(SETQ PC1 (\EDITELT PCTB (ADD1 PCNO1)))
(* Piece # of piece containing start of deleted text)
(COND
((IGREATERP CH# (\EDITELT PCTB PCNO1))
(* Split the piece, so the deleted text now starts on a
piece boundary)
(\SPLITPIECE PC1 CH# TEXTOBJ PCNO1)
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ PCNO1 (IPLUS PCNO1 \EltsPerPiece))
(* Remember the PCNO1 of the first piece to be
deleted.)
)
(T (SETQ PC1 (fetch PREVPIECE of PC1))
(* PC1 ← piece before the first piee to be deleted.-)
))
[\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Delete)
THLEN ← LEN
THCH# ← CH#
THFIRSTPIECE ←(COND
(PC1 (fetch NEXTPIECE of PC1))
(T (\EDITELT PCTB (ADD1 \FirstPieceOffset]
(* Add this event to the history list)
[COND
[(ILESSP CHLIM TEXTLEN)
(SETQ PCNON (\CHTOPCNO (ADD1 CHLIM)
PCTB)) (* Find the peice that contains the END of the deleted
section)
(SETQ PCN (\EDITELT PCTB (ADD1 PCNON]
(T (SETQ PCNON (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)))
(SETQ PCN (QUOTE LASTPIECE]
[COND
((ATOM PCN) (* Deleting before the end of text.)
)
(T (* Deleting in front of a real piece of text)
(COND
((IGREATERP (ADD1 CHLIM)
(\EDITELT PCTB PCNON))
(SETQ HIPC (\SPLITPIECE PCN (ADD1 CHLIM)
TEXTOBJ PCNON))
(SETQ PCNON (IPLUS PCNON \EltsPerPiece))
(SETQ PCTB (fetch PCTB of TEXTOBJ)))
(T (SETQ HIPC PCN] (* if not on a piece bound, split the last piece.)
(bind [PC ←(COND
(PC1 (fetch NEXTPIECE of PC1))
(T (\EDITELT PCTB (ADD1 \FirstPieceOffset]
while (AND PC (NEQ PC HIPC))
do (AND (fetch POBJ of PC)
(IMAGEOBJPROP (fetch POBJ of PC)
(QUOTE WHENDELETEDFN))
(APPLY* (IMAGEOBJPROP (fetch POBJ of PC)
(QUOTE WHENDELETEDFN))
(fetch POBJ of PC)
(fetch DS of TEXTOBJ)))
(SETQ PC (fetch NEXTPIECE of PC)))
(SETQ LO PCNO1) (* Find the first piece to be deleted in the PCTB.)
(SETQ HI PCNON) (* Counter for next after last piece to delete.)
(SETQ PCSOUT (LRSH (IDIFFERENCE HI LO)
1)) (* # of pieces to delete)
(for I from HI to (\EDITELT PCTB \PCTBLastPieceOffset) as J from LO
do (* Move top of table down over the freed-up pieces.)
(\EDITSETA PCTB J (\EDITELT PCTB I)))
(\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces)
PCSOUT))
(* Adjust the free piece count in PCTB)
(\EDITSETA PCTB \PCTBLastPieceOffset (IDIFFERENCE (\EDITELT PCTB
\PCTBLastPieceOffset)
(IDIFFERENCE HI LO)))
(* Adjust the offset pointer to the final active
piece.)
(for I from LO to (\EDITELT PCTB \PCTBLastPieceOffset) by \EltsPerPiece
do (* Adjust the CH#s of the undeleted pieces.)
(\EDITSETA PCTB I (IDIFFERENCE (\EDITELT PCTB I)
LEN)))
(COND
(PC1 (replace NEXTPIECE of PC1 with HIPC)))
(COND
(HIPC (replace PREVPIECE of HIPC with PC1)))
(replace \INSERTNEXTCH of TEXTOBJ with -1)
(\TEDIT.DIFFUSE.PARALOOKS PC1 HIPC) (* PROPOGATE PARALOOKS THRU THE DELETION)
]
(freplace TEXTLEN of TEXTOBJ with (IDIFFERENCE TEXTLEN LEN))
(* Update the file's length)
(replace \DIRTY of TEXTOBJ with T])
(\DELETEPIECE
[LAMBDA (PC PCTB PC#) (* jds "14-OCT-83 10:44")
(* Remove piece PC from the piece table PCTB.
Adjust the character numbers of succeeding pieces, if
need be.)
(PROG ((PCNO (OR PC# (\FINDPIECE PC PCTB)))
[PCLEN (COND
((ATOM PC)
0)
(T (fetch PLEN of PC]
(PCLIM (\EDITELT PCTB \PCTBLastPieceOffset)))
(COND
(PCNO (bind LOBASE HIBASE for HI from (IPLUS PCNO \EltsPerPiece) by \EltsPerPiece
to PCLIM as LO from PCNO by \EltsPerPiece
do (\RPLPTR (SETQ LOBASE (\ADDBASE2 (fetch (ARRAYP BASE) of PCTB)
LO))
2
(GETBASEPTR (SETQ HIBASE (\ADDBASE2 (fetch (ARRAYP BASE)
of PCTB)
HI))
2))
(\RPLPTR LOBASE 0 (IDIFFERENCE (GETBASEPTR HIBASE 0)
PCLEN))
(* Move the table down over the deleted piece.)
)
(\EDITSETA PCTB \PCTBLastPieceOffset (IDIFFERENCE PCLIM \EltsPerPiece))
(* Adjust the end-of-table pointer)
(\EDITSETA PCTB \PCTBFreePieces (ADD1 (\EDITELT PCTB \PCTBFreePieces)))
(* and the free-pieces count.)
))
[COND
((fetch NEXTPIECE of PC)
(replace PREVPIECE of (fetch NEXTPIECE of PC) with (fetch PREVPIECE of PC]
(* Break any forward link from the piece)
[COND
((fetch PREVPIECE of PC)
(replace NEXTPIECE of (fetch PREVPIECE of PC) with (fetch NEXTPIECE of PC]
(* and any backward link.)
])
(\FINDPIECE
[LAMBDA (PC PCTB) (* jds " 3-MAY-82 10:58")
(* Given a piece and the pctb it's in, return the elt #
of the CH# entry for that piece in the table)
(COND
[(for I from (ADD1 \FirstPieceOffset) to (\EDITELT PCTB \PCTBLastPieceOffset) by \EltsPerPiece
do (COND
((EQ PC (\EDITELT PCTB I))
(RETURN (SUB1 I]
(T (ERROR "Piece not found: " PC])
(\INSERTCH
[LAMBDA (CH CH# TEXTOBJ INSERTMARK) (* jds " 4-May-84 16:24")
(* If the current ch is 1+last ch in the distinguished INPUTPIECE, then append this text to that piece
(make a new one if need be.), and fix up ch#s in the PCTB)
(* else, create a new input piece (as a substring of the old one) and INSERT it at the right spot, perhaps after
splitting a piece to make room.)
(PROG (PC (LEN (COND
((type? STRINGP CH)
(NCHARS CH))
(T 1)))
(PCNO NIL)
CHNO NEWPC PREVPC EVENT REPLACING (NEWFLAG NIL)
(\INEXTCH (fetch \INSERTNEXTCH of TEXTOBJ))
(\INLEN (fetch \INSERTLEN of TEXTOBJ))
(\INLEFT (fetch \INSERTLEFT of TEXTOBJ))
(\INSTRING (fetch \INSERTSTRING of TEXTOBJ))
(\INPC (fetch \INSERTPC of TEXTOBJ))
(\INFIRSTCH (fetch \INSERTFIRSTCH of TEXTOBJ))
(PCTB (ffetch PCTB of TEXTOBJ))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(IMARKPC (fetch (EDITMARK PC) of INSERTMARK))
(IMARKCH (fetch (EDITMARK PCOFF) of INSERTMARK))
PLOOKS NLOOKS)
[COND
((OR (IEQP CH# \INEXTCH)
(AND INSERTMARK (EQ IMARKPC (fetch NEXTPIECE of \INPC))
(EQ IMARKCH 0))) (* We're inserting at the end of a previous insertion,
for which we already have a piece built.
Just add to it.)
(COND
((IGEQ \INLEFT LEN) (* There's enough room in this piece -- fill it in.)
(COND
((type? STRINGP CH) (* If input is a string, copy it to the insert piece's
string)
(RPLSTRING \INSTRING (ADD1 \INLEN)
CH))
(T (* If it's a single charcode, move it to the piece's
string)
(RPLCHARCODE \INSTRING (ADD1 \INLEN)
CH)))
(replace PLEN of \INPC with (freplace \INSERTLEN of TEXTOBJ
with (IPLUS \INLEN LEN)))
(* Fix the length of the insert piece)
(freplace \INSERTLEFT of TEXTOBJ with (IDIFFERENCE \INLEFT LEN))
(* And the space left in the piece)
(freplace \INSERTNEXTCH of TEXTOBJ with (IPLUS \INEXTCH LEN))
(* And the next CH#)
(SETQ PCNO (fetch \INSERTPCNO of TEXTOBJ))
(* And the piece # for future use)
)
(T (* No room. Chop this piece & start a new one.)
(replace PSTR of \INPC with (SUBSTRING \INSTRING 1 \INLEN))
(* Chop the current piece's string to length)
(SETQ NEWPC (create PIECE
PSTR ←(ALLOCSTRING 512 (QUOTE % ))
PLOOKS ←(fetch PLOOKS of \INPC)
PPARALOOKS ←(fetch PPARALOOKS of \INPC)
PPARALAST ← NIL
PNEW ← T)) (* Create the new piece)
(freplace \INSERTSTRING of TEXTOBJ with (SETQ \INSTRING (fetch PSTR of NEWPC)))
(* Set the \INSTRING field in TEXTOBJ)
(COND
((type? STRINGP CH) (* If input is a string, copy it to the insert piece's
string)
(RPLSTRING \INSTRING 1 CH))
(T (* If it's a single charcode, move it to the piece's
string)
(RPLCHARCODE \INSTRING 1 CH)))
(replace PLEN of NEWPC with LEN) (* So far, the present input is the only thing in the
piece)
(replace \INSERTPCNO of TEXTOBJ with (\INSERTPIECE NEWPC
(OR (fetch NEXTPIECE
of \INPC)
(QUOTE LASTPIECE))
TEXTOBJ))
(* Insert the new piece into the text and save the piece
#)
(SETQ PCTB (fetch PCTB of TEXTOBJ)) (* Which may have caused a PCTB overflow)
(freplace \INSERTPC of TEXTOBJ with (SETQ \INPC NEWPC))
(freplace \INSERTLEFT of TEXTOBJ with (IDIFFERENCE 512 LEN))
(freplace \INSERTLEN of TEXTOBJ with LEN)
(replace \INSERTFIRSTCH of TEXTOBJ with CH#)
(* CH# of the first inserted character)
(replace \INSERTNEXTCH of TEXTOBJ with (IPLUS CH# LEN))
(* The CH# of the next character, if it's inserted at
the current caret.)
(SETQ NEWFLAG T) (* Note the new piece's creation)
))
(add (fetch THLEN of (fetch TXTHISTORY of TEXTOBJ))
LEN) (* Update the length of the insertion/replacement text.)
)
(T
(* NEW INSERTION POINT; IF THERE'S ANYTHING LEFT OF THE PREVIOUS INSERT PIECE, CRACK OFF A NEW ONE & FILL IT.
THEN FIGURE OUT WHERE TO SHOEHORN IT IN.)
(SETQ PCNO (OR (fetch (EDITMARK PCNO) of INSERTMARK)
(\CHTOPCNO CH# PCTB)))
[SETQ PC (OR IMARKPC (\EDITELT PCTB (ADD1 PCNO]
[COND
((AND \INPC (IGEQ \INLEFT LEN)) (* There's room left in the prior input-piece's string;
re-use it.)
(SETQ NEWPC (create PIECE
PSTR ←(SUBSTRING \INSTRING (ADD1 \INLEN))
PLOOKS ←(fetch CARETLOOKS of TEXTOBJ)
PPARALOOKS ←(fetch PPARALOOKS of \INPC)
PPARALAST ← NIL
PNEW ← T)) (* Build the new piece)
(replace PSTR of \INPC with (SUBSTRING \INSTRING 1 \INLEN))
(freplace \INSERTLEFT of TEXTOBJ with (IDIFFERENCE \INLEFT LEN)))
(T (* No room left; build a whole new piece.)
(SETQ NEWPC (create PIECE
PSTR ←(freplace \INSERTSTRING of TEXTOBJ with (ALLOCSTRING
512))
PLOOKS ←(fetch CARETLOOKS of TEXTOBJ)
PPARALOOKS ←(OR (AND \INPC (fetch PPARALOOKS of \INPC))
(create FMTSPEC copying (fetch FMTSPEC
of TEXTOBJ)))
PPARALAST ← NIL
PNEW ← T))
(freplace \INSERTLEFT of TEXTOBJ with (IDIFFERENCE 512 LEN]
(freplace \INSERTPC of TEXTOBJ with (SETQ \INPC NEWPC))
(replace PLEN of NEWPC with LEN)
(freplace \INSERTSTRING of TEXTOBJ with (SETQ \INSTRING (fetch PSTR of NEWPC)))
(COND
((type? STRINGP CH) (* Insert the characters into the piece)
(RPLSTRING \INSTRING 1 CH))
(T (RPLCHARCODE \INSTRING 1 CH)))
(freplace \INSERTLEN of TEXTOBJ with LEN)
(freplace \INSERTFIRSTCH of TEXTOBJ with CH#)
(* Cache the first-inserted-ch #, for backspace speed)
(SETQ NEWFLAG T)
[COND
((OR (IGREATERP CH# TEXTLEN)
(IEQP CH# (\EDITELT PCTB PCNO))) (* We're inserting on a piece boundary;
do it, then remember the prior piece.)
(SETQ PCNO (\INSERTPIECE \INPC PC TEXTOBJ NIL PCNO)))
(T (* Not on a piece boundary; split the piece we're inside
of, then insert.)
(SETQ PCNO (\INSERTPIECE \INPC (\SPLITPIECE PC CH# TEXTOBJ)
TEXTOBJ NIL (IPLUS PCNO \EltsPerPiece]
[COND
((NOT (fetch PPARALOOKS of \INPC)) (* There weren't any paralooks available at creation
time. Find some now.)
[SETQ PLOOKS (AND (fetch PREVPIECE of \INPC)
(fetch PPARALOOKS of (fetch PREVPIECE of \INPC]
[SETQ NLOOKS (AND (fetch NEXTPIECE of \INPC)
(fetch PPARALOOKS of (fetch NEXTPIECE of \INPC]
(replace PPARALOOKS of \INPC with (COND
[(NOT PLOOKS)
(* No preceding para to take looks from)
(OR NLOOKS (create FMTSPEC
copying (fetch FMTSPEC
of TEXTOBJ]
[(NOT NLOOKS)
(* No succeeding paras to take looks from)
(OR PLOOKS (create FMTSPEC
copying (fetch FMTSPEC
of TEXTOBJ]
(T PLOOKS]
(replace \INSERTPCNO of TEXTOBJ with PCNO) (* Save the pcno for future insertions)
(SETQ PCTB (fetch PCTB of TEXTOBJ)) (* The PCTB may have expanded during the insert.)
(SETQ PREVPC (OR (fetch PREVPIECE of NEWPC)
PC)) (* The piece we're to take the inserted characters'
looks from)
(replace PLOOKS of NEWPC with (fetch CARETLOOKS of TEXTOBJ))
[replace PPARALOOKS of NEWPC with (COND
((ZEROP TEXTLEN)
(* No text yet; use default paralooks)
(create FMTSPEC copying (fetch FMTSPEC
of TEXTOBJ)))
((SETQ PREVPC (fetch NEXTPIECE of \INPC))
(* There's later text. Use its para looks)
(fetch PPARALOOKS of PREVPC))
((SETQ PREVPC (fetch PREVPIECE of \INPC))
(* There's earlier text. Use its looks, copied if need
be.)
(COND
((fetch PPARALAST of PREVPC)
(create FMTSPEC
copying (fetch PPARALOOKS of PREVPC)))
(T (fetch PPARALOOKS of PREVPC]
(SETQ EVENT (fetch TXTHISTORY of TEXTOBJ)) (* Prior edit event.)
[SETQ REPLACING (AND (EQ (fetch THACTION of EVENT)
(QUOTE Delete))
(IEQP CH# (fetch THCH# of EVENT]
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(COND
(REPLACING (QUOTE Replace))
(T (QUOTE Insert)))
THLEN ←(fetch PLEN of \INPC)
THCH# ← CH#
THFIRSTPIECE ← \INPC
THPOINT ←(QUOTE RIGHT)
THOLDINFO ←(AND REPLACING EVENT]
[OR NEWFLAG (PROGN (* We didn't add a piece, so we must update character
numbers in the PCTB)
(OR PCNO (SETQ PCNO (\CHTOPCNO (SUB1 CH#)
PCTB)))
(* The insert-piece's PCTB entry)
(for I from (IPLUS PCNO \EltsPerPiece) to (\EDITELT PCTB
\PCTBLastPieceOffset)
by \EltsPerPiece do (\EDITSETA PCTB I (IPLUS (\EDITELT PCTB I)
LEN]
(freplace TEXTLEN of TEXTOBJ with (SETQ TEXTLEN (IPLUS LEN TEXTLEN)))
(replace \INSERTNEXTCH of TEXTOBJ with (IPLUS CH# LEN))
(replace \DIRTY of TEXTOBJ with T])
(\INSERTCR
[LAMBDA (CH CH# TEXTOBJ) (* jds "13-Nov-84 11:38")
(* Handle insertion of CR and meta-CR. The former causes a paragraph break, while the latter doesn't.
Note, though, that inserting a meta-CR causes the doucment to become formatted.)
(PROG (INPC)
(COND
((AND (NOT (fetch FORMATTEDP of TEXTOBJ))
(IEQP CH (CHARCODE #↑M))) (* Inserting a meta-CR into an unformatted document.
Start by setting up para breaks.)
(\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ)))
(\INSERTCH (CHARCODE CR)
CH# TEXTOBJ) (* Put the CR in)
(COND
((IEQP CH (CHARCODE CR)) (* It's really a CR, rather than a meta-CR so do para
breaking.)
(SETQ INPC (fetch \INSERTPC of TEXTOBJ))
(replace PPARALAST of INPC with T) (* Mark the end of the paragraph)
(replace \INSERTNEXTCH of TEXTOBJ with -1) (* FORCE A NEW PIECE ON THE NEXT CHARACTER)
])
(\INSERTPIECE
[LAMBDA (NEW OLD TEXTOBJ DONTUPDATECH#S PC#) (* jds "14-OCT-83 18:34")
(* Insert the piece NEW in front of the piece OLD;
re-allocate PCTB if need be)
(PROG (PCNO OLIM (PLEN (fetch PLEN of NEW))
(PCTB (fetch PCTB of TEXTOBJ))
NPCTB BASE BASE2)
(SETQ PCNO (OR PC# (\FINDPIECE OLD PCTB))) (* Where in the pctb to look)
(SETQ OLIM (\EDITELT PCTB \PCTBLastPieceOffset))
(COND
((ILESSP PLEN 0) (* This piece has a negative length.
Bitch.)
(ERROR "Negative Piece Length" NEW))
[(EQ OLD (QUOTE LASTPIECE)) (* We're inserting in front of the LASTPIECE.
Try setting the NEXTPIECE link of the next earlier
piece, if there's one.)
(replace NEXTPIECE of NEW with NIL)
(replace PREVPIECE of NEW with NIL)
(COND
((IGREATERP PCNO 3)
(SETQ OLD (\EDITELT PCTB (SUB1 PCNO)))
(replace NEXTPIECE of OLD with NEW)
(replace PREVPIECE of NEW with OLD]
(T (replace NEXTPIECE of NEW with OLD)
(replace PREVPIECE of NEW with (fetch PREVPIECE of OLD))
(COND
((fetch PREVPIECE of OLD)
(replace NEXTPIECE of (fetch PREVPIECE of OLD) with NEW)))
(replace PREVPIECE of OLD with NEW)))
(UNINTERRUPTABLY
[COND
((IEQP PCNO \FirstPieceOffset)
(replace PREVPIECE of NEW with NIL))
(T (replace PREVPIECE of NEW with (\EDITELT PCTB (SUB1 PCNO]
[COND
((ZEROP (\EDITELT PCTB \PCTBFreePieces)) (* Must allocate a new, larger table & copy the old
table's contents)
(SETQ NPCTB (ARRAY (IPLUS (ARRAYSIZE PCTB)
32)
(QUOTE POINTER)
NIL 0))
(\MOVEWORDS (SETQ BASE (fetch (ARRAYP BASE) of PCTB))
0
(fetch (ARRAYP BASE) of NPCTB)
0
(LLSH (ARRAYSIZE PCTB)
1))
(\ZEROBYTES BASE 0 (SUB1 (LLSH (ARRAYSIZE PCTB)
2)))
(\EDITSETA NPCTB \PCTBFreePieces 16)
(freplace PCTB of TEXTOBJ with (SETQ PCTB NPCTB]
(SETQ BASE (fetch (ARRAYP BASE) of PCTB))
(\RPLPTR (SETQ BASE2 (\ADDBASE2 BASE (IPLUS OLIM 1)))
0 NIL) (* Clear out the places we're moving in on top of.)
(\RPLPTR BASE2 2 NIL)
(\MOVEWORDS BASE (IPLUS PCNO PCNO)
BASE
(IPLUS PCNO PCNO 4)
(LLSH (ADD1 (IDIFFERENCE OLIM PCNO))
1))
(\PUTBASEPTR BASE (LLSH PCNO 1)
NIL)
(\EDITSETA PCTB PCNO (\EDITELT PCTB (IPLUS PCNO \EltsPerPiece)))
(\PUTBASEPTR BASE (LLSH (IPLUS PCNO 1)
1)
NIL)
(\EDITSETA PCTB (ADD1 PCNO)
NEW)
(\EDITSETA PCTB \PCTBLastPieceOffset (IPLUS OLIM \EltsPerPiece))
(\EDITSETA PCTB \PCTBFreePieces (SUB1 (\EDITELT PCTB \PCTBFreePieces)))
[OR DONTUPDATECH#S (for I from (IPLUS PCNO \EltsPerPiece) to (IPLUS OLIM \EltsPerPiece)
by \EltsPerPiece do (\EDITSETA PCTB I (IPLUS (\EDITELT PCTB I)
PLEN])
(RETURN PCNO])
(\MAKEPCTB
[LAMBDA (PC1 MINLEN) (* jds "13-JUL-83 15:12")
(* Create a new piece table, with PC1 as its first piece, and a dummy piece at the end, with 1st ch# of 1+
(chlim of pc1))
(* A piece Table has the following format: It's an array, with 2 header words (1←# of pieces left in table unused)
(2←offset of last used word in tbl), followed by 2-word entries: the first ch# in the piece, and a pointer to the
piece.)
(PROG (PCTB [LEN (IPLUS 4 (ITIMES \EltsPerPiece (OR MINLEN 14]
(FREE (OR MINLEN 14)))
(SETQ PCTB (ARRAY LEN (QUOTE POINTER)
NIL 0))
(COND
((NOT PC1)
(\EDITSETA PCTB \PCTBFreePieces FREE)
(\EDITSETA PCTB \PCTBLastPieceOffset 3)
(\EDITSETA PCTB \FirstPieceOffset 1)
(\EDITSETA PCTB (ADD1 \FirstPieceOffset)
(QUOTE LASTPIECE))
(RETURN PCTB))
(T (\EDITSETA PCTB \PCTBFreePieces (SUB1 FREE))
(\EDITSETA PCTB \PCTBLastPieceOffset 5)
(\EDITSETA PCTB \FirstPieceOffset 1)
(\EDITSETA PCTB (ADD1 \FirstPieceOffset)
PC1)
(\EDITSETA PCTB \SecondPieceOffset (ADD1 (fetch PLEN of PC1)))
(\EDITSETA PCTB (ADD1 \SecondPieceOffset)
(QUOTE LASTPIECE))
(RETURN PCTB])
(\SETUPGETCH
[LAMBDA (CH# TEXTOBJ) (* jds "26-Oct-84 16:05")
(* Set up TEXTOBJ so that the next \GETCH will retrieve
character # CH#)
(* NB that 1st char in the textobj is #1.)
(DECLARE (LOCALVARS . T))
(PROG (PC PCNO PS PF CHOFFSET CHARSLEFT (PCTB (fetch PCTB of TEXTOBJ))
(STREAM (fetch STREAMHINT of TEXTOBJ))
FPOS OFFST SUBSTREAM)
[COND
[(LISTP CH#) (* If CH# is a piece-offset pair, make use of it.)
(SETQ PC (fetch (EDITMARK PC) of CH#))
(SETQ CHOFFSET (fetch (EDITMARK PCOFF) of CH#))
(SETQ PCNO (fetch (EDITMARK PCNO) of CH#))
(COND
((ATOM PC) (* This SETUPGETCH is to the final pseudo-piece!)
(freplace (TEXTSTREAM PIECE) of STREAM with PC)
(freplace COFFSET of STREAM with 0)
(freplace CPAGE of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0)
(freplace (TEXTSTREAM PCOFFSET) of STREAM with 0)
(freplace (TEXTSTREAM PCNO) of STREAM with PCNO)
(RETURN]
((IGREATERP CH# (IMAX 1 (fetch TEXTLEN of TEXTOBJ)))
(ERROR "TRYING TO \SETUPGETCH BEYOND END OF TEXT"))
(T (* CH# is indeed a character number.
Find the corresponding piece, its pcno, and the offset
within that piece.)
(SETQ PCNO (\CHTOPCNO CH# PCTB))
(SETQ PC (\EDITELT PCTB (ADD1 PCNO)))
(SETQ CHOFFSET (IDIFFERENCE CH# (\EDITELT PCTB PCNO]
(freplace (TEXTSTREAM PIECE) of STREAM with PC)
(replace BINABLE of STREAM with T)
(SETQ CHARSLEFT (IDIFFERENCE (fetch PLEN of PC)
CHOFFSET))
(freplace (TEXTSTREAM PCOFFSET) of STREAM with CHOFFSET)
(freplace (TEXTSTREAM PCNO) of STREAM with PCNO)
(COND
((SETQ PS (ffetch PSTR of PC)) (* This piece resides in a STRING.)
(freplace CPPTR of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS)
(LRSH (SETQ OFFST (ffetch (STRINGP OFFST)
of PS))
1)))
(freplace CPAGE of STREAM with 0)
(freplace COFFSET of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH) of STREAM
with (LOGAND 1 OFFST))
CHOFFSET))
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where this piece starts)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with (LOGAND 1 OFFST))
(* Char within "page" where the piece starts
(for BACKFILEPTR))
(freplace CBUFSIZE of STREAM with (IPLUS CHARSLEFT (ffetch COFFSET of STREAM)))
(freplace EPAGE of STREAM with 1)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(freplace (TEXTSTREAM REALFILE) of STREAM with NIL))
((SETQ PF (ffetch PFILE of PC)) (* This piece resides on a FILE)
[COND
((IEQP (ffetch ACCESSBITS of PF)
NoBits) (* ASSURE THAT THE FILE IS OPEN)
(SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF]
[freplace (TEXTSTREAM PCSTARTPG) of STREAM with (ffetch (BYTEPTR PAGE)
of (SETQ FPOS (ffetch PFPOS
of PC]
(* Page within the file where the piece starts)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with (ffetch (BYTEPTR OFFSET) of FPOS))
(* Char within the page where it starts.)
(SETFILEPTR PF (IPLUS FPOS CHOFFSET))
(OR (ZEROP (GETEOFPTR PF))
(\PEEKBIN PF))
(freplace CPPTR of STREAM with (ffetch CPPTR of PF))
(freplace CPAGE of STREAM with (ffetch CPAGE of PF))
(freplace COFFSET of STREAM with (ffetch COFFSET of PF))
(freplace EPAGE of STREAM with 32767)
(freplace CBUFSIZE of STREAM with (IMIN (ffetch CBUFSIZE of PF)
(IPLUS (ffetch COFFSET of PF)
CHARSLEFT)))
[freplace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE CHARSLEFT
(IDIFFERENCE (ffetch
CBUFSIZE
of STREAM)
(ffetch
COFFSET
of STREAM]
(freplace (TEXTSTREAM REALFILE) of STREAM with PF))
[(SETQ PF (ffetch POBJ of PC)) (* This piece points to an object.
set up so \TextBin will be called, and will return it.)
(COND
((SETQ SUBSTREAM (IMAGEOBJPROP PF (QUOTE SUBSTREAM)))
(* There is a stream below this one! Reflect things
upward.)
(* This is a simple object. Just set things up so it
gets read.)
(\SETUPGETCH (ADD1 CHOFFSET)
(fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM))
(replace BINABLE of STREAM with NIL)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(freplace COFFSET of STREAM with CHOFFSET)
(freplace CBUFSIZE of STREAM with (fetch PLEN of PC))
(freplace CPAGE of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with CHOFFSET)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (fetch (TEXTSTREAM
CURRENTPARALOOKS)
of SUBSTREAM))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (fetch (TEXTSTREAM CURRENTLOOKS)
of SUBSTREAM))
(RETURN))
(T (* This is a simple object. Just set things up so it
gets read.)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 1)
(freplace COFFSET of STREAM with 1)
(freplace CBUFSIZE of STREAM with 1)
(freplace CPAGE of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with 1)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0]
(T (ERROR "Piece is neither a file nor a string??" PC)))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (\TEDIT.APPLY.PARASTYLES
(fetch PPARALOOKS of PC)
PC TEXTOBJ))
(* Set the character looks and font caches.)
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES (ffetch PLOOKS
of PC)
PC TEXTOBJ])
(\TEDIT.REOPEN.STREAM
[LAMBDA (TEXTSTREAM PIECESTREAM) (* jds "26-Oct-84 17:35")
(* Re-open the backing file stream, and propogate the
change thru the entire piece table.)
(PROG ((NEWSTREAM (OPENSTREAM (fetch FULLNAME of PIECESTREAM)
(QUOTE INPUT)))
(PCTB (fetch PCTB of (TEXTOBJ TEXTSTREAM)))
PC)
(SETQ PC (ELT PCTB (ADD1 \FirstPieceOffset)))
(while PC
do (COND
((EQ (fetch PFILE of PC)
PIECESTREAM)
(replace PFILE of PC with NEWSTREAM)))
(SETQ PC (fetch NEXTPIECE of PC)))
(RETURN NEWSTREAM])
(\SPLITPIECE
[LAMBDA (PC CH TEXTOBJ PC#) (* jds "22-Oct-84 16:51")
(* Split the piece PC before CH
(rel to start of text); return the new second piece.)
(* PC#, if present, points at the CH# entry for the
piece being split.)
(PROG ([PCNO (OR PC# (\FINDPIECE PC (ffetch PCTB of TEXTOBJ]
(NEWPC (create PIECE using PC))
CHNO NEWLEN)
(SETQ CHNO (IDIFFERENCE CH (\EDITELT (ffetch PCTB of TEXTOBJ)
PCNO))) (* Offset within the piece before which to break)
(COND
((ZEROP CHNO)
(SHOULDNT "Splitting a piece at the start.")))
(replace PPARALAST of PC with NIL) (* There can be no para break before the split, as
things now work.)
(COND
((ffetch PSTR of PC) (* This piece points to a string.
Split it for the two new pieces)
(freplace PSTR of NEWPC with (SUBSTRING (ffetch PSTR of PC)
(ADD1 CHNO)))
(freplace PLEN of NEWPC with (IDIFFERENCE (ffetch PLEN of PC)
CHNO))
(freplace PSTR of PC with (SUBSTRING (ffetch PSTR of PC)
1 CHNO))
(freplace PLEN of PC with CHNO))
((ffetch PFILE of PC) (* This piece points to a file.
Set the fileptrs accordingly)
(freplace PFILE of NEWPC with (ffetch PFILE of PC))
(freplace PFPOS of NEWPC with (IPLUS (ffetch PFPOS of PC)
CHNO))
(freplace PLEN of NEWPC with (IDIFFERENCE (ffetch PLEN of PC)
CHNO))
(freplace PLEN of PC with CHNO)))
(UNINTERRUPTABLY
(SETQ PCNO (\INSERTPIECE NEWPC (OR (ffetch NEXTPIECE of PC)
(QUOTE LASTPIECE))
TEXTOBJ T (IPLUS PCNO \EltsPerPiece)))
(* Insert the new piece, and note its location in the
pctb)
(\EDITSETA (ffetch PCTB of TEXTOBJ)
PCNO
(IDIFFERENCE (\EDITELT (ffetch PCTB of TEXTOBJ)
PCNO)
(ffetch PLEN of NEWPC))))
(* Now set its starting CH#)
(replace \INSERTNEXTCH of TEXTOBJ with -1) (* Whenever you split a piece, you can't add to it
anymore.)
(RETURN NEWPC])
(\TEDIT.COPYTEXTSTREAM.PIECEMAPFN
[LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* jds "24-May-84 17:05")
(* Called by COPYTEXTSTREAM via TEDIT.SELECTED.PIECES,
to do the copy-operation processing on the candidate
pieces.)
(PROG (OBJ NEWOBJ COPYFN)
(SETQ PC (create PIECE using PC PNEW ← T)) (* No matter what, we need a fresh copy.)
[COND
((fetch POBJ of PC) (* This piece describes an object)
(SETQ OBJ (fetch POBJ of PC))
[COND
[(SETQ COPYFN (IMAGEOBJPROP OBJ (QUOTE COPYFN)))
(SETQ NEWOBJ (APPLY* COPYFN OBJ (fetch STREAMHINT of FROMOBJ)
(fetch STREAMHINT of TOOBJ)))
(COND
((EQ NEWOBJ (QUOTE DON'T)) (* He said not to copy this piece -- abort the whole
copy.)
(TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T)
(RETFROM (QUOTE TEDIT.COPY)))
(NEWOBJ (replace POBJ of PC with NEWOBJ))
(T (replace POBJ of PC with (COPYALL OBJ]
(OBJ (* No copy fn; just strike off a copy of our own)
(replace POBJ of PC with (COPYALL OBJ]
(COND
((SETQ COPYFN (IMAGEOBJPROP OBJ (QUOTE WHENCOPIEDFN)))
(* If there's an eventfn for copying, use it.)
(APPLY* COPYFN OBJ (fetch DS of TOOBJ)
(fetch STREAMHINT of FROMOBJ)
(fetch STREAMHINT of TOOBJ]
(RETURN PC])
(\TEXTINIT
[LAMBDA NIL (* jds "10-Sep-84 14:02")
(* Create the FDEV and STREAM prototypes for TEXT
streams.)
(* TEXT streams make use of the following STREAM fields: (DEVICE (* FDEV of this guy -- The TEXT device) F1
(* The STREAM for the PFILE of the current piece (or NIL)) F2 (* # chars left in piece at end of underlying file's
page) F3 (* The TEXTOBJ for this stream) F4 F5 (* The PIECE we're currently inside) (FW6 WORD)
(* CPAGE for the start of the piece, for BACKFILEPTR) (FW7 WORD) (* COFFSET for the start of the piece, for
BACKFILEPTR) (FW8 WORD)))
(SETQ \TEXTIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE TEXT)
IMXPOSITION ←(QUOTE NILL)
IMYPOSITION ←(QUOTE NILL)
IMLEFTMARGIN ←(QUOTE NILL)
IMFONT ←(FUNCTION \TEXTDSPFONT)
IMCLOSEFN ←(FUNCTION NILL)))
(SETQ \TEXTFDEV (create FDEV
DEVICENAME ←(QUOTE TEXT)
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← NIL
GETFILENAME ←(FUNCTION NILL)
BIN ←(FUNCTION \TEXTBIN)
BOUT ←(FUNCTION \TEXTBOUT)
CLOSEFILE ←(FUNCTION \TEXTCLOSEF)
OPENFILE ←(FUNCTION \TEXTOPENF)
DELETEFILE ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
EVENTFN ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
GETFILEINFO ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
READPAGES ←(FUNCTION NILL)
REOPENFILE ←(FUNCTION [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
(replace ACCESS of STREAM with (QUOTE BOTH))
STREAM])
SETFILEINFO ←(FUNCTION NILL)
BACKFILEPTR ←(FUNCTION \TEXTBACKFILEPTR)
SETFILEPTR ←(FUNCTION \TEXTSETFILEPTR)
PEEKBIN ←(FUNCTION \TEXTPEEKBIN)
GETEOFPTR ←(FUNCTION \TEXTGETEOFPTR)
GETFILEPTR ←(FUNCTION \TEXTGETFILEPTR)
EOFP ←(FUNCTION \TEXTEOFP)
FDBINABLE ← T
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION NILL)))
(SETQ \TEXTOFD (create STREAM
BINABLE ← T
BOUTABLE ← NIL
ACCESS ←(QUOTE BOTH)
USERCLOSEABLE ← T
USERVISIBLE ← T
DEVICE ← \TEXTFDEV
F1 ← NIL
F2 ← 0
F3 ← NIL
F5 ← NIL
FW6 ← 0
FW7 ← 0
MAXBUFFERS ← 10
IMAGEOPS ← \TEXTIMAGEOPS
IMAGEDATA ←(create TEXTIMAGEDATA)))
(* The prototypical Text stream)
(PROG ((OLDERRORINFO (ASSOC 13 ERRORTYPELST))) (* Set up the errorlst so that FILE NOT OPENs on TEdit
streams are caught and fixed.)
(PUTASSOC 13 (CONS [QUOTE (AND (TEXTSTREAMP (CADR ERRORMESS))
(REOPENTEXTSTREAM (CADR ERRORMESS]
(CDR OLDERRORINFO))
ERRORTYPELST])
(\TEXTMARK
[LAMBDA (TEXTOBJ) (* jds "14-Feb-84 16:40")
(PROG ((STREAM (fetch STREAMHINT of TEXTOBJ)))
(RETURN (CONS (ffetch (TEXTSTREAM PIECE) of STREAM)
(IDIFFERENCE (create BYTEPTR
PAGE ←(ffetch CPAGE of STREAM)
OFFSET ←(ffetch COFFSET of STREAM))
(create BYTEPTR
PAGE ←(ffetch (TEXTSTREAM PCSTARTPG) of STREAM)
OFFSET ←(ffetch (TEXTSTREAM PCSTARTCH) of STREAM])
(\TEXTTTYBOUT
[LAMBDA (STREAM BYTE) (* jds "14-Feb-84 16:29")
(* Do BOUT to a text stream, which is an insertion at
the caret.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)))
(COND
((EQ BYTE ERASECHARCODE)
(\TEDIT.CHARDELETE TEXTOBJ "" (fetch SEL of TEXTOBJ)))
((EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch TXTTERMSA of TEXTOBJ)
\PRIMTERMSA)
BYTE)))
(* Nothing, ignore it)
)
(T (SELCHARQ BYTE
((EOL CR LF)
(\TEXTBOUT STREAM BYTE)
(replace CHARPOSITION of STREAM with 0))
(PROGN (\TEXTBOUT STREAM BYTE)
(add (fetch CHARPOSITION of STREAM)
1])
)
(* Generic-IO type operations support)
(DEFINEQ
(\TEXTCLOSEF
[LAMBDA (STREAM) (* jds " 7-Feb-84 11:52")
(* Close the files underlying a stream)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
PCTB PC)
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(OR (ZEROP (fetch TEXTLEN of TEXTOBJ))
(for I from (ADD1 \FirstPieceOffset) to (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset))
by \EltsPerPiece
do (SETQ PC (\EDITELT PCTB I))
(COND
((fetch PFILE of PC)
(CLOSEF? (fetch PFILE of PC])
(\TEXTDSPFONT
[LAMBDA (STREAM NEWFONT) (* jds "10-Sep-84 13:52")
(PROG1 (fetch CLFONT of (fetch CARETLOOKS of (TEXTOBJ STREAM)))
(AND NEWFONT (TEDIT.CARETLOOKS STREAM (\GETFONTDESC NEWFONT (QUOTE DISPLAY])
(\TEXTEOFP
[LAMBDA (STREAM) (* jds "19-Jul-84 13:07")
(* Test for EOF on a text stream: At end of a piece, and
there's no more pieces.)
(OR (NOT (fetch (TEXTSTREAM PIECE) of STREAM))
(AND (IEQP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
(OR (NOT (fetch NEXTPIECE of (fetch (TEXTSTREAM PIECE) of STREAM)))
(bind (PC ←(fetch NEXTPIECE of (fetch (TEXTSTREAM PIECE) of STREAM))) while PC
do (COND
((NOT (ZEROP (fetch PLEN of PC)))
(RETURN NIL)))
(SETQ PC (fetch NEXTPIECE of PC))
finally (RETURN T])
(\TEXTGETEOFPTR
[LAMBDA (STREAM) (* jds "14-Feb-84 16:29")
(fetch TEXTLEN of (fetch (TEXTSTREAM TEXTOBJ) of STREAM])
(\TEXTGETFILEPTR
[LAMBDA (STREAM) (* jds " 3-May-84 15:55")
(* GETFILEPTR fn for text streams.)
(PROG ((PC (fetch (TEXTSTREAM PIECE) of STREAM))
(PCNO (fetch (TEXTSTREAM PCNO) of STREAM))
(CHARSLEFT (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
(OFFSET (fetch COFFSET of STREAM))
(LIMIT (fetch CBUFSIZE of STREAM))
PLEN)
(COND
[PC (* There's a piece. That means he's inside the file
somewhere.)
(SETQ PLEN (fetch PLEN of PC))
(RETURN (IMIN (SUB1 (IPLUS (\EDITELT (fetch PCTB of (fetch (TEXTSTREAM TEXTOBJ)
of STREAM))
PCNO)
(IDIFFERENCE PLEN CHARSLEFT)
(IDIFFERENCE OFFSET LIMIT)))
(fetch TEXTLEN of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]
(T (* Lack of a current piece means he walked off the end.)
(RETURN (IMAX 1 (fetch TEXTLEN of (fetch (TEXTSTREAM TEXTOBJ) of STREAM])
(\TEXTOPENF
[LAMBDA (STREAM ACCESS ASDF QWER ZXCV) (* jds "26-Oct-84 16:04")
(* Return the stream, opened for input)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
PCTB PC)
(SETQ PCTB (fetch PCTB of TEXTOBJ))
[for I from (ADD1 \FirstPieceOffset) to (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset))
by \EltsPerPiece
do (SETQ PC (\EDITELT PCTB I))
(COND
((AND (fetch PFILE of PC)
(EQ (fetch ACCESSBITS of (fetch PFILE of PC))
NoBits))
(\TEDIT.REOPEN.STREAM STREAM (fetch PFILE of PC]
(RETURN STREAM])
(\TEXTOUTCHARFN
[LAMBDA (CH STREAM) (* jds "14-Feb-84 16:29")
(\INSERTCH CH (fetch TEXTLEN of (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
(fetch (TEXTSTREAM TEXTOBJ) of STREAM])
(\TEXTPEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* jds "26-Oct-84 16:03")
(* DO PEEKBIN for a text stream)
(PROG (CH FILE STR PF PS PC)
(COND
((AND (SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM))
(fetch POBJ of PC))
(RETURN (fetch POBJ of PC)))
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)) (* Simple case -- just do the usual PEEKBIN)
(RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG)))
[PC (* We've either hit a page bound in a file, or a piece
bound.)
(RETURN (COND
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
(* Time for a new piece.)
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
with (fetch NEXTPIECE of PC)))
(* Move to the next piece in the chain)
(COND
[PC (add (fetch (TEXTSTREAM PCNO) of STREAM)
\EltsPerPiece) (* Update the PCNO pointer, so that GETFILEPTR will
know where it is properly)
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (\TEDIT.APPLY.STYLES (fetch PLOOKS of PC)
PC
(fetch (TEXTSTREAM TEXTOBJ)
of STREAM)))
(COND
((SETQ PS (fetch PSTR of PC))
(* This piece lives in a string.)
(replace CPPTR of STREAM
with (OR (ADDBASE (fetch (STRINGP BASE) of PS)
(LRSH (fetch (STRINGP OFFST) of PS)
1))
0))
(replace CPAGE of STREAM with 0)
(replace COFFSET of STREAM with (LOGAND 1 (fetch (STRINGP
OFFST)
of PS)))
(replace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where piece starts)
(replace (TEXTSTREAM PCSTARTCH) of STREAM
with (fetch COFFSET of STREAM))
(* Char # within the "page" where the piece starts
(for BACKFILEPTR))
(replace EPAGE of STREAM with 1)
(replace EOFFSET of STREAM with (fetch PLEN of PC))
(replace CBUFSIZE of STREAM
with (IPLUS (fetch COFFSET of STREAM)
(fetch PLEN of PC)))
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(replace (TEXTSTREAM REALFILE) of STREAM with NIL)
(\PEEKBIN STREAM NOERRORFLG))
((SETQ PF (fetch PFILE of PC))
(* This piece lives on a file.)
(AND (IEQP (fetch ACCESSBITS of PF)
NoBits)
(SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF)))
(replace (TEXTSTREAM PCSTARTPG) of STREAM
with (fetch (BYTEPTR PAGE) of (fetch PFPOS of PC)))
(* Page in the file where the piece starts.)
(replace (TEXTSTREAM PCSTARTCH) of STREAM
with (fetch (BYTEPTR OFFSET) of (fetch PFPOS of PC)))
(* Char within the page where the piece starts.)
(SETFILEPTR PF (fetch PFPOS of PC))
(SETQ CH (\PEEKBIN PF NOERRORFLG))
(replace CPPTR of STREAM with (fetch CPPTR of PF))
(replace CPAGE of STREAM with (fetch CPAGE of PF))
(replace COFFSET of STREAM with (fetch COFFSET of PF))
(replace EPAGE of STREAM with 32767)
(replace EOFFSET of STREAM with (fetch EOFFSET of PF))
[replace CBUFSIZE of STREAM
with (IMIN (fetch CBUFSIZE of PF)
(IPLUS (fetch COFFSET of STREAM)
(fetch PLEN of PC]
(* Must never go past end of piece
(NB that CBUFSIZE is 1+ length of buffer))
[replace (TEXTSTREAM CHARSLEFT) of STREAM
with (IDIFFERENCE (fetch PLEN of PC)
(IDIFFERENCE (fetch CBUFSIZE of STREAM)
(fetch COFFSET of STREAM]
(replace (TEXTSTREAM REALFILE) of STREAM with PF)
CH)
(T (ERROR "CAN'T GET TO NEXT PIECE"]
(NOERRORFLG (* There are no more pieces.
Punt gracefully)
(RETURN NIL))
(T (* He wants it the hard way.)
(APPLY* (fetch ENDOFSTREAMOP of STREAM)
STREAM]
(T (* Need to move to the next page in a file.)
(SETQ FILE (fetch (TEXTSTREAM REALFILE) of STREAM))
(* Get the STREAM which describes the file for real)
(replace COFFSET of FILE with (fetch CBUFSIZE of FILE))
(* Force it to do a page switch for us)
(SETQ CH (\PEEKBIN FILE NOERRORFLG))
(* Get the next character in the usual manner)
(replace CPPTR of STREAM with (fetch CPPTR of FILE))
(* Steal the fields we need to simulate that stream)
(replace COFFSET of STREAM with (fetch COFFSET of FILE))
(replace CPAGE of STREAM with (fetch CPAGE of FILE))
(replace CBUFSIZE of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT)
of STREAM)
(fetch CBUFSIZE of FILE)))
(* Can't read farther than end-of-piece, tho)
(replace (TEXTSTREAM CHARSLEFT) of STREAM
with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) of STREAM)
(fetch CBUFSIZE of STREAM)))
(RETURN CH]
(NOERRORFLG (* There are no more pieces.
Punt gracefully)
(RETURN NIL))
(T (* He wants it the hard way.)
(APPLY* (fetch ENDOFSTREAMOP of STREAM)
STREAM])
(\TEXTBACKFILEPTR
[LAMBDA (STREAM) (* jds "26-Oct-84 16:32")
(* Use this to BACKFILEPTR a text stream.)
[PROG (PC PS PF REALFILE)
(COND
[(AND (IEQP (fetch CPAGE of STREAM)
(fetch (TEXTSTREAM PCSTARTPG) of STREAM))
(IEQP (fetch COFFSET of STREAM)
(fetch (TEXTSTREAM PCSTARTCH) of STREAM)))
(* Hit start of piece; back to PREVPIECE & keep going.)
[SETQ PC (replace (TEXTSTREAM PIECE) of STREAM with (fetch PREVPIECE
of (fetch (TEXTSTREAM PIECE)
of STREAM]
(* Move to previous piece)
(add (fetch (TEXTSTREAM PCNO) of STREAM)
(IMINUS \EltsPerPiece))
(while (AND PC (ZEROP (fetch PLEN of PC)))
do (* Skip over any zero-length pieces as we back along.)
(SETQ PC (fetch PREVPIECE of PC))
(add (fetch (TEXTSTREAM PCNO) of STREAM)
(IMINUS \EltsPerPiece)))
(COND
[PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES
(fetch PLOOKS of PC)
PC
(fetch (TEXTSTREAM TEXTOBJ)
of STREAM)))
(COND
((SETQ PS (fetch PSTR of PC)) (* This piece lives in a string.)
(replace CPPTR of STREAM with (OR (ADDBASE (fetch (STRINGP BASE)
of PS)
(LRSH (fetch (STRINGP OFFST)
of PS)
1))
(PROGN 0)))
(replace CPAGE of STREAM with 0)
(replace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where piece starts)
(replace (TEXTSTREAM PCSTARTCH) of STREAM with (LOGAND 1 (fetch (STRINGP
OFFST)
of PS)))
(* Char # within the "page" where the piece starts
(for BACKFILEPTR))
(replace EPAGE of STREAM with 1)
(replace EOFFSET of STREAM with (fetch PLEN of PC))
[replace COFFSET of STREAM with (SUB1 (replace CBUFSIZE of STREAM
with (IPLUS (fetch (TEXTSTREAM
PCSTARTCH)
of STREAM)
(fetch PLEN
of PC]
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(replace (TEXTSTREAM REALFILE) of STREAM with NIL))
((SETQ PF (fetch PFILE of PC)) (* This piece lives on a file.)
(AND (IEQP (fetch ACCESSBITS of PF)
NoBits)
(SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF)))
(replace (TEXTSTREAM PCSTARTPG) of STREAM
with (fetch (BYTEPTR PAGE) of (fetch PFPOS of PC)))
(* Page in the file where the piece starts.)
(replace (TEXTSTREAM PCSTARTCH) of STREAM
with (fetch (BYTEPTR OFFSET) of (fetch PFPOS of PC)))
(* Char within the page where the piece starts.)
(SETFILEPTR PF (IPLUS (fetch PFPOS of PC)
-1
(fetch PLEN of PC)))
(\PEEKBIN PF)
(replace CPPTR of STREAM with (fetch CPPTR of PF))
(replace CPAGE of STREAM with (fetch CPAGE of PF))
(replace COFFSET of STREAM with (fetch COFFSET of PF))
(replace EPAGE of STREAM with 32767)
(replace EOFFSET of STREAM with (fetch EOFFSET of PF))
(replace CBUFSIZE of STREAM with (IMIN (ADD1 (fetch COFFSET of STREAM))
(fetch CBUFSIZE of PF)))
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(replace (TEXTSTREAM REALFILE) of STREAM with PF))
((fetch POBJ of PC)
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0))
(T (ERROR "CAN'T GET TO NEXT PIECE"]
(T (ERROR "Trying to BACKFILEPTR thru start of text."]
((ZEROP (fetch COFFSET of STREAM)) (* Move back 1 file page)
(SETQ REALFILE (fetch (TEXTSTREAM REALFILE) of STREAM))
(replace (TEXTSTREAM CHARSLEFT) of STREAM with (IPLUS (fetch (TEXTSTREAM CHARSLEFT)
of STREAM)
(fetch CBUFSIZE of STREAM)))
(replace COFFSET of REALFILE with 0)
(\BACKFILEPTR REALFILE)
(\PEEKBIN REALFILE)
(replace CPAGE of STREAM with (fetch CPAGE of REALFILE))
(replace COFFSET of STREAM with (fetch COFFSET of REALFILE))
(replace CBUFSIZE of STREAM with (fetch CBUFSIZE of REALFILE))
(replace CPPTR of STREAM with (fetch CPPTR of REALFILE)))
(T (* JUST ACT CASUAL & DO IT.)
(\PAGEDBACKFILEPTR STREAM]
T])
(\TEXTBIN
[LAMBDA (STREAM) (* jds "26-Oct-84 16:33")
(* Do BIN slow case for a text stream)
(DECLARE (LOCALVARS . T))
(PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
(COND
[(ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)) (* Simple case -- just do the usual BIN)
(COND
([AND (SETQ PO (fetch POBJ of (fetch (TEXTSTREAM PIECE) of STREAM)))
(SETQ SUBSTREAM (IMAGEOBJPROP PO (QUOTE SUBSTREAM]
(add (fetch COFFSET of STREAM)
1)
(RETURN (\BIN SUBSTREAM)))
(T (RETURN (\PAGEDBIN STREAM]
(T (* We've either hit a page bound in a file, or a piece
bound.)
(RETURN (COND
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
(* Time for a new piece.)
[repeatwhile (AND PC (ZEROP (fetch PLEN of PC)))
do (* Skip over any zero-length pieces at the end of the
file.)
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
with (fetch NEXTPIECE of (SETQ OPC (fetch (TEXTSTREAM
PIECE)
of STREAM]
(replace BINABLE of STREAM with T)
(* Move to the next piece in the chain)
(COND
[PC (* There IS a next piece to move to.)
(add (fetch (TEXTSTREAM PCNO) of STREAM)
\EltsPerPiece)
(AND (fetch LOOKSUPDATEFN of STREAM)
(SETQ NPC (APPLY* (fetch LOOKSUPDATEFN of STREAM)
STREAM PC))
(replace (TEXTSTREAM PIECE) of STREAM with (SETQ PC NPC)))
(* Take care of any piece-change uproar.
uproar -- which may include picking a new piece to go
to.)
[COND
(NPC (* If we got an NPC, this was taken care of by the
EXTRASTREAMOP.))
([AND (SETQ PO (fetch POBJ of PC))
(SETQ SUBSTREAM (IMAGEOBJPROP PO (QUOTE SUBSTREAM]
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
with (fetch (TEXTSTREAM CURRENTPARALOOKS) of SUBSTREAM))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (fetch (TEXTSTREAM CURRENTLOOKS) of SUBSTREAM)))
[(NEQ (fetch PPARALOOKS of OPC)
(fetch PPARALOOKS of PC))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
with (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS of PC)
PC
(fetch (TEXTSTREAM TEXTOBJ)
of STREAM)))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (\TEDIT.APPLY.STYLES (fetch PLOOKS of PC)
PC
(fetch (TEXTSTREAM TEXTOBJ)
of STREAM]
((NOT (EQCLOOKS (fetch PLOOKS of PC)
(fetch PLOOKS of OPC)))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (\TEDIT.APPLY.STYLES (fetch PLOOKS of PC)
PC
(fetch (TEXTSTREAM TEXTOBJ)
of STREAM]
(COND
((SETQ PS (fetch PSTR of PC))
(* This piece lives in a string.)
(replace CPPTR of STREAM
with (OR (ADDBASE (fetch (STRINGP BASE) of PS)
(LRSH (fetch (STRINGP OFFST) of PS)
1))
(PROGN 0)))
(replace CPAGE of STREAM with 0)
(replace COFFSET of STREAM with (LOGAND 1 (fetch (STRINGP OFFST)
of PS)))
(replace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where piece starts)
(replace (TEXTSTREAM PCSTARTCH) of STREAM
with (fetch COFFSET of STREAM))
(* Char # within the "page" where the piece starts
(for BACKFILEPTR))
(replace EPAGE of STREAM with 1)
(replace EOFFSET of STREAM with (fetch PLEN of PC))
(replace CBUFSIZE of STREAM with (IPLUS (fetch COFFSET
of STREAM)
(fetch PLEN
of PC)))
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(replace (TEXTSTREAM REALFILE) of STREAM with NIL)
(\BIN STREAM))
((SETQ PF (fetch PFILE of PC))
(* This piece lives on a file.)
(AND (IEQP (fetch ACCESSBITS of PF)
NoBits)
(SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF)))
(replace (TEXTSTREAM PCSTARTPG) of STREAM
with (fetch (BYTEPTR PAGE) of (fetch PFPOS of PC)))
(* Page in the file where the piece starts.)
(replace (TEXTSTREAM PCSTARTCH) of STREAM
with (fetch (BYTEPTR OFFSET) of (fetch PFPOS of PC)))
(* Char within the page where the piece starts.)
(SETFILEPTR PF (fetch PFPOS of PC))
(SETQ CH (\BIN PF))
(replace CPPTR of STREAM with (fetch CPPTR of PF))
(replace CPAGE of STREAM with (fetch CPAGE of PF))
(replace COFFSET of STREAM with (fetch COFFSET of PF))
(replace EPAGE of STREAM with 32767)
(replace EOFFSET of STREAM with (fetch EOFFSET of PF))
[replace CBUFSIZE of STREAM
with (IMIN (fetch CBUFSIZE of PF)
(SUB1 (IPLUS (fetch COFFSET of STREAM)
(fetch PLEN of PC]
[replace (TEXTSTREAM CHARSLEFT) of STREAM
with (IDIFFERENCE (fetch PLEN of PC)
(ADD1 (IDIFFERENCE (fetch CBUFSIZE
of STREAM)
(fetch COFFSET
of STREAM]
(replace (TEXTSTREAM REALFILE) of STREAM with PF)
CH)
[(SETQ PO (fetch POBJ of PC))
(replace BINABLE of STREAM with NIL)
(COND
(SUBSTREAM (* There is a stream below this one, to feed chars
upward.)
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
of SUBSTREAM))
(freplace COFFSET of STREAM with 0)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
with (fetch PLEN of PC))
(freplace CBUFSIZE of STREAM
with (fetch PLEN of PC))
(freplace CPAGE of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
with 0)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
with 0)
(replace (TEXTSTREAM CURRENTPARALOOKS)
of STREAM with (fetch (TEXTSTREAM
CURRENTPARALOOKS)
of SUBSTREAM))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (fetch (TEXTSTREAM CURRENTLOOKS)
of SUBSTREAM))
(RETURN (\BIN SUBSTREAM)))
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(RETURN PO]
(T (ERROR "CAN'T GET TO NEXT PIECE"]
(T (* There are no more pieces.
Punt gracefully)
(COND
((fetch ENDOFSTREAMOP of STREAM)
(* If there's an EOF handler, call it & return the
result)
(RETURN (APPLY* (fetch ENDOFSTREAMOP of STREAM)
STREAM)))
(T (* Otherwise, return NIL)
(RETURN NIL]
[(SETQ PO (fetch POBJ of (fetch (TEXTSTREAM PIECE) of STREAM)))
(* This is an object)
(replace BINABLE of STREAM with NIL)
(COND
(SUBSTREAM (* There is a stream below this one, to feed chars
upward.)
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM))
(freplace COFFSET of STREAM with 1)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(freplace CBUFSIZE of STREAM with (fetch PLEN of PC))
(freplace CPAGE of STREAM with 0)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with 1)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
with (fetch (TEXTSTREAM CURRENTPARALOOKS) of SUBSTREAM))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
with (fetch (TEXTSTREAM CURRENTLOOKS) of SUBSTREAM))
(RETURN (\BIN SUBSTREAM)))
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(RETURN PO]
(T (* Need to move to the next page in a file.)
(SETQ FILE (fetch (TEXTSTREAM REALFILE) of STREAM))
(* Get the STREAM which describes the file for real)
[AND (IEQP (fetch ACCESSBITS of FILE)
NoBits)
(SETQ FILE (\GETSTREAM (OPENFILE (fetch FULLNAME of FILE)
(QUOTE INPUT))
(QUOTE INPUT]
(replace COFFSET of FILE with (fetch CBUFSIZE of FILE))
(* Force it to do a page switch for us)
(SETQ CH (\BIN FILE)) (* Get the next character in the usual manner)
(replace CPPTR of STREAM with (fetch CPPTR of FILE))
(* Steal the fields we need to simulate that stream)
(replace COFFSET of STREAM with (fetch COFFSET of FILE))
(replace CPAGE of STREAM with (fetch CPAGE of FILE))
(replace CBUFSIZE of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT)
of STREAM)
(fetch CBUFSIZE of FILE)))
(* Can't read farther than end-of-piece, tho)
(replace (TEXTSTREAM CHARSLEFT) of STREAM
with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) of STREAM)
(fetch CBUFSIZE of STREAM)))
(RETURN CH])
(\TEXTBOUT
[LAMBDA (STREAM BYTE) (* jds "27-Jul-84 14:10")
(* Do BOUT to a text stream, which is an insertion at
the caret.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
(CH# (ADD1 (\TEXTGETFILEPTR STREAM)))
WINDOW TEXTLEN PS PC PSTR OFFST)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ WINDOW (fetch \WINDOW of TEXTOBJ))
(AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#))
(\INSERTCH BYTE CH# TEXTOBJ)
(AND WINDOW (TEDIT.UPDATE.SCREEN TEXTOBJ))
[SETQ PS (ffetch PSTR of (SETQ PC (fetch \INSERTPC of TEXTOBJ]
(* This piece resides in a STRING.)
(replace (TEXTSTREAM PIECE) of STREAM with PC)
(replace (TEXTSTREAM PCNO) of STREAM with (fetch \INSERTPCNO of TEXTOBJ))
(freplace CPPTR of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS)
(LRSH (SETQ OFFST (ffetch (STRINGP OFFST)
of PS))
1)))
(freplace CPAGE of STREAM with 0)
(freplace COFFSET of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH) of STREAM
with (LOGAND 1 OFFST))
(fetch \INSERTLEN of TEXTOBJ)))
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where this piece starts)
(freplace CBUFSIZE of STREAM with (fetch COFFSET of STREAM))
(freplace EPAGE of STREAM with 1)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(freplace (TEXTSTREAM REALFILE) of STREAM with NIL])
(\TEXTSETEOF
[LAMBDA (STREAM EOFPTR) (* jds "30-JUL-82 10:01")
(* Set the EPAGE/EOFFSET of the stream to be
(SUB1 of EOFPTR))
(replace EPAGE of STREAM with (fetch (BYTEPTR PAGE) of EOFPTR))
(replace EOFFSET of STREAM with (fetch (BYTEPTR OFFSET) of EOFPTR])
(\TEXTSETFILEPTR
[LAMBDA (STREAM FILEPOS) (* jds " 4-Jun-84 13:40")
(* Sets the file ptr for a text stream.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)))
(COND
((ZEROP (fetch TEXTLEN of TEXTOBJ)))
((OR (IEQP FILEPOS -1)
(IEQP FILEPOS (fetch TEXTLEN of TEXTOBJ)))
(* Means end of file)
(\SETUPGETCH (IMAX 1 (fetch TEXTLEN of TEXTOBJ))
TEXTOBJ)
(\BIN STREAM))
((OR (ILESSP FILEPOS 0)
(IGREATERP FILEPOS (fetch TEXTLEN of TEXTOBJ)))
(* If the fileptr is not within the text, punt.)
(\ILLEGAL.ARG FILEPOS))
(T (\SETUPGETCH (IMAX 1 (ADD1 FILEPOS))
TEXTOBJ])
)
(* Support for TEXTPROP)
(DEFINEQ
(CGETTEXTPROP
[LAMBDA (WINFORM PROP) (* jds "15-Aug-84 11:06")
(* compiles calls on TEXTPROP that are fetching values.
This needs to be changed whenever GETTEXTPROP is
changed.)
(PROG NIL
(RETURN (LIST (QUOTE LISTGET)
(LIST (QUOTE fetch)
(QUOTE EDITPROPS)
(QUOTE of)
WINFORM)
(KWOTE PROP])
(CTEXTPROP
[LAMBDA (FORMTAIL) (* jds "27-Sep-84 12:54")
(* compiles calls to WINDOWPROP)
(COND
((NULL (CDR FORMTAIL)) (* less that 2 args)
(printout T "Possible error in call to TEXTPROP: less than 2 args" T (LIST (QUOTE TEXTPROP)
FORMTAIL)
T)
(CGETTEXTPROP (LIST (QUOTE TEXTOBJ)
(CAR FORMTAIL))
NIL))
((NOT (EQ (CAADR FORMTAIL)
(QUOTE QUOTE))) (* property is not quoted.)
(QUOTE IGNOREMACRO))
[(NULL (CDDR FORMTAIL)) (* fetching a window property.)
(CGETTEXTPROP (LIST (QUOTE TEXTOBJ)
(CAR FORMTAIL))
(CADR (CADR FORMTAIL]
(T (* storing a window property)
(LIST (QUOTE COND)
(LIST (LIST (QUOTE FETCH)
(QUOTE EDITPROPS)
(QUOTE OF)
(LIST (QUOTE TEXTOBJ)
(CAR FORMTAIL)))
(LIST (QUOTE LISTPUT)
(LIST (QUOTE FETCH)
(QUOTE EDITPROPS)
(QUOTE OF)
(LIST (QUOTE TEXTOBJ)
(CAR FORMTAIL)))
(CADR FORMTAIL)
(CADDR FORMTAIL)))
(LIST T (LIST (QUOTE REPLACE)
(QUOTE EDITPROPS)
(QUOTE OF)
(LIST (QUOTE TEXTOBJ)
(CAR FORMTAIL))
(QUOTE WITH)
(LIST (QUOTE LIST)
(CADR FORMTAIL)
(CADDR FORMTAIL])
(GETTEXTPROP
[LAMBDA (WINDOW PROP) (* jds "15-Aug-84 11:09")
(* gets values from a window.
Called by the macro for WINDOWPROP.)
(LISTGET (fetch EDITPROPS of WINDOW)
PROP])
(PUTTEXTPROP
[LAMBDA (TEXTOBJ PROP VALUE) (* jds "26-Sep-84 14:11")
(* put a value on prop list for a textobj)
(COND
((FETCH EDITPROPS OF (TEXTOBJ TEXTOBJ))
(LISTPUT (FETCH EDITPROPS OF (TEXTOBJ TEXTOBJ))
PROP VALUE))
(T (REPLACE EDITPROPS OF (TEXTOBJ TEXTOBJ) WITH (LIST PROP VALUE])
(TEXTPROP
[LAMBDA X (* jds "16-Aug-84 16:05")
(* general top level entry for both fetching and setting
window properties.)
(COND
((IGREATERP X 2)
(PUTTEXTPROP (TEXTOBJ (ARG X 1))
(ARG X 2)
(ARG X 3)))
((EQ X 2)
(GETTEXTPROP (TEXTOBJ (ARG X 1))
(ARG X 2)))
(T (\ILLEGAL.ARG NIL])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS TEXTPROP MACRO (ARGS (CTEXTPROP ARGS)))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\TEXTINIT)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA TEXTPROP)
)
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (15369 77051 (COPYTEXTSTREAM 15379 . 17130) (OPENTEXTSTREAM 17132 . 25614) (
REOPENTEXTSTREAM 25616 . 25997) (TEDIT.STREAMCHANGEDP 25999 . 26252) (TEXTSTREAMP 26254 . 26588) (
TXTFILE 26590 . 26902) (\CHTOPC 26904 . 27221) (\CHTOPCNO 27223 . 28819) (\CLEARPCTB 28821 . 29887) (
\CREATEPIECEORSTREAM 29889 . 31889) (\DELETECH 31891 . 39167) (\DELETEPIECE 39169 . 41164) (\FINDPIECE
41166 . 41696) (\INSERTCH 41698 . 53480) (\INSERTCR 53482 . 54679) (\INSERTPIECE 54681 . 58046) (
\MAKEPCTB 58048 . 59367) (\SETUPGETCH 59369 . 67282) (\TEDIT.REOPEN.STREAM 67284 . 68071) (\SPLITPIECE
68073 . 70929) (\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 70931 . 72641) (\TEXTINIT 72643 . 75592) (\TEXTMARK
75594 . 76131) (\TEXTTTYBOUT 76133 . 77049)) (77099 109404 (\TEXTCLOSEF 77109 . 77738) (\TEXTDSPFONT
77740 . 78013) (\TEXTEOFP 78015 . 78855) (\TEXTGETEOFPTR 78857 . 79045) (\TEXTGETFILEPTR 79047 . 80251
) (\TEXTOPENF 80253 . 81038) (\TEXTOUTCHARFN 81040 . 81302) (\TEXTPEEKBIN 81304 . 88537) (
\TEXTBACKFILEPTR 88539 . 94177) (\TEXTBIN 94179 . 106058) (\TEXTBOUT 106060 . 108041) (\TEXTSETEOF
108043 . 108475) (\TEXTSETFILEPTR 108477 . 109402)) (109438 112905 (CGETTEXTPROP 109448 . 109928) (
CTEXTPROP 109930 . 111644) (GETTEXTPROP 111646 . 111963) (PUTTEXTPROP 111965 . 112430) (TEXTPROP
112432 . 112903)))))
STOP