(FILECREATED "24-May-84 17:27:28" {DSK}TEDITLOOKS.;12 84175
changes to: (FNS TEDIT.LOOKS EQCLOOKS)
previous date: "24-May-84 11:29:14" {DSK}TEDITLOOKS.;10)
(PRETTYCOMPRINT TEDITLOOKSCOMS)
(RPAQQ TEDITLOOKSCOMS ((RECORDS CHARLOOKS FMTSPEC PENDINGTAB)
(FILES TEXTOFD TEDIT)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0)
(\PieceDescriptorOBJECT 1)
(\PieceDescriptorPARA 2)))
[DECLARE: DONTEVAL@LOAD DOCOPY (INITVARS (TEDIT.DEFAULT.FONT (FONTCREATE (QUOTE GACHA)
10))
(TEDIT.TERMSA.FONTS NIL)
(TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT
TEDIT.DEFAULT.FONT))
(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.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.CARETLOOKS TEDIT.GET.CHARLOOKS
TEDIT.GET.PARALOOKS TEDIT.LOOKS TEDIT.MODIFYLOOKS TEDIT.NEW.FONT
TEDIT.PUT.CHARLOOKS TEDIT.PUT.PARALOOKS \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.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))
(COMS (* VERSION 0 Compatibility reading functions)
(FNS TEDIT.BUILD.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \SMALLPIN \SMALLPOUT))))
[DECLARE: EVAL@COMPILE
(DATATYPE CHARLOOKS (CLFONT (* The font descriptor for these characters)
CLPROTECTED (* T if chars can't be selected, else NIL)
CLINVISIBLE (* T if TEDIT is to ignore these chars;
else NIL)
CLSELHERE
(* T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will
NOT BE PROTECTED.)
CLCANCOPY (* T if this text can be selected for copying, even tho
protected (it will become unprotected after the copy;
for Dribble/TTY interface))
CLNAME (* Name of the font (e.g., HELVETICA))
CLSIZE (* Font size, in points)
CLITAL (* T if the characters are italic, else NIL)
CLBOLD (* T if the characters are bold, else NIL)
CLULINE (* T if the characters are to be underscored, else NIL)
CLOLINE (* T if the characters are to be overscored, else NIL)
CLSTRIKE (* T if the characters are to be struck thru, else nil.)
CLOFFSET (* A superscripting offset in points
(?) else NIL (SUBSCRIPTING IF NEGATIVE.))
CLSMALLCAP (* T if small caps, else NIL)
CLSTYLE (* The style to be used in marking these characters;
overridden by the other fields)
CLUSERINFO (* Any information that an outsider wants to include)
)
CLSTYLE ← 0)
(DATATYPE FMTSPEC (1STLEFTMAR LEFTMAR RIGHTMAR LEADBEFORE LEADAFTER LINELEAD TABSPEC QUAD)
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 POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE FMTSPEC)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(FILESLOAD TEXTOFD TEDIT)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \PieceDescriptorLOOKS 0)
(RPAQQ \PieceDescriptorOBJECT 1)
(RPAQQ \PieceDescriptorPARA 2)
(CONSTANTS (\PieceDescriptorLOOKS 0)
(\PieceDescriptorOBJECT 1)
(\PieceDescriptorPARA 2))
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ? TEDIT.DEFAULT.FONT (FONTCREATE (QUOTE GACHA)
10))
(RPAQ? TEDIT.TERMSA.FONTS NIL)
(RPAQ? TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT TEDIT.DEFAULT.FONT))
(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)))
(RPAQ? TEDIT.TERMSA.FONTS NIL)
(RPAQ? TEDIT.KNOWN.FONTS [QUOTE ((Times% Roman (QUOTE TIMESROMAN))
(Helvetica (QUOTE HELVETICA))
(Gacha (QUOTE GACHA))
(Cream (QUOTE CREAM])
)
(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
(ADDTOVAR 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 "19-Jan-84 14:15")
(PROG ((LOOKS (create CHARLOOKS
CLFONT ← FONT)))
(OR (type? FONTDESCRIPTOR FONT)
(\ILLEGAL.ARG FONT))
(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))
(SELECTQ (CADR (FONTPROP FONT (QUOTE FACE)))
(ITALIC (replace CLITAL of LOOKS with T))
(replace CLITAL of LOOKS with NIL))
(with CHARLOOKS LOOKS (SETQ CLSIZE (FONTPROP FONT (QUOTE SIZE)))
(SETQ CLOFFSET NIL))
(RETURN LOOKS])
(EQCLOOKS
[LAMBDA (CLOOK1 CLOOK2) (* jds "24-May-84 15:26")
(* Given two sets of CHARLOOKS, are they effectively the
same?)
(OR (EQ CLOOK1 CLOOK2)
(AND (EQ (fetch CLFONT of CLOOK1)
(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.CARETLOOKS
[LAMBDA (STREAM LOOKS) (* jds "11-Apr-84 11:28")
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
CHARLOOKS)
(SETQ CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS NIL TEXTOBJ))
(replace \INSERTNEXTCH of TEXTOBJ with -1)
(replace CARETLOOKS of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ CHARLOOKS])
(TEDIT.GET.CHARLOOKS
[LAMBDA (PC FILE) (* jds "22-May-84 10:26")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(replace PLOOKS of PC with LOOKS)
(SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which follows)
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE]
(* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance)
(OR (ZEROP SUB)
(SETQ SUPER (IMINUS SUB))) (* If this is an old file, it'll have a subscript value
not zero. Let those past and do the right thing.)
(COND
((NOT (ZEROP (\BIN FILE))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
[COND
((NOT (ZEROP (\BIN FILE))) (* There is style or user information to be read)
(SETQ STYLESTR (\STRINGIN FILE))
(SETQ USERSTR (\STRINGIN FILE))
(COND
((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info)
(replace CLSTYLE of LOOKS with (READ STYLESTR))
(CLOSEF? STYLESTR))
(T (replace CLSTYLE of LOOKS with 0)))
(COND
((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info)
(replace CLUSERINFO of LOOKS with (READ USERSTR))
(CLOSEF? USERSTR]
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
(replace CLFONT of LOOKS with (AND NAME (NOT (ZEROP SIZE))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC])
(TEDIT.GET.PARALOOKS
[LAMBDA (FILE) (* jds "16-May-84 16:42")
(* 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 TABFLG)) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS)))
(RETURN LOOKS])
(TEDIT.LOOKS
[LAMBDA (TEXTOBJ NLOOKS SEL LEN) (* jds "24-May-84 17:06")
(* Programmatic interface for character looks in TEdit)
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(PROG ([TSEL (COND
((type? SELECTION SEL)
SEL)
(SEL (TEDIT.SETSEL TEXTOBJ SEL LEN (QUOTE LEFT)))
(T (fetch SEL of TEXTOBJ]
(PCTB (fetch PCTB of TEXTOBJ))
PC1 PCNO1 PCNON PCN (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)
(NLOOKSAVE NLOOKS)
(SUB NIL)
(INVISIBLE NIL)
NEWLOOKS NEWFONT DY (\INPC (fetch \INSERTPC of TEXTOBJ))
CH# CHLIM (OLDLOOKSLIST NIL)) (* Construct the set of new looks to apply:)
(COND
((IGREATERP (fetch CH# of TSEL)
(fetch TEXTLEN of TEXTOBJ)) (* 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 NLOOKS) (* We've already got a made-up set of looks;
we'll just use it.)
)
(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 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 INVISIBLE (LISTGET NLOOKS (QUOTE INVISIBLE)))
(SETQ NLOOKS NIL) (* Tell later code to use NEWLOOKS.)
(SETQ NEWLOOKS NIL)
[COND
(FAMILY (SETQ NEWLOOKS (CONS (QUOTE FAMILY)
(CONS FAMILY NEWLOOKS]
[COND
(FONT (OR [SETQ FONT (CAR (NLSETQ (\DTEST FONT (QUOTE FONTDESCRIPTOR]
(PROGN (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 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]
(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 (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 (ADD1 CHLIM)
PCTB)) (* Last piece)
(SETQ PCN (\EDITELT PCTB (ADD1 PCNON)))
(COND
[(IEQP (ADD1 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 (ADD1 CHLIM)
TEXTOBJ PCNON)))
[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.)
[replace PLOOKS of PC
with (SETQ NEWPCLOOKS (OR NLOOKS
(create CHARLOOKS
using (fetch PLOOKS of PC)
CLFONT ←(SETQ NEWFONT
(OR FONT (\TEDIT.FONTCOPY
(fetch CLFONT
of (fetch PLOOKS of PC))
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 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]
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
[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)))
[replace PLOOKS of PC
with (SETQ NEWPCLOOKS
(OR NLOOKS (create CHARLOOKS
using (fetch PLOOKS of PC)
CLFONT ←(OR FONT
(SETQ NEWFONT
(\TEDIT.FONTCOPY
(fetch CLFONT
of (fetch PLOOKS of PC))
NEWLOOKS TEXTOBJ]
[replace CLBOLD of NEWPCLOOKS with (EQ (QUOTE BOLD)
(FONTPROP NEWFONT (QUOTE WEIGHT]
[replace CLITAL of NEWPCLOOKS with (EQ (QUOTE ITALIC)
(FONTPROP NEWFONT (QUOTE SLOPE]
(replace CLSIZE of NEWPCLOOKS with (FONTPROP NEWFONT (QUOTE SIZE)))
[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]
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CHLIM)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE Looks)
THLEN ←(ADD1 (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 \INSERTNEXTCH of TEXTOBJ with -1])
(TEDIT.MODIFYLOOKS
[LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* jds "16-May-84 18:27")
(* 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 (OR (fetch CLOFFSET of LOOKS)
0))
(fetch DESCENT 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 NIL (* jds "28-Mar-84 11:21")
(PROG [(NAME (MKATOM (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) (* jds " 1-May-84 11:58")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((FONT (fetch CLFONT of LOOKS))
STR)
(\DWOUT FILE (IDIFFERENCE CHLIM CH1)) (* The length of this run of looks)
(\SMALLPOUT FILE \PieceDescriptorLOOKS) (* Mark this as setting the piece's looks)
[\SMALLPOUT FILE (NCHARS (FONTPROP FONT (QUOTE FAMILY]
(* The length of the description which follows)
(for CH inatom (FONTPROP FONT (QUOTE FAMILY)) do (\BOUT FILE CH))
(* Print the form which can EVAL to re-create the font
information)
(\SMALLPOUT FILE (OR (fetch CLSIZE of LOOKS)
0)) (* Size of the type, in points)
(\SMALLPOUT FILE (OR (fetch CLOFFSET of LOOKS)
0)) (* Super/subscripting distance)
(\SMALLPOUT FILE 0) (* (Used to be) Subscripting distance)
(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)))
(COND
[(OR [AND (fetch CLSTYLE of LOOKS)
(NOT (ZEROP (fetch CLSTYLE of LOOKS]
(fetch CLUSERINFO of LOOKS)) (* If there is style or user-specific info, mark the
fact.)
(\BOUT FILE 1)
(COND
([AND (fetch CLSTYLE of LOOKS)
(NOT (ZEROP (fetch CLSTYLE of LOOKS]
(\SMALLPOUT FILE (NCHARS (fetch CLSTYLE of LOOKS)))
(PRIN3 (fetch CLSTYLE of LOOKS)
FILE))
(T (\SMALLPOUT FILE 0)))
(COND
((fetch CLUSERINFO of LOOKS)
(\SMALLPOUT FILE (NCHARS (fetch CLUSERINFO of LOOKS)))
(PRIN3 (fetch CLUSERINFO of LOOKS)
FILE))
(T (\SMALLPOUT FILE 0]
(T (* Otherwise say there is no style/user info)
(\BOUT FILE 0)))
(\SMALLPOUT FILE (LOGOR (COND
((fetch CLBOLD of LOOKS)
512)
(T 0))
(COND
((fetch CLITAL of LOOKS)
256)
(T 0))
(COND
((fetch CLULINE of LOOKS)
128)
(T 0))
(COND
((fetch CLOLINE of LOOKS)
64)
(T 0))
(COND
((fetch CLSTRIKE of LOOKS)
32)
(T 0))
(COND
((fetch CLSMALLCAP of LOOKS)
16)
(T 0))
(COND
((fetch CLPROTECTED of LOOKS)
8)
(T 0))
(COND
((fetch CLINVISIBLE of LOOKS)
NIL 4)
(T 0))
(COND
((fetch CLSELHERE of LOOKS)
2)
(T 0))
(COND
((fetch CLCANCOPY of LOOKS)
1)
(T 0])
(TEDIT.PUT.PARALOOKS
[LAMBDA (FILE PC) (* jds "16-May-84 17:00")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((LOOKS (fetch PPARALOOKS of PC))
DEFAULTTAB TABSPECS)
(\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 (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)
(COND
([AND (fetch TABSPEC of LOOKS)
(OR (SETQ DEFAULTTAB (CAR (fetch TABSPEC of LOOKS)))
(SETQ TABSPECS (CDR (fetch TABSPEC of LOOKS]
(* There are tab specs to save, or there is a default
tab setting to save)
(\BOUT FILE 1))
(T (* There are no tab looks. Just let him go.)
(\BOUT FILE 0))) (* Will be tab specs)
(\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)
])
(\TEDIT.APPLY.STYLES
[LAMBDA (LOOKS PC TEXTOBJ) (* jds "20-Apr-84 22:28")
(* 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.)
(COND
((NULL (fetch CLSTYLE of LOOKS))
LOOKS)
((LITATOM (fetch CLSTYLE of LOOKS)) (* Call the guy's function to find the new looks)
(APPLY* (fetch CLSTYLE of LOOKS)
LOOKS PC TEXTOBJ))
((ZEROP (fetch CLSTYLE of LOOKS))
LOOKS)
(T (* This looks has a style attached.
Use it.)
(CAR (NTH TEDIT.STYLES (fetch CLSTYLE of LOOKS])
(\TEDIT.CARETLOOKS.VERIFY
[LAMBDA (TEXTOBJ NEWLOOKS) (* jds "27-Mar-84 15:05")
(* Check with the user's CARETLOOKSFN to see if he wants
to make changes)
(PROG ((CARETFN (LISTGET (fetch EDITPROPS of 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 " 8-Mar-84 14:03")
(* 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 (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)
(CHARLOOKS.FROM.FONT TEDIT.DEFAULT.FONT]
((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)
(CHARLOOKS.FROM.FONT TEDIT.DEFAULT.FONT]
(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 (create CHARLOOKS using (fetch PLOOKS of PIECE)
CLPROTECTED ← NIL CLSELHERE ← NIL)))
(T (* No protection, just reuse his looks)
(SETQ LOOKS (fetch PLOOKS of PIECE]
(RETURN (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS])
(\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 "21-May-84 16:46")
(PROG [(SEL (fetch SEL of TEXTOBJ))
(FONT NIL)
(FACE NIL)
(SIZE NIL)
NEWLOOKS
(POS (create POSITION
XCOORD ←(fetch LEFT of (WINDOWPROP (fetch \WINDOW of TEXTOBJ)
(QUOTE REGION)))
YCOORD ←(fetch TOP of (WINDOWPROP (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)
(QUOTE (Other (TEDIT.NEW.FONT]
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 "12-Apr-84 10:45")
(* At a piece boundary, update the line formatting
fields ASCENT, DESCENT, and FONTWIDTHS)
(COND
(PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
TLOOKS FONT TEMP NEWPC)
(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 401)
(\PUTBASE WLIST 0 0)
(add TLEN 1)
(SETQ CHLIST (\ADDBASE CHLIST 2))
(SETQ WLIST (\ADDBASE WLIST 1))
(SETQ PC (fetch NEXTPIECE of PC))
(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)))
(SETQ PC (fetch NEXTPIECE of PC))
(SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ]
(add CHNO (\EDITELT LOOKS LOOKNO))
(add INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
(SETQ NEWPC PC)))
(COND
((NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM)))
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS)
(SETQ FONT (fetch CLFONT of TLOOKS))
[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 400) (* 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)
(AND (ffetch CLPROTECTED of TLOOKS)
(freplace LHASPROT of LINE with T))
(* If this line contains protected text, mark the
linedescriptor accordingly)
(SETQ NEWPC PC)))
(RETURN NEWPC])
(\TEDIT.PARSE.CHARLOOKS.LIST
[LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* jds "11-Apr-84 11:25")
(* 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)
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))
((type? FONTDESCRIPTOR 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 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 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 "21-May-84 16:48")
(* 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)
(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 QUADD (LISTGET NEWLOOKS (QUOTE QUAD)))
[SELECTQ QUADD
((LEFT RIGHT CENTERED JUSTIFIED) (* Do nothing -- we got a valid justification spec)
)
(JUST (SETQ QUADD (QUOTE JUSTIFIED)))
(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))
(RETURN NEWLOOKS])
(\TEDIT.FONTCOPY
[LAMBDA (FONT NEWSPECS TEXTOBJ) (* jds " 4-May-84 14:22")
(* 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))
T))
FONT])
)
(* Paragraph looks functions)
(DEFINEQ
(TEDIT.GET.PARALOOKS
[LAMBDA (FILE) (* jds "16-May-84 16:42")
(* 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 TABFLG)) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS)))
(RETURN LOOKS])
(TEDIT.PARALOOKS
[LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* jds "21-May-84 12:05")
(* 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# (fetch CH# of (fetch SEL of TEXTOBJ)))
(CHLIM (fetch CHLIM of (fetch SEL of TEXTOBJ)))
(REPLACEALLFIELDS)
D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD
NLOOKSAVE PC1 (OLDLOOKSLIST))
(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))
(SETQ REPLACEALLFIELDS T))
(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 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)
(CAR (fetch TABSPEC of (fetch PPARALOOKS
of PC]
(for SPEC in (CDR TABSPECC)
collect (create TAB
TABKIND ←(CDR SPEC)
TABX ←(CAR SPEC]
(bind (NPC ← PC) for PC# from (IPLUS PCNO \EltsPerPiece) by \EltsPerPiece while NPC
do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch PPARALOOKS of NPC)))
[COND
(REPLACEALLFIELDS (replace PPARALOOKS of NPC with D))
(T (COND
((NEQ (fetch PPARALOOKS of NPC)
LASTLOOKS) (* only build a new FMTSPEC when they are different)
(SETQ LASTLOOKS (fetch PPARALOOKS of NPC))
(SETQ NEWLOOKS (replace PPARALOOKS of NPC with (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)))
(T (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 (SUB1 (\EDITELT PCTB PC#]
(COND
((IGEQ NCHLIM (fetch CHLIM of SEL))
(RETURN))) (* Make a new set of looks.)
))
(SETQ NPC (fetch NEXTPIECE of NPC)))
[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 (replace PPARALOOKS of NPC with D))
(T (COND
((NEQ (fetch PPARALOOKS of NPC)
LASTLOOKS) (* only build a new FMTSPEC when they are different)
(SETQ LASTLOOKS (fetch PPARALOOKS of NPC))
(SETQ NEWLOOKS (replace PPARALOOKS of NPC with (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)))
(T (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# CHLIM)
(replace \DIRTY of TEXTOBJ with T) (* Mark the document as changed.)
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION ←(QUOTE ParaLooks)
THLEN ←(ADD1 (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) (* jds "16-May-84 17:00")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((LOOKS (fetch PPARALOOKS of PC))
DEFAULTTAB TABSPECS)
(\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 (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)
(COND
([AND (fetch TABSPEC of LOOKS)
(OR (SETQ DEFAULTTAB (CAR (fetch TABSPEC of LOOKS)))
(SETQ TABSPECS (CDR (fetch TABSPEC of LOOKS]
(* There are tab specs to save, or there is a default
tab setting to save)
(\BOUT FILE 1))
(T (* There are no tab looks. Just let him go.)
(\BOUT FILE 0))) (* Will be tab specs)
(\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)
])
(\TEDIT.CONVERT.TO.FORMATTED
[LAMBDA (TEXTOBJ START END) (* jds "24-Apr-84 10:57")
(* 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)
(* jds " 1-Feb-84 18:38")
(* 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)
(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)
(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.PROMTPPRINT TEXTOBJ "Please select some text to modify first" T])
(TEDIT.UNDO.LOOKS
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* jds " 8-Mar-84 14:07")
(* 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 "18-Jan-84 15:07")
(* 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])
)
(* VERSION 0 Compatibility reading functions)
(DEFINEQ
(TEDIT.BUILD.PCTB0
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* jds "18-May-84 11:50")
(* * READ OBSOLETE FORMATS OF TEDIT FILE)
(PROG (SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE
TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
(CURCH# 1)
(TEXTSTREAM (AND TEXTOBJ TEXTOBJ:STREAMHINT)))
(* Get the number of pieces needed
(if AN formatted file), otherwise PCCOUNT will be NIL)
[SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND
(TEXTOBJ (fetch FMTSPEC of TEXTOBJ))
(T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]
(SETQ PCTB (\MAKEPCTB NIL PCCOUNT))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
(SETFILEPTR TEXT PIECEINFOCH#)
(bind (OLDPC ← NIL) for I from 1 to PCCOUNT as PCN from \FirstPieceOffset by \EltsPerPiece
do (SETQ PC (create PIECE
PFILE ← TEXT
PFPOS ← CURFILECH#
PLEN ←(SETQ PCLEN (\DWIN TEXT))
PREVPIECE ← OLDPC
PPARALOOKS ← DEFAULTPARALOOKS))
[COND
(OLDPC (replace NEXTPIECE of OLDPC with PC)
(replace PPARALOOKS of PC with (fetch PPARALOOKS of OLDPC]
(SETQ TYPECODE (\SMALLPIN TEXT))
(SELECTC TYPECODE
(\PieceDescriptorLOOKS (TEDIT.GET.CHARLOOKS0 PC TEXT)
(add CURFILECH# (fetch PLEN of PC)))
(\PieceDescriptorOBJECT (TEDIT.GET.OBJECT0 TEXTSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (fetch PLEN of PC))
(replace PLEN of PC with 1)
(* Only object--can't be followed by either ot the
others.)
)
(\PieceDescriptorPARA (AND OLDPC (replace PPARALAST of OLDPC with T))
(TEDIT.GET.PARALOOKS0 PC TEXT)
(replace PLEN of PC with (\DWIN TEXT))
(* Set this piece's length from the character looks.)
(\SMALLPIN TEXT)
(* Skip the piece-type code, since we know what's next)
(TEDIT.GET.CHARLOOKS0 PC TEXT)
(* This document is "formatted".)
(add CURFILECH# (fetch PLEN of PC))
(AND TEXTOBJ (replace FORMATTEDP of TEXTOBJ
with T)))
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(SETQ OLDPC PC)
(\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
PC)
(add CURCH# (fetch PLEN of PC))
finally (\EDITSETA PCTB PCN CURCH#)
(\EDITSETA PCTB (ADD1 PCN)
(QUOTE LASTPIECE))
(\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 PCN))
(\EDITSETA PCTB \PCTBFreePieces 0))
(RETURN PCTB])
(TEDIT.GET.CHARLOOKS0
[LAMBDA (PC FILE) (* jds " 3-Apr-84 10:42")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(replace PLOOKS of PC with LOOKS)
(SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which follows)
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE]
(* The font name)
(SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points)
(SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance)
(SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance)
(OR (ZEROP SUB)
(SETQ SUPER (IMINUS SUB))) (* If this is an old file, it'll have a subscript value
not zero. Let those past and do the right thing.)
(COND
((NOT (ZEROP (\BIN FILE))) (* This text is NEW. Mark it so.)
(replace PNEW of PC with T)))
[COND
((NOT (ZEROP (\BIN FILE))) (* There is style or user information to be read)
(SETQ STYLESTR (\STRINGIN FILE))
(SETQ USERSTR (\STRINGIN FILE))
(COND
((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info)
(replace CLSTYLE of LOOKS with (READ STYLESTR)))
(T (replace CLSTYLE of LOOKS with 0)))
(COND
((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info)
(replace CLUSERINFO of LOOKS with (READ USERSTR]
(SETQ PROPS (\SMALLPIN FILE))
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
(replace CLFONT of LOOKS with (AND NAME (NOT (ZEROP SIZE))
(FONTCREATE NAME SIZE (COND
((AND (fetch CLBOLD of LOOKS)
(fetch CLITAL of LOOKS))
(QUOTE BOLDITALIC))
((fetch CLBOLD of LOOKS)
(QUOTE BOLD))
((fetch CLITAL of LOOKS)
(QUOTE ITALIC])
(TEDIT.GET.OBJECT0
[LAMBDA (STREAM PIECE FILE CURCH#) (* jds " 3-Apr-84 10:42")
(* Get an object from the file)
(* CURCH# = fileptr within the text section of the file
where the object's text starts.)
(PROG (FILEPTRSAVE NAMELEN NAME OBJ)
(SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which follows)
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE]
(* The re-load function name)
(SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the building of the
object)
(SETFILEPTR FILE CURCH#)
(SETQ OBJ (APPLY* NAME FILE STREAM PIECE CURCH#))
(SETFILEPTR FILE FILEPTRSAVE)
(replace POBJ of PIECE with OBJ)
(replace PFILE of PIECE with NIL)
(replace PSTR of PIECE with NIL)
[replace PLOOKS of PIECE with (COND
((fetch PREVPIECE of PIECE)
(fetch PLOOKS of (fetch PREVPIECE of PIECE)))
(T (OR (fetch DEFAULTCHARLOOKS of (fetch (TEXTSTREAM
TEXTOBJ)
of STREAM))
(CHARLOOKS.FROM.FONT TEDIT.DEFAULT.FONT]
(RETURN (fetch POBJ of PIECE])
(TEDIT.GET.PARALOOKS0
[LAMBDA (PC FILE) (* jds "16-May-84 16:47")
(* Put a description of LOOKS into FILE.
LOOKS apply to characters CH1 thru CHLIM-1)
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC)
(replace PPARALOOKS of PC with LOOKS)
(replace 1STLEFTMAR of LOOKS with (\SMALLPIN FILE))
(* Left margin for the first line of the paragraph)
(replace LEFTMAR of LOOKS with (\SMALLPIN FILE)) (* Left margin for the rest of the paragraph)
(replace RIGHTMAR of LOOKS with (\SMALLPIN FILE))
(* Right margin for the paragraph)
(replace LEADBEFORE of LOOKS with (\SMALLPIN FILE))
(* Leading before the paragraph)
(replace LEADAFTER of LOOKS with (\SMALLPIN FILE))
(* Lead after the paragraph)
(replace LINELEAD of LOOKS with (\SMALLPIN FILE))
(* inter-line leading)
(replace TABSPEC of LOOKS with (SETQ TABSPEC (CONS NIL NIL)))
(* Will be tab specs)
(SETQ TABFLG (\BIN FILE))
(replace QUAD of LOOKS with (SELECTC (\BIN FILE)
(1 (QUOTE LEFT))
(2 (QUOTE RIGHT))
(3 (QUOTE CENTERED))
(4 (QUOTE JUSTIFIED))
(SHOULDNT)))
(COND
((NOT (ZEROP TABFLG)) (* There are tabs to read)
(SETQ DEFAULTTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (\BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX ←(\SMALLPIN FILE)
TABKIND ←(SELECTQ
(\BIN FILE)
(0 (QUOTE LEFT))
(1 (QUOTE RIGHT))
(2 (QUOTE CENTERED))
(3 (QUOTE DECIMAL))
(SHOULDNT]
(OR (ZEROP DEFAULTTAB)
(RPLACA TABSPEC DEFAULTTAB))
(RPLACD TABSPEC TABS])
)
(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: DONTCOPY
(FILEMAP (NIL (7198 49418 (CHARLOOKS.FROM.FONT 7208 . 7969) (EQCLOOKS 7971 . 9269) (TEDIT.CARETLOOKS
9271 . 9688) (TEDIT.GET.CHARLOOKS 9690 . 12658) (TEDIT.GET.PARALOOKS 12660 . 15040) (TEDIT.LOOKS 15042
. 24262) (TEDIT.MODIFYLOOKS 24264 . 25614) (TEDIT.NEW.FONT 25616 . 25940) (TEDIT.PUT.CHARLOOKS 25942
. 29296) (TEDIT.PUT.PARALOOKS 29298 . 32091) (\TEDIT.APPLY.STYLES 32093 . 32969) (
\TEDIT.CARETLOOKS.VERIFY 32971 . 33758) (\TEDIT.GET.INSERT.CHARLOOKS 33760 . 35833) (
\TEDIT.GET.TERMSA.WIDTHS 35835 . 36317) (\TEDIT.LOOKS 36319 . 38433) (\TEDIT.LOOKS.UPDATE 38435 .
41470) (\TEDIT.PARSE.CHARLOOKS.LIST 41472 . 45800) (\TEDIT.PARSE.PARALOOKS.LIST 45802 . 48659) (
\TEDIT.FONTCOPY 48661 . 49416)) (49457 69360 (TEDIT.GET.PARALOOKS 49467 . 51847) (TEDIT.PARALOOKS
51849 . 58889) (TEDIT.PUT.PARALOOKS 58891 . 61684) (\TEDIT.CONVERT.TO.FORMATTED 61686 . 63261) (
\TEDIT.PARABOUNDS 63263 . 65456) (\TEDIT.FORMATTABS 65458 . 69358)) (69399 73631 (TEDIT.REDO.LOOKS
69409 . 70079) (TEDIT.REDO.PARALOOKS 70081 . 70711) (TEDIT.UNDO.LOOKS 70713 . 72278) (
TEDIT.UNDO.PARALOOKS 72280 . 73629)) (73686 83762 (TEDIT.BUILD.PCTB0 73696 . 76839) (
TEDIT.GET.CHARLOOKS0 76841 . 79764) (TEDIT.GET.OBJECT0 79766 . 81337) (TEDIT.GET.PARALOOKS0 81339 .
83760)))))
STOP