Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 6-May-82 16:02:55" <DONC>ALL.LISP.33 7194
changes to: PP-ALL ALLCOMS MAKENEWCOM ALLCONTENTS NEW-ALL ALL-TYPES
ADD-ALL DEL-ALL
previous date: " 2-Mar-81 14:13:40" <DONC>ALL.LISP.30)
(PRETTYCOMPRINT ALLCOMS)
(RPAQQ ALLCOMS ((FNS ADD-ALL ALLCONTENTS DEL-ALL NEW-ALL PP-ALL)
(VARS ALL-TYPES)
(FILEPKGCOMS * ALLFILEPKGCOMS)
(ADVISE MAKENEWCOM)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML PP-ALL)
(LAMA)))))
(DEFINEQ
(ADD-ALL
(LAMBDA (COM NAME TYPE NEAR)
(PROG (TYPLST TEM ALLPROPS PROPLST)
(COND
((LISTP NAME) (* PROPS)
(SETQ TYPE (LIST TYPE (CADR NAME)))
(SETQ NAME (CAR NAME))))
(COND
((EQ (QUOTE *)
(CADR COM))
(SETQ COM (GETATOMVAL (CADDR COM))))
(T (SETQ COM (CDR COM))))
(COND
((NOT (OR (FMEMB TYPE (SETQ TYPLST (CAR COM)))
(AND (LISTP TYPE)
(for TL in TYPLST thereis (AND (LISTP TL)
(FMEMB (CADR TYPE)
(CDR TL))
(SETQ ALLPROPS TL)))))
)
(RETURN NIL))
((SETQ TEM (ASSOC NAME (CDR COM)))
(COND
((AND (LISTP TYPE)
(SETQ PROPLST (for TP in (CDR TEM)
thereis (AND (LISTP TP)
(INTERSECTION (CDR TP)
(CDR ALLPROPS)
)))))
(SETQ TYPE (CADR TYPE))
(SETQ TYPLST ALLPROPS)
(SETQ TEM PROPLST)))
(COND
((FMEMB TYPE (CDR TEM))
(RETURN T)))
(for TP in TYPLST until (OR (EQ TP TYPE)
(AND (LISTP TP)
(LISTP TYPE)
(INTERSECTION (CDR TP)
(CDR TYPE))))
do (COND
((OR (EQ (CADR TEM)
TP)
(AND (LISTP TP)
(LISTP (CADR TEM))))
(SETQ TEM (CDR TEM)))))
(/RPLACD TEM (CONS TYPE (CDR TEM)))
(RETURN T))
(NEAR (COND
((ASSOC NEAR (CDR COM))
(SETQ TEM (CDR COM))
(until (EQ (CAAR TEM)
NEAR)
do (SETQ TEM (CDR TEM)))
(/RPLACD TEM (CONS (LIST NAME TYPE)
(CDR TEM)))
(RETURN T))
(T (RETURN NIL))))
(T (SETQ TEM COM)
(while (AND (CDR TEM)
(ALPHORDER (CAADR TEM)
NAME))
do (SETQ TEM (CDR TEM)))
(/RPLACD TEM (CONS (LIST NAME TYPE)
(CDR TEM)))
(RETURN T))))))
(ALLCONTENTS
(LAMBDA (CMD NAME TYPE)
(PROG (TYPLIST CONTENTS)
(COND
((EQ (QUOTE *)
(CADR CMD))
(SETQ CONTENTS (GETATOMVAL (CADDR CMD)))
(SETQ CONTENTS (CONS (CAR CONTENTS)
(CONS (LIST (CADDR CMD)
(QUOTE VARS))
(CDR CONTENTS)))))
(T (SETQ CONTENTS (CDR CMD))))
(COND
((NOT (LISTP (SETQ TYPLIST (CAR CONTENTS))))
(HELP "Bad Format in ALL list")))
(SETQ CONTENTS (CDR CONTENTS))
(RETURN
(COND
((NOT (OR (FMEMB TYPE TYPLIST)
(EQ TYPE (QUOTE PROPS))
(AND (LISTP NAME)
(for TL in TYPLIST
thereis (AND (LISTP TL)
(FMEMB (CADR NAME)
(CDR TL)))))))
NIL)
((NULL NAME)
(COND
((EQ TYPE (QUOTE PROPS))
(for C in CONTENTS join (for TP in (CDR C)
when (LISTP TP)
join (for PR in (CDR TP)
collect
(LIST (CAR C)
PR)))))
(T (for C in CONTENTS when (FMEMB TYPE (CDR C))
collect (CAR C)))))
((EQ NAME T)
(COND
((EQ TYPE (QUOTE ALL))
(NOT (NOT CONTENTS)))
((EQ TYPE (QUOTE PROPS))
(for C in CONTENTS thereis (for P in C thereis
(LISTP P))))
(T (for C in CONTENTS thereis (FMEMB TYPE (CDR C))))))
((LISTP NAME)
(SUBSET NAME
(FUNCTION (LAMBDA (X)
(OR (FMEMB TYPE (CDR (FASSOC X CONTENTS)))
(AND (LISTP X)
(for TP in (FASSOC (CAR X)
CONTENTS)
thereis (AND (LISTP TP)
(FMEMB (CADR TYPE)
(CDR TP))))))))))
(T (FMEMB TYPE (CDR (ASSOC NAME CONTENTS)))))))))
(DEL-ALL
(LAMBDA (COM NAME TYPE)
(PROG (TEM TEM2 INPROP)
(COND
((EQ (QUOTE *)
(CADR COM))
(SETQ COM (GETATOMVAL (CADDR COM))))
(T (SETQ COM (CDR COM))))
(COND
((LISTP NAME)
(SETQ TYPE (LIST TYPE (CADR NAME)))
(SETQ NAME (CAR NAME))))
(COND
((NULL (SETQ TEM (ASSOC NAME (CDR COM))))
(RETURN NIL))
((AND (LISTP TYPE)
(SETQ TYPE (CADR TYPE))
(SETQ INPROP TEM)
(NULL (SETQ TEM (for TP in TEM thereis (AND (LISTP TP)
(FMEMB TYPE TP))))
))
(RETURN NIL))
((NOT (FMEMB TYPE (CDR TEM)))
(RETURN NIL)))
(SETQ TEM2 TEM)
(until (EQ (CADR TEM2)
TYPE)
do (SETQ TEM2 (CDR TEM2)))
(/RPLACD TEM2 (CDDR TEM2))
(COND
((CDR TEM)
(RETURN T)))
(COND
(INPROP (SETQ TEM (SETQ TEM2 INPROP))
(until (EQ TEM (CADR TEM2)) do (SETQ TEM2 (CDR TEM2)))
(/RPLACD TEM2 (CDDR TEM2))))
(COND
((CDR TEM)
(RETURN T)))
(SETQ TEM2 COM)
(until (EQ (CADR TEM2)
TEM)
do (SETQ TEM2 (CDR TEM2)))
(/RPLACD TEM2 (CDDR TEM2))
(COND
((CDR COM)
(RETURN T))
(T (RETURN (QUOTE ALL)))))))
(NEW-ALL
(LAMBDA (NAME TYPE LISTNAME FILE)
(COND
((LISTP NAME)
(SETQ $TYPE$ (LIST $TYPE$ (CADR NAME)))
(SETQ NAME (CAR NAME))))
(COND
((NOT (OR (FMEMB $TYPE$ ALL-TYPES)
(AND (LISTP $TYPE$)
(for AT in ALL-TYPES thereis (AND (LISTP AT)
(FMEMB (CADR $TYPE$)
(CDR AT)))))))
NIL)
(LISTNAME (SET LISTNAME (LIST ALL-TYPES (LIST NAME $TYPE$)))
(LIST (QUOTE ALL)
(QUOTE *)
LISTNAME))
(T (LIST (QUOTE ALL)
ALL-TYPES
(LIST NAME $TYPE$))))))
(PP-ALL
(NLAMBDA (A)
(for NAME in (CDR A) join (for TYPE in (CDR NAME)
collect (COND
((LISTP TYPE)
(CONS (QUOTE PROPS)
(for P in (CDR TYPE)
collect
(LIST (CAR NAME)
P))))
(T (LIST TYPE (CAR NAME))))))))
)
(RPAQQ ALL-TYPES (COMMENTS FNS MACROS VARS LISPXMACROS USERMACROS))
(RPAQQ ALLFILEPKGCOMS (ALL))
(FILEPKGCOM (QUOTE ALL)
(QUOTE MACRO)
(QUOTE (X (COMS * (PP-ALL X))))
(QUOTE CONTENTS)
(QUOTE ALLCONTENTS)
(QUOTE DELETE)
(QUOTE DEL-ALL)
(QUOTE ADD)
(QUOTE ADD-ALL))
(FILEPKGTYPE (QUOTE ALL)
(QUOTE DESCRIPTION)
(QUOTE "all")
(QUOTE NEWCOM)
(QUOTE NEW-ALL)
(QUOTE GETDEF)
(QUOTE (LAMBDA (NAME TYPE)
NIL)))
(PUTPROPS MAKENEWCOM READVICE (NIL
(BEFORE NIL
(COND
((OR (FMEMB TYPE ALL-TYPES)
(AND (EQ TYPE (QUOTE PROPS))
(for AT in ALL-TYPES thereis
(AND (LISTP AT)
(FMEMB (CADR (LISTP NAME))
(CDR AT))))))
(SETQ $TYPE$ TYPE)
(SETQ TYPE (QUOTE ALL)))))))
(READVISE MAKENEWCOM)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML PP-ALL)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (523 6177 (ADD-ALL 535 . 2358) (ALLCONTENTS 2362 . 4008) (DEL-ALL
4012 . 5317) (NEW-ALL 5321 . 5875) (PP-ALL 5879 . 6174)))))
STOP