(FILECREATED " 9-Jun-86 17:15:01" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;37 64809
changes to: (FNS DEPRINTDEF REPP)
previous date: " 4-Jun-86 18:41:59" {ERIS}<LISPCORE>SOURCES>DSPRINTDEF.;36)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 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 BLANKS WIDTH XPOSITION YPOSITION
OVERLAP)
(GLOBALVARS \DEDITDSPS \DSPRINTBP \DEDITMEHASH \DEDITDPHASH
\DEDITFONT# \DEDITFONTS COMMENTFLG **COMMENT**FLG)
(CONSTANTS DOTSTRING))
(FNS PRINOPEN PRINSHUT PRIN1S PRIN2S PRINENDLINE PRINDOTP SETFONT
MAKEDOTPTAIL))
[COMS (* "String printer")
(FNS PRIN2STRING PRIN2-LONG-STRING)
(INITVARS (*DIVIDE-LONG-STRINGS* (QUOTE DISPLAY]
(COMS (* Wrappers)
(FNS SUPERPRINT/WRAPPER))
[COMS (* "DEDITMAP record and accessors")
(DECLARE: DONTCOPY (RECORDS DEDITMAP))
(INITRECORDS DEDITMAP)
(FNS DEDIT.LPEND DEDIT.RPSTART MAKEMAPENTRY \DEDITFONT# DSPDSFOR
SHOWDEDITMAP)
(P (DEFPRINT (QUOTE DEDITMAP)
(QUOTE SHOWDEDITMAP]
(COMS (* "DEDIT entry and incremental reprettyprinting")
(FNS DEPRINTDEF DEDIT-MAKE-READER-ENV)
(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 BLANKS MACRO ((N)
(TIMES N SPACEWIDTH)))
(PUTPROPS WIDTH MACRO ((STR STREAM P2FLG)
(STRINGWIDTH STR (OR STREAM \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
**COMMENT**FLG)
)
(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) (* AJB "22-Jan-86 16:30")
(AND PAREN (PRIN3 PAREN FILE))
(COND
(MAKEMAP (COND
((EQ MAKEMAP T)
(SHOULDNT)))
(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 "18-Jan-86 01:09")
(COND
(MAKEMAP (* if remembering where things went)
(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 (NEWXPOSITION FILE) (* bvm: "26-Mar-86 14:08")
(COND
(MAKEMAP (MOVETO NEWXPOSITION (IPLUS (DSPYPOSITION NIL FILE)
(DSPLINEFEED NIL FILE))
FILE))
(T (TERPRI FILE)
(COND
((NOT (DISPLAYSTREAMP FILE))
(SETFONT [PROG1 (SETFONT DEFAULTFONT FILE) (* Print introductory spaces in the
default font because we don't quite
have this right yet for pspool files)
(LET ((NS (QUOTIENT (DIFFERENCE NEWXPOSITION (DSPXPOSITION NIL FILE))
SPACEWIDTH)))
(RPTQ (QUOTIENT NS 8)
(PRIN3 " " FILE))
(RPTQ (REMAINDER NS 8)
(PRIN3 " " FILE]
FILE)))
(DSPXPOSITION NEWXPOSITION 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.)
(LET ((OLDFONT (DSPFONT FONT FILE)))
[COND
((NEQ OLDFONT FONT)
(AND MAKEMAP (SETQ \DEDITFONT#))
(SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
FILE]
OLDFONT])
(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])
)
(* "String printer")
(DEFINEQ
(PRIN2STRING
[LAMBDA (STR TAIL FILE LMARG RMARG COMMENTP) (* bvm: "27-May-86 15:36")
(COND
((SELECTQ *DIVIDE-LONG-STRINGS*
(NIL NIL)
(DISPLAY (IMAGESTREAMP FILE))
T)
(PRIN2-LONG-STRING STR FILE T TAIL LMARG RMARG COMMENTP))
(T [LET [(TEM (IDIFFERENCE RMARGIN (WIDTH STR FILE T] (*
"TEM is the last position at which E will fit")
(COND
((AND (ILESSP TEM (DSPXPOSITION NIL FILE))
(IGREATERP TEM FIRSTPOS))
(PRINENDLINE (IMIN LMARG TEM)
FILE]
(PRIN2S STR TAIL FILE])
(PRIN2-LONG-STRING
[LAMBDA (STRING STREAM P2FLG TAIL LMARG RMARG COMMENTP) (* bvm: " 2-Jun-86 14:37")
(PROG ((ESC (fetch (READTABLEP ESCAPECHAR) of *READTABLE*))
(SA (fetch (READTABLEP READSA) of *READTABLE*))
(HERE (DSPXPOSITION NIL STREAM))
(FONT (DSPFONT NIL STREAM))
ESCWIDTH SPACEWIDTH CLOSEWIDTH LASTSPACE I C NEXTC POS J MAPX1 MAPY1 SINGLELEFT)
(COND
((NOT (type? FONTDESCRIPTOR FONT)) (* "Ugh, happens for files")
(SETQ FONT STREAM)))
(SETQ ESCWIDTH (CHARWIDTH ESC FONT))
(SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
FONT))
(SETQ CLOSEWIDTH (COND
(P2FLG (STRINGWIDTH "%")" FONT))
(T 0)))
[COND
((for C instring STRING as I from 1
bind (POS ← (IPLUS HERE (COND
(P2FLG (CHARWIDTH (CHARCODE %")
FONT))
(T 0))
CLOSEWIDTH)) do (COND
((EQ C (CHARCODE CR))
(*
"Always want to print these strings specially")
(SETQ LASTSPACE I)
(RETURN NIL))
((AND P2FLG (OR (EQ C (CHARCODE %"))
(EQ C ESC)))
(* "Need escape")
(add POS ESCWIDTH)))
(COND
((GREATERP (add POS (CHARWIDTH C FONT))
RMARG)
(RETURN NIL)))
(COND
((EQ C (CHARCODE SPACE))
(SETQ LASTSPACE I)))
finally (RETURN T)) (* "It all fits on this line")
(RETURN (COND
(P2FLG (PRIN2S STRING TAIL STREAM))
(T (PRIN1S STRING TAIL STREAM]
(COND
((OR (NULL LASTSPACE)
(AND (NULL COMMENTP)
(NEQ HERE LMARG))) (* "Can't print anything on this line before the end. Comments are allowed to have different first and subsequent margin.")
(PRINENDLINE LMARG STREAM)
(SETQ HERE LMARG)
(SETQ LASTSPACE 0)))
[COND
(MAKEMAP (* "Note start")
(SETQ MAPX1 HERE)
(SETQ MAPY1 (DSPYPOSITION NIL STREAM))
(SETQ SINGLELEFT (EQ HERE LMARG]
[COND
(P2FLG [COND
((NOT (IMAGESTREAMP STREAM)) (* "Need to be able to read it back")
(LET ((HASH (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*)))
(\OUTCHAR STREAM HASH)
(add HERE (CHARWIDTH HASH FONT]
(\OUTCHAR STREAM (CHARCODE %"))
(add HERE (CHARWIDTH (CHARCODE %")
FONT]
(* * "Now loop, printing as much as we can while there's room")
(SETQ I 0)
LP [COND
([NULL (SETQ C (NTHCHARCODE STRING (add I 1] (* Done)
(GO DONE))
((NOT (LESSP I LASTSPACE)) (* "Must find the next safe place to print up to. LASTSPACE is either a space or CR position, or is 0, which is our state when printing from the left margin until we encounter a space.")
(SETQ POS HERE)
(SETQ J I) (*
"Ordinarily, J is pointing at a space or CR except when we have just printed an endline")
(SELCHARQ C
(SPACE (*
"Would like all spaces before the eol, where they're invisible, not after")
(SELCHARQ (NTHCHARCODE STRING (ADD1 J))
((SPACE CR NIL)
(SETQ LASTSPACE (ADD1 J))(*
"Go ahead and print this space, and note that it is now okay to break the line")
(COND
((AND (IGEQ (IPLUS HERE SPACEWIDTH)
RMARG)
(IMAGESTREAMP STREAM))
(*
"Extra spaces have no effect, so don't print them at all, lest the dsprightmargin bite")
(GO LP))
(T (GO PRINTIT))))
NIL)
(add POS SPACEWIDTH))
(CR (*
"If two cr's in a row, print them all; if only one, must escape it")
(COND
((EQ (SETQ C (NTHCHARCODE STRING (add I 1)))
(CHARCODE CR))
(PRINENDLINE LMARG STREAM)
(while (EQ (SETQ C (NTHCHARCODE STRING (add I 1)))
(CHARCODE CR)) do (PRINENDLINE LMARG STREAM)))
(T (\OUTCHAR STREAM ESC)))
(SETQ LASTSPACE 0)
(GO ENDLINE))
(PROGN (* "Gets set this way at left edge. Must print something on this line, even if there are no spaces before the right edge")
(GO CHECKESCAPE)))
(SETQ LASTSPACE 0)
(while (LESSP POS RMARG) do (SELCHARQ (SETQ NEXTC (NTHCHARCODE STRING (add J 1)))
((CR SPACE) (* "Can safely go this far")
(SETQ LASTSPACE J)
(RETURN))
(NIL (*
"End of string -- ok if there is space for closing quote and paren as well")
(COND
((LESSP (PLUS POS CLOSEWIDTH)
RMARG)
(SETQ LASTSPACE J)
(RETURN))
(T (GO $$OUT))))
NIL)
(COND
((OR (EQ NEXTC (CHARCODE %"))
(EQ NEXTC ESC))
(add POS ESCWIDTH)))
(add POS (CHARWIDTH NEXTC FONT))
finally (COND
((EQ LASTSPACE 0) (* "Need break")
(COND
[(EQ C (CHARCODE SPACE)) (* "Will turn this space into CR")
(SETQ C (NTHCHARCODE STRING (add I 1]
(T (SHOULDNT)))
(GO ENDLINE]
CHECKESCAPE
(COND
((AND P2FLG (OR (EQ C (CHARCODE %"))
(EQ C ESC)))
(\OUTCHAR STREAM ESC)
(add HERE ESCWIDTH)))
PRINTIT
(\OUTCHAR STREAM C)
(add HERE (CHARWIDTH C FONT))
(GO LP)
ENDLINE
(PRINENDLINE LMARG STREAM)
(SETQ HERE LMARG)
(COND
((NULL C) (* Done)
(GO DONE))
((AND P2FLG (EQ (\SYNCODE SA C)
SEPRCHAR.RC)) (*
"Have to quote sepr immediately following CR")
(\OUTCHAR STREAM ESC)
(add HERE ESCWIDTH)
(GO PRINTIT))
(T (GO CHECKESCAPE)))
DONE
[COND
(P2FLG (\OUTCHAR STREAM (CHARCODE %"]
[COND
(MAKEMAP (LET [(ENTRY (MAKEMAPENTRY TAIL (AND (NEQ MAKEMAP T)
MAKEMAP)
MAPX1 MAPY1 (DSPXPOSITION NIL STREAM)
(DSPYPOSITION NIL STREAM)
(\DEDITFONT# STREAM]
(replace LONGSTRINGP of ENTRY with T)
(COND
(SINGLELEFT (replace LONGSTRING1MARGINP of ENTRY with T)))
(COND
((EQ (IDIFFERENCE (DSPRIGHTMARGIN NIL STREAM)
LMARG)
RMARG) (* "Assume that RMARG not equal to stream's right margin only happens for centered comments. In reality, it happens as well inside REPP, where RESETCLIP hides the true right margin.")
(replace LONGSTRINGSYMMETRICP of ENTRY with T]
(RETURN])
)
(RPAQ? *DIVIDE-LONG-STRINGS* (QUOTE DISPLAY))
(* Wrappers)
(DEFINEQ
(SUPERPRINT/WRAPPER
[LAMBDA (MACRO E TAIL BRFLG FILE) (* bvm: "22-May-86 12:45")
(* * "Print E as MACRO followed by (CADR E), for example, print (QUOTE foo) as 'foo")
(PRINOPEN TAIL MACRO FILE) (* Print the prefix)
[COND
(MAKEMAP (* "Need to fool DEDIT into thinking that it is printing the whole list E when only (CADR E) appears in print. So do a fake entry for (CAR E) whose width is zero")
(replace WRAPPER of MAKEMAP with MACRO) (*
"MAKEMAP is the entry for E -- want everyone to know it wasn't printed as normal list")
(LET ((X (DSPXPOSITION NIL FILE))
(Y (DSPYPOSITION NIL FILE)))
(MAKEMAPENTRY E (AND (NEQ MAKEMAP T)
MAKEMAP)
X Y X Y (\DEDITFONT# FILE]
(SUPERPRINT (CADR E)
(CDR E)
BRFLG FILE) (*
"Finally, print a vacuous closing paren")
(PRINSHUT TAIL NIL FILE])
)
(* "DEDITMAP record and accessors")
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE DEDITMAP ((D# BYTE)
(TAIL POINTER)
(F# BYTE)
(BP POINTER)
(STARTX WORD)
(STOPX WORD)
(STARTY WORD)
(STOPY WORD)
(LONGSTRINGP FLAG) (* SELEXP is a string neatly divided
over several lines)
(LONGSTRING1MARGINP FLAG) (* String's left margin is same on
every line. If false, then left margin
for second and subsequent lines is
STARTX of BP)
(LONGSTRINGSYMMETRICP FLAG) (* String was in a centered comment,
so its right margin is indented
symmetrically with its left margin)
(NIL 5 FLAG)
(WRAPPER POINTER))
[ACCESSFNS DEDITMAP ((FNT (ELT \DEDITFONTS (fetch F# of DATUM)))
(PDSP (ELT \DEDITDSPS (fetch D# of DATUM)))
(SELEXP (CAR (fetch TAIL of DATUM)))
(LPEND (DEDIT.LPEND DATUM))
(RPSTART (DEDIT.RPSTART DATUM])
]
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG
POINTER))
(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))
(DEDITMAP 8 (FLAGBITS . 0))
(DEDITMAP 8 (FLAGBITS . 16))
(DEDITMAP 8 (FLAGBITS . 32))
(DEDITMAP 8 (FLAGBITS . 48))
(DEDITMAP 8 (FLAGBITS . 64))
(DEDITMAP 8 (FLAGBITS . 80))
(DEDITMAP 8 (FLAGBITS . 96))
(DEDITMAP 8 (FLAGBITS . 112))
(DEDITMAP 8 POINTER)))
(QUOTE 10))
)
(/DECLAREDATATYPE (QUOTE DEDITMAP)
(QUOTE (BYTE POINTER BYTE POINTER WORD WORD WORD WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG
POINTER))
(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))
(DEDITMAP 8 (FLAGBITS . 0))
(DEDITMAP 8 (FLAGBITS . 16))
(DEDITMAP 8 (FLAGBITS . 32))
(DEDITMAP 8 (FLAGBITS . 48))
(DEDITMAP 8 (FLAGBITS . 64))
(DEDITMAP 8 (FLAGBITS . 80))
(DEDITMAP 8 (FLAGBITS . 96))
(DEDITMAP 8 (FLAGBITS . 112))
(DEDITMAP 8 POINTER)))
(QUOTE 10))
(DEFINEQ
(DEDIT.LPEND
[LAMBDA (MAPE) (* bvm: "22-May-86 12:46")
(* * "Xpos of start of expression, following the open paren (or wrapper)")
(IPLUS (fetch STARTX of MAPE)
(LET ((WRAP (fetch WRAPPER of MAPE))
(FNT (fetch FNT of MAPE)))
(COND
(WRAP (STRINGWIDTH WRAP FNT))
(T (CHARWIDTH (CHARCODE %()
(fetch FNT of MAPE])
(DEDIT.RPSTART
[LAMBDA (MAPE) (* bvm: "22-May-86 12:46")
(* * "Xpos where expression ends and right paren starts")
(IDIFFERENCE (fetch STOPX of MAPE)
(COND
((fetch WRAPPER of MAPE)
0)
(T (CHARWIDTH (CHARCODE %))
(fetch FNT of MAPE])
(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 NIL (* kbr: "25-Aug-85 17:45")
(OR \DEDITFONT# (SETQ \DEDITFONT# (PROG (FONT FONTTYPE FONT#)
(SETQ FONT (DSPFONT))
(SETQ FONTTYPE (fetch (FONTDESCRIPTOR FONTDEVICE)
of FONT))
[OR \DEDITFONTS (SETQ \DEDITFONTS (FONTMAPARRAY
NIL
(QUOTE DISPLAY]
[SETQ FONT#
(for I to (ARRAYSIZE \DEDITFONTS)
thereis (EQ FONT (COND
((EQ FONTTYPE (QUOTE DISPLAY))
(fetch (FONTCLASS DISPLAYFD)
of (ELT \DEDITFONTS I)))
(T (FONTCLASSCOMPONENT
(ELT \DEDITFONTS I)
FONTTYPE NIL T]
(RETURN FONT#)))
(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])
(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) (* bvm: " 9-Jun-86 16:51")
(* * "The central pretty-printer for DEDIT -- prints TAIL to FILE with indicated LEFT margin and FONT. TAIL is either an expression, or a map entry whose TAIL we should start printing with")
(SETQ FILE (GETSTREAM FILE (QUOTE OUTPUT)))
[WITH-READER-ENVIRONMENT (OR (WINDOWPROP FILE (QUOTE READER-ENVIRONMENT))
(DEDIT-MAKE-READER-ENV))
(LET ((MAKEMAP T)
(#RPARS NIL))
(DECLARE (SPECVARS MAKEMAP #RPARS))
(RESETLST (RESETSAVE **COMMENT**FLG 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 FILE
(QUOTE REGION)))
(ITIMES 2 (WINDOWPROP FILE (QUOTE BORDER]
COMMENTCOL FNSLST TAILFLG FILEFLG CHANGEFLG (FORMFLG T))
(SETFONT FONT FILE)
(DSPXPOSITION LEFT FILE)
(SUPERPRINT (CAR TAIL)
TAIL NIL FILE]
(GETME4 TAIL T])
(DEDIT-MAKE-READER-ENV
[LAMBDA (EXPR) (* bvm: "22-May-86 12:58")
(* * "Creates a READER-ENVIRONMENT object to control the editing environment of EXPR. For now, just use the current environment")
(MAKE-READER-ENVIRONMENT])
)
(DEFINEQ
(REPP
[LAMBDA (ENT) (* bvm: " 9-Jun-86 17:11")
(bind DS OLDE do (SETQ OLDE ENT) (* Save current value)
(SETQ DS (fetch PDSP of ENT))
[COND
[(fetch BP of ENT) (* "Subexpression -- move to where it starts now, then reprint the expression with clipping region set to confine the printing to the space now available")
(MOVETO (fetch STARTX of ENT)
(fetch STARTY of ENT)
DS)
(RESETFORM (RESETCLIP (CONS DS (UNPP ENT)))
(SETQ ENT (DEPRINTDEF ENT NIL NIL DS]
(T (* "Reprint the entire window")
(RETURN (SETDEDITMAP DS (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) (* bvm: "27-May-86 15:19")
(* * "Repaints stuff LOWER than HI and on or above LO")
(WITH-READER-ENVIRONMENT (OR (WINDOWPROP WDS (QUOTE READER-ENVIRONMENT))
(SHOULDNT))
(DSPRIGHTMARGIN [PROG1 (DSPRIGHTMARGIN 10000 WDS) (*
"We reset margin b/c REFRESHIF is sometimes called with things that would overflow")
(LET ((R (DSPCLIPPINGREGION NIL WDS)))
(REFRESHIF1 (GETMAP? WDS)
(GETSTREAM WDS (QUOTE OUTPUT))
(IMIN HI (fetch PTOP of R))
(IMAX LO (fetch BOTTOM of R]
WDS])
(REFRESHIF1
[LAMBDA (M DS HI LO) (* bvm: "28-May-86 15:30")
(* * "Refresh display of that part of expression indicated by map entry M that lies between ypos HI and LO")
(COND
((AND M (OVERLAP HI LO (HIPT M)
(LOWPT M)))
(COND
[(LISTP (fetch SELEXP of M))
(LET ((WRAP (fetch WRAPPER 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 (OR WRAP (QUOTE %())
DS)))
(COND
(WRAP (REFRESHIF1 (GETME4 (CDR (fetch SELEXP of M))
M)
DS HI LO))
(T [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)
(COND
((fetch LONGSTRINGP of M)
(LET* ((COMMENTP (NULL (fetch LONGSTRING1MARGINP of M)))
[LMARG (fetch STARTX of (COND
(COMMENTP
(*
"Inside a comment, the string may be printed with a margin to the left of where the string starts")
(fetch BP of M))
(T M]
(RMARG (WINDOWPROP DS (QUOTE WIDTH)))
MAKEMAP)
(DECLARE (SPECVARS MAKEMAP))
(PRIN2-LONG-STRING (fetch SELEXP of M)
DS T T LMARG (COND
((fetch LONGSTRINGSYMMETRICP of M)
(* "String symmetrically centered")
(IDIFFERENCE RMARG LMARG))
(T RMARG))
COMMENTP)))
(T (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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3347 8856 (PRINOPEN 3357 . 3822) (PRINSHUT 3824 . 4329) (PRIN1S 4331 . 4979) (PRIN2S
4981 . 5543) (PRINENDLINE 5545 . 6703) (PRINDOTP 6705 . 6971) (SETFONT 6973 . 7793) (MAKEDOTPTAIL 7795
. 8854)) (8886 20092 (PRIN2STRING 8896 . 9637) (PRIN2-LONG-STRING 9639 . 20090)) (20165 21443 (
SUPERPRINT/WRAPPER 20175 . 21441)) (24932 30523 (DEDIT.LPEND 24942 . 25481) (DEDIT.RPSTART 25483 .
25905) (MAKEMAPENTRY 25907 . 26807) (\DEDITFONT# 26809 . 28369) (DSPDSFOR 28371 . 29061) (SHOWDEDITMAP
29063 . 30521)) (30639 33238 (DEPRINTDEF 30649 . 32924) (DEDIT-MAKE-READER-ENV 32926 . 33236)) (33239
49390 (REPP 33249 . 34532) (REPPCHANGES 34534 . 36990) (REPPUNRAVEL 36992 . 38023) (REPPDELETE 38025
. 40002) (REPPINSERT 40004 . 42796) (REPPTANGLEDP 42798 . 43961) (LEADSPACE 43963 . 44356) (
SPACINGRULE 44358 . 45106) (UNPP 45108 . 47768) (NXTUSEDX 47770 . 49201) (ONELINEP 49203 . 49388)) (
49391 58374 (MOVEDSMAP 49401 . 53795) (ADJUSTXTAIL 53797 . 55718) (ADJUSTYTAIL 55720 . 56543) (
ADJDEEXTENT 56545 . 56845) (DSLINEFONT 56847 . 57263) (DSLINEFONT1 57265 . 57958) (MAXFONT 57960 .
58372)) (58375 63372 (REFRESHIF 58385 . 59283) (REFRESHIF1 59285 . 63370)) (63373 64241 (COMMENTP
63383 . 63543) (HIPT 63545 . 63789) (LOWPT 63791 . 64022) (WIPE 64024 . 64239)) (64242 64708 (
RESETCLIP 64252 . 64706)))))
STOP