(FILECREATED "25-Sep-86 23:16:58" {ERIS}<TEDIT>TEDITFILE.;31 194447
changes to: (VARS TEDITFILECOMS)
previous date: "24-Sep-86 02:42:58" {ERIS}<TEDIT>TEDITFILE.;30)
(* "
Copyright (c) 1983, 1984, 1985, 1986 by John Sybalsky & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDITFILECOMS)
(RPAQQ TEDITFILECOMS
((FILES TEDITDECLS)
(FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET
TEDIT.INCLUDE TEDIT.PARSE.PAGEFRAMES1 TEDIT.PUT TEDIT.PUT.PCTB \TEDIT.PUTRESET
TEDIT.PUT.PIECE.DESCRIPTOR \ARBIN \ARBOUT \ATMIN \ATMOUT \DWIN \DWOUT \STRINGIN
\STRINGOUT \TEDIT.FORMATTEDP1 \TEDIT.SET.WINDOW TEDIT.RAW.INCLUDE)
(FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.PUT.PARALOOKS.LIST
\TEDIT.PUT.SINGLE.CHARLOOKS)
(FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.PUT.CHARLOOKS.LIST
\TEDIT.PUT.SINGLE.PARALOOKS)
(GLOBALVARS TEDIT.INPUT.FORMATS)
(INITVARS (TEDIT.INPUT.FORMATS NIL))
(COMS (* For converting old incoming format. Cutover 5/22/85 to permit looks changes in the
future.)
(FNS TEDIT.BUILD.PCTB2 \TEDIT.GET.CHARLOOKS.LIST2 \TEDIT.GET.SINGLE.CHARLOOKS2
\TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.PUT.SINGLE.CHARLOOKS2
\TEDIT.GET.PARALOOKS.LIST2 \TEDIT.GET.SINGLE.PARALOOKS2 TEDIT.PUT.PCTB2
\TEDIT.PUT.CHARLOOKS.LIST2 \TEDIT.PUT.PARALOOKS.LIST2))
(COMS (* For converting incoming old-format files (1/27/85 cutover))
(FNS TEDIT.BUILD.PCTB1 TEDIT.GET.PAGEFRAMES1 \TEDIT.GET.CHARLOOKS1
\TEDIT.GET.PARALOOKS1 TEDIT.GET.OBJECT1))
(COMS (* VERSION 0 Compatibility reading functions)
(FNS TEDIT.BUILD.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0))))
(FILESLOAD TEDITDECLS)
(DEFINEQ
(TEDIT.BUILD.PCTB
[LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS CLEARGET?)
(* jds
"10-Feb-86 12:23")
(* START = 1st char
of file to read from,
if specified)
(* END = use this as
eofptr of file.
For use in reading
files within files.)
(PROG (SEL LINES PCTB PC OLDPC PCCOUNT TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN
PIECEINFOCH# CACHE CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP
EXISTINGCHARLOOKS EXLOOK EXISTINGFMTSPECS (CURFILECH# (OR START 0))
(CURCH# 1)
(TEXTSTREAM (AND TEXTOBJ (fetch STREAMHINT of TEXTOBJ)))
LOOKSHASH PARAHASH)
[SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND
(TEXTOBJ (fetch FMTSPEC of TEXTOBJ))
(T (create FMTSPEC using
TEDIT.DEFAULT.FMTSPEC
] (* Set the default
paragraph formatting
for filling in piece
PPARALOOKS fields)
(COND
(TEXTOBJ (* If there's a
TEXTOBJ behind this,
set its TXTFILE field
to point to the right
place.)
(replace TXTFILE of TEXTOBJ with TEXT)))
(SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)))
(* Set the default
CHARLOOKS, for filling
in pieces' PLOOKS
fields)
(SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END))
(* Grab the file, or
a single piece
(if the text is a
string, or such simple
cases))
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ with NIL))
(* Start by assuming
no page formatting)
(COND
((STREAMP TEXT) (* OK, it wasn't a
string, so check for
cases where we have to
cache the file locally.)
(AND TEXTOBJ (replace TXTFILE of TEXTOBJ with TEXT))
(COND
((OR [AND TEXTOBJ (SETQ CACHE? (TEXTPROP TEXTOBJ (QUOTE CACHE]
(NOT (RANDACCESSP TEXT))) (* If the file device
isn't rancom access,
cache the file locally.)
(* Also do this if he
asks for a local cache.)
(SETQ CACHE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW))) (* The cache file)
(COPYBYTES TEXT CACHE (OR START (AND (RANDACCESSP TEXT)
0))
(OR END (AND (RANDACCESSP TEXT)
-1))) (* Copy the text
there)
(SETQ CACHE? T) (* Remember that we
cached it!)
(* COPYBYTES can only have start/end args of NIL if the file is not
random access. So it's impossible to grab out of the middle of a file on
an NS server. Sorry.)
(COND
(CACHE? (* for the folx who
don't trust the
connections, since all
their pcs will point to
core, we can close the
txtfile connection)
(CLOSEF TEXT)))
(replace EOLCONVENTION of CACHE with (fetch EOLCONVENTION
of TEXT))
(* Remember the EOL
convention from the
original file, so that
we can do a copybytes
if need by.)
(SETQ TEXT CACHE) (* And pretend the
cache IS the real file
from here on)
(SETQ START (SETQ END NIL)) (* Since we only
copied the relevant
part of the file into
the cache, we don't
need to remember the
limits of interest.)
))
(SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END))
(COND
((AND (NOT PCCOUNT)
(NEQ (fetch EOLCONVENTION of TEXT)
CR.EOLC)) (* This is an
UNFORMATTED file, and
it has a foreign EOL
convention. Convert it,
and save the converted
copy locally.)
(SETQ CACHE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW))) (* Build a cache file)
(COPYCHARS TEXT CACHE (OR START 0)
(OR END -1)) (* Copy the text,
converting from the
foreign EOL convention
into CR as end of line.)
(SETQ TEXT CACHE) (* And think of THIS
as the cache.
At this point, we may
have cached twice in
succession--no need to
clip off START and END.)
(SETQ CACHE? T) (* Remember that we
cached the file!)
)) (* Check to see if
this is a formatted
file, and find out how
may pieces we should
allocate for it.)
))
(AND TEXTOBJ (TEXTPROP TEXTOBJ (QUOTE CACHE)
CACHE?)) (* REMEMBER THAT THIS
TEXT WAS CACHED, SO
THAT LATER PUTS DON'T
INVALIDATE THE CACHE.)
[COND
((type? PIECE TEXT) (* If this isn't a
text stream, build a
piece table with the
one piece in it.)
(SETQ PCTB (\MAKEPCTB TEXT))
(replace PLOOKS of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch PLOOKS
of TEXT)
TEXTOBJ)) (* And note the
CHARLOOKS and PARALOOKS
of this text--as well
as filling them in.)
(replace PPARALOOKS of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS (fetch
PPARALOOKS
of
TEXT)
TEXTOBJ)))
(CLEARGET? (* If the user wants
an uninterpreted stream
onto the file , build a
piece table with the
one piece in it.)
(SETQ TEXT (create PIECE
PFILE ← TEXT
PFPOS ←(COND
(START START)
(T 0))
PLEN ←(IDIFFERENCE (OR END (GETEOFPTR TEXT))
(COND
(START START)
(T 0)))
PREVPIECE ← NIL
PLOOKS ← DEFAULTLOOKS
PPARALAST ← NIL
PPARALOOKS ← DEFAULTPARALOOKS)) (* A single piece to
describe the whole file)
(SETQ PCTB (\MAKEPCTB TEXT))
(replace PLOOKS of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
PLOOKS
of
TEXT)
TEXTOBJ))
(* And note the
CHARLOOKS and PARALOOKS
for later saving.
Keep those caches
consistent.)
(replace PPARALOOKS of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS
(fetch PPARALOOKS of TEXT)
TEXTOBJ)))
((NOT PCCOUNT) (* This is an
unformatted file)
[COND
[(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS
when (SETQ USERTEMP (APPLY* (CAR FILETYPE)
TEXT))
do (RETURN FILETYPE))) (* The input file is
in a user-sensible
format, which he is
willing to convert for
TEdit's use.)
(* See if there are
Bravo headers)
(SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT)
TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS))
(* Convert the
foreign format file,
and grab its PCTB)
(bind (PC ←(ELT PCTB (ADD1 \FirstPieceOffset))) while PC
do (* Run thru the
converted pieces,
noting their CHARLOOKS
and PARALOOKS for the
get/put caches.)
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS
(fetch PLOOKS of PC)
TEXTOBJ))
(replace PPARALOOKS of PC with (\TEDIT.UNIQUIFY.PARALOOKS
(fetch PPARALOOKS
of PC)
TEXTOBJ))
(SETQ PC (fetch NEXTPIECE of PC]
(T (* Nope--it's
straight unformatted
text)
(SETQ PCTB (\MAKEPCTB (create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ←(IDIFFERENCE (OR END (GETEOFPTR TEXT))
CURFILECH#)
PREVPIECE ← NIL
PLOOKS ←(\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS
TEXTOBJ)
PPARALAST ← NIL
PPARALOOKS ←(\TEDIT.UNIQUIFY.PARALOOKS
DEFAULTPARALOOKS TEXTOBJ]
(* So create a single
piece to describe its
contents)
)
[(LISTP PCCOUNT) (* This is an
obsolete version of the
TEdit file format.)
(SELECTQ (CAR PCCOUNT)
(0 (* VERSION 0)
(SETQ PCTB (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT)
START END)))
(1 (* Version 1;
obsoleted at INTERMEZZO
release 2/85)
(SETQ PCTB (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT)
START END)))
(2 (* Version 2;
obsoleted 5/22/85)
(SETQ PCTB (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT)
START END)))
(SHOULDNT "File format version incompatible with this version of TEdit."))
(bind (PC ←(ELT PCTB (ADD1 \FirstPieceOffset))) while PC
do (* Run thru the
converted pieces,
noting CHARLOOKS and
PARALOOKS for the
caches.)
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
PLOOKS
of
PC)
TEXTOBJ))
(replace PPARALOOKS of PC with (\TEDIT.UNIQUIFY.PARALOOKS
(fetch PPARALOOKS of
PC)
TEXTOBJ))
(SETQ PC (fetch NEXTPIECE of PC]
(T (* This IS a
TEdit-format file, so
read in all the parts.)
(SETQ PCTB (\MAKEPCTB NIL PCCOUNT))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
(SETFILEPTR TEXT PIECEINFOCH#)
(bind (OLDPC ← NIL)
(OLDPARALOOKS ← DEFAULTPARALOOKS) for I from 1 to PCCOUNT
as PCN from \FirstPieceOffset by \EltsPerPiece
do (SETQ PC NIL) (* This loop may not
really read a piece, so
we have to distinguish
that case.)
(SETQ PCLEN (\DWIN TEXT))
(SETQ TYPECODE (\SMALLPIN TEXT)) (* What kind of piece
is it?)
[SELECTC TYPECODE
(\PieceDescriptorPAGEFRAME
(* This is page
layout info for the
file)
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ
with (TEDIT.GET.PAGEFRAMES TEXT)))
(add PCN (IMINUS \EltsPerPiece)) (* This didn't create
a piece -- don't count
it in the PCTB
placement.)
)
(\PieceDescriptorCHARLOOKSLIST
(* This is the list
of CHARLOOKSs used in
this document.)
(replace TXTCHARLOOKSLIST of TEXTOBJ
with (\TEDIT.GET.CHARLOOKS.LIST TEXT TEXTOBJ))
(* Read the list of
looks used in this
document.)
[SETQ LOOKSHASH (ARRAY (FLENGTH (fetch TXTCHARLOOKSLIST
of TEXTOBJ]
(* Build an array of
the looks, so the
reader can index them.)
(for I from 1 as LOOKS
in (fetch TXTCHARLOOKSLIST of TEXTOBJ)
do (SETA LOOKSHASH I LOOKS))
(add PCN (IMINUS \EltsPerPiece)) (* This didn't create
a piece -- don't count
it in the PCTB
placement.)
(add I -1))
(\PieceDescriptorPARALOOKSLIST
(* This is the list
of PARALOOKSs used in
this document.)
(replace TXTPARALOOKSLIST of TEXTOBJ
with (\TEDIT.GET.PARALOOKS.LIST TEXT TEXTOBJ))
(* Read the list of
looks used in this
document.)
[SETQ PARAHASH (ARRAY (FLENGTH (fetch TXTPARALOOKSLIST
of TEXTOBJ]
(* Build an array of
the looks, so the
reader can index them.)
(for I from 1 as LOOKS
in (fetch TXTPARALOOKSLIST of TEXTOBJ)
do (SETA PARAHASH I LOOKS))
(add PCN (IMINUS \EltsPerPiece)) (* This didn't create
a piece -- don't count
it in the PCTB
placement.)
(add I -1))
(\PieceDescriptorPARA
(* Reading a new set
of paragraph looks.)
(AND OLDPC (replace PPARALAST of OLDPC with T))
(* Mark the end of
the preceding
paragraph.)
(SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH))
(* Get the new set of
looks, for use by later
pieces.)
(AND TEXTOBJ (replace FORMATTEDP of TEXTOBJ with T))
(* Mark the document
as containing paragraph
formatting info)
(add PCN (IMINUS \EltsPerPiece)) (* This didn't create
a piece -- don't count
it in the PCTB
placement.)
)
(\PieceDescriptorLOOKS
(* New character
looks. Build a piece to
describe those
characters.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS)) (* Build the new
piece)
(\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC)
(* Read the character
looks for this guy.)
(COND
(OLDPC (* If there's a prior
piece, hook this one on
the chain.)
(replace NEXTPIECE of OLDPC with PC)))
(add CURFILECH# PCLEN) (* And note the
passing of characters.)
)
(\PieceDescriptorOBJECT
(* It describes an
object. Read that, and
perhaps some
description of the
charlooks to go with
it.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS))
(COND
(OLDPC (* If there's a prior
piece, hook this one on
the chain.)
(replace NEXTPIECE of OLDPC with PC)))
(TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (fetch PLEN of PC))
[COND
((NOT (ZEROP (\BIN TEXT))) (* There are new
character looks for
this object. Read them
in.)
(replace PLOOKS of PC with (
\TEDIT.GET.SINGLE.CHARLOOKS
TEXT)))
(T (* No new looks;
steal them from the
prior piece.)
(replace PLOOKS of PC
with (OR (AND OLDPC (fetch PLOOKS of OLDPC))
DEFAULTLOOKS]
(replace PLEN of PC with 1) (* OBJECTs are
officially one
character long.)
)
(PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped."
T)
(SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT)
(\SMALLPIN TEXT]
(COND
(PC (* If we created a
piece, save it in the
table.)
(\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
PC)
(add CURCH# (fetch PLEN of PC))
(SETQ OLDPC PC))) finally (\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
(QUOTE LASTPIECE))
(\EDITSETA PCTB \PCTBLastPieceOffset
(ADD1 PCN))
(\EDITSETA PCTB \PCTBFreePieces 0]
(AND (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (fetch DEFAULTCHARLOOKS of TEXTOBJ)
TEXTOBJ)) (* And make sure that
the default and caret
looks are reflected in
that list.)
(AND (fetch CARETLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ))
(AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ))
(* And the default
looks we used in this
function...)
(\TEDIT.UNIQUIFY.PARALOOKS (fetch FMTSPEC of TEXTOBJ)
TEXTOBJ) (* And make sure the
default paralooks are
reflected in that list.)
[bind (CHARLOOKSLIST ←(fetch TXTCHARLOOKSLIST of TEXTOBJ))
(PARALOOKSLIST ←(fetch TXTPARALOOKSLIST of TEXTOBJ))
for (PC ←(ELT PCTB (ADD1 \FirstPieceOffset))) by (fetch NEXTPIECE
of PC) while PC
do (* Look at every
piece, and assure that
its CHARLOOKS and
PARALOOKS are in the
cache.)
[COND
((FMEMB (fetch PLOOKS of PC)
CHARLOOKSLIST) (* This piece's
CHARLOOKS are known in
the cache already.
Don't bother doing
anything else.)
)
(T (* Nope; add these
looks to the cache)
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS
(fetch PLOOKS of PC)
TEXTOBJ]
(COND
((FMEMB (fetch PPARALOOKS of PC)
PARALOOKSLIST) (* This piece's
PARALOOKS are known in
the cache already.
Don't bother doing
anything else.)
)
(T (* Nope; add these
looks to the cache)
(replace PPARALOOKS of PC with (\TEDIT.UNIQUIFY.PARALOOKS
(fetch PPARALOOKS
of PC)
TEXTOBJ]
(RETURN PCTB])
(\TEDIT.CONVERT.FOREIGN.FORMAT
[LAMBDA (CONVERSIONFN FILE PREDICATERESULT TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)
(* jds "29-Oct-84 12:46")
(* Perform the conversion from a foreign file format
into TEdit-internal form as an open TextStream.)
(PROG (TSTREAM TTEXTOBJ SEL WORKINGSTREAM) (* See if there are Bravo headers)
(SETQ WORKINGSTREAM (OPENTEXTSTREAM ""))
(RESETLST (RESETSAVE (\TEDIT.SET.WINDOW (CONS (TEXTOBJ WORKINGSTREAM)
NIL)))
(SETQ TSTREAM (APPLY* CONVERSIONFN FILE PREDICATERESULT WORKINGSTREAM)))
(COND
(TEXTOBJ (* If we're filling in an existing TEXTOBJ, there are
fields that need to be copied.)
[OR (fetch TXTPAGEFRAMES of TEXTOBJ)
(replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (fetch TXTPAGEFRAMES
of (TEXTOBJ TSTREAM]
(* Such as the page formatting, which the converter may
well set.)
))
(RETURN (fetch PCTB of (TEXTOBJ TSTREAM])
(TEDIT.FORMATTEDFILEP
[LAMBDA (STREAM) (* jds "24-Apr-85 18:14")
(* Test to see if this stream's text would need a
TEdit-format file (T) or is just plain text
(NIL))
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
(FONTFILE 0)
OLDPARALOOKS PC OLDLOOKS PREVPC TENTATIVE)
(SETQ OLDPARALOOKS (fetch FMTSPEC of TEXTOBJ))
(SETQ TENTATIVE (TEXTPROP TEXTOBJ (QUOTE TEDIT.TENTATIVE)))
(* If edits are to be shown)
(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ)
(ADD1 \FirstPieceOffset))) (* First piece in the document)
(SETQ OLDLOOKS (OR (fetch DEFAULTCHARLOOKS of TEXTOBJ)
TEDIT.DEFAULT.CHARLOOKS))
(while PC
do [COND
((fetch POBJ of PC) (* OBJECTS require the special format)
(SETQ FONTFILE 4))
([AND (OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* We just hit a paragraph break.)
(SETQ FONTFILE (IMAX FONTFILE 3)))
([OR (NOT (EQCLOOKS OLDLOOKS (fetch PLOOKS of PC)))
(AND TENTATIVE (OR (AND PREVPC (NEQ (fetch PNEW of PREVPC)
(fetch PNEW of PC)))
(AND (NOT PREVPC)
(fetch PNEW of PC))
(AND PREVPC (NEQ (fetch PFATP of PREVPC)
(fetch PFATP of PC]
(* Change in font, size, etc.)
(SETQ FONTFILE (IMAX FONTFILE 2)))
((fetch PFATP of PC) (* NS Chars in the piece.)
(SETQ FONTFILE (IMAX FONTFILE 1]
(SETQ PREVPC PC)
(SETQ PC (fetch NEXTPIECE of PC)))
(RETURN (SELECTQ FONTFILE
(0 NIL)
(1 (QUOTE NSCHARS))
(2 (QUOTE CHARLOOKS))
(3 (QUOTE PARALOOKS))
(4 (QUOTE IMAGEOBJ))
NIL])
(TEDIT.GET
[LAMBDA (TEXTOBJ FILE UNFORMATTED?) (* jds "23-Sep-86 22:41")
(* Get a new file (overwriting the one
being edited.))
(PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
OFILE OCURSOR LINES USER.CMFILE RESP TITLE FILENAME MENUSTREAM (GETFN (TEXTPROP
TEXTOBJ
(QUOTE GETFN)))
(SEL (fetch SEL of TEXTOBJ))
(PCTB (fetch PCTB of TEXTOBJ))
(TEDIT.GET.FINISHEDFORMS NIL))
(COND
([AND (fetch \DIRTY of TEXTOBJ)
(PROGN (AND (fetch PROMPTWINDOW of TEXTOBJ)
(FRESHLINE (fetch PROMPTWINDOW of TEXTOBJ)))
(NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T
(fetch PROMPTWINDOW of TEXTOBJ]
(* Only do the GET if he knows he'll
zorch himself.)
(RETURN)))
[SETQ OFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to GET: "
(OR (TEXTPROP TEXTOBJ (QUOTE
LASTGETFILENAME
))
(\TEXTSTREAM.FILENAME TEXTOBJ]
(TEXTPROP TEXTOBJ (QUOTE LASTGETFILENAME)
OFILE)
(COND
[(AND OFILE (OR (OPENP FILE)
(INFILEP OFILE))) (* Only if there's a file to load and
the file exists.)
(COND
((AND GETFN (EQ (APPLY* GETFN (fetch STREAMHINT of TEXTOBJ)
(FULLNAME OFILE)
(QUOTE BEFORE))
(QUOTE DON'T))) (* He doesn't want this document put.
Bail out.)
(RETURN)))
(TEXTPROP TEXTOBJ (QUOTE LASTGETFILENAME)
NIL)
[RESETLST (RESETSAVE (TTYDISPLAYSTREAM (OR (fetch PROMPTWINDOW of TEXTOBJ)
PROMPTWINDOW)))
(RESETSAVE (CURSOR WAITINGCURSOR))
(\SHOWSEL (fetch SEL of TEXTOBJ)
NIL NIL)
(\TEXTCLOSEF (fetch STREAMHINT of TEXTOBJ))
(* CLOSE the old files)
[OR (AND (STREAMP FILE)
(OPENP FILE))
(SETQ OFILE (OPENSTREAM OFILE (QUOTE INPUT]
(* And open the new one.)
(SETQ PCTB (replace PCTB of TEXTOBJ with (TEDIT.BUILD.PCTB OFILE TEXTOBJ NIL NIL
(fetch DEFAULTCHARLOOKS
of TEXTOBJ)
(fetch FMTSPEC of TEXTOBJ)
UNFORMATTED?)))
(for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))
(* Do any necessary cleanup for
outside packages)
(SETQ LINES (fetch LINES of TEXTOBJ))
(replace \DIRTY of TEXTOBJ with NIL)
(for FIRSTLINE inside LINES do (replace NEXTLINE of FIRSTLINE with NIL))
(replace \INSERTPCVALID of TEXTOBJ with NIL)
(* The old cached piece is no longer valid--keep people from stepping on it, to
prevent lost type-in and smashing other docuemnts to which it has been moved...)
[replace TEXTLEN of TEXTOBJ with (SUB1 (\EDITELT PCTB (SUB1 (\EDITELT PCTB
\PCTBLastPieceOffset
]
(replace CH# of SEL with (replace CHLIM of SEL with 1))
(replace DCH of SEL with 0)
(replace POINT of SEL with (QUOTE LEFT))
(replace SET of SEL with T)
(replace SET of (fetch SCRATCHSEL of TEXTOBJ) with NIL)
(replace SET of (fetch SHIFTEDSEL of TEXTOBJ) with NIL)
(replace SET of (fetch MOVESEL of TEXTOBJ) with NIL)
(replace SET of TEDIT.SELECTION with NIL)
(replace SET of TEDIT.SHIFTEDSELECTION with NIL)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
(for WINDOW inside (fetch \WINDOW of TEXTOBJ) as LINE inside LINES
do (* Fill the edit window
(s) with the new text)
(\FILLWINDOW (fetch YBOT of LINE)
LINE TEXTOBJ NIL WINDOW))
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T)
(SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* find and set the title)
(\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL))
(SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ))
(COND
((AND MENUSTREAM (type? LITATOM TITLE))
(* if we have a filename then put it
in the GET and PUT fields of the menu)
(SETQ FILENAME (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
TITLE))
(MBUTTON.SET.FIELD MENUSTREAM (QUOTE Get)
FILENAME)
(MBUTTON.SET.FIELD MENUSTREAM (QUOTE Put)
FILENAME)))
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ))
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ← (QUOTE Get]
(AND GETFN (APPLY* GETFN (fetch STREAMHINT of TEXTOBJ)
(FULLNAME (fetch TXTFILE of TEXTOBJ))
(QUOTE AFTER]
(OFILE (TEDIT.PROMPTPRINT TEXTOBJ "[File not found.]")
(TEXTPROP TEXTOBJ (QUOTE LASTGETFILENAME)
OFILE) (* Remember the file name he tried
for, so we offer it next time.)
)
(T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T])
(TEDIT.INCLUDE
[LAMBDA (STREAM FILE START END) (* jds " 3-Oct-85 14:26")
(* Obtain a file name, and include that file's contents
at the place where the caret is.)
(* Returns T if the insertion happened, NIL if there
was no place to put it.)
(SETQ STREAM (TEXTOBJ STREAM))
(PROG ((SEL (fetch SEL of STREAM))
PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM)
(COND
((fetch SET of SEL) (* There is a place to do the include.)
[SETQ NFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM
"Name of the file to load: "]
(COND
((NOT NFILE) (* If no file was given, don't bother INCLUDEing.)
(TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T)
(RETURN))
((STREAMP NFILE))
((NOT (INFILEP NFILE)) (* Can't find the file. Put out a message.)
(TEDIT.PROMPTPRINT STREAM "[File not found.]")
(RETURN)))
(SETQ NNFILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE OUTPUT)
(QUOTE NEW))) (* Create the holding file)
[SETQ NFILE (COND
((OPENP NFILE)
(SETQ WASOPEN T)
NFILE)
(T (* Wasn't open -- need to open it for input...)
(OPENFILE NFILE (QUOTE INPUT] (* And copy the file-section into it.)
(COPYBYTES NFILE NNFILE (OR START 0)
(OR END (GETEOFPTR NFILE)))
(* Have to explicitly fill in 0 and EOFPTR, because if the file was open already, NILs would only copy from current
fileptr to EOF.)
(OR WASOPEN (CLOSEF NFILE)) (* If the file didn't come to use open, close it.)
(CLOSEF NNFILE)
(SETQ NFILE NNFILE)
(SETQ START (SETQ END NIL)) (* Then pretend nothing happened.)
(TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* Delete any text, if need be)
(SETQ TEXTLEN (fetch TEXTLEN of STREAM)) (* We need the POST-deletion text length for later, so
this must come after the b-p-d.)
(\SHOWSEL SEL NIL NIL) (* Turn off SELs before we go any further)
[SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE (QUOTE INPUT))
NIL NIL NIL
(LIST (QUOTE FONT)
(\TEDIT.GET.INSERT.CHARLOOKS
STREAM SEL)
(QUOTE PARALOOKS)
(fetch FMTSPEC of STREAM]
(* Get a textobj to describe the include source file (need NSTREAM so that if we have to convert it to formatted, we
won't have lost the textstream--and thus smash the free list.))
(COND
((AND (fetch FORMATTEDP of NFILE)
(NOT (fetch FORMATTEDP of STREAM))) (* If the includED text is formatted but this file
isn't, let's format it!)
(\TEDIT.CONVERT.TO.FORMATTED STREAM))
((AND (fetch FORMATTEDP of STREAM)
(NOT (fetch FORMATTEDP of NFILE))) (* The TARGET document is formatted, but the INCLUDEd
text isn't. Better format it before completing the
include.)
(\TEDIT.CONVERT.TO.FORMATTED NFILE)))
(SETQ PCTB (fetch PCTB of STREAM)) (* HERE, because the conversion to formatted will
lengthen the pctb)
[SETQ INSERTCH# (COND
((EQ (fetch POINT of SEL)
(QUOTE LEFT))
(fetch CH# of SEL))
(T (fetch CHLIM of SEL] (* Find the place to make the insertion.)
(SETQ INSPC# (OR (\CHTOPCNO INSERTCH# PCTB)
(\EDITELT PCTB \PCTBLastPieceOffset)))
(* Likewise, this is affected by the
convert-to-formatted)
(SETQ INSPC (\EDITELT (fetch PCTB of STREAM)
(ADD1 INSPC#))) (* The piece to make the insertion in)
[COND
((NEQ INSPC (QUOTE LASTPIECE))
(COND
((IGREATERP INSERTCH# (\EDITELT PCTB INSPC#))
(* Must split the piece.)
(SETQ INSPC (\SPLITPIECE INSPC INSERTCH# STREAM INSPC#))
(add INSPC# \EltsPerPiece)
(SETQ PCTB (fetch PCTB of STREAM)) (* Refresh the PCTB in case it grew.)
]
(SETQ PCLST (fetch PCTB of NFILE)) (* A temporary pctb, holding the pieces which describe
the INCLUDEd text)
[SETQ LEN (SUB1 (\EDITELT PCLST (SUB1 (\EDITELT PCLST \PCTBLastPieceOffset]
(SETQ PCCOUNT (IDIFFERENCE (SUB1 (\EDITELT PCLST \PCTBLastPieceOffset))
\FirstPieceOffset))
(* Remember how many slots in the PCTB we took up
(i.e. 2 x # of pieces))
(\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\EDITELT PCLST (ADD1
\FirstPieceOffset)))
LEN INSPC INSPC# NIL)
[COND
((AND (fetch FORMATTEDP of STREAM)
(NOT (fetch FORMATTEDP of NFILE))) (* If the includED text is formatted but this file
isn't, let's format it!)
(\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN]
(\TEDIT.HISTORYADD STREAM (create TEDITHISTORYEVENT
THACTION ←(QUOTE Include)
THCH# ← INSERTCH#
THLEN ← LEN
THFIRSTPIECE ← PCLST))
(* Remember that we did this, so it can be undone.)
(replace TEXTLEN of STREAM with (IPLUS TEXTLEN LEN))
(* Inserting the pieces didn't fix up things like the
length of the document, so do it now.)
(AND (fetch \WINDOW of STREAM)
(\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN))
(* Mark any changed lines dirty.)
(replace CHLIM of SEL with (IPLUS (replace CH# of SEL with INSERTCH#)
LEN)) (* Now fix up the selection to be the included text,
point←left, character selection grain.)
(replace DCH of SEL with LEN)
(replace (SELECTION DX) of SEL with 0)
(replace POINT of SEL with (QUOTE RIGHT)) (* So that several things INCLUDED in sequence fall in
sequence.)
(replace SELKIND of SEL with (QUOTE CHAR))
(replace SELOBJ of SEL with NIL)
(COND
((fetch \WINDOW of STREAM) (* We're displaying; update the display and the
selection's line references)
(TEDIT.UPDATE.SCREEN STREAM)
(\FIXSEL SEL STREAM)
(\SHOWSEL SEL NIL T)))
(replace \DIRTY of STREAM with T) (* Mark the document changed)
(\SETUPGETCH (create EDITMARK
PC ← INSPC
PCOFF ← 0
PCNO ←(IPLUS INSPC# PCCOUNT))
STREAM) (* Set the fileptr to the end of the insertion.)
T)
(T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T])
(TEDIT.PARSE.PAGEFRAMES1
[LAMBDA (PAGELIST PARENT) (* jds " 1-Feb-85 14:55")
(* Take an external pageframe and internalize it.)
(PROG (FRAMETYPE PAGEFRAME)
(COND
((type? PAGEREGION PAGELIST)
(RETURN PAGELIST))
((NEQ (QUOTE LIST)
(SETQ FRAMETYPE (pop PAGELIST)))
[SETQ PAGEFRAME (create PAGEREGION
REGIONFILLMETHOD ← FRAMETYPE
REGIONTYPE ←(pop PAGELIST)
REGIONLOCALINFO ←(pop PAGELIST)
REGIONSPEC ←(for VAL in (OR (pop PAGELIST)
(LIST 0 0 0 0))
collect (\MICASTOPTS VAL]
(replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST)
collect (TEDIT.PARSE.PAGEFRAMES1 ALIST
PAGEFRAME)))
(RETURN PAGEFRAME))
(T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC
NIL])
(TEDIT.PUT
[LAMBDA (STREAM FILE FORCENEW UNFORMATTED? OLDFORMAT?) (* jds "15-Oct-85 15:33")
(* If the guy was editing a file, make a new updated
version; else, ask for a file name)
(* If FILE is specd, it's used;
else the user must give us one)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
(TEDIT.PUT.FINISHEDFORMS NIL)
(TEDIT.GET.FINISHEDFORMS NIL)
(OUTPUT.FILE.WRITTEN NIL)
OCURSOR OFILE FONTFILEUSED PROPS WINDOW PUTFN CACHE MENUSTREAM FILENAME TITLE CH#S PC)
[COND
(FILE (* We were given a file to use.)
(SETQ OFILE FILE))
[FORCENEW (* He insists on a new file.
(without giving us one NIL))
(SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ
"File to PUT to: "]
(T (* Get a file to put the text into)
(SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: "
(\TEXTSTREAM.FILENAME
TEXTOBJ]
(SETQ PUTFN (TEXTPROP TEXTOBJ (QUOTE PUTFN)))
(SETQ CACHE (TEXTPROP TEXTOBJ (QUOTE CACHE)))
(COND
((NOT OFILE) (* There's no file to put to;
don't bother.)
(RETURN))
((AND PUTFN (EQ (APPLY* PUTFN (fetch STREAMHINT of TEXTOBJ)
(FULLNAME OFILE)
(QUOTE BEFORE))
(QUOTE DON'T))) (* He doesn't want this document put.
Bail out.)
(RETURN)))
(RESETLST [RESETSAVE [SETQ OFILE (OPENSTREAM OFILE (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(COND
[UNFORMATTED?
(* If the user forced no formatting, respect his
wish.)
(QUOTE ((TYPE TEXT]
[(TEDIT.FORMATTEDFILEP TEXTOBJ)
(* If this file has objects, para looks, or font
changes, then we need a binary file.)
(QUOTE ((TYPE BINARY]
(T
(* Otherwise, we can get by with a text file)
(QUOTE ((TYPE TEXT]
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE]
[RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS)
(QUOTE DON'T]
(replace DESC of (fetch THISLINE of TEXTOBJ) with NIL)
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting file " (fetch FULLNAME
of OFILE)
"...")
T)
[COND
((IGREATERP (fetch TEXTLEN of TEXTOBJ)
0)
(SETQ FONTFILEUSED (COND
(OLDFORMAT? (TEDIT.PUT.PCTB2 TEXTOBJ OFILE UNFORMATTED?))
(T (TEDIT.PUT.PCTB TEXTOBJ OFILE UNFORMATTED?]
(CLOSEF OFILE) (* Close the file, to free it up.)
[COND
((NOT CACHE) (* CSLI if caching do not need to reopen the output
file anyway)
(SETQ OFILE (OPENSTREAM (fetch FULLFILENAME of OFILE)
(QUOTE INPUT]
(* changed TEMPORary for ns filing with caching.
may not work in general)
(* And re-open it for INPUT only)
(CLOSEF? (fetch TXTFILE of TEXTOBJ))
(* Close the old text file)
(replace TXTFILE of TEXTOBJ with OFILE)
(* And remember the new one for next time.)
(replace \DIRTY of TEXTOBJ with NIL)
(* We can safely QUIT now without losing anything.)
)
(SETQ CH#S (REVERSE (CDR FONTFILEUSED))) (* The true filepos's of the pieces in the output
file.)
[COND
((NOT CACHE) (* If we've cached this file, DON'T go thru and fill
in the real file's location, because the EOL
convention may well be wrong.)
(UNINTERRUPTABLY
(SETQ PC (ELT (fetch PCTB of TEXTOBJ)
(ADD1 \FirstPieceOffset)))
(while (AND PC CH#S)
do (* Run thru the pieces in the PCTB, pointing them to
the new file and their new locations.)
(COND
((fetch POBJ of PC))
(T (replace PFPOS of PC with (pop CH#S))
(replace PFILE of PC with OFILE)
(replace PSTR of PC with NIL)))
(SETQ PC (fetch NEXTPIECE of PC))))]
(TEDIT.PROMPTPRINT TEXTOBJ "done.") (* Tell him we're finished.)
(SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* find and set the title)
(\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL))
(SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ))
(COND
((AND MENUSTREAM (type? LITATOM TITLE)) (* if we have a filename then put it in the GET and
PUT fields of the menu)
(SETQ FILENAME (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
TITLE))
(MBUTTON.SET.FIELD MENUSTREAM (QUOTE Get)
FILENAME)
(MBUTTON.SET.FIELD MENUSTREAM (QUOTE Put)
FILENAME)))
(replace \INSERTPCVALID of TEXTOBJ with NIL)
(* Make sure any new insertions happen for real, and not as appends. Since all the pieces now point to the file
rather than the strings.)
(replace \INSERTPC of TEXTOBJ with NIL) (* make sure that TEDIT doesn't try to just add to the
\INSERTPC since it will now have a pfile property)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Put)
THCH# ← 0
THLEN ← 0
THFIRSTPIECE ← NIL))
(* Remember we did this.)
(AND PUTFN (APPLY* PUTFN (fetch STREAMHINT of TEXTOBJ)
(fetch FULLNAME of (fetch TXTFILE of TEXTOBJ))
(QUOTE AFTER))) (* CSLI changed to not presume ofile is the txtfile
anymore)
])
(TEDIT.PUT.PCTB
[LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* jds "17-Apr-86 13:51")
(* Put a representation of the piece
table onto OFILE, preserving font
changes and paragraph looks.
UNFORMATTED? means write no font or
formatting info.)
(PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch FMTSPEC of TEXTOBJ))
OLDCH# CURCH# PREVPC (FONTFILE NIL)
(PCCOUNT 0)
TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL)
(EDITSTENTATIVE (TEXTPROP TEXTOBJ (QUOTE TEDIT.TENTATIVE)))
(PARALOOKSSEEN NIL)
(FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ))
(CACHE (TEXTPROP TEXTOBJ (QUOTE CACHE)))
CH#S PREVFATP PARAHASH LOOKSHASH)
(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ)
(ADD1 \FirstPieceOffset))) (* First piece in the document)
(SETQ OLDLOOKS (OR (AND (type? PIECE PC)
(fetch PLOOKS of PC))
(fetch DEFAULTCHARLOOKS of TEXTOBJ)
TEDIT.DEFAULT.CHARLOOKS)) (* Starting looks)
(COND
((NEQ (fetch EOLCONVENTION of OFILE)
CR.EOLC) (* This file is on a non-CR host;
make a note to cache it)
(SETQ TRUEFILE OFILE) (* Remember where the file should wind
up.)
(SETQ OFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW))) (* And open a temp file to write it
to.)
))
[SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE]
(COND
((fetch TXTPAGEFRAMES of TEXTOBJ) (* There is layout info for this file.
Save it)
(SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
(TEDIT.PUT.PAGEFRAMES FONTFILE (fetch TXTPAGEFRAMES of TEXTOBJ))
(add PCCOUNT 1)))
(\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* Run thru the lists of char & para
looks and remove any that aren't in
use)
(COND
([AND (fetch TXTPARALOOKSLIST of TEXTOBJ)
(OR (IGREATERP (FLENGTH (fetch TXTPARALOOKSLIST of TEXTOBJ))
1)
(NOT (EQFMTSPEC (CAR (fetch TXTPARALOOKSLIST of TEXTOBJ))
TEDIT.DEFAULT.FMTSPEC] (* There are paragraph looks in this
document that don't match the default
-- save the list of them for later
retrieval.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW] (* Create the font-info file if it
doesn't exist yet)
(SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST FONTFILE (fetch TXTPARALOOKSLIST of TEXTOBJ))
)
(SETQ PARALOOKSSEEN T)))
[COND
((OR PARALOOKSSEEN FORMATTINGLEVEL)
(* There are character looks in this document that don't match the default
(or paragraph formatting, which forces looks to be saved) --
save the list for later retrieval.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE (fetch TXTCHARLOOKSLIST
of TEXTOBJ]
[while PC do (COND
([AND (NOT (ZEROP (fetch PLEN of PC)))
(OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* The last piece ended a paragraph,
so send out new para looks)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(* Create the formatting-info file, if
it didn't exist before.)
(COND
((NEQ CURCH# OLDCH#) (* There were prior characters that
hadn't been described in a piece yet.
Describe them)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC
EDITSTENTATIVE LOOKSHASH PREVFATP)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#) (* And now we've described all the
characters up to the current one.)
))
(\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH)
(SETQ PARALOOKSSEEN T) (* Remember that we've seen a foreign
paralooks, and must henceforth note
para boundaries)
(add PCCOUNT 1)))
(COND
[(fetch POBJ of PC) (* It's an object --
go use its PUTFN)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(* Create the font-info file, if need
be.)
(COND
((AND (NEQ CURCH# OLDCH#)
PREVPC) (* There were prior characters that
hadn't been described in a piece yet.
Describe them)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC
EDITSTENTATIVE LOOKSHASH PREVFATP)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#) (* And now we've described all the
characters up to the current one.)
)) (* If the prior thing was text, send
along its descriptor.)
(add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#))
(* Send out the object)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#)
(COND
([OR (NOT (EQCLOOKS OLDLOOKS (fetch PLOOKS of PC)))
(NEQ (fetch PFATP of PC)
(AND PREVPC (fetch PFATP of PREVPC)))
[AND EDITSTENTATIVE (NEQ (fetch PNEW of PC)
(AND PREVPC (fetch PNEW of PREVPC]
(AND (OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* The OBJECT has different ooks from
before)
(\BOUT FONTFILE 1)
(\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch PLOOKS of PC))
(SETQ OLDLOOKS (fetch PLOOKS of PC)))
(T (* No differences. Don't write any
charlooks, and mark that fact)
(\BOUT FONTFILE 0) (* MAKE BLOODY SURE THAT THE NEXT RUN
OF CHARACTERS GETS ITS OWN LOOKS)
]
(T (* It's not an object.)
[COND
([OR [NEQ (fetch PFATP of PC)
(SETQ PREVFATP (AND PREVPC (fetch PFATP of PREVPC]
(NOT (EQCLOOKS OLDLOOKS (fetch PLOOKS of PC)))
[AND EDITSTENTATIVE (NEQ (fetch PNEW of PC)
(AND PREVPC (fetch PNEW of PREVPC]
(AND (OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* We have a piece with new looks.)
(* The PREVFATP clause needs to come
first, so that PREVFATP gets set for
later use.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(COND
((NOT (IEQP OLDCH# CURCH#))
(* If there were looks past, and if
the run was not empty, save a piece
for its looks)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST
FONTFILE
(fetch TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC
EDITSTENTATIVE LOOKSHASH PREVFATP)
(add PCCOUNT 1)))
(SETQ OLDLOOKS (fetch PLOOKS of PC))
(SETQ OLDCH# CURCH#)
(COND
[PREVFATP (COND
((fetch PFATP of PC))
(T (* Switching from FAT to thin)
(BOUT OFILE 255)
(BOUT OFILE 0)
(add CURCH# 2]
((fetch PFATP of PC) (* Switching from thin to fat)
(BOUT OFILE 255)
(BOUT OFILE 255)
(BOUT OFILE 0)
(add CURCH# 3] (* Now dump out the non-object
contents of the piece.)
[COND
[(SETQ PFILE (fetch PFILE of PC))
(* It's on a file. Copy it.)
[OR (OPENP PFILE)
(replace PFILE of PC with (SETQ PFILE
(OPENSTREAM (fetch FULLNAME
of PFILE)
(QUOTE INPUT]
(* Make sure the file is open.)
(COPYBYTES PFILE OFILE (fetch PFPOS of PC)
(IPLUS (fetch PFPOS of PC)
(COND
((fetch PFATP of PC)
(* For fat file pieces, copy twice as
many bytes as characters.)
(UNFOLD (fetch PLEN of PC)
2))
(T (fetch PLEN of PC]
((SETQ PSTR (fetch PSTR of PC))
(* It's in a string.
Just print it.)
(COND
[(fetch PFATP of PC) (* The string is fat: Copy twice as
many bytes as chars.)
(for I from 1 to (fetch PLEN of PC) as CH instring PSTR
do (\BOUT OFILE (\CHARSET CH))
(\BOUT OFILE (\CHAR8CODE CH]
(T (* The string is thin.
Just copy it to the file.)
(for I from 1 to (fetch PLEN of PC) as CH instring PSTR
do (\BOUT OFILE CH]
[COND
((AND (NOT CACHE)
(RANDACCESSP OFILE)) (* CSLI leave the pieces and the pctb
alone and just write the file if its
cached or not randomaccess)
(push CH#S (SUB1 CURCH#]
[COND
((fetch PFATP of PC)
(add CURCH# (UNFOLD (fetch PLEN of PC)
2)))
(T (add CURCH# (fetch PLEN of PC]
(* Keep running track of where in the
file we are.)
))
(SETQ PREVPREVPC PREVPC)
(SETQ PREVPC PC)
(SETQ PC (fetch NEXTPIECE of PC))
finally (* Put out a piece describing the last
characters in the file.)
(COND
((AND FONTFILE (NEQ OLDCH# CURCH#)) (* Only if there WERE characters, and
only if there's a need for font
information)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch TXTCHARLOOKSLIST of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE
LOOKSHASH PREVPREVPC) (* Put out a description of the
characters)
(add PCCOUNT 1)))
(COND
((AND PARALOOKSSEEN (fetch PPARALAST of PREVPC))
(* The last piece contained the end of
a paragraph. Make sure it gets noted.)
(\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH)
(add PCCOUNT 1]
(for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM))
(* Do any user-specific cleanup)
(COND
(TRUEFILE (* This file needs to be converted to
the right convention)
(COND
((AND FONTFILE (NOT UNFORMATTED?)
(NOT SEPARATEFORMAT)) (* Formatted file: Copy without
converting.)
(COPYBYTES OFILE TRUEFILE 0 -1))
(T (* Go ahead and convert the
EOLCONVENTION, this is a plain-text
file)
(COPYCHARS OFILE TRUEFILE 0 -1)))
(SETQ OFILE TRUEFILE)))
[COND
((AND (OPENP OFILE)
FONTFILE) (* We need to write format info.)
(\DWOUT FONTFILE (GETFILEPTR OFILE)) (* So remember the end of the
plain-text part of the file)
(\SMALLPOUT FONTFILE PCCOUNT) (* # OF PIECES WE'' NEED TO
RECONSTRUCT THIS FILE)
(\SMALLPOUT FONTFILE 31418) (* Now the password for NEW format
files: 31416)
(COND
((AND (NOT UNFORMATTED?)
(NOT SEPARATEFORMAT)) (* Only write fmtg info at the end if
we want it there--not if we want plain
text or want it kept separate.)
(COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE))
(* Copy the font information to the
file trailer)
)
(T))
(CLOSEF FONTFILE)
(COND
((NOT SEPARATEFORMAT) (* Unless we want the formatting info
separately, delete the file)
(* (since FONTFILE is a stream, we
should not need to delete it at all)
(DELFILE FONTFILE))
]
(replace DEFAULTCHARLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
DEFAULTCHARLOOKS
of TEXTOBJ)
TEXTOBJ))
(* Re-add the default and caret
looks's to the lists, since they may
not have been really saved.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch CARETLOOKS
of TEXTOBJ)
TEXTOBJ))
(replace FMTSPEC of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch FMTSPEC of TEXTOBJ)
TEXTOBJ))
(RETURN (CONS (COND
(UNFORMATTED? NIL)
(T FONTFILE))
CH#S])
(\TEDIT.PUTRESET
[LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38")
(CONS (CAR PROC&VALUE)
(PROCESSPROP (CAR PROC&VALUE)
(QUOTE BEFOREEXIT)
(CDR PROC&VALUE])
(TEDIT.PUT.PIECE.DESCRIPTOR
[LAMBDA (FILE CH1 CHLIM LOOKS) (* jds " 1-May-84 11:58")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((FONT (fetch CLFONT of LOOKS))
STR)
(SETQ STR (CONCAT "(FONTCREATE " (KWOTE (FONTPROP FONT (QUOTE FAMILY)))
" "
(FONTPROP FONT (QUOTE SIZE))
" "
(KWOTE (FONTPROP FONT (QUOTE FACE)))
" )"))
(\DWOUT FILE (IDIFFERENCE CHLIM CH1)) (* The length of this run of looks)
(\SMALLPOUT FILE (NCHARS STR)) (* The length of the description which follows)
(PRIN1 STR FILE) (* Print the form which can EVAL to re-create the font
information)
(\BOUT FILE (LOGOR (COND
((fetch CLPROTECTED of LOOKS)
8)
(T 0))
(COND
((fetch CLINVISIBLE of LOOKS)
NIL 4)
(T 0))
(COND
((fetch CLSELHERE of LOOKS)
2)
(T 0))
(COND
((fetch CLCANCOPY of LOOKS)
1)
(T 0])
(\ARBIN
[LAMBDA (STREAM) (* jds "12-Jun-85 12:48")
(* Read an arbitrary object from a file, parse it, and
return it.)
(PROG ((LEN (\SMALLPIN STREAM))
USERSTR)
(COND
((NOT (ZEROP LEN))
(SETQ USERSTR (OPENSTRINGSTREAM (\STRINGIN STREAM LEN)
(QUOTE INPUT)))
(RETURN (PROG1 (READ USERSTR)
(CLOSEF? USERSTR])
(\ARBOUT
[LAMBDA (STREAM ITEM) (* jds "19-Jul-85 16:48")
(* Write an arbitrary MKSTRING-able thing in
length-contents form.)
(AND ITEM (SETQ ITEM (MKSTRING ITEM)))
(\SMALLPOUT STREAM (OR (AND ITEM (NCHARS ITEM))
0))
(OR (NOT ITEM)
(ZEROP (NCHARS ITEM))
(PRIN3 ITEM STREAM])
(\ATMIN
[LAMBDA (STREAM) (* jds " 3-Apr-84 10:41")
(PROG ((LEN (\SMALLPIN STREAM)))
(RETURN (COND
((ZEROP LEN)
NIL)
(T (PACK (for I from 1 to LEN collect (CHARACTER (\BIN STREAM])
(\ATMOUT
[LAMBDA (STREAM ATOM) (* jds "30-Jan-85 14:46")
(* Write an atom's characters in length-contents form.)
(\SMALLPOUT STREAM (COND
(ATOM (NCHARS ATOM))
(T 0)))
(OR (NOT ATOM)
(ZEROP (NCHARS ATOM))
(for CH inatom ATOM do (\BOUT STREAM CH])
(\DWIN
[LAMBDA (FILE) (* jds " 3-JAN-83 16:08")
(IPLUS (LLSH (\BIN FILE)
24)
(LLSH (\BIN FILE)
16)
(LLSH (\BIN FILE)
8)
(\BIN FILE])
(\DWOUT
[LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30")
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 24)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 16)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 8)))
(\BOUT FILE (LOGAND 255 NUMBER])
(\STRINGIN
[LAMBDA (STREAM SETLEN) (* jds "16-May-85 13:41")
(* Read a string in length-contents form: One word for the length, and one byte per character contained.
However, the length may be specified by the caller instead of being read from the file.)
(PROG ((LEN (OR SETLEN (\SMALLPIN STREAM)))
STR)
(SETQ STR (ALLOCSTRING LEN))
[OR (ZEROP LEN)
(for I from 1 to LEN do (RPLCHARCODE STR I (\BIN STREAM]
(RETURN STR])
(\STRINGOUT
[LAMBDA (STREAM STRING LEN) (* jds " 1-May-84 11:58")
(* Write a string on a file in length-contents form;
one word for the length, and one byte per character
contained.)
(SETQ LEN (OR LEN (NCHARS STRING)))
(\SMALLPOUT STREAM LEN)
(OR (ZEROP LEN)
(for CH instring STRING as I from 1 to LEN do (\BOUT STREAM CH])
(\TEDIT.FORMATTEDP1
[LAMBDA (FILE LEN) (* jds " 3-Jun-85 09:27")
(* Checks for a version-1 formatted file)
(* Returns NIL if it isn't a formatted file, or the # of pieces needed if it is; leaves file at start of text or of
piece descriptions, resp.)
(SETQ LEN (OR LEN (GETEOFPTR FILE)))
(PROG (DESCPTR NPIECES PASSWORD)
(COND
((ILEQ LEN 8) (* Too short to be formatted.)
(RETURN NIL))
(T (SETFILEPTR FILE (IDIFFERENCE LEN 8)) (* Move to start of FILEPTR to descriptions)
(SETQ DESCPTR (\DWIN FILE)) (* Read the file pos of the descriptions)
(SETQ NPIECES (\SMALLPIN FILE))
(SETQ PASSWORD (\SMALLPIN FILE))
(COND
((IEQP PASSWORD 31418) (* Version 3 TEdit format; instituted on 5/22/85)
(SETFILEPTR FILE DESCPTR)
(RETURN NPIECES))
((IEQP PASSWORD 31417) (* Version 2 format. Obsoleted 5/22/85 to permit
revision of looks in the future without loss of
compatibility)
(SETFILEPTR FILE DESCPTR)
(RETURN (CONS 2 NPIECES)))
((IEQP PASSWORD 31416) (* VERSION 1 TEDIT FORMAT)
(SETFILEPTR FILE DESCPTR)
(RETURN (CONS 1 NPIECES)))
((IEQP PASSWORD 31415) (* VERSION 0 TEDIT FORMAT)
(SETFILEPTR FILE DESCPTR)
(RETURN (CONS 0 NPIECES)))
(T (* NOT A FORMATTED FILE)
(SETFILEPTR FILE 0)
(RETURN NIL])
(\TEDIT.SET.WINDOW
[LAMBDA (TOWIND) (* jds "29-Oct-84 12:21")
(* USED IN RESETSAVES TO NULL OUT A TEXTSTREAM'S WINDOW
BRIEFLY.)
(PROG1 (CONS (CAR TOWIND)
(fetch \WINDOW of (CAR TOWIND)))
(replace \WINDOW of (CAR TOWIND) with (CDR TOWIND])
(TEDIT.RAW.INCLUDE
[LAMBDA (STREAM INFILE START END) (* jds " 8-Apr-86 08:56")
(* takes a text stream and an OPEN
stream to include. Note: Start and End
are inclusive ptrs, unlike in
copybytes and friends)
(* no interpretation
(alternate file type e.g.
Bravo) takes place. Simply include the
characters)
(* Default character and paragraph
looks are applied)
(* (* Returns T if the insertion
happened, NIL if there was no place to
put it.) WHAT DOES THAT MEAN? GBN)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
(START START)
(END END)
SEL PCTB TEXTLEN HOLDING.FILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN)
(SETQ SEL (fetch SEL of TEXTOBJ))
(COND
((NOT (fetch SET of SEL))
(SHOULDNT "\TEDIT.INCLUDE.SPAN called with no selection set"))
(T (* There is a place to do the include.)
(\SHOWSEL SEL NIL NIL) (* Turn any pre-existing selection off)
(COND
(END (* This is the copy-part-of-a-file
case, with file liable to be volatile.
Copy it to core for protection)
(SETQ HOLDING.FILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE OUTPUT)
(QUOTE NEW)))
(* Create the holding file)
[SETQ INFILE (COND
((OPENP INFILE)
(SETQ WASOPEN T)
INFILE)
(T (OPENFILE INFILE (QUOTE INPUT]
(* And copy the file-section into it.)
(COPYBYTES INFILE HOLDING.FILE START END)
(* must be copychars to respect eol
conventions)
(COND
((NOT WASOPEN)
(CLOSEF INFILE)))
(CLOSEF HOLDING.FILE)
(SETQ INFILE HOLDING.FILE)
(SETQ START (SETQ END NIL)) (* Then pretend nothing happened.)
))
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ INSERTCH# (TEDIT.GETPOINT NIL SEL)) (* Find the place to make the
insertion.)
(SETQ INSPC# (OR (\CHTOPCNO INSERTCH# PCTB)
(\EDITELT PCTB \PCTBLastPieceOffset)))
(SETQ INSPC (\EDITELT (fetch PCTB of TEXTOBJ)
(ADD1 INSPC#))) (* The piece to make the insertion in)
[COND
((NEQ INSPC (QUOTE LASTPIECE))
(COND
((IGREATERP INSERTCH# (\EDITELT PCTB INSPC#))
(* Must split the piece.)
(SETQ INSPC (\SPLITPIECE INSPC INSERTCH# TEXTOBJ INSPC#))
(add INSPC# \EltsPerPiece)
(SETQ PCTB (fetch PCTB of TEXTOBJ)) (* Refresh the PCTB in case it grew.)
]
(SETQ PCLST (create PIECE
PFILE ← INFILE
PFPOS ←(COND
(START START)
(T 0))
PLEN ←(IDIFFERENCE [COND
(END END)
(T (* get the eof pointer)
(COND
((OPENP INFILE)
(GETEOFPTR INFILE))
(T (OPENSTREAM INFILE (QUOTE INPUT))
(PROG1 (GETEOFPTR INFILE)
(CLOSEF INFILE]
(COND
(START START)
(T 0)))
PREVPIECE ← NIL
NEXTPIECE ← NIL
PLOOKS ←(\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT
DEFAULTFONT)
TEXTOBJ)
PPARALAST ← NIL
PPARALOOKS ←(create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)))
(SETQ LEN (fetch PLEN of PCLST))
(\TEDIT.INSERT.PIECES TEXTOBJ INSERTCH# PCLST LEN INSPC INSPC# NIL)
(replace TEXTLEN of TEXTOBJ with (IPLUS TEXTLEN LEN))
(AND (fetch \WINDOW of TEXTOBJ)
(\FIXILINES TEXTOBJ SEL INSERTCH# LEN TEXTLEN))
(replace CHLIM of SEL with (IPLUS (replace CH# of SEL with INSERTCH#)
LEN)) (* Now fix up the selection to be the
included text, point←left, character
selection grain.)
(replace DCH of SEL with LEN)
(replace (SELECTION DX) of SEL with 0)
(replace POINT of SEL with (QUOTE RIGHT)) (* So that several things INCLUDED in
sequence fall in sequence.)
(replace SELKIND of SEL with (QUOTE CHAR))
(replace SELOBJ of SEL with NIL)
(COND
((fetch \WINDOW of TEXTOBJ)
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T)))
(replace \DIRTY of TEXTOBJ with T) (* Mark the document changed)
(\SETUPGETCH (create EDITMARK
PC ← INSPC
PCOFF ← 0
PCNO ←(IPLUS INSPC# \EltsPerPiece))
TEXTOBJ) (* Set the fileptr to the end of the
insertion.)
T])
)
(DEFINEQ
(\TEDIT.GET.CHARLOOKS.LIST
[LAMBDA (FILE) (* jds "28-Jan-85 17:50")
(* Read the list of CHARLOOKSs from the file.)
(for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE])
(\TEDIT.GET.SINGLE.CHARLOOKS
[LAMBDA (FILE) (* jds "22-May-85 14:16")
(* Read a set of CHARLOOKS from FILE)
(PROG* ((LOOKS (create CHARLOOKS))
(FILEPOS (GETFILEPTR FILE))
(LOOKSLEN (\SMALLPIN FILE))
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
(SETQ NAME (\ARBIN FILE)) (* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(replace CLSTYLE of LOOKS with (OR (\ARBIN FILE)
0))
(replace CLUSERINFO of LOOKS with (\ARBIN FILE))
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
[replace CLFONT of LOOKS with (COND
((LISTP NAME) (* This was a font class. Restore it.)
(FONTCLASS (pop NAME)
NAME))
((AND NAME (NOT (ZEROP SIZE)))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC]
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
(RETURN LOOKS])
(\TEDIT.PUT.PARALOOKS.LIST
[LAMBDA (FILE LOOKSLIST) (* jds " 8-Feb-85 10:42")
(* Write the list of FMTSPECs into the font file.)
(PROG ((LOOKSHASH (HASHARRAY 50)))
(\DWOUT FILE 0)
(\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST)
(\SMALLPOUT FILE (FLENGTH LOOKSLIST))
(for I from 1 as LOOKS in LOOKSLIST
do (\TEDIT.PUT.SINGLE.PARALOOKS FILE LOOKS) (* Write out the description)
(PUTHASH LOOKS I LOOKSHASH) (* And save it in the hash table so people can find its
index.))
(RETURN LOOKSHASH])
(\TEDIT.PUT.SINGLE.CHARLOOKS
[LAMBDA (FILE LOOKS) (* jds "22-May-85 14:14")
(* Put out a single CHARLOOKS description.)
(PROG ((FILEPOS (GETFILEPTR FILE))
(FONT (fetch CLFONT of LOOKS))
STR LEN)
(\SMALLPOUT FILE 0) (* Reserve space for the length of this looks)
[COND
((type? FONTCLASS FONT) (* For font classes, we need to save a list of
device-FD sets)
(\ARBOUT FILE (FONTCLASSUNPARSE FONT)))
(T (* For FONTDESCRIPTORs, do it the easy way)
(\ATMOUT FILE (FONTPROP FONT (QUOTE FAMILY] (* The font family)
(\SMALLPOUT FILE (OR (FONTPROP FONT (QUOTE SIZE))
0)) (* Size of the type, in points)
(\SMALLPOUT FILE (OR (fetch CLOFFSET of LOOKS)
0)) (* Super/subscripting distance)
(COND
([AND (fetch CLSTYLE of LOOKS)
(NOT (ZEROP (fetch CLSTYLE of LOOKS]
(\ARBOUT FILE (fetch CLSTYLE of LOOKS)))
(T (\SMALLPOUT FILE 0)))
(COND
((fetch CLUSERINFO of LOOKS)
(\ARBOUT FILE (fetch CLUSERINFO of LOOKS)))
(T (\SMALLPOUT FILE 0)))
[\SMALLPOUT FILE (LOGOR (COND
((fetch CLLEADER of LOOKS)
(* Dotted-leader; relevant only to TABs)
2048)
(T 0))
(COND
((fetch CLINVERTED of LOOKS)
(* Inverse-video)
1024)
(T 0))
(COND
((fetch CLBOLD of LOOKS)
512)
(T 0))
(COND
((fetch CLITAL of LOOKS)
256)
(T 0))
(COND
((fetch CLULINE of LOOKS)
128)
(T 0))
(COND
((fetch CLOLINE of LOOKS)
64)
(T 0))
(COND
((fetch CLSTRIKE of LOOKS)
32)
(T 0))
(COND
((fetch CLSMALLCAP of LOOKS)
16)
(T 0))
(COND
((fetch CLPROTECTED of LOOKS)
8)
(T 0))
(COND
((fetch CLINVISIBLE of LOOKS)
NIL 4)
(T 0))
(COND
((fetch CLSELHERE of LOOKS)
2)
(T 0))
(COND
((fetch CLCANCOPY of LOOKS)
1)
(T 0]
(* * Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this
comment.))
(SETQ LEN (IDIFFERENCE (GETFILEPTR FILE)
FILEPOS)) (* The length of this set of looks)
(SETFILEPTR FILE FILEPOS) (* Go write the length field)
(\SMALLPOUT FILE LEN)
(SETFILEPTR FILE -1) (* And back to the end of the file)
])
)
(DEFINEQ
(\TEDIT.GET.PARALOOKS.LIST
[LAMBDA (FILE TEXTOBJ) (* jds "13-Jun-85 11:14")
(* Read the list of CHARLOOKSs from the file.)
(for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ])
(\TEDIT.GET.SINGLE.PARALOOKS
[LAMBDA (FILE TEXTOBJ) (* jds "10-Oct-85 15:12")
(* Read a paragraph format spec from the FILE, and
return it for later use.)
(PROG ((LOOKS (create FMTSPEC))
(FILEPOS (GETFILEPTR FILE))
(LOOKSLEN (\SMALLPIN FILE))
TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC TABTYPE QUAD)
(replace 1STLEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the first line of the paragraph)
(replace LEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the rest of the paragraph)
(replace RIGHTMAR of LOOKS with (\SMALLPIN FILE))
(* Right margin for the paragraph)
(replace LEADBEFORE of LOOKS with (\SMALLPIN FILE))
(* Leading before the paragraph)
(replace LEADAFTER of LOOKS with (\SMALLPIN FILE))
(* Lead after the paragraph)
(replace LINELEAD of LOOKS with (\SMALLPIN FILE))
(* inter-line leading)
(replace TABSPEC of LOOKS with (SETQ TABSPEC (CONS NIL NIL)))
(* Will be tab specs)
(SETQ TABFLG (\BIN FILE))
(replace QUAD of LOOKS with (SELECTC (SETQ QUAD (\BIN FILE))
(1 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(3 (QUOTE CENTERED))
(4 (QUOTE JUSTIFIED))
(SHOULDNT)))
(COND
((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT
collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ (SETQ TABTYPE (\BIN
FILE))
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(4 (QUOTE DOTTEDLEFT))
(5 (QUOTE DOTTEDRIGHT))
(6 (QUOTE DOTTEDCENTERED))
(7 (QUOTE DOTTEDDECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS)))
[COND
((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph parameters to be read.)
(replace FMTSPECIALX of LOOKS with (\SMALLPIN FILE))
(* Special X location on page for this paragraph)
(replace FMTSPECIALY of LOOKS with (\SMALLPIN FILE))
(replace FMTUSERINFO of LOOKS with (\ARBIN FILE))
(replace FMTPARATYPE of LOOKS with (\ATMIN FILE))
(replace FMTPARASUBTYPE of LOOKS with (\ATMIN FILE))
(replace FMTSTYLE of LOOKS with (\ARBIN FILE))
(replace FMTCHARSTYLES of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEBEFORE of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEAFTER of LOOKS with (\ARBIN FILE))
(replace FMTHEADINGKEEP of LOOKS with (\ARBIN FILE))
(replace FMTKEEP of LOOKS with (\ARBIN FILE))
(COND
((ILESSP (GETFILEPTR FILE)
(IPLUS FILEPOS LOOKSLEN))
(replace (FMTSPEC FMTBASETOBASE) of LOOKS with (\ARBIN FILE]
[COND
((ILESSP (GETFILEPTR FILE)
(IPLUS FILEPOS LOOKSLEN)) (* There is more PARALOOKS info in this piece -- we
probably lost data.)
(TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T)
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN]
(RETURN LOOKS])
(\TEDIT.PUT.CHARLOOKS.LIST
[LAMBDA (FILE LOOKSLIST) (* jds " 5-Mar-85 15:58")
(* Write the list of CHARLOOKSs into the font file.)
(* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' position in the list we wrote on the
file. Those position numbers are then written in the individual looks descriptions, and are used to reconstruct the
piece looks when the file is read back in.)
(PROG ((LOOKSHASH (HASHARRAY 50)))
(\DWOUT FILE 0) (* No characters are described by this pseudo-piece
entry.)
(\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of CHARLOOKSs)
(\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in the list)
(for I from 1 as LOOKS in LOOKSLIST
do (* Write each charlooks, in the order they appear in
the list.)
(\TEDIT.PUT.SINGLE.CHARLOOKS FILE LOOKS) (* Write out the description)
(PUTHASH LOOKS I LOOKSHASH) (* And save it in the hash table so people can find its
index.))
(RETURN LOOKSHASH])
(\TEDIT.PUT.SINGLE.PARALOOKS
[LAMBDA (FILE LOOKS) (* jds " 7-Oct-85 16:11")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((FILEPOS (GETFILEPTR FILE))
DEFAULTTAB TABSPECS OUTPUTFORMAT LEN)
(\SMALLPOUT FILE 0) (* Reserve space for the length of this looks)
(\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS))
(* Left margin for the first line of the paragraph)
(\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS))
(* Left margin for the rest of the paragraph)
(\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS))
(* Right margin for the paragraph)
(\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS))
(* Leading before the paragraph)
(\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS))
(* Lead after the paragraph)
(\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS))
(* inter-line leading)
(SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS)))
(SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS)))
(COND
((AND (fetch (FMTSPEC TABSPEC) of LOOKS)
(OR DEFAULTTAB TABSPECS)) (* There are tab specs to save, or there is a default
tab setting to save)
(\BOUT FILE 3))
(T (* There are no tab looks. Just let him go.)
(\BOUT FILE 2)))
(\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS)
(LEFT 1)
(RIGHT 2)
((CENTER CENTERED)
3)
((JUST JUSTIFIED)
4)
(SHOULDNT)))
[COND
((OR TABSPECS DEFAULTTAB) (* There are tab specs to save.)
(COND
(DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB))
(T (\SMALLPOUT FILE 0)))
(COND
((IGREATERP (LENGTH TABSPECS)
255)
(SHOULDNT "Paragraph has more than 255 TABs set--can't be saved.")))
(\BOUT FILE (LENGTH TABSPECS))
(COND
(TABSPECS (* # of tab settings <256!)
(for TAB in TABSPECS
do (\SMALLPOUT FILE (fetch TABX of TAB))
(* And setting.)
(\BOUT FILE (SELECTQ (fetch TABKIND of TAB)
(LEFT 0)
(RIGHT 1)
(CENTERED 2)
(DECIMAL 3)
(DOTTEDLEFT 4)
(DOTTEDRIGHT 5)
(DOTTEDCENTERED 6)
(DOTTEDDECIMAL 7)
(SHOULDNT)))
(* Tab type)
]
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS)
0))
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS)
0))
(\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS))
(\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS))
(\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTHEADINGKEEP) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTKEEP) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTBASETOBASE) of LOOKS))
(* * Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this
comment.))
(SETQ LEN (IDIFFERENCE (GETFILEPTR FILE)
FILEPOS)) (* The length of this set of looks)
(SETFILEPTR FILE FILEPOS) (* Go write the length field)
(\SMALLPOUT FILE LEN)
(SETFILEPTR FILE -1) (* And back to the end of the file)
])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.INPUT.FORMATS)
)
(RPAQ? TEDIT.INPUT.FORMATS NIL)
(* For converting old incoming format. Cutover %5/22/85 to permit looks changes in the future.)
(DEFINEQ
(TEDIT.BUILD.PCTB2
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* jds "25-Jul-85 16:37")
(* * READ OBSOLETE FORMATS OF TEDIT FILE)
(* START = 1st char of file to read from, if specified)
(* END = use this as eofptr of file.
For use in reading files within files.)
(PROG (SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE
CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK
EXISTINGFMTSPECS (CURFILECH# (OR START 0))
(CURCH# 1)
(TEXTSTREAM (AND TEXTOBJ (fetch STREAMHINT of TEXTOBJ)))
LOOKSHASH PARAHASH) (* Get the number of pieces needed
(if AN formatted file), otherwise PCCOUNT will be NIL)
[SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND
(TEXTOBJ (fetch FMTSPEC of TEXTOBJ))
(T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]
(SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)))
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ with NIL))
(* Start by assuming no page formatting)
(SETQ PCTB (\MAKEPCTB NIL PCCOUNT))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
(SETFILEPTR TEXT PIECEINFOCH#)
(bind (OLDPC ← NIL)
(OLDPARALOOKS ← DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from
\FirstPieceOffset
by \EltsPerPiece
do (SETQ PC NIL) (* This loop may not really read a piece, so we have to
distinguish that case.)
(SETQ PCLEN (\DWIN TEXT))
(SETQ TYPECODE (\SMALLPIN TEXT)) (* What kind of piece is it?)
(SELECTC TYPECODE
(\PieceDescriptorPAGEFRAME (* This is page layout info for the file)
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ
with (TEDIT.GET.PAGEFRAMES TEXT)))
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
)
(\PieceDescriptorCHARLOOKSLIST (* This is the list of CHARLOOKSs used in this
document.)
(replace TXTCHARLOOKSLIST of TEXTOBJ
with (\TEDIT.GET.CHARLOOKS.LIST2 TEXT))
(* Read the list of looks used in this document.)
[SETQ LOOKSHASH
(ARRAY (FLENGTH (fetch TXTCHARLOOKSLIST
of TEXTOBJ]
(* Build an array of the looks, so the reader can index
them.)
(for I from 1 as LOOKS
in (fetch TXTCHARLOOKSLIST of TEXTOBJ)
do (SETA LOOKSHASH I LOOKS))
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
(add I -1))
(\PieceDescriptorPARALOOKSLIST (* This is the list of PARALOOKSs used in this
document.)
(replace TXTPARALOOKSLIST of TEXTOBJ
with (\TEDIT.GET.PARALOOKS.LIST2 TEXT))
(* Read the list of looks used in this document.)
[SETQ PARAHASH
(ARRAY (FLENGTH (fetch TXTPARALOOKSLIST
of TEXTOBJ]
(* Build an array of the looks, so the reader can index
them.)
(for I from 1 as LOOKS
in (fetch TXTPARALOOKSLIST of TEXTOBJ)
do (SETA PARAHASH I LOOKS))
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
(add I -1))
(\PieceDescriptorPARA (* Reading a new set of paragraph looks.)
(AND OLDPC (replace PPARALAST of OLDPC with T))
(* Mark the end of the preceding paragraph.)
(SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)
) (* Get the new set of looks, for use by later pieces.)
(AND TEXTOBJ (replace FORMATTEDP of TEXTOBJ
with T))
(* Mark the document as containing paragraph formatting
info)
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
)
(\PieceDescriptorLOOKS (* New character looks. Build a piece to describe those
characters.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS))
(* Build the new piece)
(\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC)
(* Read the character looks for this guy.)
(COND
[OLDPC (* If there's a prior piece, hook this one on the
chain.)
(replace NEXTPIECE of OLDPC with PC)
(COND
((AND (fetch PFATP of PC)
(NOT (fetch PFATP of OLDPC)))
(* Switching from not-fat to fat.
Add 3 bytes for the 255-255-0)
(add (fetch PFPOS of PC)
3)
(add CURFILECH# -3))
((AND (fetch PFATP of OLDPC)
(NOT (fetch PFATP of PC)))
(* Switching from fat to not-fat.
Add 3 bytes for the 255-0)
(add (fetch PFPOS of PC)
2]
((fetch PFATP of PC)
(* Switching from not-fat to fat.
Add 3 bytes for the 255-255-0)
(add (fetch PFPOS of PC)
3)
(add CURFILECH# -3)))
(add CURFILECH# PCLEN)
(* And note the passing of characters.)
)
(\PieceDescriptorOBJECT (* It describes an object. Read that, and perhaps some
description of the charlooks to go with it.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS))
(COND
(OLDPC (* If there's a prior piece, hook this one on the
chain.)
(replace NEXTPIECE of OLDPC with PC)))
(TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (fetch PLEN of PC))
[COND
((NOT (ZEROP (\BIN TEXT)))
(* There are new character looks for this object.
Read them in.)
(replace PLOOKS of PC with (
\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT)))
(T (* No new looks; steal them from the prior piece.)
(replace PLOOKS of PC
with (OR (AND OLDPC (fetch PLOOKS
of OLDPC))
DEFAULTLOOKS]
(replace PLEN of PC with 1)
(* OBJECTs are officially one character long.)
)
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(COND
(PC (* If we created a piece, save it in the table.)
(\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
PC)
(add CURCH# (fetch PLEN of PC))
(SETQ OLDPC PC)))
finally (\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
(QUOTE LASTPIECE))
(\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 PCN))
(\EDITSETA PCTB \PCTBFreePieces 0))
(RETURN PCTB])
(\TEDIT.GET.CHARLOOKS.LIST2
[LAMBDA (FILE) (* jds "22-May-85 14:28")
(* Read the list of CHARLOOKSs from the file.)
(for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
(\TEDIT.GET.SINGLE.CHARLOOKS2
[LAMBDA (FILE) (* jds "22-May-85 14:18")
(* Read a set of CHARLOOKS from FILE)
(PROG* ((LOOKS (create CHARLOOKS))
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
(SETQ NAME (\ARBIN FILE)) (* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(replace CLSTYLE of LOOKS with (OR (\ARBIN FILE)
0))
(replace CLUSERINFO of LOOKS with (\ARBIN FILE))
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
[replace CLFONT of LOOKS with (COND
((LISTP NAME) (* This was a font class. Restore it.)
(FONTCLASS (pop NAME)
NAME))
((AND NAME (NOT (ZEROP SIZE)))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC]
(RETURN LOOKS])
(\TEDIT.PUT.SINGLE.PARALOOKS2
[LAMBDA (FILE LOOKS) (* jds "22-May-85 15:10")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG (DEFAULTTAB TABSPECS OUTPUTFORMAT LEN)
(\SMALLPOUT FILE (fetch 1STLEFTMAR of LOOKS)) (* Left margin for the first line of the paragraph)
(\SMALLPOUT FILE (fetch LEFTMAR of LOOKS)) (* Left margin for the rest of the paragraph)
(\SMALLPOUT FILE (fetch RIGHTMAR of LOOKS)) (* Right margin for the paragraph)
(\SMALLPOUT FILE (fetch LEADBEFORE of LOOKS)) (* Leading before the paragraph)
(\SMALLPOUT FILE (fetch LEADAFTER of LOOKS)) (* Lead after the paragraph)
(\SMALLPOUT FILE (fetch LINELEAD of LOOKS)) (* inter-line leading)
(SETQ DEFAULTTAB (CAR (fetch TABSPEC of LOOKS)))
(SETQ TABSPECS (CDR (fetch TABSPEC of LOOKS)))
(COND
((AND (fetch TABSPEC of LOOKS)
(OR DEFAULTTAB TABSPECS)) (* There are tab specs to save, or there is a default
tab setting to save)
(\BOUT FILE 3))
(T (* There are no tab looks. Just let him go.)
(\BOUT FILE 2)))
(\BOUT FILE (SELECTQ (fetch QUAD of LOOKS)
(LEFT 1)
(RIGHT 2)
((CENTER CENTERED)
3)
((JUST JUSTIFIED)
4)
(SHOULDNT)))
[COND
((OR TABSPECS DEFAULTTAB) (* There are tab specs to save.)
(COND
(DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB))
(T (\SMALLPOUT FILE 0)))
(\BOUT FILE (LENGTH TABSPECS))
(COND
(TABSPECS (* # of tab settings <256!)
(for TAB in TABSPECS
do (\SMALLPOUT FILE (fetch TABX of TAB))
(* And setting.)
(\BOUT FILE (SELECTQ (fetch TABKIND of TAB)
(LEFT 0)
(RIGHT 1)
(CENTERED 2)
(DECIMAL 3)
(SHOULDNT)))
(* Tab type)
]
(\SMALLPOUT FILE (OR (fetch FMTSPECIALX of LOOKS)
0))
(\SMALLPOUT FILE (OR (fetch FMTSPECIALY of LOOKS)
0))
(\ARBOUT FILE (fetch FMTUSERINFO of LOOKS))
(\ATMOUT FILE (fetch FMTPARATYPE of LOOKS))
(\ATMOUT FILE (fetch FMTPARASUBTYPE of LOOKS))
(\ARBOUT FILE (fetch FMTSTYLE of LOOKS))
(\ARBOUT FILE (fetch FMTCHARSTYLES of LOOKS))
(\ARBOUT FILE (fetch FMTNEWPAGEBEFORE of LOOKS))
(\ARBOUT FILE (fetch FMTNEWPAGEAFTER of LOOKS])
(\TEDIT.PUT.SINGLE.CHARLOOKS2
[LAMBDA (FILE LOOKS) (* jds "22-May-85 15:11")
(* Put out a single CHARLOOKS description.)
(PROG ((FONT (fetch CLFONT of LOOKS))
STR LEN)
[COND
((type? FONTCLASS FONT) (* For font classes, we need to save a list of
device-FD sets)
(\ARBOUT FILE (FONTCLASSUNPARSE FONT)))
(T (* For FONTDESCRIPTORs, do it the easy way)
(\ATMOUT FILE (FONTPROP FONT (QUOTE FAMILY] (* The font family)
(\SMALLPOUT FILE (OR (FONTPROP FONT (QUOTE SIZE))
0)) (* Size of the type, in points)
(\SMALLPOUT FILE (OR (fetch CLOFFSET of LOOKS)
0)) (* Super/subscripting distance)
(COND
([AND (fetch CLSTYLE of LOOKS)
(NOT (ZEROP (fetch CLSTYLE of LOOKS]
(\ARBOUT FILE (fetch CLSTYLE of LOOKS)))
(T (\SMALLPOUT FILE 0)))
(COND
((fetch CLUSERINFO of LOOKS)
(\ARBOUT FILE (fetch CLUSERINFO of LOOKS)))
(T (\SMALLPOUT FILE 0)))
(\SMALLPOUT FILE (LOGOR (COND
((fetch CLLEADER of LOOKS)
(* Dotted-leader; relevant only to TABs)
2048)
(T 0))
(COND
((fetch CLINVERTED of LOOKS)
(* Inverse-video)
1024)
(T 0))
(COND
((fetch CLBOLD of LOOKS)
512)
(T 0))
(COND
((fetch CLITAL of LOOKS)
256)
(T 0))
(COND
((fetch CLULINE of LOOKS)
128)
(T 0))
(COND
((fetch CLOLINE of LOOKS)
64)
(T 0))
(COND
((fetch CLSTRIKE of LOOKS)
32)
(T 0))
(COND
((fetch CLSMALLCAP of LOOKS)
16)
(T 0))
(COND
((fetch CLPROTECTED of LOOKS)
8)
(T 0))
(COND
((fetch CLINVISIBLE of LOOKS)
NIL 4)
(T 0))
(COND
((fetch CLSELHERE of LOOKS)
2)
(T 0))
(COND
((fetch CLCANCOPY of LOOKS)
1)
(T 0])
(\TEDIT.GET.PARALOOKS.LIST2
[LAMBDA (FILE) (* jds "22-May-85 14:28")
(* Read the list of CHARLOOKSs from the file.)
(for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
(\TEDIT.GET.SINGLE.PARALOOKS2
[LAMBDA (FILE) (* jds "17-Aug-84 13:40")
(* Read a paragraph format spec from the FILE, and
return it for later use.)
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC)
(replace 1STLEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the first line of the paragraph)
(replace LEFTMAR of LOOKS with (\SMALLPIN FILE)) (* Left margin for the rest of the paragraph)
(replace RIGHTMAR of LOOKS with (\SMALLPIN FILE))
(* Right margin for the paragraph)
(replace LEADBEFORE of LOOKS with (\SMALLPIN FILE))
(* Leading before the paragraph)
(replace LEADAFTER of LOOKS with (\SMALLPIN FILE))
(* Lead after the paragraph)
(replace LINELEAD of LOOKS with (\SMALLPIN FILE))
(* inter-line leading)
(replace TABSPEC of LOOKS with (SETQ TABSPEC (CONS NIL NIL)))
(* Will be tab specs)
(SETQ TABFLG (\BIN FILE))
(replace QUAD of LOOKS with (SELECTC (\BIN FILE)
(1 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(3 (QUOTE CENTERED))
(4 (QUOTE JUSTIFIED))
(SHOULDNT)))
(COND
((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS)))
[COND
((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph parameters to be read.)
(replace FMTSPECIALX of LOOKS with (\SMALLPIN FILE))
(* Special X location on page for this paragraph)
(replace FMTSPECIALY of LOOKS with (\SMALLPIN FILE))
(replace FMTUSERINFO of LOOKS with (\ARBIN FILE))
(replace FMTPARATYPE of LOOKS with (\ATMIN FILE))
(replace FMTPARASUBTYPE of LOOKS with (\ATMIN FILE))
(replace FMTSTYLE of LOOKS with (\ARBIN FILE))
(replace FMTCHARSTYLES of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEBEFORE of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEAFTER of LOOKS with (\ARBIN FILE]
(RETURN LOOKS])
(TEDIT.PUT.PCTB2
[LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* jds " 3-Jun-85 09:28")
(* Put a representation of the piece table onto OFILE,
preserving font changes and paragraph looks.
UNFORMATTED? means write no font or formatting info.)
(PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch FMTSPEC of TEXTOBJ))
OLDCH# CURCH# PREVPC (FONTFILE NIL)
(PCCOUNT 0)
TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL)
(EDITSTENTATIVE (TEXTPROP TEXTOBJ (QUOTE TEDIT.TENTATIVE)))
(PARALOOKSSEEN NIL)
(FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ))
(CACHE (TEXTPROP TEXTOBJ (QUOTE CACHE)))
CH#S PREVFATP)
(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ)
(ADD1 \FirstPieceOffset))) (* First piece in the document)
(SETQ OLDLOOKS (OR (AND (type? PIECE PC)
(fetch PLOOKS of PC))
(fetch DEFAULTCHARLOOKS of TEXTOBJ)
TEDIT.DEFAULT.CHARLOOKS)) (* Starting looks)
(COND
((NEQ (fetch EOLCONVENTION of OFILE)
CR.EOLC) (* This file is on a non-CR host;
make a note to cache it)
(SETQ TRUEFILE OFILE) (* Remember where the file should wind up.)
(SETQ OFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW))) (* And open a temp file to write it to.)
))
[SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE]
(COND
((fetch TXTPAGEFRAMES of TEXTOBJ) (* There is layout info for this file.
Save it)
(SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW)))
(TEDIT.PUT.PAGEFRAMES FONTFILE (fetch TXTPAGEFRAMES of TEXTOBJ))
(add PCCOUNT 1)))
(\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* Run thru the lists of char & para looks and remove
any that aren't in use)
(COND
([AND (fetch TXTPARALOOKSLIST of TEXTOBJ)
(OR (IGREATERP (FLENGTH (fetch TXTPARALOOKSLIST of TEXTOBJ))
1)
(NOT (EQFMTSPEC (CAR (fetch TXTPARALOOKSLIST of TEXTOBJ))
TEDIT.DEFAULT.FMTSPEC]
(* There are paragraph looks in this document that
don't match the default -- save the list of them for
later retrieval.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(* Create the font-info file if it doesn't exist yet)
(SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST2 FONTFILE (fetch TXTPARALOOKSLIST
of TEXTOBJ)))
(SETQ PARALOOKSSEEN T)))
[COND
((OR PARALOOKSSEEN FORMATTINGLEVEL)
(* There are character looks in this document that don't match the default (or paragraph formatting, which forces
looks to be saved) -- save the list for later retrieval.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST2 FONTFILE (fetch TXTCHARLOOKSLIST
of TEXTOBJ]
[while PC
do (COND
([AND (NOT (ZEROP (fetch PLEN of PC)))
(OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* The last piece ended a paragraph, so send out new
para looks)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(* Create the formatting-info file, if it didn't exist
before.)
(COND
((NEQ CURCH# OLDCH#) (* There were prior characters that hadn't been
described in a piece yet. Describe them)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch
TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE
LOOKSHASH PREVFATP)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#) (* And now we've described all the characters up to the
current one.)
))
(\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH)
(SETQ PARALOOKSSEEN T) (* Remember that we've seen a foreign paralooks, and
must henceforth note para boundaries)
(add PCCOUNT 1)))
(COND
[(fetch POBJ of PC) (* It's an object -- go use its PUTFN)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(* Create the font-info file, if need be.)
(COND
((AND (NEQ CURCH# OLDCH#)
PREVPC) (* There were prior characters that hadn't been
described in a piece yet. Describe them)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch
TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE
LOOKSHASH PREVFATP)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#) (* And now we've described all the characters up to the
current one.)
)) (* If the prior thing was text, send along its
descriptor.)
(add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#))
(* Send out the object)
(add PCCOUNT 1)
(SETQ OLDCH# CURCH#)
(COND
([OR (NOT (EQCLOOKS OLDLOOKS (fetch PLOOKS of PC)))
(NEQ (fetch PFATP of PC)
(AND PREVPC (fetch PFATP of PREVPC)))
[AND EDITSTENTATIVE (NEQ (fetch PNEW of PC)
(AND PREVPC (fetch PNEW of PREVPC]
(AND (OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* The OBJECT has different ooks from before)
(\BOUT FONTFILE 1)
(\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch PLOOKS of PC))
(SETQ OLDLOOKS (fetch PLOOKS of PC)))
(T (* No differences. Don't write any charlooks, and mark
that fact)
(\BOUT FONTFILE 0) (* MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS
GETS ITS OWN LOOKS)
]
(T (* It's not an object.)
[COND
([OR (NOT (EQCLOOKS OLDLOOKS (fetch PLOOKS of PC)))
(NEQ (fetch PFATP of PC)
(AND PREVPC (fetch PFATP of PREVPC)))
[AND EDITSTENTATIVE (NEQ (fetch PNEW of PC)
(AND PREVPC (fetch PNEW of PREVPC]
(AND (OR (NOT PREVPC)
(fetch PPARALAST of PREVPC))
(NOT (EQFMTSPEC (fetch PPARALOOKS of PC)
(fetch FMTSPEC of TEXTOBJ]
(* We have a piece with new looks.)
[OR FONTFILE (SETQ FONTFILE (OPENFILE (QUOTE {NODIRCORE})
(QUOTE BOTH)
(QUOTE NEW]
(COND
((NOT (IEQP OLDCH# CURCH#)) (* If there were looks past, and if the run was not
empty, save a piece for its looks)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch
TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC
EDITSTENTATIVE LOOKSHASH PREVFATP)
(add PCCOUNT 1)))
(SETQ OLDLOOKS (fetch PLOOKS of PC))
(SETQ OLDCH# CURCH#)
(COND
[PREVFATP (COND
((fetch PFATP of PC))
(T (* Switching from FAT to thin)
(BOUT OFILE 255)
(BOUT OFILE 0)
(add CURCH# 2]
((fetch PFATP of PC) (* Switching from thin to fat)
(BOUT OFILE 255)
(BOUT OFILE 255)
(BOUT OFILE 0)
(add CURCH# 3)))
(SETQ PREVFATP (fetch PFATP of PC]
(* Now dump out the non-object contents of the piece.)
[COND
[(SETQ PFILE (fetch PFILE of PC)) (* It's on a file. Copy it.)
[OR (OPENP PFILE)
(replace PFILE of PC with (SETQ PFILE (OPENSTREAM (fetch FULLNAME
of PFILE)
(QUOTE INPUT]
(* Make sure the file is open.)
(COPYBYTES PFILE OFILE (fetch PFPOS of PC)
(IPLUS (fetch PFPOS of PC)
(COND
((fetch PFATP of PC)
(* For fat file pieces, copy twice as many bytes as
characters.)
(UNFOLD (fetch PLEN of PC)
2))
(T (fetch PLEN of PC]
((SETQ PSTR (fetch PSTR of PC)) (* It's in a string. Just print it.)
(COND
[(fetch PFATP of PC) (* The string is fat: Copy twice as many bytes as
chars.)
(for I from 1 to (fetch PLEN of PC) as CH instring PSTR
do (\BOUT OFILE (\CHARSET CH))
(\BOUT OFILE (\CHAR8CODE CH]
(T (* The string is thin. Just copy it to the file.)
(for I from 1 to (fetch PLEN of PC) as CH instring PSTR
do (\BOUT OFILE CH]
[COND
((AND (NOT CACHE)
(RANDACCESSP OFILE)) (* CSLI leave the pieces and the pctb alone and just
write the file if its cached or not randomaccess)
(push CH#S (SUB1 CURCH#]
[COND
((fetch PFATP of PC)
(add CURCH# (UNFOLD (fetch PLEN of PC)
2)))
(T (add CURCH# (fetch PLEN of PC] (* Keep running track of where in the file we are.)
))
(SETQ PREVPREVPC PREVPC)
(SETQ PREVPC PC)
(SETQ PC (fetch NEXTPIECE of PC))
finally (* Put out a piece describing the last characters in
the file.)
(COND
((AND FONTFILE (NEQ OLDCH# CURCH#)) (* Only if there WERE characters, and only if there's a
need for font information)
[OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE
(fetch
TXTCHARLOOKSLIST
of TEXTOBJ]
(\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE
LOOKSHASH PREVPREVPC)
(* Put out a description of the characters)
(add PCCOUNT 1)))
(COND
((AND PARALOOKSSEEN (fetch PPARALAST of PREVPC))
(* The last piece contained the end of a paragraph.
Make sure it gets noted.)
(\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH)
(add PCCOUNT 1]
(for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM))
(* Do any user-specific cleanup)
(COND
(TRUEFILE (* This file needs to be converted to the right
convention)
(COND
((AND FONTFILE (NOT UNFORMATTED?)
(NOT SEPARATEFORMAT)) (* Formatted file: Copy without converting.)
(COPYBYTES OFILE TRUEFILE 0 -1))
(T (* Go ahead and convert the EOLCONVENTION, this is a
plain-text file)
(COPYCHARS OFILE TRUEFILE 0 -1)))
(SETQ OFILE TRUEFILE)))
[COND
((AND (OPENP OFILE)
FONTFILE) (* We need to write format info.)
(\DWOUT FONTFILE (GETEOFPTR OFILE)) (* So remember the end of the plain-text part of the
file)
(\SMALLPOUT FONTFILE PCCOUNT) (* # OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE)
(\SMALLPOUT FONTFILE 31417) (* Now the password for NEW format files: 31416)
(COND
((AND (NOT UNFORMATTED?)
(NOT SEPARATEFORMAT)) (* Only write fmtg info at the end if we want it
there--not if we want plain text or want it kept
separate.)
(COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE))
(* Copy the font information to the file trailer)
)
(T))
(CLOSEF FONTFILE)
(COND
((NOT SEPARATEFORMAT) (* Unless we want the formatting info separately,
delete the file)
(* (since FONTFILE is a stream, we should not need to
delete it at all) (DELFILE FONTFILE))
]
(replace DEFAULTCHARLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
DEFAULTCHARLOOKS
of TEXTOBJ)
TEXTOBJ))
(* Re-add the default and caret looks's to the lists,
since they may not have been really saved.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch CARETLOOKS
of TEXTOBJ)
TEXTOBJ))
(replace FMTSPEC of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch FMTSPEC of TEXTOBJ)
TEXTOBJ))
(RETURN (CONS (COND
(UNFORMATTED? NIL)
(T FONTFILE))
CH#S])
(\TEDIT.PUT.CHARLOOKS.LIST2
[LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:12")
(* Write the list of CHARLOOKSs into the font file.)
(* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' position in the list we wrote on the
file. Those position numbers are then written in the individual looks descriptions, and are used to reconstruct the
piece looks when the file is read back in.)
(PROG ((LOOKSHASH (HASHARRAY 50)))
(\DWOUT FILE 0) (* No characters are described by this pseudo-piece
entry.)
(\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of CHARLOOKSs)
(\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in the list)
(for I from 1 as LOOKS in LOOKSLIST
do (* Write each charlooks, in the order they appear in
the list.)
(\TEDIT.PUT.SINGLE.CHARLOOKS2 FILE LOOKS) (* Write out the description)
(PUTHASH LOOKS I LOOKSHASH) (* And save it in the hash table so people can find its
index.))
(RETURN LOOKSHASH])
(\TEDIT.PUT.PARALOOKS.LIST2
[LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:09")
(* Write the list of FMTSPECs into the font file.)
(PROG ((LOOKSHASH (HASHARRAY 50)))
(\DWOUT FILE 0)
(\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST)
(\SMALLPOUT FILE (FLENGTH LOOKSLIST))
(for I from 1 as LOOKS in LOOKSLIST
do (\TEDIT.PUT.SINGLE.PARALOOKS2 FILE LOOKS) (* Write out the description)
(PUTHASH LOOKS I LOOKSHASH) (* And save it in the hash table so people can find its
index.))
(RETURN LOOKSHASH])
)
(* For converting incoming old-format files (%1/27/85 cutover))
(DEFINEQ
(TEDIT.BUILD.PCTB1
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* jds "25-Jul-85 16:38")
(* * READ OBSOLETE FORMATS OF TEDIT FILE)
(* START = 1st char of file to read from, if specified)
(* END = use this as eofptr of file.
For use in reading files within files.)
(PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE
CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK
EXISTINGFMTSPECS (CURFILECH# (OR START 0))
(CURCH# 1)
(TEXTSTREAM (AND TEXTOBJ (fetch STREAMHINT of TEXTOBJ]
(* Get the number of pieces needed
(if AN formatted file), otherwise PCCOUNT will be NIL)
[SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND
(TEXTOBJ (fetch FMTSPEC of TEXTOBJ))
(T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]
(SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)))
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ with NIL))
(* Start by assuming no page formatting)
(SETQ PCTB (\MAKEPCTB NIL PCCOUNT))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
(SETFILEPTR TEXT PIECEINFOCH#)
(bind (OLDPC ← NIL)
(OLDPARALOOKS ← DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from
\FirstPieceOffset
by \EltsPerPiece
do (SETQ PC NIL) (* This loop may not really read a piece, so we have to
distinguish that case.)
(SETQ PCLEN (\DWIN TEXT))
(SETQ TYPECODE (\SMALLPIN TEXT)) (* What kind of piece is it?)
(SELECTC TYPECODE
(\PieceDescriptorPAGEFRAME (* This is page layout info for the file)
(AND TEXTOBJ (replace TXTPAGEFRAMES of TEXTOBJ
with (TEDIT.GET.PAGEFRAMES1
TEXT)))
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
)
(\PieceDescriptorPARA (* Reading a new set of paragraph looks.)
(AND OLDPC (replace PPARALAST of OLDPC with T))
(* Mark the end of the preceding paragraph.)
(SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS1 TEXT))
(* Get the new set of looks, for use by later pieces.)
(AND TEXTOBJ (replace FORMATTEDP of TEXTOBJ
with T))
(* Mark the document as containing paragraph formatting
info)
(add PCN (IMINUS \EltsPerPiece))
(* This didn't create a piece -- don't count it in the
PCTB placement.)
)
(\PieceDescriptorLOOKS (* New character looks. Build a piece to describe those
characters.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS))
(* Build the new piece)
(COND
(OLDPC (* If there's a prior piece, hook this one on the
chain.)
(replace NEXTPIECE of OLDPC with PC)))
(\TEDIT.GET.CHARLOOKS1 PC TEXT)
(* Read the character looks for this guy.)
(add CURFILECH# (fetch PLEN of PC))
(* And note the passing of characters.)
)
(\PieceDescriptorOBJECT (* It describes an object. Read that, and perhaps some
description of the charlooks to go with it.)
(SETQ PC
(create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ← PCLEN
PREVPIECE ← OLDPC
PPARALOOKS ← OLDPARALOOKS))
(COND
(OLDPC (* If there's a prior piece, hook this one on the
chain.)
(replace NEXTPIECE of OLDPC with PC)))
(TEDIT.GET.OBJECT1 TEXTSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (fetch PLEN of PC))
[COND
((NOT (ZEROP (\BIN TEXT)))
(* There are new character looks for this object.
Read them in.)
(\DWIN TEXT)
(\WIN TEXT)
(* Skip over the piece-type code we know has to be
here.)
(\TEDIT.GET.CHARLOOKS1 PC TEXT))
(T (* No new looks; steal them from the prior piece.)
(replace PLOOKS of PC
with (OR (AND OLDPC (fetch PLOOKS
of OLDPC))
DEFAULTLOOKS]
(replace PLEN of PC with 1)
(* OBJECTs are officially one character long.)
)
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(COND
(PC (* If we created a piece, save it in the table.)
[COND
((SETQ EXLOOK (for LOOK in EXISTINGCHARLOOKS
thereis (EQCLOOKS (fetch PLOOKS of PC)
LOOK)))
(* These charlooks are a duplicate of pre-existing
ones. Re-use the old one.)
(replace PLOOKS of PC with EXLOOK))
(T (push EXISTINGCHARLOOKS (fetch PLOOKS of PC]
[COND
((SETQ EXLOOK (for LOOK in EXISTINGFMTSPECS
thereis (EQFMTSPEC (fetch PPARALOOKS of PC)
LOOK)))
(* These paralooks are a duplicate of pre-existing
ones. Re-use the old one.)
(replace PPARALOOKS of PC with EXLOOK))
(T (push EXISTINGFMTSPECS (fetch PPARALOOKS of PC]
(\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
PC)
(add CURCH# (fetch PLEN of PC))
(SETQ OLDPC PC)))
finally (\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
(QUOTE LASTPIECE))
(\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 PCN))
(\EDITSETA PCTB \PCTBFreePieces 0))
(RETURN PCTB])
(TEDIT.GET.PAGEFRAMES1
[LAMBDA (FILE) (* jds " 1-Feb-85 14:55")
(* Read a bunch of page frames from the file, and
return it.)
(TEDIT.PARSE.PAGEFRAMES1 (READ FILE])
(\TEDIT.GET.CHARLOOKS1
[LAMBDA (PC FILE) (* jds " 1-Feb-85 15:26")
(* Read a description of PC's CHARLOOKS from FILE.)
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(replace PLOOKS of PC with LOOKS)
(SETQ NAME (\ARBIN FILE)) (* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance)
(OR (ZEROP SUB)
(SETQ SUPER (IMINUS SUB))) (* If this is an old file, it'll have a subscript value
not zero. Let those past and do the right thing.)
(COND
((NOT (ZEROP (\BIN FILE))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
[COND
((NOT (ZEROP (\BIN FILE))) (* There is style or user information to be read)
(replace CLSTYLE of LOOKS with (OR (\ARBIN FILE)
0))
(replace CLUSERINFO of LOOKS with (\ARBIN FILE]
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
(replace CLFONT of LOOKS with (COND
((LISTP NAME) (* This was a font class. Restore it.)
(FONTCLASS (pop NAME)
NAME))
((AND NAME (NOT (ZEROP SIZE)))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC])
(\TEDIT.GET.PARALOOKS1
[LAMBDA (FILE) (* jds "17-Aug-84 13:40")
(* Read a paragraph format spec from the FILE, and
return it for later use.)
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC)
(replace 1STLEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the first line of the paragraph)
(replace LEFTMAR of LOOKS with (\SMALLPIN FILE)) (* Left margin for the rest of the paragraph)
(replace RIGHTMAR of LOOKS with (\SMALLPIN FILE))
(* Right margin for the paragraph)
(replace LEADBEFORE of LOOKS with (\SMALLPIN FILE))
(* Leading before the paragraph)
(replace LEADAFTER of LOOKS with (\SMALLPIN FILE))
(* Lead after the paragraph)
(replace LINELEAD of LOOKS with (\SMALLPIN FILE))
(* inter-line leading)
(replace TABSPEC of LOOKS with (SETQ TABSPEC (CONS NIL NIL)))
(* Will be tab specs)
(SETQ TABFLG (\BIN FILE))
(replace QUAD of LOOKS with (SELECTC (\BIN FILE)
(1 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(3 (QUOTE CENTERED))
(4 (QUOTE JUSTIFIED))
(SHOULDNT)))
(COND
((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS)))
[COND
((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph parameters to be read.)
(replace FMTSPECIALX of LOOKS with (\SMALLPIN FILE))
(* Special X location on page for this paragraph)
(replace FMTSPECIALY of LOOKS with (\SMALLPIN FILE))
(replace FMTUSERINFO of LOOKS with (\ARBIN FILE))
(replace FMTPARATYPE of LOOKS with (\ATMIN FILE))
(replace FMTPARASUBTYPE of LOOKS with (\ATMIN FILE))
(replace FMTSTYLE of LOOKS with (\ARBIN FILE))
(replace FMTCHARSTYLES of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEBEFORE of LOOKS with (\ARBIN FILE))
(replace FMTNEWPAGEAFTER of LOOKS with (\ARBIN FILE]
(RETURN LOOKS])
(TEDIT.GET.OBJECT1
[LAMBDA (STREAM PIECE FILE CURCH#) (* jds "22-Feb-85 14:31")
(* Get an object from the file)
(* CURCH# = fileptr within the text section of the file
where the object's text starts.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
FILEPTRSAVE NAMELEN GETFN OBJ)
(SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ)
(SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the building of the
object)
(SETFILEPTR FILE CURCH#)
(SETQ OBJ (READIMAGEOBJ FILE GETFN))
(SETFILEPTR FILE FILEPTRSAVE)
(replace POBJ of PIECE with OBJ)
(replace PFILE of PIECE with NIL)
(replace PSTR of PIECE with NIL)
[replace PLOOKS of PIECE with (COND
((fetch PREVPIECE of PIECE)
(fetch PLOOKS of (fetch PREVPIECE of PIECE)))
(T (OR (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT
DEFAULTFONT)
TEXTOBJ]
(RETURN (fetch POBJ of PIECE])
)
(* VERSION 0 Compatibility reading functions)
(DEFINEQ
(TEDIT.BUILD.PCTB0
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* jds "18-May-84 11:50")
(* * READ OBSOLETE FORMATS OF TEDIT FILE)
(PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE
TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
(CURCH# 1)
(TEXTSTREAM (AND TEXTOBJ (fetch STREAMHINT of TEXTOBJ]
(* Get the number of pieces needed
(if AN formatted file), otherwise PCCOUNT will be NIL)
[SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND
(TEXTOBJ (fetch FMTSPEC of TEXTOBJ))
(T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]
(SETQ PCTB (\MAKEPCTB NIL PCCOUNT))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
(SETFILEPTR TEXT PIECEINFOCH#)
(bind (OLDPC ← NIL) for I from 1 to PCCOUNT as PCN from \FirstPieceOffset by \EltsPerPiece
do (SETQ PC (create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ←(SETQ PCLEN (\DWIN TEXT))
PREVPIECE ← OLDPC
PPARALOOKS ← DEFAULTPARALOOKS))
[COND
(OLDPC (replace NEXTPIECE of OLDPC with PC)
(replace PPARALOOKS of PC with (fetch PPARALOOKS of OLDPC]
(SETQ TYPECODE (\SMALLPIN TEXT))
(SELECTC TYPECODE
(\PieceDescriptorLOOKS (TEDIT.GET.CHARLOOKS0 PC TEXT)
(add CURFILECH# (fetch PLEN of PC)))
(\PieceDescriptorOBJECT (TEDIT.GET.OBJECT0 TEXTSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (fetch PLEN of PC))
(replace PLEN of PC with 1)
(* Only object--can't be followed by either ot the
others.)
)
(\PieceDescriptorPARA (AND OLDPC (replace PPARALAST of OLDPC with T))
(TEDIT.GET.PARALOOKS0 PC TEXT)
(replace PLEN of PC with (\DWIN TEXT))
(* Set this piece's length from the character looks.)
(\SMALLPIN TEXT)
(* Skip the piece-type code, since we know what's next)
(TEDIT.GET.CHARLOOKS0 PC TEXT)
(* This document is "formatted".)
(add CURFILECH# (fetch PLEN of PC))
(AND TEXTOBJ (replace FORMATTEDP of TEXTOBJ
with T)))
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(SETQ OLDPC PC)
(\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
PC)
(add CURCH# (fetch PLEN of PC))
finally (\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
(QUOTE LASTPIECE))
(\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 PCN))
(\EDITSETA PCTB \PCTBFreePieces 0))
(RETURN PCTB])
(TEDIT.GET.CHARLOOKS0
[LAMBDA (PC FILE) (* jds " 3-Apr-84 10:42")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(replace PLOOKS of PC with LOOKS)
(SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which follows)
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE]
(* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance)
(OR (ZEROP SUB)
(SETQ SUPER (IMINUS SUB))) (* If this is an old file, it'll have a subscript value
not zero. Let those past and do the right thing.)
(COND
((NOT (ZEROP (\BIN FILE))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
[COND
((NOT (ZEROP (\BIN FILE))) (* There is style or user information to be read)
(SETQ STYLESTR (\STRINGIN FILE))
(SETQ USERSTR (\STRINGIN FILE))
(COND
((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info)
(replace CLSTYLE of LOOKS with (READ STYLESTR)))
(T (replace CLSTYLE of LOOKS with 0)))
(COND
((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info)
(replace CLUSERINFO of LOOKS with (READ USERSTR]
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
(replace CLFONT of LOOKS with (AND NAME (NOT (ZEROP SIZE))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC])
(TEDIT.GET.OBJECT0
[LAMBDA (STREAM PIECE FILE CURCH#) (* jds "22-Feb-85 14:31")
(* Get an object from the file)
(* CURCH# = fileptr within the text section of the file
where the object's text starts.)
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
FILEPTRSAVE NAMELEN GETFN OBJ)
(SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ)
(SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the building of the
object)
(SETFILEPTR FILE CURCH#)
(SETQ OBJ (READIMAGEOBJ FILE GETFN))
(SETFILEPTR FILE FILEPTRSAVE)
(replace POBJ of PIECE with OBJ)
(replace PFILE of PIECE with NIL)
(replace PSTR of PIECE with NIL)
[replace PLOOKS of PIECE with (COND
((fetch PREVPIECE of PIECE)
(fetch PLOOKS of (fetch PREVPIECE of PIECE)))
(T (OR (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT
DEFAULTFONT)
TEXTOBJ]
(RETURN (fetch POBJ of PIECE])
(TEDIT.GET.PARALOOKS0
[LAMBDA (PC FILE) (* jds "16-May-84 16:47")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC)
(replace PPARALOOKS of PC with LOOKS)
(replace 1STLEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the first line of the paragraph)
(replace LEFTMAR of LOOKS with (\SMALLPIN FILE)) (* Left margin for the rest of the paragraph)
(replace RIGHTMAR of LOOKS with (\SMALLPIN FILE))
(* Right margin for the paragraph)
(replace LEADBEFORE of LOOKS with (\SMALLPIN FILE))
(* Leading before the paragraph)
(replace LEADAFTER of LOOKS with (\SMALLPIN FILE))
(* Lead after the paragraph)
(replace LINELEAD of LOOKS with (\SMALLPIN FILE))
(* inter-line leading)
(replace TABSPEC of LOOKS with (SETQ TABSPEC (CONS NIL NIL)))
(* Will be tab specs)
(SETQ TABFLG (\BIN FILE))
(replace QUAD of LOOKS with (SELECTC (\BIN FILE)
(1 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(3 (QUOTE CENTERED))
(4 (QUOTE JUSTIFIED))
(SHOULDNT)))
(COND
((NOT (ZEROP TABFLG)) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS])
)
(PUTPROPS TEDITFILE COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1967 111066 (TEDIT.BUILD.PCTB 1977 . 43403) (\TEDIT.CONVERT.FOREIGN.FORMAT 43405 .
44766) (TEDIT.FORMATTEDFILEP 44768 . 47136) (TEDIT.GET 47138 . 55337) (TEDIT.INCLUDE 55339 . 63356) (
TEDIT.PARSE.PAGEFRAMES1 63358 . 64464) (TEDIT.PUT 64466 . 71416) (TEDIT.PUT.PCTB 71418 . 95624) (
\TEDIT.PUTRESET 95626 . 95876) (TEDIT.PUT.PIECE.DESCRIPTOR 95878 . 97240) (\ARBIN 97242 . 97783) (
\ARBOUT 97785 . 98251) (\ATMIN 98253 . 98534) (\ATMOUT 98536 . 98955) (\DWIN 98957 . 99168) (\DWOUT
99170 . 99449) (\STRINGIN 99451 . 100036) (\STRINGOUT 100038 . 100537) (\TEDIT.FORMATTEDP1 100539 .
102373) (\TEDIT.SET.WINDOW 102375 . 102801) (TEDIT.RAW.INCLUDE 102803 . 111064)) (111067 117953 (
\TEDIT.GET.CHARLOOKS.LIST 111077 . 111412) (\TEDIT.GET.SINGLE.CHARLOOKS 111414 . 113852) (
\TEDIT.PUT.PARALOOKS.LIST 113854 . 114606) (\TEDIT.PUT.SINGLE.CHARLOOKS 114608 . 117951)) (117954
128697 (\TEDIT.GET.PARALOOKS.LIST 117964 . 118307) (\TEDIT.GET.SINGLE.PARALOOKS 118309 . 122571) (
\TEDIT.PUT.CHARLOOKS.LIST 122573 . 124003) (\TEDIT.PUT.SINGLE.PARALOOKS 124005 . 128695)) (128909
168208 (TEDIT.BUILD.PCTB2 128919 . 138115) (\TEDIT.GET.CHARLOOKS.LIST2 138117 . 138454) (
\TEDIT.GET.SINGLE.CHARLOOKS2 138456 . 140759) (\TEDIT.PUT.SINGLE.PARALOOKS2 140761 . 143922) (
\TEDIT.PUT.SINGLE.CHARLOOKS2 143924 . 146586) (\TEDIT.GET.PARALOOKS.LIST2 146588 . 146925) (
\TEDIT.GET.SINGLE.PARALOOKS2 146927 . 150367) (TEDIT.PUT.PCTB2 150369 . 166018) (
\TEDIT.PUT.CHARLOOKS.LIST2 166020 . 167451) (\TEDIT.PUT.PARALOOKS.LIST2 167453 . 168206)) (168281
183696 (TEDIT.BUILD.PCTB1 168291 . 175671) (TEDIT.GET.PAGEFRAMES1 175673 . 175984) (
\TEDIT.GET.CHARLOOKS1 175986 . 178792) (\TEDIT.GET.PARALOOKS1 178794 . 182227) (TEDIT.GET.OBJECT1
182229 . 183694)) (183751 194336 (TEDIT.BUILD.PCTB0 183761 . 187052) (TEDIT.GET.CHARLOOKS0 187054 .
190324) (TEDIT.GET.OBJECT0 190326 . 191791) (TEDIT.GET.PARALOOKS0 191793 . 194334)))))
STOP