(FILECREATED "31-Jul-85 17:00:19" {ERIS}<TEDIT>TEXTOFD.;15 125111
changes to: (FNS \CREATEPIECEORSTREAM \TEXTBIN \TEDIT.TEXTBIN.FILESETUP)
previous date: "29-Jul-85 15:31:38" {ERIS}<TEDIT>TEXTOFD.;13)
(* Copyright (c) 1983, 1984, 1985 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
\TEDIT.TEXTBIN.NEW.PAGE \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 \TEDIT.TEXTBIN.STRINGSETUP \TEDIT.TEXTBIN.FILESETUP))
(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 FLAG) (* This piece contains a paragraph break)
PPARALOOKS (* Paragraph looks for this piece)
(PNEW FLAG) (* This text is new here; used by the tentative edit
system, and anyone else interested.)
(PFATP FLAG) (* T if the characters in this piece are FAT -- i.e.,
are 16 bits each.)
)
PSTR ← NIL PFILE ← NIL PFPOS ← 0 PLEN ← 0 PPARALOOKS ← TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ (
(* * This is where TEdit stores its state information, and internal data about the text being edited.)
PCTB (* The piece table)
TEXTLEN (* # of chars in the text)
\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.)
(\INSERTPCVALID FLAG)
(* T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a
different piece.)
\WINDOW (* The window<s> where this textobj is displayed)
MOUSEREGION (* Section of the window the mouse is in.)
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)
(\XDIRTY FLAG) (* 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 FLAG) (* T if this TEXTOBJ is a tedit-style menu)
FMTSPEC (* Default Formatting Spec to be used when formatting
paragraphs)
(FORMATTEDP FLAG) (* Flag for paragraph formatting.
T if this document is to contain paragraph formatting
information.)
(TXTREADONLY FLAG) (* 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 FLAG) (* 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)
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)
DISPLAYHCPYDS (* The DISPLAYSTREAM used to build line images of lines
that are displayed in "hardcopy" simulation mode)
TXTPAGEFRAMES (* A tree of page frames, specifying how the document
is to be laid out.)
(TXTNEEDSUPDATE FLAG) (* T => Screen invalid, need to run updater)
TXTCHARLOOKSLIST (* List of all the CHARLOOKSs in the document, so they
can be kept unique)
TXTPARALOOKSLIST (* List of all the FMTSPECs in the document, so they
can be kept unique)
)
[ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM)
(PROGN (IF (NEQ (FETCH (TEXTOBJ \XDIRTY) OF DATUM)
NEWVALUE)
THEN
(* update the title to reflect the change)
(\TEDIT.WINDOW.TITLE
DATUM
(\TEDIT.ORIGINAL.WINDOW.TITLE
(ffetch (TEXTOBJ TXTFILE)
of DATUM)
NEWVALUE)))
(freplace \XDIRTY OF DATUM WITH NEWVALUE]
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 \XDIRTY ← 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)
TIPCOFFSET (* The offset into the current piece, as of the last
page cross.)
))
(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 TIPCOFFSET of (fetch IMAGEDATA of DATUM))
(REPLACE TIPCOFFSET OF (fetch IMAGEDATA 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)) (* Function to be called each time character looks
change.)
(FATSTREAMP (fetch F4 of DATUM)
(REPLACE F4 OF DATUM WITH NEWVALUE))
(* T if the current piece is 16 bit characters.)
)
(CREATE (create STREAM using \TEXTOFD IMAGEDATA ←(create TEXTIMAGEDATA))))
]
(/DECLAREDATATYPE (QUOTE PIECE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG
POINTER FLAG FLAG))
[QUOTE ((PIECE 0 POINTER)
(PIECE 2 POINTER)
(PIECE 4 POINTER)
(PIECE 6 POINTER)
(PIECE 8 POINTER)
(PIECE 10 FULLXPOINTER)
(PIECE 12 POINTER)
(PIECE 14 POINTER)
(PIECE 14 (FLAGBITS . 0))
(PIECE 16 POINTER)
(PIECE 16 (FLAGBITS . 0))
(PIECE 16 (FLAGBITS . 16]
(QUOTE 18))
(/DECLAREDATATYPE (QUOTE TEXTOBJ)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG
FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER
FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG
POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG
POINTER POINTER))
(QUOTE ((TEXTOBJ 0 POINTER)
(TEXTOBJ 2 POINTER)
(TEXTOBJ 4 POINTER)
(TEXTOBJ 6 POINTER)
(TEXTOBJ 8 POINTER)
(TEXTOBJ 10 POINTER)
(TEXTOBJ 12 POINTER)
(TEXTOBJ 14 POINTER)
(TEXTOBJ 16 POINTER)
(TEXTOBJ 16 (FLAGBITS . 0))
(TEXTOBJ 18 POINTER)
(TEXTOBJ 20 POINTER)
(TEXTOBJ 22 POINTER)
(TEXTOBJ 24 POINTER)
(TEXTOBJ 26 POINTER)
(TEXTOBJ 28 POINTER)
(TEXTOBJ 30 POINTER)
(TEXTOBJ 32 POINTER)
(TEXTOBJ 34 POINTER)
(TEXTOBJ 36 POINTER)
(TEXTOBJ 38 POINTER)
(TEXTOBJ 40 POINTER)
(TEXTOBJ 42 POINTER)
(TEXTOBJ 44 POINTER)
(TEXTOBJ 44 (FLAGBITS . 0))
(TEXTOBJ 46 FULLXPOINTER)
(TEXTOBJ 48 POINTER)
(TEXTOBJ 50 POINTER)
(TEXTOBJ 52 POINTER)
(TEXTOBJ 54 POINTER)
(TEXTOBJ 56 POINTER)
(TEXTOBJ 56 (FLAGBITS . 0))
(TEXTOBJ 58 POINTER)
(TEXTOBJ 58 (FLAGBITS . 0))
(TEXTOBJ 58 (FLAGBITS . 16))
(TEXTOBJ 60 POINTER)
(TEXTOBJ 62 POINTER)
(TEXTOBJ 64 POINTER)
(TEXTOBJ 66 POINTER)
(TEXTOBJ 68 POINTER)
(TEXTOBJ 70 POINTER)
(TEXTOBJ 70 (FLAGBITS . 0))
(TEXTOBJ 72 POINTER)
(TEXTOBJ 74 FULLXPOINTER)
(TEXTOBJ 76 POINTER)
(TEXTOBJ 78 POINTER)
(TEXTOBJ 80 POINTER)
(TEXTOBJ 82 POINTER)
(TEXTOBJ 84 POINTER)
(TEXTOBJ 84 (FLAGBITS . 0))
(TEXTOBJ 86 POINTER)
(TEXTOBJ 88 POINTER)))
(QUOTE 90))
(/DECLAREDATATYPE (QUOTE TEXTIMAGEDATA)
(QUOTE (POINTER POINTER POINTER POINTER))
(QUOTE ((TEXTIMAGEDATA 0 POINTER)
(TEXTIMAGEDATA 2 POINTER)
(TEXTIMAGEDATA 4 POINTER)
(TEXTIMAGEDATA 6 POINTER)))
(QUOTE 8))
(* 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 " 6-Mar-85 21:08")
(* 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) (* Set up to select the whole source text)
(replace CHLIM of TSEL with (ADD1 (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) (* Put the pieces into the copy textstream)
(replace TEXTLEN of NEWTEXTOBJ with (fetch TEXTLEN of TEXTOBJ))
(* The copy is the same length as the original)
(replace MENUFLG of NEWTEXTOBJ with (fetch MENUFLG of TEXTOBJ))
(* And if the original is a menu, so's the copy)
(RETURN NEWSTREAM])
(OPENTEXTSTREAM
[LAMBDA (TEXT WINDOW START END PROPS) (* jds "17-Jul-85 15:27")
(* 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
\INSERTPCVALID ← NIL))
((type? TEXTOBJ TEXT)
(create TEXTOBJ using TEXT \INSERTFIRSTCH ← -1 \INSERTNEXTCH ← -1
\INSERTPCVALID ← NIL))
(T (create TEXTOBJ]
(TEDIT.GET.FINISHEDFORMS NIL)
[PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)
(COPY (fetch EDITPROPS of TEXTOBJ]
[TEXTOBJ.WINDOW.VALID (AND (EQ WINDOW (\TEDIT.PRIMARYW TEXTOBJ))
(EQ TEXTOBJ (WINDOWPROP WINDOW (QUOTE TEXTOBJ]
FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP CLEARGET? PARALOOKS)
(* Remember if the textobj had a window already.)
(replace \WINDOW of TEXTOBJ with (AND WINDOW (LIST WINDOW)))
(* Necessary because some incoming object types depend
on knowing where the window is.)
(replace LINES of TEXTOBJ with NIL) (* This is here so if we re-OPENTEXTSTREAM an existing
stream/window pair we don't get two sets of line
descriptors)
[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))
(COND
[(LISTP (LISTGET PROPS (QUOTE FONT)))
(FONTCREATE (LISTGET PROPS (QUOTE FONT]
(T (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 (\TEDIT.UNIQUIFY.PARALOOKS [SETQ PARALOOKS
(\TEDIT.PARSE.PARALOOKS.LIST
(OR PARALOOKS
(create FMTSPEC
using
TEDIT.DEFAULT.FMTSPEC]
TEXTOBJ))
[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 (\TEDIT.UNIQUIFY.CHARLOOKS FONT
TEXTOBJ]
(T (* Otherwise, create a TEXTOFD to describe the text
we're editing.-)
(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 EDITPROPS of TEXTOBJ with PROPS) (* Save the PROPS for later people who'd like to know
them)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY
TEXTOBJ
(replace DEFAULTCHARLOOKS
of TEXTOBJ
with (
\TEDIT.UNIQUIFY.CHARLOOKS FONT TEXTOBJ)))
TEXTOBJ))
(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
((EQ PROP (QUOTE DON'T)) (* A SEL prop of DON'T means don't make an initial
selection)
(replace SET of SEL with NIL))
((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 (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:)
(replace \WINDOW of TEXTOBJ with NIL)
(\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 "22-Jul-85 12:53")
(* 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)))
-4))
(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)
-4)))
(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)
-4)))
(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 "31-Jul-85 16:34")
(* 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 " 6-Mar-85 21:22")
(* 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 (IDIFFERENCE CHLIM CH#)))
[COND
[(AND (fetch \INSERTPCVALID of TEXTOBJ)
(IEQP CHLIM (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)
(replace \INSERTPCVALID of TEXTOBJ with NIL)
(* Force the next insertion to be in a fresh piece.)
]
((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
[(ILEQ CHLIM TEXTLEN)
(SETQ PCNON (\CHTOPCNO 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 CHLIM (\EDITELT PCTB PCNON))
(SETQ HIPC (\SPLITPIECE PCN 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)
(CAR (fetch \WINDOW 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 \INSERTPCVALID of TEXTOBJ with NIL)
(* Force the next insertion to be in a fresh piece.)
(\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 "16-Jul-85 17:25")
(* 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)))
[FATP (COND
[(type? STRINGP CH)
(AND (fetch (STRINGP FATSTRINGP) of CH)
(NOT (NULL (for CHAR instring CH thereis (IGREATERP CHAR \MAXTHINCAR]
(T (IGREATERP CH \MAXTHINCHAR]
(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
([AND (fetch \INSERTPCVALID of TEXTOBJ)
(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))
(\TEDIT.UNIQUIFY.PARALOOKS
(create FMTSPEC
copying (fetch FMTSPEC of TEXTOBJ))
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 (fetch FMTSPEC of TEXTOBJ)))
((NOT NLOOKS)
(* No succeeding paras to take looks from)
(OR PLOOKS (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)
(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)
(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]
(COND
((AND (IEQP CH# \INEXTCH)
(EQ (fetch THACTION of EVENT)
(QUOTE Insert))) (* We're continuing a prior insertion, even if we had
to create a new piece. Just continue the old history
event, too.)
(add (fetch THLEN of EVENT)
LEN))
(T (* Nope, this is a new insertion/replacement.
Make the new history 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 \INSERTPCVALID of TEXTOBJ with T)
(replace \DIRTY of TEXTOBJ with T)
(replace PFATP of \INPC with (OR (fetch PFATP of \INPC)
FATP])
(\INSERTCR
[LAMBDA (CH CH# TEXTOBJ) (* jds "11-Feb-85 14:45")
(* 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 \INSERTPCVALID of TEXTOBJ with NIL) (* FORCE A NEW PIECE ON THE NEXT CHARACTER)
])
(\INSERTPIECE
[LAMBDA (NEW OLD TEXTOBJ DONTUPDATECH#S PC#) (* jds " 6-Feb-85 16:56")
(* 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 (IMAX (IPLUS (ARRAYSIZE PCTB)
32)
(IPLUS (ARRAYSIZE PCTB)
(LRSH (ARRAYSIZE PCTB)
1)))
(QUOTE POINTER)
NIL 0)) (* Allocate a new table that's half again as large as
the current table, or 32 spots bigger, whichever is
larger.)
(\MOVEWORDS (SETQ BASE (fetch (ARRAYP BASE) of PCTB))
0
(fetch (ARRAYP BASE) of NPCTB)
0
(LLSH (ARRAYSIZE PCTB)
1)) (* Copy the pointers over to the new PCTB)
[\ZEROWORDS BASE (\ADDBASE BASE (SUB1 (LLSH (ARRAYSIZE PCTB)
1]
(* And zero out the old PCTB, so that the pointers
don't get dereferenced by accident.)
(\EDITSETA NPCTB \PCTBFreePieces (LRSH (IDIFFERENCE (ARRAYSIZE NPCTB)
(ARRAYSIZE PCTB))
1))
(* There are now some free pieces in the new table
(half as many pieces as we added pointers to the
table.))
(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)) (* Move the rest of the table over to make room for the
new pointer.)
(\PUTBASEPTR BASE (LLSH PCNO 1)
NIL) (* Clear the place we're filling in, so it doesn't get
dereferenced.)
(\EDITSETA PCTB PCNO (\EDITELT PCTB (IPLUS PCNO \EltsPerPiece)))
(\PUTBASEPTR BASE (LLSH (IPLUS PCNO 1)
1)
NIL)
(\EDITSETA PCTB (ADD1 PCNO)
NEW) (* Move in the new piece)
(\EDITSETA PCTB \PCTBLastPieceOffset (IPLUS OLIM \EltsPerPiece))
(* Bump the last-piece pointer)
(\EDITSETA PCTB \PCTBFreePieces (SUB1 (\EDITELT PCTB \PCTBFreePieces)))
(* And count down the remaining free pieces by one.)
[OR DONTUPDATECH#S (for I from (IPLUS PCNO \EltsPerPiece) to (IPLUS OLIM \EltsPerPiece)
by \EltsPerPiece
do (* And update the starting-CH#s after the inserted
piece.)
(\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 "25-Apr-85 09:49")
(* 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)
(replace FATSTREAMP of STREAM with NIL)
[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.)
(\TEDIT.TEXTBIN.STRINGSETUP CHOFFSET CHARSLEFT STREAM PS))
((SETQ PF (ffetch PFILE of PC)) (* This piece resides on a FILE)
(\TEDIT.TEXTBIN.FILESETUP PC CHOFFSET CHARSLEFT STREAM PF (fetch PFATP of PC)))
[(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])
(\TEDIT.TEXTBIN.NEW.PAGE
[LAMBDA (STREAM)
(PROG ((FILE (fetch (TEXTSTREAM REALFILE) of STREAM))
CH) (* 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])
(\SPLITPIECE
[LAMBDA (PC CH TEXTOBJ PC#) (* jds " 8-Jul-85 16:11")
(* 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 (COND
((fetch PFATP of NEWPC)
(* This is a FAT piece; need to allow 2 bytes per char
skipped)
(IPLUS (ffetch PFPOS of PC)
CHNO CHNO))
(T (* Regular piece; allow 1 byte per char)
(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 \INSERTPCVALID of TEXTOBJ with NIL) (* Whenever you split a piece, you can't add to it
anymore.)
(RETURN NEWPC])
(\TEDIT.COPYTEXTSTREAM.PIECEMAPFN
[LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* jds " 8-Feb-85 15:16")
(* 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 (CAR (fetch \WINDOW of TOOBJ))
(fetch STREAMHINT of FROMOBJ)
(fetch STREAMHINT of TOOBJ]
(RETURN PC])
(\TEXTINIT
[LAMBDA NIL (* jds "15-May-85 14:30")
(* 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)
IMFONTCREATE ←(QUOTE DISPLAY)))
(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 " 5-Feb-85 15:02")
(* 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 (* Run thru the pieces in the document, closing the
underlying file (s))
(SETQ PC (\EDITELT PCTB I))
(COND
((fetch PFILE of PC)
(CLOSEF? (fetch PFILE of PC]
(CLOSEF? (fetch TXTFILE of TEXTOBJ)) (* And close the REAL file as well, in case we'd made a
local cache.)
])
(\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 "26-Apr-85 14:47")
(* 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)
(COND
((fetch FATSTREAMP of STREAM)
(* This is a 16-bit stream; The difference is in BYTES,
and needs to be divided by 2 to get chars)
(IQUOTIENT (IDIFFERENCE OFFSET LIMIT)
2))
(T (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 "29-Jul-85 15:16")
(* DO PEEKBIN for a text stream)
(PROG (CH FILE STR PF PS PC PO SUBSTREAM)
(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)
(COND
[(fetch FATSTREAMP of STREAM) (* This is a 16 bit PEEKBIN.
Grab two chars...)
(RETURN (COND
[(\EOFP STREAM)
(COND
(NOERRORFLG NIL)
(T (\PEEKBIN STREAM]
((ILESSP (fetch COFFSET of STREAM)
(SUB1 (fetch CBUFSIZE of STREAM)))
(* We're sure of staying on the same page.
Just grab the characters)
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
256)
(\PAGEDPEEKBIN STREAM NOERRORFLG))
(\PAGEDBACKFILEPTR STREAM)))
(T (SETQ PS STREAM:F1)
PS:COFFSET←STREAM:COFFSET
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
256)
(\PAGEDPEEKBIN PS NOERRORFLG))
(\PAGEDBACKFILEPTR PS]
(T (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 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]
((SETQ PS (fetch PSTR of PC))
(* This piece lives in a string.)
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch PLEN of PC)
STREAM PS)
(* Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run
for as many chars as there are in the piece.)
(\PEEKBIN STREAM NOERRORFLG))
((SETQ PF (fetch PFILE of PC))
(* This piece lives on a file.)
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch PLEN of PC)
STREAM PF (FETCH PFATP OF PC)
(QUOTE PEEKBIN)
NOERRORFLG))
(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 " 8-May-85 13:59")
(* 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)
(replace BINABLE of STREAM with T)
(replace FATSTREAMP of STREAM with NIL)
(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.)
(\TEDIT.TEXTBIN.STRINGSETUP (SUB1 (fetch PLEN of PC))
1 STREAM PS)
(* Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run
for as many chars as there are in the piece.)
)
((SETQ PF (fetch PFILE of PC)) (* This piece lives on a file.)
(\TEDIT.TEXTBIN.FILESETUP PC (SUB1 (fetch PLEN of PC))
1 STREAM PF (fetch PFATP of PC)
(QUOTE PEEKBIN)))
((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.)
(COND
((fetch FATSTREAMP of STREAM) (* 16 bit stream, so back up 2 bytes.)
(\PAGEDBACKFILEPTR STREAM)
(\PAGEDBACKFILEPTR STREAM))
(T (\PAGEDBACKFILEPTR STREAM]
T])
(\TEXTBIN
[LAMBDA (STREAM) (* jds "31-Jul-85 13:37")
(* * Do BIN slow case for a text stream)
(* NB that PEEKBIN and BACKFILEPTR need to track
changes in this code)
(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)))
[(fetch FATSTREAMP of STREAM) (* This is a 20Q bit BIN. grab 2 bytes.)
(* WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER
PAGE??)
(RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
400Q)
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(* This pair of characters doesn't straddle a file page
bound. Just grab the next char.)
(\PAGEDBIN STREAM))
(T (* Need to move to the next page on the backing file.
Doing so also grabs the next character.)
(\TEDIT.TEXTBIN.NEW.PAGE STREAM]
(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 OPC (fetch (TEXTSTREAM PIECE) of STREAM))
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
with (AND OPC (fetch NEXTPIECE of OPC]
(replace BINABLE of STREAM with T)
(replace FATSTREAMP of STREAM with NIL)
(* 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
LOOKSUPDATEFN))
([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.)
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch PLEN of PC)
STREAM PS)
(* Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run
for as many chars as there are in the piece.)
(* Then actually grab the next character to hand back
to the caller.)
(\BIN STREAM))
((SETQ PF (fetch PFILE of PC))
(* This piece lives on a file.)
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch PLEN of PC)
STREAM PF (fetch PFATP of PC)
(QUOTE PEEKBIN))
(\BIN STREAM))
[(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.)
(RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM])
(\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])
(\TEDIT.TEXTBIN.STRINGSETUP
[LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* jds "26-Apr-85 15:02")
(PROG (OFFST)
(COND
((fetch (STRINGP FATSTRINGP) of PS) (* The string is FAT. Therefore, make all the offsets
and things take account of the fact that each char is
really 2 bytes.)
(freplace CPPTR of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS)
(ffetch (STRINGP OFFST) of PS)))
(* The char page ptr can point to the real first char,
since it's a word.)
(freplace CPAGE of STREAM with 0)
(freplace COFFSET of STREAM with (UNFOLD CHOFFSET 2))
(* Offset into the string, in bytes.
That 2 should really be something like
BYTESPERFATCHAR.)
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0)
(* Page # within the "file" where this piece starts)
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0)
(* Char within "page" where the piece starts
(for BACKFILEPTR))
(freplace CBUFSIZE of STREAM with (IPLUS (UNFOLD CHARSLEFT 2)
(ffetch COFFSET of STREAM)))
(* Since the chars-left field is words, and we're
talking bytes.)
(freplace EPAGE of STREAM with 1)
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(* When we hit the end of the string, we'll have run
out off the piece, too.)
(freplace (TEXTSTREAM REALFILE) of STREAM with NIL)
(replace BINABLE of STREAM with NIL) (* To force BINs thru the \TEXTBIN function so we can
get two bytes.)
(replace FATSTREAMP of STREAM with T) (* And mark the stream as having wide characters, so
\TEXTBIN knows what to do.)
)
(T (* Characters are thin in this string
(the usual case))
(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 (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 COFFSET of STREAM with (IPLUS (LOGAND 1 OFFST)
CHOFFSET))
(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)
(replace FATSTREAMP of STREAM with NIL])
(\TEDIT.TEXTBIN.FILESETUP
[LAMBDA (PC CHOFFSET CHARSLEFT STREAM PF FATP OPERATION NOERRORFLG)
(* jds "31-Jul-85 11:48")
(* Do the setup needed to make a text stream read from
a file.)
(PROG ((BYTESLEFT (COND
(FATP (UNFOLD CHARSLEFT 2))
(T CHARSLEFT)))
(BYTEOFFSET (COND
(FATP (UNFOLD CHOFFSET 2))
(T CHOFFSET)))
CH FPOS)
[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 BYTEOFFSET))
[COND
((ZEROP (GETEOFPTR PF)) (* For zero-length files, do nothing.)
)
((ILESSP (IPLUS FPOS BYTEOFFSET)
(GETEOFPTR PF)) (* Only get the next character if we aren't positioning
past the end of the file.)
(SETQ CH (SELECTQ OPERATION
(PEEKBIN (\PEEKBIN PF NOERRORFLG))
(BIN (\BIN PF))
(\PEEKBIN PF NOERRORFLG]
(* * Move all the relevant fields from the backing file's stream into the text stream, so that microcoded BINs will
do the right thing.)
(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 77777Q)
(freplace CBUFSIZE of STREAM with (IMIN (ffetch CBUFSIZE of PF)
(IPLUS (ffetch COFFSET of PF)
BYTESLEFT)))
[freplace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE BYTESLEFT
(IDIFFERENCE (ffetch CBUFSIZE
of STREAM)
(ffetch COFFSET
of STREAM]
(freplace (TEXTSTREAM REALFILE) of STREAM with PF)
(replace (TEXTSTREAM FATSTREAMP) of STREAM with FATP)
(* Mark the stream, if it contains fat characters for
this piece.)
(replace BINABLE of STREAM with (NOT FATP)) (* A stream that has fat chars can't use the micrododed
BIN.)
(* And return the next character in line)
(RETURN CH])
)
(* 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 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (19489 86097 (COPYTEXTSTREAM 19499 . 21668) (OPENTEXTSTREAM 21670 . 31291) (
REOPENTEXTSTREAM 31293 . 31674) (TEDIT.STREAMCHANGEDP 31676 . 31945) (TEXTSTREAMP 31947 . 32293) (
TXTFILE 32295 . 32611) (\CHTOPC 32613 . 32930) (\CHTOPCNO 32932 . 34665) (\CLEARPCTB 34667 . 35733) (
\CREATEPIECEORSTREAM 35735 . 37735) (\DELETECH 37737 . 45282) (\DELETEPIECE 45284 . 47347) (\FINDPIECE
47349 . 47879) (\INSERTCH 47881 . 60975) (\INSERTCR 60977 . 62174) (\INSERTPIECE 62176 . 67243) (
\MAKEPCTB 67245 . 68641) (\SETUPGETCH 68643 . 73957) (\TEDIT.REOPEN.STREAM 73959 . 74746) (
\TEDIT.TEXTBIN.NEW.PAGE 74748 . 76382) (\SPLITPIECE 76384 . 79585) (\TEDIT.COPYTEXTSTREAM.PIECEMAPFN
79587 . 81404) (\TEXTINIT 81406 . 84566) (\TEXTMARK 84568 . 85137) (\TEXTTTYBOUT 85139 . 86095)) (
86145 121240 (\TEXTCLOSEF 86155 . 87140) (\TEXTDSPFONT 87142 . 87439) (\TEXTEOFP 87441 . 88350) (
\TEXTGETEOFPTR 88352 . 88544) (\TEXTGETFILEPTR 88546 . 90155) (\TEXTOPENF 90157 . 90942) (
\TEXTOUTCHARFN 90944 . 91214) (\TEXTPEEKBIN 91216 . 98013) (\TEXTBACKFILEPTR 98015 . 101704) (\TEXTBIN
101706 . 110720) (\TEXTBOUT 110722 . 112799) (\TEXTSETEOF 112801 . 113233) (\TEXTSETFILEPTR 113235 .
114224) (\TEDIT.TEXTBIN.STRINGSETUP 114226 . 117963) (\TEDIT.TEXTBIN.FILESETUP 117965 . 121238)) (
121274 124745 (CGETTEXTPROP 121284 . 121764) (CTEXTPROP 121766 . 123480) (GETTEXTPROP 123482 . 123803)
(PUTTEXTPROP 123805 . 124270) (TEXTPROP 124272 . 124743)))))
STOP