(FILECREATED " 2-Apr-86 23:58:09" {QV}<IDL>SOURCES>TOPLEVEL.;16 8475
changes to: (DECLTYPES COMPOUNDOBJECT CURVEOBJECT FILLEDRECTANGLEOBJECT LINEOBJECT POINTOBJECT
POLYGONOBJECT TEXTOBJECT)
previous date: "16-Feb-86 13:53:56" {QV}<IDL>SOURCES>TOPLEVEL.;15)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TOPLEVELCOMS)
(RPAQQ TOPLEVELCOMS [(* Contains user-error functions)
(FNS FINDUNAME UARG UERROR! UERRORPRINT?)
(VARS (UERRORSTKPTR (STKNTH 0 T))
(UERRORNAME (QUOTE UERRORTOP))
(UERRORALWAYSFLAG)
(URESETVARSLST))
(IF: TESTSYS (* UENTRY macro adds to spelling lists at load-time if
FASTCOMPILE.)
(MACROS UENTRY UERRORGUARD UERRORGUARDVAL UERROR)
(MACROS UERRORFIND UERRORSET)
(TEMPLATES UENTRY UERROR UERRORGUARD UERRORSET)
(ADDVARS (NOFIXVARSLST .P2))
(* * For GLOBAL)
(DECLTYPES ARITH FLOATING IJK IJKDELTA INTEGER POSINT SCALAR VSCALARP
(FIXP COERCION)
(FLOATP COERCION)
(NUMBERP COERCION)
(NIL COERCION))
(* * For PRINT)
(DECLTYPES STREAM OUTPUTSTREAM)
(* * For LABELS)
(DECLTYPES LABEL TITLE USERTITLE)
(* * For IDLPLOT)
(DECLTYPES COMPOUNDOBJECT CURVEOBJECT FILLEDRECTANGLEOBJECT LINEOBJECT
POINTOBJECT POLYGONOBJECT TEXTOBJECT WINDOW))
(ADDVARS (SYSSPECVARS UERRORNAME URESETVARSLST)
(SPECVARS UERRORNAME URESETVARSLST))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML UARG)
(LAMA])
(* Contains user-error functions)
(DEFINEQ
(FINDUNAME
[LAMBDA (UENAME) (* bas: "13-FEB-83 20:09")
(DECLARE (USEDFREE UERRORNAME))
(PROG [(NUNAME (if (LITATOM UENAME)
then (OR UENAME UERRORNAME)
elseif (EQ (CAR (LISTP UENAME))
(QUOTE QUOTE))
then (CADR UENAME)
else (HELP "Bad UERRORNAME" UENAME] (* This will update spelling lists at load-time if left
in translation e.g. by UENTRY)
(SETQ NUNAME (KWOTE NUNAME))
(RETURN (if FASTCOMPILE
then [SUBST NUNAME (QUOTE UEX)
(QUOTE (LOADTIMECONSTANT (PROGN (ADDSPELL UEX 1)
(ADDSPELL UEX 2)
UEX]
else NUNAME])
(UARG
[NLAMBDA (VARNAME) (* bas: "11-FEB-83 16:02")
(* Gets the value of a variable as of the nearest
UENTRY, which is presumably the un-coerced value that
the user presented to us.)
(PROG1 (EVALV VARNAME (UERRORFIND))
(RELSTK UERRORSTKPTR])
(UERROR!
[LAMBDA NIL (* bas: "15-FEB-83 13:04")
(* This passes control to the next UERRORSET on the
stack, or sets up the break at the entry.)
(AND (NEQ RESETVARSLST URESETVARSLST)
(RESETRESTORE URESETVARSLST (QUOTE ERROR))) (* The NEQs avoid an unnecessary function call.
For efficiency in the non-error transfer of control
case)
(SELECTQ UERRORNAME
(UERRORGUARD (RETFROM (UERRORFIND)
T T))
(UERRORTOP (BREAK1 (ERROR "Can't continue")
T))
(PROG [(BREAKFN (STKNAME (REALSTKNTH -1 (UERRORFIND)
NIL UERRORSTKPTR]
(* Don't use UERRORNAME cause we might be in a
subfunction of it)
(ENVEVAL (LIST (FUNCTION BREAK1)
(SAVED1 (FNTYP BREAKFN)
BREAKFN
(ARGLIST BREAKFN))
T UERRORNAME)
UERRORSTKPTR UERRORSTKPTR T T])
(UERRORPRINT?
[LAMBDA NIL (* bas: "13-FEB-83 20:15")
(* Predicate that determines whether or not UERROR
printing should occur. Prints the UERRORNAME as a
prefix on the line for subsequent printing.)
(SELECTQ UERRORNAME
(UERRORGUARD UERRORALWAYSFLAG)
(UERRORTOP T)
(printout T UERRORNAME ": "])
)
(RPAQ UERRORSTKPTR (STKNTH 0 T))
(RPAQQ UERRORNAME UERRORTOP)
(RPAQQ UERRORALWAYSFLAG NIL)
(RPAQQ URESETVARSLST NIL)
(DECLARE: DOCOPY
(DECLARE: EVAL@LOADWHEN TESTSYS
(DECLARE: EVAL@COMPILE
[PUTPROPS UENTRY MACRO (ARGS (LIST (QUOTE UERRORSET)
(CONS (QUOTE PROGN)
(CDR ARGS))
(FINDUNAME (CAR ARGS]
[PUTPROPS UERRORGUARD MACRO (ARGS (COND [(CDR ARGS)
(LIST (QUOTE AND)
(LIST (QUOTE UERRORGUARDVAL)
(CAR ARGS))
(CONS (QUOTE UERROR)
(CDR ARGS]
(T (CONS (QUOTE UERRORGUARDVAL)
ARGS]
[PUTPROPS UERRORGUARDVAL MACRO ((F)
(UERRORSET (PROGN F NIL)
(QUOTE UERRORGUARD]
[PUTPROPS UERROR MACRO (ARGS (COND [ARGS (LIST (QUOTE PROGN)
[SUBST ARGS (QUOTE COMS)
(QUOTE (COND ((UERRORPRINT?)
(PRINTOUT T . COMS)
(TERPRI T]
(QUOTE (UERROR!]
(T (QUOTE (UERROR!]
)
(DECLARE: EVAL@COMPILE
[PUTPROPS UERRORFIND DMACRO (ARGS (QUOTE (STKPOS (QUOTE UERRORSET)
NIL NIL UERRORSTKPTR]
(PUTPROPS UERRORSET DMACRO ((FORM NAME)
(NAMEDLET UERRORSET ((UERRORNAME NAME)
(URESETVARSLST RESETVARSLST))
FORM)))
)
(SETTEMPLATE (QUOTE UENTRY)
(QUOTE (NIL .. EVAL RETURN)))
(SETTEMPLATE (QUOTE UERROR)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE UERRORGUARD)
(QUOTE MACRO))
(SETTEMPLATE (QUOTE UERRORSET)
(QUOTE MACRO))
(ADDTOVAR NOFIXVARSLST .P2)
(DECLARE: EVAL@COMPILE
(DECLTYPES (ARITH (SYNONYM NUMBERP))
(FLOATING (SYNONYM FLOATP))
(IJK (SUBTYPE CARDINAL))
(IJKDELTA (SUBTYPE FIXP))
(INTEGER (SYNONYM FIXP))
(POSINT (INTEGER (SATISFIES (IGREATERP VALUE 0))))
(SCALAR (ONEOF ARITH NIL)
COERCION (CONV.SCALAR))
(VSCALARP (SUBTYPE ANY)
TESTFN VSCALARP)
(FIXP FIXP COERCION ((FIXR (CONV.ARITH UARG))))
(FLOATP FLOATP COERCION ((FLOAT (CONV.ARITH UARG))))
(NUMBERP NUMBERP COERCION (CONV.ARITH))
(NIL NIL COERCION (CONV.SCALAR NULL)))
)
(DECLARE: EVAL@COMPILE
(DECLTYPES (STREAM (SUBTYPE ANY)
TESTFN STREAMP)
(OUTPUTSTREAM (SUBTYPE STREAM)
TESTFN [LAMBDA (S)
(AND (STREAMP S)
(\GETSTREAM S (QUOTE OUTPUT)
T]
COERCION [(AND (LITATOM UARG)
(OR (\GETSTREAM UARG (QUOTE OUTPUT)
T)
(OPENSTREAM UARG (QUOTE OUTPUT]))
)
(DECLARE: EVAL@COMPILE
(DECLTYPES (LABEL (SUBTYPE LITATOM))
(TITLE (ONEOF LISTP STRINGP))
(USERTITLE (ONEOF STRINGP NIL)
COERCION ((OR (STRINGP UARG)
(AND UARG (LITATOM UARG)
(MKSTRING UARG))
(UERROR "Invalid title: " .P2 UARG)))))
)
(DECLARE: EVAL@COMPILE
(DECLTYPES (COMPOUNDOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? COMPOUND VALUE))))
(CURVEOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? CURVE VALUE))))
(FILLEDRECTANGLEOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? FILLEDRECTANGLE VALUE))))
(LINEOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? LINE VALUE))))
(POINTOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? POINT VALUE))))
(POLYGONOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? POLYGON VALUE))))
(TEXTOBJECT (PLOTOBJECT (SATISFIES (PLOTOBJECTSUBTYPE? TEXT VALUE))))
(WINDOW (SUBTYPE STREAM)
TESTFN WINDOWP))
)
)
)
(ADDTOVAR SYSSPECVARS UERRORNAME URESETVARSLST)
(ADDTOVAR SPECVARS UERRORNAME URESETVARSLST)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML UARG)
(ADDTOVAR LAMA )
)
(PUTPROPS TOPLEVEL COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1710 4554 (FINDUNAME 1720 . 2524) (UARG 2526 . 2936) (UERROR! 2938 . 4070) (
UERRORPRINT? 4072 . 4552)))))
STOP