(FILECREATED " 5-Aug-85 12:08:54" {ERIS}<TEDIT>TEDITLOOKS.;21 110407
changes to: (FNS TEDIT.LOOKS \TEDIT.CHANGE.LOOKS)
(VARS TEDITLOOKSCOMS)
previous date: " 1-Aug-85 00:49:40" {ERIS}<TEDIT>TEDITLOOKS.;20)
(* Copyright (c) 1983, 1984, 1985 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITLOOKSCOMS)
(RPAQQ TEDITLOOKSCOMS ((RECORDS CHARLOOKS FMTSPEC PENDINGTAB)
(FILES TEXTOFD TEDIT)
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.TERMSA.FONTS NIL)
(TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT
DEFAULTFONT))
(TEDIT.DEFAULT.FMTSPEC (create FMTSPEC QUAD ←
(QUOTE LEFT)
1STLEFTMAR ← 0 LEFTMAR ←
0 RIGHTMAR ← 0 LEADBEFORE
← 0 LEADAFTER ← 0
LINELEAD ← 0 TABSPEC ←
(CONS NIL NIL)))
(TEDIT.TERMSA.FONTS NIL)
(TEDIT.KNOWN.FONTS (QUOTE ((Times% Roman (QUOTE
TIMESROMAN))
(Helvetica (QUOTE HELVETICA))
(Gacha (QUOTE GACHA))
(Cream (QUOTE CREAM]
(VARS (TEDIT.CHARLOOKS.FEATURES (QUOTE (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE
FAMILY OVERLINE STRIKEOUT UNDERLINE
EXPANSION SLOPE WEIGHT)))
(TEDIT.FACE.MENU (create MENU ITEMS ← (QUOTE (Bold Italic Bold% Italic Regular))
CENTERFLG ← T TITLE← "Face:"))
(TEDIT.SIZE.MENU (create MENU ITEMS ←
(QUOTE (6 7 8 9 10 11 12 14 18 24 30 36))
CENTERFLG ← T MENUROWS←4 TITLE← "Type Size:")))
(GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS
TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT
TEDIT.DEFAULT.CHARLOOKS TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS)
(COMS (* Character looks functions)
(FNS CHARLOOKS.FROM.FONT EQCLOOKS SAMECLOOKS TEDIT.SUBLOOKS \TEDIT.UNIQUIFY.CHARLOOKS
TEDIT.CARETLOOKS TEDIT.COPY.LOOKS \TEDIT.GET.CHARLOOKS
\TEDIT.UNPARSE.CHARLOOKS.LIST TEDIT.MODIFYLOOKS TEDIT.NEW.FONT
\TEDIT.PUT.CHARLOOKS \TEDIT.APPLY.STYLES \TEDIT.CARETLOOKS.VERIFY
\TEDIT.GET.INSERT.CHARLOOKS \TEDIT.GET.TERMSA.WIDTHS \TEDIT.LOOKS.UPDATE
\TEDIT.PARSE.CHARLOOKS.LIST \TEDIT.FLUSH.UNUSED.LOOKS)
(FNS \TEDIT.CHANGE.LOOKS TEDIT.LOOKS \TEDIT.LOOKS \TEDIT.FONTCOPY TEDIT.GET.LOOKS))
(COMS (* Paragraph looks functions)
(FNS \TEDIT.GET.PARALOOKS EQFMTSPEC \TEDIT.UNIQUIFY.PARALOOKS TEDIT.GET.PARALOOKS
\TEDIT.UNPARSE.PARALOOKS.LIST \TEDIT.APPLY.PARASTYLES \TEDIT.PARSE.PARALOOKS.LIST
TEDIT.PARALOOKS TEDIT.COPY.PARALOOKS \TEDIT.PUT.PARALOOKS
\TEDIT.CONVERT.TO.FORMATTED \TEDIT.PARABOUNDS \TEDIT.FORMATTABS))
(COMS (* UNDO & History List stuff)
(FNS TEDIT.REDO.LOOKS TEDIT.REDO.PARALOOKS TEDIT.UNDO.LOOKS TEDIT.UNDO.PARALOOKS))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \SMALLPIN \SMALLPOUT))
(MACROS ONOFF)))
[DECLARE: EVAL@COMPILE
(DATATYPE CHARLOOKS (CLFONT (* The font descriptor for these characters)
CLNAME
(* Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE.
USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT.)
CLSIZE (* Font size, in points)
(CLITAL FLAG) (* T if the characters are italic, else NIL)
(CLBOLD FLAG) (* T if the characters are bold, else NIL)
(CLULINE FLAG) (* T if the characters are to be underscored, else NIL)
(CLOLINE FLAG) (* T if the characters are to be overscored, else NIL)
(CLSTRIKE FLAG) (* T if the characters are to be struck thru, else
nil.)
CLOFFSET (* A superscripting offset in points
(?) else NIL (SUBSCRIPTING IF NEGATIVE.))
(CLSMALLCAP FLAG) (* T if small caps, else NIL)
(CLINVERTED FLAG) (* T if the characters are to be shown white-on-black)
(CLPROTECTED FLAG) (* T if chars can't be selected, else NIL)
(CLINVISIBLE FLAG) (* T if TEDIT is to ignore these chars;
else NIL)
(CLSELHERE FLAG)
(* T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT
BE PROTECTED.)
(CLCANCOPY FLAG) (* T if this text can be selected for copying, even tho
protected (it will become unprotected after the copy;
for Dribble/TTY interface))
CLSTYLE (* The style to be used in marking these characters;
overridden by the other fields)
CLUSERINFO (* Any information that an outsider wants to include)
CLLEADER (* For creating dotted and other kinds of leader)
CLRULES (* For arbitrarily-places horizontal rules.
List of pairs, of (widthinpts . offsetfrombaselineinpts
). Should be taken account of in ascent/descent calcs.)
(CLMARK FLAG) (* Used for a mark-&-sweep of looks at PUT time -- T
means this set of looks really IS in use in the
document)
)
CLOFFSET ← 0)
(DATATYPE FMTSPEC (1STLEFTMAR (* Left margin of the first line of the paragraph)
LEFTMAR (* Left margin of the rest of the lines in the
paragraph)
RIGHTMAR (* Right margin for the paragraph)
LEADBEFORE (* Leading above the paragraph's first line, in points)
LEADAFTER (* Leading below the paragraph's bottom line, in
points. NOT IMPLEMENTED.)
LINELEAD (* Leading between lines, in points.
Actually, this space is added BELOW each line in the
para.)
FMTBASETOBASE (* The baseline-to-baseline spacing between lines in
this paragraph. THIS OVERRIDES THE LINE LEADING)
TABSPEC (* The list of tabs for this paragraph, including CAR
for a default tab width)
QUAD (* How the para is formatted: one of LEFT, RIGHT,
CENTERED, JUSTIFIED)
FMTSTYLE (* The STYLE that controls this paragraph's appearance)
FMTCHARSTYLES (* The characterstyles that control the appearance of
characters in this para (maybe? may be part of the
fmtstyle.))
FMTUSERINFO (* Space for a PLIST of user info)
FMTSPECIALX (* A special horizontal location on the printed page
for this para.)
FMTSPECIALY (* A special vertical location on the page for this
para)
(FMTHEADINGKEEP FLAG) (* This para should be kept with the top line or so of
the next para. NOT USED YET.)
FMTPARATYPE (* What kind of para this is: TEXT, PAGEHEADING,
whatever)
FMTPARASUBTYPE (* Sub type of the type, e.g., what KIND of page
heading this is.)
FMTNEWPAGEBEFORE
(* Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by
going the least distance back up the tree, then back down until you find that kind of box.)
FMTNEWPAGEAFTER (* Similarly)
FMTKEEP (* For information about how this paragraph is to be
kept with other paragraphs.)
FMTCOLUMN (* For setting up side-by-side paragraphs easily ala
BravoX)
FMTVERTRULES (* For Keeping track of vertical rules in force)
(FMTMARK FLAG)
(* Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so
that only "real" PARALOOKSs make it into the file)
(FMTHARDCOPY FLAG) (* T if this paragraph is to be displayed in
hardcopy-format.)
(* Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it
makes sense to save it on the file.)
)
TABSPEC ←(CONS NIL NIL))
(DATATYPE PENDINGTAB ( (* The data structure for a pending tab, within the
line formatter)
PTNEWTX
(* An updated TX, being passed back to the line formatter. This results from the resolution of an old RIGHT,
CENTERED, or DECIMAL tab, which changed the width of a prior tab.)
PTOLDTAB (* The pending tab)
PTTYPE (* Its tab type)
PTTABX (* Its nominal X position)
(PTWBASE FULLXPOINTER) (* The WBASE for its width, for updating when we've
figured out how wide the tab really is)
PTOLDTX (* The TX as of when the tab was encountered.)
))
]
(/DECLAREDATATYPE (QUOTE CHARLOOKS)
(QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG
FLAG FLAG FLAG POINTER POINTER POINTER POINTER FLAG))
[QUOTE ((CHARLOOKS 0 POINTER)
(CHARLOOKS 2 POINTER)
(CHARLOOKS 4 POINTER)
(CHARLOOKS 4 (FLAGBITS . 0))
(CHARLOOKS 4 (FLAGBITS . 16))
(CHARLOOKS 4 (FLAGBITS . 32))
(CHARLOOKS 4 (FLAGBITS . 48))
(CHARLOOKS 4 (FLAGBITS . 64))
(CHARLOOKS 6 POINTER)
(CHARLOOKS 6 (FLAGBITS . 0))
(CHARLOOKS 6 (FLAGBITS . 16))
(CHARLOOKS 6 (FLAGBITS . 32))
(CHARLOOKS 6 (FLAGBITS . 48))
(CHARLOOKS 6 (FLAGBITS . 64))
(CHARLOOKS 6 (FLAGBITS . 80))
(CHARLOOKS 8 POINTER)
(CHARLOOKS 10 POINTER)
(CHARLOOKS 12 POINTER)
(CHARLOOKS 14 POINTER)
(CHARLOOKS 14 (FLAGBITS . 0]
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE FMTSPEC)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER
POINTER POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((FMTSPEC 0 POINTER)
(FMTSPEC 2 POINTER)
(FMTSPEC 4 POINTER)
(FMTSPEC 6 POINTER)
(FMTSPEC 8 POINTER)
(FMTSPEC 10 POINTER)
(FMTSPEC 12 POINTER)
(FMTSPEC 14 POINTER)
(FMTSPEC 16 POINTER)
(FMTSPEC 18 POINTER)
(FMTSPEC 20 POINTER)
(FMTSPEC 22 POINTER)
(FMTSPEC 24 POINTER)
(FMTSPEC 26 POINTER)
(FMTSPEC 26 (FLAGBITS . 0))
(FMTSPEC 28 POINTER)
(FMTSPEC 30 POINTER)
(FMTSPEC 32 POINTER)
(FMTSPEC 34 POINTER)
(FMTSPEC 36 POINTER)
(FMTSPEC 38 POINTER)
(FMTSPEC 40 POINTER)
(FMTSPEC 40 (FLAGBITS . 0))
(FMTSPEC 40 (FLAGBITS . 16]
(QUOTE 42))
(/DECLAREDATATYPE (QUOTE PENDINGTAB)
(QUOTE (POINTER POINTER POINTER POINTER FULLXPOINTER POINTER))
(QUOTE ((PENDINGTAB 0 POINTER)
(PENDINGTAB 2 POINTER)
(PENDINGTAB 4 POINTER)
(PENDINGTAB 6 POINTER)
(PENDINGTAB 8 FULLXPOINTER)
(PENDINGTAB 10 POINTER)))
(QUOTE 12))
(FILESLOAD TEXTOFD TEDIT)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQQ TEDIT.TERMSA.FONTS NIL)
(RPAQ TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))
(RPAQ TEDIT.DEFAULT.FMTSPEC (create FMTSPEC QUAD ← (QUOTE LEFT)
1STLEFTMAR ← 0 LEFTMAR ← 0 RIGHTMAR ← 0 LEADBEFORE ← 0 LEADAFTER
← 0 LINELEAD ← 0 TABSPEC ← (CONS NIL NIL)))
(RPAQQ TEDIT.TERMSA.FONTS NIL)
(RPAQQ TEDIT.KNOWN.FONTS ((Times% Roman (QUOTE TIMESROMAN))
(Helvetica (QUOTE HELVETICA))
(Gacha (QUOTE GACHA))
(Cream (QUOTE CREAM))))
)
(RPAQQ TEDIT.CHARLOOKS.FEATURES (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE
STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT))
(RPAQ TEDIT.FACE.MENU (create MENU ITEMS ← (QUOTE (Bold Italic Bold% Italic Regular))
CENTERFLG ← T TITLE← "Face:"))
(RPAQ TEDIT.SIZE.MENU (create MENU ITEMS ←
(QUOTE (6 7 8 9 10 11 12 14 18 24 30 36))
CENTERFLG ← T MENUROWS←4 TITLE← "Type Size:"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS TEDIT.KNOWN.FONTS
TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT TEDIT.DEFAULT.CHARLOOKS
TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS)
)
(* Character looks functions)
(DEFINEQ
(CHARLOOKS.FROM.FONT
[LAMBDA (FONT) (* jds " 7-Jan-85 17:17")
(* Create a CHARLOOKS from a font, filling in such
fields as can be inferred from the font descriptor.)
(PROG ((LOOKS (create CHARLOOKS
CLFONT ← FONT)))
(OR (FONTP FONT)
(\ILLEGAL.ARG FONT)) (* It HAS to be a font, first off.)
(SELECTQ (CAR (FONTPROP FONT (QUOTE FACE)))
(BOLD (replace CLBOLD of LOOKS with T)
(replace CLITAL of LOOKS with NIL))
(replace CLBOLD of LOOKS with NIL)) (* Set the boldness bit, if it's a bold font.)
(SELECTQ (CADR (FONTPROP FONT (QUOTE FACE)))
(ITALIC (replace CLITAL of LOOKS with T))
(replace CLITAL of LOOKS with NIL)) (* Set the italic bit, if it's italic)
(with CHARLOOKS LOOKS (SETQ CLSIZE (FONTPROP FONT (QUOTE SIZE)))
(* Grab the size from the font)
(SETQ CLOFFSET 0) (* And let it be neither super- nor subscripted.)
)
(RETURN LOOKS])
(EQCLOOKS
[LAMBDA (CLOOK1 CLOOK2) (* jds "23-May-85 09:38")
(* Given two sets of CHARLOOKS, are they effectively
the same?)
(OR (EQ CLOOK1 CLOOK2)
(AND [OR (EQ (fetch CLFONT of CLOOK1)
(fetch CLFONT of CLOOK2))
(AND (type? FONTCLASS (fetch CLFONT of CLOOK1))
(type? FONTCLASS (fetch CLFONT of CLOOK2))
(EQ (fetch FONTCLASSNAME of (fetch CLFONT of CLOOK1))
(fetch FONTCLASSNAME of (fetch CLFONT of CLOOK2]
(EQ (fetch CLPROTECTED of CLOOK1)
(fetch CLPROTECTED of CLOOK2))
(EQ (fetch CLINVISIBLE of CLOOK1)
(fetch CLINVISIBLE of CLOOK2))
(EQ (fetch CLSELHERE of CLOOK1)
(fetch CLSELHERE of CLOOK2))
(EQ (fetch CLCANCOPY of CLOOK1)
(fetch CLCANCOPY of CLOOK2))
(EQ (fetch CLULINE of CLOOK1)
(fetch CLULINE of CLOOK2))
(EQ (fetch CLOLINE of CLOOK1)
(fetch CLOLINE of CLOOK2))
(EQ (fetch CLINVERTED of CLOOK1)
(fetch CLINVERTED of CLOOK2))
(EQ (fetch CLSTRIKE of CLOOK1)
(fetch CLSTRIKE of CLOOK2))
(EQ (fetch CLOFFSET of CLOOK1)
(fetch CLOFFSET of CLOOK2))
(EQ (fetch CLSMALLCAP of CLOOK1)
(fetch CLSMALLCAP of CLOOK2))
(EQ (fetch CLSTYLE of CLOOK1)
(fetch CLSTYLE of CLOOK2))
(EQ (fetch CLUSERINFO of CLOOK1)
(fetch CLUSERINFO of CLOOK2])
(SAMECLOOKS
[LAMBDA (CLOOK1 CLOOK2 FEATURES) (* gbn "15-Sep-84 15:59")
(* * Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES)
(for F in FEATURES always (SELECTQ F
[FAMILY (EQ (FONTPROP (fetch CLFONT of CLOOK1)
(QUOTE FAMILY))
(FONTPROP (fetch CLFONT of CLOOK2)
(QUOTE FAMILY]
[SIZE (EQ (FONTPROP (fetch CLFONT of CLOOK1)
(QUOTE SIZE))
(FONTPROP (fetch CLFONT of CLOOK2)
(QUOTE SIZE]
[EXPANSION (EQ (FONTPROP (fetch CLFONT of CLOOK1)
(QUOTE EXPANSION))
(FONTPROP (fetch CLFONT of CLOOK2)
(QUOTE EXPANSION]
[SLOPE (EQ (FONTPROP (fetch CLFONT of CLOOK1)
(QUOTE SLOPE))
(FONTPROP (fetch CLFONT of CLOOK2)
(QUOTE SLOPE]
[WEIGHT (EQ (FONTPROP (fetch CLFONT of CLOOK1)
(QUOTE WEIGHT))
(FONTPROP (fetch CLFONT of CLOOK2)
(QUOTE WEIGHT]
(SUPERSCRIPT (EQ (fetch CLOFFSET of CLOOK1)
(fetch CLOFFSET of CLOOK2)))
(INVISIBLE (EQ (fetch CLINVISIBLE of CLOOK1)
(fetch CLINVISIBLE of CLOOK2)))
(SELECTPOINT (EQ (fetch CLSELHERE of CLOOK1)
(fetch CLSELHERE of CLOOK2)))
(PROTECTED (EQ (fetch CLPROTECTED of CLOOK1)
(fetch CLPROTECTED of CLOOK2)))
(OVERLINE (EQ (fetch CLOLINE of CLOOK1)
(fetch CLOLINE of CLOOK2)))
(STRIKEOUT (EQ (fetch CLSTRIKE of CLOOK1)
(fetch CLSTRIKE of CLOOK2)))
(UNDERLINE (EQ (fetch CLULINE of CLOOK1)
(fetch CLULINE of CLOOK2)))
(ERROR (CONCAT F
" is an unknown feature of character looks. Detected in SAMECLOOKS"])
(TEDIT.SUBLOOKS
[LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* jds "27-Jan-85 13:07")
(* * User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks
match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are
substituted.)
(PROG ((OLDLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST))
(NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKSLIST))
[FIRSTPC (\CHTOPC 1 (fetch PCTB of (TEXTOBJ TEXTSTREAM]
(FEATURELIST (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A)))
CHANGEMADE)
[for (PC ← FIRSTPC) while PC by (fetch NEXTPIECE of PC)
do (COND
((SAMECLOOKS OLDLOOKS (fetch PLOOKS of PC)
FEATURELIST)
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST
NEWLOOKSLIST
(fetch PLOOKS
of PC))
(TEXTOBJ TEXTSTREAM)))
(SETQ CHANGEMADE T]
(RETURN (COND
(CHANGEMADE (QUOTE Done))
(T (QUOTE NoChangesMade])
(\TEDIT.UNIQUIFY.CHARLOOKS
[LAMBDA (NEWLOOKS TEXTOBJ) (* jds "27-Jan-85 17:12")
(* Assure that there is only ONE of a given CHARLOOKS
in the document--so that all instances of that set of
looks share structure.)
(COND
((for LOOK in (fetch TXTCHARLOOKSLIST of TEXTOBJ) thereis (EQCLOOKS NEWLOOKS LOOK)))
(T (push (fetch TXTCHARLOOKSLIST of TEXTOBJ)
NEWLOOKS)
NEWLOOKS])
(TEDIT.CARETLOOKS
[LAMBDA (STREAM LOOKS) (* jds "26-Jul-85 14:18")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
CHARLOOKS)
(SETQ CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS (fetch CARETLOOKS of TEXTOBJ)
TEXTOBJ))
(* Parse up the looks he gave us, to make sure they're
a valid CHARLOOKS)
(replace \INSERTPCVALID of TEXTOBJ with NIL) (* Changing the caret's looks means we can't type into
the same piece any more. Force the next insert to
create a new one.)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY
TEXTOBJ CHARLOOKS)
TEXTOBJ])
(TEDIT.COPY.LOOKS
[LAMBDA (STREAM SOURCE DEST) (* jds " 5-Dec-84 11:34")
(* Copy the CHARACTER LOOKS of one piece of text
(actually, the first selected character) to another
piece of text)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
LOOKS LEN) (* get the character looks of the first character of
SOURCE)
[SETQ LOOKS (fetch PLOOKS of (SELECTQ (TYPENAME SOURCE)
((SMALLP FIXP)
(\CHTOPC SOURCE (fetch PCTB of TEXTOBJ)))
[SELECTION (\SHOWSEL SOURCE NIL NIL)
(* Turn off the source selection, so it doesn't hang
around after the copy.)
(\CHTOPC (fetch CH# of SOURCE)
(fetch PCTB
of (fetch \TEXTOBJ
of SOURCE]
(\ILLEGAL.ARG SOURCE]
(COND
[(type? SELECTION DEST) (* make sure that the destination selection is in this
document)
(COND
((NEQ TEXTOBJ (fetch \TEXTOBJ of DEST))
(\LISPERROR "Destination selection is not in stream " STREAM]
(T (* set the LEN arg for TEDIT.LOOKS to be 1 since we
just have a char pos.)
(SETQ LEN 1)))
(TEDIT.LOOKS TEXTOBJ LOOKS DEST LEN])
(\TEDIT.GET.CHARLOOKS
[LAMBDA (PC FILE LOOKSARRAY PREVPC) (* jds " 8-Jul-85 16:15")
(* * Set the PLOOKS for the current piece, PC, according to what the file says)
(* * The PLEN field of this piece is the number of FILE BYTES taken to describe the piece. This may need to be
adjusted for fat pieces, and at fat/thin boundaries. PREVPC is the previous piece, if any, so we can detect such
boundaries.)
(PROG ((FLAGS (\BIN FILE)))
(COND
((NOT (ZEROP (LOGAND FLAGS 1))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
(COND
((NOT (ZEROP (LOGAND FLAGS 2))) (* This text is FAT--16 bit characters.)
(replace PFATP of PC with T)))
(replace PLOOKS of PC with (ELT LOOKSARRAY (\SMALLPIN FILE)))
(* Look the looks up in the array we built according to
specs earlier)
(COND
[(fetch PFATP of PC) (* For a fat piece, convert bytes to characters)
(COND
((AND PREVPC (fetch PFATP of PREVPC))
(replace PLEN of PC with (FOLDHI (FETCH PLEN OF PC)
2)))
(T (* The prior piece wasn't fat and this one is.
Take account of the 255-255-0 in the length)
(replace PLEN of PC with (FOLDHI (IDIFFERENCE (fetch PLEN of PC)
3)
2))
(add (fetch PFPOS of PC)
3]
((AND PREVPC (fetch PFATP of PREVPC)) (* The prior piece was fat and this one isn't.
Take account of the 255-0 on the front of this piece's
chars.)
(replace PLEN of PC with (IDIFFERENCE (fetch PLEN of PC)
2))
(add (fetch PFPOS of PC)
2])
(\TEDIT.UNPARSE.CHARLOOKS.LIST
[LAMBDA (LOOKS) (* jds "10-Jul-85 16:01")
(* Convert a CHARLOOKS into an equivalent PList-form
for external consumption)
(PROG ((NEWLOOKS NIL)
OFFSET)
(for PROP in (LIST (fetch CLSTYLE of LOOKS)
(fetch CLUSERINFO of LOOKS)
(ONOFF (fetch CLINVERTED of LOOKS))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE WEIGHT))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE SLOPE))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE EXPANSION))
(ONOFF (fetch CLULINE of LOOKS))
(ONOFF (fetch CLSTRIKE of LOOKS))
(ONOFF (fetch CLOLINE of LOOKS))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE FAMILY))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE SIZE))
(ONOFF (fetch CLPROTECTED of LOOKS))
(ONOFF (fetch CLSELHERE of LOOKS))
(ONOFF (fetch CLINVISIBLE of LOOKS)))
as PROPNAME
in (QUOTE (STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE
FAMILY SIZE PROTECTED SELECTPOINT INVISIBLE))
do (push NEWLOOKS PROP)
(push NEWLOOKS PROPNAME))
(push NEWLOOKS (IABS (OR (fetch CLOFFSET of LOOKS)
0)))
[push NEWLOOKS (COND
((IGREATERP (fetch CLOFFSET of LOOKS)
0)
(QUOTE SUPERSCRIPT))
((ILESSP (fetch CLOFFSET of LOOKS)
0)
(QUOTE SUBSCRIPT))
(T (QUOTE SUPERSCRIPT]
(RETURN NEWLOOKS])
(TEDIT.MODIFYLOOKS
[LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* jds "23-May-85 09:33")
(* Modify the screen to allow for underlining, etc.
Also, restore the vertical offset to the baseline.)
(PROG ((CURX (DSPXPOSITION NIL DS))
(CURY (DSPYPOSITION NIL DS))
(FONT (fetch CLFONT of LOOKS)))
(COND
((fetch CLULINE of LOOKS) (* It's underlined.)
(MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY)
(fetch LTRUEDESCENT of LINE)))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 (QUOTE PAINT)
DS)))
(COND
((fetch CLOLINE of LOOKS) (* Over-line)
(MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT (QUOTE ASCENT]
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 (QUOTE PAINT)
DS)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struck-thru)
(MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT (QUOTE ASCENT))
3))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 (QUOTE PAINT)
DS)))
(COND
((fetch CLINVERTED of LOOKS) (* Inverse video)
(BITBLT NIL NIL NIL DS STARTX (IDIFFERENCE CURY (FONTPROP FONT (QUOTE DESCENT)))
(IDIFFERENCE CURX STARTX)
(FONTPROP FONT (QUOTE HEIGHT))
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)))
(MOVETO CURX LINEBASEY DS])
(TEDIT.NEW.FONT
[LAMBDA (TEXTOBJ) (* jds " 8-Feb-85 11:27")
(PROG [(NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font: "]
(AND NAME [SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE
NAME]
(RETURN (U-CASE NAME])
(\TEDIT.PUT.CHARLOOKS
[LAMBDA (FILE CH1 CHLIM LOOKS OLDPC TEDIT.TENTATIVE LOOKSHARRAY PREVFATP)
(* jds " 8-Jul-85 15:50")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((FONT (fetch CLFONT of LOOKS))
STR)
(\DWOUT FILE (IDIFFERENCE CHLIM CH1)) (* The length of this run of looks)
(\SMALLPOUT FILE \PieceDescriptorLOOKS) (* Mark this as setting the piece's looks)
[\BOUT FILE (LOGOR (COND
((AND TEDIT.TENTATIVE (fetch PNEW of OLDPC))
(* If this is a tentative edit, save the newness flag)
1)
(T (* Otherwise, don't bother)
0))
(COND
((fetch PFATP of OLDPC) (* If this piece contains fat characters, remember that
fact.)
2)
(T (* Otherwise, don't bother)
0]
(\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY)) (* The index into the list of fonts)
])
(\TEDIT.APPLY.STYLES
[LAMBDA (LOOKS PC TEXTOBJ) (* jds "16-Jul-84 13:57")
(* Given a set of looks, return the looks with the
proper styles expanded out.)
(\TEDIT.CHECK (type? CHARLOOKS LOOKS)) (* Incoming thing has to be a LOOKS.)
(PROG ((STYLE (fetch CLSTYLE of LOOKS))
CHARSTYLES CHARSTYLE)
(RETURN (COND
((NULL STYLE) (* STYLE of NIL means don't bother.
Just use the looks we got.)
LOOKS)
((AND [SETQ CHARSTYLES (fetch FMTCHARSTYLES of (fetch (TEXTSTREAM
CURRENTPARALOOKS)
of (fetch STREAMHINT
of TEXTOBJ]
(SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES)))
(* If the paragraph we're in has character styles, and
this is one of them, use it.)
CHARSTYLE)
((AND (LITATOM STYLE)
(DEFINEDP STYLE)) (* Call the guy's function to find the new looks)
(APPLY* STYLE LOOKS PC TEXTOBJ))
((ZEROP STYLE) (* STYLE = 0 means don't bother.)
LOOKS)
((FIXP STYLE) (* This looks has a style attached.
Use it.)
(CAR (NTH TEDIT.STYLES STYLE)))
(T (* If all else fails, return the original set of looks)
LOOKS])
(\TEDIT.CARETLOOKS.VERIFY
[LAMBDA (TEXTOBJ NEWLOOKS) (* jds "12-Sep-84 11:14")
(* Check with the user's CARETLOOKSFN to see if he
wants to make changes)
(PROG ((CARETFN (TEXTPROP TEXTOBJ (QUOTE CARETLOOKSFN)))
LOOKS)
(SETQ LOOKS (AND CARETFN (APPLY* CARETFN NEWLOOKS TEXTOBJ)))
(RETURN (COND
((EQ LOOKS (QUOTE DON'T)) (* He said not to change the looks.)
(fetch CARETLOOKS of TEXTOBJ))
(LOOKS)
(T (* He didn't give us any guidance, so return the looks
unmodified.)
NEWLOOKS])
(\TEDIT.GET.INSERT.CHARLOOKS
[LAMBDA (TEXTOBJ SEL) (* jds " 6-Mar-85 21:53")
(* Given a default source of charlooks, set us up some
good ones. IN particular, reset CLPROTECTED if need
be.)
(PROG ((PCTB (fetch PCTB of TEXTOBJ))
[CH# (IMAX 1 (IMIN (fetch TEXTLEN of TEXTOBJ)
(SELECTQ (fetch POINT of SEL)
(LEFT (fetch CH# of SEL))
(RIGHT (SUB1 (fetch CHLIM of SEL)))
(SHOULDNT]
PCNO PIECE LOOKS)
(SETQ PIECE (\CHTOPC CH# PCTB))
[COND
[(NULL PIECE) (* No piece to take looks from;
use the default)
(SETQ LOOKS (OR (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)
TEXTOBJ]
((ATOM PIECE) (* Trying to take from the pseudo-piece at the end.)
(COND
[(ZEROP (fetch TEXTLEN of TEXTOBJ)) (* No characters to steal from.
Use the defaults)
(SETQ LOOKS (OR (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)
TEXTOBJ]
(T (* Otherwise, steal the looks of the last character)
(SETQ PIECE (\EDITELT PCTB (IDIFFERENCE (\EDITELT PCTB \PCTBLastPieceOffset)
\EltsPerPiece]
[COND
(LOOKS)
((fetch CLPROTECTED of (fetch PLOOKS of PIECE))
(* His looks are protected; we have to copy to a new
CHARLOOKS.)
(SETQ LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS using (fetch PLOOKS
of PIECE)
CLPROTECTED ← NIL
CLSELHERE ← NIL)
TEXTOBJ)))
(T (* No protection, just reuse his looks)
(SETQ LOOKS (fetch PLOOKS of PIECE]
(RETURN (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS)
TEXTOBJ])
(\TEDIT.GET.TERMSA.WIDTHS
[LAMBDA (TERMSA FONT) (* jds "22-OCT-83 21:36")
(* If the guy is using a terminal table, get an updated
set of widths to reflect that.)
(PROG ((NWIDTHS (ARRAY 256 (QUOTE SMALLP)
0 0)))
(for I from 0 to 255 do (\WORDSETA NWIDTHS I (TEDIT.CHARWIDTH I FONT TERMSA)))
(RETURN NWIDTHS])
(\TEDIT.LOOKS.UPDATE
[LAMBDA (STREAM PC) (* jds "31-Jul-85 13:40")
(* * Called under \FORMATLINE, on which it depends. At a piece boundary, update the line formatting fields such as
ASCENT, DESCENT, etc. Also, skip over invisible characters)
(DECLARE (USEDFREE LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT
INVISIBLERUNS NEWASCENT NEWDESCENT))
(COND
(PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
(ORIGPC PC)
TLOOKS TEMP NEWPC PARALOOKS PREVPC)
[COND
([OR (NOT (fetch PREVPIECE of ORIGPC))
(NEQ (fetch PPARALOOKS of ORIGPC)
(fetch PPARALOOKS of (fetch PREVPIECE of ORIGPC]
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS of ORIGPC)
ORIGPC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))
(T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM]
(SETQ TLOOKS (\TEDIT.APPLY.STYLES (ffetch PLOOKS of ORIGPC)
ORIGPC TEXTOBJ))
(COND
((fetch CLINVISIBLE of TLOOKS) (* We've hit a run of invisible characters.
Skip them, and insert a marker in the line cache)
(add LOOKNO 1) (* Fix the counter of charlooks changes)
(\EDITSETA LOOKS LOOKNO (fetch PLEN of ORIGPC))
(\RPLPTR CHLIST 0 LMInvisibleRun) (* Note the existence of an invisible run of characters
here.)
(\PUTBASE WLIST 0 0)
(add TLEN 1)
(SETQ CHLIST (\ADDBASE CHLIST 2))
(SETQ WLIST (\ADDBASE WLIST 1))
(SETQ PREVPC ORIGPC)
(SETQ ORIGPC (fetch NEXTPIECE of ORIGPC))
(COND
((NEQ (fetch PPARALOOKS of ORIGPC)
(fetch PPARALOOKS of PREVPC))
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS of ORIGPC)
ORIGPC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)))
(SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of ORIGPC)
ORIGPC TEXTOBJ)))
[while (AND ORIGPC (OR (ZEROP (fetch PLEN of ORIGPC))
(fetch CLINVISIBLE of TLOOKS)))
do (* Skip over this run of invisible characters --and any
trailing run of empty pieces)
(\EDITSETA LOOKS LOOKNO (IPLUS (fetch PLEN of ORIGPC)
(\EDITELT LOOKS LOOKNO)))
(* Note the invisible run length for the line
displayer)
(SETQ PREVPC ORIGPC)
(SETQ ORIGPC (fetch NEXTPIECE of ORIGPC))
(COND
((NOT ORIGPC) (* We ran off the end of the document.
Don't try to update paragraph looks.)
)
((NEQ (fetch PPARALOOKS of ORIGPC)
(fetch PPARALOOKS of PREVPC))
(* Paragraph looks changed in the course of the
invisible section.)
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS
of ORIGPC)
ORIGPC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)))
(SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of ORIGPC)
ORIGPC TEXTOBJ]
(while (AND ORIGPC (ZEROP (fetch PLEN of ORIGPC)))
do (* Skip over any trailing pieces that are zero long)
(SETQ PREVPC ORIGPC)
(SETQ ORIGPC (fetch NEXTPIECE of ORIGPC)))
(add CHNO (\EDITELT LOOKS LOOKNO))
(add INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
(* Keep track of how much invisible text we cross over)
(SETQ NEWPC ORIGPC)))
(COND
([AND ORIGPC (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM]
(* Only update looks if there's really a new piece to
update them from, and the looks have really changed)
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS)
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)
[COND
[(type? FONTCLASS (fetch CLFONT of TLOOKS))
(* For FONTCLASSes, we have to get the real font)
(SETQ FONT (FONTCOPY (fetch CLFONT of TLOOKS)
(QUOTE DEVICE)
(QUOTE DISPLAY]
(T (* It's a font already, so no work is needed)
(SETQ FONT (fetch CLFONT of TLOOKS]
[SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT (QUOTE ASCENT))
(OR (ffetch CLOFFSET of TLOOKS)
0]
[SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT (QUOTE DESCENT))
(OR (ffetch CLOFFSET of TLOOKS)
0]
[COND
((fetch FMTHARDCOPY of PARALOOKS) (* If it's a hardcopy-format line, grab the hardcopy
widths.)
(SETQ FONT (FONTCOPY (fetch CLFONT of TLOOKS)
(QUOTE DEVICE)
DEVICE]
(add LOOKNO 1) (* Fix the counter of charlooks changes)
(\EDITSETA LOOKS LOOKNO TLOOKS) (* Save the new looks for selection/display)
(\RPLPTR CHLIST 0 LMLooksChange) (* Put a marker in the character list to denote a looks
change)
(\PUTBASE WLIST 0 0) (* Font changes have no width)
(add TLEN 1)
(SETQ CHLIST (\ADDBASE CHLIST 2))
(SETQ WLIST (\ADDBASE WLIST 1)) (* Account for the dummy marker/looks in TLEN)
(COND
((ffetch CLPROTECTED of TLOOKS) (* If this line contains protected text, mark the
linedescriptor accordingly)
(freplace LHASPROT of LINE with T)))
(SETQ NEWPC ORIGPC))
((NOT ORIGPC)
(* No more pieces in this document (we ran off the end skipping invisible text!) Return a NIL from the BIN, so that
\FORMATLINE will not die.)
(RETFROM (QUOTE \BIN)
NIL)))
(RETURN NEWPC])
(\TEDIT.PARSE.CHARLOOKS.LIST
[LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* jds "10-Jul-85 15:47")
(* Takes a CHARLOOKS, a FONTDESCRIPTOR, or an ALST-format looks spec and parses it into a new CHARLOOKS.
If OLOOKS is given, it will be used as the base for modifications; otherwise, TEDIT.DEFAULT.CHARLOOKS will be.)
(PROG ((FAMILY NIL)
(FONT NIL)
(FACE NIL)
(SIZE NIL)
(PROT NIL)
(SELHERE NIL)
(ULINE NIL)
(OLINE NIL)
(STRIKE NIL)
(SUPER NIL)
(WEIGHT NIL)
(SLOPE NIL)
(EXPANSION NIL)
(SUB NIL)
(INVISIBLE NIL)
STYLE STYLESET UISET USERINFO NEWLOOKS NEWFONT NEWPCLOOKS)
(* Construct the set of new looks to apply:)
(COND
((type? CHARLOOKS NLOOKS) (* We've already got a made-up set of looks;
we'll just use it.)
(RETURN NLOOKS))
((FONTP NLOOKS) (* It was a font spec. Make the looks be that font,
otherwise unmodified.)
(RETURN (CHARLOOKS.FROM.FONT NLOOKS)))
(T (* We got an AList -- prepare looks changes in that
form)
(SETQ FONT (LISTGET NLOOKS (QUOTE FONT)))
(SETQ FAMILY (LISTGET NLOOKS (QUOTE FAMILY)))
(SETQ FACE (LISTGET NLOOKS (QUOTE FACE)))
(SETQ SIZE (LISTGET NLOOKS (QUOTE SIZE)))
(SETQ PROT (LISTGET NLOOKS (QUOTE PROTECTED)))
(SETQ SELHERE (LISTGET NLOOKS (QUOTE SELECTPOINT)))
(SETQ ULINE (LISTGET NLOOKS (QUOTE UNDERLINE)))
(SETQ OLINE (LISTGET NLOOKS (QUOTE OVERLINE)))
(SETQ STRIKE (LISTGET NLOOKS (QUOTE STRIKEOUT)))
(SETQ INVISIBLE (LISTGET NLOOKS (QUOTE INVISIBLE)))
(SETQ SUPER (LISTGET NLOOKS (QUOTE SUPERSCRIPT)))
(SETQ SUB (LISTGET NLOOKS (QUOTE SUBSCRIPT)))
(SETQ WEIGHT (LISTGET NLOOKS (QUOTE WEIGHT)))
(SETQ SLOPE (LISTGET NLOOKS (QUOTE SLOPE)))
(SETQ EXPANSION (LISTGET NLOOKS (QUOTE EXPANSION)))
(SETQ STYLE (LISTGET NLOOKS (QUOTE STYLE)))
(SETQ STYLESET (FMEMB (QUOTE STYLE)
NLOOKS))
(SETQ USERINFO (LISTGET NLOOKS (QUOTE USERINFO)))
(SETQ UISET (FMEMB (QUOTE USERINFO)
NLOOKS))
(SETQ NLOOKS NIL) (* Tell later code to use NEWLOOKS.)
(SETQ NEWLOOKS NIL)
[COND
(FAMILY (SETQ NEWLOOKS (CONS (QUOTE FAMILY)
(CONS FAMILY NEWLOOKS]
[COND
(FONT (SETQ FONT (CAR (NLSETQ (\DTEST FONT (QUOTE FONTDESCRIPTOR]
[COND
[(OR WEIGHT SLOPE EXPANSION) (* Setting one of these inhibits the FACE parameter)
[AND WEIGHT (SETQ NEWLOOKS (CONS (QUOTE WEIGHT)
(CONS WEIGHT NEWLOOKS]
[AND SLOPE (SETQ NEWLOOKS (CONS (QUOTE SLOPE)
(CONS SLOPE NEWLOOKS]
(AND EXPANSION (SETQ NEWLOOKS (CONS (QUOTE EXPANSION)
(CONS EXPANSION NEWLOOKS]
(FACE (SETQ NEWLOOKS (CONS (QUOTE FACE)
(CONS FACE NEWLOOKS]
[COND
(SIZE (SETQ NEWLOOKS (CONS (QUOTE SIZE)
(CONS SIZE NEWLOOKS]
[SETQ NEWPCLOOKS (COND
[OLOOKS (create CHARLOOKS using OLOOKS CLFONT ←(SETQ NEWFONT
(OR FONT (\TEDIT.FONTCOPY (fetch CLFONT
of OLOOKS)
NEWLOOKS TEXTOBJ]
(T (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS CLFONT ←(SETQ NEWFONT
(OR FONT (\TEDIT.FONTCOPY (fetch CLFONT of
TEDIT.DEFAULT.CHARLOOKS)
NEWLOOKS TEXTOBJ]
(* Give this piece its new looks)
[replace CLBOLD of NEWPCLOOKS with (EQ (QUOTE BOLD)
(FONTPROP NEWFONT (QUOTE WEIGHT]
[replace CLITAL of NEWPCLOOKS with (EQ (QUOTE ITALIC)
(FONTPROP NEWFONT (QUOTE SLOPE]
[AND PROT (replace CLPROTECTED of NEWPCLOOKS with (EQ PROT (QUOTE ON]
[AND SELHERE (replace CLSELHERE of NEWPCLOOKS with (EQ SELHERE (QUOTE ON]
[AND ULINE (replace CLULINE of NEWPCLOOKS with (EQ ULINE (QUOTE ON]
[AND OLINE (replace CLOLINE of NEWPCLOOKS with (EQ OLINE (QUOTE ON]
[AND STRIKE (replace CLSTRIKE of NEWPCLOOKS with (EQ STRIKE (QUOTE ON]
[AND INVISIBLE (replace CLINVISIBLE of NEWPCLOOKS with (EQ INVISIBLE (QUOTE ON]
(AND SUPER (replace CLOFFSET of NEWPCLOOKS with SUPER))
(AND SUB (replace CLOFFSET of NEWPCLOOKS with (IMINUS SUB)))
(AND STYLESET (replace CLSTYLE of NEWPCLOOKS with STYLE))
(AND UISET (replace CLUSERINFO of NEWPCLOOKS with USERINFO))
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
(RETURN NEWPCLOOKS])
(\TEDIT.FLUSH.UNUSED.LOOKS
[LAMBDA (TEXTOBJ FIRSTPC) (* jds " 1-Feb-85 10:18")
(* Run thru the CHARLOOKS and PARALOOKS lists for this
document, and flush any looks that aren't being used in
the document itself.)
(PROG ((CHARLOOKS (fetch TXTCHARLOOKSLIST of TEXTOBJ))
(PARALOOKS (fetch TXTPARALOOKSLIST of TEXTOBJ)))
(for LOOKS in CHARLOOKS
do (* Reset the in-use mark in all CHARLOOKSs)
(replace CLMARK of LOOKS with NIL))
(for LOOKS in PARALOOKS
do (* Reset the in-use mark in all FMTSPECs)
(replace FMTMARK of LOOKS with NIL))
(while FIRSTPC
do (* Now run thru the pieces in the document, marking the
looks that are really in use.)
(replace CLMARK of (fetch PLOOKS of FIRSTPC) with T)
(replace FMTMARK of (fetch PPARALOOKS of FIRSTPC) with T)
(SETQ FIRSTPC (fetch NEXTPIECE of FIRSTPC)))
(replace TXTCHARLOOKSLIST of TEXTOBJ with (for LOOKS in CHARLOOKS
when (fetch CLMARK of LOOKS) collect LOOKS))
(* Keep only those CHARLOOKSs that ARE being used.)
(replace TXTPARALOOKSLIST of TEXTOBJ with (for LOOKS in PARALOOKS
when (fetch FMTMARK of LOOKS) collect LOOKS))
(* And only those PARALOOKSs that ARE being used.)
])
)
(DEFINEQ
(\TEDIT.CHANGE.LOOKS
[LAMBDA (STREAM NEWLOOKS CH# LEN) (* jds " 5-Aug-85 12:02")
(* * Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection.)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
PCTB PC1 PCNO1 PCNON PCN \INPC FAMILY FONT FACE SIZE PROT SELHERE ULINE OLINE STRIKE
INVERSEVIDEO (SUPER NIL)
(WEIGHT NIL)
(SLOPE NIL)
(SIZEINC NIL)
(OFFSETINC NIL)
(EXPANSION NIL)
(NEWLOOKS NEWLOOKS)
(NLOOKSAVE NEWLOOKS)
(SUB NIL)
(INVISIBLE NIL)
FOOLOOKS NEWFONT DY CHLIM (OLDLOOKSLIST NIL))
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ \INPC (fetch \INSERTPC of TEXTOBJ)) (* Construct the set of new looks to apply:)
(COND
((OR (IGREATERP CH# (fetch TEXTLEN of TEXTOBJ))
(ZEROP LEN)) (* There won't be any text changed by this.
Just punt out.)
(RETURN)))
[COND
((type? CHARLOOKS NEWLOOKS) (* We've already got a made-up set of looks;
we'll just use it.)
)
((FONTP NEWLOOKS) (* If it's a font descriptor, extract what we need from
that.)
(SETQ FONT NEWLOOKS)
(SETQ NEWLOOKS NIL))
(T (* We got an AList -- prepare looks changes in that
form)
(SETQ FONT (LISTGET NEWLOOKS (QUOTE FONT)))
(SETQ FAMILY (LISTGET NEWLOOKS (QUOTE FAMILY)))
(SETQ FACE (LISTGET NEWLOOKS (QUOTE FACE)))
(SETQ SIZE (LISTGET NEWLOOKS (QUOTE SIZE)))
(SETQ PROT (LISTGET NEWLOOKS (QUOTE PROTECTED)))
(SETQ SELHERE (LISTGET NEWLOOKS (QUOTE SELECTPOINT)))
(SETQ ULINE (LISTGET NEWLOOKS (QUOTE UNDERLINE)))
(SETQ OLINE (LISTGET NEWLOOKS (QUOTE OVERLINE)))
(SETQ INVERSEVIDEO (LISTGET NEWLOOKS (QUOTE INVERTED)))
(SETQ STRIKE (LISTGET NEWLOOKS (QUOTE STRIKEOUT)))
(SETQ SUPER (LISTGET NEWLOOKS (QUOTE SUPERSCRIPT)))
(SETQ SUB (LISTGET NEWLOOKS (QUOTE SUBSCRIPT)))
(SETQ WEIGHT (LISTGET NEWLOOKS (QUOTE WEIGHT)))
(SETQ SLOPE (LISTGET NEWLOOKS (QUOTE SLOPE)))
(SETQ EXPANSION (LISTGET NEWLOOKS (QUOTE EXPANSION)))
(SETQ INVISIBLE (LISTGET NEWLOOKS (QUOTE INVISIBLE)))
(SETQ SIZEINC (LISTGET NEWLOOKS (QUOTE SIZEINCREMENT)))
(SETQ OFFSETINC (LISTGET NEWLOOKS (QUOTE OFFSETINCREMENT)))
(SETQ NEWLOOKS NIL) (* Tell later code to use FOOLOOKS)
(SETQ FOOLOOKS NIL)
[COND
(FAMILY (SETQ FOOLOOKS (CONS (QUOTE FAMILY)
(CONS FAMILY FOOLOOKS]
[COND
(FONT (COND
((type? FONTCLASS FONT) (* Needn't do anything. It's a font class.)
)
([SETQ FONT (CAR (NLSETQ (\DTEST FONT (QUOTE FONTDESCRIPTOR]
(* Try converting it to a font--it might be a list or
some such.)
)
(T (* Nothing doing--it isn't any of the reasonable forms,
so punt.)
(TEDIT.PROMPTPRINT (CONCAT FONT " isn't a valid font descriptor.")
T)
(RETURN]
[COND
[(OR WEIGHT SLOPE EXPANSION) (* Setting one of these inhibits the FACE parameter)
[AND WEIGHT (SETQ FOOLOOKS (CONS (QUOTE WEIGHT)
(CONS WEIGHT FOOLOOKS]
[AND SLOPE (SETQ FOOLOOKS (CONS (QUOTE SLOPE)
(CONS SLOPE FOOLOOKS]
(AND EXPANSION (SETQ FOOLOOKS (CONS (QUOTE EXPANSION)
(CONS EXPANSION FOOLOOKS]
(FACE (SETQ FOOLOOKS (CONS (QUOTE FACE)
(CONS FACE FOOLOOKS]
(COND
[SIZE (SETQ FOOLOOKS (CONS (QUOTE SIZE)
(CONS SIZE FOOLOOKS]
(SIZEINC (SETQ FOOLOOKS (CONS (QUOTE SIZE)
(CONS (QUOTE BOGUSSIZE)
FOOLOOKS]
(replace \DIRTY of TEXTOBJ with T) (* Mark the document changed.)
(SETQ CHLIM (IMIN (ADD1 (fetch TEXTLEN of TEXTOBJ))
(IPLUS CH# LEN))) (* last ch to change)
(SETQ PCNO1 (\CHTOPCNO CH# PCTB)) (* Piece # of first piece)
(SETQ PC1 (\EDITELT PCTB (ADD1 PCNO1))) (* Piece the first ch is in)
(COND
((IGREATERP CH# (\EDITELT PCTB PCNO1)) (* If CH# is not first ch in piece, split it.)
(SETQ PC1 (\SPLITPIECE PC1 CH# TEXTOBJ PCNO1))
(* Take 2nd half of the split, which starts with CH#.)
(SETQ PCTB (fetch PCTB of TEXTOBJ)) (* NB: \SplitPiece may make a new PCTB, so copy it
here.)
))
(SETQ PCNON (\CHTOPCNO CHLIM PCTB)) (* Last piece)
(SETQ PCN (\EDITELT PCTB (ADD1 PCNON)))
(COND
[(IEQP CHLIM (\EDITELT PCTB PCNON)) (* CHLIM+1 is the start of a new piece.
just use prevpiece as pcn)
(SETQ PCN (\EDITELT PCTB (SUB1 PCNON]
(T (* If the last char isn't the last char in the piece,
then split it and take the first half.)
(\SPLITPIECE PCN CHLIM TEXTOBJ PCNON)))
[COND
(NEWLOOKS
(* For the case of a completely specified looks, do the following outside the loop: Make sure that this isn't a
duplicate set of looks for this document.)
(SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWLOOKS TEXTOBJ]
[bind (PC ← PC1)
NEWPCLOOKS while (AND PC (NEQ PC PCN))
do
(SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch PLOOKS of PC)))
(* Save old looks for the Undo.)
(COND
(NEWLOOKS (* We got a CHARLOOKS in. Just use it)
(replace PLOOKS of PC with NEWLOOKS))
(T (* Otherwise, we have to override selectively)
[replace PLOOKS of PC with (SETQ NEWPCLOOKS (create CHARLOOKS
using (fetch PLOOKS of PC]
(* If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size
from the current font.)
[replace CLFONT of NEWPCLOOKS
with (SETQ NEWFONT
(OR FONT
(\TEDIT.FONTCOPY
(fetch CLFONT of (fetch PLOOKS of PC))
(COND
(SIZEINC (* There's a size change requested.
Fix up the size of the font.)
(PROGN (LISTPUT FOOLOOKS (QUOTE SIZE)
(IPLUS (FONTPROP (fetch CLFONT
of (fetch PLOOKS
of PC))
(QUOTE SIZE))
SIZEINC))
FOOLOOKS))
(T FOOLOOKS))
TEXTOBJ] (* Give this piece its new looks)
[replace CLBOLD of NEWPCLOOKS with (EQ (QUOTE BOLD)
(FONTPROP NEWFONT (QUOTE WEIGHT]
[replace CLITAL of NEWPCLOOKS with (EQ (QUOTE ITALIC)
(FONTPROP NEWFONT (QUOTE SLOPE]
[AND PROT (replace CLPROTECTED of NEWPCLOOKS with (EQ PROT (QUOTE ON]
[AND SELHERE (replace CLSELHERE of NEWPCLOOKS with (EQ SELHERE (QUOTE ON]
[AND ULINE (replace CLULINE of NEWPCLOOKS with (EQ ULINE (QUOTE ON]
[AND OLINE (replace CLOLINE of NEWPCLOOKS with (EQ OLINE (QUOTE ON]
[AND STRIKE (replace CLSTRIKE of NEWPCLOOKS with (EQ STRIKE (QUOTE ON]
(AND SUPER (replace CLOFFSET of NEWPCLOOKS with SUPER))
(AND SUB (replace CLOFFSET of NEWPCLOOKS with (IMINUS SUB)))
(AND OFFSETINC (replace CLOFFSET of NEWPCLOOKS
with (IPLUS (OR (fetch CLOFFSET of NEWPCLOOKS)
0)
OFFSETINC)))
[AND INVISIBLE (replace CLINVISIBLE of NEWPCLOOKS with (EQ INVISIBLE (QUOTE ON]
[AND INVERSEVIDEO (replace CLINVERTED of NEWPCLOOKS with (EQ INVERSEVIDEO
(QUOTE ON]
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ))
(* Assure that each set of looks appears only once in
the world.)
))
[COND
((EQ PC \INPC)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
(fetch PLOOKS
of PC]
(SETQ PC (fetch NEXTPIECE of PC))
finally
(OR PC (RETURN))
(SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch PLOOKS of PC)))
(COND
(NEWLOOKS (* We got a CHARLOOKS in. Just use it)
(replace PLOOKS of PC with NEWLOOKS))
(T (* Otherwise, we have to override selectively)
[replace PLOOKS of PC with (SETQ NEWPCLOOKS (create CHARLOOKS
using (fetch PLOOKS of PC]
(* If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size
from the current font.)
[replace CLFONT of NEWPCLOOKS
with (SETQ NEWFONT
(OR FONT
(\TEDIT.FONTCOPY
(fetch CLFONT of (fetch PLOOKS of PC))
(COND
(SIZEINC (PROGN (LISTPUT FOOLOOKS (QUOTE SIZE)
(IPLUS (FONTPROP (fetch CLFONT
of (fetch PLOOKS
of PC))
(QUOTE SIZE))
SIZEINC))
FOOLOOKS))
(T FOOLOOKS))
TEXTOBJ] (* Give this piece its new looks)
[replace CLBOLD of NEWPCLOOKS with (EQ (QUOTE BOLD)
(FONTPROP NEWFONT (QUOTE WEIGHT]
[replace CLITAL of NEWPCLOOKS with (EQ (QUOTE ITALIC)
(FONTPROP NEWFONT (QUOTE SLOPE]
[AND PROT (replace CLPROTECTED of NEWPCLOOKS with (EQ PROT (QUOTE ON]
[AND SELHERE (replace CLSELHERE of NEWPCLOOKS with (EQ SELHERE (QUOTE ON]
[AND ULINE (replace CLULINE of NEWPCLOOKS with (EQ ULINE (QUOTE ON]
[AND OLINE (replace CLOLINE of NEWPCLOOKS with (EQ OLINE (QUOTE ON]
[AND STRIKE (replace CLSTRIKE of NEWPCLOOKS with (EQ STRIKE (QUOTE ON]
(AND SUPER (replace CLOFFSET of NEWPCLOOKS with SUPER))
(AND SUB (replace CLOFFSET of NEWPCLOOKS with (IMINUS SUB)))
[AND INVISIBLE (replace CLINVISIBLE of NEWPCLOOKS with (EQ INVISIBLE (QUOTE ON]
[AND INVERSEVIDEO (replace CLINVERTED of NEWPCLOOKS with (EQ INVERSEVIDEO
(QUOTE ON]
[AND OFFSETINC (replace CLOFFSET of NEWPCLOOKS
with (IPLUS OFFSETINC (OR (fetch CLOFFSET of NEWPCLOOKS)
0]
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
(replace PLOOKS of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ]
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CHLIM)
(COND
((fetch \WINDOW of TEXTOBJ)
(\SHOWSEL (fetch SEL of TEXTOBJ)
NIL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE (fetch SEL of TEXTOBJ))
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* Update the screen image)
(\FIXSEL (fetch SEL of TEXTOBJ)
TEXTOBJ)
(\SHOWSEL (fetch SEL of TEXTOBJ)
NIL T)))
(replace \INSERTPCVALID of TEXTOBJ with NIL)
(RETURN (LIST OLDLOOKSLIST NLOOKSAVE PC1])
(TEDIT.LOOKS
[LAMBDA (STREAM NEWLOOKS SELORCH# LEN) (* jds " 5-Aug-85 12:03")
(* Programmatic interface for character looks in TEdit)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
TSEL)
[SETQ TSEL (COND
((type? SELECTION SELORCH#)
SELORCH#)
(SELORCH# (TEDIT.SETSEL TEXTOBJ SELORCH# LEN (QUOTE LEFT)))
(T (fetch SEL of TEXTOBJ]
(COND
((NOT (fetch SET of TSEL)) (* No selection to change the looks of.
Can't do anything!)
(RETURN)))
(COND
((SETQ CHANGERESULT (\TEDIT.CHANGE.LOOKS STREAM NEWLOOKS (fetch CH# of TSEL)
(fetch DCH of TSEL)))
(* Go actually change the looks)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Looks)
THLEN ←(fetch DCH of TSEL)
THCH# ←(fetch CH# of TSEL)
THFIRSTPIECE ←(CADDR CHANGERESULT)
THOLDINFO ←(CAR CHANGERESULT)
THAUXINFO ←(CADR CHANGERESULT)))
(* Save this action for undo/redo)
])
(\TEDIT.LOOKS
[LAMBDA (TEXTOBJ) (* jds " 6-Mar-85 12:34")
(* Handler for the middle-button menu's LOOKS button. Brings up 3 menus, for font, face, and size.
Then calls TEDIT.LOOKS to make the requested changes.)
(PROG [(SEL (fetch SEL of TEXTOBJ))
(FONT NIL)
(FACE NIL)
(SIZE NIL)
NEWLOOKS
(POS (create POSITION
XCOORD ←(fetch LEFT of (WINDOWPROP (CAR (fetch \WINDOW of TEXTOBJ))
(QUOTE REGION)))
YCOORD ←(fetch TOP of (WINDOWPROP (CAR (fetch \WINDOW of TEXTOBJ))
(QUOTE REGION]
(COND
((IGREATERP (fetch CH# of SEL)
(fetch TEXTLEN of TEXTOBJ)) (* Nothing to change, really)
(RETURN))
[(fetch SET of SEL) (* He's got something selected.)
(SETQ FONT (MENU (create MENU
TITLE ← "Font:"
ITEMS ←(NCONC1 (COPY TEDIT.KNOWN.FONTS)
(LIST (QUOTE Other)
(LIST (FUNCTION TEDIT.NEW.FONT)
TEXTOBJ)))
CENTERFLG ← T)
POS)) (* Set the font for the new text.)
(SETQ FACE (SELECTQ (MENU TEDIT.FACE.MENU POS)
(Bold (QUOTE BOLD))
(Italic (QUOTE ITALIC))
(Bold% Italic (QUOTE BOLDITALIC))
(Regular (QUOTE STANDARD))
NIL)) (* Set the face (bold, etc.))
(SETQ SIZE (MENU TEDIT.SIZE.MENU POS)) (* Set the type size)
(* Construct the set of new looks to apply:)
(COND
(FONT (SETQ NEWLOOKS (LIST (QUOTE FAMILY)
FONT)))
(T (SETQ NEWLOOKS NIL))) (* The font)
[COND
(FACE (SETQ NEWLOOKS (CONS (QUOTE FACE)
(CONS FACE NEWLOOKS]
(* The face)
[COND
(SIZE (SETQ NEWLOOKS (CONS (QUOTE SIZE)
(CONS SIZE NEWLOOKS]
(* The size)
(COND
(NEWLOOKS (* If there's something to do, do it.)
(TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL]
(T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])
(\TEDIT.FONTCOPY
[LAMBDA (FONT NEWSPECS TEXTOBJ) (* jds "26-Dec-84 16:06")
(* Cloak FONTCOPY in protection for the user from an
unavailable font.)
(COND
((NULL NEWSPECS) (* No changes specified. Punt it.)
FONT)
[(CAR (NLSETQ (FONTCOPY FONT NEWSPECS]
(T (PROG [(OLDFAMILY (FONTPROP FONT (QUOTE FAMILY)))
(OLDSIZE (FONTPROP FONT (QUOTE SIZE]
(TEDIT.PROMPTPRINT TEXTOBJ [CONCAT "Can't find font " (OR (LISTGET NEWSPECS
(QUOTE FAMILY))
OLDFAMILY)
" "
(OR (LISTGET NEWSPECS (QUOTE SIZE))
OLDSIZE)
" "
(OR (LISTGET NEWSPECS (QUOTE FACE))
(FONTPROP FONT (QUOTE FACE]
T))
FONT])
(TEDIT.GET.LOOKS
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* jds "10-Jul-85 16:02")
(* Return a PLIST of character looks)
(PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
LOOKS FONT NLOOKS)
[COND
((type? CHARLOOKS CH#ORCHARLOOKS) (* He handed us a CHARLOOKS.
Unparse it for him.)
(SETQ LOOKS CH#ORCHARLOOKS))
((ZEROP (fetch TEXTLEN of TEXTOBJ)) (* There's no text in the document.
Use the extant caret looks.)
(SETQ LOOKS (fetch CARETLOOKS of TEXTOBJ)))
[(FIXP CH#ORCHARLOOKS) (* He gave us a CH# to geth the looks of.
Grab it.)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ)
CH#ORCHARLOOKS)
(fetch PCTB of TEXTOBJ]
[(type? SELECTION CH#ORCHARLOOKS) (* Get the looks of the selected text)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ)
(fetch (SELECTION CH#) of CH#ORCHARLOOKS))
(fetch PCTB of TEXTOBJ]
((NULL CH#ORCHARLOOKS) (* Get the looks of the selected text)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ)
(fetch (SELECTION CH#)
of (fetch SEL of TEXTOBJ)))
(fetch PCTB of TEXTOBJ]
(* * Now break the looks apart into a PROPLIST)
(SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS))
(RETURN NLOOKS])
)
(* Paragraph looks functions)
(DEFINEQ
(\TEDIT.GET.PARALOOKS
[LAMBDA (FILE PARAHASH) (* jds "31-Jan-85 15:47")
(* Read a paragraph format spec from the FILE, and
return it for later use.)
(ELT PARAHASH (\SMALLPIN FILE])
(EQFMTSPEC
[LAMBDA (PARALOOK1 PARALOOK2) (* jds "31-Jul-85 22:40")
(* Given two sets of FMTSPECS are they effectively the
same?)
(OR (EQ PARALOOK1 PARALOOK2)
(AND (EQP (fetch 1STLEFTMAR of PARALOOK1)
(fetch 1STLEFTMAR of PARALOOK2))
(EQP (fetch LEFTMAR of PARALOOK1)
(fetch LEFTMAR of PARALOOK2))
(EQP (fetch RIGHTMAR of PARALOOK1)
(fetch RIGHTMAR of PARALOOK2))
(EQP (fetch LEADBEFORE of PARALOOK1)
(fetch LEADBEFORE of PARALOOK2))
(EQP (fetch LEADAFTER of PARALOOK1)
(fetch LEADAFTER of PARALOOK2))
(EQP (fetch LINELEAD of PARALOOK1)
(fetch LINELEAD of PARALOOK2))
(EQUALALL (fetch TABSPEC of PARALOOK1)
(fetch TABSPEC of PARALOOK2))
(EQ (fetch QUAD of PARALOOK1)
(fetch QUAD of PARALOOK2))
(EQ (fetch FMTSTYLE of PARALOOK1)
(fetch FMTSTYLE of PARALOOK2))
(EQ (fetch FMTUSERINFO of PARALOOK1)
(fetch FMTUSERINFO of PARALOOK2))
(EQ (fetch FMTSPECIALX of PARALOOK1)
(fetch FMTSPECIALX of PARALOOK2))
(EQ (fetch FMTSPECIALY of PARALOOK1)
(fetch FMTSPECIALY of PARALOOK2))
(EQ (fetch FMTHEADINGKEEP of PARALOOK1)
(fetch FMTHEADINGKEEP of PARALOOK2))
(EQ (fetch FMTKEEP of PARALOOK1)
(fetch FMTKEEP of PARALOOK2))
(EQ (fetch FMTPARATYPE of PARALOOK1)
(fetch FMTPARATYPE of PARALOOK2))
(EQ (fetch FMTPARASUBTYPE of PARALOOK1)
(fetch FMTPARASUBTYPE of PARALOOK2))
(EQ (fetch FMTNEWPAGEBEFORE of PARALOOK1)
(fetch FMTNEWPAGEBEFORE of PARALOOK2))
(EQ (fetch FMTNEWPAGEAFTER of PARALOOK1)
(fetch FMTNEWPAGEAFTER of PARALOOK2))
(EQ (fetch FMTBASETOBASE of PARALOOK1)
(fetch FMTBASETOBASE of PARALOOK2))
(EQ (fetch FMTHARDCOPY of PARALOOK1)
(fetch FMTHARDCOPY of PARALOOK2])
(\TEDIT.UNIQUIFY.PARALOOKS
[LAMBDA (NEWLOOKS TEXTOBJ) (* jds "30-Jan-85 17:14")
(* Assure that there is only ONE of a given PARALOOKS
in the document--so that all instances of that set of
looks share structure.)
(COND
((for LOOK in (fetch TXTPARALOOKSLIST of TEXTOBJ) thereis (EQFMTSPEC NEWLOOKS LOOK)))
(T (push (fetch TXTPARALOOKSLIST of TEXTOBJ)
NEWLOOKS)
NEWLOOKS])
(TEDIT.GET.PARALOOKS
[LAMBDA (TEXTSTREAM SELORCH#) (* gbn "19-Nov-84 17:28")
(PROG [(SEL (OR SELORCH# (fetch SEL of (TEXTOBJ TEXTSTREAM]
(RETURN (\TEDIT.UNPARSE.PARALOOKS.LIST (fetch PPARALOOKS
of (\CHTOPC (SELECTQ (TYPENAME SEL)
(SELECTION (fetch CH#
of SEL))
((FIXP SMALLP)
SEL)
(\ILLEGAL.ARG SEL))
(fetch PCTB of (TEXTOBJ TEXTSTREAM])
(\TEDIT.UNPARSE.PARALOOKS.LIST
[LAMBDA (FMTSPEC) (* jds "31-Jul-85 22:29")
(* Convert a FMTSPEC into an equivalent PList-form for
external consumption)
(PROG ((NEWLOOKS NIL))
(for PROP in (LIST (fetch QUAD of FMTSPEC)
(fetch 1STLEFTMAR of FMTSPEC)
(fetch LEFTMAR of FMTSPEC)
(fetch RIGHTMAR of FMTSPEC)
(fetch LEADBEFORE of FMTSPEC)
(fetch LEADAFTER of FMTSPEC)
(fetch LINELEAD of FMTSPEC)
(fetch FMTBASETOBASE of FMTSPEC)
(fetch TABSPEC of FMTSPEC)
(fetch FMTSTYLE of FMTSPEC)
(fetch FMTCHARSTYLES of FMTSPEC)
(fetch FMTUSERINFO of FMTSPEC)
(fetch FMTSPECIALX of FMTSPEC)
(fetch FMTSPECIALY of FMTSPEC)
(fetch FMTHEADINGKEEP of FMTSPEC)
(fetch FMTPARATYPE of FMTSPEC)
(fetch FMTPARASUBTYPE of FMTSPEC)
(fetch FMTNEWPAGEBEFORE of FMTSPEC)
(fetch FMTNEWPAGEAFTER of FMTSPEC)
(fetch FMTHEADINGKEEP of FMTSPEC)
(fetch FMTKEEP of FMTSPEC)
(fetch FMTHARDCOPY of FMTSPEC))
as PROPNAME
in (QUOTE (QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING
LINELEADING BASETOBASE TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY
TYPE SUBTYPE NEWPAGEBEFORE NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY))
as METHOD
in (QUOTE (VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE
VALUE VALUE VALUE VALUE VALUE ONOFF VALUE VALUE))
do (SELECTQ METHOD
(VALUE (* Give him the value straight from the looks)
(push NEWLOOKS PROP))
(ONOFF (* Translate T/NIL into ON/OFF)
(push NEWLOOKS (ONOFF PROP)))
(SHOULDNT))
(push NEWLOOKS PROPNAME))
(RETURN NEWLOOKS])
(\TEDIT.APPLY.PARASTYLES
[LAMBDA (PARALOOKS PC TEXTOBJ) (* jds "17-Jun-84 15:39")
(* Given a set of looks, return the looks with the
proper styles expanded out.)
(\TEDIT.CHECK (type? FMTSPEC PARALOOKS)) (* Incoming thing has to be a LOOKS.)
(COND
((NULL (fetch FMTSTYLE of PARALOOKS))
PARALOOKS)
((LITATOM (fetch FMTSTYLE of PARALOOKS)) (* Call the guy's function to find the new looks)
(APPLY* (fetch FMTSTYLE of PARALOOKS)
PARALOOKS PC TEXTOBJ))
((ZEROP (fetch FMTSTYLE of PARALOOKS))
PARALOOKS)
(T (* This looks has a style attached.
Use it.)
(CAR (NTH TEDIT.STYLES (fetch FMTSTYLE of PARALOOKS])
(\TEDIT.PARSE.PARALOOKS.LIST
[LAMBDA (NEWLOOKS OLDLOOKS) (* jds "12-Jun-85 08:12")
(* Apply a given format spec to the paragraphs which
are included in this guy.)
(PROG (D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD
NLOOKSAVE PC1 TYPE SUBTYPE TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET
NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET)
(COND
((type? FMTSPEC NEWLOOKS) (* if we were given an FMTSPEC really replace the
FMTSPEC of all pieces affected)
(RETURN NEWLOOKS))
(T (* create an FMTSPEC from the Alist)
(SETQ 1STLEFT (LISTGET NEWLOOKS (QUOTE 1STLEFTMARGIN)))
(SETQ LEFT (LISTGET NEWLOOKS (QUOTE LEFTMARGIN)))
(SETQ RIGHT (LISTGET NEWLOOKS (QUOTE RIGHTMARGIN)))
(SETQ LEADB (LISTGET NEWLOOKS (QUOTE PARALEADING)))
(SETQ LEADA (LISTGET NEWLOOKS (QUOTE POSTPARALEADING)))
(SETQ LLEAD (LISTGET NEWLOOKS (QUOTE LINELEADING)))
(SETQ TYPESET (FMEMB (QUOTE TYPE)
NEWLOOKS))
(SETQ TYPE (LISTGET NEWLOOKS (QUOTE TYPE)))
(SETQ SUBTYPESET (FMEMB (QUOTE SUBTYPE)
NEWLOOKS))
(SETQ SUBTYPE (LISTGET NEWLOOKS (QUOTE SUBTYPE)))
(SETQ NEWBEFORESET (FMEMB (QUOTE NEWPAGEBEFORE)
NEWLOOKS))
(SETQ NEWBEFORE (LISTGET NEWLOOKS (QUOTE NEWPAGEBEFORE)))
(SETQ NEWAFTERSET (FMEMB (QUOTE NEWPAGEAFTER)
NEWLOOKS))
(SETQ NEWAFTER (LISTGET NEWLOOKS (QUOTE NEWPAGEAFTER)))
(SETQ HEADINGKEEP (LISTGET NEWLOOKS (QUOTE HEADINGKEEP)))
(* Keep for headings)
(SETQ KEEP (LISTGET NEWLOOKS (QUOTE KEEP))) (* More general "Keep-together" spec -- undefined as of
5/22/85)
(SETQ KEEPSET (FMEMB (QUOTE KEEP)
NEWLOOKS))
(SETQ BASETOBASE (LISTGET NEWLOOKS (QUOTE BASETOBASE)))
(SETQ BASESET (FMEMB (QUOTE BASETOBASE)
NEWLOOKS))
(SETQ QUADD (LISTGET NEWLOOKS (QUOTE QUAD)))
[SELECTQ QUADD
((LEFT RIGHT CENTERED JUSTIFIED) (* Do nothing -- we got a valid justification spec)
)
((JUST J)
(SETQ QUADD (QUOTE JUSTIFIED)))
((NIL L)
(SETQQ QUADD LEFT))
(R (SETQQ QUADD RIGHT))
((C CENTER)
(SETQQ QUADD CENTERED))
(PROGN (* We got an illegal QUAD value.
Use LEFT.)
(TEDIT.PROMPTPRINT (AND (BOUNDP (QUOTE TEXTOBJ))
TEXTOBJ)
(CONCAT "Illegal paragraph quad " QUADD
", replaced with LEFT.")
T)
(SETQ QUADD (QUOTE LEFT]
(SETQ TABSPECC (LISTGET NEWLOOKS (QUOTE TABS)))
(* change from the users list to the real tabspec -
CONS pair of default width and LIST of TAB record
instances)
[COND
(TABSPECC (SETQ TABSPECC (CONS [OR (CAR TABSPECC)
(AND OLDLOOKS (CAR (fetch TABSPEC of OLDLOOKS]
(for SPEC in (CDR TABSPECC)
collect (create TAB
TABKIND ←(CDR SPEC)
TABX ←(CAR SPEC]
(SETQ NEWLOOKS (OR OLDLOOKS (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)))
(AND 1STLEFT (replace 1STLEFTMAR of NEWLOOKS with 1STLEFT))
(AND LEFT (replace LEFTMAR of NEWLOOKS with LEFT))
(AND RIGHT (replace RIGHTMAR of NEWLOOKS with RIGHT))
(AND LEADB (replace LEADBEFORE of NEWLOOKS with LEADB))
(AND LEADA (replace LEADAFTER of NEWLOOKS with LEADA))
(AND LLEAD (replace LINELEAD of NEWLOOKS with LLEAD))
(AND TABSPECC (replace TABSPEC of NEWLOOKS with TABSPECC))
(AND QUADD (replace QUAD of NEWLOOKS with QUADD))
(AND TYPESET (replace FMTPARATYPE of NEWLOOKS with TYPE))
(AND SUBTYPESET (replace FMTPARASUBTYPE of NEWLOOKS with SUBTYPE))
(AND NEWBEFORESET (replace FMTNEWPAGEBEFORE of NEWLOOKS with NEWBEFORE))
(AND NEWAFTERSET (replace FMTNEWPAGEAFTER of NEWLOOKS with NEWAFTER))
[AND HEADINGKEEP (replace FMTHEADINGKEEP of NEWLOOKS with (EQ HEADINGKEEP
(QUOTE ON]
(AND KEEPSET (replace FMTKEEP of NEWLOOKS with KEEP))
(AND BASESET (replace FMTBASETOBASE of NEWLOOKS with BASETOBASE))
(RETURN NEWLOOKS])
(TEDIT.PARALOOKS
[LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* jds " 1-Aug-85 00:24")
(* Apply a given format spec to the paragraphs which
are included in this guy.)
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(PROG ([SEL (COND
((type? SELECTION SEL)
SEL)
((FIXP SEL)
(TEDIT.SETSEL TEXTOBJ SEL LEN (QUOTE RIGHT)))
(T (fetch SEL of TEXTOBJ]
CH# CHLIM REPLACEALLFIELDS D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB
LEADA BLEAD BLEADSET LLEAD TABSPECC QUADD NLOOKSAVE PC1 OLDLOOKSLIST TYPE SUBTYPE TYPESET
SUBTYPESET SPECIALX SPECIALY NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET
HEADINGKEEP BASETOBASE BASESET HCPYMODE HCPYSET)
(SETQ CH# (fetch CH# of SEL)) (* First affected character)
[SETQ CHLIM (IMAX CH# (SUB1 (fetch CHLIM of SEL] (* Last affected character.)
(COND
((IGREATERP (OR LEN (SETQ LEN (fetch DCH of SEL)))
(fetch TEXTLEN of TEXTOBJ)) (* Can't change the para looks of something beyond end
of text.)
(RETURN))
((NOT (fetch SET of SEL)) (* Can't do anything if there is no selection set in
the main document)
(RETURN)))
(COND
((NOT (fetch FORMATTEDP of TEXTOBJ))
(\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ)))
(SETQ PCTB (fetch PCTB of TEXTOBJ)) (* Because it may grow during the conversion to
formatted.)
(SETQ PCNO (\CHTOPCNO CH# PCTB)) (* Starting point for the scan thru the piece table)
(SETQ PC (\EDITELT PCTB (ADD1 PCNO)))
(SETQ PC1 PC)
(SETQ NLOOKSAVE NEWLOOKS)
[COND
((type? FMTSPEC NEWLOOKS) (* if we were given an FMTSPEC really replace the
FMTSPEC of all pieces affected)
(SETQ D (create FMTSPEC copying NEWLOOKS)) (* Create the universal replacement looks)
(SETQ REPLACEALLFIELDS T) (* And set the replace-everything flag.)
)
(T (* create an FMTSPEC from the Alist)
(SETQ 1STLEFT (LISTGET NEWLOOKS (QUOTE 1STLEFTMARGIN)))
(SETQ LEFT (LISTGET NEWLOOKS (QUOTE LEFTMARGIN)))
(SETQ RIGHT (LISTGET NEWLOOKS (QUOTE RIGHTMARGIN)))
(SETQ LEADB (LISTGET NEWLOOKS (QUOTE PARALEADING)))
(SETQ LEADA (LISTGET NEWLOOKS (QUOTE POSTPARALEADING)))
(SETQ LLEAD (LISTGET NEWLOOKS (QUOTE LINELEADING)))
(SETQ BLEAD (LISTGET NEWLOOKS (QUOTE BASETOBASE)))
(SETQ BLEADSET (FMEMB (QUOTE BASETOBASE)
NEWLOOKS))
(SETQ QUADD (LISTGET NEWLOOKS (QUOTE QUAD)))
(SETQ TYPESET (FMEMB (QUOTE TYPE)
NEWLOOKS))
(SETQ TYPE (LISTGET NEWLOOKS (QUOTE TYPE)))
(SETQ SUBTYPESET (FMEMB (QUOTE SUBTYPE)
NEWLOOKS))
(SETQ SUBTYPE (LISTGET NEWLOOKS (QUOTE SUBTYPE)))
(SETQ SPECIALX (LISTGET NEWLOOKS (QUOTE SPECIALX)))
(SETQ SPECIALY (LISTGET NEWLOOKS (QUOTE SPECIALY)))
(SETQ NEWBEFORESET (FMEMB (QUOTE NEWPAGEBEFORE)
NEWLOOKS))
(SETQ NEWBEFORE (LISTGET NEWLOOKS (QUOTE NEWPAGEBEFORE)))
(SETQ NEWAFTERSET (FMEMB (QUOTE NEWPAGEAFTER)
NEWLOOKS))
(SETQ NEWAFTER (LISTGET NEWLOOKS (QUOTE NEWPAGEAFTER)))
(SETQ HEADINGKEEP (LISTGET NEWLOOKS (QUOTE HEADINGKEEP)))
(* Keep for headings)
(SETQ KEEP (LISTGET NEWLOOKS (QUOTE KEEP))) (* More general "Keep-together" spec -- undefined as of
5/22/85)
(SETQ KEEPSET (FMEMB (QUOTE KEEP)
NEWLOOKS))
(SETQ BASETOBASE (LISTGET NEWLOOKS (QUOTE BASETOBASE)))
(SETQ BASESET (FMEMB (QUOTE BASETOBASE)
NEWLOOKS))
(SETQ HCPYMODE (LISTGET NEWLOOKS (QUOTE HARDCOPY)))
(SETQ HCPYSET (FMEMB (QUOTE HARDCOPY)
NEWLOOKS))
(SETQ TABSPECC (LISTGET NEWLOOKS (QUOTE TABS)))
(* change from the users list to the real tabspec -
CONS pair of default width and LIST of TAB record
instances)
(COND
(TABSPECC (SETQ TABSPECC (CONS [OR (COND
((AND (CAR TABSPECC)
(ZEROP (CAR TABSPECC)))
1)
(T (CAR TABSPECC)))
(CAR (fetch TABSPEC of (fetch PPARALOOKS
of PC]
(for SPEC in (CDR TABSPECC)
collect (create TAB
TABKIND ←(CDR SPEC)
TABX ←(CAR SPEC]
[COND
(REPLACEALLFIELDS (* Given that we're replacing the FMTSPEC wholesale,
let's uniquify it within this document OUTSIDE the
loop.)
(SETQ D (\TEDIT.UNIQUIFY.PARALOOKS D TEXTOBJ]
(bind (NPC ← PC) for PC# from (IPLUS PCNO \EltsPerPiece) by \EltsPerPiece while NPC
do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch PPARALOOKS of NPC)))
[COND
(REPLACEALLFIELDS
(* We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified
(and recorded in the master list) already.)
(replace PPARALOOKS of NPC with D))
(T (* Only replacing part of the looks;
create a new one, and smash it.)
(COND
[(NEQ (fetch PPARALOOKS of NPC)
LASTLOOKS) (* only build a new FMTSPEC when they are different)
(SETQ LASTLOOKS (fetch PPARALOOKS of NPC))
(SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS))
(AND 1STLEFT (replace 1STLEFTMAR of NEWLOOKS with 1STLEFT))
(AND LEFT (replace LEFTMAR of NEWLOOKS with LEFT))
(AND RIGHT (replace RIGHTMAR of NEWLOOKS with RIGHT))
(AND LEADB (replace LEADBEFORE of NEWLOOKS with LEADB))
(AND LEADA (replace LEADAFTER of NEWLOOKS with LEADA))
(AND BLEADSET (replace FMTBASETOBASE of NEWLOOKS with BLEAD))
(AND LLEAD (replace LINELEAD of NEWLOOKS with LLEAD))
(AND TABSPECC (replace TABSPEC of NEWLOOKS with TABSPECC))
(AND QUADD (replace QUAD of NEWLOOKS with QUADD))
(AND TYPESET (replace FMTPARATYPE of NEWLOOKS with TYPE))
(AND SUBTYPESET (replace FMTPARASUBTYPE of NEWLOOKS with SUBTYPE))
(AND SPECIALX (replace FMTSPECIALX of NEWLOOKS with SPECIALX))
(AND SPECIALY (replace FMTSPECIALY of NEWLOOKS with SPECIALY))
(AND NEWBEFORESET (replace FMTNEWPAGEBEFORE of NEWLOOKS with NEWBEFORE))
(AND NEWAFTERSET (replace FMTNEWPAGEAFTER of NEWLOOKS with NEWAFTER))
[AND HEADINGKEEP (replace FMTHEADINGKEEP of NEWLOOKS
with (EQ HEADINGKEEP (QUOTE ON]
(AND KEEPSET (replace FMTKEEP of NEWLOOKS with KEEP))
(AND BASESET (replace FMTBASETOBASE of NEWLOOKS with BASETOBASE))
(AND HCPYSET (replace FMTHARDCOPY of NEWLOOKS with HCPYMODE))
(replace PPARALOOKS of NPC with (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS
NEWLOOKS TEXTOBJ]
(T (* Re-use the last set of looks;
they're still what we want (this paragraph looks like
the last one.))
(replace PPARALOOKS of NPC with NEWLOOKS]
[SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM (\EDITELT PCTB PC#]
(COND
((fetch PPARALAST of NPC) (* We've found the end of a paragraph.
Stop to see if we've run off the end yet.)
(COND
((IGEQ NCHLIM (SUB1 (fetch CHLIM of SEL)))
(RETURN))) (* Make a new set of looks.)
))
(SETQ NPC (fetch NEXTPIECE of NPC)))
(SETQ LASTLOOKS NIL)
[bind (NPC ←(fetch PREVPIECE of PC)) for PC# from PCNO by -2
while (AND NPC (NOT (fetch PPARALAST of NPC)))
do (SETQ OLDLOOKSLIST (CONS (fetch PPARALOOKS of NPC)
OLDLOOKSLIST))
[COND
(REPLACEALLFIELDS
(* We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified
(and recorded in the master list) already.)
(replace PPARALOOKS of NPC with D))
(T (* Only replacing part of the looks;
create a new one, and smash it.)
(COND
[(NEQ (fetch PPARALOOKS of NPC)
LASTLOOKS) (* only build a new FMTSPEC when they are different)
(SETQ LASTLOOKS (fetch PPARALOOKS of NPC))
(SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS))
(AND 1STLEFT (replace 1STLEFTMAR of NEWLOOKS with 1STLEFT))
(AND LEFT (replace LEFTMAR of NEWLOOKS with LEFT))
(AND RIGHT (replace RIGHTMAR of NEWLOOKS with RIGHT))
(AND LEADB (replace LEADBEFORE of NEWLOOKS with LEADB))
(AND LEADA (replace LEADAFTER of NEWLOOKS with LEADA))
(AND LLEAD (replace LINELEAD of NEWLOOKS with LLEAD))
(AND TABSPECC (replace TABSPEC of NEWLOOKS with TABSPECC))
(AND QUADD (replace QUAD of NEWLOOKS with QUADD))
(AND TYPESET (replace FMTPARATYPE of NEWLOOKS with TYPE))
(AND SUBTYPESET (replace FMTPARASUBTYPE of NEWLOOKS with SUBTYPE))
(AND SPECIALX (replace FMTSPECIALX of NEWLOOKS with SPECIALX))
(AND SPECIALY (replace FMTSPECIALY of NEWLOOKS with SPECIALY))
(AND NEWBEFORESET (replace FMTNEWPAGEBEFORE of NEWLOOKS with NEWBEFORE))
(AND NEWAFTERSET (replace FMTNEWPAGEAFTER of NEWLOOKS with NEWAFTER))
[AND HEADINGKEEP (replace FMTHEADINGKEEP of NEWLOOKS
with (EQ HEADINGKEEP (QUOTE ON]
(AND KEEPSET (replace FMTKEEP of NEWLOOKS with KEEP))
(AND BASESET (replace FMTBASETOBASE of NEWLOOKS with BASETOBASE))
(AND HCPYSET (replace FMTHARDCOPY of NEWLOOKS with HCPYMODE))
(replace PPARALOOKS of NPC with (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS
NEWLOOKS TEXTOBJ]
(T (* Re-use the last set of looks;
they're still what we want (this paragraph looks like
the last one.))
(replace PPARALOOKS of NPC with NEWLOOKS]
(SETQ PC1 NPC)
(SETQ NPC (fetch PREVPIECE of NPC))
finally (SETQ CH# (IMIN CH# (IMAX 1 (\EDITELT PCTB PC#]
(\SHOWSEL (fetch SEL of TEXTOBJ)
NIL NIL) (* Turn off the sel before updating the screen)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 CHLIM))
(replace \DIRTY of TEXTOBJ with T) (* Mark the document as changed.)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE ParaLooks)
THLEN ←(IDIFFERENCE CHLIM CH#)
THCH# ← CH#
THFIRSTPIECE ← PC1
THOLDINFO ← OLDLOOKSLIST
THAUXINFO ← NLOOKSAVE))
(* Save this action for undo/redo)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(COND
((fetch \WINDOW of TEXTOBJ)
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* Update the screen image)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T])
(TEDIT.COPY.PARALOOKS
[LAMBDA (STREAM SOURCE DEST) (* jds " 5-Dec-84 11:34")
(* Copy the PARAGRAPH LOOKS from one place to another)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
LOOKS LEN) (* get the paragraph looks of the first character of
SOURCE)
[SETQ LOOKS (fetch PPARALOOKS of (SELECTQ (TYPENAME SOURCE)
((SMALLP FIXP)
(\CHTOPC SOURCE (fetch PCTB of TEXTOBJ)))
[SELECTION (\SHOWSEL SOURCE NIL NIL)
(* Turn off the looks-source selection)
(\CHTOPC (fetch CH# of SOURCE)
(fetch PCTB
of (fetch \TEXTOBJ
of SOURCE]
(\ILLEGAL.ARG SOURCE]
(COND
[(type? SELECTION DEST) (* make sure that the destination selection is in this
document)
(COND
((NEQ TEXTOBJ (fetch \TEXTOBJ of DEST))
(\LISPERROR "Destination selection is not in stream " STREAM]
(T (* set the LEN arg for TEDIT.PARALOOKS to be 1 since we
just have a char pos.)
(SETQ LEN 1)))
(TEDIT.PARALOOKS TEXTOBJ LOOKS DEST LEN])
(\TEDIT.PUT.PARALOOKS
[LAMBDA (FILE PC PARAHASH) (* jds "31-Jan-85 15:44")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((LOOKS (fetch PPARALOOKS of PC))
DEFAULTTAB TABSPECS OUTPUTFORMAT)
(\DWOUT FILE 0) (* Place holder for number of characters in the piece
-- really taken from the charlooks.)
(\SMALLPOUT FILE \PieceDescriptorPARA) (* Identify this as a paragraph looks piece)
(\SMALLPOUT FILE (GETHASH LOOKS PARAHASH])
(\TEDIT.CONVERT.TO.FORMATTED
[LAMBDA (TEXTOBJ START END) (* jds "16-Nov-84 10:09")
(* Turn an unformatted TEdit file into a formatted
TEdit file.)
(PROG ((NEXTCR (\TEDIT.BASICFIND TEXTOBJ (MKSTRING (CHARACTER (CHARCODE CR)))
(OR START 1)))
(PCTB (fetch PCTB of TEXTOBJ))
[CRSTRING (MKSTRING (CHARACTER (CHARCODE CR]
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
PCNO PC)
[while (AND NEXTCR (ILEQ NEXTCR (OR END TEXTLEN)))
do (* Look at each CR in the range given
(or whole file) and insert paragraph breaks
accordingly.)
(SETQ PCNO (\CHTOPCNO NEXTCR (fetch PCTB of TEXTOBJ)))
[COND
[(IEQP (ADD1 NEXTCR)
(\EDITELT PCTB (IPLUS \EltsPerPiece PCNO)))
(* This para ends on a piece bound.)
(SETQ PC (\EDITELT PCTB (ADD1 PCNO]
(T (* The CR is in mid-piece. Split just after it.)
(SETQ PC (\EDITELT PCTB (ADD1 PCNO)))
(\SPLITPIECE PC (ADD1 NEXTCR)
TEXTOBJ PCNO)
(SETQ PCTB (fetch PCTB of TEXTOBJ]
(replace PPARALAST of PC with T)
(SETQ NEXTCR (\TEDIT.BASICFIND TEXTOBJ CRSTRING (ADD1 NEXTCR]
(replace FORMATTEDP of TEXTOBJ with T)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ (OR START 1)
(OR END TEXTLEN])
(\TEDIT.PARABOUNDS
[LAMBDA (TEXTOBJ CH#) (* jds "13-Apr-84 17:16")
(* returns the first and last chars of the paragraph
bracketed by CH#)
(PROG ((PCTB (fetch PCTB of TEXTOBJ))
PCNO NPC PC BEGIN END PIECE)
[COND
((ZEROP (fetch TEXTLEN of TEXTOBJ)) (* An empty document has no paragraphs.)
(RETURN (CONS 1 1]
(SETQ PCNO (\CHTOPCNO CH# PCTB))
(SETQ PC (\EDITELT PCTB (ADD1 PCNO)))
(COND
((ATOM PC) (* OOPS, we found the end-of-doc piece.
Back up to the last real piece in the document.)
(SETQ PC (\EDITELT PCTB (SUB1 PCNO)))
(add PCNO -2) (* And adjust the pc counter.)
))
(SETQ PIECE PC)
(for old NPC from PCNO by \EltsPerPiece while (AND PIECE (NOT (fetch PPARALAST
of PIECE)))
do (* Find the piece that ends the paragraph)
(SETQ PIECE (fetch NEXTPIECE of PIECE)))
[SETQ END (COND
[PIECE (* This is the piece that ends the para.
Get the CH# of its final character)
(SUB1 (\EDITELT PCTB (IPLUS \EltsPerPiece NPC]
(T (* If PIECE winds up NIL, we walked off the end of the
document, so use the textlen.)
(fetch TEXTLEN of TEXTOBJ]
(bind (PIECE ← PC) for old NPC from PCNO by (MINUS \EltsPerPiece)
repeatwhile (AND PIECE (NOT (fetch PPARALAST of PIECE)))
do (* Now find the piece that ends the previous paragraph)
(SETQ PIECE (fetch PREVPIECE of PIECE)))
(SETQ BEGIN (\EDITELT PCTB NPC)) (* Actually, NPC is pointing at the piece that starts
THIS para.)
(RETURN (CONS BEGIN END])
(\TEDIT.FORMATTABS
[LAMBDA (TEXTOBJ TABSPEC THISLINE CHBASE WBASE CURTX DFLTTABX MARGINXOFFSET PRIORTAB CLEANINGUP)
(* jds "31-Jul-85 18:54")
(* Do the formatting work for a tab.)
(* PRIORTAB is the outstanding tab, if any, that has to be resolved. This will be a centered or flush right tab.
it's format is a PENDINGTAB)
(* If CLEANINGUP is non-NIL, then we're at the end of
the line, and only need to resolve the outstanding
tab.)
(PROG (NEXTTAB NEXTTABTYPE NEXTTABX DEFAULTTAB TABWIDTH)
[COND
(PRIORTAB (* If there is a prior tab to resolve, do that
first--it affects the perceived current X value, which
affects later tabs)
(SELECTQ (fetch PTTYPE of PRIORTAB)
((CENTERED DOTTEDCENTERED) (* Centered around the tab X)
[SETQ TABWIDTH
(IMAX 3 (IDIFFERENCE (IDIFFERENCE (fetch PTTABX of PRIORTAB)
(LRSH (IDIFFERENCE CURTX
(fetch
PTOLDTX
of
PRIORTAB))
1))
(fetch PTOLDTX of PRIORTAB]
(\PUTBASE (fetch PTWBASE of PRIORTAB)
0 TABWIDTH) (* For now, the TAB is 0 wide)
(add CURTX TABWIDTH))
((RIGHT DOTTEDRIGHT) (* Snug up against the tab X)
[SETQ TABWIDTH (IMAX 3 (IDIFFERENCE (IDIFFERENCE
(fetch PTTABX of PRIORTAB)
(IDIFFERENCE CURTX
(fetch PTOLDTX
of PRIORTAB)))
(fetch PTOLDTX of PRIORTAB]
(\PUTBASE (fetch PTWBASE of PRIORTAB)
0 TABWIDTH) (* For now, the TAB is 0 wide)
(add CURTX TABWIDTH))
((DECIMAL DOTTEDDECIMAL) (* Put the decimal point here)
)
(SHOULDNT]
(SETQ DEFAULTTAB (OR (CAR TABSPEC)
DFLTTABX)) (* Default Tab width, if there aren't any real tabs to
use)
(SETQ NEXTTAB (for TAB in (CDR TABSPEC) when (IGREATERP (fetch TABX of TAB)
(IDIFFERENCE CURTX MARGINXOFFSET))
do (RETURN TAB))) (* The next tab on this line, if any)
(SETQ NEXTTABTYPE (OR (fetch TABKIND of NEXTTAB)
(QUOTE LEFT))) (* The type of the next tab
(LEFT, if we use the default spacing))
(SETQ NEXTTABX (IPLUS [OR (fetch TABX of NEXTTAB)
(ITIMES DEFAULTTAB (IPLUS 1 (IQUOTIENT (IDIFFERENCE CURTX
MARGINXOFFSET)
DEFAULTTAB]
MARGINXOFFSET)) (* The next tab's X value)
(COND
(CLEANINGUP (* We're cleaning up at end of line, so this shouldn't
have any effect.)
(RETURN CURTX))
(T (SELECTQ NEXTTABTYPE
((DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL)
(* This is a dotted-leader tab.
Change it to Meta-TAB, so the line displayer knows.)
(\RPLPTR CHBASE 0 (CHARCODE #↑I)))
NIL)
(SELECTQ NEXTTABTYPE
((LEFT DOTTEDLEFT) (* Flush LEFT TAB.)
(SETQ TABWIDTH (IMAX 1 (IDIFFERENCE NEXTTABX CURTX)))
(\PUTBASE WBASE 0 TABWIDTH)
(RETURN CURTX))
((CENTERED DOTTEDCENTERED) (* Centered around the tab X)
(\PUTBASE WBASE 0 0) (* For now, the TAB is 0 wide)
(RETURN (create PENDINGTAB
PTNEWTX ← CURTX
PTOLDTAB ← NEXTTAB
PTTYPE ← NEXTTABTYPE
PTTABX ← NEXTTABX
PTWBASE ← WBASE
PTOLDTX ← CURTX)))
((RIGHT DOTTEDRIGHT) (* Snug up against the tab X)
(\PUTBASE WBASE 0 0) (* For now, the TAB is 0 wide)
(RETURN (create PENDINGTAB
PTNEWTX ← CURTX
PTOLDTAB ← NEXTTAB
PTTYPE ← NEXTTABTYPE
PTTABX ← NEXTTABX
PTWBASE ← WBASE
PTOLDTX ← CURTX)))
((DECIMAL DOTTEDDECIMAL) (* Put the decimal point here)
)
(SHOULDNT])
)
(* UNDO & History List stuff)
(DEFINEQ
(TEDIT.REDO.LOOKS
[LAMBDA (TEXTOBJ EVENT CH#) (* jds "21-May-84 16:59")
(* Set looks on the current selection from the
TEDIT.CHARLOOKS.WINDOW)
(PROG ((SEL (fetch SEL of TEXTOBJ))
(NEWLOOKS (fetch THAUXINFO of EVENT)))
(COND
((fetch SET of SEL) (* He's got something selected.)
(TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.)
)
(T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])
(TEDIT.REDO.PARALOOKS
[LAMBDA (TEXTOBJ EVENT CH#) (* jds "21-May-84 16:49")
(* Re-set the looks on selected paragraphs)
(PROG ((SEL (fetch SEL of TEXTOBJ))
(NEWLOOKS (fetch THAUXINFO of EVENT)))
(COND
((fetch SET of SEL) (* He's got something selected.)
(TEDIT.PARALOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.)
)
(T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T])
(TEDIT.UNDO.LOOKS
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* jds "13-Dec-84 11:00")
(* Set looks on the current selection from the
TEDIT.CHARLOOKS.WINDOW)
(PROG ((SEL (fetch SEL of TEXTOBJ))
(PCTB (fetch PCTB of TEXTOBJ))
CHLIM
(OLDLOOKSLIST (fetch THOLDINFO of EVENT))
(NEWLOOKSLIST NIL)
(\INPC (fetch \INSERTPC of TEXTOBJ)))
(bind ((PC ←(fetch THFIRSTPIECE of EVENT))) for OLDLOOKS in OLDLOOKSLIST
do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch PLOOKS of PC)))
(* Remember this for the undo.)
(replace PLOOKS of PC with OLDLOOKS) (* Give this piece its old looks)
[COND
((EQ PC \INPC)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
(fetch PLOOKS
of PC]
(SETQ PC (fetch NEXTPIECE of PC)))
(replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we UNDO the UNDO.)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT)
(fetch THLEN of EVENT)
-1))
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\TEDIT.SET.SEL.LOOKS SEL (QUOTE NORMAL))
(SETQ TEDIT.PENDINGDEL NIL)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T])
(TEDIT.UNDO.PARALOOKS
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* jds "13-Dec-84 11:00")
(* Set looks on the current selection from the
TEDIT.CHARLOOKS.WINDOW)
(PROG ((SEL (fetch SEL of TEXTOBJ))
(PCTB (fetch PCTB of TEXTOBJ))
CHLIM
(OLDLOOKSLIST (fetch THOLDINFO of EVENT))
(NEWLOOKSLIST NIL))
(bind ((PC ←(fetch THFIRSTPIECE of EVENT))) for OLDLOOKS in OLDLOOKSLIST
do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch PPARALOOKS of PC)))
(* Remember this for the undo.)
(replace PPARALOOKS of PC with OLDLOOKS) (* Give this piece its old looks)
(SETQ PC (fetch NEXTPIECE of PC)))
(replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we UNDO the UNDO.)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT)
(fetch THLEN of EVENT)
-1))
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\TEDIT.SET.SEL.LOOKS SEL (QUOTE NORMAL))
(SETQ TEDIT.PENDINGDEL NIL)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL NIL T])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM)
(SIGNED (create WORD HIBYTE ← (\BIN STREAM)
LOBYTE ← (\BIN STREAM))
BITSPERWORD)))
[PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W)
(\BOUT STREAM (LOGAND 255 (LRSH W 8)))
(\BOUT STREAM (LOGAND W 255]
)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL)
(COND (VAL (QUOTE ON))
(T (QUOTE OFF]
)
(PUTPROPS TEDITLOOKS COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13085 49831 (CHARLOOKS.FROM.FONT 13095 . 14442) (EQCLOOKS 14444 . 16189) (SAMECLOOKS
16191 . 18347) (TEDIT.SUBLOOKS 18349 . 19614) (\TEDIT.UNIQUIFY.CHARLOOKS 19616 . 20191) (
TEDIT.CARETLOOKS 20193 . 21061) (TEDIT.COPY.LOOKS 21063 . 22673) (\TEDIT.GET.CHARLOOKS 22675 . 24781)
(\TEDIT.UNPARSE.CHARLOOKS.LIST 24783 . 26639) (TEDIT.MODIFYLOOKS 26641 . 28405) (TEDIT.NEW.FONT 28407
. 28792) (\TEDIT.PUT.CHARLOOKS 28794 . 30109) (\TEDIT.APPLY.STYLES 30111 . 31771) (
\TEDIT.CARETLOOKS.VERIFY 31773 . 32565) (\TEDIT.GET.INSERT.CHARLOOKS 32567 . 34978) (
\TEDIT.GET.TERMSA.WIDTHS 34980 . 35462) (\TEDIT.LOOKS.UPDATE 35464 . 42423) (
\TEDIT.PARSE.CHARLOOKS.LIST 42425 . 47953) (\TEDIT.FLUSH.UNUSED.LOOKS 47955 . 49829)) (49832 69558 (
\TEDIT.CHANGE.LOOKS 49842 . 62901) (TEDIT.LOOKS 62903 . 64266) (\TEDIT.LOOKS 64268 . 66801) (
\TEDIT.FONTCOPY 66803 . 67745) (TEDIT.GET.LOOKS 67747 . 69556)) (69597 105404 (\TEDIT.GET.PARALOOKS
69607 . 69922) (EQFMTSPEC 69924 . 72212) (\TEDIT.UNIQUIFY.PARALOOKS 72214 . 72790) (
TEDIT.GET.PARALOOKS 72792 . 73339) (\TEDIT.UNPARSE.PARALOOKS.LIST 73341 . 75525) (
\TEDIT.APPLY.PARASTYLES 75527 . 76467) (\TEDIT.PARSE.PARALOOKS.LIST 76469 . 81636) (TEDIT.PARALOOKS
81638 . 94549) (TEDIT.COPY.PARALOOKS 94551 . 96038) (\TEDIT.PUT.PARALOOKS 96040 . 96760) (
\TEDIT.CONVERT.TO.FORMATTED 96762 . 98471) (\TEDIT.PARABOUNDS 98473 . 100782) (\TEDIT.FORMATTABS
100784 . 105402)) (105443 109821 (TEDIT.REDO.LOOKS 105453 . 106139) (TEDIT.REDO.PARALOOKS 106141 .
106787) (TEDIT.UNDO.LOOKS 106789 . 108415) (TEDIT.UNDO.PARALOOKS 108417 . 109819)))))
STOP