(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "16-May-90 21:31:50" {DSK}local>lde>lispcore>sources>RESOURCE.;2 12730 changes to%: (VARS RESOURCECOMS) previous date%: "11-Aug-87 18:19:35" {DSK}local>lde>lispcore>sources>RESOURCE.;1) (* ; " Copyright (c) 1985, 1986, 1987, 1990 by Venue & 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") (FILEPKGCOMS GLOBALRESOURCES) (MACROS GLOBALRESOURCE 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 'INIT))) (PUTPROPS NEWRESOURCE MACRO (X (\GR.METHODEXPANDER X 'NEW))) (PUTPROPS GETRESOURCE MACRO (X (\GR.METHODEXPANDER X 'GET))) (PUTPROPS FREERESOURCE MACRO (X (\GR.METHODEXPANDER X 'FREE))) (PUTPROPS WITH-RESOURCE MACRO (= . WITH-RESOURCES)) (PUTPROPS WITH-RESOURCES MACRO (X (\GR.WITHRESOURCEMAC X))) ) (DEFINEQ (\GR.METHODEXPANDER [LAMBDA (X METHOD) (* ; "Edited 27-Feb-87 15:54 by jop") (PROG (DEF RVAR (NAME (OR (CAR (LISTP X)) X))) (RETURN (if (NULL (SETQ DEF (LISTGET (SETQ DEF (GETDEF NAME '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* '\ NAME '.GLOBALRESOURCE)) (SELECTQ METHOD (GET `[LET NIL (DECLARE (GLOBALVARS ,RVAR)) (COND (,RVAR (PROG1 ,RVAR (SETQ ,RVAR NIL))) (T (NEWRESOURCE ,NAME]) (FREE `[LET NIL (DECLARE (GLOBALVARS ,RVAR)) (SETQ ,RVAR ,(CADR (LISTP X]) (INIT `(/SETTOPVAL ',RVAR NIL)) (NEW (ERROR "No NEW method for resource" NAME)) (SHOULDNT)) elseif (FNTYP DEF) then (APPLY DEF X) elseif (LISTP DEF) then (SUBPAIR '(RESOURCENAME ARGS) (LIST NAME (CDR (LISTP X))) DEF) else (ERROR (CONCAT "Bad resource " METHOD " method for " NAME) DEF]) (\GR.WITHRESOURCEMAC [LAMBDA (X) (* ; "Edited 11-Aug-87 18:18 by Snow") (PROG [(NAMES (MKLIST (CAR X))) (FORMS (\DECL.COMNT.PROCESS (CDR X] (* ;; "Forms is a list of the form (decls comments . body)") (* ;; "This should probably expand into UNWIND-PROTECT instead of PROG1. Cf AR 8944") (RETURN `([,'LAMBDA ,NAMES ,@(CAR FORMS) ,@(CADR FORMS) (PROG1 (PROGN ,@(CDDR FORMS)) ,@(for NAME in NAMES collect `(FREERESOURCE ,NAME ,NAME] ,@(for NAME in NAMES collect `(GETRESOURCE ,NAME]) ) (PUTDEF (QUOTE RESOURCES) (QUOTE FILEPKGCOMS) '((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) '((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) (* ; "Edited 4-Aug-87 12:25 by amd") (if (OR (NULL NAME) (NOT (LITATOM NAME))) then (ERRORX (LIST 14 NAME))) (if [AND (LISTP DEF) (NOT (LISTGET DEF 'NEW] then (* ;; "Conversion from old format -- to be flushed soon after CAROL release. Jonl 5/14/84") (SETQ DEF (LIST 'NEW DEF)) elseif [AND DEF (NOT (LISTGET (LISTP DEF) '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 '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 'INIT)) (AND (EQUAL DEF (CDR TYPE)) (RETURN)) (/RPLACD TYPE DEF) 'CHANGED else (/SETTOPVAL 'GLOBAL.RESOURCES (CONS (CONS NAME DEF) GLOBAL.RESOURCES)) (EVAL (\GR.METHODEXPANDER NAME 'INIT)) '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 'RESOURCES 'DELETED) (/SETTOPVAL 'GLOBAL.RESOURCES (REMOVE DEF GLOBAL.RESOURCES)) (if (NULL (LISTGET (CDR DEF) 'GET)) then (* Help clean up mess left by the  default case) (/SETTOPVAL (PACK* '\ NAME '.GLOBALRESOURCE) 'NOBIND)) (RETURN T]) (\GR.CONTENTS [LAMBDA (COM NAME TYPE) (* rmk%: "14-Jun-84 22:29") (COND ((EQ TYPE 'RESOURCES) [SETQ COM (COND ((EQ (CAR (LISTP (CDR COM))) '*) (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) (* ; "Edited 4-Aug-87 12:28 by amd") `(/SETTOPVAL ',(MKATOM (CONCAT "\RESOURCE." NAME ".LST")) (LIST NIL]) ) (DEFINEQ (\GR.MAKEPRETTYCOMSL [NLAMBDA L (* ; "Edited 4-Aug-87 12:29 by amd") [COND ((EQ (CAR (LISTP L)) '*) (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 'RESOURCES] (OR (AND NAME (LITATOM NAME)) (ERROR "Bad filepkg command" L)) `(PUTDEF ',NAME 'RESOURCES ',DEF]) (\IGR.MAKEPRETTYCOMSL [NLAMBDA L (* JonL "24-Oct-84 18:49") [if (EQ (CAR (LISTP L)) '*) then (SETQ L (EVAL (CADR L] (for NAME in L collect (LISPFORM.SIMPLIFY (LIST 'INITRESOURCE NAME) T]) ) (RPAQ? GLOBAL.RESOURCES ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS GLOBAL.RESOURCES) ) (PUTPROPS INITRESOURCE ARGNAMES (NIL ("" . ARGS))) (PUTPROPS NEWRESOURCE ARGNAMES (NIL ("" . ARGS))) (PUTPROPS GETRESOURCE ARGNAMES (NIL ("" . ARGS))) (PUTPROPS FREERESOURCE ARGNAMES (NIL ("" DATUM . ARGS))) (* "need only be in ABC") (PUTDEF (QUOTE GLOBALRESOURCES) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: DONTCOPY (RESOURCES . X) ) (INITRESOURCES . X]) (DECLARE%: EVAL@COMPILE (PUTPROPS GLOBALRESOURCE MACRO (= . WITH-RESOURCES)) (PUTPROPS GLOBALRESOURCES MACRO (= . WITH-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 '(RNAME RVALVAR . FORMS) ARGS '(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 ("Venue & Xerox Corporation" 1985 1986 1987 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2218 4617 (\GR.METHODEXPANDER 2228 . 3890) (\GR.WITHRESOURCEMAC 3892 . 4615)) (5320 9444 (\GR.GETDEFFN 5330 . 5484) (\GR.PUTDEFFN 5486 . 7441) (\GR.DELDEFFN 7443 . 8284) (\GR.CONTENTS 8286 . 9238) (\GR.GvarInitLst 9240 . 9442)) (9445 10551 (\GR.MAKEPRETTYCOMSL 9455 . 10216) ( \IGR.MAKEPRETTYCOMSL 10218 . 10549))))) STOP