(FILECREATED "12-Mar-85 05:53:02" {IVY}<TEDIT>TEDITLOOKS.;47 106855
changes to: (FNS TEDIT.LOOKS TEDIT.PARALOOKS)
previous date: " 6-Mar-85 23:52:46" {IVY}<TEDIT>TEDITLOOKS.;46)
(* 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: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0)
(\PieceDescriptorOBJECT 1)
(\PieceDescriptorPARA 2)
(\PieceDescriptorPAGEFRAME 3)
(\PieceDescriptorCHARLOOKSLIST 4)
(\PieceDescriptorPARALOOKSLIST 5)
(\PieceDescriptorSAFEOBJECT 6)))
[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 \TEDIT.UNIQUIFY.PARALOOKS EQFMTSPEC SAMECLOOKS
TEDIT.SUBLOOKS \TEDIT.UNIQUIFY.CHARLOOKS TEDIT.CARETLOOKS TEDIT.GET.LOOKS
TEDIT.COPY.LOOKS TEDIT.GET.PARALOOKS TEDIT.COPY.PARALOOKS \TEDIT.GET.CHARLOOKS
\TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS
\TEDIT.UNPARSE.CHARLOOKS.LIST \TEDIT.UNPARSE.PARALOOKS.LIST TEDIT.LOOKS
TEDIT.MODIFYLOOKS TEDIT.NEW.FONT \TEDIT.PUT.CHARLOOKS \TEDIT.PUT.SINGLE.PARALOOKS
\TEDIT.APPLY.PARASTYLES \TEDIT.APPLY.STYLES \TEDIT.CARETLOOKS.VERIFY
\TEDIT.GET.INSERT.CHARLOOKS \TEDIT.GET.TERMSA.WIDTHS \TEDIT.LOOKS
\TEDIT.LOOKS.UPDATE \TEDIT.PARSE.CHARLOOKS.LIST \TEDIT.PARSE.PARALOOKS.LIST
\TEDIT.FLUSH.UNUSED.LOOKS \TEDIT.FONTCOPY))
(COMS (* Paragraph looks functions)
(FNS \TEDIT.GET.PARALOOKS TEDIT.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)
(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 above each line in the
para.)
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 (* 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)
(FMTMARK FLAG)
(* 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))
(RECORD 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 (* The WBASE for its width, for updating)
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 FLAG)))
(/DECLAREDATATYPE (QUOTE FMTSPEC)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER FLAG)))
(FILESLOAD TEXTOFD TEDIT)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \PieceDescriptorLOOKS 0)
(RPAQQ \PieceDescriptorOBJECT 1)
(RPAQQ \PieceDescriptorPARA 2)
(RPAQQ \PieceDescriptorPAGEFRAME 3)
(RPAQQ \PieceDescriptorCHARLOOKSLIST 4)
(RPAQQ \PieceDescriptorPARALOOKSLIST 5)
(RPAQQ \PieceDescriptorSAFEOBJECT 6)
(CONSTANTS (\PieceDescriptorLOOKS 0)
(\PieceDescriptorOBJECT 1)
(\PieceDescriptorPARA 2)
(\PieceDescriptorPAGEFRAME 3)
(\PieceDescriptorCHARLOOKSLIST 4)
(\PieceDescriptorPARALOOKSLIST 5)
(\PieceDescriptorSAFEOBJECT 6))
)
)
(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 "13-Nov-84 09:59")
(* 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 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])
(\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])
(EQFMTSPEC
[LAMBDA (PARALOOK1 PARALOOK2) (* jds "29-Oct-84 15:22")
(* 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 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])
(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 "11-Feb-85 15:11")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
CHARLOOKS)
(SETQ CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS NIL 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.GET.LOOKS
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* jds "18-Jun-84 04:13")
(* Return a PLIST of character looks)
(PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
LOOKS FONT NLOOKS)
[COND
((type? CHARLOOKS CH#ORCHARLOOKS)
(SETQ LOOKS CH#ORCHARLOOKS))
[(FIXP CH#ORCHARLOOKS)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC CH#ORCHARLOOKS (fetch PCTB of TEXTOBJ]
[(type? SELECTION CH#ORCHARLOOKS)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC (fetch (SELECTION CH#) of CH#ORCHARLOOKS)
(fetch PCTB of TEXTOBJ]
((NULL CH#ORCHARLOOKS)
(SETQ LOOKS (fetch PLOOKS of (\CHTOPC (fetch (SELECTION CH#)
of (fetch SEL of TEXTOBJ))
(fetch PCTB of TEXTOBJ]
(SETQ FONT (fetch CLFONT of LOOKS))
[SETQ NLOOKS (LIST (QUOTE STYLE)
(fetch CLSTYLE of LOOKS)
(QUOTE USERINFO)
(fetch CLUSERINFO of LOOKS)
(QUOTE PROTECTED)
(ONOFF (fetch CLPROTECTED of LOOKS))
(QUOTE SELECTPOINT)
(ONOFF (fetch CLSELHERE of LOOKS))
(QUOTE INVISIBLE)
(ONOFF (fetch CLINVISIBLE of LOOKS))
(QUOTE FAMILY)
(FONTPROP FONT (QUOTE FAMILY))
(QUOTE FACE)
(FONTPROP FONT (QUOTE FACE))
(QUOTE SIZE)
(FONTPROP FONT (QUOTE SIZE))
(QUOTE UNDERLINE)
(ONOFF (fetch CLULINE of LOOKS))
(QUOTE OVERLINE)
(ONOFF (fetch CLOLINE of LOOKS))
(QUOTE STRIKEOUT)
(ONOFF (fetch CLSTRIKE of LOOKS]
[COND
[(NULL (fetch CLOFFSET of LOOKS))
(SETQ NLOOKS (CONS (QUOTE SUPERSCRIPT)
(CONS 0 NLOOKS]
[(IGREATERP (fetch CLOFFSET of LOOKS)
0)
(SETQ NLOOKS (CONS (QUOTE SUPERSCRIPT)
(CONS (fetch CLOFFSET of LOOKS)
NLOOKS]
((IGREATERP 0 (fetch CLOFFSET of LOOKS))
(SETQ NLOOKS (CONS (QUOTE SUBSCRIPT)
(CONS (IMINUS (fetch CLOFFSET of LOOKS))
NLOOKS]
(RETURN NLOOKS])
(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.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.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.GET.CHARLOOKS
[LAMBDA (PC FILE LOOKSARRAY) (* jds "30-Jan-85 16:48")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG NIL
(COND
((NOT (ZEROP (\BIN FILE))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
(replace PLOOKS of PC with (ELT LOOKSARRAY (\SMALLPIN FILE])
(\TEDIT.GET.PARALOOKS.LIST
[LAMBDA (FILE) (* jds "30-Jan-85 17:38")
(* Read the list of CHARLOOKSs from the file.)
(for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE])
(\TEDIT.GET.SINGLE.PARALOOKS
[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.UNPARSE.CHARLOOKS.LIST
[LAMBDA (LOOKS) (* jds " 5-Sep-84 16:38")
(* Convert a CHARLOOKS into an equivalent PList-form
for external consumption)
(PROG ((NEWLOOKS NIL)
OFFSET)
(for PROP in (LIST (FONTPROP (fetch CLFONT of LOOKS)
(QUOTE WEIGHT))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE SLOPE))
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE EXPANSION))
(fetch CLULINE of LOOKS)
(fetch CLSTRIKE of LOOKS)
(fetch CLOLINE of LOOKS)
(FONTPROP (fetch CLFONT of LOOKS)
(QUOTE FAMILY))
(fetch CLSIZE of LOOKS)
(fetch CLPROTECTED of LOOKS)
(fetch CLSELHERE of LOOKS)
(fetch CLINVISIBLE of LOOKS))
as PROPNAME in (QUOTE (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.UNPARSE.PARALOOKS.LIST
[LAMBDA (FMTSPEC) (* jds " 5-Sep-84 16:47")
(* 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 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))
as PROPNAME
in (QUOTE (QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING
LINELEADING TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY HEADINGKEEP
TYPE SUBTYPE NEWPAGEBEFORE NEWPAGEAFTER))
do (push NEWLOOKS PROP)
(push NEWLOOKS PROPNAME))
(RETURN NEWLOOKS])
(TEDIT.LOOKS
[LAMBDA (STREAM NEWLOOKS SELORCH# LEN) (* jds "12-Mar-85 04:48")
(* Programmatic interface for character looks in TEdit)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
TSEL PCTB PC1 PCNO1 PCNON PCN \INPC (FAMILY NIL)
(FONT NIL)
(FACE NIL)
(SIZE NIL)
(PROT NIL)
(SELHERE NIL)
(ULINE NIL)
(OLINE NIL)
(STRIKE NIL)
(SUPER NIL)
(WEIGHT NIL)
(SLOPE NIL)
(SIZEINC NIL)
(OFFSETINC NIL)
(EXPANSION NIL)
(NEWLOOKS NEWLOOKS)
(NLOOKSAVE NEWLOOKS)
(SUB NIL)
(INVISIBLE NIL)
FOOLOOKS NEWFONT DY CH# CHLIM (OLDLOOKSLIST NIL))
[SETQ TSEL (COND
((type? SELECTION SELORCH#)
SELORCH#)
(SELORCH# (TEDIT.SETSEL TEXTOBJ SELORCH# LEN (QUOTE LEFT)))
(T (fetch SEL of TEXTOBJ]
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ \INPC (fetch \INSERTPC of TEXTOBJ)) (* Construct the set of new looks to apply:)
(COND
((OR (IGREATERP (fetch CH# of TSEL)
(fetch TEXTLEN of TEXTOBJ))
(ZEROP (fetch DCH of TSEL))) (* There won't be any text changed by this.
Just punt out.)
(RETURN))
((NOT (fetch SET of TSEL)) (* No selection to change the looks of.
Can't do anything!)
(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 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.)
(\SHOWSEL TSEL NIL NIL)
(SETQ CH# (fetch CH# of TSEL)) (* 1st ch# of the text to change)
(SETQ CHLIM (IMIN (ADD1 (fetch TEXTLEN of TEXTOBJ))
(fetch CHLIM of TSEL))) (* last ch to change)
(SETQ PC1 (\CHTOPC CH# PCTB)) (* Piece the first ch is in)
(SETQ PCNO1 (\FINDPIECE PC1 PCTB)) (* Piece # of first piece)
(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]
(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 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)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Looks)
THLEN ←(IDIFFERENCE CHLIM CH#)
THCH# ← CH#
THFIRSTPIECE ← PC1
THOLDINFO ← OLDLOOKSLIST
THAUXINFO ← NLOOKSAVE))
(* Save this action for undo/redo)
(TEDIT.RESET.EXTEND.PENDING.DELETE TSEL) (* Changing looks resets the blue-pending-deleteness of
the selection!)
(COND
((fetch \WINDOW of TEXTOBJ)
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* Update the screen image)
(\FIXSEL TSEL TEXTOBJ)
(\SHOWSEL TSEL NIL T)))
(replace \INSERTPCVALID of TEXTOBJ with NIL])
(TEDIT.MODIFYLOOKS
[LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* jds "13-Dec-84 09:32")
(* 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)))
(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 (fetch CLFONT of LOOKS)
(QUOTE ASCENT]
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 (QUOTE PAINT)
DS)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struch-thru)
(MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP (fetch CLFONT of LOOKS)
(QUOTE ASCENT))
3))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 (QUOTE PAINT)
DS)))
(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)
(* jds "28-Jan-85 17:38")
(* 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)
(COND
((AND TEDIT.TENTATIVE (fetch PNEW of OLDPC)) (* If this is a tentative edit, save the newness flag)
(\BOUT FILE 1))
(T (* Otherwise, don't bother)
(\BOUT FILE 0)))
(\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY)) (* The index into the list of fonts)
])
(\TEDIT.PUT.SINGLE.PARALOOKS
[LAMBDA (FILE LOOKS) (* jds "31-Jan-85 17:58")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG (DEFAULTTAB TABSPECS OUTPUTFORMAT)
(\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.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.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
[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.LOOKS.UPDATE
[LAMBDA (STREAM PC) (* jds "26-Dec-84 16:15")
(* At a piece boundary, update the line formatting
fields ASCENT, DESCENT, and FONTWIDTHS)
(DECLARE (USEDFREE LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE INVISIBLERUNS))
(COND
(PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
TLOOKS FONT TEMP NEWPC PARALOOKS PREVPC)
[COND
([OR (NOT (fetch PREVPIECE of PC))
(NEQ (fetch PPARALOOKS of PC)
(fetch PPARALOOKS of (fetch PREVPIECE of PC]
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS of PC)
PC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))
(T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM]
(SETQ TLOOKS (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC 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 PC))
(\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 PC)
(SETQ PC (fetch NEXTPIECE of PC))
(COND
((NEQ (fetch PPARALOOKS of PC)
(fetch PPARALOOKS of PREVPC))
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS of PC)
PC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)))
(SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ)))
[while (AND PC (fetch CLINVISIBLE of TLOOKS))
do (\EDITSETA LOOKS LOOKNO (IPLUS (fetch PLEN of PC)
(\EDITELT LOOKS LOOKNO)))
(* Note the invisible run length for the line
displayer)
(SETQ PREVPC PC)
(SETQ PC (fetch NEXTPIECE of PC))
(COND
((NEQ (fetch PPARALOOKS of PC)
(fetch PPARALOOKS of PREVPC))
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS
of PC)
PC TEXTOBJ))
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)))
(SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ]
(add CHNO (\EDITELT LOOKS LOOKNO))
(add INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
(* Keep track of how much invisible text we cross over)
(SETQ NEWPC PC)))
(COND
([AND PC (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM]
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS)
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)
(SETQ FONT (FONTCOPY (fetch CLFONT of TLOOKS)
(QUOTE DEVICE)
(QUOTE DISPLAY)))
[SETQ ASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT (QUOTE ASCENT))
(OR (ffetch CLOFFSET of TLOOKS)
0]
[SETQ DESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT (QUOTE DESCENT))
(OR (ffetch CLOFFSET of TLOOKS)
0]
(SETQ FONTWIDTHS (ffetch \SFWidths of FONT))
(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 PC)))
(RETURN NEWPC])
(\TEDIT.PARSE.CHARLOOKS.LIST
[LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* jds "18-Oct-84 15:26")
(* 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)
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 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)))
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
(RETURN NEWPCLOOKS])
(\TEDIT.PARSE.PARALOOKS.LIST
[LAMBDA (NEWLOOKS OLDLOOKS) (* jds "24-Dec-84 14:11")
(* 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)
(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 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))
(RETURN NEWLOOKS])
(\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.)
])
(\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])
)
(* 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])
(TEDIT.PARALOOKS
[LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* jds "12-Mar-85 04:37")
(* 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 LLEAD TABSPECC QUADD NLOOKSAVE PC1 OLDLOOKSLIST TYPE SUBTYPE TYPESET SUBTYPESET
SPECIALX SPECIALY NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER)
(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 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 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 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))
(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]
(COND
((fetch PPARALAST of NPC) (* We've found the end of a paragraph.
Stop to see if we've run off the end yet.)
[SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM (\EDITELT PCTB PC#]
(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))
(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.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 FMTSPEC THISLINE CHBASE WBASE CURTX DFLTTABX MARGINXOFFSET PRIORTAB CLEANINGUP)
(* jds "14-Jan-85 14:02")
(* 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 ((TABSPEC (fetch TABSPEC of FMTSPEC))
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 (* 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 (* 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 (* 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
(LEFT (* Flush LEFT TAB.)
(SETQ TABWIDTH (IMAX 1 (IDIFFERENCE NEXTTABX CURTX)))
(\PUTBASE WBASE 0 TABWIDTH)
(RETURN CURTX))
(CENTERED (* 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 (* 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 (* 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 (11401 80979 (CHARLOOKS.FROM.FONT 11411 . 12758) (EQCLOOKS 12760 . 14413) (
\TEDIT.UNIQUIFY.PARALOOKS 14415 . 14991) (EQFMTSPEC 14993 . 16985) (SAMECLOOKS 16987 . 19143) (
TEDIT.SUBLOOKS 19145 . 20410) (\TEDIT.UNIQUIFY.CHARLOOKS 20412 . 20987) (TEDIT.CARETLOOKS 20989 .
21810) (TEDIT.GET.LOOKS 21812 . 24250) (TEDIT.COPY.LOOKS 24252 . 25862) (TEDIT.GET.PARALOOKS 25864 .
26411) (TEDIT.COPY.PARALOOKS 26413 . 27900) (\TEDIT.GET.CHARLOOKS 27902 . 28462) (
\TEDIT.GET.PARALOOKS.LIST 28464 . 28799) (\TEDIT.GET.SINGLE.PARALOOKS 28801 . 32240) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 32242 . 33839) (\TEDIT.UNPARSE.PARALOOKS.LIST 33841 . 35378) (
TEDIT.LOOKS 35380 . 49021) (TEDIT.MODIFYLOOKS 49023 . 50449) (TEDIT.NEW.FONT 50451 . 50836) (
\TEDIT.PUT.CHARLOOKS 50838 . 51869) (\TEDIT.PUT.SINGLE.PARALOOKS 51871 . 55027) (
\TEDIT.APPLY.PARASTYLES 55029 . 55969) (\TEDIT.APPLY.STYLES 55971 . 57631) (\TEDIT.CARETLOOKS.VERIFY
57633 . 58425) (\TEDIT.GET.INSERT.CHARLOOKS 58427 . 60838) (\TEDIT.GET.TERMSA.WIDTHS 60840 . 61322) (
\TEDIT.LOOKS 61324 . 63857) (\TEDIT.LOOKS.UPDATE 63859 . 68861) (\TEDIT.PARSE.CHARLOOKS.LIST 68863 .
73875) (\TEDIT.PARSE.PARALOOKS.LIST 73877 . 78157) (\TEDIT.FLUSH.UNUSED.LOOKS 78159 . 80033) (
\TEDIT.FONTCOPY 80035 . 80977)) (81018 101768 (\TEDIT.GET.PARALOOKS 81028 . 81343) (TEDIT.PARALOOKS
81345 . 92522) (\TEDIT.PUT.PARALOOKS 92524 . 93244) (\TEDIT.CONVERT.TO.FORMATTED 93246 . 94955) (
\TEDIT.PARABOUNDS 94957 . 97266) (\TEDIT.FORMATTABS 97268 . 101766)) (101807 106185 (TEDIT.REDO.LOOKS
101817 . 102503) (TEDIT.REDO.PARALOOKS 102505 . 103151) (TEDIT.UNDO.LOOKS 103153 . 104779) (
TEDIT.UNDO.PARALOOKS 104781 . 106183)))))
STOP