(FILECREATED "30-SEP-83 10:20:10" {PHYLUM}<LISPCORE>SOURCES>DSPRINTDEF.;5 29269
changes to: (MACROS XPOSITION YPOSITION)
previous date: "20-SEP-83 13:53:42" {PHYLUM}<LISPCORE>SOURCES>DSPRINTDEF.;3)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT DSPRINTDEFCOMS)
(RPAQQ DSPRINTDEFCOMS ([COMS (* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY (VARS (NEWPRINTDEFDEFS T))
(FILES (LOADCOMP)
NEWPRINTDEF)
(MACROS ADJXPOS BLANKS WIDTH XPOSITION YPOSITION)
(GLOBALVARS PPDSP MAP \DEDITMEHASH)
(CONSTANTS DOTSTRING))
(FNS OPENS SHUTS PRIN1S PRIN2S NEWLINE DOT SETFONT MAKEMAPENTRY)
(FNS RESETDEF TTYOPENS TTYSHUTS TTYPRIN1S TTYPRIN2S TTYNEWLINE)
(INITVARS (\DEDITMEHASH NIL)
(\DEDITDPHASH NIL))
(DECLARE: DONTCOPY (RECORDS DEDITMAP))
(INITRECORDS DEDITMAP)
(FNS SHOWMAPENTRY)
(P (DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWMAPENTRY]
(COMS (* DEDIT entry and incremental reprettyprinting)
(FNS DEPRINTDEF)
(FNS REPP REPPCHANGES REPPUNRAVEL REPPDELETE REPPINSERT REPPTANGLEDP
LEADSPACE SPACINGRULE)
(FNS MOVEDSMAP ADJUSTXTAIL ADJUSTYTAIL ADJDEEXTENT NXTUSEDX REFRESHIF
REFRESHIF1 RESTLINEOK UNPP)
(FNS COMMENTP HIPT LOWPT ONELINEP WIPE)
(FNS RESETCLIP))))
(* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ NEWPRINTDEFDEFS T)
(FILESLOAD (LOADCOMP)
NEWPRINTDEF)
(DECLARE: EVAL@COMPILE
(PUTPROPS ADJXPOS MACRO [(DX)
(XPOSITION (IPLUS DX (XPOSITION])
(PUTPROPS BLANKS MACRO ((N)
(ITIMES N SPACESIZE)))
(PUTPROPS WIDTH MACRO ((STR FNT P2FLG)
(STRINGWIDTH STR (OR FNT PPDSP)
P2FLG)))
(PUTPROPS XPOSITION MACRO [ARGS (COND
[(CAR ARGS)
(BQUOTE (PROG1 (fetch DDXPOSITION of (fetch IMAGEDATA
of PPDSP))
(replace DDXPOSITION of (fetch IMAGEDATA
of PPDSP)
with , (CAR ARGS]
(T (QUOTE (fetch DDXPOSITION of (fetch IMAGEDATA of PPDSP])
(PUTPROPS YPOSITION MACRO [ARGS (COND
[(CAR ARGS)
(BQUOTE (PROG1 (fetch DDYPOSITION of (fetch IMAGEDATA
of PPDSP))
(replace DDYPOSITION of (fetch IMAGEDATA
of PPDSP)
with , (CAR ARGS]
(T (QUOTE (fetch DDYPOSITION of (fetch IMAGEDATA of PPDSP])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS PPDSP MAP \DEDITMEHASH)
)
(DECLARE: EVAL@COMPILE
(RPAQQ DOTSTRING " . ")
(CONSTANTS DOTSTRING)
)
)
(DEFINEQ
(OPENS
[LAMBDA (TAIL PAREN) (* bas: "21-MAR-83 14:05")
(SETQ MAP (MAKEMAPENTRY TAIL (XPOSITION)
(YPOSITION)
0 0))
(PRIN3 PAREN PPDSP])
(SHUTS
[LAMBDA (TAIL PAREN) (* bas: " 4-OCT-82 15:52")
(AND PAREN (PRIN3 PAREN PPDSP))
(replace STOPX of MAP with (XPOSITION))
(replace STOPY of MAP with (YPOSITION))
(SETQ MAP (fetch BP of MAP])
(PRIN1S
[LAMBDA (STR TAIL) (* bas: "15-NOV-82 16:44")
(MAKEMAPENTRY TAIL (XPOSITION)
(YPOSITION)
(PROGN (PRIN3 STR PPDSP)
(XPOSITION))
(YPOSITION))
STR])
(PRIN2S
[LAMBDA (STR TAIL) (* bas: "11-OCT-82 17:24")
(MAKEMAPENTRY TAIL (XPOSITION)
(YPOSITION)
(PROGN (PRIN4 STR PPDSP)
(XPOSITION))
(YPOSITION))
STR])
(NEWLINE
[LAMBDA (L) (* bas: "15-NOV-82 20:38")
(MOVETO L (IPLUS (DSPYPOSITION NIL PPDSP)
(DSPLINEFEED NIL PPDSP))
PPDSP])
(DOT
[LAMBDA (V) (* bas: "21-MAR-83 19:48")
(PRIN3 DOTSTRING PPDSP) (* Prints CDR of a dotted pair.)
(* DPs have map entries keyed off a dummy CONS which is found by a hash link off the parent CONS thru the
\DEDITDPHASH array. Done this way so we have something to push on the selection stack which makes most of the
changing functions transparent which can be found quickly and repeatably. Usually we do not have the DP cons
itself in hand, hence use of the parent CONS.)
(PRIN2S V (OR (GETHASH (fetch TAIL of MAP)
\DEDITDPHASH)
(PUTHASH (fetch TAIL of MAP)
(CONS V V)
\DEDITDPHASH])
(SETFONT
[LAMBDA (FONT) (* rrb "20-SEP-83 13:52")
(* decodes FONT and makes it the font for the pp
displaystream.)
(* allows FONT to be a fontdescriptor, a FONTSET list
and a FONTSET name)
(COND
(FONT (* if FONT is NIL, leave things alone.)
[SETQ FONT (COND
((FONTP FONT))
((LISTP FONT) (* FONTSET list)
(FONTP (CADR FONT)))
[(AND (LITATOM FONT)
(FONTP (CADR (LISTP (GETATOMVAL FONT]
(T (SHOULDNT]
(SETQ SPACESIZE (CHARWIDTH (CHARCODE SPACE)
FONT))
(DSPFONT FONT PPDSP])
(MAKEMAPENTRY
[LAMBDA (TAIL SX SY EX EY) (* bas: "21-MAR-83 19:58")
(* Used to check for existing hashlink and do something
fancy. Now should not happen except from dummy blocks.)
(PUTHASH TAIL
(create DEDITMAP
BP ← MAP
TAIL ← TAIL
STARTX ← SX
STARTY ← SY
STOPX ← EX
STOPY ← EY
PDSP ← PPDSP
FNT ←(DSPFONT NIL PPDSP))
\DEDITMEHASH])
)
(DEFINEQ
(RESETDEF
[LAMBDA (C D) (* bas: "17-NOV-82 11:29")
(if (LISTP C)
then (SETQ D (CADR C))
(SETQ C (CAR C)))
(if (LITATOM D)
then (SETQ D (GETD D)))
(PROG1 (LIST C (GETD C))
(PUTD C D T])
(TTYOPENS
[LAMBDA (TAIL PAREN) (* bas: "15-NOV-82 20:48")
(PRIN3 PAREN PPDSP])
(TTYSHUTS
[LAMBDA (TAIL PAREN) (* bas: "15-NOV-82 20:48")
(AND PAREN (PRIN3 PAREN PPDSP])
(TTYPRIN1S
[LAMBDA (STR TAIL) (* bas: "15-NOV-82 20:49")
(PRIN3 STR PPDSP])
(TTYPRIN2S
[LAMBDA (STR TAIL) (* bas: "15-NOV-82 20:49")
(PRIN4 STR PPDSP])
(TTYNEWLINE
[LAMBDA (L) (* bas: "24-NOV-82 17:34")
(TERPRI PPDSP)
(XPOSITION L])
)
(RPAQ? \DEDITMEHASH NIL)
(RPAQ? \DEDITDPHASH NIL)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE DEDITMAP (TAIL BP (STARTX WORD)
(STOPX WORD)
(STARTY WORD)
(STOPY WORD)
PDSP FNT)
[ACCESSFNS ((SELEXP (CAR (fetch TAIL of DATUM)))
[LPEND (IPLUS (fetch STARTX of DATUM)
(CHARWIDTH (CHARCODE %()
(fetch FNT of DATUM]
[RPSTART (IDIFFERENCE (fetch STOPX of DATUM)
(CHARWIDTH (CHARCODE %))
(fetch FNT of DATUM]
(PURGED (LITATOM (fetch FNT of DATUM))
(replace FNT of DATUM with NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (POINTER POINTER WORD WORD WORD WORD POINTER POINTER)))
)
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (POINTER POINTER WORD WORD WORD WORD POINTER POINTER)))
(DEFINEQ
(SHOWMAPENTRY
[LAMBDA (ME) (* bas: "11-MAR-83 14:51")
(CONS [APPLY (QUOTE CONCAT)
(APPEND (LIST "{")
[bind V TL (Q ←(CAR (fetch TAIL of ME))) while (LISTP Q)
do (push V "(")
(push TL (if (CDR Q)
then (QUOTE " --)")
else ")"))
(SETQ Q (CAR Q))
finally (RETURN (if V
then (APPEND V (CONS Q TL))
else (LIST Q]
(LIST " @ " (CONCAT "<" (fetch STARTX of ME)
","
(fetch STARTY of ME)
" - "
(fetch STOPX of ME)
","
(fetch STOPY of ME)
">"))
(LIST (if (fetch PURGED of ME)
then " PURGED}"
else "}"]
(PACK])
)
(DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWMAPENTRY))
(* DEDIT entry and incremental reprettyprinting)
(DEFINEQ
(DEPRINTDEF
[LAMBDA (TAIL LEFT FONT FILE) (* bas: "21-MAR-83 19:58")
[RESETVARS ((PPDSP FILE)
(MAP NIL)
(PRETTYPRINTMACROS NIL)
(**COMMENT**FLG NIL)
(#RPARS NIL))
(if (type? DEDITMAP TAIL)
then (OR FILE (SETQ PPDSP (fetch PDSP of TAIL)))
(OR FONT (SETQ FONT (fetch FNT of TAIL)))
(OR LEFT (SETQ LEFT (fetch STARTX of TAIL)))
(SETQ MAP (fetch BP of TAIL))
(SETQ TAIL (fetch TAIL of TAIL)))
(PROG ((FIRSTPOS (DSPLEFTMARGIN NIL PPDSP))
[LASTPOS (IPLUS (DSPLEFTMARGIN NIL PPDSP)
(IDIFFERENCE (fetch WIDTH of (WINDOWPROP PPDSP (QUOTE REGION)))
(ITIMES 2 (WINDOWPROP PPDSP (QUOTE BORDER]
COMMENTCOL FNSLST TAILFLG FILEFLG CHANGEFLG (FORMFLG T))
(RESETFORM (SETFONT FONT)
(XPOSITION LEFT)
(SUPERPRINT (CAR TAIL)
TAIL]
(GETME4 TAIL T])
)
(DEFINEQ
(REPP
[LAMBDA (ENT) (* bas: " 5-FEB-83 17:20")
(bind OLDE
do (SETQ OLDE ENT) (* Save current state)
(MOVETO (fetch STARTX of ENT)
(fetch STARTY of ENT)
(fetch PDSP of ENT))
(RESETFORM (RESETCLIP (CONS (fetch PDSP of ENT)
(UNPP ENT)))
(SETQ ENT (DEPRINTDEF ENT)))
repeatwhile (AND (fetch BP of ENT)
(SETQ ENT (MOVEDSMAP ENT (fetch STOPX of OLDE)
(fetch STOPY of OLDE)
(fetch STOPX of ENT)
(fetch STOPY of ENT])
(REPPCHANGES
[LAMBDA (UL) (* bas: "29-JAN-83 20:51")
(for I
in (bind CL TEM for UE in (SETQ UL (REPPUNRAVEL UL))
when [AND (SETQ TEM (GETME4 (CAR UE)))
(PROG (SCR (BK (OR (fetch BP of TEM)
TEM))
(OLDCAR (CADR UE))
(OLDCDR (CDDR UE))
(NEWCAR (CAAR UE))
(NEWCDR (CDAR UE)))
(RETURN (if (NEQ (NLISTP NEWCAR)
(NLISTP OLDCAR))
then (SETQ TEM BK)
elseif (EQ NEWCDR OLDCDR)
then (NEQ OLDCAR NEWCAR)
elseif (if (OR (REPPTANGLEDP UE UL)
(for I in CL thereis (DOMINATE? I TEM)))
then (SETQ TEM BK)
else (OR (SELECTQ (SETQ SCR (REPPINSERT TEM OLDCDR
NEWCDR))
(NIL NIL)
(T (SELECTQ (SETQ SCR
(REPPDELETE TEM
OLDCDR
NEWCDR))
(NIL NIL)
(T (SETQ TEM BK))
(SETQ TEM SCR)))
(SETQ TEM SCR))
(NEQ OLDCAR NEWCAR]
unless (for I in CL thereis (DOMINATE? I TEM)) do (push CL TEM) finally (RETURN CL))
unless (PURGEDP I)
do (* Earlier elements of CL may dominate later ones.
If so, the latter will be purged by the former's REPP.)
(REPP I])
(REPPUNRAVEL
[LAMBDA (UL) (* bas: "25-JUL-82 21:05")
(* Reverses and unpacks LISPXHIST entries)
(PROG (RSLT)
LP (if (NULL UL)
then (RETURN RSLT)
elseif (EQ (QUOTE LISPXHIST)
(CAAR UL))
then [for I in (CDAR UL) do (if (LISTP (CAR I))
then (push RSLT I)
elseif (EQ (CAR I)
(QUOTE /RPLACA))
then (push RSLT (CONS (CADR I)
(CONS (CADDR I)
(CDADR I]
else (push RSLT (CAR UL)))
(SETQ UL (CDR UL))
(GO LP])
(REPPDELETE
[LAMBDA (ENT OCDR NCDR) (* bas: "16-MAR-83 12:27")
(PROG ([EDGE (for I on OCDR thereis (EQ NCDR (CDR I]
NCE OCE SX SY)
(if (SETQ EDGE (GETME4 EDGE))
then (SETQ OCE (GETME4 OCDR T))
[AND NCDR (SETQ NCE (GETME4 NCDR (fetch BP of EDGE)))
(if (COMMENTP (CAR NCDR))
then (SETQ SX (fetch STARTX of NCE]
(bind IM for I on OCDR until (EQ I NCDR) when (SETQ IM (GETME4 I))
do [if (COMMENTP (CAR I))
then (UNPP IM)
else (if (COMMENTP (CAR NCDR))
then (UNPP IM))
(OR SX (SETQ SX (fetch STARTX of IM)))
(OR SY (SETQ SY (fetch STARTY of IM]
(PURGEMAP IM))
[RETURN (if NCDR
then [AND SX (DPCDRSEL NCE)
(add SX (WIDTH DOTSTRING (fetch FNT of NCE]
[MOVEDSMAP ENT (fetch STARTX of NCE)
(fetch STARTY of NCE)
(OR SX (fetch STARTX of NCE))
(OR SY (IDIFFERENCE (fetch STOPY of ENT)
(IDIFFERENCE (fetch STOPY
of EDGE)
(fetch STARTY
of NCE]
else (MOVEDSMAP ENT (fetch STOPX of EDGE)
(fetch STOPY of EDGE)
(fetch STOPX of ENT)
(fetch STOPY of ENT]
else (RETURN T])
(REPPINSERT
[LAMBDA (ENT OCDR NCDR) (* bas: " 7-MAR-83 09:31")
(if (AND (LISTP NCDR)
(OR (NULL OCDR)
(TAILP OCDR NCDR)))
then (PROG ((EDS (fetch PDSP of ENT))
(ALIGN (SPACINGRULE (fetch BP of ENT)))
(DELTAX (CHARWIDTH (CHARCODE SPACE)
(fetch FNT of ENT)))
(SX (fetch STOPX of ENT))
(SY (fetch STOPY of ENT))
NX NY TMP) (* Doesnt enter PROG unless its an insertion)
(SETQ ALIGN (if ALIGN
then (fetch STARTX of ALIGN)
else (IPLUS DELTAX SX)))
(RESETFORM (RESETCLIP (CONS EDS
(create REGION
LEFT ← SX
BOTTOM ← SY
WIDTH ← 0
HEIGHT ← 0)))
(MOVETO SX SY EDS)
(for E on NCDR until (EQ E OCDR) first (SETQ TMP ENT)
do (LEADSPACE E TMP ALIGN DELTAX EDS)
(SETQ TMP (DEPRINTDEF E (DSPXPOSITION NIL EDS)
(fetch FNT of (fetch BP of ENT))
EDS))
(replace BP of TMP with (fetch BP of ENT))
finally (LEADSPACE OCDR TMP ALIGN DELTAX EDS)))
(SETQ NX (DSPXPOSITION NIL EDS))
(SETQ NY (DSPYPOSITION NIL EDS))
[PROG (NSY (QV (GETME4 OCDR)))
(if QV
then (SETQ NSY (fetch STARTY of QV))
(SETQ SX (fetch STARTX of QV))
(if (ILESSP NSY SY)
then (REFRESHIF EDS (HIPT ENT)
(ADD1 (HIPT QV)))
(* Some action at the end of ENT's line?)
(SETQ SY NSY)
elseif (EQ NSY SY)
then (* Dont move if insert did not reach rest of line eg a
comment)
(SETQ NX (IMAX NX SX]
(RETURN (MOVEDSMAP TMP SX SY NX NY)))
else T])
(REPPTANGLEDP
[LAMBDA (E L) (* bas: "29-JAN-83 20:51")
(* Can only handle one CDR change per command lest
different CDR changes share elements)
(for I in L unless (EQ I E) when (NEQ (CDAR I)
(CDDR I))
thereis (GETME4 (CAR I])
(LEADSPACE
[LAMBDA (E PRV ALIGN DELTAX EDS) (* bas: " 3-DEC-82 18:40")
(if (NOT E)
elseif [AND (LISTP (CAR (fetch TAIL of PRV)))
(NOT (COMMENTP (CAR E]
then (MOVETO ALIGN (IPLUS (DSPYPOSITION NIL EDS)
(DSPLINEFEED NIL EDS))
EDS)
else (RELMOVETO DELTAX 0 EDS])
(SPACINGRULE
[LAMBDA (BME) (* bas: "11-MAR-83 16:55")
(bind P Q for E on (fetch SELEXP of BME) do (AND (SETQ Q (GETME4 E))
(NOT (fetch PURGED of Q))
(NOT (COMMENTP (fetch SELEXP of Q)))
(if (NEQ (fetch STARTY of Q)
(fetch STARTY of BME))
then (RETURN Q)
elseif P
else (SETQ P Q)))
finally (RETURN P])
)
(DEFINEQ
(MOVEDSMAP
[LAMBDA (ENT OX OY NX NY) (* bas: " 5-MAR-83 23:05")
(* APOLOGY: This code and any path by which you got here is a frightful kludge. WARNING: It is also very tricky as
there are lots of special cases.)
(PROG (OLOW NLOW NEXT REG BOTTOM LEFT RIGHT WIDTH (DX (IDIFFERENCE NX OX))
(DY (IDIFFERENCE NY OY))
(FONTH (FONTPROP (fetch FNT of ENT)
(QUOTE DESCENT)))
(EPDS (fetch PDSP of ENT)))
(SETQ NLOW (IDIFFERENCE NY FONTH))
(SETQ OLOW (IDIFFERENCE OY FONTH))
(SETQ FONTH (FONTPROP (fetch FNT of ENT)
(QUOTE HEIGHT)))
(SETQ REG (DSPCLIPPINGREGION NIL EPDS))
(SETQ BOTTOM (fetch BOTTOM of REG))
(SETQ LEFT (fetch LEFT of REG))
(SETQ RIGHT (fetch PRIGHT of REG))
(SETQ WIDTH (fetch WIDTH of REG))
(if (ZEROP DX)
else (for (B ← ENT) by (fetch BP of B) while (fetch BP of B)
do (SETQ NEXT (OR (ADJUSTXTAIL (CDR (fetch TAIL of B))
(fetch BP of B)
DX OY RIGHT)
NEXT))) (* Move the rest of the line)
(if (AND (ILESSP DX 0)
(IGEQ DY 0))
then (BITBLT EPDS OX OLOW EPDS NX OLOW (IDIFFERENCE RIGHT OX)
FONTH
(QUOTE INPUT)
(QUOTE REPLACE)) (* Move in then blank out far edge)
(WIPE (IPLUS RIGHT DX)
OLOW
(IMINUS DX)
FONTH EPDS)
else (* Image is filled in at exit)
(WIPE OX OLOW (IDIFFERENCE RIGHT OX)
FONTH EPDS)))
(if (ZEROP DY)
else (BITBLT EPDS LEFT BOTTOM EPDS LEFT (IPLUS BOTTOM DY)
WIDTH
(IDIFFERENCE OLOW BOTTOM)
(QUOTE INPUT)
(QUOTE REPLACE))
(for (B ← ENT) by (fetch BP of B) while (fetch BP of B)
do (* Map over everything to the bottom right moving it
vertically)
(ADJUSTYTAIL (CDR (fetch TAIL of B))
(fetch BP of B)
OY DY))
(ADJDEEXTENT EPDS DY) (* Fix extent and blank inserted space)
(if (IGREATERP DY 0)
then (WIPE LEFT (IMIN BOTTOM OLOW)
WIDTH DY EPDS) (* Repaint into cleared space)
(REFRESHIF EPDS (IPLUS BOTTOM DY)
BOTTOM) (* Clear rest of new line)
(WIPE NX NLOW (IDIFFERENCE RIGHT NX)
FONTH EPDS)
else [SETQ NLOW (IMIN NLOW (IPLUS DY (fetch PTOP of REG]
(WIPE LEFT NLOW WIDTH (IMINUS DY)
EPDS) (* Clear possible trash thru which we extended)
(WIPE LEFT OLOW WIDTH FONTH EPDS)))
(REFRESHIF EPDS (IPLUS FONTH (IMAX NLOW OLOW))
NLOW)
(RETURN NEXT])
(ADJUSTXTAIL
[LAMBDA (TAIL BK DX YLINE RIGHT) (* bas: " 6-MAR-83 00:02")
(PROG (OVER)
[bind IM for I on TAIL eachtime (SETQ IM (GETME4 I BK))
while (EQ YLINE (fetch STARTY of IM))
do (AND (ILEQ RIGHT (add (fetch STARTX of IM)
DX))
(SETQ OVER BK))
(AND (if (LISTP (CAR I))
then (ADJUSTXTAIL (CAR I)
IM DX YLINE RIGHT)
elseif (EQ YLINE (fetch STOPY of IM))
then (ILEQ RIGHT (add (fetch STOPX of IM)
DX)))
(SETQ OVER BK))
finally (if I
then (AND (EQ YLINE (fetch STARTY of IM))
(ILEQ RIGHT (add (fetch STARTX of IM)
DX))
(SETQ OVER BK))
(AND (EQ YLINE (fetch STOPY of IM))
(ILEQ RIGHT (add (fetch STOPX of IM)
DX))
(SETQ OVER BK]
(AND (EQ YLINE (fetch STOPY of BK))
(ILEQ RIGHT (add (fetch STOPX of BK)
DX))
(SETQ OVER (OR (fetch BP of BK)
BK)))
(RETURN OVER])
(ADJUSTYTAIL
[LAMBDA (TAIL BK OY D) (* bas: " 6-MAR-83 16:09")
(bind IM for I on TAIL eachtime (SETQ IM (GETME4 I BK))
do (add (fetch STARTY of IM)
D)
(if (LISTP (CAR I))
then (ADJUSTYTAIL (CAR I)
IM OY D)
else (add (fetch STOPY of IM)
D))
finally (if I
then (add (fetch STARTY of IM)
D)
(add (fetch STOPY of IM)
D)))
(add (fetch STOPY of BK)
D])
(ADJDEEXTENT
[LAMBDA (EX DY) (* bas: "19-JUL-82 17:05")
(OR (SETQ EX (WINDOWPROP EX (QUOTE EXTENT)))
(SHOULDNT))
(add (fetch BOTTOM of EX)
DY)
(add (fetch HEIGHT of EX)
(IMINUS DY])
(NXTUSEDX
[LAMBDA (E) (* bas: "30-MAR-83 14:34")
(* Finds the first used X loc on the same line as the
end of E)
(PROG (V)
(RETURN (OR (if (SETQ V (CDR (fetch TAIL of E)))
then (if (LISTP V)
then (SETQ V (GETME4 V (GETMEBP E)))
(if (EQ (fetch STARTY of V)
(fetch STOPY of E))
then (fetch STARTX of V))
else (* Dotted pair)
(IPLUS (fetch STOPX of E)
SPACESIZE))
elseif (SETQ V (fetch BP of E))
then (if (EQ (fetch STOPY of V)
(fetch STOPY of E))
then (fetch RPSTART of V)))
(fetch RIGHT of (DSPCLIPPINGREGION NIL (fetch PDSP of E])
(REFRESHIF
[LAMBDA (WDS HI LO) (* bas: " 9-MAR-83 16:32")
(* Repaints stuff LOWER than HI and on or above LO)
(DSPRIGHTMARGIN [PROG1 (DSPRIGHTMARGIN 10000 WDS) (* We reset margin b/c REFRESHIF is sometimes called
with things that would overflow)
(PROG ((R (DSPCLIPPINGREGION NIL WDS)))
(REFRESHIF1 (GETMAP? WDS)
WDS
(IMIN HI (fetch PTOP of R))
(IMAX LO (fetch BOTTOM of R]
WDS])
(REFRESHIF1
[LAMBDA (M DS HI LO) (* bas: "30-MAR-83 14:35")
(AND M (ILEQ LO (HIPT M))
(IGREATERP HI (LOWPT M))
(if (LISTP (fetch SELEXP of M))
then (if [IGREATERP HI (IDIFFERENCE (fetch STARTY of M)
(FONTPROP (fetch FNT of M)
(QUOTE DESCENT]
then (MOVETO (fetch STARTX of M)
(fetch STARTY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN3 (QUOTE %()
DS))
(for I on (fetch SELEXP of M) do (REFRESHIF1 (GETME4 I M)
DS HI LO)
finally (if I
then (SETQ I (GETME4 I M))
(MOVETO (IDIFFERENCE (fetch STARTX of I)
(STRINGWIDTH DOTSTRING
(fetch FNT of M)))
(fetch STARTY of I)
DS)
(PRIN3 DOTSTRING DS)
(* Dotted pair)
(REFRESHIF1 I DS HI LO)))
(if [ILEQ LO (IPLUS (fetch STOPY of M)
(FONTPROP (fetch FNT of M)
(QUOTE ASCENT]
then (MOVETO (fetch RPSTART of M)
(fetch STOPY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN3 (QUOTE %))
DS))
else (MOVETO (fetch STARTX of M)
(fetch STARTY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN4 (fetch SELEXP of M)
DS])
(RESTLINEOK
[LAMBDA (ME NUX) (* bas: "29-JAN-83 20:51")
(PROG [(TEM (CDR (fetch TAIL of ME]
(RETURN (AND TEM (SETQ TEM (GETME4 TEM))
(OR (NEQ (fetch STOPY of ME)
(fetch STARTY of TEM))
(AND (EQ COMMENTFLG (CAR (fetch TAIL of TEM)))
(ILESSP NUX (fetch STARTX of TEM])
(UNPP
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:25")
(* Clears region printed by ENT, carefully)
(PROG ((EDS (fetch PDSP of ENT))
(H (FONTPROP (fetch FNT of ENT)
(QUOTE HEIGHT)))
(HI (ADD1 (HIPT ENT)))
(LO (LOWPT ENT))
R)
(SETQ R (DSPCLIPPINGREGION NIL EDS))
(if (NOT (fetch BP of ENT))
then (WIPE (fetch LEFT of R)
(fetch BOTTOM of R)
(fetch WIDTH of R)
(fetch HEIGHT of R)
EDS)
(RETURN R)
elseif (ONELINEP ENT)
then (WIPE (fetch STARTX of ENT)
LO
(IDIFFERENCE (fetch STOPX of ENT)
(fetch STARTX of ENT))
H EDS)
else (WIPE (fetch STARTX of ENT)
(IDIFFERENCE HI H)
(IDIFFERENCE (fetch PRIGHT of R)
(fetch STARTX of ENT))
H EDS) (* Amazingly enough this is as good as one can do)
(WIPE (fetch LEFT of R)
(IPLUS LO H)
(fetch WIDTH of R)
(IDIFFERENCE (IDIFFERENCE HI H)
(IPLUS LO H))
EDS)
(WIPE (fetch LEFT of R)
LO
(ADD1 (IDIFFERENCE (fetch STOPX of ENT)
(fetch LEFT of R)))
H EDS))
(RETURN (create REGION
LEFT ←(fetch LEFT of R)
BOTTOM ←(IMAX LO (fetch BOTTOM of R))
WIDTH ←(if (ONELINEP ENT)
then (IDIFFERENCE (NXTUSEDX ENT)
(fetch LEFT of R))
else (fetch WIDTH of R))
HEIGHT ←(IMAX 0 (IDIFFERENCE (IMIN HI (fetch TOP of R))
(IMAX LO (fetch BOTTOM of R])
)
(DEFINEQ
(COMMENTP
[LAMBDA (E) (* bas: "15-NOV-82 22:01")
(AND COMMENTFLG (EQ COMMENTFLG (CAR (LISTP E])
(HIPT
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:25")
(IPLUS (fetch STARTY of ENT)
(FONTPROP (fetch FNT of ENT)
(QUOTE ASCENT))
-1])
(LOWPT
[LAMBDA (E) (* bas: " 4-OCT-82 15:25")
(IDIFFERENCE (fetch STOPY of E)
(FONTPROP (fetch FNT of E)
(QUOTE DESCENT])
(ONELINEP
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:26")
(EQ (fetch STARTY of ENT)
(fetch STOPY of ENT])
(WIPE
[LAMBDA (X Y W H DS) (* bas: "19-AUG-82 15:18")
(BITBLT NIL NIL NIL DS X Y W H (QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL DS])
)
(DEFINEQ
(RESETCLIP
[LAMBDA (C) (* bas: " 8-NOV-82 15:35")
(* For use in RESETFORM. Takes a CONS of a DSP and its
new region)
(CONS (CAR C)
(DSPCLIPPINGREGION (CDR C)
(CAR C])
)
(PUTPROPS DSPRINTDEF COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2773 6087 (OPENS 2783 . 2991) (SHUTS 2993 . 3284) (PRIN1S 3286 . 3517) (PRIN2S 3519 .
3750) (NEWLINE 3752 . 3947) (DOT 3949 . 4718) (SETFONT 4720 . 5552) (MAKEMAPENTRY 5554 . 6085)) (6088
7063 (RESETDEF 6098 . 6377) (TTYOPENS 6379 . 6509) (TTYSHUTS 6511 . 6652) (TTYPRIN1S 6654 . 6783) (
TTYPRIN2S 6785 . 6914) (TTYNEWLINE 6916 . 7061)) (7932 8776 (SHOWMAPENTRY 7942 . 8774)) (8886 9836 (
DEPRINTDEF 8896 . 9834)) (9837 17519 (REPP 9847 . 10532) (REPPCHANGES 10534 . 12003) (REPPUNRAVEL
12005 . 12716) (REPPDELETE 12718 . 14198) (REPPINSERT 14200 . 16228) (REPPTANGLEDP 16230 . 16630) (
LEADSPACE 16632 . 16989) (SPACINGRULE 16991 . 17517)) (17520 27878 (MOVEDSMAP 17530 . 20493) (
ADJUSTXTAIL 20495 . 21657) (ADJUSTYTAIL 21659 . 22242) (ADJDEEXTENT 22244 . 22519) (NXTUSEDX 22521 .
23454) (REFRESHIF 23456 . 24054) (REFRESHIF1 24056 . 25605) (RESTLINEOK 25607 . 26002) (UNPP 26004 .
27876)) (27879 28850 (COMMENTP 27889 . 28045) (HIPT 28047 . 28262) (LOWPT 28264 . 28471) (ONELINEP
28473 . 28647) (WIPE 28649 . 28848)) (28851 29183 (RESETCLIP 28861 . 29181)))))
STOP