(FILECREATED "24-May-84 16:21:42" {DSK}TEDITHCPY.;9 55335
changes to: (FNS \TEDIT.PRESS.MODIFYLOOKS)
previous date: "24-May-84 11:35:22" {DSK}TEDITHCPY.;7)
(PRETTYCOMPRINT TEDITHCPYCOMS)
(RPAQQ TEDITHCPYCOMS ((FILES TEDITWINDOW)
(COMS (* Generic interfact functions and common code)
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.FORMATLINE
\TEDIT.HCPYFMTLINE \TEDIT.HCPYLOOKS.UPDATE \PTSTOMICAS
\TEDIT.HCPYFMTSPEC))
(COMS (* PRESS-specific code)
(RECORDS Rectangle)
[INITVARS (TEDIT.PRESS.MONITORLOCK (CREATE.MONITORLOCK (QUOTE
TEDIT.HARDCOPY]
(FNS TEDIT.PRESS.HARDCOPY TEDIT.PRESSFILE \TEDIT.PRESS.DISPLAYLINE
\TEDIT.PRESS.MODIFYLOOKS))
(COMS (* INTERPRESS-specific code)
(FNS TEDIT.IP.HARDCOPY TEDIT.IPFILE \TEDIT.IP.DISPLAYLINE
\TEDIT.IP.MODIFYLOOKS \TEDIT.IPFONTS))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS UPDATE/HCPY/LOOKS))))
(FILESLOAD TEDITWINDOW)
(* Generic interfact functions and common code)
(DEFINEQ
(TEDIT.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER #COPIES)
(* jds "20-Apr-84 16:07")
(* Send the text to the printer.)
(DECLARE (GLOBALVARS PRINTERMODE))
(SELECTQ (PRINTERTYPE SERVER)
(PRESS (* Send to a PRESS printer)
(WITH.MONITOR TEDIT.PRESS.MONITORLOCK (TEDIT.PRESS.HARDCOPY STREAM FILE DONTSEND
BREAKPAGETITLE SERVER
#COPIES)))
(INTERPRESS (* Send it to an INTERPRESS printer)
(TEDIT.IP.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER #COPIES))
(ERROR (CONCAT "Can't print TEDIT documents on a " (PRINTERTYPE SERVER)
" printer."])
(TEDIT.HCPYFILE
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE) (* jds "20-Apr-84 16:07")
(* Send this text to a hardcopy file, depending on which
kind is currently selected.)
(SELECTQ (PRINTERTYPE)
(PRESS (* Send to a PRESS printer)
(WITH.MONITOR TEDIT.PRESS.MONITORLOCK (TEDIT.PRESSFILE STREAM FILE DONTSEND
BREAKPAGETITLE)))
((IP INTERPRESS) (* Send to an INTERPRESS printer)
(TEDIT.IPFILE STREAM FILE DONTSEND BREAKPAGETITLE))
(SHOULDNT])
(\TEDIT.HARDCOPY.FORMATLINE
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE DEVICE IMAGESTREAM)
(* jds "22-May-84 14:54")
(* Given a starting place, format the next line of text.
Return the LINEDESCRIPTOR; reusing OLINE if it's given.)
(PROG (TX DX (CH#B CH#1)
TXB CH (FORCEEND NIL)
(GATHERBLANK T)
(T1SPACE NIL)
TXB1 DXB LOOK#B FONT (TLEN 0)
(TEXTLEN (fetch TEXTLEN of TEXTOBJ))
FONTWIDTHS
(CHNO CH#1)
(LOOKNO 0)
(INVISIBLERUNS 0)
(ASCENT 0)
(DESCENT 0)
(PREVSP 0)
(#BLANKS 0)
TERMSA CLOOKS TEXTSTREAM CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING
BOX PC PCNO CTRL\L\SEEN)
%
(* * 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)))
(SETQ WLIST (fetch (ARRAYP BASE) of (fetch WIDTHS of THISLINE)))
(SETQ LOOKS (fetch LOOKS of THISLINE))
(SETQ TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
(SETQ TERMSA (fetch TXTTERMSA of TEXTOBJ))
(replace EXTRASTREAMOP of TEXTSTREAM with (QUOTE \TEDIT.HCPYLOOKS.UPDATE))
(freplace CHARLIM of LINE with TEXTLEN) (* Force each new line to find its true CHARLIM.)
(freplace NEW of LINE with T) (* Mark this line as not yet displayed)
(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 PPARALOOKS of (fetch F5 of TEXTSTREAM))
(fetch FMTSPEC of TEXTOBJ]
(* 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?)
[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
do (* The character loop)
(SETQ CH (\BIN TEXTSTREAM)) (* 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 (APPLY* (IMAGEOBJPROP CH (QUOTE IMAGEBOXFN))
CH IMAGESTREAM TX WIDTH DEVICE))
(* 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))
(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 36 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))
(↑L (* Force a page break after this line)
(SETQ CTRL\L\SEEN T)
(freplace CHARLIM of LINE with CHNO)
(\PUTBASE WLIST 0 (SETQ DX (IMAX DX 6)))
(\RPLPTR CHLIST 0 (CHARCODE CR))
(SETQ DX 6)
(SETQ FORCEEND T)
(SETQ TXB1 TX)
(OR T1SPACE (SETQ T1SPACE TX))
(replace CR\END of LINE with T)
(SETQ TX (IPLUS TX DX))
(RETURN))
(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 (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 36 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]
[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)))
TEDIT.DEFAULT.FONT)
(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 EXTRASTREAMOP of TEXTSTREAM with NIL)
(RETURN CTRL\L\SEEN])
(\TEDIT.HCPYFMTLINE
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE OLINE DEVICE IMAGESTREAM)
(* jds "21-May-84 16:58")
(* Given a starting place, format the next line of text.
Return the LINEDESCRIPTOR; reusing OLINE if it's given.)
(PROG (TX (LINE (OR OLINE (create LINEDESCRIPTOR
RIGHTMARGIN ← WIDTH)))
DX
(CH#B CH#1)
TXB CH (FORCEEND NIL)
(CHLIST (fetch CHARS of THISLINE))
(WLIST (fetch WIDTHS of THISLINE))
(LOOKS (fetch LOOKS of THISLINE))
(GATHERBLANK T)
(T1SPACE NIL)
TXB1 DXB FMTSPEC 1STLN LOOK#B (TLEN 0)
(TEXTLEN (ffetch TEXTLEN of TEXTOBJ))
FONTWIDTHS
(CHNO (ADD1 CH#1))
(LOOKNO 0)
(ASCENT 0)
(DESCENT 0)
(PREVSP 0)
(#BLANKS 0)
(CTRL\L\SEEN NIL)
FONT CLOOKS TEXTSTREAM ASCENTB DESCENTB TABPENDING BOX)
(SETQ TEXTSTREAM (fetch STREAMHINT of TEXTOBJ))
(replace EXTRASTREAMOP of TEXTSTREAM with NIL) (* DON'T use the display formatter's way of tracking
changes in looks.)
(freplace CHARLIM of LINE with TEXTLEN) (* Force each new line to find its true CHARLIM.)
(freplace NEW of LINE with T)
(freplace DIRTY of LINE with NIL)
(freplace CHAR1 of LINE with CH#1)
(freplace CR\END of LINE with NIL)
(COND
[(AND (ILEQ CH#1 TEXTLEN)
(NOT (ZEROP TEXTLEN)))
(\SETUPGETCH CH#1 TEXTOBJ)
(UPDATE/HCPY/LOOKS DEVICE)
(\EDITSETA LOOKS 0 CLOOKS) (* Looks at start of line.)
[SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (OR (fetch PPARALOOKS of (fetch F5 of TEXTSTREAM))
(fetch FMTSPEC of TEXTOBJ]
(* Paragraph formatting info)
[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 FW7 of TEXTSTREAM)
(fetch COFFSET of TEXTSTREAM))
(IEQP (fetch FW6 of TEXTSTREAM)
(fetch CPAGE of TEXTSTREAM]
(* Is this the first line of a paragraph?)
[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)))
(* A ZERO rightmargin floats to whatever the enclosing
box is.)
(fetch RIGHTMAR of FMTSPEC))
(T WIDTH]
(SETQ TXB1 WIDTH)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT)
[for old TLEN from 0 to 254 as old CHNO from CH#1 to TEXTLEN
do (SETQ CH (\BIN TEXTSTREAM)) (* Get the next character for the line.)
(COND
((NOT (EQCLOOKS CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)))
(* The font has changed. Mark it, save the info, and
update ascent &c)
(add LOOKNO 1) (* Fix the counter of charlooks changes)
(UPDATE/HCPY/LOOKS DEVICE) (* Update FONT and CLOOKS, ASCENT &co.)
(\EDITSETA LOOKS LOOKNO CLOOKS) (* Save the new looks for selection/display)
(\EDITSETA CHLIST TLEN 400) (* Put a marker in the character list to denote a looks
change)
(\WORDSETA WLIST TLEN 0) (* Force a font-change to zero width)
(add TLEN 1) (* Account for the dummy marker/looks in TLEN)
))
(COND
(CH [SETQ DX (COND
((SMALLP CH) (* CH is really a character)
(\GETWIDTH FONTWIDTHS CH))
(T (* CH is an object)
(SETQ BOX (APPLY* (IMAGEOBJPROP CH (QUOTE IMAGEBOXFN))
CH IMAGESTREAM TX WIDTH DEVICE))
[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)
(\EDITSETA CHLIST TLEN PREVSP)
(\WORDSETA WLIST TLEN DX)
(SETQ PREVSP (ADD1 TLEN))
(OR T1SPACE (SETQ T1SPACE TX))
(SETQ TX (IPLUS TX DX))
(SETQ TXB TX)
(SETQ DXB DX)
(SETQ LOOK#B LOOKNO)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT)
(add #BLANKS 1))
(CR (* Ch is a <Return>. Force an end to the line.)
(freplace CHARLIM of LINE with CHNO)
(SETQ FORCEEND T)
(\EDITSETA CHLIST TLEN 13)
(\WORDSETA WLIST TLEN (SETQ DX (IMAX DX 6)))
(SETQ TXB1 TX)
(OR T1SPACE (SETQ T1SPACE TX))
(replace CR\END of LINE with T)
(SETQ TX (IPLUS TX DX))
(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
(\ADDBASE (fetch (ARRAYP BASE) of WLIST)
TLEN)
TX 1270 0 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]
(COND
(GATHERBLANK (SETQ TXB1 TX)
(SETQ GATHERBLANK NIL)))
(SETQ CH#B CHNO)
(SETQ DX (\WORDELT WLIST TLEN))
(* For now, make all TABs be 1/2in spaces.)
(\EDITSETA CHLIST TLEN CH)
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
PREVSP)
(SETQ PREVSP 0)
(OR T1SPACE (SETQ T1SPACE TX))
(SETQ TX (IPLUS TX DX))
(SETQ TXB TX)
(SETQ DXB DX)
(SETQ LOOK#B LOOKNO)
(SETQ ASCENTB ASCENT)
(SETQ DESCENTB DESCENT))
(↑L (* Force a page break after this line)
(SETQ CTRL\L\SEEN T)
(freplace CHARLIM of LINE with CHNO)
(\WORDSETA WLIST TLEN 6)
(\EDITSETA CHLIST TLEN (CHARCODE CR))
(SETQ DX 6)
(SETQ FORCEEND T)
(SETQ TXB1 TX)
(OR T1SPACE (SETQ T1SPACE TX))
(replace CR\END of LINE with T)
(SETQ TX (IPLUS TX DX))
(RETURN))
(PROGN (SETQ GATHERBLANK T)
(COND
((AND (IGREATERP (SETQ TX (IPLUS TX DX))
WIDTH)
T1SPACE)
(* We're past the right margin;
stop formatting at the last blank.)
(SETQ FORCEEND T)
(freplace CHARLIM of LINE with CH#B)
(SETQ TX TXB)
(SETQ DX DXB)
(SETQ LOOKNO LOOK#B)
(SETQ ASCENT ASCENTB)
(SETQ DESCENT DESCENTB)
(RETURN))
(T (* We're not past the right margin yet, or we haven't
yet seen a place to do the break.)
(\EDITSETA CHLIST TLEN CH)
(\WORDSETA WLIST TLEN DX]
(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
(\ADDBASE (fetch (ARRAYP BASE)
of WLIST)
TLEN)
TX 1270 0 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]
[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 12))) (* 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 (COND
((IGEQ CHNO TEXTLEN)
\EditEOFChar#)
(T 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)
(fetch CHAR1 of LINE]
(freplace SPACELEFT of LINE with (IDIFFERENCE WIDTH TXB1))
(\DOFORMATTING TEXTOBJ LINE FMTSPEC THISLINE #BLANKS PREVSP 1STLN)
(RETURN CTRL\L\SEEN])
(\TEDIT.HCPYLOOKS.UPDATE
[LAMBDA (STREAM PC NLOOKS) (* jds "22-May-84 14:17")
(* 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 OFFSET)
(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 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
([OR NLOOKS (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM]
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS)
(SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS)
(QUOTE DEVICE)
DEVICE))
(SETQ OFFSET (OR (AND (fetch CLOFFSET of CLOOKS)
(\PTSTOMICAS (fetch CLOFFSET of CLOOKS)))
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))
(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)
(* If this line contains protected text, mark the
linedescriptor accordingly)
(SETQ NEWPC PC)))
(RETURN NEWPC])
(\PTSTOMICAS
[LAMBDA (PtValue) (* jds "19-Jan-84 13:35")
(FIXR (FTIMES PtValue 35.27778])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (SPEC) (* jds " 9-NOV-83 13:51")
(* Given a display-type FMTSPEC, create a hardcopy
equivalent.)
(create FMTSPEC
1STLEFTMAR ←(FIXR (FTIMES (fetch 1STLEFTMAR of SPEC)
35.27778))
LEFTMAR ←(FIXR (FTIMES (fetch LEFTMAR of SPEC)
35.27778))
RIGHTMAR ←(FIXR (FTIMES (fetch RIGHTMAR of SPEC)
35.27778))
LEADBEFORE ←(FIXR (FTIMES (fetch LEADBEFORE of SPEC)
35.27778))
LEADAFTER ←(FIXR (FTIMES (fetch LEADAFTER of SPEC)
35.27778))
LINELEAD ←(FIXR (FTIMES (fetch LINELEAD of SPEC)
35.27778))
QUAD ←(fetch QUAD of SPEC)
TABSPEC ←(CONS (AND (CAR (fetch TABSPEC of SPEC))
(FIXR (FTIMES (CAR (fetch TABSPEC of SPEC))
35.27778)))
(for TAB in (CDR (fetch TABSPEC of SPEC))
collect (CONS (FIXR (FTIMES 35.27778 (CAR TAB)))
(CDR TAB])
)
(* PRESS-specific code)
[DECLARE: EVAL@COMPILE
(RECORD Rectangle (origin . corner)
(RECORD origin (originx . originy)
originx ← 0 originy ← 0)
(RECORD corner (cornerx . cornery)
cornerx ← 0 cornery ← 0))
]
(RPAQ? TEDIT.PRESS.MONITORLOCK (CREATE.MONITORLOCK (QUOTE TEDIT.HARDCOPY)))
(DEFINEQ
(TEDIT.PRESS.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER #COPIES)
(* jds "22-May-84 15:44")
(* Format the document as a PRESS file, and send it to
the specified (or default) printer)
(PROG ((CHNO 1)
(TEXTOBJ (COND
((type? STREAM STREAM) (* If we were given a TEXTOFD, grab the textobj instead)
(fetch F3 of STREAM))
(T STREAM)))
TEXTLEN THISLINE LINE YBOT REGION OCURSOR FORCEPAGE (FORCENEXTPAGE NIL))
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ THISLINE (fetch THISLINE of TEXTOBJ))
(SETQ REGION (PressOutFile (OR FILE (QUOTE {CORE}TEDIT.PRESS))
NIL
(FONTCREATE (QUOTE GACHA)
10)
1 PRESSDEFAULTREGION))
(* Print in the usual region on the page)
(SETQ YBOT (fetch cornery of PRESSBOUNDBOX)) (* Starting line bottom value)
(SETQ LINE (create LINEDESCRIPTOR
LEFTMARGIN ←(fetch originx of PRESSPAGEREGION)))
(* Line descriptor used to print the lines)
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
(while (ILESSP CHNO TEXTLEN)
do (SETQ FORCEPAGE FORCENEXTPAGE)
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (IDIFFERENCE (fetch cornerx
of
PRESSBOUNDBOX)
(fetch originx
of
PRESSPAGEREGION))
CHNO THISLINE LINE (QUOTE PRESS))
(add (fetch LEFTMARGIN of LINE)
(fetch originx of PRESSPAGEREGION)))
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
(COND
((OR FORCEPAGE (ILESSP (SETQ YBOT (IDIFFERENCE YBOT (fetch LHEIGHT of LINE)))
(fetch originy of PRESSBOUNDBOX)))
(* If this line would print off-page, time to start a
new one.)
(PressClosePage)
(PressStartPage)
(PressNewPage REGION)
(SETQ YBOT (IDIFFERENCE (fetch cornery of PRESSBOUNDBOX)
(fetch LHEIGHT of LINE)))
(SETQ FORCEPAGE NIL)))
(replace YBOT of LINE with YBOT)
(replace YBASE of LINE with (IPLUS YBOT (fetch DESCENT of LINE)))
(\TEDIT.PRESS.DISPLAYLINE TEXTOBJ LINE THISLINE))
[PressClose (COND
(BREAKPAGETITLE)
([OR (NOT (fetch TXTFILE of TEXTOBJ))
(type? STREAM (fetch FULLNAME of (fetch TXTFILE of TEXTOBJ)))
(type? STRINGP (fetch TXTFILE of TEXTOBJ))
(type? STRINGP (fetch FULLNAME of (fetch TXTFILE of TEXTOBJ]
"TEdit Hardcopy Output")
(T (fetch FULLNAME of (fetch TXTFILE of TEXTOBJ]
(OR DONTSEND (EMPRESS (OR FILE (QUOTE {CORE}TEDIT.PRESS))
#COPIES SERVER))
(OR FILE (DELFILE (QUOTE {CORE}TEDIT.PRESS)))
(TEDIT.PROMPTPRINT TEXTOBJ "done."])
(TEDIT.PRESSFILE
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE) (* jds "28-Mar-84 19:44")
(* Build a press file, and don't send it to the printer.
User gets to choose a name.)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
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)
(QUOTE PRESS))
(PACKFILENAME FILENM]
[SETQ FILENM (OR FILE (MKATOM (TEDIT.GETINPUT TEXTOBJ "PRESS file name: " FILENM]
(AND FILENM (TEDIT.PRESS.HARDCOPY STREAM FILENM T NIL])
(\TEDIT.PRESS.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE THISLINE REGION) (* jds "22-May-84 15:44")
(* Display LINE on the press 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))
(CHCOUNT 0)
OLOOKS LOOKSTARTX \PCHARSLEFT \PSTRING \PFILE 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 (QUOTE PRESS]
(* Use the characters cached in THISLINE.)
(SETQ OLOOKS (\EDITELT LOOKS 0))
(SETX.PRESS LEFTMARGIN)
[COND
[[AND (fetch CLOFFSET of OLOOKS)
(NOT (ZEROP (fetch CLOFFSET of OLOOKS]
(SETY.PRESS (IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET of OLOOKS]
(T (SETY.PRESS (fetch YBASE of LINE]
[PressFont (SETQ OFONT (FONTCOPY (fetch CLFONT of OLOOKS)
(QUOTE DEVICE)
(QUOTE PRESS]
(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))
[SELECTQ CH
(401 (* An INVISIBLE run -- skip it, and skip over the char
count)
(add LOOKNO 1))
(400 (SHOW.PRESS CHCOUNT)
(SETQ CHCOUNT 0)
(\TEDIT.PRESS.MODIFYLOOKS LINE LOOKSTARTX TX (fetch YBASE
of LINE)
OLOOKS)
(PressFont (FONTCOPY (fetch CLFONT of (SETQ OLOOKS
(\EDITELT LOOKS LOOKNO)))
(QUOTE DEVICE)
(QUOTE PRESS)))
(add LOOKNO 1)
[COND
[[AND (fetch CLOFFSET of OLOOKS)
(NOT (ZEROP (fetch CLOFFSET of OLOOKS]
(SETY.PRESS (IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET of OLOOKS]
(T (SETY.PRESS (fetch YBASE of LINE]
(SETQ LOOKSTARTX TX))
((9 32) (* TAB: use the width from the cache to decide the right
formatting.)
(OR (ZEROP CHCOUNT)
(SHOW.PRESS CHCOUNT))
(SETQ CHCOUNT 0)
(SETX.PRESS (IPLUS TX DX)))
(13 (* It's a CR)
NIL)
(COND
((SMALLP CH)
(\BOUT PRESSOUTSTRM CH)
(add CHCOUNT 1))
(T (* CH is an object.)
(OR (ZEROP CHCOUNT)
(SHOW.PRESS CHCOUNT))
(SETQ CHCOUNT 0)
(APPLY* (IMAGEOBJPROP CH (QUOTE DISPLAYFN))
CH PRESSOUTSTRM (QUOTE PRESS))
(SETX.PRESS (IPLUS TX DX]
(add TX DX)
finally (OR (ZEROP CHCOUNT)
(SHOW.PRESS CHCOUNT))
(\TEDIT.PRESS.MODIFYLOOKS LINE LOOKSTARTX TX (fetch YBASE of LINE)
OLOOKS])
(\TEDIT.PRESS.MODIFYLOOKS
[LAMBDA (LINE STARTX CURX CURY LOOKS) (* jds "24-May-84 15:13")
(* Do underlining, overlining, etc. for PRESS files)
(PROG NIL
(COND
((fetch CLULINE of LOOKS) (* It's underlined.)
(SETXY.PRESS STARTX (IDIFFERENCE (fetch YBOT of LINE)
30))
(SHOWRECTANGLE.PRESS (IDIFFERENCE CURX STARTX)
24) (* A 1/2-pt underline)
))
(COND
((fetch CLOLINE of LOOKS) (* Over-line)
(SETXY.PRESS STARTX (IPLUS (fetch YBASE of LINE)
(fetch LTRUEASCENT of LINE)))
(SHOWRECTANGLE.PRESS (IDIFFERENCE CURX STARTX)
24)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struch-thru)
(SETXY.PRESS STARTX (IPLUS (fetch YBASE of LINE)
(IQUOTIENT (ITIMES 35 (FONTPROP (fetch CLFONT of LOOKS)
(QUOTE ASCENT)))
3)))
(SHOWRECTANGLE.PRESS (IDIFFERENCE CURX STARTX)
24)))
(SETXY.PRESS CURX CURY])
)
(* INTERPRESS-specific code)
(DEFINEQ
(TEDIT.IP.HARDCOPY
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER #COPIES)
(* jds "22-May-84 15:45")
(* Format the document as an INTERPRESS file and send it
to the specified (or default) printer)
(PROG ((CHNO 1)
(TEXTOBJ (TEXTOBJ STREAM))
(FORCENEXTPAGE NIL)
IPSTREAM IPDATA TEXTLEN THISLINE LINE YBOT REGION OCURSOR FORCEPAGE PRINTOPTIONS)
(SETQ TEXTLEN (fetch TEXTLEN of TEXTOBJ))
(SETQ THISLINE (fetch THISLINE of TEXTOBJ))
[SETQ IPSTREAM (OPENIPSTREAM (OR FILE (QUOTE {CORE}TEDIT.IP))
NIL NIL (\TEDIT.IPFONTS (fetch PCTB of TEXTOBJ]
(* Print in the usual region on the page)
(SETQ IPDATA (fetch IPDATA of IPSTREAM))
(SETQ YBOT (fetch IPTOP of IPDATA)) (* Starting line bottom value)
(SETQ LINE (create LINEDESCRIPTOR
LEFTMARGIN ←(fetch IPLEFT of IPDATA)))
(* Line descriptor used to print the lines)
(TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T)
(while (ILESSP CHNO TEXTLEN)
do (* Loop, creating text lines to go to printer)
(SETQ FORCEPAGE FORCENEXTPAGE) (* Remember if we're to start a new page before this
line)
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch IPRIGHT of IPDATA)
CHNO THISLINE LINE (QUOTE INTERPRESS)
IPSTREAM))
(* And before the newly-formatted line)
(SETQ CHNO (ADD1 (fetch CHARLIM of LINE)))
(COND
((OR FORCEPAGE (ILESSP (SETQ YBOT (IDIFFERENCE YBOT (fetch LHEIGHT of LINE)))
(fetch IPBOTTOM of IPDATA)))
(* If this line would print off-page, time to start a
new one.)
(NEWPAGE.IP IPSTREAM)
(SETQ YBOT (IDIFFERENCE (fetch IPTOP of IPDATA)
(fetch LHEIGHT of LINE)))
(SETQ FORCEPAGE NIL)))
(replace YBOT of LINE with YBOT) (* Place the line vertically)
(replace YBASE of LINE with (IPLUS YBOT (fetch DESCENT of LINE)))
(\TEDIT.IP.DISPLAYLINE IPSTREAM TEXTOBJ LINE THISLINE)
(* And push the line into the IP stream))
(CLOSEF IPSTREAM) (* Close out the IP Master cleanly)
[SETQ PRINTOPTIONS (LIST (QUOTE TITLE)
(COND
(BREAKPAGETITLE)
([OR (NOT (fetch TXTFILE of TEXTOBJ))
(type? STREAM (fetch FULLNAME of (fetch TXTFILE
of TEXTOBJ)))
(type? STRINGP (fetch TXTFILE of TEXTOBJ))
(type? STRINGP (fetch FULLNAME
of (fetch TXTFILE of TEXTOBJ]
"TEdit Hardcopy Output")
(T (fetch FULLNAME of (fetch TXTFILE of TEXTOBJ]
[COND
(#COPIES (* He specified a number of copies.)
(push PRINTOPTIONS (LIST (QUOTE #COPIES)
#COPIES]
(OR DONTSEND (SEND.FILE.TO.PRINTER (OR FILE (QUOTE {CORE}TEDIT.IP))
SERVER PRINTOPTIONS))
(* Transmit the file to the printer)
(OR FILE (DELFILE (QUOTE {CORE}TEDIT.IP))) (* And delete the temporary file)
(TEDIT.PROMPTPRINT TEXTOBJ "done."])
(TEDIT.IPFILE
[LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE) (* jds "28-Mar-84 19:44")
(* Send the text to the printer.)
(PROG ((TEXTOBJ (TEXTOBJ STREAM))
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)
(QUOTE IP))
(PACKFILENAME FILENM]
[SETQ FILENM (OR FILE (MKATOM (TEDIT.GETINPUT TEXTOBJ "INTERPRESS file name: " FILENM]
(AND FILENM (TEDIT.IP.HARDCOPY STREAM FILENM T NIL])
(\TEDIT.IP.DISPLAYLINE
[LAMBDA (IPSTREAM TEXTOBJ LINE THISLINE) (* jds "22-May-84 15:45")
(* Display the line of text LINE in the edit window
where it belongs.)
(* 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))
(IPDATA (fetch IPDATA of IPSTREAM))
\PCHARSLEFT \PSTRING \PFILE FONT OFONT OLOOKS LOOKSTARTX CURY)
(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 is guaranteed to have a good cache.
Use it.)
)
((NEQ (fetch DESC of THISLINE)
LINE) (* Format the line to our specs)
(SETQ LINE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ NIL (fetch CHAR1 of LINE)
THISLINE LINE (QUOTE INTERPRESS]
(* Use the characters cached in THISLINE.)
(SHOW.IP IPSTREAM)
(SETQ OLOOKS (\EDITELT LOOKS 0))
(SETQ LOOKSTARTX (fetch LEFTMARGIN of LINE))
[COND
[(fetch CLOFFSET of OLOOKS)
(SETXY.IP IPSTREAM (fetch LEFTMARGIN of LINE)
(SETQ CURY (IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET of OLOOKS]
(T (SETXY.IP IPSTREAM (fetch LEFTMARGIN of LINE)
(SETQ CURY (fetch YBASE of LINE]
(DSPFONT (fetch CLFONT of (\EDITELT LOOKS 0))
IPSTREAM)
(bind ((LOOKNO ← 1)
(TX ←(fetch LEFTMARGIN of LINE))
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
(401 (* An INVISIBLE run -- skip it, and skip over the char
count)
(add LOOKNO 1))
(400 (SHOW.IP IPSTREAM)
(\TEDIT.IP.MODIFYLOOKS LINE LOOKSTARTX IPSTREAM TX CURY OLOOKS)
(DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS LOOKNO)))
IPSTREAM)
(add LOOKNO 1)
[COND
[(fetch CLOFFSET of OLOOKS)
(SETXY.IP IPSTREAM TX (SETQ CURY
(IPLUS (fetch YBASE of LINE)
(\PTSTOMICAS (fetch CLOFFSET of OLOOKS]
(T (SETXY.IP IPSTREAM TX (SETQ CURY (fetch YBASE of LINE]
(SETQ LOOKSTARTX TX))
((CHARCODE (SPACE TAB)) (* TAB: use the width from the cache to decide the right
formatting.)
(SHOW.IP IPSTREAM)
(SETXREL.IP IPSTREAM DX))
((CHARCODE CR) (* It's a CR)
NIL)
(COND
((SMALLP CH)
(INTERPRESS.OUTCHARFN IPSTREAM CH))
(T (* CH is an object.)
(SHOW.IP IPSTREAM)
(APPLY* (IMAGEOBJPROP CH (QUOTE DISPLAYFN))
CH IPSTREAM (QUOTE INTERPRESS))
(SETXREL.IP IPSTREAM DX]
(add TX DX)
finally (SHOW.IP IPSTREAM)
(\TEDIT.IP.MODIFYLOOKS LINE LOOKSTARTX IPSTREAM TX CURY OLOOKS])
(\TEDIT.IP.MODIFYLOOKS
[LAMBDA (LINE STARTX IPSTREAM CURX CURY LOOKS) (* jds "12-Jan-84 11:12")
(* Modify the screen to allow for underlining, etc.
Also, restore the vertical offset to the baseline.)
(PROG (Y)
(COND
((fetch CLULINE of LOOKS) (* It's underlined.)
(STARTTRAJECTORY.IP IPSTREAM STARTX (SETQ Y (IDIFFERENCE (fetch YBOT of LINE)
30))
24 SQUARE)
(TRAJECTORYSEGMENT.IP IPSTREAM CURX Y)
(MASKSTROKE.IP IPSTREAM 24 SQUARE) (* A 1/2-pt underline)
))
(COND
((fetch CLOLINE of LOOKS) (* Over-line)
(STARTTRAJECTORY.IP IPSTREAM STARTX (SETQ Y (IPLUS (fetch YBASE of LINE)
(fetch LTRUEASCENT of LINE)))
24 SQUARE)
(TRAJECTORYSEGMENT.IP IPSTREAM CURX Y)
(MASKSTROKE.IP IPSTREAM 24 SQUARE)))
(COND
((fetch CLSTRIKE of LOOKS) (* Struch-thru)
(STARTTRAJECTORY.IP IPSTREAM STARTX
(SETQ Y (IPLUS (fetch YBASE of LINE)
(IQUOTIENT (ITIMES 35 (FONTPROP (fetch CLFONT
of LOOKS)
(QUOTE ASCENT)))
3)))
24 SQUARE)
(TRAJECTORYSEGMENT.IP IPSTREAM CURX Y)
(MASKSTROKE.IP IPSTREAM 24 SQUARE)))
(SETXY.IP IPSTREAM CURX CURY])
(\TEDIT.IPFONTS
[LAMBDA (PCTB) (* rmk: "22-SEP-83 14:39")
(* Scan a PCTB, and return a map of the fonts it uses.)
(for I FONTS from (ADD1 \FirstPieceOffset) to (SUB1 (ELT PCTB \PCTBLastPieceOffset))
by \EltsPerPiece do (pushnew FONTS (FONTCOPY (fetch CLFONT of (fetch PLOOKS
of (ELT PCTB I)))
(QUOTE DEVICE)
(QUOTE INTERPRESS)))
finally (RETURN FONTS])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS UPDATE/HCPY/LOOKS MACRO [(DEV)
(PROG (OFFSET)
(SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM))
(SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS)
(QUOTE DEVICE)
DEV))
(SETQ OFFSET (OR (AND (fetch CLOFFSET of CLOOKS)
(\PTSTOMICAS (fetch CLOFFSET
of CLOOKS)))
0))
(SETQ ASCENT (IMAX ASCENT (IPLUS (fetch \SFAscent
of FONT)
OFFSET)))
(SETQ DESCENT (IMAX DESCENT (IDIFFERENCE (fetch \SFDescent
of FONT)
OFFSET)))
(SETQ FONTWIDTHS (fetch \SFWidths of FONT])
)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1050 34151 (TEDIT.HARDCOPY 1060 . 1915) (TEDIT.HCPYFILE 1917 . 2598) (
\TEDIT.HARDCOPY.FORMATLINE 2600 . 18094) (\TEDIT.HCPYFMTLINE 18096 . 29831) (\TEDIT.HCPYLOOKS.UPDATE
29833 . 32891) (\PTSTOMICAS 32893 . 33037) (\TEDIT.HCPYFMTSPEC 33039 . 34149)) (34471 43912 (
TEDIT.PRESS.HARDCOPY 34481 . 37739) (TEDIT.PRESSFILE 37741 . 38625) (\TEDIT.PRESS.DISPLAYLINE 38627 .
42696) (\TEDIT.PRESS.MODIFYLOOKS 42698 . 43910)) (43950 54518 (TEDIT.IP.HARDCOPY 43960 . 47844) (
TEDIT.IPFILE 47846 . 48658) (\TEDIT.IP.DISPLAYLINE 48660 . 52456) (\TEDIT.IP.MODIFYLOOKS 52458 . 53952
) (\TEDIT.IPFONTS 53954 . 54516)))))
STOP