(FILECREATED "30-Jul-85 03:29:28" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;19 33721
changes to: (FNS PRIN2S \DEDITFONT# PRINDOTP SETFONT PRINENDLINE PRINOPEN DEPRINTDEF PRINSHUT
PRIN1S REPP)
(MACROS ADJXPOS XPOSITION)
previous date: "19-Jul-85 11:36:43" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;18)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSPRINTDEFCOMS)
(RPAQQ DSPRINTDEFCOMS ([COMS (* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS ADJXPOS BLANKS WIDTH XPOSITION
YPOSITION OVERLAP)
(GLOBALVARS \DEDITDSPS \DSPRINTBP \DEDITMEHASH \DEDITDPHASH
\DEDITFONT# \DEDITFONTS COMMENTFLG SPACESIZE
**COMMENT**FLG #RPARS)
(CONSTANTS DOTSTRING))
(FNS PRINOPEN PRINSHUT PRIN1S PRIN2S PRINENDLINE PRINDOTP SETFONT
MAKEMAPENTRY \DEDITFONT# DSPDSFOR MAKEDOTPTAIL)
(DECLARE: DONTCOPY (RECORDS DEDITMAP))
(INITRECORDS DEDITMAP)
(FNS SHOWDEDITMAP)
(P (DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWDEDITMAP]
(COMS (* DEDIT entry and incremental reprettyprinting)
(FNS DEPRINTDEF)
(FNS REPP REPPCHANGES REPPUNRAVEL REPPDELETE REPPINSERT REPPTANGLEDP
LEADSPACE SPACINGRULE UNPP NXTUSEDX ONELINEP)
(FNS MOVEDSMAP ADJUSTXTAIL ADJUSTYTAIL ADJDEEXTENT DSLINEFONT
DSLINEFONT1 MAXFONT)
(FNS REFRESHIF REFRESHIF1)
(FNS COMMENTP HIPT LOWPT WIPE)
(FNS RESETCLIP))))
(* NEWPRINTDEF primitives for a display that maintains a map as it PPs)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS ADJXPOS MACRO ((DX FILE)
(DSPXPOSITION (IPLUS DX (DSPXPOSITION NIL FILE))
FILE)))
(PUTPROPS BLANKS MACRO ((N)
(TIMES N SPACESIZE)))
(PUTPROPS WIDTH MACRO ((STR FNT P2FLG)
(STRINGWIDTH STR (OR FNT \PRIMOUT.OFD)
P2FLG)))
(PUTPROPS XPOSITION MACRO ((X)
(DSPXPOSITION X FILE)))
(PUTPROPS YPOSITION MACRO ((Y)
(DSPYPOSITION Y)))
[PUTPROPS OVERLAP MACRO (OPENLAMBDA (H1 L1 H2 L2)
(NOT (OR (ILESSP H1 L2)
(ILESSP H2 L1]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DEDITDSPS \DSPRINTBP \DEDITMEHASH \DEDITDPHASH \DEDITFONT# \DEDITFONTS COMMENTFLG
SPACESIZE **COMMENT**FLG #RPARS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ DOTSTRING " . ")
(CONSTANTS DOTSTRING)
)
)
(DEFINEQ
(PRINOPEN
[LAMBDA (TAIL PAREN FILE) (* lmm "30-Jul-85 03:12")
[COND
(MAKEMAP (SETQ MAKEMAP (MAKEMAPENTRY TAIL (AND (NEQ MAKEMAP T)
MAKEMAP)
(DSPXPOSITION NIL FILE)
(DSPYPOSITION NIL FILE)
0 0 (\DEDITFONT# FILE]
(PRIN3 PAREN FILE])
(PRINSHUT
[LAMBDA (TAIL PAREN FILE) (* lmm "30-Jul-85 03:15")
(AND PAREN (PRIN3 PAREN FILE))
(COND
(MAKEMAP (replace STOPX of MAKEMAP with (DSPXPOSITION NIL FILE))
(replace STOPY of MAKEMAP with (DSPYPOSITION NIL FILE))
(SETQ MAKEMAP (OR (fetch BP of MAKEMAP)
T])
(PRIN1S
[LAMBDA (STR TAIL FILE) (* lmm "30-Jul-85 03:16")
(COND
(MAKEMAP (MAKEMAPENTRY TAIL (AND (NEQ MAKEMAP T)
MAKEMAP)
(DSPXPOSITION NIL FILE)
(DSPYPOSITION NIL FILE)
(PROGN (PRIN3 STR FILE)
(DSPXPOSITION NIL FILE))
(DSPYPOSITION NIL FILE)
(\DEDITFONT# FILE))
STR)
(T (PRIN3 STR FILE])
(PRIN2S
[LAMBDA (STR TAIL FILE) (* lmm "30-Jul-85 03:26")
(COND
(MAKEMAP (MAKEMAPENTRY TAIL (AND (NEQ MAKEMAP T)
MAKEMAP)
(DSPXPOSITION NIL FILE)
(DSPYPOSITION NIL FILE)
(PROGN (PRIN4 STR FILE)
(DSPXPOSITION NIL FILE))
(DSPYPOSITION NIL FILE)
(\DEDITFONT# FILE))
STR)
(T (PRIN4 STR FILE])
(PRINENDLINE
[LAMBDA (L FILE) (* lmm "30-Jul-85 02:58")
(COND
(MAKEMAP (MOVETO L (IPLUS (DSPYPOSITION NIL FILE)
(DSPLINEFEED NIL FILE))
FILE))
(T (PROGN (TERPRI FILE)
(DSPXPOSITION L FILE])
(PRINDOTP
[LAMBDA (V FILE) (* lmm "30-Jul-85 02:55")
(PRIN3 DOTSTRING FILE)
(PRIN2S V (COND
(MAKEMAP (MAKEDOTPTAIL V MAKEMAP))
(T (CONS V V)))
FILE])
(SETFONT
[LAMBDA (FONT FILE) (* lmm "30-Jul-85 02:56")
(* FONT can be a font, a number or a FONTCLASS.
Returns a FONTDESCRIPTOR FOR PPDSP)
(COND
(FONT (* if FONT is NIL, leave things alone.)
(PROG1 (DSPFONT FONT FILE)
(AND MAKEMAP (SETQ \DEDITFONT#))
(SETQ SPACESIZE (STRINGWIDTH " " FILE])
(MAKEMAPENTRY
[LAMBDA (TAIL BACK SX SY EX EY FN) (* hdj "19-Jul-85 11:35")
(* Used to check for existing hashlink and do something
fancy. Now should not happen except from dummy blocks.)
(PUTHASH TAIL
(create DEDITMAP
BP ← BACK
TAIL ← TAIL
STARTX ← SX
STARTY ← SY
STOPX ← EX
STOPY ← EY
D# ←(COND
(BACK (fetch D# of BACK))
(T (DSPDSFOR)))
F# ← FN)
\DEDITMEHASH])
(\DEDITFONT#
[LAMBDA (FILE) (* lmm "30-Jul-85 02:54")
(OR \DEDITFONT# [SETQ \DEDITFONT# (bind (FONT ← (DSPFONT NIL FILE)) for I
to [ARRAYSIZE (OR \DEDITFONTS (SETQ \DEDITFONTS
(FONTMAPARRAY NIL (QUOTE DISPLAY]
thereis (EQ FONT (fetch (FONTCLASS DISPLAYFD)
of (ELT \DEDITFONTS I]
(SHOULDNT])
(DSPDSFOR
[LAMBDA (DS) (* hdj "19-Jul-85 11:35")
[OR DS (SETQ DS (GETSTREAM NIL (QUOTE OUTPUT]
(PROG [(V (OR [for I to (ARRAYSIZE \DEDITDSPS) thereis (OR (NOT (STREAMP (ELT \DEDITDSPS I)))
(EQ DS (ELT \DEDITDSPS I]
(bind [NU ←(ARRAY (ITIMES 2 (ARRAYSIZE \DEDITDSPS] for J to (ARRAYSIZE \DEDITDSPS)
do (SETA NU J (ELT \DEDITDSPS J))
finally (SETQ \DEDITDSPS NU)
(RETURN J]
(SETA \DEDITDSPS V DS)
(RETURN V])
(MAKEDOTPTAIL
[LAMBDA (V B) (* bas: "18-Mar-84 21:10")
(* 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 a CONS to push on the selection stack which makes most of the changing
functions transparent and which can be found quickly and repeatably. Usually we do not have the DP cons itself in
hand, hence use of the parent CONS.)
(* If there is a dummy CONS for the DP, we must preserve it because it may be being used as a key e.g. from the
selection stack. But we must also ensure that it has the right contents, namely V)
(PUTHASH (fetch TAIL of B)
(RPLNODE (OR (GETHASH (fetch TAIL of B)
\DEDITDPHASH)
(CONS))
V V)
\DEDITDPHASH])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE DEDITMAP ((D# BYTE)
TAIL
(F# BYTE)
BP
(STARTX WORD)
(STOPX WORD)
(STARTY WORD)
(STOPY WORD))
[ACCESSFNS ((FNT (ELT \DEDITFONTS (fetch F# of DATUM)))
(PDSP (ELT \DEDITDSPS (fetch D# of DATUM)))
(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])
]
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD))
[QUOTE ((DEDITMAP 0 (BITS . 7))
(DEDITMAP 0 POINTER)
(DEDITMAP 2 (BITS . 7))
(DEDITMAP 2 POINTER)
(DEDITMAP 4 (BITS . 15))
(DEDITMAP 5 (BITS . 15))
(DEDITMAP 6 (BITS . 15))
(DEDITMAP 7 (BITS . 15]
(QUOTE 8))
)
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD))
[QUOTE ((DEDITMAP 0 (BITS . 7))
(DEDITMAP 0 POINTER)
(DEDITMAP 2 (BITS . 7))
(DEDITMAP 2 POINTER)
(DEDITMAP 4 (BITS . 15))
(DEDITMAP 5 (BITS . 15))
(DEDITMAP 6 (BITS . 15))
(DEDITMAP 7 (BITS . 15]
(QUOTE 8))
(DEFINEQ
(SHOWDEDITMAP
[LAMBDA (ME) (* bas: " 8-Mar-84 13:11")
(CONS [APPLY (QUOTE CONCAT)
(APPEND (LIST "{")
[bind V TL (Q ←(CAR (fetch TAIL of ME))) while (LISTP Q)
do (push V "(")
(push TL (COND
((CDR Q)
(QUOTE " --)"))
(T ")")))
(SETQ Q (CAR Q))
finally (RETURN (COND
(V (APPEND V (CONS Q TL)))
(T (LIST Q]
(LIST " @ " (CONCAT "<" (fetch STARTX of ME)
","
(fetch STARTY of ME)
" - "
(fetch STOPX of ME)
","
(fetch STOPY of ME)
">"))
(LIST (COND
((UNPURGEDP ME)
"}")
(T " PURGED}"]
(PACK])
)
(DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWDEDITMAP))
(* DEDIT entry and incremental reprettyprinting)
(DEFINEQ
(DEPRINTDEF
[LAMBDA (TAIL LEFT FONT FILE) (* lmm "30-Jul-85 03:20")
[LET ((MAKEMAP T))
(DECLARE (SPECVARS MAKEMAP))
(RESETLST (RESETVARS ((**COMMENT**FLG NIL)
(#RPARS NIL))
(RESETSAVE (OUTPUT FILE))
(SETQ \DEDITFONTS (FONTMAPARRAY NIL (QUOTE DISPLAY)))
[COND
((type? DEDITMAP TAIL)
(SETQ MAKEMAP (OR (fetch BP of TAIL)
T))
(OR FILE (OUTPUT (fetch PDSP of TAIL)))
[OR FONT (SETQ FONT (fetch FNT of (COND
((NEQ MAKEMAP T)
MAKEMAP)
(T TAIL]
(OR LEFT (SETQ LEFT (fetch STARTX of TAIL)))
(SETQ TAIL (fetch TAIL of TAIL]
(PROG ((FIRSTPOS (DSPLEFTMARGIN))
[RMARGIN (IPLUS (DSPLEFTMARGIN)
(IDIFFERENCE (fetch WIDTH
of (WINDOWPROP
(GETSTREAM NIL
(QUOTE OUTPUT))
(QUOTE REGION)))
(ITIMES 2
(WINDOWPROP
(GETSTREAM NIL
(QUOTE OUTPUT))
(QUOTE BORDER]
COMMENTCOL FNSLST TAILFLG FILEFLG CHANGEFLG (FORMFLG T))
(SETFONT FONT FILE)
(DSPXPOSITION LEFT FILE)
(SUPERPRINT (CAR TAIL)
TAIL NIL FILE]
(GETME4 TAIL T])
)
(DEFINEQ
(REPP
[LAMBDA (ENT) (* lmm "30-Jul-85 03:21")
(bind OLDE
do (SETQ OLDE ENT) (* Save current value)
[COND
[(fetch BP of ENT)
(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]
(T (RETURN (SETDEDITMAP (fetch PDSP of ENT)
(fetch TAIL of ENT]
repeatwhile (SETQ ENT (MOVEDSMAP ENT (fetch STOPX of OLDE)
(fetch STOPY of OLDE)
(fetch STOPX of ENT)
(fetch STOPY of ENT])
(REPPCHANGES
[LAMBDA (UL) (* bas: "12-Sep-84 13:57")
(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 (COND
((NEQ (NLISTP NEWCAR)
(NLISTP OLDCAR))
(SETQ TEM BK))
((EQ NEWCDR OLDCDR)
(NEQ OLDCAR NEWCAR))
((REPPTANGLEDP (CAR UE)
UL)
(SETQ TEM BK))
((for I in CL thereis (DOMINATE? I TEM))
(SETQ TEM BK))
(T (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))
when (UNPURGEDP 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 [COND
((NULL UL)
(RETURN RSLT))
[(EQ (QUOTE LISPXHIST)
(CAAR UL))
(for I in (CDAR UL) do (COND
((LISTP (CAR I))
(push RSLT I))
((EQ (CAR I)
(QUOTE /RPLACA))
(push RSLT (CONS (CADR I)
(CONS (CADDR I)
(CDADR I]
(T (push RSLT (CAR UL]
(SETQ UL (CDR UL))
(GO LP])
(REPPDELETE
[LAMBDA (ENT OCDR NCDR) (* bas: " 7-Mar-84 18:09")
(PROG ([EDGE (for I on OCDR thereis (EQ NCDR (CDR I]
NCE OCE SX SY)
(COND
[(SETQ EDGE (GETME4 EDGE))
(SETQ OCE (GETME4 OCDR T))
[AND NCDR (SETQ NCE (GETME4 NCDR (fetch BP of EDGE)))
(COND
((COMMENTP (CAR NCDR))
(SETQ SX (fetch STARTX of NCE]
[bind IM for I on OCDR until (EQ I NCDR) when (SETQ IM (GETME4 I))
do (COND
((COMMENTP (CAR I))
(UNPP IM))
(T (COND
((COMMENTP (CAR NCDR))
(UNPP IM)))
(OR SX (SETQ SX (fetch STARTX of IM)))
(OR SY (SETQ SY (fetch STARTY of IM]
(RETURN (COND
[NCDR [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]
(T (MOVEDSMAP ENT (fetch STOPX of EDGE)
(fetch STOPY of EDGE)
(fetch STOPX of ENT)
(fetch STOPY of ENT]
(T (RETURN T])
(REPPINSERT
[LAMBDA (ENT OCDR NCDR) (* bas: " 7-MAR-83 09:31")
(COND
[(AND (LISTP NCDR)
(OR (NULL OCDR)
(TAILP OCDR NCDR)))
(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 (COND
(ALIGN (fetch STARTX of ALIGN))
(T (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)))
(COND
(QV (SETQ NSY (fetch STARTY of QV))
(SETQ SX (fetch STARTX of QV))
(COND
((ILESSP NSY SY)
(REFRESHIF EDS (HIPT ENT)
(ADD1 (HIPT QV))) (* Some action at the end of ENT's line?)
(SETQ SY NSY))
((EQ NSY SY) (* 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]
(T T])
(REPPTANGLEDP
[LAMBDA (E L) (* bas: " 3-Dec-84 21:45")
(* Can only handle one change per cell because of
cancelling changes or one CDR change per command lest
different CDR changes share elements)
(bind EC CCC for I in L when (GETME4 (CAR I))
do (COND
((NEQ E (CAR I)))
(EC (RETURN T))
(T (SETQ EC T)))
(COND
((EQ (CDAR I)
(CDDR I)))
(CCC (RETURN T))
(T (SETQ CCC T])
(LEADSPACE
[LAMBDA (E PRV ALIGN DELTAX EDS) (* bas: " 3-DEC-82 18:40")
(COND
((NOT E))
([AND (LISTP (CAR (fetch TAIL of PRV)))
(NOT (COMMENTP (CAR E]
(MOVETO ALIGN (IPLUS (DSPYPOSITION NIL EDS)
(DSPLINEFEED NIL EDS))
EDS))
(T (RELMOVETO DELTAX 0 EDS])
(SPACINGRULE
[LAMBDA (BME) (* bas: "12-Sep-84 10:46")
(* Looks for someone who might know what the current
left margin is and returns that someone.)
(bind P Q for E on (fetch SELEXP of BME) unless (COMMENTP (CAR E)) when (SETQ Q (GETSELMAP E))
do (COND
((NEQ (fetch STARTY of Q)
(fetch STARTY of BME))
(RETURN Q))
(P)
(T (SETQ P Q)))
finally (RETURN P])
(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))
(COND
((NOT (fetch BP of ENT))
(WIPE (fetch LEFT of R)
(fetch BOTTOM of R)
(fetch WIDTH of R)
(fetch HEIGHT of R)
EDS)
(RETURN R))
((ONELINEP ENT)
(WIPE (fetch STARTX of ENT)
LO
(IDIFFERENCE (fetch STOPX of ENT)
(fetch STARTX of ENT))
H EDS))
(T (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 ←(COND
((ONELINEP ENT)
(IDIFFERENCE (NXTUSEDX ENT)
(fetch LEFT of R)))
(T (fetch WIDTH of R)))
HEIGHT ←(IMAX 0 (IDIFFERENCE (IMIN HI (fetch TOP of R))
(IMAX LO (fetch BOTTOM of R])
(NXTUSEDX
[LAMBDA (E) (* bas: " 5-Feb-84 21:06")
(* Finds the first used X loc on the same line as the
end of E)
(PROG (V)
(RETURN (OR [COND
[(SETQ V (CDR (fetch TAIL of E)))
(COND
[(LISTP V)
(SETQ V (GETME4 V (GETMEBP E)))
(COND
((EQ (fetch STARTY of V)
(fetch STOPY of E))
(fetch STARTX of V]
(T (* Dotted pair)
(IPLUS (fetch STOPX of E)
(CHARWIDTH (CHARCODE SPACE)
(fetch FNT of E]
((SETQ V (fetch BP of E))
(COND
((EQ (fetch STOPY of V)
(fetch STOPY of E))
(fetch RPSTART of V]
(fetch RIGHT of (DSPCLIPPINGREGION NIL (fetch PDSP of E])
(ONELINEP
[LAMBDA (ENT) (* bas: " 4-OCT-82 15:26")
(EQ (fetch STARTY of ENT)
(fetch STOPY of ENT])
)
(DEFINEQ
(MOVEDSMAP
[LAMBDA (ENT OX OY NX NY) (* bas: "30-Sep-84 14:02")
(* 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 FONTH NEXT REG BOTTOM LEFT RIGHT WIDTH (DX (IDIFFERENCE NX OX))
(DY (IDIFFERENCE NY OY))
(LINEFONT (DSLINEFONT ENT OY))
(EPDS (fetch PDSP of ENT)))
(SETQ FONTH (FONTPROP LINEFONT (QUOTE DESCENT)))
(SETQ NLOW (IDIFFERENCE NY FONTH))
(SETQ OLOW (IDIFFERENCE OY FONTH))
(SETQ FONTH (FONTPROP LINEFONT (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))
[COND
((ZEROP DX))
(T (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)
(COND
((AND (ILESSP DX 0)
(IGEQ DY 0))
(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))
(T (* Image is filled in at exit)
(WIPE OX OLOW (IDIFFERENCE RIGHT OX)
FONTH EPDS]
[COND
((ZEROP DY))
(T (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)
(COND
((IGREATERP DY 0)
(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))
(T [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 -1 (IMAX NLOW OLOW))
(ADD1 NLOW))
(* Another small kludge. A slightly bigger font like CLISPFONT on the next line might stick up into NLOW and thus
get refreshed. Unfortunately, there is no guarrantee that that line will be valid to refresh.
Correct solution is to make line spacing on printing such that no two lines touch. For now, we diddle the NLOW value
to avoid touching the next line down.)
(RETURN NEXT])
(ADJUSTXTAIL
[LAMBDA (TAIL BK DX YLINE RIGHT) (* bas: " 3-Dec-84 22:07")
(PROG (OVER)
[bind IM for I on TAIL when (SETQ IM (GETME4 I))
do (COND
((NEQ YLINE (fetch STARTY of IM))
(RETURN))
((IGREATERP RIGHT (add (fetch STARTX of IM)
DX)))
(T (SETQ OVER BK)))
(AND [COND
((LISTP (CAR I))
(ADJUSTXTAIL (CAR I)
IM DX YLINE RIGHT))
((EQ YLINE (fetch STOPY of IM))
(ILEQ RIGHT (add (fetch STOPX of IM)
DX]
(SETQ OVER BK))
finally (COND
((SETQ IM (GETME4 I BK))
(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: " 3-Dec-84 22:07")
[bind IM for I on TAIL when (SETQ IM (GETME4 I))
do (add (fetch STARTY of IM)
D)
(COND
((LISTP (CAR I))
(ADJUSTYTAIL (CAR I)
IM OY D))
(T (add (fetch STOPY of IM)
D)))
finally (COND
((SETQ IM (GETME4 I BK))
(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])
(DSLINEFONT
[LAMBDA (E Y) (* bas: "30-Mar-84 11:22")
(DSLINEFONT1 [for old E by (fetch BP of E) thereis (OR (NOT (fetch BP of E))
(AND (ILESSP Y (fetch STARTY of E))
(IGREATERP Y (fetch STOPY
of E]
Y])
(DSLINEFONT1
[LAMBDA (ENT YLINE) (* bas: "30-Mar-84 10:52")
(AND ENT (bind IM (MFONT ←(AND (OR (EQ YLINE (fetch STARTY of ENT))
(EQ YLINE (fetch STOPY of ENT)))
(fetch FNT of ENT)))
for I on (LISTP (fetch SELEXP of ENT)) do (SETQ MFONT (MAXFONT MFONT
(DSLINEFONT1
(GETME4 I)
YLINE)))
finally (RETURN MFONT])
(MAXFONT
[LAMBDA (F1 F2) (* bas: "30-Mar-84 10:17")
(COND
((IGREATERP (COND
((FONTP F1)
(FONTPROP F1 (QUOTE HEIGHT)))
(T 0))
(COND
((FONTP F2)
(FONTPROP F2 (QUOTE HEIGHT)))
(T 0)))
F1)
(T F2])
)
(DEFINEQ
(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-84 12:01")
(AND M (OVERLAP HI LO (HIPT M)
(LOWPT M))
(COND
[(LISTP (fetch SELEXP of M))
(COND
([IGREATERP HI (IDIFFERENCE (fetch STARTY of M)
(FONTPROP (fetch FNT of M)
(QUOTE DESCENT]
(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 (COND
(I (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]
(COND
([ILEQ LO (IPLUS (fetch STOPY of M)
(FONTPROP (fetch FNT of M)
(QUOTE ASCENT]
(MOVETO (fetch RPSTART of M)
(fetch STOPY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN3 (QUOTE %))
DS]
(T (MOVETO (fetch STARTX of M)
(fetch STARTY of M)
DS)
(DSPFONT (fetch FNT of M)
DS)
(PRIN4 (fetch SELEXP of M)
DS])
)
(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])
(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 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2429 7851 (PRINOPEN 2439 . 2797) (PRINSHUT 2799 . 3200) (PRIN1S 3202 . 3666) (PRIN2S
3668 . 4132) (PRINENDLINE 4134 . 4438) (PRINDOTP 4440 . 4688) (SETFONT 4690 . 5216) (MAKEMAPENTRY 5218
. 5808) (\DEDITFONT# 5810 . 6267) (DSPDSFOR 6269 . 6923) (MAKEDOTPTAIL 6925 . 7849)) (9232 10132 (
SHOWDEDITMAP 9242 . 10130)) (10242 11725 (DEPRINTDEF 10252 . 11723)) (11726 23134 (REPP 11736 . 12549)
(REPPCHANGES 12551 . 14109) (REPPUNRAVEL 14111 . 14842) (REPPDELETE 14844 . 16351) (REPPINSERT 16353
. 18336) (REPPTANGLEDP 18338 . 18978) (LEADSPACE 18980 . 19365) (SPACINGRULE 19367 . 19989) (UNPP
19991 . 21925) (NXTUSEDX 21927 . 22952) (ONELINEP 22954 . 23132)) (23135 30235 (MOVEDSMAP 23145 .
26783) (ADJUSTXTAIL 26785 . 28091) (ADJUSTYTAIL 28093 . 28701) (ADJDEEXTENT 28703 . 29002) (DSLINEFONT
29004 . 29367) (DSLINEFONT1 29369 . 29885) (MAXFONT 29887 . 30233)) (30236 32420 (REFRESHIF 30246 .
30876) (REFRESHIF1 30878 . 32418)) (32421 33272 (COMMENTP 32431 . 32603) (HIPT 32605 . 32832) (LOWPT
32834 . 33053) (WIPE 33055 . 33270)) (33273 33625 (RESETCLIP 33283 . 33623)))))
STOP