(FILECREATED "25-Sep-85 17:07:31" {ERIS}<TEDIT>TEDITHCPY.;22 42689
changes to: (VARS TEDITHCPYCOMS)
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY)
previous date: "18-Sep-85 16:03:04" {ERIS}<TEDIT>TEDITHCPY.;21)
(* Copyright (c) 1983, 1984, 1985 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 \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
(COMS (* PRESS-specific code)
(VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
(* .75 inches from bottom, 1 from top)
(FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.MODIFYLOOKS))
(FILES TEDITPAGE)
(COMS (* Support for the window-menu's HARDCOPY button, LISTFILES, etc.)
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY)
(P (LISTPUT (ASSOC (QUOTE CONVERSION)
(ASSOC (QUOTE INTERPRESS)
PRINTFILETYPES))
(QUOTE TEDIT)
(FUNCTION \TEDIT.HARDCOPY])
(FILESLOAD TEDITWINDOW)
(* Generic interfact functions and common code)
(DEFINEQ
(TEDIT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
(* bvm: "17-Sep-85 17:34")
(* Send the text to the printer.)
(COND
[(OR SERVER DEFAULTPRINTINGHOST) (* We can only hardcopy if there is a server specified,
or the system will give us a reasonable default one.)
(for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER)
(QUOTE CANPRINT))
do (SELECTQ IMAGETYPE
[PRESS (* Send to a PRESS printer)
(RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE
SERVER PRINTOPTIONS (QUOTE PRESS]
[INTERPRESS (* Send it to an INTERPRESS printer)
(RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE
SERVER PRINTOPTIONS (QUOTE
INTERPRESS]
NIL)
finally (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) (* bvm: "17-Sep-85 18:57")
(* Create a hardcopy-format FILE from the text on
STREAM, with the file type depending on what the
default printer is.)
(LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE)
(QUOTE CANPRINT]
TEXTOBJ FILENM TXTFILE)
(COND
([SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT
(SETQ TEXTOBJ (TEXTOBJ STREAM))
(CONCAT IMAGETYPE " file name: ")
(COND
((type? STREAM (SETQ TXTFILE
(fetch TXTFILE of TEXTOBJ)))
(* There was a file, so supply default)
(PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE EXTENSION)
(SELECTQ IMAGETYPE
(PRESS (QUOTE PRESS))
(INTERPRESS (QUOTE IP))
NIL)
(QUOTE BODY)
(fetch FULLFILENAME of TXTFILE]
(TEDIT.FORMAT.HARDCOPY STREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
(\TEDIT.HARDCOPY.FORMATLINE
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING?)
(* jds "31-Jul-85 19:11")
(* Given a starting place, format the next line of
text. Return T if a control-L was seen on the line.)
(DECLARE (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST
WLIST DEVICE NEWASCENT NEWDESCENT))
(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 NEWASCENT NEWDESCENT)
(* * 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 (THISLINE 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)))
(AND PC (SETQ CLOOKS (\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))
(AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch PLOOKS of PC)
PC TEXTOBJ)))
(add PCNO 1))
(add CHNO (\EDITELT LOOKS LOOKNO))
(COND
(PC (* Move us to the right place in the stream)
(\SETUPGETCH (create EDITMARK
PC ← PC
PCOFF ← 0
PCNO ← PCNO)
TEXTOBJ))
(T (* We've walked off the end of the document.
Just note that we're not at any piece now.)
(replace (TEXTSTREAM PIECE) of TEXTSTREAM with NIL]
(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 FONT (fetch CLFONT of CLOOKS))
[SETQ FONT (COND
((AND (type? FONTCLASS FONT)
(FONTCLASSCOMPONENT FONT DEVICE)))
(T (FONTCOPY FONT (QUOTE DEVICE)
DEVICE] (* Keep the font around for char widths.)
(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 IMAGESTREAM)
(* 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 (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)))
(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)
(\FGETCHARWIDTH FONT 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)
(COND
(NEWASCENT (* The ascent/descent changed.
Update the real values, now that we have a character to
actually take effect on it)
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
(SETQ NEWASCENT NIL)))
(\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)
(COND
((AND NEWASCENT (ZEROP ASCENT)
(ZEROP DESCENT)) (* The ascent has changed; catch it)
(SETQ ASCENT NEWASCENT)
(SETQ DESCENT NEWDESCENT)))
(SETQ FORCEEND T)
(\RPLPTR CHLIST 0 (CHARCODE CR))
(\PUTBASE WLIST 0 (SETQ DX 0))
(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 (fetch PPARALAST
of (fetch PIECE of TEXTSTREAM)))
(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.)
(\RPLPTR CHLIST 0 CH)
(COND
(NEWASCENT (* The ascent/descent changed.
Update the real values, now that we have a character to
actually take effect on it)
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
(SETQ NEWASCENT NIL)))
(SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch TABSPEC
of FMTSPEC)
THISLINE CHLIST WLIST TX
(FIXR (FTIMES 36.0
(DSPSCALE NIL
IMAGESTREAM)))
0 TABPENDING NIL))
(* 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))
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
PREVSP)
(* All the spaces before a tab don't take part in
justification from here on.)
(SETQ #BLANKS 0) (* So we can allocate extra space among the right
number of blanks to justify things after the tab.)
(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
(* * This character isn't special. Just space over for it.)
(SETQ GATHERBLANK T)
(COND
((AND (SMALLP CH)
(IGEQ CH 192)
(ILEQ CH 207))
(* This is an NS accent character.
Space it 0.0)
(SETQ DX 0)))
(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...)
(COND
((AND NEWASCENT (SMALLP CH))
(* The ascent/descent changed.
Update the real values, now that we have a character to
actually take effect on it)
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
(SETQ NEWASCENT NIL)))
(\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)))
(* * Done processing characters; the line is now filled.)
(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 (fetch TABSPEC of FMTSPEC)
THISLINE CHLIST WLIST TX
(FIXR (FTIMES 36.0 (DSPSCALE NIL
IMAGESTREAM)))
0 TABPENDING T))
(SETQ TX TABPENDING)
(SETQ TABPENDING NIL)
(\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)))
(\EDITSETA LOOKS 0 CLOOKS)
[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 "31-Jul-85 13:45")
(* At a piece boundary, update the line formatting
fields ASCENT, DESCENT, and FONTWIDTHS)
(DECLARE (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST
WLIST DEVICE NEWASCENT NEWDESCENT))
(COND
(PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))
TLOOKS TEMP NEWPC OFFSET PARALOOKS PREVPC)
[COND
([OR (NOT (fetch PREVPIECE of PC))
(NEQ (fetch PPARALOOKS of PC)
(fetch PPARALOOKS of (fetch PREVPIECE of PC]
(* The paragraph looks have changed between the last
piece and this one. Take account of the change)
(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 (OR (ZEROP (fetch PLEN of 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
((AND PC (NEQ (fetch PPARALOOKS of PC)
(fetch PPARALOOKS of PREVPC)))
(* If there IS new text, and the paragraph looks have
changed, update the streams notion of them.)
(SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch PPARALOOKS
of PC)
PC TEXTOBJ))
(* And take care of style sheets on the way.)
(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)
(FIXR (FTIMES (DSPSCALE NIL DEVICE)
(fetch CLOFFSET of TLOOKS]
0))
(SETQ NEWASCENT (IMAX ASCENT (IPLUS (fetch \SFAscent of FONT)
OFFSET)))
(SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (fetch \SFDescent of FONT)
OFFSET)))
(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))
((NOT (OR PC NLOOKS)) (* We have run off the end of the document.
Bail out so that \TEDIT.HARDCOPY.FORMATLINE doesn't
die)
(RETFROM (QUOTE \BIN)
NIL)))
(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])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (SPEC IMAGESTREAM) (* jds "14-Jun-85 16:47")
(* Given a display-type FMTSPEC, create a hardcopy
equivalent. (Special positions are made paper-relative
first.))
(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))
FMTBASETOBASE ←(AND (fetch FMTBASETOBASE of SPEC)
(FIXR (FTIMES (fetch FMTBASETOBASE
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 (SCALEPAGEUNITS (fetch
FMTSPECIALX
of SPEC)
1.0 NIL)
SCALEFACTOR)))
FMTSPECIALY ←(AND (fetch FMTSPECIALY of SPEC)
(FIXR (FTIMES (SCALEPAGEUNITS (fetch
FMTSPECIALY
of SPEC)
1.0 NIL)
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 "23-Apr-85 02:58")
(* 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 (THISLINE WIDTHS) of (OR (fetch CACHE of LINE)
THISLINE)))
(LOOKS (fetch LOOKS of (OR (fetch CACHE of LINE)
THISLINE)))
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(LEFTMARGIN (fetch LEFTMARGIN of LINE))
(STREAMSCALE (DSPSCALE NIL PRSTREAM))
OLOOKS LOOKSTARTX FONT OFONT CURRENTY)
(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 [SETQ CURRENTY (COND
[(AND (fetch CLOFFSET of OLOOKS)
(NEQ 0 (fetch CLOFFSET of OLOOKS)))
(IPLUS (fetch YBASE of LINE)
(FIXR (FTIMES STREAMSCALE (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 [SETQ CURRENTY
(COND
[(AND (fetch CLOFFSET of OLOOKS)
(NEQ 0 (fetch CLOFFSET
of OLOOKS)))
(IPLUS (fetch YBASE of LINE)
(FIXR (FTIMES STREAMSCALE
(fetch CLOFFSET
of OLOOKS]
(T (fetch YBASE of LINE]
PRSTREAM)
(SETQ LOOKSTARTX TX))
((CHARCODE SPACE)
(DSPXPOSITION (IPLUS TX DX)
PRSTREAM))
((CHARCODE (TAB #↑I)) (* TAB: use the width from the cache to decide the
right formatting.)
[COND
((OR (IEQP CH (CHARCODE #↑I))
(fetch CLLEADER of OLOOKS)
(EQ (fetch CLUSERINFO of OLOOKS)
(QUOTE DOTTEDLEADER)))
(LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
(FONTCOPY (fetch CLFONT of OLOOKS)
(QUOTE DEVICE)
PRSTREAM)))
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER
TX DOTWIDTH]
(DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
PRSTREAM)
(* Move over to the next even multiple of a dot's
width.)
(while (ILEQ TTX (IPLUS TX DX))
do (* Print enough dots to fill the TAB's gap.)
(\OUTCHAR PRSTREAM (CHARCODE %.))
(add TTX DOTWIDTH]
(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))
(MOVETO (IPLUS TX DX)
CURRENTY 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 " 7-Feb-85 17:11")
(* Do underlining, overlining, etc. for PRESS files)
[PROG ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
[RULEWIDTH (FIXR (FTIMES .75 (DSPSCALE NIL PRSTREAM]
(ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
YOFFSET)
(COND
((fetch CLULINE of LOOKS) (* It's underlined.)
(DRAWLINE STARTX (IDIFFERENCE (fetch YBASE of LINE)
(IPLUS (FIXR STREAMSCALE)
(fetch LTRUEDESCENT of LINE)))
CURX
(IDIFFERENCE (fetch YBASE of LINE)
(IPLUS ONEPOINT (fetch LTRUEDESCENT of LINE)))
RULEWIDTH
(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))
RULEWIDTH
(QUOTE PAINT)
PRSTREAM)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struch-thru)
(DRAWLINE STARTX (SETQ YOFFSET
(IPLUS (fetch YBASE of LINE)
(IQUOTIENT [FIXR (FTIMES STREAMSCALE (FONTPROP (fetch CLFONT
of LOOKS)
(QUOTE ASCENT]
3)))
CURX YOFFSET RULEWIDTH (QUOTE PAINT)
PRSTREAM]
(MOVETO CURX CURY PRSTREAM])
)
(FILESLOAD TEDITPAGE)
(* Support for the window-menu's HARDCOPY button, LISTFILES, etc.)
(DEFINEQ
(TEDIT.HARDCOPYFN
[LAMBDA (WINDOW IMAGESTREAM) (* jds "25-Sep-85 15:38")
(* This is the TEdit HARDCOPYFN, hooking into the
system's standard Hardcopy window-menu operation.)
(PROG ((TEXTOBJ (TEXTOBJ WINDOW)))
(RESETLST [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
(QUOTE (AND (\TEDIT.MARKINACTIVE OLDVALUE]
(replace EDITOPACTIVE of TEXTOBJ with (QUOTE Hardcopy))
(TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM)))
(* Build the hardcopy)
])
(\TEDIT.HARDCOPY
[LAMBDA (FILE PFILE) (* jds "25-Sep-85 15:37")
(* Send the text to the printer.)
(SETQ FILE (OPENTEXTSTREAM FILE))
(RESETLST [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ FILE))
(QUOTE (AND (\TEDIT.MARKINACTIVE OLDVALUE]
(replace EDITOPACTIVE of (TEXTOBJ FILE) with (QUOTE Hardcopy))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL (QUOTE INTERPRESS))
(CLOSEF? PFILE)
PFILE])
)
(LISTPUT (ASSOC (QUOTE CONVERSION)
(ASSOC (QUOTE INTERPRESS)
PRINTFILETYPES))
(QUOTE TEDIT)
(FUNCTION \TEDIT.HARDCOPY))
(PUTPROPS TEDITHCPY COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1240 34039 (TEDIT.HARDCOPY 1250 . 2572) (TEDIT.HCPYFILE 2574 . 3852) (
\TEDIT.HARDCOPY.FORMATLINE 3854 . 24473) (\TEDIT.HCPYLOOKS.UPDATE 24475 . 31317) (\TEDIT.HCPYFMTSPEC
31319 . 33397) (\TEDIT.INTEGER.IMAGEBOX 33399 . 34037)) (34192 41019 (\TEDIT.HARDCOPY.DISPLAYLINE
34202 . 39263) (\TEDIT.HARDCOPY.MODIFYLOOKS 39265 . 41017)) (41117 42448 (TEDIT.HARDCOPYFN 41127 .
41838) (\TEDIT.HARDCOPY 41840 . 42446)))))
STOP