(FILECREATED "16-Jul-85 16:19:11" {ERIS}<LISPCORE>SOURCES>RESOURCE.;2 10144
changes to: (FNS \GR.METHODEXPANDER)
(VARS RESOURCECOMS)
previous date: "16-Jul-85 16:10:51" {ERIS}<LISPCORE>SOURCES>RESOURCE.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RESOURCECOMS)
(RPAQQ RESOURCECOMS [(MACROS INITRESOURCE NEWRESOURCE GETRESOURCE FREERESOURCE WITH-RESOURCE
WITH-RESOURCES)
(FNS \GR.METHODEXPANDER \GR.WITHRESOURCEMAC)
(FILEPKGCOMS RESOURCES INITRESOURCES)
(FNS \GR.GETDEFFN \GR.PUTDEFFN \GR.DELDEFFN \GR.CONTENTS \GR.GvarInitLst)
(FNS \GR.MAKEPRETTYCOMSL \IGR.MAKEPRETTYCOMSL)
(INITVARS (GLOBAL.RESOURCES))
(GLOBALVARS GLOBAL.RESOURCES)
(PROP ARGNAMES INITRESOURCE NEWRESOURCE GETRESOURCE FREERESOURCE)
(COMS (* "need only be in ABC")
(MACROS GLOBALRESOURCE GLOBALRESOURCES)
(FILEPKGCOMS GLOBALRESOURCES)
(MACROS RELEASERESOURCE))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA \IGR.MAKEPRETTYCOMSL \GR.MAKEPRETTYCOMSL)
(NLAML)
(LAMA])
(DECLARE: EVAL@COMPILE
[PUTPROPS INITRESOURCE MACRO (X (\GR.METHODEXPANDER X (QUOTE INIT]
[PUTPROPS NEWRESOURCE MACRO (X (\GR.METHODEXPANDER X (QUOTE NEW]
[PUTPROPS GETRESOURCE MACRO (X (\GR.METHODEXPANDER X (QUOTE GET]
[PUTPROPS FREERESOURCE MACRO (X (\GR.METHODEXPANDER X (QUOTE FREE]
(PUTPROPS WITH-RESOURCE MACRO (= . WITH-RESOURCES))
(PUTPROPS WITH-RESOURCES MACRO (X (\GR.WITHRESOURCEMAC X)))
)
(DEFINEQ
(\GR.METHODEXPANDER
[LAMBDA (X METHOD) (* lmm "16-Jul-85 16:17")
(PROG (DEF RVAR (NAME (OR (CAR (LISTP X))
X)))
(RETURN (if (NULL (SETQ DEF (LISTGET (SETQ DEF (GETDEF NAME (QUOTE RESOURCES)))
METHOD)))
then (* Although these could all be implemented by
functions, this is the default
(and common) case; so just put in-line here.)
(SETQ RVAR (PACK* (QUOTE \)
NAME
(QUOTE .GLOBALRESOURCE)))
(SELECTQ METHOD
[GET (BQUOTE (PROGN (DECLARE (GLOBALVARS , RVAR))
(COND
(, RVAR (PROG1 , RVAR (SETQ , RVAR NIL)))
(T (NEWRESOURCE , NAME]
[FREE (BQUOTE (PROGN (DECLARE (GLOBALVARS , RVAR))
(SETQ , RVAR , (CADR (LISTP X]
[INIT (BQUOTE (/SETTOPVAL (QUOTE , RVAR]
(NEW (ERROR "No NEW method for resource" NAME))
(SHOULDNT))
elseif (FNTYP DEF)
then (APPLY DEF X)
elseif (LISTP DEF)
then (SUBPAIR (QUOTE (RESOURCENAME ARGS))
(LIST NAME (CDR (LISTP X)))
DEF)
else (ERROR (CONCAT "Bad resource " METHOD " method for " NAME)
DEF])
(\GR.WITHRESOURCEMAC
[LAMBDA (X) (* rmk: "15-Jun-84 10:51")
(PROG [(NAMES (MKLIST (CAR X)))
(FORMS (\DECL.COMNT.PROCESS (CDR X]
(RETURN (CONS [CONS (QUOTE LAMBDA)
(CONS NAMES (APPEND (CAR FORMS)
(CADR FORMS)
(LIST (CONS (QUOTE PROG1)
(CONS (CONS (QUOTE PROGN)
(CDDR FORMS))
(for NAME in NAMES
collect (LIST (QUOTE
FREERESOURCE)
NAME NAME]
(for NAME in NAMES collect (LIST (QUOTE GETRESOURCE)
NAME])
)
(PUTDEF (QUOTE RESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO [X (DECLARE: EVAL@COMPILE
(P * (
\GR.MAKEPRETTYCOMSL . X]
CONTENTS \GR.CONTENTS)
(TYPE DESCRIPTION "global resources" GETDEF
\GR.GETDEFFN DELDEF \GR.DELDEFFN PUTDEF
\GR.PUTDEFFN))))
(PUTDEF (QUOTE INITRESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (P * (\IGR.MAKEPRETTYCOMSL .
X)))
CONTENTS \GR.CONTENTS))))
(DEFINEQ
(\GR.GETDEFFN
[LAMBDA (NAME TYPE) (* rmk: "14-Jun-84 22:39")
(CDR (ASSOC NAME GLOBAL.RESOURCES])
(\GR.PUTDEFFN
[LAMBDA (NAME TYPE DEF) (* JonL "20-Jul-84 03:31")
(if (OR (NULL NAME)
(NOT (LITATOM NAME)))
then (ERRORX (LIST 14 NAME)))
(if [AND (LISTP DEF)
(NOT (LISTGET DEF (QUOTE NEW]
then
(* * Conversion from old format -- to be flushed soon after CAROL release. Jonl 5/14/84)
(SETQ DEF (LIST (QUOTE NEW)
DEF))
elseif [AND DEF (NOT (LISTGET (LISTP DEF)
(QUOTE NEW]
then (ERROR "No NEW method for resource" NAME)) (* Note that the variable GLOBAL.RESOURCES has been
GLOBALVAR'd by the file COMS)
[if (NULL DEF)
then (\GR.DELDEFFN NAME TYPE)
else (PROG NIL
(MARKASCHANGED NAME (QUOTE RESOURCES)
(if (SETQ TYPE (ASSOC NAME GLOBAL.RESOURCES))
then (* The initialization has to be performed regardless of
whether or not the definition has changed.)
(EVAL (\GR.METHODEXPANDER NAME (QUOTE INIT)))
(AND (EQUAL DEF (CDR TYPE))
(RETURN))
(/RPLACD TYPE DEF)
(QUOTE CHANGED)
else (/SETTOPVAL (QUOTE GLOBAL.RESOURCES)
(CONS (CONS NAME DEF)
GLOBAL.RESOURCES))
(EVAL (\GR.METHODEXPANDER NAME (QUOTE INIT)))
(QUOTE DEFINED]
NAME])
(\GR.DELDEFFN
[LAMBDA (NAME TYPE) (* rmk: "15-Jun-84 11:23")
(if (NOT (AND NAME (LITATOM NAME)))
then (ERRORX (LIST 14 NAME)))
(PROG ((DEF (ASSOC NAME GLOBAL.RESOURCES)))
(if DEF
then (MARKASCHANGED NAME (QUOTE RESOURCES)
(QUOTE DELETED))
(/SETTOPVAL (QUOTE GLOBAL.RESOURCES)
(REMOVE DEF GLOBAL.RESOURCES))
(if (NULL (LISTGET (CDR DEF)
(QUOTE GET)))
then (* Help clean up mess left by the default case)
(/SETTOPVAL (PACK* (QUOTE \)
NAME
(QUOTE .GLOBALRESOURCE))
(QUOTE NOBIND)))
(RETURN T])
(\GR.CONTENTS
[LAMBDA (COM NAME TYPE) (* rmk: "14-Jun-84 22:29")
(COND
((EQ TYPE (QUOTE RESOURCES))
[SETQ COM (COND
((EQ (CAR (LISTP (CDR COM)))
(QUOTE *))
(EVAL (CADDR COM)))
(T (CDR COM]
(COND
((EQ NAME T)
(AND COM T))
((AND NAME (LITATOM NAME))
(AND [find X in COM suchthat (EQ NAME (COND
((LISTP X)
(CAR X))
(T X]
T))
(T (MAPCAR COM (FUNCTION (LAMBDA (X)
(COND
((LISTP X)
(CAR X))
(T X])
(\GR.GvarInitLst
[LAMBDA (NAME) (* JonL "21-Oct-84 15:50")
(BQUOTE (/SETTOPVAL (QUOTE , (MKATOM (CONCAT "\RESOURCE." NAME ".LST")))
(LIST NIL])
)
(DEFINEQ
(\GR.MAKEPRETTYCOMSL
[NLAMBDA L (* rmk: "14-Jun-84 22:31")
[COND
((EQ (CAR (LISTP L))
(QUOTE *))
(SETQ L (EVAL (CADR L]
(for Y NAME DEF in L
collect [COND
[(LISTP Y)
(SETQ NAME (CAR Y))
(SETQ DEF (CAR (LISTP (CDR Y]
(T (SETQ NAME Y)
(SETQ DEF (GETDEF NAME (QUOTE RESOURCES]
(OR (AND NAME (LITATOM NAME))
(ERROR "Bad filepkg command" L))
(SUBPAIR (QUOTE (NAME DEF))
(LIST NAME DEF)
(QUOTE (PUTDEF (QUOTE NAME)
(QUOTE RESOURCES)
(QUOTE DEF])
(\IGR.MAKEPRETTYCOMSL
[NLAMBDA L (* JonL "24-Oct-84 18:49")
[if (EQ (CAR (LISTP L))
(QUOTE *))
then (SETQ L (EVAL (CADR L]
(for NAME in L collect (LISPFORM.SIMPLIFY (LIST (QUOTE INITRESOURCE)
NAME)
T])
)
(RPAQ? GLOBAL.RESOURCES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS GLOBAL.RESOURCES)
)
(PUTPROPS INITRESOURCE ARGNAMES ("<RESOURCENAME>" . ARGS))
(PUTPROPS NEWRESOURCE ARGNAMES ("<RESOURCENAME>" . ARGS))
(PUTPROPS GETRESOURCE ARGNAMES ("<RESOURCENAME>" . ARGS))
(PUTPROPS FREERESOURCE ARGNAMES ("<RESOURCENAME>" DATUM . ARGS))
(* "need only be in ABC")
(DECLARE: EVAL@COMPILE
(PUTPROPS GLOBALRESOURCE MACRO (= . WITH-RESOURCES))
(PUTPROPS GLOBALRESOURCES MACRO (= . WITH-RESOURCES))
)
(PUTDEF (QUOTE GLOBALRESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (DECLARE: DONTCOPY
(RESOURCES . X))
(INITRESOURCES . X)))
(TYPE TYPE RESOURCES))))
(DECLARE: EVAL@COMPILE
[PUTPROPS RELEASERESOURCE MACRO (ARGS ([LAMBDA (RVALVAR)
(OR (AND (LITATOM RVALVAR)
RVALVAR
(NEQ T RVALVAR))
(ERROR "Must RELEASERESOURCE from a variable" ARGS]
(CADR ARGS))
(SUBPAIR (QUOTE (RNAME RVALVAR . FORMS))
ARGS
(QUOTE (PROGN (FREERESOURCE RNAME RVALVAR)
(PROG1 (PROGN . FORMS)
(SETQ RVALVAR (GETRESOURCE RNAME]
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA \IGR.MAKEPRETTYCOMSL \GR.MAKEPRETTYCOMSL)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS RESOURCE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1552 3720 (\GR.METHODEXPANDER 1562 . 3005) (\GR.WITHRESOURCEMAC 3007 . 3718)) (4205
7622 (\GR.GETDEFFN 4215 . 4372) (\GR.PUTDEFFN 4374 . 5913) (\GR.DELDEFFN 5915 . 6719) (\GR.CONTENTS
6721 . 7390) (\GR.GvarInitLst 7392 . 7620)) (7623 8725 (\GR.MAKEPRETTYCOMSL 7633 . 8367) (
\IGR.MAKEPRETTYCOMSL 8369 . 8723)))))
STOP