(FILECREATED "13-Nov-84 10:15:33" {IVY}<TEDIT>TEDITHCPY.;3 35072
changes to: (FNS \TEDIT.HARDCOPY.FORMATLINE)
previous date: "25-Oct-84 09:23:59" {IVY}<TEDIT>TEDITHCPY.;2)
(* Copyright (c) 1983, 1984 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITHCPYCOMS)
(RPAQQ TEDITHCPYCOMS ((FILES TEDITWINDOW)
(COMS (* Generic interfact functions and common code)
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.FORMATLINE
\TEDIT.HCPYLOOKS.UPDATE \PTSTOMICAS \TEDIT.HCPYFMTSPEC
\TEDIT.INTEGER.IMAGEBOX))
(COMS (* PRESS-specific code)
(INITVARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
(* .75 inches from bottom, 1 from top)
(FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.MODIFYLOOKS))
(FILES TEDITPAGE)))
(FILESLOAD TEDITWINDOW)
(* Generic interfact functions and common code)
(DEFINEQ
(TEDIT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
(* jds " 2-Aug-84 12:58")
(* Send the text to the printer.)
(DECLARE (GLOBALVARS PRINTERMODE))
(COND
[(OR SERVER DEFAULTPRINTINGHOST) (* We can only hardcopy if there is a server specified,
or the system will give us a reasonable default one.)
(SELECTQ (PRINTERTYPE SERVER)
(PRESS (* Send to a PRESS printer)
(TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER
PRINTOPTIONS (QUOTE PRESS)))
(INTERPRESS (* Send it to an INTERPRESS printer)
(TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER
PRINTOPTIONS (QUOTE INTERPRESS)))
(ERROR (CONCAT "Can't print TEDIT documents on a " (PRINTERTYPE SERVER)
" printer."]
(T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM)
"Can't HARDCOPY: No print server specified." T])
(TEDIT.HCPYFILE
[LAMBDA (STREAM FILE BREAKPAGETITLE) (* jds " 7-Sep-84 20:09")
(* Create a hardcopy-format FILE from the text on
STREAM, with the file type depending on what the default
printer is.)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
(SERVERTYPE (PRINTERTYPE))
FILENM TXTFILE)
(SETQ TXTFILE (fetch TXTFILE of TEXTOBJ))
[SETQ FILENM (COND
((AND (NOT FILE)
(type? STREAM TXTFILE)) (* There was a file!)
(SETQ FILENM (UNPACKFILENAME (fetch FULLFILENAME of TXTFILE)))
(LISTPUT FILENM (QUOTE VERSION)
NIL)
(LISTPUT FILENM (QUOTE EXTENSION)
(SELECTQ SERVERTYPE
(PRESS (QUOTE PRESS))
((INTERPRESS IP)
(QUOTE IP))
NIL))
(PACKFILENAME FILENM]
[SETQ FILENM (OR FILE (MKATOM (TEDIT.GETINPUT TEXTOBJ (SELECTQ SERVERTYPE
(PRESS "PRESS file name: ")
((INTERPRESS IP)
"INTERPRESS file name: ")
NIL)
FILENM]
(AND FILENM (TEDIT.FORMAT.HARDCOPY STREAM FILENM T BREAKPAGETITLE NIL NIL SERVERTYPE])
(\TEDIT.HARDCOPY.FORMATLINE
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING?)
(* jds "13-Nov-84 09:47")
(* Given a starting place, format the next line of
text. Return T if a control-L was seen on the line.)
(PROG ((TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(CH#B CH#1)
(CHNO CH#1)
(LOOKNO 0)
(GATHERBLANK T)
(TLEN 0)
(INVISIBLERUNS 0)
(DESCENT 0)
(ASCENT 0)
(PREVSP 0)
(#BLANKS 0)
(DEVICE IMAGESTREAM)
TX DX TXB CH FORCEEND T1SPACE TXB1 DXB LOOK#B FONT FONTWIDTHS TERMSA CLOOKS TEXTSTREAM
CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO CTRL\L\SEEN
1STLN FMTSPEC)
%
(* * Variables % (TLEN = Current character count on the line) (CHNO = Current character # in the %text)
(DX = width of current char/object) (TX = current right margin) % (TXB1 = right margin of the first space/tab/CR in
a row of space/tab/CR) % (CH#B = The CHNO of most recent space/tab) (TXB = right margin of most recent %space/tab)
(DXB = width of most recent space/tab) (PREVSP = location on the line %of the previous space/tab to this space/tab
+ 1) (T1SPACE = a space/CR/TAB has been seen) (#BLANKS = # of spaces/tabs seen) % (LOOKNO = Current index into the
LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as %characters are read in) (LOOK#B = The LOOKNO of the most recent
space/tab) (ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential
line break point))
(SETQ CHLIST (fetch (ARRAYP BASE) of (fetch CHARS of THISLINE)))
(* Place to put character codes/objects)
(SETQ WLIST (fetch (ARRAYP BASE) of (fetch WIDTHS of THISLINE)))
(* Place to put width of each item)
(SETQ LOOKS (fetch LOOKS of THISLINE))
(SETQ TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
(SETQ TERMSA (fetch TXTTERMSA of TEXTOBJ))
(replace LOOKSUPDATEFN of TEXTSTREAM with (FUNCTION \TEDIT.HCPYLOOKS.UPDATE))
(* This gets called every time we cross a piece
boundary, to check for changes in looks.)
(freplace CHARLIM of LINE with TEXTLEN) (* Force each new line to find its true CHARLIM.)
(freplace CHAR1 of LINE with CH#1)
(freplace CR\END of LINE with NIL) (* Assume we won't see a CR.)
(replace LHASTABS of LINE with NIL) (* And has no TABs.)
(COND
[(COND
((AND (ILEQ CH#1 TEXTLEN)
(NOT (ZEROP TEXTLEN))) (* Only continue if there's really text we can format.)
(\SETUPGETCH CH#1 TEXTOBJ) (* Starting place)
(* And starting character looks)
(SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM))
(COND
((fetch CLINVISIBLE of CLOOKS) (* 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)
(SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM))
(\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (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 PCNO (ADD1 (fetch (TEXTSTREAM PCNO) of TEXTSTREAM)))
(SETQ CLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ)))
(while (AND PC (fetch CLINVISIBLE of CLOOKS))
do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch PLEN of PC)))
(SETQ PC (fetch NEXTPIECE of PC))
(SETQ CLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ)))
(add PCNO 1))
(add CHNO (\EDITELT LOOKS LOOKNO))
(\SETUPGETCH (create EDITMARK
PC ←(OR PC (QUOTE LASTPIECE))
PCOFF ← 0
PCNO ← PCNO)
TEXTOBJ)))
(ILEQ CHNO TEXTLEN)))
(\TEDIT.HCPYLOOKS.UPDATE TEXTSTREAM (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)
CLOOKS)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT)
(\EDITSETA LOOKS 0 CLOOKS) (* Save looks in the line cache)
(SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (OR (fetch (TEXTSTREAM CURRENTPARALOOKS)
of TEXTSTREAM)
(fetch FMTSPEC of TEXTOBJ))
IMAGESTREAM))
(* Paragraph formatting info)
[SETQ 1STLN (OR (IEQP CH#1 1)
(AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)
(fetch PREVPIECE of (fetch (TEXTSTREAM PIECE) of TEXTSTREAM))
(fetch PPARALAST of (fetch PREVPIECE of (fetch (TEXTSTREAM PIECE)
of TEXTSTREAM)))
(IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM)
(fetch COFFSET of TEXTSTREAM))
(IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM)
(fetch CPAGE of TEXTSTREAM]
(* Are we on the first line of a paragraph?)
(replace 1STLN of LINE with 1STLN)
(COND
((AND 1STLN (NOT DOINGHEADING?)) (* This is a new paragraph. Check for special paragraph
types, and handle them accordingly.)
(SELECTQ (fetch FMTPARATYPE of FMTSPEC)
(PAGEHEADING (* This paragraph is the content for a page heading.
Handle it, then don't bother formatting further.)
(TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TEXTSTREAM LINE FMTSPEC
CHNO)
(* This will capture the text, and set LINE:CHARLIM to
the LAST char# in the page heading.
That lets formatting continue apace.)
(RETURN NIL))
NIL)))
[SETQ TX (replace LEFTMARGIN of LINE with (IPLUS 8 (COND
(1STLN (fetch 1STLEFTMAR
of FMTSPEC))
(T (fetch LEFTMAR of FMTSPEC]
(* Set the left margin accordingly)
[replace RIGHTMARGIN of LINE with (SETQ WIDTH (COND
((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC)))
(IPLUS 8 (fetch RIGHTMAR of FMTSPEC)))
(T WIDTH]
(* RIGHTMAR = 0 => follow the window's width.)
(SETQ TXB1 WIDTH)
(for old TLEN from TLEN to 254 as old CHNO from CHNO to TEXTLEN when (SETQ CH
(\BIN TEXTSTREAM)
)
do (* The character loop)
(* Get the next character for the line.)
[SETQ DX (COND
((SMALLP CH) (* CH is really a character)
(\GETWIDTH FONTWIDTHS CH))
(T (* CH is an object)
(SETQ BOX (\TEDIT.INTEGER.IMAGEBOX (APPLY* (IMAGEOBJPROP CH (QUOTE
IMAGEBOXFN))
CH IMAGESTREAM TX WIDTH)))
(* Get its size)
[SETQ ASCENT (IMAX ASCENT (IDIFFERENCE (fetch YSIZE of BOX)
(fetch YDESC of BOX]
(SETQ DESCENT (IMAX DESCENT (fetch YDESC of BOX)))
(IMAGEOBJPROP CH (QUOTE BOUNDBOX)
BOX)
(fetch XSIZE of BOX] (* Get CH's X width.)
[SELCHARQ CH
(SPACE (* CH is a <Space>. Remember it, in case we need to
break the line.)
(COND
(GATHERBLANK (SETQ TXB1 TX)
(SETQ GATHERBLANK NIL)))
(SETQ CH#B CHNO) (* put the location # of the previous space/tab in the
character array instead of the space itself)
(\RPLPTR CHLIST 0 PREVSP)
(\PUTBASE WLIST 0 DX)
(SETQ PREVSP (ADD1 TLEN))
(SETQ T1SPACE T)
(add TX DX)
(SETQ TXB TX)
(SETQ DXB DX)
(SETQ LOOK#B LOOKNO)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT)
(SETQ INVISIBLERUNSB INVISIBLERUNS)
(add #BLANKS 1))
(CR (* Ch is a <Return>. Force an end to the line.)
(freplace CHARLIM of LINE with CHNO)
(SETQ FORCEEND T)
(\RPLPTR CHLIST 0 (CHARCODE CR))
(\PUTBASE WLIST 0 (SETQ DX (IMAX DX 6)))
(COND
(GATHERBLANK (SETQ TXB1 TX)
(SETQ GATHERBLANK NIL)))
(SETQ T1SPACE T)
(freplace CR\END of LINE with T)
(SETQ TX (IPLUS TX DX))
(replace LSTLN of LINE with T)
(RETURN))
(↑L (* Ch is a <Form% Feed> Force an end to the line.
Immediately--just like a CR.)
(SETQ CTRL\L\SEEN T)
(freplace CHARLIM of LINE with CHNO)
(SETQ FORCEEND T)
(\RPLPTR CHLIST 0 (CHARCODE CR))
(\PUTBASE WLIST 0 (SETQ DX (IMAX DX 6)))
(COND
(GATHERBLANK (SETQ TXB1 TX)
(SETQ GATHERBLANK NIL)))
(SETQ T1SPACE T)
(freplace CR\END of LINE with T)
(SETQ TX (IPLUS TX DX))
(replace LSTLN of LINE with T)
(RETURN))
(TAB (* Try to be reasonable with tabs.
This will create trouble when doing fast-case
insert/delete, but Pah! for now.)
(SETQ TABPENDING
(\TEDIT.FORMATTABS TEXTOBJ FMTSPEC THISLINE CHLIST WLIST TX 1270
8 TABPENDING))
(* Figure out which tab stop to use, and what we need
to do to get there.)
[COND
((FIXP TABPENDING) (* If it returns a number, that is the new TX, adjusted
for any prior tabs)
(SETQ TX TABPENDING)
(SETQ TABPENDING NIL))
(TABPENDING (* Otherwise, look in the PENDINGTAB for the new TX)
(SETQ TX (fetch PTNEWTX of TABPENDING]
(COND
(GATHERBLANK (SETQ TXB1 TX)
(SETQ GATHERBLANK NIL)))
(SETQ CH#B CHNO)
(SETQ DX (\GETBASE WLIST 0))
(\RPLPTR CHLIST 0 CH)
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
PREVSP)
(* All the spaces before a tab don't take part in
justification from here on.)
(SETQ PREVSP 0)
(SETQ T1SPACE T)
(SETQ TX (IPLUS TX DX))
(SETQ TXB TX) (* Remember the world in case this is the "space"
before the line breaks)
(SETQ DXB DX)
(SETQ LOOK#B LOOKNO)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT)
(SETQ INVISIBLERUNSB INVISIBLERUNS))
(PROGN (SETQ GATHERBLANK T)
(COND
((IGREATERP (SETQ TX (IPLUS TX DX))
WIDTH) (* We're past the right margin;
stop formatting at the last blank.)
(SETQ FORCEEND T)
(COND
(T1SPACE (* There's a breaking point on this line.
Go back there and break the line.)
(freplace CHARLIM of LINE with CH#B)
(SETQ TX TXB)
(SETQ DX DXB)
(SETQ ASCENT ASCENTB)
(SETQ DESCENT DESCENTB)
(SETQ LOOKNO LOOK#B)
(SETQ INVISIBLERUNS INVISIBLERUNSB))
((IGREATERP TLEN 0)
(freplace CHARLIM of LINE with (IMAX CH#1 (SUB1 CHNO)))
(SETQ TX (IDIFFERENCE TX DX))
(* No spaces on this line; break it before this
character.)
)
(T (* Can't split BEFORE the first thing on the line!)
(freplace CHARLIM of LINE with CHNO)
(\RPLPTR CHLIST 0 CH)
(\PUTBASE WLIST 0 DX)))
(RETURN))
(T (* Not past the rightmargin yet...)
(\RPLPTR CHLIST 0 CH)
(\PUTBASE WLIST 0 DX]
(SETQ CHLIST (\ADDBASE CHLIST 2)) (* Move the pointers forward for the next character.)
(SETQ WLIST (\ADDBASE WLIST 1)))
(COND
((AND (IEQP TLEN 255)
(ILESSP CHNO TEXTLEN)) (* This line is too long for us to format??)
(TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T)))
(COND
(TABPENDING (* There is a TAB outstanding.
Go handle it.)
(SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ FMTSPEC THISLINE CHLIST WLIST
TX 1270 8 TABPENDING))
[COND
((FIXP TABPENDING) (* If it returns a number, that is the new TX, adjusted
for any prior tabs)
(SETQ TX TABPENDING)
(SETQ TABPENDING NIL))
(TABPENDING (* Otherwise, look in the PENDINGTAB for the new TX)
(SETQ TX (fetch PTNEWTX of TABPENDING]
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
PREVSP)
(SETQ PREVSP 0]
(T (* No text to go in this line;
set Ascent/Descent to the default font from the
window.)
(SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (fetch FMTSPEC of TEXTOBJ)))
[SETQ 1STLN (AND (fetch F5 of TEXTSTREAM)
(fetch PREVPIECE of (fetch F5 of TEXTSTREAM))
(fetch PPARALAST of (fetch PREVPIECE of (fetch F5 of TEXTSTREAM)))
(IEQP (fetch FW6 of TEXTSTREAM)
(fetch CPAGE of TEXTSTREAM))
(IEQP (fetch FW7 of TEXTSTREAM)
(fetch COFFSET of TEXTSTREAM]
(replace 1STLN of LINE with 1STLN)
[SETQ TX (SETQ TXB (replace LEFTMARGIN of LINE with (COND
(1STLN (fetch 1STLEFTMAR
of FMTSPEC))
(T (fetch LEFTMAR of FMTSPEC]
[replace RIGHTMARGIN of LINE with (SETQ WIDTH (COND
((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC)))
(fetch RIGHTMAR of FMTSPEC))
(T WIDTH]
(SETQ TXB1 WIDTH)))
[COND
((ZEROP (freplace LHEIGHT of LINE with (IPLUS ASCENT DESCENT)))
(replace LHEIGHT of LINE with (FONTPROP (OR (AND (fetch DEFAULTCHARLOOKS of TEXTOBJ)
(fetch CLFONT
of (fetch DEFAULTCHARLOOKS
of TEXTOBJ)))
DEFAULTFONT)
(QUOTE HEIGHT]
(* Line's height (or 12 for an empty line))
(replace ASCENT of LINE with ASCENT)
(replace DESCENT of LINE with DESCENT)
(freplace CHARTOP of LINE with CHNO)
(COND
(FORCEEND NIL)
(T (SETQ CHNO (SUB1 CHNO))
(SETQ TLEN (SUB1 TLEN))
(SETQ TXB1 TX))) (* If we ran off the end of the text, then keep true
space left on the line.)
(freplace LXLIM of LINE with TX)
(freplace DESC of THISLINE with LINE)
[freplace LEN of THISLINE
with (IMIN 254 (COND
((ILESSP TEXTLEN CH#1)
-1)
(T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch CHARLIM of LINE)
TEXTLEN)
(IPLUS INVISIBLERUNS (fetch CHAR1
of LINE]
(freplace SPACELEFT of LINE with (IDIFFERENCE WIDTH TXB1))
(\DOFORMATTING TEXTOBJ LINE FMTSPEC THISLINE #BLANKS PREVSP 1STLN)
(replace LFMTSPEC of LINE with FMTSPEC)
(replace LOOKSUPDATEFN of TEXTSTREAM with NIL)
(RETURN CTRL\L\SEEN])
(\TEDIT.HCPYLOOKS.UPDATE
[LAMBDA (STREAM PC NLOOKS) (* jds "18-Oct-84 16:00")
(* At a piece boundary, update the line formatting
fields ASCENT, DESCENT, and FONTWIDTHS)
(DECLARE (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS INVISIBLERUNS CHNO TLEN LOOKNO CHLIST WLIST
DEVICE))
(COND
(PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
TLOOKS FONT TEMP NEWPC OFFSET 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 (OR NLOOKS (\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)
(\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)))
(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))
(SETQ NEWPC PC)))
(COND
([AND PC (OR NLOOKS (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS)
of STREAM]
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS)
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)
(SETQ FONT (fetch CLFONT of TLOOKS))
[SETQ FONT (COND
((AND (type? FONTCLASS FONT)
(FONTCLASSCOMPONENT FONT DEVICE)))
(T (FONTCOPY FONT (QUOTE DEVICE)
DEVICE]
(SETQ OFFSET (OR (AND (fetch CLOFFSET of TLOOKS)
(\PTSTOMICAS (fetch CLOFFSET of TLOOKS)))
0))
(SETQ ASCENT (IMAX ASCENT (IPLUS (fetch \SFAscent of FONT)
OFFSET)))
(SETQ DESCENT (IMAX DESCENT (IDIFFERENCE (fetch \SFDescent of FONT)
OFFSET)))
(SETQ FONTWIDTHS (ffetch \SFWidths of FONT))
(COND
((NOT NLOOKS)
(* If we're calling this to initialize values, don't go and update the running cache. However, since NLOOKS is NIL,
we're not initializing, so go to it!)
(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)
))
(SETQ NEWPC PC)))
(OR NEWPC (SETQ NEWPC PC))
[COND
((AND (fetch POBJ of NEWPC)
(NEQ (fetch PLEN of NEWPC)
1)) (* If this piece is for an object, check for a length
mismatch)
(COND
((IMAGEOBJPROP (fetch POBJ of NEWPC)
(QUOTE SUBSTREAM)))
(T
(* The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from.
Build an invisible run to fill the space.)
(add LOOKNO 1) (* Fix the counter of charlooks changes)
(\EDITSETA LOOKS LOOKNO (SUB1 (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))
(add CHNO (\EDITELT LOOKS LOOKNO))
(add INVISIBLERUNS (\EDITELT LOOKS LOOKNO))
(* Keep track of how much invisible text we cross over)
]
(RETURN NEWPC])
(\PTSTOMICAS
[LAMBDA (PtValue) (* jds "19-Jan-84 13:35")
(FIXR (FTIMES PtValue 35.27778])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (SPEC IMAGESTREAM) (* jds "10-Sep-84 14:42")
(* Given a display-type FMTSPEC, create a hardcopy
equivalent.)
(PROG ((SCALEFACTOR (DSPSCALE NIL IMAGESTREAM)))
(RETURN (create FMTSPEC using SPEC 1STLEFTMAR ←(FIXR (FTIMES (fetch 1STLEFTMAR
of SPEC)
SCALEFACTOR))
LEFTMAR ←(FIXR (FTIMES (fetch LEFTMAR of SPEC)
SCALEFACTOR))
RIGHTMAR ←(FIXR (FTIMES (fetch RIGHTMAR of SPEC)
SCALEFACTOR))
LEADBEFORE ←(FIXR (FTIMES (fetch LEADBEFORE of SPEC)
SCALEFACTOR))
LEADAFTER ←(FIXR (FTIMES (fetch LEADAFTER of SPEC)
SCALEFACTOR))
LINELEAD ←(FIXR (FTIMES (fetch LINELEAD of SPEC)
SCALEFACTOR))
QUAD ←(fetch QUAD of SPEC)
TABSPEC ←[CONS (AND (CAR (fetch TABSPEC of SPEC))
(FIXR (FTIMES (CAR (fetch TABSPEC
of SPEC))
SCALEFACTOR)))
(for TAB in (CDR (fetch TABSPEC of SPEC))
collect (CONS (FIXR (FTIMES SCALEFACTOR
(CAR TAB)))
(CDR TAB]
FMTSPECIALX ←(AND (fetch FMTSPECIALX of SPEC)
(FIXR (FTIMES (fetch FMTSPECIALX
of SPEC)
SCALEFACTOR)))
FMTSPECIALY ←(AND (fetch FMTSPECIALY of SPEC)
(FIXR (FTIMES (fetch FMTSPECIALY
of SPEC)
SCALEFACTOR])
(\TEDIT.INTEGER.IMAGEBOX
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
(* Take an IMAGEBOX, and assure that its contents are
integers)
(replace XKERN of OLDBOX with (FIXR (fetch XKERN of OLDBOX)))
(replace YDESC of OLDBOX with (FIXR (fetch YDESC of OLDBOX)))
(replace YSIZE of OLDBOX with (FIXR (fetch YSIZE of OLDBOX)))
(replace XSIZE of OLDBOX with (FIXR (fetch XSIZE of OLDBOX)))
OLDBOX])
)
(* PRESS-specific code)
(RPAQ? TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495))
(* .75 inches from bottom, 1 from top)
(DEFINEQ
(\TEDIT.HARDCOPY.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM) (* jds " 7-Sep-84 19:28")
(* Display LINE on the HARDCOPY file under way.)
(* If possible, use the information cached in THISLINE)
(PROG ((CH 0)
(CHLIST (fetch CHARS of (OR (fetch CACHE of LINE)
THISLINE)))
(WLIST (fetch WIDTHS of (OR (fetch CACHE of LINE)
THISLINE)))
(LOOKS (fetch LOOKS of (OR (fetch CACHE of LINE)
THISLINE)))
(DS (fetch DS of TEXTOBJ))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(LEFTMARGIN (fetch LEFTMARGIN of LINE))
OLOOKS LOOKSTARTX FONT OFONT)
(COND
((ILEQ (fetch CHAR1 of LINE)
TEXTLEN) (* Only display the line if it appears before the end of
the text!)
(COND
((fetch CACHE of LINE) (* This line was cached. Don';t need to re-compute the
breaks &c)
)
((NEQ (fetch DESC of THISLINE)
LINE) (* Format the line to our specs)
(\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch WIDTH of REGION)
(fetch CHAR1 of LINE)
THISLINE LINE NIL PRSTREAM)))
(* Use the characters cached in THISLINE.)
(SETQ OLOOKS (\EDITELT LOOKS 0))
(MOVETO LEFTMARGIN (COND
[(AND (fetch CLOFFSET of OLOOKS)
(NEQ 0 (fetch CLOFFSET of OLOOKS)))
(IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET of OLOOKS]
(T (fetch YBASE of LINE)))
PRSTREAM)
(DSPFONT (SETQ OFONT (fetch CLFONT of OLOOKS))
PRSTREAM)
(SETQ LOOKSTARTX LEFTMARGIN)
(bind ((LOOKNO ← 1)
(TX ← LEFTMARGIN)
DX)
for I from 0 to (fetch LEN of (OR (fetch CACHE of LINE)
THISLINE))
do (SETQ CH (\EDITELT CHLIST I))
(SETQ DX (\WORDELT WLIST I))
[SELECTC CH
(LMInvisibleRun (* An INVISIBLE run -- skip it, and skip over the char
count)
(add LOOKNO 1))
(LMLooksChange (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX
(fetch YBASE of LINE)
OLOOKS PRSTREAM)
(DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS
LOOKNO)))
PRSTREAM)
(add LOOKNO 1)
(DSPYPOSITION (COND
[(AND (fetch CLOFFSET of OLOOKS)
(NEQ 0 (fetch CLOFFSET
of OLOOKS)))
(IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET
of OLOOKS]
(T (fetch YBASE of LINE)))
PRSTREAM)
(SETQ LOOKSTARTX TX))
((CHARCODE (SPACE TAB)) (* TAB: use the width from the cache to decide the right
formatting.)
(DSPXPOSITION (IPLUS TX DX)
PRSTREAM))
((CHARCODE CR)
NIL)
(COND
((SMALLP CH)
(\OUTCHAR PRSTREAM CH))
(T (* CH is an object.)
(APPLY* (IMAGEOBJPROP CH (QUOTE DISPLAYFN))
CH PRSTREAM (IMAGESTREAMTYPE PRSTREAM))
(DSPXPOSITION (IPLUS TX DX)
PRSTREAM]
(add TX DX)
finally (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX (fetch YBASE of LINE)
OLOOKS PRSTREAM])
(\TEDIT.HARDCOPY.MODIFYLOOKS
[LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* jds "13-Aug-84 18:24")
(* Do underlining, overlining, etc. for PRESS files)
(COND
((fetch CLULINE of LOOKS) (* It's underlined.)
(DRAWLINE STARTX (IDIFFERENCE (fetch YBOT of LINE)
30)
CURX
(IDIFFERENCE (fetch YBOT of LINE)
30)
17
(QUOTE PAINT)
PRSTREAM) (* A 1/2-pt underline)
))
(COND
((fetch CLOLINE of LOOKS) (* Over-line)
(DRAWLINE STARTX (IPLUS (fetch YBASE of LINE)
(fetch LTRUEASCENT of LINE))
CURX
(IPLUS (fetch YBASE of LINE)
(fetch LTRUEASCENT of LINE))
17
(QUOTE PAINT)
PRSTREAM)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struch-thru)
(DRAWLINE STARTX (IPLUS (fetch YBASE of LINE)
(IQUOTIENT (ITIMES 35 (FONTPROP (fetch CLFONT of LOOKS)
(QUOTE ASCENT)))
3))
CURX
(IPLUS (fetch YBASE of LINE)
(IQUOTIENT (ITIMES 35 (FONTPROP (fetch CLFONT of LOOKS)
(QUOTE ASCENT)))
3))
17
(QUOTE PAINT)
PRSTREAM)))
(MOVETO CURX CURY PRSTREAM])
)
(FILESLOAD TEDITPAGE)
(PUTPROPS TEDITHCPY COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (931 29628 (TEDIT.HARDCOPY 941 . 2085) (TEDIT.HCPYFILE 2087 . 3293) (
\TEDIT.HARDCOPY.FORMATLINE 3295 . 21195) (\TEDIT.HCPYLOOKS.UPDATE 21197 . 27256) (\PTSTOMICAS 27258 .
27402) (\TEDIT.HCPYFMTSPEC 27404 . 28986) (\TEDIT.INTEGER.IMAGEBOX 28988 . 29626)) (29782 34949 (
\TEDIT.HARDCOPY.DISPLAYLINE 29792 . 33541) (\TEDIT.HARDCOPY.MODIFYLOOKS 33543 . 34947)))))
STOP