(FILECREATED " 4-Aug-86 17:08:49" {ERIS}<TEDIT>TEDITHCPY.;26 68515
changes to: (VARS TEDITHCPYCOMS)
previous date: "21-Mar-86 15:50:16" {ERIS}<TEDIT>TEDITHCPY.;25)
(* Copyright (c) 1983, 1984, 1985, 1986 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITHCPYCOMS)
(RPAQQ TEDITHCPYCOMS [(COMS (* Generic interface functions and common code)
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
\TEDIT.HARDCOPY.FORMATLINE \TEDIT.HARDCOPY.MODIFYLOOKS
\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))
(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])
(* Generic interface 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.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM) (* jds
"21-Mar-86 15:33")
(* 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))
(LINELEN (fetch LEN of (OR (fetch CACHE of LINE)
THISLINE)))
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))
(DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE)
PRSTREAM) (* For expanding spaces
to justify a line)
(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)
(WHILE (EQ (CHARCODE SPACE)
(\EDITELT CHLIST LINELEN)) DO (* Trim any trailing
blanks off the line, to
avoid the INTERPRESS
CORRECT bug that they
cause.)
(ADD LINELEN -1))
(bind (LOOKNO ← 1)
(TX ← LEFTMARGIN)
DX for I from 0 to LINELEN
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))
(\OUTCHAR PRSTREAM CH))
((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.FORMATLINE
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING?) (* jds
"21-Mar-86 15:29")
(* 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.)
(REPLACE LSTLN OF LINE WITH NIL) (* And assume it isn't
the last line in a
paragraph until we find
otherwise.)
(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) (* Check for decimal
tabs)
(COND
((AND (SMALLP CH)
(EQ CH (CHARCODE %.))
TABPENDING
(NOT (FIXP TABPENDING))
(EQ (fetch PTTYPE of TABPENDING)
(QUOTE DECIMAL)))
(SETQ TABPENDING (\TEDIT.FORMATTABS
TEXTOBJ
(fetch TABSPEC of FMTSPEC)
THISLINE CHLIST WLIST TX
(FIXR (FTIMES 36.0 (DSPSCALE NIL
IMAGESTREAM)))
0 TABPENDING T))
(* 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 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]
(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.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])
(\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)
(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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1489 66650 (TEDIT.HARDCOPY 1499 . 2821) (TEDIT.HCPYFILE 2823 . 4101) (
\TEDIT.HARDCOPY.DISPLAYLINE 4103 . 13994) (\TEDIT.HARDCOPY.FORMATLINE 13996 . 55330) (
\TEDIT.HARDCOPY.MODIFYLOOKS 55332 . 57084) (\TEDIT.HCPYLOOKS.UPDATE 57086 . 63928) (\TEDIT.HCPYFMTSPEC
63930 . 66008) (\TEDIT.INTEGER.IMAGEBOX 66010 . 66648)) (66900 68231 (TEDIT.HARDCOPYFN 66910 . 67621)
(\TEDIT.HARDCOPY 67623 . 68229)))))
STOP