From 975610b80373f08d1f4fd771571e673f1e134d6d Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Fri, 12 Feb 2021 23:04:22 -0800 Subject: [PATCH] Partial cleanup of old versions no longer needed --- greetfiles/MAKEINITGREET | 1 - greetfiles/MAKEINITGREET.LCOM | Bin 3232 -> 0 bytes greetfiles/MAKEINITGREET.LCOM.~27~ | Bin 3232 -> 0 bytes greetfiles/MAKEINITGREET.~1~ | 1 - greetfiles/MAKEINITGREET.~27~ | 1 - greetfiles/MAKEINITGREET.~28~ | 1 - sources/FILEPKG.LCOM.~10~ | Bin 102732 -> 0 bytes sources/FILEPKG.LCOM.~11~ | Bin 103287 -> 0 bytes sources/FILEPKG.LCOM.~12~ | Bin 103331 -> 0 bytes sources/FILEPKG.LCOM.~13~ | Bin 103352 -> 0 bytes sources/FILEPKG.LCOM.~7~ | Bin 102516 -> 0 bytes sources/FILEPKG.LCOM.~8~ | Bin 102666 -> 0 bytes sources/FILEPKG.LCOM.~9~ | Bin 102722 -> 0 bytes sources/FILEPKG.~10~ | 1 - sources/FILEPKG.~11~ | 1 - sources/FILEPKG.~12~ | 1 - sources/FILEPKG.~4~ | 2 - sources/FILEPKG.~6~ | 13 - sources/FILEPKG.~7~ | 13 - sources/FILEPKG.~8~ | 13 - sources/FILEPKG.~9~ | 13 - sources/LLKEY.LCOM.~1~ | 141 --- sources/LLKEY.LCOM.~4~ | Bin 64460 -> 0 bytes sources/LLKEY.~1~ | 1779 ---------------------------- sources/LLKEY.~4~ | 35 - sources/MAKEINIT.LCOM.~9~ | Bin 12989 -> 0 bytes sources/MAKEINIT.~1~ | 1 - sunloadup/LLPARAMS | 1705 -------------------------- 28 files changed, 3722 deletions(-) delete mode 100644 greetfiles/MAKEINITGREET delete mode 100644 greetfiles/MAKEINITGREET.LCOM delete mode 100644 greetfiles/MAKEINITGREET.LCOM.~27~ delete mode 100644 greetfiles/MAKEINITGREET.~1~ delete mode 100644 greetfiles/MAKEINITGREET.~27~ delete mode 100644 greetfiles/MAKEINITGREET.~28~ delete mode 100644 sources/FILEPKG.LCOM.~10~ delete mode 100644 sources/FILEPKG.LCOM.~11~ delete mode 100644 sources/FILEPKG.LCOM.~12~ delete mode 100644 sources/FILEPKG.LCOM.~13~ delete mode 100644 sources/FILEPKG.LCOM.~7~ delete mode 100644 sources/FILEPKG.LCOM.~8~ delete mode 100644 sources/FILEPKG.LCOM.~9~ delete mode 100644 sources/FILEPKG.~10~ delete mode 100644 sources/FILEPKG.~11~ delete mode 100644 sources/FILEPKG.~12~ delete mode 100644 sources/FILEPKG.~4~ delete mode 100644 sources/FILEPKG.~6~ delete mode 100644 sources/FILEPKG.~7~ delete mode 100644 sources/FILEPKG.~8~ delete mode 100644 sources/FILEPKG.~9~ delete mode 100644 sources/LLKEY.LCOM.~1~ delete mode 100644 sources/LLKEY.LCOM.~4~ delete mode 100644 sources/LLKEY.~1~ delete mode 100644 sources/LLKEY.~4~ delete mode 100644 sources/MAKEINIT.LCOM.~9~ delete mode 100644 sources/MAKEINIT.~1~ delete mode 100644 sunloadup/LLPARAMS diff --git a/greetfiles/MAKEINITGREET b/greetfiles/MAKEINITGREET deleted file mode 100644 index efd13e38..00000000 --- a/greetfiles/MAKEINITGREET +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 5-Dec-2017 15:26:33"  {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;28 5332 changes to%: (FNS MAKEINITGREET) previous date%: "28-Jun-2017 23:52:03" {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;27) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS [(FNS MAKEINITGREET) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKEINITGREET]) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 5-Dec-2017 15:26 by rmk:") (* ;; "Make the INIT.DLINIT starting sysout for a new loadup. Derived from MAKEINIT.CM") (* ;; "IF YOU EDIT THIS FILE, EDIT LOADINITSLOW.CM TOO!!!! ") (* ;; " Edit November 3, 1987 by vanMelle, note comment ") (* ;; " The path given to the Lisp command below should point to the LispCore sysout cache. ") (* ;; " Code that runs after Lisp starts up assures that the cached sysout is the most recent, and if not, fetches a new one and restarts itself. ") (* ;; " Edited so that the most recent patch file is loaded ") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "Delete INIT.DFASL!* INIT.SAVE*, otherwise Lisp might read INIT.LISP!2 Copy INIT.SAVE _ INIT.DFASL ") (* ;; " save away site file to be restored below") (* ;; "Start inside $medleydir/sources medley -greet current/MAKEINITGREET -lisp") (* ;; "") (CNDIR (CONCAT MEDLEYDIR '/sources)) (DRIBBLE '../basics/next/MAKEINIT.DRIB) (XCL:RESTORE-PROFILE "INTERLISP") (DELFILE '../current/INIT.DFASL) (AND (INFILEP 'current/INIT.SAVE) (RENAMEFILE '../current/INIT.SAVE '../current/INIT.DFASL)) (* Make sure we have a valid sysout) (LET [INITIMAGE INITDLFILE (DATE (CAR (NLSETQ (GETFILEINFO '../basics/FULL.SYSOUT 'ICREATIONDATE] [IF [AND NIL DATE (IGREATERP DATE (GETFILEINFO '../basics/Lisp.Sysout 'ICREATIONDATE] THEN (* Get new saved sysout) (NLSETQ (PROGN (COPYFILE '..basics/FULL.SYSOUT '{DSK7}LispCore.Sysout;1) (* ;; "This was to copy all the loadup commands below") (COPYFILE '{DSK}REM.CM;1 '{CORE}REM.CM) (* Repeat current command now) (OUTFILE '{DSK}REM.CM;1) (PRIN1 '@LoadInit.cm@) (COPYBYTES (OPENSTREAM '{CORE}REM.CM 'INPUT)) (CLOSEF) (LOGOUT T] (PROGN (* Make old sysout work with new  read tables) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM FILERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM CODERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM \ORIGREADTABLE)) (* (LOAD (QUOTE LOAD-LISPCORE-PATCH))) (* ; "Doesn't exist") (SETQ DIRECTORIES '(../sources ../library ../internal/library)) (SETQ LITATOM-PACKAGE-CONVERSION-ENABLED NIL) (SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* Get new exports since last loadup) (LOAD 'CONDITION-PACKAGE.LCOM 'SYSLOAD) (LOAD 'XCL-PACKAGE.LCOM 'SYSLOAD) (* FILESETS has where to get things  from) (LOAD 'FILESETS) (FILESLOAD RENAMEFNS MAKEINIT DLFIXINIT CMLARRAY-SUPPORT VMEM) (* ; "rmk: VMEM has WORDARRAY") (* Versions are Lisp Microcode Bcpl) (IDLE.SET.OPTION 'TIMEOUT 0) (IDLE.SET.OPTION 'SAVEVM 0) (PRINTOUT T T T "Starting DORENAME" T T) (DORENAME 'I) (PRINTOUT T T T T "DORENAME finished, starting MAKEINIT" T) [SETQ INITIMAGE (MAKEINIT '(39424 5682 11008) NIL '../basics/next/INIT.SYSOUT '(../sources/ ../internal/library/ ../library/] (PRINTOUT T T T T "MAKEINIT finished, starting DLFIXINIT" T) (SETQ INITDLFILE (DLFIXINIT INITIMAGE '../basics/next/INIT.DLINIT '../sunloadup/LispDlion.db 300)) (PRINTOUT T T "Initial sysout saved to " INITDLFILE T) (COPYFILE '../sunloadup/XREM-NOETHER.CM (CONCAT '{DSK}/Users/ (USERNAME) '/REM.CM)) (DRIBBLE) (* ; "Why logout? (LOGOUT T)") INITDLFILE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (MAKEINITGREET) ) (PUTPROPS MAKEINITGREET COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (503 5211 (MAKEINITGREET 513 . 5209))))) STOP \ No newline at end of file diff --git a/greetfiles/MAKEINITGREET.LCOM b/greetfiles/MAKEINITGREET.LCOM deleted file mode 100644 index 4ba1a61114c13677dfb988a63780c2651e747af3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3232 zcmbtW+iu%N5Vez{cNK9^6opZwQvn4eBb3PHMWk97p~aQWhPNy!*#_F8vdqRT6v+^! zAVJY@=}+`M|I?>_LT8s0CE0EfAbOy7XV1*eeW&5jz8g@f?|M{ngMJ8)7`2_mKJqBk z-5{aNbK|HEk0QJG)IQ!KHfs&e*F%nkI#35)a?-IxWTgX&-X%s?RqN2Gk7qBgvq^dh zvnhgVzdP~MKfWK%Cd(ITei)_md^R0T4kxoQeqW@Qlk~OP(htYW`8=I24t@J6bptm! zW|Sta?}*t%A(muc&+#T%2F2{kN>?RyxR|HaRkifh^*sN!3tQ}vp$5LV0`LxqY}SMR zax#JVbv|1z05mC>z2t&bXti2(xEw7|@%kp6sCZjfGwW|>|GSzCHCa3HljNy1!_jj7LEtlFD0|mN{S!+a~ zKHzvc#7W@AGI^&hfZ>G(ZwESwCn|6dv9L#}gMNsq02UtF^aDDl13pEO=Z?#8 zXWnA#qg@A#`r(ila9OWXFZ6vHBq+8Iiv0f?B0_;)=uqY)M;>P&@MFkaEVxxCK$;4u z0qrGtKw}Qlz;hEj34N(-4R~oVq%7uspaJh7P7`+j{@}x%ozu_O@%yL>r&!JS_6ALW z1?^9DYin~c>ikr)#bR5w7yrYZfx&T|2L7M0$40FfqGN^i7PUJS&@np!6BgA4FAa| zBwYzMvHX?>(6)G6l`g_=D~oL1u6U{%n`HzOHwlpaF~0<9}vyt zi4~oT0@6ALZUU@&&O(>7u*XqpE2A1I)y#%e{h>KNY@UX5qGEJ3x* z)q!d$C0gxR6|qCArJ+|#-K-iXsA{L8tMW>OvX+a5QL3iOl^O&uc0z_Jj@lEmLKC#M zM3c_S5MoqX5WUiZXco9w)h%p!tuW%P1BhzgrjZVC=fz%VJ3!F>Vj-6c#UceoF*HC~ z@p+KgXIPuo=1$!@lS$ekN2t;zeLMC5)A8m3 zw;iwux6p#9DYw9mkV3>k`IZW=uV#W4uYE9}jpNjOoaPvREM^&J$!WI8Mia=3K`S4< z#JOrQ!_i7LbsWmdDGz?lrdfWKUOt9=F`6&3>GO5XBUV?T!Skh%-sbvc(?vSR39>!O zF6N{8Ye8JCn>A3;#SPWc(3QG@p-~iB#vxM0eZ8vVJFZ=+R0m?1P>(Bh%GyUdLCIy= zYz$;;g`wwrHe>d=6c3^(WC;v?>Z4AIVQt#M%_ud#%c3S&GBmLCC}Sam)<)RNfdkD^ zHs^J8dxY~>a*nylJ8H6B^GJ;m!Xo?Gv)d=oxNE*_IJAexP#i6t5C;t$)SifXa6;bW q0mr|_%4MRlH2JS~gNAwy5=__LT8s0CE0EfAbOy7XV1*eeW&5jz8g@f?|M{ngMJ8)7`2_mKJqBk z-5{aNbK|HEk0QJG)IQ!KHfs&e*F%nkI#35)a?-IxWTgX&-X%s?RqN2Gk7qBgvq^dh zvnhgVzdP~MKfWK%Cd(ITei)_md^R0T4kxoQeqW@Qlk~OP(htYW`8=I24t@J6bptm! zW|Sta?}*t%A(muc&+#T%2F2{kN>?RyxR|HaRkifh^*sN!3tQ}vp$5LV0`LxqY}SMR zax#JVbv|1z05mC>z2t&bXti2(xEw7|@%kp6sCZjfGwW|>|GSzCHCa3HljNy1!_jj7LEtlFD0|mN{S!+a~ zKHzvc#7W@AGI^&hfZ>G(ZwESwCn|6dv9L#}gMNsq02UtF^aDDl13pEO=Z?#8 zXWnA#qg@A#`r(ila9OWXFZ6vHBq+8Iiv0f?B0_;)=uqY)M;>P&@MFkaEVxxCK$;4u z0qrGtKw}Qlz;hEj34N(-4R~oVq%7uspaJh7P7`+j{@}x%ozu_O@%yL>r&!JS_6ALW z1?^9DYin~c>ikr)#bR5w7yrYZfx&T|2L7M0$40FfqGN^i7PUJS&@np!6BgA4FAa| zBwYzMvHX?>(6)G6l`g_=D~oL1u6U{%n`HzOHwlpaF~0<9}vyt zi4~oT0@6ALZUU@&&O(>7u*XqpE2A1I)y#%e{h>KNY@UX5qGEJ3x* z)q!d$C0gxR6|qCArJ+|#-K-iXsA{L8tMW>OvX+a5QL3iOl^O&uc0z_Jj@lEmLKC#M zM3c_S5MoqX5WUiZXco9w)h%p!tuW%P1BhzgrjZVC=fz%VJ3!F>Vj-6c#UceoF*HC~ z@p+KgXIPuo=1$!@lS$ekN2t;zeLMC5)A8m3 zw;iwux6p#9DYw9mkV3>k`IZW=uV#W4uYE9}jpNjOoaPvREM^&J$!WI8Mia=3K`S4< z#JOrQ!_i7LbsWmdDGz?lrdfWKUOt9=F`6&3>GO5XBUV?T!Skh%-sbvc(?vSR39>!O zF6N{8Ye8JCn>A3;#SPWc(3QG@p-~iB#vxM0eZ8vVJFZ=+R0m?1P>(Bh%GyUdLCIy= zYz$;;g`wwrHe>d=6c3^(WC;v?>Z4AIVQt#M%_ud#%c3S&GBmLCC}Sam)<)RNfdkD^ zHs^J8dxY~>a*nylJ8H6B^GJ;m!Xo?Gv)d=oxNE*_IJAexP#i6t5C;t$)SifXa6;bW q0mr|_%4MRlH2JS~gNAwy5=_Personal>local>medley3.5>current>MAKEINITGREET.;1 4254 changes to%: (VARS MAKEINITGREETCOMS) (FNS MAKEINITGREET)) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS ((FNS MAKEINITGREET))) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 24-Jun-2017 19:26 by rmk:") (( (* ;; "Make the INIT.DLINIT starting sysout for a new loadup. Derived from MAKEINIT.CM") (* ;; "IF YOU EDIT THIS FILE, EDIT LOADINITSLOW.CM TOO!!!! ") (* ;; " Edit November 3, 1987 by vanMelle, note comment ") (* ;; " The path given to the Lisp command below should point to the LispCore sysout cache. ") (* ;; " Code that runs after Lisp starts up assures that the cached sysout is the most recent, and if not, fetches a new one and restarts itself. ") (* ;; " Edited so that the most recent patch file is loaded ") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "Delete INIT.DFASL!* INIT.SAVE*, otherwise Lisp might read INIT.LISP!2 Copy INIT.SAVE _ INIT.DFASL ") (* ;; " save away site file to be restored below") ) (* ;; "Start inside $medleydir medley -greet current/MAKEINITGREET -lisp") (* ;; "") (XCL:RESTORE-PROFILE "INTERLISP") (DELFILE 'current/INIT.DFASL) (AND (INFILEP 'current/INIT.SAVE) (RENAMEFILE 'current/INIT.SAVE current/INIT.DFASL)) (DIRECTORY 'current/INIT.DLINIT;* '(DELETE)) (* Make sure we have a valid sysout) [LET [(DATE (CAR (NLSETQ (GETFILEINFO basics/FULL.SYSOUT 'ICREATIONDATE] (IF [AND NIL DATE (IGREATERP DATE (GETFILEINFO 'basics/Lisp.Sysout 'ICREATIONDATE] THEN (* Get new saved sysout) (NLSETQ (PROGN (COPYFILE 'basics/FULL.SYSOUT '{DSK7}LispCore.Sysout;1) (COPYFILE '{DSK}REM.CM;1 '{CORE}REM.CM) (* Repeat current command now) (OUTFILE '{DSK}REM.CM;1) (PRIN1 '@LoadInit.cm@) (COPYBYTES (OPENSTREAM '{CORE}REM.CM 'INPUT)) (CLOSEF) (LOGOUT T] (PROGN (* Make old sysout work with new  read tables) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM FILERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM CODERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM \ORIGREADTABLE)) (* (LOAD (QUOTE LOAD-LISPCORE-PATCH))) (* ; "Doesn't exist") (SETQ DIRECTORIES '(sources/ /library internal/library)) (SETQ LITATOM-PACKAGE-CONVERSION-ENABLED NIL) (SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* Get new exports since last loadup) (LOAD 'CONDITION-PACKAGE.LCOM 'SYSLOAD) (LOAD 'XCL-PACKAGE.LCOM 'SYSLOAD) (* FILESETS has where to get things  from) (LOAD 'FILESETS) (FILESLOAD RENAMEFNS MAKEINIT DLFIXINIT CMLARRAY-SUPPORT) (* Versions are Lisp Microcode Bcpl) (PROGN (CNDIR '{CORE}) (* ; "CNDIR doesn't know about {CORE}") (IDLE.SET.OPTION 'TIMEOUT 0) (IDLE.SET.OPTION 'SAVEVM 0) (DORENAME 'I) (DLFIXINIT (MAKEINIT '(39424 5682 11008) NIL NIL '(sources/ /internal/library/ library/) 'INIT.DLINIT LispDLion.db 300) (LOGOUT T))) NIL]) ) (PUTPROPS MAKEINITGREET COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (355 4189 (MAKEINITGREET 365 . 4187))))) STOP \ No newline at end of file diff --git a/greetfiles/MAKEINITGREET.~27~ b/greetfiles/MAKEINITGREET.~27~ deleted file mode 100644 index aad40f96..00000000 --- a/greetfiles/MAKEINITGREET.~27~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "28-Jun-2017 23:52:03"  {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;27 5323 changes to%: (FNS MAKEINITGREET) previous date%: "28-Jun-2017 23:51:37" {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;26) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS [(FNS MAKEINITGREET) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKEINITGREET]) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 28-Jun-2017 23:52 by rmk:") (* ;; "Make the INIT.DLINIT starting sysout for a new loadup. Derived from MAKEINIT.CM") (* ;; "IF YOU EDIT THIS FILE, EDIT LOADINITSLOW.CM TOO!!!! ") (* ;; " Edit November 3, 1987 by vanMelle, note comment ") (* ;; " The path given to the Lisp command below should point to the LispCore sysout cache. ") (* ;; " Code that runs after Lisp starts up assures that the cached sysout is the most recent, and if not, fetches a new one and restarts itself. ") (* ;; " Edited so that the most recent patch file is loaded ") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "Delete INIT.DFASL!* INIT.SAVE*, otherwise Lisp might read INIT.LISP!2 Copy INIT.SAVE _ INIT.DFASL ") (* ;; " save away site file to be restored below") (* ;; "Start inside $medleydir/sources medley -greet current/MAKEINITGREET -lisp") (* ;; "") (CNDIR (CONCAT MEDLEYDIR '/sources)) (DRIBBLE '../basics/next/MAKEINIT.DRIB) (XCL:RESTORE-PROFILE "INTERLISP") (DELFILE '../current/INIT.DFASL) (AND (INFILEP 'current/INIT.SAVE) (RENAMEFILE '../current/INIT.SAVE '../current/INIT.DFASL)) (* Make sure we have a valid sysout) (LET [INITIMAGE INITDLFILE (DATE (CAR (NLSETQ (GETFILEINFO '../basics/FULL.SYSOUT 'ICREATIONDATE] [IF [AND NIL DATE (IGREATERP DATE (GETFILEINFO '../basics/Lisp.Sysout 'ICREATIONDATE] THEN (* Get new saved sysout) (NLSETQ (PROGN (COPYFILE '..basics/FULL.SYSOUT '{DSK7}LispCore.Sysout;1) (* ;; "This was to copy all the loadup commands below") (COPYFILE '{DSK}REM.CM;1 '{CORE}REM.CM) (* Repeat current command now) (OUTFILE '{DSK}REM.CM;1) (PRIN1 '@LoadInit.cm@) (COPYBYTES (OPENSTREAM '{CORE}REM.CM 'INPUT)) (CLOSEF) (LOGOUT T] (PROGN (* Make old sysout work with new  read tables) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM FILERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM CODERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM \ORIGREADTABLE)) (* (LOAD (QUOTE LOAD-LISPCORE-PATCH))) (* ; "Doesn't exist") (SETQ DIRECTORIES '(../sources ../library ../internal/library)) (SETQ LITATOM-PACKAGE-CONVERSION-ENABLED NIL) (SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* Get new exports since last loadup) (LOAD 'CONDITION-PACKAGE.LCOM 'SYSLOAD) (LOAD 'XCL-PACKAGE.LCOM 'SYSLOAD) (* FILESETS has where to get things  from) (LOAD 'FILESETS) (FILESLOAD RENAMEFNS MAKEINIT DLFIXINIT CMLARRAY-SUPPORT VMEM) (* ; "rmk: VMEM has WORDARRAY") (* Versions are Lisp Microcode Bcpl) (IDLE.SET.OPTION 'TIMEOUT 0) (IDLE.SET.OPTION 'SAVEVM 0) (PRINTOUT T T T "Starting DORENAME" T T) (DORENAME 'I) (PRINTOUT T T T T "DORENAME finished, starting MAKEINIT" T) [SETQ INITIMAGE (MAKEINIT '(39424 5682 11008) NIL '{CORE}INIT.SYSOUT '(../sources/ ../internal/library/ ../library/] (PRINTOUT T T T T "MAKEINIT finished, starting DLFIXINIT" T) (SETQ INITDLFILE (DLFIXINIT INITIMAGE '../basics/next/INIT.DLINIT '../sunloadup/LispDlion.db 300)) (PRINTOUT T T "Initial sysout saved to " INITDLFILE T) (COPYFILE '../sunloadup/XREM-NOETHER.CM (CONCAT '{DSK}/Users/ (USERNAME) '/REM.CM)) (DRIBBLE) (* ; "Why logout? (LOGOUT T)") INITDLFILE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (MAKEINITGREET) ) (PUTPROPS MAKEINITGREET COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (503 5202 (MAKEINITGREET 513 . 5200))))) STOP \ No newline at end of file diff --git a/greetfiles/MAKEINITGREET.~28~ b/greetfiles/MAKEINITGREET.~28~ deleted file mode 100644 index efd13e38..00000000 --- a/greetfiles/MAKEINITGREET.~28~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 5-Dec-2017 15:26:33"  {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;28 5332 changes to%: (FNS MAKEINITGREET) previous date%: "28-Jun-2017 23:52:03" {DSK}Personal>local>medley3.5>current>MAKEINITGREET.;27) (PRETTYCOMPRINT MAKEINITGREETCOMS) (RPAQQ MAKEINITGREETCOMS [(FNS MAKEINITGREET) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKEINITGREET]) (DEFINEQ (MAKEINITGREET [LAMBDA NIL (* ; "Edited 5-Dec-2017 15:26 by rmk:") (* ;; "Make the INIT.DLINIT starting sysout for a new loadup. Derived from MAKEINIT.CM") (* ;; "IF YOU EDIT THIS FILE, EDIT LOADINITSLOW.CM TOO!!!! ") (* ;; " Edit November 3, 1987 by vanMelle, note comment ") (* ;; " The path given to the Lisp command below should point to the LispCore sysout cache. ") (* ;; " Code that runs after Lisp starts up assures that the cached sysout is the most recent, and if not, fetches a new one and restarts itself. ") (* ;; " Edited so that the most recent patch file is loaded ") (* ;; " Updated Lisp version for big physical memory --bvm |11/3/87") (* ;; "Delete INIT.DFASL!* INIT.SAVE*, otherwise Lisp might read INIT.LISP!2 Copy INIT.SAVE _ INIT.DFASL ") (* ;; " save away site file to be restored below") (* ;; "Start inside $medleydir/sources medley -greet current/MAKEINITGREET -lisp") (* ;; "") (CNDIR (CONCAT MEDLEYDIR '/sources)) (DRIBBLE '../basics/next/MAKEINIT.DRIB) (XCL:RESTORE-PROFILE "INTERLISP") (DELFILE '../current/INIT.DFASL) (AND (INFILEP 'current/INIT.SAVE) (RENAMEFILE '../current/INIT.SAVE '../current/INIT.DFASL)) (* Make sure we have a valid sysout) (LET [INITIMAGE INITDLFILE (DATE (CAR (NLSETQ (GETFILEINFO '../basics/FULL.SYSOUT 'ICREATIONDATE] [IF [AND NIL DATE (IGREATERP DATE (GETFILEINFO '../basics/Lisp.Sysout 'ICREATIONDATE] THEN (* Get new saved sysout) (NLSETQ (PROGN (COPYFILE '..basics/FULL.SYSOUT '{DSK7}LispCore.Sysout;1) (* ;; "This was to copy all the loadup commands below") (COPYFILE '{DSK}REM.CM;1 '{CORE}REM.CM) (* Repeat current command now) (OUTFILE '{DSK}REM.CM;1) (PRIN1 '@LoadInit.cm@) (COPYBYTES (OPENSTREAM '{CORE}REM.CM 'INPUT)) (CLOSEF) (LOGOUT T] (PROGN (* Make old sysout work with new  read tables) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM FILERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM CODERDTBL) (SETSYNTAX (CHARCODE ^^) 'PACKAGEDELIM \ORIGREADTABLE)) (* (LOAD (QUOTE LOAD-LISPCORE-PATCH))) (* ; "Doesn't exist") (SETQ DIRECTORIES '(../sources ../library ../internal/library)) (SETQ LITATOM-PACKAGE-CONVERSION-ENABLED NIL) (SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* Get new exports since last loadup) (LOAD 'CONDITION-PACKAGE.LCOM 'SYSLOAD) (LOAD 'XCL-PACKAGE.LCOM 'SYSLOAD) (* FILESETS has where to get things  from) (LOAD 'FILESETS) (FILESLOAD RENAMEFNS MAKEINIT DLFIXINIT CMLARRAY-SUPPORT VMEM) (* ; "rmk: VMEM has WORDARRAY") (* Versions are Lisp Microcode Bcpl) (IDLE.SET.OPTION 'TIMEOUT 0) (IDLE.SET.OPTION 'SAVEVM 0) (PRINTOUT T T T "Starting DORENAME" T T) (DORENAME 'I) (PRINTOUT T T T T "DORENAME finished, starting MAKEINIT" T) [SETQ INITIMAGE (MAKEINIT '(39424 5682 11008) NIL '../basics/next/INIT.SYSOUT '(../sources/ ../internal/library/ ../library/] (PRINTOUT T T T T "MAKEINIT finished, starting DLFIXINIT" T) (SETQ INITDLFILE (DLFIXINIT INITIMAGE '../basics/next/INIT.DLINIT '../sunloadup/LispDlion.db 300)) (PRINTOUT T T "Initial sysout saved to " INITDLFILE T) (COPYFILE '../sunloadup/XREM-NOETHER.CM (CONCAT '{DSK}/Users/ (USERNAME) '/REM.CM)) (DRIBBLE) (* ; "Why logout? (LOGOUT T)") INITDLFILE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (MAKEINITGREET) ) (PUTPROPS MAKEINITGREET COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (503 5211 (MAKEINITGREET 513 . 5209))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.LCOM.~10~ b/sources/FILEPKG.LCOM.~10~ deleted file mode 100644 index 5a12cc746473d2109eefbbfcfccf8098444c8702..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 102732 zcmdqKdw5&dbtj5*KufY?(I7?BGEK|Jw5^D8C=uXWNo^d0lmHL}Xpj_0S++t7w82=G zTuE-?PIGJL(WFT_ZS2^Vo!CyD*tL_`IRuD1*2BSc+L?Q2Iy32=PA7d$A4w*??VV0> zlgzaD`);HATWjro9w4Z=X}|l&=(CA)_St8j{aAaw*V=m~CJ&~vlYIwMnaRFX_F&H1 zm7laH=Irszq}7wk&Q0bsso9wxYuAjOn6eKA3VXNjq4yGaV{UT7>aj-q>_;E$i}lC) zt?0;sfq?@9u^wwr&+$_aKeBparD&ZxiAvl5$;9l`hu=4UX65vmyB=D4&&S~Paj`7a~FMQX6n$s_m1_ViLpNWk<<82 zKfW`1pg+prSw6kuerWsg($dKXSI*pVz?z&$%_ZziW->o(t>XLB{1FRZu?{|Z;)FH( z7`}1V^7nn;zI{Dbap^32930aSK6GFx*7FVq9__LIVdJ#6$3_Q6qESl?#X5TmquFyX zJL?}(ul303m7iHX_2?PyFlzKzBYo3LG&{5kg9l=R2cl#D&{-et-A?m(FrS;Im9R1M zQTh|3KLgf*iP7zQW~`_+n>uh{Z^E8SB>VD{bMyIZAHA~Inz8!j*~I+x^kUz^T)vNM z?X?bCF$*w=-vKLYPfy}v(3)GEp^G7YC!3j_oV%y*u$`Hw!eNVgfQu2ChurjRuNAt( z++v1S<87ufJC{HAU`92m3?WOMmxJ7Yx$ zte-;3W+T;uluqrHULDNXhiG(z*4~+XE-^VdfpN`F&QjUH#@^4U!TzLEHLPc5M9xW^Iz^MmGg$4| zSk`8kQmy`Up?$Sp-kA=shd;6w`lsna=QZ>u-#uQ4RC>9gRW7U@zM7tyrh)ZQMGvXp zLTe$?bv#llw5}H4MYU@F7uzD?_fuhEXIER>RT*xko%>l|4^Op!)n9j&pVmt4So#ik z>H7yQLT3w@g_(THijIxQJ#Mm5;H*KOrp>@SIy4ZdJ{a|GW0+F)bQY*`a@LAQhrGvV z9Q$N;(#|K6GuRq)iv;7D**R-$*k5a8$U5rZY5Oy|+*B%S4aTfPlXJ9DV)_cO8jB8l z;5*vyT@T0nz~=`|YbeT)GJqQPVPI`QLSjCjpUlpoLCi?h>Um&^uyqfx$B5N)U_0<_ zztyu+Ts^yb@?7Xlj4kG~g;aK; z4}F}QOw7^7!A9gK!7a8CVyUX2oB*_=v|qNzj5R9AVg^`)_sI-!3L}@4Mo0-@v+Vo~ zp`>YSTkMQMy^}y7fN6MB4ZFC8Y6#}>ZKl!2%|x}vtXww3%S=rG87mq_-v`PvO08Q% z2E%i4wf?jK`V9=;)|(8lg`QGZ7r@u56?Rp(a?LioC0V^W)qZ>zZ>^^ayNlr`*FqmH zpJv#19t(ddd8zcVq;V-}zQu36lqvE~;G6EsSdA~d&7GldtZu(5gnzP?Udj}@`ARlm z>G9RdFJ&&Kt5;8zx{jQ8o|xKwVeRtIagAbO4{vGSj^S!cDPr7L9EjJ;J=6T0A4;ol zv_-ZQcD1!_%e7Xo-mxQN9(8^@{A#ZCSfp0^WUke~Z?4rm)>@M{>z^-luhw5JbeE2I z*FKYrNGbQIt?imzd$@Yl4(ES0j&)@D8djow&!*Va@dh;H;=VDzY_wY zAKPSaTLZCSYkG2ed@^qh^b2`OfU3~ujNuXX9e@*11!R$*oX#Ddw4%fPRwidp5TXFU z^jr4q)ch>oj{?EubGbQMY65YhFav-+kVOTffxS4;FL>FCjR^jZ4MeSMDwDy7mgWTZ2LL)Idr9Q=)rS`&rTbiq!|p$DjpuPf9-xP*I}ojsU2WDUyjcxZs) z1smO$dGS}`iSh~_C^YnlDbKAZlypW{getgTJ1vGvHZo*ULzE`ilK^E99yK#5ZL8K=ReyB zo@=*nF+lJKgk*CM1lwSpt)tV2K?<b z#ESJ>^spCrR<0PLtm2n?!{;rf&v&Q40I9NK{B0i%Uj%J6ppew5xeZ zHtW_EmZz6UjemK}e{+oy3b%dn>bO7_1It4BCM?Z~aPqp=h4t$S!VvM3WW=54*Yv9F zrB%^z*#Sn4ArhROc_xm#$4$M;`h|V;g8N3N>3=1TS4`sxv+<>`sFz;``Kpa$35lYa z?Qyr6yXaes`qQE3Z6n1H)wxi_JD)af(?|;JEYvGMn@X-SJTSAm8nKPI*|}h@A5Z$~ z9jRCH$utk!KLx81J&uBcDe8*xiMTMO&P_$*ZF`zudsh9{rtb|`w_#6y4d(c23HX%=ZczwIcz>?7{*_#7c>Tp}uC;sp zT-@aGFPN3jBn=xA_6vB4D;L9GDt@-q#qaZ<;P9w9kk?4HeU;gUH}IZ(3lunVteq%u z#K3PZVxr=BPMB)0Qm_2$lJi??2$db`!UdHMJ(Bf8T(zku(|h#3hDYw(*Sl}u=wdU0 zg{$=|p*)-c%T%^!kHZ~ky#VDpDVqk}Hp9|GsFX)8lu$EWT5ls%hB+SxyXb9M?$#MoFv=VGHHZp*QehN+VVQ*)EkAd29@As&EcTQM*&fv)=N zf%O2w6ntord=x;I(9ihq!6*gi3e1Dzu7LiAF;d2*!x(2Oo0^jwphvmDpeGkFg|oA% z97Nq=vn zN*!cQYY;pdUkm{ElZ-vkKVpq%a*3%~Oz@z*850W+AhM8?ifLYbqxQtA9#V`)ldk^ycrMz?p+wfw2ThRnqVT`CBX!5oG{;q zJOV58MGUgy($X!&?FeqGTt8m^Df<&eBW%Qf_+_B~zbTdb+Tvl`=_wlb#(!Ap8h>^w z{JAMSeWPf+m8xz{LS}j*x%)io{z*Dw6R)OZjo$5G^ob9%Cnn}{v~6ea_Vj9+d;UpP zYRtcpPK_a)bZR~s1b{a`2?lhR8CLq9{H*YjHRhWkb8h4HLw8BG$c;nffxaM_D~Q%C zHlkGxJgdz{FhFA&q(4Ld(6P|oamS-BfJ}j5ub?DU;~rt@ftYPqK{#g|Z<)ILAp|~`ePwKtK=LY@Ma>;p}jfabez90EZqdx-Utq8e&Y zU}A#+$psadO*Dy{t4%g)KuLdl#jcPpcRo7-z0WijDB2PZ86{SLv_(R^2yDAqChCAYPL>vV29)>->Nsq5IzTCSry zFO_!UE5|xS-sOI?0;825@)YqOMmway*pchxNA>b;Ig#7=mS@+IA?0?;-5c^!uB&=o zZl{^+40Cs&1F!6PM-%j3zXH9mORL};*5s0&gN&Yo&`bUou|E3EQjs6XQ=g8J`*nO5 zG=4^*2Y)t0#sz^HUQJYO1|-fckj``ypD7vwF4NMr?_=S=UD)-kY6sstzGp|N*meAN zoBVf)ZCU`Fli}bIU*kwM33r#fGzb+J4Nz|S2N~%K0*pew80CBFGj7 ztqdeLuLYR;+y;Q^nom8@{xBFwO`?aN5? z_2|hWw8z8N$x~;6=Lg9C9#z0V9gJcDvMWocA!qRGZLfO*I|x%BW#k2N*9NG=&|tckw?#3u<4)0 z-5?ZmDEpbE6OXP~t7o{bcm`~wrY<2Bdeq3Xj5J|dFbf+<7l>q2t1Z@QBi9pT5SUda zDho-9R+~vQQ%NGj%w+z=Bv=&n@M@rDl#QsdKOnP^-f}<&n0^x7Vvu3&iSc=|m_zp6 zFjkbp#_7^!<4<-7U5>SQ1V->}>C(l*-s+&x3^A8pVlu%MHz01M)_Kl3qts#|;?>K& zh24%-G>$M5m!>~eG}0xeNkp`Ni2wi0`Ke6#R{6^M4f0L-TUsr=hpQf~5hdL=9j@NI zBlC<{cNG;Tl)X<-wsAjy2NLSB*77}B)vG6KQ=jsE|5zkk9tzSVWnlIfN^hX_YKvY= z7Nu=Frp^1DkHDx@-MSX~a;`(YbHY>?rDBmMNSVuyb*itIyK8Nc?fj^)2j-{ia^2jS z_8rb8?sfgil5=NHSAVkR9F*d6N1^}N&gxdalaG8f*9mT+EfVpXYtQvabMn%9OU`P4 zdF}Et+qTv&r$T!Mp?GPEePK5i>LJ*uS)G_Q06|1k8^YtteogugAv|zIv6RJ}ltw~h zV!*uW3Szpt3Q*7(2}MmT-Z5Z>X5~?k&iNS_F5r?xcGoDBaN|<|byB+zLS-VCgzy$; zX$M51b;+c%av9}~K|2+r(IPce@l0>Df(pWDvoB+OG62%WD^nhZLOTt99B@z}2^d(~ zRWp#;t4Tw^oP$GSF7+6MipsY^{Q?#i2I`4ZA1tk$UV*l0*t%moj1Ty+K!gXZJMII~ z2-vm*FOxCzj(Z_=4thgXm^cQcz{;!`^j4aTVPetZ2s~^^y##N9An8sn2?Q_LOAjW4%|pTI)gPD}`^{?%mME{!X}%x2`nRl#MS zXKPYQaoOX=7gY1FaKqy?6|xPvvtThbyGA-^cZwPrX>4+SCXDm|k5rgec*Qilr8s45 zPBcwlQFN3<=wJz^HtOTbu)ADN2Rlzqr)xClh1ld{T1yyZ>opXFWb;pD!61`4_uFL7 z1%$-OJoN|R^056hQ#jASrVW_SiSQRUyCOAZrCT;@%b^|4zpxcasSMWQJeLb_yqY7B=Fn8)WR&BoZwmq-zV>pUtEG7c%EJ6fbEqqKsyHf z8vGi-xeBlYYH-Wgp4e7s%cR`DtfJ{7W)x_QN7EYfYaB4_swm+FE^sC%ATF^fl#{P^K%ZFGwvfneJ zhwbr1e4<{0F;s2B_UZ@<)?=<^U7OY8go2KU(@nU%BVB}TUGLoT?W>XWX6Ey!YH9Nc z{O|lG^ztx}HEb+BNJ9U?jRgL_S#2c+WA*i`px10i7plwqkBl3xbsUBqGK6Dm`>f;e z`=CN?9dEi1^#`tqA2-ZDnLJ=|aZMiKtG60JkB@9gRAG1a@Y+H-K2h$R-~xa;Go@^l z{$osj;zWxwo{Of2F<~+?t}9mlS;^bzfAEs}uaS zN5(z2QhSH+16Wv1-41uMzW%NaEtmT?HQwK#jrST%bZ^Rc)+Sy}&^L@9_{>1x0+X%H z@5Ud{%g(>lT|3~u@#~wK{*71hjxzl>e$rH*fMFS)UgVKfbsp`#)JnsuvC&VcJ|DZ+v#qgI> z7fK&X85dIK`83z7SH8)=;^6x4q_CU16#D1Rx^X{Ry>xG;{%R)t>{O=vscF;sHCtTM z%KyFOd{IrCyX^P49uJ`>;uxRjZgGpA^wPw$G;Hks?exo7|8cXky2Un1T`>DI0O}6Q z0Lypy{1^W2j0T=3*Z%GS4^HC7cmQr-V27SU@2sdb0xgp74w%??2Zh1@EX)fDvb_5_ z>tWObwgB4%2PCN5y>|xTy%x0n4MKgRE#!kxJj`cdssKam@5KO^Row>ctiC?s4(zgi z2ESTx7rr|PE#BS8sAmzMy_-C3f;|DwaxLa~4y}+H1F+A?AhGy!_ke8<8lFeM*+BRQ zdfaOb69-O22G(bmw8(fogwIaf2}}jsl80dO@!vuNzmIfy; zO_8!rnWYCnIeE4RFxz{r0nC5Erc9Rpz0kXX(|4`OGECAubga&(qb*!RgI4k|)F&~l07AnvTl8z;ORs*OKC9#^a`_~G~l(_h3M zH^qgf7I*$4Q5l0>o9kD)y%%@Ibtylp&2SI+8cs)O!1)WZO3}mxK`ja>(iU&h!TI&V zQD~Qx11fP!>Jn?MUjRU9oif3&&$QkNxfQZe=sv_cgIYfyG z^D)6TtGfc8fxYn446Mh;iJ@uhhmV)SNN)-E3jSm;4xZCzVO7YuEVhi4*?msAWH}@0 zq8Tptnn#SqaQVNcH2<>E>8Ms)b$$!2$`ZuACE%%t$6mwKV~gpT1dQ%S5QLpbk_)?@ z)Swp&`6^6J%8U^60>q@iJ*FK$uyerKCb$?%VR(bs8NPv5Sg|#Ez6bB=?LP=Bek-pZ z_2`Kg*9;QqVpcAnIz)0YDHth~F8GHdd~uZttdf@zpsm-4}=YziPpzlACz& zb!*C8bbct2CiU_U+xoAHlhO1@_*_~Q!dK~Hrn(jJ9rq!+;}RK7rz3FyDTodA-R}es z1gbsf!N_br54_7PNa||eV@0B1Kd@z{5o*Lw=e-LD$r%h3Y>!;QHaqt7Q-cU*~CdL&|w8G&~R;$P( z_PFq2ZruC*E(i&t2*E@0X0O%qz3Z+*hr`ty3cCbNli1PnxKP-LUf7!oyBI`RPHI_J z&das6mcw!IL2c!0ll(H%%p>Jn;sxugg&soxU#2*tCtzdWRj^L9z|q3F(O>loaXjc@ z4~%=OR*D6nmax>Qzovf6!vtipVz_eqDt93KXN8{C`YQ$N$+htB@`sfTWi9-#n4Z+u z!f&Sx8Bh6v6a*k9MYkf>sZm%uR7WCe5|cxE+s zbNy%V>mmBe6oIYfrktH_hqx=cyp}BNg71s@xWD<@nt4*H zKcnEn{mO9gEAkNr6@QP{Tm8-HVeHg{gAmG{;6D+!?ZaN%TDke6o>ut~VmSc=#{c0i z>lbQ1hE073t#jx79r~L72(+nBdY>uZfd*v(j1Q|W!`x^n@FH_#N%ww6JwK{K(*!{H zBlpW>eJvX<@8-*FclqXNr?W_o_tOR(N}vJt+WgCm>0B)AO4gxz_^58b@?N!~m6*Qh z)fbk&xIta`hx3cR;SA~Ng3Xcx=#I6A%QxlP)wX_V@pn&@B86S(CLpo9e0{Rb2msFx=iBLXY2blBDp-|o6?RvCM?TJNb(;4U z%fDf$Z%&!4Ws|QsUnR2vdD}Nd#N<9rGWq=YjGcmf7y|>}ye2!pN68ZADV?Jv?KZDI z3!IC_Da@{U1!<3>VVghK4S;cIUO^h@hdX}r=hOg{K zA)Y@yv_W7}@4`!Lvjvw<4PAMI3~fFp)<8krg1&$AjtwFnHu%^#DAM``9|j^*1~=bJ z2#winSUewtaDfT7d@!LzY!2H9J_~%69I~1}h66W+A#6U_f#$#i_`s`Ih8>C*A%`3& z<2GAp-ZwGSYu*D{PBK*?bAZGgi-Cm|fH02fjSJU^&08RMq0OH%e-1r}DC*$mue6X+ z(g~7;O&Ai+6nKKG{;>g{KCmBM@Nx18f+igWc2$&ekceinAHd|RGX_sXzov1FJTLNj zd(j%>Kp1$N*;!~+$3PB}xqLo_d^FtT7}}mclv$J;s3l$Le++=(>L|zXIj%Aaw>Q?% zTBDFK)D;8^JYgtfaODMV35)1+F@uet%$*WXd zu|gY)X6T&JM^)HAs9z*SyA%#W53J*v;C4!dP`Hn>kdexQ_zVJp`4m-HUMv<_=R}P) z040p?G5Q@)HdBl{Rx_7}n-ORS?}`{S+4#<(EQCNEC4~uAsvHWKa#t><;UxwDM0^wo znQtdTavIj1CmS$#o-FzTszNse4&Va-GK@YC3jshI06hh}m%&S7?oRU1?FP1+S&oeK!e!_k_ zK9BS?k@zgsLyC2M%7%7sPWZg??RgT7p32ATAIZmmxc=V5vuy}{Ev9aMvX*)x)zyx- z@~ibX0<}KR?pjD$_4R+4@ zF|+20+}^Zd0&XYo2sU&Jmst#-D=H@S6$!4YCCvrryYMgAOcEzFh>v5Bc}uxjXN0Qj z1%yMuEcnT=NJRl&`1_?uG5qqS(npO;Q|85_xmZh8Tb%Fut$>*{ z;Knm zH-HQJ6;})fwdT*6ErHWX^QTPP;ds*gDZdM1-sGu(Fz{THXV?JrCar?9HNq^a@Vfjo zLvB7sTTedrXjV))q#7GEX_GRT)3nM?T{P@^xr;P3VWnYt&NNIdaMPy!eR!a5)=eJ% zl}3*-z%FvnJi@@5Y-S%z>2=wKLiF680}Dpb16OuQA4Yk1G(N_dercPDG0_H6!(lzs zazRCsJzI#plqy6zKUs)`pTPxENgUK}Q|rUE)UTWWI@A{3n&E^q?}2uJH&XZ4Q@K{g z-`|+7UYjj-y`3?U(dLh`yPdzec%+s_;3wwgSHfRPUo3qrZCp&77gAGPpU_8iQ^tIj ziQA^UGe4$9hXd^*-+=NHSA$sZEABYWAbWFI0DGlN`z;10OxCA7EWMsdZf=3Qp=Q58 zTZptIBD^O}XIk&hTSQT||5e_3`$5X=^8TdgTb(;(J68T{QsMvZ=WF(h>gmUoQWmqf zcKPQ?9nf@Z0Q@2UZ@OQJE^jIf3qW2OfrA{nQP^|#Ax;GZ;T@m#SR!mZG8>T9YeK?z z`4;-|31UIe2lizm_hHxd35&!JR72#4NP1znG8Hu01X_p@=OY=EZUKm(sXdNzk|=u|!)w44C;n*Y zED*8s)a6wO^iR0KD;wU}&?AvmIy2ygJbPpz@OuFRQ06JF1nebS)wzugS;?UHYBVAd ztBDK-oD4yyMN~Yf_(C#L%ukYM`yBaaP?Ep~$7YlP(r0t?`2?>7-78j_L_z#ox4xAFQhVtt#Bch5ia$z;D;)5N0lLjV&R4VDd# zAv39ii!y#T=V7NeDdoTo)CHcStQUL*A+AYH$dFA+(M$Cf`lO#jNf3yJqlgJFbesIV z#&dH?a!67#V&2YD9})ZzEC3;-5tcRt5;sSbs z8SJ$UJ5~jB&n&3$ZrP?3@Irna7`~cd%2G&pk?}hv64mSs;|^?LZ0NpmPv#H?|w8ga~O)cOSQTzTcphRV;x)Hm*t^VYRZBLxIM)8%iThj)-vC?puOq=H0+h{x0rp<3;xDnp` zVc1}Nw-=`k^Oaod%WK9LZLUbW*^JtOaZTq4wzrHFgNz2G=Awrxm{UtSBp zd)iRAt+c#lxn(W%I|=mZKjd21XEO5s@|NNk81KORWc;vlM*_d*@)jOYr8mKk%D2id zS1EVkCm{%P9F0Amba^*5%3qd%JOq^_utKfg%$6-_GQpqnW(BMU{y9r(Ld*N48dsP$3~{>_KO=rK z!+-fL=RNAB*YwLb%FA3uKExFv@*aWR@Nr&{w2?Ns0=r=AHy2^%(?IZCO(wPG@vys8 z=VfxIh3v_Vvq!a|Vd1&js#=6k*M3pf8z#?@g4K4bWDVgN6k7e|T=z+2?(ta$Bye#J43| z!if-S@(?dcPC44)Y~ z6+)EP@;MOUk z-K~VhfHwHRYzjK@$vz1a@0+}59#Yrtt=30*f370V}Sy*qVU_!tF@u;Er7abIR5BgyCMCNaU&8PQ>;qM23qG3YQ zM%XVrK=BIU>WzGT8_A(a_jfq|pAOX>}2Fz6SZqRz5l zh_2DKFr2_MFiK(%P}Kper?1a#jq^o3vU2)?Q>Sqx1I|JKCPrHD`IB_Q!hStD$^!)6zGL&PO;)YKl z=J&L<@*$jWaOMoYfJ_m{JdAK+d$Pv62MN9Y5A|$E>>Dy!oT4wd%kVQet^yyiPCbCU7Qjk9EElF12NENOD;A|2U=j2nOySavx`6`Kbtj_p^Q z2rOY%t?izx64mWVJI;*J1!vi;+?Ftww}_|WxrC0%LXCvMtmOsgE_=29x>g^nFyCd< zQGT1xGKaKmenyEguLw7oFiV$^PIm8js(O`XpX}!f?QOSi%OX5&N1@~Sq{mF9k#JUf zOWtN0sjl-{DC*3pE+GZ2k&!M@0@_!gwPvMvf3B5BCQ8<0k@79M*6~g=7h#SKS(GHn ztsy_Pta-ol1gSYdsXZM7C!A@P)d8Claw$auBuFU*VDRfHSl!UqYa!RElyZK#AqtG-VXcYqixmkdOKu_)fV zz_~`jZF-LY!!DeIW77B?*7t-aWguIM1hDd8n-F&wsf{G4^)l?(ujE{Cv7%F%Xw;jE~pL9q|(f z`F53e&T^<4QF1DGq!fWXxr%cJ?nsfM4SbO#;UgcI>C`N5*vSb*?15GB!6qf3^%P)H zaBRLi*o}R6@DI_PE%-KTKZ5v~Ys8|t*YHH~-T()rUyzo#x?%;$21V*)VZa&xpdsP_ zm?q<0f^RMdAL?FXhv;hnJY5QHh60OjNEbuDM5HNMRuAQIVnj*Fmq3@nUGH%LRD+!h ziZ1Xe$n%&D7^o@R#&&9)d?plUqhS!7gILtmbHbve|83c3n4uN2o_?TS9!84yLZr>! zl7@IW6*2B-6w{gI#b5k zf%KA60AHG_ZpVQX_a1@A_oDNsncep~f0KNuUjEsKmcr#bA6imj4am8D1ex9<-7i71 zXWXTK`Mp1RXvv4>+LpGa5amnXDqlZs-XE^+D1Bubmj3E3^r;I7)%~`1`u(@hYJp4VS&YipeT?)(^}vre2tNh zOS5X=?i&!yol?8@M2~)sgD}*u(<6qbx5Kk)|UcW6V z%8&ZG+T)aW-H?pGJS}AN!31cx5|YXS8L=VzViIV(0Fc4|2A_gu5U(sw+e@Iv7*e{e z5AM>CNn-z8GKaL-JQv`nAvpFie1hT=zuRx+G7~_LE!SO#kVFY!Yy0fg6Vms$#p^l)*0a*CbC1+~hWq0rHdd1ddsTxwRE5{nZ}~m^fd9a(-PHv(+T~K} z#Wa_ssO0?GN@@iyXnFznYPba#c=HHL;U#)EVUuucU4qxE8W%A}77F6~jdHKjPx-u_!^k z8EI-QbU}CG{WbS{b}PPj4ZgR$Wi9j^f2>=5tXq97p6ix|j+B2lqcF^+T=%iAT5c!0 zid8+fle+L$u4^}X=r}yEdiiemBRr^W_{dRb=pBydw|QYExa&Gr<*UiCGIk}qKOfI@ zKO2{!UCJclQ%pFMlGuMPwLT+r98amP7nMRT!9ckl<>ucpXv3AJ+0g*;T)VXA+{2L) zHZr-k@(0RyKeka;>Tmi|DwG6U_DbtG(mq+M9es?b)>-!A%8{uFhHp z4vsu!_}s64Fc|t0&h2tJ2DVOJK>}A-5TVr-bQ|gl+9DuYP6Is#imXcA)=8_Q%HY!} zSEC3_sgHKi1Ms8)R5djK?YRH-0cbS?_fXLW?y(Dy(wZ{-*=QI98j=lEvT*9w9?LP9SP!Nq zGdNcv2AM`5oDhS_8Y+$yoexSbXFBBr{Q24a4`tAx(V9cmg%Ec5Crqb~(Ak?T03v2S zg;Nj2rc7-8!TBspi+GNWN5iD7fBs=o-qPt=@WnP+Jeh?C;09^{Yy^|QBkTk**zBv$*-LTW9W;kMl%x)qP#E@*P6n3{HhL1L9z9Vc zHH;j~NyQKc^m{P&_oydDd1;h%Yn12o^vVOs^>^|(6kbphLB})#t+&@4Yjq^q9W+?b z+V#w5Y0?j6F?|!5e-;L%yQIWHdRAI9tRm%h??s9f9K^-*K9RzEbD70nQtWNF_Rw>P z2{ZTL#4civh`HZGJQ!@|QCz~i-on9Dx575wONWnnPh+?wRhG2}6OT60f>zU$1VR5( zcGvt0&Tu`xVv*u#4?FUSB5=`59GF#^1EKJuRDv+K%dfiMO}Aj$bgR0RKyE<1x9GN? zhbfzeGFhPakeg6CE?>v#igz5~ay85WR7oAQ_Do^~cieWHwdW|tK0q(JcQLNd52Df& z6l@1nAPJ)W67Zp{<EoyFogb!<{C#RdEaEIc`(9F?#K*jC6z(Ys+EU9x2mQksQ+ z1~4B$<`kkp&L*VyXLB5IVW0wVDA^A9eL6USYlB*9sD*%CmO|hoMOLx)wWt$8kI) zWQ#dCl8|VugeEI=0}|1gGoo5qZ?#K2&&&{EMlnfHDO_;OB5bO!&}llfImvK@K@miQW`e^|Yz$?q z5oU!#I_L_U88k@B6k`~(V9${f=p>}lF!@HYd05yU%ns*g;IEKkojD#pkJ3AV7Fd@J zNFY~MarFUExC2BoamU6QoD)d~0Wva>Im9c*I^y_P;V0!7*EYxHqrZA)9mA^+QqSov|~ z_N3E|gcxyKd@Z=p>=Zo{#Z3H{lDHlvyA~c#w%PB(32oIKxk&p$u}bOSUf@NByG3U$ zZs$5ZNLlptp438b z0w6w! zEv`VE(j^P14k$4SunJ~Ml_|EJ;8zPo1JFqclvB!NRZodfs0TjXO=1*-XP5 z9IPw40XGJv4MKRq5+Kb%2%@tkzfe8|F+B1<$`Xa@R zC;a8fj#0zl^vfHQ@oJ{l!% z$yd$>K5)Tg>P9wc)QEyBXv6>*XUy7jQZZZnI;_0ht{?}^lDNp-$7gi|85o+$!kJy? z%(!IMi12PF0xdwM8zH-sR+1}52V6veDPe>c{4|c;o*3P}hfjCa-XgwU%;EenGp@8< zt8G2uJ}h#u7i;4o z-J72S1xICwRybD}2N4K-X^;Fs1|*7eJD5NvL_cH?gUn7FNOHqCz;|@qaT5whB>(5w zgnM|^jT%lY-2o&sUc@TzLU=_UJasNj}p8d&;eHh5*k5 z|JfG8KR!Q5cEF;jLV3PkQ@N#UDW32teu0@*Re;Qi;?6HIOUTFvcU`DG#Y#w-q3DQP z*G@)8Ib!|+kZu|D1T?XtT7m-`danK7U@Or04_v9=<_fuXgDVk*`KY6sfw3vP*AJ+e zeHh(}NZ*V@Onm-t(7K3RSjV-bC31_Mzw zocS=2N*(OtgmAhz_(2jKLi_(E_l#EF#)~@bEgX0MnXFE|{Aev@I1eF~Q)3A2WBNJT z^^~?*Hc7oa3GZptqSMw7#M8z@rPZRuCM=Zq+G!*C@MT_6Uhsvq=*oGaML%3iCwCJ4 zea3mO^z=2AJGR_o7Y!W8`xX32aT7H;WVZfw`F+BU>+*5Auo;ztu+Af-j1C}yN)rk; zVj7`}QI}CtSE+-Mq7bB^!-CT$ES-P_71%)5+!;GDg%EITShPUFeV_}x6L5+(N!h4P z-+;bJDJGjyLOM=Jh165p7cxD8TSU#h#GI-?c;adRG>QwE92Mk9%LN?Np?I5{XAtfwOLN;t_<6} zCcIpoX64;-%S&15V%|&`R^*7QhV?PvGtVWEacjJ?FHzlQ!;hpZB4X)sOI*xg8&5kd z|Gu<5PIevM)j;2Rjlc`|GmS!1>a7&SeBRxp9KxarBaby{X1Bz2>g^8l>b8MxhnzeV z?hkfOXDAhy5n5nYngcRuS1Qe->|l=ZpProoVM7yej3TqRtBisF66xJ=xWpqCJcyK2 z7C9LC7!bHJK|>SJy6b%}G;5=15qfhgxCuH^fft2jh^@R>WB@1oH$pvOtxFrq{!u?)j3??EVQdHKo&`ou?GWZ`uZTDN%Brg z986Z|d5&S6fOeMwM=c&X?$C)N*orPY34yd{&vDYSvKwM?<;2R_6O;>&6%_q6W|7b&}F=JO;nJpP0>EY^BH8?f%9m*DDwe-A-I<6roNsq=Zs3WNOGNU+VnJRldT=tYhqDpHtf8pQ#O z!i>LWSKr0!7O|gI>++J%`zdS~)$4`nvDMK^GCFXCfO4iUP<0Z1W&;Q8A9^v+2QViD z=hRE#7wF^y+`}b0m7%LZKZ(26T?OhO|68q-ptq^dd(h{w&dc6jvZZI^%mSE^z%8H% znjK$a3F?|VCD_3JM-W8yBkH!YaJjt${P;WP&Ea;21V%)9TENrlrg&qDRtLUCo^=Mz z`TT`^G>?3Rdadw#wuQts2u?cDmSho5J3lR$4Xi1S^qR=FlbCPZEF30-RQHR#imM<# z{LJt@>okvW?ABj#6-vGVjY?}xN8KO!LN?b*r91?9NZjYVaKc1ZL}LqFb`+Fc%`O(pDfPLEa-FG{M^gqOsOf(q(88J1jg*+6wLB{R zlQJdn1_R`KUYHdBC5Bs-*2}l}Ca3$es}bLAry0SZeJh$gVP3kJDNg+$IM|1NZ|Op2 ziN8`WKbXcbHO6VUW8LX%svB`j$E08UmnTFfdCi#gRqU+ZEY;F7mO#aBv01DcJJRKM z`(Dysg1#c{#UzF!*Mzipkkz1Z_oVK85yGg}Y0u`Ut74tRfg*dQqH^bF7 z>3az?%+2zb9C^XlISFs(ceon=aehiQtg$2rNBRYSmz|q@9r;Wx<6D|q=7jklkFNdb z0niI5K7?-?L1vNt;AYvOkdjb&LKIkEpJ&(z3G!l&r$Y%`RthYvkFmn}H{#D|&(7u& zIHw`tT}IY>@5N!DJNMJWU>Dp^4}&zjPbdSG`(y~Q4Zcndfj{sX9D+>ky8{;0PLpKf z_P-`xVT$t~gmats8Xc+Wt4fxC-$TgazB@4W0g8iD)Ijz4#AZtO=G7bk;qu*y4*-cM zpam%B$yYARd>w_P;MI?!OS)DRWW>G3%xl*JByeOrDjX_;Tzv0?3c8H}M~^5`m8+_R zRU;~{Bv1w|4vD-teiQ8xDbkgpx{|nGk3Sx1!ZVM+ZM3l-9dNp#j2&Bo{5GX0W7eAk zE)>%zFM<%VTf@deFnB1OLP#;z!{i(NIXXDH*goH)@a=O@Ij^JmIA~Bl{WdiRT+LNb`(**qmyr_w`&+~AYrBhUp$tSUM!n3~@zGvF zO`3w!8AHBDF%Vk+Er2vgiDTGF(xn(kflL0N1MpMgDC~93)JBwU*`u=XMp3?hWXx8Z zfq_{Fv*IH}L8xxPBJt5ufd2t}a$<5ekx#K!7ZwqhVo)Qpk?ABQU(0ZeL$?D3F-%*q z0IUG_BIdmdbOJpDJjeny$*nC|00j%bN{LbYebXnMtKBMn1Id=rHgo`#ipw!sf!2Wv zeD{KwSX%}o{7D@}(tuR=pMC5R3MbTj;th^Nf{qp1OK&4hI~mZwJB>Z_RTgKIHjHc6xNh}U`PqVek`YhjsVOCy z^OsG^zG>Xc+mAO^*j&J21#kG9Up+t7MD3PryOqN4uG^uSPMb(iK#_D|9I=;+RBw@T zHnZzwc*wiKNXfZTc^^36RV_cHekrEzYes5)tJlxZt|EEd+T|9QBURkb?A>rk!HTkR zNS($UL*OsplbQ~WFu?nK3%5wNu+nPJ-c1kZXoJ%sU;gS437|kvvEy$PESJ1Hna2xI z!mGAK0~iH^?R%9Xj@?^$+CZc4ZcAVqe?to9ecb@q`YXUt-q26YHb^nqynWx&Ded?n zb}@1h^ZQ^u$&87bZtOkw^F~)OQRcEr0|8WER^%-D6OWQ(CvovT*1moF#F6uixNAlc zpVBkO5xAs7UMU_xSSw5js!YdL(c$*s?^P+CY>%2K0~Y8(lM=!!4eW!jqeNQKvTD*x z+c=MPg5M5Byntu8$AoSR3g$SObk+}vnh4ZwVg0>wEqb`c@cNxldu;^Rq!bBN6xbwR zp@y~A#tsis!2kNDT-@~BOc84N1TZi)9ug-@U6XK5R_eiTD;c0SDlUn=BuN*K2|-J= ztc@&*W^S>XLOR^Dc6pvGwi|ozQB>MdWJqm^V_WW3Ngh)XItrB)Y{l|_znHFGi<51R zASLL6^PQ>P7o5LkY*2qLQ7nIpw`;^!Ohx6+TD&R|LZ4Wz3opYs>F?$wTi#-c)mWjw zQhLWqCok6vamGsBu*Lv^{kDF1Q=FsQ)~~P4N!JF|>u<(O`jh3k+MH9ufy$}+lX2%u zDfoh>jQUe4(|MLU{7;R=V)$2#Biv7cgWtXQfvF!r~tdz$<7sX6{(+{avIwSTbo2LLEaL0 zzC3!;m+t^l2jq{_J~L7uQNsPe2qchT>jNV{ha{V~j z4(Hpa*l#VVR(#|q)Gw5-pDwK#=iIK|QIniUJS>kZAnoiKo`f~yA?edO+5c^I)-UNafyvW6!(B=-x)ta$ezf`_Sxqsj+n?IE%x&1XG6#P!;2ktBT z{D<}&A+hLNhE#re?MI(an|#e9SPQ)^56YwJAaXcksw*B&1-Fz`mutNnuOAiLjR1`E zbNZX-R4<(q(%v~4YNvBl*LbQ{a&q#pawC`}Co~FY^2qy4B$Rv;KH_q}JBIg&#Uy%0?yu@<+qZAe1w6 z|9xaK`}1u3TIe+%_F*fj`!I0u4JA}WE&P}gH%&0Kmk3f&_gv@wEGH+W$L`X`BAVrw5E zID}|H<`U91BJ_y9I1Kdcs|iy#7+UqAA(*Af>DGXv-&2cRoxPJBjS+wTV#PVOUg31(4W!n~+`P7zMik2s+*$OY1-5V$cI zCA{1ke8dOB0F~Rv7@R`rp?m9|t3iSeMOV5(YhxH2GqcP9jAHrtPQ5vbC8CCCIq>Ev z*b`Z9zyl-`-=h&0#5nkE1QJRk7eVQ(d}T1dxRe&gmyPx5sBC}zVQ?Kj8#5Fi}$A$sJLm95r zwBei|h-EoWY=T5{1YRoU!x{vK=T7b*1RgzKgPb*tBg+P%zU8hBLf^vEO?g6d`9(GB zgU|x`S78v~;J+ULOUYGbv~C|?4` z0^VHoN5vB%Ni91+?ggqyB>TjpwU45GC6O$<`cBMGPcKr0W*^tuYmp-_zK>sQX)j?g z=dFg^`jek@yRomroU(bNsoOF6#_k2GgHsG5nEMc^G=URp`UnnF*+a853UTk;8%)9- z-H`X1-D?{LbH()A8xvbA4!7MnC%k?@v_QiuH#s@~`xXMgmYAHJz;YoT z6rPtq$$7Sc&$=Q4K>C0FBWwdh7jgu`@c+}Pwd4~`tcRBHTuIDzBVvIJz|Y>ChOn^st^mil033VeB=L_Zin}TL{cm!Z*=~u82&PJp{0)-_?s~=vBc}!ueY7JvEf`)CQA)Y4oHWV| zcU4Y{$oU**auITi!Qq@L{K$Ecl7w_3FUL-BwiE;9d?vSZH|6K}7`RJtCydrvGm4!9 zwUziqP-Kb62a&c_(jgN5M(_$n?yQ_Vd-^eWq7K3n5&r&IDk2puOnZSBdIE9Q?;Nr~ zDAM4%k0TTvQQXrrBxeg}fN3^u%L<67u{H;yFhm0Qyyd-7M!*K29XeEe)0DSaPVb)HB;mHiTny;M+_4_{ca=FufR%X%Zg~zj0 zy2UNKUYGqMx6F?f*sxj)OrH-nD2albMQ#AB`Z%o{*lR$-xGW-wJ?Jy`rg{R#!1n+= zwtl65(Ekc4%J@SR(vKrUV&KL&U?L_W0JVmuIW`3WQLv*?GzFzb)I2yj%pb(Q?F&?; zSZLn>U@&*@q7-?l-v(FdGt@!!QBFk4W(B5*Ss2#AxgCM{6Nt?q5(HLG4V{=MHP{&0 zpkzWQ)9C?X``JEmfUp}ICm^r{I}Rp~HVRA+h@PSs`iMJ)*$grjk}r!?#XGObsG(s* zAUP}%kT&QS+&4HdO1^<659M?7kj6OAt@@_QzYD$K1``1=z3zIy8V|+^c?&#O_SDI~ zl@F0>|0J?KNFu+}NaJw!(bE+6&jGIfQQZy2KV@b>94oqW(3+**^;)o!_H38eDLDXC zdm4Al3bkPbvN_MQd8pOK<3DEcSyyk$3Rj@?uU-`n86{31z70eqbhy${Xccw#9jT|e zsJ3HXg{K_9=CJG7-jb}|0%cxGqDDn4%-jC6tE^1_b)2?!iB8+PgwwV%f~d%2wT^bAClZdT=gf20R#|n_&KcS&*6~*RmcZan|4az@Ckw!5E(Wt zF^k@_7ykfhlLt6G>jS4woH+GCTKc8aE9}yK{M1QG6$=;wok7l3PU&}GJ2GhmphK7f z&8P+<$4EcRU1ye6r!lZXd+GQlo@%BQAkgq*=X=I|{6`iX8R$u|4~LP4Z08W-bhs64 z$a>lZR54UwfW|k*0%vaw`tR_958Sa?{N6G=0OC3R&?Ijefyj65;O@rZ?z>2aFc?JS zEUoWBv+Vq>A;gCcbNI4%`JB2e@2C8KMMdZ;yYyB0F{swK-Fo>XoN&*VAB25HIsexy zDm1QMnNjUj4(W@#^u>_A&?gX7Zqp@QwUj=|>P;bG`mk0#9L0bjA?04t#+!i0_<=9ug?M$JbFa`1s2~1)iPQu6D-xo z&$=7;?-}8S-TVdMpcXOTESqhSP#hLbMm$JwWAhx#(vSfsaiRs`HPwe*rTT5P@roSe z6fc_LXNsozvS~byxb1NDy>YOF&XC&1QSEI1Qd|(8GWa^;vpp^;8W7j^1VzGC-$fr| znTa&cP_2Q(pd?U)-_#Ik>-cWP*iDKY^21|g3o}#%^vY;WyBWL)BG{msLN#m}Rwd#5 z0O(Zb?jgT{fSQk7cF~@z*(3WXM-aNx&5EODJ7=tgb`FVT`;nW1Ct=DzLsOWcEmN4G zuCBLIz?d+2Kat#h9^2?Yq$42?=s@?VdG}kMmaNGKjXSTU475B`y3;aJX#nd(-M_4}Tf+I_Q6pV9;rczAG0ALw;;;U#RSH1`I@~cE3m#jSd(|$fD6fqGQB77IFT7 zOdB1}4|1)^E_FELeK^+jUgunP_uHT#kVM=1A&GLsPA@`jT0QA9>O%+M{R4@S z;OxoUQxgcFYrV_Cgiz3ztA_L|HnE!C0%A>p?IG(^by`hZ(!Jp-!}P#T%=r-uoq#}G zx33J0DzuAUlfEza!Zg9yA5yT0#Nb=JnvDAMQ}!%O{n+jqnz8n@=BBx#R4jr@Yfgy!DG&A;)&qmX7ASmD4P-i!-#gQU74n1K5RW@X^q}(W86H$0; zG;2cHq!>E_Y2pPRnx$Mt?0o_#kHPq+eOsfr7RPL|H^n&2RD&SgJJ`(wRy&a;VXgxf zR{#oDUcU&)))gSk>k1gDuv1Xm6Qt7qqD)51I59!N^yOeFYYPgy$?Z}YZCvP4uN7yi1u=e0^paCLdqTo(PCirw0$)NWY5|Hz%^81HK08% z=M(@QAdLWnsGh)84rA55fZ?ZMd$BXQC=Z3?VLBk-1eXBgr~C<&oe?9#h9s5{SzlZ$ z1Sy??2jBn%kGvFHK0Q{SQ}r=rg9eN-6t4rewa=T2HO--4g)f&0GB@|DNTy{P>;G@u zAYXxd!{ra#a1-6STDjLbX-wge-Yha9Oqsa&Z@37*Typ-L2~zn_P{>!jixqvLS6mV$go1z^QY>Q0e{9+vn=J5Kp ze4Xruwy>S+euTf_H5)Y<>WOycU2pIzq@-ISO|-ZiXdGbp_f0?p1IU8e>it26X*dfnl;^x?oE7NZ%cF zf4)1QP~V;6J)u0oXn-d;!U>p0u{IjQ0nC*85je5e<#%r(69mJ+fxz3qJ`dCL9Qk2lY*sdjv2AR9}x9N%2~GTpf+! zbm&*=>(|7Eo|C4T+zW&03?+dHXIduissWj}5sBzO4AeZ4~vCWprm)rR3E!42Wwy znt-ZON(u;hpnP&JLFh^3^SVl?cqz_Txd5mX9kSxa`qATp>* z;q{|cU%-8gacKD@>$ES;1u?eN0X@}MhT$KDY3qi|y>|88gyQLNXAhzqu*dh(5!-vH z!M$Fds*QhDsV!RI?f7PVT=d)en1x%JV}FKUbvgukMZEYJmmxunOz|1M#i1vZbdq0M zZjqwO!nhQGnUQ_tzI4}k<%YQQ%j5r+TgtoR<2F;mPP2MF<@f=O;(LiGH29M?;X^2W zD5OhFouq%n>hN-c-p~W+n*6?KWOqRg?Gy&`BbDH3mq_F$CZXMcGLe)SIKvnw)cJ8- zfFM$^YOYlcl0gJO~I@O|lPwN#V}iO&{s%M%CrcxgI?9h|rJs|FeS;}(dm;xYL~?L;f-q8J9m z1y+IrdXtq8rOJ=ml!WQRTv=T4;}j>^HOEL8O6~NG&SPe{JOh@?u9p+0F@Dnc6<+OC zxUF7Hno1g&DnBs4TCa$CQ~-#9jXsQjN=xJPEt>Gi{sqVk#9iaF_)T|&YE8e+$D42~ zQ>8k8vv&BI_y@Ra<4k+OO{h_W@gVmtzczrP{aopkZ0W>5V47IhAA-)(RcE2GTKR;oLlUwyA1N5}Qe$dY#$T z1xT8)JJwXkLeo8QEmr6u6QYT@lIQbcte8SL$3c5t+^%Jw`7cjWoOoWGrpzV0=pxx8 zyBgnxU$5EfKxiAr4y4?xKb@*NtIiwbE&pXChzLYmLdN$tDAe~pgRb~$YOhlCoKoCi z#8B=BqHy3=YLWTMFX-w_0D7FnI=~2CzrBSFhYP z&vVa!dZa8$eo1QffO zz@EeTVZa-JI9zep;jyd=0h*Lel2pX1h*pRA_Z$*P-VGN&w0CqCX@jF~9;75Bsq=b-6U6Q{xhsUm=TR~QlNvk2hupq0nX(?VG!X`hRP z=|3774%gaP2oB#5H|Rg`e9*QiW5P)dN$M2=h>K=j&zR7Az=0YKk|9igIKP@>sU)^Z z&?4=V@4<)(2=Pdlw4|U9Uj(o#;vo^SL_WA91o4PR@;|>}o$l#6W zuH@q5AuzLjEK=P%4Id>$E8);7qypNJYgGqeqA}-tIC83(Ywa%g;M2LC`0BB)=TJj% z_a}2Z)dZk!uG2i$>BtO{^`X7mlB83U+TnsGK5Z1l!9HyrJh(r}bznw*e?0s&F1jnf zJ@HJggXZLai|0B-iC4aq>%e!Ns>JgvzIy=pL3`|A6J~U3=LDoc5ZAyxFp=xfh#+iI zRJfasvV(wzhz)I!Jnyw(@H7pZaVaJvyYJ61suWDN>IG})+k5l^=@y-H0N$CS1+bz z+K+6Nz*?JufT3eq!nB1DBlMCBs~yZr%ZY~VJCf_+xOgJgR^M{|b3;P-`^?V!O@8fY z`PS99GDcS2J(Bcsnn*{F==oQdeXSJAS9OvaGfl@Rk)BY{w_`l?~KP;0{U+5QZ~_cZofw z2Tw<5V|J;AQMyP3uS^#~0jk#sBFUc}E5lAKs>%~F}IjWIJf<rUmwd@q=KXLT#3 zOZZ&TEWe*l=BpgwHr2b#pKy=(k64vAd6vT4K;&P`b>IZUV}i>O4JYR=-(iHP)FzN5#tWXKfwnP2&6>uJQ$Q@LBxnQtG7fmlCT|hNfpTu6BPaIa z#zL@$D5O0&shmJbPu^IBA<4F52OR1XFoWzcIgS^!QdIz5Q)xgcqd8Tj9Z9%Tsm{DT z>qnWrmU#!%ekO9Y3kvijGQM7bF7$*6OY)lWeXTJqPwT*09SiG^!WBLZQNq8$yCPm( z?3(Te(mOeDe^^v!Y5KMnxZ1yv7nNP? z3ODL|ecY*fSvW+=B_LZ=U5o1LGe_cSLp5sRGv8Om_r_t16I}xr%MiJ3zHHe12s(C$ zvI~<&2d%zALETCR-^qhn3&{cO_4193^FECOSd;>k96WyDe8_EtLYBkjRW~l&IjY8U zxAcVHmsZuNHkR-={bP3IxLBcASQ_mnsEC_r4M3rW0DM6m$`BYU(wKncz}ODhKyj4_r;HQ&_Rm zvqEd&A#1u+10}=)lrzMx3zTUQ@4$}X^W{O@rr$kqP{%o_D$3|K2>q?AEbzr^LUGE) zx*GY2lFClsQ>cvp9&9a*0CAa(k(?@hB%WaYmEDqvWP?@;Y*Da;A_{ziCBoo(wG)An zY#`9DcuS8uAQ*HnD4S1{#GNKB`e=5rPNE?oR|YyFPV~x9CyQPgT4Xsx5N=qLd5WmR zN(YahgsFlR%}`}RqXmtpHk-JdG{O&%Ylzso)rTKBvGOpSrr_-T*veTPf`woOL>8P~ zIe<(e$ZQV3@E-IDu3OZ1l6N*xu^_pEj=C8ndvu5N)oe^5Gisa;pHVrcyVr-~RRSqOz97_Uc?(Hq-4E5DX9<9BKaDdG z1k2+#Kx-+th_>GB(7s@wXiPx@%cY3o=be9|{mjZUg2fXmMgr<`Tk`cS`o2&vr<)fK zDEuz|r{|s9gp`2bt1tcXc(^*^+ECB0zLk7cvN)ZW=3zWi^HJHI2$#h}CDHwov(r#i z={LvC^UiOj;v(;)uw-rq*V{p6hU|Fw7i!Es&Jea9{+S$4cK0ZFtB%k~NpWrz_e z{*WkJt}84+kXYi!QUD~75+w=(U;`%jqX20|ajkJYZpY(#+DMM=q>1fm5;t*^IxCP! z{4+?CG&7ne?KJfyaVFEGsb`W&lZI|QZabaE{d~{4_r3demlPz;wEZI-Y4P5D_uY4Y zoO^zsbG0DK7&@$|VOfXbL$4G4gD}s4LBo6g$L09_Y|>(R{tA{MsydQHge_JJY5>nV z>~+vy7wbd?f!x?TKfxHpClZ_h0z3fU_HNUFga}84-o#7g($(e!iN*oA$cu{_Okq3@ z3lx}LV=0Q(NaZ|x(1f$BYZy2w0nd7K#Ad}uAaUdM7?xRnB<2OjC?OclIK7o-7^_oi zZX%+K{f@^2=oGOIX0@e)_Ig;0xQ204C0hv(A#-ArV4fPL>>wehjdHA%{#dPyOiv%F z=~jx-XsW836^p0!!%EbvXhpEc$F4)5mp$o>aW`Bn43d#7K;5NTw_;zp^p<#WbGZ0I z+&W6WvPa6V%R~Oim?F7SIOMi_`(UH$>EAY3>;9>jygyjU0cv4v4S`PX)nPvY>X==b zntgf9S3-xa`2`>$sIdhC%bIAS0wtaGm4vm5D+y0xZ*i1R@TTEQPMS0!V)K1D#B0Qr z2!XQ$pskWAG;R(C9t)R!eF&HR%cFUy?6=vTkX|jm{Dr~_XD#o|5NZ3PGu`_BHER_MeOjGt+?LT;tc+06EVa7ddmx6u@{bZc)>sLlinkDw{abUjTqqA zk6s7!jL;JN0$41bUaQQBnc)V5A^ShQg|$d;fdO9`JW4yvKl?tZtw;+kBhq8;lg%Ty!CkbAc*Ffo7|3k(2CIg@qi$XoMdpoC!Ho;h^l^`4q%m^YOH2 z=$W{&2Ovs5q2nt2d*FTN+YEY(odg$U@Pra$T8Y3SsV=Jgzy)7}lh_9P5O(;_4|T7H zP>b7sqGpR@TYLNPrTasbFAgC>{eY9sq1)E0*pY|214LL|9bU9-s-EK;w+=nJd6XEB zpv+q~fW-&&%B4TE#z*}dc1^o>lvba;>!0QLov-Tnov(8Ij-O|?zHXKM1T)!Fm4P(^ zh`b+2SVz(b@F3cptQ=_Yr2zYj1DxW3Z5$qgejIFKp}8)~h?)uaIBgS!mE%mr@c|{_ zpAZ_qyaajX4lVR(CudkW>%!<18 zbNt+T*J5^cj=Rc0Bg3X^aTS0ZSLT=lQo7}ac$lASA%jz`E!8GTlIMNvUh|=?p8eQs z^S!pwO{rlm%WQWjT2!q?`nSX@bXO~- zTVs;!GzujV+ro}27BFW%FM6u8-Go*ndG5FqG9-63^d@FVk~ot!JyYZ80`Bo5YIQrH zG?AE9i6NOI%kCj0MVa5(3v8L%p}b(P7m%iR+-h**nfx0osi9)r8HOhBaTp$dqYElg~aGo_@+d|1tk#o%m8hTHIM<=(Zp8)EF<62k6`#zOB~B@=^4J zQP=>s-O$CqO@GCj>`pRdl#}ajY2RKb{fDfJ59M7feLZQj)UQ#N!rj`|QLd)koJ^(%7WK?yp?}e^Eh|R4x z@_~2#h7a6-zj9)|dNeqr)%|-%8C|ol?oN;Oj~~^iyZ(u_uScXX48tC<1zPV56WRUQ zMC<(gXw$QCH)n#aj?mto8$vwZ@r`%PR^e#7x*mJ6YwX4H*o)ivuV>rqXZw3@e}gq| z3u`~V+&HJ)bd#@n@6{ldm>95U5jlwa(P2BFOA|})M>?Ju;}Vp3KM_JL&MTDBLO6)@ ze$Z^OwF1#Sh~K;ueKs|@WtHG8i!(ilod^6lHA0@hgXq?BbbTMHCPV+>n1=h1EW^Fp zxfd)MDaV0e07iK@E`+6A{Ba=r6IpvdLTUa1DFD=4+o~| zer74MMEAqrwyg%#QV5akUkOTtu1JVCo!&vrL>i2-#Rpli{042GOYD5oRtQZ(kPy8< zsU1~4`h_c7UeE(ilhIKcOes9?Wq~vfL~5e&xknB#ZaX}Nc4coJz$hFvs0Yv%yOQw$ z>mRP<77Hbd3wi*%Uc5n#VOi`l-6mQK_0GI!bs;4r-nm2zA>A;wc7Z}!xoM^jq3MM7 zX4fL9?qR(TU3XM~^1e+Js^U29NJ3JfSO_2x(LsQSDj>0%n#8ThI2crD?+?51Chv``dbf(Bo3yhg>MR=^^(YoQdLw$s|acGK2uh%*j3e zC+ZJSFldCDH9;rqDaThP4t6Ip^)NUj7Ww-M`nXdubOIFykk-z%KHhwsW}o3>vF*sJ zbl}v*Ph@-nOa=SL=cD)N6+?5 zU0>gL3;IlZJ|5=FsF#Uo9FAK5%F;*b9>(BVU{0?8+l0M%{3i!%=u&b6IBH{tCK0m|PFKvdNAOg+5@rljR<~?OkUohF%ykoM|tj^xtbGv8C?m+x{ z9~&hd%HRC3fBwq)j-yYCe%|);%f1>0wPS$oy?~rD$FjZ16ng*~)rwRP2yX`xrxR0( zP#(e1cl!ZQcLa7(8Q~!Z*F6R{0oO?rlRS#SYaw1Myby7d9K4gtjzwi#OA14~I=vw& zHQXh9mXsOtGVEo0%v_%)UDg7<7sn?01kKNNMix#i8qMy#7h8f`O313%d=tOzx!0n-$Q!dG1Wn&;jk`29~UPYHnm0gv?*O z?WVx;v|5;4$Wok9Oto9I_7dB5$QG7il#b}HSy?QUS zw|~HLT|Ha7>)D+F z8IP6sR#}0vkQyX>cp3cd0SGO<@|j@7tgg+yAM0hJdU_8BYm@29j%N!`-#@ox;V&7IIWb&Ld=Ra`Lx{IPSU!f{{Lqtc5x+#xBYK z!PNie>n*aT`%?eq>g=u82tw%Xx&1m@5m)M#AGaI#KeT0dytZ*e&)yp*n!9{oUiwaL zVn=!VLdiM31v!du+(7P@Q`>)d@=koX5tP40_WhH!&n|ddJKW=M`}q0+D;Ot()b~v^ zNhQ{8xnc10zM0%Gy)?1o!;M}t&8Ut4+}P3Ew|zn;D$r~c($Mso>zo3b3@IY^ILZfb zi=h$NX0x>pv@zWztd;pKuozM?M~uxac7XG%i|=1PcX3U^)P-|WwXx5O&1Y+kK(l9J zWa>!Vf^pG-o#U)C9t;Q|To6l#R|mL2-UQ+wM@SdWejCQUoV_-@k7fJu8_l;s(W~S) zsrUBu-@rl7cT8?Com}WHf7Wd@WcRBmyWfdTMQeO>?9NA<|D6;(rO6#Q;=hSQoV{Am zl0LDilbpYXR@G9+c5l3%q&v2<%|9hYED3(>=F-iLK2Q4EneE*3!k)+Hl6 z2C8pYIN?{0ZuHiF!dbsjWBq0nL;O`@h|M(O`{L)u9Na@joS@O`TzcsyPX>FX^W)B? zB!his`OAc4VCqyNfWUPMjxn>lX;xAxPtq9zy6>w#Ku|zSo>O*5OFcNM4w*p#<6?7& zrLCU;|31+ED%@^JXNq0L5`1rt0Wob9$ zq6>V#yFU6FyVLi z`IF7POIMozYr?;-B4wQvr&?r zmeZR2^f}|1&9za=d|iOYbi9R)Q(R5lqaemf=aBbUnh1c21uwcsnVqbq$UKAf?cf9q z6mmE*EKFuY+rtt>om|+XFvc^ADVDg+h1d;O*6$7rA;N0ZSOik1GxEn5Cs0h$I?3Cp zwqhjSv>{Og04<UH}`DcR_p1xeq!TIH;r47W6_?{YlhcPHEwJ^(*4sDzq0g^2`pLV zuZL7qj%P`T)>Gm{8hgur#(T;nUTfU^mggHce?%93y(bmy_WRAB^8Ssjl!rY9*0-0o zH*ORaL{OO+6N``TiK9I{H@%YOwFLawr0+%(D%YRL2nF@0T+RKA7R1u25!6O_Hfx&?~K1*za{LQbUVe0Ob7y}32p-L{Z(Y*?2ZV6Ak>BZfDk*5xHmpBc?3h5037-= z1*Ojpa0~yH)d!rcdOUnxtwF9m;QUPi8^rJ)CK>E;b~#vA$ljj=EZ_i@Y||z$&6U*ID~3(+CKz zZ-H5rT^B~@dI<;~%EXW!iOIo0aoflrdHqeJ&GV&`qdP9`7%Yt=p&2xX@PXy8DEH$Z z3R7J-(Y=27NrCwKTPEzULBom9Oe~Z*bMf-)%JuSLQ_#V0b}8goNRg13PS{pLg<+PJDax27OADr;^W@G@ zVN4mOd_w*bE!(-#Q%^76xTx+@(}i-*$gb`b^$FfqK09A(Jbhmr3?v9Ua+hABNVi8 zLZz+AA0STJP0;KSh?Lbs`b-}gU?D>ASt<1ff_||@mF8+YG;gk93p%^lrj&Lzpca*0 z`kkzAQt{15WtXge5o5f}g+FqQh2LHeiQ)!Jbs&;po^r_+Y@_?51=jR;BWs$jgLJ3L zl87D@eB+S%YUe3ehz<HtTim`+;qm84{j5 zw0)ucV-D4$%#J8lI(|UKb+K|ji>hk02QOzX3@#jM3^DoGgjtYF{%@*?ix4M$XC_Hu z5Ukau#30)I<)ECCFb*A1j-7GZ3VC>$mCGon#z>p+hLFG5j!5`jbIADY_(W+U_vrZA z1X|$V!;Xj*A{=VZ9*&oVMFL1O3-ZfZnAXi48_{Oo3XlfW5@2-8X!@fdVmXPnL8kI7 zKNi#RKfl!Xai)t?g-(&w`Hpa~P;c;*{{5o?of}fu(L(Sbt&S!j&WrT0Hf9GMrX8$l1u(Y>Zn*c_ zIP`F`A)@Ic`$TL}I5Js;h$K>!X||a_DfhiRuzeicMFiWBUJk1Shm0BxBQ89W$mrns zNzzMUnFxfl)&23G+Eb^mro#JWgIl@%nHo1EYk2le9jiU`pi<|d!+uC!t}2jyLH7?4 zDQyK0Da<$eXykKSAQ@6{#^K{YSM;&NgRbCW_l_11yZZ|scJjzLHr|j0f#sGjwzy_D zB>)%XEZQpCmEzhJx2abw%*h{rAEt4jJ_PCf0x>#ov)LZLZGDHQhO-HLwDe_i)gIrt zad2VCn2sIHJ80wjaSz%5`XGpbvL}dM{kXq(=}v3N86Ueew)ClOa451v%z9VCMfP|PnGz!J|M zIc|um)D5B_di<5o)PzA4voOuc9Mb$SsF-lG1LIxVZl3kk(olEYnxEVpLRr3S>wV?9 zA$PGG+EMEsrF%U1_7B6;$le?~b!8mAxK(ZDg%lwiX zINd?=?HjKR7Y1rpw|P_0^o)+Z-AW|^{nvVPuXn=arQ0rT;Y141}#9{hnp6a%!*O9^!}?Q-N#Z!x1kDF(-e-(2z1Nf-t|})1j;=_9h^%Z7#W;T zt;}F^i17XV&c!r)kd$up_{|U`%m5QE7fCyd)5cN`^|r0bJjd)i!FQz17={N(tc@%m zFIftvOwdCVjyMMPvvl$lFmp1MgX?tXk;mw>^BYrT%Ui^CXy}H_@4}Fai2SRVM@_}H z!6A>7Vc29u1kFZq+)n(6izRn_SFVJ^8HAOx6>C=o+(gqMPS}?yPOVI81yOOUB#jgDIfaFJ!oS%i1JOYz!aE^HNAIvUvy!`g<}ZQ+I4bs=R{?rms8VSoYy z8%yS8*D|ND4%#B9$zT_Lhg^Ht4SlZQ^+Be!5G9;zH!K0$bM3_+%-rq}_rB<+zQLL) zM4C^A+floPVYB(W?B}ca^_xaZ&07}iGwwCL?Cy0vrBZ!i{jK?q!}rc^@*ef}LUNYo zuRpr*x#95ekn2|sV}trM+u9~s0;PR8EsL&W2f)o~dQ8WLfH8#z$3{5%TsmGmv}*i; z6T3Nccyc%F87u-yeq!HrojR?-ElB(C9&Fg;qRj@h=1jVHhj8UVb}TQ;yboPU%R)Ou z?n5>pZj|>8N1#M=Cn5HHaO&i3=nNTS&8s#>sq1{W{^hd^%ky&=7OPJ$Ezd7G;=FLK zx^j+FBGeo@anLF{^690yl@$QQo?KX3Uh}%D^Ptq{_}M%=U8OiZ8SdE+R51^JaF2Yh zDpCNc&eGhP&LVxbmiXgX4V`$Hb`cKSX`fPtcYaVTM}iJ}b&msj*sQMr+JSMMRvV&6 z9fQQY*3v?})4)XA{i^7LH8dnjohS#`{xbxjC&6^~caU~UgHQ6cuG^j)3>Hw6ca#H* z%x;(f9K1i5c7xQx?=n}0Jr371 z1QR=ojl=Z~D7CG-<~So`zA=Hdai#03$aL=qF}%iOIJ&+!Shiq}uJ7W7G#F#eF1@pq z??@jfCtj70mrgui?|y!?`R38)cfwIvMjO2f$>*tKQiU8>W=fH>j6$EhO#gVnTE=5^ z6RlAe*1diw*Uew|XP16e3MFgw%1@|LDE^tAp6;WMbzi=jbEhu90bVrJ`RAKUy_etK z+()kBw~V>Me*I=1dm>}&;pTGlKaxi4H@wJ=5_XCWxm%(MMF~J6;yaMcPlK00>$UQzAKv0`;i0n$8fPmcI}GpXowjr# zo)2#Th~}6MofNgQ06F8EO!q}YiiZ=ugWQ;vcsDTao||mn2f~f~+m$jqs~JR=yfRQ% zs0>bX#jPbiF}RB_Kj=_5UL7#WLxWU)xV;Iib&Yh%O@vt7cZEf|yicI^T25FicVkM4 zi@JWxF-7;k@0ihvZ#vCKrF!g&8-v-p@HXrXi<-rv8BABqkeev!8FTb5F**5khHZjD zs5Z`7?U`JUahBcTT)CToBtXiYLAuRyO5>b}jg~IoGFtwmQKOF-7><_kr8bzNYmk>r zgLZ%QP-ZW-c@E!J2k(=gC^#M1=|8`6ajkmp!qVbu_58}*{317JF=J|S!y5_TVu(O~ zRl8b)Xb}PrR3DWrC|wOSi{NW)fg`xzaf5my3HZZ(*aT%B$fHUGj+1~SIzpiyo|upw z4Ja~CM-e4Vu!33{QVlK70D-cgf`;%3;X=9;L}9Na!;%Z7Q-@}TJnQmsjaqwSk9?|a z7}2FDi?@L2*%8*$_9egw-b$JnWe#!d%N6d=dW<*EH-erz%{+*-N@`TlQ(Ha6f(iSZ|J1ngQ|__x4}#;y>;sH- zV0Qmc&+fh4KfdwW+5NUC6SIS}56t2Yn4Kfi|nT=N{e9vMUi(dn9ekc$w78l^ zP-kx?5&{E^o^ue@MC}Md%VuH*)EoWHpbU}~-VBL13Ar`C5W&UuhUV2Mcj^a4Ozs6O z%AL&k`ZIIqZ^sKBM^kylfID#qw7Yx?n!ugGyEa3|hg&XFB>99l{Pjz`3%ExLOuQgt>d3gEC`b~CeKZZS;`)Ui_ zm$x-{^)=rv1h#E$gjTW^{kVRGhiZ8 zvz4sFgawVF&(2|{ht(9Ewlt)j68L}MX!=B$Hh>@&V|1uZp3tcaQo2mS0tQY;lQwR0 zfZTF!rT67QTvi5aw`~u3k2n6uU>QHnzd$l_$4B1H+-|as5yYVTjl(#Irw{CgF%U3Y zHCq}d`O=^akBc49(qya$-~JPprW{w`sq)|_pQJNgAFa z>&hJewH3D?4qwA9akO#c`>ahZ>tD@oU%w?}e6c$IXtOrjcYN?O3-%#D@n-Ymqv_o! z4%p;*L5d%NgHwLVsoDv)n!+J!hb#w!gl;_K%_fmlN!dqajEt3ZJ>byP7#P8{gIW-n zHbqGo_QJ?m_?U%Wq~DUNICcf_*bilhi)!5?tc!JTEs`2p8##MbF}_;aVwr;D0v1N8 zg}0d$B&uRAgQ(2)zC7|cCw!)kORl8^aa%* z>doAh%eFyh-t$0YFg>cSfYhWX@NgEu8bJP3cXwCGz|-S+4MgUz4=mtJ-@My8rwt5M z+NUz|n0+M)o*;5u;5kTT#wr|(l2 z%%vHv#%Z;o1ZMK}*R+~!fhsDW=;`6wq>e0YDS`Yt{XwmilQR}c`J0CUa>=xkKM^l* zQ1&aV8yRBNVp-4#&{WRlE32}P(x^l^4>&}Br2JZq;~r#cq$1b zc0^^NNkUOVRvJIJDzG_$jOaX)@~b_MB=4<(Edz5gCB$0Kf~FJjwlxY^R^prxcLsId zQ}m92-=~#RGbn9-Bu|*O*VEaP^$efwG51pKE#!dv(=-QMRKD!9*UHVUzGq-~<+&w} z-&?-&bDM58*{of@j(pDsf7$7I3MYjLfTQw>umLJWU8P{9ywuL^_WIIS{gp@U;dj0`cGOqK_G|N79!U1( z=5Jy)$`uG{j8I_<%cnsGZ<%#8YNTLr6Abv(_)%sF4i8N>O2EdHEFqG%xrJNDq{4pO>?pgngw=5~l4;d5QV+Gpjl6!mAj5%(OzlWEO=cqm95U z1$WETfnZ=9Cv;;gS*xJ-;aF@b!^<~ZAL#k4D|QT`=C_N&%EzU*Z{ErDtScgo@>(g0 z5x@eUUUDt+56|9ue8F(Ti5I)-FP7^sZsR`?gWI_b!j`P<;oB+V@G+C8l1 zbYyGbk#nJ@j8TABMCOPxt&&{F7hn$k1?B4rg~lBMI>^|F+p*A$T~-Lwt9K-VqkS~4 z0q6}y$noJyXupnY=L|{0-5i3}!Jpv)q>C9#PF6%)+H5BeHG*2(Ty{ui2Hyi$6!O@? zdKQ@&$#Bw!vSr)xAW0Rn7vni+`?MN%E$4zMxoGP)e&wtXOKD6H)?(j+#t+4v(UB?Y zeziV^B+zm+^@RG318` zd_cgVMA*euGz5};!MLdpg# zc*afe^nDlCE>y8kMZMx$Rtf(ec@bCpJHLMz?*tAWm^&|%*2*)5*T|=Wvq1mc>SFbo za~G>?7sJKVb7%S3IX{F3&x+f^GA{(%glrR{i3dCTDeVapjrn z^4aPfekm8K=iY<&$-*L$(A9y;vFZSV9}~ok)F+}UKxMJ<)=~Mrq(*I{Fh<=@hb1sr z2vbnW7|Lja43j;ztLV(7N%fW?ls3(sx^-l{F~oS|R?PNqrMS;qqQbciUo}iHZ5~N# z!#H0snPsC3QTPhtVPdpW21f&x!kHj?Mq|@e0WoWFX6`h=dUtgWSyX>lme+LB$K6cv zne)pl5s=q3*&1W`nAGfoIrRc)O7B3ez+rvzVQI0muG*L*dJ28Ez@0JomeU6P?#F74$I&JWJ>vA`cD5P!M{%Q0{7}2#i(LWPoD3r z!iMomh5QU;s~Q=u?x{`<^DSIKvg;XLSz){|&>GK5SysO(0#WRye_Xs^MblCQy=?dK zS%<JoN-^Px5%9`jDy)2j4xL;OicGgtbehx?Yc_h+6$!Q;1E+CotER3~3S3D8 z@w01Z7PAn2RE^q*4gSPh-e=?r3Ui zV(fwHu<S_F#7CW`{xV2%A@Alco)%48V>S@>j=4h_EaPiEUXY^*) z#lkF;ysv*83id#?I?&$F0TH+AStcBLI%%L9;bP#;nnlPLfua*y!GWE3Rd+sKW#l_w zcURlc4R7`xiGjvn8L}$xmDT73u{pAA9Uxf-3CEbgRP4ROr7N|gD`jT zQmt$C5PF+*G4EO4DJYh~ct>c_X)HOkI4_?q^Ui7pwG}222Y|y0v(T({7?)!sd)l8( zW}smTZZ%zG}LwN2v^#KJidNfWeyco2->-;2OLE~l{@crbVI2jS4>R-dV6EkwE?-*Dts z`cuh;1<41-mYbXVAv^EMrbihvffUX$Fr`_*0zvK-Bjo@d3bOn75q)I~uPfB0{au?4 z5rNiIvf-x1L6VcG5;J;)`D`dZQhg>Qkw~T-m_K%0Z4K}#Sen>DyVuJ}S=%bCU3_YH zHjgHeb&4-qBNwtlmNMq0n7<<2rC}_tl`%%mjr?K@LLTltX+=?0d*7fua$M8dosG`r zlB~>T#O{ntD`p|7VNVO+&~Adgf>IY!T_nXm0%Isb#VGI@uMx_8C6d>Iyp)vKE=caR zF1if@c8n)dQ5IZO(M!cA$qWHJ+3vFMc`xj;I&^}4SR0;dR1eu7D!1)G;UT?KK~xKS zvc6|}PXj**RB}_!cUx*1^-5}H@3Qq~( z{)pQ5+f=GeO6Ws)D~Fu|x&}WTT6_=ugVCoDWw%y+YH{V<)79ExF(P7(B)luLxq(bN-eJ-`N3qV}{( z`pf@mxL7RTV{lwGLEfr`lMJCN{+7`%Bg!zxDx#kTWn9{a_?w?JxN4iWyX*P)y(#Ek?aF*|ZSq))kkvOEGAT}%j{Xv@5tCju{xajJF zf`!&Do|jF~^;(1lL50wAp?I|^%r@Efe96yCna2Ba!Ze{t0;8A%c1V*KANp*#S zkaghsdlxTM*$%6mv%06h!gq^!F}{}~6y{HKIYpnmm!U#IQ9!D8+-!1BwN#Iow&227 z{%ZWNra`?*o&=I$z^Lhq$SS8}RlWkCXYH%^e&fHkC>p2$H`0>~hz*(9^e1Qy9S_JH z*{~hEDP>A*gb?|73A&G$34*at?-EmwGb%yQf|P9PD$}F2Lyg(p-rs>79O*0dG5|9% zGi`&1S@#EQ`)YO~F3YwOlNFFvzW4I@63u0JY-l7yKhZ5y=atkawHi!a^t&s38t%@} zk>ke+(snh-YaVu2+CE8sMzF^EPD#2RyqVp@j;4)I$zAz0BKT)9)Hwqk^cFnw4`q%C zloQ(9A$UHcv zX|ZBNgH{xf>sDKalucytD)h(lLM$#{u&Ks{ODx-dDNY(SPiF8ozoLTkOTmDNg*mrT zGJ5Pg&4d_%VwX@n z$?s$Rv=LTFbC4j?j=gAYyEt#iGpzp+DN__D5a&;-!l^K5zL9OgtfDKkqs|p?mDM?c z5W?sA)9(d^((0Kx*DWA!B&~r9rjN0`alH!GDt%L4F8VtH&!3o{C~2`cp-s@Rd60~| zVp>JxFJYnfwLIPV{W>j0+dk;dG_IgTXiSFK{$(t*LB*>37}-? z-5sa{OK6x=*N{d$jhvws%6Q-(ZTX}~&5 zATaC^1%rawE#eh*Yr1HIi;_{mE}FPZpKoG`y%QywYDH3RCk2J78M28N+O4`~PUEFB zqS3?2&8S3#+iVE5++ELL8gtupZ-d1)yXm+ zWZX)NcZ#vC4ato~8(A(#rgpECzNHi_=adSqD0VB;RT#C>03+{TV91OK3;PT}FYZSQ zav@l22+_-h;TDWY<%0Zf!MJ+KOIecqDrWA;<@b2HSrGFxj?!PYiI!#5a6s0ec4lF# z78rpn-y|g3n1o!NT4~j%wzxb5XAJr*OZk)`sGRRne)w8}DKsE%0Y8J^B7k;+W&`~U zg!2tTT{ngou!A8N&ad+==sVW8X$$OXYUrl?cdWPiOx&j7S}PJSBidx1TD)fjsQ!h4 zfO(|W(|d=M8D;X}a2?h@p6eIjChV6)6Btjqj)_1B9`Y7|6t(K@v~?qjhZ*k9J8!5* zuiE>f10s1oG%%Q&io=XJ&FHhwm}VhBbzb0CS;IEZo`}mlkCdrlfPj>Ta(-yQgZ#pW z@=1#flc)%4$l*BSd5uhTwUyGzTmuC0;ot;9IUeOSt$<#kl_Zr8Axb8yiI64XULxZJkgfGWuSl2}#QNb0-zqAkb-WXl3@c`2Tc_xdAz=;_#cyg9^lg<*l?;NsY{W z!fKlUkbWz*K3}y`;2Q$V7lGT)>PQ<)#K73rfPK+4cP=1`mCPohVAYPVwDmDFcVD%J z0e8_39_xkOxHZluobyz zaa?azbhJcXKuN|f@jMel@*YqoGl&#_^+{BMbjUwjluZ%{q{b`h+0{E%dDT4=LtVqM zA;FmHu!_-IQtX^+!EzsooGJ=&b+DP|#!2l^gE}?zkn8RAj)=!@m|IWecNI%{0;@R; zD;c@ohHlW!2@;n(A%f90O+1k%P8NU~3A)M#&8k~g>EhDlZMu~_xlbn~6x&FmG^+{n ztt5p{0GssvYn54OPS&Sf3Z_v{jHyonTA0746v<@qLvRw~q(sF-1;^Eua|A%GV!vNp zotL{^D+0iFU+jz>A&4S9SiYt%% zqNHC5-coAUmNuC?!woqad6`;Go?I!i#_kLLq^ z5Q}Fotm5<2AG_+Gj;A`Mnj1$(1%;^EZtFbbcm-V#J#B9;M;Q#GUHcKs27GC3eNwd4 zp}|~9zLgdWb4IK^veFuU(#%+4a;~O(zbn(u3uZgbmpfo=r7MPG*kM<1Dbw<8Wd#I4 zMbNU@v!ArQ(qWPHd@J8@Q$W;5z#pDy*m2mUI{Zz-o>tEQ;VQ*SP(S@^($)3=Qc4*TB z7=)KMS9&4LOXy=%tcF8PGWF?ILBZT$uC-l?=)-se^phFQPv$IJj>D63d$L79Pb=nE z2am>089l-@uc*joYvd*+@0*5IMo=x&g{{w)!Lq+d##xM*Zm0~Meknk%=9bbpom$>v zaSM5hz2t@5mTLw!*3sv%0`PV*MP2|Oyl^{QN=PBOKg%Qr@HWbZ32lSytm9`7Ko&m z#+GwG=+2Zff1Vt`pzI36xK?S>`QQ5EC6-YjB|z?s=nn%Ikpo&r%e9&rYgHsY*7r&a z0Sa6yUv8&WLUAPWeF@ep`!x2=0Y7gYV&?s{)?JP@W>Cx4iQ0#R4gC^j4X=69db61h zp`BwndVsDjbICy~1;SvK^vxFJ&5dDX`X@cBG={UBh~8p_Ky6 z$@KxA+1_UqkuUoHg~doDt(Tsjd|>IW&zrDP+xoDXFU|QaD%`*hQ!9B+~~VDQ;NRQ zxPYkKGhZW6OSBz72&#Fxj`~?!MIZfG?0)MpU#~t?Fp0VRdMsIqNpoyyUoH0pPbyxG zbmy}SjHmAG$t1?!b#xrxs{49uq}9mRYx=M!n%7t4UT&OEAm`WcE|(a)Rrhk+ zBF0xl?g!iyBM1ljA6Yzmagor{eO`MHmT%pC5qfA9XitUmj#@_zu6f^`-E diff --git a/sources/FILEPKG.LCOM.~11~ b/sources/FILEPKG.LCOM.~11~ deleted file mode 100644 index 2dcdd489ff01e0e462c658da1205c0f747968c96..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 103287 zcmdqK3wRvYbtc$V4Uv>ALJbgtCXf$LcnQy-RhM$D4x^?T;eVlvV=iGhc6Nl5;iN3?>%tT*0dpKw9 z$xqnhbM{zf!sbo5YvyvN$tbMo|q53R1P6s^;ztR8FUKN_E%`pEm{&#s&~d&dJy53Mbox+8P? z{m>bF zsK4KejvVTb9*W0$tmQK+?w59+EG?b7f933Lhb()1d@e`t&)#XRq65?X6$_uS4nMrM zX3ai=kDRmooj-8kK#x^iI)^R?1{IAT8W_QUJ?~)T=+HlKpw`aV$iVQ(fThM_ojZ-; z>^o}bXDu}!$=vj8ueI-RcGf@4UhAPVD?ht>`r)%Y2)xu|jd)8F9X=F~ABso+p-VB^ zyK`bZJ$E>to2KsASdA$CiP4|9b!dEK=e`*$YR#q(9onC?=aQ+u{KVXRKHEpH?6+pD zet9-NKRvzJcQ}{t<68Tz!&b}!VB$A!W$oz+Tnt!qi!*dF$nRt`vlDZ7^&Pb{^Hey* z6M~Cji@GG!61vUYW`(z8!>N8p^vn$Fxf-!%CnmC(jZupr<1k=*^Jh^SSNUc5E(dGfb&gf2z>FS}*UO3~z)#x*qz+lZDQ!=uN(Rv=FKEazm?JSUY+p zJu^)M>!XSuP``!NLZs_tq*iEMExwCt)%-8EMZzDT!ou#ZwzexW+)O+7v%V3YYX646 z?kYd6mD;iN9q!Wi4_Jib7BCAl`Lq=s9hQ6CWTRGecz~yAD=?1^#sk#{qTX!`Q>vcM z0)I}-V$KJ>$7me;WOl;NCsQ-n8gq*TIlN+Vh?IDBVxwu+?N&x*j25;+i2G~MRsjCa%Yt;&Ss@u6{o86MC-k5Gbxrevb zlZCy-@DuBykCo3b>^qNyzmmFCdOT%ZN||r)8!u*xyc77QyE0ni3vY90=o_m$uL$9v zY^4`7g>Jr*4On_~weq>l#mVZGQ>CtBZ#s`n?Y*#m`RBPtv9OP~G;hanwWSm>?kUC- z^>WWNKj(+i>T7M0ZG}B;Z98(U)hl=H%9zKU-wJ;%*LosSD}5^0YT!55YMyAV$(!{r z7P?pKUn_K%PIlKmn~O*(_o%Jys$6@xdc`j1e>P5ZWceGF>)Rsl;*k|@MQ3*Ab_;UY zm1{Rov^&2Y0-_(?VsBgV*pM|nF+Dbsx8nUmUWlsD=8WMH_8ou|Pz7X>pP0@aod7)a zTbZ0aPKW{k({I_cQ}eTUKMDks&*kQ5sR_i1!o&f4Ad3n{1A8&vFL>FC4GaE`#iLd> zoyp+C@`QGLbVMFT2L~-XlabC03|fnfa_~1gVvQHl(*-*{haR9ZzOGOU;S%m?cJ^@Q zh&3R?~7 zgPUE`OGWte6QJU1lchl~y}gkJrPP$%N`peujow_q(P|gcj^!_g_8Xzl6%19p;@Bc> zhQKZ_I{(>0@Laofn*o9!7n03A5Nv~WwvJC91u4K13p)_N`Gi`f-~N~0$wc+;Y>K{_ zLCRSBq80{*fh_cb+>T=$rftanD93E)#-f3dq-Y0iT*JjFhVD|m{V6kC{od+hwbJ>7 zZE|5GVXyLjzzB!b7=TED;b@Js?TK!f}3?Bagh_U;^?$k3n( z)Mc&EznEZ003oqr{g!Z7#J$lKL$noo(F}#c3Et;j3F4is3Rli@TB~0g! zYGbO6-?kG*z5K7;hF0HnekrssIvBGK=4Ue5-1tPy!uIlRhN9MS-{22=*H(O#w!05e zTbMTQIfy#rgSp%c*ip=46f?|BdKCMWs9_-mZY&B4Hh~HWOxg_gq7?RHk*JV17MG0h zcD9CwX;<@-Y}G9dK24UVmq?9&dCY%tl@SWJefi3SKo$ebLiq+P&008hP3ywOH3eaa z_(>|_&hsmJRrb@WXt?YEqs9;k&dxlWz}=&!US<8l0eZoGqto=ilE5pb@tE28(%03? zFM)j3#;}A$(aiRQ+sqyGtwsIm&~vttW{B!sDB_*Zn6_!81a=ncm7hzeRv8|cSzV3T zM#Ah|FgH%7eD#jiEBVwU58FQls}Vhpf`TdPit)*WFs057MdK}dnqPZH{nn=M4p(0_1d*gh<aPdZ1M?*K&?5OLfGnZ2@!x|{3eFXn2Q|w;e?u54 zTwu@>3z)*$*>nz~?hsl7Uk{-xj{)b$Q9^>l;;eg%$){%Y{UAWay#_%bK8j_5K``|E zi2)#SDxI|kz(u7GGp98G9*r;J!2Kj+$NPt^u}m&GHH!%zkT+ukBjA8YiUbEX3fUTj zVnnq?%%V-K2B-%+&U zZ=NvUhdcr+^F<7@;?gEth}#j|R=IYp{C@kBMI&q^e*9IS|GzGk``Qv=+vzD9cPD;a z=^A@xD*S~hJbkTbypgVMPeEpSEVcJd)cxbhh)ukjk~MmFg3%{F%%`;U^lF-W{`;!b zn13Uk8bdhg)O<1s0B?Q*4Co#+tn@wkS>YvX%r`^k+`;RI?viYg8-vILeL*T$5Up8k zSgRU%R-26=PGcFMKZF0!vC!Ue$D=NQOo3tFMoFl~JT;VYgTyNOwttgZ+;>Tq~ODsgpcz_Cem3*gg^&_0q6v) zt`&|T0a{XnbfsYRr%b5KB~QW@+LO4oKbgxygaVfA15FywOyv8C=Tu_18M3cC++GMi^l=Qc6+ZEE~&S%G=_nF25MO(rlqr?i3wn&HMe-4 z-VRdJ3W>Mrw_SjjUANya`?7jVjan2~{K@qA1d%iF4y>O{kz`8hD;M@>pzjutCuNq# z-}H(o%l?i^cR(e<9tjVwQW<1W?JjJ3Z?LZB9hw5KbF9(I*t0Aw^;+ioHKKqYyP_>| zWnoXLVDT0@(aLh-bguQ}9^P{I7J3R+u00nKmDB54x-S*>$Zf4)d4%JaipB+cTG+D| zp1h{D1|0fV>t-CvBCb=16z~b?jEHe%a3MxreI@u2!qh(~m9OR3(6_EGrCoMzruVs+ z|KN#!B$%+VKNod>rgVRduN3ySMR)S+xeg|H=+W+C_zUKVPUnUbowW~^x=!q_6S<9Vd3GHcQf{~0y(TZ^x~kXY zcAL4*Fn0$!@XEe-G(qq6E6@vjv!aT+75RZY_30S7UnloK z<7X6l@MkMzTo9Py)kM{1K;qm4=}b5A*`gufGA&*EAr}6-g+0%xcJRHE`*xLzT_MKxz^_gzgfHPA@{VgM^}4%0aTD5C$E980A$NAoBr= ziGhqm-DL9UD|1AzP5w53=Lj zclzN|MQD$QtW&39^d5?nQ9i1GfjSt)0%TW~&Op!rWV$aC=^F$D?c3MWW8ptYT^SqP z%p9QXh}E-X-3RlKb!zFsl^$zqVv$!i3YBSdpWDuBD zCMp|~)n*dSRFcRrGns#H5-f^(xH?cX%0|@KACOr{Z#f_XOh1WkG03p?_}DyI%pv=3 z8Y@a++FvNWff}tXdNtXocI=uq?{Pi~GgWo_dg$d`hk9qtR2QXU zk*8bD$caw=WO428dbzvS7TL)U3;STwx+d4n&)Ro67m925)Ss-CoZE|QR{e>ZGgVx> zs{V3u?fv!gwY5V3iQU!hJT&>pV4t zD~2&-(pkP_Et3u7N(@$fcgRrn#695-m=>dJ^5rN7C?kjxLDHr|nEEh5;M;**@copX zx09F$U}fU(7QM(?myiVln6EX`iDx~KKu{q z-oHAt`+Kd>O<^NsXqkByxWa6dl|_%^u8!i*FsGmudRd4sX=@fo=T-ABbHiga6~H5y3+^nq zU(HF9I^3P2Mjjuq$zD6R)e@Vkfp86=6e}CU47>OhT6OmtG{lDz z*%xPF7XDZ8`U67u9{D9XsHo@Jn-7Rx$tkpBKz87A0j64j9Z-W?sQ*b+0wz};M}cJ( zB_ypdq)n~|+{eGb-HHK+e5J0STutCZATDsZIC*9TzNyx!l@Brh45SA%TM_Mfaxnvdas=Qm(7fbFhfW9dO!u&4w#5=4(? zwUvO5)z`1W2E!(PVIp|{k=?~L+{4C1HhOGrpWz-ZDO9Kp_f7Yq{=nPf$4&E3))*Lr zTx(4D%IyZw<3rn$RhYy*ytYtIjF&sdxd5Qf+%4P7{|J+xTx(HweNiGYCQL=fbj8X) zDR~>c+~wL_$=?0~;Z)wG+6e9%XQwm*sK1i@+Bkphp)rL6z@2Kx6@CEYuc_PNPS!Wx zwW;ND-c-=~+I|5bPGko(53ZRwR@ zd=2j?uY|@=`t0;SsJR1PgwqLI>c2>qdOcPfrg~WKseeCtftq|`{U=Y6RbE--@y=%3 zyl<6OBWkv2faLp7y6|SYdLtvxd&1RmvDg1UXiF!MZYnkvfQ_VK;*ZHGfR#*2P#8izU<?*~X=$ij*O5ysz(_^=WInEuCneS#zb-rZ|I3hu&prx|3thp~)!#(G36 zK-U)R32>Hc%*S&mtkf8QeTD~!sh_*c8it7Cw}}sfvw>a$=yAU_1Z9jeJCiDth7ZLe zK09qEaV@uyO#HV{PWf-~QQz$V?B{$7B_iA-#9|HsMVcZ#qOzFBK{77mZP9a-CHkBNZG4f7+pw0#OV4dC}HpbgZo^_2(@6(DY&0YK23Wh zS^p&cFwQzhSMJ6MFNbPl&y6J%s|$WOvB@eKvBymD?x`i5KTlRhVRGmCm2U6FJqcaP zk7_gA1HOho6dG{;oD60(aY0av0*bUTp45YWm30(~FXbCcoRYf4TI&}8P+HwhFzhpY zg2z$S@kN)#B9aT(<`uw3(&|(|#8zZg5plg7!Y;$IO$-!k;sRcAy>KB7tjEWRp=s-f z`ZwU7a{$wBlp3`UiRmiw3W|p+seO`HsIm44hGhFU9j~R>M@_$Ne{$;a2RIRq^ z{7bYdOOWuEfTteLgbh=VEv9D@FnSR28Fn&7-t~G?gAO+2Mlm%ZGeR>7#H7GIrhQVd zbHLdqxfuFtII7qgzJbCTdyCkbJl})&^f{W4hMJTV6a~<`(~o-e#EaJmF^n-Qmroxd znVEE-8F&ok?aVB5lHilD0C7km#2z!hLoU4PLd%4qd$A}jv?xqFmd&K>mS+_)`g|!e zR%8a$Qqo=hS8b{Cv@n@9`Qg{aM`b~^@nkyH6-fcmfy&_{b#x*>J7EEf9QTdspmz;y ziHHky`)HIT{4HwHuvk*`iF24Jpg~b7aa08ctS6R#u{cznuYvo?tyy5)`}&<;Psn4- zHJd;+^A8KD!b$@%ZPpJ%7`y>&iiAq#HSs>#0+)|%Ji&w^#CsKe_0$9Jq~p@({~>%6 zFip3&nD5*lL3tuHho0cdVkY0II|Avzf^PVr??25WVe3A)q6sWlnIj_kkg6A|^H>!)7>UM;l+=IZAOJvWTjwAr2AU4!@zkfausCMcHBeV59 z@Gi3;sjGdD6=4l*Zh9I~Q0xE(y(M;#zJ=bg@muiS39b%nUjyp}grR6!)BWx_-3z%Q zJxyCE6fzQ@Dhf+YmX7~QkcFN$ZNhaSYyQ|>Z~g$SH*`&miE#xKt#CM8KvYl^JA?Qz zH}3r|A%p}`gt#Vov)5|*!8KQ)!{O?6g*}3vN$hBOR48mjFYFD4Jq#i&C$%gqzv|k0 z%h3e*ptkbWDSnx0=CSfkiGuZwLJy(;uTluqV=({kDOhVQ@BwkI_gDQ=0uOrFIpprD zm1Y5`B`h`Suc+Vh5CK`N7_Qv9${h&*X`yGe{&K;3Vmy(JYif?TKkK2d%jCY8P# z^tZpunN%J4y4&E4H(1z|^moD5a#PN3w?o_&U0zES_P{O2eAM53ZQVR2)t^>y;eKT( z_!U_P1{HsgH(LG8>0#{FgM$#to!~zax9y`|+giE#f}U3S5W-9W1IGX1F6)`B$3dia=bzw%zSqLrAw=+zgNzPL_Z z_=oe0zTph&>4Nc-WBX3Dhs!tQ+SRsxojaFn*L^|ofb$*c`^(gyjSs6aItS48j$*ic ztx@jDb*R@X*Wq&Y7hlMAsBZA!3FrN`9!0rVwQ!YGz0 zYuV&0&Ns+xK!E^F5ixmolT1E8He;tDAI8AIH?PTl`Oz4}R97M*s}r19nl}ubi^eGe zuz3Y(j{1D9`~CN>k{Nceh+x^=XJ6Z}&PBCBessldRE6+F5pH3qB0Qmke$a znAE$l;%>Fz(y76>-ynlqkBK!<5VxT3-+E345ULw|>>Ctm{elkzgBsX+FTwu3)v$Oe z2H>3&Z253fiP#)b5_}f;D*1{ve+=JpijdfPu<_==!+JDwqj5*{ay`0RdHV**D_Qldut0ZhI+qwurvYZ^x(YS{U_y=aX> z*9#5v?3|rNFwZE+K`NKer;$I0W&BaJJ%1##C^t|`y3+qB0K@ImC_cwkM&Oah8d_@v z5{9~hV1b8>aYn#>D-AB`!TFtG4B4KUnaGaIE!G|yOS#79F(7!;!(DFp6+B|85DNDZ7BbRV5Fc_Z@hPgXyjUzxjTMIy#`hTg z4k()`{2r^B%flZNw1am=44Q0w=SUVppbp@|1S?ez#d5hT7t`<(0{|j)3xv$K6CpVb z>CTf4m^)9VUjbF28v+OL0RZUCLBJ#*TtB>#tCSx?d7}hr)9~;<}Xo zJ^>iXY7}NqL*b54Jcg^Qqu2{7h0ys?^NNr;rz8&;_VVWwdFI77*6gPe^T?bNNz6h$ zq*&J{ZD{A_gwHGAnkUid$$X;z(R|{^8}B_j+lHvzV*17>YU#()UF~=)zgmASQ0t5Q zu42LSl?`be{1s-{MIz)lO&J+z??VOcpL6UL>iKLAnhsTgt6EBUD{4ARGc_*+;`h z3JxOy2NuflVO*R-mJIO1KP*Lx;g>FzK4x5+GB2jg#ag=B;(Xt41dfNiy%)wD02u_%{`&$f}w`e$3{4(|OP4x0jt#(JO99 z&TeRQSg7lMZqlxQ%?>|1X?IgXgFmN)2IXJpXP-j=on8Ni9e#4k?xui^|GQLvRT`){ zUxqut+f6-%U(wzp@TXh{KxRIy1Vy*+4m!;(fkm?~dIpr@1ipZJvz$h>q>)#f<%@p7 zQ*WRHQb>YdTbq%RWrW~|%q(wGW)_+uJ+AM`HrlvR-a)_%rBl#h?X>=X#dZU@;JxjN z!JyXsxv;fwOWWai@;2{+m^XPUAPhX$wMDmQI2X=)pdH|i)cvh=u9flkx2LOD zXG>jgWlSX7`NQm9=dUjwt4$&%74!1T;jc_yEImGHT%0s7q^Gz(p%1dnZ82L++_vPM zXX!C5`Y8F&^2}Jw)gTQ0ZFihzki9u9fW6YC{T2fgChOB4mfpyuwzj}sSF@j|Eks%p z5#Cd#Gp%>$O`<3}_%+^n2SLj0^1+noTbgmUoQWmqfe)$(j z9nf@Z0Q@2UZ@FKIE^jFe3qZa-0tY#C1H|X-Bb=oO!aF|eu|(K-WHunH*SMrZ#s`j=#d z6@T%n_daXVk)BE96av+t3&x%uk>Y>?K>(xs6Q;)1dciG$IkJiR22L zr$J|IR6MBoLNZd!Pq4w6{4*$jVS{5c$^hxJx%qsOSAy;pD@`H-?f|`p`@L-gCCTTFtO7x3XwubVfRiL>_VZFt*{u8 zJnxFjkgiEe+XT?asmcN)Co_UeD<|VnPE+J}LmW6vMn2~a%(*b;SPF9Xpy%)aBB@gv z0eSHBn(&|UohtdMuny3^Eyvbpi;u2FnJ= zkeT%1MHxSv^RUyKl)|T*OM&MoAqU=KN8TniAwxDPMK9G`=#zd9B|#ui4?f-gI6jEQ zW4XB$IV33=F>hz7j|g@Q7Jv|Qo3~k%gDUt8lOHTV&_s@F2ato{1&pd6SPx49#Rc>N zGuUgJcC3mupIK0m=dw*HT88{OINSu;ZRlEJNg2OWj#JIf;0fmtfCow67*e20&R6Lr zjgOo{e4Cl_y!rM&`G{zQ!HM30dTEPmNt#-~EfNYa%1~cGiAtWyy~eGmv#3unPR_Ts zgj#sd*~$rXS-hrTqiHF0BdmN!{fV_5kF8y$_{!PslLox8CgCtSX_{~CpzTzfHou+W zMtJjwVT1AAUYs_}mvgNzts7sqxl+Bd*A7emS-ZQ^^#N+)iSE}18=i1Emw7mCm33XGJBJK(If&jerQCs^q#(>OH1=rLIfr2T=PBS`OgGEhs$>4(Id=y9h1?&(#C8`V5qxw1?e(8L zuDS#R>yOLTY18+Vzbuh`2r5Zpg<8FtEnCuLl0W6m3Rn&NbC%SEmJdiZt}tyF;&v^5 zM*L=m|MFYTd(=y>=$EgTm${03h$}+mJqEksqr4!K#-zy=*acg^xd=0#27+g6GO0C> zhuxz(FOxehWKV9KeX0!&3(wY8)gpYR_KULKFnJCathSpap$X3*{}FJfj02gIJ+)~C z5L2qb$}I}4r@AZGWs2PU?yvJt7boqgO-b{WTc&^w9Uz zGTbH)2h;TN#41dEJn_zlkiz1a1n(tiC@5(r6(H6=>NZV*i+Vz0 zXxZ1B7+4ylM4HcxQ_?S*Ydww_2$wj&S`r}2Lj@C}jUiC{iw=su2YoPmBJ;Pw<|`%$ zVW6Zfmj%_d5%voYP`pC8dgJ39Yep6jh@aWq9Ffh z1e^|@$BRF$o}i*O|MMXgeHIz+U>1fv_KOm*%T2hlOax&}-aWIRFFAfLFt1{m6{wxlkSHHbiA5ke<>FTfsx*V0~i>bg<<9x!RKPwcle7sZg6c3<|f|! z*vK*LJ>A(DI4O4)V%T+`ALhEA`BQWt z#QmpMe-6>T`peeoht92@K7|NgY`uN^7AcH(XAjO$$Re(nFKnx4`Sh7{?i(oVwa6IH zsgBXq&#o@%`8i-^DE%?T6rV=S?-^_5!#H~3>{)yPNi2{Q8KK7b6gGZO?$p{N*4fh! zu2}ayeCj0iL2BSJhK?BGvpmr&#rJaKY`vo};(c1{b>M&p3BCRg_3T9K8-*p)7u;p| zSsbr{k65SgLzFVGQjd$zS2au^tqA?R>;v2AKhv7 zya!{zpd@&@w1fy}1U@5(`a@?{&z)O2Wi25p5fRh_u-o*UTsrmcbI9d!s%WjCEldv$ z$UU3F?V*&PKC^oN>ZzqQ%PqgpLQ65MQ_qpp)>3JOW*Tj|OSyFFkq<3Bawjr}kQYvm z1(4u5;8{L>AG&$gI{V0j%cs{?PoA~7v&$>!BLVbEk=lm)hW8qE&YeC^XHvqV1mB?G z{vN8x&%H%MUX?TI? zreq+16j*jSNEMq0Dvq63ng}dmR;}%>E0WcnDLcW8(FJGOtlW|`mbZzg;`yYG$wG~! z!K~#4=MHCbxJE|0M7eQahSr*u-u<~&9+@av zPejT$cEK9ZVjfh#{ZKJP11a9w2CP?#F`u8bQ#y8+NgyYxP3^%v;m;V4_M22f z4%lE;`6yznTrv;^#-e!d0;fR*{r4ULhFv%Z$E5K)tnW!p%0RXh31H>H<{o-*4D<{r zK0Kevut6gL$kah9C1cI^Rd|O$>l;1~%Ej`HcKMi{Hbm^{HoME2v>{ejXOI1g#Bzko zr{tZK4YzUz^2M6Hab2>!OUjdDy1WLkekQGi75(l0)3az|qAFyF57&RGssBT7!?j+7#hCs%O@{D9;GGo7C0 z4LdQ8h&`|>KG>w(xSj$m3XaWp7tGiJ{}9dDl6LJNg7}4j9QLl^iQ>Hv4oJTsEpc_l z3Xlzo)W^brGyb8-7`Uo4O;*khTn;{zV4bhAL-aKOo-TzpLxDv%q>G_nBGQz{tA|od zF`}frP@v1;uJ^eBs=>|$MHl!KzMP0(|a#D zfAhc+POv$M*P<;Hp8#CO5lAm81@NV*>Q0=MarZHJd@nkGlG%H=^Vg{d>gAt%U@2U_ z{edMF)_`>2$B=|B()}VNd&XV*m*4y22bO$ju5D?18d1LVt@5?g=Dp$SuF}`1Vd<~l zM4!5VP~Gopr{90|bgs2hUv>U8>-=tJ??vZ7u9-`1hVj5sTD~Gb1d-tRd~g>7Q{N;3 z3=1qC1Vw=an$`k0;cJY1T$)v*D9hk_L1P*$abp$4pXdPDlav(cnolXbvcOO&VG3Am zg;0iI{0sX7;%TMB8@HrH`BC3cdz@0j8sm2H@FpEkZdZN8ONjohd&I@HChI+fNl(ynut)O?!z<0Lm%lLz}%gS%9P zSJZF$J^X8SE=g0#o9mYgllYTYBm4Sz_<4Rh-u)E+KF)u&vgv=S zB`dpx(cyBQxkpP$eb~;;S0igDG*#^kOUIo!(&cv`l@`+FcOb_na(bFbY6Wd}S+!iRQm1#Mxs}f_gL3)OzTG?!*Ub?)U6geD5lJZ+Y8#=vn?)xB6JO`dA{@ zEe#zj|4v3>m`l0t6J533Zgdr^dSW+q;f-9^Ui8p$cwqJNo$g0?P&@FEANhYS4aHizUfw}a?jLdN&t-4-R3b`Z$wWtROSP^h105+{(1z8I+eqXyjIow z;CbPhJx9u8T6mbY`56BEcH#Db;I(;mPDd zGbR_{1LXn&J=2;T+1}B2^&v&HhDk#T9nUb-fc%RA((e!yHB^&kXb6&r5O+B4c-$YI zj^LlH0o?0X1|VusGvtFi4V4Y(Ayj41prWIysW`Ob{@3HsY6kA1q7B?*7a-d<9kyVj zVGw9YHc-jJsatz2$6#VToSw+w$cGqY8hxfi3?^%+IMQ^UDY=~Kln?OdXZJspL4!tX z4pkRI*x{crojyh+oCQF{%%^c6gV>abtv@`UWoZ%5vGHh_WFq$ulTxZq&w?+u$>Pau zGXOVG17I7thYAdXgH{^nJ3x*i3%I^yH|N9ldDDL(>zS4NklpXpNhrLa zCW4M>7+P`f^JKu}LL~uqJ z&--{9@6BZvDbrs6PHP`MhnO&P7Y-96=7^a4eZ+&oW*)^Qyz4ETnRPR4pJxLJsKP8^cui(ttlPeY}j`p!5pC|$sJxyR%RDria;YGSZnA_!7 z-S4GaFm1Y3-HJbNARa@zsGsCv%BG=A6zDxD8>Qp&bsYS7+aWGj!;GU!`Y`esVg$F{ za*MU^IL02Q7u~xU*XIXO=?MyU0xJ43L+VSwhq9JSYf#!1SFmQ1=McI+JSi-lIYoyz z_VqzOr960Cwp&oZESe5|J{$@g$jcyt`*O$#pHCPU5(wR{eVjSM3zL$lgxLx?O6jGN zb8DjbHD;b1v3N75u&^On(Nlcqdtsqeul6Jq*Sq*xZkOvU7SF2_ooZ<=;6GsD$qD7S zggwBvLN1El4g2VlErT&A^fQ3@05Yc#1#&hay+51dfC~c^fJ4c4!0*$U4qO}5QY#-p z_^fQko*o;w57_x5EKUPYZ!&UlI^{-l2*(U zKvAB(J2(tQ!q>Gx3_OmLDD_eb8Wv1Y>?6&%HuYB34SFTfuo_Ha(tk&2Um~3=kKwARxnAac1 zl&lP(fwJ=#^_5g!&AKYUEnX(}ELe(WSx9<9kScjvia5bbIAy<_purC&muY*3CJUbe z-$85CupluIiDuI5Vew(*|i+_7U7%wRc5QNrs9WO=`CjA5UwmvhiTm@g`M8*i>Jk zgMMgplHmx0B8Udf1c#y67|K>7%nF5c&=oc_XpodC#xQ2Vo+BmDNl2w3@{MBiu&_Ot z9nR0dUm?Xhb3A-hCOfO~AvM6dY(N6JvWlzsfx;akl8HMu*5C+BG6;~7fy^OZG1d_$ z+X_D^C*1ZTMPFkPu&9iZgU}3Qh8TxOr<`3YRrZz@lgRh zhBc%;tzM;1LTg*vHU|0MX2i;mE4QYcZY0D=*y3x!g=VMdnJ8xBKbFMxDAl#_XsXSA z7Y>iB?#e~l7mA$c`*~huxLb7A5_YcBgOo*IALY6Z(&|JzYWIhwujM+^U6WlG zN>1DdDUf}eNHtm{65yz7AgKjNr80G7IpMMSoO@I<%>+0}m`0NB;fL~417gSHPh6%?To>huN z{}ld5GKI?@Vay=mPXKW`P9Xr|1K8pU#0Ok4Dz3yRz$%z20pGY{+X;TPKoo~gN}xRM z%71YsLZKe`bT^4n45n%I9XgXu+KeG4NnL?~R96r*y=W!-pYB zk=F!BZx+@B-nzg9>L6+&m-I!78&Lubd_RbPbvJSxI&60*Qv|Hu%5ltx`+)4;``Au+ z`qYYWML5Ko4k)0b5x|+kQv!_=x8y5l10T3xGIb*xG-^b_6*OW1j5B8KJEfQ{ejQd` zZdZ_lW=UM+?&Gt%feZ}IWZ^im^JYRaYeaar6M+^W(~XebNh`?}qXRA?z?3k;3w|0W zf>RnPCf3?p#Mg^C9BpPMl(uWNttXtiV25>N#Z$G?o3<$$!}=4p`KW!7)ag)gEAvQc zawne}4gIx|o|Ox%8 zep{eD$3e(uC;F&MeJP}J$4109fnAeIX6EuFFnUHea;=}B(>O2`+FImwF*lzFPegnz zI4Sf$naRyg9B!OHfd)EBD&P(*CuRiZfZTkEz0&T$kkPY8;o?iCZ2Z8aAT#On)nyJ> zUcj6^yn}L*&$PgvajR;I(^r*nUPVBn12AITLwJ=O{}Pv;J}8SYyUUc3N-!$SL(O9 zLayE9NJ({UYzpu711e@8MzGJb+kEjUlv;=@)3%Q`%pLX6WJ$*&xjxG1tMFS@Ve;t3)+(b>zzpZ~uejl?F zx_nG7Y(}NvJLeHnMrWfyr3nQaF^y2gsLLp+tJIlIQ3%q|VZmt=mQKKej)%aGow1Ws z2m!~2MGF+%2fDyJ0S9c8l#SZ-4d|PcVzL<}q?3+RNIj)}A=4AMMbz9+%&7{5XI>aV zE(%fsF)C{T5P|Td6jZ0KMl_A2BfVLFM5q_)2M~T2XhatZKq0Q2k!O%Y1-hfKGJYNJ zLDnIVWXF@xFHlBPo8_eL%8<=#!pqfZR^BbQyp)wL=FNm*MUJ>?Sf5Zn^K23sx5g?5 zlGPnH{7AYYB9<<r8*c1ujB-tHi;ZX4KkbP@!e)Jh(R#7Y5PxB@LOE6o8Jv@4ZnQFbuL_)pKyfUuzn zI7X3K+*QWFe~I*NIC$bA3m!zuDT^G8d<+O&nV_KwXx;U`7n-$MvvGWKBLxM3e8G)dk`iG#@sJAI|+fbXWvQE zva%auab<1g+zPE1F((8Wda3*GUP&a!d09Wr&xJc9iijB$h@c~ibyBh(B z#oZH)Y4!otz(o84a)hcuW2fj#$s@>A%a=i=sjXkKIg=J+9NYj9x{SB3i3)PHDSEgZsy!XPya z5^VD?56DF-dXb}uiWFv=MsWzEFcYuX)pzl_MeJwPy1eM~ehM2#^;%(iY;{JHj1C+j zpq%LoRGoyM*}wt&hh7Zy0n7=(IrWk{LjcS7aEVT5=qk`p;;wa9fjSUCn zK8JN)_V$u3JsV>dz>EZL0Y%X4_!3J{*W4+=2KGOKAgUixxBYRoR1Wy@cg~x`oeT+# zi1f68r`1jI#uTj%e2YBm44U)#3;Ads`3m(~;rHwaiE9v?bfPV(BAj-9Mlc&#Q=APp zo^2;F-?&jYOa`g$7kCv{L45d`;d|C;9^=@pzvL>Ed;=Pl)|!sGKlY_;u9Zr82=I`& z$9aCuL{>y&8(el2lz&O_w*lC0TKIyhsR(Z4J}7_0-%@o!`pL~M7Rzb%xr%a~sh3C6 z1|q2Ge|(03u?BT zRD3y5@flq)U!z`#0}FRETy2xSmoUTJEPu(77kr(Q@MeC8tMMP_{it^lDq+>IiYp0}L5o8oFHQzUdz=_evRhH2M2Y+L_~YRwJo7Nz zMjPwV*{hq%*s&$ZZ&P|QX1zJ!LNR^vA_yV7HEb>fy+q*zBG4#?0*=^NVW>{#7U`8i zFnWze&@rM2Ar+ni6jYYjdroRbgvrP9BQ!@i$Uqq+h{k$4YR6x10PZQ9>M1=zpdJRk zsUFm^o61Cg2(@XTPn=7zv2Gj^?WQsa$}}x;I4Fpg5xQv7Dy#Xz@xTydU82u#N0%0+BSVY!spytt`~T3@)4J6yDnO1ohlrdV<|B@RsNB{Ls?L2bS*Vc#;Rnob=F{ z(+E&H_XvETv8eB;9^_E+W)PbZO<^x4egqB@4TWTzl0mz3qXvo51ehSg6P|A>+0SrK zJm086nrGz0=2TO~4}j$gG4c2&U#eJM$%@OQhzSrSoA^y~ro~1l4I@wssnvikfK+`m zq*&=0USn{GZYm&vqkD~I*4Hk_3K-{iG{?G?pZDw9&)Z|>P75>VjYQbG5wLY}AI0o` zj)%i6ouYzFK8c+Zp8cJ$a<77wE1v*Q!=LMZHjPW3KH_r}^?k0E=9a->shoNL%~_-g zVv#~GfJM3iiJ`z6g`O0?p%76lQRp#B9aR+#UwX1jKX6LI0XZL-EO*kouLobOWr}KS zI4NxMxpZbpm>s7dm%?T2RgBt;X=%zd<@Ym9*on)B05c>ZGT9^Zm=IkX#8CT)$=0Uj zC(KG`kh|19j=k+t_c*jTKH5vDNmFn-W61X?214t<1&{_QaSS_2x)cK`aLFG;DnBKT z!d}-*ZA9soJt_-t6ybe0;}f&Ve44eou!y)6 zgBp>IOeZP%T83jBx*aHpVcLQPUL}+J0)P3Q)O2u!0p90ZxJ9ysl~#N9PS&E*2B$;5 z{M8{6K!KiS$KNPeE_rt%j~AeXS8a&~kj_u`y-E?s?kzlRpwV}?B`}S@AqDfkZUAik z6<{cD=%;2Iq!^ZK|F?8XJAQ~=j9kS0K3GpOW1?j@_8$9rv#XdWb6KT<04gvmcyjxW(|s?NEDd2H2Do2~`x>BwwM1wbsTC4^qJY`j%JR^xRAlYWV~(Ff|?$Cre$E za86e0!EY-Spf@TmiM=FA7mo=+OSG(wEQw}rv6@0U+_QFho-DQ-d+$+Jvg62*+LFMw z+^>>6rXzF|Dl6EE<^OVVvU)X6wmF8BpbO6TruJTN{)VwZ{n=!({2kt|5nC}8mD_8H zszeBVaNizQZLh5l0M9V?x@T+b&MD|N#f0|fS4`r!=;j&9qywl*hS z8&I#mo+#;0mgj17P6-Dpr|VB7oUf$e3z|0SPo_=h8S3yqHWrKFUp9_$KLrkc=i&#a zepJ~#^}vrRyAr|_oKF`g>y?*H=OudQSsC9`+^0{^@ekuZ<}$1OW0m*luj}ka!ok#^ zVyyHy{}mV12=SwFkak7LAr!l5SYnVE6IC&VW$wU_;>luu$dGh#%4c%i46Z$qX9y}xHsjDbFg>H=3l)6O0~QBk2*=%22Dw!TE<_c6liWz81g;~E)hVMI z*8)Gl83CwCa?w{>UZB1^(I4b3f#=J^r+oPiAay|gIO8)T^${gJ2#i1ii8?U7=__6p zeEp}jYEi4$A21G*IibHFm|G(am4RB}3@g+Mo1u}I;pOJF#acnFBClc?n27m2`2gWs zx9B#86{EA6NoTEXB)~=@7rB0%Y=`shQ|z~vbSqgZi{Wp1L=~2laQWu8n@!5GitTqH zF)8tZi?kuae??IFXI^!NFL=U?Rj=g2u#8-{AnAn}wxV5AVPM zN#Yr_Zd{hGRPNE6curqT>5DOaF{&^6^@Xz3)+>8-$+ha@>*^Ou*UyyJjq`3-Z>vep zBOaE=6_9rJEKkC^@qqN{yzKvVYy-PH1xnL7AB zW2!42P6fA=RF`YL8?PT1+l>H>^Yi+f=T$GAHEHj>47Jlau4_D5D>*rNSh-QpcZa%g zvoKJtUa9qhnwRd%jfL)RXBW=5=Lcz~6*zVKrS-r4Hwgk+<9+(j;1_uQ3f*dO|3QDe zJX~w*-^LG}E@dN=0QuwLrxD7Tx%VD2nf+O|eLeIF5B#3Y_0E5mj+F1@7u%v&k@M&d zIFGJ}K4$2w4!ca85YcU^6hQ?JKYYFKPsXZ zugrDAIkfAexlW2)qz>k~+8^gyrDT}fDXs2ghFgo(Q8i0KJ$i(u(W1)a38D2oY9q?l z_0=&5&K;YkID(Qfcftu_^~*uRz;~+5r+mAI^bbl!!`TGSu}bSTmO% zjX?Lv2Wj z3!Zk=MQA7S6}*?uPK=}2XKSZWH&h|13#a%}4o0|&<)#q!z`V28dBdR+d9$V_7RkRJ zHKFUnTVTdGv4f-kYo!QY^bV|ls5uuAN}Ph zSTy$ z2!9>Vd^-pzq%Xn=9~%Y?4`sMg(}r_?AeQAgu?Z5*5qPPX4{HD%o;$e%5P0-_4RF>l zjw~C1`j)#k0DTKjH{}V<7=+tcY)YX+ zCi!fRvWh@FN|OJamXhQ%P`(6=1-!ZF&;LJ9y4~DYVNTh+(bVmjd}H?m)xjwS5zKvv zR2oNmh(3bDboR(BrNb5X&i%n8+?+HwmzI;4+iso{UOymOpkbApoSgrCeFw0)BZEhA@WfQS2%-QRN9K@7a0h&^s`+aK z8&^aCNdJ$2gze@T|L=HeE%`(f>!Bq)R}ypGh*%&4Fm;CDMufxXZAp{F9IGqy!EIJt zZ-xA$MXhl`m~a4NV6Dk}iaKgDB2gcy6oE@2J&vg3& z4#=oRQpXmFZ~Q+e+u=PSkra!m>z%(WhQA73XzAky{$|WexyY2+X72wA0ktwH?oF}1gQyW)gN_BB@To3*4#<5hr za`U9fp8Qqw)!L+FK7M8rDSaPWbskGYmHlA`pn7?aNOn^jt(lj(=wnkG$_d$dBrBEN z;oduDc+&5)V>nrarKZ|+xx;>Dny;O4_4_{ca=FufMrP6Jg~zj0y2&lOR+s%Ex6F?f z*sxj)OrH-nD2albMJ^6jeT>!(>@^@^OcoKu9`qS|Q#}D=;ClcbTffpj;D3b_W&9xu z>Bo^FF>qrXFcA|GfLcS-9GilGDA>^`nu1azy8Ju(b{PA%FHn_Yp?w2@!Q8!zQskw6 z8(gK&PzTXRIT0zF6__GsVOR&}b_C*2AU1-)Fjd7k^^-Yz37ka@>CIW~6y6gRFJVY_$7#)JrPW7#Pm{j|xknKSd`JF); zhjR~~p|F1raP^PsPAL8q0u6Y%na`LL9u48*k zs(KTYd1;9n6|FFD`_HekGX2+Z+SVmHZR-+F+sX*C;!Vw!!sbggr>3zqmn*E4k;6fh zT@CvAD_KA9JVDC&&jDv+^%#(~zdBY<&lxbd59Y}nnxxrex_^UTn5KmZYkpT~OsJRT`fg?vD@X{Q7ZpCEVvkzvykv*6gx|uuJ>N)2Ap^EMN$9202$brQe~QWSjCshcE>k2iAD>3+ZRM>wIF2 zPGew&_S5lAJk?AqK%n8r&i9P__>U|&GSHJ^9}Xi8+0G%v>2NF9koB|+sA8zV0F7^q z2F~6X@ZaGDAGl+)_`PL#0K{|rfl1yn0+H|9#obN7-FJ};VK9iuSz14UX4&~0Lx>L@ z=I~YT@>z9RK1lihii*%x_UNnfBT%hzyY=!ZIN`ooz904#<@{f-sL;52Wk$7AIifG_ z&=-UHLZ3iTxkZBG9wnf1$Ku>EKi$cOi z5_LL8GYVNx)H~@Uup%%V$Gih2B2mx+o?{!}7a@w2%85>lVPs2rIW*P-=)!mg3p|B2 z(HTR~I`9R`Aii@ddPt!39$%B~71#7SNf^95R6qbuL}?$=0SD|G0)dkMS@D&;ZAENu zSZ(Gmzjp;z8a7T|i?;rj1gTCLR6Cz98W*Oj+uPXWfnacZ_huZvGN* zP>Yyvmd&7r@AWEzhm zZaZ9kZvrf#GpM$4R6E!Eb2E?^JMv-vUchSdKW+IIG359<(-CpE%2NZDcnImtrw@-zuH)Ps~rDFyAd5x^j3i{y=pfNCVxEXNzfY!(4(CU?)>M}|obetU z>w33yKD+lVP!LF>ZT*l$xnZXlp|*+cS0}^eJ(Fm&jAK;Eqo*B)63Ce+IzF0W~Xzt{uD#rry1DB1R7g>C<#_< zuE0--9jR{HHRtT}pD7D8A~BcF_u03X?}5U00YK`?@Kuibjn~u;B=eoS5)zGDbFxO_ z$8Iuh@FCxWQip+2tli>TYBVVWFPE2)DQxd9IX;>q4`W~(U>nMb;6;(su6c)!+4jJY zLLHhp?U2t#({dmv-`h}UH?75yA~+5`X#-U@WV58)C|(m$cxyCkLfNDkI|6Cq1s|HF zTt%$A1eC{MeAB+IQCy2-HrbnE9A>IP5bho9<^ijn$dWME0gEdD1uLZ3+95ax9S zj8xbusO@g5623AkoS5rXtj4c3MLlss7+GBD~0pJ1B2r!8130&nc zR^1C2ej2tHJClp@P)Hu80|HKP2{3-jpFr6eF(Pb8VhNG;#kE3^(iwOF4nXk8OS9$E zWA!;zA5%7Hz!*dEI$&G-yt!D@9Qqaba+x4=bH9RQTBfn_|0WFb6}UTG{)i1X(e101 zyPZ?U6b|XlA``-tiHrY?i||V&=g*iRmH!xpe8szXq5PY;H&Uqg&v0R;;8^|^E=pX5 zCl2lb-$W_}=cNSN#lB(`P?AUR48@a=r3vp`{+WbX+Fe67WN;9$BnFTaV_)cCVTVbn zz#qEAJW*;c89T8BzEo=fP2U|sCqbH*wG0k)G*>vDS!)(2@dlO59qQ?f_;?x6eg-2sLA?iB9{bu}?Ayu)w3LXO75A8a_a>;y7 zeGOqbfk1Wry{&WMry#|I1Htj2zNvDL0H%QIs|h0|UQ3UvqcNNg{Yrh~s)W#U(lnEM zVKAMcBrxGj%fwwZAQLwt5&egOnkSN+L?}N-`baj1WQO1-dgc*3&mD*gV*)PHqNK0R`rRyx)G0}1k zXguSuCI<=BxiPNxaUp-4SqN)M+YIuQ8!V5BeT-nP64lQW#;@y~8ZI zyRJ!|1z#))%Rnkd1CAI2vH>*J<4r1*(VbzHl2^|#Ag=Lf0;)k6Ubr34SY&2C98*3#8$ktZZMF6Nfh-L+bPo+Mtr zhV%=RM3`(KnPKQ9Rh!>A@84|?E6rbf=9C|`YC;6r27AdMMj7b5Q8QC}POLvS_ zu1iS2JpOOFrMx#WW-}%1G^^KAjvvq{zL$tXgFk5#K7`VTLb}A%N%}{u4lgI@4LyLa z$?uCsb{EvpPGKNFQVE`R$z*PP0@@8I6G@qYGmK$Eogc#m2qLvg`i$V(Q{E)CX23-; zC>Hq+-zWcYNdrY@Z*mcbOhKzFckrFkzA<$6lBg{yJSCfBUn7E11{2b_fDU08z!ua& z^p6yyGkH?FQ1{@?#|$e3Afahc-z&xyVcH(&Dqay{BL@ddouTRRK#ft6C~iQWgx6A0 zDkMHz#4Y2DPLW+%m#6)zflvRa1!AjsOuklIYb9M2!+^NJN>D&=s`BA<`C*%qFkP4{ ziz|MD;v~D~7zsnEJ$b$Jh#4-=faS95<)mqhoicuzS9=w1s~1zIk_M*A_sy@?D`FlM z0AgUH596QG(l~vKCOon~0hxigYkU^JlO3U2)35XKCfv$Ysm|Z59eq0SLGIcZ(_U~B z>JT+B9^}5|*9K6upDUe`EuHuWEEJ`CqKJ7d&cQ~?XNJ;&j=mSv39t(UNB|GTO2f!T z0NO{HfBQL=WE9p49l8e6F>2x5Jb1RLYD^NFNuGM0+0_L|nz1|9RL4ToJ#j5o=m8U= ziMW#I^J1)+LO91^dqdo=WuEyjPf~(-UYw@PCA{b&*(19e--TbT+3G-O8^#W#+^av8 zt~#sEYve8eRV0WAL|a0}_ckch_dbIzY^dHN><~_IgAqfyABe(%Td76nE5D$tGXdyv z66*jXcmezI9a$&gwo2rUC^E7)bMiv@Cec&+7OG0bp<*oB(XNwM*9xr#ITnvA5few8x{l1J9IifPF%0ZEoF4|f0f@sDcO4$fst}+_ z*(6CttcqxLh=0!^f#jWV@pEfpYPcZ*SXl@`Ml_LujFND>ZL|xLv5>bHVMrifNwY@6?_c2mKOtBF0Tdq#<%iX~Q+>`QEX>=&z)fO>B zRpR*--yH{j&>lP3gc+UMISDBc#5HgaOyoK=A_$ul74BxE>>wZ%qJsbhRn3!?QFHh@ zpbv(~1vu>-LV1eal4KwBk?9zr_@E9P^?;2;C*f(>rW0Qn;ZS~0X6pcq;Ljuojk5fy znzHH8*R4K6au;v}Q!7F7?p7V)2)*8&4VmWLjTJODVCQ~xy9CzS3h6hb=2O$zX}RMH zoUZv>5U{}O>Qo98hp3j6-Bcv06DCLnX^7UGR|=Xz%_2e5q@Kg;#UuITlhG^`w~;N! zYJrR31%j?d&#$7OMEK{kyl9P*7Vr?Qo1z`POypgT7dm)melgKshVnLSmv57au2;JC z#V&R6iux@dq;TC^V26Wrb{$w+o~H)M>@Oghad~8{vR4U1e6Lul5At?iZuwQ4MWn9C z9CrL}ZDm<)GvF;NGT5$9>MI+lnZO;C8Xyd33hxqoOb?!p&c^Ig4aosTQ>6oyVT@4I z6tw{Q`Wkb~W?zzJa3YXQ7}kr06mnD}kpzp*vI@Cw%;fP3Gpa~$j#E8VPILdUwwgE+ zZwgL|m|y&ot`{iY*C(=%-G2?Z)50E{Sxh0A$REBa@~VLNOEpKlt&UZ8sbgFf>sfPV z80yoBPP6Sy>!jpz@uADzMsBy66O$}YKTsXgB3P5E?5%X*(BNGl%IlYZ0Y+4Bw;870 zeST6Q&POLtbeH$%e2>E?It)aom9Ncpr*mSy7fijox}DM`e4%KTKR_q*RSt2R>Rskf zxJUd)tjb$FOXF=I@^9ukaDw3p!R3gClXI7^&ovvP^9kd4u1mJ@E4eN?caKg}{!Mb5 z!cJz74rFMev?r3+pR(d>rw_`T;$A~;(behTCLilgraOfPVlW8!_B4qu9$OOwr0ROu zyS{pmp!^6w3i!lR!SN8J0;Xn4(&Rpb+~oTJS*V*L5rCSXz|eU}dR(ye=}R_h6G#%{ z1<%ny+nAwdO=HI?AQn{;v;lq@2fSsIw}|3EIk(x76MJ!UAy`8c(jJ^pPN1YGZ!E%) zWZSU=4)qC`L3WrN#|v7iDuAx3G@z8xoT}1}B;2V~XWpLmqs(5*ybWqU6S>+21^N*g zUoSuxx@N+Xyl(tZYfQ`2I&fCU!uq3dg-=72@UQc(NEA0ZimUZ+#v>{@DvA8~kGILX zAt!X!pZ9Ur>&BgGr-^4Fn%i;2>8yD^zSL3-;dcyBZt7=r6OZc1qF*|Zx ztk5egjdl}M#7(pYpiqMVzMu|e5R4UROh9sAYzO;AYTAR!uFE850FO_n{R^siav~>~{}u5q@m4y^(TB)ccy;$}xl< z`K9!C8fzezTa5hTg*pTCAhfUfXemEMv%XVg-{H)>2&B+okV4Xzev^FlNX;bJ6!tvt z29x0%COPhDb}pz_rRnt0IO(PQClzAq@ESJ{TurT0Sh3QxLTlh5Yr0eeCBy=hGsvzB zlxY#~z&+FF%Y(R0zkA?-j&o2|l+kSf`de37;EUIU;*^VZHS!T9m7Tt)P#OO{*jgF^ z;xZc}IaT^dJi+`cyCo6H2CWp>qF@O{6!->9gu(S{CjukcK%igomL7FLFz8-THlHSm zJ55^j(d=NIL_WAolYqJ~_lybpTX}ch+5ka!Vbh0ijTNF*gbn&}?u(D>&H%%r`Ac zQ&Ej1wKG7HoB^PqN+LzbmxNj^ZzIX9`+@p%ECKNCXK)6BV0qjIXf5Ry(bk(?+86AT zjVVZAxfD_SP3IqJKeO_TVDY4ik$}4V|7-7TVC%fj`_6kQJ5HMGh_tOZjFMclkwdGN ztPe*{oMq-EMTuAZxH3tHk}X@NNhV}WeT<}g$c7*b*4k;3c5M=@ZQ5q-(rZd= z?bs>1wku$?-LNibo1$2|Ex+&)0V{Y2nK1vG$J-2K?^+r_VRP*GUNkKeY5i1D$L4WH!|27oQvc8PDSMyjPF$ zD9p#D+Xp*W-9u$?=NFr|mI77!je+v>&EKl`yS!6p$#k^qDPM@Y>5i^v_>lD*?lIQ zWnII-$rJFbS4V7Cd<7CWUXNj!nrRF9gy4de{Jb+FS>tI$} z3TUr~wTNpNH&wEg@DMU5HVNjbVag5?a@r{4l=R1{WoUBpXic|Lj7C#c)vQ>&tshaM zUPUW{JwACI0=?`>XNTzWC7|fO}iEQ%B8o&i<`s6m*dt^@|C?(eqA2$SH={{ zmBJx+qqh$>s;=H`{k6`YjLG|hl^mcJ#?}z%mqWZpT!|1k+XvbznL^{{VBoQE z+1H0~*}poLhsu77?Fs4C;>%wstZ-KIz6_CWe3i6HAHeXX&g(?caY=o9=x`P zOOEV^%f?$aW6vJy{Ol-6(H=e}w)d~byl1CI-qie7c0vT9G*l31#kIei3y5fU@)fbe z&)egAPm447pO3{1`>QPnSb_uQd*G~T1KSvHf0rS{J_BRS{)_7ls6bDw7KX) zBIg2CiUQ46-y$d3s|pJ_j?oA|PB;^Croutlz4IxEyXNC*@6azVkf~x89brHm{cOLNUDn}KXAc|a1z^KAHoj*`GL;W5NfgW$7{AYwzanpUb-g~ z`N{wy)b}~*9N4*9#g07C86d*S>hPjPQ}vu!yLI5f^<%_%1ZCc$0W3bCS1$dzRX*%( z*fsUqQCdCrtvAc@J1^+?ofkNM$ImlcUA4k~f|=~8%D@@{MBWc1tRrazco1z)_8e&N zr2zYj1DxQ1Z5$qgejIFKp}8)~h?)uaIBgS!mE%mr@c|{_pAafklghY82BB~v#fUut zdu3!u`ianPyrK~!J$=a;Myb-UxU2!2NymQB*Y}kKm%8PuTa`?1evyKSSJQp0MP-eC`>yWJCE+TVK) zy4TgaXK!7cy_rmO^<$-goJ5N*MnuJ-5Tqw~&B$r;Z(Tpy-8>ab{bDE)kI4D#x{?+& z|Cm29%J1h(SzHMTUz@*TaV6n19n)6+ly&>cGsnsw!;QnbuYg%|9Xp%`e~^?8$&(embETi(JA4*8y%p7?*QRcH>HIe`83;qLGer z9uHus^dJZhdvsJ2l9ZhI2S+(xc&c{PW5Yq3D$q|)6d`Wq_G1yZhw_yVPlSGspY$7i zib6FIRJrc#)&c4Rq)Ctw>BF#U^@%}z89!3Z?dQ_FHO8l0Y!lnUjw(K2&U{|k!8;SlA^NDuou`e zwZr*?eg1$ny`xrw6VK$IQ9EjPF0%5WECcKzS$2g;*h`11yYU#@lVt+hWA$=EWPPGB zK1Nc<-6|DiaW~_4-n-!~`LG7n5;cQ9TI%WnDiosyogO(Y-d^1mK_w*0T) z@qQOkWT_KXM7;TtZshSz}=5k9um1XUlzb?(M#rQFk zo-O_Rtc&;OT`YYqsk79yHv8vRZ`z<-9d6aQDk{e-{(%iWEq%aTt-5Zze)N&fwKtMX zMO`lWA*TJq>dlbHE$sZl*f`cig(4W{_}Vxj2)`41`WX^iK3j5ps)HXpt(w<)n8YUt ziz6iBOH!GBXTe(N_-h}4UT`w1y4Uk;#~;S(RvY=iJAT6l?!R9>xmrCIoYCsu-Z4hk z?5VrcWBpUd)O5!WS^auN3d1n$K3kyGo-mP}Ur4mh&kQ#`8+UUm*y;%F?YbevrmpVpXDv!LhjsLo~y?(m4>$W#o^|r9~Z|10bQC{dJod^*a(-P#CwPkYH?oS88w81Nbdp77HcaI-9z}zJJDxTlUr5^&aybu zL)dx1j}t@W`8$MeEl1byMAc;IKOEEWP9)24uX^qVOGe6ZFc^SQ9*zoODHnen$bm%G zK7de~Hy{OoDl}Ac0Q8(%8^bv`dT+`C=!Gc@>_Sg?o^H2rX3s_tQyB1?1+{OyL-fLaP6lKm?|iO>}Z z@ut%|gqcW#F@E_F3zpxY?Q@BpCT)e#Bm@c3A1Jk>ihDePXUhwE;7Kw%N`ond=iMxj z#(_vp6h8OJ0mf~I*U+x)tAiMYg9h~=+G1BS9%TK)mE2;XWN|?cV%Li|s4*;yU8dVa zYoXqm_pC0Ygv2|SXd$EBdHC6(KSH!0|n#A{-+_ z8^kU8s=>yz(qfBua%G~ToTAtwHHKCafn_Q?P}=YWm~WwHqGxtn*Y=KuNy8-fn^%te z+xi2c$AzAcx=?b{{q8?F6~zscNsu&U2mz9rle_#+)E}T=5G$lv6Lhkka(rdtV0R)@ z4}(Kuk$yE5S8%|yPM9QeJe|)a$xSPef%Fo6m zi%5|75(h!{e^v!7{fn<7>$B-uqizSIWH@@ZYvTI)+FQ_P+WXNkUq-!5MB{MO`d1e| zUiUBt&jNF5_1`4y#lt_*UmG19Ub=2f7SJphp?)V@6`t#{G z9p8+kuBGsAw=4Y1n-ud=C0d3Q+6BT*Zt5i=}`Xm2fg_#t2>T8D*Cze=NEl7 z3~EOJ+q(fd_^j;jB z=o2(Q*BMzjv1l~A_il)->XmioZa8jT6E?e%C>>-TXbT2H1~2S3;4-!$k3~ILwkGsEZ5ajwL6~LwMz*}$pzDgUZij6 zerT3*U>c&nquQr&^x3Gw^FAMT->$yuu7~bGU)ksL(>I}`y}51uOO-}K!V5k@36A=V z1O$FyhF9#`@_6p^;)O*r5}Z3rqJnT>jl8Ld$Sy9j>wBZ#b~9lR((xp&zMT;jtm05$ zThs8_+6;1#Z7j!ZzG+wYI(P4}{@aU1;>P9#(CwV|+5F@F5W`~?me<};ERLc|Zq>dN zfxrkn72+OJ7s7XKe2@8H<3raz3I173WO$nb;E9aK%6qG~&@I_tjDoGjMY4uq|);NccO3 z2)M7Dt)k)OuG_Ym0+M`apRK!x^r-9BpR2o)s`)z|eQa|W15Javi)_G3XLs`C%2l^}%fuG_A& z6>+6*`C+?p|3h1bhihv$bnUxgthw9w<)v@e#&(pq&y}3ho0FsX+70AxIlcV{$8X1n z8$tP-WZyqk`-1E5C~XyOA6-3YRg98B>U+kTq!R12+%Wig-%M_pZmQVvu|_wUW>m+2 zYV7Fl**+!{6=*gJX=wV)bxr|Ih7=Kd9OVPJ#n1?Bv)Nh)+L&$<*2?@ASPZF{BgWcTmx+SupC>a(>*pxHY%G;uU;!MNza&I#5T4+aDfE{LVWs{>ph zZvw%=5b46%Z-cm(v)2aqvur`^r{+4#UvL`@+5IZY z?ssxs(Hh?vx&6WBerrYB|Hu?Vf7M_Ki(C;$@Oi(>~XB(qzk#cx1dWJ-opmG-aOKP4ILlZ($2l7XpHi2wrEDLBT=?xtBurMyXJ z$b53{B`BaJ&ndg3r5qepo6Mkqaj`nY($*%xzxQtZ6mB=9GsUiaZ@5Ix4p#_pAy23h zmWE5PY`Ajef(f1wPI}w>)PY^QcJH2^Sw4%0&%NZ$d;ILVC(asMWts*jm`_cr98?jm z&d`2HnxdT-#WeDTk;s2^)L_C;vXH1CMevF5cgH7Qqx^|$+l}v6I$>=`Cp?dJG_Pno z{^+=EoJX2(H%j&J+HIpD8K?0w;W}jGT>MOP-@=vV{~Ys=R^K${@2!5T$C8Pzj}?yA z`jj25#lAC6RJm|C=E0abQ#UC3BO4{zX*sRQPoFcM*<2f?%-02YOvhUou@F}i_b7;Q z+&SdEmL>vVV!?~EM)#BDCb zZn(03Pgn>MR-?uukUE`_KkB&DG12vcWfHdLkGm;Oa+Q!n)x`S!Hv4p2|Duvw{u&+x z1D$Jk+Eh1pDa?#81~+KhZtf<9VN0OIA06xFsFllA+uF9gmv8RczOB~Pb^X}dn{FDl zM~+3iO0OAQJ>9sm`M%Dd8vB)nkB?!=Dt|4cnsPi#LbR?DC(_tg_A}a5Ch=P1=C?f4 zxcTF{=;=PCV7EVL{-pPBWT`ypDX_k^u)T4ks33yM*oatsbWa@ZVOjUt+;_JI{Me-L zK@%$1pU4OW^`~6T{frjG(upC|MtI|)aT7L)hoOj<(Ui06aXUBFmfx_(`02HT7v-(_ zQbylxTeR#%yo4>)E`!Bnjoyt&UGn`AGirZ*sq^a#zBB%2^_H-A((M!rG9d_@Cb$W} z4^)wfvpXUPf>0Os148U5;@;@c_)!dH0&wWh1e88Iz%dXgM0n3StHiO&99tZQlXk%y zBQSiS;S%b}NXq?-c-L587wp$yXR-1c-gVGjxJJBT>8pI(g=z)W#R<|TLYVEnlRnT7 z4nHITmN<+0I7h660D5f1 z7t`;5LgzXM@R~C?eY&>2zw>joa7f(;VM1yr*S<&W_u6!=IaTWXO1;$o_`>2`#jOdS zu0PoPCXejnhlaoPBO}k%AN(j`gugX+ssw~z-|uYXmydmM#IJs~-_hU4#$H(H{%OJc z!q0{F9xK-brj4+yJ}NYwLz9lt{bDrhf%!}-igqa-=Ne^<_K?YWPxyO9xj$4 zqJ#i?V_Pylr0_{VPmoSAXmDitm7Y}~Ae(cIm z4L|;k?Zc1%!E?<&WgMt{r-lV&A(29Qn{^`Q0Sfwt&q5 z%*D&EE7!|cF1>wh!QL6VUGFcAZAc3CRbjuTnZLgKWJn5jUhvTBwl5YG*-Jr`It3m4 zW|u;ag%k;i>4a@1R2XJinWBtYvb10dI#2El6~>fd$|vL>QNtY-zufCegop`pjYm5w z^nI4`sPpnW@Bx#<-rJJ!2|4UtzR{+YoJUe%3Q3q}OXg6(ZipU9)&=1VZ@-`r41fbA zVBNQ-j0OU}MD)zI1vd~I!ZPiPiyk<87@b1yD3=0XyZW~E{?T%I$EnqM>$Uv|G}viB1#O&AX>0Nqh?8~`G~(#{6dqS8y-$@(T0-;`8#$?6v|#>-szqgPq@?e&l- zuD?_VA_?Xxmu$h-IzLfhO@A-4rs+CJcd9Ij=t03Z4ymtpo^pj~-yqc*e`gxZWICdj z);2;NmJx2%)xEcwO(l(swqt^I!00L5nxOcB7vx#KUs)7wmMQ@8I(RxXU{iK_J7# znT3|EjwT?^i}bKIW(OUn9js{&U~UuKaQD@5=#gYYMAJvsM66LbGFgO(BvO=VwwXXF z_rE-_eHhzC1ly2a4yy!*j2aCiE`WJtjohmQkY(Z>!C zx`K<{yIMT#?kRZK$s^Xsc*fifdQgre3iyCx7xin8tzn z5Tx@9#OS=uW_xhw>JCp0XA}5f>3MS1o>;rFe{R5-jvdT9Xyf`(583}(KZt>6j}X23 zDgW-$?N*U9K6Ytr>0{gAP-KUg-qAC=V|~CSmGycX R7MZNN%Tzd6(uYI#$D&Ow! z=-_Di)U)565xZwOBr#N?P1OS6Yoa6;c7eUYrF|S#{1JA`@Ce`c#Hb^Oj7_#w0pQ#Aa(KCgN<>I$SF%FZVHhqM9?6P!U=ga4RW*ht;Ih`nqUMEX{OvP zf>%z=!h{@T0XgUfz#7!;AQ^msVt&a0mU#BaaYIz4ZV(00dk%L36qz0UfM!S|IVt*Wv{H_dRnn%P=d?VGBf?AFjWSGaM(Qf1A{0AXq}f5%4pi< z$e-R~MzwM*r4FV_YI7{FY`tDLrq#nklYssh*&zD@A1G?DP3LX*}P#3+5w80}U9pk=frE`<27 zw3m8+2X;NQFK3lOWN~S}dVXg1agM3CL*(Pp^jTUw1)6d=m0AmJdtcN*wDz{t6OOLW zs|Z@A!fp@(-7>g$Jk$Y!a?el)=aL6T2Io_IX0SOx_X3K023}3 zNjrEwC9%*j*^uG5`I z9;46BZ%mafZxPp_p&K&43qvj<@~>hZH5J?X2Ru@SVUrONG#kZnJMkkf7J5%95%a?t zgq5-t+o+JfiK;`KurE=ZTA9=env23Tq=RFQWVhNYUqoHwA;{5i@(>iX44ojcxoPhvY)Tw*KZmwHE)@- zX54Ff(cSC1N~QYT>Ra<2hwq);9iwzW;N1WNmH zS{7Z$4uG4}dcjtp`1xpcgCXw~SwC-*ca_Kfd=J%dF+$xrN?u2ZKqxCLqd z-GdFAT(sGM)|^Qf?+~s$$d2V@nfIehX<2B8$o~W-?A(+@vY#gp{K&frrHOCn_DH{`58&$fl zicI%@5W{OchNI)V{bdX0==cs^Nc}O^?9#hS`Hu8)a^h9_MCs%+_0DI8n{OU&emfk6 zWwg{oB*wI?#R9cS* z?;tm3CEf#!yXPj`_ugKXM zF1!tU!=h%fXa>_2Gvp>pdd3{RM@&vWonf0`5UP!GR(mGbW1MAoI9Ki_APJCiXOM2Q zoYFWaV#B4&w+xp*W7O#528P2We5nnl=o;iD)1ci`J)GH#ZJtBh>fk%&Ckjpnc6!e* zU0kW2yRb07Ts^-uGds`CSAps0YTzWJd#v%+pas2@|ZKR)$nV z%Tqw0EU2I%d_uU8E(KB83(2tLLg~cesR7TrJXoXDzStw5Y8ys$Dazt4AbNI$^`x}~ z7{Oaf6Qj%_j(xep{aLRu2Zk})`!+EMl(mhg_i$bzZv%i~edQUuOe?O}ezHxdkYs6} zzxA~^WBy5H`fh{8hktSUZd>=5z}y{{#taG!03M0@kazXWzRP(aPyG6@fw3POjpv_L zXFsQV?4Y-v^66VkFOUkbgePBP``l+uh4NDQ!Rfzu%xXS)Z2A!S6vT{`e)CvYf7kTi zM?1qQalKZ}(wo7bjozj5neSRlr+Ym&jh~il9c=VkMW=UszR~-5W5?sZvzl*fcnxcO zZdG-ax*NTVo>+!M?E<9RxV`F~>y5YKd$<$d!|KNxJ8wVzR{0*%vG1-ls@*4grVsVZ z9$FuMwuHB0SLvp4JQX`XcsgV$YurB0L3wkFbvN>#-hq$@<>e%AkoO6uU z+~R^qz^soD4*H&vweK5u_tkZuzc`N%t#vP+dcnW2A+9f!ySi>^^mVTFEp%V%Y3zun z0#4sOy>I8w>bGZh-}>Y3H1X_r&y-H@E;V-iuWzl+G7n{G@ zxU+ov&gNR9uY9`i+3zk&Z^4B9?SE|C_*wVZ_(#EUWBOjk+BbdRr>6H^?j2ow?eqa# zl(Fgl>3gSfhjK1rePMRr>;ZARhXRR;Q4#1pAuJK?974*7{!IuZW*-ap??e!_```8xaCUnDRvFeO z>}8x#OigRIxQiU1C`yY#0!5UaVr<0GK8Q|I|`3oK1HaJWZ%HXe5aK|SGm2C@NIO_hOrfqzlU9{LtBdD{t5($9;M$b8jYNB=o zp=C2M1?r9dW>5yn3U7wQn}pmNUx?u1dPDPSB#Q0GeIh1zgBImZW_T+R>(aAwl2g6FwKJnDU_W|9KushJ)pWP(koP-HEo(qwsK;Fr7krpjm| z3^uS3q3(PukDcGh$r8Q*Qv{&~R1X;np5BPLt>|6K0?@W7#|Cl@@(z}1k3jFZa04lW z(1jc3gXyqD9glT*8p?-iYp*q4vUz0j%IZyaX+MTNn)_>WotL*YclR{kAq2K@Bgn75==H3Vk27E*QnQt;!-NHmqR-9|riaxO zoVHY?of7ze;Arw>m^OeQKE~)!8$Y?5&!u!3hXo9rjwWr?@brP*Fa`oMH@O)&l*wVb%F-nR7MQmw08K34ymOE(W6 zn_H@W-6+!fvB$suVDm3;>c4z@SO4`^k^XD(dx?P#$zqaD`!{KYVB@Q=k z{GipTW&P{v?W?zhj4xKkU#-`MdrtI!e$E>56K~c(HJsiJiMn*8>hrjDQhLJE#SLX;YMhVK0n~g~lxOB5g~m z;@B0y;{cQ)E~<5purAiU^^w%b+Q`|bit*LT7N03NE?{AlT6mjDL82n&GKk7t-^(M9 zbHbZvENyuL`E~k(S}7-IERym!4+7+pX(fLmUf`hYS6DYZ3{SukvYA42 zLq(DmdCJ7QA&koS7;Tb&;~h{%Xo&LOM3N*bnUJK7_E8f)a*`x;n60J3gT~Lg2R0{= z5uHa;ezoV3t|Loq^$%rx!SWZ}G~{t-IA^y>|IJ@;w{;WvAyU zoD_u>9FRKSZw{C7zm)t68a=Frxi4K&1h7M z#hz3)!oOKkoOiZZ?1^*9MC3NpPW4RtgHWcj57%TgMZ3JzG5k___@!<9*R}06MhQ4} zX>QS#(*L}^y}s~*fAXNc{PtHyj`_;ierUl%mRU!m zMhXTu!GLeZk1|VecxbXw0yZXO36Zodm+yfgvR-6Q1G|heK=l`m);80F!$X53zG9gQ zvHJVF>imZKaz5B5a%jEJeYtKB}@#!Ux zursO7(iuKV_|S`l54|{Cel7%!JiPkSs9{V4Mw`kGYcenwt+Ka8rdC4Rw=T6HnfrK||!A6>ls#{Pe5yx?frwTWU6u1NlpIFWB~RQR}` z2J-?Qm_a5oJPXzf+Casu7Ems-R?7L~KY+RRP_%8hb6nh^we2-UzYZXq|NismmM@_1Up{w69`Z+P;<|m=C$~sU<lF_rzA!I3w&ed~!i!wn~2 z>Zrd|uD`U6|3D0G=Q0Reu)5b>=npsP3y@4lN1Nvh2Jf!h39tRpbdM4jzR5t=%2*Ad zrzE~e(h^SZAm5?2PogHT4`}|5eb9VSrc8|f9u%cB6K&Cvt$|0*g_2*9g>;B_rMi}Ja(|2MJ7fvoV1~A*^PLRqzc)G z@f@|twU}4XSncG%5bepW0;GvvABnrqc#kmlsXOEYL3}!C4DeIt#sqi#bhv~~3Z;E) zyL!Vut%hC8xnN2z+PaNjIV;3c8e+y;>|4-qble$jnWD~D%M@+IKulG8zUUMR>Em$@ z0&PdFCF_<+nXaxML*Osj7RpJ2T^Yq)a=#6G(Eq791rp?l{J$FLTRAIWx8Qb^IAOtX zlQH-bD;yr-q~SUL&`Bs~vM(0e(yWBR(s?@_+~dYg!`1-HxF zY??kcl%e>K*yOCETCw?R{sSCptu8|-<<;9pqO#S#c03dC9PJ+PAl?uZQ@pXc_v1vM z)Q%t*HpUtL@Ud=>`&{rp{c}IIc;!n|_O;pn(E<*RPFRS`euSG$3?dGGvT*93PIQfe zh#A=85eq0(B9_AT;47;bPlo~R&`8NKsHMrvXd*%k`5^)y5O63FcClJkRf){a(a=14 zWYN{>xLP}NMF8|N^-jz&+7N{p`Zb*$>RG z+-Z@fPb{9FpWDk30Qg`z<51mGo&V7M@{_m(=oo;IvH=U8aTC1#;Kh{-RqRtyueg#G z!oNpe#MR#R-ygv{frAHT&da2=^km^P@~Pk~&^xm{Uw!i2#p=q%aPh>h;(uol$^5kh&0#~1t&^g$|v~#^cj<3 z+Qq)zm<}twD;H+Y&dn^(RhQ>y&n?fvI+1N;W)|bz3X|lH6PviX&A@5xtyYJO=OSf^ zzVyC`K{KCfbFvODh0+AUe)KtplW(0_bg|<~;^|lawb+Mo^ZGmkA{+q|$abD^qLzqq2wS)QL?da}BBwmO4f%7yB=_v3vsH%}yV zwXbr#+K1rB1TiD^v8W2rvsiiSsQg}1qqb2Pqi!d|5*RFmDX3%&Wwb$t$)4CcR5-VxRl@|6=8>d2jPnJPSvI;5g|8qUTGvV$ z9Q9QSXM$MIq#_p(vleG&9tT+Otj-{d>hIFxicb2tlPNxPesL)R@`@%~V+@T+%`TWz zFMy`>4%7-9*2f=^7CY;zjX9#HFzLno9`T_UvK$tXiQk{KV9eQlS*??qzhm%wG=r7# zpV}|^BwS?~gZ2pGSxDTViBgy3KSL;m9KItS=DxT>{-Cf%Jc_-yRpP!9&f`+ebk|oW z7K%9(CI+j6GWYIkhTIoR*DHnjDS}L zQ(@&Jbm-)Q@W^yKMW;!Ft#Adpp0E+br_z*i9UXGKCPjLrwHoGW-KM@hMe}BC{^E8t zDnUL0^>y;TVD!qu-?clOU#CcRjV~g~SKB&MocX~D*()KQkL<}%W7M!maRz%o zymB7LCv^bp^~|gmx^-l|4;LEL@l{XYGQ|vd^{oSL-%`@$YVX6=p4D=vFBiadW@h_> z>q>9GyQl3jkggiAUrd1fET0+3yAzvA6-U>8Z~%SZE_Pk$SK6gb2Q#QXYlh-rHXC)E z7bb?%mEI$YOVPw{9AB@aU3=SGjeUKyCWo(Orx3og8^fp(ZN-z*s>mWXGp1fG;_z@d zqM>lC7Nb(#SS9&&@>oVGr7XgGUAUPm$MAFmUYPsC_eDCKR?KT(!{p%|#!m>T6h14| zX&+UpdZrfRCwv12bW{iz>oiZlM(=p8zs2cbg5Q7ftnFJDmFCWg8!(BIjRa2Cw(>_{ zMHfifWJ1;#zaLg~X8Fl#RzoC!a)L)dr$3ckDv}^%@`w5JAGU+7Y|AKR17qmjo#KvoE(S|RB(q-s9n(u#>X!d)7#cC0%VQp}tQ9W#bD7;|@3MuKE3NmTfll8rmdmA`}pnIHf0mF!`dL@0jciH+a z_dG3K$hs=YeWHGJ*kxtg*Iv0;FWc^wf!fFv+=L0#=6G%$Ls)bnQH8{W3zowhi};Ao zb!rL=HR+CSva9E3d?v7QfkIloi&7%`~4Entw z^%<4tO;vRSnl)B2p0?WS09HLSkM?6O+hr4unHTxKHqC_Ts4h_6$?i;LRb7N zqhH44AqD6W{WK`!(i-A#IE$Vufe5GfP|m@HYYQixY#d>}5Y?g@BZzx@rL;AaCM8_& znADD}6`b$;VWLAkT_g@^%!>^RK);V_^=YMd2x*}@r>H2&0T@4Bfk*rkRA>%$UpK<>0tHHUHkXl_3i_As1e)x7PF*1v}Z$nL|-K^PDdUXAG9D2ADj&!_NXNQ zBha8eB!>qE$&Aa^q?x)-G5^@2=OVEA1Oc0DUy<1`d zUbjSh3sSPFt4t2p4mYOvcz^qHaHOx4%K*&8>9h`BX5H_z?W@^|xGdXBOjbZv`QFO| zX*8GNwV{y={Y3v$9n4Z6*J?0z(ZR6LG~At`Bgcvhmt>&F*~Eh5fA3Vp^F8>5-*qB*o&0ro|p38nmK-T#4K=q--LC`=q~?yJd0t zg7G*mTw=oaOL5ZZvog!RIZze6dn_e4@(k;L zR7xHNM8x@%PIMv+nl`d6m=$!beN-;vma{w~5JLDo|M&+$q11Y2#?>2$8%b^8g304- zZ+y&xSx#-rokxF%;Q1398&6tHYx4PN9kwY?jk|<_+TSuKyS`V4!f4Y66`@8IWZxFe zFa5-qH$8*aC_Cl%4xN}{>djyk&**EnmlH6_kh}Yd2Zm61vtnn*LmBa?a(-5PUkh3d z<*&g_I@*nlwL1$%CA^6k>QJukE*Mb)rx|kFJKlx?9+!?T!;!Midi4pC)+M-Gy{_nb z+D<(RV;6F^FIc;XK5`wvB(wN(bOYEMGTgD(REM&N8I{mfiqLAkflpT;Sc|!qc#9h2 zihWOosmeIPTAQ^DyoL;$SqC!ha{_JjB5y(6&9(3MCA#SHQ`)Ez;lx2ZNg!zikg3E2)1`$j!mij;TZu;&KSl_C3lY-)|c%G?vhW7(jn z*eY$ARMmuglA}jdcqRcECAFiJ>~+?fE?nRn42j_#2&@!qk^bGsE8UCf^1|YO3imBb z9Xj1cJKz;WE+C)}EL$K;!yT?N0FWdOxVXELST6itm$E(+KsH&Von;}wX+ zQlwgujN48!0#whASyHyXF(s=1?Xu?W5e5e$!w2|$dz}H&EG!w+2_&Nwj*_s>N zipHyN?KLDsw*{}p+yv}e6GK=DPifsxCP0_g!|X+llft9KGGp4l;OAA)NSOp~3=Q$Z z8)R{~)q)Bp$df^$jiR6aN@>;30U=1Zl@=!)V_F-M8jGgDT#8K1dnr{3q4 zS_V}{tTe#L`4`wRW5L2c1JH~6kq5a5Z15G(HOn%U@^RX{6fQ{b7IUnR{3%P4U&RC^ zx%3_naSK9z#!vdkHqkNwqfwm9tI^JEp$7^3lcm*!L>rHgD^n}2+SC@$j^J}bpXCrR zVF)VcdXxsgR$vJYh+DwV;I{~%?V#DVQU=1g3Q<#R?;_I?Zrm{<$60g{#2Otnm~UTZ zO%2_Yo09cbU&n14uC*fZGNMi9sl`bsBj8l%##1Tv^xa`4fEj-vT!*!f#}@{;3Hv3{ z1IEL=W4;q&q`U?oMYVc88@dsN!wh%lozF0neJ?s7iswTU&0$1wm~pa3jG>`?(jvp8?ST?e9HAov2pc>Gaii6sD(avk<|GG0#`)+OKOe7+b`Kn++ zoYM9P2TJHR?9|{(l<~ToI1@RD<8m_zwA6HZv`>_$(7d)^%?7ucSfQ3bt*X#%R>B)7 zc0YYw7)JIYQb>2Y$!e*OQd|kpvW1TYBj5Du9dDxFO$9;h)i~b7PRAbRLWls=r=>;w ziZZV`-o!HCHz{x#c;b#xn1O`mLn}h%xd;%=oPX!qu)&Ao?_3+A%Ru6x0K)w{*9J55 z|Nr9J;Hcz&3&a$@mcsyOqM#%V41r$f7WCv{bQx&*Y@?UK1}B3AS4GwUdhNtL8XxJ+ zt2gSqYaC3S|~6xfe($q?FOl| zvP3qGb@f?`)m)+yf16E2!O$K*+0e(#0>5bq1MZ?}K9&s~uo6L_N_&tz&&G9)Pg->g zEiGvsOw15JpN!Q%%iICtR~ts_i>SRo4@IzW_< zlLeqg(zh~kE5ZW(xy0FIqrxq}j=P+q%Eq<<4(GfmVei`rM?g1P3nF+d6lK8*+ZA*n8i4 zK5f3X>?8Nf*sUF&y2tIUYE#61V+NnhlE3%jjDc&${Mif3xFPk%u6on)M6Fbvzv7mLa-6v!#T`?TP4%@t@O!c^x70?bVPGvrY>GMjPMb`VRw2=eo@hZ?M z{}P8$t3ZeY;^Z(&99TGMAUnUS6$iB2xZV?{PjS&hkg1J37duq&pu+PEk66-i8svuU z9QLMF6ul}7YwK^4NBN?LCD|K#u@Tzz0tVsb&6Pd~^Ah?PwY}j$nM|juKopwE(%An{VTEYI%!~TgX%FB_HGwXlC_e9eoblj&6&fCtzqh zL&kse_FC|pV~&JlZ#U)X>z6a->Vq(d=vz{UJ!am8qjDximom&b-AQ$_vg)EJFT(?!5woBCQtxuLR+bx|3+@h}513=sMWnA#D5cANE$ zCanSMLc|3XqJM((r$yrV1WwA^Ge-_`ih5!h>;NBkju4?vlutq1Z~G2k!c*?=3}-=mYnLs^VJC?zWH7=lUX2={xr6hyJokil==JQ@C(JG z4dU*lN#}p-k3TWzxRe07f26+*Ttp6N8OG6Sny6?Xw~-=MS_n|!QfYZ3t&+KwAkAyA zURl#ZfqvFK#LW9?wYwZ^%%GO79kmb1GI}M-8ea1Q1I&=ym!At1r`o*aXhD`jEsoU2 zwn%cGg~KqtS9q@`H$rsoI86oD0&C4_TPlj)HLS-LYAL{+{4wB}?R!QM`J(?~9{$(Q_GtEs9*Q zg^cT1n;B{Myi8$#t6uxZrpTFLo@SE3wWlOYf`SPNj#4`$2n<2SQFWQ#0YuV@z{%&d z1tN<$T*a?c!~n7C-rz7JIM za$^Uwx{6@~@o|f%J&RBcS9PmT^pUT~z1* diff --git a/sources/FILEPKG.LCOM.~12~ b/sources/FILEPKG.LCOM.~12~ deleted file mode 100644 index 4ec81efe06b59652959576cfd7086221d3eae265..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 103331 zcmdqK3wRvYbtc$V4Uv>ALJbgtCXf$LcnQy-RhM$D4x^?T;eVlvV=iJ`$iNopa#QwwS%*6h5_HfSH zlb^81=j^e}gw>PI&Q0Vq>DiecYtM|GoU)Gu3j22U(tAm~F*h-8^+fyk+YjHrKh_`X zw_?#lv4KN_qdit{&&ksdKD4^FQnXH=vU;qY|7d)6>Lc%)Kf7|~>>Up*J+!uT>W<9m zlS^xNJh)O^TX`gYVDOH$)w2(sJbh;6j>c!-nW-ZO-W!efp^ee~_Csgz zq5gg=I&!E#dMF<2v6j!QxL?|Nvb1#S{*|-09kT54@wptmKYOROiVjTkS1f$SI{fh3 znl<|fK61|TcmBYE13gx8=^VNo7*sTVXkY~Y^}K_TkMvmoz=2vjVfHaCX)|%s%U(Gb=y4divqBJP5qhV~u!A6CFMjj~|Lh|Dj7U z+P8CJJUw?fpPQ!c*jSAy{fW_^xOHfJWM}V;6}4v5hYsya+H=X&{`|z;d_KFMUfE~O zSpD*Be13X*asT05em~dRXC1a;7622!aVu+2PvBy}np>Qqi$Q)To0*-MyKDbZJ2Ov( zLp&k47`CWOGA*Io%xz|9HPL1ovvc|L_lNK=-&GACEwo-u*QKtLS8-t^)EgV*7x7Un zZG6Bwl+ER*?Ti(TTkl87RwLDeluqrFULDTZM`&~d*1nm1E;%tVj&aRS%u-o=bMI%= zVE?{THKb=|SkKjnH9Ikp#cYgP1Q~|`+nYa&(kPF4#-772r|QvIV~_i+&>w8ut|qb2 zdX%T@G)*4QV6|g&S({->wfa+q_SJfM_hfh@{L%H$Kb|afUPW*6-J^v_rH>n0<-*$0 zE9seO8dx7y^nm&;v=$;=CnL2&>uT{`RIBEHu`Lq*02LN?ceS-$k>O_Axu5lo@KpOZ z{B>9PX|2?brSEW;zJI_X9Jhd3n8~ND=;*NA<0c!mqQe6`O)^Yz%JDADkrqWq!AZ8tz zn4^sn(^r7iSaiq(-;sXrdMM_H0zYV4gHeW*IBM8Ofyx01$@zSKB0Gl$F(Xl{=e{LE z;XPJ#VA$$8v=cbE-|AT@uAW;xb-#74v;rIxAGUh4xnyo;(aPo~^7&l857W1)tjT7Q zeZ*UxvBiA0kj{?pM<3@Vl5@0iuo3x5aEon*SgI;0Cx9YQ+ArH<#u^c1F$1i@`(y?< zg^^2IBcvp-S$2MgP|`HEEq2C$-bo-DL`tY^$i+2uCz!{#nMN8n6V)2Ea@ha`srPAXm<5J3egWq^DQ{ErQD;owySdO;p!E;od4N4(UIkERIYD}yo*OxxD}n*ncFSM zVOOr*Jkjp_b_j@mbc?-h#bZO(^u+YoMBa+`3wa@`LYp&&N7#1&PCylqMSfyBcXR^q z&~IgO_BbI508GDS&rZ$H;{7NPOg@*JqopPgCkhh>?13yQ7!B;jc)#FfD>f|nI~I>x z*>om@56ctU@zD`^7#$q6>`X>FGcaf^GRnc<=!i95NKY5+^c;GC%J{lMErd(Br`g%V znIqPK43CEfC|ox-fKQ1Jjdmz{b>uepLJ_=HRB^Gudfb$8pO27Rty_1RR+u0O- zGlP_|dZQKwhJh^ff!vN`9Hwo^{wT+6=fakaW3|%x zgl%$RBw?@ee!vKa)EIzBf#GP4v*Y&MtVJWA%g^LyX+Wda4M2nY?Cjz`-1hAppUBXl z3Djk+(7%{qM*tzQV*QqISH!*16+^TYdeIDp!U^8zT?y(i&-ijEywRPo$D~hf5o1h> zTWSelhIGUTmk%Zk^}MJC-BC*vWjHl1dDHoKpI?15VJ?T9f0Zy)t#7H{UsbU2lF$TY;JraW?_4IH$zeDxNq@xfef2J9$iF^U;xCOwM%O4P8B0yh=~1)D&H1SV|;dr=Deu}D-%8;eUu zcspA|!?de;Nw(^i2A?L&(?_JnzdYu@xXK8H+rE5dLLiHQWubfnmS!!Sx~6quzRQ%&e|P zY$IWIE|?o9Q@(n~>Xm$Il85b|g4Ku~M?t|9b;bB(LYPwLhNAJ7J=Oy@hQb>Dz1F7V!m@nRtLXA{5#{7MA3C&K?0jJ&4^%xW-P})*$x0Vi^V?TL|M1q!6_RAUkZ?XdL{uG%;?)fhANE zaR>**rvR#b{b5?=x9UdVk5(D%dz2xsgnlNa}(1bir~Q^ z9)M`!KnS>ZVGz?YG9+t)iFB6) z6TErCd>`@%tjrfN$cjswY$0w(a9ictvGV)vPZo`^k@)dff&TxxRNmi~2-{9i(YQPD z<4V`qGgIL&OyTKkMdOWhb$bdj(_^WC_m)NvGzMK>&F36JS91m|>;w$!+w^o~M)_{`!_HDaDy4?BfIP^Z#SfFT2IAoMq0n!!;@gmH1t+HBU zzN;-97Us`Y_odoTUR?rwLXY)Rzz;JTA8{vLDVLf_QdTe=Vp4J zi}??p=tqJH8~bxn_h(A?$M{NNZ(DRHzn<%0f`=aME{4Bgp6GOLIMG@AV5#fG?pm&+ zIxm%W<0~gRMBe3ovjU@)AMzCOA4WT*z}S`RVcD>kM;upaZY;zM~0xuU~;)*rQeO4Qp~q&p}4dLFh&Qi&!81W~s;z)F;46i1tHUkppCP-(xiO&`d0hej%+7Get-!1HUMzw?Qo$TFJDt4W` zmFJMC@i3UP@p0Y@Ln8evW_HM@`XkQrxVzPv`8$Z)>_h<@(Ha~TH8X8W+yHGV&Up}A zrk@lH4zuoFeP9rTq_NRL%ANx?83bj~D#bzcgBZ&gB#S}5g7h#F)r>QU5HXs>cn*Mt z6hp=UM#A0YE)77%rNjc_YzG+W3IdEmz8K+q>N9TGqA@o!KZhsayb1ltO*18$Pm31E zH{1!Dz0+l6gblD_(7CXXLV8Wb@w7~Yc^9voI>u&wB_Cc4Hr1P~uJg3vJ#xQ~IO=C)&l>LX+e^7=t` zocm5ce5wfT@sM@uG>qOuaWcwB6);c-qga6K%F-DK8h}jqWg>lpfS}&qo*oPTLF&rb z;AZ9kWk;-@CF?$zhpbae53clBQxl8SQtu6Y&}a@~ihJlIRDmqfgBV4Rg?|q{e9nTQ z{~YcHpqNA1&n~S!ykf1M<+|c7u$h{=gjDEJBhND2glWMnY$9DCl1;6)SgXxkPmn=i zR+*@5OjesoG*d|;!^~vf!1@%_tjDV}C$qA-&~*3^4s9y2T*F+T&yMWHE>A zyJ@T_g^kmr%duTTmt!p+ff0OLx^%IyuS)jXj|trnlj$WU6{%eOLJE|k=vn8iQnZQCSTFY#_BvM4IL4oo&VIUROqQ6+5gYJh{QsxU`!nU6 zrOzAJ$q3|cX|?bku6n#iw0XyLxO(HR%+q2oR&eUmq zsZaa9eMlquQ}++Pug4D9lvV?dzeJa~dZq;*ZMo1eAsaxN6t?x{anD>=6p*R1*zHD{{0 zc2)i5;@bP`K&t?ynwAYf^P#NcaS%-*YjKD~${rtgDOem7 zP-s~kre<{|v_p~4IPK{s_H@RK&B}q|=4W6Qffp26bz?(A*4Pv_5-#zvWJWH@TDLe$ z`zwYqWYSr_WG#~o<4O!xe0RuD^~62l4wx3BYx3nN1}Gzl5<$|YLYVq6LEzhgT=4yr zowt*i2ViC5@8tn>Pu>F%XH^c8;}s8(28{ZKuCu5Pa^mVk$UfJkPeAd5&>LzpHyFeu zen}9^4dQkBL#357E6`dB9&IK)4FL1HGo#2t9Kt_q)?y=Y64HJ)Scu#10ZIljg{cH| z?H&sj&MY)~FlmCE!P^1)E^W{pfhLeDD#tHo$u!naYvYXAZ_ph&VlJu<&{S zH9Oq{6*HV4&VrbMBKCY}>C`zmXIW>L99`Sj1OSofdq2}*>TeEmZuZXf=K zbnjoC*?oOh=%%m{GPKM*3tV9~%F3e0aaTw2XP8sa3cW1Emo&9fqneL0%a~v)WKSB= z%fNFBU=Ot-Gel7#i{gXP2iobkPK7=K>iS^5OscMN$)j+rgP>Pj}VTN7&3az?(4I1J@ ziR_EBFbn@Hc>MvPdyo8*98}cv?9B(nuH+QjF(5l|xd2lwzz(RvE!6)cDgl!#kE6h{ ziV~7m7}6%!1McHr;BLi$L%vd1P_8EMArKe1T%0_!0^d~Y)XImLe+JS68uFJCs|_Dj z4>&a>G~1udullV4aNuazpC1cjeVS`~4zc3NJ|H$s*8t!3ZA{#xnw$E@6mlP`0hWn=bP=DZU@#CiXCueC2in=<%U#$tq0Z9$s50C&tU2<6HnxXYQ8m<$r|9Pp-8nyS^xq7!#%Pta3|{< z@7mOIdHV_#@2P)3d4ZaIV*MvikyTz<NeXbb-^Qn0Z?~X23Wq$=UVZ%XEpFVvHrLB zd2o_2#sY8y+dot&dS^wgVTcF5J78kp9i)lh$DS(wsN>CU=JzxvA;SRzQ;Jq^d zwlip!9Drs?8}A25V93IX0ujdFi}Be0_o>0p8tfKML-`cc&R-yoa%jc*c4} zD?ry4>{3ne1lBgA430Y#c3J)*Lh$3Z!Hw&R%XeHIC7 z0dqGwA?$+6LP@@oExC>E81Fp9K`Cv;aTo1@t z4=O@GP{4^CBFvOjQI?~iN!?p7O-R|RTNqtPLd59$DJWs^0E7En$OyGy&ndW{OFm6| zBw7C?{V>itM_2B~2``6gW6zBx6srqikQzDoc>?mVl=o&V&t9k1eKW5-@rY@fmh9Mc(y#QiBdQO#wep?k3?Ewm_1JC@C)?3QO0G5UNd zGFD^;)Kb!2{a07aKF zY>9{qbo*$OB>XLE(Xd!j^oetrD4;=6DREQ<2COHRf3Y}Jov(rW$*oyn-23{SUQftl z%Qc%oHS-S(slrMFF>TflLm0dPY>I?R*#ei3Z9Kt*A;fzXef87>@1*0>=l>ym z6EID;x0vtTA3=E{G>4wx%3>zpsXGGcz=Cf0pzlA;BVp@4xS|OxSD7Os`H{{i;Gdwd zCnn(hHYg2z?4PaZ7Z_m0^MxHzp)>pW_HOvQ5|6^E+pZigl57akFad|~>h`p`==@lM zVCv-`xAk97JY;JlQQBdpv2E8SAkiLc9vGH5*-3hJ^YhMHF1%#n!TGRdRIo%7n zB0Wu8C=@ahpDGGVO_q-TN|1$~Hf_RnA#48FU2pyXtv7T{jEQjt6s>SLTtHM%6gz|X zFgNb~E+K>jQG~cAd9%-I`N1_;pu^$nb%i~Go=NOzc~mHDL@(?Og*^-+EGM-rE5GX6 zddtxS_@K7()hT|NY38x=O^Jf_jY1Eh|F2RA)MGIJ?2{QUVWp*g53x zs+DE|s3j~l>aVEZ@(=-8tQfA`y2>30|7oFTwf=I!dSX5NJN#i~j9Cx=Go~lC_3&G1 z&A;83h5*E*=w^grH3~~dYH76>ocEcCa2Qd(67}){JtO5?QAM}5TUUqQL-%>yAYAF> ztu@uvS5vC}7i(&cxIgQmugm1Vm{4{jRs5u`U*4|S^T)Wz4 z?DV(4%b8Ri_`2KRj5k==l=OGO)^bzMZns0+6`=lvb}rv3=DsZV&HDc^<$WdV$js4l~9X(;d_yJboDenve%uA=4yK=>o~%4B^r z8!qqV%WQY~#%ZUsNHGD^27Fzh0rlGai;U@9EbK|up?dh3Zol$gwW5`nzUb2zmcF=7 zUHFIdi@xCu>gj^+#HEvnpN$WzF**m(^^Rh= ze63OL$#tmLE7#$2^%q~rb*OIe;0fpbwjM>fPqlEOQ*~fBx|iE+)X&4eiPsypP1E_V zw;q4{SSeE2gKh#6yUW+6+Kd43>~g+4d43Xj;13H{p&9&h(L6eYpOhm)+)N!nR_$v8|HGd4>a*B}Hda&{4z{7epa-(>=SK*IAzCuvOH9~>z z9q*eM>NRghmXl0XNNOPA&|+X=1t5%LdgH>bzjX`b$+Y!T=Fg!A5k(y$5R?`&N;*N3 zun9vVNDNPK)eoNxPaoJ%t`Z(6kNE6?;hh_Xxv^{?$vnV%EOS;nkC;-Fl(B0G(VGP-xnVHCr%PrO(8cVsx=P@97)5BeF4muC?K;O*5 z!4J`42WAgI$pdW&RHkwb^g^Lf_!}Jb5Vkf-u}xhavUdq3w_1Wh;61(+B``U>sw-A# zL(vSKGy13s`v>%kq-dAI0qB8ss1-b7sSpbH5f(DiSr8v`Eb%F-u)J6-PmL9a62|u! z{SGLbDf}L*najf;6SRYOMGTs3eCJ3OLZA-d!UQW-4#jf0D;Lx75(5AtbPI&cw-X^b z4e8F44VXJmre6V7p&J4R@Bskm%t62;A6!4Yk*ky+LV2OzM&H6aQY+?Voe(73%qH4&#GO09rMQBVo_3pE7Hn$n8xV zCg4``j$lK#aGAyM`J!S{UzWJ9TFP8-z7PL`tt4?;6MP(d%v;K>IwMqFFCZKOX4yx> zMhXri0S6Y!@nKw?LY55h!apoUis6?ol|E)%nldk@%*9%|+TwiQZw1UuLLOi?mAXj5 z?Y`Oa^o!C(6?3*l6(O#=YkJ!PCsjsLq;epMQ% zIbVi5z}rndg%tOP~3?+!Z6ErCU|FM0-);sm~cdb6BHw4{+&o8^ms z!BcOb15!wWUt61zl4XS8hs-Q*Qf3yKAw90|$u`=!QQkqo3#C)gVePd3f5mnKxZu6* ziou}P{JF5TZ%f7t&K)pU?-{=C+tECT?5u z&a?EG7JZcbXL)8U=4udz{6VD zuQFXm;3M@sD*Q}FZb>SFf8STqv#FG6Q(*PlvPf3WI&j{y1ig}=a~^0mMNcKu7T z!iv9m)q9^c=}6BcateWJ&;?`APZ!9{N;~zxokeZ|h@h!Gj?$$ldmO`Sz!WF`Xy_~u zvGUaARS5L&ofzKO&?A1^I%(mi6o6zQ@OuFRQ06C42=fFYrglW)wH5!qK)kJay z&eNbXHYy%ed?6Vr<|o+TO#T^^zp%lv8D)U<+1z|S$tywkij^i20e662&ba{`Yh2lK zWyoL%nrB>AmY_-TH8 z*SO+QiOMYh^zSn|r=V7B2fi+}!?`;=$xzZx+`$h@NSN4Z7==ioqp*7?40fT=$yQj5 zNS=4aWk}Z~rELOen0zDQ^CkB}e#ySB6T!UqU zW5`VU@S=>L&3V}AO-kX@&85I|l#l~&u_JGjnvfxzl%kjFE%Zr0hms%=s0W{Je;gmg z;<4OZiX4)ZjF`8x)JFt61`9xlxy{=w%0U%;hRF{WAZQ}TwFAgO@B&8F53Gl!fZ_sr zff?+zO*>Y_n$Ik#$aC4I6fHx39UN|g>^5{Qv80UODaWa1XYhn`2*876{}@uBO3qj5 zC5?}qLVTN<^1S)>KlzAggu#j4fO=_*Ye||~z%3FAFv?J0K#5A8$-Ty{sI#a~Fiy_5 zwuD-E&)Lceb6LEmV54a%bR(>MNBxPl9gnSDrTEI(?UM$)u_oa#Icb`2?V#;cn>N3l z;YN7#hhc;9-CmqF%$IYmFRdG2wz*Qhveynv{#m=b()9sq;)(T8MY_RF;P$I{jU6<< zfQwaFZbF|<=$L7gC}!mu$qDJ)sqP!|py}r~sps0v^|ZYAaS3%(mLl#6_ksh~*tQ`( zerY}Y?rB5ew$k#p<(Bo(Zzs{Gf17LFn90cd%iD@yV!Q+MlkwxqZAtu^%iDNBmA)iD zD&H)>T&3KBpQIqnF*NpQ);Wh@`{ya(UQ9R3+p1&!;5l~&{Ds^f!NhhKA`yIZ|Lygk zJg&L~1M82=)oIiBl)o&IeF!Q^Vuf10nJrt=WRgGS%?elz{BxGngq9CTHLfsi7~*y< zen$LehX3+g&U@5LujrSrmzTMUe26PTGY;>oP^|efQV-r;C$z)TX5Q$}Lkrt)|^}^G=RQ%U3%zy zY8h^mhl6SQcw!Z%KAw2zL-K+04ZbSnlZldB;b_in=O%wUA9rlLvT7a>|Jh&7au4et99mrC3AIS42*$m=GXW(7D5DH=G2DZbcYDIiae} zAUvcWnnzU#QC^d;s5J_5#pR<=@%xIE>m&k#JkQJ#AVWgievg+C#8+#Vml0O3`iMMo zbdvj@t+m5GpH1)s-UARXx?$!05XhAdni*`+bq=Bfgjp#!yU^QlV%;blR2Q@Rr>4b& z5?RBPVqipq!-$|DVxFy^@&G0`qP(!OQ3mD#D019egpoojac}XIvU0J+0m_329PK$7 zM_3JYfm^3wd$$r61KQw2vuWtWC-zGO`~Hc$<{^c}F$vyF&`?m)Oe#REebjB50vGj! z#L%*@H!-j@NQpF`8Koh(_!k`%eGmFz_C)4ygUwe= z5W+x7TP_Q#X(Q|x9-w%IaP`K=Io6CUAP_&Zxj8DC;1N+7xMeD^MmdK8rA;S!Q9T|d zD+xFk%9z#o2s+k0o?-DfKcoBsn_j@|Z7LiAphNb2w{F}Tfu5kDU{j|@;F^h+{Nosb zdcUyI`3{6l5yjn83vzgTf?wAxF-k^oIN>U$hFpPanyN0T=b$1btq`s(C%1(!fR+wOP!<4Dc{o)`xhFI5t>4JDt z5FqV-j4UYoVN<0h2hpVa;Q<}5rr2M~1wvq?x8MK<24`WIIY#ig81^0hqK+F}8-uxt zH$OIV40}&^HU>`0orM^-o!gffme(CdlpT!KEJTqq0x8u1vG6XVOn(BpQp9XHth&@2 z(qPapIz^pj!4O@eYhgHnXJC{BD@#@5R?q(ZZfl&%;-Qr@_nkh2BP0$W9*WjE>RCR0=A8Qm3i~WF z#&fD;H1)HqOL~3|SQ$!xOfki$5%YV-TKO=JUO0OeUqBKIBt=H3F+PQj-;+DF_K0=% z^n)wbeGi{HNqvwSc#NSVhWIQ`^h)u)+&EkBD2%vQYrPH}@F1bj|Dm3ph<&55Wcq@; z3_pwGHSiJZ^nHj@23G2E@%btTE1zCIw}j&`=sO3ost#3a={8YI^v@{ zt)BN_3>cIIPnVVu;f%m%1W|wJ%<8#wE2pd_L?t4EdH{Bto|8+b-hB?aJWds@6|{xv zp#iyPQ@A~p^3!Kl?_WK&v}U>G_gQEuhIQ&Wa@txdt9GJ3JO@0>r|&~I&st|6d2spk+Um)(7I$`e1$`udUMW)BaNqD=qt3b0$LUN;Sd`!! z6x`oK75TZhXvnK_M!md5Ym4M2XC69zcI7PhNMbP=muqbpKs!mnpCt0puWUI6d!bvT zBiob=1dsyDE(fV%^FYP1^GXweCCsX|-E~E>x-(@bm@&HGESr^ElE(5j@l-sY)G=A8 zku;dKyx`nnuhw7H>SGn=yKFkjZ}S=Eke1EQDlz6|;Rcgt=@K&C?i)*2uh8t1{cNGV z?dBa>gs1H)bUc^xn5jwR!qwiAx0pt{>rE{bb!JqTkR8{^NS7!#?#s|xv(mdi*UBRk zCF_Yu`KDa!Sf`nbFvo@jPm+Jvke^!Cyw`b*)EuDHo{oWY;WSCW5W}W~TuPAuNm5Dy z82ow)RyQbD;%hG-zgJKKQuN-^g1lXgnS?lKAFM760sm?!)h6z^Ig>WT%IfT~Uy)dj zaQT$Hld|Df&Op9cvp23wmUl^ca!i-k0M^f>m9V1Uez(+Oi0ZCfFWf)>cRKlpEJmfJMQv`R;-lJK!IpIa|`M9YhenFp$IEH9S$g_rU?_7o;Vw zu2=!GL6Q1c7;wfv6d40ob*9P6*@4T!hZ3ywHFk);2Efy$&}JyG=!SGL^h-pV@_6-7 ziYZ2vlotwg8QgWR3!ob8Tu^j@PeGo?Y`{Q`OdNeXsd4g|P@Ij1L2wRYQB%*^69CAu zWrtygR>*q#!FqWJ+2;$9HhbG7#LFop_+b>&ndQY_{9-l@n^^Vg=~CBmSig=re>lDO zlJhqYEa3#3gLp04Lh%W}WgLO@qEY}~nyT)^Ss8a9gU9!x^Cy|TcRPQbdZ1qZxd)cQ z<=Y=vQeh292Yw7m=px-OLb7MvrGNRoKYn1zhvwRrwx<#0OW!JAJ8j+@uI?&*eHxbj z>P_^i3kcQyu6FwUS5N0!EA>_9PqWVNX7*lm{^Odt)MgkDET!cu@!4fxCLHvmhkUdFBk*@ia!Yd05l@g|a z#a0Mq2*$s#KOmk~I=pd9N|Yb<4YkK9CA=ZYhbr1M-#NbH|W<&d$PM-F}(g5!RMPf&c~cl)heW*q3T z<(g{{k|+UeZJ)n#ym}?0o8=vhq3V?*<4S=t-d%ZbqLdOM&)Ns2%u_DPqUTd(lj?Vs z0jzu-*JtY&UvVR!7EDMcHQ>*?$JGa~9f$YEdg$MXUTM4=*T2SH!o?e@(zoB5u3nSI z^*6cxdgz~qzcT&p(&N*{x2MgwvZ|3A^+kuecvYv;dPdrH?vk2MbAO!V=4$d_pK5TI zs_=^XEx(5!@E@49ySku8yIe}YFv%rpDtUALa$ypG@@iyX9}hpzPsh8T;@`*luU0nw zPqk!amoPe9&NKIDDX9sB92 z)MMRIt~x4UcS@)2oGupK62a{e23%t zEnb*$?z)au`9>H^Cbg(Qz9mnA`8K z_KurtZ}JVbXV-rMHx)>_WbNQ{$okn~MlQi%=u$Yh%jGE8I&}pJTwOtgR#(t%s4K`y zK(w5pdK45{mAb8yR!5b=r&F#*5R9O%(6&n7Pq=&*N*k5=fNtTm>ZQLPfuc_3a3il( z^*(rCxf+H)wz`6aP+dXir294uJ|1{DKLN*8;?IZSIU-!NCK1Er#tBzHeM}FuF_g`p zPh%QFkA(*#LH{@>frvrq7eovlB{4LVyHh_JgtI3#rcwAH+?xaP!64W!e}4vOP9QyF zCRGnfp{e+MAwtTa99vjgz4a3A3_L86HBX0+>~%rKo9r=v))#(GNi+F*Dx zdC-i>1^7U@fI!c*CP%h+^j&>O5v^g;kV3~Z3^gGCVu18J1Vs(iq!}85?YRH-IJBC9d#Gpw_t*u@{llb`s?)RJi*2%a zGTRKm4b%YG2JWE(!{DHm#`zAAqsRiTFWJrcusxr_J|MnF*a>2=A<;o?M2S_Aln$E1 z9!g+`ODGI`NGF3!2pc`g(+{r|Nev^1h*GidJsA6Y)RUsTG(x&HO2K+&KQsN*_9<3QxkttvO}DCB@#hW1V`vxklRQk>G?a+~y$5BZbX>lUgCB1@#N}$3aa2hkMjk_q z;I>~VV0y^C>ueh`(OpkODUq8~G)z65+IYq_)rrCo6aYbJRPq3gqw!qS;j zba>595TY^6UK!ELbq!lXO8f~q$Da~wnC0l zda2~xnkasanI}gq-pna1Y)Dr06yNz?SSZ!2JqgA2E`FBV2Q_2JjMFFDO7k&ZAVe z9g#OslxOb_4nvXfbuADBkK^P@$QE;OBq7mQ2~Ae$IwYboXGFEK(Q21?o|z%SjAD|Y zR!G^ia7A$~PL!tyHZ1r|pAUPvvgHTDH28{HSsmVi9w z^@lMfD+6et?EFQ2C6!mRt_pCAmx(=*)Jz(@Po-^+Mc1w z!l%G@&>A%?NDM@xSvk&q^-(V6aO9g{n2$gS+^q-`FFU-&TyL2u>t_%qicrK^m5Q1UFahU6E9hq2fl9+U>;0)7q+RJXm$SNmUUx z)mP}CAKIK`IKrR^qCqpkVJJ3+vegK)LLnV=h0P2aBxQ;*j9IYfNC|WjQfY{Mqu4ww zY!7CK^E2>QNU_cw46}Grbw%@W#uBVK-7UbuB!a zYO~*k!{e&Ea*_6hBIo&jo);PJ7M-<(o$K@j~6Zb(1WZx!IjTVUnIBKhv4mf*2PHsnEIv}97>$6_hFQ3eH?8WgN&JWF(rEila z^bF_4#c@6K(c-<%hwss#Tgw_o`Fh{ypF=?tphVcZIy@RaJAoJASJU(b)zhqD!tsV@ zmEzDph5wOE;qpfqGf4OoK%9!_eI?5i7*>T}p}=Js zhjtAVyhQVmdm3HU&%r;dLiCkrqfZ+Pn}rtLfE$C-1|hs)36SOh1kqWbFGSEH>s0#i zVMtQsH38C_g*AbYHeUaiulmG+Y58_|ljU0y#+ug|&0jsxi9P{BmAiH-j z+X+vfS`n@Yhgj1A1#~n5I8%5^pi$zMeC2H50~buDZe)W-jVQQ+Mht*)#;o2`irM1V zVddp^1vzMz#6|8tKC2tZz|c$N&k13vu;Y)ku2Qna0oZI0fDk1tI zdlY1L+CY*U#sR)l?M|9dIN}rmj!n3WSM6lWT_0rRA&O4EnG?m4h)617I|IF&F8@r z5nl^V3jI%Jaw6bKQJlCO!|Cv znZuPAFlP_%pq%70EwHEDEQb;BOz@u_A^hW`jbsNbiYk=n>lKw-x|Ze%pW+voX;lTt zoG9-660?Mid~nx=+Ec8Alo^Un-*s(fWRxT39{}l=K~F#vE2C~1={tLwplhwy*vT$Y1E>F;14AxjR#7rMTt#VDDSf; zjnspec}01_7bZnl&I>L2;o4+sH__jxo%c#lUs1VZ%RP3{z)8Vh$DcGeQIqp;>)(>! z$LxeIACn84Q7QP&d4!bF*(gwHLcvB%BUCZ!GD_+yb!Jl(f;4nkaN2~W6R@D;A+Td- z?BoHqc(j5`X;5AY(@#`q$3qlPibGs^aO4ZHTMy7ssiDe z7ec0^%31(KAUr7r)v2oyO(W?@Z`L0X>V^6Ngx>`k(S-s~h%0C08RSrb?kKE` zU&nipbqFNc@g(#Ml+n~?IjOrcWb>Nva&?-Ocgrm=Wu=RGGhtYfBd!|OCzQ`Tn?%N~ zvC4sDb%zZ8(()MDb$C|;ed{#>FW}EK3QeiEQV{cbcaw4m zizbXb)})!;64R--JIJfs2DTlY1VJaYk_RHOQh*n(Knu)Db3g{|N~Kwp9n3NQ)3Y-m zY-j?GQDhc(l`-&NBE1_9o_NTD2a$5hA_pTM0|HkjXlMdjcfIe0W^EQNLa%QJH$g`# z@S>0mv7Hx-4B%w{MyMyOb(6-o5$Y*6aGa#T+ox1d*kWERzu(7K>%30^`(m~Ur?2?t z%5y#_kRuqfYhir^Ll(yNtJv7Se)$Yc?dzAgdjsNl^;d3a+`p$VZ)JbLZn5I%LUlCukcOcvRN$hKI4s5 zzR7>a1-J=H`aZsP1+u=kS1ft0{@mCriR3sh>!j;2d6tcsEZXZFld4=)h;O*7MnbbsxP1R}cJq1QHtm!Y@o69ZXgj zq=rF)ZT{r}xkyDXauiXK!c5aB4q+5#;uX94E?&2Y{ft_d7k%DOVZ*3iD@>2A&S;X+ zfg=QzGkt-olkhVeIAH(Ki-A6XIUzWwUQ%ZWVEG;{(di6b1^P+cweBiV2Lh;E0Hn96 z&%Nk#Sm$MLFWJ(wF=heGNZ=Mw1kH{wu>^I^of2$d|04*Z`Vn>8A6HA|fFFP7ygA&- zkidvYPYZZj-4t(3(dxjr$g|F%IiJ6fkLHoDP@ffk&yJ9|2Ej=u+L9{5Y3FAIvw=0m z*GUkm`PcS8)}@ho2d~XPxFTj@|l8u0qK-piyb9>8Sf-U&`iMsg#ER z4~cu6=hsYRMKrd-Wk*5zmlS^+fbFJ*FQ}S|;5P1q@<;qFRTre6-0WhpoK~N!DA$>K zc_eKhf|~v(0xg_5-AIWETFay2KWS3}Z!kc<=Y>i0Ut+jbX}x@tZ*sanzZ&t~cA60k z+P9*qHS^NNOmXT*!NET8yGs``OZ=63`Tj{9Q)8TgJJ#*Krn(WgbVB;Ye|bV=lGlw1 zU&YSqjZ$q=#uBL5EjEjFW7lN)-M*K!m!Pjmc?o9pnw5KMlP}2gNk+5qn2}qaZk)ED zX1htnmje}_(G~MG>V-J4a5ux%HtBl_GtABMmmGP)*EtDq=6ARn|8d^08rE16gk$n~ zf0vybd>#30E#q67T4v4scgNR%av$gg6d%Gj4I{J2L2$F|P)JFrJRu6Kug^1Vm;`w- z$J3z%E-M8V*2h@k{2TFSv}b2?Nu1LV@Gc|kz4zh}(4G6~A+QVXr-wkA-6xcR%6&43 z*alyx2EiYA4Gu!4_T2%CYNtsuar<8ruQ0{=55T$2dyP)}^i?IxzwaSrao-)7`T)g& zwI5WE50j>JZ(hwf2$%0pd;my90WCl|PrhATl0X@>I3)7oWKguniP0px6(vfPxL=Py9&W-j z55sM=u^yehx~YsETY~&Hr6*(7n*%Ns(aD7>SS(_ zUKs?V*H{D{BZ?4G;VD2tWr@A#q-I2zd@MggbA*EoltF@Mtf!-P{PhOlp0cT)(h~&g zVc?tUK^?oPO!S9Pn+E#Cxda>Q#v##eDubX*(-Mb+f@m3`izcnInlBs=3_;c<`kZHo zV&z!0B)5F^QVcvfXf`=I=(pLL6$6{;ep5jiIbCRoqJvc2d}-vo+z1s>d`uvKQWb1k z>?pRrTI?tgNyExUA)3+3LOsmjvUyJ7txZo*&+Vlr*bM`3c@EDHEuDN|>3)tUd63LW z51l!U0Ht$}zy}(O`i|;B4kd2}u^G`6_F>{j;2_aZNVX{%v^zIykQhyX2_ih<`KFTn z4EMzIjT)qRMm}s#HC6loSgsHgk8kp&ishB8xJ-(e08z4u-y~;RY;@8v0=1A@4d?<$ z)i*28ZaT0s=U?*H~tK?Q*Puaeha0tXuhczpnkfJ!bB-Fmv8WgsmF^TNn3H z%bn5;nSKn1>gK}@VIgAv}1B56RX2hTn75QP(J%u1&)Zm!%| z3E0xtdxamNCt@Vi7;=Xol54Mo8fFI&VyNu{SMUbMAwee!?WMPnrX3<;==;;yGv8ow zMrp&ic8%*+Z|)A$=wFz@RI zz}8;@hVq7fYPLa&VY&8yOQ*EshuFo)Ma=Jm^&~SUT6Saav7a})iit9pRT>DO0<%Ki ziq=DG50hgjaq&IYfddD`k@Kv$Yeo^D(lf^qxTHf~DIP*tD@+KgOvhFo!mHr#Rq5L5 z*>k9gGGKuoG$|px(!c@uI!dG!EvqKIw2kvvC;079#0z+ayG-b|pkPjrNoV7TsEI(` z7B=21*P@483~$^Hwby2VO-YeZMS)H76>3;(ZS3$M1^lmXdBsi7%@m=QPXGf`;~{af z)HMm`WThVbwo(ClqvDd-OOkZ)m=Lr?%i742Xyz8HDWtFyLPw#pf~{EoFBd1PSL0-xV@L_Q;Cydt?*->?7#q}|O%}`F;q4l+6;n~U zy_Tp-gwQ8f>%z-0PWsz9$(FZRVl`IiFO}Z0(#gy9e1fr3H>@#0V85jw-jLwvwvB6R zbJDc|_4@0HlKy0Qt~TeCaG-L!{zSt0N*cbPX`}vR+H{_w4*z3gu^9ek;~4i-;NW*I zesJnXmEBVh{HU@kAxy#fbaAp?dD(PcqIaH^@jbbn#DLEaL0zC3)&m+t^l2jq`4J~PsOqJ#&55lA3W2c|cD z#jAp^|Fl*uY8Cqf#z8VC^!EdEYowtvP%E5ag<4@VG!iqs+`P6}E2vfERSW|YF`p+N zAYAJf-NvwDbT%{TthJ2<*hu6e*N>C!aK3$t{nnChB}-*7{4I~D!jcj$-`sYyNjX-r z{VpUXB|dPGHbnTZ2rB=~tIqHRPnfalm0Y;o!awy_#)=<=4mbRZ@SJ0S7nH}a`^36g zl6}RucRvU7%UXEqn$~qQ!+Q|y`Rf|2%kQh5D0SF{Up@^+mtFP?p+yWsfeoR$Y8u{X*&bnbNv(-tFpb zHOYCz!}7QS($1dcNmw@?kUpK4{lAVJ&I(__e&g-#bwiS7)yvl!G*gL3uZP+L?VXpQb~?v(jVEg*CnpapH|qKB zP#10%2CCI3wO&y3(p|Z+(B19q!uj_6AkDM_r*6Nr{B44u_smx+^n$dj`@=*j8)dv@e>++}%20N6Pqtv)Ti(NI~wy{&(z+d=Y2 zMfBp8xlTBTc6~J0Ns)`x!CY7S<6Nth40AiB)t$_6Yq2`2W=W_=kI*z)RGB;>w4O(8 zMA^E&ItIbHW78BzP%`FDI3cWlIY=1T4z2)TS3n))8pv2XKtkxlIS`BzQ3*_jx*i2< z=F+1P=pOl?jbW6!!3)FCKS}fwTl)yXAw&x@myoVup-1$^A)sepO_;jD(5ep&!YoZ@ zPxx%X(~i0b?IgZ}_tM#kaTNP(?G);UDkOE`6kp202v@P(6v7^uch)*@I8-8U*3`rz z`PZW+bbWXW%ovAu;Zh$g0fiz?9?i{XQ7aA+7jID>t^Ko$(_=X#*@6Zes;VUAjey!m ze>n;k&Ao=(lX5i098H_lyr_Ln5l+*OIH6I<1=6MvxKS7-yxbam#0SCvmD|TCoI>cKd+VO7L4poNSGqxK zqZk`Av&;aDVEOn?y*YvG8A&TQ9B3BsonzUg}#IYsvWak|1#`mFo_&GMcpC3688kp z2n&QsKAWSgA`p*~4=KF9Bl#Z!Y@t|Id?dH}_STQ#Nljbvq{C*nL2CaEd_$ z^L|7sjUzq8euBev_Q))y!xi_=eZeH$oHRF=oR}EjpF|KTSAI}h+2#3$xk|v2cR#)bO z+pM_W3i(HiTH}H+;Q+?KT9e}{6B#Cw`pYC+;xqrE6_zVz1KSeegmXO(jKNtsJ2KUt z>GlO2kWr1Kjx7@3_c=4vTn4Ny6%0;spMMse%pBs87A71Qv-=U+L4?V46lhOrCe7|8fAvNDyK!{d=4|Y z2)V`Ja84C|dWkih*)Io7=sY@^d^6?h@PyqjlDdV&_0@C4LbUS>o|Q zq-~XSh=jipyh4#XE2qw#c?6!Q1MozIzdx3WNCgYiUf_kEK%DhEhb$0^G`Q~L2t`K} z_w)?O*}@rMnvGxBj-%N{_Cf@jWYkhelDe5#Zb?a2q{7q^|Q%)&4PeR|OHm=B&>f++K9{S&n zW2t)O=1Gw~`K#uuwMof*{LCa$`aZPkJeGzk`@;-C_3|E(?4~waGcR+|$EG%v6SDJ2 zRw}u}y?4y;q~B-9aIy$XO||KAhyBbnUpwRK_kHT+a;N=_%%al=k7ucLlUsJJF8f7p znI9{#VYL>RJ|ApQ5(PJlTpX?5r{v5*bE{;VCB@%iHTB!jgbvXCWJDb9wN4% z?GuLxyRmTs)F;?+FnP35V0u9G6uq#YxKo(TAX6dvvPf0D^O}qr8b$s#e&5eXfwbQD@eoqb#SDK4t*npfc|C$Bo{ zI<~i@sy9KImzJne(F*gn|NJT|(|--8ZC#?%wl3kct&AWm-qc(vY`#=;Y8p#(xxz{r zIUGdU)u5lhlJ)b>6QrE~9B?*Pj{#Zxt7GN#oB@OTV4loTKA=aWGgu=H^<*dx1Q!wi z4+vrFn({-Edx)z#&kQ{W1Q2ofd93HpuwDuxOS z(D=q^;Ovb7{~ccNfjc&f-&=+UKs?7EnB*-Z5c#fM+}#A+eHY0P27`#4rS$`7mYu&b zg!s^54qx>ypH-LTgOvZTs0dwUkG?8D0@WI~TQ8r26YiVk`(a;E&j0m_3XQ8*W>hbIko|Q5u!+`oan?DMz)lfLt{OFE{tce zz*ATgoiPNh17DyF;yb6JhXhLR@ip0AaZRt2gu%;01q9$klzNd4IAGrp2$cNKim&8t zD`IoQYBP8Fy(_TNuyOKQwDq?nNOj7f+WCCZxG+`S4)>trk4^5qNSet^`+{;BN)aUg z-KsMVS_rZcWH^-Vu%h?V}u)a z^Ot~wTEu*_Y_>&030O24@gTj8&2ubELk67WS_{H!st>wK^;>FV6*4ZGk6h1ut7D2YS=WaO2YX89MM940|7N3 zx$L4nSF=aLtR~Oq=7ME@O~_{ z_f2f0e>)ioaX<&UN6ow6^0Z`4K4{#2HGL3CimC_O`o&MjIaD+jWw%zYPs_#YDpWz! zd3^8>9Sg^DUd&XtgRI~4*wo%jDEzDG_9Cx4pn!YN9C@3)eJWhNA=B==`#?rAL1GtD z$OnT?Tl8JINEq^Cd;3DA*NGd5Q0;z!EE*j!l8{BCgG9%Oc_QNcKAAQ;oFC;{Q(fwC z#(QwA>)p=z?B2IPK_H2?^+OWnhMhiy+9tYRoeY=vOrp&)j!`9#o^}{YAZMQF_-HOd zxic_=--Q^v@FmsiPUObqR@X1jP_utcTR!092GZ(Dmr)-&0Pi12j09&--kzF30A1@{ z4km-Sm*=<;<|lhU{s-9^qTa2 zxeulZ#{Q6kMI;8_;?-o-pP#a4Vd}^6RpUNo2BaNI3lvmlSdn}CBsB>>q%WfSLLbpnxk=fWozB(zQw({ZW?&l=Xl(JJ zBv`Sz0zV;kq`Ga_oYU(+Qx<4MVlJKUvu`io1BLAZfYg=Ys~q(kuc;kK<~w&KBpSEo zWR1j+-DKL}L%s*44g;fDyT!HCXi^4VE-xWd*xp@od^ANK#=thfHk1>=iz268^9~)e z?SUbMIy7_IA)k$=urx1r8%T8kq^a2$Hl2C8hxW=XkGye6XX)@as*vPm&^1k%I{ zJ~T_Yidc6ED38JTrhQwZxE9B3vNy#z%v6IQ+&kFK16DhcC1I`u7FPfYR$jjd$kr7g z%Aea*8o;x}*$47y>TL7S)&rQ={0Q2IWBHsHD zq`4;Xzmp+QObO9mZczaI5>iOnV<1`#te&>7rhx1jTL8F*Dy#;y$K;#>zyqWaU=Y<4 zxXNLyx)(6~G;A++CKu(QkUUHW1f1X!VEmLnfwD7VMA(qT5+du1YlR@CGw=W$fZ&mr zX3M9?>T{|-rfkrFF^1xGz_#{zbFrp5^egb?GC}6%eg(<2Ok?B!O&H`WaCf-;5gTrz z+gB@hJEx2(9MYRbCWI*y7ylU-;g?FzpD{ry|1k>rig)os`8RQIq)_jl;lfP8vHUGu zl(-5{9NYuGiBt;CO9`}#eZ?rCB#+=3iYFgS6W+P}GYPY_yM}DY;2>a03?M1SzR=Q<@`1eI$`h=)@FaZ*$sWKRv}c8OyMm#vgHwUu2sz&B+| zE<%|u!h-*v=WmQ(6n_ZfNpubuV5K6e57@o&ZglZb`!2xFK*4?z;e@7~s0uo5%#g@GxaEm^G}_cfsF6s$zK+JOsEO+I58G zlKGta8p3h{f$I8uTj#=0L5c|ng5yDbQ{^53Oaawb6GlqBmL63{V>li9mHNh238Ckt zX(so=U^+udV8WS}iMwh*CT>I``VRv&Pb4{sP=1W`k!%jh48c(bU!uq_C>6+?n5S59 zx*jQ1VZw`1#1@=Klqa~*B<1#pY5xcdZ#+ESmqC^YGw`e{wYg5SUxX)+mcC?5*IBk> zqU9XWc*b8%4iczyV_fayLjE|j5Z02m8RRK9VuD!O1Iok&EjKG3^gZY@!K%KcFv6^R zhgouWU6VWuzE~2LfmDnJ95DuD18Azpn^Y*HJHsj^ubyE*T;tIMRFzUvK*$5-lXD3| zPavPy6+*>J2_Af#-I7|YrK{H>Pe^iH%q^+AYg5&j9l@Ca7fK&9EKU(z#+{YM)mQS)y z`_fzxV@n;-Q~mZZ{F5+k-Eg_juD+X4JRR=rL39K5_`zhv_8w|*ua~E4W8Y9}ixzl0 zzMdEp{kA@4;b!L8pXOJc4uM_~FCOPIB#4nIKFhZ_^n{X5@=MDtQdC(OlL9a^vTxj% z?ij0FmymvW{NHj*d2eFOW=hy;R3FA;?Xf6^v=2&E5&bcv~x^p98_UQW;( zdH`LM-xrPSE~ufM!a#nc5Q++k}?Bl7{i1*KZXksL~51v8Ns!uyh&=! zfQw>KEb<+`PyXSO28ztyu}V;5(&#W9aN9QCm`YN;b#7Mg*e_CZurz9l|hx zEvSR&A1Ov>@}zX3?!lXn8CD2DLerqWSBxvdv^~yMyduO#4i1(&L(}7d8lxgn+<-g@ zuce|?NPM=4TgDlkBD=CKPy1B^pZ-w`#8&Z`e66-a4S=#I)Afv^y$P0xocxg zd%;bpL)5@{ko%Tj8$i*1u5?PabmAYdP?YY8BIdO?2OBA$8A=B_`d&~cz%CFV0X!5d z4I>)?=zhxl+s~;aqp()!&^3^bQ48nh!Lv+o1s zg#b;;CP^w{RYa>p{Cf@wB=3ZapIZ}C!wm_*%0dV-qKOP-l!V)Dqg{}Ug}l8OGg0y@ z?ui@DLDQ`!PK5_jMF97nFe27x5y0U=E03F}g|bM}J{Jkoe>5^2uC=ic9KIiJ(0}0h zplwmcgp(Rl)GKDV^!9T-V?yr%2Wm7(hA{o%{A!M+lGr9ei?mOE03#+K#3NnOl7c>b z5x}m9heX5@`QVNa#3LTb2jyUV;0Fs_#ruCY1tVQS&X&Rq_2THW&|S{WMI+zobc#TH zSNF52ySOhW%^C^6e}Vu1gkS{(P<$+uA6DN^^*NWYFmDS3H_7c{+Jjygw!higG>+Eb z+UQR3UWezDu9e3t#|^xpUs*SH1XxebO8I(btX_F_Ec}Jc zSa;=D#-GYOFy2~zHpPxg2TPS-N(hI_$P(-hzq8+8SiUKf>Uv}S@_ojI%w%Ctr`gS3 zMuk=9H=s7Xn8~%0TiN>M!^XFBtuL)#J||?4J7}07gV&?Gl8cXrz|8iENOk)(e3THa zghQv03TRiZRULqd#+)DE$f;tkwY%JdPv>^yt0%giMGe8-pUUl46M(w8PV+>kBQr?W zhxTeqicU>xhYOncv{4WT`?PiN;Qlz*ff@O|vG7y4=&tP}LnT`>P59+{C57FOJJ?dK)}$kEMeM0 zh!J|ph1CvbrR7A!_Fbusa6&v0YpZWK|Dhov{5@vpy(YhQynOTO8yO?3?w-hIJ~f@4 zmOHM%>6*U<0SmmYPNhI`h-yjMO+}JAVS-eUhG@-srJxzqED|(L>N&h#Jd#g78O=g* z8`*NK7PtsrAn0oJ{3;4cgnvHEi`FP<0T0o-DcaG;MBe3ip@V1U7Zd$uC~w1d`8Jv8 zdZk-m>{1u6sNeEI3fH{_b~s39*MX(wd1{c%{sNL2mq*4bdzCQ6_ll+ZAaCd8mS445 zMCyvnVaM;*R+iN^1KzSCgYEjHzOsRu3EV-c0m5*m@Gh~(^x)~}Y|JjzkQ`7nRXR`^ z#t1b{Q4652uQ9i5_9a;cCj!ZYVZB&LAxAY5NwDZFtB~u)OdhW=ql)zAIMq|-H1{8C ztBE7=rr@NA`Nc2kdV%77eIonV{nvmyE$qRW#T0^x{NaltuL_92RCC1J>R4r$I>uG8 zo;7ENp+24HG~3R!PD(BpAG+LaQ+x?~%_lIxOl_vkd` z-z2vw>}2-nK!zqtdm?%LDJ#Bq`k=fi?lt5VU7ZeY^0Dq@x>I-{27`caPm}24u{AM3 zs;-B<>#GL|%8&4)fKNOX91lS%U}~l$P3}X;O}-D1g}Nyc0jT*244sFh#|2xTzGR~| zfg~|r@Ei@ajTvgzG&6eY#@sPFCPPSwl8AxbU* z*`n%NR9~MxmY6hDqb5G{Lsfit0=78OHE^*Ek=y3WhRu(lV|OTfFlltq>T49#t#t66 zJec*69Kc>LU(Y!2GdO@nDL~1=<44Yi-9{*6Ib2?KT6?%oG(Qbl@xQW&P6lxH_7u2B)g0Uiv2}ll%?O?x1O?yz;b(zErfKoLrhZdn} zxv+7Y+kr8{O$eDRu4oN}?QMn0mXveWkzD&xNg zTT3HATxMe=r%E4*CzyX_w#r3XE#QATDNG*_5+K44#C|@-Cx^JI4uC50&bmubZmFX*AQUPu=0<@6nhg$U1t*(; z`KCo_DyosBb_Ph2GXNA+Nu&t*l2EJVZ6uj>KTv;;B>=wt49-9hERWj&t)<)|+Iq7~ z`+|M4F$D=Mmm-S4>HH(@XI7pOEdKwscP_wjUe|rcE+|=cyfOhvv<%bs3NdAf5h*@o z%9iU23lJohcq|1#1}RaZAOJRCfsX>D6~(p2@wgq2>uDl6wv#5dr%9Z|P3o*bB9SaP zNRu=(nk4Ns^(1j7)1;|ql1Y<>Zai)~oyPtB&$;*e?zdQwkTlcBOgPfwd))6n&pq#R z?qGZELrXt2(7AR`Wz(@`bod&N*5TWegou z)Ud2W@uioE{y~^$z@Xtf|KoD}0XAvzdHxBOA&NSZM1(CC3u*w*I_zc8UKh(m1%cey z+rPmWL=y>400AC^Z+ow4KthD0LT}=wa_MSwf<)s0T;#AJOR&ob;M@HS0HiY^%#~}ekA4v$0#8f%{aZ4W*DneYHlK;i~Wwr1Lzd7 z4raBbfcAP=i@1hyQzcso4gwIrU+etIn7lt&$pLC%Yz=`njOs6;~3T#J=Jvq2NtJOHP_JA!74=ImBzkl?Z{eeW0z9DKu^l z1|AESeSHX*{i|bnsO-1co{(NGzWjy43THL%%Mj_tS4pe%0SsU2ygsz+t76D~2RRP! z!E1ZCHDZfQWV{ zUlBX}ygjb>v^azR`B==bzuNM_SM7siZ9eb@e!_d??l!JNun_|s2hi(ao)KDtUjU26 z(`%JEF*Dp?Fl7Iyx3CuJEim9KgGXtb`DfoJr4?zRWkfn}Q&zFY4-6cy)lu?Gd4rKc zn~N?aaxPG%D9~*6Epn2*s<4pb7>)4bgfk&$DjbyEJD-BMYd)U#4n0$J83$3)#3b!gft{;W?8pP10V1rd4li0XRnLjFTL&IoKSqp4Q06Tfz~TdX<769InG2JA5aqh386wYsf=r65DFJk zjMx*fS4M`Up9t;7D;hD<)0doKlqwC2%NnqmbnFLxeP2m%sax+_%&yLHR~cwz*mNzf z0+8d%9CJWQx7-j9^K&g^aH_SXS|>^JtZ&_`zO>b|ANy>!+cvr>HLQl|9rj?l+dUDc z{k`X)dtJSI_SVJOo5@61KUNCJNwnxWa#g&lowfQR+R}wzcF>U2fS+}n|bFBO^+&HZJ3Yaz5;RA3cQER5i zWd(#AK~nq%lA`fAQ*3y+s%#6}`~tqgo(ve~rxS{?$R$j09pDy(aXHsyH?Gw7H->a9 z8tEwK@c@QO4}##ZM@KawNy&+SaFpYPr)oz%HXNj>0{!$v5#m;EKNfL&C|~*TMCj-E zNx#9TC{zPMmFv!K9iToyngkhcRHnA=2sNw_W%;!aK zb+(((Y9!BXcS45bHbZY>h9rqIS(8&WjxOLHFQSdsb&T95`kHy2LJY|qS@sMdDJuI6 zdx0%eJDfk*=MPBJJ8C63@l5_1wWD_DA}b%tGQb{^WmkxVy>zI$8;`*~Stg)8Rxc++ z)+ZX{VIo=B>>^0{b38TP%463r@$NeRpU*xG!y{FHxn&rVYx~;Z}{SqH?_AAK1{-(g)1ds_VAvM<3~2 zdn3tI)a8;NV%k5f-VAx%!p<*@jblwzD1u>*uZ1t+7bdp*x~{9&wawUH0J<2QWZ{`=LFtJPz{8LjT^ z9b!*9WZhM1OZwqTbzT7yc+;o$#dG}@zOH2&d zvxpqT{pheA(4~o`_aGgQjc^G{yoU&(7Uvb7QA0S0^d8V`v9Qegq;WcI59+?zeDKOa&-MpR85Bd!!Zr-M6wL`s^@O7WTYGig8>-j;iwRna`DH3 z97tsC0|=#g15yB}LPIqNK+mbQF`R>=_ogg>UYN4L&HxGXB38%Tb1j{rm?+Yp_%-+{ zZwMdE;`C^;S%KI^^bb;@A+O?RU7t9L1&b&_(+>xx>Kk9sHG4h*}oE$ z2wjm7Z#un0n29tPK zWx7qY7V4dO&+0--NW6227DBpVYV87rvU1Z*97fX#?ai)5P~F3NKf3Oy0Ofm|C{)F9 z+L45$La`7)Afk-`5mi89HObqeQ?NH@HO)5-Mq$tUh9(9YoWz`*ZfvAh5fbAM9N$AK z!Z9+mLENIR8f;7}Ew*?kS0*aTDT*ypV`wE2Sf;WAr43Jj`4)O6dS?4UVWTqpW)-N?#QaN;nc-Xq>Kvt$LFe!yIGv8 z{A^6Jhy-~raS&wxXH~$`zxX<`KAWC3>UJ=wb8-hrR&CI0nK95$ZxF2Ap=$ER;MpnYTx4Pj{o7W zKc9Zn@y$r;S_=PmyTZS`N#QTHEBwh?p2qm0)rS|{oy|(xJlIvs4-xSISdX9K>z6h| zj}U?8ZG3utxOrFE(-(~QG~Yg6YF4Lj?z+u0Ww#-I-46|u4&`ru(3`)qy5rcRqMti| ze$iLMpmqeXy&I5&&)4=MQ|v)#R4Y+~V*`h4k(wJB1|jnoZ@USwJhc`k7xQJDQB1XQ8u#1z zZX!_oAp&v2g3FiB6iQFOpcghzPEmY4B*kcq483|cw70jjERB0q6yxvc*U+QkLNxwURWd}!MU>}DhLPG$eW6Y?BXK3zBlS^HxmXS9Z%xw+Zj>8 zDh>s6w;wY-* zR_#j>2#ml}A?_h{A$-@y_m~ehK6LGq;Ge}rhPNpIp2&Etytm26Om}BW87F=0jL76V=oEIar%aS9UyGc>AH5rHk_xhXH($3~Q6mSP}tNFv_|Y=r!2} zHuWHaF-K60zmLCUNan<(@{Vq=DTir8?tCKcT?Y@9E6CDjA5Toz@(+MyCcE%Lwwx*VM+3=^s(upVvzLuXGY zR#=V5T@djVBFx2?2sxM`Y0!Y{Lqtc5x+#xBYK!PNie>n*aT^HT5S>h!Hw2}0=Z zy6rk!5m)M#AGRC!KeT0dxVCmf*S;IZn!9~pUix-zY)5(fT**1TIXQ~2-9YY^)7yV= z{C0e}5tP44_We_}FS!1W(pJ&-(ba=i#V8r1zGtjSDzQ$>4TGQe&E$sZrivXOYjl%o zMs@tB#*Xfu?PD@gfo7wShNjP4=M>OnND;BeQ9giM42{4xo2_-Ajp-&~t;}zM#gK|Q zVr*`)1Ds!;|Ip&Oiz^bQE}WC9jeTCMK3i)9n!RH~6G!6~jEfHJoM4^tU_b!jf>=7d zI=}_;CJ-D9kuIG5Hi&yUdu?z(%l2b8ns0%kSIKWu@9yfofrFmkKEAzlYOb^V1-H?V z-LInTeka!zt?`YK+aGNHH&XDF#&_U||0WJ`_F_Rx`pCLYa()r5s-=$YTzfr9cWgnL ze@2Q}68zZBrJEZ)p7galOZsY__RW7AGQa+fuqeWqJ7&sk8y5xLX?BSfJQ|5WTJbtF zzuB&2!h9u+tv6(4GZ0f)*tw35;&Gwf?x~h+-`J!hUM3ke?Q?A>O|~3~N5&h|<6H;% zQ#C7PVTjQow-mTqd8+nA;V9HMv6}^uzjet7kAdnt6i)cnV{6^@A9vPo*jT?Q#Sp(h z46&I;d|&+Bh=Y5`h!Zq=?Vnz{$&1 z^NP0PkB-~Md8GMvqf`&C-8LGMaT+fZu0ux7#m_YNEnI2-&oTdK^-W{`-s-n{ESc!~ zSm9``PubC0>^tK`l?#Vs9*mhYb%UZmvQd(qmeZR2^f}|1&9za=d|iOYbi9QT3vo4Z zkAfJ-okQMhX(9k77QE;lWp=WbN9Gx`@rwDa8~^ z+~z{;hAZp$goO}cHEJvZsnZ$xqmD}*6J0M@CShy-xSQf6R|z>(O|0KMD`R184S8bCjfllZ_r%d2mUW-aeRpfX zk4^d>G@)|+iHuNCf6CR|&uBp`oftxGgf|`alqO*y+Bw{uf%`3-A~pI%FN zQQn#_W%S*)MaxdaOW0EFGFVL3=-r6aCEp)0qxRRAI={Z)JL7LwZwY%R-A=I}6N12L zf|~&RKoyxdyCZ@i2z6mUAjFO$?u`zOAH`560EhleKc*?E}@=`q};!Vca8OR!F~;P7AvpeT?gHTYs4FtzRI^z@X@Iw+{iLD(Y)Jy%3FD%Yg z+?w#|`h(4H^2k1ZX!u({GV)yg!H*I~_*-+QNy`Pdgn{OV`>9sPZ5?1hEy zpBB6?{9I`7v2sm7&cem84&}GFt2Q-N8)V7kx-oiu7}YD`od{j|4NC1~j_~G276`}Y z;bIvgN(i7gwk6|33ZDe@1nCrm21k}p-u~)Io39hh)-K$U%8$cK_q!l+@+WG3@!+TH z$FBU;@Z;auKK%F}JlFhF#(~OrYFI!P5-Fs&Stnv1prCIE-N3%!<z8d|>gb%Ki99!c^Cdb*>(HR3N_kmNENl&~Wne zV{;|WT)h0ca=m=z(%Z)t?46<8_5RY>hNNI$74~bI`Rlt+hNNKU1rM!m`(iL zQ_#V0b}8goNRg13PS{pLg<+PJDax27OADr;^W@G@VN4mOd_w*aHQZ70%e}5dh?pSP zc(kKJ-)9+*IxoKiA22!Wy)6l!ki*{P8*N(2c_amh%TvVv8!x)pls!T*DT0cCk(=?QB3TD!sIwtZ!2BO-W^!tbP$=yv&6^dX4$rfy_^AiQu^!Flbny!O%r^=Fu9u$1zkos!pDOZU04N|S~cc#Hi zrXy-;Z6nlS8R1r4P5d(U!#+0absP5s+cYyIJbifkT=_>Gs)v~!QLJ?QfQsv4<$M-Z z)o2f1&RiH=IMf(o^07(4K`!|}sUj{yob;WUB!xk+R+kckX!DnYa!$cGv_Uy`#%U|$ z;bm4XqnsKcZNeKu{$e{K;rGlT;|rr>rLo+jkjZ&Ab&L4X7o+=$6s+CqTq<65Rlq%Cr1XOvnGsLeHm|E>0CXO;YE#hl7Q> zgQxT#91G~&kh+c*`p>~JCS>0ueP?4k{{?Rrw0PrdH~Ps!JS;bV!A=+Y4n7}%yS#G| z1TsvVS!mhnXaeHANDpgccFqsL?Ru!Xt@{4vwE8y%d&-Ksa07AOD%Xb^2;5yk9oB zmD``GaWk@pXWzu}+Wq$_bsjqG`{m`T2eL2d{(d5*?ZN#D^Nl_l`P>#rh7_D}_&CrN zeeCd{E4bLbtHs0ao`Q#+JTi`tHe^9yx#f#3uGviqzy&#rwu*M8xOT;D>JW0%I3KDG@GMRthk9X+!<)(2ctS+BS8oQg?b)GH6lrB`qF+Bf^9 z^6mbP4vv;jJ^S4mv3r(75o=+%pi(cQ0jAO zei&3txY>sBE^Rl@`f6#QGj7e#tPh|pU$phU^7Mea*bVF`Kj*-(qx}4Eb3_tN`Iwiv zbZ@-aA20gi#oOY=j&O3R_s*HplYH*6Vd+T0J~8IXF?bKt%w%(6*QMbLGcjCgiFnf8BA8 zUzw6c1|coGLHJi+5c~B^g&{53YxsDlDu6BF+XU}Q6A2$GG--W7jMDdv(QYLGT1H#q zLWmDbd#U$#VAn(Ya#k5c7MJF$=VxXg=a_msL_Qu(pQXi9pect_skP9y_eBjvYi~;@swErWZZJ4@BoRWk>%qhOTm;0dWgai$H0D;PM!zMoJ{55 zI^B8XG5YNM##Gtz7I7UKx*_wsFyta4|0?EDQ?adoz$0ZCHW?8?vr!zk6F=f&q4$&$ zF+ZF^SSeevjSA_Ts5-<6`x3>el}W9jxhPCSIymM?cB{SeMbtGOf*cJe4?#i8&#6mi-|3)TTgMnS0iMM!L8g*5I$<5aMV2XN5#IA2 z#cPMTuvKX3Xkg%@Vmg_Kpfx1kM%0SXKZ(`R0GEprO%pe=%$40hpn$+dUg zz!wW%A7ok!QNp=)!xFGPz47r!GPgU#y|1{bufJvrk>;b}cGzxV*lhkT`}rz<{ifkk z^OiYl#=WK&-My}>RI1OdzBS)*_}{wowc|W?8mW6hR+>dNP+$i50jzEd#PD1SY;MB?2 z&>1qunpbU%QrG!#y^Ck(7H4NJ%vYaSSe#vO1bpFKb?F?ZM5sD+;-FP@+I*atFTH=pmC3NCp z+C?~Qr+rEp-u^}LITCc(t9u>L!)AR2&<>32wAv6o>KG*EwU!p*-3BJw?wg_y*3ghB zWuhEl`_B-B-UQRx-$U9d^*>5$9Xp@y4;E09ca#H*%x;(f9K64ncy??@jfCtj6LlukZV?|f#s`R3u~ zx5H6bMjO2d$>%9!QiU8>rb>~sj6$EhO#fugYQ|%99j#Fo*1dW=*Uew|cb9%u3MH%b z%8#p1c>L2{U7g1s>b!h2=T2RI1H5P`^E2xU-Iw3d+)u9Jw~V;Le)VQvdm>}&;re3p zKafW2H~f(sCF~R%a<@biiV}cC#BIU6F$11XWzSy#+VSQ-DaRwlW=+E-i*$fU0T8qz zrbKcS1?o|0HJu?oDSsJ^(P;_%u4;$hw}b^1?t}p)fej6}Oi7#NaM|e4j(zXtmEI z4-HcJ;r1o4)-lu}HxXiS-xC(;@_vEZYdK-9+=(eAF6!zn#}(cG!Q)0JzTq?; zZVYDY!rQPnENT{uW-whbLvEs^XUx%i#N_1D8MX-qq1q^CwP$iY##wfUbLDOVk^m`p z2I)4-DUEX?He9-V%W(NKMvXphU^raDm)c;8u0dWh4ca}`!a;v-8}X#f+)R4PPXDiy;E}RqcLYd>Z!z!N=6lAYph2fd{J( z>W_3a&@6(lu>}s{e#Z^!i6r0;_hA#1c_EJ~5jai)lIRG9dSGl!b~K>KJRL=pFu@9H zWk@x&JOu>Gf(jbKCxi>>QV@l`kPJ&MlujI;8t|;kgEdO+i#_tGwqZnKvlZxe$+S=)Ge59bx~HUJpbSDvxUwBma0C)1O`_!p<|wsnsQ%-vyW%%H#k;E|{gc~{TuyPOB|#IFw<82ho& zc>Y;+_H(+&4tnb;pT4#90;vE?c=9#2&wbWZC@+;Coc?>qtmc!)rVo)%LCjd`H;;Ao zcTN9&v@@I%*K5@*y&3%3=v^wG`L4Bey4Q2l_-VP;!A7rDbb80<8@-P=c0BGotNFHu z*RaOtR#jK2yV1MoiDfv{Eepe9p73#!3CAPv2iC( zObgws!;Rf*zqHuAR64y^1t@w~V{f^vqPI8p&XuMQ?EJ-2XlD9A&+LJ9z1GQqd)Iz_ zvH7cwJIkl%BTCD{qCal7EIXR{>R3RpLLIoe-s=yrtf8}ebWbiYI@)0-qE$! zP9LyE8Jq5(zIPgTDCZ*97iRa(9uT*CD3GWa6@lIp!V=NWA*77x--JM7_OWpPP6ScA z556D>k9Ny`8brRh8(uVh4MxpwagB=B0k)vFx-zr{UdeA!Q05NA2jQ2Kj}IaZXSWAn zm0^9tUd9Q<)Uf@Hmj z<&g;jnUGMBztG`rgTpkT4E{<5cYI<{*|y+?qwWuC+Q#SEMT^Zef;xLEkq{VQ^qhmJ zCTd3zS~e3?px)?j24#?}@McK7Nyx47g$ORLH#DzCqS%hyCt`9pXi@HD#@C;jIe!~o z@Hm>vD+b(&JD~l=dv?F*!hi|Ea3|5Z7%ir%Fx0BwtMY#`Sl?_ins2=tB% zH;^(2UASRBm<~(S@mPnap?s*e_FCg5n@1L}tlngo_G8$ixxY5od3jrNcTe*jLSWmb zw|Cv<=iAs;w4WO~_@{*QH)$*Xp&Z|?J64xFg8b@>Ue7xDI0GgkHCxF#Ojyt;`s^HG zdRR@tX-h@gDS`h7jwVlrX#)u2V~h^9@sqpxTuPU5Sir#PXwpVa4v<^Ut@OU!kIPDb zZRhro_jv8U_m}b0{7WPwEth?px!q(NBZxuw7>98PPaoI~V<2F*YPK{^@})r;92GmD zrO8+i+Wu3PrW{w`v2y=s9;GuKAGhBf)w;^%WA(qe zbo21BxuxpYjUufdd;IGUHvjUb{>!&_^bB^2pGY%gIW-nHbqGo_QJ?mXv{({ z(zc{3j$Hvf4nP^=qFVO|>tfwoA4!d@jhua|7+LG3hPX^F_Cb>X;i~KO+k)MbY^=9tMW!s=V?|IO6 z5-{sgbp@m*J%NX_0M-EVXFEGPN(P=D$7>)mdwpO5r+Q}H);VclsHZ)8Mjo@zO+H{{ zKZ%4LF1x)RD=K@+TuY({9mC_=v(^T!VjPORN~>4EhYBeJ9(4LXb-`Sk(Q2Gl8%kg% zUw=)j$rh-h@`;`ttc~l)(v~NXU#CB)m2z^%A}N3KAV4meR`Ms}1rEx7g>}Qj@B}O& zn<+FmR3urEr%b#X!l;ao(I)vf-T_sFhA8h%BuS!@2}#;$A2s14CrLtw*;*PrX#A{u zU~>W)(Rn20S9=~w-dh7(2IgW)h_#jwmw>meQNXei=i2lXy(8fFIpx$0N}C_f6Q=F+ zboOLD!)JTMy;QpkIpF>*%>fscFZ=DYa&xQS85mx9dV%Bj7O(u=x?4@wYnQJh-?PDA zc6y$|Nl{qAQTasJ02QLHr(mW0slgB0m!Q*Nv1?|00wSe{#n$hMfdINJp-(b%T0w)? zj7GIs>`7%K{F^1kd1s5oo;a6GL~b+fRL`_O2xTh!a7{*2w988!!!MPGU)sihUE5w` zlz?NG<`!Kk{m<*$>kBXVClA`oZ+~Uvn6HfO*XB1pknH*9Z(=se6$ojJP+<$pr$Gj9 znRPU3q+oCp4ESdJD6<5Ihb9{(U}Hj-5J}r|`5qV|>qYi7u*)a|RDaQEZ8JSMJTy4s zE0(EH4pnV`M`b{UNMamcci8pbqWw5fb#^``Me9{ zN4(c60POkZXXJ(V!>9^d;urj=RTm>&%8D@l(Z$Pe?Ek063yzjun<)0+isUbe6Zr;5 zg^&AbFfZVN8Dt{EvtYfT4OGl(0p%iVrJO(h1DIj1L(?>~QT`2za><#T7`A%C*jN^oEY$afRi~NJrx1N|Y z+;H-xj`~aG`b*pR55(YhE`zWIt9#vr{&17N0LgT8w0XW@@b0>u@Y)|u_b74Un+#;F zjMWf&O5%$oE#dSI@*P_HBx>^dfadSm2hA5{%EajJK~Xw0(H0%q8hGSfs0m{f;1!WM zqD-qK*YN|GL;pbedcs5F4gnoxY{c#O(2QO75T;k(NCZdwXj}u(8y+FYhby7|IF(00^XvTm7_>FWA11pbn3p`0Yxl~LR!_uH@s{hyjsAVH4E|Eqz%m9qkN3vNe= z6BZ0N8G|pe!r>848lLkHorH2G`(mL@PLxaj)d3Kiy%iP4XQ-75qwj7{h2cj8KgxW; zV%y2hM(szA#N12ZNP|sLaH8a;e1h*! zpD`JxUF_S9>9Eqfa$)A|+|2S^b$NdF-0~c(6WK;)W--pKFiGw>v5A}844l^9YIVqX zE>f20OYe&qH1nx8C+px+C`}OTN1tOj`PP|57dx&bo__UTi+vb3K1+nx7b7>|cz8iA z;ek1H%TQKnccO{+0M6f>?J#%ww>CZA0r>@NUU%BDN=whYUrgM4s=ddT&&@8)ES^zH z;lVoY*%ubht;|d%UiUJ_Lfx$wUf=b3vMjK?9?1|k) zXD&^u*DTGC{N~$r>*#1>fbqtynC;(6ai6zDg>xHPHB2yR9!aXhIA1WCWupsG_zL2o zb*+@aQD3ESCW!S+DsllaYjI}gae(#C>I|}|{w^)9=%kN3nc_3&7ndR+uV}J0#?YA5 z?1DM<0%%I_K&`-Gef$Awv9qq)m?L@$lU~g45g&RX%V80j`2AT6#+==k)jFB^I|jc; zGguk_sr`~q!c~?rXpbPCg~Sb-D0NBxGlWve;XC4C?u#qr4+?9Gmx!nXt27s zIx$FFxPoNYQ@XN;@xnlBG<(Xj`b`mtVmG~U@q!giOA++4-AA(yg-l5XX)EAkrI>KU z2zX^M6;?h%hfXdCk4(2ybehx~t2TPn6$!Rp1E+CotE8?|3S3D8@w01Z7PAn2RE?pf z{AviYVTK||Kn3Rj@(2^&FtDorWZ(ILlcQlv*(t6`qjZR*=oG;hY{ zFK$Pp666z5UnlPiMz1XVUAx2ib&6!y_#&cwwXHM7nIEi>z2YjnkXzAVAWY9HTKjMf zZIG{Q{sb7vH(7YgM{riQ5JH6oU{8))XO;9)NTm>tpT>~$-q2K~cVcYh-s+$+DRWGE zKyJ*3w$Yu{m2(`hqDiv+YWOG4R9Bund+zL$XNgW-0-PyV7%o3lh zTs%)oq7_P?KR-XSJacw-UeslI<_R>^R&4Z$=uYHodMk9u_iZ+t!85dPAmoqh>wO5L zX|FPrL6OFTx~$UsP<789B|y4BPnH+OzrZXlUYI|lMZGY;d}i_N%#yXq3rO9{ma6@}eTkgH>Dt|8=*vibAc|OaNEHSe4=gzLox7N^i>P~hpW|!I^oTy(~ zJpJeqk&ZTf|1fl5e$V^o=jT51avGBH*c&tZyxIU87;>}rtxwB{n z2`WoG>)4T_)xKSKRChfbrn=3#`V?!kZMO1pA}WEg?;AWkL8`~e>7fZnQ^HjKT3Wa7k3uY0R;AaB-`@wKcM!h&{VcsB4{@i?_A0*XzW z>0Db7dpI)D5IeSvQ7Lq+lKeV(EK`*d8R64DR@H^0eR=_d%>Ci}B5_XZy`x$Q+)wiK z4&yR}Y6{;KDs^0^M`|#B!6%?a$B(eKfe`ACQ9)klZ*e-1quzhu{+~Z6ta<&u(yRaw42~A zVN?p4K9a{i0^_Gb!6@$P&nIyD(5>7NZ`7Hq#E{QeedMn25ur~Bqv<#FcPd@ zNz3kCwtmZLPfHhau}Yqws2?463EFD+%Ege`cCQT7MyB8~Ow2ZSbn6%*q>GL!B-UI| z9^P0SNPModR9L7I+h;QF-1}RR^P4V-@3ctGy0j)id+xMCP(xHsP4bu}pLkciwq&xG~MxnbqT( z1F0SJKMW&0;A&qro(cEB1Qkw&H%xlCik7Z$>+waP64j?w(qH~hqvhiBy#~is(_>h% zaF8Q(#lJH8Wvm~vfgaIMgEB6yA^wIF>bVk#aHbFC99+1zAk)dl5#|d4E-E*I5V%*W zTtjJ6&Gn8+8Od6~55FJQIz-t;;*dtd*suWf`>0l*R(gk!A*yqVm6CLTNz~PPL`6Y` z=1@|;-vgTFmshHuZJM4ARuA2^f8Sm2K5&N`v8`{BOxiz1r-kB@5GcKho2JcD>m!UDi8{p!Ut z=L<-yIt8rzp|)o<$B!YxoJHoESz7!77-BvNabf9KlAzF!vJSle!2E?O+hLhwX7`#n zRm6+&yA+`?f1=AN`lP=ZDijn2q-v+_CifIe)u?F=E_>#m#)dTwe3n!aGh7)kYWgCw z%IR2@Rsi&@e)ZmO{MQym0~O##dXfRLAv2r)1g)Xs0+}NkZ^UlO7!xZYLqNO)-N(xW z!C2F~B`n~JOANRmC7Zg+)>V9{XW~inw^NtvaQ5q z1!R@)y*#`|a~WP68p+U4^h(unE%kA&22&T^4hv1g-5EM^{5VF|vIc40!|qD!C&$qc z#%SLuN!Nojw>ub8wecyrC!H+=7}1~=1>~ybmLX*m8JsHp zwVW`E%NI<_ap4lfzF&%yM$47i`^~MY;QLds-(q0TO|*<4-C(d4I1TVHUzkc;b7$}F z>aN}+jnUBt9&txSi}ZyZXybJZ9p2SzD0qVfH3G$Mp?Grt$MR_+++@8E2j48G#Ve=lRD!01BnnGc&IAK-@@b z0~bslXM5v$7L0XjQ%*kmI|R?4Sl)QjVsMiuQ0uTwrE1(I4AlOXIob8SIx0q+J}3?~ zsv!He=!5Ae9=_?xv_{z}zjx@w6jN_ztax%?ySOpOy2o z;`>_AYAAmVZqm`N4Lvh5MAf{B80t{21TUCY0;d@=-aFog0Unp;F2j+s*?RQ}lGY`- zTfMI6dfLuH3S$>?wl7$_h(2;1z$CNya&!Y&Au`;t*A$AflNpuJREp4Qy@5~HAXtmJ z?s$uO0md~9ls!O92} z#ba5fsMsoPnN-z;(~_e{6niEC86~v?mh5%bnl4=68w}~<9SE!xYmxrl$1B~7>GHzj ze+u_4OC37hMmyjYL@pqp5A0naOT!(mG60Yy4!9LCl?!N9EoU;N-4qRwQ7#JDB{yBf zjpG%F#8RYMk&N3;J)vUSA;u``Lc3KDnbLUaY-qwtI((=Uue6cvoxs;x#b6V}p!hln zN7L~@w`J_TE3S7&e%7~Q)7&-p}J7z3c*k=HGaX<1P7l94F0=i~drcypmo0q}`>D?lc z^^reiN%E_hwj`I{L>+OXN6< zE`nI2`v&vv%dDxPn{r;V-s)C5$`S#%84kYX^r&>wM4PaNfxMF46p`ig920o8dGslJ1^S#^882qf z&0LH`L^2N+?21#`9^se?-G-eSJd844cM}&Q2XP#6CV`fk&Xo3v^2D0g_O{vJY!fTg z@~2f5y3I;>1I6yAj|;=dUPKD%t~gmO^-+o|En2qlv0&tzUcEa`^v0>RNP5^G)dB%S8wWfiS??E0+mfn{Yf8!$dFv z@I?N3wESk16dnlSXNAlxoR>H{-k4C_K=xidL_W>+4e!mEe3kD72(EUxMxm=UqDo|) zzDgAm>ht$b)v`gLec^D?>}!cC=@@fMcUHvVH<<@L5Vx4uvY|+74W|h!ZL&(*R%#~S zv`}Di0(TmL+s#yIWr@TZ>*})>tGS#dt~Z;Ag84muvZ0TeU4GLN2HZu1eJmR~U?qZ> zmG&Tco{j4opR{TmT3XUNnD8MkKN+ikmN^N;uQrU<%cb4}TPX@C_~^1xY^XS2gRD&3 z)yY`XfgmmPVnRYow#BkE6V#L*8srj7lJo60f9Zn|G{2&tF~7#QWFqz(_ErI;_Vi zSb6MBb-~3T5;+wV;%Z~u&#kE1p$2uT=ze#V&^IC;A=nhp?@dhl39RNYtfcY!ny={Q z7zyT`5W$n1&47p?CksH0WO8NgRx}1$bqTr2Nb@?~oS)pcDP|*yg107!GN29VrUGoF z-(T&Sg-~UE$^~{R^#rDBigm?KH=&3#i}Qk$7$tQrt~9v*E}bJ#Z5c;{`Q=&p1-2pp zoD7Pcv7^2@N<=lsu4M{qjfLil3RgPAZ1LDWNi&)EwsnfT%U$AvTCEC6^tnk}32t4g zw{`9eH{|?KvG>09eA;|%*+=fJv0FPlb(-5-)uxF3#yCEiC5rFGMFWS8`Lh?6aZc)u zUG=8p>07Ci$&pb(cdNQLbRHOZ1zit4-B?|YG8l%Bz5RUH(%4UmmfBR9>+`o#V`0w7 ziJyQj!jx?(tn9kzK*nL=_aE1(@#oXUI()8~~o zi>&usX(I>F<5i$jUMCKtR)G))#K~cln6YpwL3Y+xD-LM4alI!@pJJ$oAX6K6F4n2w zSA{=X9YwzHX1=ijhrMYPMPJLp+WMR1QNE~QN%n?bY=kzwfI)b9bEOZ$yo5eR9dI~& zCe!q83JT`0bG7ZFxy@I{cmq_a8Ie!sEL)Bv;|h1NML?x2=2r*A#!VSr*Mx4+=1teg zAxnNh3nrc+@k8`%o0IpXh2`|}xuFog$TtweLs7lTvK?_b7wmw@1%l;vmfw8x`O*M4-T7X>5jk<9 zjy{KNN4G`L6EL)$A>+S!doB3QF-O9&x0~|x^~;%Z^+6a!^ew5w9y9O4Q8^Q_DYV#^ zas)j?ya3L${A)$WwkNJNT+LU$d2%CI!RCddn01&$coSJ%1$KxW8)Z97>^Zy{y!a6^ zJ-|Z+)6dClisJU6pu=g*@gMKy$05m75kfj)Mq|@-5nR}&zLrsLsBB|hRK{*R%s>nS zgnk01c3hy{W__bcYrwh?aY2QEq2Ll~QF}gtlkx%0k%L^No>&Guz{i~`p>4Twi@T#e`hG6euy_gcT!CEH|*wJzb`27s;DHY#u&^|SaZ!>NVg z=ZuSq_ahKfoeBa>RAD{j!A9*hHWi^;(iK| zC2;y&WLtwn{gW1$-pYkp6{&YY+p$Mv8ppT!m~E0Jr@HWbbpnaUzSqoT7Ko%jjjiPl z+wCc3{ysS`QQ5EPt0X5B|z>q=`RBpkpo(WakQEyDjLXbq)3$(0u;DZ zTHZ*jWP~N4^BSyI*0fMy?f7vyUH0LIq+wa@F2@=(sAX$M?L%UXUWu}X*Zgn+Gw=50 zX9&fqHs3i~ko{1LBek(Dl3Z%xFih_i-mA%t5S_bIQ^B>sT65Z#ilTQ7>#>De3NR-x z4R~hzo>4@;=>HWKBayVOJw5rr(p{fdVNY%A!)9Ka^P5*(hS7xfgnWyvPu{C7@xY46 zVi61bn@4f9$x%?`>&WLZu%?D%SYPrjLQgAcUozF5b zp8DMQi&bnNSW-~8E&^Mt^jm|s5k{cx+x1c(Kvd=3YDH>t$&_`pOE;LpLdcsn=@Dr>^rcJ#b>)!{x^Sg32^`b diff --git a/sources/FILEPKG.LCOM.~13~ b/sources/FILEPKG.LCOM.~13~ deleted file mode 100644 index c3d5a0d857fdc175b963d9a9542121d1889deabe..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 103352 zcmdqKe|%flbtj1TKufY?(I7?BGEK|Rw5^bGC=mdEDv6CpkP<+G01c7?Da%$Ufi@V^ zk}Jtg+-ABe+YtO8moVE`K3j22U(tAm~F+VwB^~6T{b0^RB#|B~p zR&?m#;K0FnyvOS8IeGfwM^@KXiq`2+I=A&zxL2dl!9YcKY!C_eW!WXk)D3e&h^3 zG=L9{9vp}sjK_Mc6K7W3FYR3U=p$#&-f_^Hv8OS@%w*I`=4NJTlyrBuwTiCH@b@fy z&^q+!+L|@@7(RE-ip9NQ?BBn?$0{zLL+5w)_#edL2Zx3a#zuPH#U!9_|G+U@J7c3m z1A~Ls$AKW)@)|CT zgnDB`{31SzMU4+y2eY~SjGeKfaqEL9*=nSEkkYAr(yK!m`!J1e(Aqbf&m|`(CorzL z$vG;EZ|?o98tjidRl|B_M)X{bT62?=SoiRs&tSD8LhEYrJyfgaf3YnR{ty)wc6YV4U6tWx z+PRhwMbaKv$Mu)t|XdL@wZqm*tQ?u9_^GgKdnYnpuY}j9GWXL+^-)RRj zx!iO*YYoP%!;|y0QDXWEuo{aFd*C}d;9U>L{J`f2O=~F1kP=4?`v~wkAR)Ps&rfFO z(I93dYV|y@OnAJ-Lbr@LXK2KO=yC1B18qCIf7tr_|L2@U?1%J=N`8 zv(0WvRc}tWpWMS+>*>PYV)&``&?m}g81|jV!e2^VDm|GpE~U)3_>Gq{McxT~(_I;> z@rAd!GxUwsomYkMPqxy_nL;;T$p$PvzFPUk%*Cnd)zhV}qi;J;Oz*w0e)*@lMzPS# zTbj3HxY|;R821(9iF&zbhM)68Y4we^$hN|swzeI)*6P)}c4f?C&Togml50I4sg*vJ zYc=qjYc-Fz*5u9l=L_Ad^{*7VODDT)pUFj}lzY_Hc1^B5T)k?S^S>C!JF@(Z%8hN2 z_wdLHx1%#VbGrpO?8>#9$J?FX2?5cMZLznlcx>33nVcD)%vTAe z38(_H$WPAXj!at7;Q=d?vnL2q0AL0zdv1DR4(~^SVDh=#JS{bWI8m55U=L(b!DwJF z#s>s1Td@(r-?4bq%BC|Jd{~~)j*pJY!|2eEWoI(dnZY4ziBS&zMn|oQLVBiPr{~cF zRL0j8Y9U<0JE)vJz?stz_gEv? z>mWGT^n+IKytN-#pf9-DHN8}XKR*d7t~Oa3^wQfKX;4Z{$*nXfB;DxE1stt*A?;ZH zVrZWc3SGre#Vd|2(q;(k@}l#f9R$y{+qW4Y_;DfG+ylWjSZC|l%n^_REU~Zy0h~{$ zRr>9J>D^3J-_EA!n;E2x)f=@iFbrg|59D?N<1lSQ_D4BpJ2w{%j3h-nXyZCAPBCg~^%;p(?npQx42Cv1}oBMEzz_X9>ati}LD3JgbUoSm@e=PVlee10}JM*|wOZUP$I zXJ?o8;kIw*#AJpBO`tAoh5p3^I|2xa6&oOK8f#448(lF(TcMZDP$-<>ecqLz4)ctk z2!%Jg6ZW|DsV!oROL0pr0nCt&7~%4PgrS}n)u20SiJ}ar#wBk%|NgV9Zzs$XA?IHw z3{~sb)bFpV-_O+&rt`*B_B1!0KzNh;#b^J{ul_R*?nxaQlgxUDgSJlg}fPB@)v4lj?%=U!a%w6=YCH?8p3$~GFi0WJ{;+@3zRKb20cGCVM|x*D;KgxR@hZk$Z{>K(0D@~J5vwtos%BYGSK1yj@&lsY#R zjd$!Be(gE+TbsEzT-|{^`CX8_W8rd_osq7*l+jmQzcy_;-&C#p23&E0_W_I-1F1is z04Cs9BDh5%DB=CN*7{d-t>KNAvbomojq?eU$G>P+K9e$ROxVxjC9Yfyf2sJ{QWw9^ ze}coK=0IK})%I0p8{WWs@-0x{$nkcfz!3w#xrm91<2hlfxk|nAFG|k8QbVZhQWq|$ zbm)<66cVaUJ(=F44>UY--@e{``$iX=2`pT#UkUY&fXUlpV??cCu+LjR1exCYVLZO| z!=ceZm+lXNbJ((#A+X~!c7EEPOQ!7XVer#K*o}m1?4)fCVb3d;VGy!~F#bRaQEL#g z!n9=yCJLyWf)Jz&5 zvhKKz`oky(Z&@G*y@aSqy#*21+d*ntA@Mf-whQpG>-PC&Usi9aQHuhLKbfAGBytAc zf%TIql1xc`<--0f^xXpTq|DOzn_dxR+22#?4yYv9BjLeSDuWEF-Gxo>4c67XLsQ^& zjx|~tdya*rKFeIcP89ItSG6UsF6=24EZ#!LTUkz=$+e!`!&~nDLQlcUwdW$Da(XjM z_oc!fxvdo}k8u1_(YQcQ3wzeWQ`fcDfJ6U!-Hbz7#C7VB0)7@cBVt?`T!>LuUkQGM zF!gs!3uHdKX{@a2_|gp&qdvzY26>=ONG5{(VhHyu7e34dbGP3 z{+xNd)4Az*XYIqKuH(CFxsK|BRN9TN9Pbc$m;22Mj8=ZgQ^bE5?T`XvSFV#E)yuc# zL~i3-o?S3!{$t67p89fJ~ zm;Endee|29B0rF)J{=?X>*OA2{ER{m{%nPe3j#B|nyA_gNSs?Bo#`e%Q#1rzW~6K1 z!@_^7u;)3|4!(D?cUP&{b@FzeL!!nbV9q8ccrOf#^skuNVV~-cILl-1R%hn#0B*CB z1#CoXXiU`1v?*}|w5d4fA#j;~QZO{ax_kA3ArO+rMhhu>9@JzAltrr)htLmVEMt%? zhWHB7!)R19&LBd>XcFT&2o_Qd8G{%JcbB^~2o)C%P;LeW8R-fFj6%K`<$LNgZrGwR zKf5rGC*ZsZ{m4x-C7Mr*7RNW-3Gy*A!Uk9|=v-JxA-$$z`JoaY)sz&*WHpE=n197b zgMsq~5rq`u4g%Uo-N^9Zrb+Zx29lfC0!)2w13-1nrygj37!0H)(ZlF2vFP+7L_0_* znxz~fI|^aYL5NXal|eEepqLoQI7GfVAa=}T4DZPd4~?iY*j98|6J28*0*H?qLFgC^ z+{eICbK9{Y^%1fKdHo9{QvU~=D1|ZXY znMmIdAgH&ur^mv7kh(H9xS4rC*KZmWLSG*e1R?%;|3Xl{4K2(-p5ss)rdClmumTXizcFmagIUk3a zs=9qW^lGj{y|ZSji&C-3)2(LYcqf0dxOQ*7++Ayn?Bs`qUYNA5%XRa!_Fc|};@W-n zr)wqW&f=O?f2!t87uT+-zgk@TV7+{OtuSzWcXc}tO+NBuE!PPKq%9KhT5HesNNZfL zzR{Ai+Fx0}yv*jZ^~cp%;kcMOmatLS@pj6YcL1;ddbvzED zDP%1Ukx1F&<1Ph@g8~XIi^J5cu7q|d@)@T+-Nc^Gn6X(oP~5^S%p&Y41l`T>ur)r7 zjf6{lESZr@veqrl(f*2I44HJ6FImfE!?+TI72h2)R6TJ|xC5re=$d>viUG<9qC}9i zsSu_BNTzb6 z^_hn;6CzHJ8Z5jXK+R6~K*bE_hqEANpol#mSw3|RZdumZ<;N_U6Y_^xK5_adSF8t5 z_XH(EO}_r261NZkL%R2`&fLB}D|AcP2pL*to&&Bh8)aqDkVWyq*knBX7>tKkLEUJVME6qdv;_rrKT{jG zPqfq+FP$*O62rLmM2omEEGF#agpiJ}r4n{&T&`<2BQdTD0pM*mbfuL5FkXC7HUBC% zJWf*qJc7C4&Vu{ZoFu8k-6?A1@d2CsOnCe_k5u?+IP5gMrI>hVCeSo}MUi-t?t>+m zTG{}bVZ1l&AubMAK2l4S zgsh3{*n_e{^{*zRTDUS-b6c}&N=k&Pw80bQv#E%B^QraA_o!-#P1QiS22qNYjbVme z{0gnQdkq@mLy16;hti94@V|oB9}v3t$S=u3MZLh@d_e3!T)2dC_ zUL8TfM$9$(Ym0w^P|#8F2MU*WO%-AG*E_d-`)XurE6e`VwJGxn{O|lGOa`#sHEb+B zNDCH~;6{Sz(X6%-(6RdZRoGzI#4k()??1A;xQ2V!n8-$tt?e`1!zG0Zwc)<$KGYw$ zB7WR7|74AUG03&Xgsdf7;z5I_c`N_2wW!D!a z5@W(tWL#IQ{L_-R(aT+~&6Vu!FA+}VU8;@Xu5or+BY^sA$*)ZC*B%*HH~`$Kc3j~H zF#ejl9qwd(<2{>NF86QgS8#*&E6`w~dsDu%Hu04teZ%;^&qDQ0aO>JL!1x1t+4i$J^1Lrxoe+Ed|BDv&7sFplUno79HZG*i zx2L#Xz4BZ9E55h?Mhd&BOQHYO*)Z-$tC#N0)W4DmKR2D}etO1qe$^JQx$=K4IbT%M z<}Uj^t}{mHi3G;yd4k-cC%rWB91RgWtZuW7QWrcD7yxyLWq{>7e6AIL zcUA+>Q|o{CfCncDV>|#iu>C`YqIXu*8i9D=y8|Zn-9aijkR|?@oB~+Mqy&Xw)C0C) z8}1M+0p2@+6LP@@oExC>E81Fp9K z`Cv;aTo1@t4=O@GP{4^CBFvOjQI?~iN!?p7O-R|RTNqtPLd59$DJWrZzx!3_g^&?y z!JboaKc9S-_DHh+bM(VF>l|IV8z+1sR2zR`JfT=!@WY8sR>_DxZi;tLE#dq{vN8sf zJJ+vtdoS)u=u&=Eo8=zxHTb^U9`viMqfmS)-&o?5)Fswh zzW{*J>TZHzpWzccj;f9?x-1rvT);N305+0Vrvf6jBCCps>*Wx38J2BgpjZX|p;cLegtr7d^>8L^n0jn6J(GaZ1BlPClPU79*OMA_upu{!=}DOp znn@rg1@1BJlY*TC&Nj)#&{xAz#m?{z6xP^V#Mb2b9=xZ|(S$VAq@ND=5RBB-ej-o(u_!IHC`>y} zm`T|!&nsf|*-~V@$PB2Zq`UgB+EV3NVKQs-!>@~v%A#uH>2#_qk^-OumBUBs$Yg$Q z(gGGa<{Q%i?;6+=5f|w8ktj*{ThyXqv83n|=P*$~gQ8O6s0s{NPb~jpai}_91NW0# zv%t9b^}D^EkjK_Pp8p3{8i;ALei*{wO<+?bR4T8D_sJHxd~D+hCJZ6otLUqz9(Xq$ z7uNTG2;T%u)158myZ1*>o(RpMC%Ceh$#?6HKsvCX8$Rg!kMc;^x(}{s0?SqAuxMsT z=M(TxP}ma_aDE$<20r%BR`d%Du;Tf`j;PR?{k*ap{;tI1aO$=zhl(T{LNrXkA-uXh zZ7w-KkRX_P`3G$SS0%`vdo+B0N)^J5>SCt49ib=pA@Jl9*>h(i2>>aG4fWmcpAQ78 zo%+GZY&{RW%PdIhYTsi;SOc4znL!j3JAgrNi5;YGp?7Tj7JPSttHavYz zEhm&;b#1-nNCJFNTlv})zsxlAX!({z!TMUEhtU6*DFo^XnE&?_thE;SfH*h$t9~JY z2R-Z@a&Og2vjEf*mKycf)Ngs1fGk!FS8iYB4ut=#(6d^9wO~E99{yeaurkK1hyOX# zliGUtowVlP9!Ns~Vp4P~!mt{JrNgzf+6&GHOhh=0Dqo3udB2{K^6jXiTidOx!|$Q{ zJZ=!Kbn^C^>gww$)&9#hHAmc^_0U&ka$im;yOAn>TGub{RcgC#QqMrF|Dmja?gP)P z=5DTEZ8LWI+u!9(sSbSAZE)5bENn{pyI^a%DQCCaA?}JUucZom;Fe=P?r*-fZl03r z&nmcZzcL*BimU^JioeGjt^VfpFm~&~K?vne@Slj=_7Sgbt=xP`PpfZ5bVYf6Cc#++*qr-t;0C;ve-2qfbz9}aKX zFnt&Lhb>3QA0CEm7HpfvCjur4bby4?6guSHEtgh(8luOQUWcM2`1nwgH9AQ<%g$`U zhk^K#p-lpldKXsQtrlE5HFV_-GPL!WSOW!d3;O=8=VTC}y1~c3L6O!k_%JZ2!L9ca z?B81ri$-Z{aR4<(g|%@HNRXMwMhuUPZP@GYkZiLD14Zw@@HMPT4DuC% zGOiH{bnkfI#89t!GqRjyszOo&35ON~3o8I&9Mc;YcKxkeAWx>PpE7?AJ%}jk5P_hy zkWtbJl7vkd5MlE z!_MdJC2I`2UTB!-=ItzkdB#8vQn`FSjU+nUl5+>3;r3|^pW`Z{ z@W^8gtu+b>LtR0zz(dA3qu{=k2AA~U{LTo5Y|qY4W+&tpYY&a3T;uZ?5WMN(t~U>z z2YR4y=HTFm=&=2B`=R84HUuhDxdwWnP$>Kj4tf|{8>QH$t`6C|gpyk=!4U8sUy2f# z9A4EGE3~0#hRzv%RD}bB`bAQ-OW`2&z&g|l9^|j6jfMWES9In zibDzGdyIYul+6@=kJZfO;g1R0!Mh>`O*X!BI13?A2XJA6l`4l~x!jeDX?TeN01>(c zLgw3vker5f=g9`lohQ?;fU3|9fdlve0CeUdU{Z9MAKu7S$`7Hu&{xp6@Q&0rlt7pIXW1HAC}N|9ptl}n{h7?-Baiz#!dmaeuq-|<@kGgFWU zm`$ZFQgFL(wmki!bWz2eZBa#ttL~cKw!k>^a1;oF6Xxx~7K7$38cr3zNWFX;y?h&a zM>KHsi5rr$8yX!J>bhT;vg=>5!_QCI-IUPaFDRiw`8W94FCu`>u7AxAKRs=CQ^3am zQ!2kM4b+@3!X4mBQ%~VnwD$=7Dc1pznGY*L(e1l~PIF6O(d>(!0i`&BFQDEmrx7h_ zRykGFt8)&~2lHk|YW~5{pA^0IP%iENhg=R>P>)W!8Hg1-85b#3j6m(cSt^Z%M z-2g6lS6nd|)S5pRw)Tp&9gZhgco)RH$x{Jg;JGHxumR|+vXKpC%Uz_Q2`dfD^QK{Hftxn%?}vIJm^JSvBho94 z9{q$9*F6h}P;1&{0=YTjlf5pxP>7z}^YH7SeFHCh$!ta`fiynGn0|4Gi80XzQo~_A z(}{u#a(k{2c{yE(bbhK32|tSqWVtw`-KI8%Yw2G%|3#=Rx;?|WaNY;)0B@x3UrXm& z8GnCcrh09*)b&orM6#Vf%Iln(Gt#Aluv) zv&F=1OWt{o9@C zCXy>~o(7$1IryKef~ z{VGY~8(i^-L}iwL^!FK^Q&20m178=~;oKdbVkl`R?%=y6Buwlyj6$T)QP{l`2D?z` zWGgI2B+t9zGNfyg(j-Hw51^4)l?6slW(1d3PR5~}rpWJxIB=MZe9jw~b79P}6y)qd z&*1??Ql~Tm^5E$;;Xma)fuQ6)A&!h*4yr+s9R!5{Z&HsEOf?HLhye)nSU8;+WHK1* z1Q2iymJN;}v*|-iGJZDaVW&4Kg-P6TLxbr7f-{X=(wtNGQN4Lwx}yDtRXN8n>d( zqCUYmxzO4YYT-R+D<{ko;xz>uO-rF0VdXpOPp$2EV(l8mSI%vpGT@Ch1&7Hg(|l(K zZKv9d`Hc)W!ka$~8;tMv;*4RwnrnS!-T0!-mFktfc3ASy+TE3|4^b0Ot%oYo4Q>Lr zU&d?fp!qpmtio~=`gB6aOru0GE6+(zNat>K-*4p#7z($QPHa2TvL5=KB>MF4a;+P)8F~N2w&E8U@4)h{ZkrD+8PoTazbuh`2r5Zpg<8FtEnCuLl0W6m3Rn&NbC%VFmiJ3F zt}tU5;&v^5M*L=m|MFYT`_xOX>6dSmm${03h$}+mJqo+w2nGO0C>huxz(FOxeXWKV9KUe$(%h39LlY7u^+_VcpdFnNv?thQSvp$X3*{}FJf zj02gIJ+&DH5Ywu`%54g)r@JdRWQyGT?yvGs7boqgO-u8Y+ope1O}p*Zog9;x+YP}7 zo*>7&^w9UzGTbH)2h;S)#41dEJn_y)hv#OU z{oW@kx8=G@d|R?5oCu*N5Al-ZloKDCKfZhY@?wHZv4)_ph@4h2AwaI6bG~pAD7qD4 z1m%RPHiPhx0cajoAw+pizM|F`$Q755LB;PYR<4uQsLwNV6v&X!w%_Ar6!F#C?%iS2u2rLQl|8u&L9daLq(Z z{&9>#z28^_y*szW!yAQfop(0^$+&UPjDXLztr1uq++zer!2eNh+XqgawMM|3>dAr8 zgnNlz&n~eAC8^Ii7{NZKT|-sby1N8NQeV_6Wv4?#D@-uDVainJesKsLL#%7SbV0@w zbX`6+1dw(=Mi!KQ*i@;>AvEcJcu>cyDfX9gfe;w!EjWmQ!C4q)j!}FrhJA;>sN)9L z#$ayZ&5w;7!`{=Kje(PLXCa1d=k_Ir<#mSsdHOr$RhgiL6;KkPK?OmcU-km*tNK%ftUcRuco)f3foO9nm zVV_0DcusYUrhamDS=|Vt&t9boRu`*|Ycpl2{-qGD3~`7VXL+Jmitp#f*?LD|#JyVUwST_{34Q(#_3T9K8-*p) z7u;p|Nu05Pk65Q4K$J4DQjd$zS2N zTbLdikb5|V+e0ZoeP;E+)lw}R%{1C_mvZ^kV;@<5>~3TZ zAupUB3n0OBz_Wb%0d(`Mb@s7`Pn=#`J$csR&YoC79|@pWiqtmTH@w%VbMEwUI+GF> zCHMvf_xDgme(o(A@~WIsFE7*DBDu+#M^2x`aUIkniN$1GuC-wR?IZ<%lE_EDvgH`; zg>I3KY*R82Kng6o9HffP0~N>4t4#!!Fss&f&sE9l&Xk>C#^{1`!mQkuG)`<2PsQ^| z9g~F`NrPF-3(j5kYW;PsK2~AACrn5AZ9c~w(h2i3N{o3`xWS}Zx`a%(`^MANt2Fy$ zKVN8XyLCqv;c2@H9WSIjW@-w#aJ9GOZKjd#dRq%cof*|7WXCl!(k04``zo~7tn?np zwerYB$$C6ez9rW>-f89{%&{TCljPquv&u&iW95>8C@>bqdlxtjD!5JW5n$Mbb8t)=zr*^T)T9h#OOXIp9&GNR z2gg9qfZ{_7nG72=0)R{%q*5~0d`E?M2(-TC^PpTR-)xtU+G#_?o^G?doJkvEWp(!0 zuSqONxO__9N!f5KXCPmy*&8<`%e$mJIj+lV0PE+{N?6fvzgKE8M0Hng6z-q@a*<-} z?aJNbi8T26sfxuwT)r_eUN3hf)(-LQD({>Vp=w0QsoarL1oGr6jzG90O^P<~MUo$o zd|+nMbG%_EClIj*R>cRKlpEJmfJMQv`R-sh_T9lhM02*JT|0mveqkU-ylZ%(cyE9M z(l1C$TwSpOWP>90u`u9_e<(5ruIfyam9qnvgAXNG=WFZ`eGP!8OQFqBV9^cfV(6EM zH0AN?p%hb$C@C)#=rXwLUKc<$*twwS0-u6BkJ*5M8ksoyc2eWyGod&e4TInu#G1Cw=zBFCkiL)~9JqnNSCFf5wd+&ArCiPIg z{8JAths$?9w5-A!kPiGPlF&uEUxsAQxJ&=?dw=rKvJcI*EpJaF%9p-XzJA8MKV02a z`sxfU{ncCOQx_1b`z`JC`>&tPwN~n@&YxwS-^=X1==`TObGgkh9$HSzSLBBv5Kkg0Q%ZP4k`eQ?kj)1ZpxsJHDhnj*hU|+; zpzQ)c2LBs;3YI~-7hbNQ*Wum+C{zNGyM4q(|N|~ozlts^{ z%BIxsDg#*g2CmQ6FTUbNJ}sD#OlrWN_fDt}UOxfvjrGvK6}{3#H?Du3yM&9kQl)Ra zGgG}Tjq9&-{q@j43x8?m8>J^_jBm`C?_^aYH|vWIb@94RrS+V&>)azXpXL5I$<5W| z!9LaCE>+<*^;>=)Kj1$wYj<@)jdr<|erbwJ(p2*H`sKnD{^ZrjzB&?BH$nlAso+c7` z<~r4BGh7P^Kann9*@|JJ`ELnv_E?gj-i$Q09=f1A@u8agJ-Zd(y9VDov28u{Jb$cP zeXLu3ERpM$hK`nhH={7jrCj&%u3Bz4x{6gjzMH!6R<3I=dgwSjuzLA!_ai*09r(yG zXXssy=eK!bCb;W5R^@A{urhX~x<8-DbU&AnpB2zMpXU9F#UH^8ww$Y1K=AJqksg z%Hc*{tLlC5zH&7Je{6LH3!%D#&Pn%e1bjU3aDEbwtHhs=z;i^nXiXwU$c+=Oe)^am zXk#dwKcB`lj2;UQMuPq^P682w&@YG>I!a<_D0ioRGz4c)YD}Z>A-FdOMVVnbGfqd5V2$;Z z>b1e}Wb&XHlMC>Hash#!X-$r7@94YwkRn1?4cNmHqs!20649P=? zI~;dB?vGAK@K4qt?)58!5H+Y7^1+>f$_DfhsxoL$(NWb@9NKaJ>v3o`1NTtT2JW#7 zkZqd|Td>hE2s9)csAS>Ptv!}wFtHv=PiAoBLku#FKGPuvlQmQvX*$%DT+VdL2l(@| z`ya}nL8CQ?stY0P@K2aYA0-mb0w7}M(>RbpY|6yeA6m$=w20@}cr;8hk^6^9DOG3Y zz!%$O@np6cfE%a*unpWp1%|;vD~VHH;h|O2rTd^m{P&_oydDd1;h%Ym|cZ%*q4E z?sw`W6kbphLB})#t+&@4Yjq^q9W+?b+Vw1CY0?j8F?|!5e-;L%yQIWHo;+GJtRkhI z@55mtI3tYbeIkwb<}*u_X>VYs)l1JICd}T0!^DU=BIdrAcre(^qqu~3y@fNgZiQ{U zkIqH&p5lDiUQ%UQy_k5ki59e)o+JqRpAygJS8(v`$rXzfN4@OGCyKx&PZO9GRp1>^ zc#&=p=63m2_j~CUOq*_1x8lzmh{w<_>L+=avS}!j1$qz4M(MbG9S1+&agfW^Fyp9_ zK7>4m7{ML4-DdS3!`S2WqI(zP`urd&Jwd@vK*a!NNPP+TP}XvJ4NAM>3f4^W975NJ zCxzuRr|9s;{(k7Eln0N?b_)uaL(`$phC^Wkc^O1-KM^v*=M%<-1VXoKpJa~k!jvQ` zVYWh!QhKH2+@2_Yg_$QuEZ)p1EN)0v^c3IuURW&Et33(D^)7ve+vPe-#q;V!r&^i| z_zzfkazZ&KVGppakc*;s!#=uX%U}!&{S06}fXpdGft*c9@6YBq;KD!!;83z1@cVS8 z1J?$%)XGN?J}aBCXT~S&{dWE^i_^f0(uAY3Gku!2~daz8wT(aTQ4X; zLC&L8wjGf-P?Try4h}<+@O3Q^1CQh6O2`)Ta3mqoSP4y5=msRBF=s`!ve9anc%GRd z!i-{)pjJrPb8tm*El!lD2R1DJ%2r=S(oj0=m(Q}>>dSrdWusoXK_zdT` z!KxEYs*13wzCs86(B>q=5e7vN4VnoKL$NWGtwxv?3hAILY-Z3PDN~GL%z`~fN}!XF zO2gzE#pYpQdoVkkpMk$Zigo6A_^3>FR^vlzfOXk`1af5+S04a{J4hrGcWkV|5td{S zAR_~rL%d?FBTlvzeo{`j?L&&b#v))*86^ju=`8_=H(ovryFr6t{3ezp3_qmuuG+Xt zefrF}4OQaf0(cB-NPAknMxTV%w!Cc|^1sc9l^<7bPdVL4h>@_x*MbYpPSG<_%*1~x ziR)3SYw__^oBbXf9#`F!i?lBmInVctyvT63=&U8|T&D*qOTIqTE7laEP%fp_iFVZP z_ex*Mb*8(fx-OKQxDQew`!mIdY=Z}TGlYiH~K#R0t%V{CBoL#;nDEf3A_Nmnx-$P zo@NabjyF836o>vP{EuV`mp{gsLBgK^;&hxs0K^Be#TAGTx?)sZiBW)6FjE4)amBV1 z{Az(H4xN-hdEAx%;!1=T?C7Ora)99*x4*ppcqOU|7ecD*qEVSqb+!&NL2;l`wfHVgoh|U3h zA%YfJr_zTGL6Rb`36S0_tO>kzfeF+>)I=`nixfAa1Q_^!5dZ3K*}Z$&PI&s%if~0Z#F`E$praAMnZi*YjS{!yD`x{AxL`7MBO5eoM8Op_VgQUY zX7!#@%oe{6D=)Vz$U(CtE^_zrS=~SehGw#GoY;9YA(=HIyxWOD3y|qX$nK<-S#t%#i zGLt@EUFLA*1`3FF{WzZAQ#ENPO4s7VT_J4z| zK;u7frGA?$`M*KyA}S)?0Z;&jMleMU z&Pr+lXO{>;>a7g@hzhOH9@Rb;(Pw5b5LLsO4+E*x!7fe+r~6dNkwk~k{(s3mK9;xf zl1_UI$K8J_t5YvOT1y+wLx|i1sXn}(JKo@u?;DBwCvQeA90ezEFOg5v0bkdOusi(9rWO@R(h?@I| zIaPu1%nKvPML{YcMrADkA`qUGg6h=OsHTy0q&Mr22=zk!0K)GAjp#xFD8!XB@(gmQ zKz9^Y#;@Z&$T|d)?06FT8OmsCvz*jj8Mb*%c)2>w%6sLOm$K5uyqPep$Prf!>l4an zpHCv=)_7%qvbw{DA4yk4#L^Qj2{D6hK8UgW`_l3_*>!kV1AXf?0x#gtGzv|rw^9)E zd3Td?2#Y3+Jl3R{-4fHOw>!wI+Xl8BodiKAwUP%Su~L8+u0RXSN^?L4?MkItlpV}5 z{xfs4AZ%y?j!|S5ca<^lUn0F54xV_#f(Mau$|46N9|HncCTM5^T6ewgg=TFQEkbW@ z2RA`SD)6F^46&UTiwxjo|3;`MtaVeyHxTM6HgKGzz}u%(PuOB!EPv3)SL?h_0sCUM z38%04=E@5`D3Bu|1Va|a_G{SKzJB=(OzrEJ*GNwEQiD*qq!tmOS5cg+D;Pq5 zBSkJBt&Ru-XQ5qv0kTMvj6E1QZrBG2O_Fy~;$X5uFR(}P1ZDXrz)_1wjyrVN2)3fj zPC_8<={-qWR(3-yuB@$`TcPzL=7bC};WtRVU$RHgLfHp%(*v0CPfcPQ9eg5Ww<1T%yw%x(f7@xNF^2pbi93 zxd2FSQ=fa$=djMp-d?h$XXDHQn32FOpa_~BUt$UBnmZ-f!2U-NMD-);wm+_x$^k$A z&UtgVlOcf-k)9Utw7MzYn4;BzZ;@x6L32KTAs@{nU!guL{JtF_aSei#PP8RegwxJX z2xbFoinGBcvh5`18#fDw$spDJ60hPahz~zAe9t<~qa3^SS6qdXZ$P8cTGLVYN57EG zwNfb$0Ui?fIWMl6$ckuegUgPB@-Hai<#o|_k)9d==YW{WS03W_40#LIHtxp19z-DeNA;EZt1x6i~sV3 z$Rw{DlfH_b)tjZ-l#C@%v0H2w>&C9B@_T(RX)i%vk@6DE=rt?%)TUmN=TnSk;V~n( zJl!~LLCtoPimwJLKBp_@Yt##IVBv0tt8LQv5@wj2ZyG^nkptjn*`bhds`)_d>8VW2zr)5BmF+)odKG`mkI z1C{$^2(b;mP7Q%S@ERO~Ozpb^7S&FZWa9R}CSGBR^B;tBoA(->_UWrimVe(v$l|^` zF!ce718YC19v>!6>E67WaS$%wo%jHdhyq%Ga-MwUvdq^}ND5y4D7vI;(V=SYHD+GB z9w31u<5A&I5#-`~A5_q74Cs19iK<*xC9E1zaV3E=XmLp7#mS&(j}xOwb}LGhC~?0Y ze>~EJXC8suXk$G(dv#M8JGKP*ZAwqZtTzW-D5g(d1R-R%hRubbmnfV>1RBLqz!4iO z4Asf}61_46Mz665Iz|*Bq{35xg31zm&q>XQF!@-1gyskb87PAU(O6GM?fB~r!aZeE zJ*6iI)Wg6x)q^^AQ<>-wp*9WliE{}y){R4=-BboanWiNU2L;hGLKjV1Wi?+o9vFhG zOY}L<5XH)|Xi0AQ>ZKTXa?osYbkJ|JH7f=-)BUD`GIF}m5Jd;6xcSn^dASiPqWG9V z0HrF}wAfK>eYMz8Ad-fajY2e|m4$kk!DaKD!dsi3pq|@HPp}&S-trutA6Y*6(DH*E zPx3IClO8#98Uae@9)k}w7WG}#gB(iU3}Q2)DeS|h)F3gM024%b z!t+ff`x)+u=NmIf^Nf7hoNB80A+TH_CLUksOBKs2S#g;ZF#)1v6Td~ywAkpRVFYR+ zwHnX`kg9Kn6e~T;YYYz2O$7vSbg!|@`r74K0pt9R=2*A#^L|tNd3(&TOK_;cOQr*X;CM|_T=zAx0$+%h;U zl{4=jokf}?7Af=+Sfrbf7z(UW=xN~_3K7K;g`S|)QB~3KrKh^|1E(Y$kn^Fbawom} zX7I&Yrl`h-lftH6NN1LX*>MJNDO|>0#i+fUmZnToet)3}J8}6SV1^__CVONa6QXN_ z7-}Ce+1j-Hgjwkfa+kWtvA1379)}jkM|%l1X$nqf4EY|#KxqB90MZ~Oj$tQBmtr6V zF8PB<<)_3^*z209jVRr+M`huSqFfHin5{Mg1G5lj#Yc#OP~Ct<;-jSi|8abBVsb8- zPqS7R77>?XP$ROD=_Dmz%W#ZCw*v(+Ok1!3tN`~S=DiDa0zCvg$O1LVtu0sp1q;7Q ziBbH0(}%FD-70+p$(GSJbO4l!%Q0Dj)`1Fq_kx&MTLvS%8%5H9R1chc>=6nl)R>h{ zVccA~u@bPQulEW+LQljUTAjDAHhpyrcjzfZu7urkjAWb_&#L#zU zuxGx;;*8RUaqSw{t==j>+mKH(;)y&pr6hCyvPs!*8Taz`l0 zMtWnr*U!(cB6-~UcHK)wAbN6J@{xJ!n!wc%^~;@O6|(D_T}fdTATyu}<*Yp@+Dw-nyE6Kb!`0GpB`p^5^V)*& zb_^L(TN2oo`&5$0bcBvVWd&QY{9i9lRjXbkX_t^xg~3-!e9+Kc6g?zscJ* zVk@Sia%U}3l?b7qTdfN(!#L^h<|SL+Qi;`Ap}$gk$4VzJ*NX|pO5L!=0D=9set1)Y zquVyFugy!>2G#3tCQAB~<@wsYQ^JAD>H1R%=Syk$f~Jl7(`nOrjyn8LjHP1umyM&` zPl1Eqz4+nj?^kwDKlJ^|u7ofJ=hMZhdgWEqd4=A2UdHzf_vzE~{KL49xypHuUa4_{}7%M%=f5ingLi}hPq+Jnm2*qw1mKY=kIlD0iP9DZ;GSS7zdIqCwo;<$c zcp{fjXw&*pI$@|WgKJOZ8G;Iv%{a6UOwZ`}LIof6fW^TW!f`j1L2ea-3sHsNBsUT% zf$KMgVG(T=bQe7pU)U^apuM;Q8|CDPO(=NF9(r&iKqo{X_{503(n< zq7F=N`ifTtU;k09TGT4`2aJPcP8b*f=GI6snW-{AnA zTZN@q5AVPMN#Yr_Zd{hGRPNK8cwS#j>x*%HF{UpD^o6q2)+>8-$@S{utLhg@*Iy{D z8|U4w-cggBM?5T#Dnn}$?=W&MYrpECKHN3b4x zM;??%)j{NN##C24oC)gFJ3<;wi^K$=cn~I&#PWKYtr6%8EU68*&VOJ>PRCuA=LCSA!_w-r(i;tx&xR1oI5s6aRepf?t~M<8jyp8f$iW50Cok`L9T&}wF4xCKAZ!=C=r#w zWT@*gux2hj8inqW584<(sT;g70{xRjFR`_c5FA3ZAae=n8WDO#UmON{_SJ-`8w{=b z&=AbhWcGy57Ch~!i_lKuD|j!Rot!|i&(=<%Zm2?17f$h|9E@-k%S|Kffq7@G^M*qu z@@7p>E|GsdYC_kCx4?{XXcsQ^!4gm?;^fiXLKd~+5OMJq<V7zR4H{ zv>r`F03UNMD2#J~j*(9?Ec~rVZ!(KrG8~ViP2qBk)o&AJ!l^Ja=*j zA@Jz=8sw~D99cF9^(}X85c(FLZpssy%P*-}AA}ajzY2o@2mgH>EG1W!(b5su>P^Zx zr?&w11i+c5LE;tt(@AlQ?gYiK_kA-GW0k*zF+x*BLnkTQ9Tc4`&b_CMNB(Y67^CV3 z$=Y5&$emgGL0)EbMZiP}YowG;E0Lj)%Z=JOU{3WGKri$qBv9>`?fREtH-ky!&?)K; z@s+qIct%(tO!CKBjJev0;$ zM6&#BVqs=xi6S)nxz;|59C`75{9;Rc34=LrHRRSG|D@Z^eHG@E%^Td8Mz>?~jok-S z2d5ZBF!v);X#(jX`Uwux*~4=*3UTk;7fiy?^QK_ zjbP)72mtB-@sF_GJmdczPpu`NXktCIgy%|Pt{V{xWB{hl5Zs7x_`EG?l9*$4Wj?sg zitDYAf3&DIE(jA2U<|A^Ij%C1VIrx&OtK|D^DkRrxnef3EfG#QH{!q;oRza9Q|*~) zU&H|!)kx~-67h}y*Hk;aCnS<$DRrasSHBMr*0-{&$>8u66G>oHvkRq8&Lkkm#cw$!Wpxnut=$b>*Z{X1J?zT13w0Fq4ar zTMQ28RN+U?OOzy}6L~pygR`X=DCaY|-FqoN$CKbL!JRN#XU!;f4%AlS7eSFF9v?*7 zR!N6Q_#4416uGl<>fD*f;E6g2Pel0pW2uN#urTcfUg!zLS-pqT9bVPB_ z%#xffoB^iU_}F$F%`UQ+{B6r`6Ej- za`%-g|2K<}q6?g=hIN$IxGZYDdX2u)zu$OAJ1~_~O3IsI0GQdhDqE_HgX4PW|1gfF z>XlnFB6;#R&DU!g$$R`<1_^!7tU8~Vh9di?`0aXmkH~d18?D(_x#$x!8_EUQd8~1; z_m3N%?ECyU&J|&q39dUG_Hz=c=1i#H59k@{w4amNbNb-#%r7{%xMkPtvY+Rc`LO~T zR%&U@s6YlW8*UCc@)a4URU_sam$HN)^`OR3P^l;2OMMT(*63G2Z+)+jos2<{0{U@a z2&u6+T!L5*;ALtJO><-lhePp0Vklhh9eq25UE3e1N{qY@v|%oH@1hiUsow@q=`+(o z@KG*A%3=kUh#43NBfgG6_z6U25CMXCrG_2@C!z*RnXq&z=H?(V{m}8@if|jQC}KA_ z#wfUd+9n*C#xL{}ZwjLsWE-Sj7MTkB4(!$DQDfU8j2w0d7`W+|4Bhi!ySd53`P>3z zG0t+UhNH6YLMyn*KmY+icU>W{VN|O#r`SedXO}JXOP6<+@ohG=%2$| z0}}?dKjmcri-ztTvgW9FeHPZfXQ#YQsR5wa)0ksUL?1>UTXQ^H2U=}D{9_KEb+x9f zZUsXB+Ew9@QR3v`J3vB0M=BkKR#9f(k$#4YYP%LxaLUPRj<{~^Evf1)Q01j1W>j>- zyzM``%Bu8V$5~sK=&Y?vIBP2-sEW5aR|=c2)SQ~e(Oj-f78yAjL|N6Koxhs3^UhPG zn*T*$Y^)vwvi4TT%IP@+{#FrC%2WmaG8gC(=M2V3Lp_;^1EEF4{R8OOwx+z0xy#yuUAxHT)i@@+Nm7Y7kBB4A$_6G zAE?}>OS)=leU8-RR8v<#AYb0bfjG2(sWvNqA8Qmyv^&mf@n1uaQEX4$+JP z1Br4codi~dR)r(pffA7>Xc5n`4e*NqMM~sE=fyCxrK}tp>j89OI)nY4f|}@rAy6H@ zKpBL0PDBs+liuTNvb^G&UMKm2mxl@nz+>1;y+{Teux^PRq|F8p}AqTnYaA* zRaj|QIC(AF23iuNIAu`ne6eU;n67SzbI`FTruJSWy=10+QMnAI2$KJP)fopZ2H)y# z`jMp#fjRC}8eeMs*t>s?KT2U#l6@Wg1BXE=pa{RIA=1|I z-HNH3)Ho6n4pj>?R0QH^ZET}|Hx&tS zI0w2%&AZ?7bYx9FXxw=%eGn;%st4Kz#7oCHSTvSow^nXU%f*{2P(jmqeDIGP3x{%E z%v867tl#&<^xjJ-{Og(aBCk83fP2pzd7Hg`I$XUe)9$JJvD&SWP2lP~KQ5I&WbG7~qL*Azu*v17KTYM-9Hf*lIPlz3< zZre5Q^!iVf1saivOXoZ6*~|ApVY>hzb!GM{NByR2YG)~2-MK3vvA8uSYb1W)rqTu< z@@=Se7#PLYEsmu|lQQsfc?p=p_U@9yqbcq%2DSl~p_~X_6gTY}cj%C94-6^Lp_$7L zd2BQ-2ZHjw4P|!IS{x^W!_bp9P-R0dOUjJmH4%lcMzbcAMT)T_kS1R6p;^jQ#F|S$ zc?_mE?b#Z|wYX)IwJF9yrWyp{+`&#Bu-S<$31b~ZZ3UoU<@JkzY+V65eq8}06?O_r zdxBKjUy$p1PT;%*1=Fjif?!IVd+x~OJRbz=ZUKNcbn7%2z`Qu8i0?k^8eEh3->DEN zrUYo8Xi)(C3KB@!;~-iLte&o~rhx1@TL8F*Dy#&w$K{j)zyqWaU=Y<4ILcwHx)(6} zG;A++B^TA9kUUIBGfGF<6DT($MuZJXEFp5fxHbq?=kAC3ytDP(1lWn()r$pGcUc-8JMw1_uE{@>kg7dDLo+EBfqY#|oZYw?mMqm3 zXal%c!BG$=nUjV2Tz^(zn5>vCn36TpcLyu5?+z%`cc*wyC{HjN;0caz0;W-{jfQZr zK9u+oII+*=cW)sB1jEC$$zay7Qr`l93#p3bRqznterVSbmP_Vy>T3wf352QZ?`@q4 zKLsf!90-jE^-Yy~1TY0uUr!h*@mYFY9gN|0=vV3+*Cd3Vlct%R3xmlFC4C9!StjnP z0hze*i0D7e(>#&nB0||Q(ucD-q%s6Y8GMQ2zMxbfUt*qO!RdOWP=yIEM)6v39Z`PZ zLX(u!AEy0dEWGjXcwYutBFw<^uGHqb%zhqzKwA2eEnR2Xj)|7DU*j2nH91D0&W&-k zPYU_tyh2z@+GecRRcrvUwELBT3tDa}b?-r!30C!ED5F83^c`l&-F3XXe0&9gi5E%2 zGLVYUfE&i3YyeI5c#{fcbZ1y4u) zo86LHs->&fBTGnfLd-3xdu!9xm>t210T)W2FfKr8CGpGk%I_uYsgkQYE1!Yk?A-aveq=!V$^i=Yxnla5|r0yU{i`21+q7jPeA99llfIqgew!EQw8m!9e? z!|)Hov~|PfKD+u}Lh*F8vj@=)*yFoX5!-vH!M$Fdu8n_9sV!RI>-c73T=d)ekcC^B zV}F)kbvgukMZ9>D%a9&MruZ!1;>Z(9Ims`bXpy4I;IwzzN1Mpe~H#0tAs-C4EM4?I~-LS~G027!-?qhwqbj zxFmrhqc=H-L#7~qF}Z{1l=h6Flb1woNx>=E9D5oOj53&z#szc;!vMCR4x)dg7@f_N z(uKMQUp{77Api+YgZf@Et_afhI9KtB5DPgtSn3Q-j|XauibQb(@+7>Licul)*&=Qk zCv=MJ%DO!5RSkUl$1MmFa9X{XGLLDbeyB_1$F-GA^{S>L$T7Z+!BEHQ{LYJ zP9zzHwL%B3fpm;nI5iJ`ZK@iR#AcGGUT1c60g`6yjy2Vh&~#5+ixqmvglHm;zh;Af6XzDRT)gx=8lOt;ToZ*K4*q4%&vX0}1!)&!nr)s`Cc< z%6}Q@Ap)_Mknz0@3iZ9upgSB$j)0z1f*Xt&%KbnL4xCCYGGF-xU7ZI&kCRvj7{LqJ zkMGJl38z&eZ-n@fyO~oL$~TFg(#Oaj>rjT&qqP5|1hg=pW^K=vjGNRZR-#GTL^5)+ z!SoPPhRceDj$PHlnGhGshZlB)@ULFEYk}vU0rhBEl>FjAfZb4XZd{P9$d&jND#oH6 z={k9Bt%DH>$rT%;ObKr!@!=y>0!VdfH+)n*I^4+g#b;;B}pn`RYa>p z{Cf`RBkzVwfm;((!wm_*%0dV-qKORTlT@C3Tt+Fvl}{UQFUCxi`igtv26NDKtBF&= zfm9K|y(f%#^*MxZc+kq@=4qiElC;l7!t@`E41WM^ECh$|ha2=Ccs^)blriC)h7|RR z87{s3T)&vm`@n%34U!>De>lCGBdH{^NzfwglkdWaNzubD>5`Td^x=yDc11iS9+t=l zcZA>u(MUch2jc@TSl}w&|8prA=?ZeP6lSOw2cL!Rac(Ud`A(-(1mb(TpHJPxeK~2? zNcjCr{Qsu}Dcc!9nfZ?>AqQ0ZKwqC>unQ|FE8((zVky6tL9p}TbH;&e6fVP5-I z5&dyq8gw3^*K)1pZVx72O5|F3ymHvUTl$rCV@H7XynS3s8q1C{=zbAsi|rORziqPQSmfd`l+P_16032aF4usluL4v-`Ozco`K| zo!^Ao^kOF0N={|#mk$}=$hE$*e)*h`J?@}kf(+h>?n)*;9s)Dl$0OD4Gw@MDtP+l# zLL#7DxmI=jB^qMxz_G-4?dmSjjtZ>dLA_dcYi9kTTKA!<~q&eosP^PSs&V~ zEh#!PsT~ez;?YJS9PH87!GrsgTnA?4_s7G};G(a45ScvvmMQ@MjW&Mmhch zn+|>5>LVm~0Y@;k5)|)l)lrVm>)Y9oXU^SNL1P1U?#H)FSgp-Kz|e6*g0zJYBk+<7 zs~yZr%Xx1)cU*y! zHUAm}EbzKIkpe{_swHJN6-nuY2~r^%qBZB0f@V;&NYFH?=kR**xB>FXXcmau$d+TZ zz(vr!>Vzvazlwqq;a|w|qBTldz(cfdigxrdk#{*>=-`?8#YBG*%GbHD=f^~0$9S+jj4Pa?`o*E>xzl3DQ<&p8qUL_3iy<(|8%-i`y%dgrjB6UUP zvEz4ZE6Zw|0bf~>!FK(ezOsRu3EV-c0m5*m@Gh~(^x)~>Y|JjzkPJ{XWjah5#t1b{ zQ41toUt@0B>`Sr?&I6JO!+Nohg4JS?1dGnH3b}5~=J5(Msz`2*Gd)#CbN`{Xnm7_~ ziiINP7r&(I1&a6eiR@z!UI*^9um>j=QvfEihcAh|Dj@z!%@J>_qm^Ci5Ld-|)|^>} z`gEexY&+9BC61Lobh+Ee?KX2_lI7_KszXu)Yf6>9lMWmiybDBm{qoPii0bV&!?e54 zPbtLt_|)<4^1ht!ark(Lf!MV2^||hJPR#d$sdrbmQ?i8570vR8=v=hg`bW@B`I);N~yl5PB2u1ikcqqCHMi`=HL zli8yK`I#u`iDdPsocP-5gR-W$*N|Iubvm}m$GVg0PT_$V3sdvS9iSVI)j9-LH8pyZd@ScDJu=7>@Ycu7qn7U09{i_Kq;R&RizzCxKpXlyglnjnSGXd2h@HhGPMf|^dmC9 zUW6`m&4eX+-T0o?n3iXB*sP9(^~c}}pN1IW-{4)5C~kBVSLnv>*C4%{D>)JdAYtp%?3FXTmK7rVlZ`d&YGs$LcjQ8Ee07FE}x z`ufb##FU{LHSwA6sp5MRu*He4fs18`+%{h}Y<`3syF=N7Nuy&{-=L6grGxL}!K{bm z`1N}EM#g!+fa6z`0+bv)zVCe0ZG-}r!{t>sD%?4y#&fsygx{A|)u=X?@HhQqcI2>F zp;uTM?Ix&*n`jL{p@sl_K^@8v7%TC29fGkP>=&tN4=B4XlbAtJs;1@8A~Y=*Hg0n} zFh;m(p(v}JdqWAMnza-cM{}KV37g%ARw$v8W?ix0J-kKuvB~yE!X;7fYjP`x5PIa7 zlHX~pfrzviHl+U+7O7@^r0f(;%OM>e$}EUL3jGBsBz?&@$yblmOoB~e&+~3D8NOkX zcf_hb&P7jTfUdn$?A*K$mar3~{)H($fD?KZ;1|G7eOEpkJEI>I!?7BdC7V!@3 z7(QPf_$vF|0|!BKT&;jFEED?MX2npPa z;tA$o*)54kHfW{576nUU;CX$6CBoo(wG)AnTp-Y|cuS8uAQ*HnD4WlcBzmN+<>1Na zDOe}b5RfYa9S|paWvG)yuM91+oFE7{tjRng1IsC#Y5fNOssCUHXZK7g9 zas?fAGf4L64(Y4em_laM1RXu2GE8@G3@6BgkZ~vZ=-q3BVV(|uZrZf#ZxkCX;D0tH zOdk*uAi@vCem=z~hq$T^fGY9Mx=T=Qse?2i6e=&~Mu7sF4Gw1oC!2uzrbTHgs*$92 z2KfKmI~U+Muj{@83yP8)uMB_^EyJ|ELPQy2M2atywj5VjfFQAWEd@XVDN&*z05V{L zAPbOI6xSNZF@ zl2V*xpYzdrP@cLpV{hh$Kw4VMgnzt*|YVX z%(QT2b*TB{0|CFg|LIG$?{-oG!4EC{P+!~H;lzge(!z^_KjS%^Uh?WO9)@L6k4FUope74#k&VCi({< z!h=D>cmBua`2B3s{PXk^EJGA^B#8){FBa4Qo^#mCpuNtQi3$R_u{VE%F^DF@b`J>f z0DRjAOal_)8~4Mf#Y<(<)#e0=#sPrp4FO<4jxpErM@z1;6h&*KGM?RQ!dcQa44gax z&w6#l*2h;MapUzEmRWw_A_FvI846&Hs0Txj)hTOkBDRVBj>iM&6tNCwwXT5ndRU9N zhH+D6wh|sf=ENq!JZqS;V}uxSaIBR6ShWmHOdKm8Gll$EHJYkQX2s%d<*3s1DpnEf z@u}+&=w(kjYupVNv%Taa3s84y%B|Q}F1;gO+#D{x6t|92uk4ZX>vEsJGNwqb6b`wK z-agokNHaIs5QR;B(&qI@M`t>Q|;lh{`rBoy4SXvs;FCPZw$F9%bUptle<+XLEaHHF5_!N6m|vTqK- zvVS#{2FiYu?Fs4C;>%wstZ-8E-UN|0zRI*pAHeXfZCgXTzAA>?x0B)UFkah(t&Z#m z3&va4V$U9GdwztJXb+zf+xu6e-m_D~Z>xPXIUj;h8Y&31;@aQM21K+g^A(Z9FWKWt zSDiEXpO41;`m1#xe8oN(YVv_M@LBJXyW6-9!A1;l>_@MIc}8dnegP~N&#qP8#Kdre z!I1r*y@j>N-U0)@GI*3WnSb_urnDk0w2VmSP0A|L`2N1*&a3>u1+TzKY=M0UJN)PS+EzoT#g3mS+v3>PZtuTzI28GE zA0pKEIO*)$v0B28+}9Q$!piFCq6Jg+oLIZH@4@vUVmyK}Z@~Z-AJ8k8{@f}b^fv68 zdhH;sF8kJ-9O2R)ORH!DEZ;kvx;X;ZLdjj@K z$dL3Cq1|{zBSw09GA9^im4^9c4cJVEtpmQkuP3Am})`gjy$wOBeY7NLqwCG|)R2&IGa)RrJPm_IX>quwqR4nz2p+r0&=lOM|EU5i4 ze`1v1&$lLVC8T?;{ffnvgwJ$HTj6Qz_LXOc3LnRf!@944S#urU4`&j!X3A!&fNo^p02w&O4KTM){cCxyZ_gvJ9|?WZ4xWVJ{sj?ZRVlcajH)WIfc&`H+?I>ewhL z9hH{{R?}p0H{-Y6+>U=YNV=Tvn-gn^2d1(+7%zrpxA6N;Nl(}&l8<%a-weJ`_}B1w zzl$ic*oG?dM5dZ6pNTewZw5SWVaMl3$FL?U6u~gZSH}oJ_?_6(=SXY$LaXCb9sAg3)x62WBtA)4 z93c^3l*;tm^VUMkU;6;`f^$*Ty{;Ep{xDXzT1^Mu@*6&I|NY9z)e@;U?CXlRH^k^_ zT@`nFtUNuWrdxiNVfpOLlq zBb25MNCBV<4b|)iJ!h?r;S?ObH)R3z!juJe0!Ww_u{!3SYsn17M3Mf)ufbPoL-=6k zr$>{`3dAm=e~=0dc@;nF%J?xXSVRe$emF2yhnc0w5*>!WZCDMcr4S;yzcMHhx*{Ro zbb5y{6KOEUFCSvT(i^mWF0s?3tq_`oAR+n#C3aMCk0YaJd>Ox9LymN^bLb_pU?E;0ea?^|-LDLECO|C^y-NRZ5RH6cu?`@(`6~}2u5|RqV zLI8n?CIUoM0g2T-cr8{_q)m*%?gs|O`>LG7oH^UrNUb6y#_m6^#B=gxgSbUsHQ1PX zT5R!7u1r*vQxsdI#?VS4uuLY$NgJL3^UZgScg<|+Xm6RHFidivdF42Y^9MqY^Iacv zp=8^A?msvg#SN25kThio0g{=MyZukpAE02+2sLYhPS#V7uS^{5PGss~a7Zljj}-KA zhhpdiDhwc7I@S7k^>LbghL6X(BdgMcQx`vx@C7gx>>r=23hricuF{h+NqZOMy^Mn( z`#-4ymj0DDk@MN~tWmdvQ8FAntJGC%??9hv??=LX8TB#|jiXU3Uzz_z#lsjp3(Tq2 zf16=19{y}^d8B`E@w!o2K$F-svK#Ah$UxP4tJ9Yxv2Xr$%m4J(pUZyJ@{LI9>I(mM zv%z6h|j}U?8ZG3utuy%LB z(-(|&)oveat(B&3?zrtnd)h_^WML&1^{DQBBLG3VLdk~O= z&)4=MPwW9`R6SBXAiNz&oX$(hLwN*4-|YuL-4WPDWrT+uT=y8*1Y9RgOy*S#UJLPB z;e&{q{wK`wamj%ug-4BJawfA_$>3xke6XE+hgYXH0H7v=siC+(I;qrsxz{1 zV$o=J??H&I>XmioARM=@37c&sN(Yz++Jb?Q!3(<$xJ>S(2e1(ZG;f|eI`-iJ`^$9+ zV0yAxLc+1Ll}G!Ilp{4aG7LiIFWz?JV0miIO)jdUIHQ%8 zsYm1Ju~CKRJwEK7ojs+U58a8rvd8DAXIuw+b6fwHDotAvUhoM@aMWicAn@Zdykggu z$5WpdE-a9d;M@|43c_(U@}?ppJHN=T?@cx65fL`%x}L<k=k7h$zdc_hZfwr~Z0D@c+8_6Z7#^#zu=bXGaTHZ@tM;V`1V-Sg5ciO{ z5WcJNJ?4YPhpv4RFtC`&@HPd&6Zwvn^;TJdl8_oCe0UlB?Ewfaz4Do0#4N2$e;Dg! zM)mYK$7+-5$_{4>Z$CV}cyZ3+Fn|w|VQugkOCrDuM%j$(^~M@15wD~D&@c|57<+)f zU1tj^cKbZR8e6vN?v|Z}HT$;M|DnSUH9k*R)E8;UJN=RUk} z?&6AssSD?%YGa@0t54P%fo9L>!1%Ga1>>RvJ11CYJQxr_xFD7euMTj5ya@yc10)M) zzxCr@&R*-^$Flv{P3Bvm=vDHYR60AlZ{V2c+sE2lPtCR!KJPXfvilX4-S6bOqBXug ze8+>e|4s^?*0Jq4;=hd}oV{4kl0LGobDUp6t7?g3+t%Jp(j8ln+MkgimIOa`bLr-4 zm#2K~Oj5p@r+w|;g}kqSBP@zA=8l;%+r~vfcbZ&c1&>A|kXF1-%x|_UnJ`}oW9yB0 z*bMj{VH(sUNAbAOwtK22P?q7)JBx^yNovnig!(-K{F|LFBshYzcA+Hp8 zS~;qAN5Lr6HNJ~hzlg7OuGkrcelJzB;r94NbsX+|&3itZ>M03W~lbTtYPC6)xVYdPGSO?g^J*>2MXI za!eG3l!_!iwSVW%UAv~HmzVJQxra=8XO_-Av1H3_x(6qrPfe&CbP_(#2ti1rqP-aT z6*7pC*necih^8TFq16aGc!Rfm@_J=dTx&N;pksQgZBQpgkG0gUXoLRfm~Ev;YPTEh zdU)-&k&vF#xSMbta&#^{SKB*(rS`u@{iD^ljrx15-|DgSqU)o%qqd&5qqf+I#+xcT z4#z$iduIv=#e*cHBwsD3H~DFF#zj}g@UNG8Ul(9D9d}_{Lwru$wV=u|=b86d;t0?r zm@MxwWtOwLN9HT6wu4(R_)+IwbX$5(bH(4o5=1SXZF=@An^aN862Q3-1LErY-C-d_ zYK=aNWa_j={lCEK>Pyq9n8Xx~!q=-4{C_O@*!_Q>&SN9**V3Z!DI-u#Ydt2ci_7hRpF z6#n)HwV(9<4KEh@Jt@{V=i93{i7v9uM~B7qv!^-g!?N&0%nsIv0NJGPMmH*FpvW2p zg{Yj*{md42=lB4MB>eNx!3n*@!%@WD2u|3XIHH@f%Wqg?JooAXj?&hADWf;HYDf<; z%rL52B$!Ut=zYTbzCU7$?XNAieQn-%#^0>o6827ZJH>)b2(WFUoB(`(2`M?bBc>pT zd0{^w){YEgU8ys7*i0U$_kth?(V0@8tr)Zm?}q9Wz6q`mHZ*n+#0R?;oUdZGHIB z8Js>-ZtrdTOgS7{_aWGl^2xRD5<|W=Rjy68wtczM+IwbxVYcY@g-=%=tbKz=_VGi5 z-~5r`7b_2bjKIR*nmyGDgm3M2#_~%;Ul{hQpY3(@_wmt}=R1E|@IL=@p}ofnWdS)0 z7Xv+%@#60C^b~hNU;CxifPF%0oH`$LQg78DdNbsW(O@;Y@O$ z1oVU(lUO!*v~=?Jl}_4xonW?h;-FMG19#o)qRGk6mi^+vPgjPn{M6u?ueT4L`GXg0 zf66#e0#6PK$U}}GCm>DQ&AVN2Ac^jC*IyvsxPiqXOlN!X?DC=TXf*kAXB`YYf zwYo@flU3{_x^peIe=>o{;2IcrWn(b^e5*tT4{l;e55#m~ptvn$l-#;)uy&qw_1iCP z?`<7HW;19G0R;QK1$XF;S6s-ry>l110`VHH>aKk0=`H* z&6asL85_bfeT)kuxPKU(LJ}#o21a-FUF*Fgg~Ikzt8> ziad02u5$}oyjZ8ycs8IqC119kq;FFCO-hNES^Yf5c#R8x>?#Z2UJ0q=dRr?%B;h@U zR$H*Owom3*)8C7%X?7i0hB!pfYiH$-7M0iN6JE<)7+g5i7-I6V z39}%V{9P)I^AP9i@PtH7mMcnl#V1hl7SXgYWbo3b> z6Y}wq(6idkf5E>6z24Z`O@7i44-2(lu+xUVjTZ>uE`MDFfdmsLHe0qjy4g4{(#+bJ z9dwv>u%88D8bgvMVvWL)nMH_5B8xK3S`*-R-)jTghp}cvunh_4 zuv2j8sL?PY#UqJ~E|1TVa0**RAe{9Mkw0#4oxYk<@0Sg3+>oBywev2U?fxCB z+dWyFP2hvAFOj|W#M({0vwg;NY-ip<8(T*_i2tj-AO@a2LOko!{@tZJtRiQ8?9$lM z$F{(s$TBgty=!LsdY?-w>y;+HR51;VdgWod^y+r6eWPD0Z})d}aHMeRh3`y@-LtHc zm@d(;Y60**QCbVTzyjgYKCUbN2uo&ogg1P~%pvtq#+{Y&o-7F?hIk|ys{oWlJ8ru# z>-4i5tK)8wQ~7A^~v^j|Brz1|6vmv&s*L`(nP zs!L_Bq~c1pV#}!nm#bxF`b|<%PK0pyJop0>DJE&1pc2Yx+U44xy+t2vC+g{qwnID6hkn@^6c*i)9Wl}a8gtX)a;a`10?AJ3D zhO{KF;p3gE0Ja2l6V5A5Bz&mQr1b?cO5Za^yOjWFIc|v*A!01sOTE7nOCQ>oCFK-Z zSez@JpPo6xvGsPSd_1Z?NtCD1)5E16wHDg;zNmp{|E;Sh9A%$Y5wuLX-5>f0O zs09M$zM>A!tsW{F+)?eB!Db%;{pp>HY4#%Xbgjd0`XFHjm~gpB+DYU#wsWYrZB^zu z=Hm(8Bn{>QZQwL9^!JuF|ePdlji|5C*wJ|PIn%Qj6OTPF;%wwM}nmX zt+HslAs1b|fqB$aZ0YUu*cpaRjzrLG6vyohkhoarJ*7lUk82QCN>;2<6|jw}L*%e8 zQJh*C*>akT+%#kd#~jI;wMX8Gy2fV^E6$Pk7JCFO11CszjzhotVPG!2sAOX7D|H>a=;+9IgQU>AOu?0eVseIe%uLhiK?H=JrWEG64B zjgLQ?IN~Ahec5e)y=7B~)E*7DgLVtUX7hL1Ph9cqw+*(|Zke@a+>d&}9qu|>TPw4x z?@V_b-gtJC_NcQHk~2TEb!her{o&;i*RLAJ2K8ySwM~+gO8anQ7G1{zhas9p-ZV-Xotvs$Oc4`^1a~*lxXfY#GVgso_r0RA&0E_*~Ykaofy}>ur#|c zGksyM^u+wa%)BGu3+GCU=QuY))u9syt)e5Jn4ex;1VHS~h53aQFRL>5N_~#!%~KO4 z9%s*rd+H-4%!41@BQLC?6hJC7KfR)}NuMfbJanvt&Opp|5f0mFpOT0-f02KV1ReJ3 z9tZTWSziaV1LHcqHpG)U28o%jrG82pn=XOfStn1`id19sX z0^qgQ1+3m>t_*t|tt1F0b`%?j>l;vNTX)TsMsCZ-1eQmXz^f>Oz8}qSy+?Jle5bcy z;TP8YO|=t9Ni+`*nYJ=~tytvP!S~gbIbnKi$#MHuO;2<(oN) z>hfFQMMIgNS)cE`{O;O5vKPN&*cJAxH}l$48(R<87i#~J#9F`MkK8C>=h|Rek0unQ z1c`{-!h2&*Je|^>z5ul2&An2N12w*l6F*QEX}`Pxs-udb63J0qsK=?5b*A`)JZLaR zXG`FTRX*~-ZmOa<@SzLwdn68vb z0g7r|4RiE(z#)$t)DxKyKpcuqQ09ev ztVG~A8%Uxf6zcxbQQ6UeBJ+I|QNjc(sFfkr(DEb@C<`iR2%iuxq)R~*_Chi&xllTO zWU|lmF!z@!wKw+2r`m=Q9gUI*42Yf`X+7ZtfD|IMf+j|}L>&8ag+sJnV-5^swD(P- z5-4jMPw(NpLM8_Q!}`iIc9~XOul=l>P$B8lK6mSlxM%)Jaq6JK;={i&@>H-78yJsTHTVMBU;8=TWkKs&>^aotwU;@iQW)$YZ@+3#3Or@K8{ zjh~-uU|Q|AicW9;T($d5b^96LS+#dny@oYDx2if?JFDFbo@$0;?gFISxV`Ef>(zJS zjkp7E#L~yBJMK9BPI)8JvG1%@OPwdWrVe$@99kcIp%wqdj@E5s_%616=yb?iR=s14 zqw{7LDsJRIy&Wafx2iW?dglTP)X|06S?3t7xrKR;iCG^eK=l2?Yu_{G4z24xe{mik zTI*am^|F6qLtLLPbadQO?P*)bGlV@A?^cnt0(mXIoG2 zYOQYn-``xFuI@ssyZxK1C%B-Jw^r}M%W%GPb+Ec??Uxp6ms(HnQ2~nHUENbCsOTNl zJ+rM-`*-|eYiMR_f7i_Zb-mVEfqT||eWCWN)w>F(@2ag;dkUv}Uii*}^cGCm-~OlS zP0zc>#y<{@8&mf%)}E>TKQ*=Ya`(vEjZ^z=QAVeFr|y};9m=_g_4%2-GyBEu9ttEX z#z~;}gs?=ka|kIT`Zpnvn0+kVzXw6o?t?D~!lT`?pZbw64#JCOUxQJTTU?`}b$~6X zt*)GHfmiZd6qKn;@d5bd%*O|ihLhXDC(S`jWLGob4^2h{%Oh_n5U+6fu{y~~hPJbnbJ3ij8{9EwC zQTGQmZQ=#(qQyoUL7m2xkq{VQ^qhmJX4H-#v}7hGLA}x649Xx`;q8!klaT8p4iQ{j zZ^(27y`hN7LC~Vy$&9Z*JAM8({Niyvl~)Y76W4kBi^~}T0nSXiRX9Djh)3N|l}%FM zgf-LSgxs(hDim2usWe&M7z*Z&zgcCp5e6HWrG$?TX*_m*BPC1t0!$K?8c;oC$S}Q$ zx%KE>LON($l%s)MgS>-fI;57ra05w%(1jc3gXyr;9gnqmV#+}1L7w(` zKWLqWoB$KCoAqQJCM;+aeRhsAJ*=kSw63BcB#8e9jwViqX#)r}S$d4op*(g{=P*d= zG6oA6I2}#eh{*wR%ej@_7kY77=`HVQ51EkH{zq>CKh3{HGIGa9zD?Y2l8q6>pu@&t z9KzEls-9uC%C<3(#MTcDgdhf30Hs;W#$j5(ld{eaPz6vi|i{`|2$r2aJ{RSL@}$t`ohVo3)1g z44n0+2eWsBxMY+01u1?24o(>-$IB<#Y6_4jAF-?qCLrts2j`1q*+*oIgq3tXVBh#K z7{RoIS`e5v#Z4IY!pNAb$$~MmZAn!ey8?LZhcd)PweAt<#k$u&k{VeXIr&skzgpS+ zGlk0qEG!mWr@DF(a~VWsuJ7fM$I0Q76ax&^i>QzE%%YL<; z5s&gPlqjNt% zE}2&HC*lPT%6^4)!vpgKEFr%sG&fWvS&^p*5>C*ljE~VK`8VDHRfL8p?M);}qLLYs z)My_y;UgtULWjv(8a!zHk^!6`2Qs1)N(yiEgp#zk2DS{$#gq_zJq4Q1fVZttz_JqO zn)DRCBjEQLW!Vf$n;%Y7sO|Lx_vAstXM5PaR6BE7;r=X}6)q}Y_St8J+Gf8q0KD?d zJO}bET=}_mx04wuu}Te;0NtX&}p#PWz)(7 zk-SVa09}&eCo^+eL4((XM%7vDNp2(jo21EkPo2e{=$Ax9ZZhpu&$K@XWh(e^ zO-57r%d0JeuNDSh-NJtzTdp@sz(Gv23$B#@7nSzP{LB8ygZA=UUmhOvm9hO=`-X>> zy;S>6%tomKAsaQ6+rsi`kilDK9gP|(7~BK{z7aplEWzQS$wmoS9hW6U(zaZ_`v%B^ zkvt9TGRgqepEp|DO!p5C^bh-rB`TCdCEMRo8IT~7gzeK@j#bgRiyaVSU@OI3e)W3I zr9ws4zPr--Sc~O$`B&vKa8rdE`GreUv)9krK||!A6vNm*4}?+ zyx>T|wTWU6u1NlpIFW8}RQR}`2J-?Qm_a5oJPX!~ia}WM9Lh!3%5whr4`8l6RI21K zDWZ@!WV4O8+(}jh#USR`o|C2Sxs_r!4n1R~?sHt+skQAkMZb^MPh7loCNOJ~=Nlj$i}L>lF_ zr=&^%3w&nYwa7m(b?b>)!wn~2ZK=FksJyy`|3D0G=Q0SJx4PF|=nps97a*CImL|{V z4c=Y16JGnHsV=25e4Bx+m9ZK^Pf3N5NmMwsoeYT9KB=3$KA`#A_Cf6xnKCi@dr*{4 zQM5%jvwsH8<+G5;v`Tv&KY%&(50t?tJT&eQ&_TvV+>Q^;*kuo4di9M&aI}xcH2}Tg z5psOE656le+Br!!aW{vcb?|q10O?}V(v{`WmO{o)9jOMjwz=$(-VDA6t|(--gZ0ca zF_Ph=4Q0zV;z80ZBp=3;)gsqoUO}VflYIlUC$|dQqR_AI9^*a2*eCCl4+P*`?M5xEhmL3-Dv$be*LTvOKFH1Yq4)Z!_jePG-Zm~-Y8Sl zh=G`@=6um96w=4z90b~qT1(a~lQLahKZ?NLYFj8J33g=^chUVe>_P9-vkD|g5&3^J z(6@3{z;40qC~?Aq;U;77B~~~*!b!uk0HTvn7G+;7w8rEoY=G`uDvuXO+P=?|^Vw1CuYQ^TO_78EWwYm(U6jpB=j>=a1+VM=lbF{nP zqk2P7O#a5^-VYdoQagg2Z;Uhi;h|2C`<(Yby|X{IaOI1W_O;pn(E|35j9ZAyK7^Y@ z3?edqB6kj;&UlT2h#A=8p$jNfB9_AT;47;bPlo~R&`8NKsAbcc(L{t8GDZYGAmC6U z>|(X7s#2SqqoH~9NOhz0aYOP1i=rWZ2(~;4E9iJf zE?H)(pP8Rt`rzEkT^4Ej#KQTx**zQzfDe{44yE0txew1RKZ#3#4h9HG9I)USH^JKv zU0k_P!af!CiYrMW{Cng@T3tD{W7fM?7iz}L(<+-`VCrb-UrD^<9 zE|ktaj`zvz9Ffqap5pOR4}u>P#Eeu%qbfkpV&(Ot@_R{*+D2iFx}6A1V6YITpqMa} z(FPeNdwf^knM;%EHB0j&zxig}IyO@6W4v)ICi}OT-{*Bv;oOE+4HHb5N0RC=&KFE( z`RPIwzJhpYT`Og9)Kkoz5@J1*id;aKU2zVth6;?h%ht4txk4(3dcbe22t2TPnyOjVD!4zFqno7m^r^rk>na*M3k?#btXC7h840`TqPHBD>?#% z=~+>0AFiPd@|8`W00ZeJ3vc-d&dL@-s4xfYnFH8aCA}0<$%W%*W5{`LXsXyfK016) zso$8CStdOoH|9gz=&sVrIgVV>Bw5Ba{1c~3D^D(+TYB=W(bkJg7oI#n4Q(ln90k`c z&6cJY`DEqdd6E>ZQ2PA&x#{KUrI|TVm*wdv&`?{kk)xtJk+114(jnis$!rGC(4M}K zQLd-^A&jQo%2@_Q8Vl;OV)sL(-Mf_%=>k1jUJ(BRv$Sww?yMH|!rb!Ng{A35Ym*m{ zx|K7f=?_jXEOpC2vVX9uJ*O@Afo7F|01j+r`s^H^rD>NK+4*xzD|7WV^qjhjor~F} z+z%(}mljVya#WiV*CIh>iDw->daTs5^Ul)Fhr?7iSy!K8ZMKb8K2Ah2F!nwDN5)D1I59Oa?ufjX zxnzgP`d`=GUUy5|ZJ=B-AitOa?j^o5Ps z>wb+y^A?A=(OksYV!9~ZeN@3JT8)OW7m-YynCW$QDGucAnliqY^+H(CZVb-`o+}=( zRzg6rX)~Q`9bylMC>mnNmN6oQj#ZLgXCBK`r9?*fw2zi_;b@;;z#wyfW@)DUg&RrI*_9tzqn+(*#)TC zbK((9&SZOmskPbs5xCODRJNW__{HyoL7iTHvXs;i$)a525!>ldF_o1h9+^~PUj9ey zTsNB^r3?l85OiWX!!RX5>=z&D!wnCT``CzD*~I6H^lALoW|gRaXy9!O_JI+Pyx`JZo5mm5YzPm+)@+ z^c~?Y8^z;FDdSV!#{v9-+TIeA@5vSvQ(@m5lt+ehBDu5CxmcDwvl+2F<5Co|kttzs zb8Toh!Ck_rsHpX+oL7HT53wx>sgW?(^skrIcZp%%X%xbObT1FGL|vqF9534I7( zrLZI1Z7>z|JV)jphy5`kmh6JZ<`&OAQ7Ru510_aIx(lVcJimPI{M_<|1(X=`q^B)C zHU}>^hozRv-BPy$Sn2E>I+59AmyJ7Sax4>F#GQAZ7_3e) zc4qas=0Ix4^bf-b54hS}il@ZgKTd^{;SG}>uA-$Y+9@7sI#`}W_dMr`X_B$M{g?uMv|o??&{j^01k zZ=oGNI2%ChQC(O@pg}#z6ZiL%L6@ybGZmfQgBT?!a@~@(?eS4f+iqSxpC=HnNtg$? zrC+^x_IwU$l_r68Kj!wV=J+v0m?dPc>BWWbhau*Z5EqvHN)ip2$H`0>?hz*(9^k>i-DlU*YqH!a3(+MB35;6qD zOVEA1%pe$RdY6O+d~t~Z7o;RpSDY9uAE{35_Wt&y;7DI7mjIXv+1WaHnRLI$wy$O< z;<98bF$C^b@^Ob%0A{Osm1vMYqFT({Oi&jvPOZlC`W#qW7@7 zvh|bWXaHlh@03i}gEO}~7*e(IDXAx;Mg#+0%yGg&ZNn>XDDlhSiJ>2q`E!dXw2iH| zgY*PW^0?^fBfrNm44V3ujMuhna_6JY?Prx1)5<(ZyDar1i5G`8E%q4EpdJOJs^z*N zB@-E(D*d&bF!Re7Ov-WLGKPJ>6eo?AYgEoc8lJgT<$Ql~_FD|>sfm^mWH%UW1(onH zU6^81b7%Li($4Oq)sc}Z9&yJ+i}ZyZapQFi9NF1zD7e9b8i8V$P&}sr#PZonSRu_p z29Y-HMSb1*c|)FI{f|lYqcDj$f6|nWhe6XuvIUcZuFH=qXPkAGrv*YtpXbkf5EM$S zXQy51fw+;W4O}pBob8S0SuobAO*#4K?*Kf1#`4CKI)j@$f$E2CDplhyVW9Ta&B@O1 z*5NVQ^g(f`Q3ctzP9ID^aRSbsRcn-;@_PnOOfvPkv;3Ovc@ZtsXK~HZ&Pi0h7oipl@Tb4$FfXOu~k|(sj3O5B}b1a_DljYN@_tr5LhYJ zBKvnQuXHb_%L|MD$=%m2b?9^x?SNMhxqyH^uy=th4R^T806>yB;8wt_TtKU8Igu&t zCU1a@a#6r8sp%qa9IrqmmLjF1WZY)z2^G^0F-B1r+O2xXl*UVELo=+T!-q=oN*meU z34E zW3S1m6_wwa6y+6*VF&#(W5&=BMcg2Z!>#62FhQOS5^WUy^jAu&W^M^V!Y$Uh<`~mj zmDHFw5T;UO*65d|>RAew@=3W`6u6c^l@TiqFmnDmcFb6?u+ISW{C?y?DgqmP1$51_ zOlJ8wZC(oJq<4!%)<^!7B}uPh+LBaykB7YlAwS_K{bQSGnT63PPNdanXV%e!4EvKL z+vK=i;}KG2YO!9MTIcT(JW=Sg+yurAL8V-elH-?iETI8$9rzji<^i-BG}~56KsZ$) zYKrY$WIDo)yGx`vi!Op#qx%N)?aQpGp__7Evfk?JxJ|>gRwQ0Vw8=cxxeg@+oC@8f zDy5#jJEF8OWA}&au=eqo!vHs7zhv})@zC#>1%=2duK`F=tzJ(PL|PU-|d=(0M+ROze*}L%;;Ij%{8Ba?jf~&2R4l3&*f)Vd75Xy-trD=`z3AIGA%}ExhTnw-VX@de(0~%9t zP&+T0`SSci;;skjyMxQOIfE(`$TzS z&1-wxG&tMD3bp*%s&d_CCA@)r_p^_4!$@943hAymNiCHTiYvugvhcBBDa?m2oZq#wA6`TQRX#woLC0@CIv17&p2u1W*|fJp%tO>lp&91&cAnf zXz;A~dxwYUNRTn`gK+=e;UP00iJw5;jpP4&hX+S6_gT=Uu(;d^Kpr{OX23 z9!5`sy3aP@dyv6kkzs&}JIRkGNqY0fP5myhUe!^cxPhrZ(?{cD#ffjmRG<0ISW{g z;12rMATr0Yp#xSTh*{YlWS%GEy2dB<8i%@;v<@bGh|AB6)jvy|1maf>qxEuG?}5z} z1r+KA-cWJ62K6IN-{fSH^f7Xf`DmGkxrsyeV*(PQ4~!fgm zmPVnRYow#BjG?@wL*8s&jLJYDC0aZT8VCAth)j1b~NaR#dh^vWlKeeK2hZ@wWqWj!cLf?pZgkV!Vzc(=H zXJ9pjVI_^%*L+1cM@ca6gb1G8Yz9OGIaxrUkxZ_v-HOIQt1cloGt#t9H|J;Wn-sH= zM8R7VL>bVAbW;H~vfp3rnT1d#eM$v(D)j`WYKnEmPB*TIGmG?{4Z8celI5 z1+`iUpCg}}Y%9U7OZC>zo#BR*AIkUMx1LX%uPyt?y)|}ehi9GU_LQ_KV!tttr-|ab zanZnGV{YlfGR{fev8Jbf#xWOB5d)7`4>hRy>6ucPasr;XL6D1%}6*qhIXEsgzT z(NdENQ+@tsYRt_UIS~{dfTuY#mYbZ7%mjBvhbSRvb2q48Z1)t|OjiuYu){X4DN#sn zW(Bmv@>7{kVfJ~k$s+6hX4*&r^mqyAl-G&Fs8t}u0daB|C1xy~N|2oORgVLjZCvjO z)2A5f0mxM2&c!+v{HpLrtDwmD-OM*O;IKEXqUdXxTU&pVd6X_{Sdu-V7md)S7cdB~ zZLah|n3vGUr~?j%&m@}O4MD;Db*{EuG`H#M7;k_oH6ikuIZKw~=$OJ?Y!Of?i}}?7 zv2jyI*EOLVw0Toya>$Y&(1MAlN&FB!+h*lGX<<3td~PU&FH+6{W?ZTpe9dRt*$5qVe!F94*1FDjMtfS9i)6s1b^aKn|XUO<(-d+oSQ_PX!*qcpx_VsI-a`izNMD#6F zhdpNAg`-j?Vnb-LFXae&mUsc2Y57-=j%`m|Yq*-Pbn~P}u$;{cM=|R#iSWjgxC-nL zDK<)Wme_N6GkEc%hI=_0tWNqu#r zY^bcUE-GU;9$_Gc0YX0kQ#&ruZj-*zq%~k&h`69gz))}rwWvLxzzO+)rpQ6AQco;{ z9pK~65jND%Qk`2W5gT=$xR04-&JUO%4?%2>^-Kg4@X;}R1B>1>AGonTcA8(D2-z8I ze(PKJlh%^>Yud0^m;DLs>pg5G#z_Hrg3~5kJ%vQc ziHZhtjTEU^M}PvCO3RJ3N=8@$Ik(%IjLiArVw^s3x0vGOQ4 z`mRmv^{+R8Au9LGEeg~U&D{5bYF=wZK~h&fm>@o`^S@^iawajCU**>s@y(d|U^K3l zyR2slZbZ7%Sq8?le)pM4jJ<2>;l5cv`&dc6M|>O$TD+?|+h_EVugeeKIG;eyui^$T zF?N%F@U}yYt%$l3P*aR_?CE}BZt3D2A+RUrmd|}3-0Cs`V!2%W9^pRxJ+urFE zH_1$Uzwb7>zqQuh=K+F>oA$eZj6Rz-6ot@}Q=MLtr zT{9E*_?$hKov?b+xw(m%YiE)$yB=OCo>+NoVBg?fCsxlqa{SckmAlTIdi3=1l{0tIccv!~?R)P~FPa!t-|6qS zq9X_TqX!0JJ=XH+7578iS3dN}=`(j6uqMXSb4fd!otT-mR`K;I{)B~ZSO*_Hal)E? z3|}~FMTfnf@7uSp$0{zJMSpwz<+0d-fe{+fI~(>tY?Rja*vP=Z$gp+1v~=>pl{41a zQy9&jgSlD%kb130POtpT>ZwQ1aEDQ&CpzSfB!-C@KF~k-51sSD-t9Dx2WRqAv<`NE ze}9zz#OTj}bzppC`<`hlYR#q(9N3$*=aQ+unTfginOq;eve%ln`sLa9{M6K9-@*J$ zAJ^Jz9kgN=AP~O;R?eQ9z(w4eTb!ngL4GHfot>Dwr|+^k%!-os4*V1*V>-aTX7zyo(4f2clD3);`ZXL+wXQu3| z6&~KdlD)lTOu;o|$1i zS0mQ!#6%9WF=`QH9K^2M_*s-jdCb%H9JVu6kH#8%j7j{%EnC$j7FrMUbe*Ef;~A`W zY%FUtOsQ6Xy3oE_FYnBR*TWxK3;okfq4OGglkXlcL@K@9&?*%6*hb}W5| zyY&5Wi;&p@W?_0JZAC|ih?=Z46VYp3VYMPRwG?2ffE= z9Q$N;!k$T{rm;2V7750)vvbzykiXXOpmo&0)Ancc`N?$7ipQ)&6LYjtV)_cO8jB8j z;5*XqT@S_lP~ZnmYcR@?GJqQPVc={)LUMj)W+FF-1~DU1tLK3w!qq)iG(K$g9M}$Q z+i&%(6j#r#o_x?cTUr7B9T>LuPx8_Jq&CfP^4)frpN=L+fE zcpv&WH<6s9jf0KIPl8))Bg9fwK{){wfzp229@Ex{Ad6{W4c;fyz$uJe(i$Npfz5LB z(}a?yux+t3;(8~6KmgP5rW$f_4b>3L8^~{_`=)VS^CE6_NzkpCtK;IY@wU4 zWCNBSU#_YC>HkcmgemkuC|mS#(l+sM7`WI#n1Vn zwE9L{WJ_UJTidpLYxU|KJF@0c=eNVJ=39?NYNb!+TMhi?Tg_vwHF>lC`9k+<{nbKu z>3DbTGx>;=a*x{DuF1EDt5@xC{#WBzM~=Tyxv?$sE*@Foc64TYey1RZ9r1m5F4_lCZ@(FW~_mJAumZ#722FJJi@*Ma004;EM_LA@`op^=up3v&D-OI zC;%}1mOVQ;Ka2OHKrl1;{2T!efjCi^0l*%}qJq)DUL5EbyllmW1%Jl|qE;@Q&EmuI zgm!#%L>@*52Q4r%(wX?6wa6$3f5B{x7t&J&J3WUUpfbL$Pz&J_?rCoJVD^v|m*Mfy z0L2S7x-awMuf!AO6);|ijaWS=PAwI!2Tq@QxW^jCUI)R!rjJ{D=B$0d0=>b_uIZ&B z{4*1v;%bwnK`*_%kp`t?CJl3Lr9mO-MsF_QXtfJz$MP3LdyP=&Duyavacq$`LtvK| zo&Rhjc&^>P#Q?z{5R%P35Nv~WwvJ961}VT23p)_N`Gi`f-~N~0$wc*TZ;HN|LCRWt zq80{*fh_cb+>T=$rftanD93E)=Awa-q-Y1NU&qBMhVD|m{b@5?{m$wWwbHqSZE|5G zVXyLjzzB!b7=TED;b@I>?cF{;k)=TssLNWR ze=)(1077EL`Yn3c3p^`V4AEBTB{LKXCwQNCC8)zZ&0sU?6J z(h(zE-k&hk^P(DbM=ep5;ncX~yz?JFyLvuhE{B|dn=n+ZudCl*Q@@|9B~0g!Yh$X7 z-?0-$z5MUohE~rzzZ}{V9gJD~XQs2c{P;x7!uIlRhN9L{-{ALq*Ve!&ZFkx~3Q=2_ zHt#uzI^%=6{5056%wiNXeAtF$5ygHbYFJ2t8;gR1O`t*o(>IN_q_7{0M1{1mxMYO4 zvo$nKyPB6|vu+&ymURn{-;qZiyaI!*s83A|z&PneA_eMPiu>Di88qwn@D43$I7@tT8Q|jDQG~TwS__b%%Z*A({aCIB@ zIbVpd;q{o17Id`q?N8*s%1-Ul#V45a>C0+@hbiQpE6poI75TkBuR zw}#hW%;j6V*Uu$P9{++_`Ao{NF=4-em$-5<{H5Y&OI`dv{|OF{nge-_RNGgXZFmFk z$+tj(Bgfi_0!Iw|<|8I5j^%}^<|_5dzb-kyrG`-1p)Ood>ChutFC_Khw!6Ii%fzY^Lr3?^@rjS;nmz&>yO5M+AuhXVtfKO7v1yL5jLoWrKA41yh> zvS%jk*<{Mj9Rfc+h}}rI#!lMSAojds8RC#Fgz*Pbh+1*T4x2VQ0DfDV7`Fz1B~%jw z5Dth>0b0lNaa{`0KuST>puYjW!58N2G?<9d(T2{&pij^($A%lGP8v+lO-z9(f(M6q z0Ge&Zz`z8$>aPdZ0|-;_p+)jh09isiV8q4OBle3uMxV#yQkAMRrDH0smC}e98 ziV@WoF^e{_8bT%T2n{5&2Z$K-F(DX^;)THxrnZ0?%vmyP&rCp>qsfa)gj^8161|A} z=s9tHesWIq0umqSx}xUCOd=PS;Y0cRfp`}f@!l@9ebG(}U0U{D}c23H=!s)oa%hVA78FEG3s3PG7S146*P3xk-Jks(VX4D|murE*_eB5XT7MdRMY z4=Y_`&rXIvH;Jcj6pgpi)vYPWOi!eCpGVz4$wX}8)s(E!yB&-^@nQD(_*|a0?d;v2 zUQKh)KdDNM`8U$3F@%#&%_oBZ@a8ALfbKHGO5ZaxE4*Zl`DVzR+j#xZU6L*GV-R_u zFG%GJqBV;RYgGf!YO@gx&{*R1XYe077TP=Rc+>@uDKP96l!R*B!z?`zv+XJf=Zxbm zvolOe!!l|gK-XpuvrxfYtZ}@xx>e7Jt3L#P%?giONt(j`ota1jDfsXu;p3S@6X_fz zLZE}e0Ca*?*9u3F04=FOx>B(EVMz5O*U#kNq>9Au8=NwJ~s}%&lDCY+7b>KC02m6MMAs? zb6u;f)|l^V3x|dIbJcyR_T$%<0H4rf{TT4Wj1G*rldhCY&7|=`>yF!~Ka6tlmIZRK zhY&TXw;)6g(zN0!Xm3HDQ$2vsb<$kjQqm>`>6!9NMJEXwak?-V3_3~|bk=yu|XV;M-<#)>6 z8}d@Vt9o62rOwL1%Vk}O;l|LB+f06&U6!>DH;MUQ_{8XW8uGD*!8Sx2j4rs zXGf{nb^LaoL!!pRV9v(Jc`po!^skuNA)o4xILo8%R%hmKKW=jq1#CoXa8%UHv?*}| zw5d4fL2#LVQZP8ox_kA3K@gJ0Mhhu>4%B22ltrr)2hk5=EMt%?2Kfro!$?#!&LBd> zXcFTY2MZ~Nj5tQZ-Q_ODq2i(e%1wWqk**-XDCCO~zNbFphAkR%)AMt90?wPzkK8m< zqWQFF1NeqJK|V%C*Z?aAoeK*oq}Nm|KUCr)nv%x)V`>mlF#n2=1_S2}A_^(Q9R#$G zx{;yyhDr2R29lfC0!)2w13-1nrygj32n?hq(L?AivFP+7L_0_*nxz~hI|^aYIK(Kg zN}S9GC?*DS03zQk5IbfvhWBKK2ZvP|Y%98~iLP+~0*H?qLFkAF?qlGnx$W4X`Uu&A zync`!=Ydm?o-9IpJY=0b1q1ic09oIo3K*z^Q7k}iW$82o4M3**GLgPPK+v8&Jv|ow zgVdF^!OhG8$_`mQOV$H04_POd9$x9OCMOoDr9C(GLZdl|Dej?LotW4pIJKb=!&&^hUlZ@jXcY66Q%{Tuz_@eNH(?FVy!lE zJwXP6S!JTKF-v)==gz#Y{$$NLD8=QDLjSRy)vbIdANgp$6Wl^uB;qyKp6`+7>5W0L@NQoF~YGLcI{ zc#E^N1ESEnWYamhjPk~yor=+Dks7LarZ-wa1!1(=moYvW0O{hDDGx)Tod!P+IH-^W zjNR#~8OZF_q#pPN`8KFuz{0{nJ#p%TrIphw&^8TOcWj680Y4Uq@PKv4 zeIObE+jih(GG^X!FNDsxH&lg*V?YY5%z_V=+YwAGS{#Ol4XKylO)%&g3`e;-i#yl_#~!9FdSgc#C~->Ev0sJ6UIz z9SP!1+35s2sM*Ks?S|5^y2<@Nl*}c71=$5b%GPGbii%o7e3Z$Ye zaY0WpL6}$|WX(?y@o#DhMl~P#lQF>_$L=bk{J`R2FF|+5Tt`%Bk2pGPu+V)N7P_mT z)3ZyW;HY-mMaC!HPuIrm<(3-blVwxP9n6g{w}_v>Lc>3#A`A4Y{*mF*UnJI%ju^8X0M9a(*U^^Z<`km{xejG`yua zWo%9~O<&OlJBZN15=?E>$CY7sxttDmo|;bAXwD0<$;Y&oFv`|zC|s#Kqyt2WzR4P$TirdQeuV{*{DO3s+`qZfjOeiDJ-4Hn@9yHWg8CKDl=J9#t)| zp&AHI9Hm&<7-m=_$tYCU?lpXZdT zd;^hHD*%A%_g%*xEkp zIQ%}SP+P~F?nC{7E8@ou^G_xZSX^9_NBHWk2GHXpTas1Sojts^P)>}OJIA>Ipw3Jw z8>Rmklb<}%qKxOFsbNf*ij3)sm48<9HhQ_sHEfbm`$fX3yi2vE*|mU9Y6MV!E&1v= zf9;VmkFC_+A^ZRqR#Ugbovg3FYeUQBzD;e5J!Gb7LY!qssxivK@oQGYS~ zrSyf;$I`}yw0S`X?S5*?bbiei z*R=9~FF9XS)8;PwJ+8+?=!pcz=eb+lq9?sH{wxg}dw)CqGS+|G?5u9FjZzoP{tSS+ z!!p3~9X|hszdNIW=gGCdd%%N}gfSL?8yMK3r_ehqY7Ik+UQs)IK0<_w!b*kH`+oThvH#A2U7(YVt+3Nz^v*vU}yF933p(Z z^)vX@g1hkDL1^*rhDSV$`0U-}X%p-TaF%N^$8%_f)EIz$hU3KI&)oyIIcRtu24@4| zALwzfHAEaZ5gAyYS<)io@gP1sWhXHeY)c-5$;W>S4Uqp9ANAeFAp`I&Y|s#Y#4HU? zUYa6hoia-gfO7I|BSrun8NmDpY|3Qm-wVAPIDOZeOx}zrgNB2-s;IVJ6BXy7lBwEn zV~@hOfV&WdU!rT0Cr4)~g?*na;-Dh*11*PpX6=j|Y+O546(u9;l(FKS4i?v(D0$yK%zHq1xEc!Laa48j5cfzfV4GKfq(0@D0EpO(tSTa|mqV18 zFdq|av$`wbde#d+&A@tmoEVz6e)xDPjP#apui#JO3Gkdg3#&rLWwB+X&F*u`CCeGk z6wPqC*F0h@hRgpot@)RYPDi!cs`FcDRhA&(EdftGJoXx<9$QS$Bw%zuf*|Z@+Hp#_M3d0-3&hibk!iue#;d}6&-u{EI;_ZaFh{b{04N=uH+2FaRlp*kI;&$WK;XXqhl{KNh8h z7KLfYvYC|K@|+?@pDjhkip+poHCrD2n)-c4n9Q2|@ay6TvY^^{DxKO~eoVF_mizFLDG)%zj zy1F%OE;>JyNRxW`hi&~=CCF%cBz!KT3gN4CFTJ!-EoPGrc;pwfE2`r`tEmv z2Ljce^I&8)p9kJ$79@4G@3A6LupihmQwTL;FDocxeYY?RHGT_v>EP->DcV>9=I09A z#`A0!az%QYwooW!BtBUbmYNI{|AQb4J#C6ITtBVmkKOg=572r;DZ!W+S3uDUheKJd zB9GYP!iTwW@AtbPB#0se56PRoR?GLUy9yl+S8pin5;RR>N6X_vVIz8BZz}9!5Meo~ zWm!2d*VbANC%^}_m9I_l%SpMV;*6evjeS?aI?)103+G0E)h{IQ zpocv$?yXvB7Jyp9QltKw`YjI;kj0AO%I&M%f$*OddRFVN6s#xL!oSNORyLHi@V{bu zQdToXT zK8G8`1RcMriO11w|P0bPaXD##<>C8(BW$sbMPwD#Q-AZlOP3jql^*@po(0$;U z)!fbXt8K=1fBQR}jOxHw+ybFXrR^=4)%_ zNvZyff(!R6L&2}eM;KK6Jzj71H>ZcOQx6V8D0hPYMBKIydu?mw=8Jk-Yx*P5ratL?rhEq)lm#$8thx+yqoKfy%#9`8`)T$3s0vLJ z0O60^FO&7PT)4cOFLT}Ho2Q)4B01hq8E`0p2GncwFSDj|v9K#uhw9;@y8X&~)rwYP z`l44~So-1yb>Sb*FZzZvsHY1yOAeqr)*de3ly6tt`c3X!zFqeP9{SF=r0=g#f7U;w z#^~%r*E@>g^7Tf!C*Pr7uiSvk)n9xu-=Vs}gD0H#J9-r5Ue&^}PSt^(=w5!OQ9lPK zB3|!WzSDHR?XAb(JyD7jcA=Yq#P0I-sWu}3JUg6kXU=7S2mYvFRlZf&UHKjPIJebl z-dimHhM~SWX|k40zT$k9%m(Cb-xLv(`!vbq^JCL?8uDQb41DvN?ED@jOPHs0j*_(7 zy!tF~E*hsWyXF<7J&J~H{#-Wz#-VuyX`mnO_|2bF15lDfm}~xAy${Kz`E!1M6n^K; zAM@)Yn+}iP9)Zh|R^W_4JAS2>K)9Pf=9Y#>H+#(e7>4mN`1Zjh=^U754ns2D^x@E^ z4byj_f7o<{{NW+UX2G^ud?H}NyBL0xhu}}--A$KPeHx<2m0pLUB>4DXk~KO>8x~no z!Z(F@{`BAmfl0j!FR{%QTsk#)?iUM?7rsv2ReM^$R`>M5e?y z-%ALM*=$%mA91+A1Y16sR3bKqZ3LeMzDf>R%^$;oo5Bz_AM8ML-~oK#)hoje#fy+b z4wP}5Ei~_&80t0efh;GPs*pKAVvfbY!U{kb$MnX9YsBU)kh{?4Pnkc59z+y%aPwDM z$SCOqNx~)!31X5xlD7n=V3v$%(ol+qb?jtN@q;nuXaUd|Cq6*84#UksR zsIdm1gz-H_zXQr4HIt}+WG3;$_4gj0ZA0j5F@5uswe%C| zu6DdNvs!;6Q0w#ju42JwD(liX_$$n?i$usfnbIE6-iHd>Kj+vh)brUq#s`}Kv}zQr z!OmGfX4X8B+nY8_!0qH6!G><(GK=AJMa87PBEeO)l)2!17ybpCN#cYC@p0@iZz(tH zj8JvGfN%(yWgiV2c`l3u99SrkhH-HcsVKk;f4>wdhF`u^`lxYf(!7{57i;Nii}PK- z6)>BDJiu%!b&(>-eY5517p03TuxpblLR@v%^tJ`YnS-N15S%b?54IRIZ_#k7_(kgF zdGzu;l6z?2=oL34XD2i|EYx*BpRwz&+TrIib~j}W_zTJ!Q2q^m_DhITv+G~A!%t1x z-4qq^f0xRyO9M6Mi*N_H($rIo6YV_$f7&`gWpYppP=1rao2m{YGd4>%@Z_+9#TO-V( z3a`sgGvwxDwDsg;kLJXbL#na3Nt=|xoTgQF>Y`!S%Uz_Q2`dfDbEaWxftxn%@52Li zvu^V6uQYm$0d|pl<`D+gWHb9%O0UZ<6r$($99S^gH*jT_^kI~DN8@9R>6f;d7!z$E zH5}G6Ef-WI*|UYnOX)(S^OJ>0_!(RvmBc~qHnl!fOaHq0uS0FotyxYu^B!micq4Ux zJ)Li5{QZro>b1F2*V|bW8EyV3x7+!fi$`i11b$*(ekJ^+%*E2jGRDP>c_BT?^$C4M zH)YIcnYeArJM&{&bU4s1@(n0IaW#nbzT%G446-+e1+Z7TwBKT2!eo8Q!_w>7)aDkr z8*26ow1r4ZBEoyhbf)y~yhRjc`(Ndqw;!a;F7Ho?zSX%ywqxbLrWF3~e!gbEsGfdY zDP=KxYnOkX)B#Pm2EZTk|EBwu=<=q*umI$h5je=98-+b*AL3L%5Z>`wk0rv!BeMZn zy~ZVcmv5mTA14+BePCZEavyeGpRh>$Ks7{uh@=;GD^o#}O`wGsfevpC8CYlw{8+vO zOAFg7I1riqa&+eNGqS@YrS|nn_<449G5cXG8j1Snp)nIA?UP-iU$>6NJfe?6Xe-GNB$XX5+@G|#xKERl)gZ`#EVR@MGi6>j4~e+4e!w`+3lAXPEq8K^)#2Tswdq1TSEG{lI!y3Mek1 z7nsIg+puF*K=<^53h$O}N&zqA*MZ@y38pNCgcljVQzB8#&M@x47RH9|8$+H^NvtZp zr16nch;K7fGBw}+Cm#`wFgTkUK0#YtOVZQ=ZV|Qb{{l)>hDz==Zbh9%eS&dvzO^OP z!h6nEPMFK$H3b_@OQ9RF+uQ0-p4j%piE9*JIlDDuz#A(Ahslg-zP*jMQ*FxpMwT1l z%^!vh#&>&h$}nHax4yh)e9`7g^~!ELEJADsfj1oLKW!-H-XzP<282B{2VS; zVYvx?Dxm|DQKFcYXC?8XbGN#0Og5&U-=dytGuJcn-p3_EO<9V#C)^8;Gh^F^^!Vkq z@VloBh1*KYTb5haLcfzlpZ-I>b$vQ3?=NpDeu420%umJ-D|aOEYc6l$0abdF{HT1Z z{Bo6Y2Y!-*Fvrl?<2mOnBHCY|sCF^kEN`if`D5PP8Soc!e*_cTU5G^R&HXple)KWb zB^X$LSguZ)zNh?U3CKfGNfIm6>dkD~k|vY!AYw-_3alr)D>r0|-23jY@J|WADTb5bM5j%f=jW6psxr|Rxu$!uAp2e)+opomybfl?<-cWlh%mOGjjyUkkGc@<7EWlirVF6gq5p4B9BCvIRFg@b%9%_ zh<3LU76aPg1G8!9#3%YBOuTR6o_R=N1DFKwC1@xpGbI%upgrm~P4T6ALSksy*P9qv z8sr_C&yG`OEt+dR4kTR0uw-Gqp@Ink2gIX>;$L)7^gZZ<*%O(+4K|VNbAf+mzVQ)s ztTT9q#ozdhg7i1MfZ5wnI08V2?D=lpxHSSjK|{fYPLIGf6D|42F#`2|V-Z+3Zi$CC z0^d6CZWxkrYWD81C9~Ll- zeN4NCs4JDt5FqV-j4UX9 zu&Gj$gJ{zIa9qc$DejCCZV(vhEf~kZ;4BO?#|SNE~yz*z{u#7GN1f0E8uc<|)v&mw|X zf7v?q$l29XClM`-t=BYM*tU9>Pn|yNzJVCxUW<(JoKF}{{mkl;o}YbImU0YJ-0&&H z{GPVx6o-{FXYd7Nia_RJgcIXa*!Vs9lP4at&YXI9#d_e;lgFtKQUi}Mbi@#!;fY=; zzLy(k>m7v=@6lSXefvB}==Fc7XFFowkjdf{eZgIZpTS`j_=t7t0pzs+R_bx_`6>r1 zpISbXr9 z)w5?;PFhQdN<@@&9Cn+Y<4Y&seHIBbkkw-aZDD$7K<)t$ZV#pW)alg+S5GdTu-x(o zEVLBEI`tenWi6FfXr|GYyOc{OAN%0aV|ODx2Zw-L012K0p5;>ypqpo`GmkyIeCovN z@iP{8c6kMTB!FHiQrmFf=y6}8&biaaIYUZVl;9gtSQ>k%B0u*Q4arMRtCyE(ZIMCb z^dqOv;1~?*k;Gy$F4x*HfOe9CKS|`HU)gdD_CmKvN46p31|S8NT@F&k=7EZ1`_(1_ zOPEz_yXUH8b$iNAFk^JVSvD)TC5`1R;;DEpsbjKGBWW;edBM5MUah~b)yFE#ciD85 z-{!N-AuXGqQDV$1!VM%10V%r001TFm|Gw;w77 zq;v4)QD+;lUMa?We$q}k&s`>goTxUm2lGU*Ik0paDk0IT?~}wGAjZli15scsiuW#X zu2FEC-Xp-U3+LdNG=7KmJ*i0<$d)1jtUTEGaSx7xo&m)N=d)QhXaoS6I!L8ttog1A z?+|Ex%jZG4SiadVAF7ZKSXo3;M=VI2;yh15sT(t!xP1O100ZkL0aPKiWMLm6seDe0cZS!hKK`T znv8b|zPTKHsC$haqOSq)bSbnM3M{%IT@3vak)~u>J(S0Z5hW#G0$m1oy~hPm4R$Ul zy1=I(&to=Vpr&ja+o^H#nNXaKhCy%+Vo_7i*%JWBv1OZKhE~XW`hj|R2r1qRkv4lv z2IA#p#JHbPOlOW4fARCVG;CtkYo|(GM`8Us;{4In?n}`i< zoj=Ptzn9&8(fKbY%%wKNcxWjtUy&bzNbr0Jgszi{kD`S zKkDmhk5k@tLo)vIw2;jQ6QJEnNGc0t#D?sPNucclKnDLCdpSFdJtv%HNl zRK0R&Tq#h-yDRTalu|a6h5o(hmBzbq{p;K%T)dSkedFz^>UC*ce~s&}h5kkOOHq0&q}+_JyP=-?vIn)SWO=6RSoV?6<$-n<@fLd{sXgiR~OW1mrLmv zGhC9UlJjeq3mN>GQ6u}xc=!c=I^O*>|9*`BYGu>^QcG5L2&2R0JadnilKMoOTdzfG zOlYdw8J3PZ1IS6=ffQKCN#B7)nn;{!B3ov@QyuBTwUAX4Iq8+H7$%zkkq~E(MG5N7 zN>gj03%V2Uuesl|Tk*YX@V(_NYoX`(W8Law-RfhBe77`or2M;Cg<&q`yN`9%@;lL0 ztm?6y)P=Y5UAxgk$Kiq1%XhmU;X!S~M~*s!?{GZ7%?mTmUDvTHUrmLTu`AX6`9!w+ z*@O)3QZ|{GWWt$}#Qt;X^=X;oL|S#ds1$NZ2Fmp)H~)@78?H3Xjs{5N+oe6{9*&f- zk;%1{KTy6K&-C>`v%O=hkNZ24Z&ig@M8|EMV6M+!?HxDQ-sBr<&#wIlZYq#;b=ER) zaO5e&=YI8r!O)j*ZkNkZuyyJR61cj82(7N5+fY}~76H+68t73_WL4_6PFfvR2A@v3 z8bL6ExyFcS2SauSFbgnmK9 z&`}a|LkTkVqd_=(Qezs055m1UARi2Z?eh00PICh388fMRND58G=OaG^d045>k~=F+ zkNRvJJ{ImHe5R31!V@(hE`Y7lQ6yMnJ*9eWFg%$&XvX9Me4t!Fpl4c>C)+#vu0EuQ z)-Y*Eq2n2b8jyc6K>8hmqK0bH3=Ki|D8wC(J0AB(M-ccYD~@~pN*tmFHA6nQQ&8DJ z!h)&{8dP*tH8lY3xc~J5Xf*@(P|*hNu?vvWnlk*^Xcz<;y5`?5ob%OL5*EG>1Kuqz;!*81|4(2A2>vdXlFeJy9ez zj2z2J#SjPddocF*s3%2vX@qoZl;`yH$^*#tck(zCUQiQ3$21JBx7QqNbtKsxG+5Bu z^~~pJ(hub@edCya76zreq{KmbR$4QxBIS1PMT!(0#KrSIp2mA~*~MN`>}|L9&~u0h z)A!)SE@F;|x!*%P7;NTIT*ABF!ogIx!ZzMZhmUzrW4I($mbC{Hk2cYQR@0LNLH|>B z*O?WZ;Cg(;BE``jcH|R9;G&l}FsCvHLg7WJ1YvHMUvyAN-f@7-)i4K8C4JD^Gl3D@aocUyo}(E10KMqm#kf8{h)PdT zupLl=B#8P;z=yJyODCYTE3RP8B$pv{eRxt>I(?E(NbKu_eoA@pxNNtefLSyh`fNB9 zHjtM=1o!2T5k8kNE+i1TUHdq5gcmZBsD#-HIj`vDl5=~a_$o6`j##{zQ&?D+)Z;0> z^S!W8s#kjwitAnc47ba57K`W9u}QTw7w{jj@Z^MYRKgx$TOk)k?}mMJ$@h(r(k%2d zfcXG2rw|2lHX*$~o8y2B0~LTn$#%f+)4>T`8`M%OA3^x6T-Kf%8@Kn_Gly852A-SK=%cdjh`fQK8TRhrFcb-2*J20oIF5&e zY%vE%5)zG-&}4;fKq4A*T2w3Rt#*m$nHeI?C?*MNg_J!DR}|OcM0t8(!{V=O_T`uh zHk*IBSH5i2D>tY_PrQ&?R%`4FOg6eNpe+G;%&EYK-u|=`bsLVW?hwDikFE! z3zni;7LuM2q)MKaB96%tPT4OfXz+u{Wy+qW$-<|=chDL&EJ%!Uur?`25-1<#B5P!D zf?+-aC2;2yCSG=UL*`p`6@?s0M4V(u5QUgpUqS?-Uot6I-^V{borF{xBHt)B4-4Ca+2Q;Q{1sBHGsnZ{QF+;|1@IWwkoL5CjXrLyZE4FG zo^ra85F=rWuLT#HouX%=n2G;V64#?t*TUneHv3&Tp{=?jA8B7GRw*6a3%tm1x9F@T z?0lyODT}^7)GJm7Q7D(v>ex7H_xq(+^PTCgOxJ~yGvI?1$i7Xa8Z8nDaMV^S9dP!5 zoZODSbU;9D*9WSuT|S=g*o`wXobQ{jNZ&Fh^bF_3#c?h4k>dT%hwjs$Tgw?n`9|O8 zpGQFxphVcZI-wapJAoJASJU(b)zh3|!tsV@mEzDpiT^Qemp{yyLBgK^;&f&~0L0_i z;tIqmU9y1cfD)qst6-*7nPS@sezia}0G*UTIi*Zi^^^#Odf?ODBt|iqrqy@o;4`Tk zLrjvo0t2b8AZW-{6wH|JD_Nevuqylt1un}tv}>T?C7OprV$oIo9Q?B?L|=(Edb&Ks z!MdUwaAQ!~AcPkz0n&^^5S<13!kfrCl|Fb7k`#GOfb`~IP2jByOpuh*o{3!27b$K; z2{7>eApX_e$OF(}yE~a8VD(lWze7dXl7V-6B4(ErN38n2? zZR-iAF4$omS@CqOblx^aV_1LEHXpYyk~$pB$U}9QaNiasCjw zw@B;}`#;h#LTd61BY*}d4rmM{FaeQ+J;E}8N7}$q31NpzL^?N5GNO<3VUdHqSQ`)N z-uxUWI4VQ5!nwi}&&BYiJ@Nw?kSNaWU=o!O{g68hGCO4;$qnNG-_dc$O(-0Z{GVeJ z?%`EC-g3_e7-3^`(&59UBqb z1a?g-nVy>=fzdO%k!$?~9eIJF(AJ`4@N@Gs;E9N@1t*36C$st4iGz*vC(uC0H3i&( z^Mp_G3(T~t0%T4UcYcXkLPkEg>q6}*Rzk`QMMvDa zb}}-`5%Uj#bjzS8potaL5**mjbM5~ITY<)Z;7a{ASID&+T!|>mM;+A+j7{Oaen7?S z!{}B-`eqzr;`4ul)KIj z%!h$g>R=bgh112s50dB*+W#-PXSDJ*UesxC;kf(HWOeH0M{8-rc?hwb8bfFw)6dba zr?kzoN$TYZcu%7iowj};kue@BtrjIVVWGU&&KRkOFY}7>f-hu5SI!G9`r%q8wUg-Y zGtPUZr?08pvE?4SXy7>Bui#Ibo2bblv-Pjb?-O=HmygMX&8QTFbsiyQbN~rdnozJ2 z(+E|Jx{Q*#N*#<8g&++b7MwO==>#n3=m_lCX*)TI5O8c*v_QdqpbNYcaEdia*{Dt5 zfWAp7CYw=0I!;K1)Kl6QGChG?M9sa#oT@;0=7kaDq97Fzqp}tN5eQF8L3QeCMAJw* zH=FfGgnFTV0O5CmMs%S76ynMmc?LODpgRgH0yCkEAOiV(D^ALd;+rPdhCC zzO+0>b{*c;K;L?ezzg^@jY3oEtrWz3-rb}e!lDTyk2Ps#x5RYn?GEzlwt;PjoIDin z4|YyxC>56xT3}Y112Sk=D$SzoV2<&hnwD_R+#3L3wh?G+n zIT-mE5V$fyLle-t>wPaYYollpdUGqd2|7}N7lmYqt-M%d04Mu5LOo%v%NXB4sHfP# zagqXWpHe+xi+Qp9Q$D_0=Y0y;7jsQGeZ@Cdp7%k49Knz~5!OdAf&ZT*tXnY0+=;0A!uWxRDwRFJDp(GwoD&IhlfE7sd<2^@CI5bx$mr0wn< z!yNc5)_Oh{uY4?#lXU-*To^Lfb%gZ$b^u+6_bAQ!3VMUEmWQkZEP#Q}`M zOuS}S-^J?|v7c4z@{-T{DQpxJpD)zL~aI&g%5a;7g(brODN0|)FMdNI%kFee1( z)Jx$P=;Q+2!zDVMrK>Y6(x*uefr5JdGO>bA0QxxEAY_&ev#;dX`uMnrmAz|-occw>rI2fjs~bq3A( z{Dpipk9>uCt?+xcg~T-oPCC(+R1r=)KP{LItSOH48qc+pm~Y%H943QQ_lvxWs~|r7 z%>rX)?aZIO1=S&N^4C=-5>cvF5gO}JOp@1+~>S-!bDa?V+&k%6qJ8K@wWlk zZd&-Fs;LNW<31>V*xyohLHfzfE*8sa^|^|2ovD{c(gq@^>3<^7!kN>Jl$fBkJSzT^ zHYM-|1LS*Nm^A+-hFg`^%eVL@r~9+35#Md68Nr}^E1EiCUb>hqPW~V`*oS^^=|Xmi zzfvzhn87hM#%Z`?-RWzp8*xj=q+k4(CqyQB&6x02?5y4_)iN@cK*escS*#g5GUa#s zUeaEIz9Qu%nAK}m?x|&7l;;^nv+$UaTb^#5wxDLaNyS$J6`$1=XKK_7abV$YhO2GT z_Y!89o8>P#@`A5(65h=3a5etp{FG`~V@VK>%nSZ5J2&|{@|jxJw=}iv3G+W5UHj1k zpchbl2;Ve}%p&{2&9XxwC86?!D6qah&#++<-iPzEaZ$sl4Ie4QEuf8aGZ2$|Y<2P~?cCdtI@ ze@(o?6z3m@bDQ@X9jWQ7N|t}$L&)O3J23SDii1giq#J$GMYu5uLaAZ6x94dlbeD8w_x{U!x4=YiXtEz-m z!z!*MPzEgyiM%*|6YUWx(v_jQlDJ=wKOSzvGY`XUw6Pu?aJr$49b1C@Hl-(H)|&$^ z6w@a!f)KJ>!^T1|cqp7e1RBLqz{eUZ4AsfpBE2#QMz665Iz|*Bq{35xg31zm&q>XQ zF!@-1K3rr&86=3tG99(!e>V>IlnwQio*+;U1K&^&>evlsqCbS%RJdBz2ImrNtUCaS zc0(BiWtx@&I4Fpg5xQv7Dy#Xz8N3i=U82vqf+$vwMN4waS1-lDlY?fHql12%tywX! zneI0g;E>aWhA28n#f2zxUT%bnC_W|-Ku3gZSnMdazFO=k5J|(zMj@Kf%0fNN;IeT} z;jK+iP|xk9C)f=GZ+Q;Sk1QR3Xz4+YCwZ96NspX9g#e|qkHH5Ti~5f0K@KHv2I0?W z3VSi}BXE#tC?wmI4BDL=HAsvmzyuMV@Y0=;{S5cS^Nkv$c}6~LPBm40KUl616OXU) zrHbX1thh{ym;h0-iEolKEjBu77=cIo8emyx-J*-X1e|N|-rsB*NB>fUO(wQOxe=c{t3{DJsb1lh`@o+208(_c~a) z@-gr<{JHMu(zxX5BR)q_-{)&-ZW$bw%9;0%<|^ixhehEYeL#3X4I2(AAXKpLdPG3+GiQVgWPC4bNX_$hG|_PS zz$}DW@e!gRR5xIe_-HA>{{TKYJ~5k|NwZcL77>?XP$ROD=_Dmz%W#ZCw*v(+Ok1!3 ztN`~S=DiDa0zCvg$O1LVtu0sp1q;7QiBbH0(ONee4kmC)AjgPGQ_wxv>(krLXr2KSEE$NTxC54nZW>Ukx?P zHXy`M+xxHL4UR*CjuqNVZzD}R8PLBwg+23C7H5<;jBD4pZuM6A*@AqM5l`f)DJ7Zn zmrcsPY23@(k2hA>T)<%kZ}^*EJwMq*?Uri0mBR0?+o77ym`G1Rk#u1kv6qijZ;^5~ zv+HDd$h*Nv$+=N^A2{DtEkC4wDW>jgMtXg#*U!(cB6-}}Qv<8Kr!m%KYMgBPHL zS8a&~FbW3S_bNpkySMPPfkxlmmcTUrh7`>Ex&g5DSAe0sp`V&6S^%Zm=k2uSwAFdB2c%5_4mrP=;0Q_>vux!wGm)bQY2JSV3T}> z8rE7HJ3L4M|LdD_ano}%MX2Qyz`)daNSrKnO~N@@sRzHURDj;7xFq(HBwaiv1TE3B zHnJp|xy5P<>2S~5<$1E$ZtT5BS;>wfLuyL`+j6f;@|cd$QK+n7E0+KJ#Z2{DoNRLh zDM1&U?@aE#;QTFPgZgvHV)<&1`owBocp1h?e>W%D@)k?1#tQwF z(mPfQALj=UM9TKQ$JM;a@S1a6bhOe)r-BCVx=bIr-2JDmxOw6r4*JGxf?Vrt>nr z^PG(DY3|df=JvxQR+EV?M%FVJU1!MS8;&P(357PTAEgt98Z)@|M4ln2Fxeb{)`9669bc&6 zgC4Lr7(+PjhBC;lLU19f@SEgDA|-GgX{;WF5`t@iAK;7t)Fip+D=jZj-`(gB@|M8! z<&MA< zINv_Serrj$lBKd3{<=q0VMz&>Z*9BPq#Uc*eisrMi4R<)4H5opg33Slsxy4S6K1S> zH5V?o@K61^z0bq^aw0r=UF({eq;2@81*1|&9`N=Z4$!$(SczbZN~v=XUjun&dp8uX=l&yB&-<^NuSQi{$E25 zXN9j|zwvhWnjuNE>g5{}MK11yHa9L;YsPN{#2Ue_ScM1@H?R&xUcN< zAKG(-#G-E*Qu*bzAALS!@->fOE%dfLD37Rv$l;8su6Q^V+)`3quJvxbepGBX0x-_c z>2ID>y>w1Ud*@`Roz78R58<_;i9}Pc)P|ocA z_mRo$&vWf-q1Sle_hoN%{+o29d^f+?7QKd?N4LRwbS?BzLuYl^Vd5ko^5kp}dU87d zi5)o|cUhhl0Co;ZtItSpG*p)FZ0q0dc98s05xsbIz7x)&T_4GJQsg3aFyGbwF|Jig zhPj>6>UL(hwOAchvn14`M`#)?s!W~`TF;|4qHJAX9)sZAv0;iMC>e7noDf#O93%{E z2Uh^FE1(W?4P>li*C6!a90*2x z5TXT{OGwwS&?EZd5YV%)CQRL6Xw`=XVU{MdCw#WxX-8dzb`oE~d+FT7I30TIDTpc5 z4OK|$!YRI#gAuM``ALL5Fz>8&-f*Zy-mJ-qMe?slP3ZdY7ML*(?ZTx#SON+~oIIMJ z&!N@;L|nW@d9?aw7pKPZNU{YDHdIwf${PW-kN$ELESh@_waF^P=`SML11A;)F&a7f72z;6`DT z@N#SL5g!NxRBj)ma0;P^?yY;S1_?S8UFim`jbd!f%rXNog5~2o_2vkch#I2hz?&mr zPh`0P50FfJkA_(g$6~0+vcd{~;_dz0Lf}5SSX@WDJ3E^53!|n)^Kne;vU)e9g}bDUZ6TS#UO&Y50OgaIH9JG;4qy#G)top_s+e+B;3&r zd9T^MwqY<=OuxM`aW?YgUZE?PnV;lv+l_O=>jy*&G^}!ylk>lCApmU2iHUJ67ve$T zdHIu^XB+seDdJg@n-$kvA^&JmYg`Z}9KaYr5#+eaM23l^{xZpy_{_g)h2@Ibz_vs<;oOJ= zV{lf^wrsU$s(k?mWK<)mBa6g0{-2q4cuz;z{^F;LED@;i4^evXfUy99T_Xq`2q*f~&J ziC+XomUw&+X7BH?cYuTbR9%E_~*AA=`q9G-~q_s3EZsbFE+3%t-1h_im@kOe}K z2G@NYq3DR>o|+~(TQ~zuv+?s=aWuQgUWh=Gj9ThQQa2OJZ7Io$RJln~yQG*)=V{?T zrHB|1`R2aTg+-{*OO^kNMM$L{oT`T1Fs(6J)_V0CeWiadUDQcr$|)u1N$A_;`c>Id zU0fX3LjSvQBvr56ni1KPziPf-%Sh(qXER9Y`^c*EL>j8>4>17M%ezFfn_O?rzQRQx zom^K=$j)OqspJm#{xQRoexDn|$s#N@)uzfF_Onxb?ToA6_o=(IZeyqTT)mmWse6T@D6x=Lw17Ow1Xx+eG0}{q$5kc%hpRqU96EFt82jH>w zEB$f*E2Jpn4^c=zjtq%`8{>e9n1}$>8k*+V6a+-Ujz-ZGlp0a<;N&oW5c{?-P?ch# zeFK2O+`WrZ~Y+SVnUwv`oR#haQdh0T|1 zPEBKJE>~D7D~E$9yBhTKSF?WJd6Ja#zXY6()nh=`{_0pcJ!in+KA0zSln>|;=?vCL zLp>Ra1Hnba{{uqUx~BY)ax6_^8XbTp{wlDSLMf`TH|)><&$v2Jzsth_7&y)U$3ap zxO!z;wNp8yFYeM8gZe_BKv20&mvq(A`XsA2g@ozDy3v`n%VV(X0=}64AjpC%CE-OK zUPdlfT8fK8!bTExIz}@JSx?kE=_IfsFdWCc10^C+&;p)g8{iiqij>NUj>%$VOL;jo z)&uCmcm@kRg*DL`L(n?#1<}SZ;6;>KHPF{<){+0x(P8n1?Unm+ECaYWF9(44H%);9K2IKeD(kFvp!r<4cVnd*`q5M=6ksk{x*tD>xfkoL6WAk%2}O zBs@dpgQplvq>F@F%=e7eooAG55=ZLRgcaU<0u739;_3Js|1A_)d>d5DXst}JR3AU< zZrs0Tgd2AA7l4CW#C)@Cwnah-STq^&Aia&vb1X|k2At%H7KGPSA9j`Mx7Effa*$J^ zXojCDn&!)<@i^kP!`1gDz!ExxY8ywjv;9j6L3qmG>xj?xn51YxT-y^A30Hj=eT-!$ z(l|r41`dOgKoNdZL!_w!r=WxYWI0;qyLbJggBrB-J|B+Z+Tj>CLc8Jyp}$QBt_NzZT;e>;~Xd&i?UlQ zH>Ty{O%|5$_+cc2(?Xgzn%$~cV*CK8ONxSM^8Hp zC6F_Zb$lcrq1+i5!S6wgUHF1(bvtrna;s~Xr>WV$p)DWqaRX`fq|2xe9f0=_Bu0X> zCvQ(pAb_s*E(a4rL0_&K(y!RWYI+NZH3hbZtWVWxHEl`vhN~>o13NkAM=W##0&(5G zGBB#pE_zM+zT6Ab1Y>_l!6FiaZ}Dm}>YtgkXJP8k9fI;-OT=XO;Iu$NWrjrxMHeIC zPG}7_70Jlt;1O^mgmeOdxf5~L;aLg^G9o%|x{}l+_<+8M>I;2DPvsV6V|F@M>rXS} zeTso?OrWvFhmv5$<_i3T*pcd%9dphe|CzEtBNB7ze3yND`5q{22LPn53}5A_-*`>! zKr-LHBO%eaH792ze&{CC1|RYrD0LVZ#o8^drACu7@NzQ}GKKBkCC5io@g5623AkoS5rXttStasLlss7+GBD~ z0pJ1B2r!8130&ncR^1C2ej2tHJClp@P)Hu80|HKP2{3-jpFr6eF(Pb8VhNG;#kE3^ z(iwOF4nXk8OS9$EWA!;zA5%7Hz!*dEI$&G-yt!D@9QsxGa+x4=bH9pYTBfo7|0WFb z6}UHC{;&-<(XFeMd!3WUBo67#Arr!+iHrY+i}1@O=g*lSmHz~Ve8szXq5MtU8!6QL zSGX`!a4dft7bUL369@NzuOXF!^Kt_1VqY-|D9IyuhT_Rb(}Z^}|8&AE?W`diGB^lW z5(7wzu`hJ6u*0NO;16A5o+ve!jGfp5FEbh9vix@hodjuKS~xh+(OltpW)GkGCJz!I z!xN~*+!W2E*aQM%V&n80Lt%(obBsm%U7qWtco9^tFCiXI1;j~Fd5}FdoI53sAzZdn z-qcoh-~iv0DY*z`x(EyYC!W7Ceo_1(h$qoGT$E1%hjzXx+Cjm#$TZF`)}deyuV2g8 zscvWs+qv#X_`A)zIHdG{KS3Ye6pT0$+-TsM{yNhh=r>_mu=I3N?_oISLPMcfn~*1V z3$J_(DnMO_jw;|Kl~j6=+fa)!TofXJ>z)8jm~KhJ+_)id5AM4Fq8N6u-doB(O#Zj@(zUQ3UwqcNNg z{YriPnuO4E(lnEMVKAMcBrxGj%fwwZAQLwt5&egOnkSN+MCg#x^r2iH$qd0!24AAc zFDMnro0z9qaJn8TRAIu4QN$LUN0cYH#v$6u^kEj>czC=ogDeqd;5k=nbDd^C4^JR1 zeaV)tvuwvi%h{*#jK7*3Bv9wZxZ1~s{BdR>tR-zT$Wv~_1hKUHl!*&kZdN?#d(dTq zReeigggN&Pv*hkN_Gt0(6$B>Ab3ot*DM;muaKwnq2GCTGH>prYcZO9;UOmHrxW=Oi zs4AtTfRG2uC+8A`o zKU(z#+{YM)mQS)y`_fzxV@n;-Q+;I^{!y5=Zn)fQSKm!2o(^~RAi4p2d@mERy@wjy z>*dMX*jJU>q6OZLZzje>zpam1xRp8fXZTg8L!ej0i;r;`62!<9pW#~^dO}Gj`K9F+ zDXJ`tNdcG{**ES>ca2qUNJzgt{%^UZygM;wGbQXatJhPGAJ8bimxw}xKWP&_gwlsX zy2R8;`bVq|FDK{?J%Fys?~6uu7u3*BVIV(J37&SzWPW@C+6^cZNtuB&jA25ZAHxL* zBDG5TjNsZ+-XyhV*kmy%7Wod}C;xCs14U+UauJ72L8~iw@SW1WF?9Bls4XcxC6{Mk zBZ5%|6VkYV4q+I;7SuuXj})WRGo*B(?!lXn8CD2DLerqWSBxvdv^~yM{MyAv4i1(& zL(}7d8lxgn+_=1!ic%r**&=Rv{2(7MO{cJf^VWXVAY*^r0D&=s`8<9`B9saFkP4{iz|MD;v~D~7zsnEow?C@%nX;O!E)L4a?&)$P8z?$tGx=h z)r%=pNduGR2j*An6)}$r05P!9hw)EoX`H@A6CT;W0GWZfYkU^JnT}Ac>DT#q6K-X) zROfHj4nLFl0C#PSX)m}5HEJ*(oz4@|mG@ zprh{vbpq@H0TRGNvC=TI5rFnl=HGr!B^iaaLWiz_bc|X!HxHg|sv48TW|F5~XLfY~ zl4k6VHPx}ubWdE16?({oXd@?u4SJ2FHcf}cwU^Q%q6_&BH1Im z8sCLqui5HAXdA{3q};1Novu2o&Ku+{|79eI2t->##`iWT)b~DvuJ~$duTu1!Qruv~ zQ0@n!aNt&Ik@?Cm=;}-WdYr^MzzANzetbvPNw}>Nc_Xrl?9H6KP`*hdn?6P!SqHPE z9;N*!C7^{fY1Z~!$+*c5^2uC=ic9KIiJ(0}0hplwmcgp(Rl)GGoI7tOk!F`@T>12q~XLzw<>el^EZNov* z_TcEV&^^wrMPsJZ=@fzZp6=&T_i$g1n>7-C{}TWIDZvT|p!irQKdj#E>T~XhnbU-U zo8)#e?LjXL+u!VL8b@nzZFDDiufuc5CagQ^G0E}{1_8@qpzp?;ttN6*I@hT9kT2uh zd1JD4tQDGWyV_FdE?v4fSxtO^*S=Lmf1H>Gok!@kd~3PegNYXt`BomU95?Wmer3(r z7GOO&E9INnv3lk8vGC`zW8IZs9e+Ce(0FV4xfDAp?Jre+IUyV>BTKM5{7#?0uzX84 z)%DiegT^=VtuL=#J}YF8J7}07gEykP zl8cXrz|8isNOkKJe3THaghQv03TQ{ZRULqd#+>ir$f;t!wY%JdPv>{ytH-*YLk+>* zpUm%66M(w;PV-o&BQr?WhxTeqicU>xhYOncv{4WT`?PiN;Ql1vff@PzvGCKl=&tnT`>P59+{C57Co5BK01&TvdOUiC4lGF(kq=Ga=YtAbL&7fwH zplMRi;q~Hi1LTv@EEKnqEyrqsi{J%f$x^Ti#FMy0^g&2kGnvu(Ui+4U*YkLNep>$XI2! z5{CF*u~Z-6?Y!LbYc`8WU6DEL_?_Cyvf5_ATUKPS9iPxwHc&HxJ18|k7|s;lCH9ye zJRO~l*`*qi1B#|f*?h?up{6Nn0rd4X=9bOAB+KALAek_%7Yixms74|Q7M*1ka^0Ao z!7I$DBE30I^;9{{{pVEqc~fvw#Qb7IkggXf-q$Cxk3D!DxYNQeoLNjEn8+W#DDtX+ z_{%j%yseH@cBo@q73*1ZrWxwfiB7ZabZbU(x%klKP9wk5%!^5uryr;eX%Vc9DtkK} zI5c<%i1OOypNA3E+iiwvcc05B#QAvUSa*4E-uF0stiwQbTKW2XcRDZTd%@H@t6M2u z!sm)+`TcYvoziYBL7;x11A_B6I_mHI5~Iu#(c9eI=^5X z&3DN*el6c6=kC#I%HJfnDePqS=s<=hN_!%C{V6NHcKV>aDeg7o7G0eVZt}72WV%y$ zAO?egZ%>ox;;}U`K&q~Xz3Zz73CfS~qkvC56&w#iDqw1+Bu(x^$W6WvkcGM_5&@|B z2@IWwq{jtYpT1{6^ zKg#U2%sZg=Gm)!ZP@o@?@$~|9p(jjOlGlvyYmI4nN(avBSXh4)uJCDy68;U|6^Y_{ zM{%|OwSkCAj!Ggw{^M=3X2=Ph^%s1c^_uZX_e-;q-pPUc!=gG%)3>$2)&7ONsO(}_ zxKZEh<4)Df!XZj70okJJT2x=3Ig-d2s!Q*}VP9Dr!NDg4Hmv3a8_h}r!q7Hpw5mq6v4p?rAG0IJ#R|Q`(r7n9MchPd017n-;0x+d2Eka7#snk>#&)n@q^8}k z?7B>1;-FMb%b`VRS}ttd#&%$ga1%pOUOV@OQbsjvX+Rv!mHL6up%1N4N+r#@V!wNM zi|}KU?TwU6qTbi!R*oU`$S5&H7G}eFwAiB9KCV zK?+G<`c3lHBQ=v?Q`qyo8%&08nB=&p*}0%zm8R1}Mtm#q>ln@J0&LF!kP^Lw^13QM#mj`j1e)qt*j&o2|l+i5?{jIAk@WpFFamvNI z8u^Hl%1+-?sEq#}Y%PrdahZ*goGN`Jo?!l!-I9o8gH{S`QLuy}3Veel!r*$f6M>Oz zAkeRPOOHAr7<4Zvn@^L(ohB{%Xm+qpq9Gtx209{6^vX~ti(VO8WI00+ZdemD6j6tj z4jw-VQw1xUp~{3t3mQ*tHgP#=gdZT+5V3Wu4?l8Zu(erE#QBa5vC6a2@v52Vn3halS5op2SAm0XWb3W}ZN1r{eZfA_n1TeBOA*D-JO4!cnU$vnizii#1k~lW-aCO+Vp`KrTEA^^maXK%}!+50Tqp~|0E{lgsvil`xr=h6Q zZ;qMgo!?3)MBYhb$^O6g&ObP=>$>mQ1trUlS0*5dmSNdmA*Q@yM2bHo%9fJ~3lJoh z_^}iK8Kgvsh5*=r1^y^N+EH9<9FN=axSlq)V>@YLdz!>e+@#J5BohA&(j?7{rb#LYWYVOe8;{#gr*S{ubMAfbzTG7SNi%8x2uE7Hci(;Y-5=+k-{)K%?Rwf5 z;$AuDXhD=QbVO0ZvJS!7_Z)`mGkT&6V9@(Vc?_$JnPL7n-w2{#EsWuSZ4W=m=_$QgkUt|^j4Z-tWK%9 ziHI)tJ01_9Q^Y!$)wT-S>tQY88pchPY$ZH|%!y5cd1{!lgM^$m%CS=VW3@6mGjpu2 zTPa4Psj6yLES@%wDp9YZ6~P`Kz5#(=_N24M-EgruL`Jdzb(iPdihcF+>*B?&;o|dg z>nQokJ}JMh4ErNvisVY+klX3)gN>?haK})+_org={$M2ssD-gL1Uk82hy4VoV|Ha~ z_T@2O2_3fP7l4GI#uf-HYodt?lyuft64olNBs__|#Zf}Rn}#nrY0`v<&G+RHuMt-w z1kTn#TP0Iy+!_o#7B2hB5H9G9XJzLlL2K`0Fk z1X}U@?=1#Iv?qCs*x@f(abuv(8T`*CV}|{Wwimu^FC6dkf`8yAy+`hD<2nQzF~D&U zy$I#+ z@QHc@CBKw67%8;5=t3gr0#%9v%~szcC)ukC3ps(&2tQ6Z6LO})LD{|YDTuq~<7v;( zGjU@NK$Lt!$5r_E!28a(8T1xA2`aT7)FHpJ|~^ScWhL#BMORQl(*WSpzncVe62uubKSJin{%C z{M>riW_ERsyUIW#!=`I-6@VO9=9mLgy6vWTn4fDQgHx?7)fP#T7kukp_o1zx{n%>@ z{kG9fsbMY5?XrToe)mL}^XHy}?iG#xh1*vaZY2|4<9I0`C()uy5m9j{1nCK0HhzZu zTQ^Shw@$}ezZh!7BXT~urKAO|KjKe}^85Kx7FR;T*VeCCTuFFM$F!9{V%@&_vE$_r z;KpIySHP^f4j+UwiCQy7E-N712$JGAkQ9x_nPtPnRb^Y)<`?h{_GG{?Kb=sFMJ{22 z>j1YPjLW$uyK$wqKQW|Z(MZQQj|VWs)+3+0y*jE1NlH%qBNH4iJX=5JvEd+1RT!ct ziV(MY2e61+p?u{-iO|o9Q+|U_QD_E&D%YJoIzWAxGzl^yy%$!kF+GAW<-3@ zVc9MJo>S73wu$6pUH&&?&zAo+Jl^jhimdjciaeP#bM;fvhBD@R7bTiC7LyW||B-$3 z+43{~*42NRDbtQ8pM86H`bq!%hy9Or;)@Asac7O;JATYlV?0}~(YZJJw%QoaN6{BX zVFTE4QxE^P{1t1mH_4DuPOf{UeS5a_AG0n#oOiMGwWQ5b%f30ZxN%E|a&@d-+ry_>HlnTonx@+Z24@-@u?1e?6qcI;b9UVA}o%Oh|fu7`kiI_LeF3M0Q7*9QPsVHXM6r2Hn-8t z2j24=K5+m2@~MsL@!*Ws@b4XGbghAgJ3Tf&a$KM8`KQ*t9+AQ@47+9vv@sASviCEI z*7;*&Ezic?nhmx(LVNpe3h{U+H{U#0g`@51dF;8K@#o6p&+Xv9z8$Ze8|=IDRo1*M zto`_M3DLSOHkqiL08oR5Y7T;)Q)^>52S?9MSpdB-Wr3Xm z66Qs$j=ASrIzus0q(AX%@KydHd@zgCqse9kVi(arNQH*Hil233`WO~0g4j(z9GI#H zn5D=PJpg~(u^LcIAw;r&B`6WPA|c*%dWSI+X)wkXA7;Vw8?=2cvGYk=Av6g=Li7Tq zc2xD~7p`o1K@U7bMn`EdrSQCu1=2VWsfohp9y!3c?eG}dmA!Qcqj1om9zt8}O2$L1 zf4GucER-xR=ppQS@dh=9WwFb2n`kZ6JM*5^g_MwZ=MpW1bi>rz1qx;5rkOs1rW4wm zU5lW)hxGw;-BAI``!-RiisQ5+2}y-wA%H+c7Xc!wfW&H&w?(I5Uz^nwX%nNc_idxo z!%a?NPEI#AQmY7wsYgyI_1q+>+#qhzR}D6%ofccXlPePy1Y!o+4CPC7aAp}TfPVV(T zQGbAfK_k?x2|8I%IleM+use~dhruDS$Ujif$6bn{6R0qNw05rb@#f<+`wX9mZAVt6 z3#TrABI65SD%d|hR}I|F;#}otW0FNA$a{%{Ap1XS0+#-(uOREQ=~<(02cu*-dbV%+ z#>VFB&}Z87i7;PAy-Y;oaMZ?^mp|C>Fb2;8b9&?7CG5rHKRHyN7#Ul=VNw>*EH;h& z#wrdOs7kjxeaTY$79aQgFMs^$^qrn>MpD;S`M0`N{^e^_{%p6(AFk(Vj33*0eA(UE ztftL_UA6rX5f6Y3_!+)_X*2W$5orF6k8h2&?k#)zf~kSl8>dRG>fEh;cY3DmF2t|@ zu`$x2{LK&h=dW(;I{tRi&pUp8#aF|ib{w$150F#lShg3LVh=&1+L7uZ;q5@;bYe;o z$|D&1Za)O-j=(M|BRu5by3fES;5unyl1DLkEyQbu7b0$wgLhKdv8ZfoNnvPLr#B>} zhP#B%k}^YHhP`Z$nd{S(%UYoK;@Cu=p!vDZ$ij(5quIUpL2T8otTXq)aqF6}*-oN# zhYrvjUno&z)%+I>i2RT>_Y%JeH7f>}>VP;Uo1(&5aC$kok+Z z-85L9Rtu90S&B1?sWwjI0XyGK1nK}pAWm3t`SO`U>FF2r!sf{-im!*H7>$vkSMP)N z4%RH!)id?GpV_@z2}#KXQ$sIO8+{m>r5u=ssPC@UG>)2$DwNlJ*tOlY>h8zxMqgR; z`Ke9oXm4)Y|I(z9knn(4P=cdABLRUQnBfh(wmhEuymE1cj0ES;k*FXXSR-#LBC?B% z?E2oQx4o7y2A8N2FshTDpp5PCAVr{ia=llo(gdfsSDw|I-g@c=qz;Yli;7lM25F10G`Nr zth~3%3Y3M^AmPKy;BOB=Xz7*D1S4j3eg558FB8?%J2+UIOjmY1TX_2J`PEBH7KZ_R zkPPb@udyTotYDN)T(7UkHn6EjpkW+AG4(e7k|CKB!{x*W(F#0-cngH(6X;D|R73%5 zzHmbs{e88R#0;F;JYvh6772gH5CQjFiFPoY@`Rdc?*I_cXELa80VZcg#3n@Jgx&V!15JfVD#>U{PZ%Z?r4Gm+wo4%sRzkJHYDDgWh%XP%H@-p0!3;?w1{^OY2q9rD)Oj&>N&XL} z{x@G~ku|-S2d`A;Zof_tLVw?#H`t1}Qn&oL-MIguEyLsW&71o6-!$3U`NLCp;lquf{7tg&pRRvq(c9YP9)CM0HV#?A1R12hXR<{q zv0lp!gP-@Uk_6eo|mePeO_!nTWbWGeUqcp z$Kn=@iw^9ZWS#L~Kmg%_SUS8qzy&2}Xd<||=ry%7(aftbR=&UJJYj|=TiPqhTfG8}q$ z1@SV;sA;cjJ881zNIX8(oSWi0$e(IiDGLo9O0L-hu2!C^y-_#{?M?4t0pxF8GQwk^ z`X+@Fe);%jf8!^d^&2zRZ&oqHUm=FrOe4N8es0{sJ!HfQ8olnNmv8Z8uvfc3?p{hV z*r!*%L`VjvP9*{eT&Lg|GrOB+C6)3dogtw6{_2AS1+?WkWp}jIgQMz_85A%sHiuZ+ z{t58!gPpI!?S^!w*p(j)m&n=S3IQ(U301<zg(wDY2vM!ql-`A-DS+Kx_mp6qE|)pq=`Dcd+twBBfx>haAxCqgn#<7L8i$jG_! ziPrw*tF8Y%=`U@(X40Qq`__&n6Wy9D9If>cJ6el|JFs4~OZD9KLC zX-$6mobk-&+9+kdF2G|t-onNyt|snL5aX0{$oni!1i-|C7u}=GPS#drp27NdZ~_Jj zIh+_4CbOaKV+o>8F6>bl<5|TNOWfu{?1n4r_lAWKVKr(j0;$s(`QwWdD5hwgq(d&_<%`pP6;Yu@_0k2P=ope_dbPb=8%_gg>Z{Tp8`k9Z2KZ!Pa^ z-YhDJpfWiw79ZUcM|*f~dL_$i3;3}~--{+xu0N3x3hGa}n)?|oh^5n`sEzQ(L*piF z5)VTWFC#c%*W-3>sx7}^jq%gF=GS~FqwltDr0hhzge}z~!D6yTZ$YFk`TmF*wZFdF z`}Jkt8GpTTTi844c8V355Cl#W+yvkUtH{LJ9T5aUs0;f6A$9_BZ(?-n7=|(dIP_;4 zN}nCz7zh+1yl0(N;#g&lEe^v;yNEU;FsiNL66(oF%0nx7*H~Yd?bl#urSdYK_0V0o zM!aF^t9;vqYK3Wv6QoUqFgth;eV`v4en%_%ecso#3jw#n!m{r<;vu6G!(IfK)W)^`r|eySc0se2bpNd462 z_lW)8oU6BHOTAxcl!l&KURkWTHR0opM_b>d$X{~xN{>8?l?$9`<5tdA@8xtqS zP`wh~iO`kbpwv$02ybp=fpBadE|wvpgaCSDTQWYR@Jc{WkWMjZaAf)99jKnN`8vsL z?ZzFc{1m+OkP9NGezNWtkAA#y{OV7SJ@t*9V^9757h8YAI8gb{jtR&@B8Bue>qN{0 z6!ZA$#vxlu4`-UJi%p4btgqK>psv>HBCpLhv5M%n825LBpv}PcD`?bMeY6%8l~X%Ws@qwr7TJw}wiS9ZA8yEbP}Z z^VfHu4oSf-2p-zq_QirCdnt%gr=Wx1>{7_FkRl;5ov^Kh3d1ZbQTDZI7m-}3a5HUfn@zDIYQ=#v(j7Pm!-h>aB9QNLjgipv}@5;?Kt>iqC z0#iuBJX{xaKu^}wezPRXtvxm_s zL7-PlPc^kKN zw(E$}U;`BF1=u3xDi73%|1w62%Rb8bBn$Jmr!t*kp59bo_vd>tf}67FE?~4_?Sz7+g5i7-I6V39}%V{B5d;ix4M$XC_Hu z5Ue+(#30)Ig`k|%Fb-W%j-7GZ4taQ)mCGon#z~v-s*u0fj!5`jbIAD2#AInQ_vrZQ zBwFC#!;Xj*A{=VZ9*&oVMFL1O3-SwDnD)&a8_{Oo4v+@a5@2-OX!=7SVmXO+K&J96 zKNi#Re{6Z+BTN^k3Y{UT^Bcp#LjA#0`uC3qbZ$spM+^Pe;20CK?~%T=Us?;mBkWB9cf^rrBl!r9AM$!1i%$7ZGejdO55T95QM&jJWVfBBO)j zCrB@aWg-yHcK64BW>1~InhNii4Q}Q3XKLJxtl`-=eWL#GLrR^84*OwwxvD_+1>HYP zq_h=0tT5l`qmj>Tfn-R*8HbMpUD3x554wVj-J9Dy>>en1*vTW~#6(jT1eROA*y5Vq zlmJ|ivuL|$SBh&_+@@Z!FeiWfJ($LU`Vge^3&iNW!Df5pj*VTO8qOy0(bAX5ReN&t z=Ap%5V>)&*@1TtvCp={TYeOIg%AO#4^&|e?<-4pQXMF6^*wQC=z@f+vF}G`AVb|8M zODbE9E}l~{>5F>hLAmtmjo$jTerbHCKcj;a<lp*^7;FugED&CvFOn zDn!sAj=~9fG!1gI_pQx8NSa^-4{4^{EP_`~%)*2mWC1zo2EZD$?I0O^fMR~h0G4?6 z$Z~7A z!08T>Z`yo$xG+$&x~*G+re|#YO;#!i=)W~u`@It;FWqr@8(;bl)?6-oWeqpdhAo2< zT&|Xx={HG584$u@^WYB*q8OlcUP`E=X_q5^dW#v=>amnMm?~+_vAnYNdfS**kBrWY zOgAi05x_2d+iUx|@>4Jqa#fSR?i9zb%*rBzke1yb{HrgB{VG#sNK5t@KHjMcU`zNm z!MoB#!iNe?T3-;O^gd&>TM2-c(U!On;=|Hj>iON+_0YbUB6DSRsd{04;VF)(uck-S zXKC>iXv*PK`daw5_eCFw)?PA^r0s;G>+>dpmZ`8Cgh00q?mdt7K%m?+)WNyrfsw)a z)XEGthY8=$?_5l?2TAE>pWh5a!VECsa*?#NIBhKDP;c9+%yZ1X6MRQHjA3|y#M;R6 z@sg!r$^<<`;fP~kKT9W10W&94Ik--D9(jyDJHIhiw!B4LhlXy*{4NZ+h{(T$dDK+w z7#j9S8HPcjZbroIzMATd_`6z%4W#;)H#P;?&BdR?u7&rXd|1 zb0oXfKKUZ*8V^B^hLeY&pk?$ViOq4}S3eBQg%>rgiB|khjjwKmldPxKgCVDbc5NMF z*aUbMy9Aj^*65^l02f)NoJDx+TNSSz=E7E?t)r3cFsyBe-4!2-ynhbW~cgVGO!|-PdULRyy3sJ(kcEb{|eYCUqeVN-G;@%hB)HhT& zg-Gk|;dab!Vc2Z`uK4*Xe*K!UQtP%w`;2={uef_%U#Zks+<1Mydj^YulAqW&U8hcKa0}A@y9XOKxoEQitvQn}-XUChkR8j*G9N&f(zehJ zkq3|sh#Td7!x1Ra+)0Q%ADlXQ8#+VASo5llQR+G$ZgAz?;>yDO#ii)?S4)4!5SJ8rB0LsZ2uX8(34;~`+lUI($L%aTF)IH9SRmulXsK@ zi_C7A035tOn|SLCUHxcdr~DEA0Ix_l1*tu^Q$l84C(p_g8Knn`2GU0btlnj=40{}H zWC$j96dQ-@8&GOncg=A|#(ZM}>k~@XRgvl54`O(k$8hv~cc^T^96jH`3u!3Enq7WN zDc_MkPENckpDdmFSflr2W3AVYwZ0vW!ZOBBzFh-{}@VlxXdD~vLC)H_7 z7vlNw27qXe>(EJ2D+`b_zR7f7G^BVq(L2bES&8=o9+fFFD|6M1HPJF{@J}T7{SKS!Q)`hoWZ&=hU7R_L~VusvANza(0w~EQhr!#C5 z3_|q@&T7x(dW^H|4(H0<1SA1c?hMjxmQxz%L~N{d<+ic%CyW|>(7)l2Ku^B0$w)~Xj)=NFc^IfofjlN;Vh_!dJ1 z@~hg@9z=@}c&PfQWI^d_pjiZ8V+$O`{f-;d6G^}y?!zW1^FSU|B5<4pB+(HH^~mI; z>}Wudc{++HVS*LZ%8+Vkc@_wi1r;=ePY4&%r63A>B^j1nD4jksJM3APN9xqtAA96e zZNrEzMOnNBM9+?}p0O_hM(|eB#3*x!V_&Xtf7WBnfnkjHyh{uMb#3G6Ih+W=r# zUnygkX~p%}&p8VXk}U1hx4#@`%s;No-Dj})_%F`gXX_pln7hN$q(OlJz!Om)^5%hs zH#-mHiC-T#F!p1k@%*#q?B~pY9rQL(K688NE2IJ};mOzBx%f#_p*&Z9bng3)Tg#`8 z&mAV8f|#+=ZyxU(>YMv}XlFPjZqS-peJ%L2Ik;Lr`(69enL*D@)|TJ-h?o!|Df`cieU6 z_3}NWW8YnGR{Kv5%pD$BIJ`CXYzc40zS1pIcq;b3>rBW}*1T(qgYp(v8gAr2vkN8D zx0^R#e*Fpx)X9~_Mdujpb1Tap0kbtuIOto)H@|Pn-B-7K{^C47w%NaO`YZm14RLF^ z+}C$ov(~#=TkgL+(A*VI1)RHYZvP!WtKWfz{aa7D)5NpiJzF}nr_|i_f4;Rb-`s;% zch|QzPI5sbuWsIh6Vr14##nRD<}aiQw6Ht+uT$6(a#7T2g~9bgM;t1ClW;FbIq1!e9) zd}8x#OigRIxQiU5DoTqH0!5UaVshNkK8Q||TOZ(}>res1dFpYqY)qMiH)@_W1CcthR@a;q;oJ?r4(43-Gg zY^Un*U_qhivvZW`VKoJ&Z4GIo1oj^=nmHAw4H$^U*c|Fpr*!CobS_hHfPvA`q)nI@ zAg`R;>3w+!kCmbN9XmtX z&eca(>wV?&@y1_YzIE*Q;%fElMv%6SKlSxTTYquO(3QLThHkWml+F1GTdB5`KYu>i z@46iSwH3D?&R)YSajbdsyR1zu>tD_7+_)_ye6c$IXsbRpaB}F=i}oQu@Mh~HW9i)( z{@0{=L5LrPfm3?P>G~!) zs?FS!%eFyx*7H#0FFmNPfYhWW@Mspm8bJPJZ*Nb@z|+Hc4MY}h3>@I>z=E4PXABHg zI-oMrn0;#I5v%)Q1nh9x@9kJsnNt?q@;vAi9#@{Vf6yAnpU9iEb_INBkTT#wrSDT0 ztfd*L#%Hyu{AF_W*R+~wfhH=S=$VoFluj&dD}nkt`9Z6cQ!^Gx>6=FYa*4DOKano* zPxdQ}8y&}BqEuRq)ziFcq)k_ zc0^^7NkUOVRvJIJDsVZ0jOaL$@=HCAB=4<(Edz5YC4^effuX({<6dK6io^f07K;yVFOfzx=O)Hd8xq<%9o(hV6p3_lm{ZE zhQ-wHd4T}BET2y@b6P=z*NjHB8SKeqBmA4?#JRuCU{9D!CLwp3cA96}AB8fNeYhr~ zDcI$?p0Vf3W6$m2zrGzWGfKdzON%S6lm6$8osH$M_$!av!*73K{J5`-?bp^fJ&x>4 zt>46Il=|-LmRv)Cj@gCiw4bv7^iq93F~nbb!ri8A2p%%j0`^l%y9~ zY2cR81*rX^&Dv&qWNdU~+*d5qpd7B+{*JnU43Wez1OwrzCQA2ouSvu5wU=ow6)Cd$ zy^a1Sdn}R5zp8)i*`ANDdVrk?b(YQW?L-fKmFS_bj+MU{Vn!a{cy7WlrU9c(_!5PzPj>fm`U?$+84nx0?hk1hS+h4X6{QTMN%KPw0M zV|8)ezU(vGB&Kp_ks2u5J}+cD3HwT!Buv|#@)GjrM^HXDIi z3htJu1Hr&JPUyyVl2$?O!>QQPg_m!-G0^il*XtNWE$kG9m5WRNz=D(MIoCrP<+W1s zB7g-xwd_jdAD+AY0ZPh|Cd1TIINoFTfo73rg1$3XMAibP%zTwqv2$x~veUSMNvyNBL-6 z1JE0a5aYv@(0&8Y&RKGVyEO!*gFnLoNEfq~o2-bowAoG{X$GyfdF+tO488}hD5SB2 z^(-w`lt|e(|gjOKD6H#$w-s#t+4v(UmFc zeW^@QCkA4wy7NV+(MO+%a}a1dS}hs3Ov-d^{Uic^$+l2V670$-?y9?OSi#Uo78OU3 zBl7=lpl|i8g584K(cy#z!%N2CORR7x!bihX{-Kjl%4Aefl@nyT<#1r{E_4R9`?EHe})!+eC6urX6A_c4A)XEc+M$t>V^2$Sm+^@RF{FnG zd_cgV1lYx9SykmRH$Ovj=#fEJhvRDP%o737%hWqD#f*E4;O7PAQbipKWq(mL#23Mq zr(gvg@5m#|EcFY^^XJ~Vw0@5Tn!ab{!qVbCP5{6K%Nd92-s;l3m)4%fBS5DBgp3Us z@Qj<_>ANniU#w!Dih9NMtP<`$aw4t{c7OjU&Iz15Fn>W7t<|RsuaQm#UxC5-wWaFQ z=Py;)FNKTu%%9_9=lxiMB@%m%PM?|`L#K;_1o}+Wm8!lle=gSO=v{R$98iS}FUrU% zLyt&J637ynfHr{ zduw&@#M=3V)%lgP$|yY2z&rcm^7-|p>bvLHR_32v#k6^GdH!NmtA1%+le4z8wEA>) z_hx0H+3^Y6gsP&l{YtA+_?%ppl_ z80QNnvt)E32wyQgOpI2_;HXw990{UlG&WNe5VIC%=br*t@2Sosi|X&{%DN8vxQ8h| zdtqfY0`j^hTVo6#lbT&Hr(OU}=^dyQIBZNkA}w~-RU30ePhrxF={;hhSF#iqk%>Q$ zeZiQshq6{@GIz(|_Gk(m<3F`u@=3VPG6wAt#IumMK@+7e$$f@M3i*3SJj{J@g}k7! zMij-~+bVHi3CD4%WxDID6D!3O3ezLi5!riyOesH1-|4^P_t$}5;9k9>5LL|S$@AS+ z*f3tHke-2LRih)-ebwm^zJ(`9c0H>rD~uNgS`%3*%j!2pAd21ekBb+qXj+P(m+d}2 z>rj|N+B*1H873St0$v$Rg_V!cp@R!Tk?D4dK9hQ4%|?g1BEi;U;52S+)zo!Lfh%bo zes=B5Viuu~sxf>iznTHrVq1z2ber6ny1sFA#E^Bh!WHOx+C~sdr77h)`r~*@3iL=@ zHO$k#O?`Wc=FQvu#qDTRf^-7v>&!#J=#@pkYj-%mPL=E$S45PrwsmGX@&jC8kGRS% z$x)C@UA2&T1+zF0GwiIXAyr zg^ue11ZMrI>ij$BSI!N}DRE@1DM%+s6a--30z{|lBk*s4ehfl?;&_D$d^;eLLKk@O zUXbY0-ghi5Exr#vX?_0e5}(O4A+0T~UpRkmeJOiC`>?`OW1}^8cV)1;`xWg&9DMKk z1>AwuG)CR|1*Mnk=zPp<_qfh;dJjHCOPvi>1|PRJ?D0K5N4R;OonLzj8cdJptBaS; zo_$(xW?l5TiOtulgA0|3t66)kCK1{}kmjW3y|(-A z>h8y@jC}Vi?v5;HZRE%_IS6OwMyCUg311&#ex{b@*JPkBEJ1Z}$Q`Hl+PYT_A}%G6 zaE`YOF5JCJwXWAgh+Wdfyk~i*t_v+X2_**>XQZ=b-dz=}*@!AkBG&h#3USb^bs3kV z0(&}`P2+3Bv`BZZJ;-f=;#UUaVO~}EW1A9F`4#a>IIqvp3Yzo@sS^xUE0{W%}aX;T7HiML1c7vvNGF zU&Fza>u+&7fSGq(I%k{4+4sfsqEIH~0P&y&!M_)QGh9ewH}GKo(htHO&96OO&02^^ zS$^3Fjr6CIbLwKwjVCr2^CNcFl1-1YQ-Vx5L%=jv0gD8oQ(TM#cqqv3<45$BZM?29 zlg@W-HiUuOPpF2K75hd$pi0c95$3b0+(eDpkia3Ca?@U^ts0+#pNJi_d%c{Lb*#er zr6>1h^JwBwx7eO_@(?RrDB~Q8xg)||8babK5#y5F!Y-N|a$xUED~hDq`v&Ea-I>Ym zY;-OZWMwuZc4stF@d8N=ds_I0;2YisGFeD7krev~jGBjvQQ9&>AIf|slGlQ;l9bpk zNba>Rx((88jO9^L7T8nKOT{P23;{gZ?y~QBFYK~9e2RToADM1ekJuk7ckDpnA-z*U zP6~Unv2SKy6DI}qVbjj^T3Q$NN;+Qevh`aYV_Le92vpMKbmQ2V%Wt-?y>W#s*>&=gyOkhESkqUvTp%uR$ zefW{a+tj|_rXpohLLb6gIqVeBHTdbs(mUWEj6Q`3xAp3iORMMKQ>`BrBO-=IlC!cZ zURXPSVQKB+3L^9}nNX<*PqT!c;z@|_vQ#>(LH?<#Xpu>S5F6<<1|7hvXP1!37qeY9 z?U>22O!QB7&TVF_Img(U)f1WnDZTPPOm!&WYJW8zNcPAy4bFxqOnSJAc9wAK!7ZQ? zwWn3mU;a-+wPN``gX5}6(N-;-A_%eZw~T%n3kPSaBKm1i#-)9Tzxj#s0uc_Bp`L>a z*B1IU(>%(2AwERWI*1_qq)0TBW|KH6RTygppZ5+}%n;%gi9;HOVZ#E@AEH^kS{WQ& zT)9|XRG`lKr3*61xl)Oc9HFG%I@Vy82-}{z>ck3gz^(~A> zduVTm%YLmAIHseIOpRDvfe+3G5PQ@X6A)-n4Zix35t6mCHTg_K2gSg|3yNH`Vc+)P zoUY&Q-aM}}9KT-9p=J-ii`Ew*xo?l)0A$U|?2|-Ee zThbe$onsw%{?4U~Rkp(#XPoXEtnl3;UX1Uh2!;6*T~5&_?`5b^P!y1=9rc>rQ!Q2E zr7gJRlfN22tZ7iMk|%*A7%*!3BC^WqSe35;=vn*fz2Eq+Es6#zz>V}I17bsFHvI`& zL%{+vM=gCl*V zUIt(mhMKm)!>s!?+rFBeh|99A#AF3zmG8YgwnK9n9vd3T&`n040WgP$e&|qE0og-p*_jILY2$8z#BLIQvX}%f@TlHM{ds7xuGii)m#Zq}!D8 zi>!a+nieZYG-yWwxni?zNZCXNmp*?i7r^531%qZ>xWugNm*S++v1Ha}bLuI0o)oNy zn0IpnAtOjP7;FV5YYOv)sdP2A4eqJ#9z5Edm}ugUbxgEKZ`f%n-p1&W-GhdLJM4E6 zDE0`&lXyPXPa9!{GzSSH?b?g>wu|$IJj41QlL|yW`f>iGr<)Fg<{Q}-%qqGjIVwDH z6 zHV=|Kf9Bn~yWJV*E0^S}CxQg`0q7I}mSVt=)wss)nOblIUOys{O!g zhJ@>mxnY5)q)W-Lq-=)Xe1fKR3HDaEbvb7z@ualN-e8d;0?D-iGf{ZAiO9>7;(~S{ zK_2@|zg3Z)#^{7v5UJIA1EH=$urKDi%NMN2tk6@iN`6#k0 z>#1o)669uu$pq-qdYC=PaZ)Hs>;=_a2dMPIriHS%O$IlXh9K4sX`BftC}Dy`8D!ch z{OPaMR^80vLB_4LxrP|q+LYW_G*IPoWNLIu>03&{a!#qxiUOxHU4>CA4KVWl1%}L+ zu&~bn^x}S`AQytQh7i467;eLeR4&Nx76_}Cyp$!$uVU7WTz-!yiv=-1<0$=Qn`oIO z4F_ZmYG)R$#jY-JWsg-tpYMZ}7@PwexGE+|*g39?GO@l3q{H(|ddn!tF%bWFlQgoYnU5f*IY0ofV zhXpjL+%XYM0K9>}9&Mo6B!vPYzO0fNNb?%Urkd08-_D*JD!k5fGpk0v~YgP)RK5%Ifxcz90w6R2Ti*42Hi>7RInNHkaHW39wbbO_wkC}z~nl%i# zi>B*XH*~;ibm>7-o{j5yUTKqF+F#Q;xUhq!KN+jPmYK_A|2jtN^-??fcB%pjKDw+s z9S!F)Usk8<>SQch@cIxa|b1B5UFOF&Xz}Qff3_%2BoIiA7t^zAcdYV~dnO*ZjxR!j zG1XxeqiCeqnahH)-3uRfwOLnFb0(C{MDupXJ0c!?;YU61-8GEc39RNYtlZst8@fR^ zC&}~egb3Eul;=cdI9UK{B%3OEGOKP$n2Sr3x9NuMGL!}zLlh-=^|BL zugpSOvOeX4D~);{Nqq{?!eTY8$RCThLGwF722q?!U^Z9J6EL)f$$e>UK^}7L2mo_? zI+$wBPF&_h2Sd4`yV1yCW8rf}#UrK67RB~TnoxSMt9#hJ?i?1hR8_oh+SXT3;vGqyOQkMpEz4mrm zEX*0P>9|R+hilYg}Pw2+kCmt#CE!(sSuQ0yQNGqx1ALb02M*YX3u`o z@=BLQ*7NOr!;y~w^h6ctl>ddps5PL?261v2l{>R1htG~&QV$KEsZY#Mw~gyP;h|z# zM})WGUe)nFo@_|(uNf?@4`_z z6LC#wu{Y%sc^1!k+)DY^PJ4q8@K){v=LlBq&kbkK*!rs*Qct4n)rqwHv`vn?89Hy&Xih54@k#rDbs^#cMa2Z?NDJ|H=4D3SkU4UY)6jd?zz*ydA0*Cqnvmn;(3P2~%2LBJaGSDDZ8@Gr90> zIW&vA<9qb|eC%(Izsx1}nL5w4e(g(kjVac;gnu0XTd{3a;5ZuR@Z5z{3&YPDHE+Hv zqh@YVxz~VwtsTtUnB;8fM6aTFoPn0{n!*w3Q=08;)T6Vvk4e*QErQ~44v{5rp03EY z2G{bZEkL-P3$rFtD|^?mM`RkumyRlyxmaS8EIHMM=j#(leAm5YCbK{!y)?F*yDoR9 zl=<`IyaHt-7{MD#lg|IvA1|>8{FDH>|DZn%Ttp6N87Muk6#9Bx`;=ImFESX|1~)Ys{dQtsAuu2@VD&${Jqt9Pei4tmQ|!#Hp@G z65tE6qiJ!ZBeq47b158#>Ak{peXDrrI{q~{8N%8t{AMg2@FBTQFEEz0YuV{ zz{$b04JZ#{+O=d4`Wc+;pTDtu_OHc6WitSJRgR6=c$6D`*Jeu57wgI&m3!tM1Zv66 zz1%3&=LPuIXKfYT>SM9Hn#cUM`Ve?&JAU=;tL4ty+gP%EmVxoq13j6<*t@R2-rMy! zkBzkZhDSg^i+5eO^F;IdqCCQl^9khqIu79yW4G%OZj)|&MdW_KO)==NHu$!sbC;Hg z20gj7cK!!pSJ#M@3jXOF()1Q`I`MNzKlkb9e*GNQ&jb2-vwq%Et&l%`KbK@- zlgzaD`);HATWjro9w4Z=X}|l&=(CA)_St8j{aAaw*V=m~CJ&~vlYIwMnaRFX_F&H1 zm7laH=Irszq}7wk&Q0bsso9wxYuAjOn6eKA3VXNjq4yGaV{UT7>aj-prk76l#rk9Y zR&?+{bo9VLe~-1N=lH3IA6Y%IQnXH;M5XQjWMX#e!|$6vvvT^(T@Niia$@P^U71tI zmrmUE@JjK-%3}ljhVDACdghVir%tcjb>`Hgr;o3kxr@FtGj(X+dq;ZF#8{vG2z{p? z-x)p7A3ZP->#>$kuecxDzVe|*PM^8sfOYcJ+0yFC2d!0nd77KI(7tu>(Gw@E*~ifO zS@em?)fo8?jJiags%L8hI@=EJ<(A$G0{;g+J9g$dLTCX51sJg-tChU zskwvs+%$dM#-vB-PmKNySO+FXx9^#;qSkEcz=6F9doGde%TLbD=d*qE%3f>6>X&B| z^V8FdeFt;-KCZRbI%vf#fFFJbtgJmfiHkvNZgGY#hWMRqW_EJ!p1#9&W}XU%dHA>( zv8YQj386d8EoNvn-ewxJbNO=*hVU=nRSh35v|dZsrLN=GaA730CpN?{;-gr{fkEp) zHkY5aGgfrK`YDubHc~xE>C|57)xnH?h(`yvX z!+K^$^jwWvvy+oq%*L2?Fbl}Qif{ZZN~1jH8G8tUX* zQ#5%zgVm0WWo?Ej)#^_d+E?r4o$2s;_#uT{`RIBEHu`LpQKNS{scD1!#mEmUExu5m*@KpO({dHIQ zX|2?brSEW;zJJgnOtyeon8~NC=-7zd<0c!mq9cPmO`CyvbZ8(@eK6|X#xSMo=`671 z&u}@|v?R+9RgRL>QNHCt6owLS<{k2AhtfT&&wm*~0O{KEdV9Yu+IY%2M zrmq02vFNY|zN7u#^>EA&1%A-9hN2891E^si2Eqm;BnJz*H8_?Jig5|+PImh)|i#cW_X#Y2~b0Yw(0x8 z+eWE%Ysg@DF0R&}7C^s&!P|P10k+Un>godcTD8Ki>Q=7VX164(H>cW<@8YfXRAF~9 z{N!5bqvg{K`_5zGFC{OPK9)2tCC#_^jh8Y--U)ouT^XzKg}1pg^o`Z+SB3CTw$e+P zLN{N@1}r_kTKT2S#dP)RsZ!UG^Uf1fyDzL={yDBuEbQSe&D$|tZ7D^J`-%hcdbwws zpYua$^^La3mcp*Kwr#oA>eV}TWXz+^Z--yawH}MqN}tTN8u-n%n#Wpe@@D<>h3?h* ztA*~;@$TAZauF%z9<{YylWPxGuiD}Kug0;CEPtbNV_W21JhH;==*;%qPC*Vka_#1^ zcIS6OK=fmq>}_ixHf&8#PLEIKt$}_aFGN*nbH?xp`wqYfr~F8ek+r+ zCkRmhVEQe4c4~eW??-`P^10j`Ej58SQJ4Y19>}7C(ZF6D=oh?f#YO~w#|ENSHkHZX z!}5f7d~{SEMu&zhJCl*l3=Ua~jB@Z7gnpusnl9L>IrIRP@pXk-2$yhAv$F>?hpa&v z9uEyrykMjIGB5s0JW*Z&P#Q?z{5R%P35Nv~WwvJ981}VT23p)_N`Gi`f-~N~0$wc*TZ;HN|LCRQr zq80{*fh_cb+)iK|rftanD93E)=Awa-Bxwh&U&qBshVD|m{b@5?{m$wWwbHq`ZE|5G zZm;rwzzB!c7=TED;b@Js6ZYJ!MI)cf&*WxlKx5WTK!bbj?BZVB_HLh;%+R0-)Mc&E zznEZ003oqr{g!Z7#J$lKL$noo$qa?Uao*=$aq2M7_;M(`-W|8crB7`UV_b?`YH?tO zRKy6E_s0$Oyr>4+1K{)bHnNant$Z+PG@t zckH-PFaJBYq1E%wFNgL-hhosnoYFJ2u8;gR1O`<{^lQx6BD24r4Br2qh#U-P>ovq;! z+SR-yn{`WrPm|^8B~s&G9`oN^V}!zOU%Walkj22VP`(LEb0VC)u61Gkx`Hr7{3IE1 z=lM0gDtl>FG+cIoQDcY%XJ?*?UgFBd@Ry38Ep_qx{3kd(Y7XQzQf*&lw&4xDC*J}E zjvQ+z3LG);n~RvJIGz)xnyb_+|GMP-mKs83hq`bdEvTy|3Ys`}Xzj z+c&z{Okm+^{Yq%h2$;N0Hb&GM2K&7ELy+ms9}Wy`{%~k?(53rB;2bt>WeDu}w4I-_ zXA?;~dkFmW5OyQs8arWIL)i0*Wf+8PA&fteLev_B?67I01K_u%i3w`}SVA>10O5f6 z6rgoHpU|Zc4WtxA4aytf8+>8TPJxLS8*AuXY;?qJIX2QTb<$vJZgLt#5j;4=1JG~1o8UH;PrQlqFc~IOH(BCjd%D8kG<4k2!b8-XpC>I#? zv1fUoN?EEB@IhwqgeXlzB5C1l+qYh-n!emNmgdx=Vry-Z){t z4|xPu=8G6)#igZNh}#j|R=Iw>{8RQPibmLo|M1H||9?{|_qD~tw$oEI?v4Mj(l!3< zRQPjKc=|@scq>)inuN^sL~{3e)cuom#3o)%$r`=e!RQkoW=~Aaxb@=Y>^v>$OC;rGFK3- zS!_hB8hBQljbMPrGDv@h{-I-`z2lBYT>zN^!(Ks2sK!0Q(gQKuu7YsRINmawXHpuL zQTqV8HhY+b3g%*surPnFx-Z#&{Mr)W6MC#41Ads%fl+tTm2#<>G(KeAaU1oAQ4Zd+fUWlsq9*kg zL|ktNscD78+w|Kmz{{@N>z935y`@Gi3M~F)YGRVe8F&ZQPbNt+CH0jH`!mpY3&@i) zOXF{PMU-WKPo+Dcl3KGN^VJHoZ4kSMv@{f!8_KXl3kK7M6M~bL~1&z>i7r3(y%6&#$3xU0q7M?A%K4 zb20zH6a7dqVPk(T>i$gW{uo~>>~4#0=ht%`Oz_a7oyG9y%wwI-O~*QGA1HMl+gZzX zROhAAPJHE9hse9!Z&qNm@=3- z?}En9DD>dZX2`f8FvF{fs?C7JxdqahZsIdVL%?NPy7ql6{I?6co>lGOd&l?eC>6Vo z-_CPL)OZBU*~A3zg<+BY6*D{RQ~eQVdDPwN%>3=gZFaJNjc5&xiJF-TQufo=I8JPoHwB#xoM_E^J&or z@C|o@e2k2+0agq;7Zy@Tuc=smsKiG#C55$E4I&EWU-8jk;JiUZA%(bufc8;0GCa6p z61|my2ihM71F1>$FuF@DI=u+d4ibuHDTm08LKt)qVw6{9kjw`t zCI)fsdU=ok##$G}l@+p!__5wZn&{UAHe z1E(H6S%mg@m<-^+^8;jhk1AlG4o0y6*_EZ!5HtXp?#o2_h5$i(_Vn~v_zzN7#s)Vt z2Piva^(|?K0*~>iH0mQhQIjt$fIX1nDfu# zZV-w&l>N-oiAPtg)iYdIoB}pdQ{x>(p-9Tb`&=F&?{Cb;4T#I4ji&pBt5T1-T|dbzi- z+p&tq5k}(D^rwnOy2Lbzi1rWh|DQQOl_}pUUs=CFzA1l8tA+P))uT0{q}!&$)th%@ zo)PP=qQZo-_X)~2?&t47LOs@6z9*}C^<-`8Q@-yXi-gNVL7Jot%>F{@4U}GO(QC<~ zv~9<*9K z!@0!0u0L6F?#$`xPu84+Qe5sR^dH+<-O6|Jk&os&!7a2!B3^UtxgKdwURrO-S?w>c zU0!C}*4pJ%XwM)NFHNy8?8ZVp1RFK06SD>&h-hjQY_}AG!hyU z1Ljp%5YyFFfP%(IC~9KyjsYt)E02P7&dRsmCBxRK5-B7qGA}P*0rtU}@#_3bakb)*ahne87(dB0ON-aUY0A zz_uNDnT(lt+zX*|&>O14#4#WRR%XSZx6)(`6N?r{;9*1RC3q7Ic?QEVuFm2Pc%h!& z9v~24?L9pf^j3TJEW+}CW_wRBO#4>PDZW5cJ*w;Q4QQYa_gQ@)H$1NQSW9rQT0Oh+ z@EPlatGHZVu^wJJ{Sf@Bmf)`R=)(^`hWFt zQ%n#h76@4{1QGwHreIX_kv|y|>~ZX_BFYae9`+J+cg%G}h4zS}LoW!F-vku;Ff4Re zL8oVzM8Q$*w2O>Sx}UC%+siFA#wW|Bm^+voUv3dUfrYr8m=IR|tI4=s8drju&B%wV zg3CV7)})l;vd4=rsODechR10tWE*m4!D4E5jdafL6g4u^*yQ|780i5XsW7eZifMRD zamv`7XqvvF=qQQM!4gbu)W?-!ce$JncAlC}*J#cQvB}4@mN3fJYfL%W{8L#l$Yjp_ zHkoq)A#pNK{Xw`qY(LEu&NHxS1Lkug{Kd_#NKIMkmd)C7XovGJY(-KkgS9x%<${{o zCn4<03UP6`^1)iNB-BX!vmTTcs(&Re)xwq8n%kOHQ=%C3kqz!1pG`*8n@_G?zDHGy zZ>R=>Gl){GYz#B3kz^FAYxf#HK|TZt{B|(4FbgLqxYoh<$$R7%m!JopXO}r(dnF9e zjsd?0zXouw0_=bq+%mQ&wiVhkDfcg{X!?j51sWr{g>VV~4r1#FmkS|AT|t8x$A_S- zhhM|-(<|`yv`(&kkeO6CJ^_jQONpO_*QW=Z8WNiAPi6}JDtCBEH0;lhhOs~6#quFm zj_mi0=wW+25ud1+U<_58u)R8hg7uhdS=VOuIH8~;;&c-(??@M6Th}|ceEVu7y_xy^ zsao260{=U|3B5cFWDOfj50cP-a3g`gZ&q7L!B~C$D(E%a(S_>r{v+dtYaNFnhYaD^ z+CJ+z{645qTgRL3L;Zm(;>Qj1PbLpoTwIe!`0A|&(BmUp5>?opJ-oJ1j!%?3C%6Eh z&P*vArT-X{pE%K?jOU`MVN95ejO&V(e^&A~db!IrY?4v?MZ&4POSPrhwSZ1(1WHj`~VhKQ@6vNtgpXoL(Ap9O^x?AXyd&G6WyEgowbQq6Z8$^2R<{< zx4>j;^Ski}^s@6Wb=MBKZ~XeErhnsAyrWG2ji2-x!@pN^2fPT+4mO8>p3LETtTyc7 zFp*RLe)J+W`Q+MG;Y|#M8!Ju^Ee5!ggBhUN7)d?|*|37F^ ze=+=})P>T=QpSapc|Ohc>XmQuuQ<5=J1Oj@E`|QNvu@mvRxjO~slS>DKRcD_ernou ze$5uwwDNy1IbT%M<}Uj^uE#^@i8#jRxm(<#C%rWBEDalbe>?p$)_>gWtZuQ5QWwnr z41l`BGQjd3KL3TkJEMW;$+f?Gz=M;xF&=;$7}%kw&^s$?jX;a!y8|Zn-9cfnKMV6h zf-LWT&UzU2fGxl_!2t>CcJG}*c&`O*e}hopXbbru6c6)Rm@2>!`+G3}W>vQVJFBlx zxC6VapTVyd+=cHBLW_4dGU{2xXYVFYn_y3Xvs{ZgofK8b!{d=Kz1E=p=lgXPAWzcXiR~6OPYog*j zR5DfjZR}C_7H}7$@Jn<}^5p0&rLgalMI2OwexT(N$wQbasiMp?LA$lLLYk1W>$EVs z(3KIR>!+ZE!2=BL^C2VDf<33;elGD0?U6+N6ZFG4>nvTl8z;ORs*OKC9#^a`_~G~l z(_h3MH^qgf7I*$4Q5l0>o9kD)y%%@Ibtylp&2SI+8cs)O!1)WZO3}mxK`ja>(iU&h z!TI&VQD~Qx11fP!>Jn?MUjRU9oif3&&$QkNxfQZe=sv_cg zIYfyG^D)6TtGfcOXT9*#46Mh;iJ@uhhmV)SNN)-E3jSm;4xZCzVO7YuEVhi4*?msA zWH}@0q8Tptnn#SqaQVNcH2<>E>8Ms)b$$!2$`ZuACE%%t$6mwKV~gpT1dQ%S5QLpb zk_)?@)Swp&`6^6J%8U^60>q@iJ*FK$uyerKCb$?%VR(bs8NPv5Sg|#Ez6bB=?LP=B zek-pZ_2`Kg*9>A9V^%JoIz)0YDHt`0cCt(2wAcYVc%=`}d$*K!26Nc`` zqO{PWFzr}26S7;LQ^e@ArO0@Z8BnWc%cEaYzt0GhS(6`rT^vCcR2xsFl3kG`03E0t zj!1_m^Rtr{u*gy0nD%?uz?KMWK(`M^VIbM877dFfMV~l_`3D*ltq_MUV8D7}`4@{r z)%hB@pL~Y}#=WoK?e&D*qWHboh(pH}n7?t1eFXuYA7U`&iFplF4| zp{!PsN9=Lo!`!&{`&|$cL=l3A@6$6N+JC90=7{^V7W#^G=B2nY_o(8hbp7&frMBxP^$f)NAIS>n zKJd(H?&kW{HeJ&*gEQV>%hyBnl_>&S%S|~u-41bAba^dV*ahDg^KpOk zwKemkRDVXnh5MD^;8)}$3@ZK}uebV})5F-Q2L~aPJHdYiV4qE5V`#bbC{SjzWpY%Rcz5@-)0vI1wU52^QP~b)8#**&+jCy`l zg{BFB@JH^K$@*G0T;9!>+3xbq(@tlR9Pg(MIFvvG>b3co8PmB~*p;k9_3%;Me&xMt zMJq9V(W@^keQ|@j@DJw~eZv{j(*>I)2hbgB50`JswX1FYCU-8^uKNNHedk-!_gAPt z>mO2MboQa^9mR0@dZXNv>rk&(ZouX0FTR-TP~G6c6VCe`J&JO#YT;O?>cCEPFSpaE zpMw(-uXioiX*%Eb*5mJ9nQDY=hDCfe^jt4-zw~`{EmE_ z+v+s$EtY@7P~V&~S<5D0alT4s1M;?SiipX5nq>0%@fkY>`7j0szIjb{evgtR%u_l? zN!o2*eHJ(ujZ>Ii^9s@)MZ-3Kt{VX3(7b{)&<}U~=Fh1CD9ItrHGi(&hh)?IIln&! zzw_pg`SsCFhsSS^!sSRSa7LjWzfwye+|3_zOCw{OJ?4Il!1x$^`(T1}4oovgAQ^A^ zaCp;(>ATQBY&t^z@GxYvVB0J{5isFh48O@k@F()_rc0|n4bkIDuR~E1e0(s$8l8j< zi!3SOn?gK)dT4{dq~3*>*k%hZof^9G1{vCXOss)|xCMRx<{cYEJZ$i>Z&0N53qA}) zrVMVrmk=7W*|2y%2H^q|Z24e9iP#*r5quW-Dmi2|e+&n13Pad@umjD32k?PcuM9gB zFG3DEP{wVx(7bPAsMov)vYce9LgoO8ITiy8D*#~}(;FAA5u3L_?n0YCW&Rv`5K+{@ z&0lFDqoflg37aq^oGI`GSN&rHK7C+6y5QsF5d_`uYE0k(K}ytUKY+zt^u2B3uTJx0F+%4Ujj$7<&Ca5Dn!;9U`eCL7;5l!XweqogpwN|i$aQ|`*eG`z$B zfQXL*A@l7-NKV7L^JD|&&XYx7Kvn35zyW*!V4RqPfJq@-et3iS)dzjBVAE<|NpK{J ztd(*s%0uC~Ai-10NuB_VWHpLqr=f61DCoh})lq;0l|tzJhdIQT2fu!}^8%&n@Qq?2Jvz1F>fh1 z>x@u!y?}5Cm}MUg8+k5_I2>3gk%n<`3aKc-3xB^9DTZIZRQjlKY0A8qG#6{BYK!w- zzZEc(hCIM*Ds_<}$bGZr=@+GoDzIylDneX!*Yvgp#+ieoKoFcTZx6N@G;h&xviL>n z<$3h-Jd%58;OG@MBxffyIxN(6KcBYiuiD|~(snmx4fqSn8c_ZXe)da9j1%oW0)N^%KxRIy1Vy*+4m!YdTbq%TWrW~|^e5*j{Rz#G9@lqd8?E0g?;xs#au(>= zaa#YsX1f7g(66{+FsLpf_n1l&ukF zQH9s#rx|kdG1_|au}8CF$|2R*ph=sQ!JMX5cIu*G*UMd`p$RJu%X6k-YJrH?KZVOTuc4B`L9E5(XAOyIP)H82Y4fO ze?66JW&Hh(>FTxFQrFuV6B%v(D7)MFn~O(kX#{>^UVbI~rS!$p$I`~dw0R*l#q|k& zL^oy3XPLNd$~*I8T68$jF7gd1KXEmP^}gbc(+sjVhXt@#y0qV7V8Ud5%EQv@ndIgc zxEpHr3$%quOCrL1(sZWv?z}}5W&2;{owpyP%r5UwioVskL$+h(za|y_?|!~!zo?#m zTq$KSdux|}p40(Nw+6r;^8cp$mFV)O!mt43l@U0|p&NxgXCLBJKoH*XS&t>c#v`)< zS-mDCe3x&bAD{6IBCeu$(Ob}LgslTDz77=aFN4H;Ny3;bBV z1WOCsDmW0C{Bkt^`Mm7#NU42&3VxnlUCe$Mi$=WudFV{-`qQcE_g0nNqX{Y|zUg2%6gCC?|=s$1%JH zOmX6mhRy;JD^Fcsg+Tw_iQ$b6JrY@^GXrkOvqu&JzZWn7WquNcU@zIK&TVYSN(Q}G zqY;T%O=K|OWC%JfqT)ft7m|@;ev&-f=g2>Uk_0w5HlqxXKAW4*CwL|3Ua`_7BH#|t z%ZV+3V~wj@t_~RtLGz5u$`Y9<{-$00U{&pJRpB-+^jF{le!Dh@Fmr(;e}$6w(D$jY z`L3IOcAv^b_y$)zETNC(AOC$u=M*`L?ZDTCb~ty3(+nl;#2tLEgsg;}hEa$VItn|t z!(bN*9dCujh~#-!T!wT_QrZT9Mt)Kj7&&7Qhcx(flEgw$LJx8m@fDK?0~eET5MRIp zh@?(w1mwZ14F4(b2?QnY32|ifa!?J56dWi7c$0dRV5(UpbPPbC$HFz2GYdaZPGMhHO%bUaGgyC;c2sf;2TklWU=hbc36~?U(TyJ7|6m z7pt(`ggzD5fypRQ%*wNpc+t6A-8Uv1)6Z{F&$XHB8F}yH5}~FnMcfna1;?4OZ9{te z@>=-a(}u!rrR6QlEo-6QNuW>vA=kP-lacqAw-mp?cn9VuZ|)5E3%NgniR~^#BKYS18*4xM znCcP?tUoMQr%m5e{;~w*A*dvQ6>9Znwrok03I3EfD_}M7&skCvTHYtsxWcqyh}*UJ z8S$GL{>yJU?@=$kreD5MUgj$DA+89K_XzBUkMn}0jkL)X*acg^xd=0#27>2mGO0C> zhux(*FOxehWKV9KJ*o{23(wV7)gpYl_KULKFnNv?thQSvYY5LE{}FJfu>Q>Pp4zkm zh$+=z??S$Y1Pmp6>dg!}q z8E%t@gK7GBd=;iXo_Obj@`3VAzAEM8@seBNaL#S#7JobCyZBA`!*jFFKJOEi+j3nc zzAf1jPJ~dChj>YH%83unAKSThc_GfFSVPcPgeR+*5Fl63IbS#l6y1t2f^tGtn?ZO; zKQxc35Td*$Ur}oexV+wbu*if~2k@-oWGRUeT@B204s zv$b~E=d%fZz3L zw@wl5ZY3-Rw7~~vQ_zV|_DPs{-{d{>kirHq3EoT4P*7${DnLMc)NPvLOZ9}r(6X;L zF|ahqJ2an}pv+n{*LoaCxQt=R!g@mm69Nv1M-9cl=%DC(&69rIia*`L-<1w<5fOCO= zX0GuObgX$i!{TpzMnU=;Ucl^aC>#Z#L-u^PZrmD$o}i&%L#IdKnu(VD;~0f{zp)4` z8@I&68-;J3cQ*pbxN*;nK;>^+Bd|KS+4x7m|4{7pEV2b9 zp-&1J!9J#4Lsi+jy9h^8RMxp}DFs{>_LHdFFr|ZYzc_@BEh1@y-*iF76LeiZHUyA% zKSmamKG;;L$ssi9et1yFt10e`5^fL}=`A>jfx%fAW{y#OE{1)Fzo_GOGX`@LZ+>iK ziiy^<5CbRW&H@ERyM3Y9U3VB!b}&}65aqCBf>?N$Q93=rMMz~vS76{M?vi>#8VveH zr>L_m7@})*Eet2{42+W415|au>gnrqTjP8YkF1=2;M8fH#(={RfQgY7eEuXIuJGW= z)t^NKul}-i>XEanr%obT7+bGtxUg;YET1}k)_nsp#Jv_7<2j!&n);d5B|Sg;tPJHC zrnq68*|2ijq9Ytu&YZy)kSPM0hY?PUPhsQt=F)`pzrL*s?MSo?83f&AO`wu$ptGU!WbCaZuPteW5A#!K)SSq2xkO7 zBT)K-r&rIOT{&qjAu173(u1(u^c-J0`R=nwn1QSwD`*STLj!UTfN*;#<)==sKDc^v z>4fE$KVYGy7}lxh&?#%Fv_dnDw%ny$I{DZKmma$t={YzA+yY4O9PlikdH~%#W1V^I z;pI~&R*#>txU&=QlX1D$h5@t_6#PjdAN|UfW3U&xMLMz#88-kauDmD*P z9NVup5m>^kTH8HWC92z#cAOcb3(m4xxh-KVZxK($a|s=jg&GNiS<4H~UG{4Ib*(;D zVZO_zqx?3XWe#cC{EQM~UJ-6EVU{i-o$TK6RP`#&KH1L|+S_j3mPL5ljzY)tNspOI zBjK#}mb}e0QeEe@P}G@GT|x?4BO_g+1hlU}Yt2gU{#+}MOq8t0BIR3ht>c|$F2Woe zvM5QCTSI86x&{o89G1$`C87v&()>VmZR)lk!f|hFduU`C`pp zzadfHA?1m2U0wrNKbum*ihlduQi~y~yK z+z~%QnNH2}hMk;1#2#1`A8b+r zT2BEM1;^&QgWcG72mcVw*@ADg_9KX&xkfCSdks$%?+tK3`UPo;t1DK3Y*3^=76zR0 z4;ms4fN3(`CHUrY@S*NCc8I*)vTxlD5)4MM@fBVo9j)~ci*P<;H zp8#CO5lAm71@NV*>UJDRaqkg$d@nkGn%RA?^Eb(d>gAt(XenI2^Pwdb)_|PbN08|) z()|)7d&XV*m*4x7hn9S3u5D>+3Q@lFt@8EL=KbO7j?!1AVd<~lLZ7;TP~C59r{913 zOs=(3Uv>U0>-=73_eJNwoG_Q#4CA4tlzc^g2qMAr`QR=FroKr!7#3JO2#Nv;G_3`0 z!q*u2xHPKIN$@h93x_9P`my3Q;VURhwMlrRM>wn8YwF#d)80r9lb z;q}{+qWq|@t36J6*A2<|%hN(OA54IDD

YkP#cQFD8Mu3ji7XZ}2Ht2Jy<`w7mps zj3K4l2&;n&lIK!FV*gw+hqTx{7vQHMIQB7og5ndu+i&GE6F`qG*IkE@L=LfIsh@P#?U00^S>Ip?@!WrHO7_|2lUG7jGp?-*|hvdR+?FU*q~~p??wn()2e< zADcG5F>St`RgK)NFFMr4>pBD0v(m0}kJNmI`{N`wR+9&NRf9WJh1b+?`91uA|G=!> z)de-$$OOY2~AZy!_rY_06FP9kOB)i={t}}6NxiTWXsHTsv}*v7P4w0C%v*2!$k8x z;^OSFC_%j$X=*KWL3iT)HTQdVE53IPzPG$(E%Y3JtXqAoTYW5^>z0O&lz%s)FwCV~ z_pz>8ZYR2mRXw(oy6{%6Yd3o6I6Sa=`EK_kJg9B>$WdqL9ggR>d0{5F>pE8DtI4o3 zb|t$%AJ23@8<(M7$|T}bOgNL0*ncjyJ|lA+PpPgKl|nATK)D{}=HD@B!Ex82S>^FkHURGrC}qlRrNl2U%48AKeoDp zg-~5V=cM~K0zMviI6n!;RpQS_;5i~(v?dWFrAc5d{9p8pOSRWe}nU zHA6nQ(@@!f9zsl?sAvQC*ab*wO&R`dGzo$>+x{OtaRGHB3f&7tZ-2s``}rc+0V zgtGvMnE4b=JrJ8RvGoV%vn(y*IW`^*ld}H#he>%$r)R+z+hp-%78-yXr~$AI+(QM1 z!9gpHLlhuKkp)~|vYYckdp?7GKzxs|6U1NxA3$wH*-LTW9W;kMl%x)qP#E@*P6n3{ zHhL1L9z9VcHH@6gNyWbRVC?TvPm1!=DCyQH&*|xv2axOUHbAM>8Za7n5xYY!$KZK4IO zrY8x4{-^A&`4t@BdVIwq#nB#i$lnj?)$IIKbsjJ!9q{{fa01r`wbaT-5I!rLv8Tr;?0t6r z5R22m(;JK&oU^#m90Ga=^9k^w_X$vl1{((O5?e1QKtT?DRJI+FH&B#k?+y+_k??gb z5Cf0ncu2?=b8sXf(O3yhR_F#KqA_PgwX)u7mw29;A;OGelAu;d+Ou#)aV<`irw2AH z{>o-wj=5m7`Imd;%SOF&gG%(o3#nzb#=gL0qx%Bd5|GEd{xGIwWdIG7oxiBBr1EOk zRq3U8nb@;nDVk*==?Ouq~*#3%=AlX4`1 z@=-3bMg}Js<|9x7cTQpAWrsIpzExLI$dN?ENrnVbh^h4@L=gHVlXCTqi*o_<-1hhc zGpBsh25DIK5!_t0cSS-;hKd_aXtxs|Piw2PiD1=hJf3W`--Q#}sylL#_Jv}V(!ssJ ziwt**&RX2gb$XDp=<7qhVx@PZ{knu8ETXMw)(CbCYY4jzOgMP3siy;)cjcSb zBA4_yPNoQ0y_E+rAMOLPd+%X8;i;1=!WH49XgURe&L040 z3Qq|%O5BpKoDF>7g2~j4Y|^L^1y|6B0Wi*(wdbT_w)k~edAVId4w@x#k-Lx2>IO0} zG?RrhyUv+$$*d9K-A)8rfJ`?+b|UX}eb2dcw&Ic34MNJY6fDw@uL))}OS^$L))xPKSb9nMX?L?R+#d^w&meD$OJZ zzLQ6sKSb^=5_`n{k93TXnmoe@paF^l8UqPTK;&SLungdlHgHrz*x?e9%FdIF=;M4? z#zVR{KL-kq$`Gw^t}w-OF??x{{6GdIigP=dKqW*!WDkSPP8&#a!#KcqblhvOMbvXUB|CM6rpi^ThhSlLR`~+TcABhLC9t&`>0EO zNhEg1M#MIOU6V>?=JF&kdPX;Lt)HYLFEA9^T9gcaZaxp5i1=D?Qs{polbfA9*f@Uz z4Rl;nz#UkQr3lOcx%m>OqTPWZqh}Ap#g|Ok_<>15X42=Y%N(w}fH`|~8|5UQX@NcE zRyjj}XM+E13*jH1A0#_qQB;aG-}al>j&a#VaIj(xLnwbNOlb z#hRpS)TVDh-=q|i%_t!qC!|8^DeViHp1>`l=3Zh>RUka`!U%FvkP3)VSqp#&geRq- zI(0RwX(XMS&H5uky-+`Z@Vh`Gx=;WLapjCWgB&W*9fg(g>v#{c4uK>)o`im$GMd^f zCv{hbZC(>zu1>S^Zn@>9taLGNCJZZb#8t!k81R|r63DnUUfGwZZnNP>(iIW0bh#xi zX0VN?9hQGzS{^664)1E9Z@os~1^k&tp(*uN3SvI*Zc+|m(S(u5nl!UpVmkG92YGed zz_vq99t!sdJEt?0ipvNsFe}Xg8MG^vW>I!9$M{dr&VaC?2{=ZPS=?2|z<-JKZa7@x z5eptf$|;K+jC>3TT$!Mu325E*z89LcQM3rXxfR?59jU;JLNdfwUMwc^p0L)X zjc*{-Q*7WkNrAUdsUEk*yjcDzA78EWJ_YQH*(RL6;+rea`=CIMV91^b>mwMlFt%UA z#`d+#r(tSeyL^J=L@zZ6g-dD?5qcHHxw?WO^fyxE^3m!XE^rpw)fXU(B+1x=fir!5 zkkBM~CnXLhEA%|aFit?b%YdU6j~sXC#1U*omz{(_+Oy|4X<69~vAA+#;hyDhn##ft#SD?-M7kLe}^8 ziY2erpC5lMo|xce{S-eJ?u;lRwuIW+`*cs0RvyLsM1k*a1Rxf7Pc)|42UG(S@e9Zi zss@dnqAw+nAX6=029>6^e#z!cT8s&B13>69-nu3#$knFk2@hK5gV)g&>+Q8T4!dQD zck?9DcK4294ty4CJ)aF&_t8sm^}xS}AffRu{KC}vykvzzY8WKg=3gF=i&XR?M-de% z%ruSS07hZPU$d+4;&qGI&#HBK$>;qPHjL`^!t~hcXeAjPI6^=<(-){Z2|u%e1NINS z80Z6-6M}QRiK~5UF)s_b&&t9)=ALY)aO0ub6DqPZ!g)>vvFnt z%t+uCPz246FR=u5&7Bf#VE-csqWTeaTUof=-T{96o%7~!J3|5^B0VkOX?0V)F-5Bb z-y+XCgXVnxLOz;DzCyiL_&wV~;u-`eooGw42&bK&7R(0L6i0eZWZOy1H*OXVlR>Kc zMP9{K5FdVK_?~r|M>uxtueb^&-+)G?wWg!)k9;AUYo$^i0z4${b6z-MA}gY?1ui=Z z%D4gEqqbcR0OwiACy1rZ>hQ<{p4mBi{+I1Tt&Ig)XSqO0}<5pKM`o*%;`o- zOwd{$75_<@5_p3F@;xt1ivJSBtxD_VTYQt#{n^!s@3zy7V9>r5O`b3>UCb1xeh?h& zL%+9lA+y9^sh1y2tNrk3$7O)Yc6 z{EtW1e)It71r#5`H;o{($bN9M>`+Kas5~JGtgp{AY=i`PF~`%P1THHD7S_jD;rtu% zXS8Q$a|xW&5b!P|>%I5lFwmX*>0z)7?x%-An%yUqfy#X{gxCgOr-r~EcnuCgruN+d zi)yDyGI9G~6R$AE`47Um&3lcG)bv#)%fIg-WO3genEC+4!6|B>dVFFtrF-*g4uEj^ z?!*UxL=?~hl=I{(mu0?=LQ?SRN6{r+D+)5=USsC9>j4rtG9DEU6+te(_dx~S#(<+o zl&H#8Rl=$f6;~1{gBFKGUL3!P_J|be%1~WN+^@$Uk2K+#N8mQvSdR`k-B8AkEkS;p z(vvak%>fsR>5~^h2-&S+V<8wk6iy-njbbR^V~rJt>SS(_UKs+T*H{D{BZ?4G;VD2t zWr@A#q-I2zd@Mg7F0!Ev5=3K}j@t3RI|%ob4fT|sAW#nj-%tSuwDg?l%?Skkf^RC^|^Rg(z}fZiI>`J|+-AM}%xx>?pRrTI?tgNyExUA)3+3 zLOsmjvT;t~txZo*&+Vlr*o^>hc@EEyEFFJn=|PSsd6>*ekDNY*0Hw2!!3P?P`i|;B z4kd2};m>Fadol5&aFA#yB-@k>+MOFUNQ@@H1QDL_d{fDOhI``q#thOtBOf-Wnkv2@ zELVt$$Jh8$#qvs4TqZ?KfGF9-H_4e68=W+aKrN(J1G)fG_05oCrDu4J!6CY-fB=r} zHI`XlyF4M_li$%C>t=r5Z)!hpkC{6q%$zq8Ve3Z0)(!Y5X7}?v9A@bh6=d>B?40oI z?}U|m9jsjW7%=<@YktT^n3cUyx=_VwG0&5g{ zO8ACCM6pDnCn$APRWy95beDeMl!OCv-k&aa(z|a4U#w+{YHTOO$I?Navv zXmNbBmr#?Y;B>~2?@2rCau>EWA;a z?;jbn)n;H|7Q(Ff2vHEK8?Z=xv=rcf0H2(goK56Ytks1@#HAS2h-_p!Ny*nT9OKaK zKtT-C7AycOz`clh?*g4b4*?IdKuvOM3l>1Z!mm%GE{&=WC|X$-kT z5XtpdLk+VH2r<<5{;PO{1yCEISL@Vo1FsHW2<(i2c5T^L8~ z|)A$=wFz@RIz}8;@hVq7fYPLa&$>!~T z8mS2UZoAmU$VJTWgY_gcCThB|_t?)HUByJ1%PI{7P=Q&Iv*=GeN{*ex#rIhI_U#i# z&NJe!8AW_b&m2eKk`8&LcmQFoFd?Wi9a}|*+k?MXrF61AYN8BSpa)G#2(L7-55A5P zX+_JbNiS{VJk|+*I~4H(p5Y!7x-BS}<7CoVKO|}*P`8Ek_sX^C;TFT|cS7y85nz*2 zBvesglYE65)><1oJV*im>zi_M)6<{;sm1pUQ{y3VveY#R=VYZG{I-$-dZXf!*h`Xh z@t6>_&IylCbYt0|)hy+wXS;>wfLuyML+j6f;@|cRyQK+n7E0+KJ z#dP&roNRLhDM1&U?@aB!;QTFPgZgucV)W%D z@)k?1#tQwF(mPf3ve`+ii!@pu2;eHAn{O-jMO#Ps;bLycVRCdILDL9uZ zrt6hgOy^~K=Q$bQ)7+;|&G8T8KISs3{o|GQ=&$SSM#90=pJuG|G5#wqs1f2v2SC~t zA%{@xreTReVvw^NW8martR@p(jI3ucy5`B_8;&P(357N<7aZrI#tg1Kk!J`hOg0Cg zb)bsyId=&fJz#M#hHzX3GhP|wRw1|$RrpPEBasrgjx<(}LJ7gOzz=Xn0BVw4^p%zu zsPAs{2YE~2`SR#VU%mrK9gsgx`^-pvL<#o;BalFXtq+Xc{1vYXzTUiw&p1V`Vt>Fm zNalq8eqe5mG*kv^g)^*BD{O{Fe1?~s*A{C9wTiroVPGP}*9X_SMYl1m7@f^bI%{ns z0X7o3$o1o7JDhKyV!ySdTFFvb41e7ts<5Pl%eS`OYEq6>Y`+Wfw8RH4(uN5CH9_T{ zd(|1f;0ZHcy_yS`TllB`+IaB;(BX!E5uS4l@PhIfcAs1`OR}%{_TJ}VemN1Ix~_H2 z%d>+<_*I4|i=KGHV)(}Gc{BM*4{4hQJmDlElXcpDB#63?JDxCgv6q68B+P>wI6*xZSpmbU@i2vJSdNj}yom@6(3{zsU1f=vIUK&-&x#ky=~-7Jle-DI1vt z$R7Z6p|0U})8chG3Q^vnPDE;Aux)gmw~N!F#Ff z?w#T)D2Zg>cT0$l!FnjV!0`VJuvUAb>48OMBc2a$wl(7M@{JZ@D>;@4(-CF zK3D<@MVvgEo6n-w07P88MR~OPW*4W&b4aoU4K`F&3CbG*wU7RC6fBy14Yw!dXo@+e zV$})Ceb9`L1Hsnsf~VCp&kUfC9DuH%Iq?~RZNDE}IJu9|C74Bh3G<@%IYl^4KjMVO zAQwoRLg2<=l<;zE@DU#f15|DwV{i(ghwiO=t_BG@6kX{Ct&L%9%&;;8FpA~lJN4!$ zmWUdn<-nVxU{7SZ0S}N&e2+$05aZyt5lASFTm+@B@|D5-;!;`|UpCgKqq6<=hrxCD zZ0LM02mlFe2-aC21p<~zME_wdFTKtD$}pH3-((Dfaq{1?BAWX>1b-dRd^-dvq%Xn= z9~%Y?4`sMg(}r_?AeQAgu?Z5*5qPPX4{Hz{o;$gN5P0-_4RY2njw~C5`j)#k2z?7r zH{}V<P^Zxr?&w11i+c5LE;tt(@AlQ?gYiK z_kA-GW0k*zF+x*BLnkTQ9Tc4`&b_CMNB(Y67^CV3$=Y5&$emgGL0)EbMZiP}YowG; zE0Lj)%Z=JOU{3WGKri$qBv9>`?fREtH-ky!&?)K;@s+qIct%(tO!CN_z%J-tW~ntfbruSJf$ z_&$EIrM-l~oVOZs>rZ~t?Z&pLIn9fb{?TN7x32F60P=;s2*oYsn{?SPw1XxssUcM#KUc zfT=SCHzFK9Z%dja=2%^s4{o#KdMo4~EozMm!h{1D11N$VSDDB#kwiKJLe-st>QG5lrdLQ5Yv z@Hb;#%0;HkHhVj`*sfehdl!6nvdFs8TI#z0ZKslJ-Te*c4P=;TM@|hS`e;XTS}?pO zqLgx7Icby`?y8&?k@GpsuD>B?;+7UXGpMY$*oH`Alx-ZpzQ`F>sgQ zP8hATW)wRIYAf-JpvV%B4+`DB9xI>Dk2puOnZSB zdIE9Q?;Nr~DAM4%k0TTvQQXrrBxeg}fN3^u%L<67u{H;yFhm0Qyyd-7M!*K29XeEe)0DSaPVb)HB;mHiTny;M+_4_{ca=Fuf zR%X%Zg~zj0y2UNKUYGqMx6F?f*sxj)OrH-nD2albMQ#AB`Z%o{*lR$-xGW-wJ?Jy` zrg{R#!1n+=wtl65(Ekc4%J@SR(vKrUV&KL&U?L_W0JVmuIW`3WQLv*?GzFzb)I2yj z%pb(Q?F&?;SZLn>U@&*@q7-?l-v(FdGt@!!QBFk4W(B5*Ss2#AxgCM{6Nt?q5(HLG z4V{=MHP{&0pkzWQ)9C?X``JEmfUp}ICm^r{I}Rp~HVXXz5j{mO^bvOovl(P6BwrS( zig#X$PAd z?b$A`Q*r>P_B8I86>7r>WOJTp^H8ge$A8S?v##Eh6|O+(U%e_EGD@62d>e>J=y0W@ z&?@TeJ5o<`QEkV(3QswH&0*KEy(L+_1o{%e5}men38!sk z1X=N>=1O7n<(gB|SenZfR?5iXAj+-={ruIepLd=l<@_%JXJhpkkhQ-$R!+|uFt`uq z$sFYadKjy~8fmB}LvbLui1>d%2wT^bAClZdTy3;8fjIme*7N7^NP#Nk1FB6sC2;rz z!3&5Co0gbG@7argfV9a2oSyZ8QzuTG`XDX+(&-g;X+M7IB&CW441vxd=PIZ4JFp#@ zGy>2eOo3)p1Ce8-pXIJI%c|2DSfRaid=pPK(+Uu1__6an<39c)3yuu*q}YeUNJF-B z2yr^x3N~at?ElGCmSFg;db}EPT#a;ShNMGm^2r9SflCD}xpJer>kT88%H#)O+c^r0Kz!&o$ zm=8Kgh47*dFC!N#EyYD4VIzq;9ithAtS9Q7R03EL7>;A!ffA7@XaUc$4e*N)MM~vF z$7C_GrMw&(>j89OJc9+E!kXxeA!r@=0%Z{2ITbx5PAo=fCopI1Y@U8BqA6Z-%nBz{R@TJC&z4O=jqZCL*$&NgS6`Tz% z&MUNm$Uq|s5}qOQ!BdPS(nUfo=6go#&NIq2i6eDu!V2#_fd<7l@pSx+{}u`?z748n zv{oiqs*j&_H}2mv!VSCm3&24wV!l~6+ajSjESijXklx1TIhLg%15V;Z3&Lxv54%eB z+iK$#ImjtqG{esnP4i{bcpP!t;p%(iU21BXFLpa{RIA=1|I-HNfB6glLF$I2FFs0iqlXAbRV@FIv{gK7%Z zuxVJ8g!2QSQ=Pkq{00JQK62Sbd#+}W?4uk(=uS5)j+*V9u@>4nB$Dk%ZVH}+DgO*j zVTQI$VTQW8-bw*u!r=Wxa`$;`qyLbOggBrB-J|B+Z+Tj>CLc8Jyp}$QBt_NzZT;e> z;~Xd&i?UlQH>Tv`O%|5$_+cc2(^uOzn%`4ccsy0 z8ONxSM^8HpC6F_Zb$lcjq1+i5!S6wgUHF1(bvtrna;s~XXQCvQ(pAb_s*E(a4rL0_&K(y!RWYI+NZH3hbZtWVWxHEl`vhN}$I13NM2 zM=W##0&(5GGBB#pE_zM+zT6Ab1Y>_l!6FiaZ}Dm}>d#NvvoQ5%4?+2_C1Nssa9W_C zGQ%Q;qKlDmC$t8eiezMR@CdjOLOOxK+=)2r@GOM{84(>fT}fyXd_Z4B^@Tp7r*ez3 zF*}{B^`{x~KE=Q`F3{NGLrJh=a|M1v>_~OXjyY$K|4dn+5sA5UzRSM7d=C`10{~K2 zhOcteZ@i{$??$? zc^CuR0NYSb1TTu5cFj9<%(e%H6zb5-*h4-WP0N9xd~ZXY-Lw`*ir_f(gbh^Lkj;{E zqj*h3;jPiE31yRF>|PC|G&@A|P8=fH1EsV5GuML2XZvO8bj487TUsmHni(B7{I)^r-=7H1Zl2G{BJr0iYX!5%Pk6kUq%WkdmKcIfz{LY)fA9DYYPC^ zP=(ci_PCr=0C<2j0t}*h0#`YVRrdmhpN8$l&g7yz6q1MOfPfQR0*s&XCs1}qj0hW& zSVCldajg)fbOs)P0}wp&Qf&G3Sba{_$CM2kFvd{44%pT{Z!Xp}hkg~lTqele+^-^; zmT9d2zj1?n1?~-(KWxKIbn9y6UgxASg+qF?$b>Lu;^M#IBK&g6`Ew>n3=RU8!~l|F>@Z0c_(PYNCrZsFV<)!2%S?v2EdL!rCqbH*77h+{G*>vD z*~6#4$%6#Q@C0fxH%&7sHi3Yc*f_n$a2TT29AnXbm*+YuUIdlvONfV40dZ1P9%4@o z=T3=Z2$!v-H?@@=IKVe)N-jc~F2aKUiRW*eUle}`;z@K47v)pHp`CAvc2KY_GL7?# zbtss_>(}yivK!jMcCPyo{%*4_4lDiNPtZp<1tX3GHyXI6zfQLY`b}6CEIpmndl=5S z&`{{rCgh3T!Ydzx3Q*UfqY8LQC6ylJHq>Ga7ljDmx+g#rrdyIQH*N^rgZnOkD283E z_m;8`lYg)WG0?L40SNM10M_UTAz$Sv+}*etmMqm3Xal%c!BJ?8IawIc^=Ac!$&TrQ zDcK`^chLR$?tnslcZ&Cf@&uy+p5O>4U>e2RXb1-|Q|d?H#9o)*y@gB=3=dN#gIU8$ zeH;8Oq$-wI!9#%ipH(Blxz!Xq@J#Hk$ zYw2-yG=|fmU#YKO6Bl|;nr3n@45l-b1SXtmnYgP4Wa367qW>^Z^F)%92pv+II+V>J znISmJ;7b(w1*HOc6Y~@cPS+!aDol7Wir9kli1Gy2I7C~SKFq=!50Cd{kR`$lJm*Sn zuG8%2;R&RrFWJ&{mhG5mIr}u8@mG_B1nS%vSNph-Kh7+KwWMtZdCHBLAeMHYGI2r6 z&58$o54udSs&6TbFzeo7mfT&(9xXn;g1|(14hY;J1*v=yju?Zo0W{U)O)8Ypone)d zSI;mYuJLFBs!Ay-AmoAa$+-lfCy~$VDxu<~I1j$fZb>fIQq}8`CnPZ;=9c8WwW(^% zj^NCI3#E@57ofC~2DWqjB z*$soppelvek5+vF_c6wy<&&(_zBCua*ir}dR9_i}e-x&z8!q?S)prw$r^B5+h;G0h z-%Ceq@1X|wdU>ig{#B*6Xo0umoAGhcZ|h?gZe@=B8GhC25a<>0;$vKf1TiwjXZRL} zo>0h+Z42Q-TBC8E&a zPuheJq4c4UE-`hI{t>Ig%L#fz51?!E`=XKE1vRu&7|4%Qf~Q>~k(-!=b_2>pQfA-` zW0+9q$8iCINUf4SBe?dIH%YA-HdzdcMZUxL$v<4uK#|#-T*M($(CW$^e5bT;44u6s zYD)@F$>!MCh+ve#gfuRoLl_3I1$7YpBgN=Uo|G=sJ$Umm!wLaNXd2Y_ig87lw#T`O zU%S}I!NF2zXnH(QV^k!H8<*EoQ7R-pTf{9-9OUDr=@fQw-rBDkWbBVyAhwFfFSgnc?ybST4I>PMF5{ zN#j>|wO8S`dNFA#X<(}S!2D{xBIZ#6AO<%2F#ahmjnlVi!Xx_^ATtnmjnCpY-4Uua z{W>3S!mUh|>io^x;b-C>;I54`?FBcXMh(V;+_(JN0E+f=rBkw{6aRpPf)WIa20+V; z=m;ArpBYLAI{IEvC%`TcAOSoSD-9zX0cam({_W>fl2KSIbm$sL$C!n4^WfR0sxe7y zCVA?0W>*&=X~ynYQymLU_r$eWp@&R}CgMt-&x^5Q3gH|F?R9axmU-sCJV|lld2yOD zm++#CWRL7>d>4MbW~&3CZ5TU{a zO3`ylaf1;xa!mk-Tv z3*leAa@Rc1Jp<~IvMBi_=`D6c$+>Y}wjx*JSEv|^cDU>KwY5TPL5{`aO2otwr>-OO zDTk|1SquYv4(EpfZvf(O#a)NTvMK~RXcm>ON9wP(hsdczZEsqU2ZH6E~cLrdv&%3J;`;0PbC3M6AyufWw1U9yd=5 zWs#(PE)u5yXk<8CYhxied_UZv|G@J>+oFsKCp9FgR|Fs~nsq&6Lhk_wYBWfOF#X~D zYL2Cn*d{@Xv`@YVBPJlkBVE#xffNqB z=Z=^;O&GXIZWq%Y^unZZoJuQB1ffj zjfxNXGR~bhrb@?Jq3O1(ErssVrHfP5_y>6HTSfH8iD}SzgkH?Q^z_^e}7j|`;-RxylSap6AYSW9ETr0VitzAB7d?VNT^4jIILiV_W zh6yrwBf2ZO_;?7+Y#)nMw@$-H3DHV8bPB0}cH~;s0hnma`5um(D&|_d%RTsXZYREa ztm`?{5ZwLA+)gzCsGI9Fk99gSgJgYZueK!V)TDN}povc#1#z%XTL%yBPjVfYk>4K= zKaGp-%5P6Rlk1>4`QPHX4pHKjFXcM$U8gGX{EF`$0DjOOJJ^I7o!U7;VRA71`tN~> zT!%&kVUwc5-E5Q{1T;i+5TKx{d9pHU4qpfK!4SCsr=0^RPqJH*?1Mfs9U~MU)PbWO zu#xB_JPq4);tL}ja#v!u4!{WhOeLIFN?CW)p|6{Lgyb&Z2&Pto;@!7KIYO^@dqbu< zcVoGFF)h=6WUB<$+6)8?9m^7?Erb}Mmt0uwU{+dAG;H6ITo1>^6S21Xmh+z*62jkS zcHVFDYe&nsuD+Eqvg+>1Z03{G*=f1s3Y@O_>kzQO>*`br6o;sml-*P$sS_qh1!;)Z zoL35(LCqpT)1;om>&4>+$S0#&C~hNLj@1Ge!3zXkjhYB`x3~T46;y zdYQ<(94~b6%=`jHei6#suwA}GCc0kf))za}#cS%fyr05#Z-X5U(%B7QX?dO+B(uMS zWX9!@@yc!`4Dr2UsXoBldAa4+Y!;EaB6HaBJGGT%watLHtjJ(HKB2E{pk@MhP-=iM zoGH9Z>@hufIyxJ(OEn}16it<~`I0e0O;gkY=<93DEt`EwmcfZYGGSOR7E;JjjYJYG zI?F2Lx-pZ-E6k`Oy*WsfPV80u5;PP6TFYg%%-_|WA}Be&DciAk2HAE*v# z5v;T-dpi|4G}2-nK!zqtdm?%LDJ#Bq`k=fi?lt5VU7ZeY z^0Dq@x>I-{27`caPm}24u{AM3s;-B<>#GL|%8&4)fKNOX91lS%U}~l$P3}X;O}-D1 zg}Nyc0jT*244sFh#|2xTzGR~|fg~|r@Ei@ajTvgzG|$5AQQzz1PSwl8AxbU**`n%NR9~Mt5>FedQ4^o}zAC;q4qKe)8n{@7$Zhjw z!{$fOu{)Gqm^3 zcCcThrrodXx=dmQL8+RSLyOR~T-dmc?Z6n}CWfNCcJ2+OjB3`>fH;~f^#h?pA6lW5 zN}6@We)sSe;m0Q18!4AWy|2lw97E`lUrK+cu?Aw&V&oSu)ESrup?%FqOZh39^_?R7 z4rb;>Acg*d6q3I5o8+rUY9_&^u;+OSB5%S^vcj8%Nc@j z!*Q-c>E+x6|886DiazlXgsyq#O0(Bet=v<#MZ4o{K$!whv75@XYa>W&f*X( z1S=r2;Oxo)WD-GUbNGe#pigk!qP~;7vw?~Q$rW_e%^=yMJEX5>V+xs3<8=6p$}!!& zJ{%_xLdKosqj#?jhIuOdxhd1Gzfo+ofd5%qm_8sRK!hKN{d|f~4slf-09E3hb(f&r zQb%b(C{$j|jRFNU8ywIIPBsqnO^ec0R3i!P43Hpa04S&uND=Y{p;pUVNHXhwsQx@l z0DSvtoPi)%9=8EnOSwg~^=60m1^Yx}3KCc@MHD~p{1feGR-O?oo=`CoP?y`1uW!-! zg?c&Nym&z2ckw?x@7yM&1O#7w>6gdD)e+Z*dVck-AW-#xR>Pg~Erb$!JB$Fl$-FVz~I*t4Jo^$Ve_w6nzNSbN;M>x{rz5DLF@BTRV{66Q_ zSu!2%dfFG_9y#Y|L6k9cSW&~W4#kIFC;A6ro&ke~_xz8`@dw$Y#q#_WEJIXvB#8)H ztQOP&o^{ykpuH~Ei3$R_v3GugF^EqjH~|EB2)^x|rU3~Njtaerm&&E9%?T2X18|WS z7d4o|cpMfeFuTT56s?iUdG??QXIa-Ua8d%E_2!7pijP3z#_KUGv;0WR3yx7jFq(0C zE6p%gr_|g;L>K!Vj|b2xVjawCO9k!quoiI*99zIyph z@#2iX+p&2 z`*Miah$|5SX9qxAB~xhJ5)3>RF8kULF8i0q^HAAuvppfbT73Bng%!?P-k%}T_D9KA z=>r(P)V)1?*H^`m`%ZEk-jCPzXvvZNXxVtnX6)Hx-Or7a6z%cTVtfB`!h3dl>ANWb{k-OWt z4#7qYa2!OhgLy`134Q@A7EiBL=ETf!gTavfpWeb+q_@C;uM8fg9p;~XpVU^Qg_aTN zyhB~Z8b3UAqE<)AFXatJ3T-aBkjS|}m7+ki)wjq=_Nu}{PGB^`j}y*>oT+e7cJF)& z;;#94+B5V_+}HyUC7;l775+W&zVmGcy~R#~i!yjZi7~B2V3AZ8Res=tufa)dgMA1) z{O5mfX;}Mj3%LcIcfL^`)XV&Wo9KZ8b9l!Hcj^FX~%+}YfvY%ik zd#W<9MgWob0}1O$8UY?eo0F9T4Zaj$e{q0Q9I%bUL(q?dO)NCmMHx{u;U1@LqOfwD zi8wx>B>WRXgZiX0u8~0~Tu3ouC19_N3`su`z8kOjh>@OwBu!kZG%PM_z-BVv9`f}y zlb=~pw|3mnkjNw0pUiF6u*I_Xgtmg8y>DI+rl=#fN!uT1BUtO zgkmgm2@_lgxCLQc&NbPME4BTJAsvfGI>vcCfFZUX`P}W*QB6ova^fEz=Xl|n+A)s} z2WhIpAU#opxYav=McfMID<4XPeomb78+?jFGZ0j{?(ES4>O-VSkP+zvuxjLQ<6ZoxQ-8sU67+_Im+oddIB>C!Wbaqjt>hTx8`%Sq9ic zvg`_xu$K;3_uw(OH_HS>x*po)gvk0-V{(FnU6q*!R?}p0H{*BTvIGBakaR8IHzzkT z4@_luFkTGHZu$3|lAg3pBp>VYzaD+Q{IB5geg{!xr5jb`$)uU9pN=+^QQx~L(X6qU zl(75{?VHb+pYgY@{)bZUU_!He5uP2#`x?J)@Ob18Rn-Py&*!9_oNvw$qMKH|q z^+`eyemnN`SrS`5Uvhk^gCD!Cnb&xj#77B>BP8PUQki~t$-dC_S3Uqe;AB*FukZP; zKZwn(H}ZjZ{e}*+lF7$x%p;a^WJMgEHN=)&mwXV_oKshK$j+#-j8%VF~%h*@qQwNTAWuX zqlIt~>HVPDVrvDWdl>l8R85Bd!!Zr_ zAz6ldwR106GE$C1!2pc%a9jvWx%lHi4kohpL4?x$15yB}K|?hMLC>kRF`R>==cX)x zUYN4L&HxGXB38%Tb1j{rm?+Yp_%-+{{}4Wy#p%&xvjVY;=pUp)Lte$tx;}Lb3l>4_ zrXLPW)&0y;WQp#FzinF$sHG4h*}oE$2wjm7Z#uohn29tPV~Y>7VEGN&K9|_}q^%H| zgdib$fl@oFdh`odw!EMRo+hKCG?-F&-pc}M9Ej9J;d751VBB_i4DHI^I)qU;XiyKK zEp{d2A=W=!$t@O278mpocD;Cm8pE>KWx7qY7V4dO&+0--NW6227DBpVYV87rvU1Z* z9YNCx?ai)5P~F4&0J`p|0Ofs~C{)F9+L45$La`7)Afkf+5mi89HObqeQ?ReiYKpXp zQP}&)$kb4SlbDm!jg8bQLSpja6G}ZdK`J+hTl7_fjcKLD7VqTBL`6A8u|;YOtt0}= zOm?8O;R!I`Qr}eH{I;GQT}#u3Nggt<9QU{N0-?vHz7M%ja`Qv(KR6S`4UDqJOdRY^Wa?pXNG$UA74&hZV(0`a3?QwYYkj==IL$u8 zCt}-?Rq4Q~i=W8&0+K?}6Szu1D|J#JUc>E^^YvaSCD>qEY z0-D99k>6OwAp=$EHm5IHYTx4HuK($eKa;-G^{q(iS}Olmr^>&4jmn?vRQY4IJdN>V z>yIzFJDb(Cd9bUNA0pxbus%P-*Dq~`o*)9vzwxQf(dIp6PhT+E*Sur0)U3|l(sR3K z%I-k?dLJ7l9m?PQuz&vQ`p)C;68+ru^UJ;(2DM{=?Y)4UGRLyL$P{}B8r6za4+(Dv z5~mYWiclWG(0BVGP)3y%%Duc4eKp7mi!k zgw3`Sr9;dE--3aV!3(<$xJ>S(%9|C?ym{_S(a<6Gm+KP1^yIOGgkxu`O$;5WMQUzj z7=+AUyzQpI^0Zo*T*y+KQB1XQ8V}g{ZX!?zAOdm1g3FiB6iQFOpcghzPEmY4B*kcq z483|Uw6}l2a$P-ByX%?VyOofXTrdOZMFvJ5f@UcPrXlLPsskFwfQ>4Y5BRVLb`Ml{ zKXw=T$^oCBfhisB&28&nnlus;9`FiEaMWicAn*e-ykXat$8(>TFD{dj;QTof6@&w8 zL{w@R_#j>2#ml}A?_h{A$(W+bIb?rg|2-P{Ii(I z@HPd&6B&<{_f}bfvXB}ie0UlB?Ewfaz4Do0#H_B(y$|bUqI!Ba2Wyk*%8q9XPv1AU za%s`xFn|w|VO`@jmPCLRjIvt}FgQ944dV!k$w&B0hGb3*mlGdEEASBFEfAJZpf`D0 z5e2OI{0(LF_tjDoGjM9-h%IkgB>Wvi1l(87R?+Zs&+Xex0ZBfz=j!euJ?^^oFV$U1 z)%@+Q0k%1efu=#-MK)livpacmW_NJw5gRky)5M0uHL2>}QR95UE2$oc<+3OP)(({r zYLSPh(BqIv{`8E`>~33DpX#5xEN@zC1kN_y!>dGb9ZgaJ-x#goL$F=f&71 z`9GNY-+Zk_)^uO)zfzsO?K(jSy*;yAHx5&PKy7t)xZ)>M}{OuTDKV${tWRUv4 zi6*JUx-B;he%`l`8>W{gc7C|gOQspM@t+$zd;4}w$V3I2jY1llK69N@K$9Uw#2!ca z0B$if0^4l1)`2#rn}oG8zXcXUD&~l>xy24}VRi9+%jYkxNtn8LUaB_sd9nFytr2MU zO^i$(i(4=*IG0|R7s#7H{No7e!r5=bxR7ASg^ z{3i9@p8gv-==qMx9i`I?-Q~}^jfU)g6=nB3wW(;0Z;svhX!F05f~PdO6G!|vaEP;4 z3tG}AHg%Ho*U+k3>e%j$*OGL{R<`-4q=+TKkKJ6prP1d}UwgBpujXmr{C6Sq>t73t zB8<6Xrp&f+QP7=cmsr80kqD#}uQT(T?Mf!hSHjqOBOW#bF@=Sl>*y#R7up@3YRNo9 zY|;@glZ=}7y0()hTaLtIla1L)u7mukmX)&5NTB4JJ>Y8PsoEQbqtM>e9u`3U)+Hl6 z2C8pWIN?{0Z}irG!dbsjWBq0nL;O`@h|M(O`{L)u9Na@joS@O`TzdItPX>Fn^W)B? zB!hi=`OAc4VCqyNfWUPMjxn>lX;xAxPtq9zy6>w#Ku|zSo>O*5OFcNM4w*p#<6?7& zrLCU;|31+ED%@^JXNq0L5`1rt0Wob}d3m1!EBU_LXgdQe5UIz#&*B1$_iifQBvBa#33xWR!0gy+ew=2dOSADgs|^F;Fwqg0P?+&&(XaT+fZu0ux7 z_MLH}%7w!*55~-yx}nMpXQL!L zEvGg4>2t<2n`@(#`MLm)>39npr?{H9M?s8}&LQu!G!Xz33tn`OGCNsIk$DE|+rbGK zDCBTrSeVR)wvQ!(*4sDzq0g^2`pLV zuZL7qj%P`T)>Gm{8hgur#(T;nUTfU)rcX9*`G_w1dQU6Z?f08M<^3C5DGz%JtZy&v zXxt)BEe#^MsG)?F8Th58MVK$ z(*2Dk-x+_serwn}>2``0nGgg{6Wj#g2dl`$*&PuCL8uG+0U>rAac_KN@)(9P0XXz$ z3QC_H;1~!LBD`mvRpMA>jx7$uNxO(PBQUD1;S%b}NXmoDc-L58m+aSIXSwn!o^{b( zxJJBT>8pI(g=&RqiW8(wgfQEGH+`TV9DYawEO8d~Nsd?v0rc7!lA49XMDn!hC-@6* zLAo%rv*|g?RqY1bCXGom`>Ef0)3(XTEdBmRbgp{{uQ`L$PtSl07qYyE#~zXiEzA6=A=o znZLgGbVv$zLGaM(wl5YG*-Jr`It3m4W|u;ag%k;i>4a@1R2XJinWBtYvb10dI#2El z6~>fd$|vM6(ZXF7zuf0agop`pjfdvHl?wfUWjyM>@>YDn;$f*bC= zJ`O#aY=~(3$UYHU6pl<5AtH$sWtwd!P|5=@4QwCBb`ilgq?f}g!6BnY!-xxyBr-ZU zK1+HjEE9onwz@z5Q+w+4)l_)DY;Y^LKU3poWDU>0sS~w_9#rZ)bl4Bc%T)!kFX;Xu zBBib1A%*!yAB}u&3nW7d&NzG==!!mec+eGG?B3SmVRwJQ!%iL#TM7> zrUc-EoJCtjyHZ@c;x_e)g*o}-@53|>)Q2FQUm!;3EjHW3yViGlYB-y~M@wHOSMAA- zn+6w#jOp0Pyn{Bjk9)}e*9Soils!T8>c{=P%XeBs&iL4+v87LLgF}%WVs>ZW{LalG zmsB?E9XzLE(iip0gL3KB9p3u2erbG%Kcj==<lp*^7;FugED&CvFOn zDn!sAj=~9fG!1gI_pQZ0NSa^-4{4^{EP_`~%)*2mWC1zo2EZD$?I0O^fMR~h0G4?6 z$Z~7A z!08T>Z{2uxxG+$&y3Lz|re}2QtyU@t=)cyR`@It;FYUU#g)jYkYc7|)vWDwv!z{?!-6ewC>*q$PU{AMaEJuqAw( z;9Y4V;X{QctuKgCdY>`ctpq^JXiHoO@nLB%_53dEdT3uvk-5CGSiLYe{}jj6SJR{E zv$S{$H05wAeJy<3`=Sp-YcH8d(sshp^?4IP%T(A6LZDj)_pZmfAW-fZ>fl`Rz{ucy zYGnqSLxk_=cP^&cgQRq$$8UxpVFs9Rxk%bsoHmwnsJCrZ<~e5H3BDt3#xOiUVr^vk zc*#;QWr7}}aKtgNpQV$hfSHr299*Y6k32@7o!^)$TiznBLqj)Yeiw#ZMC4z=JZdVo z4Gwvv48tZPB4{>><96alTr9ccyK*HQ&LFImtysG%;AWZ*al*btacX5!D`+kX(~u61 zIg;IKpL`K@jfWsd!^uNX&@yt8#OAo~s~-mD!i$>LL@R!~##b}KN!C;A!JyMYyS9!o zYyv!sU4l#{Yjn~&fQu|s&LX_y9g5cub78B{($UCv7}hq#ZVNBWt_vxva&JQ$3Ih}v z*jO?zyOueHbKm+? zLZtbwa64+ZFl;t|SNwbxzkb7Lsd?*yea5|}m)*Utr&OvhtiL(maroZZP2Qv4UP#W; z{PyDupBoMjkGOu-FgB=9v#o8CB~Utm)3WF~b^zR*rpI(_2pCgnaBPI5&!ywFL#xIg zIJK8EhbQ;Kp1~rZh=v@Enk zN*1T$Cl)4TN?O#5(uslC^ak2XTrRDi0N1PYW zS69w+N`#t2Ck|RgM?SqYx3U6&*prJ(%WGa&bsm)Z96y_9rmGaEC&NASfhy*~5AKuC zRYeLQ)mfTb(^;g?)DnLjtDzGQ(=NhcJMB}-@Xim4BNC6PEBBn%g6b0&0X*Hc8J}rM4jL~Tg{H|(89@)$Gq&jWs zLOdVd01(YF9Xcs$WdU-=H<|8>h7=DcdIz~NEAd`n+&wqhz7K>O`L`=&c2+ZpEO}+1 zu231A=89WOd}44HUw+V`ZoE2Rl7|MV{BZjdSnC?;lA8#zxbFyybmf3R?bV#HR_?}> z5*Ky-))R{EfA0yS6W?^2k4p8#RW}B+b>VH;8x}Q-MKhSLm?1Y&(lh4h9b$6w=?vQh zgHUapv)VJc9^)*#!?|)d0ZD+AJA-ta<&?%b5gRRCxplPstWl$n7#NP0@TE4GqHBE-5-(rYB zepP!~gJ=-~4^hPCY=I-V-*JO_A_@4zeb@wL9>}9g1dfw{BsxN&9-f$x z9StZlPe&0YOt6Al8Bz@`&j5k4pn`_*3E@Jz6hvXKB*T&mrBg>{hCJ)?aE)5~V~>2Q zZ5Yv|D2um%=-Cn0)Al962;NGX7-bG|?8_DI&w7kGFpSZjcZfltu5CO$hw}<~8vqRJ zD`o65t+*chIcK3klBIp-wpZhf`Nx&ndkq#J|HavRZQWx6b9Y#pFeoqpcp~aU-qtt& zHs^sn@$2IT#(r!xo`2Sy{haBugWmeeXKpKfl~jNwJoy?s7M?Q|$_wR3XaCM|Yx&gi z*~8>h5HnW#&Eq|TJ+pro?F^^H^;8M)qG3CTiD=rYpSQz+vs2R#4;Re7a-ln?M?66Y`huY!(I3uRzKX>b?2Ek z%lD9ueQ&K%?LFByd$@1@@aE|ACA<}TN;gm9so4GAGa*Y^1xU)}Wii}U!{M(^_JulgG{#LcC0 zPtUE5f$oigrQXYZjh*pSz}b6e_wV{y{r1i8-+aoQCZ7M^+0vOkrN++x{q6O+#vZh~ zJHNetk_#GnedBJNn3j6iM;m)KerdURxpZcqDp2*F#=de{Rqt%s$8?k=CXySdRAD4!X4{(H;PTQFgN^Pd_wJ?9=9{~$PS%s#+a z2WAic^z8mC{o@<2o;_%bGBG|^2nJ_J#_556D>k9Ny`8b-dj7hW`d3`WgvagB=B0k)vFx-zr{UdeA!Q05NA zhv1i!mk%KgXSWAom0^9tUd9Q<)UbP1KGcv}`73K)uo549Xx`;f;`ZlaO2E3lUsgZ)jePa;Fw8xfiS` zZ!%-+&(2-A9VdAFOyv{<>ckt+{^D_lJb*8gZWTMvEz(i{Gc^+wI8M#fI3W>iLWCk` zDUBwp8{@v*%Qw|U8(pw*DIVO2gBFwvXE$=Hge$-dF{lC4Lxl{{o0Qv%-6f-gwM97E zs5Q7d7^Xb{z3bwQWDG(TZio+_!}4@I+2vU%AFFM=+E~fv(dDb_H`}HC81iTys4a9~ z+1A|C*L`!{Kl(X|KjGsD|hw`ZnuV%&G`visg{&Ke?HOc zx*Y$t6}KPGUc)PKv~kmWtxYZKU(N1VzcnO$u{!=}vo_jya_}D?&) z*Q9wth#!H0Q+mm%+9|f0q9JNWECqvPZXD#zB#~4}xkp5djFWUV;Ly|<2*H$tS`c_P z1xXn4!p2zmm_=Ts-;$;{b_MV_2w{keYTYBMi*;`;k``GTIeS$hzFOI0nPTGt5=N(m zvzhcGs$w34Xw3D#9P&6Oe5Q^^u4M#qR2#kyL1}H(Bisz0450l;a)J65*fyQ^g2>0!JEBJV6CXJ6!g9J62WZl!cZ&4?2a%m1nIVw1)8~@+Pfa0UsKq40urK`_u(% zX-2B?S#2nPnOyxfttMKaiOMH>dbl>J6H8l4puSFi&?@EBj73uV=3#(bBCW(vqzn9$ z{R-oTN8t%rLNZfGZfHoNBBjU?ZU>_=UPhVZ?|28)5DKEaH<2WXNG2qy-8>4OO5%te zQCVb?P?V6B#t*IvTuvY(I*z3LN{=JSduw3Jz+6fRq1LmY=>)uOjRKaHG$+KJL7n#$ zwIks7X{FQ*I-4KK^QGdC8#u5?3yX%fk>%g zG4*?1Ab>8*=abBwR?y%zqfspedotMw|7JOH?rSmF6Xudh$Q`Dg=9%_Kp-g2Tu8C+0 zc6p&|^o8>13)}dwXWOfc5^(C$!m{h6|5<%Ued(+I%A@x1J6{|-?ki*awfQZNBl~jm zH?bP!`hzq?sIZ0Q(ja@ctU4MsLNK@q{`*?&D6<5IhawvtU}H*#5DDAz_#PS|=|xr= zxMg$!YQJc+wwWFt9T^_;70WazhpV=~qb?vrBry!ZKzOo&(mma4(y)B}Rhmmhifnv; zz4ys3OXTt|YoC0+>r*QpU}r*|Wixyi(L-M&dgyDTz)JhqD+y}7M9f|2!9WX>I#W&#&{x7Ju-<`PGZ4`&ZAOm4p1T znz(LX_USDWQ@OK94U}!4m$IFNeWgqirtM653HkFQt2yk#s~CRFltRE{7KA37jle7g zcT3cPU|<|4bYm+?tDyGbRBY+O%QtQh^nBL!ItEemJ49jS;?mnU?__$`^^it+t(3e7 zV1Z9Bxf1z@XKy>XV7TGb3tjaW%Jmnv@gIo6&0GdyOV;+L%lzRceE^c_>grIwWbp2) zo$%O;X8V-4@C^pCR>xWhJtgl&l9h0FC+QCD`{Zfz_JHQ^+6&FE$&!i9-(#Y5WTGuP zqBZcyu~1XSD8MTsb3~C=Ij-XiFo*tv()ENw;|>8GL~Nw(SZKB`D}?FQJCeXrJ{s2m z^oAnD_;4k(U&pg^h8*E;4MFMP&u{?J#f;@9E21rJw$n!%L91;ZJLEEh?|~}{Y3yJ< zi%g7UI4MKfvh8?~oC?{C@ffwpwU|@TMD5hj2;Y-e1xORMJ`(qUiNj&+Gk3`ag79>* z7~rPNjS23!>2L{~6l(j}cK3&US`E9FW5JYLv~?T5d{&61G$sgRv2Q`+hvLrY$P{(I zQl_XK12I*d`J&V4qff*+2(%romW*2_WxBS00)f9|TPP<9c4ZWI#oacnVDRG$iX+Go z`F}Iew|Z8=Zo%#7aKeJ&C1da2As&j({d0@Xbz1iMLAbR~ zVfnh>@6o;fdWV3qB{$34Y??YY)S>#1+T?7aTCw?R{yqF@tt~?+<@MXgqOR56c03dC z9N#_YF}xurrg&p>@281CsU1NswTBu0$njne`&{xrg9|^teD(7)_O_Y-Q34K+Pg#V^ z0fd`O3?dAEx^U>94s?xzh}qZT2@5DxB9_AR;47;TPlo~R&`8O#r=_{e_(X&l(nAD3 zAmC5}>|(R5s`8kdpP@PQ$e^pkakX~li2&$j>YbQk#=S-G^8$0Jq7H?!zbG2wi(t!B zu!4?vyt8V)g0s zm#S-*!o~aN&hfGHek{Qvi9JWAPR)#>)5SpoeJ1KkRiB?b7i+ZjuDTZvs6vJpW#p8h zN2I}~DELtFP%gm_rDaTpX%`3fU^%SxuU(uww=lQ5P+eV|Kfk&F>qN4Vxp{1JYfO^+ zOD^rrVk44S!An~!zyD3m4$_G7>?oLuY7po*+_IBZIvr@@J%IB!UpuT_{;o}rcR+3d*KRxQSf!V1g+&6Ps{@r2)d2)QCWslSPefIK%3|ZKqw;%6joLMcVkZJIlE>)3c>i1Eg)nC;(6ai6yYg>xIeYM5Z!9Fo+A zalT+OOGX!h@D;} z8^$XY(ld~(YGk;&uR1l%x9|kXu4i;*h4I2bYdkAuS^cI6M6sLxaq)r`O-m8>{t{8ID#L*Djntx3<{U zlJ^>5pQ;VR39^Y|IQtXF`4WQ&7^yH8SfTz8fQ}dUzI$6f&yJ*s{`PP z{_5`6w9nNC)-K>!q^2cXY7XP?%aSr-elObWjKaR|`^)#^ZdKLDiH~fUUyd2I1`{7w1-G>MpE7wSUlEu=W}R zRSmW-B`|f4w+zDEQA@S1*F(r=(#5=Id8Z&e2IC!}MQ5ty(Bdq4w#>V$8PryoMC|xS z6)d4y>o6`yD)zKLo5nYWX^|FQyP4Yp?@;NF$AVSiv~5aEd050y;p9I&P)+#h)`0&?1LHteMEE~AzL{K9L6Hf_Z#Rh8+B@fF?y z**JlQM{|s>U&H2<>u+&7fSGq+I%k{41%ZY0qID)O0r4Oh!M_)QeO%mPH}GKY(htID z&87Q5>_O|J_6$lLd7Vz8OspL zd?k|Cg4mOk*e*!!wJy31a&n9cQc)HnRMAVtC&>%}JlXED?|ComvO08%eOMcwYE+Nd zA1b%)K;a?1Q$gYid$PW7dS3%~2Q+I_&OTd$81+ipV(+r`TfS#nx{y*-a_Ln4*r-c_ zwy(W$1wYw#uME}3W}ww3E}B=hbqrC+MIcoYiz!$RPb{1vmg`6m7HZnPxMVfX53o#N zL4%Ppf~uhvzaM$%;rb(L-)~dlG%2AE;jJ8Y3g{aAbY$_}@DE0xLaf|c^~uGR^Y5?L zj*1ZxYa|(5`57;)p1-iTdT|+He2JW@)Pp-(MC0)!#CJ)`A=V)OR8_RdI^pD(Nr(r$Jw_e4oK_)#P!j7S1DtuJ~I9kxe&_GG7QHQAiKM%s#0k4W-#6PDrW7TESVq8)h{Gi$&s)26Wi4 z0Q3iGRfVvv%o%Ona`LBDe=Cgt7`Pisi{&TwSYr(qwu%Ts?fxf&KTq z{oq~th;4lf$k86!+vfZ~PzfB<(T698EkeNuX9I{mYKblgG-v=0{o!HKzOps>OkGFL zAPxwMTt{Nx_AsB0-|pNzuQTOQxl!p~0=T6oymal_^&OB1}eaf z^dtjfLuNMp30gx{12RX%YsYR%d=eWW&^=y)?&D>GVC>U-#MI+cN+`1+C7Zg+^l0r! zV|K6icOVBx`bxbFz$~COZG(qd_XlkIYIY(n%eE4e6_8cF_wpza&1HCOXe2{F(YsQo zj?^c$8cbbupDTPC?#|GWtyR$%<5FkhHTN3&i3p6c%YqmA+L2A*BVM2qx>oy+2F zj2zkBZz#CU5*UGEk5D`*>|_135mrcZkRZ~Iy=ZN_IB&=^tp717Q{?R*=T92HsW521 zk!``OqU)ri>J+Dw)j5F>!smsj-UAAy)w6T1TR_}MS_2nMpJ03AK^2Tn`lg&!^mhcF zKd~TD(qcG5o1kIyAQ^YXl!L}!!a^NrdAj@ib>@k-eNcgETtSJ@qS-X)N>5mg+~2;D zlc-#Sa2AiC>$IB_K*`X%`#}em&@iX2A&oc;IYTSPFT<;q0t;EV30Srb@kZ9#onfMq zISM6-Hn(6T2)t%U-R_th7I;#+lnhJC`smFkXj+$GZ*^Ojvv#IWO1tb07AYc-TnjLr zr~%UJq`06RNRY=q({EK|@i97~sT8TzdIO=ZLa;C9TF{rQ5v|ZtP=mI8y8X*QEU6}y zKr-t_SVlU{iL1$;(G_^9V^A`2g`3tGm+I7vzM+|PHllGO|g3=mO2*mCvQoT*J zX&S~+o=izME?g=iT&+m670xnlAYU1}&&FVI!`jH45n)j_78aFGLa^2lqL&N9Ef|r?1^L}VYW0$rvLyLc%)gP#@9~VXAm(Qr zrN3+wEd!_FfUH67%)(YJFalZDNJz9X3AsA8(yC8w@mvT#74%sK?2xJ|>g zRwQ0Vw8=cRIKc=|{R;yD^GL0y_l_vP$>hV~I;?#>oiD&m*e{7DFrHN%(|HgBqZn0Gu)kb-cXNTwf98_MDl!SU@$cmhZ%92(Py7A%|d|cyuh!rhHaibot8Ne zDc`~XaU~Ds{Lp~M>V*&GlNK2!Q4!RT!*Ry*8ky*7E2Z{t^0N-BtAuf(w=b~^SjmqG-fJ}oWcSCo3qu_V?Bd=LXq z+zkpdkkEX1o2+r0BP~xf7z=>nW*YcgM}pjSAbnc)5-Qaoc9@1eKy; zJ`i5*%iLC-6h`BG%WLiS{5Erbf)gSMhAui0jb=WO!z(wRy9{_;<9p>A=JTYF#u-Y! z-HQ1;dCz!yXU|-$Z?mN)mD?tQ34qJ+*P}Hxo1{=66q;2sQ)^!1*kof$KIPeSL#o$# zZU)-xJQpCiApatj^0lnDbwZ8E;(MJYBqrz2olazfK%v38liAy1{?jq$*5j;-!*4PV zDiHsbx6)Q6wJ`Gut8LtW`mNOTe9cOMX$bsY1a3cWBW)~^0b^SO_C-_MxpXK#GMk8k zNjtvM*2m1&ea#vM+(jdJtQ$IDH9GVlDbL3BBCoW_L9MT89b9a}W{`~4U&{>dv43r& z^?IpAek)Z01s`43owkN^=`pL*adk3gFL_~L!u+1h``82w`!SINVFK2Tyq;*&d7f}b zGMnl=TyrvONxfCk=@5AVB^j&4^GpWGdqA0NAkzBPC(#GeA^&VqFi9Yg8ZW13 z*X~&5757ZsbPcbD1Y@ehDn?~Vv9qZKv%MESuPH?%Squ<5dJY7 zm{u{~FRsqZ*RB--V7M=K#!i9elnFz*p}WysVPoNQMHMEc%ofG=N}A-lzoVnsJ?>@} z^j%f_c-#>s{Yr3^QoFXa$=n%k$oZjS?}LF@>mAmXedHbxd$hw-N3?xaZHm}$ly}ov z4)K269&mzKJa=&whoAn~RsVE6m?>4;I5H||L)CU$=NZS#=z8dBdviI;U>NPHk61R~ zOJnPkqNNTE<{I*?v{;xk;^mQ()^L($#tM^jEyep?nQC4z+iAYs`(i6y(NqXZuH90m z;@ip!2!M*9WwU2LX?dl?BJ259zTwD60D7Vdbjp*%VbmJXW`j66jLI?E6V_+PK&gj@ z&(tSosME&vp72odwIh(J_MMBpC-^Gi$LYSA($EZ~e=aOW)(`$l)`M_LnyA;uf@dhX-Gn${wS+*QUC*|{G zi-3|=%&*Q4jhiyMgK1vTkImLdFG}t>3pAZ0DM0iVGY2%>t`ul+bkY`rH*(GaW?af9 zqvjb%*f=|)-{^ncA8{=2$5l);%R2O{4OPhjBj}as!q#WYVA)?JX)G2@w^D{qzZf7_ zb2Dk2PAzY-xP?5$Uh+b2$TjO4>*#aXadcY*Jpn_<88ZHxr!NM-Ip#<>_D)ltK7J`v zu09BZh`uFlSTXZ19F;Q>*Mt^(Q_huV@xjMIm4B_YHwYmwrEj@esbEENlqa1(%yi|t zJ4@_2ycxXsQL+HQLj_~XsjM4u`($t$)4#_WGFnSARd9?BAJNz}T?C$WXs>0IZH=|J zMPuy7BMihaKVdu`gOv|q_M-Fm7djBfe0Y2_L zQ8vRY)%kN(;({&^OEJGnYWZnm)Z^z^&rC1@A05NruHrrOfg6sugWlpqNON!VgSRpP zPfLsB!dE;7UefqD7rrgmXmNLZkG`Le{mt>0IoCc@P2|Oyl^{QN=PBOKg%Qr@HWbeFBLW zytm9`7Ko&m#+Gv@=+2Zff1aG7pbQDa_*H4r`QQ5EC6*N+B|z?p=nn%Ikpo&r%e9&r zYgHsY*7r&a0Sa6yUv8&WLUH8ceG%3x`!vSQ0Y5SwV&?s{)?JP@W>Cx4iQ0#x3;hyh z4X=6Lc{7*}p`BwndVgDjbICy~1;SvK^vx7iAiFF|gL0cBG={ zUBh~8p_Ky6$?pN4+1_UqkuUoHg~doDtrwr3d|>IW&zrDP+xoDXFV6WbD%QbhLT5t0 zMb;ys>=tuf;@VGXQ#3-jCRLlpB55 zW=heQ8x#os`+hFT49SmPAuB3B_mNbY^EnRgKe(U0%6_Z-A251j1poj5 diff --git a/sources/FILEPKG.LCOM.~9~ b/sources/FILEPKG.LCOM.~9~ deleted file mode 100644 index db587672f0033f19aba5f811c30614bed3a07b1c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 102722 zcmdqKdw5&dbtj5*KufY?(I7?BGEK|Jw5^D8C=np|Qc@d-ASHkV0U9I)QkJcd0&Oss zC0CN0xYOL)c{FK~P8&P6Whb^%CwA>5b`AmJj`eUbop$Elna)glr_)Ja(?^m?Z+oXx z+$1yY{l44i{?=N1p9cskZrbnuG5T!coPGA$XFt|n@3r=x@ri@!>_p$ebY`M2ojsVd zcI7AR@i}`eGhy|lvvU*qOnP>v$J#YxC#UQ~fx_PHd+5C+-k6&hw|cDMzUigYeX;&n zzZH!ih{X>K^!HeMdXArZ_>t8UD@E(nNmSbYPsV4bKK#Dov7**&`oMv`Nqa7t>dQ~e&F8ay^vYgq#_E@6r&V8Yq&5H+7lb(7x7W7<3QXxkj>?%?Ti&2uzm_9n~hWt zQaZI)dUY^kAEMF4t-Uk(TykP!9OIgun5D9TjlG{ygZ)XTYDmw_u%4?CYj$EHi`f{p z4rT!vR#YasVbY>e9`lSnhkZ=dqp`*w_gbMp+_F_oVxjdgPuD4$Jf6X7$HuZY!<1_E zrwi??_43Zi@Ot8yM7oYg zYK7L-;=8C;&HrLsB>a9VEbQ!RYr87L&9rkr>+9jE_OJTuuJY4bsU1t-;VylD+#)Qt zfLWNyr>*Gdu-xM&8?~atah|5lz&tuQ5U3uHdbcr5sd_pK3^_4tMWch>V>FI^GCN`C zlc^bOjk!gF@yzU;H9F+4H9Tk?_3yO(nOtrvowedI>(Im;ZIqb40<6ZOLmv2!^n2Gs zF+cG6LDL$HGNcTkhJ6^w8jz5j&*vwyb7&AV6193BSRy3d1Jpfi^&Hp^G}~|WtQ1$z z5&}J2S^6s;@U~HE-5N3&o{OvXrv=b& zVDPryWPmO7l)AbAzE-WUtGbnIw%IMI>doo)$bXP`eeBo{G41HsD`&A+QldbeprqIn-vH?qvuU393b8)hI z^;D_r$a&|9sofXWF8>_YC>HkcmgemkuC|mS#(l+sM7`WI&CmIvwE9L{WJ_UJTido= zYxU|KJ2K``=eNVJ=30+MYNb!+S`GZ>TFqmvHF>lC`9k+<{nbKu>3DbTGr5SAa*x{D zuF18Bt5@xC{#WBzN0z@)xv?$sE*@Foc64TYZl@rJ9l3V%SiAE(At3tEP4>1m5F4_l zC#J_H^437VkQbsVv^isVgnb9#1XKZ8*4a8beHf$wODya_0Ou2Gm45qQdM6XryS*v;W(Fx^?TK0#7zVP?3vxS-ahSFt z`=cDQotujWMv|f(w0<2Irx?0R_4cRDaP>Q@Pt;2161K^Ok%Ya<`vD^yQeyxj1%{(F z&W_u2vlfkfEUG%1kEX|2<>blm2_3H}45b={##GU8Y^s4NoRnc(S0Y;4> z5}ciRCV{)hO})zcg?;pb`$nhfekC~)LhJ5k_>f!|!jM8&b3 zFx6b8UisH0=eN`lDm&DL3o0FYBpw3R`y}Q6D`guFp@-iC#eB^QieTlgNc- z_)z|SAl?N=ytfN&U$oOg*B9$=rqTgKTZ))=!jz}L!{1K`%aUhg%ot=93<{*m;L1Z- z)et_^u)TcX1%_8cAt>`^KnS>ZVGz?YG9+t)iFB6)6TET4d>`@%tjrg2&x%W%Y$0w( za9id2vGPyZpC}q(Bk{v81O5L^sod9=2-{9i(YQD9!%ElKvs2;EP2uSqMdPh>b!!ST z(-W!P=TY}hCL=cSYD(7V-3~^d_%M5Xd@e`ZcJ^*huco=@pH!vB{2S@i7{W=X=957H zc=HorKzEs8rSHkl3NKk>z8Ny-HeNq;mt>3F7(^cE3sSj)Xw4uyD6JXKYO@gx&{*R1 zXYe077TP=Rc+>@uDKP96l!R*B!z?`zv+XJf=Zxbmvw0?^VHvd#plh>-S*Tzx);Qi; z-KuBA)gOYtW`)PCBu!!e<|ooX3O;;E_&9%PBAtaq2y`$QfKIULTHy#1;0j|d`uH&u zDs#z`u!;6$z}lP4Wg$WVOZI^#jb|qEePa*^(%D0-mlV}dg8~y91V}EZz-*#P++1z4 zQ3Fc)+bed3bh-1{ap--fu|Uz5aL6dJ0;DYx;zgM2T4lAyd{@UrXn z`ek2MZ>dp>0*gPH9-km`2Ht`7lPQu+NqyzQ{tWcp0`jEH()gQR5oOumQ|S()Diti=LdRNJPMprQ z9^b`V?*2kg!OFGgBBFA7GfVfS!Y;Y36)cZ%{BqH_Ku-(1PJ}0~Ypnr?{`HzU0A&%^ zsY43*1?Y^3ab<8JMqPa+_z}X?-z$}`=hx7;t}dlrc5bEjxtRapiGC!Qu(3ZEb$_OG ze~d2`cDF^h^Xs_|CV1%4&SLm;=CMxaremG850tu&?X2ZGs`FB5C%$s5L*!lVH!Cn& z`5{jc|6#O43XC1OPJUD`-cACUHd*3{@aCJ&#HFtz2kd!l!{%)Z|6BAYCH_)YN9TGqA@o!KZhsayb1ltO*18$Pm4ByZ@3fWV`PL4uwu};u#iG} zO~vvlpfS^5ldU`DU2dOJ#gPWNHlpV5qmaGS09gemEc|=q(X$pz`Dbw#hhh$8KeKe=(G_d;4A&Kh zfQ{7DC8R=+8hMuCCQJ)vVFT#`k!)(U#aeCTdV&lBv&uweW3t*zqM1q(8D=K)Cnmw7 zsE0EHHKS}qjr{?ch4hvKGQjkc=oW(vYmbl3lf@je?}o9W6gEzmE*pQcL+Em>#Un6+ zZ%dah7WP)-LNml%dWp#dSKNTOm0IUH=ZsQ|iHKJ(_ZD_LR?#@ZNL-r!RMD6$F-;<( z{X_i!XUYWp&x+oQkJVDA_cC1rGE|EBiI+JB0AWMj%Iu#hjEzLStgUyy^;Ky1EKb&=?6tO)TCq zV1;JoQIO9085l0$i3DjFm@96LO##$N?H-59L@o*8EzZ&oh(haERkJPd_)8vHomph6Nbu(YdYAhTDKhJZQagQG6>h(kr? z+n{~{3kw7F#HkOKR!*-#+cad|u^q+-{8%8u1J)h)foKG5+kuzKn0d#&5IW=DP!%SQ z0V%LDD+axlCS#abv^We88&WU9n_$p07>;sv7I(l4_4M`tfdFgo>9L@<+Oua7mj5%` zdwOBow|Y+T1)AznU59T#19iC1>I1pqalOY{I&s2UJ-hPo8S8_qxLjVb9$q^A5d5l^ z;I8!O!w)}(_u)Q}Oyx-JGDjq25N={0TsnCc{!Z4JrN=CpA#yrcT0ZqNE7pUjdV*q? zrV;;8vDSxVAwv77dvZ<8Fs<;4X?RO<%GjJ}n!cjwD2dR)5=?E> z$CY7sxttDmo|;bAXwD0<$;Y&oFv`|zOgY*7(^)XcWX}CInR5Xl2{KRpLAX3*Kg|@* zGq7m`=5r$aCCsi!O))jO~eS zg)f4X`*gC@HLWogU&|oI;At>wN*Kqvw3cNk7lPe!&CKZlP zK;r&V;%DLY=>eyPgl7AbnL@wH9bOU*`}3n=?9W88e2A4J`#mFi*d9wJ#_J^*L)9j1 zuMVSNJ?2{0wOKtuDCmed-Gs|KCX2AG>z!M^eKj($MBB%cS=tXMs$+aInO{Q;U z_QpFK4dA|2T8*gLq5+bFLFvNzboFLNp7({T<6;#5f6$`-V)#qx3#E^xjSFe>{3O?_ zSH8)=;^6x4q_CU16#D1Rx^X{Ry>xG;{%R)t>{O=vscF;sHCtTM%KyFOd{IrCyX^P4 z9uJ`>5*VN7ZgGpA^wRjVG;Hks?exo7|8cXky2Un1T`>DI0O}6Q0Lypy{1^W2j0T=3 z*Z%GS4^9%sSO9KdV27SU@2sdb3@wuH4w%??2Zh1@EX)f@vb_5_>mk$wwgB4%2PCN5 zy?5g9UJKg(;!xjc3wa!hhxsf_6<~<{y%+$qs@s5_)z>H7fnCQcz_+kLL;Ml5G&p%_ij;NAEIk0q$+JCx z+1_gnVEzL(WwP||h29OEzH3b;Z$^|s!@*otR9ml!it|v(RPDF1N8ww*U5LUj(KX4F zqqCI4zE2i$P!alpmP;fLVWy;tGS39<*4_$fLdvew!stR*MvShXf)WM~Fu2c$j8F^q zoPztgY9N9iai|FUTrI6Bh)vD4y2!cQ}> z9v>%$rmY`7UJ4_h9`?=xZG%*y4{ zhe$3a1!D$oIe9xX%bXQg+L8iWq&i z6d5Zr18UW5dGu@Q_ZeX_Yx2XdizCQ_YU8PNswPr!r)C{QzRZKuZj2Z7Wh?c;fW>;AugimtEV1#Cmk2o_kRip08G=J zE#^Bn`YUsPa~KP*EN1eZ+Wg6LKIrQX`u^k0{+su~6-{6s${Z5Ok90l(Cjf;#F#+ec zKxyD(|7=CSzyK?rFYJiso7vAR`?~K)JPyxkyK=BdvLQsn1iY@RThr#E^FxU=sh5A) z)_+xkjHXAz=O$Gle3dR{s#_7?aUY^PE|Jl6I+6g8g4j^s{Z8;epxSdDjLhcqz`M+X zq^|ZoRwN4c16yVqp+@Xw1!b)77G|NwZ$U2|TpcJy8%x0aTw&XIp6x=eNKexi3Wbcs zCyT;TlY!!Y5M-gJO;LvHr`7ziyWac(T5l*N7!%_PC|cogD63WE5qn(tFgNb~eiwuU zQH09{Z8YvH%khK#5DKpFxN zlcHM@>(nSL9jc|(UU1%LB8*@}IV9A}`}B;IZ$}l~+D=^^&IR4)aD$kj@!5MF`0#{DgM$#to!~zax9!7T+giE#qMlay5Mnt21IGX1F6$R+K88(w2d#7G z{T=$6{s^?GPkNsz-+=~Y0gMl;F2metDDWb4V@daZMm;~OLem65_#^krWPL3gF7M{c zY=8_1gT)jOkn~>`K+4dibbrzw%zSqLrAw=+zgNzPLeM_=oe0 zzTph&>4MFY1L%&mhs!tR+SRsxlRKAd*L{J9zVj{V`zzF+^$)2rI{VP|j$*icy;1JT zb*R@XH{f#h7hlYEsBZA!3FrNe9!0rVwQ#IcbzmpDm)mL7&%ud^*SnVMG@WmI>+yF_ zlp=*)=q4bsyL^4B%?JR`4(HpG=O%#%{-|J8zE#*=`5pN5Od@?i`NeDj*@{2nDsn5T4(lC;~r`YdoR8mBP3<`twp ziiU0eTsHv5p?L*qpdaq|&7V^PP?AHKYyMol56PzabAEpme&@{}^Xns<4v*g+fyZ&0N53qA})ro=bjO9+kGY*;)Wak#() zTRxanA~uI@1fK=IN)B1gAH#v0!Voqe>_Bti0es-qE5i=Oi;zPOlyRFaH1C@j>NW3y zEGL<&kU2nNj>W*j3P2dg^u~p2#O5uKyU^xOnLmdfL=<&!^H*BPDCq=A!X^v}X9_&Q zRsZOKPaoKiF8DZk1VQ(^8WVUxkP@2jZ zqaX*VTt1&h8XA`IN745Dq0FM(KrQJ?|Dym5S4TOD&vBIzxV^E4)*69?p{^iU;2~q2 z5pds1gG+jFerFg%wr6H0vg2}#wTH%1uF0hX0Z$Xt@QIs)&I3KrH?#1fLkQNs*?rKr zK^p>Q8zAtRjy@reV0`4m-HUMv<_=R}P)040p?G5Q@)HdBl{ zRx_7}n-ORS?}`{S+4#<(EQCNEC4~uAsvHWKa#t><;UxwDM0^wonQtdTavIW|CmS$# zo-FzTszNse4&Va-GK@YC3jshI06hh}m%&S7?oRU1?FP1--$TKgte!_k_F^}{#k;E+2LyC2M z%7%7sPWZg??RgT7p2{ccAIT?vxc=V5vuy}{Ev9dNvX*`#-PMk_@~ibX0<}KR?pjD$_4R+4@F|+20+}^Zd0&XYo z2sU&Jmst#-D=H@S6$!4YrOXBAyYMgAOcEzFh>v5Bc}uxjXN0Qj1%yMuEcnT=NJRl&`1_?uG5qqS(npO;Q|85#xmZhATb%Fut$>+H$OFu#QWq(L+&5dE zeo?xp0=qV;BE(g9O>bLZoH;lO1i=aO_F#)a^A-)KieIE&o<}dwBe{nLj$Uy?a&|(a z!$Mv6^OJV{RXhCLq}@$f1O9@t29$q;pZyY|)a?3K?eJ4mb~i;u{NJVW>(W5Y`6Ao_ zt~B)&<3xLpz@N4bkeLrFLDB8IgHCf(VA1T0o&lvef#a&)ET<5XXynyq`Mh87)Ej7@ z6q4ZA)@Gz+86o%~{mFSse?l{)$MqfAM(a1rJBTWwoCP{|oYw!Z*=_(A^ee6y3~J4v zGg|_uljcvEw!`tH`BQ!u#JtH<0b$^|CeN?|=uKJ$Wov|4RN-~`X@=Z?zO-KN%uYUy7$|8=M>x;4WIXWj$t0B@x3ucvdZjK9AzUA;D2>Uuk4 zBBRY8Wp_J&bMZ)R5`mwXmtP5gY4T#}W0S_kN%KN_it7{lh;GW5&oXh_ly~OGwCHf4 zUE~{3e&T8n>wU!?rx|2#4hvwfbZNiEz=X;Al!v9)GpWrja5vQK7ibHSmPCa2l<7?C z-Fb^B%J#p?J8wTonO)wW5`C+4hiu2ne@!X;-~D{eeo;OBxKheu_SP={JgEbkZViAx zQUj zOyoZ7x;|l%_{h0NCYwMDF#;Xl8ZxlZ7WlDz36>VNRd66O`Q>Q-^Lg3f zky88m6#P89x|sbi7L7#x^U#^v^{3O-@2xuDAwd2E;V^_x=@C~kbSVAAm zKmPlS&M9&f+kvkO?Qrf6PcoFW6L;{v60#C@8b%>f=qT*m4uf4Nbi5T7Ba-J`aT(Gz zNogAZ8o5bXVC0NJ9Ma&^NfHZ12|dVN#8*rn3|vgUL3{xZAd)(z5s(M3GW@5!ClHjp zC&ZD_%Rx0LQgEOU;7#gLf~jVa&@ljk9t-E}f=mWuod5!^!Lq?IWF~!ZQO3{aJnZx) zr5w0{y1;Xk^@6V;#5Ji28L~+!da2$*pY(Gm2?Eh@6fxn2Zj+zaSZ*#w4oONz%-dP& zBZ41-1t7%SCc-W->A`21{9r*G-WyyyfE)xbV0`_+dRPi5E}$2f!Cu?2V^u)+%z_H< zmTgJ_FXY#O;j0OzEQN#@8NX8^QO(XU?!XqthVC0fo>57xD!rufkyD6oGgC4(-~J~b z5sff7n;JerTU<-h)BqkQ?lo>joke|uadN)3CDg)u&Q?yC%i=W!8%;~0 z8?oEl>QA27_QZ*66kj>Jb<%)0)+8JzCr$J1ZM2LCNH@3%+ zoh177A9AhhGZ}e*c}wvNjCWvuGJaUOBZ*&gc?%Dy(wpQ* z9)e1eSfN&LX3Lf|ndDD-vjSEF|C}W?q2+y2jVnwWhPYjepAo;A;lKQr^B(omYx?CI zEg^7wJB-7a@*98t7*60x}9SQb2}mUz!T(Hmmd1AT87)?;b59Ro>+yck0;*w zpnRZwldnqoc%tN1IGl6axy9d3`7VAF{_xzav(NiP<+fZ`iEm4`gcBjuqdg}Fpy8k{aO)J&?pDHLKpT8uHVvKl zM4yC-_f6b04=HQ_liFF^~T3J z){HD55I?iIIVzdp5m6bqWh$^nIZ*)RCMS7OJsu@12{;${XXY9oLC2cMGc5kbXB4Er z;RVdzhQbj5I%Lmx>&C4S=m{DMHgtLfu9;}bKaLTo_Zy4AvT;j1yb<`;d3VE*j2rjN zFjW4wH4LkRn~8rI{2wKdecbl%pzM*lKPZ@VeDhtHB^4Qy`njA!v?uX+# zUQKallyHNS71_ozgm^nu9xfu2x{-TcC%^1v0y!o+_DJELaLJXXgI|~#P?e>LY zcimw`*}+)NLX^Xj31Z=0M(Okf7a^4yU4en4xJ&8{X)x#)oubaNV2G~KwJ@B(GcZbG z4^Y(stEaEeZH@CqJhF27fm5e(5(5rH047FS@cEN;u)>2USAP}}y!y-5sYlMPo;rzW zVQjso;lj4nvwZ6GS@#XZ5cgVSjOTp9XzFKHm-PJXvoe%pnBsU(h18gf51XZF|1S1p;OjU zX@zDQZMjRibn>weEI}}opdLvq zCgXCg4FhN=Dfp8_KKhj{$6zmXi*#fgGHw7;VA;b0 z>;yAL7o26Ya$C|^-Xflg=aM=m3pJ7kvz8Z}yX@8a>so!R!hDxaNBM0&%N)|O`57g~ zydvCS(kxvFQOQeX^e`w71>5EsOB99fgkPQyw!liG;J-Tk4GEuS~i;20uSpu^5QUHzvmF<&MOOgM7QnJ7+mmjVL*l zJ5q{3o?OK_19zlJ(FVRqlJJoa%yfE|H|)eXBKE+l_+XO~(0U56C^$CX9qh)wJNSoa z&K7)|wI4zJ%r#=s+-rEEcyE9M(l1C$TwSpOWP>90u`u9_f6x$d08EqdF2OgKgAaAD zu|xDV0G=*|Hba3$H>8W9Un0_!EUSm|I5DE6x1w|M56y$l#1`O1c zZDTt%PCgTgv(YdJ&Ot0{>N$G?06Dg7GtAHmSx-MuFApKbdm++hZ<&O6ITbPPXB5+! z<;7q8d^Qc6SoPZJQrA&fzm7P6G`;(h^S2Kz;h32HcrDsO@d?0X9D($bQUG6?s&2=D z6!#v1$M>T1rpAYV0VCtKsgJFTigP$CNXuegy<2___y8t~`6tE+C;o_}S=^JlPSFcOs`fFT&E%YzKUz+|#>0{HzH>SfnEx(5!@E@49ySku8yIe}YILRexDmlM) zxiE=8c{Q@HjE7&~r{mpE^Y6#_uU0nwFSTT4hcG%^&NKITDXCAix%FD4#)PJ-onh&y zGk~1*9Y}$Nob(+?q>03tCbDJbI@OUbTnkw>k&|B8ieaMp9|>{xSd^gNj5M_tx}ZDp z{+jzeyA|KN2H#uWvKD%dKh~{2)~!C4$aPCYN6NpOQ5fb@uKQS5Ew>Y0#i}0LNnLm= z*R>lxbQ~U7y?nR(5gybweB`Jz_zuVO+q^L2+;ttR^3_yW8M{*5pHF1EpH0ZnE@hI5 zDJGmLN$fwDUZ0UUPNY@Wi%KDvWT0G+a`W#PwBbtA>}Y^Qu3g%5?%_xY8<|{N`2*#< z@l0P2G}}A2`nbO%xmHz(MReT83Fi9z)!uP)?M=R+_Uzh^;HCmeS7$8)2S=VVeC}62 z7z}+0=XSXq1zV@CAc3nZh|uZ^x(#&&Z4nSHr-2>?MOLM5>!j6DW$@{gs}Tevs4KLs za^w?spM}y!Wj>%=IIVg)rbpmDpwh6B*Q$CSysumh!yj8+!9u96pmWlF8wMW_Je;3^ z<0|pz!|)stE?Sd_VRGYytDim#2ih1)na@Wa4WY-vgOQ+rl#@WjAoL3&hK`b$8%mI= z9}U9UlN!?~d=T!<0r_AMY?r@3ahelI&zMQoLsDoeJ|FoZ$iqr~mfTrsdemp*@Ud_o z;WLe75}v35aRF?Vjv~Pt>nYW1gW<{KK{F;7-~;6X0zK239NFH{cl9Afw1!DT3LVcd z)PVep0n+af6g5N zLJTHrs5sJeEGW60>68!f=V$jnltF_=YYtTxLfGM-Fr7X^B%B36#LTC0>VepliLF04 zpJizg&$01nn3VO;KTOJ7Iz0=%*d~i7v(NzCKn;Lx;2tV43=Udp9HIa@iY(yzlHHsS z+VdIg1LAvxogfAq_yB4n%3g}|?w~pBp(J&i!Db%CCA{k`987g9Y~#Ij_?Y)JhD%aqS$iZ5UYL|bCCpaHc||XmoZAz{SDATo#Ny4I!os?w9#8R|?}dd@z1ovd zT<_v%xLvNZSUjhWO{%52fd7DnCnuDn67~Sw3b`nHH|(QJwhTf_v(V1~<^#x_LKMi^ zg!KMwjsq?XQ~(Yo+X25%2PbfCP)n_R1mUx?8GCwc+}>yB53x86JiWol!8wZ?%^{$7 zFrNS)dY=G=Xs}@bFR}H40u_gx_U_;?6bWC~0x|G7j)#P7F$YHy5{;G6 zWQA@(A{ui>R4ePPc8TYi86wOmCJAbVlsyYq6xZTJd3s>O;;(G><(LaLn}4}izHHPh zH>gBUypUQ}YwQb5Ho7mMEdhDV>knf}RtC^O+4+n5N-D2rU6o#nmx(!^E*)Jz(@Po-^+Mc1w!l%G@&>A%?NQ`o@HYrCEC?Dk_Yh-YOVLk#SaOV^z zUUqmx=38|Yg&avloMcE4g_v4jLIj~-GAUQzm^c?O&ux#5Gjqx}ZIFg#AHmI4dsift zWT?2&q;@;;@wB!o8xK|;Z&Fo+P4yKzO@}ro8ICY0f@si8a2Se>p=>q6tWZb?U12kW z21%J>3}Y7TIZ^_hgj5#_j}H_y@EF#R_OyD9K5ndSY0DVof1432Kd#)Ka=MWaBVmiL z1s9r~qGzI*iT_d(*P~R|!sDqn`&~Gpt-2!@X%^`FO5lH_pg#zHh!FeVa6)XE-M=j%%Th6z_LFbe{&@TGlYiH~K#RJPMisCBoL# z3C-}?3A_Nmnx-$Po@NabjyF836o>vv{Eun7{9(on68;1br!xxzARfmSS0GO5k_A); zlo$nA1v90}6x&Yls|BI~=%fV7DP^*%r$i{!1E20DF^a)7t-eDCpGn;qVv^Jq7)W&m zK|`*hV8(P`$?^n-RpD1Ca9PHoT>}L#(L5Xyi>~VD;Gb0?`bxCX)8!!!))n1=8-vmY zA-rG-kY*f$=q%6|-bB`^^udFWq{wRmq&Ev|0&iVlf~1`GOyrWjNO2=dfPwD^@vrVi z9)J$p-N_UItGDt1=EHqJcJDoGCp>j>MYtlI6iuf9(D?)4OyMbkMu}VUm9v2lTrios zkxd#kqTmV|F#yIHv-X@+%oe{6D=)Vz$U(CtE^_zrS=~SehGw#GX4g40A(=HIyxWOD z3y|qX$nK<-VUcj6^x{Y#@&$Pgva;uynz%#*rwuSJI&kvFv zuqdifp0C$bZs}T@Cwz)uV5U_SAakO)^GnPUGV;M)7iv$j5>jR;I^x!~laW!5n12AI zTLwJ=O{}Pv;J}8SYyUUc3N-!$SL(O9LayE5NZoR5Yzpu711e@8Mzj{(s3mqm{SuqE34Y$K8J>t5YvOT1y+wLx|gBoI**VtI)DT!O(@uiX@n|9T}DY= zr4B}lLXd_I3r?G`bOIJsU;|lmXYAw@Lcp3sMHkt41e*2jR)JeNeqt+C3!WObVjKa#G9h^5Od2{D6hJngXj`_l3l*>!kV z1AXf?0x#gtGzv|rw^9)Ed3Td?2#Y3+Jl3R{-4fHOw>!wI+Xl8Ba`I5PKiD~)p;TN( zXn|R24#=QgsWgkSgE_{3dUghc4Nbr?ip=7!G6w!jq<6#N5|3E$AW}|Qj*}F4`;_Vl zTg;2)pYrk5I`31!zL;&o=_|gu^1KfU>u;EBI zA<`nqtTSlN=P%@=dE_h9 zYlYvlEhMf%aMFpkq>6Cb`DwvyU`=tP*Lb#_#C+ps;V>Dbx?ki~Tm|vrXNK=tr+I{9 zxBiN&Q1T6ER9b5~>i)rA~ok~R=QP5%>t7S5b*q{IZRtMzipkkz1Z_oVK85yGg}Y0u`Ut74tRfg*dQqH^bF7>3az?%+2zb z9C^XlISFs(ceon=aehiQtg$2r$K(tCE;~2*I`WxX#99$ov<1E3dBdw_P;MI?!OS)DRWW>G3%xl*JByeOrDjX_;Tzv0?3c8H}M-MAem8+_RRl_Q-Bv1w| z4vD-teiQ8xDbkgpx{|nGk3Sx6!ZQ!UZM3l-9dNp#j2&Bo{5GX0W7eAkE)>%zFM<%V zTf@deFnB1OKm;1aP{79;D-6}i+#KGjzvpy%U3VOz>|Y!lcR%vo2^+fu$k^R72uH5 zg@!0PNX3OHa$atPiYPuN5I{$SY*_3lw!T{IC=f}*%0?lY(aJ(S%;2(dPT{RhPf*Y8 zr6<@818;c_&yOq}e`x7JjwgAT%t?=&K7|0KvyZ_C8jJdl>Ol@AZwBGdXbO8V@gs1M zXecDxlnmOP8#PFbCcp#{p74BA$$o}=;`v4m(mW#{Hm8~@z8@@Ch>6G7_)^94N>*GZ zMNEJw*~B-=nHC$JG>kwkq*epE08;hMkYc50c#Xj!x~YHwj_x&fnW(H!e$ ze%^0tKW~qjJ0;AVHxgm%M!?n$_$X%g^E@18=@b=Y@=5HR@a*q|m3tkmT=^Jy8vb1O zb7@@i^bwz6OXbY_M`w{Hh(!v$2o~ukB!&WO6naYdhC)QKM4=}rbyQU} zeCf$9{lF;+2jskevfN4Uz8QS6mMN;S;iRz1=hK-bVRoE;Tnd-5TQO=crKKs;l;2M` zVJ9vh0L+kt$YhVqV?uOo5JT-FCR>}9pD-&O^zBmj0qkv;x(`5$7OnMdG8S0RIE{(${qyee!Kl|7t6i%oyE1kl)v2tT2U`t=`6@G-Ch>=WV$Q^=6uD=>;m~B9ap|dpA9tqYX}neEF+GB!B`v&5plOuw3%4oar1TPJ--EN+}2i z+r1@EFyAdaZJ^P2wEY{k+jtOq98-(m((em=!sT{=}o?*hyS`kF{^#K5^tcBkr0}#HaMkaRe^u zkXMQa5Y`G4f-2LoRdl#L_U$N(1}g>nM>{w5*!+(l*Xxo#3}a z5ij5w?lGa;f`U0gCY|*|q9y`$TUdXuT#FuVF}!{!)Lt6_HYG(u6$LiQSEymFwXws4 z6!5>kDHk_A4GNH2e9tg79ug-@U6XK5R_eiTD;1zODlUn=BuN*K2|-If1m(_)W^S>X zLOR^Dc6pvGwi}B`Kn0YQ>?ks%wj{7E_o^h1=?EQ#$_ln(`M+PBtX_+gZH^!%=z{Z| zsofWxzh!Jte=b=pe~Y(k#8ym2<<457DiK1TSgi{$!#L^h<|JF*Vu{sQp}$gk$4VzJ z*9!^8O5L!=0D=9set1)YqubW6ugyu<;_CG`6D9r0@?34sDd9lnbp6SM^QAO=LDNS4 zskG@lOCA2F#$qx2E5;G-r@+DQUi`q+4=OvS9{NFLM?#o_bLrw_z4D6byiD&rC*ymX z`}C@kB16(B|cW<2=-u!L=vy3_*p-<^Z$~R1rSsEIrz4;Tl@oY3D7%&n1z%0R7f zh81ds&Cp29@N)CoVy&Q7kykMcOoaIQ;99rnHii|WvzbX}t!*U0Mj{uvew=KF^X*gY zx0ZA(St^U+uX{ulmXvV$*0x(s%CU;=cOfw;@qvr9A;N!6Q2FOxb%rl^!i-g~=ECI` z{;9t?^*#_j#CKPK2kfYh5!lya&Oazp25x{Jt8_ zOS+Sfv zWvQ)KcIlGq)x}rTFO;sIF0C2o+^*hHlblC9ERQQ7?d%zzgf-(K>C-vc|7*zMtnd}= zH{R}EGbCwNy?jHW$id+r*l--c&b)%a`Lcpv!3q`b>U`Vpjy3B>qRv$-IbdQ-QCU(oNvz$(o8FG z>h{ZPfA{Yb1hU5a^r68o^86LL)!_cK{&;z~*4Dp;A39yiMkWFBN5jt`lrwYxePlBG z^KAQC=rtbreVH4b|0W$N-_0+!MXw>}(QR-ZT?>8G&{-XJm^jIYJUQEgo}A8qVnNCQ>x6S?*GF=l6uC$p%yqSYjBAyWVQ#0i zx}6zrEmlX>ED81K5t>GeDw8LK*7K;1C|lQ;#~?U&Y?$H*O2*s?Cxq262MGh)!4&}P z3aEoz0~zbsH3)q;2ZB)|DuKyR*P~#~TzWJD-6J2gF^p0-cwrd&Cy8ESYabyvglIwL z64Es+^oYJV1oZ5y2~#&1TJ@npn5D_=37;)^+EEvwoy1r0UOGE5PKO?Q3StU%Llu&` zaEdSGV1%n!ZVF)!%sXqHHykRFH*0EQk^JjX6S_XU1%``5yKt!wmViPLCy(alv#2!y z5f^V!9<9FF#p$sel59bP4OLZ=@H_lyr_Ln5l+*OIH6I<1=6MvxKS7-yxbam z#0SCvmD|TCoI>cKd+VO7L4poNSGqxKqZk`Atjqw6VEOn?y*YvvGWt`Jn0DA)9Ow%CoivH=OxJ7q@V%Yn>8HusVU&0unDWaj1 zluOH;jEd3xaGrA&RqJ%Y4N~e{`P{`#*?Hn+tdJCWz z`VtbTcFcDD%dnflBy#8!b%*#$+!H(_ED$F7Y>u*uKs-v4|D2YReiAQT6Mf*x3S$6dupP!yyqzKJEuC>=9M_zm%zu3}V!eGu@4Y~Cv zKk0U3Uxhhk^F~v*WAcsN3seWE7(_7lAyR1^=^^?E4%68~vos2E@7x0>GA>m>9=$As!T-mp{pQ zwt>&OA_74AfBqwE149>b1j6wD)2X%O6HTm#mhfCj%ylDTfegUZ8G;)T4xhIrO%ijg zuFMCwS#iA;@{bm^#sy)*0gM3@L5{0TWSB_mFOzJE&-|NKSgx22Y)ga_&W$)Q2504L z%T#-&+ZS*^Mm3T;vPgX6|2f$X?+J;dSWMmM{8cghW#~dnA2;wfV_wQdrpz{bJGj`c zTt|Bse0Q?Qy3tzdy8msbl55@l4d)GHm}o~%4J7(#M{-&)ye6WQa$PxTlo{@-oEDMu zIn3lDauw6^h(hIeGT1x;w(;AaytyiznSNiwTMV&;ZoKkY0guYF!UzI7<#l>+g z^uHTNQuWHMlOlWaSIyUJlal%P*-51IePq>nA`MmchZunBin3T_s;0kG<0v~FOp0SRNWh#>Z$&)A#l2^a(41Mt}TmHxQ@ z6;hP(hbW{UM~1|}jd8$4Ohf=`4NY@w3Id{FN26#8N{y&_aB`SGh<)1^s7kTWz5&2s z?%qWy@>0JIuF_|ygXp82h?LC=OcAp%tb=nq0`Vshn?WQ9tehG;F;Qx;F|t9)gixl_ z1H|^Tec}LNH#SZ{U-}mx7$@W{@LbtbC;L`DM5_Ih z$o3$K{7xf{!`VkqQ`kQTxcWzRHx&PrnE`RE=*~fFmU`D~!Ajb*U0$c;08s5|+%YTE zh7ri-JkRE#RvVB1n8jyZy(uePfzrQvRXAjnIDPmw5RuT~N=Knp)Y*5WpXQ?4j(HWH za{QXZu48*ks(K5Qd1;9n6|FFD`_HbjGX2+a+SVmHZR-+F+sX*C;!Vw!!sg30r>3zq zmn*E4k;6fhT@CvAt64wqJW0y=Ujoj?>MnxxreygXlVj*_&KcS&*6~*RmcZan|4az@Ckw!5E(WtF^k@_7ykfh z69+gw>jS4woH+GCTKc8aE9}yK{M1QG6$=;wok7l3PU&}GJ2GhmphK7f&8P+<$4EcR zU1ye6r!lZXd+GQlo@%BQAkgq*=X=I|{6`iX8R$u|4~LP4Z08W-bhs64$a>lZR54Uw zfW|jQ17~l<{dai52kzJ`es38b0P!4uXp*;#K;*l2aCZ}M_gy4I7z`qEme%*6S$6)` z5aL6JIegi>d`?}K_f!7Aq9SyaUHYp07*uQAZoPaGPPpgG55m5pod4?;6&hEs%&2xM zhxEl=`eIOD=o1Jkx9O6uT3VlE^`?+8eONa-vvzq5c3r?1^Bvl8HKDT>Ya2FSP>YGW8Q%hktk>Z&#?{gix5Rhfsrs+}(sjSExNt#A)I`o!e!i=>&%v@a;9p%g*# z->*93poQRD-AzBTxGpfqol4_NjURjGuklAIkcyHWc@8T$8(N%KXakXfMieAGL*#>} z7)zv!gj&q^jMklJlxq@4>ehr6-g^QKif`iS_#6K%6j*#4RLf|sOt4fRKkIJXzh{IS zcJmj2gIdIVvuw6SLJ3$j8Sx;!jm>i`OG5^ne2DV>c;s$PbT|EzD36&@0az+Rfla5Wxo36slpkDX~~*=(75wj`XG`NRrj~`i=U2jplB@0ZmryymWwx4 zsDh^R_~0Ko7LMh-n5k|BS-M$h6Vn{2QaX@-iKpd?{&^)cfSn^0!g&3ACf3H?DQhkHqrh1WVpO*5^a`oj4FBbw8KyWIrCV@ zM{*I$oq-Yj9>my%FQ`_xBR3|ux^{Vnn*AHv@&O+=kXBE+jQY?4c>h3RBshEW_S6Id z=vwb`Fd-E5<*Fh5icPGhw}4nvV0*~=RGn7SmUM5p$}l~!lXHH=LMI>)*X=6uy)aEM_Jb^HCc_7(1qv!NEK(@C7zuYmYp|(E zMkWW3fEyvC69~+mh_epQQb>>y(Q(t2q$a@!^hH!(=p%Y6wXI;3ve6RJZJybN2Yplm!}*m`mro?Ay!tKw&!oAa!NutStId7H<>p0kncdL!@wxkZgDL&nv{W;%S*@mF|ZA=4dq1eqR462 zyhF!qdtgYR4$X``{Lhh`~P5qqBi%40CTY2Vf;uEjB%>`gHaGu0pn_YQXRfYnZ9Nto+^#T9^pmDeu< zvULRr^SS~?D(n>0_5`W4zbKQ@GEPiTFui&*2&N?0{uo}=FlXD6H50FNH zK~zuRDu=P^Ucm6vu)WxsT$G1G@-Q6`aDq#K@l*Z;%Fc)pVM7v2h^#NJ6@rw`zyojq zf=6DOEuS8%&#C&DvOxpJ7>d^c+uG;N#hT{Oufmth1eu%rRV33gjrIRGVUVxDz2WkQ zZMcbUU9H^foHV9zNN*OI5T;CA{5M>LUoJU+&IGCaCn)4A-o*>$Z{praq29m3g_(k5 z`P;ZCaTT68xCeXFsdPd=I^ymR@d6J}{=4cU;vLBNt2KvIl- zp@W4TCZz&@=o0fpskvnA#1?p&$q<+2za!`*Nb}Od!GVtE3db{h_|!LfkN_E;KrQB` zX(q)c5D*g^r`H$?L)4mMEZXn#TqnhgpmKc)@o*|2PKwHd?5W}0DRB(pvX%0twz2~U z_@+$BMJUrnSnxmb{EhL8;txSQiO%7odz6&6VVHfMYrR>AxAM8O4v}}F= zg1i=hH9A7bS2+rIH*SU{OLYa>0Pab`Vly>*X4I_Arl0{!<5Nj*056F27e2wise=C5a51j z*AbRW=5y+62+Iiss_XAg(4e zgr1Y8ncNG5=?o=-31?a+?y3QqxDkoyKMd47k>n&ohm@udWphYo2#zxN5=DMNsX*Su zJjH_3^+=%#6JCrWw%|OXJi#>%(N?Apv+%~l<9!)qi7*4txl)_!H2ZmY0%_?>wsf6k zJ0@DrK8vwH*aZD1LqU=dUbX<18l!yq!KO5ydRRbRk; zjB#lBB^;G)B!!!SBBvqg=y=C%e{8>-Gt)laAyyq8?eXsCL^}@P=kBDJXIU} zs#06Dz}xZ7#F*%}^)U;#GROW5zv^@d^on@#F)l-b7@6WTe2YU*DCs1>wA>;^m4z`W z05c=|#(n9ovC0hz>6gd#fddl$w8pZb#QE2cdZNi68`cO!hm^w-S zh}Gfc1ihgL&^7se(a7$C8rmrg$AeQ`$F%&R!C=C55MCbL?wGFv?&; z8W+$Z30hzqO)1@xvW zA4-=WwJ8bHg}Ji0;wLChvTKf!FqGPpH#(1*;qnYvF1ub%n#R~k<5zgKSK+pLF=Z-g zV5*97T^UQyFk`l!8;xuJ0;YAn89@*9SF8q4U zRtG}cFm@p2Uj6BG)me4kAaD6EBSAzU+7dFpw?U!4_Zf7>S5teHqUV(21|x=YKM;ij zw^EDDSAIcPX9CdUB-Q~&@B;SZJF-r~ZI#FykyT`G=H!L)O(NO!G4jYdm?8Bj?LR32 zEzGA`+jAx3CQHqADZ75!oPauu6dq&2Gk>E zQSwXDTkM9CbK|^hMXtoJP%#$maM$r`YlYT=9E-=5h>0UkT}S3q4p*PD7zXwn&JP3L z0L0;nyAF?KRS3|eY?7oRRzw3n7-UANQXpjtH`osCv97`p!O@bC_pL`ES zOhAZ7x}+rqefT1PT@eq7h$ZsD9U+LH&H14mj1T-^fvb4`&!%9cE6CYWn4vv5`Yd#h zb8FGacRHOS5Z}}NTr3+0E^yIpjj=cKM+3ja=)?YnRUo+2alxCdlB8=&t1A;~_A! zeJoPlIt?EsL@VLYDWn40k!w{4V4^YSdpL5cm}~7W_u$jHo%rgpuIErgaQ7#3JJkfB zZm!cj*6GL$lJ%jz+LEGEliJ~eCO&Nx#KAso9Xz-{$#q~xet#_dG%mU;zdim;u7l>} ze@o;#M2T0vls z&=AozmSL*xRSb`GFC#coNm5BkV-j8J?~2abBcMxvAOG;Gs}FN|== zU5VK`03-M_m2g@qW!+7OzHasrlDmK-m|6*nci$S}2)*9z4VmWLjpgdav`qVvtrA#k zGY~LzEK8WS5MqR0a$&WDS!p@Zuzg2rJ)96v#MHH!pIlX?!X z7mphtpNwXqxQ%Q%RtsDNFA#J!dVUoJCBi?ScKHsO=z67FU+hp9uc_biehSyU4R$z4XE%VQ<#}q5%>ELR8J9=KD!Y|1#P^D& z`T%d|<(6NwSw!lJ%wfmx)K-?&HUr+WB7^Ptgub$YnhD%NsR6=prtmJY$MoRo=xod` z)sP%eG*!yxOU4K_O;HP=udgw;Z1yEt1}6f^gkil{NFhfx5=pS=EUS>~#!McsFr$j} z<~Y?;96lakBDhc0&-xt(TCOtL)vKy^rqU`?vBx6^?`gLi-^ zuU-Cm7*W05W|(&Oxk-gMAD=wdUEZ7XJq{o1Fc6(qzCPET&WZV6F!j#rR!W!fxuRKq zKb_21IlyhIcbPxo9`PTsDsS>Ejkkfwzn1I335Lf6mm?ZZ&RxDS*KCZ=FBnI2U9yc| z%XP`Qdvu!eH_2@ZJDEK?kfDjvo=9GQ%8IX@J}7UBdkwioSEqxUe5^Z}?i3z~!64w< z(;$3u_`n3^d`llu^IlkWp$p>B#q0BU{$L+2ss zalzK7FWIO~AW4iDJVygS2KZ$h@Rm*9B8mg$+(t)E?8S|RU=2}7 zdvHQIfs&rQu?RzwZO0Bc)F)sD*W#Je}i{LqPX5sT&;g? zAfl3^lE{z$c$=&lazbbQ1s`X}Y{wy3%m)z@c^Bqj~jsEN;fUlre*fGtjR4O}ck;Ve=#C*d59)Od1`u z`UVAcD;<0%4`wYS2e8-6H!{xqG!9@<3Q%(J_<{2ww-E|i4wqNmxNzsF8qeL*6MkP> zRioNi!r%0d*^%R7gH$)9zPxT_!Pc zP^zZo&>}P~7dCEVJ1|DLiJ>U3oqIzmqnfoeAdcor{Xpo@hgK-1l4f18-#xrV__4|M zM#?2o?`v`^#}Intm(t&9tbv%c82QBubq3}^XkYWuQhthNeW%F2gPC~|NTI(Vg`_Y2 zCi&`-nn|!J?0Mb|Cc`&Oa@^DGTu`q{)9Imc(o6YID#X;`HEtfbnp&r@Vx?z=*1$v7 zbg2ePhy^HTkX;uj(<0u19mD6#gSbtRhx;x(Z-YlNNn6J6I>t5RfYa9T6vbWvG)yuM91+oFND|tcg5D)M2HA$4|mk z!HQ<6GNI9e##5V3TuvI{2go%O09h8>m>2TtP?O43a&%L;7kqrjQvmL5I(%9Mj$FLkaRAWZX$UdiUC3 zn5V*@n=6?h=$+>L?8eh02S$QJ{ck zg9BQ@$tGaFX;GSrY9y(h0g~hl00mVNDMG#=)M|MPNoL&-)t_exfNwvIGY|yJ<2FER zDYuBW-t5r6V4rAAK?2LAh~np+f1>@&$}@t+lPX36>T+B1^)33oP%lq5FCI|%UHnha zJGTib0l`;a`sJ~3b=b9`o?m?{^{QlXIxo$`c%HqOz=km(u(3*<9OVT$Mv+49NS3~+tVa&;wE)gAd&cIkS1wn zG)>xR>Pg~Erb$!JB$Fl$-FVz~I*t4Jo^$Ve_w6nzNSbN;M>x{rz5DLF@BTRV{66Pu zL6k9cSW&~W4#kIFC;A6ro&ke~_xz8`@%!1N#q#_WEJIXvB#8)HtQOP&o^{ykpuH~E zi3$R_v3GugF^EqjH~|EB0KVK!V zj|b2xVjawCO9k!quoiI*iX+p&2`*Miah$|5SX9qxA zB~xhJ91J`bF8lfrF8h~9^HAAuvppfbT73Bng%!?P-kTxP_D9KA=>r(P)O~&UuCIzA z_Z{RoydSUa(UK$k(X#QD&DgWYx<55eQnbfUitYW&3Gdm-u{Slpot+RtC=Cq+TJh5F zEd)fgD|w69;V)Zpy|2X?{Ldz0hW+)H7rtUI9PRLef8Zy*NA7OpIs_Xrz_A~_4(1u5 zCHMufSUkN}nG-X^4F*H@e|igRk=_CWzA|`}c9?(meNtPI7FtH6^A2?tYy9xgv05D^ zzmzu^DYUuhLL%n^Rf+=5R^K8g*{cc*Ifl^)KTbFka;CyT*}d~Ah`Z+FY0uCzabpia zlzc+RRrvS7`_8u+^cFh_F3R8uCC0Q8fkjeXRQZ7mz6K|;4fY}I@Sh**UJs!bxBW!T z7RR>s_TfwShbmtjLWKGOC!IsLtyi%l4|NBKu(~?DXxUUf$2V>rdUW$BF&;sgw`>55 z59pOke`bx3`Zw&FcI_ywK6}?c%kev3)$u!D<@g;x&uo3&D*Fj$vZpEoYXlH^KajAF zq!Hjjv^iNh(BMk}_7?{@#R1zmJOuqX*u+9}U6c_u6Yg=^CJHOZnTX>9O2R)OG^kH1 z;~E)+!i5wgRs#0Q$dL3C;k)sQj~MA0NYccmO2gu^25ctt?Ezn3Gx?bnb?fK&x%IBa z?CKnMm4QZvP1oWo06DJAF$bh{%MI}`Ki5JAr&?R8O_C(f`_{eYLt8!jvDfB%ZKIn~ z!&;c#VFk0j?ujt#&pij->*~Gpw=U1$OeVVe(NaK8qD2=YqT)~p(i6O9>=gO8t{?Ah zo{Y7AG1Q1h#oluNLE@6V}0Jk8F z%ef}Iaiz9DF{ESBNJlu22Qb9eBcHq7I;sgtN>2R4;~XzMQ#<0Z;UG;_7^EkP5Vv~! zu!viseC0!l(9f|GeuGa@Xa<5R*PUHDKz)cb2{Iym09LI&HHc zN+Py}9aSt~&U{|MlG6 zcW0S^NY_KVoDf-`YD`XWu&Xljz-pQ-?q>Y%o44cN4U(?q`{wvY=7Fi~4#taN*)9K` zQ_|zMiR5El{@0@~l>Zex-tQoataPJ_Jf1Xj<M7;rG&J&v&PVEKjx`1UMLUHxjTGYt&ioS=n12+0c^XW zi+`K`iZ$7tWXLEd*WJ>-y-@lOSr;G5yIA^q(q^e?-yB?6zo|{RI@+pnRaA~Q{6lR$ zExp%Vt$J?1e*B5dlD9E!_6miAk)93Pmu?@%2eU5Pm!M^phmE ze4*s{R0ltHTQjfoFo};67Dq_L=cO|J?vj0>>#uwOdceu3>R#UqU4IapTW{n8@A?fN zxc`3T#Cr8;a7L^9_l`2UW?$W%9_t@Js!wx(YK2%MH{=+d1_aRw^d$n^fSTa(M z1Hk}{@^D-TOS$;tK=voH_I`xY`~y+|s6j(D`$5mCwK1H7qvxh9fL@rgz|H^(^CDKq z+;c6Rp_nMrpZGQSD*q5Zn8oSQWU~UXi|8MuLPK7~&$>Q!1Pc~H?4})n01;I{Vl~OzqEoQ1&T5LZiBZ`7$jH=CgOiw( z(~XVPDnerN;bTfYH$f^lh+FhkgNf5P?U}m1zVR0H znf81<%$HFw6VW&vwf>c*kJLSk!Lz`eT>rNTd-3>B4%WtpM^~vnt$UHo1@Kp%AUSpvafl^WT{!5y}9Rh&y?MP`1L+EN;;Ik z`C@U|Pfa%F&2?@u}R+|_)REyNy$S??*zj)hCf#qqn zFu9PWIHQ8jsY80C?D`)59}PM?tJVn^pyiXKLb-b z+MC8RW_ZJ{Esy6uFJD+DBf+_|Bq|68*2tTRi0tAbyS_K- zZLcN_LOPzo)wesMf^{4UY-<`m+n7TRvW?}K%{T4(9_Q{o)_;4kO5E6-0J@#iKAV3u z7-D#=!Sco%iq%n6$*tO#A`lpXr$XFA>O%Og_UD)n+6!I#B=~1Bk>PC$fG08@EAOqc z0%ajJNciwF_}c>zT6*O(!H8L1n|nXj%S83`9uC$f)0G|17M{L;Zsp>l#bE#+B*VJO zYb=QXD;Q6tVZN6i1_mGeB&F09L$h3Y{2nKf)EncLY)_5m*oFo>VNa~7FpAM zssD0y_SS0zA@ug#ex0p|D|O3{+l~7l+A=&|+qj`;?+p{pUA`|beWy0Dqr82gj>B7rd<k1_b;EjxF%uh!a1qh*yqLOv$aN`*)uURbtG=Vxah#n zan>0R1_Tf;h^51;16&|)0`ZR{qzh-i4dY(UUK`%Wvioyv)`&E?P@5H8}HNH7^=cCR4P70pVE=eCCw=YBlD?X!ee>Ui%&&hfEQ&DZj+rvs#zjGQ znq6WAk47SpR=m#4Z?-F$FkcB{>y3EW48#-`cCMqNcwA_=d#WY#46#W^yi77`+Uwd* znrt}|k4-jaC%F#tr&?CZLL-5aYj%OFm8WWV6pliBQ@dCI`CFHa@EEARUEzdZIl9qX z{|RUPMve8GQ4H}{i6J)Ai0_M^8*^|E8F7L}uXE|8n>-opmClblmy!(jndL7Nl7XpH zi2wrEDLBT=?xtBur94Sz2Sxf zA)P69EJbWG?Z{F#% z=bk=mY?WymoM1jXt$I*JxH?1oAtFjUFN$g83nP*L__)D@wxS_XL5eQ${qFkcYm`56 zW4rPFN++!C=!EB~uI3eO#~+)tjq^nF4x?0$Z`?i}l5rX@6Rtx>&gD-w_by#&{;vst zY5h$T{@mKPb}X6b=0xFWt&iK$TI@UHM3oDNV;+o|Gj&6i8O}yYc3Mtr^3&&xXExVH zDf4v!9@Fs_HcoLhagTx+C!IsyV`(A)CKkNt9%Xj2mLl^E*0+NbFi^+#Gg=T!r$$g4;f;sJP1qzJh9X`@aKf&~ z?c7vbe#08$r+3w_`BFyTZQDrMiFgTHszrjuWR2d5NL}*%5i@FkW2O5WOTIJydi|EL zchc5MnoF=#l!1q^?iL*N*2!c=-_5(ufIO5*;$m9_WWdd;M&lHqCJHRmzC`5SA zI;+I7${br9hLd&?ZAM^JTf-&PlaZ7Mm+`K#zAo9X!On8!H9YI0yKs$o!_rszwhPq? z(-bF2n+RdH|8Dv~KREo51X$uM>XRI?5(4P8F(fq$hl%8A(@*dh-hy;tW@poLl&jhe zwoMw7X7*FR^`>o;ky-lvkLXZ&73~KQ{X9A07Kr{m~B*M)+?QPL_c1>j#~U{KC=CjrrBj z4m$e#@WfY_dVfanzVvh9dry^X0&*5EhIJ^v#XYr|nc6T*CfAMeW22~E3GYPc%5P9= zCv${1H?lxDHV+re5K%$^y|FDBA5wTFpeIPD7&JJteDd~HPuP4NXSR0Yj#NGkFFojj z$cdk<`NgB3s2{!Z)1#-qxqbBX?|-TJCyWD?@64!xEF@A$Z?jIsJU~I;5W0bb+sG`o z$SKEuT4NltrSx#7$-3B(*v9&L%{uC8tuFG~OarTk?p$Z>uS_E#xV{BuRd!t%o$Dna zcqkJ?dL$+X1I2A4f8_NyjW*AhPLA%lv}3R|j)Z2=9Kr{dzoOiae<)0K-9-2L;U@*+ z>u;H`zXlB_J~OdU;>^X%uPfKfS1#Q#v1HE--EIz+CfbsMeMQ)>Y38r*Jrk0GofkZ` zy6uYvMfOq2&%U>T3PFTWihFgfhKEeW5H!`|f^ZCc5BBn76Bgn71P4h8In z=#gYy5YF)L7Zid4aG(UN`_`1vK)~mTp4qnK24X{4rhReI17{DTQ^+0VQs8UX-?lk8 zUM}xAxxQ$~WPpVT!Dpq^8wmQv7FC+7?a;irhArsqVw+Oh*??M9dg*tvzDdP5Bb8mU z`bCWKG8g{HH5Pt*JtT@7EY*QXf_cg%TdZ_fn zTp>CzOtZ${nFceNj;N)zjZlYWgj;nr@ypl`d)chlweJVEX=X@x?$Gvy@{c)Gk1{)= zSn2oy71zbe`7Elc(H^{LkV-sdUF8RNyA}&Il^qrX`g+Z`ZmlA_$^Ou8i zPQo~JKsk2CX)EO6WmYbuoEjr-!W%;VVml(?cg-Q=v*Qz`iQJ>(YZGXJe-Aq%R)}z@ zJ$pD_78VI0%`C_-XJJ}5b8JMLc`HB~P)mT(Eu-m=f{5iL+6I}*v;0_0$N&6N-^ZCQ zP8B*uQs+Cu!9u;kQ~LLh26S#nT}KQ3m*5x^vhR_;v$383f;S6VyvdCl{bV5u%gtY~ z(}li^&j;Wx?_30d3=?M-TDCfxfH*JG!`he~beMLqrWL^4Cb;3=Yva(v$%crgkL(k% zMd8R~5h9XEQKs2u0;Syd^1$|SY!?x1LwY%^5*#vWG>o|LNFt+y<0nZkg=HcT&Q|xw ze`-&izM2Z}mkn;^_GfC`jI80=H+8J`(1S{yhYtH8dAX`U_66NPM5MG8Jftw+=%bO( zZGmJ+!5N2-16|R_4iCD5i`_d~JnZf-c-YA!&HE0|LcPw2FjiwdiCS}-laROA!mH-(%90cw!xvu4l%oG3kqX zJD%HYQHqT-Jj9H@$$(RzBea!&vHm&s6?Bp1;E!tNi6IFdxJ~+II4INcFRzN z?|Wj@ka{R_UZuXLMnah;9!aJt043TzTq}^e`0U2UxLf3ur4u)WNEISz5J%yJJemf% z+56VwA0$mMf`>FyZWh5SCuU(n4zhq8bOT@w+IEl(K0q z%3mIBj!B{^AN4wy9*7tF;>AF`cw4;K5l-&9@&)6d4Fbtpge>z*Zs2qW$+vI3He48} zS>5JMLDMrj_I4|k1oU6)&Ar|Ulb3G0w1qGIduuM2y|RYuX~UL52`*R5%=DY2q6`S( zuzBzY22l*qIxi*E(X`8vKfT3_YV}x39ZZ$9=2%|YdcAE-tA|FWho|Zms0d&ezU{UB zT=_|u3Aw7tUw4w@S7v09K}gGP5dPH{#D0~jGNdJY3?J`Q1+XQ2o8Vn(BH=@YCao`s zQF@;-+N}gY%V~vRFMoH-DOA>Z|F|^jTUw1)6d=mA)3f z?S0V)qP3SyBxyV0==!{gpk*rT1|iTbgL~IwT@Wbu40UiWd0=F4KD9D~%^||~^E(&Q z>_Jkx(c?EmkT3&GxLhRdEKVCsIn>*>D)St(?*!kGHe(nbAh9;Ge7s~Sm@+{RQ8?ll z*w50*Q^3s0R1U7wokt#{&(3d5l`U@(*P)>sGQSH$E+X=;VjeXW+Xja`QifrZ5fL;S z#c@0FBQBQQ@m;wR4rdTn%2uph6>t+xhd5zhqBylOsTDLAg=t6!#~jISwMV{)y2eA0 zqv7NsC}9x^^{8Wh4r`QI}YDFyUBah+Y8BAn!o<&!smv=!$YoL zHH;1F(`;*-WC@h^;j}EejvW9ur|B^r8v@1@8XOzp=yU0K?a-?62Tttf%;Cx1uxGFc zDEWzf({<{!2Dc#Xzk9G@lZ!SR(3&&p;vK@32idW_Eb~5eDJ=`_5V;T8fVffKHynWy z&7FkU^TDZ;x1lp+j5V*?7^SYmL;IJ{E-cT_U0AF>y|g^P~xjl^kleaKTyRy_`yB$xvEG3q&iD;YdVYc z*;?X{V>NW*VcJDFY^Qxn8Q%Fpu^b6H?A1LE=wY+I0%!-uby{tR9(4>7^IA&_@lFF1 zZTG9957y9-D0QM7VEfMygq{S`+229hDGff!*ScSiQ?!8TL3_&k#)PC^in)H=xwE z?waF_jQPd{*2a~tt0L3AAH?t)kKyS0-eB2+Il8`!7t&yiHM{iAQobX7oSb-7K3+QU ze7*bm(dL^+o8JjXVHs`oDkPt$j!6}AT$w3F&N2#p@-qG71#20P(M_~QSy=b_om@A6 z-Jf0hRVkFL(JMcpN}>2?dV0E#KGuEtX3m|u{04Z@Q0Jd-F7;l1dvhPTir+Hk3j6h& zdF+Xdt%sY-&HqRmt>5q>H%izkHso%JCKM$AiHO^Rd1D4Voywj+0JP)HgHn!1ip`pa zOBQKAkpduSMNEn0C<@f0(rP+Gd|Li87^Bk~_+8ZwJ+hnaNp;%Ng?K)^0U(-VI&@Oh z$^zt!Z!+B%4JjT@^bT@kR^r{jxO;B0eIE!n@^4ql?5t)GS@Oz2U7<2K%@wzn_{88Y zzWks=-FS7tBo7Tz`Qi2^u+}xwB{vabao-gd>GD2-+G{yst=x?%B`)gvEyony|Gr~J zC%)-4AC>B{D{c&C>%!ZxH!Nxvi)JugF+*;mq-V_0yTs(=(;2o22BF$GXSHW?J;qsf zhjZm_0+IkJcLwP;%PEa>A~ssOe9LJ0lSYj`VqiF0!k5}$impLkG7Z}O)kB%R*ycHW zTOGVlexl%XV5k55%Eh(nxeH5+tJU)>bMuSboW+c($qjELe2XCh`Bm*|4WdN|JWzd9 zvY>P|&@6(lu?3Fce#Z^!i6r0;_hA#1c_5D}5jai)lIRG9dU#?&b~K>KJRL=pFu@9H zWk@x&JOc#Ef(jbKCxi>>QV@l`k_<~OlujL*8S<>l!!>H{jXmY;)_H(Mw4tnb=pSrd5RZ;<#@Z@W3U-*=%P+lxQI{SByTFWPn&K@M6f|#+=ZyxO# z?3w+$XlFPjuHTwjc{BL4(Z5nY^F900seaE*^SW^tNFHu zx3IzM)>Kcax6!}siDfv{E^lw5SG5c7!zYjsw z?t?D~!lT`?pN5ey?u8dkAA?b|TU?`}b$~6Xt*#7hfmiZd6qLCG@d5bdu$2rZk58BlNZH-j=rR(LZc-X!GK_(B91*BhEwqui-QOYQ|L%A3sC`ZIIqZ^sE9 zKT|oyfI9I8w7+c+S)_wr43 z(MA_+T#5%b;-CfP!r6_SD&Yz+Lkw!b^iUx~^d{xDVt2{tU~LhOHfjy-4u)wDK<~P6 z0~v!*g&X37=de5-Pjz_~%ExLOuQgV(d3gEC`b~CeKZZP-`)Ui_m$x-{^)=rv{IzX% zd(Z8Dyp8Qd`?;Zuf67OHlXmhS$nWjCqjh;B$gRHU^sIxAGgu-}vz4mDg9U}6&(2|{ zht(9Awlt)T64-yhX!=B$HeetYV{@oYp3tES(z#5+0R~1#lQwQ*fV^^UrT67QJXQv4 zw`~t;k2n6uU>P^fzd$f@zenE9yl%365u~8|jlnpGqYvDM@elA?HCq~|_)?$@kBb}7 z(qxa>$)8OwH3D?&R)YS zakO#c`>ahZ>tD@oU%w?Je6c$IXtOrjcYN?O3-%#D@MiPlqv_o!{@0{=L5LrLfm3?P zsoDv)nxY|Uhb#qyWNsYf%_NajNx4TvjEs|XHQ>l8##MbA--DKVwqy&0un~2g|nITBdTH^gJ{h4 zz8vy6CVZxjN3LZAaa0?=4nb*c)g#;to(!PBR>!)s?FS!%eFyh*7HE* zFFmNPfYhWW@Mspm8bJP3cXwCGz|+Hc4MgUz4;+M)onNt>8@;vAi9#@{Ve$X1mpU9iEb_INBkTT#wrSDT0tfd*L#%Hym{AF_W z*R+~wfhH=S=;`6wq)setDS`Sr`9Z6cQ!^Gx>6?cEa*4DOKano*PxdQ}8y&}BqEuRq;~Ttcq)k_c0^^7NkUOVRvJIJ zDsVZ0jOaL$@~b_LB=4<(Edz5YC4^eff~FJjwlxY^R??ghcLsIdQ`C-t-=~#QGw5u7 zB+r+&*R$D^^bD8nF?Uk!Eu?_^(=-KK)V=Jp*UHVUzGq-~<+&wJ-&?-&bDM57*{of@ zj&#okf7#)AiYA2#fT8k5%13?UM>&B z4UPsM@6%vizyULeM22UvUe zNDY*2pO>?pgngw<5~l4;c?tRRBda;=!mAj5%#=dFWEO-bn~lIM1$Rr-fnZ=9Cv;;g zNvojt;Z$tt!pk>YAL#k4>vasG=C_N&%EhI(Z{ErDtm`3-@>(f*5x@eUUUDV!56|9u ze8F(Ti5I)-FP7^sZsR`?gPXYw!j`P<-c$+V{!RBvM|bVO_5kz=8zj8TAB zMCOPht#Vw)7hn$k1*Pi=g~lBMI*8av+p*AWT~-Lwt9K-UqkJ^30q6}yi1Fb{XupnU z=L|W*-5P?@!Jpv(q>CBLO;$u(+H5BeHG)>#Ja))s2Hyi$6w=tidKQ@&$#7DJvSr)x zAUPGX7vnK%k!vxhpo!Xvp%K0(uL_VRYJDW`0TYMA*k|sN3k2cmWHG=^nHv+_ans=v zHYwEhvF+>+`?MN%Eysc>w`l7&e&wtXOKD6H#$w-s#t+4v(UB?Yeziefl@nyTxt(9{E?%*9`?E9e+CzReEG`fXY6e=|DyyP9-p!ZmwgB~nHWSE{B+^a zKON{A1rf8a#S<1#s6;G<>A_c4A)XEc+M$t>V^2$Sm+^@RF{FnGd_cgV1lYx9SykmR zH$Ovj=#fEJhvRDP%o737%hWqD#f*E4;O7PAQbipKWq(mL#23MqCtw8~@5m#|EcNqC zb7$YXxOTS%nm)aJesN(BCjj7r<%~mhcXjdoi>uGz5uj55LdFIRc*afe^nDlCE>tm3 zMZMx$RtfhWIT2U;JHLMz=LF6jm^&|v*2*)5*GQ*=uR#CY>SFboa~G>?7sJKVb7%S3 zIX{+Qk;I-OQzvFd(dptKfj$#;rK-=*osBixdRN^I2UH=$i!yS`&?C}dQxtqCc_^3Q zhte`8!?cS7yRaNq`qwVZon4q)U8t@u&YxRdfOR6-$lN@(xiu!q{U)yBxNj(7HjrE_bG)%VY>F3&x+f@$-@(%glrR{i3dCTDeVapjrn^4aPfZYdY4=iYlme+L9$K6cvne)pl5s=q3*&1W` znAGfoIrRc)O7B3ez+rvzVQI0muG*L*dJ2vA`cD5PzrPOj0{7}2g{WdqPoD3r!iMomh4c(0s~Q=u z?x{`<^DR6GK5SysO(0#WRye_Xs^MblCQy=?dKS%<Jo$}r)G z5%9`jDy)2j4jo(&icGgt^qJHXYc@L66$!Q;1E+CotER3~3S3F!@Uv@Y7PAO_RE^q*92+PeaIg?r3UiV(fwHu<S^4V7CW`{xV2%A@Alco)AY>T>S@>j=4h_EaPiEUXY^*)#lkF;yRUy73id#? zI?&$F0TH+AStcBLI%%L9;bP#;nnlPLaiSAi!GWE3Rd+sKW#l_wcURc_VJtbcI4_?q^Ui7pwG}222Y|zhve2w`7?)!sd)l8(WT0U-l=TZZ%zG}LwN2v^ z#KJidNfWeyco2->-;2OLE~l{@crbVI2jS4>R-dV6EkwE?*Kp)k`cuh;1<41-mYbLR zAv^BLrbh`fffSB0Fr`_*0zvK-Bjo@d3bOn75q)I~uPf4}{au?45rNi2vf-x1L6VZF z5)*oa`D`dXQhg@mkVvK+m_K%0Z4K}#Sen>DyVuJ}S=%bCU3_YHHjgHebqX(9BNehD zmNMq0n7$(1rBN)dl`%%mjr?K@LK^NpX+=?0d*7fua$M8dosG`rlB~>T#O{ntD`X+5 zVNVO+&~Adgf>IYUT_nXm0%Isb#VGI@uMx_8C6d>Iyp)vKE=caRF1if@b_^#{Q5IWN z(M!cA$qWHJ+3vFMc`xj;I&^}4SR0;dR1eu7D!1)G;UT?KK~xKSvc6|}PXj**RB}_! zcUxu|^-5}H@3Qq~({)pQ5+f=GeO6Ws) zD~Fu|x&}WTT6_=ugVCoDWVcp*YH{V<)79ExF(P7(B)luJxq(bN-eJ-!B1qV}{(`pf@mv{)?PV{lwG zLEfr`gAAc7{+7`%Bg!zxDx#kTWn9{a_?sVUFA(8O8|pc@aBb0N(~ZN-7ZOaA?t>Jx zN4iWyX*P)y(#Ek?aF*|ZSq)KUkvOE0AT}%j{Xv@5tCju{xajJFVujW&o|jF~^;$#) zL50wAp?I|^%hq|8896yCna2Ba!Ze{t0;8A%c#6_iVNp*#SkaghsdlxTM*$%55 zv%06h!gq^!F}{}~6y{HKIYpnmm!U#IQ9!D8+H7)9wN#Iow&227{%ZWNra`?*o&=I$ zz^Lhq$SS8}RlWkCXYH%^e&fHkC>p2$H`0>~hz*(9^e1Qy9S_JH*{~hEDPu}(gb4X~ z3A&G$34*at?-EmwGb%CAf|P9PD$}F2Lyg(p-rs>79O*0dG5|9%Gi`&1S@#EQ`)YO~ zF3YwOlNFFvzW4I*63u0JY-l7yKhZ5y$CcD4wHi!a^t&s38t%@}k>ke+vUW8{YaVu2 z+CDjcMzF^EPD#2RoSEIjj;4)I$zAz0BKT)9)Hwqk^cFnw4`q%CloB$tDMA@W;{vCq`EY`nHzvpXMkVLz+3m{#UN>Q(9ANIW>EX|ZBNgH{xf>sDKa zlucytD)h(lLM$#{u&Ks{ODx-dDNY(SPiF8ozoLTkOTmDNg*mrTGJ5Pg&4d_%VwX@nx$k5Bv=LTFbC4j? zj=gAYyEt#iGpzp+DN__C5a&;-!l^K5zL9OgtfDKkqs|p?mDM?c5W?sA)9(d^((0Kx z*DWA!B&~r9rjN0`alH!GDt%L4F8VtH&!3o{C~2`cp-s@Rd60~|Vp>JxFJYnfwLIPV z{W>f~+dk;dG_IgTXiSFK{$(N*LB*>37}-?-5sa{OK6x=*N{d$ zjhvws8MAXCdGWw96Z*r2nsQkz%6Q-(ZTX}~&5ATaC^1%rawE#eh* zYr1HIi;_{mE}FPZpKoG`y%QywYDH3RCk2J78M28N+O4`~PUEFBqS3?h@)+j#+iVE5++ELL8gtupZ-d1)yXm+WZX)NcZ#vC4ato~ z8(A(#rgpECzNHi_=adSqD0VB;RT#C>03+{TV91OK3;PT}FYZSQav@l22+_-h;TDWY z<%0ZfvABB4OIecqDkkp8<@b2FSrGFxj?!PYiI!#5a6s0ec4lF#78rpn-6SO1n1o!N zT4~j%wzxb5XAJr*OZk)`sGRRndiYv_DKsE%0Y8J^B7k;+W&`~Ug!2tTT{ngou!A8N zj<54A=sVW8X$$OXYUrl?cdWPiOx&j7S}PJSBidx1TD)fjsQ!h4fO(|W(|d=M7-jO| za2?h@9_tt2ChV6)6BrMf10s1oG%%Q& zio=XJ&FHhwm}VhBbzb0CS;IEZo`=gkkCdokfPj>Ta(-yQgZ#pW@=1#flc)%4$l*BS zd5uhTwUyGrTmuC0;ot;9IUeOSt$<#kl_Zr8Axb8yiI64XULxZJkgfGWuSl z2}#QNb0-zqAkb-WW@Yxa`2Tc_xdAz=;_#cyg9^lg<*l?;NsY{W!fKlUkbWz*K3}y` z;2Q$V7lGT4>PQ<)#K73rfPK+4cP=1`mCPohVAYPVwDmDFcVD%J0e8_39_xkdb)F{-k}Rh>OV>Qkuobyzaa?azbh1QVKuN|f z@jMel@*YqoGl&#_^+{BMbjUwjluZ%{q{b`h+0{E%dDT4=LtVqMA;FmHu!_-IQtX^+ z!EzsooGJ=&b+DP|#!2l^gE}?zkn8RAj)=!@m|M@|cNI%{0;@R;D;K%mhHlW!3G$XZ zA%f90O+1k%P8NU~3A#!K&8k~c>EhDlZMu~_xlbn~6x&FmG^+{ntt5p{0GssvYn54O zPS&Sf3Z_xdi>XfmTA0746v<@qLvRw~WJJY71;^Eua|A%GV!vNpotL{^D+0iFU+j#X zAk7ICYB_c-S}bfVe6Fa)q?FmB*j`B!WcPRUHM_?>&4S9SiYt%%qNHC5-coAUmNuC? z!woqad6`;Go?I?F%akLLq^5Q}Fotm5<2AG_+G zj)yv>nj1$(1%;^EZtFbbcm-V#J#B9;M;Q#GUHcKs27GC3eNwd4p}|~9zLgdWb4IK^ zveFuU(#%+4a;~O(zbn(u3uZgbmpfo=r7MPG*kM<1Dbw<8Wd#I4MbNU@v!ArQ(qWPH zd@J8@O`L&In46EoCl<9bhcsMy>Q$W;5z z#pDy*m2mUI{ZyyI>tEQ;VQ*SP(S@^($)3=Qc4*TB7=)KMS9&4LOXy=% ztcEj9GWF?ILBZT$uC-l?=)-se^phFQPv$IJj>D63d$L79Pb=nE=Z?lr89l-@uc*jo zYosP6@0*5IMo=x&g{{w)!Lq+d!dZ-%Zm0~Meknk%=9bbpom$>vaSM5hz2t@5mTLw! z*3sv%0`PV*MP2|Oyl^{QN=PBOKg%Qr@HWbZ32lSytm9`7Ko&m#+GwG=+2Zff1aGb zpzI36xK?S>`QQ5EC6-YjB|z?s=nn%Ikpo&r%e9&rYgHsY*7r&a0Sa6yUv8&WLUH8r zeF@ep`!x2=0Y7dXV&?s{)?JP@W>Cx4iQ0#R4gC^j4X=65db61hp`BwndVsDjbICy~1;SvK^vxFJ&5dDX`X@cBG={UBh~8p_Ky6$@KxA+1_UqkuUoH zg~doDt(Tsjd|>IW&zrDP+xoDXFU|QaD%`*hQ!9B+~~VDQ;NRQxPYkKGhZW6OSBz7 z2&#Fxj`~?!MIZfG?0)MpU#~t?Fp0VRdMsIqNpoyyUoH0pPbyxGbmy}SjHmAG$t1?! zb#xrxs{49uq}9mRYx=M!n%7t4UT&OEAm`WcE|(a)Rrhk+BF0xl?g!iyBM1lj zA6Yzmagor{eO`MHmT%$)79fA9XitUmj#@_zugQgf{U diff --git a/sources/FILEPKG.~10~ b/sources/FILEPKG.~10~ deleted file mode 100644 index b849fd17..00000000 --- a/sources/FILEPKG.~10~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "10-Aug-2020 21:19:02"  {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;10 284784 changes to%: (VARS FILEPKGCOMS) (FNS ADDTOFILES?) previous date%: " 8-Aug-2020 17:33:31" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;9) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file") (VARS [ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% ) RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only "] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST )))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 10-Aug-2020 21:18 by rmk:") (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (* ;; "RMK: Eliminated literal CR's in the key list.") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") `([Y ,(CONCAT "es" (CHARACTER (CHARCODE EOL] [N ,(CONCAT "o" (CHARACTER (CHARCODE EOL] (%] ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (* ; "Nowhere") (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (* ;; "SELCHARQ to avoid literal CR") (SELCHARQ (CHCON1 (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T))) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (* ; "Nowhere") (SETQ FILE)) (SPACE (* ; "No action") (RETURN)) ((LF =) (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file" ) (RPAQ ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% ) RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST ()))) (RPAQQ LASTFILE NIL) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 8-Aug-2020 17:32 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only ")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22824 24529 (SEARCHPRETTYTYPELST 22834 . 23813) (PRETTYDEFMACROS 23815 . 24273) ( FILEPKGCOMPROPS 24275 . 24527)) (25331 59272 (CLEANUP 25341 . 26729) (COMPILEFILES 26731 . 27007) ( COMPILEFILES0 27009 . 27729) (CONTINUEDIT 27731 . 29151) (MAKEFILE 29153 . 40795) (FILECHANGES 40797 . 43132) (FILEPKG.MERGECHANGES 43134 . 43957) (FILEPKG.CHANGEDFNS 43959 . 44271) (MAKEFILE1 44273 . 48543) (COMPILE-FILE? 48545 . 49877) (MAKEFILES 49879 . 51572) (ADDFILE 51574 . 54095) (ADDFILE0 54097 . 58233) (LISTFILES 58235 . 59270)) (59960 95200 (FILEPKGCHANGES 59970 . 61320) (GETFILEPKGTYPE 61322 . 64395) (MARKASCHANGED 64397 . 66034) (FILECOMS 66036 . 66420) (WHEREIS 66422 . 67842) ( SMASHFILECOMS 67844 . 68079) (FILEFNSLST 68081 . 68243) (FILECOMSLST 68245 . 68729) (UPDATEFILES 68731 . 74031) (INFILECOMS? 74033 . 75936) (INFILECOMTAIL 75938 . 77078) (INFILECOMS 77080 . 77241) ( INFILECOM 77243 . 87452) (INFILECOMSVALS 87454 . 87781) (INFILECOMSVAL 87783 . 88785) (INFILECOMSPROP 88787 . 89616) (IFCPROPS 89618 . 90879) (IFCEXPRTYPE 90881 . 91392) (IFCPROPSCAN 91394 . 92447) ( IFCDECLARE 92449 . 93760) (INFILEPAIRS 93762 . 94094) (INFILECOMSMACRO 94096 . 95198)) (95235 126011 ( FILES? 95245 . 97438) (FILES?1 97440 . 98090) (FILES?PRINTLST 98092 . 98874) (ADDTOFILES? 98876 . 109478) (ADDTOFILE 109480 . 110396) (WHATIS 110398 . 112374) (ADDTOCOMS 112376 . 114020) (ADDTOCOM 114022 . 120569) (ADDTOCOM1 120571 . 121742) (ADDNEWCOM 121744 . 122794) (MAKENEWCOM 122796 . 124639) (DEFAULTMAKENEWCOM 124641 . 126009)) (126081 128898 (MERGEINSERT 126091 . 128434) (MERGEINSERT1 128436 . 128896)) (130397 141309 (DELFROMFILES 130407 . 131257) (DELFROMCOMS 131259 . 132938) (DELFROMCOM 132940 . 138808) (DELFROMCOM1 138810 . 139607) (REMOVEITEM 139609 . 140483) (MOVETOFILE 140485 . 141307)) (141523 143892 (SAVEPUT 141533 . 143890)) (144017 152341 (UNMARKASCHANGED 144027 . 145735) ( PREEDITFN 145737 . 148248) (POSTEDITPROPS 148250 . 150751) (POSTEDITALISTS 150753 . 152339)) (152490 173044 (ALISTS.GETDEF 152500 . 152879) (ALISTS.WHENCHANGED 152881 . 153525) (CLEARCLISPARRAY 153527 . 154701) (EXPRESSIONS.WHENCHANGED 154703 . 155077) (MAKEALISTCOMS 155079 . 156152) (MAKEFILESCOMS 156154 . 157591) (MAKELISPXMACROSCOMS 157593 . 159611) (MAKEPROPSCOMS 159613 . 160311) ( MAKEUSERMACROSCOMS 160313 . 162113) (PROPS.WHENCHANGED 162115 . 162736) (FILEGETDEF.LISPXMACROS 162738 . 164180) (FILEGETDEF.ALISTS 164182 . 164801) (FILEGETDEF.RECORDS 164803 . 165734) (FILEGETDEF.PROPS 165736 . 166528) (FILEGETDEF.MACROS 166530 . 167590) (FILEGETDEF.VARS 167592 . 168008) (FILEGETDEF.FNS 168010 . 169374) (FILEPKGCOMS.PUTDEF 169376 . 171816) (FILES.PUTDEF 171818 . 172775) (VARS.PUTDEF 172777 . 172920) (FILES.WHENCHANGED 172922 . 173042)) (175066 182499 (RENAME 175076 . 176477) ( CHANGECALLERS 176479 . 182497)) (182500 230448 (SHOWDEF 182510 . 183303) (COPYDEF 183305 . 185779) ( GETDEF 185781 . 188057) (GETDEFCOM 188059 . 189025) (GETDEFCOM0 189027 . 190373) (GETDEFCURRENT 190375 . 196795) (GETDEFERR 196797 . 198098) (GETDEFFROMFILE 198100 . 202380) (GETDEFSAVED 202382 . 203486) (PUTDEF 203488 . 204191) (EDITDEF 204193 . 205170) (DEFAULT.EDITDEF 205172 . 208008) (EDITDEF.FILES 208010 . 208211) (LOADDEF 208213 . 208389) (DWIMDEF 208391 . 209245) (DELDEF 209247 . 212261) ( DELFROMLIST 212263 . 212767) (HASDEF 212769 . 219091) (GETFILEDEF 219093 . 219615) (SAVEDEF 219617 . 221276) (UNSAVEDEF 221278 . 222174) (COMPAREDEFS 222176 . 225478) (COMPARE 225480 . 226184) (TYPESOF 226186 . 230446)) (230515 235558 (FIXEDITDATE 230525 . 234028) (EDITDATE? 234030 . 235556)) (235977 244563 (FILEPKGCOM 235987 . 240920) (FILEPKGTYPE 240922 . 244561)) (256600 271152 (FINDCALLERS 256610 . 257125) (EDITCALLERS 257127 . 264785) (EDITFROMFILE 264787 . 270467) (FINDATS 270469 . 270741) ( LOOKIN 270743 . 271150)) (271153 272880 (SEPRCASE 271163 . 272878)) (273397 278939 (IMPORTFILE 273407 . 274381) (IMPORTEVAL 274383 . 275263) (IMPORTFILESCAN 275265 . 275686) (CHECKIMPORTS 275688 . 277024 ) (GATHEREXPORTS 277026 . 278349) (\DUMPEXPORTS 278351 . 278937)) (279277 281485 (CLEARFILEPKG 279287 . 281483))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~11~ b/sources/FILEPKG.~11~ deleted file mode 100644 index 452adc78..00000000 --- a/sources/FILEPKG.~11~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "10-Aug-2020 21:24:58"  {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;11 284888 changes to%: (VARS FILEPKGCOMS) (FNS ADDTOFILES?) previous date%: " 8-Aug-2020 17:33:31" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;9) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file") (VARS [ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] (@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL] RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only "] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST )))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 10-Aug-2020 21:18 by rmk:") (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (* ;; "RMK: Eliminated literal CR's in the key list.") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") `([Y ,(CONCAT "es" (CHARACTER (CHARCODE EOL] [N ,(CONCAT "o" (CHARACTER (CHARCODE EOL] (%] ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (* ; "Nowhere") (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (* ;; "SELCHARQ to avoid literal CR") (SELCHARQ (CHCON1 (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T))) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (* ; "Nowhere") (SETQ FILE)) (SPACE (* ; "No action") (RETURN)) ((LF =) (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file" ) (RPAQ ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] (@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL] RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST ()))) (RPAQQ LASTFILE NIL) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 8-Aug-2020 17:32 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only ")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22908 24613 (SEARCHPRETTYTYPELST 22918 . 23897) (PRETTYDEFMACROS 23899 . 24357) ( FILEPKGCOMPROPS 24359 . 24611)) (25415 59356 (CLEANUP 25425 . 26813) (COMPILEFILES 26815 . 27091) ( COMPILEFILES0 27093 . 27813) (CONTINUEDIT 27815 . 29235) (MAKEFILE 29237 . 40879) (FILECHANGES 40881 . 43216) (FILEPKG.MERGECHANGES 43218 . 44041) (FILEPKG.CHANGEDFNS 44043 . 44355) (MAKEFILE1 44357 . 48627) (COMPILE-FILE? 48629 . 49961) (MAKEFILES 49963 . 51656) (ADDFILE 51658 . 54179) (ADDFILE0 54181 . 58317) (LISTFILES 58319 . 59354)) (60044 95284 (FILEPKGCHANGES 60054 . 61404) (GETFILEPKGTYPE 61406 . 64479) (MARKASCHANGED 64481 . 66118) (FILECOMS 66120 . 66504) (WHEREIS 66506 . 67926) ( SMASHFILECOMS 67928 . 68163) (FILEFNSLST 68165 . 68327) (FILECOMSLST 68329 . 68813) (UPDATEFILES 68815 . 74115) (INFILECOMS? 74117 . 76020) (INFILECOMTAIL 76022 . 77162) (INFILECOMS 77164 . 77325) ( INFILECOM 77327 . 87536) (INFILECOMSVALS 87538 . 87865) (INFILECOMSVAL 87867 . 88869) (INFILECOMSPROP 88871 . 89700) (IFCPROPS 89702 . 90963) (IFCEXPRTYPE 90965 . 91476) (IFCPROPSCAN 91478 . 92531) ( IFCDECLARE 92533 . 93844) (INFILEPAIRS 93846 . 94178) (INFILECOMSMACRO 94180 . 95282)) (95319 126095 ( FILES? 95329 . 97522) (FILES?1 97524 . 98174) (FILES?PRINTLST 98176 . 98958) (ADDTOFILES? 98960 . 109562) (ADDTOFILE 109564 . 110480) (WHATIS 110482 . 112458) (ADDTOCOMS 112460 . 114104) (ADDTOCOM 114106 . 120653) (ADDTOCOM1 120655 . 121826) (ADDNEWCOM 121828 . 122878) (MAKENEWCOM 122880 . 124723) (DEFAULTMAKENEWCOM 124725 . 126093)) (126165 128982 (MERGEINSERT 126175 . 128518) (MERGEINSERT1 128520 . 128980)) (130501 141413 (DELFROMFILES 130511 . 131361) (DELFROMCOMS 131363 . 133042) (DELFROMCOM 133044 . 138912) (DELFROMCOM1 138914 . 139711) (REMOVEITEM 139713 . 140587) (MOVETOFILE 140589 . 141411)) (141627 143996 (SAVEPUT 141637 . 143994)) (144121 152445 (UNMARKASCHANGED 144131 . 145839) ( PREEDITFN 145841 . 148352) (POSTEDITPROPS 148354 . 150855) (POSTEDITALISTS 150857 . 152443)) (152594 173148 (ALISTS.GETDEF 152604 . 152983) (ALISTS.WHENCHANGED 152985 . 153629) (CLEARCLISPARRAY 153631 . 154805) (EXPRESSIONS.WHENCHANGED 154807 . 155181) (MAKEALISTCOMS 155183 . 156256) (MAKEFILESCOMS 156258 . 157695) (MAKELISPXMACROSCOMS 157697 . 159715) (MAKEPROPSCOMS 159717 . 160415) ( MAKEUSERMACROSCOMS 160417 . 162217) (PROPS.WHENCHANGED 162219 . 162840) (FILEGETDEF.LISPXMACROS 162842 . 164284) (FILEGETDEF.ALISTS 164286 . 164905) (FILEGETDEF.RECORDS 164907 . 165838) (FILEGETDEF.PROPS 165840 . 166632) (FILEGETDEF.MACROS 166634 . 167694) (FILEGETDEF.VARS 167696 . 168112) (FILEGETDEF.FNS 168114 . 169478) (FILEPKGCOMS.PUTDEF 169480 . 171920) (FILES.PUTDEF 171922 . 172879) (VARS.PUTDEF 172881 . 173024) (FILES.WHENCHANGED 173026 . 173146)) (175170 182603 (RENAME 175180 . 176581) ( CHANGECALLERS 176583 . 182601)) (182604 230552 (SHOWDEF 182614 . 183407) (COPYDEF 183409 . 185883) ( GETDEF 185885 . 188161) (GETDEFCOM 188163 . 189129) (GETDEFCOM0 189131 . 190477) (GETDEFCURRENT 190479 . 196899) (GETDEFERR 196901 . 198202) (GETDEFFROMFILE 198204 . 202484) (GETDEFSAVED 202486 . 203590) (PUTDEF 203592 . 204295) (EDITDEF 204297 . 205274) (DEFAULT.EDITDEF 205276 . 208112) (EDITDEF.FILES 208114 . 208315) (LOADDEF 208317 . 208493) (DWIMDEF 208495 . 209349) (DELDEF 209351 . 212365) ( DELFROMLIST 212367 . 212871) (HASDEF 212873 . 219195) (GETFILEDEF 219197 . 219719) (SAVEDEF 219721 . 221380) (UNSAVEDEF 221382 . 222278) (COMPAREDEFS 222280 . 225582) (COMPARE 225584 . 226288) (TYPESOF 226290 . 230550)) (230619 235662 (FIXEDITDATE 230629 . 234132) (EDITDATE? 234134 . 235660)) (236081 244667 (FILEPKGCOM 236091 . 241024) (FILEPKGTYPE 241026 . 244665)) (256704 271256 (FINDCALLERS 256714 . 257229) (EDITCALLERS 257231 . 264889) (EDITFROMFILE 264891 . 270571) (FINDATS 270573 . 270845) ( LOOKIN 270847 . 271254)) (271257 272984 (SEPRCASE 271267 . 272982)) (273501 279043 (IMPORTFILE 273511 . 274485) (IMPORTEVAL 274487 . 275367) (IMPORTFILESCAN 275369 . 275790) (CHECKIMPORTS 275792 . 277128 ) (GATHEREXPORTS 277130 . 278453) (\DUMPEXPORTS 278455 . 279041)) (279381 281589 (CLEARFILEPKG 279391 . 281587))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~12~ b/sources/FILEPKG.~12~ deleted file mode 100644 index cafb9363..00000000 --- a/sources/FILEPKG.~12~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "27-Oct-2020 15:40:32"  {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;12 285044 changes to%: (FNS MAKEFILE1 COMPILE-FILE?) previous date%: "10-Aug-2020 21:24:58" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;11) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file") (VARS [ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] (@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL] RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only "] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST )))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 27-Oct-2020 15:40 by rmk:") (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "RMK: Call COMPILE-FILE? with FILE instead of (ROOTFILENAME FILE)") (PROG ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? FILE)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (FILE) (* ; "Edited 27-Oct-2020 15:39 by rmk:") (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;; "RMK: Argument is FILE instead of ROOTFILENAME, maybe more information") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET (ROOTFILENAME FILE) 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 10-Aug-2020 21:18 by rmk:") (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (* ;; "RMK: Eliminated literal CR's in the key list.") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") `([Y ,(CONCAT "es" (CHARACTER (CHARCODE EOL] [N ,(CONCAT "o" (CHARACTER (CHARCODE EOL] (%] ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (* ; "Nowhere") (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (* ;; "SELCHARQ to avoid literal CR") (SELCHARQ (CHCON1 (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T))) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (* ; "Nowhere") (SETQ FILE)) (SPACE (* ; "No action") (RETURN)) ((LF =) (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file" ) (RPAQ ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " ,(CONCATCODES (LIST (CHARCODE SPACE) (CHARCODE EOL))) EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL))) EXPLAINSTRING ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL))) NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE)) ,(CHARACTER (CHARCODE EOL] RETURN (CDR ANSWER] (@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL] RETURN ANSWER))) [,(CHARACTER (CHARCODE CR)) "" RETURN ,(CHARACTER (CHARCODE SPACE] ("" "File name: " EXPLAINSTRING "a file name" KEYLST ()))) (RPAQQ LASTFILE NIL) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 8-Aug-2020 17:32 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only ")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22882 24587 (SEARCHPRETTYTYPELST 22892 . 23871) (PRETTYDEFMACROS 23873 . 24331) ( FILEPKGCOMPROPS 24333 . 24585)) (25389 59512 (CLEANUP 25399 . 26787) (COMPILEFILES 26789 . 27065) ( COMPILEFILES0 27067 . 27787) (CONTINUEDIT 27789 . 29209) (MAKEFILE 29211 . 40853) (FILECHANGES 40855 . 43190) (FILEPKG.MERGECHANGES 43192 . 44015) (FILEPKG.CHANGEDFNS 44017 . 44329) (MAKEFILE1 44331 . 48558) (COMPILE-FILE? 48560 . 50117) (MAKEFILES 50119 . 51812) (ADDFILE 51814 . 54335) (ADDFILE0 54337 . 58473) (LISTFILES 58475 . 59510)) (60200 95440 (FILEPKGCHANGES 60210 . 61560) (GETFILEPKGTYPE 61562 . 64635) (MARKASCHANGED 64637 . 66274) (FILECOMS 66276 . 66660) (WHEREIS 66662 . 68082) ( SMASHFILECOMS 68084 . 68319) (FILEFNSLST 68321 . 68483) (FILECOMSLST 68485 . 68969) (UPDATEFILES 68971 . 74271) (INFILECOMS? 74273 . 76176) (INFILECOMTAIL 76178 . 77318) (INFILECOMS 77320 . 77481) ( INFILECOM 77483 . 87692) (INFILECOMSVALS 87694 . 88021) (INFILECOMSVAL 88023 . 89025) (INFILECOMSPROP 89027 . 89856) (IFCPROPS 89858 . 91119) (IFCEXPRTYPE 91121 . 91632) (IFCPROPSCAN 91634 . 92687) ( IFCDECLARE 92689 . 94000) (INFILEPAIRS 94002 . 94334) (INFILECOMSMACRO 94336 . 95438)) (95475 126251 ( FILES? 95485 . 97678) (FILES?1 97680 . 98330) (FILES?PRINTLST 98332 . 99114) (ADDTOFILES? 99116 . 109718) (ADDTOFILE 109720 . 110636) (WHATIS 110638 . 112614) (ADDTOCOMS 112616 . 114260) (ADDTOCOM 114262 . 120809) (ADDTOCOM1 120811 . 121982) (ADDNEWCOM 121984 . 123034) (MAKENEWCOM 123036 . 124879) (DEFAULTMAKENEWCOM 124881 . 126249)) (126321 129138 (MERGEINSERT 126331 . 128674) (MERGEINSERT1 128676 . 129136)) (130657 141569 (DELFROMFILES 130667 . 131517) (DELFROMCOMS 131519 . 133198) (DELFROMCOM 133200 . 139068) (DELFROMCOM1 139070 . 139867) (REMOVEITEM 139869 . 140743) (MOVETOFILE 140745 . 141567)) (141783 144152 (SAVEPUT 141793 . 144150)) (144277 152601 (UNMARKASCHANGED 144287 . 145995) ( PREEDITFN 145997 . 148508) (POSTEDITPROPS 148510 . 151011) (POSTEDITALISTS 151013 . 152599)) (152750 173304 (ALISTS.GETDEF 152760 . 153139) (ALISTS.WHENCHANGED 153141 . 153785) (CLEARCLISPARRAY 153787 . 154961) (EXPRESSIONS.WHENCHANGED 154963 . 155337) (MAKEALISTCOMS 155339 . 156412) (MAKEFILESCOMS 156414 . 157851) (MAKELISPXMACROSCOMS 157853 . 159871) (MAKEPROPSCOMS 159873 . 160571) ( MAKEUSERMACROSCOMS 160573 . 162373) (PROPS.WHENCHANGED 162375 . 162996) (FILEGETDEF.LISPXMACROS 162998 . 164440) (FILEGETDEF.ALISTS 164442 . 165061) (FILEGETDEF.RECORDS 165063 . 165994) (FILEGETDEF.PROPS 165996 . 166788) (FILEGETDEF.MACROS 166790 . 167850) (FILEGETDEF.VARS 167852 . 168268) (FILEGETDEF.FNS 168270 . 169634) (FILEPKGCOMS.PUTDEF 169636 . 172076) (FILES.PUTDEF 172078 . 173035) (VARS.PUTDEF 173037 . 173180) (FILES.WHENCHANGED 173182 . 173302)) (175326 182759 (RENAME 175336 . 176737) ( CHANGECALLERS 176739 . 182757)) (182760 230708 (SHOWDEF 182770 . 183563) (COPYDEF 183565 . 186039) ( GETDEF 186041 . 188317) (GETDEFCOM 188319 . 189285) (GETDEFCOM0 189287 . 190633) (GETDEFCURRENT 190635 . 197055) (GETDEFERR 197057 . 198358) (GETDEFFROMFILE 198360 . 202640) (GETDEFSAVED 202642 . 203746) (PUTDEF 203748 . 204451) (EDITDEF 204453 . 205430) (DEFAULT.EDITDEF 205432 . 208268) (EDITDEF.FILES 208270 . 208471) (LOADDEF 208473 . 208649) (DWIMDEF 208651 . 209505) (DELDEF 209507 . 212521) ( DELFROMLIST 212523 . 213027) (HASDEF 213029 . 219351) (GETFILEDEF 219353 . 219875) (SAVEDEF 219877 . 221536) (UNSAVEDEF 221538 . 222434) (COMPAREDEFS 222436 . 225738) (COMPARE 225740 . 226444) (TYPESOF 226446 . 230706)) (230775 235818 (FIXEDITDATE 230785 . 234288) (EDITDATE? 234290 . 235816)) (236237 244823 (FILEPKGCOM 236247 . 241180) (FILEPKGTYPE 241182 . 244821)) (256860 271412 (FINDCALLERS 256870 . 257385) (EDITCALLERS 257387 . 265045) (EDITFROMFILE 265047 . 270727) (FINDATS 270729 . 271001) ( LOOKIN 271003 . 271410)) (271413 273140 (SEPRCASE 271423 . 273138)) (273657 279199 (IMPORTFILE 273667 . 274641) (IMPORTEVAL 274643 . 275523) (IMPORTFILESCAN 275525 . 275946) (CHECKIMPORTS 275948 . 277284 ) (GATHEREXPORTS 277286 . 278609) (\DUMPEXPORTS 278611 . 279197)) (279537 281745 (CLEARFILEPKG 279547 . 281743))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~4~ b/sources/FILEPKG.~4~ deleted file mode 100644 index 1ca197ac..00000000 --- a/sources/FILEPKG.~4~ +++ /dev/null @@ -1,2 +0,0 @@ -  (RPAQQ ADDTOFILEKEYLST (("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (% - "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T) (" " " " EXPLAINSTRING "{space} - no action" NOECHOFLG T) ("]" "Nowhere " EXPLAINSTRING "] - nowhere, item is marked as a dummy " NOECHOFLG T) ["(" "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFG (%) %] % % ) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% ) RETURN ANSWER))) (% "" RETURN % ) ("" "File name: " EXPLAINSTRING "a file name" KEYLST ()))) \ No newline at end of file diff --git a/sources/FILEPKG.~6~ b/sources/FILEPKG.~6~ deleted file mode 100644 index a0bfe4fb..00000000 --- a/sources/FILEPKG.~6~ +++ /dev/null @@ -1,13 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "18-Apr-2018 10:41:28" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;6 283387 changes to%: (FNS EDITCALLERS) previous date%: "16-Apr-2018 21:37:05" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;5) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (INITVARS [ADDTOFILEKEYLST (LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -"] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST )))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") '((Y "es ") (N "o ") (%] "Nowhere " EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (SELECTQ (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (SETQ FILE)) (% (* ; "space. means no action") (RETURN)) (% (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (RPAQ? ADDTOFILEKEYLST [LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (]) (RPAQ? LASTFILE ) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 18-Apr-2018 10:41 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22517 24222 (SEARCHPRETTYTYPELST 22527 . 23506) (PRETTYDEFMACROS 23508 . 23966) ( FILEPKGCOMPROPS 23968 . 24220)) (25024 58965 (CLEANUP 25034 . 26422) (COMPILEFILES 26424 . 26700) ( COMPILEFILES0 26702 . 27422) (CONTINUEDIT 27424 . 28844) (MAKEFILE 28846 . 40488) (FILECHANGES 40490 . 42825) (FILEPKG.MERGECHANGES 42827 . 43650) (FILEPKG.CHANGEDFNS 43652 . 43964) (MAKEFILE1 43966 . 48236) (COMPILE-FILE? 48238 . 49570) (MAKEFILES 49572 . 51265) (ADDFILE 51267 . 53788) (ADDFILE0 53790 . 57926) (LISTFILES 57928 . 58963)) (59653 94893 (FILEPKGCHANGES 59663 . 61013) (GETFILEPKGTYPE 61015 . 64088) (MARKASCHANGED 64090 . 65727) (FILECOMS 65729 . 66113) (WHEREIS 66115 . 67535) ( SMASHFILECOMS 67537 . 67772) (FILEFNSLST 67774 . 67936) (FILECOMSLST 67938 . 68422) (UPDATEFILES 68424 . 73724) (INFILECOMS? 73726 . 75629) (INFILECOMTAIL 75631 . 76771) (INFILECOMS 76773 . 76934) ( INFILECOM 76936 . 87145) (INFILECOMSVALS 87147 . 87474) (INFILECOMSVAL 87476 . 88478) (INFILECOMSPROP 88480 . 89309) (IFCPROPS 89311 . 90572) (IFCEXPRTYPE 90574 . 91085) (IFCPROPSCAN 91087 . 92140) ( IFCDECLARE 92142 . 93453) (INFILEPAIRS 93455 . 93787) (INFILECOMSMACRO 93789 . 94891)) (94928 125023 ( FILES? 94938 . 97131) (FILES?1 97133 . 97783) (FILES?PRINTLST 97785 . 98567) (ADDTOFILES? 98569 . 108490) (ADDTOFILE 108492 . 109408) (WHATIS 109410 . 111386) (ADDTOCOMS 111388 . 113032) (ADDTOCOM 113034 . 119581) (ADDTOCOM1 119583 . 120754) (ADDNEWCOM 120756 . 121806) (MAKENEWCOM 121808 . 123651) (DEFAULTMAKENEWCOM 123653 . 125021)) (125093 127910 (MERGEINSERT 125103 . 127446) (MERGEINSERT1 127448 . 127908)) (129054 139966 (DELFROMFILES 129064 . 129914) (DELFROMCOMS 129916 . 131595) (DELFROMCOM 131597 . 137465) (DELFROMCOM1 137467 . 138264) (REMOVEITEM 138266 . 139140) (MOVETOFILE 139142 . 139964)) (140180 142549 (SAVEPUT 140190 . 142547)) (142674 150998 (UNMARKASCHANGED 142684 . 144392) ( PREEDITFN 144394 . 146905) (POSTEDITPROPS 146907 . 149408) (POSTEDITALISTS 149410 . 150996)) (151147 171701 (ALISTS.GETDEF 151157 . 151536) (ALISTS.WHENCHANGED 151538 . 152182) (CLEARCLISPARRAY 152184 . 153358) (EXPRESSIONS.WHENCHANGED 153360 . 153734) (MAKEALISTCOMS 153736 . 154809) (MAKEFILESCOMS 154811 . 156248) (MAKELISPXMACROSCOMS 156250 . 158268) (MAKEPROPSCOMS 158270 . 158968) ( MAKEUSERMACROSCOMS 158970 . 160770) (PROPS.WHENCHANGED 160772 . 161393) (FILEGETDEF.LISPXMACROS 161395 . 162837) (FILEGETDEF.ALISTS 162839 . 163458) (FILEGETDEF.RECORDS 163460 . 164391) (FILEGETDEF.PROPS 164393 . 165185) (FILEGETDEF.MACROS 165187 . 166247) (FILEGETDEF.VARS 166249 . 166665) (FILEGETDEF.FNS 166667 . 168031) (FILEPKGCOMS.PUTDEF 168033 . 170473) (FILES.PUTDEF 170475 . 171432) (VARS.PUTDEF 171434 . 171577) (FILES.WHENCHANGED 171579 . 171699)) (173723 181156 (RENAME 173733 . 175134) ( CHANGECALLERS 175136 . 181154)) (181157 229105 (SHOWDEF 181167 . 181960) (COPYDEF 181962 . 184436) ( GETDEF 184438 . 186714) (GETDEFCOM 186716 . 187682) (GETDEFCOM0 187684 . 189030) (GETDEFCURRENT 189032 . 195452) (GETDEFERR 195454 . 196755) (GETDEFFROMFILE 196757 . 201037) (GETDEFSAVED 201039 . 202143) (PUTDEF 202145 . 202848) (EDITDEF 202850 . 203827) (DEFAULT.EDITDEF 203829 . 206665) (EDITDEF.FILES 206667 . 206868) (LOADDEF 206870 . 207046) (DWIMDEF 207048 . 207902) (DELDEF 207904 . 210918) ( DELFROMLIST 210920 . 211424) (HASDEF 211426 . 217748) (GETFILEDEF 217750 . 218272) (SAVEDEF 218274 . 219933) (UNSAVEDEF 219935 . 220831) (COMPAREDEFS 220833 . 224135) (COMPARE 224137 . 224841) (TYPESOF 224843 . 229103)) (229172 234215 (FIXEDITDATE 229182 . 232685) (EDITDATE? 232687 . 234213)) (234634 243220 (FILEPKGCOM 234644 . 239577) (FILEPKGTYPE 239579 . 243218)) (255257 269759 (FINDCALLERS 255267 . 255782) (EDITCALLERS 255784 . 263392) (EDITFROMFILE 263394 . 269074) (FINDATS 269076 . 269348) ( LOOKIN 269350 . 269757)) (269760 271487 (SEPRCASE 269770 . 271485)) (272004 277546 (IMPORTFILE 272014 . 272988) (IMPORTEVAL 272990 . 273870) (IMPORTFILESCAN 273872 . 274293) (CHECKIMPORTS 274295 . 275631 ) (GATHEREXPORTS 275633 . 276956) (\DUMPEXPORTS 276958 . 277544)) (277884 280092 (CLEARFILEPKG 277894 . 280090))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~7~ b/sources/FILEPKG.~7~ deleted file mode 100644 index eae35d0e..00000000 --- a/sources/FILEPKG.~7~ +++ /dev/null @@ -1,13 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 7-Mar-2020 14:09:52" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;7 284219 changes to%: (VARS FILEPKGCOMS) previous date%: "18-Apr-2018 10:41:28" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;6) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (INITVARS [ADDTOFILEKEYLST (LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -"] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST)))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") '((Y "es ") (N "o ") (%] "Nowhere " EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (SELECTQ (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (SETQ FILE)) (% (* ; "space. means no action") (RETURN)) (% (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (RPAQ? ADDTOFILEKEYLST [LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (]) (RPAQ? LASTFILE ) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 18-Apr-2018 10:41 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22680 24385 (SEARCHPRETTYTYPELST 22690 . 23669) (PRETTYDEFMACROS 23671 . 24129) ( FILEPKGCOMPROPS 24131 . 24383)) (25182 59123 (CLEANUP 25192 . 26580) (COMPILEFILES 26582 . 26858) ( COMPILEFILES0 26860 . 27580) (CONTINUEDIT 27582 . 29002) (MAKEFILE 29004 . 40646) (FILECHANGES 40648 . 42983) (FILEPKG.MERGECHANGES 42985 . 43808) (FILEPKG.CHANGEDFNS 43810 . 44122) (MAKEFILE1 44124 . 48394) (COMPILE-FILE? 48396 . 49728) (MAKEFILES 49730 . 51423) (ADDFILE 51425 . 53946) (ADDFILE0 53948 . 58084) (LISTFILES 58086 . 59121)) (59811 95051 (FILEPKGCHANGES 59821 . 61171) (GETFILEPKGTYPE 61173 . 64246) (MARKASCHANGED 64248 . 65885) (FILECOMS 65887 . 66271) (WHEREIS 66273 . 67693) ( SMASHFILECOMS 67695 . 67930) (FILEFNSLST 67932 . 68094) (FILECOMSLST 68096 . 68580) (UPDATEFILES 68582 . 73882) (INFILECOMS? 73884 . 75787) (INFILECOMTAIL 75789 . 76929) (INFILECOMS 76931 . 77092) ( INFILECOM 77094 . 87303) (INFILECOMSVALS 87305 . 87632) (INFILECOMSVAL 87634 . 88636) (INFILECOMSPROP 88638 . 89467) (IFCPROPS 89469 . 90730) (IFCEXPRTYPE 90732 . 91243) (IFCPROPSCAN 91245 . 92298) ( IFCDECLARE 92300 . 93611) (INFILEPAIRS 93613 . 93945) (INFILECOMSMACRO 93947 . 95049)) (95086 125181 ( FILES? 95096 . 97289) (FILES?1 97291 . 97941) (FILES?PRINTLST 97943 . 98725) (ADDTOFILES? 98727 . 108648) (ADDTOFILE 108650 . 109566) (WHATIS 109568 . 111544) (ADDTOCOMS 111546 . 113190) (ADDTOCOM 113192 . 119739) (ADDTOCOM1 119741 . 120912) (ADDNEWCOM 120914 . 121964) (MAKENEWCOM 121966 . 123809) (DEFAULTMAKENEWCOM 123811 . 125179)) (125251 128068 (MERGEINSERT 125261 . 127604) (MERGEINSERT1 127606 . 128066)) (129806 140718 (DELFROMFILES 129816 . 130666) (DELFROMCOMS 130668 . 132347) (DELFROMCOM 132349 . 138217) (DELFROMCOM1 138219 . 139016) (REMOVEITEM 139018 . 139892) (MOVETOFILE 139894 . 140716)) (140932 143301 (SAVEPUT 140942 . 143299)) (143426 151750 (UNMARKASCHANGED 143436 . 145144) ( PREEDITFN 145146 . 147657) (POSTEDITPROPS 147659 . 150160) (POSTEDITALISTS 150162 . 151748)) (151899 172453 (ALISTS.GETDEF 151909 . 152288) (ALISTS.WHENCHANGED 152290 . 152934) (CLEARCLISPARRAY 152936 . 154110) (EXPRESSIONS.WHENCHANGED 154112 . 154486) (MAKEALISTCOMS 154488 . 155561) (MAKEFILESCOMS 155563 . 157000) (MAKELISPXMACROSCOMS 157002 . 159020) (MAKEPROPSCOMS 159022 . 159720) ( MAKEUSERMACROSCOMS 159722 . 161522) (PROPS.WHENCHANGED 161524 . 162145) (FILEGETDEF.LISPXMACROS 162147 . 163589) (FILEGETDEF.ALISTS 163591 . 164210) (FILEGETDEF.RECORDS 164212 . 165143) (FILEGETDEF.PROPS 165145 . 165937) (FILEGETDEF.MACROS 165939 . 166999) (FILEGETDEF.VARS 167001 . 167417) (FILEGETDEF.FNS 167419 . 168783) (FILEPKGCOMS.PUTDEF 168785 . 171225) (FILES.PUTDEF 171227 . 172184) (VARS.PUTDEF 172186 . 172329) (FILES.WHENCHANGED 172331 . 172451)) (174554 181987 (RENAME 174564 . 175965) ( CHANGECALLERS 175967 . 181985)) (181988 229936 (SHOWDEF 181998 . 182791) (COPYDEF 182793 . 185267) ( GETDEF 185269 . 187545) (GETDEFCOM 187547 . 188513) (GETDEFCOM0 188515 . 189861) (GETDEFCURRENT 189863 . 196283) (GETDEFERR 196285 . 197586) (GETDEFFROMFILE 197588 . 201868) (GETDEFSAVED 201870 . 202974) (PUTDEF 202976 . 203679) (EDITDEF 203681 . 204658) (DEFAULT.EDITDEF 204660 . 207496) (EDITDEF.FILES 207498 . 207699) (LOADDEF 207701 . 207877) (DWIMDEF 207879 . 208733) (DELDEF 208735 . 211749) ( DELFROMLIST 211751 . 212255) (HASDEF 212257 . 218579) (GETFILEDEF 218581 . 219103) (SAVEDEF 219105 . 220764) (UNSAVEDEF 220766 . 221662) (COMPAREDEFS 221664 . 224966) (COMPARE 224968 . 225672) (TYPESOF 225674 . 229934)) (230003 235046 (FIXEDITDATE 230013 . 233516) (EDITDATE? 233518 . 235044)) (235465 244051 (FILEPKGCOM 235475 . 240408) (FILEPKGTYPE 240410 . 244049)) (256084 270586 (FINDCALLERS 256094 . 256609) (EDITCALLERS 256611 . 264219) (EDITFROMFILE 264221 . 269901) (FINDATS 269903 . 270175) ( LOOKIN 270177 . 270584)) (270587 272314 (SEPRCASE 270597 . 272312)) (272831 278373 (IMPORTFILE 272841 . 273815) (IMPORTEVAL 273817 . 274697) (IMPORTFILESCAN 274699 . 275120) (CHECKIMPORTS 275122 . 276458 ) (GATHEREXPORTS 276460 . 277783) (\DUMPEXPORTS 277785 . 278371)) (278711 280919 (CLEARFILEPKG 278721 . 280917))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~8~ b/sources/FILEPKG.~8~ deleted file mode 100644 index 2c62c32a..00000000 --- a/sources/FILEPKG.~8~ +++ /dev/null @@ -1,13 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 7-Mar-2020 14:24:19" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;8 284246 changes to%: (VARS FILEPKGCOMS) previous date%: " 7-Mar-2020 14:09:52" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;7) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (* ;; "RMK: Changed INITVARS to VARS, so = addition works") (VARS [ADDTOFILEKEYLST (LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T ) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -"] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST)))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") '((Y "es ") (N "o ") (%] "Nowhere " EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (SELECTQ (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (SETQ FILE)) (% (* ; "space. means no action") (RETURN)) (% (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (* ;; "RMK: Changed INITVARS to VARS, so = addition works") (RPAQ ADDTOFILEKEYLST [LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (]) (RPAQQ LASTFILE NIL) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 18-Apr-2018 10:41 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22660 24365 (SEARCHPRETTYTYPELST 22670 . 23649) (PRETTYDEFMACROS 23651 . 24109) ( FILEPKGCOMPROPS 24111 . 24363)) (25162 59103 (CLEANUP 25172 . 26560) (COMPILEFILES 26562 . 26838) ( COMPILEFILES0 26840 . 27560) (CONTINUEDIT 27562 . 28982) (MAKEFILE 28984 . 40626) (FILECHANGES 40628 . 42963) (FILEPKG.MERGECHANGES 42965 . 43788) (FILEPKG.CHANGEDFNS 43790 . 44102) (MAKEFILE1 44104 . 48374) (COMPILE-FILE? 48376 . 49708) (MAKEFILES 49710 . 51403) (ADDFILE 51405 . 53926) (ADDFILE0 53928 . 58064) (LISTFILES 58066 . 59101)) (59791 95031 (FILEPKGCHANGES 59801 . 61151) (GETFILEPKGTYPE 61153 . 64226) (MARKASCHANGED 64228 . 65865) (FILECOMS 65867 . 66251) (WHEREIS 66253 . 67673) ( SMASHFILECOMS 67675 . 67910) (FILEFNSLST 67912 . 68074) (FILECOMSLST 68076 . 68560) (UPDATEFILES 68562 . 73862) (INFILECOMS? 73864 . 75767) (INFILECOMTAIL 75769 . 76909) (INFILECOMS 76911 . 77072) ( INFILECOM 77074 . 87283) (INFILECOMSVALS 87285 . 87612) (INFILECOMSVAL 87614 . 88616) (INFILECOMSPROP 88618 . 89447) (IFCPROPS 89449 . 90710) (IFCEXPRTYPE 90712 . 91223) (IFCPROPSCAN 91225 . 92278) ( IFCDECLARE 92280 . 93591) (INFILEPAIRS 93593 . 93925) (INFILECOMSMACRO 93927 . 95029)) (95066 125161 ( FILES? 95076 . 97269) (FILES?1 97271 . 97921) (FILES?PRINTLST 97923 . 98705) (ADDTOFILES? 98707 . 108628) (ADDTOFILE 108630 . 109546) (WHATIS 109548 . 111524) (ADDTOCOMS 111526 . 113170) (ADDTOCOM 113172 . 119719) (ADDTOCOM1 119721 . 120892) (ADDNEWCOM 120894 . 121944) (MAKENEWCOM 121946 . 123789) (DEFAULTMAKENEWCOM 123791 . 125159)) (125231 128048 (MERGEINSERT 125241 . 127584) (MERGEINSERT1 127586 . 128046)) (129833 140745 (DELFROMFILES 129843 . 130693) (DELFROMCOMS 130695 . 132374) (DELFROMCOM 132376 . 138244) (DELFROMCOM1 138246 . 139043) (REMOVEITEM 139045 . 139919) (MOVETOFILE 139921 . 140743)) (140959 143328 (SAVEPUT 140969 . 143326)) (143453 151777 (UNMARKASCHANGED 143463 . 145171) ( PREEDITFN 145173 . 147684) (POSTEDITPROPS 147686 . 150187) (POSTEDITALISTS 150189 . 151775)) (151926 172480 (ALISTS.GETDEF 151936 . 152315) (ALISTS.WHENCHANGED 152317 . 152961) (CLEARCLISPARRAY 152963 . 154137) (EXPRESSIONS.WHENCHANGED 154139 . 154513) (MAKEALISTCOMS 154515 . 155588) (MAKEFILESCOMS 155590 . 157027) (MAKELISPXMACROSCOMS 157029 . 159047) (MAKEPROPSCOMS 159049 . 159747) ( MAKEUSERMACROSCOMS 159749 . 161549) (PROPS.WHENCHANGED 161551 . 162172) (FILEGETDEF.LISPXMACROS 162174 . 163616) (FILEGETDEF.ALISTS 163618 . 164237) (FILEGETDEF.RECORDS 164239 . 165170) (FILEGETDEF.PROPS 165172 . 165964) (FILEGETDEF.MACROS 165966 . 167026) (FILEGETDEF.VARS 167028 . 167444) (FILEGETDEF.FNS 167446 . 168810) (FILEPKGCOMS.PUTDEF 168812 . 171252) (FILES.PUTDEF 171254 . 172211) (VARS.PUTDEF 172213 . 172356) (FILES.WHENCHANGED 172358 . 172478)) (174581 182014 (RENAME 174591 . 175992) ( CHANGECALLERS 175994 . 182012)) (182015 229963 (SHOWDEF 182025 . 182818) (COPYDEF 182820 . 185294) ( GETDEF 185296 . 187572) (GETDEFCOM 187574 . 188540) (GETDEFCOM0 188542 . 189888) (GETDEFCURRENT 189890 . 196310) (GETDEFERR 196312 . 197613) (GETDEFFROMFILE 197615 . 201895) (GETDEFSAVED 201897 . 203001) (PUTDEF 203003 . 203706) (EDITDEF 203708 . 204685) (DEFAULT.EDITDEF 204687 . 207523) (EDITDEF.FILES 207525 . 207726) (LOADDEF 207728 . 207904) (DWIMDEF 207906 . 208760) (DELDEF 208762 . 211776) ( DELFROMLIST 211778 . 212282) (HASDEF 212284 . 218606) (GETFILEDEF 218608 . 219130) (SAVEDEF 219132 . 220791) (UNSAVEDEF 220793 . 221689) (COMPAREDEFS 221691 . 224993) (COMPARE 224995 . 225699) (TYPESOF 225701 . 229961)) (230030 235073 (FIXEDITDATE 230040 . 233543) (EDITDATE? 233545 . 235071)) (235492 244078 (FILEPKGCOM 235502 . 240435) (FILEPKGTYPE 240437 . 244076)) (256111 270613 (FINDCALLERS 256121 . 256636) (EDITCALLERS 256638 . 264246) (EDITFROMFILE 264248 . 269928) (FINDATS 269930 . 270202) ( LOOKIN 270204 . 270611)) (270614 272341 (SEPRCASE 270624 . 272339)) (272858 278400 (IMPORTFILE 272868 . 273842) (IMPORTEVAL 273844 . 274724) (IMPORTFILESCAN 274726 . 275147) (CHECKIMPORTS 275149 . 276485 ) (GATHEREXPORTS 276487 . 277810) (\DUMPEXPORTS 277812 . 278398)) (278738 280946 (CLEARFILEPKG 278748 . 280944))))) STOP \ No newline at end of file diff --git a/sources/FILEPKG.~9~ b/sources/FILEPKG.~9~ deleted file mode 100644 index 88375137..00000000 --- a/sources/FILEPKG.~9~ +++ /dev/null @@ -1,13 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 8-Aug-2020 17:33:31" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;9 283711 changes to%: (FNS EDITCALLERS) previous date%: " 7-Mar-2020 14:24:19" {DSK}kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;8) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation. All rights reserved. The following program was created in 1982 but has not been published within the meaning of the copyright law, is furnished under license, and may not be used, copied and/or disclosed except in accordance with the terms of said license. ") (PRETTYCOMPRINT FILEPKGCOMS) (RPAQQ FILEPKGCOMS [(COMS (* ;  "standard records for accessing file package type/command parts. Exported for PRETTY") (VARS FILEPKGTYPEPROPS) (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS))) (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS) (INITRECORDS * FILEPKGRECORDS)) [DECLARE%: EVAL@COMPILE DOCOPY (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.") (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) [COMS (* ;; "making, adding, listing, compiling files") (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE ADDFILE0 LISTFILES) (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (FILELST) (LOADEDFILELST) (NOTLISTEDFILES) (NOTCOMPILEDFILES) (MAKEFILEFORMS) (NILCOMS)) (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C))) (INITVARS (MAKEFILEREMAKEFLG T) (CLEANUPOPTIONS '(RC] (COMS (* ;; "scanning file coms") (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS INFILECOMSMACRO)) (COMS (* ;; "adding to a file") (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM) (INITVARS (DEFAULTCOMHASFILEFLG)) (ADDVARS (MARKASCHANGEDFNS)) (FNS MERGEINSERT MERGEINSERT1) (* ;; "RMK: Changed INITVARS to VARS, so = addition works") (VARS [ADDTOFILEKEYLST (LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T ) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (] (LASTFILE))) (COMS (* ;; "deleting an item from a file") (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE) (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T)) (ADDVARS (SYSPROPS PROPTYPE VARTYPE))) [COMS (* ;  "functions for doing things and marking them changed and auxiliary functions") (FNS SAVEPUT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT] (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS) (ADDVARS (LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT] (COMS (* ;  "sub-functions for file package commands & types") (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED) (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO) (SYSPROPS PROPTYPE)) (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT FILETYPE) (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS PRETTYPRINTYPEMACROS USERMACROS)) (COMS (* ;  "Define the commands below AFTER the various properties have been established.") (USERMACROS M)) (COMS (* ; "GETDEF methods") (FNS RENAME CHANGECALLERS) (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF) (INITVARS (WHEREIS.HASH))) (* ; "Must come after PUTDEF") (FNS FIXEDITDATE EDITDATE?) (* ;  "Edit date support for all kinds of definers (from PARC 6/10/92)") [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES)) (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES] (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) (COMS (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.") (FNS FILEPKGCOM FILEPKGTYPE) (PROP ARGNAMES FILEPKGCOM) (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS) (FILEPKGTYPES FILEPKGCOMS)) (FILEPKGCOMS FILEPKGCOMS) (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS)) (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS))) (INITVARS (SAVEDDEFS)) (COMS (* ; "EDITCALLERS") (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN) (FNS SEPRCASE) [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL] (INITVARS (SEPRCASEARRAYS) (CLISPCASEARRAYS)) (P (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE")) (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM))) (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)) (COMS (* ; "EXPORT") (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS) (FILEPKGCOMS EXPORT) [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"] (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)) (COMS (* ; "for GAINSPACE") (FNS CLEARFILEPKG) [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -"] (GLOBALVARS SMASHPROPSLST1)) (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (ADDFILE ADDFILE ADDFILE0) (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (NLAML) (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES]) (* ; "standard records for accessing file package type/command parts. Exported for PRETTY") (RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF CANFILEDEF FILEGETDEF)) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (DECLARE%: EVAL@COMPILE (ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'ADDTOPRETTYCOM] [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE)) (T (/REMPROP DATUM 'DELFROMPRETTYCOM] [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE)) (T (/REMPROP DATUM 'PRETTYTYPE] [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS) (UNDOABLE (COND (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE)) (T (/REMPROP DATUM 'FILEPKGCONTENTS] (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS] (STANDARD [COND [NEWVALUE (PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] UNDOABLE (COND [NEWVALUE (/PUTASSOC DATUM NEWVALUE (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS)) (/SETTOPVAL 'PRETTYDEFMACROS (LIST (LIST DATUM] (T (/SETTOPVAL 'PRETTYDEFMACROS (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS)) (GETTOPVAL 'PRETTYDEFMACROS] (* Not an atom record cause want  REMPROP on NILs.) (* NOTE%: PRETTCOM on PRETTY has  open-coded access to the MACRO  property.) (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS))) (ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF EDITDEF FILEGETDEF CANFILEDEF) (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM)) (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) ) (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))) (STANDARD (SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE) ) NEWVALUE) UNDOABLE (/SETTOPVAL (CAR ( SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM))) (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM NEWVALUE)) NEWVALUE))) (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST (REMOVE (SEARCHPRETTYTYPELST DATUM) (GETTOPVAL 'PRETTYTYPELST] (* NOTE%: PRETTYCOM on PRETTY has  open-coded access to GETDEF property) (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST )))) (ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP) [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE) (STANDARD (PUTPROP DATUM 'FILE NEWVALUE) UNDOABLE (/PUTPROP DATUM 'FILE NEWVALUE]) (RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME)) (RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED)) ) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (SEARCHPRETTYTYPELST [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ;  "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) TYPE NIL)) (GETTOPVAL 'PRETTYTYPELST] (OR (LISTP (GETTOPVAL (CAR FLG))) (/SETTOPVAL (CAR FLG) NIL)) FLG]) (PRETTYDEFMACROS [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ;  "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) 'MACRO (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS (MAPC PROPS (FUNCTION (LAMBDA (Y) (OR (MEMB Y SYSPROPS) (SETQ SYSPROPS (CONS Y SYSPROPS))) (PUT Y 'PROPTYPE 'FILEPKGCOMS]) ) (RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP)) (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS) [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS)) (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X) (PUT X 'PROPTYPE 'FILEPKGCOMS] (ADDTOVAR PRETTYTYPELST ) (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) ) (RPAQ? MSDATABASELST ) (* ;; "making, adding, listing, compiling files") (DEFINEQ (CLEANUP [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (SETQ OPTIONS (CAR FILES)) (SETQ FILES (CDR FILES))) (T (SETQ OPTIONS CLEANUPOPTIONS))) (RETURN (APPEND (MAKEFILES OPTIONS FILES) (COND ((NOT (MEMB 'LIST OPTIONS)) NIL) ((NULL FILES) (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ;  "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] ((NULL FILES) (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES) (CDR TEM1)) TEM2) ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES)) (COMPILEFILES0 TEM2 (CDR TEM1)) TEM2]) (COMPILEFILES [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) (CAR FILES))) (T (COMPILEFILES0 FILES]) (COMPILEFILES0 [LAMBDA (FILES OPTIONS) (* rmk%: "19-FEB-83 21:59") (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES) first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS)) (C (SETQ RCFLG NIL) (CDR OPTIONS)) (RC (CDR OPTIONS)) OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X) 70 FILELST NIL X) (CAR X)) RCFLG OPTS X]) (CONTINUEDIT [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (SETQ FILE (FULLNAME STREAM)) (SETFILEPTR STREAM 0) (CL:MULTIPLE-VALUE-SETQ (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN))) (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ;  "also calls addfile to notice the file.") )) (/replace FILECHANGES of FL with (FILECHANGES FC)) [/replace FILEDATES of FL with (LIST (create FILEDATEPAIR FILEDATE _ (CADR FC) DATEFILENAME _ FILE) (create FILEDATEPAIR FILEDATE _ [CAR (SETQ TEM (CDR (MEMB 'date%: FC] DATEFILENAME _ (CADR TEM] (RETURN FILE]) (MAKEFILE [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 29-Aug-89 11:46 by bvm") (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.") (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS] PRETTYFLG)) (*PRINT-BASE* (if (EQ *PRINT-BASE* 8) then 8 else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments") 10)) FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE))) (DECLARE (CL:SPECIAL PRETTYFLG)) (SETQ FILE (CAR Z)) (* ;  "Necessary because FILE might have been misspelled.") (SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.") (SETQ FILEPROP (CDDR Z)) (UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.") (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP)) (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME))) (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE)) LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP)) (NULL FILEDATES)) then (* ;  "File has never been loaded and never dumped i.e. user just set up COMS in core") elseif [OR (EQMEMB 'NEW OPTIONS) (AND (NULL MAKEFILEREMAKEFLG) (NOT (MEMB 'REMAKE OPTIONS] then (COND ((AND (fetch LOADTYPE of FILEPROP) (NEQ T (fetch LOADTYPE of FILEPROP))) (LISPXPRIN2 FILE T T) (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP "the file was loaded for compilation purposes only") ((compiled Compiled COMPILED) " -- only the compiled file has been loaded ") ((loadfns LOADFNS) " -- only some of its symbolics have been loaded ") (SHOULDNT)) T) (COND ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ") 'Y) (* ;  "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.") (GO OUT))) (/replace LOADTYPE of FILEPROP with NIL))) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) elseif SOURCEFILE then (* ; "source file given") elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T)) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE (fetch DATEFILENAME of (CAR FILEDATES ] (INFILEP SOURCEFILE) (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CAR FILEDATES] then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE) (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))) elseif [AND (CDR FILEDATES) [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES] (EQUAL (FILEDATE SOURCEFILE) (fetch FILEDATE of (CADR FILEDATES] then (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.") (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP) (fetch FILECHANGES of ROOTNAME))) (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)) else (LISPXPRIN1 '"can't find either the previous version or the original version of " T) (LISPXPRIN2 FILE T T) (LISPXPRIN1 '", so it will have to be written anew " T) (SETQ SOURCEFILE NIL) (SETQ REPRINTFNS NIL) (push OPTIONS 'NEW) (SETQ CHANGES (fetch FILECHANGES of ROOTNAME)) (GO LP0)) (COND ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "only loaded via LOADCOMP. Need to do LOADFROM") (LIST 'N SOURCEFILE "was loaded with LOADCOMP" '- "LOADFROM it to obtain VARS/COMS")) (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%: (fetch COMSNAME of FILEPROP)) (LIST 'Y "only compiled version of" ROOTNAME "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions" ))) ((compiled loadfns) (LIST 'N "Only some functions from" SOURCEFILE "loaded via LOADFNS. Load all other expressions from it" )) NIL))) (SELECTQ [ASKUSER DWIMWAIT (CAR Z) (CDR Z) '((Y "es ") (N "o ") (A "bort MAKEFILE "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ;  "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled (* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.") (LOADVARS 'DONTCOPY SOURCEFILE) (/replace LOADTYPE of FILEPROP with 'COMPILED) (* ; "So wont have to be done again.") (* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)") ) ((loadfns compiled) (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.") (LOADVARS T SOURCEFILE)) NIL)) (A (GO OUT)) NIL))) (RESETLST [COND ((MEMB 'NOCLISP OPTIONS) (RESETSAVE PRETTYTRANFLG T)) ((MEMB 'CLISP% OPTIONS) (RESETSAVE PRETTYTRANFLG 'BOTH] (RESETSAVE %#UNDOSAVES) [COND ((OR (MEMB 'CLISPIFY OPTIONS) (MEMB 'CLISP OPTIONS)) (RESETSAVE CLISPIFYPRETTYFLG T)) ((OR (EQ FILETYPE 'CLISP) (MEMB 'CLISP (LISTP FILETYPE))) (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES] (for X in MAKEFILEFORMS do (ERSETQ (EVAL X))) (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP) REPRINTFNS SOURCEFILE CHANGES))) (SETQ LASTFILE ROOTNAME) (/replace TOBEDUMPED of FILEPROP with NIL) (COND ((NOT (EQMEMB 'DON'TLIST FILETYPE)) (pushnew NOTLISTEDFILES ROOTNAME))) (COND ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE)) (pushnew NOTCOMPILEDFILES ROOTNAME))) [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL)) (SELECTQ OPT (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE T (CDR TAIL)))) (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES) (MAKEFILE1 FILE NIL (CDR TAIL)))) (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES) (APPLY 'LISTFILES (LIST FILE)))) (COND ((MEMB OPT MAKEFILEOPTIONS)) ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL OPTIONS) (GO $$LP)) (T (ERROR "Unrecognized MAKEFILE option" OPT] (RETURN FILE) OUT (RETURN (LIST FILE "-- MAKEFILE not performed."]) (FILECHANGES [LAMBDA (FILE TYPE) (* bvm%: "30-Aug-86 15:08") (* ;; "If FILE is a list, it is assumed to be a file-created expressions; otherwise, the filecreated expression is read from FILE. If TYPE, returns the list of changed items of that type from the changes expression. If TYPE=NIL, returns the whole list of typed change-lists") (PROG ([FCEXPR (OR (LISTP FILE) (AND FILE (RESETLST (LET (OLDPTR STREAM) [if (SETQ STREAM (OPENP FILE 'INPUT)) then (SETQ OLDPTR (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0) else (RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] (CL:MULTIPLE-VALUE-BIND (ENV FC) (\PARSE-FILE-HEADER STREAM 'RETURN) (if OLDPTR then (SETFILEPTR STREAM OLDPTR)) FC)))] FNS CHANGES) (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR))) (MEMB 'previous CHANGES))) [if (AND TYPE (NEQ TYPE 'FNS)) then (RETURN (CDR (ASSOC TYPE CHANGES] (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM))) (* ;  "Old style changes expression listed FNS by name and other things by type") (RETURN (if TYPE then (* ; "TYPE=FNS cause of test above.") (NCONC FNS (CDR (ASSOC 'FNS CHANGES))) elseif FNS then (CONS (CONS 'FNS FNS) (SUBSET CHANGES (FUNCTION LISTP))) else CHANGES]) (FILEPKG.MERGECHANGES [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") (* ;; "Merges 2 changes lists into a single one. Treat LITATOM's as FNS, to accomodate old-style format on files.") (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND E1))) in C2 do [COND ((SETQ TEMP (ASSOC (CAR E2) VAL)) (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP)) collect X))) (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL]) (FILEPKG.CHANGEDFNS [LAMBDA (CHANGES) (* rmk%: "20-MAY-82 22:00") (* ;; "Returns list of function names from a file-changes list. Interprets old format (functions are atoms) and new format (with explicit type headers)") (CDR (ASSOC 'FNS CHANGES]) (MAKEFILE1 [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES) (* ; "Edited 29-Aug-89 11:46 by bvm") (PROG* ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? ROOTNAME)) GROUP) (COND ((AND (OR (EQ COMPILER 'BCOMPL) (EQ COMPILER 'TCOMPL)) (NOT (FILEFNSLST ROOTNAME))) (* ;  "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.") (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES)) (RETURN NIL))) (COND ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP)) suchthat (AND (NEQ X ROOTNAME) (OR (fetch TOBEDUMPED of (fetch FILEPROP of X)) (MEMB X OTHERFILES] (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled. Wait.") (RETURN))) (LISPXPRIN1 '" compiling " T) (LISPXPRINT (OR GROUP FILE) T T) (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS) 'ST) (EQ (CAR OPTIONS) 'STF] (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER ((FAKE-COMPILE-FILE) (* ;  "The old CommonLispy interface to the ByteCompiler.") (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS (AND REDEFINE? (NOT FORGET-EXPRS?)))) ((CL:COMPILE-FILE) (* ; "The new, improved (?) compiler") (CL:COMPILE-FILE FILE :LOAD (COND ((AND REDEFINE? (NOT FORGET-EXPRS? )) :SAVE) (REDEFINE? T) (T NIL)))) ((TCOMPL BCOMPL) (* ; "The old ByteCompiler") [IF (MEMB (CAR OPTIONS) '(ST F S STF)) THEN (LISPXUNREAD (LIST (CAR OPTIONS] [IF GROUP THEN (* ;;  "File contained in FILEGROUP. Therefore must be blockcompiled.") (IF RECOMPFLG THEN (BRECOMPILE GROUP) ELSE (BCOMPL GROUP)) ELSEIF (EQ COMPILER 'TCOMPL) THEN (IF RECOMPFLG THEN (RECOMPILE FILE) ELSE (TCOMPL (LIST FILE))) ELSE (IF RECOMPFLG THEN (BRECOMPILE FILE) ELSE (BCOMPL (LIST FILE]) (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?..."))) T T]) (COMPILE-FILE? [LAMBDA (ROOTNAME) (* ; "Edited 19-Jan-87 21:12 by Pavel") (* ;;; "Which compiler should CLEANUP use?") (LET ((TYPE (GET ROOTNAME 'FILETYPE)) (UNKNOWN NIL)) (FOR X INSIDE TYPE DO (SELECTQ X ((TCOMPL :TCOMPL) (RETURN 'TCOMPL)) ((BCOMPL :BCOMPL) (RETURN 'BCOMPL)) ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) (RETURN 'FAKE-COMPILE-FILE)) ((:COMPILE-FILE :XCL-COMPILE-FILE) (RETURN 'CL:COMPILE-FILE)) ((CLISP) NIL) (SETQ UNKNOWN T)) FINALLY (IF UNKNOWN THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE )) (RETURN *DEFAULT-CLEANUP-COMPILER*]) (MAKEFILES [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ;  "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE (COND ((NULL FLG) (* ; "Gets printed the first time") ' "****NOTE: the following are not contained on any file: ") (T '" "] do (SETQ FLG T) finally (AND FLG (ADDTOFILES?] (SETQ OPTIONS (MKLIST OPTIONS)) (RETURN (for FILE inside (OR FILES FILELST) when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP of (ROOTFILENAME FILE] collect (LISPXPRIN2 FILE T T) (LISPXPRIN1 '|...| T) (PROG1 (MAKEFILE FILE OPTIONS) (LISPXTERPRI T]) (ADDFILE [LAMBDA (FILE LOADTYPE PRLST FCLST) (* bvm%: "29-Aug-86 12:22") (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.") (PROG ((ROOTNAME (ROOTFILENAME FILE)) FLST VAL) [COND ((NOT FCLST) (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE))) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND ((LITATOM (CADR FCLST)) (ROOTFILENAME (CADR FCLST))) (T ROOTNAME)) LOADTYPE FILE (CAR FCLST] (T (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.") (SELECTQ LOADTYPE ((T LOADFNS) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ;  "loadcomp on compiled file. Don't notice since we don't know what its state is") NIL) (SHOULDNT)) (for X in (CDR FCLST) when (LITATOM (CADR X)) do (push FLST (CADR X)) (OR (EQ LOADTYPE 'LOADCOMP) (ADDFILE0 (ROOTFILENAME (CADR X)) LOADTYPE (CADR X) (CAR X] (UPDATEFILES PRLST (OR FLST (LIST FILE))) [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES when (AND (LITATOM TYPE) (SETQ CHANGED (fetch CHANGED of TYPE))) do (/replace CHANGED of TYPE with (INTERSECTION (CDR (ASSOC TYPE PRLST)) CHANGED] (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS)) (RETURN VAL]) (ADDFILE0 [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME)) (COND ([AND LOADTYPE (FMEMB LOADTYPE (CDR (FMEMB (fetch LOADTYPE of FILEPROP) '(LOADCOMP loadfns compiled Compiled LOADFNS COMPILED NIL T] (/replace LOADTYPE of FILEPROP with LOADTYPE) (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in. e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file. LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.") (* ;; "LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc. however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.") (GO OUT)) (T (GO OUT1] (COND [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP COMSNAME _ COMS LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.") (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ;  "so wont try to spelling correct again if file isnt there") (GO TOP)) (T (GO ERROR))) OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME with (LIST (create FILEDATEPAIR FILEDATE _ DAT DATEFILENAME _ FULLNAME] (AND (EQ LOADTYPE T) (/replace TOBEDUMPED of FILEPROP with NIL)) OUT1 [COND ([AND (LISTP (GETTOPVAL COMS)) (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ;  "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") (CONS FULLNAME (CONS ROOTNAME FILEPROP))) (T FILEPROP))) ERROR (ERROR FULLNAME "not file name." T]) (LISTFILES [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") (for FILE FULLNAME OPTIONS in (COND (FILES (SETQ FILES (NLAMBDA.ARGS FILES))) (T NOTLISTEDFILES)) when (COND ((LISTP FILE) (SETQ OPTIONS (APPEND FILE OPTIONS)) NIL) ((SETQ FULLNAME (FINDFILE FILE)) FULLNAME) (T (printout T FILE " not found." T) NIL)) collect [COND ((LISTFILES1 FULLNAME OPTIONS) (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T) NOTLISTEDFILES] FULLNAME]) ) (RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE) (RPAQ? FILELST ) (RPAQ? LOADEDFILELST ) (RPAQ? NOTLISTEDFILES ) (RPAQ? NOTCOMPILEDFILES ) (RPAQ? MAKEFILEFORMS ) (RPAQ? NILCOMS ) (ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% F ST STF (REC . RC) (BREC . RC) (TC . C) (BC . C) (TCOMPL . C) (BCOMPL . C)) (RPAQ? MAKEFILEREMAKEFLG T) (RPAQ? CLEANUPOPTIONS '(RC)) (* ;; "scanning file coms") (DEFINEQ (FILEPKGCHANGES [LAMBDA N (* Pavel " 7-Oct-86 19:22") (COND [(EQ N 0) (PROG (TEM) (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X) (SETQ TEM (FILEPKGCHANGES X))) collect (CONS X TEM] [(EQ (ARG N 1) T) (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES X] [(EQ N 1) (COND [(LISTP (ARG N 1)) (for X in (ARG N 1) when (FMEMB (CAR X) FILEPKGTYPES) do (/replace CHANGED of (CAR X) with (CDR X] (T (for Y on (fetch CHANGED of (ARG N 1)) when [AND (CAR Y) (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y) Z] collect (CAR Y] (T (/replace CHANGED of (ARG N 1) with (ARG N 2]) (GETFILEPKGTYPE [LAMBDA (TYPE ONLY NOERROR NAME) (* lmm "20-Nov-86 23:10") (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ") (COND [(LISTP TYPE) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") (AND NAME (TYPESOF NAME))) [(AND (NEQ ONLY 'COMS) (OR (SELECTQ TYPE (NIL 'FNS) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) then (* ;; "type matched exactly") (RETURN TYPE) elseif (AND (LISTP X) (EQ TYPE (CAR X))) then (RETURN (CDR X] [(AND (NEQ ONLY 'TYPE) (LITATOM TYPE) (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST)) (* ; "Prefer an exact match quickly") ] [(AND (NEQ ONLY 'COMS) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) then X else (CAR X))) (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization") (AND (<= 0 (- (NCHARS NAME) (NCHARS TYPE)) 1) (STRPOS TYPE NAME) (RETURN (if (EQ X NAME) then X else (CDR X] [(FIXSPELL TYPE NIL (SELECTQ ONLY (TYPE FILEPKGTYPES) (COMS FILEPKGCOMSPLST) (UNION FILEPKGTYPES FILEPKGCOMSPLST] ((NOT NOERROR) (ERROR (SELECTQ ONLY (TYPE "unrecognized manager definition type") (COMS "unrecognized manager command") "unrecognized manager definition-type/command") TYPE]) (MARKASCHANGED [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) REASON) (NIL 'CHANGED) (T 'DEFINED) (ERROR "bad REASON in MARKASCHANGED" REASON))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (for FN inside (fetch WHENCHANGED of TYPE) do (APPLY* FN NAME TYPE REASON)) (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON)) [COND ((EQ REASON 'DELETED) (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L) NAME) do (/RPLACA L NIL)) (* ;  "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ;  "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) 'NILCOMS) [(AND (OR (NULL X) (EQ X 'COMS)) (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE] (T (PACK* (NAMEFIELD FILE) (OR X 'COMS]) (WHEREIS [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") (CL:UNLESS (EQ NAME T) (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES) FILELST) (FUNCTION (LAMBDA (FILE) (INFILECOMS? NAME TYPE (FILECOMS FILE] (AND (EQ FILES T) (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS) (LET ((FILES NIL)) (for TY inside TYPE do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS NAME (GETFILEPKGTYPE TYPE)) do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) (APPLY* FN NAME FILE] IN-FILES)))]) (SMASHFILECOMS [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) do (SETTOPVAL X 'NOBIND)) FILE]) (FILEFNSLST [LAMBDA (FILE) (* ; "Edited 14-Jun-90 19:30 by jds") (FILECOMSLST FILE '(FUNCTIONS FNS]) (FILECOMSLST [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ;  "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG))) (T (INFILECOMS? NIL TYPE (FILECOMS FILE) FLG]) (UPDATEFILES [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g. LOAD, LOADFNS) involving the files in FLST began.") (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE)) do (COND ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE))) (* ;  "FILEPKGCHANGES eliminates duplicates") (/replace CHANGED of TYPE with NIL)) (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) (* ;; "First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally. These are `found' but not marked. LST::1 contains all other items.") (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND)) do (SETQ PCHANGES (COND ((FMEMB (fetch DATEFILENAME of (CAR (fetch FILEDATES of FILE))) FLST) (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed; any items that were only changed during this operation are ignored.") (INTERSECTION CHANGED PREVITEMS)) (T CHANGED))) [COND ([AND PCHANGES [SETQ COMS (fetch COMSNAME of (SETQ FILEPROP (LISTP (fetch FILEPROP of FILE] (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE] (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms") [COND ((CDR LST) (* ; "CDR items must be distributed") [COND ((NULL (fetch TOBEDUMPED of FILEPROP)) (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL") [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL 'NOTLISTEDFILES] (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE (GETTOPVAL ' NOTCOMPILEDFILES ] (* ;  "Get the (possibly new) TYPE item list to smash") [COND [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of FILEPROP] (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE] (* ;  "Now distribute items to the file property") (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP) ) do (/NCONC1 TYPEDPROP Y] (SETQ FOUND (NCONC (CAR LST) (CDR LST) FOUND] finally (/replace CHANGED of TYPE with (LDIFFERENCE CHANGED FOUND]) (INFILECOMS? [LAMBDA (NAME TYPE COMS ONFILETYPE) (* ; "Edited 12-Jul-88 17:42 by MASINTER") (* ;; "Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in other case") (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of (literals . elements) where literals are those which are `literally' on the file (e.g. (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned") (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ") (PROG (VAL LITERALS ORIGFLG) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (SELECTQ ONFILETYPE (EDIT (SELECTQ TYPE (FILEVARS (RETURN)) NIL)) NIL) [COND ((LITATOM COMS) (SELECTQ TYPE ((VARS FILEVARS) (* ;  "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] (INFILECOMS COMS) (SETQ VAL (DREVERSE VAL)) (RETURN (COND ((EQ ONFILETYPE 'UPDATE) (CONS LITERALS VAL)) (T VAL]) (INFILECOMTAIL [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (LISTP (EVALV (CADDR COM] (T [RESETVARS (DWIMLOADFNSFLG) (NLSETQ (SETQ COM (EVAL (CADDR COM] COM))) (T (CDR COM] (if (NOT FLG) then (for X in COM do [if (AND (LISTP X) (EQ (CAR X) COMMENTFLG)) then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X) (OR (NLISTP X) (NEQ (CAR X) COMMENTFLG] finally (RETURN COM)) else COM]) (INFILECOMS [LAMBDA (COMS) (* rmk%: "19-FEB-83 22:17") (for X in COMS do (INFILECOM X]) (INFILECOM [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND ((EQ TYPE 'VARS) (INFILECOMSVAL COM] ((EQ (CAR COM) COMMENTFLG) (* ;; "must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") (* ;  "don't know why I should bother, but someone might want to know all of the comments on a file???") (COND ((EQ TYPE COMMENTFLG) (INFILECOMSVAL COM T))) NIL) (T (PROG ((COMNAME (CAR COM)) (TAIL (CDR COM)) CFN TEM) (COND [[COND ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME)) (SETQ TEM (APPLY* CFN COM (COND ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ;  "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME)) (* ; "for compatability") (SETQ TEM (APPLY* CFN COM TYPE NAME] (COND [(NLISTP TEM) (COND ((EQ TEM T) (COND ((OR (EQ NAME T) (NULL ONFILETYPE)) (RETFROM 'INFILECOMS? T] (T (INFILECOMSVALS TEM] ((LISTP TAIL) (* ;; "this SELECTQ handles the `exceptional cases' for the built in types. There is an explicit RETURN in the SELECTQ clause if the default is handled") (SELECTQ COMNAME ((PROP IFPROP) (SETQ TAIL (CDR TAIL))) NIL) [COND ((EQ (CAR TAIL) '*) (COND ((LITATOM (CADR TAIL)) (SELECTQ TYPE ((VARS FILEVARS) (INFILECOMSVAL (CADR TAIL))) NIL)) ((AND (LISTP (CADR TAIL)) (EQ ONFILETYPE 'UPDATE) (EQ TYPE 'VARS) (EQ (CAADR TAIL) 'PROGN) (FMEMB (CAR (LAST (CADR TAIL))) NAME)) (SETQ VAL (CONS (CADR TAIL) VAL] (SELECTQ COMNAME ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) (EQ TYPE 'DECLARE%:]) (ORIGINAL (* ; "dont expand macros") (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ;  "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) NIL)) (PROPS (RETURN (IFCPROPS COM))) (MACROS (RETURN (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T) MACROPROPS)) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ;  "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) (P [RETURN (SELECTQ TYPE ((EXPRESSIONS P) (INFILECOMSVALS (INFILECOMTAIL COM T) T)) (COND ((NULL ONFILETYPE) (* ; "for WHEREIS and FILECOMSLST") (SELECTQ TYPE (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR)) (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE)) NIL]) ((ADDVARS APPENDVARS) (SELECTQ TYPE (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) 'VARTYPE)) do (for Z in (CDR X) do (INFILECOMSVAL (LIST (CAR X) (CAR Z)) T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) [RETURN (COND ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) (NEQ (CAR X) COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ;  "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") (for X in (INFILECOMTAIL COM T) do (COND ((LISTP X) (AND (CAR X) (NEQ (CAR X) COMMENTFLG) (INFILECOMSVAL (CAR X) T))) (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS]) (DEFS [RETURN (for X in (INFILECOMTAIL COM T) when (EQ TYPE (CAR X)) do (INFILECOMSVALS (CDR X]) (FILES (RETURN)) NIL) (* ;; "Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual. Else expand the com's MACRO, if it has one, unless there was a CONTENTS function") (COND ((EQ COMNAME TYPE) (INFILECOMSVALS (INFILECOMTAIL COM T))) [(AND (LISTP TYPE) (FMEMB COMNAME TYPE)) (LET ((TYPE COMNAME)) (INFILECOMSVALS (INFILECOMTAIL COM T] ((AND (OR (NULL CFN) (AND (EQ CFN T) (NULL ONFILETYPE))) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) (INFILECOMTAIL COM T) (CDR TEM]) (INFILECOMSVALS [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") (for Y in X when (NOT (AND (LISTP Y) (EQ (CAR Y) COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) (MEMBER X NAME)) (COND (FLG (SETQ LITERALS (CONS X LITERALS))) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ;  "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X))) (CL:PUSHNEW TYPE VAL))) ([OR (EQ NAME T) (COND ((LITATOM NAME) (EQ NAME X)) (T (EQUAL NAME X] (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") (COND [(EQ ONFILETYPE 'UPDATE) (AND [OR (NULL NAME) (find X in NAME suchthat (AND (EQ (CAR X) AT) (EQ (CADR X) PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) (AND (EQ (CAR NAME) AT) (EQ (CADR NAME) PROP))) (RETFROM (FUNCTION INFILECOMS?) T)) ((NULL NAME) (SETQ VAL (CONS (LIST AT PROP) VAL]) (IFCPROPS [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") (* ;;; "Examine a PROPS com for objects of specified TYPE") (SELECTQ TYPE (PROPS (* ;  "the PROPS command can actually take (PROPNAME at1 at2 ...)") (INFILEPAIRS (INFILECOMTAIL COM))) (PROP (* ;  "return the atoms which have any properties at all") (for PAIR in (INFILECOMTAIL COM) do (for ATNAME inside (CAR PAIR) do (INFILECOMSVAL ATNAME )))) (MACROS (* ; "only MACRO properties") (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR) (CDR PAIR)))) NIL]) (IFCEXPRTYPE [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") (* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN") (for SUBCOM in (INFILECOMTAIL COM) when (AND (EQ (CAR SUBCOM) FN) (EQ (CAR (LISTP (CADR SUBCOM))) 'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM)) T]) (IFCPROPSCAN [LAMBDA (ATOMS PROPNAMES) (* ; "Edited 2-Aug-88 02:20 by masinter") (* ;;; "Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES") (for AT in ATOMS WHEN (LITATOM AT) unless [COND [(EQ ONFILETYPE 'UPDATE) (COND (NAME (NOT (ASSOC AT NAME] ((LISTP NAME) (NEQ AT (CAR NAME] do (COND ((EQ PROPNAMES 'ALL) (for PROP in (GETPROPLIST AT) by (CDDR PROP) when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP))) (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP]) (IFCDECLARE [LAMBDA (TAIL WANTDECLARE) (* ; "Edited 8-Jun-90 18:11 by teruuchi") (PROG ((TAIL TAIL)) LP (COND ((LISTP TAIL) [SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL) (CADR TAIL] (SETQ TAIL (CDR TAIL))) (DONTEVAL@LOAD [COND ((OR (\STKSCAN 'DOFILESLOAD) (\STKSCAN 'LOAD)) (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"") (RETURN)) (WANTDECLARE (INFILECOMSVAL (CAR TAIL]) (COMPILERVARS (RETURN)) (COND [(FMEMB (CAR TAIL) DECLARETAGSLST) (COND (WANTDECLARE (INFILECOMSVAL (CAR TAIL] (T (INFILECOM (CAR TAIL] (SETQ TAIL (CDR TAIL)) (GO LP]) (INFILEPAIRS [LAMBDA (LST) (* lmm " 4-DEC-78 09:51") (for LL in LST do (for X inside (CAR LL) do (for Y inside (CDR LL) do (INFILECOMSVAL (LIST X Y]) (INFILECOMSMACRO [LAMBDA (ATS PROPS) (* lmm "28-SEP-78 18:35") (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it. --- Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom. However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties") (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE) (EVERY (PROPNAMES AT) (FUNCTION (LAMBDA (X) (OR (NOT (FMEMB X MACROPROPS)) (EQMEMB X PROPS] [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) (EQMEMB PROP PROPS] (INFILECOMSVAL AT]) ) (* ;; "adding to a file") (DEFINEQ (FILES? [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") (* ;;; "Display each file needing dumping, etc. For files needing dumping, display details of why.") (UPDATEFILES) (LET (FILES CHANGES PRINTED) (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) then (LISPXPRIN1 "To be dumped: " T) (SETQ PRINTED T)) (LISPXPRIN2 FILE T) (LISPXPRIN1 " ...changes to " T) [for CH in CHANGES bind TB do (COND ((LISTP CH) [COND (TB (LISPXTAB TB NIL T)) (T (SETQ TB (POSITION T] (LISPXPRIN2 (CAR CH) T) (FILES?PRINTLST (CDR CH))) (T (* ; "old style") (LISPXPRIN2 CH T) (LISPXSPACES 1 T] (LISPXTERPRI T)) (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED " plus ")) do (SETQ FLG T) finally (if FLG then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 [LAMBDA (TYPE FIRST) (* bvm%: "27-Oct-86 18:17") (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") (LET (STR LST) (COND ([AND (LITATOM TYPE) (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (fetch CHANGED of TYPE] (AND FIRST (LISPXPRIN1 FIRST T)) (LISPXPRIN1 '"the " T) (LISPXPRIN1 STR T) (FILES?PRINTLST LST) (LISPXTERPRI T) T]) (FILES?PRINTLST [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") (* ;; "Print elements of LST separated by commas and indenting new lines a bunch. If MAPRINT had a left margin arg, this would be simpler.") (MAPRINT LST T (OR STR ": ") NIL ", " [FUNCTION (LAMBDA (STR) (COND ((> (+ (POSITION T) (NCHARS STR T T) 3) (LINELENGTH NIL T)) (LISPXTERPRI T) (LISPXPRIN1 " " T))) (LISPXPRIN2 STR T T] T]) (ADDTOFILES? [LAMBDA (NOASKSTR) (* ; "Edited 21-Aug-91 10:13 by jds") (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says") (ERSETQ (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS] (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES") [COND (NOASKSTR (PRIN1 NOASKSTR T)) (T (DOBE) (SETQ BUFS (READP T)) (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go") '((Y "es ") (N "o ") (%] "Nowhere " EXPLAINSTRING "] - nowhere, all items will be marked as dummy " NOECHOFLG T)) T) (N (RETURN)) (%] (for TYPE in FILEPKGTYPES do (for NAME in (fetch (FILEPKGTYPE CHANGED) of TYPE) do (ADDTOFILE NAME TYPE NIL))) (RETURN)) NIL) (* ;  "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) (LINBUF) (SYSBUF) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch DESCRIPTION of TYPE)) (LISTP (SETQ LST (COND ((EQ TYPE 'VARS) VARSCHANGES) (T (fetch (FILEPKGTYPE CHANGED) of TYPE] do (printout T "(" STR ")" T) (for NAME TEM FILE in LST when NAME do (PROG NIL LP (PRIN2 NAME T) (SPACES 2 T) (* ;; "if user typed ahead before entering addtofiles?? then dont allow typeahead here, because it will justgobble his earlier typeahead.") (SELECTQ (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)) (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T) (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer") (DOBE))) (GO LP)) (%] (SETQ FILE)) (% (* ; "space. means no action") (RETURN)) (% (PRINT (OR (SETQ FILE LASTFILE) 'Nowhere) T)) (SETQ FILE TEM)) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND ((LITATOM PLACE) (* ; "file name") (SETQ FILE PLACE) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.") ) ((EQ (CAR PLACE) 'Near%:) (SETQ NEAR (CADR PLACE)) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) (T (PRINT (LIST (CADR PLACE) 'not 'found) T T) (ERROR!))) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT) (OR (SETQ FILE (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed") ) (T (PRIN1 " put list " T) (PRIN2 (CAR PLACE) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " '(("" "" EXPLAINSTRING "a file name" KEYLST ())) T) 'FILE)) (SAVESET (CAR PLACE) (MERGEINSERT NAME (LISTP (GETTOPVAL (CAR PLACE))) T) T 'NOPRINT) (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.") (ADDNEWCOM (FILECOMS FILE) NAME TYPE (CAR PLACE) FILE) (for F in (fetch WHENFILED of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] (AND BUFS (BKBUFS BUFS)) (UPDATEFILES]) (ADDTOFILE [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") (* ; "adds NAME to the file FILE") (PROG (TEM COMSNAME) [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T) (COND ((FMEMB TYPE FILELST) (GETFILEPKGTYPE (swap TYPE FILE))) (T (GETFILEPKGTYPE TYPE] (SETQ FILE (WHATIS FILE 'FILE)) (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE)) NAME TYPE NEAR LISTNAME) (ADDNEWCOM COMSNAME NAME TYPE NIL FILE)) (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE)) (AND FILE (NOT (FMEMB FILE FILELST)) (ADDFILE FILE)) (RETURN FILE]) (WHATIS [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable") (PROG (TEM UCASE) (RETURN (COND ((NULL USERINPUT) (* ; "nowhere") NIL) [(LISTP USERINPUT) (COND (ONLY (ERROR!)) (T (SELECTQ (CAR USERINPUT) ((@ Near%:) (CONS 'Near%: (CDR USERINPUT))) (WHATIS (CAR USERINPUT) 'LIST] ([AND (NEQ ONLY 'LIST) (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT))) FILELST) (LISTP (GETTOPVAL (FILECOMS UCASE))) (SETQ TEM (FIXSPELL UCASE NIL FILELST T] TEM) ((AND (NEQ ONLY 'FILE) (LISTP (GETTOPVAL USERINPUT))) (LIST USERINPUT)) ((AND (NEQ ONLY 'LIST) (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE) NIL T) 'Y)) UCASE) ((AND (NEQ ONLY 'FILE) (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT) NIL T) 'Y)) (LIST USERINPUT)) (T (* ; "none of above") (ERROR!]) (ADDTOCOMS [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME. If NEAR is given, only insert near it") (COND ((NULL COMS) NIL) [(LITATOM COMS) (* ;  "given a name of a command; rebind COMSNAME to current variable and try to add to its value") (OR [PROG ((COMSNAME COMS)) (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME)) NAME TYPE NEAR (AND (NEQ COMS LISTNAME) LISTNAME] (AND (EQ COMS LISTNAME) (ADDNEWCOM COMS NAME TYPE] (T (SETQ TYPE (GETFILEPKGTYPE TYPE)) (for TAIL on COMS do (COND [(LISTP (CAR TAIL)) (COND ((ADDTOCOM (CAR TAIL) NAME TYPE NEAR LISTNAME) (RETURN T] (T (SELECTQ (CAR TAIL) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ TAIL (CDR TAIL))) NIL]) (ADDTOCOM [LAMBDA (COM NAME TYPE NEAR LISTNAME) (* ; "Edited 2-May-87 19:04 by Pavel") (* ;  "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] (RETURN))) [COND ((SETQ TEM (fetch ADD of (CAR COM))) (RETURN (COND ((OR (NULL LISTNAME) (INFILECOMS? LISTNAME 'FILEVARS (LIST COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR)) (MARKASCHANGED COMSNAME 'VARS)) TEM] (RETURN (SELECTQ (CAR COM) (FNS (AND (EQ TYPE 'FNS) (ADDTOCOM1 COM NAME NEAR LISTNAME))) ((VARS INITVARS) (COND ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ;  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) 'SETQ) (ADDTOCOM1 COM (CDR NAME) NEAR LISTNAME)))) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME)) (DECLARE%: (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE NEAR LISTNAME))) (CL:EVAL-WHEN (AND (OR LISTNAME NEAR) (ADDTOCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE NEAR LISTNAME))) ((PROP IFPROP) (SELECTQ TYPE (PROPS (COND ((EQ (CADR COM) (CADR NAME)) (ADDTOCOM1 (CDR COM) (CAR NAME) NEAR LISTNAME)) ((AND (EQ (CAR NAME) (CADDR COM)) (NULL (CDDDR COM))) [/RPLACA (CDR COM) (UNION (MKLIST (CDR NAME)) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) (NOT (GETPROP NAME PROP] (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed") (ADDTOCOM1 (CDR COM) NAME NEAR LISTNAME)))) NIL)) ((PROPS ALISTS) (AND (EQ TYPE (CAR COM)) (ADDTOCOM1 COM (/NCONC1 (OR [ASSOC (CAR NAME) (COND [(EQ (CADR COM) '*) (COND [(LITATOM (CADDR COM)) (AND (OR (NULL LISTNAME) (EQ (CADDR COM) LISTNAME)) (GETTOPVAL (CADDR COM] (T (RETURN] (T (CDR COM] (LIST (CAR NAME))) (CADR NAME)) NEAR LISTNAME))) (P (COND ((AND (EQ TYPE 'EXPRESSIONS) (NEQ (CAR NAME) 'SETQ)) (ADDTOCOM1 COM NAME NEAR LISTNAME)))) (AND (EQ (CAR COM) TYPE) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") (AND [COND (LISTNAME (EQ (CADDR COM) LISTNAME)) (T (LITATOM (CADDR COM] (SAVESET (CADDR COM) [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM] (COND ((AND NEAR (SETQ NEAR (MEMBER NEAR COM))) (/RPLACD NEAR (CONS NAME (CDR NEAR))) COM) (T (MERGEINSERT NAME COM T] T 'NOPRINT] ((NULL LISTNAME) (* ; "add to standard com") [AND (NOT (MEMBER NAME (CDR COM))) (COND [(SETQ NEAR (MEMBER NEAR COM)) (/RPLACD NEAR (CONS NAME (CDR NEAR] (T (/RPLACD COM (MERGEINSERT NAME (CDR COM] (MARKASCHANGED COMSNAME 'VARS) T]) (ADDNEWCOM [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. --- if LISTNAME is given, then use it as the listname") (PROG (NEWCOM OLDCOM TAIL) (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE)) [COND ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME))) (RETURN (SAVESET COMSNAME (LIST NEWCOM) T 'NOPRINT] LP [COND ((OR (NLISTP (SETQ OLDCOM (CAR TAIL))) (SELECTQ (CAR OLDCOM) ((LOCALVARS SPECVARS BLOCKS) T) (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM))) NIL)) (/ATTACH NEWCOM TAIL)) ((LISTP (CDR TAIL)) (SETQ TAIL (CDR TAIL)) (GO LP)) (T (/RPLACD TAIL (LIST NEWCOM] (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname") (AND (LISTP NAME) (SETQ NAME (COPY NAME))) (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE)) (APPLY* TEM NAME TYPE LISTNAME FILE)) (SELECTQ TYPE (PROPS [AND (NULL LISTNAME) (CONS 'PROP (CONS (COND ((AND (LISTP (CDR NAME)) (NULL (CDDR NAME))) (CADR NAME)) (T (CDR NAME))) (OR (LISTP (CAR NAME)) (LIST (CAR NAME]) (EXPRESSIONS [COND ((EQ (CAR NAME) 'SETQ) (MAKENEWCOM (CDR NAME) 'VARS LISTNAME FILE)) (T (CONS 'P (COND (LISTNAME (LIST '* LISTNAME)) (T (LIST NAME]) NIL) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM [LAMBDA (NAME TYPE LISTNAME FILE) (* lmm "20-OCT-82 22:48") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch MACRO of TYPE) (fetch GETDEF of TYPE))) (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION of TYPE) TYPE) T)) ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) ((EQ FILE T) (* ;  "FILE=T only when called from SHOWDEF") (LIST TYPE NAME)) ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE)) (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME)) T) T 'NOPRINT] (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items") (LIST TYPE '* LISTNAME)) (T (LIST TYPE NAME]) ) (RPAQ? DEFAULTCOMHASFILEFLG ) (ADDTOVAR MARKASCHANGEDFNS ) (DEFINEQ (MERGEINSERT [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") (* ;; "searches LST to find the most reasonable place to insert NEW. Does nothing if ONEFLG is T and NEW is already a member of LST") (COND ((AND ONEFLG (MEMBER NEW LST)) LST) ((LISTP NEW) (/NCONC1 LST NEW)) (T (PROG ((N 0) LST1 PLACE TEM) (SETQ LST1 LST) LP (* ;; "finds the function with the longest leading common substring. The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.") (COND ((NULL LST1) (GO OUT)) ((OR (LISTP (CAR LST1)) (SETQ TEM (STRPOS (CAR LST1) NEW 1 NIL T T))) (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE") (SETQ PLACE LST1) (GO OUT)) ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1) NEW)) N) (SETQ N TEM) (SETQ PLACE LST1))) (SETQ LST1 (CDR LST1)) (GO LP) OUT (SETQ TEM (CAR PLACE)) (OR [SOME (OR PLACE LST) (FUNCTION (LAMBDA (X LST) (COND ([OR (ALPHORDER NEW X) (AND PLACE (NOT (ALPHORDER TEM X] (* ;; "for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may or may not be in order, e.g. (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.") (/ATTACH NEW LST)) (T (SETQ TEM X) NIL] (SETQ LST (/NCONC1 LST NEW))) (RETURN LST]) (MERGEINSERT1 [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") (PROG ((N 1) C1 C2) LP [COND ((OR (NULL (SETQ C1 (NTHCHARCODE X N))) (NULL (SETQ C2 (NTHCHARCODE Y N))) (NEQ C1 C2)) (RETURN (SUB1 N] (SETQ N (ADD1 N)) (GO LP]) ) (* ;; "RMK: Changed INITVARS to VARS, so = addition works") (RPAQ ADDTOFILEKEYLST [LIST '(%[ "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) '(= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (LIST (CHARACTER (CHARCODE ^J)) "" 'EXPLAINSTRING "{line-feed} - same as previous response" 'NOECHOFLG T) '(% " % -" EXPLAINSTRING "{space} - no action" NOECHOFLG T) '(%] "Nowhere% -" EXPLAINSTRING "] - nowhere, item is marked as a dummy% -" NOECHOFLG T) '[%( "List: (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST (( "" CONFIRMFLG (%) %] % % -) RETURN (CDR ANSWER] '(@ "Near: " EXPLAINSTRING "@ other-item -- put the item near the other item" NOECHOFLG T KEYLST (( "" CONFIRMFLG (% -) RETURN ANSWER))) (LIST (CHARACTER (CHARCODE ^M)) "" 'RETURN '% ) '("" "File name: " EXPLAINSTRING "a file name" KEYLST (]) (RPAQQ LASTFILE NIL) (* ;; "deleting an item from a file") (DEFINEQ (DELFROMFILES [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") (PROG (COMS) (SETQ TYPE (GETFILEPKGTYPE TYPE)) (RETURN (for FILE inside (OR FILES FILELST) when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE)) NAME TYPE) (COND ((INFILECOMS? NAME TYPE COMS) (printout T "(could not delete " NAME " from " FILE ")" T)))) collect (for FN in (fetch WHENUNFILED of TYPE) do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list). Returns T if it does anything") (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.") (COND [(LITATOM COMS) (LET ((COMSNAME COMS)) (DECLARE (SPECVARS COMS)) (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME))) (DELFROMCOMS COMS NAME TYPE] (T (PROG (DONE) (SETQ TYPE (GETFILEPKGTYPE TYPE)) LP (COND ((NLISTP COMS) (RETURN DONE))) [COND ((LISTP (CAR COMS)) (SELECTQ (DELFROMCOM (CAR COMS) NAME TYPE) (ALL (/RPLNODE2 COMS (CDR COMS)) (SETQQ DONE ALL) (GO LP)) (NIL) (SETQ DONE T))) (T (SELECTQ (CAR COMS) ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) (SETQ COMS (CDR COMS))) (COND ((AND (EQ TYPE 'VARS) (EQ NAME (CAR COMS))) (/RPLNODE2 COMS (CDR COMS)) (SETQ DONE T) (GO LP] (SETQ COMS (CDR COMS)) (GO LP]) (DELFROMCOM [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND ((SETQ TEM (fetch DELETE of (CAR COM))) (AND (SETQ TEM (APPLY* TEM COM NAME TYPE)) (MARKASCHANGED COMSNAME 'VARS)) (RETURN TEM))) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND [(EQ (CADR COM) '*) (COND ((LITATOM (CADDR COM)) (CADDR COM)) (T (RETURN] (T (CDR COM))) NAME TYPE)) ((CL:EVAL-WHEN) (DELFROMCOMS (COND [(EQ (CL:THIRD COM) '*) (COND ((LITATOM (CL:FOURTH COM)) (CL:FOURTH COM)) (T (RETURN] (T (CDDR COM))) NAME TYPE)) ((ALISTS PROPS) (AND (EQ TYPE (CAR COM)) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ VAR (CADDR COM))) (SETQ TEM (ASSOC (CAR NAME) (GETTOPVAL VAR))) (NEQ (CDR TEM) (SETQ TEM (REMOVEITEM (CADR NAME) (CDR TEM] (SAVESET VAR TEM T 'NOPRINT) T))) ([AND [CDR (SETQ TEM (ASSOC (CAR NAME) (CDR COM] (NEQ (CDR TEM) (SETQ NEW (REMOVEITEM (CADR NAME) (CDR TEM] (/RPLACD TEM NEW) (MARKASCHANGED COMSNAME 'VARS) T)))) (BLOCKS (* ;; "Remove function name from blocks declarations. This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.") [AND (EQ TYPE 'FNS) (for BLOCK in (INFILECOMTAIL COM T) do (AND (MEMB NAME BLOCK) (/DREMOVE NAME BLOCK)) (for X in BLOCK when (AND (LISTP X) (MEMB NAME (CDR X))) do (/RPLACD X (REMOVE NAME (CDR X]) ((PROP IFPROP) [SELECTQ TYPE (PROPS (RETURN (COND ((EQ (CADR COM) (CADR NAME)) (DELFROMCOM1 (CDR COM) (CAR NAME))) ((AND (EQMEMB (CADR NAME) (CADR COM)) [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM] (EQ (CAR TEM) (CAR NAME))) [/RPLACA (CDR COM) (REMOVE (CADR NAME) (MKLIST (CADR COM] (MARKASCHANGED COMSNAME 'VARS) T)))) (COND ([for PROP inside (CADR COM) always (EQ TYPE (GETPROP PROP 'PROPTYPE] (DELFROMCOM1 (CDR COM) NAME]) ((RECORDS INITRECORDS SYSRECORDS) (AND (EQ TYPE 'RECORDS) (DELFROMCOM1 COM NAME))) (P (AND (EQ TYPE 'EXPRESSIONS) (DELFROMCOM1 COM NAME))) ((VARS INITVARS) (AND (EQ TYPE 'VARS) (DELFROMCOM1 COM NAME T))) (AND (EQ TYPE (CAR COM)) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") (* ;;  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND ((EQ (CADR COM) '*) (COND ([AND (LITATOM (SETQ TEM (CADDR COM))) (NEQ (SETQ VAL (GETTOPVAL TEM)) (SETQ VAL (REMOVEITEM NAME VAL FLG] (SAVESET TEM VAL T 'NOPRINT) T))) ((NEQ (CDR COM) (SETQ TEM (REMOVEITEM NAME (CDR COM) FLG))) (/RPLACD COM TEM) (MARKASCHANGED COMSNAME 'VARS) T]) (REMOVEITEM [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") (* lmm "10-FEB-78 17:29") (* ;;  "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) (AND FLG (SOME LST (FUNCTION (LAMBDA (Y) (EQUAL (CAR (LISTP Y)) X] (SUBSET LST (FUNCTION (LAMBDA (Y) (AND (NOT (EQUAL Y X)) (OR (NOT FLG) (NLISTP Y) (NOT (EQUAL (CAR Y) X] (T LST]) (MOVETOFILE [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") (* ; "To move items between files") (SETQ TYPE (GETFILEPKGTYPE TYPE)) [COND ((OR (EQ TYPE 'FNS) FROMFILE) (* ;  "FNS definition can reside on file if LOADFNS was done. This guarantees that it is loaded.") (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM] (AND (EQ TYPE 'FNS) (MARKASCHANGED NAME TYPE)) (* ;  "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T) (MOVD? 'MOVETOFILE 'MOVEITEM NIL T) (ADDTOVAR SYSPROPS PROPTYPE VARTYPE) (* ; "functions for doing things and marking them changed and auxiliary functions") (DEFINEQ (SAVEPUT [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") (* ;; "analogous to SAVESET but also marks changed property lists; LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT") [COND ((NOT (LITATOM ATM)) (ERRORX (LIST 14 ATM] (PROG ((X (GETPROPLIST ATM)) X0 TEM OLDFLG) LOOP (COND ((NLISTP X) (COND ((AND (NULL X) X0) (* ;  "typical case. property list ran out on an even parity position. e.g. (A B C D)") (SETQ TEM (LIST PROP VAL)) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) (FRPLACD (CDR X0) TEM) (GO RET))) (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning") ) ((NLISTP (CDR X)) (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. (A B C) or (A B C . D) fall through and add at beginning.") ) [(EQ (CAR X) PROP) (SETQ OLDFLG (NEQ (EQUALN (CADR X) VAL 400) T)) (* ; "i.e. it probably changed") (/RPLACA (CDR X) VAL) (COND ((NOT OLDFLG) (GO RET1)) (T (OR (EQ DFNFLG T) (LISPXPRINT (LIST 'new PROP 'property 'for ATM) T T)) (GO RET] (T (SETQ X (CDDR (SETQ X0 X))) (GO LOOP))) [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM] (SETPROPLIST ATM TEM) (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM) LISPXHIST)) RET (MARKASCHANGED (LIST ATM PROP) 'PROPS (NOT OLDFLG)) RET1 (AND ADDSPELLFLG (ADDSPELL ATM 0)) (RETURN VAL]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT) (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT)) ) (DEFINEQ (UNMARKASCHANGED [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties. Value is name if anything is done") (PROG (ANYFLG) (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) (SETQ ANYFLG T)) [for F TAIL PROP TYPEDPROP in FILELST when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED of (SETQ PROP (fetch FILEPROP of F] do (SETQ ANYFLG T) (COND ((SETQ TAIL (REMOVE (CAR TAIL) (CDR TYPEDPROP))) (/RPLACD TYPEDPROP TAIL)) (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP (fetch TOBEDUMPED of PROP] (RETURN (AND ANYFLG NAME]) (PREEDITFN [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ;  "EDITL is advised to call this before editing something") (AND FILEPKGFLG (SELECTQ TYPE (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (GETPROPLIST ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made") [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS) EDITCHANGES (APPEND (GETPROPLIST ATM]) (VARS [COND ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE)) [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS) (CONS)) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) (GETHASH X CLISPARRAY) (PUTHASH X (CONS (CAR X) (CDR X)) CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) collect (CAR X]) NIL]) (POSTEDITPROPS [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP) when (for OLDPROP on OLDPROPS by (CDDR OLDPROP) do (COND ((EQ (CAR OLDPROP) (CAR NEWPROP)) (* ; "Found the property") [AND (EQ (CADR OLDPROP) (CADR NEWPROP)) (COND ((NLISTP (CADR OLDPROP)) (* ; "value is same") (RETURN)) ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP) CLISPARRAY)) (EQ (CAADR NEWPROP) (CAR OV)) (EQ (CDADR NEWPROP) (CDR OV))) (PUTHASH (CADR NEWPROP) NIL CLISPARRAY) (* ;  "value has been edited (CLISPARRAY translation went away)") (RETURN] (RETURN T))) finally (* ; "didn't find the property") (RETURN T)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWPROP)) 'PROPS NIL) (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ;  "called after an ALIST has been edited") (OR FILEPKGFLG (RETURN)) (COND ((CADR EDITCHANGES) (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES)) do (MARKASCHANGED (LIST (CAR EDITCHANGES) X) 'ALISTS NIL) (SETQ FOUNDCHANGE T)) [for NEWENTRY in NEWENTRIES do (COND ([AND (LISTP NEWENTRY) (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY)) (EQ (CAR NEWENTRY) (CAR OV)) (EQ (CDR NEWENTRY) (CDR OV] (PUTHASH NEWENTRY NIL CLISPARRAY) (MARKASCHANGED (LIST (CAR EDITCHANGES) (CAR NEWENTRY)) 'ALISTS NIL) (SETQ FOUNDCHANGE T] (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) ) (ADDTOVAR LISPXFNS (PUT . SAVEPUT) (PUTPROP . SAVEPUT)) (* ; "sub-functions for file package commands & types") (DEFINEQ (ALISTS.GETDEF [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) (GETTOPVAL (CAR NAME] (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME) ASSOCIATION]) (ALISTS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ;  "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) (EQ (CAR VARTYPE) 'ALIST) (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME) (CADR VARTYPE) NEWFLG]) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") (AND CLISPARRAY (MAPHASH CLISPARRAY (COND [(EQ TYPE 'I.S.OPRS) (FUNCTION (LAMBDA (TRAN FORM) (AND (MEMB NAME FORM) (PUTHASH FORM NIL CLISPARRAY] (T (* ; "MACRO changed") (FUNCTION (LAMBDA (TRAN FORM) (COND ((OR (EQ NAME (CAR FORM)) (EQ (CAR (GETPROP (CAR FORM) 'CLISPWORD)) 'CHANGETRAN)) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) 'VARS)) ((PROGN PROG) (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X))) NIL]) (MAKEALISTCOMS [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") (LIST (CONS 'ADDVARS (for PR in X join (for ALISTNAME inside (CAR PR) collect (CONS ALISTNAME (for ATNAME inside (CDR PR) bind ENTRY when (SETQ ENTRY (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME)) (PROGN (LISPXPRINT (LIST 'no ATNAME 'entry 'on ALISTNAME) T T) NIL))) collect ENTRY]) (MAKEFILESCOMS [NLAMBDA FILES (* JonL "12-FEB-83 19:02") (* ;; "This scans the command just to warn the user about any errors. Must match up with the big SELECTQ in FILESLOAD NIL") [for FILE in FILES do (OR (LITATOM FILE) (while (LISTP FILE) do (SELECTQ (CAR (OR (LISTP FILE) (RETURN))) ((LOADCOMP LOADFROM)) (FROM (pop FILE) (if (OR (EQ (CAR FILE) 'VALUEOF) (if (AND (EQ (CAR FILE) 'VALUE) (EQ (CADR FILE) 'OF)) then (pop FILE))) then (pop FILE))) ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR)) (OR (FMEMB (CAR FILE) LOADOPTIONS) (PRINT (CONS (CAR FILE) '(-- unrecognized FILES option)) T))) (pop FILE] (CONS 'FILESLOAD FILES]) (MAKELISPXMACROSCOMS [NLAMBDA X (* lmm " 5-SEP-78 23:15") (PROG (TEM TEM2) (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXHISTORYMACROS ] (LIST (CONS 'LISPXHISTORYMACROS TEM))) (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z) (FASSOC Z LISPXMACROS ] (LIST (CONS 'LISPXMACROS TEM] (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z LISPXCOMS] (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2] (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z) (FMEMB Z HISTORYCOMS] (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS [NLAMBDA X (* lmm "26-FEB-78 17:10") (* ;; "make command to dump PROPS") (for PAIR in X collect (CONS 'PROP (CONS (COND ((AND (LISTP (CDR PAIR)) (NULL (CDDR PAIR))) (CADR PAIR)) (T (CDR PAIR))) (OR (LISTP (CAR PAIR)) (LIST (CAR PAIR]) (MAKEUSERMACROSCOMS [NLAMBDA X (* rmk%: " 3-JAN-82 23:20") (PROG (TEM) [COND [X (for Y in X do (OR (FASSOC Y USERMACROS) (FASSOC Y EDITMACROS) (LISPXPRINT (CONS Y '(-- no entry on USERMACROS)) T T] (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR)) X] (RETURN (LIST (CONS 'ADDVARS (NCONC (for VAR in '(USERMACROS EDITMACROS) when (SETQ TEM (for Y in (GETTOPVAL VAR) when (FMEMB (CAR Y) X) collect Y)) collect (CONS VAR TEM)) (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS DONTSAVEHISTORYCOMS) when [SETQ TEM (SUBSET (GETTOPVAL LST) (FUNCTION (LAMBDA (Y) (OR (FMEMB Y X) (AND (LISTP Y) (FMEMB (CAR Y) X] collect (CONS LST TEM]) (PROPS.WHENCHANGED [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND [PROPTYPE (RETFROM 'MARKASCHANGED (COND ((NEQ PROPTYPE 'IGNORE) (MARKASCHANGED (CAR NAME) PROPTYPE NEWFLG] (T (SELECTQ (CADR NAME) (CLISPWORD (CLEARCLISPARRAY (CAR NAME))) NIL]) (FILEGETDEF.LISPXMACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (MEMB SECOND '(LISPXMACROS LISPXCOMS)) T] when (SELECTQ (CADR X) (LISPXMACROS (* ;  "Rebuild the expressions cause there might be other elements in the ADDTOVAR") (AND (SETQ X (ASSOC NAME (CDDR X))) (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X)))) (LISPXCOMS [COND ((MEMB NAME (CDDR X)) (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME))) ((SETQ X (ASSOC NAME (CDDR X))) (* ; "For synonym pairs") (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) NIL) collect X]) (FILEGETDEF.ALISTS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'ADDTOVAR) (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) (CDDR X))) collect X finally (RETURN (COND ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) $$VAL]) (FILEGETDEF.RECORDS [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (MEMB FIRST CLISPRECORDTYPES) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) 'NOT-FOUND%:) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL]) (FILEGETDEF.PROPS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (EQ FIRST 'PUTPROPS) (EQ SECOND (CAR NAME] join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL) (CADR NAME)) join (LIST (CAR TAIL) (CADR TAIL))) finally (RETURN (COND ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME) $$VAL]) (FILEGETDEF.MACROS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "28-May-86 09:51") (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND) (AND (FMEMB FIRST '(PUTPROPS DEFMACRO)) (EQ SECOND NAME] join (if (EQ (CAR X) 'DEFMACRO) then (LIST X) else (for TAIL on (CDDR X) by (CDDR TAIL) when (FMEMB (CAR TAIL) MACROPROPS) collect (LIST 'PUTPROPS (CADR X) (CAR TAIL) (CADR TAIL]) (FILEGETDEF.VARS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:14") (for X in (LOADFNS NIL SOURCE 'GETDEF NAME) do (SELECTQ (CAR X) ((RPAQQ SETQQ) (RETURN (CADDR X))) ((RPAQ SETQ RPAQ?) (RETURN (EVAL (CADDR X)))) NIL) finally (RETURN 'NOBIND]) (FILEGETDEF.FNS [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: "29-Aug-86 22:30") (LET (MAP ENV) (COND [(AND (EQMEMB 'FAST OPTIONS) (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP) (GET-ENVIRONMENT-AND-FILEMAP SOURCE)) MAP)) (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME (CDDR PAIR] do [OR (OPENP SOURCE) (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT 'OLD] (SETFILEPTR SOURCE MAPLOC) (RETURN (WITH-READER-ENVIRONMENT ENV [COND ((EQMEMB 'ARGLIST OPTIONS) (RATOM SOURCE) (READ SOURCE) (RATOM SOURCE) (LIST (READ SOURCE) (READ SOURCE))) (T (CADR (READ SOURCE])] (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE]) (FILEPKGCOMS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) (TYPE (SETQ TYP (CDR DEFINITION))) (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION))) (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION] (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE") (for I in COM by (CDDR I) do (SELECTQ I ((ADD DELETE MACRO CONTENTS CONTAIN COM)) (ERROR I "not file package command property" ))) (* ;  "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP (LISTGET COM PROP))) [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS) (SELECTQ I ((DESCRIPTION TYPE)) (ERROR I "not file package type/command property" ] (* ;  "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") (PROGN (PUTDEF (FILECOMS NAME) 'VARS (CAR DEFINITION) REASON) (* ; "DEFINE THE COMS") (ADDFILE NAME) (* ;  "MAKE SURE IT IS A FILE PACKAGE ENTITY") [/replace TOBEDUMPED of (fetch FILEPROP of NAME) (FILEPKG.MERGECHANGES (CADR DEFINITION) (fetch TOBEDUMPED of (fetch FILEPROP of NAME] (OR (fetch FILEDATES of NAME) (/replace FILEDATES of NAME with (CADDR DEFINITION]) (VARS.PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED [LAMBDA (NAME TYPE REASON) (MARKASCHANGED (FILECOMS NAME) 'VARS REASON]) ) (ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO) (ADDTOVAR SYSPROPS PROPTYPE) (PUTPROPS I.S.OPR PROPTYPE I.S.OPRS) (PUTPROPS SUBR PROPTYPE IGNORE) (PUTPROPS LIST PROPTYPE IGNORE) (PUTPROPS CODE PROPTYPE IGNORE) (PUTPROPS FILEDATES PROPTYPE IGNORE) (PUTPROPS FILE PROPTYPE IGNORE) (PUTPROPS FILEMAP PROPTYPE IGNORE) (PUTPROPS EXPR PROPTYPE FNS) (PUTPROPS VALUE PROPTYPE VARS) (PUTPROPS COPYRIGHT PROPTYPE FILES) (PUTPROPS FILETYPE PROPTYPE FILES) (PUTPROPS BAKTRACELST VARTYPE ALIST) (PUTPROPS BREAKMACROS VARTYPE ALIST) (PUTPROPS COMPILETYPELST VARTYPE ALIST) (PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS)) (PUTPROPS ERRORTYPELST VARTYPE ALIST) (PUTPROPS FONTDEFS VARTYPE ALIST) (PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS)) (PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS)) (PUTPROPS PRETTYEQUIVLST VARTYPE ALIST) (PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST) (PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST) (PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS)) (* ; "Define the commands below AFTER the various properties have been established.") (ADDTOVAR USERMACROS (M NIL (MAKE FILE FILE)) (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITMACROS (M (X . Y) (E (MARKASCHANGED (COND ((LISTP 'X) (CAR 'X)) (T 'X)) 'USERMACROS) T) (ORIGINAL (M X . Y)))) (ADDTOVAR EDITCOMSA M) (ADDTOVAR EDITCOMSL M) (* ; "GETDEF methods") (DEFINEQ (RENAME [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD))) (* ;; "special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message") [for TYPE inside TYPES when (NEQ TYPE 'FIELDS) do (COPYDEF OLD NEW TYPE NIL (COND ((EQ TYPE 'VARS) 'NOERROR] (CHANGECALLERS OLD NEW TYPES FILES METHOD) [for TYPE inside TYPES do (COND ((AND (EQ TYPE 'FIELDS) (HASDEF OLD 'FIELDS)) (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.") (COPYDEF OLD NEW 'FIELDS)) (T (DELDEF OLD TYPE] (RETURN NEW]) (CHANGECALLERS [LAMBDA (OLD NEW AS-TYPES FILES METHOD) (* ; "Edited 6-Dec-86 01:25 by lmm") (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES)) REL TEM EDITCOMS FNS) (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD)) [SETQ EDITCOMS (LIST (COND [(OR (EQMEMB 'CAREFUL METHOD) (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES)) (printout T "Warning --" OLD " is also defined as " TEM T))) (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename. Y means do it, No means skip, anything else goes into TTY.") (SUBPAIR '(OLD NEW) (LIST OLD NEW) '(BIND (LPQ (F OLD N) (MARK %#1) (ORR (1 !0 P) NIL) (MARK %#2) (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " '((Y "Yes ") (N "No ") (% "") (% "") (% "") (& "")) NIL NIL '(NOECHOFLG T)) (Y '(R1 OLD NEW)) (N NIL) 'TTY%:)) (MARK %#3) (IF (EQ (%## (\ %#3)) (%## (\ %#2))) ((\ %#1)) NIL] (T (LIST 'R OLD NEW] (SELECTQ (COND ((AND (EQMEMB 'MASTERSCOPE METHOD) MSDATABASELST (for TYPE inside AS-TYPES do [COND ((SETQ TEM (SELECTQ TYPE ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 'CALL) (MACROS '(CALL DIRECTLY)) ((VARS VARIABLES) '(USE OR BIND)) ((RECORDS FIELDS I.S.OPRS) (LIST 'USE 'AS TYPE)) (RETURN NIL))) (COND (REL (SETQ REL (LIST TEM 'OR REL))) (T (SETQ REL TEM] FINALLY (RETURN REL))) (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known") 'MASTERSCOPE) ((EQMEMB 'EDITCALLERS METHOD) 'EDITCALLERS) (T 'SEARCH)) (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND ((NULL FILES) (UPDATEFILES) (FILEPKGCHANGES 'FNS] (for FILE inside (OR FILES FILELST) join (FILEFNSLST FILE] (FUNCTION UPDATEFN)) (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL)) T) FNS))) (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST) when (SETQ TEM (EDITCALLERS OLD X T)) collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM))) X)))) (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST X)))) (ERROR "UNRECOGNIZED RENAME METHOD" METHOD)) (AND (EQMEMB 'FNS AS-TYPES) (FMEMB OLD FNS) (SETQ FNS (REMOVE OLD FNS))) (EDITFROMFILE FNS FILES OLD EDITCOMS) [for TYPE inside AS-TYPES do (for FILE in (WHEREIS OLD TYPE FILES) do (AND (ADDTOFILE NEW TYPE FILE) (DELFROMFILES OLD TYPE FILE) (printout T OLD " changed to " NEW " on " FILE))) (COND ((SETQ TEM (WHEREIS OLD TYPE FILES)) (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM] (COND (REL (UPDATECHANGED) (COND ((AND (SETQ TEM (GETRELATION OLD REL T)) (WHEREIS TEM 'FNS FILES)) (printout T "Couldn't find where " OLD " is referenced in " TEM T]) ) (DEFINEQ (SHOWDEF [LAMBDA (NAME TYPE FILE) (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ;  "prettyprint NAME as it would be dumped as a TYPE") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP) (DECLARE (SPECVARS . T)) [AND FILE (NEQ FILE (OUTPUT)) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") (* ; "like MOVD, but takes a type.") (PROG (TEM DEF) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) [SETQ DEF (GETDEF OLD TYPE SOURCE (COND ((EQ OPTIONS 'NOCOPY) NIL) (T (REMOVE 'NOCOPY (MKLIST OPTIONS] (* ;  "The default is for GETDEF to return a COPY. Make sure that NOCOPY isn't in options though.") (SELECTQ TYPE (VARS) (FILES [for X in (CAR DEF) do (* ;  "change all the listnames which are of form filenameTYPE") (SELECTQ (CAR X) ((PROP IFPROP) (SETQ X (CDR X))) NIL) (COND ((EQ (CADR X) '*) (SETQ X (CDDR X)) (COND ((AND (LITATOM (CAR X)) (SETQ TEM (STRPOS OLD (CAR X) 1 NIL T T))) (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X) TEM -1))) (COPY (GETTOPVAL (CAR X))) T) (FRPLACA X TEM]) ((PROPS ALISTS) (OR (EQ (CAR NEW) (CAR OLD)) (DSUBST (CAR NEW) (CAR OLD) DEF)) (OR (EQ (CADR NEW) (CADR OLD)) (DSUBST (CADR NEW) (CADR OLD) DEF))) (DSUBST NEW OLD DEF)) (PUTDEF NEW TYPE DEF) (RETURN NEW]) (GETDEF [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") (* ;; "returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found. The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.") (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) (DECLARE (SPECVARS NOCOPY)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST)) (SETQ NOCOPY T)) (T (SETQQ OPTIONS SPELL)) NIL) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (SELECTQ SOURCE (0 (SETQQ SOURCE CURRENT)) (T (SETQQ SOURCE SAVED)) (NIL (SETQQ SOURCE ?)) NIL) [SELECTQ SOURCE (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS))) (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS] (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR)) (fetch NULLDEF of TYPE)) (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS]) (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS))) (COND ((AND (LISTP SOURCE) (EQ (CAR SOURCE) '=)) (SETQ DEF (CDR SOURCE))) (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS)) (SETQ NOCOPY T] (OR NOCOPY (SETQ DEF (COPY DEF))) (COND ((AND (EQ TYPE 'FNS) (NOT (EQMEMB 'NODWIM OPTIONS))) (DWIMDEF DEF NAME SOURCE))) (RETURN DEF]) (GETDEFCOM [LAMBDA (X) (* lmm " 4-Jul-85 13:31") (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed. --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion. That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.") (* ; "a RETFROM point") (for Y in X join (GETDEFCOM0 Y]) (GETDEFCOM0 [LAMBDA (COM) (* wt%: " 7-FEB-79 23:28") (PROG (TEM) (RETURN (COND ((SETQ TEM (fetch MACRO of (CAR COM))) (* COND ((fetch CONTENTS of  (CAR COM)) (* ;  "if it has a CONTENTS function, generally means it is not safe to evaluate")  (RETFROM (QUOTE GETDEFCOM)))) (for Y in (SUBPAIR (CAR TEM) (PRETTYCOM1 COM) (CDR TEM)) join (GETDEFCOM0 Y))) (T (SELECTQ (CAR COM) (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X))) (ADDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'ADDTOVAR Y))) (APPENDVARS (for Y in (PRETTYCOM1 COM) collect (CONS 'APPENDTOVAR Y))) (P (APPEND (PRETTYCOM1 COM))) (RETFROM 'GETDEFCOM]) (GETDEFCURRENT [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ;  "Gets the current definition--source=0") (LET (DEF) (COND ((AND (SETQ DEF (fetch GETDEF of TYPE)) (NEQ DEF T)) (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.") (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS)) (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF) (T (OR (NEQ [SETQ DEF (SELECTQ TYPE (FNS (AND (LITATOM NAME) (EXPRP (SETQ DEF (VIRGINFN NAME))) DEF)) (VARS (if (LITATOM NAME) then (GETTOPVAL NAME) else 'NOBIND)) ((FIELDS RECORDS) (if (LITATOM NAME) then [SETQ DEF (SELECTQ TYPE (RECORDS (RECLOOK NAME)) (MKPROGN (FIELDLOOK NAME] (if (EQMEMB 'EDIT OPTIONS) then (COPY DEF) else DEF))) (FILES (* ;  "what is the `definition' of a file? -- I guess the COMS which say what it contains") [if (LITATOM NAME) then (if (SETQ DEF (GETFILEDEF NAME)) then (UPDATEFILES) (LIST (LISTP (GETTOPVAL (FILECOMS DEF))) (fetch TOBEDUMPED of (fetch FILEPROP of DEF)) (LISTP (fetch FILEDATES of DEF]) (TEMPLATES (if (AND (LITATOM NAME) (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) (KWOTE DEF)))) (MACROS [if [AND (LITATOM NAME) (SETQ DEF (for X on (GETPROPLIST NAME) by (CDDR X) when (FMEMB (CAR X) MACROPROPS) join (LIST (CAR X) (CADR X] then `(PUTPROPS ,NAME ,@DEF]) (EXPRESSIONS (LISTP NAME)) (PROPS [AND (LISTP NAME) (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME)) [FUNCTION (LAMBDA (X) (EQ X (CADR NAME] (FUNCTION CDDR))) (LIST 'PUTPROPS (CAR NAME) (CADR NAME) (CADR DEF]) (FILEPKGCOMS [AND (LITATOM NAME) (PROG ((COM (FILEPKGCOM NAME)) (TYP (FILEPKGTYPE NAME))) (RETURN (COND ((AND COM TYP) (LIST (CONS 'COM COM) (CONS 'TYPE TYP))) (COM (LIST (CONS 'COM COM))) (TYP (LIST (CONS 'TYPE TYP]) (FILEVARS (COND ((AND (LITATOM NAME) (LISTP (SETQ DEF (GETTOPVAL NAME))) (WHEREIS NAME 'FILEVARS)) DEF) (T 'NOBIND))) (LET ((COMS (LIST (MAKENEWCOM NAME TYPE))) FILE) [COND ((NOT (SETQ DEF (GETDEFCOM COMS))) (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (RESETLST (RESETSAVE PRETTYFLG) (RESETSAVE FONTCHANGEFLG) [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH] (PRETTYDEFCOMS COMS) (SETFILEPTR FILE 0) [SETQ DEF (for X in (READFILE FILE) join (SELECTQ (CAR X) ((*) NIL) (DECLARE%: (for Y on (CDR X) unless (SELECTQ (CAR Y) ((COPYWHEN EVAL@LOADWHEN EVAL@COMPILEWHEN) (RETURN (LIST Y))) (FMEMB (CAR Y) DECLARETAGSLST)) collect (CAR Y))) (CL:EVAL-WHEN (CDDR X)) (PROGN (CDR X)) (LIST X] (SETQ NOCOPY T)))] (MKPROGN DEF] (fetch NULLDEF of TYPE)) (GETDEFERR NAME TYPE OPTIONS)) DEF]) (GETDEFERR [LAMBDA (NAME TYPE OPTIONS MSG) (* lmm "13-Jul-85 04:11") (DECLARE (USEDFREE NODEF)) (* ;  "Message non-null if looking for saved or filed definition.") (PROG (TEM) (RETURN (COND ((EQMEMB 'NOERROR OPTIONS) (* ;  "We want to do the string search in the HASDEF case") (RETURN (fetch NULLDEF of TYPE))) [(AND (NULL MSG) (EQMEMB 'SPELL OPTIONS) (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS) 'SPELL) T))) (NEQ TEM NAME)) (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS] (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) T]) (GETDEFFROMFILE [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") (* ;; "Tries to get definition from source file. If successful, returns the definition. Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.") (DECLARE (SPECVARS NAME)) (bind (NOTFOUND _ "not found") DEF SOURCE TEM2 for FILE inside (COND ((EQ SOURCE 'FILE) (WHEREIS NAME TYPE T)) (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) (NEQ [SETQ DEF (COND ((SETQ TEM2 (fetch FILEGETDEF of TYPE)) (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND)) (T (SELECTQ TYPE (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND)) ((VARS FILEVARS) (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND)) (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND)) (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND)) (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND)) (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND)) (COND [(SETQ DEF (GET TYPE 'DEFINERS)) (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF `(LAMBDA (FIRST SECOND) (AND (MEMB FIRST ',DEF) (OR (EQ SECOND NAME) (AND (MEMB SECOND '(%( %[)) (PROGN (RATOM) (RATOM) (RATOM) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) else (CAR VAL] (T (RESETLST (RESETSAVE (RESETUNDO)) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ;  "just in case we get a PRETTYCOMPRINT in here") (LOADFNS NIL SOURCE 'PROP (COND ((LITATOM NAME) (* ;  "If an atom, only bother with expressions that contain it") (CONS (LIST '& '|..| NAME))) (T T] (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))] NOTFOUND)) do (AND (EQ SOURCE 'FILE) (OR (FMEMB FILE FILELST) (CL:FORMAT T "(from ~A)~%%" SOURCE))) (* ;  "Copying and dwimifying are done in GETDEF") (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS (APPEND '(no definition on) (MKLIST SOURCE]) (GETDEFSAVED [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ;  "Gets the `saved' definition--source=T") (SELECTQ TYPE (FNS (OR (GETPROP NAME 'EXPR) (GETDEFERR NAME TYPE OPTIONS "no saved definition for"))) (VARS (* ;  "The value of a variable is never substituted into and never COPIED") (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X) 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS "no saved value for ")))) (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))) (GETDEFERR NAME TYPE OPTIONS "no saved definition for "]) (PUTDEF [LAMBDA (NAME TYPE DEFINITION REASON) (* ; "Edited 8-Apr-87 12:52 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE))) (COND (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON)) (T (SELECTQ TYPE (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON)) (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON)) (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON)) (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON)) (EVAL DEFINITION)) NAME]) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") (* ;; "lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if necessary). If you change it, then the definition gets unsaved. OPTIONS is passed through from ED to the editor.") (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (COND ((AND (fetch EDITDEF of TYPE) (APPLY* (fetch EDITDEF of TYPE) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ;  "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") (EDITDEF.FNS NAME EDITCOMS OPTIONS)) (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS))) NAME]) (DEFAULT.EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 11-Jun-92 16:26 by cat") (PROG [(DEF (COND [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY] [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR] [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR] (T (LET ((FILES (WHEREIS NAME TYPE T))) (CL:IF (NULL FILES) (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE) [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME FILES) (CL:IF (CL:ENDP (CDR FILES)) (CL:IF (CL:Y-OR-N-P "Shall I load this file PROP? ") (CAR FILES)) (ASKUSER NIL NIL "indicate which file to load PROP: " (MAKEKEYLST FILES) T))] (CL:WHEN FILE (LOAD FILE 'PROP) (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])] (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.") (DECLARE (SPECVARS RETRY)) (* ;; "what is RETRY ???") (SETQ RETRY) (CL:WHEN DEF (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG) (* ;  "this function is called when there were changes made") (FIXEDITDATE DEF) (* ; "fix the edit date first - jtm") (PUTDEF NAME TYPE DEF) (MARKASCHANGED NAME TYPE 'CHANGED) (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition. doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here. this sometimes results in MARKASCHANGED getting called twice.") ] OPTIONS))]) (EDITDEF.FILES [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") (EDITDEF (FILECOMS NAME) 'VARS SOURCE EDITCOMS OPTIONS]) (LOADDEF [LAMBDA (NAME TYPE SOURCE) (* lmm "13-SEP-78 01:34") (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY]) (DWIMDEF [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) 'CLISP%:) (SELECTQ SOURCE ((CURRENT SAVED FILE ?) NIL) (AND (LITATOM SOURCE) (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE] (LET ((NOSPELLFLG T) (DWIMESSGAG T) FILEPKGFLG LISPXHIST) (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST)) (DWIMIFY0 DEF (COND ((OR (LISTP FN) (NULL FN)) '?) (T FN)) NIL DEF]) (DELDEF [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND ((SETQ TEM (fetch DELDEF of TYPE)) (APPLY* TEM NAME TYPE)) (T (SELECTQ TYPE (FNS (* ;  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such") (AND (EXPRP NAME) (/PUTD NAME)) (REMPROP NAME 'EXPR) [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME]) (VARS (/SETTOPVAL NAME 'NOBIND)) (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES) do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST] (/replace FILEPROP of NAME with NIL) (/replace FILECHANGES of NAME with NIL) (/replace FILEDATES of NAME with NIL) (FLUSHFILEMAPS NAME)) (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME) (DELFROMLIST 'FILEPKGTYPES NAME) (for FIELD on (FILEPKGCOM NAME) by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD) NIL)) (for FIELD on (FILEPKGTYPE NAME) by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD) NIL)) (/replace ALLFIELDS of NAME with NIL)) (ALISTS [AND (LISTP NAME) (DELFROMLIST (CAR NAME) (FASSOC (CADR NAME) (GETTOPVAL (CAR NAME]) (MACROS (for P in MACROPROPS do (/REMPROP NAME P))) (PROPS (AND (LISTP NAME) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS )) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") T] (MARKASCHANGED NAME TYPE 'DELETED) (RETURN NAME]) (DELFROMLIST [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) (AND (NEQ X VAL) (OR (NLISTP X) (NEQ (CDR X) VAL]) (HASDEF [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") (* ;; "is NAME the name of something of type TYPE? NIL SOURCE means 0, not ?") (DECLARE (SPECVARS TYPE)) (COND [[OR (LISTP TYPE) (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] (COND ((NULL SOURCE) (SETQQ SOURCE CURRENT))) (RETURN (SELECTQ SOURCE ((CURRENT 0) [COND ([OR (MEMBER NAME (fetch CHANGED of TYPE)) (LET ((TM (fetch HASDEF of TYPE))) (COND (TM (APPLY* TM NAME TYPE SOURCE)) [(NOT (LITATOM NAME)) (SELECTQ TYPE (PROPS (AND (LISTP NAME) (GETPROP (CAR NAME) (CADR NAME)))) ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS FIELDS USERMACROS FILEVARS FILEPKGCOMS) NIL) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (T (* ;; "symbol definitions") (SELECTQ TYPE (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS") "INTERLISP"))) (AND SYMBOL (BOUNDP SYMBOL)))) (TEMPLATES (GETTEMPLATE NAME)) (MACROS (GETLIS NAME MACROPROPS)) (LISPXMACROS (OR (FASSOC NAME LISPXMACROS) (FASSOC NAME LISPXHISTORYMACROS))) (VARS (AND (NOT (CL:KEYWORDP NAME)) (NEQ (GETTOPVAL NAME) 'NOBIND))) (RECORDS (RECLOOK NAME)) (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD] (RETURN (AND TEM (EQ (CAR TEM) 'FORWORD) (GETPROP (CDR TEM) 'I.S.OPR]) (FNS (AND (OR (AND (GETD NAME) (EXPRP (GETD NAME))) (GET NAME 'EXPR)) (NOT (HASDEF NAME 'FUNCTIONS SOURCE)))) (FIELDS (RECORDFIELD? NAME)) (USERMACROS (FASSOC NAME USERMACROS)) (FILEVARS) ((PROPS ALISTS DEFS EXPRESSIONS) NIL) (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST) (FMEMB NAME FILEPKGTYPES))) (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS] (OR NAME T)) (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME) (FIXSPELL NAME NIL (SELECTQ TYPE (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) (LISPXMACROS LISPXCOMS) (I.S.OPRS I.S.OPRLST) (USERMACROS (MAPCAR USERMACROS (FUNCTION CAR))) USERWORDS) NIL (LISTP SPELLFLG) [FUNCTION (LAMBDA (X) (HASDEF X TYPE 'CURRENT] NIL T))]) (? (OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED SPELLFLG)) (WHEREIS NAME TYPE T))) ((SAVED T) (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS))) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") (* ;;  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST") (COND ((FMEMB FILENAME FILELST) FILENAME) (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T) do (COND ((EQ (FILENAMEFIELD FILE 'NAME) FILENAME) (RETURN FILE]) (SAVEDEF [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) (MAPCAR NAME (FUNCTION (LAMBDA (I) (SAVEDEF I 'FNS] (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME))) (/PUT NAME [SETQ TYPE (COND ((SUBRP DEFINITION) 'SUBR) ((EXPRP DEFINITION) 'EXPR) ((CCODEP DEFINITION) 'CODE) (T 'LIST] DEFINITION))) (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME))) 'NOBIND) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR NODWIM] (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS)) (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME)) SAVEDDEFS] TYPE]) (UNSAVEDEF [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND [(LISTP NAME) (* ; "for compatibility") (MAPCAR NAME (FUNCTION (LAMBDA (X) (UNSAVED1 X TYPE] (T (UNSAVED1 NAME TYPE)))) (PROG NIL [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) 'SAVED 0)) (RETURN (CONS TYPE '(not found] (COND ((NEQ DFNFLG T) (SAVEDEF NAME TYPE) (LET ((DFNFLG T)) (PUTDEF NAME TYPE DEF))) (T (PUTDEF NAME TYPE DEF))) (RETURN TYPE]) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) (GETFILEPKGTYPE SOURCES NIL T)) (swap TYPE SOURCES))) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T] [COND ((NULL SOURCES) (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE)) (SOME SRCS (FUNCTION (LAMBDA (FILE) (MEMBER NAME (CDR (ASSOC TYPE (fetch TOBEDUMPED of (fetch FILEPROP of FILE] (push SRCS 'CURRENT] (SETQ SRCS (for SRC in SRCS when (COND ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY] (fetch NULLDEF of TYPE)) (OR [SOME DEFS (FUNCTION (LAMBDA (DP) (COMPARELST DEF (CDR DP] (push DEFS (CONS SRC DEF))) T) (T (PRINTOUT T "No " SRC " definition found for " NAME T) NIL)) collect SRC)) (RETURN (COND ((NULL SRCS) '(no definitions found)) ((NULL (CDR SRCS)) '(only one definition found)) ((CDR DEFS) [for S1 on (DREVERSE DEFS) do (for S2 on (CDR S1) do (PRIN2 NAME T T) (AND (CAAR S1) (PRIN1 " from " T) (PRIN2 (CAAR S1) T T)) (PRIN1 " and " T) (PRIN2 NAME T T) (COND ((CAAR S2) (PRIN1 " from " T) (PRIN2 (CAAR S2) T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS (CDAR S1) (CDAR S2] 'DIFFERENT) (T 'SAME]) (COMPARE [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY] (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY] (COND ((COMPARELST DEF1 DEF2) (RETURN))) (PRIN2 NAME1 T T) (COND (SOURCE1 (PRIN1 " from " T) (PRIN2 SOURCE1 T T))) (PRIN1 " and " T) (PRIN2 NAME2 T T) (COND (SOURCE2 (PRIN1 " from " T) (PRIN2 SOURCE2 T T))) (PRIN1 " differ:" T) (TERPRI T) (COMPARELISTS DEF1 DEF2) (RETURN T]) (TYPESOF [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER) (* ; "Edited 2-Aug-88 02:08 by masinter") (* ;; "return list of all known types which NAME names") (LET (FOUND SHADOWED) (if (FMEMB SOURCE '(? NIL)) then (CL:FLET [(RSHADOW NIL (for X in FOUND do (for Y in (CDR (FASSOC X SHADOW-TYPES)) do (if (FMEMB Y FOUND) then (* ; "shadower found before shadowed") (SETQ FOUND (REMOVE Y FOUND] (LET (NOTFOUND NEWTYPES) (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when [AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (NOT (find X in FOUND suchthat (FMEMB TYPE (CDR (FASSOC X SHADOW-TYPES] do (if [OR (HASDEF NAME TYPE 'CURRENT) (AND (LITATOM NAME) (HASDEF NAME TYPE 'SAVED] then (push FOUND TYPE) else (push NOTFOUND TYPE))) (RSHADOW) [for FILE in FILELST while NOTFOUND when [NEQ T (fetch LOADTYPE of (GETPROP FILE 'FILE] do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND (FILECOMS FILE) 'TYPESOF)) then [bind X for TYPE in NEWTYPES when (FMEMB TYPE NOTFOUND) do (push FOUND TYPE) (if (SETQ X (FASSOC TYPE SHADOW-TYPES)) then (SETQ NOTFOUND (LDIFFERENCE NOTFOUND X)) else (SETQ NOTFOUND (REMOVE TYPE NOTFOUND] (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES] (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF)) then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND)) (SETQ FOUND (UNION NEWTYPES FOUND))) (RSHADOW) FOUND)) else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES) when (AND (LITATOM TYPE) (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) (OR (NULL FILTER) (CL:FUNCALL FILTER TYPE)) (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) (RPAQ? WHEREIS.HASH ) (* ; "Must come after PUTDEF") (DEFINEQ (FIXEDITDATE [LAMBDA (EXPR) (* ; "Edited 17-Jul-89 11:13 by jtm:") (* NOBIND "18-JUL-78 21:11") (* Inserts or replaces previous edit  date) (AND INITIALS (LISTP EXPR) (LISTP (CDR EXPR)) (PROG (E) (COND ((FMEMB (CAR EXPR) LAMBDASPLST) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR))) [(FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-ARGLIST-DEFINERS) (* ;; "insert the edit date after the argument list") (SETQ E (CDDR EXPR)) (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E)) finally (SETQ E (CDR E] ((FMEMB (GETPROP (CAR EXPR) ':DEFINER-FOR) EDITDATE-NAME-DEFINERS) (* ;; "insert the edit date after the name") (SETQ E (CDDR EXPR))) (T (RETURN))) RETRY [COND ((NLISTP E) (RETURN)) ((LISTP (CAR E)) (SELECTQ (CAAR E) ((CLISP%: DECLARE) (SETQ E (CDR E)) (GO RETRY)) (BREAK1 (COND ((EQ (CAR (CADAR E)) 'PROGN) (SETQ E (CDR (CADAR E))) (GO RETRY)))) (ADV-PROG (* No easy way to mark cleanly the  date of an advised function) (RETURN)) (COND ((AND (EQ (CAAR E) COMMENTFLG) (EQ (CADAR E) 'DECLARATIONS%:)) (SETQ E (CDR E)) (GO RETRY] (COND ([for TAIL on E while (AND (LISTP (CAR TAIL)) (EQ (CAAR TAIL) COMMENTFLG)) do (COND ((AND (LISTP (CDR TAIL)) (EDITDATE? (CAR TAIL))) (/RPLACA TAIL (EDITDATE (CAR TAIL) INITIALS)) (RETURN T] (* scans the comments for a  timestamp for this user.) NIL) (T (* attach the new timestamp at the  beginning of the comments.) (/ATTACH (EDITDATE NIL INITIALS) E))) (RETURN EXPR]) (EDITDATE? [LAMBDA (COMMENT) (* ; "Edited 11-Jun-92 16:44 by cat") (* ; "Edited 13-Jul-89 09:30 by jtm:") (* lmm "21-Mar-85 08:45") (* Tests to see if a given common is in fact an edit date --  this has to be general enough to recognize the most comment comment forms while  specific enough to not recognize things that are not edit dates) (DECLARE (LOCALVARS . T)) (* jtm%: changed test so that it  creates one timestamp per user.) (COND [(LISTP COMMENT) (COND ((EQ (CAR COMMENT) COMMENTFLG) [COND (NIL (NULL NORMALCOMMENTSFLG) (SETQ COMMENT (GETCOMMENT COMMENT] (COND ([OR (NOT (LISTP (CDR COMMENT))) (NOT (LISTP (CDDR COMMENT] NIL) [(EQ (CADR COMMENT) ';) (* ; "CL style comment") (STRPOS INITIALS (CADDR COMMENT) (IMINUS (NCHARS INITIALS] (T (* ; "IL style comment") (EQ (CADR COMMENT) INITIALS] ((STRINGP COMMENT]) ) (* ; "Edit date support for all kinds of definers (from PARC 6/10/92)") (RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES)) (RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS) ) (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started." ) (DEFINEQ (FILEPKGCOM [LAMBDA N (* JonL "10-Jul-84 19:38") (PROG (TEM (COM (ARG N 1))) (RETURN (COND [(EQ N 1) (OR (for FIELD in '(MACRO CONTENTS DELETE ADD) when (SETQ TEM (FILEPKGCOM COM FIELD)) join (LIST FIELD TEM)) (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (LIST 'COM T)) (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (LIST 'COM TEM] ((EQ N 2) (SELECTQ (ARG N 2) (ADD (fetch ADD of COM)) (DELETE (fetch DELETE of COM)) (MACRO (fetch MACRO of COM)) ((CONTENTS CONTAIN) [OR (fetch (FILEPKGCOM CONTENTS) of COM) (COND ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM)) (COND ((EQ COM 'NILL) COM) [(EQ (CAR COM) 'LAMBDA) (CONS (CAR COM) (CONS [CONS (CAADR COM) (CONS (OR (CADDR (CADR COM)) 'NAME) (CONS (CADR (CADR COM)) (CDDDR (CADR COM] (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM] (T (LIST 'LAMBDA '(COM TYPE NAME) (CONS COM '(COM TYPE NAME]) (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) T) (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]) (ERROR (ARG N 2) "not file package command property"))) (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'COM) (SELECTQ TEM (NIL) (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]) (COND ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST] (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGCOMSPLST (CONS (CONS COM TEM) (GETTOPVAL 'FILEPKGCOMSPLST] (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST)) (/SETTOPVAL 'FILEPKGCOMSPLST (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST] (SELECTQ (ARG N I) (ADD (/replace (FILEPKGCOM ADD) of COM with TEM)) (DELETE (/replace (FILEPKGCOM DELETE) of COM with TEM)) (MACRO (/replace (FILEPKGCOM MACRO) of COM with TEM)) ((CONTENTS CONTAIN) (/replace (FILEPKGCOM CONTENTS) of COM with TEM)) (ERROR (ARG N I) "not file package command property"] (MARKASCHANGED COM 'FILEPKGCOMS]) (FILEPKGTYPE [LAMBDA N (* lmm " 5-Jul-85 09:07") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES] (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) (DESCRIPTION (fetch DESCRIPTION of TYPE)) (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) T) (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]) (ERROR (ARG N 2) "not file package type property"] (T [for I TEM2 from 2 to N by 2 do (SETQ TEM (ARG N (ADD1 I))) (COND [(EQ (ARG N I) 'TYPE) (SELECTQ TEM (NIL) (T (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES)))) (COND ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES)) (/RPLACD TEM2 TEM)) (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM) FILEPKGTYPES] (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES) (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES ] (if (FMEMB (ARG N I) FILEPKGTYPEPROPS) then (if TEM then (/PUTPROP TYPE (ARG N I) TEM) else (/REMPROP TYPE (ARG N I))) else (SELECTQ (ARG N I) (DESCRIPTION (/replace DESCRIPTION of TYPE with TEM)) (ERROR (ARG N I) "not file package command/type property" ] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) (PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS))) (ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS) (ADDTOVAR FILEPKGTYPES FILEPKGCOMS) (PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE) (* Revert to NILL when no longer coercing PRETTYDEFMACROS to FILEPKGCOMS) (AND (EQ TYPE 'FILEPKGCOMS) (INFILECOMTAIL COM] (TYPE DESCRIPTION "file package commands/types" GETDEF T PUTDEF FILEPKGCOMS.PUTDEF))) (PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X] (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF WHENCHANGED (ALISTS.WHENCHANGED)))) (PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X]) (PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS))) (PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED ( EXPRESSIONS.WHENCHANGED ) EDITDEF NILL))) (PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL))) (PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS) (TYPE TYPE FILEPKGCOMS))) (PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X] CONTENTS (LAMBDA (COM NAME TYPE) (AND (EQ TYPE 'FILES) (SUBSET (INFILECOMTAIL COM) (FUNCTION LITATOM] (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED) EDITDEF EDITDEF.FILES))) (PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X))) (TYPE NULLDEF NOBIND EDITDEF NILL))) (PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (FN) (AND (GETPROP FN 'FUNCTIONS) (CL:WARN "~A has a FUNCTIONS definition" FN] (ORIGINAL (FNS . X))) CONTENTS NILL) (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF T))) (PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS))) (PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "LISPX commands"))) (PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM MACRO [X (DECLARE%: EVAL@COMPILE (P * (MAPCAR 'X (FUNCTION (LAMBDA (Y) (LET [[FNDEF (GETDEF Y 'FUNCTIONS 'CURRENT '(NOCOPY NOERROR] (MACDEF (GETDEF Y 'MACROS 'CURRENT '(NOCOPY NOERROR] (COND ((AND FNDEF (EQ (CAR FNDEF) 'DEFMACRO)) (CL:WARN "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S." FNDEF) (LIST 'PROGN FNDEF MACDEF)) (T (OR MACDEF (CL:CERROR "Go ahead and finish writing out the file." "No MACROS definition for ~A." Y) (GETDEF Y 'MACROS 'CURRENT] CONTENTS NILL) (TYPE DESCRIPTION "Interlisp macros" GETDEF MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY)))) (PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS))) (PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X] (TYPE DESCRIPTION "property lists" WHENCHANGED ( PROPS.WHENCHANGED )))) (PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (RECORD) (AND (GETPROP RECORD 'STRUCTURES) (CL:WARN "~A has a STRUCTURES definition" RECORD] (E (RECORDECLARATIONS . X)) (INITRECORDS . X)) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (EQ TYPE 'FIELDS) (NULL ONFILETYPE) (MAPCONC (INFILECOMTAIL COM) (FUNCTION (LAMBDA (X) (APPEND ( RECORDFIELDNAMES X] (TYPE DESCRIPTION "records" DELDEF (LAMBDA (X) (/SETTOPVAL 'USERRECLST (REMOVE (RECLOOK X) USERRECLST]) (PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T))) (PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X))) CONTENTS (LAMBDA (COM NAME TYPE ONFILETYPE) (AND (NULL ONFILETYPE) (EQ TYPE 'RECORDS) (INFILECOMTAIL COM]) (PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))) CONTENTS NILL) (TYPE DESCRIPTION "edit macros"))) (PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X [E (MAPC 'X (FUNCTION (LAMBDA (VAR) (AND (GETPROP VAR 'VARIABLES) (CL:WARN "~A also has a VARIABLES definition" VAR] (ORIGINAL (VARS . X))) CONTENTS NILL) (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF VARS.PUTDEF))) (PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL))) (PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X) (P (CONSTANTS . X]) (ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS) (VARIABLES VARS CONSTANTS)) (RPAQ? SAVEDDEFS ) (* ; "EDITCALLERS") (DEFINEQ (FINDCALLERS [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) (LIST (CONS (COND ((CDR X) '"plus other places on") (T 'on)) (CAR X]) (EDITCALLERS [LAMBDA (ATOMS FILES COMS) (* ; "Edited 8-Aug-2020 17:32 by rmk:") (* bvm%: " 3-Nov-86 17:30") (LET (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN) [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS] [for FILE in (COND ((NULL FILES) FILELST) ((EQ FILES T) (UNION SYSFILES FILELST)) ((LISTP FILES) FILES) (T (LIST FILES))) do (RESETLST [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I) (OR (SETQ FULL (FINDFILE FILE)) (RETURN (LISPXPRINT (CONS FILE '(not found)) T T))) [RESETSAVE NIL (LIST (FUNCTION CLOSEF?) (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT] (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM))) (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP) (OR (GET-ENVIRONMENT-AND-FILEMAP FULL) (\PARSE-FILE-HEADER FILESTREAM))) (* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file") (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))) (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL)) [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS))) (push FFILEPOSPATTERNS (CONS RDTBL (SETQ PATTERNS (for ATOM in ATOMS collect (CONCAT (COND ((EQ (CHCON1 ATOM) (CHARCODE ESCAPE)) (SETQ ATOM (SUBSTRING ATOM 2 -1)) "") (T " ")) [COND ((SETQ I (STRPOS ' ATOM)) (SUBSTRING ATOM 1 (SUB1 I))) ((STRINGP ATOM)) (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE ATOM))) (* ;  "Keep MKSTRING from putting a prefix on") (MKSTRING ATOM T RDTBL] (COND (I "") (T " "] (for PATTERN in PATTERNS do (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0))) (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA)) do (COND ((NULL PRINTFLG) (* ;  "cause the printing of the filename to be saved on history list") (SETQ PRINTFLG T) (LISPXPRIN2 FULL T T T) (* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list") (LISPXPRIN1 ": " T NIL T))) [OR [AND (NEQ MAP T) (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0) (SETQ MAP (OR (GETFILEMAP FILESTREAM) (LOADFILEMAP FILESTREAM] (PROGN (* ; "file has no filemap") (SETQ MAP (SETQ NOMAPFLG T)) (LISPXPRIN1 " no filemap!" T) NIL))) thereis (AND (ILESSP (CAR X) I) (IGREATERP (CADR X) I) (for Z in (CDDR X) thereis (COND ((AND (ILESSP (CADR Z) I) (IGREATERP (CDDR Z) I)) [COND ((NOT (FMEMB (CAR Z) FNS)) (SETQ FNS (CONS (LISPXPRIN2 (CAR Z) T T) FNS] (SETQ I (CDDR Z)) T] (PROGN (LISPXPRIN2 I T T) (OR (FMEMB FILE OTHERSFILES) (SETQ OTHERSFILES (CONS FILE OTHERSFILES] (LISPXSPACES 1 T))) (COND (PRINTFLG (LISPXTERPRI T)) (T (TERPRI T))) (COND ((NEQ COMS T) (COND ((OR FNS OTHERSFILES) (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS)) FULL EDITPATTERN COMS (NULL OTHERSFILES)) (SETQ OTHERSFILES) (SETQ FNS])] (COND ((EQ COMS T) (CONS OTHERSFILES FNS]) (EDITFROMFILE [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* rmk%: "14-Mar-85 21:51") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) (T EDITLOADFNSFLG] (PROG NIL [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN] (AND (SETQ FILES (for FILE inside (OR FILES FILELST) when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE) FILELST)) (COND ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" FILE) NIL T)) (LOADFROM FILE FNS 'ALLPROP) T))) collect FILE)) (for TYPE in [COND ((LISTP ONLYTYPES)) (ONLYTYPES '(FNS)) (T (* ;; "Move FNS to the front. This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.") (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) (NEQ (fetch EDITDEF of TYPE) 'NILL)) do (PROG (SEEN) (for FILE inside FILES do (for NAME in [COND ((AND (EQ TYPE 'FNS) (NEQ FNS T)) (* ;  "for this type, we are given the list of items") (PROG1 FNS (SETQ FNS NIL))) (T (* ;  "only want the values of `TYPE' which are not part of some other type") (FILECOMSLST FILE TYPE 'EDIT] unless (MEMBER NAME SEEN) do (ERSETQ (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT '(NOCOPY NOERROR)) (GETDEF NAME TYPE 'SAVED '(NOCOPY NOERROR] (* ;; "If definition has been loaded, it may have been editted. Work on that explicitly instead of bringing in a file definition to smash the users previous changes. Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS. --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file. But ... rmk") (COND ((OR (AND (EQ TYPE 'FNS) (NEQ FNS T)) (AND (LISTP DEF) (LOOKIN DEF EDITPATTERN))) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) (LISPXPRIN1 (OR (fetch DESCRIPTION of TYPE) TYPE) T) (LISPXSPACES 1 T))) (SETQ SEEN (CONS NAME SEEN)) (LISPXPRIN2 NAME T T) (LISPXPRIN1 ": " T) (COND ((NOT (ERSETQ (EDITDEF NAME TYPE (OR (AND DEF (CONS '= DEF)) FILE) EDITCOMS))) (LISPXPRIN1 "failed" T))) (LISPXTERPRI T]) (FINDATS [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) (T (OR (FINDATS (CAR X) L) (FINDATS (CDR X) L]) (LOOKIN [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) (EVERY (CDR PAT) (FUNCTION (LAMBDA (X) (AND (LITATOM X) (NOT (STRPOS ' X] (FINDATS X (CDR PAT))) (T (EDITFINDP X PAT T]) ) (DEFINEQ (SEPRCASE [LAMBDA (CLFLG RDTBL) (* bvm%: "24-Oct-86 18:16") (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent. Based on FILERDTBL, but others are close with respect to breaks and seprs") (OR RDTBL (SETQ RDTBL FILERDTBL)) (OR [ARRAYP (CDR (ASSOC RDTBL (COND (CLFLG CLISPCASEARRAYS) (T SEPRCASEARRAYS] (LET ((CA (CASEARRAY))) [if (READTABLEPROP RDTBL 'CASEINSENSITIVE) then (* ; "map upper into lower case") (for I from (CHARCODE A) to (CHARCODE Z) do (SETCASEARRAY CA I (+ I (- (CHARCODE a) (CHARCODE A] (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS collect (CHCON1 Y))) (GETSEPR RDTBL) (GETBRK RDTBL)) do (SETCASEARRAY CA X 0)) (if *PACKAGE* then (* ;  "symbols qualified with package prefix will otherwise be unfindable") (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR) 0)) (SETQ CA (CONS RDTBL CA)) (COND (CLFLG (push CLISPCASEARRAYS CA)) (T (push SEPRCASEARRAYS CA))) (CDR CA]) ) (RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL)) (RPAQ? SEPRCASEARRAYS ) (RPAQ? CLISPCASEARRAYS ) (MOVD? 'INFILEP 'FINDFILE) (* ; "or else from SPELLFILE") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG) (NOLINKFNS LOADFROM)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS) ) (* ; "EXPORT") (DEFINEQ (IMPORTFILE [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT] (RESETSAVE (INPUT FILE)) (* ;  "Reset INPUT in case some form on the file's action is to read the next expression") (NCONC [COND ((EQ RETURNFLG T) (* ;  "Just creating EXPORTS.ALL, don't side-effect the world") (IMPORTFILESCAN FILE RETURNFLG)) (T (LET (FILEPKGFLG DFNFLG) (IMPORTFILESCAN FILE RETURNFLG] (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE)) ''IMPORTDATE (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms") (AND (LISTP FORM) (SELECTQ (CAR FORM) (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG))) (/DECLAREDATATYPE (* ;  "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) (EVAL FORM)) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE) (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF join (until (EQUAL (SETQ DEF (READ FILE)) ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ;  "Loads exported definitions from new versions of FILES.") (COND ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE when [AND (SETQ FULLFILENAME (FINDFILE FILE T)) (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE) 'IMPORTDATE] (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 'ICREATIONDATE] collect (LIST FILE FULLFILENAME))) (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from " (MAPCAR FILES (FUNCTION CAR))) '((Y "es ") (N "o ")) T) (N NIL) T))) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS [LAMBDA (FROMFILES TOFILE FLG) (* bvm%: "14-Oct-86 23:12") (* ;  "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] (RESETSAVE (OUTPUT TOFILE)) (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*)) (SETQ ENV (if ENV then (\DO-DEFINE-FILE-INFO NIL ENV) else *OLD-INTERLISP-READ-ENVIRONMENT*)) (WITH-READER-ENVIRONMENT ENV (PRINT-READER-ENVIRONMENT ENV) (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T) " ON " (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) (FUNCTION PRINT)) (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") (* ;;; "Dumps an EXPORT form. IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.") (PRIN1 "(") (PRIN2 '*) (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2)) (* ;  "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) (TERPRI]) ) (PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X]) (RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")") (RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM) ) (* ; "for GAINSPACE") (DEFINEQ (CLEARFILEPKG [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG ((E T) T) (Y (TERPRI T) (PRIN1 "you can delete just the filemaps - " T) (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? " '((Y "es - everything" RETURN T) (N "o - just the filemaps" RETURN NIL) (E "verything" RETURN T) (F "ilemaps only" RETURN NIL] (TERPRI T))) NIL) (UPDATEFILES) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED of (fetch FILEPROP of FILE)) (PRINT FILE T T) (PRIN1 " has changes, not wiped." T) (TERPRI T) T) (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) (NCONC1 SYSFILES FILE) NIL] (SETQ LOADEDFILELST))) (SELECTQ FLG ((NIL T)) (CLRHASH *FILEMAP-HASH*]) ) (ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE) ((Y "es") (N "o") (E . "verything") (F "ilemaps only% -")))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS SMASHPROPSLST1) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T) (SPECVARS COMSNAME)) (BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM (NOLINKFNS . T) (SPECVARS COMSNAME) (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1)) (BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG) INFILECOMSPROP) (BLOCK%: NIL MAKEFILE (LOCALVARS . T) (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES)) (BLOCK%: ADDFILE ADDFILE ADDFILE0) (BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T)) (BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS) (LOCALVARS . T)) (BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T)) (BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED (RETFNS GETDEFCOM) (NOLINKFNS . T) (GLOBALVARS NOT-FOUNDTAG)) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES) ) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020)) (DECLARE%: DONTCOPY (FILEMAP (NIL (22668 24373 (SEARCHPRETTYTYPELST 22678 . 23657) (PRETTYDEFMACROS 23659 . 24117) ( FILEPKGCOMPROPS 24119 . 24371)) (25175 59116 (CLEANUP 25185 . 26573) (COMPILEFILES 26575 . 26851) ( COMPILEFILES0 26853 . 27573) (CONTINUEDIT 27575 . 28995) (MAKEFILE 28997 . 40639) (FILECHANGES 40641 . 42976) (FILEPKG.MERGECHANGES 42978 . 43801) (FILEPKG.CHANGEDFNS 43803 . 44115) (MAKEFILE1 44117 . 48387) (COMPILE-FILE? 48389 . 49721) (MAKEFILES 49723 . 51416) (ADDFILE 51418 . 53939) (ADDFILE0 53941 . 58077) (LISTFILES 58079 . 59114)) (59804 95044 (FILEPKGCHANGES 59814 . 61164) (GETFILEPKGTYPE 61166 . 64239) (MARKASCHANGED 64241 . 65878) (FILECOMS 65880 . 66264) (WHEREIS 66266 . 67686) ( SMASHFILECOMS 67688 . 67923) (FILEFNSLST 67925 . 68087) (FILECOMSLST 68089 . 68573) (UPDATEFILES 68575 . 73875) (INFILECOMS? 73877 . 75780) (INFILECOMTAIL 75782 . 76922) (INFILECOMS 76924 . 77085) ( INFILECOM 77087 . 87296) (INFILECOMSVALS 87298 . 87625) (INFILECOMSVAL 87627 . 88629) (INFILECOMSPROP 88631 . 89460) (IFCPROPS 89462 . 90723) (IFCEXPRTYPE 90725 . 91236) (IFCPROPSCAN 91238 . 92291) ( IFCDECLARE 92293 . 93604) (INFILEPAIRS 93606 . 93938) (INFILECOMSMACRO 93940 . 95042)) (95079 125174 ( FILES? 95089 . 97282) (FILES?1 97284 . 97934) (FILES?PRINTLST 97936 . 98718) (ADDTOFILES? 98720 . 108641) (ADDTOFILE 108643 . 109559) (WHATIS 109561 . 111537) (ADDTOCOMS 111539 . 113183) (ADDTOCOM 113185 . 119732) (ADDTOCOM1 119734 . 120905) (ADDNEWCOM 120907 . 121957) (MAKENEWCOM 121959 . 123802) (DEFAULTMAKENEWCOM 123804 . 125172)) (125244 128061 (MERGEINSERT 125254 . 127597) (MERGEINSERT1 127599 . 128059)) (129323 140235 (DELFROMFILES 129333 . 130183) (DELFROMCOMS 130185 . 131864) (DELFROMCOM 131866 . 137734) (DELFROMCOM1 137736 . 138533) (REMOVEITEM 138535 . 139409) (MOVETOFILE 139411 . 140233)) (140449 142818 (SAVEPUT 140459 . 142816)) (142943 151267 (UNMARKASCHANGED 142953 . 144661) ( PREEDITFN 144663 . 147174) (POSTEDITPROPS 147176 . 149677) (POSTEDITALISTS 149679 . 151265)) (151416 171970 (ALISTS.GETDEF 151426 . 151805) (ALISTS.WHENCHANGED 151807 . 152451) (CLEARCLISPARRAY 152453 . 153627) (EXPRESSIONS.WHENCHANGED 153629 . 154003) (MAKEALISTCOMS 154005 . 155078) (MAKEFILESCOMS 155080 . 156517) (MAKELISPXMACROSCOMS 156519 . 158537) (MAKEPROPSCOMS 158539 . 159237) ( MAKEUSERMACROSCOMS 159239 . 161039) (PROPS.WHENCHANGED 161041 . 161662) (FILEGETDEF.LISPXMACROS 161664 . 163106) (FILEGETDEF.ALISTS 163108 . 163727) (FILEGETDEF.RECORDS 163729 . 164660) (FILEGETDEF.PROPS 164662 . 165454) (FILEGETDEF.MACROS 165456 . 166516) (FILEGETDEF.VARS 166518 . 166934) (FILEGETDEF.FNS 166936 . 168300) (FILEPKGCOMS.PUTDEF 168302 . 170742) (FILES.PUTDEF 170744 . 171701) (VARS.PUTDEF 171703 . 171846) (FILES.WHENCHANGED 171848 . 171968)) (173992 181425 (RENAME 174002 . 175403) ( CHANGECALLERS 175405 . 181423)) (181426 229374 (SHOWDEF 181436 . 182229) (COPYDEF 182231 . 184705) ( GETDEF 184707 . 186983) (GETDEFCOM 186985 . 187951) (GETDEFCOM0 187953 . 189299) (GETDEFCURRENT 189301 . 195721) (GETDEFERR 195723 . 197024) (GETDEFFROMFILE 197026 . 201306) (GETDEFSAVED 201308 . 202412) (PUTDEF 202414 . 203117) (EDITDEF 203119 . 204096) (DEFAULT.EDITDEF 204098 . 206934) (EDITDEF.FILES 206936 . 207137) (LOADDEF 207139 . 207315) (DWIMDEF 207317 . 208171) (DELDEF 208173 . 211187) ( DELFROMLIST 211189 . 211693) (HASDEF 211695 . 218017) (GETFILEDEF 218019 . 218541) (SAVEDEF 218543 . 220202) (UNSAVEDEF 220204 . 221100) (COMPAREDEFS 221102 . 224404) (COMPARE 224406 . 225110) (TYPESOF 225112 . 229372)) (229441 234484 (FIXEDITDATE 229451 . 232954) (EDITDATE? 232956 . 234482)) (234903 243489 (FILEPKGCOM 234913 . 239846) (FILEPKGTYPE 239848 . 243487)) (255526 270078 (FINDCALLERS 255536 . 256051) (EDITCALLERS 256053 . 263711) (EDITFROMFILE 263713 . 269393) (FINDATS 269395 . 269667) ( LOOKIN 269669 . 270076)) (270079 271806 (SEPRCASE 270089 . 271804)) (272323 277865 (IMPORTFILE 272333 . 273307) (IMPORTEVAL 273309 . 274189) (IMPORTFILESCAN 274191 . 274612) (CHECKIMPORTS 274614 . 275950 ) (GATHEREXPORTS 275952 . 277275) (\DUMPEXPORTS 277277 . 277863)) (278203 280411 (CLEARFILEPKG 278213 . 280409))))) STOP \ No newline at end of file diff --git a/sources/LLKEY.LCOM.~1~ b/sources/LLKEY.LCOM.~1~ deleted file mode 100644 index 96d6a036..00000000 --- a/sources/LLKEY.LCOM.~1~ +++ /dev/null @@ -1,141 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 9-Apr-2000 16:32:15" ("compiled on " {DSK}sybalsky>lispcore>sources>LLKEY.;7) "30-Jan-2000 16:38:25" "COMPILE-FILEd" in "Medley 31-Jan-20 ..." dated "31-Jan-2000 00:39:45") (FILECREATED " 9-Apr-2000 16:28:23" {DSK}sybalsky>lispcore>sources>LLKEY.;7 207701 changes to%: (FNS FLIPCURSORBAR FLIPCURSOR) previous date%: "30-Mar-2000 20:01:05" {DSK}sybalsky>lispcore>sources>LLKEY.;6) (RPAQQ LLKEYCOMS ((COMS (* ; "Access to keyboard") (FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \NSYSBUFCHARS \SAVESYSBUF \SYSBUFP \GETSYSBUF \PUTSYSBUF \PEEKSYSBUF) (INITVARS (\LONGSYSBUF)) ( INITVARS (\\KEYBOARDWAITBOX.GLOBALRESOURCE)) (DECLARE%: DONTCOPY (RESOURCES \KEYBOARDWAITBOX)) ( DECLARE%: DONTCOPY (CONSTANTS (\SYSBUFSIZE 200)) (MACROS \GETREALSYSBUF))) (DECLARE%: DOCOPY DONTEVAL@LOAD (COMS (* ; "Here because it must be done in init before PROC loaded") (P (MOVD? (QUOTE NILL) (QUOTE CARET))))) (COMS (* ; "Key handler") (FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF \KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSECHORDING \DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR) (CONSTANTS (\SUN.TYPE3KEYBOARD 0) ( \SUN.TYPE4KEYBOARD 1) (\SUN.JLEKEYBOARD 2) (\TOSHIBA.JIS 7)) (INITVARS (\MOUSECHORDTICKS) ( \MOUSECHORDMILLISECONDS 50)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT))) (DECLARE%: DONTCOPY (MACROS .NOTELASTUSERACTION) (CONSTANTS ALLUP \CTRLMASK \METABIT) (CONSTANTS * DLMOUSEBITS) (CONSTANTS * DLMOUSESTATES) (CONSTANTS * TRANSITIONFLAGS) (MACROS \TRANSINDEX ARMEDCODE TRANSITIONALTGRCODE TRANSITIONSHIFTCODE TRANSITIONCODE TRANSITIONFLAGS TRANSITIONDEADLIST CHECKFORDEADKEY) (EXPORT ( RECORDS KEYACTION) (CONSTANTS \NKEYS)) (RECORDS RING) (COMS (* ; "can get rid of shiftstate after clients have been fixed") (RECORDS SHIFTSTATE) (GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP)) (CONSTANTS NRINGINDEXWORDS) (CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE))))) ( DECLARE%: EVAL@COMPILE (VARS \KEYNAMES)) (* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun." ) (VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DORADOKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS \MAIKOKEYACTIONS \MAIKOKEYACTIONST4 \MAIKO-JLE-KEYACTIONS \TOSHIBA-KEYACTIONS) ( VARS (KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL)) (INITVARS (\KEYBOARD.META 256) ( \MODIFIED.KEYACTIONS)) (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE))) (GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)) (COMS (* ; "Key interpretation") (FNS KEYACTION KEYACTIONTABLE KEYBOARDTYPE RESETKEYACTION \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS \KEYACTION1 KEYDOWNP KEYNUMBERP \KEYNAMETONUMBER MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP) (* ; "To support office style 1108 & 1186 keyboards") (FNS SETUP.OFFICE.KEYBOARD) (OPTIMIZERS \KEYNAMETONUMBER) (MACROS \TEMPCOPYTIMER) (* ; "Don't copy this optimizer since it expands out to \getbasebit, but do exportit.") (DECLARE%: DONTCOPY (EXPORT (OPTIMIZERS KEYDOWNP))) (EXPORT (MACROS XKEYDOWNP KEYDOWNP1 \NEWKEYDOWNP))) (COMS (* ; "A raw keyboard device/stream") (FNS \INIT.KEYBOARD.STREAM) (DECLARE%: DONTEVAL@LOAD DOCOPY (P ( \INIT.KEYBOARD.STREAM))) (EXPORT (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM))) (COMS (* ; "Hook for a periodic interrupt") (FNS \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \PERIODIC.INTERRUPTFRAME) (INITVARS (\KEYBUFFERING) (\PERIODIC.INTERRUPT) (\TIMER.INTERRUPT.PENDING) ( \PERIODIC.INTERRUPT.FREQUENCY 77))) (LOCALVARS . T) (COMS (* ; "cursor and mouse related functions.") (FNS \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN) (FNS CURSOR.INIT \CURSORDESTINATION \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN CURSORPROP GETCURSORPROP PUTCURSORPROP \CURSORBITSPERPIXEL \CURSORIMAGEPROPNAME \CURSORMASKPROPNAME) (FNS CURSORCREATE CURSOR \CURSOR-VALID-P \CURSORUP \CURSORPOSITION \CURSORDOWN ADJUSTCURSORPOSITION CURSORPOSITION CURSORSCREEN CURSOREXIT FLIPCURSOR FLIPCURSORBAR LASTMOUSEX LASTMOUSEY CREATEPOSITION POSITIONP CURSORHOTSPOT) ( PROPS (CURSORPROP ARGNAMES)) (INITVARS (\CURSORHOTSPOTX 0) (\CURSORHOTSPOTY 0) (\CURRENTCURSOR NIL) ( \SOFTCURSORWIDTH NIL) (\SOFTCURSORHEIGHT NIL) (\SOFTCURSORP NIL) (\SOFTCURSORUPP NIL) (\SOFTCURSORUPBM NIL) (\SOFTCURSORDOWNBM NIL) (\SOFTCURSORBBT1 NIL) (\SOFTCURSORBBT2 NIL) (\SOFTCURSORBBT3 NIL) ( \SOFTCURSORBBT4 NIL) (\SOFTCURSORBBT5 NIL) (\SOFTCURSORBBT6 NIL) (\CURSORSCREEN NIL) ( \CURSORDESTINATION NIL) (\CURSORDESTHEIGHT 808) (\CURSORDESTWIDTH 1024) (\CURSORDESTRASTERWIDTH 64) ( \CURSORDESTLINE 0) (\CURSORDESTLINEBASE NIL)) (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE) (FNS GETMOUSESTATE \EVENTKEYS) (EXPORT (CONSTANTS ( HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)))) (DECLARE%: DONTCOPY (EXPORT ( MACROS \SETMOUSEXY)) (MACROS \XMOUSECOORD \YMOUSECOORD)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD ( QUOTE CURSOR) (QUOTE SETCURSOR)) (MOVD (QUOTE \CURSORPOSITION) (QUOTE \SETCURSORPOSITION))) (VARS ( \SFPosition (CREATEPOSITION))))) (COMS (DECLARE%: DONTCOPY (RECORDS KEYBOARDEVENT) (CONSTANTS ( \KEYBOARDEVENT.FIRST NRINGINDEXWORDS) \KEYBOARDEVENT.SIZE (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383)))))) (COMS (FNS MACHINETYPE SETMAINTPANEL) (* ; "DLion beeper") (FNS BEEPON BEEPOFF)) (EXPORT (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY)) (FNS WITHOUT-INTERRUPTS) (COMS (* ; "Compile locked fns together for locality") (BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS \HARDCURSORUP \DOMOUSECHORDING \KEYBOARDOFF \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN))) (DECLARE%: DONTCOPY (ADDVARS (INEWCOMS (ALLOCAL (ADDVARS ( LOCKEDFNS FLIPCURSORBAR \SETIOPOINTERS \KEYHANDLER \KEYHANDLER1 \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \INCUSECOUNT LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE \PERIODIC.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \CAUSEINTERRUPT \DOMOUSECHORDING \KEYBOARDOFF \TRACKCURSOR \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN \SOFTCURSORPILOTBITBLT) (LOCKEDVARS \InterfacePage \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE \PENDINGINTERRUPT \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS \RCLKSECOND)))) (RDCOMS (FNS \SETIOPOINTERS)))) ( PROP FILETYPE LLKEY) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) ( NLAML WITHOUT-INTERRUPTS) (LAMA CURSORPROP METASHIFT MOUSECHORDWAIT))))) BKSYSCHARCODE :D8 (L (0 CHAR)) s@ µ[`P`È\jð³5`LÐÈ`È`LdlËð“¿lkØ[Í¿Kð˜`jÍ¿µH -@ ºIµ JhY¸°¥J&¹° (96 \PUTSYSBUF 85 \NCONC2 5 \PUTSYSBUF) (90 \LONGSYSBUF 72 \SYSBUFFER 48 \SYSBUFFER 41 \SYSBUFFER 32 \SYSBUFFER 20 \SYSBUFFER 12 \LONGSYSBUF) () \CLEARSYSBUF :D8 (L (0 ALLFLG)) L@­`d—`ðŸh¿`jÍ¿@²`‹dh&¿µóh`d˜h&hNIL (69 PROCESS 62 \RUNNING.PROCESS 47 PROCESS 39 \PROCESSES 27 \SYSBUFFER 21 \LONGSYSBUF 13 \TTY.PROCESS 6 \RUNNING.PROCESS) () \GETKEY :D8 NIL ˆ`µNµh`µ2lH ¿h¿Y²K`lÐH ö¿IH¿h¿°ÌÉ&²­`HÉ&YHI&¿¿°£(132 \WAIT.FOR.TTY 126 \TTYBACKGROUND 62 CLOCKDIFFERENCE 45 \GETSYSBUF 37 \CLOCK0 16 \GETSYSBUF 11 WAIT.FOR.TTY) (115 PROCESS 105 PROCESS 96 \RUNNING.PROCESS 87 PROCESS 79 \\KEYBOARDWAITBOX.GLOBALRESOURCE 71 \\KEYBOARDWAITBOX.GLOBALRESOURCE 53 \MISCSTATS 23 \\KEYBOARDWAITBOX.GLOBALRESOURCE 4 \RUNNING.PROCESS) () \NSYSBUFCHARS :D8 NIL 1` `È`ÈHjð‘j‹IdHñ‘HƒHlÈÙÙØ(9 LENGTH) (21 \SYSBUFFER 14 \SYSBUFFER 4 \LONGSYSBUF) () \SAVESYSBUF :D8 NIL ·`jC`²``ð²z`µIH ñ²PI ¸°GÉ&[²å`h&¿IK ÔYH ñ–I ¸Kd¼HJkÔZL ¿µïIJkؾ½NMó®HNµNkÙ¹¿¿Ijðhð´ -HkI  ¿NkÔ^°Ô(174 RPLCHARCODE 168 SUBSTRING 145 \GETSYSBUF 123 RPLCHARCODE 106 ALLOCSTRING 98 NCHARS 90 LENGTH 56 ALLOCSTRING 47 NCHARS 9 \NSYSBUFCHARS) (79 PROCESS 74 \RUNNING.PROCESS 64 PROCESS 38 \RUNNING.PROCESS 30 \TTY.PROCESS 25 \RUNNING.PROCESS 18 \RUNNING.PROCESS 4 \SAVEDSYSBUFFER) () \SYSBUFP :D8 NIL >`ž`d`ð²¿`µ"`Èjðhðµ`´`É&NIL (57 PROCESS 52 \RUNNING.PROCESS 45 \RUNNING.PROCESS 32 \SYSBUFFER 25 \LONGSYSBUF 16 \TTY.PROCESS 10 \RUNNING.PROCESS 4 \RUNNING.PROCESS) () \GETSYSBUF :D8 NIL _`²``¿µD`ÈHjðhð´3`HÐÈ`È`HdlËð“¿lkØYÍ¿Ið˜`jÍ¿NIL (88 \SYSBUFFER 64 \SYSBUFFER 57 \SYSBUFFER 48 \SYSBUFFER 31 \SYSBUFFER 23 \LONGSYSBUF 17 \LONGSYSBUF 11 \LONGSYSBUF 4 \LONGSYSBUF) () \PUTSYSBUF :D8 (L (0 CHAR)) D`È`ÈHIð‘h`IÐ@ÍHjð˜`IÍ¿`IdlËð“¿lkØÍiNIL (50 \SYSBUFFER 41 \SYSBUFFER 27 \SYSBUFFER 11 \SYSBUFFER 4 \SYSBUFFER) () \PEEKSYSBUF :D8 (L (0 STREAM)) \²6`ž`d`ð²*¿`µ`ÈXjð³Ó`HÐÈ¿°¿`É&(89 SHOULDNT 66 BLOCK 7 \SYSBUFP) (80 PROCESS 75 \RUNNING.PROCESS 54 \SYSBUFFER 42 \SYSBUFFER 35 \LONGSYSBUF 26 \TTY.PROCESS 20 \RUNNING.PROCESS 14 \RUNNING.PROCESS) () (RPAQ? \LONGSYSBUF) (RPAQ? \\KEYBOARDWAITBOX.GLOBALRESOURCE) (MOVD? (QUOTE NILL) (QUOTE CARET)) \KEYBOARDINIT :D8 NIL  l lËkØkØâ jÍ¿`lÍlÈhdi `l8ÐnôlÔkØâ jÍ¿`lÍlkØâ HnÿÿÍ¿HnÿÿÍ¿HnÿÿÍ¿HnÿÿÍ¿HnÿÿÍ¿HnÿÿÍ¿HnÿÿÍ¿Hlj ¿HjÏ ¿H`Èl€åjð‘k€jÏ P¿HjÏ Ð¿HldØââ lwjö` (285 \KEYBOARDON 280 MOUSECHORDWAIT 249 \ALLOCBLOCK 197 \PUTBASEFIXP 136 \ALLOCBLOCK 108 \ALLOCLOCKED 76 ALLOCSTRING 48 \ALLOCBLOCK 31 \ALLOCLOCKED 19 KEYACTIONTABLE 4 KEYACTIONTABLE) (275 \MOUSECHORDMILLISECONDS 270 \MOUSETIMERTEMP 262 FIXP 254 \SHIFTSTATE 238 \LASTKEYSTATE 210 \EM.KBDAD3 122 \KEYBOARDEVENTQUEUE 113 \KEYBOARDEVENTQUEUE 94 \LASTUSERACTION 86 \MISCSTATS 81 \SAVEDSYSBUFFER 62 \SYSBUFFER 53 \SYSBUFFER 36 \INTERRUPTSTATE 24 \COMMANDKEYACTION 14 \CURRENTKEYACTION 9 \DEFAULTKEYACTION) () \KEYBOARDEVENTFN :D8 (L (2 EXTRA 1 EVENT 0 FDEV) F 1 \MAIKO.XBEFORE?) ™Agð³Agð³AgðªAdgð²<¿``È!lågð´o oôcgð³ Agð³Agð¬Agð´‚±``ð²%Qgð´o oô𒱃gð³2°&dHH` ¿HH` µÛ°:` -°&dHH` ¿HH` µÛ gð´V``È!låð³E` -°&dHH` ¿HH` µÛ h(404 MOUSECHORDWAIT 399 MOUSECHORDWAIT 389 KEYACTION 374 KEYACTION 353 \APPEND2 348 \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 312 MACHINETYPE 306 MOUSECHORDWAIT 301 MOUSECHORDWAIT 291 KEYACTION 276 KEYACTION 255 \APPEND2 250 \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 233 KEYACTION 218 KEYACTION 197 \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 184 MACHINETYPE 168 UNIX-GETPARM 150 MACHINETYPE 84 UNIX-GETPARM 66 MACHINETYPE) (384 \DEFAULTKEYACTION 369 \COMMANDKEYACTION 343 \ORIGKEYACTIONS 330 \InterfacePage 325 \MAIKO.BEFOREKEYTYPE 317 MAIKO 286 \DEFAULTKEYACTION 271 \COMMANDKEYACTION 245 \ORIGKEYACTIONS 228 \DEFAULTKEYACTION 213 \COMMANDKEYACTION 189 MAIKO 155 MAIKO 141 \KEYBOARD.BEFORETYPE 136 \MACHINETYPE 124 AFTERSAVEVM 116 AFTERSYSOUT 107 AFTERMAKESYS 98 AFTERLOGOUT 71 MAIKO 61 \MAIKO.BEFOREKEYTYPE 51 \InterfacePage 46 \KEYBOARD.BEFORETYPE 41 \MACHINETYPE 32 BEFORESAVEVM 23 BEFORESYSOUT 14 BEFOREMAKESYS 5 BEFORELOGOUT) ( 173 "X" 163 "DISPLAY" 89 "X" 79 "DISPLAY") \ALLOCLOCKED :D8 (L (0 NCELLS)) (@h@dl€ñ’¿l€ HdÓlÿå@àØlÿØã -H(36 \LOCKCELL 15 \ALLOCBLOCK) NIL () \SETIOPOINTERS :D8 NIL ig`È -dlð§dl𢱿go -¿go -¿go -¿go -¿goþ -¿goþ -¿goþ -¿goþ -¿goþ -¿g`lBÐ -¿`nÿÿÍ¿g`lCÐ -¿`nÿÿÍ¿go -¿go -¿go -¿g`Èàààà -±$dlð§dlð¢±$¿g`l;Ð -¿g`l<Ð -¿g`lîÐ -¿g`lïÐ -¿g`l=Ð -¿g`l>Ð -¿g`l?Ð -¿g`l@Ð -¿g`lAÐ -¿g`lBÐ -¿g`lCÐ -¿g`lëÐ -¿g`lðÐ -¿gh -¿g`lð“}C‚n -±ölð¢±êgHkÐ -¿gHlÐ -¿gHlÐ -¿gHlÐ -¿gHlÐ -¿gHlÐ -¿g -¿g -¿g -¿g`lëÐ -¿g`lîÐ -¿g`lïÐ -¿gH -¿g -…¿g`l<Ð -(870 SETTOPVAL 851 RAID 844 SETTOPVAL 839 \DoveDisplay.ScreenWidth 828 SETTOPVAL 816 SETTOPVAL 797 SETTOPVAL 778 SETTOPVAL 759 SETTOPVAL 754 \DoveDisplay.GetCursorBitmapBase 743 SETTOPVAL 738 \DoveMisc.GetMouseYBase 727 SETTOPVAL 722 \DoveMisc.GetMouseXBase 711 SETTOPVAL 696 SETTOPVAL 681 SETTOPVAL 666 SETTOPVAL 651 SETTOPVAL 636 SETTOPVAL 620 \DoveMisc.GetKBDBase 605 SETTOPVAL 578 SETTOPVAL 566 SETTOPVAL 547 SETTOPVAL 528 SETTOPVAL 509 SETTOPVAL 490 SETTOPVAL 471 SETTOPVAL 452 SETTOPVAL 433 SETTOPVAL 414 SETTOPVAL 395 SETTOPVAL 376 SETTOPVAL 357 SETTOPVAL 338 SETTOPVAL 303 SETTOPVAL 281 SETTOPVAL 265 SETTOPVAL 249 SETTOPVAL 222 SETTOPVAL 192 SETTOPVAL 173 SETTOPVAL 157 SETTOPVAL 141 SETTOPVAL 125 SETTOPVAL 109 SETTOPVAL 93 SETTOPVAL 77 SETTOPVAL 61 SETTOPVAL 45 SETTOPVAL 16 SETTOPVAL) (862 \InterfacePage 857 \EM.UTILIN 834 SCREENWIDTH 822 \EM.REALUTILIN 808 \IOPAGE 803 \EM.CURSORY 789 \IOPAGE 784 \EM.CURSORX 770 \IOPAGE 765 \EM.DISPINTERRUPT 749 \EM.CURSORBITMAP 733 \EM.MOUSEY 717 \EM.MOUSEX 702 \EM.KBDAD5 687 \EM.KBDAD4 672 \EM.KBDAD3 657 \EM.KBDAD2 642 \EM.KBDAD1 628 \EM.KBDAD0 589 \MACHINETYPE 584 SCREENWIDTH 572 \EM.DISPLAYHEAD 558 \IOPAGE 553 \EM.CURSORBITMAP 539 \IOPAGE 534 \EM.DISPINTERRUPT 520 \IOPAGE 515 \EM.KBDAD5 501 \IOPAGE 496 \EM.KBDAD4 482 \IOPAGE 477 \EM.KBDAD3 463 \IOPAGE 458 \EM.KBDAD2 444 \IOPAGE 439 \EM.KBDAD1 425 \IOPAGE 420 \EM.KBDAD0 406 \IOPAGE 401 \EM.REALUTILIN 387 \IOPAGE 382 \EM.CURSORY 368 \IOPAGE 363 \EM.CURSORX 349 \IOPAGE 344 \EM.MOUSEY 330 \IOPAGE 325 \EM.MOUSEX 292 \InterfacePage 287 SCREENWIDTH 271 \EM.DISPLAYHEAD 255 \EM.CURSORBITMAP 239 \EM.DISPINTERRUPT 228 \EM.KBDAD5 214 \InterfacePage 209 \EM.KBDAD5 198 \EM.KBDAD4 184 \InterfacePage 179 \EM.KBDAD4 163 \EM.KBDAD3 147 \EM.KBDAD2 131 \EM.KBDAD1 115 \EM.KBDAD0 99 \EM.REALUTILIN 83 \EM.CURSORY 67 \EM.CURSORX 51 \EM.MOUSEY 35 \EM.MOUSEX 9 \InterfacePage 4 \MACHINETYPE) () \KEYBOARDOFF :D8 NIL `dÈnßÿåÍ`lð´h}RNIL (18 \MACHINETYPE 4 \EM.DISPINTERRUPT) () \KEYBOARDON :D8 (L (0 NOCHECK)) #`dÈn äÍ`lð´i}R(4 \SETIOPOINTERS) (23 \MACHINETYPE 9 \EM.DISPINTERRUPT) () \KEYHANDLER :D8 NIL (4 \KEYHANDLER1) NIL () \KEYHANDLER1 :D8 NIL ³nÿÿdddddddl -l`@Í)¿`AÍ*¿n€`Èñ²ã`@Í)¿`AÍ*¿`n€Í¿`@Í¿`AÍ¿`—@A -¿`lð—@A -¿`@Í`AÍA(359 \DoveDisplay.SetCursorPosition 342 \SOFTCURSORPOSITION 231 \DoveMisc.SetMousePosition) (373 \EM.CURSORY 365 \EM.CURSORX 348 \MACHINETYPE 334 \SOFTCURSORUPP 325 \EM.MOUSEY 316 \EM.MOUSEX 305 \IOPAGE 296 \IOPAGE 287 \IOPAGE 277 \IOPAGE 265 \IOPAGE 256 \IOPAGE 218 \MACHINETYPE 208 \MACHINETYPE 197 \CURSORHOTSPOTY 192 \CURSORDESTHEIGHT 181 \CURSORHOTSPOTY 168 \MACHINETYPE 159 \MACHINETYPE 150 \CURSORHOTSPOTY 125 \CURSORHOTSPOTY 120 \CURSORDESTHEIGHT 105 \CURSORDESTHEIGHT 91 \CURSORHOTSPOTX 86 \CURSORDESTWIDTH 72 \CURSORHOTSPOTX 60 \MACHINETYPE 51 \CURSORHOTSPOTX 26 \CURSORHOTSPOTX 21 \CURSORDESTWIDTH 9 \MISCSTATS 4 \LASTUSERACTION) () (RPAQQ \SUN.TYPE3KEYBOARD 0) (RPAQQ \SUN.TYPE4KEYBOARD 1) (RPAQQ \SUN.JLEKEYBOARD 2) (RPAQQ \TOSHIBA.JIS 7) (CONSTANTS (\SUN.TYPE3KEYBOARD 0) (\SUN.TYPE4KEYBOARD 1) (\SUN.JLEKEYBOARD 2) (\TOSHIBA.JIS 7)) (RPAQ? \MOUSECHORDTICKS) (RPAQ? \MOUSECHORDMILLISECONDS 50) (\KEYBOARDINIT) (RPAQQ \KEYNAMES ((5 %% FIVE) (4 $ FOUR) (6 ~ SIX) (e E) (7 & SEVEN) (d D) (u U) (v V) (0 %) ZERO) (k K) (- %) (p P) (/ ?) (\ %| FONT LOOKS) (LF SAME) (BS <-) (3 %# THREE) (2 @ TWO) (w W) (q Q) (s S) (a A) (9 %( NINE) (i I) (x X) (o O) (l L) (%, <) (%' %") (%] }) (BLANK-MIDDLE OPEN DBK-HELP) (BLANK-TOP KEYBOARD DBK-META) (1 ! ONE) (ESC ESCAPE ->) (TAB =>) (f F) (CTRL PROP'S EDIT) (c C) (j J) (b B) (z Z) (LSHIFT) (%. >) (; %:) (CR <-%|) (_ ^) (DEL DELETE) (SKIP NEXT) (r R) (t T) (g G) (y Y) (h H) (8 * EIGHT) (n N) (m M) (LOCK) (SPACE) (%[ {) (= +) (RSHIFT) (BLANK-BOTTOM STOP) (MOVE) (UNDO) (UTIL0 SUN-KEYPAD=) (UTIL1 SUN-KEYPAD/) (UTIL2 SUPER/SUB) (UTIL3 CASE) (UTIL4 STRIKEOUT) (UTIL5 KEYPAD2) ( UTIL6 KEYPAD3 PGDN) (UTIL7 SUN-LF) (PAD1 LEFTKEY CAPSLOCK KEYPAD+) (PAD2 LEFTMIDDLEKEY NUMLOCK KEYPAD- ) (PAD3 MIDDLEKEY SCROLLLOCK KEYPAD*) (PAD4 RIGHTMIDDLEKEY BREAK KEYPAD/ SUN-PAUSE) (PAD5 RIGHTKEY DOIT PRTSC) (LEFT RED MOUSERED) (RIGHT BLUE MOUSEBLUE) (MIDDLE YELLOW MOUSEYELLOW) (MARGINS) (K41 KEYPAD7 HOME) (K42 KEYPAD8) (K43 KEYPAD9 PGUP) (K44 KEYPAD4) (K45 KEYPAD5) (K46 SUN-LEFT-SPACE) (K47 KEYPAD6) (K48 SUN-RIGHT-SPACE) (COPY) (FIND) (AGAIN) (HELP) (DEF'N EXPAND) (K4E KEYPAD1 END) ( ALWAYS-ON-1) (ALWAYS-ON-2) (CENTER) (K52 KEYPAD0 INS) (BOLD) (ITALICS) (UNDERLINE) (SUPERSCRIPT) ( SUBSCRIPT) (LARGER SMALLER) (K59 KEYPAD%| KEYPAD.) (K5A KEYPAD\ KEYPAD, SUN-F10) (K5B SUN-F11) (K5C SUN-F12) (DEFAULTS SUN-PROP) (K5E SUN-PRTSC) (K5F SUN-OPEN))) (RPAQQ \ORIGKEYACTIONS ((0 (53 "%%" NOLOCKSHIFT)) (1 (52 "$" NOLOCKSHIFT)) (2 (54 "~" NOLOCKSHIFT)) (3 ("e" "E" LOCKSHIFT)) (4 (55 "&" NOLOCKSHIFT)) (5 ("d" "D" LOCKSHIFT)) (6 ("u" "U" LOCKSHIFT)) (7 ("v" "V" LOCKSHIFT)) (8 (48 ")" NOLOCKSHIFT)) (9 ("k" "K" LOCKSHIFT)) (10 ("-" "-" NOLOCKSHIFT)) (11 ("p" "P" LOCKSHIFT)) (12 ("/" "?" NOLOCKSHIFT)) (13 ("\" "|" NOLOCKSHIFT)) (14 (10 96 NOLOCKSHIFT)) (15 (8 8 NOLOCKSHIFT)) (16 (51 "#" NOLOCKSHIFT)) (17 (50 "@" NOLOCKSHIFT)) (18 ("w" "W" LOCKSHIFT)) (19 ("q" "Q" LOCKSHIFT)) (20 ("s" "S" LOCKSHIFT)) (21 ("a" "A" LOCKSHIFT)) (22 (57 "(" NOLOCKSHIFT)) (23 ("i" "I" LOCKSHIFT)) (24 ("x" "X" LOCKSHIFT)) (25 ("o" "O" LOCKSHIFT)) (26 ("l" "L" LOCKSHIFT)) (27 ("," "<" NOLOCKSHIFT)) (28 ("'" "%"" NOLOCKSHIFT)) (29 ("]" "}" NOLOCKSHIFT)) (30 (194 194 NOLOCKSHIFT)) ( 31 (193 193 NOLOCKSHIFT)) (32 (49 "!" NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (34 (9 9 NOLOCKSHIFT)) ( 35 ("f" "F" LOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (37 ("c" "C" LOCKSHIFT)) (38 ("j" "J" LOCKSHIFT)) (39 ( "b" "B" LOCKSHIFT)) (40 ("z" "Z" LOCKSHIFT)) (41 1SHIFTDOWN . 1SHIFTUP) (42 ("." ">" NOLOCKSHIFT)) (43 (";" ":" NOLOCKSHIFT)) (44 (13 13 NOLOCKSHIFT)) (45 ("_" "^" NOLOCKSHIFT)) (46 (127 535 NOLOCKSHIFT)) (47 ("(" "[" NOLOCKSHIFT)) (48 ("r" "R" LOCKSHIFT)) (49 ("t" "T" LOCKSHIFT)) (50 ("g" "G" LOCKSHIFT)) (51 ("y" "Y" LOCKSHIFT)) (52 ("h" "H" LOCKSHIFT)) (53 (56 "*" NOLOCKSHIFT)) (54 ("n" "N" LOCKSHIFT)) (55 ("m" "M" LOCKSHIFT)) (56 LOCKDOWN . LOCKUP) (57 (32 32 NOLOCKSHIFT)) (58 ("[" "{" NOLOCKSHIFT)) ( 59 ("=" "+" NOLOCKSHIFT)) (60 2SHIFTDOWN . 2SHIFTUP) (61 (195 195 NOLOCKSHIFT)) (63 (")" "]" NOLOCKSHIFT)) (77 EVENT . EVENT) (78 EVENT . EVENT) (79 EVENT . EVENT) (102 LOCKDOWN) (103 LOCKUP))) (RPAQQ \DLIONKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (33 ("\" "|" NOLOCKSHIFT) ) (45 (96 "~" NOLOCKSHIFT)) (OPEN METADOWN . METAUP) (PROP'S CTRLDOWN . CTRLUP) (SAME METADOWN . METAUP) (FIND ("2,3" "2,43" NOLOCKSHIFT)) (UNDO ("2,4" "2,44" NOLOCKSHIFT)) (STOP (5 7 NOLOCKSHIFT)) ( MOVE) (COPY) (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) (CENTER ("2,101" "2,141" NOLOCKSHIFT)) (BOLD ("2,102" "2,142" NOLOCKSHIFT)) (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) (UNDERLINE ("2,106" "2,146" NOLOCKSHIFT )) (SUPERSCRIPT ("2,113" "2,153" NOLOCKSHIFT)) (SUBSCRIPT ("2,114" "2,154" NOLOCKSHIFT)) (LARGER ( "2,110" "2,150" NOLOCKSHIFT)) (DEFAULTS ("2,115" "2,155" NOLOCKSHIFT)) (93 (27 "2,64" NOLOCKSHIFT)) ( 47 ("2,22" "2,62" NOLOCKSHIFT)) (31 ("2,5" "2,45" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (80 ( "2,13" "2,53" NOLOCKSHIFT)) (FONT ("2,112" "2,152" NOLOCKSHIFT)))) (RPAQQ \DLIONOSDKEYACTIONS ((56 LOCKTOGGLE))) (RPAQQ \DORADOKEYACTIONS ((2 (54 "~" NOLOCKSHIFT)) (10 ("-" "-" NOLOCKSHIFT)) (13 ("\" "|" NOLOCKSHIFT )) (14 (10 96 NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (45 ("_" "^" NOLOCKSHIFT)))) (RPAQQ \DOVEKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) ( 56 CTRLDOWN . CTRLUP) (65 (27 27 NOLOCKSHIFT)) (71 (39 34 NOLOCKSHIFT)) (93 ("2,24" "2,64" NOLOCKSHIFT )) (108 (96 126 NOLOCKSHIFT)) (DBK-META METADOWN . METAUP) (DBK-HELP ("2,1" "2,41" NOLOCKSHIFT)) (SAME METADOWN . METAUP) (FIND ("2,3" "2,43" NOLOCKSHIFT)) (UNDO ("2,4" "2,44" NOLOCKSHIFT)) (STOP (5 7 NOLOCKSHIFT)) (EDIT ("2,5" "2,45" NOLOCKSHIFT)) (MOVE) (COPY) (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) ( CENTER ("2,101" "2,141" NOLOCKSHIFT)) (BOLD ("2,102" "2,142" NOLOCKSHIFT)) (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) (CASE ("2,104" "2,144" NOLOCKSHIFT)) (STRIKEOUT ("2,105" "2,145" NOLOCKSHIFT)) ( UNDERLINE ("2,106" "2,146" NOLOCKSHIFT)) (SUPER/SUB ("2,107" "2,147" NOLOCKSHIFT)) (LARGER ("2,110" "2,150" NOLOCKSHIFT)) (MARGINS ("2,111" "2,151" NOLOCKSHIFT)) (LOOKS ("2,112" "2,152" NOLOCKSHIFT)) ( CAPSLOCK LOCKTOGGLE) (NUMLOCK ("2,11" "-" NOLOCKSHIFT)) (SCROLLLOCK ("2,12" 180 NOLOCKSHIFT)) (BREAK ( 2 184 NOLOCKSHIFT)) (DOIT ("2,13" "2,53" NOLOCKSHIFT)) (KEYPAD7 ("2,14" 55 NOLOCKSHIFT)) (KEYPAD8 (173 56 NOLOCKSHIFT)) (KEYPAD9 ("2,15" 57 NOLOCKSHIFT)) (KEYPAD4 (172 52 NOLOCKSHIFT)) (KEYPAD5 ("2,16" 53 NOLOCKSHIFT)) (KEYPAD6 (174 54 NOLOCKSHIFT)) (KEYPAD1 ("2,17" 49 NOLOCKSHIFT)) (KEYPAD2 (175 50 NOLOCKSHIFT)) (KEYPAD3 ("2,20" 51 NOLOCKSHIFT)) (KEYPAD0 ("2,21" 48 NOLOCKSHIFT)) (KEYPAD%| ("|" 46 NOLOCKSHIFT)) (KEYPAD\ ("\" 44 NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)))) (RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP) (36 CTRLDOWN . CTRLUP) (CAPSLOCK ("2,5" "2,45" NOLOCKSHIFT)))) (RPAQQ \MAIKOKEYACTIONS ((61 (5 7 NOLOCKSHIFT)) (91 (520 552 NOLOCKSHIFT)) (92 (513 545 NOLOCKSHIFT)) (30 (513 545 NOLOCKSHIFT)) (63 (516 548 NOLOCKSHIFT)) (93 (532 564 NOLOCKSHIFT)) (62) (111 (329 263 NOLOCKSHIFT)) (89) (90 (515 547 NOLOCKSHIFT)) (73 (521 521 NOLOCKSHIFT)) (74 (522 522 NOLOCKSHIFT)) ( 75 (2 2 NOLOCKSHIFT)) (81 (524 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT)) (83 (525 57 NOLOCKSHIFT)) ( 84 (172 52 NOLOCKSHIFT)) (85 (526 53 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (94 (527 49 NOLOCKSHIFT)) (69 (175 50 NOLOCKSHIFT)) (70 (528 51 NOLOCKSHIFT)) (98 (529 48 NOLOCKSHIFT)) (76 (523 555 NOLOCKSHIFT)) (72 LOCKTOGGLE) (97 (577 609 NOLOCKSHIFT)) (99 (578 610 NOLOCKSHIFT)) (100 (579 611 NOLOCKSHIFT)) (67 (580 612 NOLOCKSHIFT)) (68 (581 613 NOLOCKSHIFT)) (101 (582 614 NOLOCKSHIFT)) (66 ( 583 615 NOLOCKSHIFT)) (104 (584 616 NOLOCKSHIFT)) (80 (585 617 NOLOCKSHIFT)) (13 (23 21 NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (65 (27 27 NOLOCKSHIFT)) (2 (54 94 NOLOCKSHIFT)) (10 (45 95 NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (56 LOCKTOGGLE . IGNORE) (45 (96 126 NOLOCKSHIFT)) (31 METADOWN . METAUP) (14 METADOWN . METAUP) (71 (10 10 NOLOCKSHIFT)) (47 (530 562 NOLOCKSHIFT)) (105 (92 124 NOLOCKSHIFT)))) (RPAQQ \MAIKOKEYACTIONST4 ((61 ("^E" "^G" NOLOCKSHIFT)) (91 ("2,10" "2,50" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (30 ("2,1" "2,41" NOLOCKSHIFT)) (109 ("2,25" "2,65" NOLOCKSHIFT)) (63 ("2,4" "2,44" NOLOCKSHIFT)) (14 METADOWN . METAUP) (93 ("2,24" "2,64" NOLOCKSHIFT)) (62) (111 ("1,111" "1,79" NOLOCKSHIFT)) (89) (90 ("2,3" "2,43" NOLOCKSHIFT)) (73 ("2,11" "2,11" NOLOCKSHIFT)) (74 ("2,12" "2,12" NOLOCKSHIFT)) (75 ("^B" "^B" NOLOCKSHIFT)) (81 ("2,14" 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT )) (83 ("2,15" 57 NOLOCKSHIFT)) (84 (172 52 NOLOCKSHIFT)) (85 ("2,16" 53 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (94 ("2,17" 49 NOLOCKSHIFT)) (69 (175 50 NOLOCKSHIFT)) (70 ("2,20" 51 NOLOCKSHIFT)) (98 ("2,21" 48 NOLOCKSHIFT)) (76 ("2,13" "2,13" NOLOCKSHIFT)) (110 ("2,53" "2,53" NOLOCKSHIFT)) (72 LOCKTOGGLE) (97 ("2,101" "2,141" NOLOCKSHIFT)) (99 ("2,102" "2,142" NOLOCKSHIFT)) (100 ("2,103" "2,143" NOLOCKSHIFT)) (67 ("2,104" "2,144" NOLOCKSHIFT)) (68 ("2,105" "2,145" NOLOCKSHIFT)) (101 ( "2,106" "2,146" NOLOCKSHIFT)) (66 ("2,107" "2,147" NOLOCKSHIFT)) (104 ("2,110" "2,150" NOLOCKSHIFT)) ( 80 ("2,111" "2,151" NOLOCKSHIFT)) (106 ("2,113" "2,153" NOLOCKSHIFT)) (107 ("2,114" "2,154" NOLOCKSHIFT)) (108 ("2,115" "2,155" NOLOCKSHIFT)) (13 ("^W" "^U" NOLOCKSHIFT)) (33 ("ESC" "ESC" NOLOCKSHIFT)) (64 IGNORE . IGNORE) (65 (27 27 NOLOCKSHIFT)) (95 IGNORE . IGNORE) (96 IGNORE . IGNORE) (102 IGNORE . IGNORE) (2 ("6" "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (56 LOCKTOGGLE . IGNORE) (45 ("`" "~" NOLOCKSHIFT)) (31 METADOWN . METAUP) (71 (10 10 NOLOCKSHIFT)) (47 ( "2,22" "2,62" NOLOCKSHIFT)) (86 IGNORE . IGNORE) (88 IGNORE . IGNORE) (105 ("\" "|" NOLOCKSHIFT)))) (RPAQQ \MAIKO-JLE-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) (4 ("7" "'" NOLOCKSHIFT)) (8 ("0" "0" NOLOCKSHIFT)) (10 ("\" "_" NOLOCKSHIFT)) (13 ("^W" "^U" NOLOCKSHIFT)) (14 METADOWN . METAUP) (15 (8 8 NOLOCKSHIFT)) (17 ("2" "%"" NOLOCKSHIFT)) (22 ("9" ")" NOLOCKSHIFT)) (28 (":" "*" NOLOCKSHIFT)) (29 ( "[" "{" NOLOCKSHIFT)) (30 ("]" "}" NOLOCKSHIFT)) (31 METADOWN . METAUP) (33 ("ESC" "ESC" NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (43 (";" "+" NOLOCKSHIFT)) (45 ("^" "~" NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)) (53 ("8" "(" NOLOCKSHIFT)) (56 LOCKTOGGLE . IGNORE) (58 ("@" "`" NOLOCKSHIFT)) (59 ("-" "=" NOLOCKSHIFT)) (61 ("^E" "^G" NOLOCKSHIFT)) (62) (63 ("2,4" "2,44" NOLOCKSHIFT)) (64 ("2,14" 55 NOLOCKSHIFT)) (65 (27 27 NOLOCKSHIFT)) (66 ("2,107" "2,147" NOLOCKSHIFT)) (67 ("2,104" "2,144" NOLOCKSHIFT)) (69 ("2,13" "2,53" NOLOCKSHIFT)) (70 ("2,20" 51 NOLOCKSHIFT)) (71 (10 10 NOLOCKSHIFT)) ( 72 (766 766 NOLOCKSHIFT)) (73 ("2,11" "2,11" NOLOCKSHIFT)) (74 ("2,12" "2,12" NOLOCKSHIFT)) (75 ("^B" "^B" NOLOCKSHIFT)) (80 ("2,111" "2,151" NOLOCKSHIFT)) (81 ("2,14" 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT)) (83 ("2,15" 57 NOLOCKSHIFT)) (84 (172 52 NOLOCKSHIFT)) (85 ("2,16" 53 NOLOCKSHIFT)) (86 (765 765 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (88 (770 771 NOLOCKSHIFT)) (90 ("2,3" "2,43" NOLOCKSHIFT)) (91 ("2,10" "2,50" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (93 ("2,24" "2,64" NOLOCKSHIFT)) (96 IGNORE . IGNORE) (98 ("2,21" 48 NOLOCKSHIFT)) (99 ("2,102" "2,142" NOLOCKSHIFT)) ( 101 ("2,106" "2,146" NOLOCKSHIFT)) (102 IGNORE . IGNORE) (103 (767 768 NOLOCKSHIFT)) (104 ("2,110" "2,150" NOLOCKSHIFT)) (105 ("\" "|" NOLOCKSHIFT)) (106 ("2,113" "2,153" NOLOCKSHIFT)) (107 ("2,114" "2,154" NOLOCKSHIFT)) (108 ("2,115" "2,155" NOLOCKSHIFT)) (109 (769 769 NOLOCKSHIFT)) (110 ("2,53" "2,53" NOLOCKSHIFT)) (111 ("1,111" "1,79" NOLOCKSHIFT)))) (RPAQQ \TOSHIBA-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) (4 ("7" "'" NOLOCKSHIFT)) (17 ("2" "%"" NOLOCKSHIFT)) (53 ("8" "(" NOLOCKSHIFT)) (22 ("9" ")" NOLOCKSHIFT)) (8 ("0" "0" NOLOCKSHIFT)) (10 ("-" "=" NOLOCKSHIFT)) (59 ("^" "~" NOLOCKSHIFT)) (45 ("\" "|" NOLOCKSHIFT)) (58 ("@" "`" NOLOCKSHIFT)) ( 29 ("[" "{" NOLOCKSHIFT)) (105 ("]" "}" NOLOCKSHIFT)) (43 (";" "+" NOLOCKSHIFT)) (28 (":" "*" NOLOCKSHIFT)) (15 (23 95 NOLOCKSHIFT)) (13 (8 8 NOLOCKSHIFT)) (86 METADOWN . METAUP) (73 (530 562 NOLOCKSHIFT)) (88 ("2,24" "2,64" NOLOCKSHIFT)) (98 IGNORE . IGNORE) (75 ("2,11" "2,11" NOLOCKSHIFT)) ( 110 ("2,12" "2,12" NOLOCKSHIFT)) (74 ("^B" "^B" NOLOCKSHIFT)) (64 ("2,14" 55 NOLOCKSHIFT)) (65 (173 56 NOLOCKSHIFT)) (95 ("2,15" 57 NOLOCKSHIFT)) (81 (172 52 NOLOCKSHIFT)) (82 ("2,16" 53 NOLOCKSHIFT)) (83 (174 54 NOLOCKSHIFT)) (84 ("2,17" 49 NOLOCKSHIFT)) (85 (175 50 NOLOCKSHIFT)) (87 ("2,20" 51 NOLOCKSHIFT)) (94 ("2,21" 48 NOLOCKSHIFT)) (69 ("2,13" "2,53" NOLOCKSHIFT)) (70 LOCKTOGGLE))) (RPAQQ KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL) (RPAQ? \KEYBOARD.META 256) (RPAQ? \MODIFIED.KEYACTIONS) (ADDTOVAR GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE) KEYACTION :D8 (L (2 TABLE 1 ACTIONS 0 KEYNAME)) ƒ@d¤ Bµ`Id ²7¿lI ñ³*IdÉ•dɲ É ²IdÉ š¿IÉ ¦I ¿lpHØAd—µgI HAd—µgI (127 \KEYACTION1 109 \KEYACTION1 87 \ILLEGAL.ARG 80 \BLOCKDATAP 70 \BLOCKDATAP 59 \BLOCKDATAP 38 \#BLOCKDATACELLS 27 \BLOCKDATAP 9 \KEYNAMETONUMBER) (121 IGNORE 103 IGNORE 17 \CURRENTKEYACTION) () KEYACTIONTABLE :D8 (L (0 OLD) F 1 KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS) S@µ‚±šlk -HlpdØlØââ ¿HlpdÔkØâ ¿HlpdÔkØâ ¿HlÿkØlØâââââ ¿HlpdÔkØâ  -¿HlpdÔlpÔlpÔi - ¿Hb` Q - -±³d ²9¿l@ ñ³,@dÉ•dɲ"dÉ ²¿@dÉ š¿@É ¦@ ¿lk -H@É H@É H@É H@É H@É H@É -  -H@É  HdHH@ µî(331 KEYACTION 312 COPYALL 301 COPYALL 290 COPYALL 279 COPYALL 268 COPYALL 257 COPYALL 246 COPYALL 234 \ALLOCBLOCK 225 \ILLEGAL.ARG 218 \BLOCKDATAP 208 \BLOCKDATAP 196 \BLOCKDATAP 174 \#BLOCKDATACELLS 163 \BLOCKDATAP 154 \APPEND2 149 \APPEND2 143 \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 138 COPY 121 \ALLOCBLOCK 101 \ALLOCBLOCK 85 \ALLOCBLOCK 64 \ALLOCBLOCK 48 \ALLOCBLOCK 32 \ALLOCBLOCK 14 \ALLOCBLOCK) (133 \ORIGKEYACTIONS) () KEYBOARDTYPE :D8 NIL ~Hdgð²R¿o o -µNo µ8oo -´"ggð³Hdgð¨gð´H(89 STREQUAL 84 UNIX-GETPARM 67 MKATOM 62 U-CASE 57 UNIX-GETENV 43 SASSOC 33 L-CASE 28 UNIX-GETENV 4 MACHINETYPE) (119 DOVE 112 DANDELION 102 DORADO 96 FULL-IBMPC 14 MAIKO) ( 79 "ARCH" 74 "dos" 52 "LDEKBDTYPE" 38 (("type3" SUN3) ("type4" SUN4) ("type5" SUN5)) 23 "LDEKBDTYPE") RESETKEYACTION :D8 (L (2 RESETINTERRUPTS 1 FROM 0 TABLE)) á@d ²9¿l@ ñ³,@dÉ•dɲ"dÉ ²¿@dÉ š¿@É ¦@ ¿Aµ `b ²3lA ñ³(AdɕɲAÉ ²AÉ ˜AÉ ¦@ ¿@ÉAÉ@É àÄ@ÉAÉ@É àÄ@ÉAÉ@É àÄB²@ÉAÉ@É àÄ¿@AÉ @(219 COPY 207 \#BLOCKDATACELLS 188 \#BLOCKDATACELLS 172 \#BLOCKDATACELLS 156 \#BLOCKDATACELLS 141 \ILLEGAL.ARG 134 \BLOCKDATAP 125 \BLOCKDATAP 115 \BLOCKDATAP 94 \#BLOCKDATACELLS 84 \BLOCKDATAP 68 \ILLEGAL.ARG 61 \BLOCKDATAP 51 \BLOCKDATAP 39 \BLOCKDATAP 17 \#BLOCKDATACELLS 6 \BLOCKDATAP) (77 \DEFAULTKEYACTION) () \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS :D8 (F 1 \MAIKOKEYACTIONS F 2 \MAIKOKEYACTIONST4 F 3 \MAIKO-JLE-KEYACTIONS F 4 \TOSHIBA-KEYACTIONS) ³`dlð•`dlð•`dlð²o¿o oô´o`È!låjô—QH -`È!låkô—RH -`È!lålô‘S`È!lålô—RT -Qlð´ lñ¯`` -`(170 \APPEND2 151 \DoveMisc.ReadKeyboardType 138 \APPEND2 100 \APPEND2 79 \APPEND2 43 UNIX-GETPARM) (176 \DOVEKEYACTIONS 165 \DOVEOSDKEYACTIONS 160 \DOVEKEYACTIONS 122 \InterfacePage 106 \InterfacePage 85 \InterfacePage 64 \InterfacePage 25 \DLIONKEYACTIONS 14 \DORADOKEYACTIONS 4 \MACHINETYPE) ( 56 ((56 LOCKDOWN . LOCKUP) (72 LOCKDOWN . LOCKUP)) 48 "X" 38 "DISPLAY") \KEYACTION1 :D8 (L (2 TABLE 1 ACTION 0 TI)) )BÉ@Âdjð˜¿g±dlð¥dlð²n¿BÉ@ÐÈdnÿÿÙjð²¿gBÉ @àÐÉhBÉ@ÐÈdnÿÿÙjð²¿gBÉ @lpØlpØàÐÉhBÉ -@ÐÈBÉ@Âlð•g„gh±œdkð˜¿g±dlð˜¿g±dlð˜¿g±sdlð²%¿gBÉ @àÐÉBÉ @lpØlpØàÐÉh±Jdlð˜¿g±

¿dg8¿dg6¿dg4¿dg2¿dg*¿dg ¿dg¿dg¿dg¿dg ¿dg¿ -l djÏ0¿djÏ ¿dg¿d` -¿dnÿÿÍ5¿`HdIÍ4¿dh2¿d`.¿dg*¿dg(¿dg&¿dg$¿`HdIÍ¿dj¿dj¿djÏ 0¿djÏ ¿djÍ¿dlÏ¿dh¿djÏ¿dg -¿(439 \SETACCESS 263 \DEFINEDEVICE) (445 \KEYBOARD.STREAM 434 INPUT 373 FILELINELENGTH 365 \STREAM.NOT.OPEN 356 \STREAM.NOT.OPEN 347 \FILEOUTCHARFN 338 \EOSERROR 329 \NOIMAGEOPS 308 \STREAM.DEFAULT.MAXBUFFERS 293 \KEYBOARD.DEVICE 284 {KEYBOARD} 258 \KEYBOARD.DEVICE 250 NILL 241 NILL 232 \GENERIC.RENAMEFILE 223 NILL 214 NILL 205 NILL 196 NILL 187 \GENERIC.READCHAR 178 \GENERIC.WRITECHAR 169 \GENERIC.PEEKCHAR 160 \GENERIC.UNREADCHAR 151 \GENERIC.BINS 142 \GENERIC.BOUTS 133 NILL 124 \GENERIC.CHARSET 115 \ILLEGAL.DEVICEOP 106 \IS.NOT.RANDACCESSP 97 \IS.NOT.RANDACCESSP 88 \GENERIC.READCCODE 79 \INIT.KEYBOARD.STREAMA0008 70 NILL 61 \SYSBUFP 52 \PEEKSYSBUF 43 \GETKEY 34 \KEYBOARDEVENTFN 25 NILL 16 KEYBOARD 9 |FDEVTYPE#| 4 KEYBOARD) () (\INIT.KEYBOARD.STREAM) \DOBUFFEREDTRANSITIONS :D8 (P 4 \INTERRUPTABLE P 0 PENDINGINTERRUPT I 0 \INTERRUPTABLE) _g@`ÈZjð²"`j`Ê 0jð’±p`jÂkä±n`JÐ[dÈ`Èð³ ¿j`ÈKÈ ¿`KÈÍ¿KÈ`Èð³l`ÈKÈ ¿`KÈÍ¿KdÈ`Èð³!¿l `ÈKÈ ¿`KÈÍ¿KÈ`Èð³l0`ÈKÈ ¿`KÈÍ¿KdÈ`Èð³!¿lP`ÈKÈ ¿`KÈÍ¿KÈ`Èð³l``ÈKÈ ¿`KÈÍ¿KÈ`Èð³l@`ÈKÈ ¿`KÈÍ¿`nôJñ¢lƒlJØYÍ¿I`Èð¢±þ‚`jÍ¿±þv`jÂlþåÇ¿`j`Ê @jðª`jÂlä‰`jÂlýåÇ¿`j`Ê Pjðª`jÂlä‰`jÂlûåÇ¿`k`Ê `jð¡d€jÇ¿`l`Ê pjð¡k€jÇ¿`l`Ê €jð«`lÂläŠ`lÂl÷åÇ¿`l`Ê jðª`lÂkäŠ`lÂlþåÇ¿`l`Ê  jð«`lÂläŠ`lÂlýåÇ¿`l`Ê °jð«`lÂläŠ`lÂlûåÇ¿`l`Ê Àjð«`lÂläŠ`lÂlïåÇ¿`l`Ê Ðjð«`lÂl äŠ`lÂlßåÇH¬`¦hg/ɬihhdi(860 INTERRUPTED 350 \DOTRANSITIONS 308 \DOTRANSITIONS 266 \DOTRANSITIONS 222 \DOTRANSITIONS 180 \DOTRANSITIONS 136 \DOTRANSITIONS 94 \DOTRANSITIONS) (851 \KEYBUFFERING 845 \PENDINGINTERRUPT 838 \KEYBUFFERING 832 \PENDINGINTERRUPT 822 \INTERRUPTABLE 816 \KEYBUFFERING 809 \PENDINGINTERRUPT 795 \SHIFTSTATE 783 \SHIFTSTATE 772 \LASTKEYSTATE 765 \SHIFTSTATE 752 \SHIFTSTATE 740 \SHIFTSTATE 729 \LASTKEYSTATE 722 \SHIFTSTATE 709 \SHIFTSTATE 697 \SHIFTSTATE 686 \LASTKEYSTATE 679 \SHIFTSTATE 666 \SHIFTSTATE 654 \SHIFTSTATE 643 \LASTKEYSTATE 636 \SHIFTSTATE 623 \SHIFTSTATE 612 \SHIFTSTATE 601 \LASTKEYSTATE 594 \SHIFTSTATE 581 \SHIFTSTATE 569 \SHIFTSTATE 558 \LASTKEYSTATE 551 \SHIFTSTATE 535 \LASTKEYSTATE 528 \SHIFTSTATE 512 \LASTKEYSTATE 506 \SHIFTSTATE 494 \SHIFTSTATE 483 \SHIFTSTATE 472 \LASTKEYSTATE 466 \SHIFTSTATE 454 \SHIFTSTATE 443 \SHIFTSTATE 432 \LASTKEYSTATE 426 \SHIFTSTATE 414 \SHIFTSTATE 402 \KEYBOARDEVENTQUEUE 390 \KEYBOARDEVENTQUEUE 367 \KEYBOARDEVENTQUEUE 356 \LASTKEYSTATE 340 \LASTKEYSTATE 328 \LASTKEYSTATE 314 \LASTKEYSTATE 298 \LASTKEYSTATE 286 \LASTKEYSTATE 272 \LASTKEYSTATE 256 \LASTKEYSTATE 243 \LASTKEYSTATE 228 \LASTKEYSTATE 212 \LASTKEYSTATE 200 \LASTKEYSTATE 186 \LASTKEYSTATE 170 \LASTKEYSTATE 157 \LASTKEYSTATE 142 \LASTKEYSTATE 126 \LASTKEYSTATE 114 \LASTKEYSTATE 100 \LASTKEYSTATE 84 \LASTKEYSTATE 72 \LASTKEYSTATE 61 \KEYBOARDEVENTQUEUE 49 \SHIFTSTATE 35 \LASTKEYSTATE 29 \SHIFTSTATE 17 \KEYBOARDEVENTQUEUE 9 \KEYBUFFERING 4 INPROGRESS) () \TIMER.INTERRUPTFRAME :D8 NIL hNIL NIL () \PERIODIC.INTERRUPTFRAME :D8 NIL `H´jHNIL (4 \PERIODIC.INTERRUPT) () (RPAQ? \KEYBUFFERING) (RPAQ? \PERIODIC.INTERRUPT) (RPAQ? \TIMER.INTERRUPT.PENDING) (RPAQ? \PERIODIC.INTERRUPT.FREQUENCY 77) \HARDCURSORUP :D8 (L (1 INVERTFLG 0 NEWCURSOR)) ®h@dÉXdÈ`Èð³@`È -¿@ÉX€Hjd`jlHÈÙldA•g„gg -`dlð¿` ¿°lð´@É@É}@h(143 \DoveDisplay.SetCursorShape 122 BKBITBLT 64 \CURSORBITSPERPIXEL) (165 CURSOR 157 CURSOR 138 CursorBitMap 127 \MACHINETYPE 116 REPLACE 111 INPUT 105 INVERT 92 BITMAP 83 CursorBitMap 71 CURSOR 57 BITMAP 52 \CURSORDESTINATION 41 BITMAP 36 \CURSORDESTINATION 29 BITMAP 20 CURSOR 14 \CURRENTCURSOR 8 \SOFTCURSORP) () \HARDCURSORPOSITION :D8 (L (1 YPOS 0 XPOS)) ú`kÙAÙbj@ñ’j°`@ñ§`kÙ€@`ÙnÿÿåbjAñ’j°`Añ§`kÙ€A`Ùnÿÿåb`dlð²¿dnÿñ“jb¿@nÿñ“jb¿`dlð™¿@A -°Odlð—¿@A}A°Blð²>`@Í)¿`AÍ*¿n€`Èñ²ã`@Í)¿`AÍ*¿`n€Í¿`@Í¿`AÍ`@Í¿`AÍh(132 \DoveMisc.SetMousePosition) (243 \EM.CURSORY 234 \EM.CURSORX 226 \EM.MOUSEY 217 \EM.MOUSEX 206 \IOPAGE 197 \IOPAGE 188 \IOPAGE 178 \IOPAGE 166 \IOPAGE 157 \IOPAGE 119 \MACHINETYPE 87 \MACHINETYPE 75 \CURSORHOTSPOTY 66 \CURSORDESTHEIGHT 58 \CURSORDESTHEIGHT 39 \CURSORHOTSPOTX 30 \CURSORDESTWIDTH 22 \CURSORDESTWIDTH 4 \CURSORDESTHEIGHT) () \HARDCURSORDOWN :D8 NIL ` (9 \CLEARBM) (4 CursorBitMap) () CURSOR.INIT :D8 NIL ~p`hdj`É`È`È`ÈdààààX`dHnÿÿåÍ¿YdkÏ -¿IjÏ -@¿IjÏ -Q¿d `djÍ¿djÍ¿ZdkÏ -¿JjÏ -@¿JjÏ -Q¿d `djÍ¿djÍ¿[dkÏ -¿KkÏ -@¿KkÏ -Q¿d `djÍ¿djÍ¿\dkÏ -¿LjÏ -@¿LlÏ -Q¿d `dHnÿÿåÍ¿]dkÏ -¿MjÏ -@¿MjÏ -Q¿d `dHnÿÿåÍ¿^dkÏ -¿NjÏ -@¿NjÏ -Q¿d h(378 \LOCKCELL 333 \LOCKCELL 288 \LOCKCELL 241 \LOCKCELL 195 \LOCKCELL 149 \LOCKCELL) (372 \SOFTCURSORBBT6 338 |PILOTBBTTYPE#| 327 \SOFTCURSORBBT5 293 |PILOTBBTTYPE#| 282 \SOFTCURSORBBT4 246 |PILOTBBTTYPE#| 235 \SOFTCURSORBBT3 200 |PILOTBBTTYPE#| 189 \SOFTCURSORBBT2 154 |PILOTBBTTYPE#| 143 \SOFTCURSORBBT1 109 |PILOTBBTTYPE#| 98 \CURSORDESTRASTERWIDTH 91 BITMAP 86 ScreenBitMap 81 \CURSORDESTHEIGHT 74 BITMAP 69 ScreenBitMap 64 \CURSORDESTWIDTH 57 BITMAP 52 ScreenBitMap 47 \CURSORDESTLINEBASE 40 BITMAP 35 ScreenBitMap 30 \CURSORDESTLINE 24 \SOFTCURSORDOWNBM 18 \SOFTCURSORUPBM 12 \CURSORDESTINATION 7 ScreenBitMap) () \CURSORDESTINATION :D8 (L (0 DESTINATION) P 1 \INTERRUPTABLE) N@`ð’±@`ÉÈ@Èð³`@È -¿`dlð™¿jd -°Odlð—¿jd}A°Blð²>`jÍ)¿`jÍ*¿n€`Èñ²ã`jÍ)¿`jÍ*¿`n€Í¿`jÍ¿`jÍ¿`jÍ¿`jÍ¿j¿gÁ @Éο@È¿@È¿@Èàààà¸`HnÿÿåÍ¿`HnÿÿåÍ¿`HnÿÿåÍ¿@h(83 \DoveMisc.SetMousePosition 64 \CURSORBITSPERPIXEL) (330 \CURSORDESTINATION 316 PILOTBBT 311 \SOFTCURSORBBT6 298 PILOTBBT 293 \SOFTCURSORBBT5 280 PILOTBBT 275 \SOFTCURSORBBT1 265 \CURSORDESTRASTERWIDTH 258 BITMAP 251 \CURSORDESTHEIGHT 244 BITMAP 237 \CURSORDESTWIDTH 230 BITMAP 219 BITMAP 211 \CURSORDESTLINEBASE 205 \CURSORDESTLINE 195 \EM.CURSORY 186 \EM.CURSORX 177 \EM.MOUSEY 168 \EM.MOUSEX 157 \IOPAGE 148 \IOPAGE 139 \IOPAGE 129 \IOPAGE 117 \IOPAGE 108 \IOPAGE 70 \MACHINETYPE 57 BITMAP 51 \CURRENTCURSOR 41 BITMAP 33 BITMAP 26 CURSOR 21 \CURRENTCURSOR 8 \CURSORDESTINATION) () \SOFTCURSORUP :D8 (L (0 NEWCURSOR)) È ° -@ÉX@ÉYHÈZHÈ\HÈ]`ò4`ÈJð²$`ÈLð²`ÈMð’±ìJ¿L¿JLM ¿JLM ¿`É_k -¿`É_k -¿HÈàààà¾HÈHÈÚ»`NnÿÿåÍ¿`OÒÍ¿`OÓÍ¿`NnÿÿåÍ¿`OÒÍ¿`OÓÍ¿`NnÿÿåÍ¿`KÍ¿`LÍ ¿`OÒÍ¿`OÓÍ¿`NnÿÿåÍ¿`NnÿÿåÍ¿`KÍ¿`LÍ ¿`OÒÍ¿`OÓÍ¿`NnÿÿåÍ¿`NnÿÿåÍ¿`KÍ¿`LÍ ¿`NnÿÿåÍ¿`NnÿÿåÍ¿IÉ_¿`OÒÍ¿`OÓÍ¿HÉ_¿`OÒÍ¿`OÓÍ¿@dk -ih(708 \SOFTCURSORUPCURRENT 697 \TEMPLOCKPAGES 192 \TEMPLOCKPAGES 171 \TEMPLOCKPAGES 145 BITMAPCREATE 131 BITMAPCREATE) (703 \SOFTCURSORP 690 \CURRENTCURSOR 678 PILOTBBT 673 \SOFTCURSORBBT4 662 PILOTBBT 657 \SOFTCURSORBBT4 647 BITMAP 635 PILOTBBT 630 \SOFTCURSORBBT3 619 PILOTBBT 614 \SOFTCURSORBBT3 604 BITMAP 590 PILOTBBT 585 \SOFTCURSORBBT6 572 PILOTBBT 567 \SOFTCURSORBBT5 558 PILOTBBT 553 \SOFTCURSORBBT4 544 PILOTBBT 539 \SOFTCURSORBBT4 526 PILOTBBT 521 \SOFTCURSORBBT4 508 PILOTBBT 503 \SOFTCURSORBBT4 492 PILOTBBT 487 \SOFTCURSORBBT4 476 PILOTBBT 471 \SOFTCURSORBBT4 462 PILOTBBT 457 \SOFTCURSORBBT3 448 PILOTBBT 443 \SOFTCURSORBBT3 430 PILOTBBT 425 \SOFTCURSORBBT3 412 PILOTBBT 407 \SOFTCURSORBBT3 396 PILOTBBT 391 \SOFTCURSORBBT3 380 PILOTBBT 375 \SOFTCURSORBBT3 366 PILOTBBT 361 \SOFTCURSORBBT2 352 PILOTBBT 347 \SOFTCURSORBBT2 334 PILOTBBT 329 \SOFTCURSORBBT2 318 PILOTBBT 313 \SOFTCURSORBBT2 302 PILOTBBT 297 \SOFTCURSORBBT2 284 PILOTBBT 279 \SOFTCURSORBBT2 268 PILOTBBT 263 \SOFTCURSORBBT2 252 PILOTBBT 247 \SOFTCURSORBBT2 234 PILOTBBT 229 \SOFTCURSORBBT1 220 BITMAP 212 BITMAP 199 BITMAP 182 BITMAP 177 \SOFTCURSORDOWNBM 161 BITMAP 156 \SOFTCURSORUPBM 150 \SOFTCURSORDOWNBM 136 \SOFTCURSORUPBM 122 \SOFTCURSORHEIGHT 115 \SOFTCURSORWIDTH 101 BITMAP 96 \SOFTCURSORUPBM 85 BITMAP 80 \SOFTCURSORUPBM 69 BITMAP 64 \SOFTCURSORUPBM 57 BITMAP 52 \SOFTCURSORUPBM 44 BITMAP 35 BITMAP 26 BITMAP 17 CURSOR 8 CURSOR) () \SOFTCURSORUPCURRENT :D8 NIL $ð`ȸ`jÍ¿i¿`Èdnÿñ•nÿÿÙkÙ¹`Èdnÿñ•nÿÿÙkÙºj[¼`½`¾jIñ›jIÙ»MKÙ½j¹°IMØ`ñ—`IÙ½jMñ’±OjJñ›jJÙ¼NLÙ¾jº°JNØ`ñ—`JÙ¾jNñ’±&`Jñ¢±Aj`Ù_¿`dJ𢱿`ÉÈ_IÚ¹OKÚ»OMÚ½`_¿I_¿L`ÈÚ_¿`ÉOÐ_¿`ÉOÐ_¿K_¿`OÒÍ¿`OÓÍ¿`OÍ¿`OÒÍ¿`OÓÍ¿`OÍ¿`MÍ¿`NÍ ¿`OÒÍ¿`OÓÍ¿`OÍ¿`OÒÍ¿`OÓÍ¿`OÍ¿`MÍ¿`NÍ ¿`OÒÍ¿`OÓÍ¿`OÍ¿`OÒÍ¿`OÓÍ¿`OÍ¿`MÍ¿`NÍ ¿`jv¿`jv¿`jv¿`jv¿`j -¿`HÍhkÙ¿gÁ `OÐαýÎJ`ñ¢±ýÑ`dJð’±ýÄkØ¿gÁ ``Ðο°×(709 \SOFTCURSORPILOTBITBLT) (796 \CURSORDESTRASTERWIDTH 791 \CURSORDESTLINEBASE 784 \CURSORDESTLINEBASE 778 \CURSORDESTLINE 764 \CURSORDESTLINE 754 \CURSORDESTLINE 740 \CURSORDESTLINEBASE 733 \CURSORDESTLINEBASE 727 \CURSORDESTLINE 715 \EM.DISPINTERRUPT 703 \SOFTCURSORBBT5 695 \SOFTCURSORBBT4 687 \SOFTCURSORBBT3 679 \SOFTCURSORBBT2 671 \SOFTCURSORBBT1 662 PILOTBBT 657 \SOFTCURSORBBT6 648 PILOTBBT 643 \SOFTCURSORBBT6 633 PILOTBBT 628 \SOFTCURSORBBT6 617 PILOTBBT 612 \SOFTCURSORBBT6 601 PILOTBBT 596 \SOFTCURSORBBT6 586 PILOTBBT 581 \SOFTCURSORBBT6 570 PILOTBBT 565 \SOFTCURSORBBT6 554 PILOTBBT 549 \SOFTCURSORBBT6 540 PILOTBBT 535 \SOFTCURSORBBT5 526 PILOTBBT 521 \SOFTCURSORBBT5 511 PILOTBBT 506 \SOFTCURSORBBT5 495 PILOTBBT 490 \SOFTCURSORBBT5 479 PILOTBBT 474 \SOFTCURSORBBT5 464 PILOTBBT 459 \SOFTCURSORBBT5 448 PILOTBBT 443 \SOFTCURSORBBT5 432 PILOTBBT 427 \SOFTCURSORBBT5 418 PILOTBBT 413 \SOFTCURSORBBT1 404 PILOTBBT 399 \SOFTCURSORBBT1 389 PILOTBBT 384 \SOFTCURSORBBT1 373 PILOTBBT 368 \SOFTCURSORBBT1 357 PILOTBBT 352 \SOFTCURSORBBT1 342 PILOTBBT 337 \SOFTCURSORBBT1 326 PILOTBBT 321 \SOFTCURSORBBT1 310 PILOTBBT 305 \SOFTCURSORBBT1 288 BITMAP 283 \SOFTCURSORDOWNBM 270 BITMAP 265 \SOFTCURSORUPBM 254 BITMAP 249 \SOFTCURSORUPBM 236 \CURSORDESTLINEBASE 214 BITMAP 207 CURSOR 202 \CURRENTCURSOR 189 \CURSORDESTLINE 180 \CURSORDESTRASTERWIDTH 168 \CURSORDESTLINE 153 \CURSORDESTHEIGHT 146 \CURSORDESTHEIGHT 112 \CURSORDESTWIDTH 105 \CURSORDESTWIDTH 80 \SOFTCURSORHEIGHT 74 \SOFTCURSORWIDTH 51 \EM.MOUSEY 31 \EM.MOUSEX 25 \SOFTCURSORUPP 15 \EM.DISPINTERRUPT 7 \EM.DISPINTERRUPT) () \SOFTCURSORPOSITION :D8 (L (1 Y 0 X)) E`ÈX`jÍ`È@ðš`ÈAð³`›¿¿`HÍh(56 \SOFTCURSORUPCURRENT 50 \SOFTCURSORDOWN) (62 \EM.DISPINTERRUPT 44 \SOFTCURSORUPP 33 \EM.CURSORY 23 \EM.CURSORX 15 \EM.DISPINTERRUPT 7 \EM.DISPINTERRUPT) () \SOFTCURSORDOWN :D8 NIL /`ÈX`jÍh`j -`HÍh(35 \SOFTCURSORPILOTBITBLT) (40 \EM.DISPINTERRUPT 29 \SOFTCURSORBBT6 24 \SOFTCURSORUPP 15 \EM.DISPINTERRUPT 7 \EM.DISPINTERRUPT) () CURSORPROP :D8 (L (0 X)) 0eHdlñž¿kalala lð´ kala - (45 \ILLEGAL.ARG 39 GETCURSORPROP 23 PUTCURSORPROP) NIL () GETCURSORPROP :D8 (L (1 PROP 0 CURSOR)) @ÉA'NIL (5 CURSOR) () PUTCURSORPROP :D8 (L (2 VALUE 1 PROP 0 CURSOR) P 1 OLDVALUE) d0@ÉXd²EdA'¹B™HAB °DI´BHdAð²%¿@@É°%Að˜Jd¿°JZµíŽBœ@ABhI(28 LISTPUT) (89 CURSOR 53 CURSOR 47 CURSOR 8 CURSOR) () \CURSORBITSPERPIXEL :D8 (L (1 NEWBITSPERPIXEL 0 CURSOR)) §p@ÉÈXdAð’±@ÉY@ÉZ@H I @H J @A -]@A -°1kAçkÙ»j¼@g -LKA ½@g -LKA ¾@M@Nh(144 COLORIZEBITMAP 136 CURSORPROP 124 COLORIZEBITMAP 116 CURSORPROP 95 CURSORPROP 90 \CURSORMASKPROPNAME 81 CURSORPROP 76 \CURSORIMAGEPROPNAME 69 CURSORPROP 63 \CURSORMASKPROPNAME 56 CURSORPROP 50 \CURSORIMAGEPROPNAME) (160 CURSOR 151 CURSOR 131 MASK1 111 IMAGE1 40 CURSOR 31 CURSOR 15 BITMAP 8 CURSOR) () \CURSORIMAGEPROPNAME :D8 (L (0 BITSPERPIXEL)) '@dkð•gdlð•glð•g(36 SHOULDNT) (30 IMAGE8 20 IMAGE4 9 IMAGE1) () \CURSORMASKPROPNAME :D8 (L (0 BITSPERPIXEL)) '@dkð•gdlð•glð•g(36 SHOULDNT) (30 MASK8 20 MASK4 9 MASK1) () CURSORCREATE :D8 (L (4 DATA 3 HOTSPOTY 2 HOTSPOTX 1 MASK 0 IMAGE)) äA3 ¦A ›Bb¿Ab¿hb¿@d lñ³)¿@ lñ’@°Aµ° lñ©A lñ–A ¿B ™Bb¿Bb¿`d@¿Aµ@HdI¿@ kÙB3 µjHdIñ‘¿IjHñ¡H€jHdI¿@ kÙC3 µ -@ kÙHdIñ‘¿IjHñ¡H€jHdI¿dD¿(186 BITMAPHEIGHT 173 BITMAPHEIGHT 127 BITMAPWIDTH 85 POSITIONP 78 \ILLEGAL.ARG 68 BITMAPHEIGHT 58 BITMAPWIDTH 41 BITMAPHEIGHT 29 BITMAPWIDTH 9 POSITIONP) (101 |CURSORTYPE#|) () CURSOR :D8 (L (1 INVERTFLG 0 NEWCURSOR)) m`X@dið—¿`b` -²?¿@A -¿@É¿@ÉÈkÙ@ÉÙ¿‚@µH ¿°ø(104 \ILLEGAL.ARG 46 \CURSORUP 38 \CURSORDOWN 31 \CURSOR-VALID-P) (92 \CURSORHOTSPOTY 84 CURSOR 74 BITMAP 67 CURSOR 60 \CURSORHOTSPOTX 53 CURSOR 26 \SOFTCURSORP 19 DEFAULTCURSOR 7 \CURRENTCURSOR) () \CURSOR-VALID-P :D8 (L (1 SOFT? 0 CURSOR)) [@ ´SA‘i@É@É@ÉH lóhð´'H lóhð´jIóhð´lIó´ jJóhð´lJó(57 BITMAPHEIGHT 44 BITMAPWIDTH 5 CURSORP) (33 CURSOR 25 CURSOR 17 CURSOR) () \CURSORUP :D8 (L (1 INVERTFLG 0 NEWCURSOR) P 0 \INTERRUPTABLE) ¤@`È -@É@Éð²B@dÉÈlñ³.¿@dÉÈlñ³¿``ð—@A -…@ ¿`@ÉÙ@ÉÈkÙ@ÉÙ`Ù -(161 ADJUSTCURSORPOSITION 109 \SOFTCURSORUP 102 \HARDCURSORUP 20 \CURSORBITSPERPIXEL) (155 \CURSORHOTSPOTY 147 CURSOR 137 BITMAP 130 CURSOR 121 CURSOR 115 \CURSORHOTSPOTX 93 ScreenBitMap 88 \CURSORDESTINATION 75 BITMAP 68 CURSOR 53 BITMAP 46 CURSOR 34 CURSOR 26 CURSOR 13 BITMAP 8 \CURSORDESTINATION) () \CURSORPOSITION :D8 (L (1 YPOS 0 XPOS))  `kÙAÙb`@ñ§`kÙ€@`Ùnÿÿåb`Añ§`kÙ€A`Ùnÿÿåb`dlð²¿dnÿñ“jb¿@nÿñ“jb¿`dlð™¿@A -°Odlð—¿@A}A°Blð²>`@Í)¿`AÍ*¿n€`Èñ²ã`@Í)¿`AÍ*¿`n€Í¿`@Í¿`AÍ`—@A -¿`@Í¿`AÍ¿`lð´ -@A -h(264 \DoveDisplay.SetCursorPosition 228 \SOFTCURSORPOSITION 118 \DoveMisc.SetMousePosition) (252 \MACHINETYPE 243 \EM.CURSORY 234 \EM.CURSORX 220 \SOFTCURSORP 212 \EM.MOUSEY 203 \EM.MOUSEX 192 \IOPAGE 183 \IOPAGE 174 \IOPAGE 164 \IOPAGE 152 \IOPAGE 143 \IOPAGE 105 \MACHINETYPE 73 \MACHINETYPE 61 \CURSORHOTSPOTY 52 \CURSORDESTHEIGHT 44 \CURSORDESTHEIGHT 32 \CURSORHOTSPOTX 23 \CURSORDESTWIDTH 15 \CURSORDESTWIDTH 4 \CURSORDESTHEIGHT) () \CURSORDOWN :D8 (P 0 \INTERRUPTABLE) `•(19 \HARDCURSORDOWN 13 \SOFTCURSORDOWN) (7 \SOFTCURSORP) () ADJUSTCURSORPOSITION :D8 (L (1 DELTAY 0 DELTAX)) š@d ²I¿@``Èdnÿñ•nÿÿÙkÙØØ@`kÙ``Èdnÿñ•nÿÿÙkÙØÙØ -µj``Èdnÿñ•nÿÿÙkÙØØAµj`kÙ``Èdnÿñ•nÿÿÙkÙØÙØ -(151 \CURSORPOSITION 78 \CURSORPOSITION 6 POSITIONP) (129 \EM.CURSORY 124 \CURSORHOTSPOTY 117 \CURSORDESTHEIGHT 92 \EM.CURSORX 87 \CURSORHOTSPOTX 56 \EM.CURSORY 51 \CURSORHOTSPOTY 44 \CURSORDESTHEIGHT 21 \EM.CURSORX 16 \CURSORHOTSPOTX) () CURSORPOSITION :D8 (L (2 OLDPOSITION 1 DISPLAYSTREAM 0 NEWPOSITION)) áAgh É0XB´B3´ -Bd3¥¿hdb``Èdnÿñ•nÿÿÙkÙØH -B`kÙ``Èdnÿñ•nÿÿÙkÙØÙH -@d²*d3²$d3²HÉØ@HÉØ -°8²-@dò$¿@d²d3²d3@@ ‡@•@ B(221 \ILLEGAL.ARG 212 CURSORSCREEN 165 \CURSORPOSITION 121 \DSPUNTRANSFORMY 80 \DSPUNTRANSFORMX 14 \GETSTREAM) (178 SCREEN 157 \DISPLAYDATA 146 \DISPLAYDATA 99 \EM.CURSORY 94 \CURSORHOTSPOTY 87 \CURSORDESTHEIGHT 59 \EM.CURSORX 54 \CURSORHOTSPOTX 26 \DISPLAYDATA 19 STREAM 8 OUTPUT) () CURSORSCREEN :D8 (L (2 YCOORD 1 XCOORD 0 SCREEN) F 1 \CURSORSCREEN) :A£jb¿B£jb¿@ÉX@cH ` AB -h(54 \CURSORPOSITION 47 \CURSORUP 37 \CURSORDESTINATION 28 \CURSORDOWN) (42 \CURRENTCURSOR 20 SCREEN) () CURSOREXIT :D8 (F 6 \MAINSCREEN F 7 \COLORSCREEN) b``X`Y`ZHVð’W€V[Idjðœ¿dÉlÙHÉkÙð´%k¼JKÉkÙÚHÉkÙÛ]KLM h(94 CURSORSCREEN) (80 SCREEN 69 SCREEN 53 SCREEN 41 SCREEN 19 LASTMOUSEY 13 LASTMOUSEX 7 LASTSCREEN) () FLIPCURSOR :D8 NIL c`³X`¸ldjñ²HdÈnÿÿæÍ¿HkиkÙ°ê¿`dlð—¿°%lð´!`d²É`É}@h(58 \DoveDisplay.SetCursorShape) (90 CURSOR 85 \CURRENTCURSOR 78 CURSOR 70 \CURRENTCURSOR 47 \MACHINETYPE 14 \EM.CURSORBITMAP 7 \SOFTCURSORP) () FLIPCURSORBAR :D8 (L (0 N)) T`³L`@Ð`@ÐÈnÿÿæÍ`dlð•lð´ `d²É`É}@h(43 \DoveDisplay.SetCursorShape) (74 CURSOR 69 \CURRENTCURSOR 62 CURSOR 54 \CURRENTCURSOR 33 \MACHINETYPE 18 \EM.CURSORBITMAP 11 \EM.CURSORBITMAP 4 \SOFTCURSORP) () LASTMOUSEX :D8 (L (0 DS)) $`@gh É0 -(33 \DSPUNTRANSFORMX 16 \GETSTREAM) (28 \DISPLAYDATA 21 STREAM 10 OUTPUT 4 LASTMOUSEX) () LASTMOUSEY :D8 (L (0 DS)) $`@gh É0 -(33 \DSPUNTRANSFORMY 16 \GETSTREAM) (28 \DISPLAYDATA 21 STREAM 10 OUTPUT 4 LASTMOUSEY) () CREATEPOSITION :D8 (L (1 YCOORD 0 XCOORD)) @µjAµjNIL NIL () POSITIONP :D8 (L (0 X)) @´@3´ @3´@NIL NIL () CURSORHOTSPOT :D8 (L (0 NEWPOSITION)) $``@ Ÿ@¿@¿(16 POSITIONP) (32 \CURSORHOTSPOTY 24 \CURSORHOTSPOTX 9 \CURSORHOTSPOTY 4 \CURSORHOTSPOTX) () (PUTPROPS CURSORPROP ARGNAMES (NIL (CURSOR PROP {NEWVALUE}) . U)) (RPAQ? \CURSORHOTSPOTX 0) (RPAQ? \CURSORHOTSPOTY 0) (RPAQ? \CURRENTCURSOR NIL) (RPAQ? \SOFTCURSORWIDTH NIL) (RPAQ? \SOFTCURSORHEIGHT NIL) (RPAQ? \SOFTCURSORP NIL) (RPAQ? \SOFTCURSORUPP NIL) (RPAQ? \SOFTCURSORUPBM NIL) (RPAQ? \SOFTCURSORDOWNBM NIL) (RPAQ? \SOFTCURSORBBT1 NIL) (RPAQ? \SOFTCURSORBBT2 NIL) (RPAQ? \SOFTCURSORBBT3 NIL) (RPAQ? \SOFTCURSORBBT4 NIL) (RPAQ? \SOFTCURSORBBT5 NIL) (RPAQ? \SOFTCURSORBBT6 NIL) (RPAQ? \CURSORSCREEN NIL) (RPAQ? \CURSORDESTINATION NIL) (RPAQ? \CURSORDESTHEIGHT 808) (RPAQ? \CURSORDESTWIDTH 1024) (RPAQ? \CURSORDESTRASTERWIDTH 64) (RPAQ? \CURSORDESTLINE 0) (RPAQ? \CURSORDESTLINEBASE NIL) GETMOUSESTATE :D8 (F 0 \CURSORSCREEN) i``Èdnÿñ•nÿÿÙkÙØ`kÙ``Èdnÿñ•nÿÿÙkÙØÙ`ÈlålæPh(90 \EVENTKEYS) (101 LASTSCREEN 95 LASTKEYBOARD 85 LASTMOUSEBUTTONS 72 \LASTKEYSTATE 67 LASTMOUSEY 46 \EM.CURSORY 41 \CURSORHOTSPOTY 34 \CURSORDESTHEIGHT 29 LASTMOUSEX 9 \EM.CURSORX 4 \CURSORHOTSPOTX) () \EVENTKEYS :D8 NIL ®l€`lÂåjð‘j€kjð’l€€jl@`lÂåjð‘j€kjð’l@€jl`lÂåjð‘j€kjð’l €jl`lÂåjð‘j€kjð’l€jk`lÂåjð‘j€kjð’l€jl`lÂåjð‘j€kjð’l€jl`lÂåjð‘j€kjð‘k€jääääääNIL (149 \LASTKEYSTATE 125 \LASTKEYSTATE 101 \LASTKEYSTATE 78 \LASTKEYSTATE 54 \LASTKEYSTATE 30 \LASTKEYSTATE 6 \LASTKEYSTATE) () (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD) (MOVD (QUOTE CURSOR) (QUOTE SETCURSOR)) (MOVD (QUOTE \CURSORPOSITION) (QUOTE \SETCURSORPOSITION)) (RPAQ \SFPosition (CREATEPOSITION)) MACHINETYPE :D8 NIL 4`È dlð•gdlð•gdlð•glð´gNIL (49 MAIKO 38 DOVE 27 DANDELION 16 DORADO 4 \InterfacePage) () SETMAINTPANEL :D8 (L (0 N)) 3`dlðš¿`@Í@dlð™¿@xlð´ -@9NIL (46 SMALLP 32 SMALLP 15 \IOPAGE 4 \MACHINETYPE) () BEEPON :D8 (L (0 FREQ)) ]`dlð²:¿n€`Èñ²%`o@dlñ¢¿lÛÍ+¿`n€Í° °Êdlð—¿@ ‰lð´i@}Ph(78 \DoveMisc.BeepOn 64 BLOCK) (52 \IOPAGE 29 \IOPAGE 19 \IOPAGE 4 \MACHINETYPE) ( 34 1843200) BEEPOFF :D8 NIL D`dlð²"¿n€`Èñ›`n€Í°°âdl𖿉lð´hd}Ph(53 \DoveMisc.BeepOff 40 BLOCK) (28 \IOPAGE 19 \IOPAGE 4 \MACHINETYPE) () WITHOUT-INTERRUPTS :D8 (L (0 FORM)) @ XH(19 \KEYBOARDON 13 DISPLAYDOWN 7 \KEYBOARDOFF) NIL () (PUTPROPS LLKEY FILETYPE CL:COMPILE-FILE) (PUTPROPS LLKEY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1992 1999 1920 2000)) NIL \ No newline at end of file diff --git a/sources/LLKEY.LCOM.~4~ b/sources/LLKEY.LCOM.~4~ deleted file mode 100644 index b231786848a537c06c836064d5810dcac947a8ae..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 64460 zcmdVD3v`^vbtc$ofDg%P3Zy7XVr1!eTa-XqgwQVllw}zWpg}ayKtp&)fJ93I*^mjK zMQ}*Uw&KUo&SU4XGl}fjk{?MNCvlRQOag-BS-+8Sd`_s$aLk?f?2yi$9gkyq=FIFS z;IWUhXZP6J@4L6^|LcE%lGn*TcqH^+Rkz+%_ujhq)~$}g%20K@a$u-hs~o6~57oW9 zCdvb&(R zzi=SmmFx9#g@+3HhjN9i*O5KC^4y8V=0d|;Iqqe>%=-tYMnCxQ%&CQwryg0JKhc~& z{zz@*=zQ~$=N1~xg%=8)rAL~Jr%oJQIl1u2sg>tX9$h%~NUb(nnd^LeaX$(;c%XdZ zBx>pE@^ZZob>&b|);n@?!LKH>@V*l#PwjiiJHB%I*y8bbdyA-dObYi zXNGFkiGi8PsrqDpdD44mus73D^E$e`@%{U~)O0G9YIz2KQs-*&(|6hYTudE*?X~Y; zN=dNM+`jSg?SM+PH(NK(dm6cR`&LH1(k4Ou-ul75bo;UPR7bJk9UfeH&%z*&?~= zX<%(%eb>^pkJWdr-qvh=H-T>CpU*tQzZY7Um#;p(OCc|&>U%dnE%ErgbK~4z^Zm5{ zai`>6A2$gbYq!;RFK?_pSik+f^*w*PbZu>4GyU{#TijFi-2#u8`VK!!W!V3GsOo<{ zIO2caGwOfdq3h>jYU49wHu9rqQ$H}@$G7*ty0o#jUxJN`t>*XkORejdZeN$-wrzRh z>`(q$bLq;wnA*8(S3O(zHc;NLNlM+j{PaD|ZI|D>UcW~{Q?nRJKQMQxB?vrmDIEl! zM1?-s;Y(YBz`HJO4FXT^xYV{@&n|6z($t62in<1SwZ)>5T9@t2e#Tr&;IzY>g|~L_N8n1{tuF+ znZ5j8{qQdT?bCN@!|Hck`}h+6ti8=9$?uOewRzX&xx|-G27R zA4zqTda$Pk$}>|HAs~}86VqO)z+D-RE93x&J=0$=PY%|HhOqYlG*}<2BkRC$eR8lm ze#pxevHPYcL6gjG?nO9U5_VrV_W$9r>eRs0ba{Hp>+S}S6Xd?19H@<=-1_*S*In!m zB^LngCg;!&CwH#P4VHSD*+ChlUZhV{#@Sq_$KAjresE|KNZKovP;eZwgz7mCGebj_ zN%pyf_Msz_q@|?-+CEs<#L6H>VtlGPU9FE#d8ND=z#wA|Z3`F0#)o6N@{yQg51MKx zqVgCJ=c6-~nTl6r7n0)HU?9nv>1wSy?iCA)Ge`Re%Y!Aam@i4H1dCoVhw1<e?+oP2iv z=)%POyB83JE=8hxoTedDH|D{XQS$O!QZ`uh@+43;Sn%=%r_;!r*8!6;$a#6ri3JAh zVur*FXRb#Z3tp;bql!AhZj`A(Hp`rs<5ED85}XCa(h6-V7$hgP7o#_Ul~y0D4s`lU zv~y^(f_WbwnDf~4IDlEhXi7ZID`L_UmI}9hX!Ye$cd)fW8%>F*yVWgwku&sr&g(K? zvtTz`K9EYK(t?*1N!@d~nf^v!5OMX#*Uk<09sh@~U0XY_)CW>}b@{5KUb(i`sadve zytwpFl&oF_z^g}6tBQdo8SqC^XO8_*S%KS8Ac)4dHK-7%Vzew(6qm~3DhjrW-`9`r z8y{U-{W+(y|6by?9MqIH$hCFj+1H1&a$5?az6IZpAAa zo<+e}i7p;45K{&<%}h*q1%r#sJ}3}92D_xtg%Ydv2_AOx2a#mIxk2oAkMqqI*m$BQ z`%R|NZArc>5|KNIQnca2_35dJ`ZTueK@5z>4OXV6hbz@X!_%OF7?vm`@vvKdj>8^~ zzy^=zV&7wNKAc-8$061dV#HAPS&zs%fP1_;I6dt3_`NVaoAtU;iQ77oi%3a%za&2w zab&b`cGD;7nB7`=Y8uP|xB*f?MHq2pq=<^hLs;XR48!gBTA$v6 zLsh`(?d)rP29>8Srk(%?oRx3IDSv)L*AiH~mJ=HH_2uuKZ8x1la;!b+mC&(eK6d#<{nwH$8<- zk6uiNVAEikM-7vH5!mhSW|u;?A~pos3Vs@;Zqei|QtE^Wj9%Olg53gkd-UQ~P2I{; zpE2Kv4MA=NFFty)O;g(l*=N2H8-i>DpDsyY%ty$V|3Y)e$dx&aN>y{TY<%wQPd*~w zJZzo)iDK%duQz}4>Yr&=I~jdT8~;K9zuruL?;qRGA4lOP9Jsas?*FuK%aZfYZ+K>D z89r-`M;RK?WgXmTReP(InU&?2*_3O>;-}@*2_utxbn-=s}Z36(h>_GZG z@*zL#7MgZI{Z9Fyt1f7p1M2t72mKQlwA}&yn^;pXyP%!}`X68Yv*ACKK7L-$Jngb$ z9(*PBhkBASvHH`HGt=VEmbUFF`~xBD1cV)^3pB@C(I3#i+96hVq`vxvH2`U#;zC{yCTQVX+x1qFw}-3 zslE%53y)0Eo=l_1w}V(INrwwaM-$`8n}upFaIJ-7IAY-#wk8ylKNy9{$5vQAHct6i z?Q%E_mmI4-ADc0VwIl7x#cI#>#9&GolTckbGT`AD&Om%R&Qg!)TbF2R| zjy!1IAjC+6m4G+|lH6#D-;A6$SbuzcsCGyjF+MZaUzyzR4S_R^;@bUQ`bb+#{A64H zwdRSwD`%8<*_my9hE01VHT?C4uzf3yW_n}oE$da`1J`cBZyzL%_?eLO(~D1nH{>C5 z?G6LPM8JS&e4L3>jb(n{+i2c^gJyNTbFYj5DBiNLZ6+-OqznDQo*B7totWr8U< zH%cA}?AZ9sdbJ_#So_ZM>i^Pcwi(!G2)o6=O5i4wa)K!tlOlmTOv)Li+-_1Nu-BA- z1`M&5f3t!8Rl>F#SPASjuwZ%&>@EZQS;F38U?s5Iz<$<;z16_35_XS)MWA`x#;4gs za6N0^U0(f;uodg0FX_3#>M52$4P&t++p)+P z)&){|-Sef$9nrKYUp15ZBaUD5%ro+{?dw1jFD{)~#ztzMIkRLA7tJkhd>`VsD}0+9 z?*;Lpa<-pYT2}B@7rYJN%J_pwO6AoUijz3nJoL0;TRILz1(0|kd@!rn%l=AF- z!m~G2FPNIu4|7tK$cs2G-mS>dgcW!9*(_&bl)v&P zBRK_@sO;Bu>&UKIU)@WcVCMZ!LCW=bPY4cwHXn%FOzcvjugsf5O zQmYUORVF8@vy~bKD+ktD$HB{ip4(4w`Kt8nUpzfFe*%Sp7P*3!9GLmZ%0#U^07WK5 zz@U&b5Gi3Z=^%R$IiV`*G{NqL%IdK)Ru2^#7&7cyH-$yj@iK)j5a`=gX?|Gt=~J6S|0{6`wd8fe*!@-G^GGroi8tMoI9+0?V-!634=O| zNkgQS_c5!7*#UrmF*^Q(jn?#X0shVgjJs$>LFJ&U{(dT`ByNDk1PW{vTg^)yQkPX15;u z;AD$!1;*c9IhY^FMF(N);p6t`rk${o+hAJe5C?u{7C)Si{{wX^c3Qq#hCF+z?;0fD zN}>9${hl;y`Kn=HjJSQN9Ke(V7!|QAj21~gWbMxN24(FZ;{=OfA74gz_5ZA}T>9cl z&t>!T#B)87w$&2p9+-m+T*qC*v(OU(aa#E_lF16&AW})JjmTL9%J#b#lWD(+tnD`s zZ1$VS0{bmm7e|3faksk|dX%7IU;Dyp78RfZBdg{?H5Ms~UcvIdWS8V2fK#zCkM_|x z9~}m=>F6RP6CJGfo3P+?wF_HfXIV-%4THMmE;&al);&jkVoQc*_`B z?*DZ}sM~r?e@1F!B9=@F1$kddJ-uUDX-9(zErN4uJU$ZT@?fv$bgFNHZd_nRW z#MF2Ed&qa)@LyO3k#s8|NBh5rJl4t4{ufr3>g3qwK#X28%&DZ;F5Tdy{q*%~i~he- ze!Mj{rYgO~)EV0w3D$Q-25%P!Pp1l?#;!&|cSk^X6VxzAI`Jy-+@8WeVx=C+E!}00 zZAVTWhEmw~)0MG_T76)YO0X%_NkyW-8APEVgj5o*27fT|vpj)DV5{|Xfv^R&PM|i$ z0BOC2s4hn13(lO1;ByDFdN;FD+GlR<%D1hUN_KQ03f0# zp8-K_0O%^(!b)hY4_oR5J`5Gs4JOHHS&4F}5I_k>9j9-lQoL`aB2NCc^I{$oDxnDL zj&28l+Oa4ACN?M`Jl-;VMX-B5K#^EJQbG}m{s4dz9R+YFpctEg0#1xh8&m=q9@HXc zBB+9=jZhUR0fMgppex!)T8uc2EKn;MDWL%Qx?e(p#48E_>Jq3^*xuLzCBbRWA?6(K7FSX zTi+XDSoVe)minF0K}%beiY5|VCw(_m#zAl_#Hx&kSrrr&VwFI<&5=Z_+8wU>_6YsH zJoBClm%xB5UsWzv1S|jgCK=Rv`{jR^ zI{V{)HzFY{q#yr}@`dFCv(#@aUx{atbmUrJ{SRbmz~=`WQgNEdRLFS{3FxNdIbsqz z$;za$RS9fbm;~d+id89{62$W~6^@5(TnyIhp+qbSN0n1JPV1t@c~U%uIpKJ( zhv+VPF83m=6-a#v+*JrMD)$tl_~3C82upX2@aJBS^Xi7|%ArQxqWbfZHEIU{`sov! zZqZLh0DvR|0II)&8PyVi*L?tyMMnTAiw*!pts1VP1oc<|Ao}PC046Q~5Jgo40J9hX zP<0h*1Ngk_b7=s894;t9w6Ja!u$RTu`2a<7$&o6Gn6m(Y!l5VtmSg}x+ps8rJ6Ulq z4Q+trA}E0?FXBi~R7FztnLcL2Z*7X`opAON7rTND5UIRFrA z0(T@)1vH%j02Ou765Pou#8_&S0L$E<1S%mSCFCJ%vD98P=6(wdFO$cTvjE`*C)^0l zhHY|qxoL7(r0OH0JdP_i8(3sT6A%cg5XCuCi3xoKi-`S65a%Mq9EUkbVtwGzLI}!o zUNo5xAZ;wSZ4hhuF^pR@GR%CL?BTVnxs7ePZ?PGYfQ2T62A;_XGLAH(>{pU7lafq| zF)OZE`C@8TNDufh`MsFx+xV3EDsPorqxKbgse51|7PQ3>&>2{%iH|Lq;J>#j1Yd zW{5|FXD7sStmti-M$vN+!a2?fagzpx>dcFjR5Li^RIb&ah~r4rQXHv&CH-vZNnztR zb@~khh|c$|-5~(~w9z6g=(_5N}Vra1MPNwkR!q5V9 z`}p$JFRsJHXXDt$`5T9qs{-7vS;m*Y_0;OOup&X8Cnst?Iwi9(HPeqHmEOw>Ej(U8 z3IT)D1vaVULY{!blx|#S2q;d67#1QS5bS;n0`%xiD#n*Aut6MT8Y1g}nsl2?Q`l%S zrNJ(Spcpa=!#f<&I1(ew>Y%m-JI>6sECaP+kZFD-g?}uN%l6@oP=ga@ID}dbtx#o?Kkh8#R`o@X(t2JVFgsFr~NHu z)~}Msv?9O@gQl0nc(Snc0u+s&G)2LoME9wwSk^n#)Qkfan*NxJnM4p0A#|`0Ly){u z6hIQExPt-I=mx_?Bw<7QblD-0mXR35P-u7j&Jm|nH(oTfuX-8UVGM(E3RNo-sydy& z)Us&jJw&c~;nnE{k1>9KfySK>*QZU=S(~U-$O6%r%c|+SaFrBx6Jw<6hr!pifUgs5 zwAL-t5?-?Rnh zi(38!!Dd>puEaL~&GMDyE8h(w$PLPvG}|tqG0)H(Vw*bwCWG^gap~5KU-nqvTaH6_%IAO0V{Q1gt;2+#b6Qk%^N1x znRI!5c$fC1wQ=RUPDjA_$h5w9=|@51rJphqnB+VeSUZ3)3Cd$m0~-}G1z_aCCkO%1 zB_IY1*in>$4OM4xa^q3g1)!Qz!dx=Af&tx>OF+o{I^f*uE;N*TXpov7s-Kc#Bm&c( zr*bH0=vcJ|?KB!uxbvI$q_J|_*RfH~lgflF-a>bJ3u5QxkC1b7 zIY(yIj+_%uYkZa$TyB%gb^(JV(yb6J5)L}pDWYPu$N-lmVeS#O+~mEt+29|6da_7a9x|$&6uUJa&@%cIon?W zUt4)6uI+xZr6tu`em6E6?xNjgKW;T2|DxQ`q_u~2I|Xa-;#*+iB|%w;3U+?i3QLmp zDPKQ4n%2ud8|OS*_-*Fn56$oS){mTR+5HSN%Abw3eUDzZOvt5Ezu-We%S&MO-bM>I zY0Ge0$}t-+6ubp2*k7(bB9 z>;Z6A6Xi)&hPnWN52b^AI?3391xih$I}=+S`!%+)3lz!MC##42relD~2UkOW59ETh z?oi#J02e^WIBvxylXS`Ugd7efiwdN`NkLM>MjOC~JQftj&>dY7UA%DcR zmFlX8NX{7{Al;%@9)h-qO#5RPU>t!pJcolR4PkpUJXRj%QO(1lMAB>ZLrh1Pv`Xk1T6r$(VZa!P^N}BiyT~qO4ER8Z3u-m7)a)Q1*mtb2(L8hQqwCExg13ms8h_Dz z?bW{TTxq^`<*x)!4Fe-^oJo|KT?C8)9S&~3OjTeVJW&^-6CA@^7s*fw&Qe^Zrq#5g z{XLq@e(r3`?dy^Z+})yHgM#p_(u5$qClbCb9RA7ek+AVvWXu1_n4Tbzm7-!O+4xy@u)}QQSXdL^~Iyg@hCfZPE+lOIZ^*Do^ivCIu;!$49dqoIFS0t z@iz5nbvE@Q80mlRZ0f%Xt;8~x(ubGbQihx9aIiHTYzqgsgo9h%U_iumUS2P(^On%f z*PEnar{_T>xBQZPyKBNM03N@<#bPH;*C!q;*F4@Io-9`fyCM(2hGH=pEeVz;KwxKyO-i5D5m_|7#Kv@uvW%Z8QIH~hUDPhiPy_>DkvSD z#`MzY63IA0!B`%ClR%Aan%I>1X|rAr&zB}&4>iL`3*EQCc0g`Fhf(+T&|CzO!u6tt z@RfibYJia{j-_A)LW>U@g!wGhM>YuC57Sox&O@x`q{8BZY?=k`@=ENA%fXbue7ZwJ z3s}M%PGlJVLB;6R_EBtJk*;H7dLwqOW)Q@&nJK_Os=}Tk7^afZ{h8jC!2H|Ni_}us z*22jc>=OMX8YbE#*q72$(o|XGjRl*Ohw&=XZ&fE;rDC~d%y|K!Wu_{c3`zE3C&XM5gti2 z+}QzP5eTGS4r5&(7_JPAQo{Py6nH%$&_eck3(HG=&%K4UD7Uca3lxY7i@~tWD4qgq zr$ROeJqb;RHUf$^(PfI~#6Wo2523UQFC9HS_()@=04C}8l^1C>CJf5ZN}T)=|39Ii zv23)d#)i@c&6N=wG}eVSXzUnm(AXN9pf8RTu{mXuRdXYP*UnY)gRegS>ly#c++;@T z89(k<{jbmZU#tFC+8GaP$bnxcHYDCG@Pd>*)nTFwT=RqFISK}`|Kk%^;0}n0?+Os3 zgoM>%q2~+exJ&&y96?~7C_^NWf%BMvLP?+x zK}v9=6`eM&18n#5o{I8wo+j|JDWK@^nz;5CfbUxS8e3X^N49VO1?@C2O0^*|Yd!1D zEvgy6cJBUa)#-d{z52>l$@F>6u--f|e5KrYspY~pIZmpI zd>Aq5P|RMOy5u6Z-+T}$;sYlvEJ3YSIaIE7mM0H^Z}bj}T4b<1jl0<744oiXmlNc% z=&gQOL^xs(<3~-9P?%wvt{cxHu*+t(3m*GQjTBbsI1?OUJ8u{$-~XEN+gr}6t#Dt7vS=oF7Seo8>aTsNhZm1f>A{y z2&0oqN)rUJb8QqwIL z#v_RWaiLdYgCv1IpOq4={_B=uqf7gJt>}C!#krt;v=*)p9Nl-R&oKhI9;`nGL#*=0g?p& zcnY%S4NYQnx|A}J3jHU{9H@}Y3Or5xEa;?s;RYewM-<O0?nqhTLO z^c9vdZwb-_sCcl=u6pi!J4_|szCDg`8EVc8?KYVF27THYy@Wm+ysJRVL(}J+tA8p66^t>ko zy4iN^kEKQON7J>1G)4rI$lfb~Yo8SM4|O zn8jIC#}Z9JObQ>Ik5!zZq$?hYt4{^~selIHFEj?qGgMfDkP}%^NaIT469yvv3CD1; z4-!SX4FQxQOD7U>VN6S#$_`#TpuSFQ`a9)wW&%hM+c6%!pJwG$Ap(oKDn!2)eUe1Y zJi_cav0xP_aO?h?fdc!1aOjHeWz|faP2WO?biXSO=Z>%U1O32&tbwD(RX9nzMS=QX zxvB3vmtRR8+q<_P_{agcBLHZgxPt$Dup0>`m7#dobrTBNyZ3C%XW;S2wxQ)$xXk^~ zhpBh;L#GafBPh&-O6g8qM8)%A<`Y9o}imU_%_$3fa7AUoqA zyCNXB#6fmPKyHnL?1_Nf76-XA0`hYNaVPD~h}iijZz?xhTUyuNhrcbFy4GCZ*|nqG z+LCTroouu`-QM!lmX?=sz5I9T?JXBF__Hj4H}9yor=Q-jrR9@L^&L!1Gcj!w_u^)F zeeZ=E>bD=;`}Cb3so#DtE{5Zz^vCr(cOB*x`Pp+>R3a?Y?3R{~Ee&7$O@wXsS?G-a z7;Q_pwBqXwKWzI>YWvb`;4~Vzr{(Eg(u!SZ#U3_sk6%oE51u}f#NA9}6ZgDs6aN*O z_^y}H#JP`^(-+=SPPaa(?VMvfabh$`kmiq+D9l7?Ipxh_c&a&W-wXXfaXmWwK`33&IE%3wZ z$3A!VwHE}Ph@Du&70Bw(4N}YXe5VTxgjDZIf_Qzm=cwJfxAi^8*zi6P7)`kn$#qegyPvC4w*rfMQ8^@&;>A& zPUZp>xB)cZjB!HXMw}1~kq4pw0?EV)Cj>|<*8q?PNI|Fz75Le@09dX~ADW!5A3B6r z_HbrBs1ZWN;f^=2LAb3t$Wt3$K^Vg&w}OE`2t|h|q~*s+ zu3n6xAA?-IV3}+c?p=h;aQF=7PR{s6Gxm1nCT2iZdv%Jy2OO0I(h$>F5|# z<8jVpfbrnIITI#(4;U+-ap{3%mjQrL-I)jUr_~_Sa7fHKX*f@4kZIuN2c{=$ zlB>k|LICk4=#JEYmCAb~J1e1C&y|& z2>m%KKtE{asDPuHnU(@()t@fD-sQ{@_lKDlT8I17MeUgGhuXx=TAx=L+MNy zEdl+_fn{Q*h4Z-+BQ+|{}PE}*ZSZ^eO}_bK_md3eyR#nDWnTUJ_rWSi~7 z5}Zd5w_ez1gceV3oKqi-OFMUMts(x{t_$0>pY1JQ>Kobk{7CD^`$q13vD!YI{z7&6 zTVGuL)0VG|j&FQ^y!8{K<9B{^Z1r+2{gtuhZ+&(3>#!fjAu5E)u`onRgs#%Yz%*%! zXH@$wqX2YP9h&PzoR#)lAv6p;=HIgbXMQIaj-P%fl>iGbl#lXxp;MH=Jb^Q9x_tg^ zcp9Z|_2(KbPqrAExAzOx3)_Z|?S10I!}op>e8KleRL#-1+5!3M&K5b;uI_2He32I1 zD)(0tZUFzcV-&hx#YBc|im{$6w5{tP#l zE?L`iSkmi#+=r}s#~j3!QGtHv{2j~liyJRie`R_8!VY1YWS#Cw%lWy{sQ&O*am}a$ z#30mMkkYWwlDeG!T6ui*Kz|*0o35NfVfF-aHh=$j8mxe3`)Jl(z7mPqX<<8B`jqec zD6HuF3{zpe>WUleV;hFoUwgB(UR;>tuH3u{_3=Jgdn{*{L~GIK{wJHf_JAsWZ6SBM zg5yulR!V401Btz1Qjlnf;2Hm2?S9XSh+0YVg+2E z2}mrSlZz=p`J$Xf?|5I1VunzDav?Sy`ly7519}C)tMNrRE2IZRv0$IDro&0Gc8EDf z7zS;Txvx)>2vD-CD4#Be!^MF+Q;aV!Mukct5(!0sOQtc$nQv9?o7@Z+qPUmluRbwX&(-B8ckRrz;Lq`8-4OOI+ zDTU=n7)TX}10jl}C!7q@;fu+oN4U&`o8h)AoqD6MjE9eVePqv@5pa57oLID@i|MlI zi|R#dt($+m9RV#{>4G%YHm$KOVLp zyY0s@`!Q)hChW(!{TQ|%{r02Jemr77dhJKI{V3Xxy#2V}et7odF8cvT!_vpyd+o0PD}X|Fb& zR4nK@tg2x8xbZ3F~jn}JVFte;r;OYvkE=?&$ z#*Vv0vuY%P%X_d64ce+*z{QoK_kP=f58}m6Wj<7gZDDZA1Q%5U!p)fv-l#rQ8OQsW z1F-8O_r!(*2Nw(g7)Q+l>tFex##2A2=nwLi2iZ4V+(5-P_VLN;G#sm7zJ=dlG#)lhRn)lXg+-i?Fv`wlWs({k?J-+0 zgbb!qxO*%PAbstZ-0o6ze$e|sTPyDwQVICh4}hJtb1i60Z7yL%ee3*tUFgFKU6ZnF&2%!jw!3xx zT?#!W(EOWJwgrAlfyV`ye?!2$Us&LFAZsAki3(Jo`ysm5azfM!`e`{D&;=pdk=YO? zyg*%J$XQpnpcJeT>(I-r6P{wjka*1(_#+M}ws@g3`Ot575@gu-5!}~-X@lY^UZyzc z3Y7^t1>{l*klYg?NHr{qL(=mBGH+7_lD2p;TSUxzK5<8`edWhX?x$!c9jVjWFbEn zx2UstzDA;+K5SSCu;kXa3YHoYWgqrkYD6CPU9u1RE+szf8%ma9j|UI?`pyWFKNQoc zmgZmIWZc`Q;9b)+R`Hw-DU!1x#c)J$Uyxd*+ZM+~V_c{57DcGDa-ssB2z)he^a)_` z`=N7&RpUO7BKGj{+2rfKcCW)Uip0kE&L<8f`JS5(AS^=&0BC@|DXdR!aTX8)fFz6B z;GkyLl^)p(v%2%7)d7^*TzSYyEr7Ubl1n38c)FeP*aS8m!Ug{`RF=P&@^nrZ)S;gH zh#_Hks?m@|^VsKy;Tz7}j1c2XB-0`S$r7aJI8uDQWssv0l>H{FXurvp*>BoJ*l*`j z3>Ec`Qrdk_M!Q1WLv5n_mJBY$>dQ0`rkhlnapBW}4|GfV*3RCWf!hQGlDn%N-9vo>*qq%4{1h?8rNXzXP2!e?V z`@_~qOuWCn{a%6{uRI<~aR=}Bz{sV+$eHG*4DOw6l4@H{{dHvGUX?0eDXFK-3)|TC-?Sj!`}oXuAVN zX_N*-MNtS8w2!*DgrYFpB9IqAAP`$U4kEltKQ+qxIT*j zKA~Uh{gU*_{xk~fZ$W9#aGdXM^g;DozR=pIQV$3tc4?{0SNjXzh1MmFzxE>T{lKgY zn)%-vKC`sTK(__Z1AxBKX1#8vt&och?%s|&3>~C=x~{CFT1YFx5jX{Cgt_Sn2Z-i@ zE9f6d{Q?Os6pi7`KB?EdIHrWk29b1&hU+?8GB*s2k-@_2eCm(i8i2$MxSFj08&&PJV38syr-xc{Iv@4jKJpaVDD0uakn(vt3NoOSsGzrYqNdi2Uw!uwnB@> z=MK%`%Cv=JhajUlG8 za3bBtlXv}n_7O&fYa`C+1Om|kNoi~=W6iq_vQRf(GE4E7bX0Z8n&R8+0<^iE6)Cx| zN@KXQAw((01iOb#Ar;wwb8`QZe%t z@W+tk8@QyR-6d}kkh46(Z}+tbH!4G|Z}-XPW{>ts;{V@X>$B_6EIgPjX*cW#?T~LY zYm|r6JY^m{oenOZI?53Q6FMZl z{>y+^x=u}a8xSSf!yAqA!N%DjXun(wH)lDXvh6tynAZOmyJG{x_E;Foo$NPHneJf@ zWHc0}NH?_Z=R~p_taC$uf!&CbnP@KEog$@ZSOhk8k zcnil;(2px)sDFWAaKa6ch7?4NSupmDLR}#tBC+)TOd?(i5HfDPOqb_?e&s_Br=LPQ z()R91b-hpJNwO}(kNRA>(wCO#<*V|O1akF?B1te;o5EZHOQxxBpdbuJAj$9-H<=@y zB0map7nj4KkiZu^K+Zr>UTB^XN8v#*(Plw#)%qD{>2*4s4=jKy(ZE`ZFTccerEey z&$sut6xz?<*xyJO+JATbSYz*zwoRu@uT$LKF96q@H3ht*uhF`8e*@*O-NWM7?y~;J z+pva=EAp+nR91Ui*ADbGTK+VJe{1)EhNoNC-rPtt^B$c03+=z&(wD}6Y3ap(*Y|Oy z-Tg$598;GiBu3H^RPPgzFZo2#j*ni=8=RV$8Hc~f@hP~39GjEtu;DmhFsvDfQgo0p zJ5-|Caw(`XlOX3G+JS{4VEhnF_ngPeL6P+rEG^;`v;54pZUx0!i)I6Qic|z-VU|I! z2MwGGK&&*%G&fjAa|3lem5dcMs~>RmBfe&gqfB@3u#O%QH<`c9r*8Z4w{0D3%CJl6 zS;1C)M-A&KOGD0K<$l2dq+dbv{m~EP^5ok6-R1Hlq-fd@gXicx01*Kz&4aROcOZGI z%o;UY$B>6H!mXrn)BPcO{}tJW?QH7ERvbikKC?xdty;1<`F>*fv5k*DzT?bePgZe} zgB6{`L0p(bSg&x^Bx*g@jYys zMFocpKDjOPg>#(w!o1SP#0pAb>1ac67|ak6y}`v@e6os z9QW~W9i~%|*IxTR7?0uQ%U@W&y82(06`@+-CG#S{KEBxe78#Ys+8x?g#Sy08=D~3) zwG){Xd2bx;<5ggl&+z6^cqXx@Od5r@;WVxlm-2H%`Y6<}od5~wqS8QTpzOj2!4nS! z_oN`Dkshh&ERGs2lTV#s3?X1yxd?#^)kOk8M`kO+ct-akRKh`XWUBn2J_Er^O@9}y zqb&VrYTcZ)PNh5kZnfi=^9#%qYjTLm>+)JrXUl7@Rm4L?a3v1&6+YFY^l#cSn91vzrXCivT#hg4>E%Mmn4qGjfac-Hgy%r1sO7 zx)P140}Z3#fZks2tn$90n7~00=i9n*ADJ8B=s?xII4KhjGZvB-_|JvWk-I#(B?@ST z;uqf6`;22Cr0A9Ln zRWHM?{<)F^-CF;co)(2%d)>zJ5?cTM2qu?akDGVRrBfI^7-d~%}v=%Yal?%^`Q z>$u;0yO%8=J-Tq}ly`c?TQ*mfv$&BvguNbqvr3<@S1T#sBq|en4h2LvcxuKss1o9+ zFFyn?O1U;xsE)=^kMWh94w%l^N2V}P9T_LZ?|1U!J_H}E4Ajb#m3(+;7kEhK~fgHfCbDw4#Tw$(~T);$Y?mjEZA?8b(97qPiIj&B>SV)OXV3hgI4){ zwL07oy5l~)aB{&rvT$_%c{m(hJncRA{HfCjdySRj2p`9Ph&;0J>VF7eqxJtRF@ajI~tQ%)UC4HZ$Hy6-L2s6|W1Ufj*e{q930_yhOuO zfghP?q;XTwIZ_4L<6t^VF=)AZiDKD7T*#+XN!Cnwl?5weu&#>~Q|gaD>xnHVvzjw@ z_0cS{LZV4ydcBr{CI({wih-llVcN@6R|hHqn_6(kA)x!c!J0H12~%!L#`BYeg$X4h zEtr&{TKN!D?WWKaI8vGQ;JctQC{~yOxZFaMxJ(c!_VW?INKmSAs^wiNYW8t!5&jK< zR?X!pw4^dSQJTW-N(RB=#!U9;{BiHy3#Yx4 ziw$q(S?|=b#b-~SIz4}S!JB{f^ukH+Xmb%4e@X>!M_AtzwHa(X#b-`|cv=g)SEGps4Q|NlRLV$5&2!M^}!Yo(Ix%(lFeok1cq> zf6saQviS!}UHh^wzC3brVSX8O3oyit&!6y4oLmu72KhH*Pd$IUGn+w2wLOtbMKL!P zNw*#1el6t21iEG~f)Qy&uTW6PFj{wjq7l==v?aJlu{bB>8l@wnlo180g*g0#T+hoH z4U!}1%FinIQSzm3j0zDJuC+yOg&|?HX)O=JfQKa7S;U9wcTXRxfzfLS8v&m)0#)nc zXOrBV{xYMrtR?y2v8;8YzcFHsM9BfJ75p0zAfa84&QxH9B>2?&DwIP9MMeI!Af`Sx z20|6YU@{}G%WUrPGI~kP$KIVX#!d@E)PU=Sex>|MN#`OCRW@0PA@48oWv4j9pstLU zCB0wdIpxI31z;>_g)G_k>kcrZx=%rZtT0ke&r)mScq-#`P+e#xx;i72<`8#qIzFt2){+r1~TcFD{Wv3wkyU$z%stj^9Vbb>anJ zo5fS!%8Ap9&n^Buh{CDG<7gMSw}tne0K$%f+F6^(Q5PuSZYTn5D8d$IvSsh&{CoW|^BN29 z!KglX>NL>nb9Mj|uTaDqoXFK=lJmMPcd-JRsYuRTg9%oh5x9qzIcUo8%E~f{gg5V< zSU9=3(pWsI%l_o^CrDG|Wlpk3pFequ{XX9Co?GD| z;^aaToJqrb_W9#VU%99xPh(_|}aKDhmKvnW;w132~^>N+pyD8=9IXkXywZO;l$gYcX+Qi#!ua&evKOhI(Yo z)wCwexPJKdHzq6$v>Y#jmMf&RI#H`?8gGq1G^hf$jOnMSBplg%@Y#>sS0tK3-e!Z( zIWHoCwe6WOMH;y%mlgX9B5m41+g_Ln`<$4wfEB{zoRtHT>9>i4Mi>P$&e5@ux!~dr zW>9tE8t+6K)m1EhLiiK1pU%=rjO-uF#9=w|xNi|F7IyS7%$3GDB_lSU7%SJ&A{_y+ zT%cp8gT^6N?s&yw1oG1cPB^0Cw2qbRs$Y^LxNoOQJc% zN6zm1BL|#L5l03RBhAX`f^d+B_~cSMIFHKe3X`STq%8Q{k>2>-;mXBi4dW8E90x)Q z4nUC`2NPVQwHX8-;JqxfWz-KwR?h*lEUJrtpy4r8jtV3BoO5(Xv*-fibs{yvc&%r& z z)8$pkqQwQtcE5>iIzXLvd%Fb)C+E7E~Hb}w)K0d~7dR)c9-x*rXyy3%(vv~B1W_7y1#bmTg z886G^+VQkuS(I3ljqpX%?HY2;h ze@=(==KmGy7$$=b3AS|4(pB)=_7em&cn#bU2rF}hOAexICRz(4GEJBBs`zUWHbd0b z*gIh?>hgdgPSM9xJ1`3_ogKTsO~c3J_NU5r`j^Egi;TiV9=l zk5rldPFH4a6zqueg;kpQKK6AnhW|pfhoA z-#)CI$KV73kCxp7w_!7r`0VyR}RI_p+B6#m@n6-|hH0;n6kugC1Un?>Ox3`+&M7tJUkHRKeAT@Yn=i`vC_v zgUY|GpI17ER_c;Fk1MgA%J>@a$yqDpcJm~G~fVg0s;EP@r zf8Xb^)hiyeH9fA4eGhmK^XERO!1((v?}PYJZ+K(XK`7Zh@ntmFKYC!eQe%TP5$~*` zGe(%|F`3I6$vN*WUR~;}ObvMWzYJObfk%)69f0=^emv_9;jegFqcG{dDX%gpisPf+ z01}qG5&S*k_2ci)dr$0#j2cV>RGA3x>-1Q{+r51c;b&kHBeU-V_2cyti-hyt9+j{!cysuB%p1nvUMQS1mFl5kf*$uckI#8y_)7wd zpQ(v5{6eAfC%yOM=N;bL@ORQSDdakE3gd!AY(r+486V_O^I*~CWw4~Fcbg~=zQaVq zaMO=_(8R$8YX;2DgHVc^7~Fva4`c#(igJ3gI!gCZCZkQwNf-|zjm?F|Xi!Zw@PRlf81_?8 z#mPSB7oyFwox_ve^~W_uznKP6CG4~DH44)~u3vPc2RDahqm9DiTcap28^vuP4dEK= zA$dk%6jv-Xswe<<=t~lU9UX@lErsSvSIj7EiA^mOvW&vHgtYpAIlf5_jj>s%2m&Y^ zlCh8FLooWoui1Mz2;MjD;kXO6qLf!L?LlY2j4(s(@$%f%f%^CX8lD6pu8skS%PZUn zqcD@xe&CL@3`f7bb=6Uw#7}31D6@ps>Rcvq4j| zxZA|A0-!F_iv6(~ z4kE`gN*ax1fMs|`_5c#_f3)N1dGCUiafATqr(o~eMO!$|r-JPF-Lb@U7u zcqEq*M)!NYOvqoc#H0JT&Xj#?yeJF+957`2;wcz`?0ZrFT4xUcz0S zj_gsu4@BWP0!v63i6)@?nd}jy^hZ))ZQGIkc_cg$O@Ox!nJ788cbb5pe2|2WY$x(O z66Hn*d`O8%nsA?8rWiJWs{*U?K25#S+FSG;F{#pd%ezhuJ6N**Fj< zku(|Y71zOOBuqyVu%$Y(??%F*Py(vKHtfj0fRwpV3KBRB$B=;6$U@5+*p!d%Wbco) z3rMpgdmLHD!&zXY%`tcmDP!T3&0g=p9_+vp#DAe-LB;GkMkM?GSnU~HY3spMrh^!lTPqVugL^5Fb$gxqi-ikA^;p!wSQKyS zb38@5hpKUznL)J0p<+?{oepsSLX+Za$j9?oVv#oDYEdG}CNsxX351SA! z3=UmX*2+M3n|kr<)SDq`bT}^s&Y5CM@nU_p%s}b@!oy;ySe9y-Heg9~#0*X@VRU@X zi!%m)*V@h!ew}u*Ku`=)0YG)fYs(1k%0H0Dh!G+_aHKp)(ejH4#S{6U1(H8udf>ZG z`=W!BFgASA!3>MGB3FtwBf8(hZmIp3#q?p0(C&=d+xgow&NBMjGl30D-k!1ya04-! zrQ)7WB)^-I8Mm9*F5u9urK#WSpBk$qwjg7isT;gOJfRpCs3tK3o)_qVvpHPHNmyN& z{=6>e$O_Z(fo&e~R}Qz7Bblva!o^2EIn|^&vrJ0owBAFC_a0xj%37Atb zbBPc{ak%^mMl&&)EF%g4jVz&>L=dvi@bUt_Gcj3-Ob#=Tqf8M2N~%E9u01pahB-9I*QFRT%h3mQNa8~*BJbOVPKQf zI>?rnaCx>AA91oJC7c>cxF8xC%x+4S=%En@3%s3$Lc)E6q~ahM8>tsd0)rnZ0ser{ zlN=UoY%O3BB8h7`*2xUk7r6IWJp5N83l?v*?;Uvhjaw^WXTiG>@}P0Cwq>x_H`z_N zbB#PIhe3T;I|Vg=qrXH zIv?ffOFx7&J$OJRwwvJu1xdYl?JR~5@tPdd4k8UA(@2wX)f`94E~Lfg2YwKd zltWT%+<3_yX?di@ml-;g;p1xExKSOcjh+ROuZXl5(j-S)!c_6SwrDoYI)*5=>cm-I zGG_&EG|36vad5U7Yc|Du%7jHY zX|hWJTFmCa29dkTJXC0PrrtZbi>zkfLA) zvrj>gCx4=iFjJApmn7p&IW7=!vf4y$1JqiBWbllc-kkLx2)WJ_i@ zfI~AZG?~>P9%YR>GyI8+95`Ho;87WX2`6TtTd@}l;ais3#YKVNgoR7IDFH0gTFX%k`tjtA;K;HhX?vcyqMlIn_U;ULoD znoY2h9aOX=Xd1vvLjISm2M}Vri83si1BvdAQ1ij^ZgOOTwLnMq?Pyi9Y%em$wUC=~U7{C((v<5x)O@f?#LWkLBM!m`6r=e zL+X?wN4v5q3V8!qIEg02$~W|9bE2kLI+>(yy4^FNg?I_I+vER{A^T}q9MXsDa5$Mn z7U%Wp3XhH~TE{%nK8Fj6j@I7`7X;eIZzE4;MX?OK$_yuu(6X8+T5+yL<0i-y%ygm$Uq|-lE^I!LIt9mN6Np3;;6G|i8zAL6UC8x`z`=5v za41hNqw0E>YqBf>y@Cq_z0-eq+I2+2+nJNF#ps~TH~aMd z;hYubUgIo@EaWE_Gf71FoaUUv>=RYVs`Qh2=2%s~a59vAB95)fLP9j{papKS*IMCszW z08yV)0W6BfMHF5@iN0_ipdvsAeqemu6~7M|&NmXYc31!YqTqnsm1xd(8WVLy!IGfm{B}jwTBDsTd3v%-`s5CashqKqFX*j~V zX*vrqCaB=W@`M!Lc(mRuHc2*vO*bR{;ApYTtn-AEOff0db$J1oBMJF=2O+XJlDv;- z&PToA4sPJxBA#X%MS^b$?3C*RBgpH<`nixTi52kOS%f_6FxHH(5AX&YVCY>wOSN@8 zfm>oOD8g{&-m1Nm>}TN3NG-!pGJ}mvlh^S-;a~!}IT>7}e5jvSBDpnv{y`yVeyLY; zIiHOYw&W=ioH)hgP>>^6{sKe|q`nApSrG dkilO<<6w;keqg@a1wC%QE7uE5gH@UNzW^~xS-t=O diff --git a/sources/LLKEY.~1~ b/sources/LLKEY.~1~ deleted file mode 100644 index 2ebf7636..00000000 --- a/sources/LLKEY.~1~ +++ /dev/null @@ -1,1779 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Apr-2000 16:28:23" {DSK}sybalsky>lispcore>sources>LLKEY.;7 207701 - - changes to%: (FNS FLIPCURSORBAR FLIPCURSOR) - - previous date%: "30-Mar-2000 20:01:05" {DSK}sybalsky>lispcore>sources>LLKEY.;6) - - -(* ; " -Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1999, 1920, 2000 by Venue & Xerox Corporation. All rights reserved. -") - -(PRETTYCOMPRINT LLKEYCOMS) - -(RPAQQ LLKEYCOMS - [(COMS (* ; "Access to keyboard") - (FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \NSYSBUFCHARS \SAVESYSBUF \SYSBUFP \GETSYSBUF - \PUTSYSBUF \PEEKSYSBUF) - (INITVARS (\LONGSYSBUF)) - (INITVARS (\\KEYBOARDWAITBOX.GLOBALRESOURCE)) - (DECLARE%: DONTCOPY (RESOURCES \KEYBOARDWAITBOX)) - (DECLARE%: DONTCOPY (CONSTANTS (\SYSBUFSIZE 200)) - (MACROS \GETREALSYSBUF))) - [DECLARE%: DOCOPY DONTEVAL@LOAD (COMS (* ; - "Here because it must be done in init before PROC loaded") - (P (MOVD? 'NILL 'CARET] - (COMS (* ; "Key handler") - (FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF - \KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSECHORDING - \DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR) - (CONSTANTS (\SUN.TYPE3KEYBOARD 0) - (\SUN.TYPE4KEYBOARD 1) - (\SUN.JLEKEYBOARD 2) - (\TOSHIBA.JIS 7)) - (INITVARS (\MOUSECHORDTICKS) - (\MOUSECHORDMILLISECONDS 50)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT))) - [DECLARE%: DONTCOPY (MACROS .NOTELASTUSERACTION) - (CONSTANTS ALLUP \CTRLMASK \METABIT) - (CONSTANTS * DLMOUSEBITS) - (CONSTANTS * DLMOUSESTATES) - (CONSTANTS * TRANSITIONFLAGS) - (MACROS \TRANSINDEX ARMEDCODE TRANSITIONALTGRCODE TRANSITIONSHIFTCODE - TRANSITIONCODE TRANSITIONFLAGS TRANSITIONDEADLIST CHECKFORDEADKEY) - (EXPORT (RECORDS KEYACTION) - (CONSTANTS \NKEYS)) - (RECORDS RING) - (COMS (* ; - "can get rid of shiftstate after clients have been fixed") - (RECORDS SHIFTSTATE) - (GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP)) - (CONSTANTS NRINGINDEXWORDS) - (CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) - (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE] - (DECLARE%: EVAL@COMPILE (VARS \KEYNAMES)) - - (* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun.") - - (VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DORADOKEYACTIONS - \DOVEKEYACTIONS \DOVEOSDKEYACTIONS \MAIKOKEYACTIONS \MAIKOKEYACTIONST4 - \MAIKO-JLE-KEYACTIONS \TOSHIBA-KEYACTIONS) - (VARS (KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL)) - (INITVARS (\KEYBOARD.META 256) - (\MODIFIED.KEYACTIONS)) - (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE) - )) - (GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS - \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION - \COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS - \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS - \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)) - (COMS (* ; "Key interpretation") - (FNS KEYACTION KEYACTIONTABLE KEYBOARDTYPE RESETKEYACTION - \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS \KEYACTION1 KEYDOWNP KEYNUMBERP - \KEYNAMETONUMBER MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP) - (* ; - "To support office style 1108 & 1186 keyboards") - (FNS SETUP.OFFICE.KEYBOARD) - (OPTIMIZERS \KEYNAMETONUMBER) - (MACROS \TEMPCOPYTIMER) - (* ; - "Don't copy this optimizer since it expands out to \getbasebit, but do exportit.") - (DECLARE%: DONTCOPY (EXPORT (OPTIMIZERS KEYDOWNP))) - (EXPORT (MACROS XKEYDOWNP KEYDOWNP1 \NEWKEYDOWNP))) - (COMS (* ; "A raw keyboard device/stream") - (FNS \INIT.KEYBOARD.STREAM) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INIT.KEYBOARD.STREAM))) - (EXPORT (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM))) - (COMS (* ; "Hook for a periodic interrupt") - (FNS \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \PERIODIC.INTERRUPTFRAME) - (INITVARS (\KEYBUFFERING) - (\PERIODIC.INTERRUPT) - (\TIMER.INTERRUPT.PENDING) - (\PERIODIC.INTERRUPT.FREQUENCY 77))) - (LOCALVARS . T) - [COMS (* ; - "cursor and mouse related functions.") - (FNS \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN) - (FNS CURSOR.INIT \CURSORDESTINATION \SOFTCURSORUP \SOFTCURSORUPCURRENT - \SOFTCURSORPOSITION \SOFTCURSORDOWN CURSORPROP GETCURSORPROP PUTCURSORPROP - \CURSORBITSPERPIXEL \CURSORIMAGEPROPNAME \CURSORMASKPROPNAME) - (FNS CURSORCREATE CURSOR \CURSOR-VALID-P \CURSORUP \CURSORPOSITION \CURSORDOWN - ADJUSTCURSORPOSITION CURSORPOSITION CURSORSCREEN CURSOREXIT FLIPCURSOR - FLIPCURSORBAR LASTMOUSEX LASTMOUSEY CREATEPOSITION POSITIONP CURSORHOTSPOT) - (PROPS (CURSORPROP ARGNAMES)) - (INITVARS (\CURSORHOTSPOTX 0) - (\CURSORHOTSPOTY 0) - (\CURRENTCURSOR NIL) - (\SOFTCURSORWIDTH NIL) - (\SOFTCURSORHEIGHT NIL) - (\SOFTCURSORP NIL) - (\SOFTCURSORUPP NIL) - (\SOFTCURSORUPBM NIL) - (\SOFTCURSORDOWNBM NIL) - (\SOFTCURSORBBT1 NIL) - (\SOFTCURSORBBT2 NIL) - (\SOFTCURSORBBT3 NIL) - (\SOFTCURSORBBT4 NIL) - (\SOFTCURSORBBT5 NIL) - (\SOFTCURSORBBT6 NIL) - (\CURSORSCREEN NIL) - (\CURSORDESTINATION NIL) - (\CURSORDESTHEIGHT 808) - (\CURSORDESTWIDTH 1024) - (\CURSORDESTRASTERWIDTH 64) - (\CURSORDESTLINE 0) - (\CURSORDESTLINEBASE NIL)) - (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH - \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM - \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 - \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH - \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE) - (FNS GETMOUSESTATE \EVENTKEYS) - [EXPORT (CONSTANTS (HARDCURSORHEIGHT 16) - (HARDCURSORWIDTH 16)) - (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN - LASTMOUSEBUTTONS LASTMOUSETIME - LASTKEYBOARD] - (DECLARE%: DONTCOPY (EXPORT (MACROS \SETMOUSEXY)) - (MACROS \XMOUSECOORD \YMOUSECOORD)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOR 'SETCURSOR) - (MOVD '\CURSORPOSITION '\SETCURSORPOSITION)) - (VARS (\SFPosition (CREATEPOSITION] - [COMS (DECLARE%: DONTCOPY (RECORDS KEYBOARDEVENT) - (CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS) - \KEYBOARDEVENT.SIZE - (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES - \KEYBOARDEVENT.SIZE - 383] - (COMS (FNS MACHINETYPE SETMAINTPANEL) - (* ; "DLion beeper") - (FNS BEEPON BEEPOFF)) - (EXPORT (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN - \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 - \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE - \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT - \PERIODIC.INTERRUPT.FREQUENCY)) - (FNS WITHOUT-INTERRUPTS) - (COMS (* ; - "Compile locked fns together for locality") - (BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR - \PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS - \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS \HARDCURSORUP \DOMOUSECHORDING - \KEYBOARDOFF \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP - \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN))) - [DECLARE%: DONTCOPY - (ADDVARS [INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS FLIPCURSORBAR \SETIOPOINTERS - \KEYHANDLER \KEYHANDLER1 \CONTEXTAPPLY - \LOCKPAGES \DECODETRANSITION \SMASHLINK - \INCUSECOUNT LLSH \MAKEFREEBLOCK - \DECUSECOUNT \MAKENUMBER \ADDBASE - \PERIODIC.INTERRUPTFRAME - \DOBUFFEREDTRANSITIONS - \TIMER.INTERRUPTFRAME \CAUSEINTERRUPT - \DOMOUSECHORDING \KEYBOARDOFF \TRACKCURSOR - \HARDCURSORUP \HARDCURSORPOSITION - \HARDCURSORDOWN \SOFTCURSORUP - \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION - \SOFTCURSORDOWN \SOFTCURSORPILOTBITBLT) - (LOCKEDVARS \InterfacePage \CURSORHOTSPOTX - \CURSORHOTSPOTY \CURRENTCURSOR - \SOFTCURSORWIDTH \SOFTCURSORHEIGHT - \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM - \SOFTCURSORDOWNBM \SOFTCURSORBBT1 - \SOFTCURSORBBT2 \SOFTCURSORBBT3 - \SOFTCURSORBBT4 \SOFTCURSORBBT5 - \SOFTCURSORBBT6 \CURSORDESTINATION - \CURSORDESTHEIGHT \CURSORDESTWIDTH - \CURSORDESTRASTERWIDTH \CURSORDESTLINE - \CURSORDESTLINEBASE \PENDINGINTERRUPT - \PERIODIC.INTERRUPT - \PERIODIC.INTERRUPT.FREQUENCY - \LASTUSERACTION \MOUSECHORDTICKS - \KEYBOARDEVENTQUEUE \KEYBUFFERING - SCREENWIDTH SCREENHEIGHT - \TIMER.INTERRUPT.PENDING \EM.MOUSEX - \EM.MOUSEY \EM.CURSORX \EM.CURSORY - \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 - \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 - \EM.DISPINTERRUPT \EM.CURSORBITMAP - \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS \RCLKSECOND - ] - (RDCOMS (FNS \SETIOPOINTERS] - (PROP FILETYPE LLKEY) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML - WITHOUT-INTERRUPTS - ) - (LAMA CURSORPROP - METASHIFT - MOUSECHORDWAIT]) - - - -(* ; "Access to keyboard") - -(DEFINEQ - -(BKSYSCHARCODE [LAMBDA (CHAR) (* rrb "30-Dec-83 11:56") (OR (\PUTSYSBUF CHAR) (PROGN (SETQ \LONGSYSBUF (NCONC \LONGSYSBUF (bind C while (SETQ C (\GETREALSYSBUF)) collect C))) (\PUTSYSBUF CHAR]) - -(\CLEARSYSBUF [LAMBDA (ALLFLG) (* mpl "27-Jun-85 20:04") (DECLARE (GLOBALVARS \PROCESSES)) (COND ((OR ALLFLG (TTY.PROCESSP)) (SETQ \LONGSYSBUF) (replace (RING READ) of \SYSBUFFER with 0))) (COND (ALLFLG (for PROC in \PROCESSES do (replace PROCTYPEAHEAD of PROC with NIL))) ((THIS.PROCESS) (replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL]) - -(\GETKEY [LAMBDA NIL (* lmm "18-Apr-85 00:07") (DECLARE (GLOBALVARS \KEYBOARDWAIT1 \KEYBOARDWAIT2)) (COND [(AND (THIS.PROCESS) (fetch PROCTYPEAHEAD of (THIS.PROCESS))) (pop (fetch PROCTYPEAHEAD of (THIS.PROCESS] (T (WAIT.FOR.TTY) (OR (\GETSYSBUF) (GLOBALRESOURCE (\KEYBOARDWAITBOX) (* Busy-wait loop that gets next  character) (\CLOCK0 \KEYBOARDWAITBOX) (bind C do (COND ((SETQ C (\GETSYSBUF)) (\BOXIPLUS (LOCF (fetch KEYBOARDWAITTIME of \MISCSTATS)) (CLOCKDIFFERENCE \KEYBOARDWAITBOX)) (RETURN C))) (\TTYBACKGROUND) (\WAIT.FOR.TTY]) - -(\NSYSBUFCHARS [LAMBDA NIL (* JonL " 7-May-84 01:50") (* Tells how many characters can be \GETSYSBUFed.  Used by \SAVESYSBUF.) (IPLUS (LENGTH \LONGSYSBUF) (PROG ((R (fetch (RING READ) of \SYSBUFFER)) (W (fetch (RING WRITE) of \SYSBUFFER))) (RETURN (COND ((EQ 0 R) 0) ((IGREATERP W R) (IDIFFERENCE W R)) (T (IDIFFERENCE W (IDIFFERENCE R \SYSBUFSIZE]) - -(\SAVESYSBUF [LAMBDA NIL (* JonL " 7-May-84 01:50") (DECLARE (GLOBALVARS \SAVEDSYSBUFFER)) (PROG (TA (BUF \SAVEDSYSBUFFER) (NC (\NSYSBUFCHARS)) (J 0)) [COND ((TTY.PROCESSP) [COND ([AND (THIS.PROCESS) (SETQ TA (fetch PROCTYPEAHEAD of (THIS.PROCESS] (replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL) (add NC (LENGTH TA)) [COND ((IGREATERP NC (NCHARS BUF)) (SETQ BUF (ALLOCSTRING NC] (for CH in TA do (RPLCHARCODE BUF (add J 1) CH))) ((IGREATERP NC (NCHARS BUF)) (SETQ BUF (ALLOCSTRING NC] (for I from (ADD1 J) to NC do (* Test on J means that we'll ignore extra chars typed since we got the  length. Test on \GETSYSBUF so we don't get screwed if buffer gets cleared  while during this loop) (RPLCHARCODE BUF I (OR (\GETSYSBUF) (PROGN (SETQ NC (SUB1 I)) (RETURN] (RETURN (AND (NOT (EQ 0 NC)) (SUBSTRING BUF 1 NC]) - -(\SYSBUFP [LAMBDA NIL (* JonL " 7-May-84 01:52") (OR [AND (TTY.PROCESSP) (OR \LONGSYSBUF (NOT (EQ 0 (fetch (RING READ) of \SYSBUFFER] (AND (THIS.PROCESS) (fetch PROCTYPEAHEAD of (THIS.PROCESS]) - -(\GETSYSBUF [LAMBDA NIL (* lmm " 9-JUL-83 00:56") (OR (AND \LONGSYSBUF (pop \LONGSYSBUF)) (\GETREALSYSBUF]) - -(\PUTSYSBUF [LAMBDA (CHAR) (* rmk%: "27-Nov-84 17:51") (PROG ((R (fetch (RING READ) of \SYSBUFFER)) (W (fetch (RING WRITE) of \SYSBUFFER))) (RETURN (COND ((EQ R W) (* Full) NIL) (T (\PUTBASEFAT \SYSBUFFER W CHAR) (AND (EQ 0 R) (replace (RING READ) of \SYSBUFFER with W)) (* Return random non-NIL value to  indicate success for BKSYSBUF) [replace (RING WRITE) of \SYSBUFFER with (COND ((EQ \SYSBUFFER.LAST W) \SYSBUFFER.FIRST) (T (ADD1 W] T]) - -(\PEEKSYSBUF [LAMBDA (STREAM) (* bvm%: " 8-Feb-85 17:50") (PROG (R) WAIT (until (\SYSBUFP) do (BLOCK)) (RETURN (if (TTY.PROCESSP) then (if \LONGSYSBUF then (CAR \LONGSYSBUF) elseif (NEQ (SETQ R (fetch (RING READ) of \SYSBUFFER)) 0) then (* Here's the vanilla case) (\GETBASEFAT \SYSBUFFER R) else (* Foo an interrupt could have sneaked in here and gobbled down the remaining  characters) (GO WAIT)) elseif (THIS.PROCESS) then (CAR (fetch PROCTYPEAHEAD of (THIS.PROCESS))) else (SHOULDNT]) -) - -(RPAQ? \LONGSYSBUF ) - -(RPAQ? \\KEYBOARDWAITBOX.GLOBALRESOURCE ) -(DECLARE%: DONTCOPY -(DECLARE%: EVAL@COMPILE - -[PUTDEF '\KEYBOARDWAITBOX 'RESOURCES '(NEW (CREATECELL \FIXP] -) -) -(DECLARE%: DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SYSBUFSIZE 200) - - -(CONSTANTS (\SYSBUFSIZE 200)) -) - -(DECLARE%: EVAL@COMPILE - -[PUTPROPS \GETREALSYSBUF MACRO - (NIL (PROG ((R (fetch (RING READ) of \SYSBUFFER))) - (RETURN (AND (NOT (EQ 0 R)) - (PROG1 (\GETBASEFAT \SYSBUFFER R) - (AND [EQ (fetch (RING WRITE) of \SYSBUFFER) - (replace (RING READ) of \SYSBUFFER - with (COND - ((EQ \SYSBUFFER.LAST R) - \SYSBUFFER.FIRST) - (T (ADD1 R] - (replace (RING READ) of \SYSBUFFER with 0)))] -) -) -(DECLARE%: DOCOPY DONTEVAL@LOAD - - - -(* ; "Here because it must be done in init before PROC loaded") - - -(MOVD? 'NILL 'CARET) -) - - - -(* ; "Key handler") - -(DEFINEQ - -(\KEYBOARDINIT [LAMBDA NIL (* ; "Edited 19-Nov-87 16:46 by Snow") (DECLARE (GLOBALVARS \SAVEDSYSBUFFER)) (* ;  "Sets up keyboard decoding tables.") (SETQ \CURRENTKEYACTION (SETQ \DEFAULTKEYACTION (KEYACTIONTABLE))) (* ;  "added \commandkeyaction 11-19-87 WAS") (SETQ \COMMANDKEYACTION (KEYACTIONTABLE)) (SETQ \INTERRUPTSTATE (\ALLOCLOCKED 2)) (PROGN (SETQ \SYSBUFFER (\ALLOCBLOCK (FOLDHI (ADD1 \SYSBUFFER.LAST) WORDSPERCELL))) (replace (RING READ) of \SYSBUFFER with 0) (replace (RING WRITE) of \SYSBUFFER with \SYSBUFFER.FIRST)) (SETQ \SAVEDSYSBUFFER (ALLOCSTRING \SYSBUFSIZE NIL NIL T)) (SETQ \LASTUSERACTION (LOCF (fetch LASTUSERACTION of \MISCSTATS))) (PROGN (SETQ \KEYBOARDEVENTQUEUE (\ALLOCLOCKED (FOLDHI (PLUS \KEYBOARDEVENT.LAST \KEYBOARDEVENT.SIZE) WORDSPERCELL))) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) (replace (RING WRITE) of \KEYBOARDEVENTQUEUE with \KEYBOARDEVENT.FIRST)) (SETQ \LASTKEYSTATE (create KEYBOARDEVENT)) (SETQ \SHIFTSTATE (create SHIFTSTATE)) (SETQ \MOUSETIMERTEMP (SETUPTIMER 0 NIL 'TICKS)) (MOUSECHORDWAIT \MOUSECHORDMILLISECONDS) (\KEYBOARDON]) - -(\KEYBOARDEVENTFN [LAMBDA (FDEV EVENT EXTRA) (* ; "Edited 11-Oct-90 09:49 by jds") (DECLARE (GLOBALVARS \KEYBOARD.BEFORETYPE \DORADOKEYACTIONS \DLIONKEYACTIONS \MAIKO.BEFOREKEYTYPE)) (SELECTQ EVENT ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM) (SETQ \KEYBOARD.BEFORETYPE \MACHINETYPE) (SETQ \MAIKO.BEFOREKEYTYPE (LOGAND 7 (FETCH (IFPAGE DEVCONFIG) OF \InterfacePage ))) (SETQ \MAIKO.XBEFORE? (SELECTQ (MACHINETYPE) (MAIKO (EQUAL "X" (UNIX-GETPARM "DISPLAY"))) NIL))) ((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM) (* ;  "Restarting a world. If we changed machines, fix up the key actions to match the new machine.") (* ; "(COND ((NEQ \\MACHINETYPE \\KEYBOARD.BEFORETYPE) ; Changed machines. Change Keyactions. (|for| X |in| (\\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) |do| (KEYACTION (CAR X) (CDR X) \\COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \\DEFAULTKEYACTION)) (MOUSECHORDWAIT (MOUSECHORDWAIT))))") [COND ((OR (NEQ \MACHINETYPE \KEYBOARD.BEFORETYPE) (NEQ \MAIKO.XBEFORE? (SELECTQ (MACHINETYPE) (MAIKO (EQUAL "X" (UNIX-GETPARM "DISPLAY"))) NIL))) (* ;  "Changed machines. Change Keyactions.") [COND ((NEQ (MACHINETYPE) 'MAIKO) (* ;; "Non-SUN, so just change machine-specific key actions:") (for X in (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION))) (T (* ;;  "On a SUN: Some keyactions contradict %"normal%" ones, so reset them all.") (for X in (APPEND \ORIGKEYACTIONS (  \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS )) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION] (MOUSECHORDWAIT (MOUSECHORDWAIT))) ((EQ (MACHINETYPE) 'MAIKO) (* ;; "Same machine type. SO only worry if we're on SUNs, where the keyboard type can differ between machines.") (COND ((NEQ \MAIKO.BEFOREKEYTYPE (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage ))) (for X in (APPEND \ORIGKEYACTIONS (  \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS )) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION)) (MOUSECHORDWAIT (MOUSECHORDWAIT]) NIL]) - -(\ALLOCLOCKED [LAMBDA (NCELLS) (* lmm "20-Apr-85 13:08") (* allocate a block of NCELLS cells  and lock it) (PROG [(BLOCK (\ALLOCBLOCK NCELLS NIL (IMIN NCELLS CELLSPERPAGE] (\LOCKCELL BLOCK (FOLDHI (IPLUS (fetch (POINTER WORDINPAGE) of BLOCK) (UNFOLD NCELLS WORDSPERCELL)) WORDSPERPAGE)) (RETURN BLOCK]) - -(\SETIOPOINTERS [LAMBDA NIL (* ; "Edited 28-Apr-88 01:10 by MASINTER") (SELECTC (SETTOPVAL '\MACHINETYPE (fetch MachineType of \InterfacePage)) ((LIST \DOLPHIN \DORADO) (SETTOPVAL '\EM.MOUSEX (EMADDRESS MOUSEX.EM)) (SETTOPVAL '\EM.MOUSEY (EMADDRESS MOUSEY.EM)) (SETTOPVAL '\EM.CURSORX (EMADDRESS CURSORX.EM)) (SETTOPVAL '\EM.CURSORY (EMADDRESS CURSORY.EM)) (SETTOPVAL '\EM.REALUTILIN (EMADDRESS UTILIN.EM)) (SETTOPVAL '\EM.KBDAD0 (EMADDRESS KBDAD0.EM)) (SETTOPVAL '\EM.KBDAD1 (EMADDRESS KBDAD1.EM)) (SETTOPVAL '\EM.KBDAD2 (EMADDRESS KBDAD2.EM)) (SETTOPVAL '\EM.KBDAD3 (EMADDRESS KBDAD3.EM)) (SETTOPVAL '\EM.KBDAD4 (LOCF (fetch FAKEKBDAD4 of \InterfacePage))) (\PUTBASE \EM.KBDAD4 0 ALLUP) (SETTOPVAL '\EM.KBDAD5 (LOCF (fetch FAKEKBDAD5 OF \InterfacePage))) (\PUTBASE \EM.KBDAD5 0 ALLUP) (SETTOPVAL '\EM.DISPINTERRUPT (EMADDRESS DISPINTERRUPT.EM)) (SETTOPVAL '\EM.CURSORBITMAP (EMADDRESS CURSORBITMAP.EM)) (SETTOPVAL '\EM.DISPLAYHEAD (EMADDRESS DCB.EM)) (SETTOPVAL 'SCREENWIDTH (UNFOLD (fetch ScreenWidth of \InterfacePage) BITSPERWORD))) ((LIST \DANDELION \MAIKO) (SETTOPVAL '\EM.MOUSEX (fetch DLMOUSEXPTR of \IOPAGE)) (SETTOPVAL '\EM.MOUSEY (fetch DLMOUSEYPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORX (fetch DLCURSORXPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORY (fetch DLCURSORYPTR of \IOPAGE)) (PROGN (SETTOPVAL '\EM.REALUTILIN (fetch DLUTILINPTR of \IOPAGE)) (* ;; "Where the hardware bits live, vs. where the Lisp software sees them after reinterpretation by keyhandler") ) (SETTOPVAL '\EM.KBDAD0 (fetch DLKBDAD0PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD1 (fetch DLKBDAD1PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD2 (fetch DLKBDAD2PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD3 (fetch DLKBDAD3PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD4 (fetch DLKBDAD4PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD5 (fetch DLKBDAD5PTR of \IOPAGE)) (SETTOPVAL '\EM.DISPINTERRUPT (fetch DLDISPINTERRUPTPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORBITMAP (fetch DLCURSORBITMAPPTR of \IOPAGE)) (SETTOPVAL '\EM.DISPLAYHEAD NIL) (SETTOPVAL 'SCREENWIDTH (SELECTC \MACHINETYPE (\MAIKO (SUBRCALL DSP-SCREENWIDTH)) 1024))) (\DAYBREAK (PROG ((KBDBASE (\DoveMisc.GetKBDBase))) (SETTOPVAL '\EM.KBDAD0 (\ADDBASE KBDBASE 1)) (SETTOPVAL '\EM.KBDAD1 (\ADDBASE KBDBASE 2)) (SETTOPVAL '\EM.KBDAD2 (\ADDBASE KBDBASE 3)) (SETTOPVAL '\EM.KBDAD3 (\ADDBASE KBDBASE 4)) (SETTOPVAL '\EM.KBDAD4 (\ADDBASE KBDBASE 5)) (SETTOPVAL '\EM.KBDAD5 (\ADDBASE KBDBASE 6)) (SETTOPVAL '\EM.MOUSEX (\DoveMisc.GetMouseXBase)) (SETTOPVAL '\EM.MOUSEY (\DoveMisc.GetMouseYBase)) (SETTOPVAL '\EM.CURSORBITMAP (\DoveDisplay.GetCursorBitmapBase)) (* These three set this way to  prevent address faults) (SETTOPVAL '\EM.DISPINTERRUPT (fetch DLDISPINTERRUPTPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORX (fetch DLCURSORXPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORY (fetch DLCURSORYPTR of \IOPAGE)) (PROGN (SETTOPVAL '\EM.REALUTILIN KBDBASE) (* Where the hardware bits live, vs. where the Lisp software sees them after  reinterpretation by keyhandler) ) (SETTOPVAL 'SCREENWIDTH (\DoveDisplay.ScreenWidth)))) (RAID)) (SETTOPVAL '\EM.UTILIN (LOCF (fetch (IFPAGE FAKEMOUSEBITS) of \InterfacePage]) - -(\KEYBOARDOFF [LAMBDA NIL (* ; "Edited 20-Apr-88 10:28 by MASINTER") (\PUTBASE \EM.DISPINTERRUPT 0 (LOGAND (LOGXOR 65535 \LispKeyMask) (\GETBASE \EM.DISPINTERRUPT 0))) (COND ((EQ \MACHINETYPE \MAIKO) (SUBRCALL KEYBOARDSTATE NIL]) - -(\KEYBOARDON [LAMBDA (NOCHECK) (* ; "Edited 24-Apr-88 00:03 by MASINTER") (\SETIOPOINTERS) (\PUTBASE \EM.DISPINTERRUPT 0 (LOGOR \LispKeyMask (\GETBASE \EM.DISPINTERRUPT 0))) (COND ((EQ \MACHINETYPE \MAIKO) (SUBRCALL KEYBOARDSTATE T]) - -(\KEYHANDLER [LAMBDA NIL (* lmm "30-MAR-83 20:40") (\KEYHANDLER1]) - -(\KEYHANDLER1 [LAMBDA NIL (* ; "Edited 30-Mar-88 10:40 by Snow") (PROG ((OLD0 ALLUP) (OLD1 ALLUP) (OLD2 ALLUP) (OLD3 ALLUP) (OLD4 ALLUP) (OLD5 ALLUP) (OLDU ALLUP) (OLDFAKEU ALLUP) (LOOPCNT 10) (PERIODCNT 60) (MOUSESTATE \DLMOUSE.UP) (MOUSETIMER (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) (MOUSETEMP (LOCF (fetch DLMOUSETEMP of \MISCSTATS))) CURSORX CURSORY YHOT) (SETQ \KEYBUFFERING NIL) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) LP (\CONTEXTSWITCH \KbdFXP) [COND (\PERIODIC.INTERRUPT (* eventually can be replaced with  general timer mechanism) (COND ((IGREATERP PERIODCNT 0) (* Continue counting down to zero) (SETQ PERIODCNT (SUB1 PERIODCNT))) ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \PERIODIC.INTERRUPTFRAME)) (* When we've counted down, then keep trying to cause the interrupt, and  reset the counter when it finally happens) (SETQ PERIODCNT (SUB1 (OR \PERIODIC.INTERRUPT.FREQUENCY 1] [COND ((OR (NEQ (\GETBASE \EM.MOUSEX 0) CURSORX) (NEQ (\GETBASE \EM.MOUSEY 0) CURSORY)) (\TRACKCURSOR (SETQ CURSORX (\GETBASE \EM.MOUSEX 0)) (SETQ CURSORY (\GETBASE \EM.MOUSEY 0] [COND ((OR [COND ((OR (NEQ OLDU (\GETBASE \EM.REALUTILIN 0)) (COND ((AND (EQ MOUSESTATE \DLMOUSE.WAITING) (IGREATERP (\BOXIDIFFERENCE (\RCLK MOUSETEMP) MOUSETIMER) 0)) (* Timer expired on seeing both left and right down, so set state to normal) (SETQ MOUSESTATE \DLMOUSE.NORMAL) T))) (SETQ MOUSESTATE (\DOMOUSECHORDING (SETQ OLDU (\GETBASE \EM.REALUTILIN 0)) MOUSESTATE)) (NEQ OLDFAKEU (\GETBASE \EM.UTILIN 0] (NEQ OLD0 (\GETBASE \EM.KBDAD0 0)) (NEQ OLD1 (\GETBASE \EM.KBDAD1 0)) (NEQ OLD2 (\GETBASE \EM.KBDAD2 0)) (NEQ OLD3 (\GETBASE \EM.KBDAD3 0)) (NEQ OLD4 (\GETBASE \EM.KBDAD4 0)) (NEQ OLD5 (\GETBASE \EM.KBDAD5 0))) (COND ((EQ 0 (LOGAND (\GETBASE \EM.KBDAD2 0) 2114)) (* Ctrl-shift-DEL panic interrupt --  switch to TeleRaid immediately) (swap (fetch (IFPAGE TELERAIDFXP) of \InterfacePage) (fetch (IFPAGE KbdFXP) of \InterfacePage)) (\KEYBOARDOFF) (SETQ OLD2 (\GETBASE \EM.KBDAD2 0)) (GO LP))) [PROG ((W (fetch (RING WRITE) of \KEYBOARDEVENTQUEUE)) (R (fetch (RING READ) of \KEYBOARDEVENTQUEUE)) WPTR) (COND ((EQ R W) (* eventqueue full!) (RETURN))) (SETQ WPTR (\ADDBASE \KEYBOARDEVENTQUEUE W)) (\RCLK (LOCF (fetch TIME of WPTR))) [with KEYBOARDEVENT WPTR (PROGN (SETQ W0 (SETQ OLD0 (\GETBASE \EM.KBDAD0 0))) (SETQ W1 (SETQ OLD1 (\GETBASE \EM.KBDAD1 0))) (SETQ W2 (SETQ OLD2 (\GETBASE \EM.KBDAD2 0))) (SETQ W3 (SETQ OLD3 (\GETBASE \EM.KBDAD3 0))) (SETQ W4 (SETQ OLD4 (\GETBASE \EM.KBDAD4 0))) (SETQ W5 (SETQ OLD5 (\GETBASE \EM.KBDAD5 0))) (SETQ WU (SETQ OLDFAKEU (\GETBASE \EM.UTILIN 0] (COND ((EQ R 0) (* Queue was empty) (replace (RING READ) of \KEYBOARDEVENTQUEUE with W))) (replace (RING WRITE) of \KEYBOARDEVENTQUEUE with (COND ((IGEQ W \KEYBOARDEVENT.LAST) \KEYBOARDEVENT.FIRST) (T (IPLUS W \KEYBOARDEVENT.SIZE] (OR \KEYBUFFERING (SETQ \KEYBUFFERING T] [COND [\KEYBUFFERING (COND ((EQ \KEYBUFFERING T) (COND ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \DOBUFFEREDTRANSITIONS)) (SETQ \KEYBUFFERING 'STARTED) (* don't call until  \DOBUFFEREDTRANSITIONS is done) ] (T (COND (\PENDINGINTERRUPT (COND ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \INTERRUPTFRAME)) (SETQ \PENDINGINTERRUPT] [COND ((AND (NEQ \MACHINETYPE \MAIKO) (ILEQ (SETQ LOOPCNT (SUB1 LOOPCNT)) 0)) (* Only do this once in a while) (SETQ LOOPCNT (COND ((\UPDATETIMERS) (* Timer was updated, so do it next time around, too, in case we just came  back from RAID or other bcpl code) 1) (T 20] (COND ([AND NIL \TIMER.INTERRUPT.PENDING (IGREATERP (\BOXIDIFFERENCE (\RCLK (LOCF (fetch DLMOUSETEMP of \MISCSTATS))) (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) 0) (COND ((EQ \TIMER.INTERRUPT.PENDING '\MOUSECHANGE) (SETQ OLDU NIL) T) (T (\CAUSEINTERRUPT \KbdFXP (FUNCTION \TIMER.INTERRUPTFRAME] (SETQ \TIMER.INTERRUPT.PENDING))) (GO LP]) - -(\RESETKEYBOARD [LAMBDA NIL (* ; "Edited 30-Mar-88 10:07 by Snow") (\SETIOPOINTERS) (* Called with lisp keyboard disabled whenever Lisp is resumed from bcpl  logout or copysys.) (SETQ \KEYBUFFERING NIL) (COND ((OR (EQ \MACHINETYPE \DANDELION) (EQ \MACHINETYPE \DAYBREAK) (EQ \MACHINETYPE \MAIKO)) (* Initialize fake mouse bits to all  up) (\PUTBASE \EM.UTILIN 0 ALLUP))) (with KEYBOARDEVENT \LASTKEYSTATE (SETQ W0 (\GETBASE \EM.KBDAD0 0)) (SETQ W1 (\GETBASE \EM.KBDAD1 0)) (SETQ W2 (\GETBASE \EM.KBDAD2 0)) (SETQ W3 (\GETBASE \EM.KBDAD3 0)) (SETQ W4 (\GETBASE \EM.KBDAD4 0)) (SETQ W5 (\GETBASE \EM.KBDAD5 0)) (SETQ WU (\GETBASE \EM.REALUTILIN 0)) (SETQ LOCK (XKEYDOWNP 'LOCK)) (SETQ 1SHIFT NIL) (SETQ 2SHIFT NIL) (SETQ CTRL NIL) (SETQ META NIL) (SETQ FONT NIL) (SETQ USERMODE1 NIL) (SETQ USERMODE2 NIL) (SETQ USERMODE3 NIL) (SETQ MOUSESTATE \DLMOUSE.UP)) (SETQ \TIMER.INTERRUPT.PENDING) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) (replace (RING READ) of \SYSBUFFER with 0) (SETQ \LONGSYSBUF) (\DAYTIME0 \LASTUSERACTION) (\KEYBOARDON]) - -(\DOMOUSECHORDING [LAMBDA (REALUTILIN STATE) (* bvm%: " 9-Oct-85 11:24") (* Handles mouse transitions on a DLion.  REALUTILIN is the actual util word from the processor.  STATE is our internal state. Sets contents of \EM.UTILIN to reflect the  virtual mouse state, which may contain a middle mouse button even where there  is only a two-button mouse. Returns new state) (PROG (LRSTATE) [COND ((OR (NULL \MOUSECHORDTICKS) (EQ (SETQ LRSTATE (LOGXOR (LOGAND REALUTILIN \MOUSE.ALLBITS) \MOUSE.ALLBITS)) 0)) (* Not interpreting chording, or both LEFT and RIGHT are up --  real state and virtual state the same) (SETQ STATE \DLMOUSE.UP)) (T (* Either L or R or both are down, so have to decide about Middle) (SELECTC STATE ((LIST \DLMOUSE.UP \DLMOUSE.WAITING) (SETQ REALUTILIN (LOGOR REALUTILIN \MOUSE.LRBIT)) (* Turn off the L and/or R bits) (COND ((EQ LRSTATE \MOUSE.LRBIT) (* Both L and R down at once, interpret as MIDDLE without waiting) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) REALUTILIN)) (SETQ STATE \DLMOUSE.MIDDLE)) ((NEQ STATE \DLMOUSE.WAITING) (* Only one of L and R down. Set timer, and ignore the down bit for now) (\BOXIPLUS (\RCLK (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) \MOUSECHORDTICKS) (SETQ STATE \DLMOUSE.WAITING)))) (\DLMOUSE.MIDDLE (* State is middle and at least one of L and R is still down, so consider it  to be still only middle) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.LRBIT))) (SELECTC LRSTATE (\MOUSE.LEFTBIT (* Right came up. Henceforth treat  right transparently) (SETQ STATE \DLMOUSE.MIDDLE&RIGHT)) (\MOUSE.RIGHTBIT (* Left came up. Henceforth treat  left transparently) (SETQ STATE \DLMOUSE.MIDDLE&LEFT)) NIL)) (\DLMOUSE.MIDDLE&RIGHT (* Only ignore LEFT) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.LEFTBIT)))) (\DLMOUSE.MIDDLE&LEFT (* Only ignore RIGHT) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.RIGHTBIT)))) (PROGN (* Remaining state is \DLMOUSE.NORMAL which means treat mouse normally, and  the only interesting transition is back to \DLMOUSE.UP) ] (\PUTBASE \EM.UTILIN 0 REALUTILIN) (RETURN STATE]) - -(\DOTRANSITIONS [LAMBDA (KEYBASE OLD NEW) (* ; "Edited 1-Feb-92 11:59 by jds") (* ;; "OLD and NEW are keyboard state words that are known to have changed. KEYBASE is the number in hardware order of the key corresponding to the first bit in these words. This function figures out the indices of transitioning keys and calls the decoder.") (for I (BITMASK _ (LLSH 1 15)) from 0 to 15 do [OR (EQ 0 (LOGAND BITMASK (LOGXOR OLD NEW))) (\DECODETRANSITION (IPLUS I KEYBASE) (EQ 0 (LOGAND NEW BITMASK] (SETQ BITMASK (LRSH BITMASK 1))) T]) - -(\DECODETRANSITION [LAMBDA (KEYNUMBER DOWNFLG) (* ; "Edited 19-Nov-87 16:29 by Snow") (* ;; "KEYNUMBER is the key number in the hardware keyboard layout, DOWNFLG is T if the key just went down. PENDINGINTERRUPT, bound in \KEYHANDLER, is set to the decoded character if it is an interrupt.") (.NOTELASTUSERACTION) (PROG ((TI (\TRANSINDEX KEYNUMBER DOWNFLG)) (KEYSTATE \LASTKEYSTATE) ASCIICODE SHIFTED) (SELECTC (TRANSITIONFLAGS \CURRENTKEYACTION TI) (IGNORE.TF (RETURN)) (LOCKSHIFT.TF (* ;  "Take shift action if either Shift or Caps Lock is down") (IF (fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE) THEN (SETQ SHIFTED T))) (NOLOCKSHIFT.TF (* ;  "Take shift action only when Shift is down") (IF (fetch (KEYBOARDEVENT SHIFT) of KEYSTATE) THEN (SETQ SHIFTED T))) (EVENT.TF (RETURN)) (1SHIFTUP.TF (replace (KEYBOARDEVENT 1SHIFT) of KEYSTATE with NIL) (RETURN)) (1SHIFTDOWN.TF (replace (KEYBOARDEVENT 1SHIFT) of KEYSTATE with T) (RETURN)) (2SHIFTUP.TF (replace (KEYBOARDEVENT 2SHIFT) of KEYSTATE with NIL) (RETURN)) (2SHIFTDOWN.TF (replace (KEYBOARDEVENT 2SHIFT) of KEYSTATE with T) (RETURN)) (LOCKUP.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with NIL) (RETURN)) (LOCKDOWN.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with T) (RETURN)) (LOCKTOGGLE.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT LOCK) of KEYSTATE))) (RETURN)) (CTRLUP.TF (replace (KEYBOARDEVENT CTRL) of KEYSTATE with NIL) (RETURN)) (CTRLDOWN.TF (replace (KEYBOARDEVENT CTRL) of KEYSTATE with T) (RETURN)) (METAUP.TF (replace (KEYBOARDEVENT META) of KEYSTATE with NIL) (RETURN)) (METADOWN.TF (replace (KEYBOARDEVENT META) of KEYSTATE with T) (RETURN)) (FONTUP.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with NIL) (RETURN)) (FONTDOWN.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with T) (RETURN)) (FONTTOGGLE.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT FONT) of KEYSTATE))) (RETURN)) (USERMODE1UP.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with NIL) (RETURN)) (USERMODE1DOWN.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with T) (RETURN)) (USERMODE1TOGGLE.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE1) of KEYSTATE))) (RETURN)) (USERMODE2UP.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with NIL) (RETURN)) (USERMODE2DOWN.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with T) (RETURN)) (USERMODE2TOGGLE.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE2) of KEYSTATE))) (RETURN)) (USERMODE3UP.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with NIL) (RETURN)) (USERMODE3DOWN.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with T) (RETURN)) (USERMODE3TOGGLE.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE3) of KEYSTATE))) (RETURN)) (SHOULDNT)) (* ;;  "Only the LOCKSHIFT and NOLOCKSHIFT cases make it to here, having set SHIFTED if appropriate.") [SETQ ASCIICODE (COND (SHIFTED (TRANSITIONSHIFTCODE \CURRENTKEYACTION TI)) (T (TRANSITIONCODE \CURRENTKEYACTION TI] [COND ((OR (fetch (KEYBOARDEVENT CTRL) of KEYSTATE) (fetch (KEYBOARDEVENT META) of KEYSTATE) (fetch (KEYBOARDEVENT FONT) of KEYSTATE)) [IF (IGREATERP ASCIICODE 127) THEN (* ;; "Non-ascii interpretation--what is cntrl/meta supposed to mean? Try using the original interpretation. This way we can type ^E or Meta-D even if Russian keyboard is set, but doesn't mess up simple ascii remappings, such as bs->del.") (SETQ ASCIICODE (COND (SHIFTED (TRANSITIONSHIFTCODE \COMMANDKEYACTION TI)) (T (TRANSITIONCODE \COMMANDKEYACTION TI] [COND ((fetch (KEYBOARDEVENT CTRL) of KEYSTATE) (SETQ ASCIICODE (LOGAND ASCIICODE \CTRLMASK] (COND ((AND (OR (fetch (KEYBOARDEVENT META) of KEYSTATE) (fetch (KEYBOARDEVENT FONT) of KEYSTATE)) (ILESSP ASCIICODE \KEYBOARD.META)) (SETQ ASCIICODE (LOGOR ASCIICODE \KEYBOARD.META] (COND ((ASSOC ASCIICODE (fetch INTERRUPTLIST of \CURRENTKEYACTION)) (SETQ PENDINGINTERRUPT T) (replace WAITINGINTERRUPT of \INTERRUPTSTATE with T) (replace INTCHARCODE of \INTERRUPTSTATE with ASCIICODE)) (T (\PUTSYSBUF ASCIICODE]) - -(MOUSECHORDWAIT [LAMBDA MSECS (* MPL "21-Jun-85 16:31") (DECLARE (GLOBALVARS \RCLKMILLISECOND)) (PROG1 (AND \MOUSECHORDTICKS \MOUSECHORDMILLISECONDS) (COND ((IGREATERP MSECS 0) (SETQ \MOUSECHORDTICKS (AND (ARG MSECS 1) (IMIN MAX.SMALLP (ITIMES (SETQ \MOUSECHORDMILLISECONDS (OR (SMALLP (ARG MSECS 1)) 50)) \RCLKMILLISECOND]) - -(\TRACKCURSOR [LAMBDA (CURSORX CURSORY) (* ; "Edited 30-Mar-88 11:11 by Snow") (DECLARE (GLOBALVARS \CURSORDESTHEIGHT \CURSORDESTWIDTH)) (.NOTELASTUSERACTION) [COND ((OR [COND ((IGEQ CURSORX (IDIFFERENCE \CURSORDESTWIDTH \CURSORHOTSPOTX)) (* Large cursor values are either out of bounds to the right or are negative  values (16-bit bcpl signed numbers)) (COND [(IGREATERP CURSORX 32767) (* Cursor value is negative) (COND ((ILESSP (IPLUS (SUB1 (IDIFFERENCE CURSORX 65535)) \CURSORHOTSPOTX) 0) (* Cursor pos + hotspot is still off to the left  (the IPLUS is an optimization of (\XMOUSECOORD))%, so clip to effective zero) (SETQ CURSORX (COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) 0) (T (UNSIGNED (IMINUS \CURSORHOTSPOTX) BITSPERWORD] (T (SETQ CURSORX (SUB1 (IDIFFERENCE \CURSORDESTWIDTH \CURSORHOTSPOTX] (IGEQ CURSORY (IDIFFERENCE \CURSORDESTHEIGHT HARDCURSORHEIGHT))) (* repeat test so that both X and Y will get clipped each cycle.  This keeps the cursor from moving off the screen.) [COND ((IGEQ CURSORY (IDIFFERENCE \CURSORDESTHEIGHT \CURSORHOTSPOTY)) (* Large cursor values are either out of bounds to the bottom or are negative  values (16-bit bcpl signed numbers)) (COND [(IGREATERP CURSORY 32767) (* Cursor value is negative) (COND ((ILESSP (IPLUS (SUB1 (IDIFFERENCE CURSORY 65535)) \CURSORHOTSPOTY) 0) (* Cursor pos + hotspot is still off to the top, so clip to effective zero) (SETQ CURSORY (COND ((OR (EQ \MACHINETYPE \DANDELION) (EQ \MACHINETYPE \DAYBREAK)) (* Temporary workaround) 0) (T (UNSIGNED (IMINUS \CURSORHOTSPOTY) BITSPERWORD] (T (SETQ CURSORY (SUB1 (IDIFFERENCE \CURSORDESTHEIGHT \CURSORHOTSPOTY] (* If need to clip mouse, do so here. \SETMOUSEXY MACRO takes dlion  complexities into account.) (COND ((NEQ \MACHINETYPE \MAIKO) (\SETMOUSEXY CURSORX CURSORY] (COND (\SOFTCURSORUPP (\SOFTCURSORPOSITION CURSORX CURSORY))) (COND ((EQ \MACHINETYPE \DAYBREAK) (* Have to kick DAYBREAK IOP to track the cursor.  *) (\DoveDisplay.SetCursorPosition CURSORX CURSORY))) (\PUTBASE \EM.CURSORX 0 CURSORX) (\PUTBASE \EM.CURSORY 0 CURSORY]) -) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SUN.TYPE3KEYBOARD 0) - -(RPAQQ \SUN.TYPE4KEYBOARD 1) - -(RPAQQ \SUN.JLEKEYBOARD 2) - -(RPAQQ \TOSHIBA.JIS 7) - - -(CONSTANTS (\SUN.TYPE3KEYBOARD 0) - (\SUN.TYPE4KEYBOARD 1) - (\SUN.JLEKEYBOARD 2) - (\TOSHIBA.JIS 7)) -) - -(RPAQ? \MOUSECHORDTICKS ) - -(RPAQ? \MOUSECHORDMILLISECONDS 50) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\KEYBOARDINIT) -) -(DECLARE%: DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP - of \MISCSTATS)) - WORDSPERCELL))) -) - -(DECLARE%: EVAL@COMPILE - -(RPAQQ ALLUP 65535) - -(RPAQQ \CTRLMASK 159) - -(RPAQQ \METABIT 128) - - -(CONSTANTS ALLUP \CTRLMASK \METABIT) -) - - -(RPAQQ DLMOUSEBITS ((\MOUSE.LEFTBIT 4) - (\MOUSE.RIGHTBIT 2) - (\MOUSE.MIDDLEBIT 1) - (\MOUSE.ALLBITS 7) - (\MOUSE.LRBIT 6))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \MOUSE.LEFTBIT 4) - -(RPAQQ \MOUSE.RIGHTBIT 2) - -(RPAQQ \MOUSE.MIDDLEBIT 1) - -(RPAQQ \MOUSE.ALLBITS 7) - -(RPAQQ \MOUSE.LRBIT 6) - - -(CONSTANTS (\MOUSE.LEFTBIT 4) - (\MOUSE.RIGHTBIT 2) - (\MOUSE.MIDDLEBIT 1) - (\MOUSE.ALLBITS 7) - (\MOUSE.LRBIT 6)) -) - - -(RPAQQ DLMOUSESTATES ((\DLMOUSE.UP 0) - (\DLMOUSE.WAITING 1) - (\DLMOUSE.NORMAL 2) - (\DLMOUSE.MIDDLE 3) - (\DLMOUSE.MIDDLE&LEFT 4) - (\DLMOUSE.MIDDLE&RIGHT 5))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \DLMOUSE.UP 0) - -(RPAQQ \DLMOUSE.WAITING 1) - -(RPAQQ \DLMOUSE.NORMAL 2) - -(RPAQQ \DLMOUSE.MIDDLE 3) - -(RPAQQ \DLMOUSE.MIDDLE&LEFT 4) - -(RPAQQ \DLMOUSE.MIDDLE&RIGHT 5) - - -(CONSTANTS (\DLMOUSE.UP 0) - (\DLMOUSE.WAITING 1) - (\DLMOUSE.NORMAL 2) - (\DLMOUSE.MIDDLE 3) - (\DLMOUSE.MIDDLE&LEFT 4) - (\DLMOUSE.MIDDLE&RIGHT 5)) -) - - -(RPAQQ TRANSITIONFLAGS - (ALTGRDOWN.TF ALTGRUP.TF ALTGRTOGGLE.TF CTRLDOWN.TF CTRLUP.TF DEADKEY.TF IGNORE.TF EVENT.TF - LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF - 1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF FONTDOWN.TF FONTUP.TF - FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF USERMODE2UP.TF - USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF USERMODE3TOGGLE.TF)) -(DECLARE%: EVAL@COMPILE - -(RPAQQ ALTGRDOWN.TF 27) - -(RPAQQ ALTGRUP.TF 28) - -(RPAQQ ALTGRTOGGLE.TF 29) - -(RPAQQ CTRLDOWN.TF 5) - -(RPAQQ CTRLUP.TF 4) - -(RPAQQ DEADKEY.TF 30) - -(RPAQQ IGNORE.TF 0) - -(RPAQQ EVENT.TF 1) - -(RPAQQ LOCKDOWN.TF 8) - -(RPAQQ LOCKSHIFT.TF 2) - -(RPAQQ LOCKTOGGLE.TF 14) - -(RPAQQ LOCKUP.TF 7) - -(RPAQQ NOLOCKSHIFT.TF 3) - -(RPAQQ 1SHIFTDOWN.TF 6) - -(RPAQQ 1SHIFTUP.TF 9) - -(RPAQQ 2SHIFTDOWN.TF 11) - -(RPAQQ 2SHIFTUP.TF 10) - -(RPAQQ METADOWN.TF 13) - -(RPAQQ METAUP.TF 12) - -(RPAQQ FONTDOWN.TF 24) - -(RPAQQ FONTUP.TF 25) - -(RPAQQ FONTTOGGLE.TF 26) - -(RPAQQ USERMODE1UP.TF 15) - -(RPAQQ USERMODE1DOWN.TF 16) - -(RPAQQ USERMODE1TOGGLE.TF 17) - -(RPAQQ USERMODE2UP.TF 18) - -(RPAQQ USERMODE2DOWN.TF 19) - -(RPAQQ USERMODE2TOGGLE.TF 20) - -(RPAQQ USERMODE3UP.TF 21) - -(RPAQQ USERMODE3DOWN.TF 22) - -(RPAQQ USERMODE3TOGGLE.TF 23) - - -(CONSTANTS ALTGRDOWN.TF ALTGRUP.TF ALTGRTOGGLE.TF CTRLDOWN.TF CTRLUP.TF DEADKEY.TF IGNORE.TF EVENT.TF - LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF - 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF - USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF USERMODE2UP.TF USERMODE2DOWN.TF - USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF USERMODE3TOGGLE.TF) -) - -(DECLARE%: EVAL@COMPILE - -[PUTPROPS \TRANSINDEX MACRO ((KEYNUMBER DOWNFLG) - (COND - (DOWNFLG (IPLUS \NKEYS KEYNUMBER)) - (T KEYNUMBER] - -(PUTPROPS ARMEDCODE MACRO ((TABLE CHAR) - (\GETBASEBIT (fetch (KEYACTION ARMED) - TABLE) - CHAR))) - -(PUTPROPS TRANSITIONALTGRCODE MACRO ((TABLE CHAR) - (\GETBASE (fetch (KEYACTION ALTGRAPHCODES) of TABLE) - CHAR))) - -(PUTPROPS TRANSITIONSHIFTCODE MACRO ((TABLE CHAR) - (\GETBASE (fetch (KEYACTION SHIFTCODES) - TABLE) - CHAR))) - -(PUTPROPS TRANSITIONCODE MACRO ((TABLE CHAR) - (\GETBASE (fetch (KEYACTION CODES) - TABLE) - CHAR))) - -(PUTPROPS TRANSITIONFLAGS MACRO ((TABLE CHAR) - (\GETBASEBYTE (fetch (KEYACTION FLAGS) - TABLE) - CHAR))) - -[PUTPROPS TRANSITIONDEADLIST MACRO ((TABLE CHAR SHIFTED) - (\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) - (LLSH (COND - (SHIFTED (IPLUS CHAR \NKEYS \NKEYS)) - (T CHAR)) - 1] - -[PUTPROPS CHECKFORDEADKEY MACRO - ((KEYCODE TABLE CHAR SHIFTED) - (LET ((CODE KEYCODE)) - (COND - [(IEQP CODE 65535) - `(DEADKEY ,(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) - (LLSH (COND - (SHIFTED (IPLUS CHAR \NKEYS \NKEYS)) - (T CHAR)) - 1] - (T CODE] -) - -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -(BLOCKRECORD KEYACTION ( - (* ;; "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage.") - - FLAGS (* ; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc.") - CODES (* ; - "Table of character codes generated by each key when no shift key is pressed.") - SHIFTCODES (* ; - "Table of character codes generated by each key when the shift key is pressed.") - ARMED (* ; "Not sure...") - INTERRUPTLIST (* ; "List of armed interrupts?") - ALTGRAPHCODES (* ; - "Table of codes to be generated when the ALT-GRAPH key is pressed.") - DEADKEYLIST (* ; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each %"table%" is an ALIST of orignal code => accented code. no entry means punt the accent..") - ) - FLAGS _ (\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS) - BYTESPERCELL)) - CODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) - WORDSPERCELL)) - SHIFTCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) - WORDSPERCELL)) - ARMED _ (\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR) - BITSPERCELL)) - ALTGRAPHCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) - WORDSPERCELL)) - DEADKEYLIST _ (\ALLOCBLOCK (PLUS \NKEYS \NKEYS \NKEYS \NKEYS) - T) - (CREATE (\ALLOCBLOCK 7 PTRBLOCK.GCT)) - [TYPE? (AND (\BLOCKDATAP DATUM) - (IGEQ (\#BLOCKDATACELLS DATUM) - 5) - (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) - OF DATUM)) - (LISTP (FETCH INTERRUPTLIST OF DATUM))) - (\BLOCKDATAP (FETCH (KEYACTION FLAGS) - DATUM)) - (\BLOCKDATAP (FETCH (KEYACTION CODES) - DATUM)) - (\BLOCKDATAP (FETCH (KEYACTION ARMED) - DATUM]) -) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \NKEYS 112) - - -(CONSTANTS \NKEYS) -) - -(* "END EXPORTED DEFINITIONS") - - -(DECLARE%: EVAL@COMPILE - -(BLOCKRECORD RING ((READ WORD) - (WRITE WORD))) -) - - - - -(* ; "can get rid of shiftstate after clients have been fixed") - -(DECLARE%: EVAL@COMPILE - -(ACCESSFNS SHIFTSTATE [[DUMMYSHIFT (NOT (EQ 0 (LOGAND (\GETBASEBYTE DATUM 0) - (LOGOR 1 2] - [DUMMY1SHIFT [NOT (EQ 0 (LOGAND 1 (\GETBASEBYTE DATUM 0] - (\PUTBASEBYTE DATUM 0 (COND - (NEWVALUE (LOGOR 1 (\GETBASEBYTE DATUM 0)) - ) - (T (LOGAND (\GETBASEBYTE DATUM 0) - (LOGXOR \CHARMASK 1] - [DUMMY2SHIFT [NOT (EQ 0 (LOGAND 2 (\GETBASEBYTE DATUM 0] - (\PUTBASEBYTE DATUM 0 (COND - (NEWVALUE (LOGOR 2 (\GETBASEBYTE DATUM 0)) - ) - (T (LOGAND (\GETBASEBYTE DATUM 0) - (LOGXOR \CHARMASK 2] - [DUMMYLOCK [NOT (EQ 0 (LOGAND 4 (\GETBASEBYTE DATUM 0] - (\PUTBASEBYTE DATUM 0 (COND - (NEWVALUE (LOGOR 4 (\GETBASEBYTE DATUM 0)) - ) - (T (LOGAND (\GETBASEBYTE DATUM 0) - (LOGXOR \CHARMASK 4] - [DUMMYSHIFTORLOCK (NOT (EQ 0 (\GETBASEBYTE DATUM 0))) - (\PUTBASEBYTE DATUM 0 (COND - (NEWVALUE (HELP - " Can't turn on SHIFTORLOCK" - )) - (T 0] - [DUMMYCTRL (NOT (EQ 0 (\GETBASEBYTE DATUM 1))) - (\PUTBASEBYTE DATUM 1 (COND - (NEWVALUE 1) - (T 0] - [DUMMYMETA (NOT (EQ 0 (\GETBASEBYTE DATUM 2))) - (\PUTBASEBYTE DATUM 2 (COND - (NEWVALUE 1) - (T 0] - [DUMMYFONT (NEQ 0 (LOGAND (LLSH 1 3) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 3) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 3] - [DUMMYUSERMODE1 (NEQ 0 (LOGAND (LLSH 1 0) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 0) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 0] - [DUMMYUSERMODE2 (NEQ 0 (LOGAND (LLSH 1 1) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 1) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 1] - [DUMMYUSERMODE3 (NEQ 0 (LOGAND (LLSH 1 2) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 2) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 2] - [DUMMYALTGRAPH (NEQ 0 (LOGAND (LLSH 1 4) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 4) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 4] - (DUMMYDEADKEYPENDING (NEQ 0 (LOGAND (LLSH 1 5) - (\GETBASEBYTE DATUM 3))) - (\PUTBASEBYTE DATUM 3 (COND - (NEWVALUE (LOGOR (LLSH 1 5) - (\GETBASEBYTE DATUM 3))) - (T (LOGAND (\GETBASEBYTE DATUM 3) - (LOGXOR \CHARMASK - (LLSH 1 5] - (CREATE (\ALLOCBLOCK (FOLDHI 3 BYTESPERCELL)))) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP) -) - -(DECLARE%: EVAL@COMPILE - -(RPAQQ NRINGINDEXWORDS 2) - - -(CONSTANTS NRINGINDEXWORDS) -) - -(DECLARE%: EVAL@COMPILE - -(RPAQ \SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) - -(RPAQ \SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE))) - - -[CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) - (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE] -) -) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \KEYNAMES ((5 %% FIVE) - (4 $ FOUR) - (6 ~ SIX) - (e E) - (7 & SEVEN) - (d D) - (u U) - (v V) - (0 %) ZERO) - (k K) - (- %) - (p P) - (/ ?) - (\ %| FONT LOOKS) - (LF SAME) - (BS <-) - (3 %# THREE) - (2 @ TWO) - (w W) - (q Q) - (s S) - (a A) - (9 %( NINE) - (i I) - (x X) - (o O) - (l L) - (%, <) - (%' %") - (%] }) - (BLANK-MIDDLE OPEN DBK-HELP) - (BLANK-TOP KEYBOARD DBK-META) - (1 ! ONE) - (ESC ESCAPE ->) - (TAB =>) - (f F) - (CTRL PROP'S EDIT) - (c C) - (j J) - (b B) - (z Z) - (LSHIFT) - (%. >) - (; %:) - (CR <-%|) - (_ ^) - (DEL DELETE) - (SKIP NEXT) - (r R) - (t T) - (g G) - (y Y) - (h H) - (8 * EIGHT) - (n N) - (m M) - (LOCK) - (SPACE) - (%[ {) - (= +) - (RSHIFT) - (BLANK-BOTTOM STOP) - (MOVE) - (UNDO) - (UTIL0 SUN-KEYPAD=) - (UTIL1 SUN-KEYPAD/) - (UTIL2 SUPER/SUB) - (UTIL3 CASE) - (UTIL4 STRIKEOUT) - (UTIL5 KEYPAD2) - (UTIL6 KEYPAD3 PGDN) - (UTIL7 SUN-LF) - (PAD1 LEFTKEY CAPSLOCK KEYPAD+) - (PAD2 LEFTMIDDLEKEY NUMLOCK KEYPAD-) - (PAD3 MIDDLEKEY SCROLLLOCK KEYPAD*) - (PAD4 RIGHTMIDDLEKEY BREAK KEYPAD/ SUN-PAUSE) - (PAD5 RIGHTKEY DOIT PRTSC) - (LEFT RED MOUSERED) - (RIGHT BLUE MOUSEBLUE) - (MIDDLE YELLOW MOUSEYELLOW) - (MARGINS) - (K41 KEYPAD7 HOME) - (K42 KEYPAD8) - (K43 KEYPAD9 PGUP) - (K44 KEYPAD4) - (K45 KEYPAD5) - (K46 SUN-LEFT-SPACE) - (K47 KEYPAD6) - (K48 SUN-RIGHT-SPACE) - (COPY) - (FIND) - (AGAIN) - (HELP) - (DEF'N EXPAND) - (K4E KEYPAD1 END) - (ALWAYS-ON-1) - (ALWAYS-ON-2) - (CENTER) - (K52 KEYPAD0 INS) - (BOLD) - (ITALICS) - (UNDERLINE) - (SUPERSCRIPT) - (SUBSCRIPT) - (LARGER SMALLER) - (K59 KEYPAD%| KEYPAD.) - (K5A KEYPAD\ KEYPAD, SUN-F10) - (K5B SUN-F11) - (K5C SUN-F12) - (DEFAULTS SUN-PROP) - (K5E SUN-PRTSC) - (K5F SUN-OPEN))) -) - - - -(* ;; -"\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun." -) - - -(RPAQQ \ORIGKEYACTIONS ((0 (53 "%%" NOLOCKSHIFT)) - (1 (52 "$" NOLOCKSHIFT)) - (2 (54 "~" NOLOCKSHIFT)) - (3 ("e" "E" LOCKSHIFT)) - (4 (55 "&" NOLOCKSHIFT)) - (5 ("d" "D" LOCKSHIFT)) - (6 ("u" "U" LOCKSHIFT)) - (7 ("v" "V" LOCKSHIFT)) - (8 (48 ")" NOLOCKSHIFT)) - (9 ("k" "K" LOCKSHIFT)) - (10 ("-" "-" NOLOCKSHIFT)) - (11 ("p" "P" LOCKSHIFT)) - (12 ("/" "?" NOLOCKSHIFT)) - (13 ("\" "|" NOLOCKSHIFT)) - (14 (10 96 NOLOCKSHIFT)) - (15 (8 8 NOLOCKSHIFT)) - (16 (51 "#" NOLOCKSHIFT)) - (17 (50 "@" NOLOCKSHIFT)) - (18 ("w" "W" LOCKSHIFT)) - (19 ("q" "Q" LOCKSHIFT)) - (20 ("s" "S" LOCKSHIFT)) - (21 ("a" "A" LOCKSHIFT)) - (22 (57 "(" NOLOCKSHIFT)) - (23 ("i" "I" LOCKSHIFT)) - (24 ("x" "X" LOCKSHIFT)) - (25 ("o" "O" LOCKSHIFT)) - (26 ("l" "L" LOCKSHIFT)) - (27 ("," "<" NOLOCKSHIFT)) - (28 ("'" "%"" NOLOCKSHIFT)) - (29 ("]" "}" NOLOCKSHIFT)) - (30 (194 194 NOLOCKSHIFT)) - (31 (193 193 NOLOCKSHIFT)) - (32 (49 "!" NOLOCKSHIFT)) - (33 (27 27 NOLOCKSHIFT)) - (34 (9 9 NOLOCKSHIFT)) - (35 ("f" "F" LOCKSHIFT)) - (36 CTRLDOWN . CTRLUP) - (37 ("c" "C" LOCKSHIFT)) - (38 ("j" "J" LOCKSHIFT)) - (39 ("b" "B" LOCKSHIFT)) - (40 ("z" "Z" LOCKSHIFT)) - (41 1SHIFTDOWN . 1SHIFTUP) - (42 ("." ">" NOLOCKSHIFT)) - (43 (";" ":" NOLOCKSHIFT)) - (44 (13 13 NOLOCKSHIFT)) - (45 ("_" "^" NOLOCKSHIFT)) - (46 (127 535 NOLOCKSHIFT)) - (47 ("(" "[" NOLOCKSHIFT)) - (48 ("r" "R" LOCKSHIFT)) - (49 ("t" "T" LOCKSHIFT)) - (50 ("g" "G" LOCKSHIFT)) - (51 ("y" "Y" LOCKSHIFT)) - (52 ("h" "H" LOCKSHIFT)) - (53 (56 "*" NOLOCKSHIFT)) - (54 ("n" "N" LOCKSHIFT)) - (55 ("m" "M" LOCKSHIFT)) - (56 LOCKDOWN . LOCKUP) - (57 (32 32 NOLOCKSHIFT)) - (58 ("[" "{" NOLOCKSHIFT)) - (59 ("=" "+" NOLOCKSHIFT)) - (60 2SHIFTDOWN . 2SHIFTUP) - (61 (195 195 NOLOCKSHIFT)) - (63 (")" "]" NOLOCKSHIFT)) - (77 EVENT . EVENT) - (78 EVENT . EVENT) - (79 EVENT . EVENT) - (102 LOCKDOWN) - (103 LOCKUP))) - -(RPAQQ \DLIONKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) - (10 ("-" "_" NOLOCKSHIFT)) - (33 ("\" "|" NOLOCKSHIFT)) - (45 (96 "~" NOLOCKSHIFT)) - (OPEN METADOWN . METAUP) - (PROP'S CTRLDOWN . CTRLUP) - (SAME METADOWN . METAUP) - (FIND ("2,3" "2,43" NOLOCKSHIFT)) - (UNDO ("2,4" "2,44" NOLOCKSHIFT)) - (STOP (5 7 NOLOCKSHIFT)) - (MOVE) - (COPY) - (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) - (CENTER ("2,101" "2,141" NOLOCKSHIFT)) - (BOLD ("2,102" "2,142" NOLOCKSHIFT)) - (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) - (UNDERLINE ("2,106" "2,146" NOLOCKSHIFT)) - (SUPERSCRIPT ("2,113" "2,153" NOLOCKSHIFT)) - (SUBSCRIPT ("2,114" "2,154" NOLOCKSHIFT)) - (LARGER ("2,110" "2,150" NOLOCKSHIFT)) - (DEFAULTS ("2,115" "2,155" NOLOCKSHIFT)) - (93 (27 "2,64" NOLOCKSHIFT)) - (47 ("2,22" "2,62" NOLOCKSHIFT)) - (31 ("2,5" "2,45" NOLOCKSHIFT)) - (92 ("2,1" "2,41" NOLOCKSHIFT)) - (80 ("2,13" "2,53" NOLOCKSHIFT)) - (FONT ("2,112" "2,152" NOLOCKSHIFT)))) - -(RPAQQ \DLIONOSDKEYACTIONS ((56 LOCKTOGGLE))) - -(RPAQQ \DORADOKEYACTIONS ((2 (54 "~" NOLOCKSHIFT)) - (10 ("-" "-" NOLOCKSHIFT)) - (13 ("\" "|" NOLOCKSHIFT)) - (14 (10 96 NOLOCKSHIFT)) - (33 (27 27 NOLOCKSHIFT)) - (45 ("_" "^" NOLOCKSHIFT)))) - -(RPAQQ \DOVEKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) - (10 ("-" "_" NOLOCKSHIFT)) - (33 (27 27 NOLOCKSHIFT)) - (56 CTRLDOWN . CTRLUP) - (65 (27 27 NOLOCKSHIFT)) - (71 (39 34 NOLOCKSHIFT)) - (93 ("2,24" "2,64" NOLOCKSHIFT)) - (108 (96 126 NOLOCKSHIFT)) - (DBK-META METADOWN . METAUP) - (DBK-HELP ("2,1" "2,41" NOLOCKSHIFT)) - (SAME METADOWN . METAUP) - (FIND ("2,3" "2,43" NOLOCKSHIFT)) - (UNDO ("2,4" "2,44" NOLOCKSHIFT)) - (STOP (5 7 NOLOCKSHIFT)) - (EDIT ("2,5" "2,45" NOLOCKSHIFT)) - (MOVE) - (COPY) - (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) - (CENTER ("2,101" "2,141" NOLOCKSHIFT)) - (BOLD ("2,102" "2,142" NOLOCKSHIFT)) - (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) - (CASE ("2,104" "2,144" NOLOCKSHIFT)) - (STRIKEOUT ("2,105" "2,145" NOLOCKSHIFT)) - (UNDERLINE ("2,106" "2,146" NOLOCKSHIFT)) - (SUPER/SUB ("2,107" "2,147" NOLOCKSHIFT)) - (LARGER ("2,110" "2,150" NOLOCKSHIFT)) - (MARGINS ("2,111" "2,151" NOLOCKSHIFT)) - (LOOKS ("2,112" "2,152" NOLOCKSHIFT)) - (CAPSLOCK LOCKTOGGLE) - (NUMLOCK ("2,11" "-" NOLOCKSHIFT)) - (SCROLLLOCK ("2,12" 180 NOLOCKSHIFT)) - (BREAK (2 184 NOLOCKSHIFT)) - (DOIT ("2,13" "2,53" NOLOCKSHIFT)) - (KEYPAD7 ("2,14" 55 NOLOCKSHIFT)) - (KEYPAD8 (173 56 NOLOCKSHIFT)) - (KEYPAD9 ("2,15" 57 NOLOCKSHIFT)) - (KEYPAD4 (172 52 NOLOCKSHIFT)) - (KEYPAD5 ("2,16" 53 NOLOCKSHIFT)) - (KEYPAD6 (174 54 NOLOCKSHIFT)) - (KEYPAD1 ("2,17" 49 NOLOCKSHIFT)) - (KEYPAD2 (175 50 NOLOCKSHIFT)) - (KEYPAD3 ("2,20" 51 NOLOCKSHIFT)) - (KEYPAD0 ("2,21" 48 NOLOCKSHIFT)) - (KEYPAD%| ("|" 46 NOLOCKSHIFT)) - (KEYPAD\ ("\" 44 NOLOCKSHIFT)) - (47 ("2,22" "2,62" NOLOCKSHIFT)))) - -(RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP) - (36 CTRLDOWN . CTRLUP) - (CAPSLOCK ("2,5" "2,45" NOLOCKSHIFT)))) - -(RPAQQ \MAIKOKEYACTIONS ((61 (5 7 NOLOCKSHIFT)) - (91 (520 552 NOLOCKSHIFT)) - (92 (513 545 NOLOCKSHIFT)) - (30 (513 545 NOLOCKSHIFT)) - (63 (516 548 NOLOCKSHIFT)) - (93 (532 564 NOLOCKSHIFT)) - (62) - (111 (329 263 NOLOCKSHIFT)) - (89) - (90 (515 547 NOLOCKSHIFT)) - (73 (521 521 NOLOCKSHIFT)) - (74 (522 522 NOLOCKSHIFT)) - (75 (2 2 NOLOCKSHIFT)) - (81 (524 55 NOLOCKSHIFT)) - (82 (173 56 NOLOCKSHIFT)) - (83 (525 57 NOLOCKSHIFT)) - (84 (172 52 NOLOCKSHIFT)) - (85 (526 53 NOLOCKSHIFT)) - (87 (174 54 NOLOCKSHIFT)) - (94 (527 49 NOLOCKSHIFT)) - (69 (175 50 NOLOCKSHIFT)) - (70 (528 51 NOLOCKSHIFT)) - (98 (529 48 NOLOCKSHIFT)) - (76 (523 555 NOLOCKSHIFT)) - (72 LOCKTOGGLE) - (97 (577 609 NOLOCKSHIFT)) - (99 (578 610 NOLOCKSHIFT)) - (100 (579 611 NOLOCKSHIFT)) - (67 (580 612 NOLOCKSHIFT)) - (68 (581 613 NOLOCKSHIFT)) - (101 (582 614 NOLOCKSHIFT)) - (66 (583 615 NOLOCKSHIFT)) - (104 (584 616 NOLOCKSHIFT)) - (80 (585 617 NOLOCKSHIFT)) - (13 (23 21 NOLOCKSHIFT)) - (33 (27 27 NOLOCKSHIFT)) - (65 (27 27 NOLOCKSHIFT)) - (2 (54 94 NOLOCKSHIFT)) - (10 (45 95 NOLOCKSHIFT)) - (36 CTRLDOWN . CTRLUP) - (56 LOCKTOGGLE . IGNORE) - (45 (96 126 NOLOCKSHIFT)) - (31 METADOWN . METAUP) - (14 METADOWN . METAUP) - (71 (10 10 NOLOCKSHIFT)) - (47 (530 562 NOLOCKSHIFT)) - (105 (92 124 NOLOCKSHIFT)))) - -(RPAQQ \MAIKOKEYACTIONST4 ((61 ("^E" "^G" NOLOCKSHIFT)) - (91 ("2,10" "2,50" NOLOCKSHIFT)) - (92 ("2,1" "2,41" NOLOCKSHIFT)) - (30 ("2,1" "2,41" NOLOCKSHIFT)) - (109 ("2,25" "2,65" NOLOCKSHIFT)) - (63 ("2,4" "2,44" NOLOCKSHIFT)) - (14 METADOWN . METAUP) - (93 ("2,24" "2,64" NOLOCKSHIFT)) - (62) - (111 ("1,111" "1,79" NOLOCKSHIFT)) - (89) - (90 ("2,3" "2,43" NOLOCKSHIFT)) - (73 ("2,11" "2,11" NOLOCKSHIFT)) - (74 ("2,12" "2,12" NOLOCKSHIFT)) - (75 ("^B" "^B" NOLOCKSHIFT)) - (81 ("2,14" 55 NOLOCKSHIFT)) - (82 (173 56 NOLOCKSHIFT)) - (83 ("2,15" 57 NOLOCKSHIFT)) - (84 (172 52 NOLOCKSHIFT)) - (85 ("2,16" 53 NOLOCKSHIFT)) - (87 (174 54 NOLOCKSHIFT)) - (94 ("2,17" 49 NOLOCKSHIFT)) - (69 (175 50 NOLOCKSHIFT)) - (70 ("2,20" 51 NOLOCKSHIFT)) - (98 ("2,21" 48 NOLOCKSHIFT)) - (76 ("2,13" "2,13" NOLOCKSHIFT)) - (110 ("2,53" "2,53" NOLOCKSHIFT)) - (72 LOCKTOGGLE) - (97 ("2,101" "2,141" NOLOCKSHIFT)) - (99 ("2,102" "2,142" NOLOCKSHIFT)) - (100 ("2,103" "2,143" NOLOCKSHIFT)) - (67 ("2,104" "2,144" NOLOCKSHIFT)) - (68 ("2,105" "2,145" NOLOCKSHIFT)) - (101 ("2,106" "2,146" NOLOCKSHIFT)) - (66 ("2,107" "2,147" NOLOCKSHIFT)) - (104 ("2,110" "2,150" NOLOCKSHIFT)) - (80 ("2,111" "2,151" NOLOCKSHIFT)) - (106 ("2,113" "2,153" NOLOCKSHIFT)) - (107 ("2,114" "2,154" NOLOCKSHIFT)) - (108 ("2,115" "2,155" NOLOCKSHIFT)) - (13 ("^W" "^U" NOLOCKSHIFT)) - (33 ("ESC" "ESC" NOLOCKSHIFT)) - (64 IGNORE . IGNORE) - (65 (27 27 NOLOCKSHIFT)) - (95 IGNORE . IGNORE) - (96 IGNORE . IGNORE) - (102 IGNORE . IGNORE) - (2 ("6" "^" NOLOCKSHIFT)) - (10 ("-" "_" NOLOCKSHIFT)) - (36 CTRLDOWN . CTRLUP) - (56 LOCKTOGGLE . IGNORE) - (45 ("`" "~" NOLOCKSHIFT)) - (31 METADOWN . METAUP) - (71 (10 10 NOLOCKSHIFT)) - (47 ("2,22" "2,62" NOLOCKSHIFT)) - (86 IGNORE . IGNORE) - (88 IGNORE . IGNORE) - (105 ("\" "|" NOLOCKSHIFT)))) - -(RPAQQ \MAIKO-JLE-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) - (4 ("7" "'" NOLOCKSHIFT)) - (8 ("0" "0" NOLOCKSHIFT)) - (10 ("\" "_" NOLOCKSHIFT)) - (13 ("^W" "^U" NOLOCKSHIFT)) - (14 METADOWN . METAUP) - (15 (8 8 NOLOCKSHIFT)) - (17 ("2" "%"" NOLOCKSHIFT)) - (22 ("9" ")" NOLOCKSHIFT)) - (28 (":" "*" NOLOCKSHIFT)) - (29 ("[" "{" NOLOCKSHIFT)) - (30 ("]" "}" NOLOCKSHIFT)) - (31 METADOWN . METAUP) - (33 ("ESC" "ESC" NOLOCKSHIFT)) - (36 CTRLDOWN . CTRLUP) - (43 (";" "+" NOLOCKSHIFT)) - (45 ("^" "~" NOLOCKSHIFT)) - (47 ("2,22" "2,62" NOLOCKSHIFT)) - (53 ("8" "(" NOLOCKSHIFT)) - (56 LOCKTOGGLE . IGNORE) - (58 ("@" "`" NOLOCKSHIFT)) - (59 ("-" "=" NOLOCKSHIFT)) - (61 ("^E" "^G" NOLOCKSHIFT)) - (62) - (63 ("2,4" "2,44" NOLOCKSHIFT)) - (64 ("2,14" 55 NOLOCKSHIFT)) - (65 (27 27 NOLOCKSHIFT)) - (66 ("2,107" "2,147" NOLOCKSHIFT)) - (67 ("2,104" "2,144" NOLOCKSHIFT)) - (69 ("2,13" "2,53" NOLOCKSHIFT)) - (70 ("2,20" 51 NOLOCKSHIFT)) - (71 (10 10 NOLOCKSHIFT)) - (72 (766 766 NOLOCKSHIFT)) - (73 ("2,11" "2,11" NOLOCKSHIFT)) - (74 ("2,12" "2,12" NOLOCKSHIFT)) - (75 ("^B" "^B" NOLOCKSHIFT)) - (80 ("2,111" "2,151" NOLOCKSHIFT)) - (81 ("2,14" 55 NOLOCKSHIFT)) - (82 (173 56 NOLOCKSHIFT)) - (83 ("2,15" 57 NOLOCKSHIFT)) - (84 (172 52 NOLOCKSHIFT)) - (85 ("2,16" 53 NOLOCKSHIFT)) - (86 (765 765 NOLOCKSHIFT)) - (87 (174 54 NOLOCKSHIFT)) - (88 (770 771 NOLOCKSHIFT)) - (90 ("2,3" "2,43" NOLOCKSHIFT)) - (91 ("2,10" "2,50" NOLOCKSHIFT)) - (92 ("2,1" "2,41" NOLOCKSHIFT)) - (93 ("2,24" "2,64" NOLOCKSHIFT)) - (96 IGNORE . IGNORE) - (98 ("2,21" 48 NOLOCKSHIFT)) - (99 ("2,102" "2,142" NOLOCKSHIFT)) - (101 ("2,106" "2,146" NOLOCKSHIFT)) - (102 IGNORE . IGNORE) - (103 (767 768 NOLOCKSHIFT)) - (104 ("2,110" "2,150" NOLOCKSHIFT)) - (105 ("\" "|" NOLOCKSHIFT)) - (106 ("2,113" "2,153" NOLOCKSHIFT)) - (107 ("2,114" "2,154" NOLOCKSHIFT)) - (108 ("2,115" "2,155" NOLOCKSHIFT)) - (109 (769 769 NOLOCKSHIFT)) - (110 ("2,53" "2,53" NOLOCKSHIFT)) - (111 ("1,111" "1,79" NOLOCKSHIFT)))) - -(RPAQQ \TOSHIBA-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) - (4 ("7" "'" NOLOCKSHIFT)) - (17 ("2" "%"" NOLOCKSHIFT)) - (53 ("8" "(" NOLOCKSHIFT)) - (22 ("9" ")" NOLOCKSHIFT)) - (8 ("0" "0" NOLOCKSHIFT)) - (10 ("-" "=" NOLOCKSHIFT)) - (59 ("^" "~" NOLOCKSHIFT)) - (45 ("\" "|" NOLOCKSHIFT)) - (58 ("@" "`" NOLOCKSHIFT)) - (29 ("[" "{" NOLOCKSHIFT)) - (105 ("]" "}" NOLOCKSHIFT)) - (43 (";" "+" NOLOCKSHIFT)) - (28 (":" "*" NOLOCKSHIFT)) - (15 (23 95 NOLOCKSHIFT)) - (13 (8 8 NOLOCKSHIFT)) - (86 METADOWN . METAUP) - (73 (530 562 NOLOCKSHIFT)) - (88 ("2,24" "2,64" NOLOCKSHIFT)) - (98 IGNORE . IGNORE) - (75 ("2,11" "2,11" NOLOCKSHIFT)) - (110 ("2,12" "2,12" NOLOCKSHIFT)) - (74 ("^B" "^B" NOLOCKSHIFT)) - (64 ("2,14" 55 NOLOCKSHIFT)) - (65 (173 56 NOLOCKSHIFT)) - (95 ("2,15" 57 NOLOCKSHIFT)) - (81 (172 52 NOLOCKSHIFT)) - (82 ("2,16" 53 NOLOCKSHIFT)) - (83 (174 54 NOLOCKSHIFT)) - (84 ("2,17" 49 NOLOCKSHIFT)) - (85 (175 50 NOLOCKSHIFT)) - (87 ("2,20" 51 NOLOCKSHIFT)) - (94 ("2,21" 48 NOLOCKSHIFT)) - (69 ("2,13" "2,53" NOLOCKSHIFT)) - (70 LOCKTOGGLE))) - -(RPAQQ KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL) - -(RPAQ? \KEYBOARD.META 256) - -(RPAQ? \MODIFIED.KEYACTIONS ) -(DECLARE%: EVAL@COMPILE - -(ADDTOVAR GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \MOUSECHORDTICKS - \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION - \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS - \DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS) -) - - - -(* ; "Key interpretation") - -(DEFINEQ - -(KEYACTION [LAMBDA (KEYNAME ACTIONS TABLE) (* ; "Edited 19-Nov-87 16:19 by Snow") (LET ((NUMB (OR (SMALLP KEYNAME) (\KEYNAMETONUMBER KEYNAME))) (TABLE (OR TABLE \CURRENTKEYACTION))) (OR (TYPE? KEYACTION TABLE) (\ILLEGAL.ARG TABLE)) (* ;  "Make sure he supplied a valid TABLE argument.") (CONS (\KEYACTION1 (\TRANSINDEX NUMB T) (AND ACTIONS (OR (CAR ACTIONS) 'IGNORE)) TABLE) (\KEYACTION1 (\TRANSINDEX NUMB NIL) (AND ACTIONS (OR (CDR ACTIONS) 'IGNORE)) TABLE]) - -(KEYACTIONTABLE [LAMBDA (OLD) (* ; "Edited 23-Mar-92 12:44 by jds") (* ;; "Create a fresh key action table (or copy OLD so it can be modified without danger). Returns a fresh keyaction table.") (COND (OLD (* ;; "He supplied an existing table; create a copy of it:") (OR (type? KEYACTION OLD) (\ILLEGAL.ARG OLD)) (* ;  "Make sure the argument IS a key action table.") (create KEYACTION copying OLD)) (T (* ;; "Create a completely fresh table, filled in from \ORIGKEYACTIONS, and the machine-specific exceptions:") (PROG1 (SETQ OLD (create KEYACTION)) (for X in (APPEND (COPY \ORIGKEYACTIONS) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS) do (KEYACTION (CAR X) (CDR X) OLD)))]) - -(KEYBOARDTYPE [LAMBDA NIL (* ; "Edited 6-Nov-95 15:35 by ") (* ; "Edited 17-Feb-95 14:36 by rmk:") (* ;  "Edited 16-Jun-92 11:03 by kaplan") (* ;; "Returns a symbol identifying the currently connected keyboard type. For now, infers it from the machine type, defaults to NIL (= unknown).") (LET ((MT (MACHINETYPE))) (SELECTQ MT (MAIKO (OR [CADR (SASSOC (L-CASE (UNIX-GETENV "LDEKBDTYPE")) '(("type3" SUN3) ("type4" SUN4) ("type5" SUN5] (MKATOM (U-CASE (UNIX-GETENV "LDEKBDTYPE"))) (AND (STREQUAL "dos" (UNIX-GETPARM "ARCH")) 'FULL-IBMPC))) ((DORADO DANDELION DOVE) MT) NIL]) - -(RESETKEYACTION [LAMBDA (TABLE FROM RESETINTERRUPTS) (* ; "Edited 19-Nov-87 16:55 by Snow") (* ;; "Resets the actions of key transitions in the keyaction table TABLE, copying in the actions from FROM. If RESETINTERRUPTS is true, also copies the interrupt-character settings from FROM.") (DECLARE (GLOBALVARS \DEFAULTKEYACTION)) (* ;; "do some type checking first.") (OR (type? KEYACTION TABLE) (\ILLEGAL.ARG TABLE)) (OR FROM (SETQ FROM \DEFAULTKEYACTION)) (OR (type? KEYACTION FROM) (\ILLEGAL.ARG TABLE)) (* ;; "do the resetting.") (\BLT (fetch (KEYACTION FLAGS) of TABLE) (fetch (KEYACTION FLAGS) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION FLAGS) of TABLE)) 1)) (\BLT (fetch (KEYACTION CODES) of TABLE) (fetch (KEYACTION CODES) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION CODES) of TABLE)) 1)) (\BLT (fetch (KEYACTION SHIFTCODES) of TABLE) (fetch (KEYACTION SHIFTCODES) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION SHIFTCODES) of TABLE)) 1)) [if RESETINTERRUPTS then (\BLT (fetch (KEYACTION ARMED) of TABLE) (fetch (KEYACTION ARMED) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION ARMED) of TABLE)) 1)) (replace (KEYACTION INTERRUPTLIST) of TABLE with (COPY (fetch (KEYACTION INTERRUPTLIST) of FROM] TABLE]) - -(\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS [LAMBDA NIL (* ; "Edited 18-Sep-90 22:36 by jds") (* ;;  "Return a list of machine-specific keyactions appropriate to the machine you're running on.") (* ;; "Also take account (on Maiko implementations) of whether we're running under X or not -- the CAPS-LOCK key works differently.") (SELECTC \MACHINETYPE (\DORADO \DORADOKEYACTIONS) (\DANDELION \DLIONKEYACTIONS) (\MAIKO (LET [(CAPS-LOCK-ACTIONS (COND ((EQUAL (UNIX-GETPARM "DISPLAY") "X") '((56 LOCKDOWN . LOCKUP) (72 LOCKDOWN . LOCKUP] (* ;; "If we're running under X windows, CAPS-LOCK-ACTIONS, appended to the normal keyactions, will reset the keyboard appropriately.") (COND ((EQUAL \SUN.TYPE3KEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage))) (APPEND \MAIKOKEYACTIONS CAPS-LOCK-ACTIONS)) ((EQUAL \SUN.TYPE4KEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage))) (APPEND \MAIKOKEYACTIONST4 CAPS-LOCK-ACTIONS)) ((EQUAL \SUN.JLEKEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage ))) \MAIKO-JLE-KEYACTIONS) ((EQUAL \TOSHIBA.JIS (LOGAND 7 (FETCH (IFPAGE DEVCONFIG) OF \InterfacePage ))) (* ; "Toshiba JIS") (APPEND \MAIKOKEYACTIONST4 \TOSHIBA-KEYACTIONS)) (T (* ; "default is type3") \MAIKOKEYACTIONS)))) (\DAYBREAK (* ;  "Moving to a daybreak. Need to distinguish among the various kinds of keyboard.") (* ;; "For now, we only distinguish between the office keyboards (1 = US, 2 = Euro, 3 = Japanese, 4 = ADM-3), and some yet-to-be-determined Lisp-keyboard number") (COND ((ILEQ (\DoveMisc.ReadKeyboardType) 4) (* ;  "It's an office keyboard. Set it up right!") (APPEND \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)) (T (* ;  "Lisp keyboard. Leave the Dove keyactions as they were.") \DOVEKEYACTIONS))) NIL]) - -(\KEYACTION1 [LAMBDA (TI ACTION TABLE) (* ; "Edited 4-Mar-92 13:59 by jds") (PROG1 (SELECTC (TRANSITIONFLAGS TABLE TI) (IGNORE.TF 'IGNORE) ((LIST LOCKSHIFT.TF NOLOCKSHIFT.TF) [LET (CODE) (LIST (CHECKFORDEADKEY (TRANSITIONCODE TABLE TI) TABLE TI NIL) (CHECKFORDEADKEY (TRANSITIONSHIFTCODE TABLE TI) TABLE TI T) (TRANSITIONALTGRCODE TABLE TI) (COND ((EQ LOCKSHIFT.TF (TRANSITIONFLAGS TABLE TI)) 'LOCKSHIFT) (T 'NOLOCKSHIFT]) (EVENT.TF 'EVENT) (CTRLDOWN.TF 'CTRLDOWN) (CTRLUP.TF 'CTRLUP) (DEADKEY.TF (LIST 'DEADKEY (TRANSITIONDEADLIST TABLE TI) (TRANSITIONDEADLIST TABLE TI T))) (1SHIFTDOWN.TF '1SHIFTDOWN) (1SHIFTUP.TF '1SHIFTUP) (2SHIFTDOWN.TF '2SHIFTDOWN) (2SHIFTUP.TF '2SHIFTUP) (LOCKDOWN.TF 'LOCKDOWN) (LOCKUP.TF 'LOCKUP) (LOCKTOGGLE.TF 'LOCKTOGGLE) (METADOWN.TF 'METADOWN) (METAUP.TF 'METAUP) (FONTUP.TF 'FONTUP) (FONTDOWN.TF 'FONTDOWN) (FONTTOGGLE.TF 'FONTTOGGLE) (USERMODE1UP.TF 'USERMODE1UP) (USERMODE1DOWN.TF 'USERMODE1DOWN) (USERMODE1TOGGLE.TF 'USERMODE1TOGGLE) (USERMODE2UP.TF 'USERMODE2UP) (USERMODE2DOWN.TF 'USERMODE2DOWN) (USERMODE2TOGGLE.TF 'USERMODE2TOGGLE) (USERMODE3UP.TF 'USERMODE3UP) (USERMODE3DOWN.TF 'USERMODE3DOWN) (USERMODE3TOGGLE.TF 'USERMODE3TOGGLE) (ALTGRUP.TF 'ALTGRUP) (ALTGRDOWN.TF 'ALTGRDOWN) (ALTGRTOGGLE.TF 'ALTGRTOGGLE) (SHOULDNT)) [SELECTQ ACTION ((NIL NOCHANGE)) (IGNORE (change (TRANSITIONFLAGS TABLE TI) IGNORE.TF)) (EVENT (change (TRANSITIONFLAGS TABLE TI) EVENT.TF)) (CTRLUP (change (TRANSITIONFLAGS TABLE TI) CTRLUP.TF)) (CTRLDOWN (change (TRANSITIONFLAGS TABLE TI) CTRLDOWN.TF)) (1SHIFTUP (change (TRANSITIONFLAGS TABLE TI) 1SHIFTUP.TF)) (1SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI) 1SHIFTDOWN.TF)) (2SHIFTUP (change (TRANSITIONFLAGS TABLE TI) 2SHIFTUP.TF)) (2SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI) 2SHIFTDOWN.TF)) (LOCKUP (change (TRANSITIONFLAGS TABLE TI) LOCKUP.TF)) (LOCKDOWN (change (TRANSITIONFLAGS TABLE TI) LOCKDOWN.TF)) (LOCKTOGGLE (change (TRANSITIONFLAGS TABLE TI) LOCKTOGGLE.TF)) (METAUP (change (TRANSITIONFLAGS TABLE TI) METAUP.TF)) (METADOWN (change (TRANSITIONFLAGS TABLE TI) METADOWN.TF)) (FONTUP (change (TRANSITIONFLAGS TABLE TI) FONTUP.TF)) (FONTDOWN (change (TRANSITIONFLAGS TABLE TI) FONTDOWN.TF)) (FONTTOGGLE (change (TRANSITIONFLAGS TABLE TI) FONTTOGGLE.TF)) (USERMODE1UP (change (TRANSITIONFLAGS TABLE TI) USERMODE1UP.TF)) (USERMODE1DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE1DOWN.TF)) (USERMODE1TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE1TOGGLE.TF)) (USERMODE2UP (change (TRANSITIONFLAGS TABLE TI) USERMODE2UP.TF)) (USERMODE2DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE2DOWN.TF)) (USERMODE2TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE2TOGGLE.TF)) (USERMODE3UP (change (TRANSITIONFLAGS TABLE TI) USERMODE3UP.TF)) (USERMODE3DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE3DOWN.TF)) (USERMODE3TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE3TOGGLE.TF)) (ALTGRUP (change (TRANSITIONFLAGS TABLE TI) ALTGRUP.TF)) (ALTGRDOWN (change (TRANSITIONFLAGS TABLE TI) ALTGRDOWN.TF)) (ALTGRTOGGLE (change (TRANSITIONFLAGS TABLE TI) ALTGRTOGGLE.TF)) (PROG (CODE SHIFTCODE ALTGRCODE ACT DEAD SHIFTDEAD) (COND ([AND [OR (AND (AND (LISTP (CAR (LISTP ACTION))) (EQ (CAAR (LISTP ACTION)) 'DEADKEY)) [SETQ DEAD (for PAIR in (CADAR (LISTP ACTION)) collect (* ;;  "Make sure we'll take string charcode specs in the deadkey list.") (CONS (OR (AND (\CHARCODEP (CAR PAIR)) (CAR PAIR)) (APPLY* (FUNCTION CHARCODE) (CAR PAIR))) (OR (AND (\CHARCODEP (CDR PAIR)) (CDR PAIR)) (APPLY* (FUNCTION CHARCODE) (CDR PAIR] (SETQ CODE 65535)) [\CHARCODEP (SETQ CODE (\GETCHARCODE (CAR (LISTP ACTION] (SETQ CODE (APPLY* (FUNCTION CHARCODE) (CAR (LISTP ACTION] [OR (AND (AND (LISTP (CADR (LISTP ACTION))) (EQ (CAADR (LISTP ACTION)) 'DEADKEY)) [SETQ SHIFTDEAD (for PAIR in (CADADR (LISTP ACTION)) collect (CONS (OR (AND (\CHARCODEP (CAR PAIR)) (CAR PAIR)) (APPLY* (FUNCTION CHARCODE) (CAR PAIR))) (OR (AND (\CHARCODEP (CDR PAIR)) (CDR PAIR)) (APPLY* (FUNCTION CHARCODE) (CDR PAIR] (SETQ SHIFTCODE 65535) (SETQ ACT (CDR ACTION))) [\CHARCODEP (SETQ SHIFTCODE (\GETCHARCODE (CAR (SETQ ACT (LISTP (CDR ACTION] (SETQ SHIFTCODE (APPLY* (FUNCTION CHARCODE) (CAR ACT] (OR (NULL (SETQ ACT (CDR ACT))) (LISTP ACT)) (SELECTQ (CAR ACT) ((LOCKSHIFT T) (change (TRANSITIONFLAGS TABLE TI) LOCKSHIFT.TF)) ((NOLOCKSHIFT NIL) (change (TRANSITIONFLAGS TABLE TI) NOLOCKSHIFT.TF)) (AND [OR [\CHARCODEP (SETQ ALTGRCODE (\GETCHARCODE (CAR ACT] (SETQ ALTGRCODE (APPLY* (FUNCTION CHARCODE) (CAR ACT] (OR (NULL (SETQ ACT (CDR ACT))) (LISTP ACT)) (SELECTQ (CAR ACT) ((LOCKSHIFT T) (change (TRANSITIONFLAGS TABLE TI) LOCKSHIFT.TF)) ((NOLOCKSHIFT NIL) (change (TRANSITIONFLAGS TABLE TI) NOLOCKSHIFT.TF)) NIL] (change (TRANSITIONCODE TABLE TI) CODE) (change (TRANSITIONSHIFTCODE TABLE TI) SHIFTCODE) (\RPLPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH TI 1) DEAD) (\RPLPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH (IPLUS \NKEYS \NKEYS TI) 1) SHIFTDEAD) (AND ALTGRCODE (change (TRANSITIONALTGRCODE TABLE TI) ALTGRCODE))) (T (\ILLEGAL.ARG ACTION])]) - -(KEYDOWNP [LAMBDA (KEYNAME) (* lmm "18-Apr-85 02:09") (* T if the indicated key is  instantaneously down.) (\NEWKEYDOWNP (\KEYNAMETONUMBER KEYNAME]) - -(KEYNUMBERP [LAMBDA (X) (* ; "Edited 16-Jan-96 13:16 by rmk") (AND (SMALLP X) (IGEQ X 0) (ILESSP X \NKEYS) X]) - -(\KEYNAMETONUMBER [LAMBDA (KEYNAME) (* rmk%: " 2-SEP-83 10:29") (DECLARE (GLOBALVARS \KEYNAMES)) (* The fast case is when KEYNAME is  lower-case) (for X N in \KEYNAMES as I from 0 when (EQMEMB KEYNAME X) do (RETURN I) finally (RETURN (OR (AND (NEQ KEYNAME (SETQ N (L-CASE KEYNAME))) (for Y in \KEYNAMES as I from 0 when (EQMEMB N Y) do (RETURN I))) (\ILLEGAL.ARG KEYNAME]) - -(MODIFY.KEYACTIONS [LAMBDA (KeyActions SaveCurrent?) (* ; "Edited 2-Feb-89 15:38 by GADENER") (PROG1 [if SaveCurrent? then (SETQ \MODIFIED.KEYACTIONS (for ITEM in KeyActions collect (CONS (CAR ITEM) (KEYACTION (CAR ITEM] [for action in KeyActions do (for table in '(\CURRENTKEYACTION \COMMANDKEYACTION) do (KEYACTION (CAR action) (CDR action) (EVAL table])]) - -(METASHIFT [LAMBDA FLG (* ; "Edited 19-Nov-87 16:59 by Snow") (* ;; "Sets interpretation of swat key to first arg, where T means meta-shift, NIL means original setting. Returns previous setting") (PROG ((METASTATUS '(METADOWN . METAUP)) OLDSETTING) [SETQ OLDSETTING (KEYACTION 'BLANK-BOTTOM (AND (IGREATERP FLG 0) (COND ((EQ (ARG FLG 1) T) METASTATUS) (T (OR (ARG FLG 1) (CDR (ASSOC 'BLANK-BOTTOM \ORIGKEYACTIONS] (RETURN (COND ((EQUAL OLDSETTING METASTATUS) T) (T OLDSETTING]) - -(SHIFTDOWNP [LAMBDA (SHIFT) (* lmm "18-Apr-85 01:07") (* Tells whether a given shift is  down) (SELECTQ SHIFT (LOCK (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)) (META (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE)) (SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE))) (1SHIFT (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)) (2SHIFT (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)) (SHIFTORLOCK (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))) (CTRL (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE)) (FONT (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE)) (USERMODE1 (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE)) (USERMODE2 (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE)) (USERMODE3 (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE)) (\ILLEGAL.ARG SHIFT]) -) - - - -(* ; "To support office style 1108 & 1186 keyboards") - -(DEFINEQ - -(SETUP.OFFICE.KEYBOARD [LAMBDA NIL (* jds " 8-Oct-85 16:27") (SELECTQ (MACHINETYPE) (DANDELION (MODIFY.KEYACTIONS \DLIONOSDKEYACTIONS)) (DOVE (MODIFY.KEYACTIONS \DOVEOSDKEYACTIONS)) NIL]) -) - -(DEFOPTIMIZER \KEYNAMETONUMBER (&REST X) - [LET [(CE (CONSTANTEXPRESSIONP (CAR X] - (COND - (CE (\KEYNAMETONUMBER (CAR CE))) - (T 'IGNOREMACRO]) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \TEMPCOPYTIMER MACRO ((X) - (PROGN (\BLT \MOUSETIMERTEMP (LOCF X) - WORDSPERCELL) - \MOUSETIMERTEMP))) -) - - - -(* ; "Don't copy this optimizer since it expands out to \getbasebit, but do exportit.") - -(DECLARE%: DONTCOPY -(* "FOLLOWING DEFINITIONS EXPORTED") -(DEFOPTIMIZER KEYDOWNP (KEYNAME) - `(\NEWKEYDOWNP (\KEYNAMETONUMBER ,KEYNAME))) - -(* "END EXPORTED DEFINITIONS") - -) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -[PUTPROPS XKEYDOWNP MACRO ((KEYNAME) - (KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME] - -[PUTPROPS KEYDOWNP1 MACRO (OPENLAMBDA (KEYNUMBER) - (DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 - \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5)) - (PROG NIL - (RETURN (EQ 0 (LOGAND (LRSH (LLSH 1 15) - (PROGN - (* (IMOD KEYNUMBER BITSPERWORD) - - GETD cause IMOD and BITSPERWORD not - exported to user) - (LOGAND KEYNUMBER 15))) - (\GETBASE (SELECTQ (PROGN - (* (FOLDLO KEYNUMBER BITSPERWORD) - GETD follows since FOLDLO and - BITSPERWORD not exported to user) - (LRSH KEYNUMBER - 4)) - (0 \EM.KBDAD0) - (1 \EM.KBDAD1) - (2 \EM.KBDAD2) - (3 \EM.KBDAD3) - (4 \EM.UTILIN) - (5 (OR \EM.KBDAD4 (RETURN))) - (6 (OR \EM.KBDAD5 (RETURN))) - (RETURN)) - 0] - -[PUTPROPS \NEWKEYDOWNP MACRO ((KEYNUMBER) - (EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER] -) - -(* "END EXPORTED DEFINITIONS") - - - - -(* ; "A raw keyboard device/stream") - -(DEFINEQ - -(\INIT.KEYBOARD.STREAM [LAMBDA NIL (* ; "Edited 4-Sep-87 10:25 by jds") (* ;; "Initialize the %"Keyboard%" device: Set up the FDEV and the prototype keyboard stream in their respective global variables.") (DECLARE (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)) [\DEFINEDEVICE 'KEYBOARD (SETQ \KEYBOARD.DEVICE (create FDEV DEVICENAME _ 'KEYBOARD CLOSEFILE _ (FUNCTION NILL) EVENTFN _ (FUNCTION \KEYBOARDEVENTFN) BIN _ (FUNCTION \GETKEY) PEEKBIN _ (FUNCTION \PEEKSYSBUF) READP _ (FUNCTION \SYSBUFP) EOFP _ (FUNCTION NILL) GETFILENAME _ (FUNCTION (LAMBDA (X MODE) (if (EQ MODE 'INPUT) then \KEYBOARD.STREAM] (SETQ \KEYBOARD.STREAM (create STREAM USERCLOSEABLE _ NIL USERVISIBLE _ NIL FULLFILENAME _ '{KEYBOARD} DEVICE _ \KEYBOARD.DEVICE ACCESS _ 'INPUT]) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\INIT.KEYBOARD.STREAM) -) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM) -) - -(* "END EXPORTED DEFINITIONS") - - - - -(* ; "Hook for a periodic interrupt") - -(DEFINEQ - -(\DOBUFFEREDTRANSITIONS [LAMBDA (\INTERRUPTABLE) (DECLARE (SPECVARS \INTERRUPTABLE)) (* ; "Edited 1-Feb-92 11:59 by jds") (SETQ \KEYBUFFERING 'INPROGRESS) (LET ((PENDINGINTERRUPT)) (DECLARE (SPECVARS PENDINGINTERRUPT)) (* ; "Used by \DECODETRANSITION") [bind R RPTR until (EQ 0 (SETQ R (fetch (RING READ) of \KEYBOARDEVENTQUEUE)) ) do (SETQ RPTR (\ADDBASE \KEYBOARDEVENTQUEUE R)) (* ; "get pointer to this event") (* ;  "handle simple keyboard words by calling \DOTRANSITIONS for each word") [COND ((NEQ (fetch (KEYBOARDEVENT W0) of RPTR) (fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE )) (\DOTRANSITIONS 0 (fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W0) of RPTR)) (replace (KEYBOARDEVENT W0) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W0) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W1) of RPTR) (fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE )) (\DOTRANSITIONS 16 (fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W1) of RPTR)) (replace (KEYBOARDEVENT W1) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W1) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W2) of RPTR) (fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE )) (\DOTRANSITIONS 32 (fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W2) of RPTR)) (replace (KEYBOARDEVENT W2) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W2) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W3) of RPTR) (fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE )) (\DOTRANSITIONS 48 (fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W3) of RPTR)) (replace (KEYBOARDEVENT W3) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W3) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W4) of RPTR) (fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE )) (\DOTRANSITIONS 80 (fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W4) of RPTR)) (replace (KEYBOARDEVENT W4) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W4) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W5) of RPTR) (fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE )) (\DOTRANSITIONS 96 (fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W5) of RPTR)) (replace (KEYBOARDEVENT W5) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W5) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT WU) of RPTR) (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE )) (\DOTRANSITIONS 64 (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT WU) of RPTR)) (replace (KEYBOARDEVENT WU) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT WU) of RPTR] (* ;;; "now remove event from queue") (COND ((EQ [replace (RING READ) of \KEYBOARDEVENTQUEUE with (COND ((IGEQ R \KEYBOARDEVENT.LAST) \KEYBOARDEVENT.FIRST) (T (IPLUS \KEYBOARDEVENT.SIZE R] (fetch (RING WRITE) of \KEYBOARDEVENTQUEUE )) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0] (PROGN (* ; "update dummy shift state") (replace DUMMY1SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 1SHIFT ) of \LASTKEYSTATE )) (replace DUMMY2SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 2SHIFT ) of \LASTKEYSTATE )) (replace DUMMYLOCK of \SHIFTSTATE with (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)) (replace DUMMYCTRL of \SHIFTSTATE with (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE)) (replace DUMMYMETA of \SHIFTSTATE with (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE)) (replace DUMMYFONT of \SHIFTSTATE with (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE)) (replace DUMMYUSERMODE1 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE)) (replace DUMMYUSERMODE2 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE)) (replace DUMMYUSERMODE3 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE)) (replace DUMMYALTGRAPH of \SHIFTSTATE with (fetch (KEYBOARDEVENT ALTGRAPH) of \LASTKEYSTATE)) (replace DUMMYDEADKEYPENDING of \SHIFTSTATE with (fetch ( KEYBOARDEVENT DEADKEYPENDING ) of \LASTKEYSTATE) )) (* ;; "Note: there is a window between the test of READ above and the setting of \KEYBUFFERING below where a keyboard transition can be ignored until the next transition causes \KEYBUFFERING to be set again") (COND ((NOT (OR PENDINGINTERRUPT \PENDINGINTERRUPT)) (* ;  "No interrupt noticed this time or on any previous invocation") (SETQ \KEYBUFFERING NIL)) ((NOT (\GETBASEPTR (\STKSCAN '\INTERRUPTABLE) 0)) (* ;  "We're not interruptable, so try again later") (SETQ \PENDINGINTERRUPT T) (SETQ \KEYBUFFERING NIL)) (T (SETQ \PENDINGINTERRUPT NIL) (SETQ \KEYBUFFERING NIL) (LET ((\INTERRUPTABLE T)) (INTERRUPTED]) - -(\TIMER.INTERRUPTFRAME [LAMBDA NIL (* lmm "22-Apr-85 09:47") (* place holder for periodic  interrupts) (if NIL then (APPLY* \PERIODIC.INTERRUPT) (if \PERIODIC.INTERRUPT then (SETUPTIMER (QUOTIENT (TIMES \PERIODIC.INTERRUPT.FREQUENCY \RCLKSECOND) 77) (LOCF (fetch DLMOUSETIMER of \MISCSTATS)) 'TICKS) (SETQ \TIMER.INTERRUPT.PENDING T]) - -(\PERIODIC.INTERRUPTFRAME [LAMBDA NIL (DECLARE (GLOBALVARS \PERIODIC.INTERRUPT)) (* lmm "16-Jul-85 16:22") (LET ((FN \PERIODIC.INTERRUPT)) (AND FN (SPREADAPPLY* FN]) -) - -(RPAQ? \KEYBUFFERING ) - -(RPAQ? \PERIODIC.INTERRUPT ) - -(RPAQ? \TIMER.INTERRUPT.PENDING ) - -(RPAQ? \PERIODIC.INTERRUPT.FREQUENCY 77) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(LOCALVARS . T) -) - - - -(* ; "cursor and mouse related functions.") - -(DEFINEQ - -(\HARDCURSORUP [LAMBDA (NEWCURSOR INVERTFLG) (* ; "Edited 2-Jan-2000 18:10 by kaplan") (* ;  "version of \CURSORUP that knows about the possibility of the cursor being on the color screen.") (PROG (IMAGE) (SETQ \SOFTCURSORP NIL) (SETQ \CURRENTCURSOR NEWCURSOR) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR)) [COND ((NOT (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE) (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION))) (\CURSORBITSPERPIXEL NEWCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION )) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR] (BITBLT IMAGE 0 0 CursorBitMap 0 (IDIFFERENCE HARDCURSORHEIGHT (fetch (BITMAP BITMAPHEIGHT ) of IMAGE)) HARDCURSORWIDTH HARDCURSORHEIGHT (COND (INVERTFLG 'INVERT) (T 'INPUT)) 'REPLACE) (SELECTC \MACHINETYPE (\DAYBREAK (\DoveDisplay.SetCursorShape CursorBitMap)) (\MAIKO (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR))) NIL]) - -(\HARDCURSORPOSITION [LAMBDA (XPOS YPOS) (* kbr%: "13-Jun-85 21:24") (* sets cursor position, adjusts for hotspot and tty region limits.  XPOS and YPOS are the screen coordinates of the hotspot location.) (DECLARE (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURSORDESTWIDTH \CURSORDESTHEIGHT)) (* YPOS is reflected around CURSORYMAX because the screen has  (0,0) as the upper left corner. *) (SETQ YPOS (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) YPOS)) (* Clip coordinates *) (SETQ XPOS (UNSIGNED (IDIFFERENCE (COND ((ILESSP XPOS 0) 0) ((IGEQ XPOS \CURSORDESTWIDTH) (SUB1 \CURSORDESTWIDTH)) (T XPOS)) \CURSORHOTSPOTX) BITSPERWORD)) (SETQ YPOS (UNSIGNED (IDIFFERENCE (COND ((ILESSP YPOS 0) 0) ((IGEQ YPOS \CURSORDESTHEIGHT) (SUB1 \CURSORDESTHEIGHT)) (T YPOS)) \CURSORHOTSPOTY) BITSPERWORD)) [COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) (COND ((IGREATERP YPOS 32767) (SETQ YPOS 0))) (COND ((IGREATERP XPOS 32767) (SETQ XPOS 0] (\SETMOUSEXY XPOS YPOS) (PROGN (* change the cursor position too so that GETMOUSESTATE will get the correct  values if it is called before the next 60 cycle interrupt.) (\PUTBASE \EM.CURSORX 0 XPOS) (\PUTBASE \EM.CURSORY 0 YPOS)) NIL]) - -(\HARDCURSORDOWN [LAMBDA NIL (* kbr%: "23-Apr-85 18:26") (\CLEARBM (CURSORBITMAP]) -) -(DEFINEQ - -(CURSOR.INIT [LAMBDA NIL (* kbr%: "23-Jan-86 17:34") (PROG (DESTBPL) (* Assorted globals for doing the  color cursor. *) (SETQ \CURSORDESTINATION ScreenBitMap) (SETQ \SOFTCURSORUPBM NIL) (SETQ \SOFTCURSORDOWNBM NIL) (SETQ \CURSORDESTLINE 0) (SETQ \CURSORDESTLINEBASE (fetch (BITMAP BITMAPBASE) of ScreenBitMap)) (SETQ \CURSORDESTWIDTH (fetch (BITMAP BITMAPWIDTH) of ScreenBitMap)) (SETQ \CURSORDESTHEIGHT (fetch (BITMAP BITMAPHEIGHT) of ScreenBitMap)) (SETQ \CURSORDESTRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of ScreenBitMap)) (* Initialize PILOTBBTs.  *) (SETQ DESTBPL (UNFOLD \CURSORDESTRASTERWIDTH BITSPERWORD)) (* These PILOTBBTs are the mixing areas for forming the color cursor image.  *) (* Does SCREEN to DOWNBM via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT1 (create PILOTBBT PBTSOURCEBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT1) (* Does DOWNBM to UPBM via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT2 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT2) (* Does MASK to UPBM via INPUT,  ERASE. *) (SETQ \SOFTCURSORBBT3 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 1 PBTOPERATION _ 1)) (\LOCKCELL \SOFTCURSORBBT3) (* Does IMAGE to UPBM via INPUT,  PAINT. *) (SETQ \SOFTCURSORBBT4 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 2)) (\LOCKCELL \SOFTCURSORBBT4) (* Does UPBM to SCREEN via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT5 (create PILOTBBT PBTDESTBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT5) (* Does DOWNBM to SCREEN via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT6 (create PILOTBBT PBTDESTBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT6) (* Lock things down.  *) ]) - -(\CURSORDESTINATION [LAMBDA (DESTINATION) (* kbr%: " 2-Sep-85 20:13") (* Change DESTINATION of  \CURRENTCURSOR, assuming it is down.  *) (PROG (DESTBPL) (COND ((NOT (EQ DESTINATION \CURSORDESTINATION)) (UNINTERRUPTABLY [COND ((NOT (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch (CURSOR CUIMAGE) of \CURRENTCURSOR )) (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATION))) (\CURSORBITSPERPIXEL \CURRENTCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATION] (\SETMOUSEXY 0 0) (\PUTBASE \EM.CURSORX 0 0) (\PUTBASE \EM.CURSORY 0 0) (SETQ \CURSORDESTLINE 0) (SETQ.NOREF \CURSORDESTLINEBASE (fetch (BITMAP BITMAPBASE) of DESTINATION)) (SETQ \CURSORDESTWIDTH (fetch (BITMAP BITMAPWIDTH) of DESTINATION)) (SETQ \CURSORDESTHEIGHT (fetch (BITMAP BITMAPHEIGHT) of DESTINATION)) (SETQ \CURSORDESTRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of DESTINATION )) (SETQ DESTBPL (UNFOLD \CURSORDESTRASTERWIDTH BITSPERWORD)) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT1 with DESTBPL) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT5 with DESTBPL) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT6 with DESTBPL) (SETQ \CURSORDESTINATION DESTINATION))]) - -(\SOFTCURSORUP [LAMBDA (NEWCURSOR) (* kbr%: " 2-Sep-85 20:15") (* Put soft NEWCURSOR up, assuming soft cursor is down.  *) (PROG (IMAGE MASK WIDTH BWIDTH HEIGHT CURSORBITSPERPIXEL CURSORBPL UPBMBASE DOWNBMBASE) (* Get cursor IMAGE & MASK.  *) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR)) (SETQ MASK (fetch (CURSOR CUMASK) of NEWCURSOR)) (SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of IMAGE)) (SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of IMAGE)) (SETQ CURSORBITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE)) (* Create new UPBM & DOWNBM caches  if necessary. *) (COND ((NOT (AND (type? BITMAP \SOFTCURSORUPBM) (EQ (fetch (BITMAP BITMAPWIDTH) of \SOFTCURSORUPBM) WIDTH) (EQ (fetch (BITMAP BITMAPHEIGHT) of \SOFTCURSORUPBM) HEIGHT) (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of \SOFTCURSORUPBM) CURSORBITSPERPIXEL))) (SETQ \SOFTCURSORWIDTH WIDTH) (SETQ \SOFTCURSORHEIGHT HEIGHT) (SETQ \SOFTCURSORUPBM (BITMAPCREATE WIDTH HEIGHT CURSORBITSPERPIXEL)) (SETQ \SOFTCURSORDOWNBM (BITMAPCREATE WIDTH HEIGHT CURSORBITSPERPIXEL)) (SETQ UPBMBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORUPBM)) (\TEMPLOCKPAGES UPBMBASE 1) (SETQ DOWNBMBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORDOWNBM)) (\TEMPLOCKPAGES DOWNBMBASE 1) (SETQ CURSORBPL (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH) of IMAGE) BITSPERWORD)) (SETQ BWIDTH (ITIMES (fetch (BITMAP BITMAPWIDTH) of IMAGE) (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE))) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT1 with CURSORBPL) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT2 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT2 with CURSORBPL) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT2 with DOWNBMBASE) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT2 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT2 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT2 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT3 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT3 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT3 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT3 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT3 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT4 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT4 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT4 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT4 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT4 with HEIGHT) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT5 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT6 with CURSORBPL))) (* Change PILOTBBTs.  *) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT3 with (fetch (BITMAP BITMAPBASE ) of MASK)) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT4 with (fetch (BITMAP BITMAPBASE ) of IMAGE)) (* Put up new \CURRENTCURSOR.  *) (SETQ \CURRENTCURSOR NEWCURSOR) (\TEMPLOCKPAGES \CURRENTCURSOR 1) (SETQ \SOFTCURSORP T) (\SOFTCURSORUPCURRENT]) - -(\SOFTCURSORUPCURRENT [LAMBDA NIL (* kbr%: "18-Aug-85 15:09") (* Put soft \CURRENTCURSOR up, assuming soft cursor is down.  *) (PROG (DISPINTERRUPT X Y XBASE YBASE WIDTH HEIGHT BITSPERPIXEL MINUSDESTRASTERWIDTH DEST DESTBIT SOURCEOFFSET UPBMSOURCE DOWNBMSOURCE SOURCEBIT) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) (SETQ \SOFTCURSORUPP T) (* Roughly, we want to  (BITBLT CURSOR XBASE YBASE SCREEN X  Y WIDTH HEIGHT) *) (SETQ X (SIGNED (\GETBASE \EM.MOUSEX 0) BITSPERWORD)) (SETQ Y (SIGNED (\GETBASE \EM.MOUSEY 0) BITSPERWORD)) (SETQ XBASE 0) (SETQ YBASE 0) (SETQ WIDTH \SOFTCURSORWIDTH) (SETQ HEIGHT \SOFTCURSORHEIGHT) (* Clip off screen parts of cursor.  *) [COND ((IGREATERP 0 X) (* Some of cursor is to left of  screen. *) (SETQ XBASE (IMINUS X)) (SETQ WIDTH (IDIFFERENCE WIDTH XBASE)) (SETQ X 0)) ((IGREATERP (IPLUS X WIDTH) \CURSORDESTWIDTH) (* Some of cursor is to right of  screen. *) (SETQ WIDTH (IDIFFERENCE \CURSORDESTWIDTH X] (COND ((ILESSP WIDTH 0) (GO EXIT))) [COND ((IGREATERP 0 Y) (* Some of cursor is to above of  screen. *) (SETQ YBASE (IMINUS Y)) (SETQ HEIGHT (IDIFFERENCE HEIGHT YBASE)) (SETQ Y 0)) ((IGREATERP (IPLUS Y HEIGHT) \CURSORDESTHEIGHT) (* Some of cursor is to below of  screen. *) (SETQ HEIGHT (IDIFFERENCE \CURSORDESTHEIGHT Y] (COND ((ILESSP HEIGHT 0) (GO EXIT))) (* These loops reset \CURSORDESTLINEBASE while avoiding large number  arithmetic. *) [COND [(IGREATERP \CURSORDESTLINE Y) (SETQ MINUSDESTRASTERWIDTH (IMINUS \CURSORDESTRASTERWIDTH)) (until (EQ \CURSORDESTLINE Y) do (SETQ \CURSORDESTLINE (SUB1 \CURSORDESTLINE)) (SETQ.NOREF \CURSORDESTLINEBASE (\ADDBASE \CURSORDESTLINEBASE MINUSDESTRASTERWIDTH] ((ILESSP \CURSORDESTLINE Y) (until (EQ \CURSORDESTLINE Y) do (SETQ \CURSORDESTLINE (ADD1 \CURSORDESTLINE)) (SETQ.NOREF \CURSORDESTLINEBASE (\ADDBASE \CURSORDESTLINEBASE \CURSORDESTRASTERWIDTH] (* Reset PILOTBBTs.  *) (SETQ BITSPERPIXEL (fetch (CURSOR CUBITSPERPIXEL) of \CURRENTCURSOR)) (SETQ X (ITIMES BITSPERPIXEL X)) (SETQ XBASE (ITIMES BITSPERPIXEL XBASE)) (SETQ WIDTH (ITIMES BITSPERPIXEL WIDTH)) (SETQ DEST \CURSORDESTLINEBASE) (SETQ DESTBIT X) (SETQ SOURCEOFFSET (ITIMES YBASE (fetch (BITMAP BITMAPRASTERWIDTH) of \SOFTCURSORUPBM ))) (SETQ UPBMSOURCE (\ADDBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORUPBM) SOURCEOFFSET)) (SETQ DOWNBMSOURCE (\ADDBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORDOWNBM) SOURCEOFFSET)) (SETQ SOURCEBIT XBASE) (* TBW%: Most of these fields only need to be set if we are clipping this  time or the previous time we put the cursor up.  *) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT1 with DOWNBMSOURCE) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT1 with SOURCEBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT1 with DEST) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT1 with DESTBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT1 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT1 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT5 with DEST) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT5 with DESTBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT5 with UPBMSOURCE) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT5 with SOURCEBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT5 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT5 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT6 with DEST) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT6 with DESTBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT6 with DOWNBMSOURCE) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT6 with SOURCEBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT6 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT6 with HEIGHT) (* Save background behind cursor.  *) (\PILOTBITBLT \SOFTCURSORBBT1 0) (* Compute cursor appearance.  UPBM = (OR IMAGE (AND DOWNBM  (NOT MASK))) *) (\PILOTBITBLT \SOFTCURSORBBT2 0) (\PILOTBITBLT \SOFTCURSORBBT3 0) (\PILOTBITBLT \SOFTCURSORBBT4 0) (* Put color cursor up.  *) (\SOFTCURSORPILOTBITBLT \SOFTCURSORBBT5 0) EXIT (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) - -(\SOFTCURSORPOSITION [LAMBDA (X Y) (* kbr%: "18-Aug-85 14:50") (* Move soft cursor.  *) (PROG (DISPINTERRUPT) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) [COND ((OR (NOT (EQ (\GETBASE \EM.CURSORX 0) X)) (NOT (EQ (\GETBASE \EM.CURSORY 0) Y))) (COND (\SOFTCURSORUPP (\SOFTCURSORDOWN) (\SOFTCURSORUPCURRENT] (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) - -(\SOFTCURSORDOWN [LAMBDA NIL (* kbr%: " 6-Jul-85 00:09") (* Take COLOR cursor down.  *) (PROG (DISPINTERRUPT) (* \SOFTCURSORUPP must be set to NIL  before BITBLTing. *) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) (SETQ \SOFTCURSORUPP NIL) (\SOFTCURSORPILOTBITBLT \SOFTCURSORBBT6 0) (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) - -(CURSORPROP [LAMBDA X (* kbr%: "11-Jan-86 20:03") (COND ((IGREATERP X 2) (PUTCURSORPROP (ARG X 1) (ARG X 2) (ARG X 3))) ((EQ X 2) (GETCURSORPROP (ARG X 1) (ARG X 2))) (T (\ILLEGAL.ARG NIL]) - -(GETCURSORPROP [LAMBDA (CURSOR PROP) (* kbr%: "26-Apr-85 11:18") (LISTGET (fetch (CURSOR CUDATA) of CURSOR) PROP]) - -(PUTCURSORPROP [LAMBDA (CURSOR PROP VALUE) (* kbr%: "26-Apr-85 11:18") (PROG (OLDDATA OLDVALUE) (SETQ OLDDATA (fetch (CURSOR CUDATA) of CURSOR)) [COND [OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP)) (COND (VALUE (LISTPUT OLDDATA PROP VALUE)) (OLDVALUE (COND [(EQ (CAR OLDDATA) PROP) (replace (CURSOR CUDATA) of CURSOR with (CDDR (fetch (CURSOR CUDATA) of CURSOR] (T (FOR TAIL ON (CDR OLDDATA) BY (CDDR TAIL) WHEN (EQ (CADR TAIL) PROP) DO (FRPLACD TAIL (CDDDR TAIL)) (RETURN] (VALUE (replace (CURSOR CUDATA) of CURSOR with (LIST PROP VALUE] (RETURN OLDVALUE]) - -(\CURSORBITSPERPIXEL [LAMBDA (CURSOR NEWBITSPERPIXEL) (* kbr%: "12-May-85 17:15") (* Swap in NEWBITSPERPIXEL IMAGE and MASK, creating them if necessary.  *) (PROG (OLDBITSPERPIXEL OLDIMAGE OLDMASK WHITE BLACK NEWIMAGE NEWMASK) (SETQ OLDBITSPERPIXEL (fetch (CURSOR CUBITSPERPIXEL) of CURSOR)) (COND ((EQ OLDBITSPERPIXEL NEWBITSPERPIXEL) (RETURN))) (* Save OLDIMAGE and OLDMASK.  *) (SETQ OLDIMAGE (fetch (CURSOR CUIMAGE) of CURSOR)) (SETQ OLDMASK (fetch (CURSOR CUMASK) of CURSOR)) (CURSORPROP CURSOR (\CURSORIMAGEPROPNAME OLDBITSPERPIXEL) OLDIMAGE) (CURSORPROP CURSOR (\CURSORMASKPROPNAME OLDBITSPERPIXEL) OLDMASK) (* Unsave NEWIMAGE and NEWMASK if possible, otherwise create them.  *) [COND [(SETQ NEWIMAGE (CURSORPROP CURSOR (\CURSORIMAGEPROPNAME NEWBITSPERPIXEL))) (* Use cached NEWIMAGE & NEWMASK.  *) (SETQ NEWMASK (CURSORPROP CURSOR (\CURSORMASKPROPNAME NEWBITSPERPIXEL] (T (* Create NEWIMAGE & NEWMASK.  *) (SETQ WHITE (MASK.1'S 0 NEWBITSPERPIXEL)) (SETQ BLACK 0) (SETQ NEWIMAGE (COLORIZEBITMAP (CURSORPROP CURSOR 'IMAGE1) BLACK WHITE NEWBITSPERPIXEL)) (SETQ NEWMASK (COLORIZEBITMAP (CURSORPROP CURSOR 'MASK1) BLACK WHITE NEWBITSPERPIXEL] (replace (CURSOR CUIMAGE) of CURSOR with NEWIMAGE) (replace (CURSOR CUMASK) of CURSOR with NEWMASK]) - -(\CURSORIMAGEPROPNAME [LAMBDA (BITSPERPIXEL) (* kbr%: "26-Apr-85 11:18") (SELECTQ BITSPERPIXEL (1 'IMAGE1) (4 'IMAGE4) (8 'IMAGE8) (SHOULDNT]) - -(\CURSORMASKPROPNAME [LAMBDA (BITSPERPIXEL) (* kbr%: "26-Apr-85 11:18") (SELECTQ BITSPERPIXEL (1 'MASK1) (4 'MASK4) (8 'MASK8) (SHOULDNT]) -) -(DEFINEQ - -(CURSORCREATE [LAMBDA (IMAGE MASK HOTSPOTX HOTSPOTY DATA) (* ; "Edited 10-Jul-92 16:32 by cat") (* ; "Edited 31-Jul-87 10:01 by jds") (* ;; "creates a cursor from a bitmap. HOTSPOTX and HOTSPOTY specify the hotspot.") (* ;; "INVARIANTS: the hot spot X and Y must be in the range 0..(width - 1) and 0..(height - 1), respectively.") (PROG (CURSOR) (COND ((OR (FIXP MASK) (POSITIONP MASK)) (* ;; "If Mask is a fixp then we presume this is the old arg list (bitmap x y). the cursor filepkgtype has been changed to write the new arg list. The other is provided for (dubious) compatibility") (SETQ HOTSPOTY HOTSPOTX) (SETQ HOTSPOTX MASK) (SETQ MASK NIL))) (* ;; "Make sure that the image and mask bitmaps are no larger than the hardware cursor, i.e. 16x16 bits [AR 8916 7/31/87]:") (COND ((OR (IGREATERP (BITMAPWIDTH IMAGE) 16) (IGREATERP (BITMAPHEIGHT IMAGE) 16)) (* ; "IMAGE is too big.") (\ILLEGAL.ARG IMAGE)) ((NOT MASK) (* ; "No mask, so it's OK") ) ((OR (IGREATERP (BITMAPWIDTH MASK) 16) (IGREATERP (BITMAPHEIGHT MASK) 16)) (* ; "MASK is too big.") (\ILLEGAL.ARG MASK))) [COND ((POSITIONP HOTSPOTX) (* ;;  "The hot spot can be specified as a position in one arg, rather than X and Y in two:") (SETQ HOTSPOTY (fetch (POSITION YCOORD) of HOTSPOTX)) (SETQ HOTSPOTX (fetch (POSITION XCOORD) of HOTSPOTX] (SETQ CURSOR (create CURSOR CUIMAGE _ IMAGE CUMASK _ (OR MASK IMAGE) CUHOTSPOTX _ (IMAX 0 (IMIN (SUB1 (BITMAPWIDTH IMAGE)) (OR (FIXP HOTSPOTX) 0))) CUHOTSPOTY _ [IMAX 0 (IMIN (SUB1 (BITMAPHEIGHT IMAGE)) (OR (FIXP HOTSPOTY) (SUB1 (BITMAPHEIGHT IMAGE] CUDATA _ DATA)) (RETURN CURSOR]) - -(CURSOR [LAMBDA (NEWCURSOR INVERTFLG) (* ; "Edited 24-Mar-87 18:30 by jds") (* ;; "Installs NEWCURSOR as the cursor and returns the old cursor state. If INVERTFLG is non-NIL, the cursor image is inverted during installation. If NEWCURSOR is NIL, just returns the current cursor state.") (DECLARE (GLOBALVARS DEFAULTCURSOR \SOFTCURSORP)) (PROG (OLDCURSOR) (SETQ OLDCURSOR \CURRENTCURSOR) (COND ((EQ NEWCURSOR T) (* ;  "If NEWCURSOR is T, use the system default cursor.") (SETQ NEWCURSOR DEFAULTCURSOR))) (COND [(\CURSOR-VALID-P NEWCURSOR \SOFTCURSORP) (* ;  "Only install the cursor if it's a real, valid one.") (\CURSORDOWN) (\CURSORUP NEWCURSOR INVERTFLG) (* ;  "set after adjustment to avoid confusion about hotspot during adjustment.") (SETQ \CURSORHOTSPOTX (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR)) (SETQ \CURSORHOTSPOTY (IDIFFERENCE (SUB1 (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR))) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR] (NEWCURSOR (* ; "NEWCURSOR = NIL means just return the old one, so only error if one got specified that wasn't valid.") (\ILLEGAL.ARG NEWCURSOR))) (RETURN OLDCURSOR]) - -(\CURSOR-VALID-P [LAMBDA (CURSOR SOFT?) (* ; "Edited 25-Mar-87 09:41 by jds") (* ;; "It returns T if CURSOR is a valid cursor. Validity depends on whether it's meant to be displayed using the cursor hardware or the cursor software.") (* ;; "This is really wed to the D-machine display architecture. ") (AND (CURSORP CURSOR) (COND (SOFT? T) (T (LET ((IMAGE (fetch (CURSOR CUIMAGE) of CURSOR)) (HOTSPOT-X (fetch (CURSOR CUHOTSPOTX) of CURSOR)) (HOTSPOT-Y (fetch (CURSOR CUHOTSPOTY) of CURSOR))) (* ;; "The bitmap must be <= 16x16, and the hot spot must be within the cursor if we're using hardware cursor.") (AND (>= 16 (BITMAPWIDTH IMAGE)) (>= 16 (BITMAPHEIGHT IMAGE)) (<= 0 HOTSPOT-X) (< HOTSPOT-X 16) (<= 0 HOTSPOT-Y) (< HOTSPOT-Y 16]) - -(\CURSORUP [LAMBDA (NEWCURSOR INVERTFLG) (* kbr%: "18-Aug-85 14:38") (UNINTERRUPTABLY (\CURSORBITSPERPIXEL NEWCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION )) (COND ((AND (EQ (fetch (CURSOR CUIMAGE) of NEWCURSOR) (fetch (CURSOR CUMASK) of NEWCURSOR)) (ILEQ (fetch (BITMAP BITMAPWIDTH) of (fetch (CURSOR CUIMAGE) of NEWCURSOR)) HARDCURSORWIDTH) (ILEQ (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR)) HARDCURSORHEIGHT) (EQ \CURSORDESTINATION ScreenBitMap)) (\HARDCURSORUP NEWCURSOR INVERTFLG)) (T (\SOFTCURSORUP NEWCURSOR))) (ADJUSTCURSORPOSITION (IDIFFERENCE \CURSORHOTSPOTX (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR)) (IDIFFERENCE (IDIFFERENCE (SUB1 (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR))) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR)) \CURSORHOTSPOTY)))]) - -(\CURSORPOSITION [LAMBDA (XPOS YPOS) (* ; "Edited 19-Mar-98 14:41 by jds") (* sets cursor position, adjusts for hotspot and tty region limits.  XPOS and YPOS are the screen coordinates of the hotspot location.) (DECLARE (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURSORDESTWIDTH \CURSORDESTHEIGHT)) (* YPOS is reflected around CURSORYMAX because the screen has  (0,0) as the upper left corner. *) (SETQ YPOS (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) YPOS)) (* Clip coordinates *) (SETQ XPOS (UNSIGNED (IDIFFERENCE (COND (NIL (* ;; "Removed 2000/1/3 JDS so mousr cursors work.") (ILESSP XPOS 0) 0) ((IGEQ XPOS \CURSORDESTWIDTH) (SUB1 \CURSORDESTWIDTH)) (T XPOS)) \CURSORHOTSPOTX) BITSPERWORD)) (SETQ YPOS (UNSIGNED (IDIFFERENCE (COND (NIL (ILESSP YPOS 0) 0) ((IGEQ YPOS \CURSORDESTHEIGHT) (SUB1 \CURSORDESTHEIGHT)) (T YPOS)) \CURSORHOTSPOTY) BITSPERWORD)) [COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) (COND ((IGREATERP YPOS 32767) (SETQ YPOS 0))) (COND ((IGREATERP XPOS 32767) (SETQ XPOS 0] (\SETMOUSEXY XPOS YPOS) (COND (\SOFTCURSORP (\SOFTCURSORPOSITION XPOS YPOS))) [PROGN (* change the cursor position too so that GETMOUSESTATE will get the correct  values if it is called before the next 60 cycle interrupt.) (\PUTBASE \EM.CURSORX 0 XPOS) (\PUTBASE \EM.CURSORY 0 YPOS) (COND ((EQ \MACHINETYPE \DAYBREAK) (* Need to notify DAYBREAK IOP to  move cursor. *) (\DoveDisplay.SetCursorPosition XPOS YPOS] NIL]) - -(\CURSORDOWN [LAMBDA NIL (* kbr%: "12-Jun-85 17:21") (UNINTERRUPTABLY (COND (\SOFTCURSORP (\SOFTCURSORDOWN)) (T (\HARDCURSORDOWN))))]) - -(ADJUSTCURSORPOSITION [LAMBDA (DELTAX DELTAY) (* kbr%: " 6-Jan-86 11:55") (COND [(POSITIONP DELTAX) (\CURSORPOSITION (IPLUS (fetch (POSITION XCOORD) of DELTAX) (\XMOUSECOORD)) (IPLUS (fetch (POSITION YCOORD) of DELTAX) (\YMOUSECOORD] (T (\CURSORPOSITION (IPLUS (OR DELTAX 0) (\XMOUSECOORD)) (IPLUS (OR DELTAY 0) (\YMOUSECOORD]) - -(CURSORPOSITION [LAMBDA (NEWPOSITION DISPLAYSTREAM OLDPOSITION) (* kbr%: "13-Feb-86 15:53") (PROG (DD) (SETQ DD (\GETDISPLAYDATA DISPLAYSTREAM)) (OR (type? POSITION OLDPOSITION) (SETQ OLDPOSITION (create POSITION))) (freplace (POSITION XCOORD) of OLDPOSITION with (\DSPUNTRANSFORMX (\XMOUSECOORD ) DD)) (freplace (POSITION YCOORD) of OLDPOSITION with (\DSPUNTRANSFORMY (\YMOUSECOORD ) DD)) (COND ((type? POSITION NEWPOSITION) (\CURSORPOSITION (\DSPTRANSFORMX (fetch (POSITION XCOORD) of NEWPOSITION) DD) (\DSPTRANSFORMY (fetch (POSITION YCOORD) of NEWPOSITION) DD))) ((type? SCREENPOSITION NEWPOSITION) (CURSORSCREEN (fetch (SCREENPOSITION SCREEN) of NEWPOSITION) (fetch (SCREENPOSITION XCOORD) of NEWPOSITION) (fetch (SCREENPOSITION YCOORD) of NEWPOSITION))) (NEWPOSITION (\ILLEGAL.ARG NEWPOSITION))) (RETURN OLDPOSITION]) - -(CURSORSCREEN [LAMBDA (SCREEN XCOORD YCOORD) (* gbn%: "25-Jan-86 16:53") (* * sets up SCREEN to be the current screen, XCOORD %, YCOORD is initial pos  of cursor on SCREEN) (COND ((NULL XCOORD) (SETQ XCOORD 0))) (COND ((NULL YCOORD) (SETQ YCOORD 0))) (PROG (DESTINATION) (SETQ DESTINATION (fetch (SCREEN SCDESTINATION) of SCREEN)) (\CURSORDOWN) (SETQ \CURSORSCREEN SCREEN) (\CURSORDESTINATION DESTINATION) (\CURSORUP \CURRENTCURSOR) (\CURSORPOSITION XCOORD YCOORD]) - -(CURSOREXIT [LAMBDA NIL (* gbn%: "25-Jan-86 16:52") (* * called when cursor moves off the screen edge) (DECLARE (GLOBALVARS LASTSCREEN LASTMOUSEX LASTMOUSEY)) (PROG (SCREEN XCOORD YCOORD SCREEN2 XCOORD2 YCOORD2) (SETQ SCREEN LASTSCREEN) (SETQ XCOORD LASTMOUSEX) (SETQ YCOORD LASTMOUSEY) (SETQ SCREEN2 (COND ((EQ SCREEN \MAINSCREEN) \COLORSCREEN) (T \MAINSCREEN))) (* generalize for more than two  screens (or alternate physical  arrangement of screens.)) (COND ((EQ XCOORD 0) (SETQ XCOORD2 (IDIFFERENCE (fetch (SCREEN SCWIDTH) of SCREEN2) 2))) ((EQ XCOORD (SUB1 (fetch (SCREEN SCWIDTH) of SCREEN))) (SETQ XCOORD2 1)) (T (RETURN))) [SETQ YCOORD2 (IQUOTIENT (ITIMES YCOORD (SUB1 (fetch (SCREEN SCHEIGHT) of SCREEN2)) ) (SUB1 (fetch (SCREEN SCHEIGHT) of SCREEN] (CURSORSCREEN SCREEN2 XCOORD2 YCOORD2]) - -(FLIPCURSOR - [LAMBDA NIL (* ; "Edited 24-Apr-88 00:04 by MASINTER") - (PROG (ADDR) - (COND - ((NOT \SOFTCURSORP) - (SETQ ADDR \EM.CURSORBITMAP) - (FRPTQ HARDCURSORHEIGHT [\PUTBASE ADDR 0 (LOGXOR (\GETBASE ADDR 0) - (CONSTANT (SUB1 (EXPT 2 HARDCURSORWIDTH - ] - (SETQ ADDR (\ADDBASE ADDR 1))) - (SELECTC \MACHINETYPE - (\DAYBREAK (\DoveDisplay.SetCursorShape)) - (\MAIKO (AND \CURRENTCURSOR (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) - of \CURRENTCURSOR) - (fetch (CURSOR CUHOTSPOTY) of - \CURRENTCURSOR - )))) - NIL]) - -(FLIPCURSORBAR - [LAMBDA (N) (* ; "Edited 19-Mar-98 14:23 by jds") - -(* ;;; "Inverts the Nth line of the cursor, N = 0 being the top") - - (COND - ((NOT \SOFTCURSORP) - (\PUTBASE \EM.CURSORBITMAP N (LOGXOR (\GETBASE \EM.CURSORBITMAP N) - MAX.SMALLP)) - (SELECTC \MACHINETYPE - (\DAYBREAK (* ; "Notify IOP") - (\DoveDisplay.SetCursorShape)) - (\MAIKO (AND \CURRENTCURSOR (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) - of \CURRENTCURSOR) - (fetch (CURSOR CUHOTSPOTY) of - \CURRENTCURSOR - )))) - NIL]) - -(LASTMOUSEX [LAMBDA (DS) (* rmk%: "30-AUG-83 13:07") (* returns the mouse x position in the coordinates of the DisplayStream DS) (\DSPUNTRANSFORMX LASTMOUSEX (\GETDISPLAYDATA DS]) - -(LASTMOUSEY [LAMBDA (DS) (* rmk%: "30-AUG-83 13:07") (* returns the mouse y position in the coordinates of the DisplayStream DS) (\DSPUNTRANSFORMY LASTMOUSEY (\GETDISPLAYDATA DS]) - -(CREATEPOSITION [LAMBDA (XCOORD YCOORD) (* rmk%: " 6-Aug-84 13:43") (create POSITION XCOORD _ (OR XCOORD 0) YCOORD _ (OR YCOORD 0]) - -(POSITIONP [LAMBDA (X) (* rrb "25-AUG-82 11:04") (* is X a position? For now just a cons check but should be made a datatype.) (AND (LISTP X) (NUMBERP (CAR X)) (NUMBERP (CDR X)) X]) - -(CURSORHOTSPOT [LAMBDA (NEWPOSITION) (* gbn%: "26-Jan-86 15:36") (* returns the current cursor hot spot and sets the hot spot to NEWPOSITON if  one is given.) (PROG1 (create POSITION XCOORD _ \CURSORHOTSPOTX YCOORD _ \CURSORHOTSPOTY) (COND ((POSITIONP NEWPOSITION) (SETQ \CURSORHOTSPOTX (fetch (POSITION YCOORD) of NEWPOSITION)) (SETQ \CURSORHOTSPOTY (fetch (POSITION YCOORD) of NEWPOSITION]) -) - -(PUTPROPS CURSORPROP ARGNAMES (NIL (CURSOR PROP {NEWVALUE}) . U)) - -(RPAQ? \CURSORHOTSPOTX 0) - -(RPAQ? \CURSORHOTSPOTY 0) - -(RPAQ? \CURRENTCURSOR NIL) - -(RPAQ? \SOFTCURSORWIDTH NIL) - -(RPAQ? \SOFTCURSORHEIGHT NIL) - -(RPAQ? \SOFTCURSORP NIL) - -(RPAQ? \SOFTCURSORUPP NIL) - -(RPAQ? \SOFTCURSORUPBM NIL) - -(RPAQ? \SOFTCURSORDOWNBM NIL) - -(RPAQ? \SOFTCURSORBBT1 NIL) - -(RPAQ? \SOFTCURSORBBT2 NIL) - -(RPAQ? \SOFTCURSORBBT3 NIL) - -(RPAQ? \SOFTCURSORBBT4 NIL) - -(RPAQ? \SOFTCURSORBBT5 NIL) - -(RPAQ? \SOFTCURSORBBT6 NIL) - -(RPAQ? \CURSORSCREEN NIL) - -(RPAQ? \CURSORDESTINATION NIL) - -(RPAQ? \CURSORDESTHEIGHT 808) - -(RPAQ? \CURSORDESTWIDTH 1024) - -(RPAQ? \CURSORDESTRASTERWIDTH 64) - -(RPAQ? \CURSORDESTLINE 0) - -(RPAQ? \CURSORDESTLINEBASE NIL) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT - \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 - \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION - \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE) -) -(DEFINEQ - -(GETMOUSESTATE [LAMBDA NIL (* kbr%: " 6-Jul-85 14:16") (* Reads the current state of the  mouse and keyboard) (SETQ LASTMOUSEX (\XMOUSECOORD)) (SETQ LASTMOUSEY (\YMOUSECOORD)) (SETQ LASTMOUSEBUTTONS (LOGXOR (LOGAND (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE) \MOUSE.ALLBITS) \MOUSE.ALLBITS)) (SETQ LASTKEYBOARD (\EVENTKEYS)) (SETQ LASTSCREEN \CURSORSCREEN) NIL]) - -(\EVENTKEYS [LAMBDA NIL (* rmk%: " 4-JUN-81 22:58") (* Returns the state of the various keys that are represented in mouse events) (LOGOR (COND ((KEYDOWNP 'LOCK) 128) (T 0)) (COND ((KEYDOWNP 'LSHIFT) 64) (T 0)) (COND ((KEYDOWNP 'CTRL) 32) (T 0)) (COND ((KEYDOWNP 'RSHIFT) 8) (T 0)) (COND ((KEYDOWNP 'BLANK-TOP) 4) (T 0)) (COND ((KEYDOWNP 'BLANK-MIDDLE) 2) (T 0)) (COND ((KEYDOWNP 'BLANK-BOTTOM) 1) (T 0]) -) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -(RPAQQ HARDCURSORHEIGHT 16) - -(RPAQQ HARDCURSORWIDTH 16) - - -(CONSTANTS (HARDCURSORHEIGHT 16) - (HARDCURSORWIDTH 16)) -) -(DECLARE%: EVAL@COMPILE - -(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD) -) - -(* "END EXPORTED DEFINITIONS") - -(DECLARE%: DONTCOPY -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -[PUTPROPS \SETMOUSEXY MACRO ((XPOS YPOS) - (PROGN (SELECTC \MACHINETYPE - (\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS)) - (\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) - (\DANDELION (do (PROGN (replace (IOPAGE NEWMOUSEX) - of \IOPAGE with XPOS) - (replace (IOPAGE NEWMOUSEY) - of \IOPAGE with YPOS)) - repeatuntil (ILESSP (fetch - (IOPAGE NEWMOUSESTATE - ) of - \IOPAGE) - 32768)) - (* ; - "smash position until mouse says it is not busy") - (replace (IOPAGE NEWMOUSEX) of \IOPAGE - with XPOS) - (replace (IOPAGE NEWMOUSEY) of \IOPAGE - with YPOS) - (replace (IOPAGE NEWMOUSESTATE) of - \IOPAGE - with 32768)) - NIL) - (PROGN (\PUTBASE \EM.MOUSEX 0 XPOS) - (\PUTBASE \EM.MOUSEY 0 YPOS] -) - -(* "END EXPORTED DEFINITIONS") - - -(DECLARE%: EVAL@COMPILE - -[PUTPROPS \XMOUSECOORD MACRO (NIL (IPLUS \CURSORHOTSPOTX (SIGNED (\GETBASE \EM.CURSORX 0) - BITSPERWORD] - -[PUTPROPS \YMOUSECOORD MACRO (NIL (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) - (IPLUS \CURSORHOTSPOTY (SIGNED (\GETBASE \EM.CURSORY 0) - BITSPERWORD] -) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(MOVD 'CURSOR 'SETCURSOR) - -(MOVD '\CURSORPOSITION '\SETCURSORPOSITION) - - -(RPAQ \SFPosition (CREATEPOSITION)) -) -(DECLARE%: DONTCOPY -(DECLARE%: EVAL@COMPILE - -(BLOCKRECORD KEYBOARDEVENT - ((W0 WORD) - (W1 WORD) - (W2 WORD) - (W3 WORD) - (WU WORD) - (W4 WORD) - (W5 WORD) - (TIME FIXP) - (MOUSESTATE BITS 3) - (1SHIFT FLAG) - (2SHIFT FLAG) - (LOCK FLAG) - (CTRL FLAG) - (META FLAG) - (FONT FLAG) - (USERMODE1 FLAG) - (USERMODE2 FLAG) - (USERMODE3 FLAG) - (ALTGRAPH FLAG) - (DEADKEYPENDING FLAG) (* ; "T if the last key was a dead (accent) key, and we should generate an accented character if possible.") - (NIL BITS 2) - (MOUSEX WORD) - (MOUSEY WORD) - (DEADKEY-ALIST XPOINTER) (* ; - "The ALIST describing accents possible from teh last dead key.") - ) - (CREATE (\ALLOCBLOCK (FOLDHI \KEYBOARDEVENT.SIZE WORDSPERCELL))) - W0 _ ALLUP W1 _ ALLUP W2 _ ALLUP W3 _ ALLUP W4 _ ALLUP W5 _ ALLUP WU _ ALLUP MOUSESTATE - _ \DLMOUSE.UP [ACCESSFNS KEYBOARDEVENT ((SIZE (INDEXF (fetch MOUSEY of DATUM))) - (SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT) - DATUM) - (fetch (KEYBOARDEVENT 2SHIFT) - DATUM))) - (SHIFTORLOCK (OR (fetch (KEYBOARDEVENT - SHIFT) - DATUM) - (fetch (KEYBOARDEVENT - LOCK) - DATUM] - LOCK _ (XKEYDOWNP 'LOCK) - TIME _ 0 DEADKEYPENDING _ NIL) -) - -(DECLARE%: EVAL@COMPILE - -(RPAQ \KEYBOARDEVENT.FIRST NRINGINDEXWORDS) - -(RPAQQ \KEYBOARDEVENT.SIZE 14) - -(RPAQ \KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383))) - - -[CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS) - \KEYBOARDEVENT.SIZE - (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383] -) -) -(DEFINEQ - -(MACHINETYPE [LAMBDA NIL (* ; "Edited 30-Mar-88 10:27 by Snow") (SELECTC (fetch MachineType of \InterfacePage) (\DORADO 'DORADO) (\DANDELION 'DANDELION) (\DAYBREAK (* This is \DAYBREAK internally) 'DOVE) (\MAIKO 'MAIKO) NIL]) - -(SETMAINTPANEL [LAMBDA (N) (* mpl "21-Jul-85 18:15") (SELECTC \MACHINETYPE (\DANDELION (replace DLMAINTPANEL of \IOPAGE with N)) (\DOLPHIN ((OPCODES MISC1 3) (\DTEST N 'SMALLP))) (\DAYBREAK ((OPCODES DOVEMISC 2) (\DTEST N 'SMALLP))) NIL]) -) - - - -(* ; "DLion beeper") - -(DEFINEQ - -(BEEPON [LAMBDA (FREQ) (* ; "Edited 10-May-88 18:17 by MASINTER") (SELECTC \MACHINETYPE (\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE) 32768) do (BLOCK)) (replace DLBEEPFREQ of \IOPAGE with (IQUOTIENT 1843200 (IMAX FREQ 29))) (replace DLBEEPCMD of \IOPAGE with 32768)) (\DAYBREAK (\DoveMisc.BeepOn FREQ)) (\MAIKO (SUBRCALL KEYBOARDBEEP T FREQ)) (PROGN NIL)) NIL]) - -(BEEPOFF [LAMBDA NIL (* ; "Edited 10-May-88 18:17 by MASINTER") (SELECTC \MACHINETYPE (\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE) 32768) do (BLOCK)) (replace DLBEEPCMD of \IOPAGE with 32769)) (\DAYBREAK (\DoveMisc.BeepOff)) (\MAIKO (SUBRCALL KEYBOARDBEEP NIL NIL)) (PROGN NIL)) NIL]) -) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 - \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD - \EM.CURSORBITMAP \MACHINETYPE \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION - \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY) -) - -(* "END EXPORTED DEFINITIONS") - -(DEFINEQ - -(WITHOUT-INTERRUPTS [NLAMBDA (FORM) (* lmm "18-Apr-85 02:53") (PROG (VAL) (\KEYBOARDOFF) (SETQ VAL (DISPLAYDOWN FORM)) (\KEYBOARDON) (RETURN VAL]) -) - - - -(* ; "Compile locked fns together for locality") - -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY - -(BLOCK%: NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \PERIODIC.INTERRUPTFRAME - \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS - \HARDCURSORUP \DOMOUSECHORDING \KEYBOARDOFF \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP - \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN) -) -(DECLARE%: DONTCOPY - -(ADDTOVAR INEWCOMS - (ALLOCAL (ADDVARS (LOCKEDFNS FLIPCURSORBAR \SETIOPOINTERS \KEYHANDLER \KEYHANDLER1 - \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \INCUSECOUNT - LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE - \PERIODIC.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS - \TIMER.INTERRUPTFRAME \CAUSEINTERRUPT \DOMOUSECHORDING - \KEYBOARDOFF \TRACKCURSOR \HARDCURSORUP \HARDCURSORPOSITION - \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT - \SOFTCURSORPOSITION \SOFTCURSORDOWN \SOFTCURSORPILOTBITBLT) - (LOCKEDVARS \InterfacePage \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR - \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP - \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 - \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 - \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH - \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE - \PENDINGINTERRUPT \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY - \LASTUSERACTION \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING - SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \EM.MOUSEX - \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN - \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT - \EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS \RCLKSECOND)))) - -(ADDTOVAR RDCOMS (FNS \SETIOPOINTERS)) -) - -(PUTPROPS LLKEY FILETYPE CL:COMPILE-FILE) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML WITHOUT-INTERRUPTS) - -(ADDTOVAR LAMA CURSORPROP METASHIFT MOUSECHORDWAIT) -) -(PUTPROPS LLKEY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 -1992 1999 1920 2000)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (14769 21865 (BKSYSCHARCODE 14779 . 15128) (\CLEARSYSBUF 15130 . 15688) (\GETKEY 15690 - . 16865) (\NSYSBUFCHARS 16867 . 17507) (\SAVESYSBUF 17509 . 19121) (\SYSBUFP 19123 . 19427) ( -\GETSYSBUF 19429 . 19609) (\PUTSYSBUF 19611 . 20825) (\PEEKSYSBUF 20827 . 21863)) (23123 59302 ( -\KEYBOARDINIT 23133 . 24856) (\KEYBOARDEVENTFN 24858 . 29558) (\ALLOCLOCKED 29560 . 30150) ( -\SETIOPOINTERS 30152 . 34621) (\KEYBOARDOFF 34623 . 34970) (\KEYBOARDON 34972 . 35284) (\KEYHANDLER -35286 . 35417) (\KEYHANDLER1 35419 . 42737) (\RESETKEYBOARD 42739 . 44248) (\DOMOUSECHORDING 44250 . -47921) (\DOTRANSITIONS 47923 . 48600) (\DECODETRANSITION 48602 . 55291) (MOUSECHORDWAIT 55293 . 55976) - (\TRACKCURSOR 55978 . 59300)) (101704 125063 (KEYACTION 101714 . 102558) (KEYACTIONTABLE 102560 . -103742) (KEYBOARDTYPE 103744 . 104846) (RESETKEYACTION 104848 . 106607) ( -\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 106609 . 110016) (\KEYACTION1 110018 . 120639) (KEYDOWNP 120641 - . 120976) (KEYNUMBERP 120978 . 121176) (\KEYNAMETONUMBER 121178 . 121872) (MODIFY.KEYACTIONS 121874 - . 122735) (METASHIFT 122737 . 123681) (SHIFTDOWNP 123683 . 125061)) (125126 125422 ( -SETUP.OFFICE.KEYBOARD 125136 . 125420)) (128845 130557 (\INIT.KEYBOARD.STREAM 128855 . 130555)) ( -130822 147199 (\DOBUFFEREDTRANSITIONS 130832 . 146262) (\TIMER.INTERRUPTFRAME 146264 . 146989) ( -\PERIODIC.INTERRUPTFRAME 146991 . 147197)) (147453 151530 (\HARDCURSORUP 147463 . 149345) ( -\HARDCURSORPOSITION 149347 . 151383) (\HARDCURSORDOWN 151385 . 151528)) (151531 175591 (CURSOR.INIT -151541 . 155241) (\CURSORDESTINATION 155243 . 157561) (\SOFTCURSORUP 157563 . 162817) ( -\SOFTCURSORUPCURRENT 162819 . 169855) (\SOFTCURSORPOSITION 169857 . 170622) (\SOFTCURSORDOWN 170624 . -171332) (CURSORPROP 171334 . 171676) (GETCURSORPROP 171678 . 171866) (PUTCURSORPROP 171868 . 173023) ( -\CURSORBITSPERPIXEL 173025 . 175141) (\CURSORIMAGEPROPNAME 175143 . 175367) (\CURSORMASKPROPNAME -175369 . 175589)) (175592 193542 (CURSORCREATE 175602 . 178277) (CURSOR 178279 . 180091) ( -\CURSOR-VALID-P 180093 . 181180) (\CURSORUP 181182 . 182897) (\CURSORPOSITION 182899 . 185427) ( -\CURSORDOWN 185429 . 185662) (ADJUSTCURSORPOSITION 185664 . 186242) (CURSORPOSITION 186244 . 187786) ( -CURSORSCREEN 187788 . 188444) (CURSOREXIT 188446 . 189837) (FLIPCURSOR 189839 . 190965) (FLIPCURSORBAR - 190967 . 191947) (LASTMOUSEX 191949 . 192203) (LASTMOUSEY 192205 . 192459) (CREATEPOSITION 192461 . -192667) (POSITIONP 192669 . 192953) (CURSORHOTSPOT 192955 . 193540)) (194776 196324 (GETMOUSESTATE -194786 . 195445) (\EVENTKEYS 195447 . 196322)) (202185 202981 (MACHINETYPE 202195 . 202595) ( -SETMAINTPANEL 202597 . 202979)) (203011 204150 (BEEPON 203021 . 203674) (BEEPOFF 203676 . 204148)) ( -204601 204864 (WITHOUT-INTERRUPTS 204611 . 204862))))) -STOP diff --git a/sources/LLKEY.~4~ b/sources/LLKEY.~4~ deleted file mode 100644 index 04a57a3d..00000000 --- a/sources/LLKEY.~4~ +++ /dev/null @@ -1,35 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "19-May-2018 13:32:12" {DSK}kaplan>Local>medley3.5>lispcore>sources>LLKEY.;4 199267 changes to%: (VARS LLKEYCOMS \KEYNAMES) previous date%: " 9-Apr-2000 16:28:23" {DSK}kaplan>Local>medley3.5>lispcore>sources>LLKEY.;1) (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1999, 1920, 2000, 2018 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT LLKEYCOMS) (RPAQQ LLKEYCOMS [(COMS (* ; "Access to keyboard") (FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \NSYSBUFCHARS \SAVESYSBUF \SYSBUFP \GETSYSBUF \PUTSYSBUF \PEEKSYSBUF) (INITVARS (\LONGSYSBUF)) (INITVARS (\\KEYBOARDWAITBOX.GLOBALRESOURCE)) (DECLARE%: DONTCOPY (RESOURCES \KEYBOARDWAITBOX)) (DECLARE%: DONTCOPY (CONSTANTS (\SYSBUFSIZE 200)) (MACROS \GETREALSYSBUF))) [DECLARE%: DOCOPY DONTEVAL@LOAD (COMS (* ;  "Here because it must be done in init before PROC loaded") (P (MOVD? 'NILL 'CARET] (COMS (* ; "Key handler") (FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF \KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSECHORDING \DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR) (CONSTANTS (\SUN.TYPE3KEYBOARD 0) (\SUN.TYPE4KEYBOARD 1) (\SUN.JLEKEYBOARD 2) (\TOSHIBA.JIS 7)) (INITVARS (\MOUSECHORDTICKS) (\MOUSECHORDMILLISECONDS 50)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT))) [DECLARE%: DONTCOPY (MACROS .NOTELASTUSERACTION) (CONSTANTS ALLUP \CTRLMASK \METABIT) (CONSTANTS * DLMOUSEBITS) (CONSTANTS * DLMOUSESTATES) (CONSTANTS * TRANSITIONFLAGS) (MACROS \TRANSINDEX ARMEDCODE TRANSITIONALTGRCODE TRANSITIONSHIFTCODE TRANSITIONCODE TRANSITIONFLAGS TRANSITIONDEADLIST CHECKFORDEADKEY) (EXPORT (RECORDS KEYACTION) (CONSTANTS \NKEYS)) (RECORDS RING) (COMS (* ;  "can get rid of shiftstate after clients have been fixed") (RECORDS SHIFTSTATE) (GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP)) (CONSTANTS NRINGINDEXWORDS) (CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE] (DECLARE%: EVAL@COMPILE (VARS \KEYNAMES)) (* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun.") (VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DORADOKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS \MAIKOKEYACTIONS \MAIKOKEYACTIONST4 \MAIKO-JLE-KEYACTIONS \TOSHIBA-KEYACTIONS) (VARS (KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL)) (INITVARS (\KEYBOARD.META 256) (\MODIFIED.KEYACTIONS)) (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE) )) (GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)) (COMS (* ; "Key interpretation") (FNS KEYACTION KEYACTIONTABLE KEYBOARDTYPE RESETKEYACTION \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS \KEYACTION1 KEYDOWNP KEYNUMBERP \KEYNAMETONUMBER MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP) (* ;  "To support office style 1108 & 1186 keyboards") (FNS SETUP.OFFICE.KEYBOARD) (OPTIMIZERS \KEYNAMETONUMBER) (MACROS \TEMPCOPYTIMER) (* ;  "Don't copy this optimizer since it expands out to \getbasebit, but do exportit.") (DECLARE%: DONTCOPY (EXPORT (OPTIMIZERS KEYDOWNP))) (EXPORT (MACROS XKEYDOWNP KEYDOWNP1 \NEWKEYDOWNP))) (COMS (* ; "A raw keyboard device/stream") (FNS \INIT.KEYBOARD.STREAM) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INIT.KEYBOARD.STREAM))) (EXPORT (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM))) (COMS (* ; "Hook for a periodic interrupt") (FNS \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \PERIODIC.INTERRUPTFRAME) (INITVARS (\KEYBUFFERING) (\PERIODIC.INTERRUPT) (\TIMER.INTERRUPT.PENDING) (\PERIODIC.INTERRUPT.FREQUENCY 77))) (LOCALVARS . T) [COMS (* ;  "cursor and mouse related functions.") (FNS \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN) (FNS CURSOR.INIT \CURSORDESTINATION \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN CURSORPROP GETCURSORPROP PUTCURSORPROP \CURSORBITSPERPIXEL \CURSORIMAGEPROPNAME \CURSORMASKPROPNAME) (FNS CURSORCREATE CURSOR \CURSOR-VALID-P \CURSORUP \CURSORPOSITION \CURSORDOWN ADJUSTCURSORPOSITION CURSORPOSITION CURSORSCREEN CURSOREXIT FLIPCURSOR FLIPCURSORBAR LASTMOUSEX LASTMOUSEY CREATEPOSITION POSITIONP CURSORHOTSPOT) (PROPS (CURSORPROP ARGNAMES)) (INITVARS (\CURSORHOTSPOTX 0) (\CURSORHOTSPOTY 0) (\CURRENTCURSOR NIL) (\SOFTCURSORWIDTH NIL) (\SOFTCURSORHEIGHT NIL) (\SOFTCURSORP NIL) (\SOFTCURSORUPP NIL) (\SOFTCURSORUPBM NIL) (\SOFTCURSORDOWNBM NIL) (\SOFTCURSORBBT1 NIL) (\SOFTCURSORBBT2 NIL) (\SOFTCURSORBBT3 NIL) (\SOFTCURSORBBT4 NIL) (\SOFTCURSORBBT5 NIL) (\SOFTCURSORBBT6 NIL) (\CURSORSCREEN NIL) (\CURSORDESTINATION NIL) (\CURSORDESTHEIGHT 808) (\CURSORDESTWIDTH 1024) (\CURSORDESTRASTERWIDTH 64) (\CURSORDESTLINE 0) (\CURSORDESTLINEBASE NIL)) (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE) (FNS GETMOUSESTATE \EVENTKEYS) [EXPORT (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) (DECLARE%: EVAL@COMPILE (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD] (DECLARE%: DONTCOPY (EXPORT (MACROS \SETMOUSEXY)) (MACROS \XMOUSECOORD \YMOUSECOORD)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOR 'SETCURSOR) (MOVD '\CURSORPOSITION '\SETCURSORPOSITION)) (VARS (\SFPosition (CREATEPOSITION] [COMS (DECLARE%: DONTCOPY (RECORDS KEYBOARDEVENT) (CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS) \KEYBOARDEVENT.SIZE (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383] (COMS (FNS MACHINETYPE SETMAINTPANEL) (* ; "DLion beeper") (FNS BEEPON BEEPOFF)) (EXPORT (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY)) (FNS WITHOUT-INTERRUPTS) (COMS (* ;  "Compile locked fns together for locality") (BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS \HARDCURSORUP \DOMOUSECHORDING \KEYBOARDOFF \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN))) [DECLARE%: DONTCOPY (ADDVARS [INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS FLIPCURSORBAR \SETIOPOINTERS \KEYHANDLER \KEYHANDLER1 \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \INCUSECOUNT LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE \PERIODIC.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \CAUSEINTERRUPT \DOMOUSECHORDING \KEYBOARDOFF \TRACKCURSOR \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN \SOFTCURSORPILOTBITBLT) (LOCKEDVARS \InterfacePage \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE \PENDINGINTERRUPT \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS \RCLKSECOND ] (RDCOMS (FNS \SETIOPOINTERS] (PROP FILETYPE LLKEY) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML WITHOUT-INTERRUPTS ) (LAMA CURSORPROP METASHIFT MOUSECHORDWAIT]) (* ; "Access to keyboard") (DEFINEQ (BKSYSCHARCODE [LAMBDA (CHAR) (* rrb "30-Dec-83 11:56") (OR (\PUTSYSBUF CHAR) (PROGN (SETQ \LONGSYSBUF (NCONC \LONGSYSBUF (bind C while (SETQ C (\GETREALSYSBUF)) collect C))) (\PUTSYSBUF CHAR]) (\CLEARSYSBUF [LAMBDA (ALLFLG) (* mpl "27-Jun-85 20:04") (DECLARE (GLOBALVARS \PROCESSES)) (COND ((OR ALLFLG (TTY.PROCESSP)) (SETQ \LONGSYSBUF) (replace (RING READ) of \SYSBUFFER with 0))) (COND (ALLFLG (for PROC in \PROCESSES do (replace PROCTYPEAHEAD of PROC with NIL))) ((THIS.PROCESS) (replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL]) (\GETKEY [LAMBDA NIL (* lmm "18-Apr-85 00:07") (DECLARE (GLOBALVARS \KEYBOARDWAIT1 \KEYBOARDWAIT2)) (COND [(AND (THIS.PROCESS) (fetch PROCTYPEAHEAD of (THIS.PROCESS))) (pop (fetch PROCTYPEAHEAD of (THIS.PROCESS] (T (WAIT.FOR.TTY) (OR (\GETSYSBUF) (GLOBALRESOURCE (\KEYBOARDWAITBOX) (* Busy-wait loop that gets next  character) (\CLOCK0 \KEYBOARDWAITBOX) (bind C do (COND ((SETQ C (\GETSYSBUF)) (\BOXIPLUS (LOCF (fetch KEYBOARDWAITTIME of \MISCSTATS)) (CLOCKDIFFERENCE \KEYBOARDWAITBOX)) (RETURN C))) (\TTYBACKGROUND) (\WAIT.FOR.TTY]) (\NSYSBUFCHARS [LAMBDA NIL (* JonL " 7-May-84 01:50") (* Tells how many characters can be \GETSYSBUFed.  Used by \SAVESYSBUF.) (IPLUS (LENGTH \LONGSYSBUF) (PROG ((R (fetch (RING READ) of \SYSBUFFER)) (W (fetch (RING WRITE) of \SYSBUFFER))) (RETURN (COND ((EQ 0 R) 0) ((IGREATERP W R) (IDIFFERENCE W R)) (T (IDIFFERENCE W (IDIFFERENCE R \SYSBUFSIZE]) (\SAVESYSBUF [LAMBDA NIL (* JonL " 7-May-84 01:50") (DECLARE (GLOBALVARS \SAVEDSYSBUFFER)) (PROG (TA (BUF \SAVEDSYSBUFFER) (NC (\NSYSBUFCHARS)) (J 0)) [COND ((TTY.PROCESSP) [COND ([AND (THIS.PROCESS) (SETQ TA (fetch PROCTYPEAHEAD of (THIS.PROCESS] (replace PROCTYPEAHEAD of (THIS.PROCESS) with NIL) (add NC (LENGTH TA)) [COND ((IGREATERP NC (NCHARS BUF)) (SETQ BUF (ALLOCSTRING NC] (for CH in TA do (RPLCHARCODE BUF (add J 1) CH))) ((IGREATERP NC (NCHARS BUF)) (SETQ BUF (ALLOCSTRING NC] (for I from (ADD1 J) to NC do (* Test on J means that we'll ignore extra chars typed since we got the  length. Test on \GETSYSBUF so we don't get screwed if buffer gets cleared  while during this loop) (RPLCHARCODE BUF I (OR (\GETSYSBUF) (PROGN (SETQ NC (SUB1 I)) (RETURN] (RETURN (AND (NOT (EQ 0 NC)) (SUBSTRING BUF 1 NC]) (\SYSBUFP [LAMBDA NIL (* JonL " 7-May-84 01:52") (OR [AND (TTY.PROCESSP) (OR \LONGSYSBUF (NOT (EQ 0 (fetch (RING READ) of \SYSBUFFER] (AND (THIS.PROCESS) (fetch PROCTYPEAHEAD of (THIS.PROCESS]) (\GETSYSBUF [LAMBDA NIL (* lmm " 9-JUL-83 00:56") (OR (AND \LONGSYSBUF (pop \LONGSYSBUF)) (\GETREALSYSBUF]) (\PUTSYSBUF [LAMBDA (CHAR) (* rmk%: "27-Nov-84 17:51") (PROG ((R (fetch (RING READ) of \SYSBUFFER)) (W (fetch (RING WRITE) of \SYSBUFFER))) (RETURN (COND ((EQ R W) (* Full) NIL) (T (\PUTBASEFAT \SYSBUFFER W CHAR) (AND (EQ 0 R) (replace (RING READ) of \SYSBUFFER with W)) (* Return random non-NIL value to  indicate success for BKSYSBUF) [replace (RING WRITE) of \SYSBUFFER with (COND ((EQ \SYSBUFFER.LAST W) \SYSBUFFER.FIRST) (T (ADD1 W] T]) (\PEEKSYSBUF [LAMBDA (STREAM) (* bvm%: " 8-Feb-85 17:50") (PROG (R) WAIT (until (\SYSBUFP) do (BLOCK)) (RETURN (if (TTY.PROCESSP) then (if \LONGSYSBUF then (CAR \LONGSYSBUF) elseif (NEQ (SETQ R (fetch (RING READ) of \SYSBUFFER)) 0) then (* Here's the vanilla case) (\GETBASEFAT \SYSBUFFER R) else (* Foo an interrupt could have sneaked in here and gobbled down the remaining  characters) (GO WAIT)) elseif (THIS.PROCESS) then (CAR (fetch PROCTYPEAHEAD of (THIS.PROCESS))) else (SHOULDNT]) ) (RPAQ? \LONGSYSBUF ) (RPAQ? \\KEYBOARDWAITBOX.GLOBALRESOURCE ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE [PUTDEF '\KEYBOARDWAITBOX 'RESOURCES '(NEW (CREATECELL \FIXP] ) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (RPAQQ \SYSBUFSIZE 200) (CONSTANTS (\SYSBUFSIZE 200)) ) (DECLARE%: EVAL@COMPILE (PUTPROPS \GETREALSYSBUF MACRO [NIL (PROG ((R (fetch (RING READ) of \SYSBUFFER))) (RETURN (AND (NOT (EQ 0 R)) (PROG1 (\GETBASEFAT \SYSBUFFER R) (AND [EQ (fetch (RING WRITE) of \SYSBUFFER) (replace (RING READ) of \SYSBUFFER with (COND ((EQ \SYSBUFFER.LAST R) \SYSBUFFER.FIRST) (T (ADD1 R] (replace (RING READ) of \SYSBUFFER with 0)))]) ) ) (DECLARE%: DOCOPY DONTEVAL@LOAD (* ; "Here because it must be done in init before PROC loaded") (MOVD? 'NILL 'CARET) ) (* ; "Key handler") (DEFINEQ (\KEYBOARDINIT [LAMBDA NIL (* ; "Edited 19-Nov-87 16:46 by Snow") (DECLARE (GLOBALVARS \SAVEDSYSBUFFER)) (* ;  "Sets up keyboard decoding tables.") (SETQ \CURRENTKEYACTION (SETQ \DEFAULTKEYACTION (KEYACTIONTABLE))) (* ;  "added \commandkeyaction 11-19-87 WAS") (SETQ \COMMANDKEYACTION (KEYACTIONTABLE)) (SETQ \INTERRUPTSTATE (\ALLOCLOCKED 2)) (PROGN (SETQ \SYSBUFFER (\ALLOCBLOCK (FOLDHI (ADD1 \SYSBUFFER.LAST) WORDSPERCELL))) (replace (RING READ) of \SYSBUFFER with 0) (replace (RING WRITE) of \SYSBUFFER with \SYSBUFFER.FIRST)) (SETQ \SAVEDSYSBUFFER (ALLOCSTRING \SYSBUFSIZE NIL NIL T)) (SETQ \LASTUSERACTION (LOCF (fetch LASTUSERACTION of \MISCSTATS))) (PROGN (SETQ \KEYBOARDEVENTQUEUE (\ALLOCLOCKED (FOLDHI (PLUS \KEYBOARDEVENT.LAST \KEYBOARDEVENT.SIZE) WORDSPERCELL))) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) (replace (RING WRITE) of \KEYBOARDEVENTQUEUE with \KEYBOARDEVENT.FIRST)) (SETQ \LASTKEYSTATE (create KEYBOARDEVENT)) (SETQ \SHIFTSTATE (create SHIFTSTATE)) (SETQ \MOUSETIMERTEMP (SETUPTIMER 0 NIL 'TICKS)) (MOUSECHORDWAIT \MOUSECHORDMILLISECONDS) (\KEYBOARDON]) (\KEYBOARDEVENTFN [LAMBDA (FDEV EVENT EXTRA) (* ; "Edited 11-Oct-90 09:49 by jds") (DECLARE (GLOBALVARS \KEYBOARD.BEFORETYPE \DORADOKEYACTIONS \DLIONKEYACTIONS \MAIKO.BEFOREKEYTYPE)) (SELECTQ EVENT ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM) (SETQ \KEYBOARD.BEFORETYPE \MACHINETYPE) (SETQ \MAIKO.BEFOREKEYTYPE (LOGAND 7 (FETCH (IFPAGE DEVCONFIG) OF \InterfacePage ))) (SETQ \MAIKO.XBEFORE? (SELECTQ (MACHINETYPE) (MAIKO (EQUAL "X" (UNIX-GETPARM "DISPLAY"))) NIL))) ((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM) (* ;  "Restarting a world. If we changed machines, fix up the key actions to match the new machine.") (* ; "(COND ((NEQ \\MACHINETYPE \\KEYBOARD.BEFORETYPE) ; Changed machines. Change Keyactions. (|for| X |in| (\\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) |do| (KEYACTION (CAR X) (CDR X) \\COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \\DEFAULTKEYACTION)) (MOUSECHORDWAIT (MOUSECHORDWAIT))))") [COND ((OR (NEQ \MACHINETYPE \KEYBOARD.BEFORETYPE) (NEQ \MAIKO.XBEFORE? (SELECTQ (MACHINETYPE) (MAIKO (EQUAL "X" (UNIX-GETPARM "DISPLAY"))) NIL))) (* ;  "Changed machines. Change Keyactions.") [COND ((NEQ (MACHINETYPE) 'MAIKO) (* ;; "Non-SUN, so just change machine-specific key actions:") (for X in (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION))) (T (* ;;  "On a SUN: Some keyactions contradict %"normal%" ones, so reset them all.") (for X in (APPEND \ORIGKEYACTIONS (  \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS )) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION] (MOUSECHORDWAIT (MOUSECHORDWAIT))) ((EQ (MACHINETYPE) 'MAIKO) (* ;; "Same machine type. SO only worry if we're on SUNs, where the keyboard type can differ between machines.") (COND ((NEQ \MAIKO.BEFOREKEYTYPE (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage ))) (for X in (APPEND \ORIGKEYACTIONS (  \KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS )) do (KEYACTION (CAR X) (CDR X) \COMMANDKEYACTION) (KEYACTION (CAR X) (CDR X) \DEFAULTKEYACTION)) (MOUSECHORDWAIT (MOUSECHORDWAIT]) NIL]) (\ALLOCLOCKED [LAMBDA (NCELLS) (* lmm "20-Apr-85 13:08") (* allocate a block of NCELLS cells  and lock it) (PROG [(BLOCK (\ALLOCBLOCK NCELLS NIL (IMIN NCELLS CELLSPERPAGE] (\LOCKCELL BLOCK (FOLDHI (IPLUS (fetch (POINTER WORDINPAGE) of BLOCK) (UNFOLD NCELLS WORDSPERCELL)) WORDSPERPAGE)) (RETURN BLOCK]) (\SETIOPOINTERS [LAMBDA NIL (* ; "Edited 28-Apr-88 01:10 by MASINTER") (SELECTC (SETTOPVAL '\MACHINETYPE (fetch MachineType of \InterfacePage)) ((LIST \DOLPHIN \DORADO) (SETTOPVAL '\EM.MOUSEX (EMADDRESS MOUSEX.EM)) (SETTOPVAL '\EM.MOUSEY (EMADDRESS MOUSEY.EM)) (SETTOPVAL '\EM.CURSORX (EMADDRESS CURSORX.EM)) (SETTOPVAL '\EM.CURSORY (EMADDRESS CURSORY.EM)) (SETTOPVAL '\EM.REALUTILIN (EMADDRESS UTILIN.EM)) (SETTOPVAL '\EM.KBDAD0 (EMADDRESS KBDAD0.EM)) (SETTOPVAL '\EM.KBDAD1 (EMADDRESS KBDAD1.EM)) (SETTOPVAL '\EM.KBDAD2 (EMADDRESS KBDAD2.EM)) (SETTOPVAL '\EM.KBDAD3 (EMADDRESS KBDAD3.EM)) (SETTOPVAL '\EM.KBDAD4 (LOCF (fetch FAKEKBDAD4 of \InterfacePage))) (\PUTBASE \EM.KBDAD4 0 ALLUP) (SETTOPVAL '\EM.KBDAD5 (LOCF (fetch FAKEKBDAD5 OF \InterfacePage))) (\PUTBASE \EM.KBDAD5 0 ALLUP) (SETTOPVAL '\EM.DISPINTERRUPT (EMADDRESS DISPINTERRUPT.EM)) (SETTOPVAL '\EM.CURSORBITMAP (EMADDRESS CURSORBITMAP.EM)) (SETTOPVAL '\EM.DISPLAYHEAD (EMADDRESS DCB.EM)) (SETTOPVAL 'SCREENWIDTH (UNFOLD (fetch ScreenWidth of \InterfacePage) BITSPERWORD))) ((LIST \DANDELION \MAIKO) (SETTOPVAL '\EM.MOUSEX (fetch DLMOUSEXPTR of \IOPAGE)) (SETTOPVAL '\EM.MOUSEY (fetch DLMOUSEYPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORX (fetch DLCURSORXPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORY (fetch DLCURSORYPTR of \IOPAGE)) (PROGN (SETTOPVAL '\EM.REALUTILIN (fetch DLUTILINPTR of \IOPAGE)) (* ;; "Where the hardware bits live, vs. where the Lisp software sees them after reinterpretation by keyhandler") ) (SETTOPVAL '\EM.KBDAD0 (fetch DLKBDAD0PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD1 (fetch DLKBDAD1PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD2 (fetch DLKBDAD2PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD3 (fetch DLKBDAD3PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD4 (fetch DLKBDAD4PTR of \IOPAGE)) (SETTOPVAL '\EM.KBDAD5 (fetch DLKBDAD5PTR of \IOPAGE)) (SETTOPVAL '\EM.DISPINTERRUPT (fetch DLDISPINTERRUPTPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORBITMAP (fetch DLCURSORBITMAPPTR of \IOPAGE)) (SETTOPVAL '\EM.DISPLAYHEAD NIL) (SETTOPVAL 'SCREENWIDTH (SELECTC \MACHINETYPE (\MAIKO (SUBRCALL DSP-SCREENWIDTH)) 1024))) (\DAYBREAK (PROG ((KBDBASE (\DoveMisc.GetKBDBase))) (SETTOPVAL '\EM.KBDAD0 (\ADDBASE KBDBASE 1)) (SETTOPVAL '\EM.KBDAD1 (\ADDBASE KBDBASE 2)) (SETTOPVAL '\EM.KBDAD2 (\ADDBASE KBDBASE 3)) (SETTOPVAL '\EM.KBDAD3 (\ADDBASE KBDBASE 4)) (SETTOPVAL '\EM.KBDAD4 (\ADDBASE KBDBASE 5)) (SETTOPVAL '\EM.KBDAD5 (\ADDBASE KBDBASE 6)) (SETTOPVAL '\EM.MOUSEX (\DoveMisc.GetMouseXBase)) (SETTOPVAL '\EM.MOUSEY (\DoveMisc.GetMouseYBase)) (SETTOPVAL '\EM.CURSORBITMAP (\DoveDisplay.GetCursorBitmapBase)) (* These three set this way to  prevent address faults) (SETTOPVAL '\EM.DISPINTERRUPT (fetch DLDISPINTERRUPTPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORX (fetch DLCURSORXPTR of \IOPAGE)) (SETTOPVAL '\EM.CURSORY (fetch DLCURSORYPTR of \IOPAGE)) (PROGN (SETTOPVAL '\EM.REALUTILIN KBDBASE) (* Where the hardware bits live, vs. where the Lisp software sees them after  reinterpretation by keyhandler) ) (SETTOPVAL 'SCREENWIDTH (\DoveDisplay.ScreenWidth)))) (RAID)) (SETTOPVAL '\EM.UTILIN (LOCF (fetch (IFPAGE FAKEMOUSEBITS) of \InterfacePage]) (\KEYBOARDOFF [LAMBDA NIL (* ; "Edited 20-Apr-88 10:28 by MASINTER") (\PUTBASE \EM.DISPINTERRUPT 0 (LOGAND (LOGXOR 65535 \LispKeyMask) (\GETBASE \EM.DISPINTERRUPT 0))) (COND ((EQ \MACHINETYPE \MAIKO) (SUBRCALL KEYBOARDSTATE NIL]) (\KEYBOARDON [LAMBDA (NOCHECK) (* ; "Edited 24-Apr-88 00:03 by MASINTER") (\SETIOPOINTERS) (\PUTBASE \EM.DISPINTERRUPT 0 (LOGOR \LispKeyMask (\GETBASE \EM.DISPINTERRUPT 0))) (COND ((EQ \MACHINETYPE \MAIKO) (SUBRCALL KEYBOARDSTATE T]) (\KEYHANDLER [LAMBDA NIL (* lmm "30-MAR-83 20:40") (\KEYHANDLER1]) (\KEYHANDLER1 [LAMBDA NIL (* ; "Edited 30-Mar-88 10:40 by Snow") (PROG ((OLD0 ALLUP) (OLD1 ALLUP) (OLD2 ALLUP) (OLD3 ALLUP) (OLD4 ALLUP) (OLD5 ALLUP) (OLDU ALLUP) (OLDFAKEU ALLUP) (LOOPCNT 10) (PERIODCNT 60) (MOUSESTATE \DLMOUSE.UP) (MOUSETIMER (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) (MOUSETEMP (LOCF (fetch DLMOUSETEMP of \MISCSTATS))) CURSORX CURSORY YHOT) (SETQ \KEYBUFFERING NIL) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) LP (\CONTEXTSWITCH \KbdFXP) [COND (\PERIODIC.INTERRUPT (* eventually can be replaced with  general timer mechanism) (COND ((IGREATERP PERIODCNT 0) (* Continue counting down to zero) (SETQ PERIODCNT (SUB1 PERIODCNT))) ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \PERIODIC.INTERRUPTFRAME)) (* When we've counted down, then keep trying to cause the interrupt, and  reset the counter when it finally happens) (SETQ PERIODCNT (SUB1 (OR \PERIODIC.INTERRUPT.FREQUENCY 1] [COND ((OR (NEQ (\GETBASE \EM.MOUSEX 0) CURSORX) (NEQ (\GETBASE \EM.MOUSEY 0) CURSORY)) (\TRACKCURSOR (SETQ CURSORX (\GETBASE \EM.MOUSEX 0)) (SETQ CURSORY (\GETBASE \EM.MOUSEY 0] [COND ((OR [COND ((OR (NEQ OLDU (\GETBASE \EM.REALUTILIN 0)) (COND ((AND (EQ MOUSESTATE \DLMOUSE.WAITING) (IGREATERP (\BOXIDIFFERENCE (\RCLK MOUSETEMP) MOUSETIMER) 0)) (* Timer expired on seeing both left and right down, so set state to normal) (SETQ MOUSESTATE \DLMOUSE.NORMAL) T))) (SETQ MOUSESTATE (\DOMOUSECHORDING (SETQ OLDU (\GETBASE \EM.REALUTILIN 0)) MOUSESTATE)) (NEQ OLDFAKEU (\GETBASE \EM.UTILIN 0] (NEQ OLD0 (\GETBASE \EM.KBDAD0 0)) (NEQ OLD1 (\GETBASE \EM.KBDAD1 0)) (NEQ OLD2 (\GETBASE \EM.KBDAD2 0)) (NEQ OLD3 (\GETBASE \EM.KBDAD3 0)) (NEQ OLD4 (\GETBASE \EM.KBDAD4 0)) (NEQ OLD5 (\GETBASE \EM.KBDAD5 0))) (COND ((EQ 0 (LOGAND (\GETBASE \EM.KBDAD2 0) 2114)) (* Ctrl-shift-DEL panic interrupt --  switch to TeleRaid immediately) (swap (fetch (IFPAGE TELERAIDFXP) of \InterfacePage) (fetch (IFPAGE KbdFXP) of \InterfacePage)) (\KEYBOARDOFF) (SETQ OLD2 (\GETBASE \EM.KBDAD2 0)) (GO LP))) [PROG ((W (fetch (RING WRITE) of \KEYBOARDEVENTQUEUE)) (R (fetch (RING READ) of \KEYBOARDEVENTQUEUE)) WPTR) (COND ((EQ R W) (* eventqueue full!) (RETURN))) (SETQ WPTR (\ADDBASE \KEYBOARDEVENTQUEUE W)) (\RCLK (LOCF (fetch TIME of WPTR))) [with KEYBOARDEVENT WPTR (PROGN (SETQ W0 (SETQ OLD0 (\GETBASE \EM.KBDAD0 0))) (SETQ W1 (SETQ OLD1 (\GETBASE \EM.KBDAD1 0))) (SETQ W2 (SETQ OLD2 (\GETBASE \EM.KBDAD2 0))) (SETQ W3 (SETQ OLD3 (\GETBASE \EM.KBDAD3 0))) (SETQ W4 (SETQ OLD4 (\GETBASE \EM.KBDAD4 0))) (SETQ W5 (SETQ OLD5 (\GETBASE \EM.KBDAD5 0))) (SETQ WU (SETQ OLDFAKEU (\GETBASE \EM.UTILIN 0] (COND ((EQ R 0) (* Queue was empty) (replace (RING READ) of \KEYBOARDEVENTQUEUE with W))) (replace (RING WRITE) of \KEYBOARDEVENTQUEUE with (COND ((IGEQ W \KEYBOARDEVENT.LAST) \KEYBOARDEVENT.FIRST) (T (IPLUS W \KEYBOARDEVENT.SIZE] (OR \KEYBUFFERING (SETQ \KEYBUFFERING T] [COND [\KEYBUFFERING (COND ((EQ \KEYBUFFERING T) (COND ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \DOBUFFEREDTRANSITIONS)) (SETQ \KEYBUFFERING 'STARTED) (* don't call until  \DOBUFFEREDTRANSITIONS is done) ] (T (COND (\PENDINGINTERRUPT (COND ((\CAUSEINTERRUPT \KbdFXP (FUNCTION \INTERRUPTFRAME)) (SETQ \PENDINGINTERRUPT] [COND ((AND (NEQ \MACHINETYPE \MAIKO) (ILEQ (SETQ LOOPCNT (SUB1 LOOPCNT)) 0)) (* Only do this once in a while) (SETQ LOOPCNT (COND ((\UPDATETIMERS) (* Timer was updated, so do it next time around, too, in case we just came  back from RAID or other bcpl code) 1) (T 20] (COND ([AND NIL \TIMER.INTERRUPT.PENDING (IGREATERP (\BOXIDIFFERENCE (\RCLK (LOCF (fetch DLMOUSETEMP of \MISCSTATS))) (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) 0) (COND ((EQ \TIMER.INTERRUPT.PENDING '\MOUSECHANGE) (SETQ OLDU NIL) T) (T (\CAUSEINTERRUPT \KbdFXP (FUNCTION \TIMER.INTERRUPTFRAME] (SETQ \TIMER.INTERRUPT.PENDING))) (GO LP]) (\RESETKEYBOARD [LAMBDA NIL (* ; "Edited 30-Mar-88 10:07 by Snow") (\SETIOPOINTERS) (* Called with lisp keyboard disabled whenever Lisp is resumed from bcpl  logout or copysys.) (SETQ \KEYBUFFERING NIL) (COND ((OR (EQ \MACHINETYPE \DANDELION) (EQ \MACHINETYPE \DAYBREAK) (EQ \MACHINETYPE \MAIKO)) (* Initialize fake mouse bits to all  up) (\PUTBASE \EM.UTILIN 0 ALLUP))) (with KEYBOARDEVENT \LASTKEYSTATE (SETQ W0 (\GETBASE \EM.KBDAD0 0)) (SETQ W1 (\GETBASE \EM.KBDAD1 0)) (SETQ W2 (\GETBASE \EM.KBDAD2 0)) (SETQ W3 (\GETBASE \EM.KBDAD3 0)) (SETQ W4 (\GETBASE \EM.KBDAD4 0)) (SETQ W5 (\GETBASE \EM.KBDAD5 0)) (SETQ WU (\GETBASE \EM.REALUTILIN 0)) (SETQ LOCK (XKEYDOWNP 'LOCK)) (SETQ 1SHIFT NIL) (SETQ 2SHIFT NIL) (SETQ CTRL NIL) (SETQ META NIL) (SETQ FONT NIL) (SETQ USERMODE1 NIL) (SETQ USERMODE2 NIL) (SETQ USERMODE3 NIL) (SETQ MOUSESTATE \DLMOUSE.UP)) (SETQ \TIMER.INTERRUPT.PENDING) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0) (replace (RING READ) of \SYSBUFFER with 0) (SETQ \LONGSYSBUF) (\DAYTIME0 \LASTUSERACTION) (\KEYBOARDON]) (\DOMOUSECHORDING [LAMBDA (REALUTILIN STATE) (* bvm%: " 9-Oct-85 11:24") (* Handles mouse transitions on a DLion.  REALUTILIN is the actual util word from the processor.  STATE is our internal state. Sets contents of \EM.UTILIN to reflect the  virtual mouse state, which may contain a middle mouse button even where there  is only a two-button mouse. Returns new state) (PROG (LRSTATE) [COND ((OR (NULL \MOUSECHORDTICKS) (EQ (SETQ LRSTATE (LOGXOR (LOGAND REALUTILIN \MOUSE.ALLBITS) \MOUSE.ALLBITS)) 0)) (* Not interpreting chording, or both LEFT and RIGHT are up --  real state and virtual state the same) (SETQ STATE \DLMOUSE.UP)) (T (* Either L or R or both are down, so have to decide about Middle) (SELECTC STATE ((LIST \DLMOUSE.UP \DLMOUSE.WAITING) (SETQ REALUTILIN (LOGOR REALUTILIN \MOUSE.LRBIT)) (* Turn off the L and/or R bits) (COND ((EQ LRSTATE \MOUSE.LRBIT) (* Both L and R down at once, interpret as MIDDLE without waiting) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) REALUTILIN)) (SETQ STATE \DLMOUSE.MIDDLE)) ((NEQ STATE \DLMOUSE.WAITING) (* Only one of L and R down. Set timer, and ignore the down bit for now) (\BOXIPLUS (\RCLK (LOCF (fetch DLMOUSETIMER of \MISCSTATS))) \MOUSECHORDTICKS) (SETQ STATE \DLMOUSE.WAITING)))) (\DLMOUSE.MIDDLE (* State is middle and at least one of L and R is still down, so consider it  to be still only middle) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.LRBIT))) (SELECTC LRSTATE (\MOUSE.LEFTBIT (* Right came up. Henceforth treat  right transparently) (SETQ STATE \DLMOUSE.MIDDLE&RIGHT)) (\MOUSE.RIGHTBIT (* Left came up. Henceforth treat  left transparently) (SETQ STATE \DLMOUSE.MIDDLE&LEFT)) NIL)) (\DLMOUSE.MIDDLE&RIGHT (* Only ignore LEFT) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.LEFTBIT)))) (\DLMOUSE.MIDDLE&LEFT (* Only ignore RIGHT) (SETQ REALUTILIN (LOGAND (LOGXOR ALLUP \MOUSE.MIDDLEBIT) (LOGOR REALUTILIN \MOUSE.RIGHTBIT)))) (PROGN (* Remaining state is \DLMOUSE.NORMAL which means treat mouse normally, and  the only interesting transition is back to \DLMOUSE.UP) ] (\PUTBASE \EM.UTILIN 0 REALUTILIN) (RETURN STATE]) (\DOTRANSITIONS [LAMBDA (KEYBASE OLD NEW) (* ; "Edited 1-Feb-92 11:59 by jds") (* ;; "OLD and NEW are keyboard state words that are known to have changed. KEYBASE is the number in hardware order of the key corresponding to the first bit in these words. This function figures out the indices of transitioning keys and calls the decoder.") (for I (BITMASK _ (LLSH 1 15)) from 0 to 15 do [OR (EQ 0 (LOGAND BITMASK (LOGXOR OLD NEW))) (\DECODETRANSITION (IPLUS I KEYBASE) (EQ 0 (LOGAND NEW BITMASK] (SETQ BITMASK (LRSH BITMASK 1))) T]) (\DECODETRANSITION [LAMBDA (KEYNUMBER DOWNFLG) (* ; "Edited 19-Nov-87 16:29 by Snow") (* ;; "KEYNUMBER is the key number in the hardware keyboard layout, DOWNFLG is T if the key just went down. PENDINGINTERRUPT, bound in \KEYHANDLER, is set to the decoded character if it is an interrupt.") (.NOTELASTUSERACTION) (PROG ((TI (\TRANSINDEX KEYNUMBER DOWNFLG)) (KEYSTATE \LASTKEYSTATE) ASCIICODE SHIFTED) (SELECTC (TRANSITIONFLAGS \CURRENTKEYACTION TI) (IGNORE.TF (RETURN)) (LOCKSHIFT.TF (* ;  "Take shift action if either Shift or Caps Lock is down") (IF (fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE) THEN (SETQ SHIFTED T))) (NOLOCKSHIFT.TF (* ;  "Take shift action only when Shift is down") (IF (fetch (KEYBOARDEVENT SHIFT) of KEYSTATE) THEN (SETQ SHIFTED T))) (EVENT.TF (RETURN)) (1SHIFTUP.TF (replace (KEYBOARDEVENT 1SHIFT) of KEYSTATE with NIL) (RETURN)) (1SHIFTDOWN.TF (replace (KEYBOARDEVENT 1SHIFT) of KEYSTATE with T) (RETURN)) (2SHIFTUP.TF (replace (KEYBOARDEVENT 2SHIFT) of KEYSTATE with NIL) (RETURN)) (2SHIFTDOWN.TF (replace (KEYBOARDEVENT 2SHIFT) of KEYSTATE with T) (RETURN)) (LOCKUP.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with NIL) (RETURN)) (LOCKDOWN.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with T) (RETURN)) (LOCKTOGGLE.TF (replace (KEYBOARDEVENT LOCK) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT LOCK) of KEYSTATE))) (RETURN)) (CTRLUP.TF (replace (KEYBOARDEVENT CTRL) of KEYSTATE with NIL) (RETURN)) (CTRLDOWN.TF (replace (KEYBOARDEVENT CTRL) of KEYSTATE with T) (RETURN)) (METAUP.TF (replace (KEYBOARDEVENT META) of KEYSTATE with NIL) (RETURN)) (METADOWN.TF (replace (KEYBOARDEVENT META) of KEYSTATE with T) (RETURN)) (FONTUP.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with NIL) (RETURN)) (FONTDOWN.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with T) (RETURN)) (FONTTOGGLE.TF (replace (KEYBOARDEVENT FONT) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT FONT) of KEYSTATE))) (RETURN)) (USERMODE1UP.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with NIL) (RETURN)) (USERMODE1DOWN.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with T) (RETURN)) (USERMODE1TOGGLE.TF (replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE1) of KEYSTATE))) (RETURN)) (USERMODE2UP.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with NIL) (RETURN)) (USERMODE2DOWN.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with T) (RETURN)) (USERMODE2TOGGLE.TF (replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE2) of KEYSTATE))) (RETURN)) (USERMODE3UP.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with NIL) (RETURN)) (USERMODE3DOWN.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with T) (RETURN)) (USERMODE3TOGGLE.TF (replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT USERMODE3) of KEYSTATE))) (RETURN)) (SHOULDNT)) (* ;;  "Only the LOCKSHIFT and NOLOCKSHIFT cases make it to here, having set SHIFTED if appropriate.") [SETQ ASCIICODE (COND (SHIFTED (TRANSITIONSHIFTCODE \CURRENTKEYACTION TI)) (T (TRANSITIONCODE \CURRENTKEYACTION TI] [COND ((OR (fetch (KEYBOARDEVENT CTRL) of KEYSTATE) (fetch (KEYBOARDEVENT META) of KEYSTATE) (fetch (KEYBOARDEVENT FONT) of KEYSTATE)) [IF (IGREATERP ASCIICODE 127) THEN (* ;; "Non-ascii interpretation--what is cntrl/meta supposed to mean? Try using the original interpretation. This way we can type ^E or Meta-D even if Russian keyboard is set, but doesn't mess up simple ascii remappings, such as bs->del.") (SETQ ASCIICODE (COND (SHIFTED (TRANSITIONSHIFTCODE \COMMANDKEYACTION TI)) (T (TRANSITIONCODE \COMMANDKEYACTION TI] [COND ((fetch (KEYBOARDEVENT CTRL) of KEYSTATE) (SETQ ASCIICODE (LOGAND ASCIICODE \CTRLMASK] (COND ((AND (OR (fetch (KEYBOARDEVENT META) of KEYSTATE) (fetch (KEYBOARDEVENT FONT) of KEYSTATE)) (ILESSP ASCIICODE \KEYBOARD.META)) (SETQ ASCIICODE (LOGOR ASCIICODE \KEYBOARD.META] (COND ((ASSOC ASCIICODE (fetch INTERRUPTLIST of \CURRENTKEYACTION)) (SETQ PENDINGINTERRUPT T) (replace WAITINGINTERRUPT of \INTERRUPTSTATE with T) (replace INTCHARCODE of \INTERRUPTSTATE with ASCIICODE)) (T (\PUTSYSBUF ASCIICODE]) (MOUSECHORDWAIT [LAMBDA MSECS (* MPL "21-Jun-85 16:31") (DECLARE (GLOBALVARS \RCLKMILLISECOND)) (PROG1 (AND \MOUSECHORDTICKS \MOUSECHORDMILLISECONDS) (COND ((IGREATERP MSECS 0) (SETQ \MOUSECHORDTICKS (AND (ARG MSECS 1) (IMIN MAX.SMALLP (ITIMES (SETQ \MOUSECHORDMILLISECONDS (OR (SMALLP (ARG MSECS 1)) 50)) \RCLKMILLISECOND]) (\TRACKCURSOR [LAMBDA (CURSORX CURSORY) (* ; "Edited 30-Mar-88 11:11 by Snow") (DECLARE (GLOBALVARS \CURSORDESTHEIGHT \CURSORDESTWIDTH)) (.NOTELASTUSERACTION) [COND ((OR [COND ((IGEQ CURSORX (IDIFFERENCE \CURSORDESTWIDTH \CURSORHOTSPOTX)) (* Large cursor values are either out of bounds to the right or are negative  values (16-bit bcpl signed numbers)) (COND [(IGREATERP CURSORX 32767) (* Cursor value is negative) (COND ((ILESSP (IPLUS (SUB1 (IDIFFERENCE CURSORX 65535)) \CURSORHOTSPOTX) 0) (* Cursor pos + hotspot is still off to the left  (the IPLUS is an optimization of (\XMOUSECOORD))%, so clip to effective zero) (SETQ CURSORX (COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) 0) (T (UNSIGNED (IMINUS \CURSORHOTSPOTX) BITSPERWORD] (T (SETQ CURSORX (SUB1 (IDIFFERENCE \CURSORDESTWIDTH \CURSORHOTSPOTX] (IGEQ CURSORY (IDIFFERENCE \CURSORDESTHEIGHT HARDCURSORHEIGHT))) (* repeat test so that both X and Y will get clipped each cycle.  This keeps the cursor from moving off the screen.) [COND ((IGEQ CURSORY (IDIFFERENCE \CURSORDESTHEIGHT \CURSORHOTSPOTY)) (* Large cursor values are either out of bounds to the bottom or are negative  values (16-bit bcpl signed numbers)) (COND [(IGREATERP CURSORY 32767) (* Cursor value is negative) (COND ((ILESSP (IPLUS (SUB1 (IDIFFERENCE CURSORY 65535)) \CURSORHOTSPOTY) 0) (* Cursor pos + hotspot is still off to the top, so clip to effective zero) (SETQ CURSORY (COND ((OR (EQ \MACHINETYPE \DANDELION) (EQ \MACHINETYPE \DAYBREAK)) (* Temporary workaround) 0) (T (UNSIGNED (IMINUS \CURSORHOTSPOTY) BITSPERWORD] (T (SETQ CURSORY (SUB1 (IDIFFERENCE \CURSORDESTHEIGHT \CURSORHOTSPOTY] (* If need to clip mouse, do so here. \SETMOUSEXY MACRO takes dlion  complexities into account.) (COND ((NEQ \MACHINETYPE \MAIKO) (\SETMOUSEXY CURSORX CURSORY] (COND (\SOFTCURSORUPP (\SOFTCURSORPOSITION CURSORX CURSORY))) (COND ((EQ \MACHINETYPE \DAYBREAK) (* Have to kick DAYBREAK IOP to track the cursor.  *) (\DoveDisplay.SetCursorPosition CURSORX CURSORY))) (\PUTBASE \EM.CURSORX 0 CURSORX) (\PUTBASE \EM.CURSORY 0 CURSORY]) ) (DECLARE%: EVAL@COMPILE (RPAQQ \SUN.TYPE3KEYBOARD 0) (RPAQQ \SUN.TYPE4KEYBOARD 1) (RPAQQ \SUN.JLEKEYBOARD 2) (RPAQQ \TOSHIBA.JIS 7) (CONSTANTS (\SUN.TYPE3KEYBOARD 0) (\SUN.TYPE4KEYBOARD 1) (\SUN.JLEKEYBOARD 2) (\TOSHIBA.JIS 7)) ) (RPAQ? \MOUSECHORDTICKS ) (RPAQ? \MOUSECHORDMILLISECONDS 50) (DECLARE%: DONTEVAL@LOAD DOCOPY (\KEYBOARDINIT) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP of \MISCSTATS)) WORDSPERCELL))) ) (DECLARE%: EVAL@COMPILE (RPAQQ ALLUP 65535) (RPAQQ \CTRLMASK 159) (RPAQQ \METABIT 128) (CONSTANTS ALLUP \CTRLMASK \METABIT) ) (RPAQQ DLMOUSEBITS ((\MOUSE.LEFTBIT 4) (\MOUSE.RIGHTBIT 2) (\MOUSE.MIDDLEBIT 1) (\MOUSE.ALLBITS 7) (\MOUSE.LRBIT 6))) (DECLARE%: EVAL@COMPILE (RPAQQ \MOUSE.LEFTBIT 4) (RPAQQ \MOUSE.RIGHTBIT 2) (RPAQQ \MOUSE.MIDDLEBIT 1) (RPAQQ \MOUSE.ALLBITS 7) (RPAQQ \MOUSE.LRBIT 6) (CONSTANTS (\MOUSE.LEFTBIT 4) (\MOUSE.RIGHTBIT 2) (\MOUSE.MIDDLEBIT 1) (\MOUSE.ALLBITS 7) (\MOUSE.LRBIT 6)) ) (RPAQQ DLMOUSESTATES ((\DLMOUSE.UP 0) (\DLMOUSE.WAITING 1) (\DLMOUSE.NORMAL 2) (\DLMOUSE.MIDDLE 3) (\DLMOUSE.MIDDLE&LEFT 4) (\DLMOUSE.MIDDLE&RIGHT 5))) (DECLARE%: EVAL@COMPILE (RPAQQ \DLMOUSE.UP 0) (RPAQQ \DLMOUSE.WAITING 1) (RPAQQ \DLMOUSE.NORMAL 2) (RPAQQ \DLMOUSE.MIDDLE 3) (RPAQQ \DLMOUSE.MIDDLE&LEFT 4) (RPAQQ \DLMOUSE.MIDDLE&RIGHT 5) (CONSTANTS (\DLMOUSE.UP 0) (\DLMOUSE.WAITING 1) (\DLMOUSE.NORMAL 2) (\DLMOUSE.MIDDLE 3) (\DLMOUSE.MIDDLE&LEFT 4) (\DLMOUSE.MIDDLE&RIGHT 5)) ) (RPAQQ TRANSITIONFLAGS (ALTGRDOWN.TF ALTGRUP.TF ALTGRTOGGLE.TF CTRLDOWN.TF CTRLUP.TF DEADKEY.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF USERMODE2UP.TF USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF USERMODE3TOGGLE.TF)) (DECLARE%: EVAL@COMPILE (RPAQQ ALTGRDOWN.TF 27) (RPAQQ ALTGRUP.TF 28) (RPAQQ ALTGRTOGGLE.TF 29) (RPAQQ CTRLDOWN.TF 5) (RPAQQ CTRLUP.TF 4) (RPAQQ DEADKEY.TF 30) (RPAQQ IGNORE.TF 0) (RPAQQ EVENT.TF 1) (RPAQQ LOCKDOWN.TF 8) (RPAQQ LOCKSHIFT.TF 2) (RPAQQ LOCKTOGGLE.TF 14) (RPAQQ LOCKUP.TF 7) (RPAQQ NOLOCKSHIFT.TF 3) (RPAQQ 1SHIFTDOWN.TF 6) (RPAQQ 1SHIFTUP.TF 9) (RPAQQ 2SHIFTDOWN.TF 11) (RPAQQ 2SHIFTUP.TF 10) (RPAQQ METADOWN.TF 13) (RPAQQ METAUP.TF 12) (RPAQQ FONTDOWN.TF 24) (RPAQQ FONTUP.TF 25) (RPAQQ FONTTOGGLE.TF 26) (RPAQQ USERMODE1UP.TF 15) (RPAQQ USERMODE1DOWN.TF 16) (RPAQQ USERMODE1TOGGLE.TF 17) (RPAQQ USERMODE2UP.TF 18) (RPAQQ USERMODE2DOWN.TF 19) (RPAQQ USERMODE2TOGGLE.TF 20) (RPAQQ USERMODE3UP.TF 21) (RPAQQ USERMODE3DOWN.TF 22) (RPAQQ USERMODE3TOGGLE.TF 23) (CONSTANTS ALTGRDOWN.TF ALTGRUP.TF ALTGRTOGGLE.TF CTRLDOWN.TF CTRLUP.TF DEADKEY.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF USERMODE2UP.TF USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF USERMODE3TOGGLE.TF) ) (DECLARE%: EVAL@COMPILE (PUTPROPS \TRANSINDEX MACRO ((KEYNUMBER DOWNFLG) (COND (DOWNFLG (IPLUS \NKEYS KEYNUMBER)) (T KEYNUMBER)))) (PUTPROPS ARMEDCODE MACRO ((TABLE CHAR) (\GETBASEBIT (fetch (KEYACTION ARMED) TABLE) CHAR))) (PUTPROPS TRANSITIONALTGRCODE MACRO ((TABLE CHAR) (\GETBASE (fetch (KEYACTION ALTGRAPHCODES) of TABLE) CHAR))) (PUTPROPS TRANSITIONSHIFTCODE MACRO ((TABLE CHAR) (\GETBASE (fetch (KEYACTION SHIFTCODES) TABLE) CHAR))) (PUTPROPS TRANSITIONCODE MACRO ((TABLE CHAR) (\GETBASE (fetch (KEYACTION CODES) TABLE) CHAR))) (PUTPROPS TRANSITIONFLAGS MACRO ((TABLE CHAR) (\GETBASEBYTE (fetch (KEYACTION FLAGS) TABLE) CHAR))) (PUTPROPS TRANSITIONDEADLIST MACRO ((TABLE CHAR SHIFTED) (\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH (COND (SHIFTED (IPLUS CHAR \NKEYS \NKEYS)) (T CHAR)) 1)))) (PUTPROPS CHECKFORDEADKEY MACRO [(KEYCODE TABLE CHAR SHIFTED) (LET ((CODE KEYCODE)) (COND [(IEQP CODE 65535) `(DEADKEY ,(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH (COND (SHIFTED (IPLUS CHAR \NKEYS \NKEYS)) (T CHAR)) 1] (T CODE]) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (BLOCKRECORD KEYACTION ( (* ;; "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage.") FLAGS (* ; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc.") CODES (* ;  "Table of character codes generated by each key when no shift key is pressed.") SHIFTCODES (* ;  "Table of character codes generated by each key when the shift key is pressed.") ARMED (* ; "Not sure...") INTERRUPTLIST (* ; "List of armed interrupts?") ALTGRAPHCODES (* ;  "Table of codes to be generated when the ALT-GRAPH key is pressed.") DEADKEYLIST (* ; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each %"table%" is an ALIST of orignal code => accented code. no entry means punt the accent..") ) FLAGS _ (\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS) BYTESPERCELL)) CODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) WORDSPERCELL)) SHIFTCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) WORDSPERCELL)) ARMED _ (\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR) BITSPERCELL)) ALTGRAPHCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS) WORDSPERCELL)) DEADKEYLIST _ (\ALLOCBLOCK (PLUS \NKEYS \NKEYS \NKEYS \NKEYS) T) (CREATE (\ALLOCBLOCK 7 PTRBLOCK.GCT)) [TYPE? (AND (\BLOCKDATAP DATUM) (IGEQ (\#BLOCKDATACELLS DATUM) 5) (OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM)) (LISTP (FETCH INTERRUPTLIST OF DATUM))) (\BLOCKDATAP (FETCH (KEYACTION FLAGS) DATUM)) (\BLOCKDATAP (FETCH (KEYACTION CODES) DATUM)) (\BLOCKDATAP (FETCH (KEYACTION ARMED) DATUM]) ) (DECLARE%: EVAL@COMPILE (RPAQQ \NKEYS 112) (CONSTANTS \NKEYS) ) (* "END EXPORTED DEFINITIONS") (DECLARE%: EVAL@COMPILE (BLOCKRECORD RING ((READ WORD) (WRITE WORD))) ) (* ; "can get rid of shiftstate after clients have been fixed") (DECLARE%: EVAL@COMPILE (ACCESSFNS SHIFTSTATE [[DUMMYSHIFT (NOT (EQ 0 (LOGAND (\GETBASEBYTE DATUM 0) (LOGOR 1 2] [DUMMY1SHIFT [NOT (EQ 0 (LOGAND 1 (\GETBASEBYTE DATUM 0] (\PUTBASEBYTE DATUM 0 (COND (NEWVALUE (LOGOR 1 (\GETBASEBYTE DATUM 0)) ) (T (LOGAND (\GETBASEBYTE DATUM 0) (LOGXOR \CHARMASK 1] [DUMMY2SHIFT [NOT (EQ 0 (LOGAND 2 (\GETBASEBYTE DATUM 0] (\PUTBASEBYTE DATUM 0 (COND (NEWVALUE (LOGOR 2 (\GETBASEBYTE DATUM 0)) ) (T (LOGAND (\GETBASEBYTE DATUM 0) (LOGXOR \CHARMASK 2] [DUMMYLOCK [NOT (EQ 0 (LOGAND 4 (\GETBASEBYTE DATUM 0] (\PUTBASEBYTE DATUM 0 (COND (NEWVALUE (LOGOR 4 (\GETBASEBYTE DATUM 0)) ) (T (LOGAND (\GETBASEBYTE DATUM 0) (LOGXOR \CHARMASK 4] [DUMMYSHIFTORLOCK (NOT (EQ 0 (\GETBASEBYTE DATUM 0))) (\PUTBASEBYTE DATUM 0 (COND (NEWVALUE (HELP " Can't turn on SHIFTORLOCK" )) (T 0] [DUMMYCTRL (NOT (EQ 0 (\GETBASEBYTE DATUM 1))) (\PUTBASEBYTE DATUM 1 (COND (NEWVALUE 1) (T 0] [DUMMYMETA (NOT (EQ 0 (\GETBASEBYTE DATUM 2))) (\PUTBASEBYTE DATUM 2 (COND (NEWVALUE 1) (T 0] [DUMMYFONT (NEQ 0 (LOGAND (LLSH 1 3) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 3) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 3] [DUMMYUSERMODE1 (NEQ 0 (LOGAND (LLSH 1 0) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 0) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 0] [DUMMYUSERMODE2 (NEQ 0 (LOGAND (LLSH 1 1) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 1) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 1] [DUMMYUSERMODE3 (NEQ 0 (LOGAND (LLSH 1 2) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 2) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 2] [DUMMYALTGRAPH (NEQ 0 (LOGAND (LLSH 1 4) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 4) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 4] (DUMMYDEADKEYPENDING (NEQ 0 (LOGAND (LLSH 1 5) (\GETBASEBYTE DATUM 3))) (\PUTBASEBYTE DATUM 3 (COND (NEWVALUE (LOGOR (LLSH 1 5) (\GETBASEBYTE DATUM 3))) (T (LOGAND (\GETBASEBYTE DATUM 3) (LOGXOR \CHARMASK (LLSH 1 5] (CREATE (\ALLOCBLOCK (FOLDHI 3 BYTESPERCELL)))) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP) ) (DECLARE%: EVAL@COMPILE (RPAQQ NRINGINDEXWORDS 2) (CONSTANTS NRINGINDEXWORDS) ) (DECLARE%: EVAL@COMPILE (RPAQ \SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) (RPAQ \SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE))) [CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD)) (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE] ) ) (DECLARE%: EVAL@COMPILE (RPAQQ \KEYNAMES ((5 %% FIVE) (4 $ FOUR) (6 ~ SIX) (e E) (7 & SEVEN) (d D) (u U) (v V) (0 %) ZERO) (k K) (- %) (p P) (/ ?) (\ %| FONT LOOKS) (LF SAME) (BS <-) (3 %# THREE) (2 @ TWO) (w W) (q Q) (s S) (a A) (9 %( NINE) (i I) (x X) (o O) (l L) (%, <) (%' %") (%] }) (BLANK-MIDDLE OPEN DBK-HELP) (BLANK-TOP KEYBOARD DBK-META) (1 ! ONE) (ESC ESCAPE ->) (TAB =>) (f F) (CTRL PROP'S EDIT) (c C) (j J) (b B) (z Z) (LSHIFT) (%. >) (; %:) (CR <-%|) (_ ^) (DEL DELETE) (SKIP NEXT) (r R) (t T) (g G) (y Y) (h H) (8 * EIGHT) (n N) (m M) (LOCK) (SPACE) (%[ {) (= +) (RSHIFT) (BLANK-BOTTOM STOP) (MOVE) (UNDO) (UTIL0 SUN-KEYPAD=) (UTIL1 SUN-KEYPAD/) (UTIL2 SUPER/SUB) (UTIL3 CASE) (UTIL4 STRIKEOUT) (UTIL5 KEYPAD2) (UTIL6 KEYPAD3 PGDN) (UTIL7 SUN-LF) (PAD1 LEFTKEY CAPSLOCK KEYPAD+) (PAD2 LEFTMIDDLEKEY NUMLOCK KEYPAD-) (PAD3 MIDDLEKEY SCROLLLOCK KEYPAD*) (PAD4 RIGHTMIDDLEKEY BREAK KEYPAD/ SUN-PAUSE) (PAD5 RIGHTKEY DOIT PRTSC) (LEFT RED MOUSERED) (RIGHT BLUE MOUSEBLUE) (MIDDLE YELLOW MOUSEYELLOW) (MARGINS) (K41 KEYPAD7 HOME) (K42 KEYPAD8) (K43 KEYPAD9 PGUP) (K44 KEYPAD4) (K45 KEYPAD5) (K46 SUN-LEFT-SPACE) (K47 KEYPAD6) (K48 RIGHT-COMMAND SUN-RIGHT-SPACE) (COPY) (FIND) (AGAIN) (HELP) (DEF'N EXPAND) (K4E KEYPAD1 END) (ALWAYS-ON-1) (ALWAYS-ON-2) (CENTER) (K52 KEYPAD0 INS) (BOLD) (ITALICS) (UNDERLINE) (SUPERSCRIPT) (SUBSCRIPT) (LARGER SMALLER) (K59 KEYPAD%| KEYPAD.) (K5A KEYPAD\ KEYPAD, SUN-F10) (K5B SUN-F11) (K5C SUN-F12) (DEFAULTS SUN-PROP) (K5E SUN-PRTSC) (K5F SUN-OPEN))) ) (* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun." ) (RPAQQ \ORIGKEYACTIONS ((0 (53 "%%" NOLOCKSHIFT)) (1 (52 "$" NOLOCKSHIFT)) (2 (54 "~" NOLOCKSHIFT)) (3 ("e" "E" LOCKSHIFT)) (4 (55 "&" NOLOCKSHIFT)) (5 ("d" "D" LOCKSHIFT)) (6 ("u" "U" LOCKSHIFT)) (7 ("v" "V" LOCKSHIFT)) (8 (48 ")" NOLOCKSHIFT)) (9 ("k" "K" LOCKSHIFT)) (10 ("-" "-" NOLOCKSHIFT)) (11 ("p" "P" LOCKSHIFT)) (12 ("/" "?" NOLOCKSHIFT)) (13 ("\" "|" NOLOCKSHIFT)) (14 (10 96 NOLOCKSHIFT)) (15 (8 8 NOLOCKSHIFT)) (16 (51 "#" NOLOCKSHIFT)) (17 (50 "@" NOLOCKSHIFT)) (18 ("w" "W" LOCKSHIFT)) (19 ("q" "Q" LOCKSHIFT)) (20 ("s" "S" LOCKSHIFT)) (21 ("a" "A" LOCKSHIFT)) (22 (57 "(" NOLOCKSHIFT)) (23 ("i" "I" LOCKSHIFT)) (24 ("x" "X" LOCKSHIFT)) (25 ("o" "O" LOCKSHIFT)) (26 ("l" "L" LOCKSHIFT)) (27 ("," "<" NOLOCKSHIFT)) (28 ("'" "%"" NOLOCKSHIFT)) (29 ("]" "}" NOLOCKSHIFT)) (30 (194 194 NOLOCKSHIFT)) (31 (193 193 NOLOCKSHIFT)) (32 (49 "!" NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (34 (9 9 NOLOCKSHIFT)) (35 ("f" "F" LOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (37 ("c" "C" LOCKSHIFT)) (38 ("j" "J" LOCKSHIFT)) (39 ("b" "B" LOCKSHIFT)) (40 ("z" "Z" LOCKSHIFT)) (41 1SHIFTDOWN . 1SHIFTUP) (42 ("." ">" NOLOCKSHIFT)) (43 (";" ":" NOLOCKSHIFT)) (44 (13 13 NOLOCKSHIFT)) (45 ("_" "^" NOLOCKSHIFT)) (46 (127 535 NOLOCKSHIFT)) (47 ("(" "[" NOLOCKSHIFT)) (48 ("r" "R" LOCKSHIFT)) (49 ("t" "T" LOCKSHIFT)) (50 ("g" "G" LOCKSHIFT)) (51 ("y" "Y" LOCKSHIFT)) (52 ("h" "H" LOCKSHIFT)) (53 (56 "*" NOLOCKSHIFT)) (54 ("n" "N" LOCKSHIFT)) (55 ("m" "M" LOCKSHIFT)) (56 LOCKDOWN . LOCKUP) (57 (32 32 NOLOCKSHIFT)) (58 ("[" "{" NOLOCKSHIFT)) (59 ("=" "+" NOLOCKSHIFT)) (60 2SHIFTDOWN . 2SHIFTUP) (61 (195 195 NOLOCKSHIFT)) (63 (")" "]" NOLOCKSHIFT)) (77 EVENT . EVENT) (78 EVENT . EVENT) (79 EVENT . EVENT) (102 LOCKDOWN) (103 LOCKUP))) (RPAQQ \DLIONKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (33 ("\" "|" NOLOCKSHIFT)) (45 (96 "~" NOLOCKSHIFT)) (OPEN METADOWN . METAUP) (PROP'S CTRLDOWN . CTRLUP) (SAME METADOWN . METAUP) (FIND ("2,3" "2,43" NOLOCKSHIFT)) (UNDO ("2,4" "2,44" NOLOCKSHIFT)) (STOP (5 7 NOLOCKSHIFT)) (MOVE) (COPY) (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) (CENTER ("2,101" "2,141" NOLOCKSHIFT)) (BOLD ("2,102" "2,142" NOLOCKSHIFT)) (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) (UNDERLINE ("2,106" "2,146" NOLOCKSHIFT)) (SUPERSCRIPT ("2,113" "2,153" NOLOCKSHIFT)) (SUBSCRIPT ("2,114" "2,154" NOLOCKSHIFT)) (LARGER ("2,110" "2,150" NOLOCKSHIFT)) (DEFAULTS ("2,115" "2,155" NOLOCKSHIFT)) (93 (27 "2,64" NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)) (31 ("2,5" "2,45" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (80 ("2,13" "2,53" NOLOCKSHIFT)) (FONT ("2,112" "2,152" NOLOCKSHIFT)))) (RPAQQ \DLIONOSDKEYACTIONS ((56 LOCKTOGGLE))) (RPAQQ \DORADOKEYACTIONS ((2 (54 "~" NOLOCKSHIFT)) (10 ("-" "-" NOLOCKSHIFT)) (13 ("\" "|" NOLOCKSHIFT)) (14 (10 96 NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (45 ("_" "^" NOLOCKSHIFT)))) (RPAQQ \DOVEKEYACTIONS ((2 (54 "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (56 CTRLDOWN . CTRLUP) (65 (27 27 NOLOCKSHIFT)) (71 (39 34 NOLOCKSHIFT)) (93 ("2,24" "2,64" NOLOCKSHIFT)) (108 (96 126 NOLOCKSHIFT)) (DBK-META METADOWN . METAUP) (DBK-HELP ("2,1" "2,41" NOLOCKSHIFT)) (SAME METADOWN . METAUP) (FIND ("2,3" "2,43" NOLOCKSHIFT)) (UNDO ("2,4" "2,44" NOLOCKSHIFT)) (STOP (5 7 NOLOCKSHIFT)) (EDIT ("2,5" "2,45" NOLOCKSHIFT)) (MOVE) (COPY) (AGAIN ("2,10" "2,50" NOLOCKSHIFT)) (CENTER ("2,101" "2,141" NOLOCKSHIFT)) (BOLD ("2,102" "2,142" NOLOCKSHIFT)) (ITALICS ("2,103" "2,143" NOLOCKSHIFT)) (CASE ("2,104" "2,144" NOLOCKSHIFT)) (STRIKEOUT ("2,105" "2,145" NOLOCKSHIFT)) (UNDERLINE ("2,106" "2,146" NOLOCKSHIFT)) (SUPER/SUB ("2,107" "2,147" NOLOCKSHIFT)) (LARGER ("2,110" "2,150" NOLOCKSHIFT)) (MARGINS ("2,111" "2,151" NOLOCKSHIFT)) (LOOKS ("2,112" "2,152" NOLOCKSHIFT)) (CAPSLOCK LOCKTOGGLE) (NUMLOCK ("2,11" "-" NOLOCKSHIFT)) (SCROLLLOCK ("2,12" 180 NOLOCKSHIFT)) (BREAK (2 184 NOLOCKSHIFT)) (DOIT ("2,13" "2,53" NOLOCKSHIFT)) (KEYPAD7 ("2,14" 55 NOLOCKSHIFT)) (KEYPAD8 (173 56 NOLOCKSHIFT)) (KEYPAD9 ("2,15" 57 NOLOCKSHIFT)) (KEYPAD4 (172 52 NOLOCKSHIFT)) (KEYPAD5 ("2,16" 53 NOLOCKSHIFT)) (KEYPAD6 (174 54 NOLOCKSHIFT)) (KEYPAD1 ("2,17" 49 NOLOCKSHIFT)) (KEYPAD2 (175 50 NOLOCKSHIFT)) (KEYPAD3 ("2,20" 51 NOLOCKSHIFT)) (KEYPAD0 ("2,21" 48 NOLOCKSHIFT)) (KEYPAD%| ("|" 46 NOLOCKSHIFT)) (KEYPAD\ ("\" 44 NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)))) (RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP) (36 CTRLDOWN . CTRLUP) (CAPSLOCK ("2,5" "2,45" NOLOCKSHIFT)))) (RPAQQ \MAIKOKEYACTIONS ((61 (5 7 NOLOCKSHIFT)) (91 (520 552 NOLOCKSHIFT)) (92 (513 545 NOLOCKSHIFT)) (30 (513 545 NOLOCKSHIFT)) (63 (516 548 NOLOCKSHIFT)) (93 (532 564 NOLOCKSHIFT)) (62) (111 (329 263 NOLOCKSHIFT)) (89) (90 (515 547 NOLOCKSHIFT)) (73 (521 521 NOLOCKSHIFT)) (74 (522 522 NOLOCKSHIFT)) (75 (2 2 NOLOCKSHIFT)) (81 (524 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT)) (83 (525 57 NOLOCKSHIFT)) (84 (172 52 NOLOCKSHIFT)) (85 (526 53 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (94 (527 49 NOLOCKSHIFT)) (69 (175 50 NOLOCKSHIFT)) (70 (528 51 NOLOCKSHIFT)) (98 (529 48 NOLOCKSHIFT)) (76 (523 555 NOLOCKSHIFT)) (72 LOCKTOGGLE) (97 (577 609 NOLOCKSHIFT)) (99 (578 610 NOLOCKSHIFT)) (100 (579 611 NOLOCKSHIFT)) (67 (580 612 NOLOCKSHIFT)) (68 (581 613 NOLOCKSHIFT)) (101 (582 614 NOLOCKSHIFT)) (66 (583 615 NOLOCKSHIFT)) (104 (584 616 NOLOCKSHIFT)) (80 (585 617 NOLOCKSHIFT)) (13 (23 21 NOLOCKSHIFT)) (33 (27 27 NOLOCKSHIFT)) (65 (27 27 NOLOCKSHIFT)) (2 (54 94 NOLOCKSHIFT)) (10 (45 95 NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (56 LOCKTOGGLE . IGNORE) (45 (96 126 NOLOCKSHIFT)) (31 METADOWN . METAUP) (14 METADOWN . METAUP) (71 (10 10 NOLOCKSHIFT)) (47 (530 562 NOLOCKSHIFT)) (105 (92 124 NOLOCKSHIFT)))) (RPAQQ \MAIKOKEYACTIONST4 ((61 ("^E" "^G" NOLOCKSHIFT)) (91 ("2,10" "2,50" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (30 ("2,1" "2,41" NOLOCKSHIFT)) (109 ("2,25" "2,65" NOLOCKSHIFT)) (63 ("2,4" "2,44" NOLOCKSHIFT)) (14 METADOWN . METAUP) (93 ("2,24" "2,64" NOLOCKSHIFT)) (62) (111 ("1,111" "1,79" NOLOCKSHIFT)) (89) (90 ("2,3" "2,43" NOLOCKSHIFT)) (73 ("2,11" "2,11" NOLOCKSHIFT)) (74 ("2,12" "2,12" NOLOCKSHIFT)) (75 ("^B" "^B" NOLOCKSHIFT)) (81 ("2,14" 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT)) (83 ("2,15" 57 NOLOCKSHIFT)) (84 (172 52 NOLOCKSHIFT)) (85 ("2,16" 53 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (94 ("2,17" 49 NOLOCKSHIFT)) (69 (175 50 NOLOCKSHIFT)) (70 ("2,20" 51 NOLOCKSHIFT)) (98 ("2,21" 48 NOLOCKSHIFT)) (76 ("2,13" "2,13" NOLOCKSHIFT)) (110 ("2,53" "2,53" NOLOCKSHIFT)) (72 LOCKTOGGLE) (97 ("2,101" "2,141" NOLOCKSHIFT)) (99 ("2,102" "2,142" NOLOCKSHIFT)) (100 ("2,103" "2,143" NOLOCKSHIFT)) (67 ("2,104" "2,144" NOLOCKSHIFT)) (68 ("2,105" "2,145" NOLOCKSHIFT)) (101 ("2,106" "2,146" NOLOCKSHIFT)) (66 ("2,107" "2,147" NOLOCKSHIFT)) (104 ("2,110" "2,150" NOLOCKSHIFT)) (80 ("2,111" "2,151" NOLOCKSHIFT)) (106 ("2,113" "2,153" NOLOCKSHIFT)) (107 ("2,114" "2,154" NOLOCKSHIFT)) (108 ("2,115" "2,155" NOLOCKSHIFT)) (13 ("^W" "^U" NOLOCKSHIFT)) (33 ("ESC" "ESC" NOLOCKSHIFT)) (64 IGNORE . IGNORE) (65 (27 27 NOLOCKSHIFT)) (95 IGNORE . IGNORE) (96 IGNORE . IGNORE) (102 IGNORE . IGNORE) (2 ("6" "^" NOLOCKSHIFT)) (10 ("-" "_" NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (56 LOCKTOGGLE . IGNORE) (45 ("`" "~" NOLOCKSHIFT)) (31 METADOWN . METAUP) (71 (10 10 NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)) (86 IGNORE . IGNORE) (88 IGNORE . IGNORE) (105 ("\" "|" NOLOCKSHIFT)))) (RPAQQ \MAIKO-JLE-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) (4 ("7" "'" NOLOCKSHIFT)) (8 ("0" "0" NOLOCKSHIFT)) (10 ("\" "_" NOLOCKSHIFT)) (13 ("^W" "^U" NOLOCKSHIFT)) (14 METADOWN . METAUP) (15 (8 8 NOLOCKSHIFT)) (17 ("2" "%"" NOLOCKSHIFT)) (22 ("9" ")" NOLOCKSHIFT)) (28 (":" "*" NOLOCKSHIFT)) (29 ("[" "{" NOLOCKSHIFT)) (30 ("]" "}" NOLOCKSHIFT)) (31 METADOWN . METAUP) (33 ("ESC" "ESC" NOLOCKSHIFT)) (36 CTRLDOWN . CTRLUP) (43 (";" "+" NOLOCKSHIFT)) (45 ("^" "~" NOLOCKSHIFT)) (47 ("2,22" "2,62" NOLOCKSHIFT)) (53 ("8" "(" NOLOCKSHIFT)) (56 LOCKTOGGLE . IGNORE) (58 ("@" "`" NOLOCKSHIFT)) (59 ("-" "=" NOLOCKSHIFT)) (61 ("^E" "^G" NOLOCKSHIFT)) (62) (63 ("2,4" "2,44" NOLOCKSHIFT)) (64 ("2,14" 55 NOLOCKSHIFT)) (65 (27 27 NOLOCKSHIFT)) (66 ("2,107" "2,147" NOLOCKSHIFT)) (67 ("2,104" "2,144" NOLOCKSHIFT)) (69 ("2,13" "2,53" NOLOCKSHIFT)) (70 ("2,20" 51 NOLOCKSHIFT)) (71 (10 10 NOLOCKSHIFT)) (72 (766 766 NOLOCKSHIFT)) (73 ("2,11" "2,11" NOLOCKSHIFT)) (74 ("2,12" "2,12" NOLOCKSHIFT)) (75 ("^B" "^B" NOLOCKSHIFT)) (80 ("2,111" "2,151" NOLOCKSHIFT)) (81 ("2,14" 55 NOLOCKSHIFT)) (82 (173 56 NOLOCKSHIFT)) (83 ("2,15" 57 NOLOCKSHIFT)) (84 (172 52 NOLOCKSHIFT)) (85 ("2,16" 53 NOLOCKSHIFT)) (86 (765 765 NOLOCKSHIFT)) (87 (174 54 NOLOCKSHIFT)) (88 (770 771 NOLOCKSHIFT)) (90 ("2,3" "2,43" NOLOCKSHIFT)) (91 ("2,10" "2,50" NOLOCKSHIFT)) (92 ("2,1" "2,41" NOLOCKSHIFT)) (93 ("2,24" "2,64" NOLOCKSHIFT)) (96 IGNORE . IGNORE) (98 ("2,21" 48 NOLOCKSHIFT)) (99 ("2,102" "2,142" NOLOCKSHIFT)) (101 ("2,106" "2,146" NOLOCKSHIFT)) (102 IGNORE . IGNORE) (103 (767 768 NOLOCKSHIFT)) (104 ("2,110" "2,150" NOLOCKSHIFT)) (105 ("\" "|" NOLOCKSHIFT)) (106 ("2,113" "2,153" NOLOCKSHIFT)) (107 ("2,114" "2,154" NOLOCKSHIFT)) (108 ("2,115" "2,155" NOLOCKSHIFT)) (109 (769 769 NOLOCKSHIFT)) (110 ("2,53" "2,53" NOLOCKSHIFT)) (111 ("1,111" "1,79" NOLOCKSHIFT)))) (RPAQQ \TOSHIBA-KEYACTIONS ((2 ("6" "&" NOLOCKSHIFT)) (4 ("7" "'" NOLOCKSHIFT)) (17 ("2" "%"" NOLOCKSHIFT)) (53 ("8" "(" NOLOCKSHIFT)) (22 ("9" ")" NOLOCKSHIFT)) (8 ("0" "0" NOLOCKSHIFT)) (10 ("-" "=" NOLOCKSHIFT)) (59 ("^" "~" NOLOCKSHIFT)) (45 ("\" "|" NOLOCKSHIFT)) (58 ("@" "`" NOLOCKSHIFT)) (29 ("[" "{" NOLOCKSHIFT)) (105 ("]" "}" NOLOCKSHIFT)) (43 (";" "+" NOLOCKSHIFT)) (28 (":" "*" NOLOCKSHIFT)) (15 (23 95 NOLOCKSHIFT)) (13 (8 8 NOLOCKSHIFT)) (86 METADOWN . METAUP) (73 (530 562 NOLOCKSHIFT)) (88 ("2,24" "2,64" NOLOCKSHIFT)) (98 IGNORE . IGNORE) (75 ("2,11" "2,11" NOLOCKSHIFT)) (110 ("2,12" "2,12" NOLOCKSHIFT)) (74 ("^B" "^B" NOLOCKSHIFT)) (64 ("2,14" 55 NOLOCKSHIFT)) (65 (173 56 NOLOCKSHIFT)) (95 ("2,15" 57 NOLOCKSHIFT)) (81 (172 52 NOLOCKSHIFT)) (82 ("2,16" 53 NOLOCKSHIFT)) (83 (174 54 NOLOCKSHIFT)) (84 ("2,17" 49 NOLOCKSHIFT)) (85 (175 50 NOLOCKSHIFT)) (87 ("2,20" 51 NOLOCKSHIFT)) (94 ("2,21" 48 NOLOCKSHIFT)) (69 ("2,13" "2,53" NOLOCKSHIFT)) (70 LOCKTOGGLE))) (RPAQQ KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS NIL) (RPAQ? \KEYBOARD.META 256) (RPAQ? \MODIFIED.KEYACTIONS ) (DECLARE%: EVAL@COMPILE (ADDTOVAR GLOBALVARS \RCLKSECOND \LASTUSERACTION \LASTKEYSTATE) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS) ) (* ; "Key interpretation") (DEFINEQ (KEYACTION [LAMBDA (KEYNAME ACTIONS TABLE) (* ; "Edited 19-Nov-87 16:19 by Snow") (LET ((NUMB (OR (SMALLP KEYNAME) (\KEYNAMETONUMBER KEYNAME))) (TABLE (OR TABLE \CURRENTKEYACTION))) (OR (TYPE? KEYACTION TABLE) (\ILLEGAL.ARG TABLE)) (* ;  "Make sure he supplied a valid TABLE argument.") (CONS (\KEYACTION1 (\TRANSINDEX NUMB T) (AND ACTIONS (OR (CAR ACTIONS) 'IGNORE)) TABLE) (\KEYACTION1 (\TRANSINDEX NUMB NIL) (AND ACTIONS (OR (CDR ACTIONS) 'IGNORE)) TABLE]) (KEYACTIONTABLE [LAMBDA (OLD) (* ; "Edited 23-Mar-92 12:44 by jds") (* ;; "Create a fresh key action table (or copy OLD so it can be modified without danger). Returns a fresh keyaction table.") (COND (OLD (* ;; "He supplied an existing table; create a copy of it:") (OR (type? KEYACTION OLD) (\ILLEGAL.ARG OLD)) (* ;  "Make sure the argument IS a key action table.") (create KEYACTION copying OLD)) (T (* ;; "Create a completely fresh table, filled in from \ORIGKEYACTIONS, and the machine-specific exceptions:") (PROG1 (SETQ OLD (create KEYACTION)) (for X in (APPEND (COPY \ORIGKEYACTIONS) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS) KEYBOARD.APPLICATION-SPECIFIC-KEYACTIONS) do (KEYACTION (CAR X) (CDR X) OLD)))]) (KEYBOARDTYPE [LAMBDA NIL (* ; "Edited 6-Nov-95 15:35 by ") (* ; "Edited 17-Feb-95 14:36 by rmk:") (* ;  "Edited 16-Jun-92 11:03 by kaplan") (* ;; "Returns a symbol identifying the currently connected keyboard type. For now, infers it from the machine type, defaults to NIL (= unknown).") (LET ((MT (MACHINETYPE))) (SELECTQ MT (MAIKO (OR [CADR (SASSOC (L-CASE (UNIX-GETENV "LDEKBDTYPE")) '(("type3" SUN3) ("type4" SUN4) ("type5" SUN5] (MKATOM (U-CASE (UNIX-GETENV "LDEKBDTYPE"))) (AND (STREQUAL "dos" (UNIX-GETPARM "ARCH")) 'FULL-IBMPC))) ((DORADO DANDELION DOVE) MT) NIL]) (RESETKEYACTION [LAMBDA (TABLE FROM RESETINTERRUPTS) (* ; "Edited 19-Nov-87 16:55 by Snow") (* ;; "Resets the actions of key transitions in the keyaction table TABLE, copying in the actions from FROM. If RESETINTERRUPTS is true, also copies the interrupt-character settings from FROM.") (DECLARE (GLOBALVARS \DEFAULTKEYACTION)) (* ;; "do some type checking first.") (OR (type? KEYACTION TABLE) (\ILLEGAL.ARG TABLE)) (OR FROM (SETQ FROM \DEFAULTKEYACTION)) (OR (type? KEYACTION FROM) (\ILLEGAL.ARG TABLE)) (* ;; "do the resetting.") (\BLT (fetch (KEYACTION FLAGS) of TABLE) (fetch (KEYACTION FLAGS) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION FLAGS) of TABLE)) 1)) (\BLT (fetch (KEYACTION CODES) of TABLE) (fetch (KEYACTION CODES) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION CODES) of TABLE)) 1)) (\BLT (fetch (KEYACTION SHIFTCODES) of TABLE) (fetch (KEYACTION SHIFTCODES) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION SHIFTCODES) of TABLE)) 1)) [if RESETINTERRUPTS then (\BLT (fetch (KEYACTION ARMED) of TABLE) (fetch (KEYACTION ARMED) of FROM) (LLSH (\#BLOCKDATACELLS (fetch (KEYACTION ARMED) of TABLE)) 1)) (replace (KEYACTION INTERRUPTLIST) of TABLE with (COPY (fetch (KEYACTION INTERRUPTLIST) of FROM] TABLE]) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS [LAMBDA NIL (* ; "Edited 18-Sep-90 22:36 by jds") (* ;;  "Return a list of machine-specific keyactions appropriate to the machine you're running on.") (* ;; "Also take account (on Maiko implementations) of whether we're running under X or not -- the CAPS-LOCK key works differently.") (SELECTC \MACHINETYPE (\DORADO \DORADOKEYACTIONS) (\DANDELION \DLIONKEYACTIONS) (\MAIKO (LET [(CAPS-LOCK-ACTIONS (COND ((EQUAL (UNIX-GETPARM "DISPLAY") "X") '((56 LOCKDOWN . LOCKUP) (72 LOCKDOWN . LOCKUP] (* ;; "If we're running under X windows, CAPS-LOCK-ACTIONS, appended to the normal keyactions, will reset the keyboard appropriately.") (COND ((EQUAL \SUN.TYPE3KEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage))) (APPEND \MAIKOKEYACTIONS CAPS-LOCK-ACTIONS)) ((EQUAL \SUN.TYPE4KEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage))) (APPEND \MAIKOKEYACTIONST4 CAPS-LOCK-ACTIONS)) ((EQUAL \SUN.JLEKEYBOARD (LOGAND 7 (fetch (IFPAGE DEVCONFIG) of \InterfacePage ))) \MAIKO-JLE-KEYACTIONS) ((EQUAL \TOSHIBA.JIS (LOGAND 7 (FETCH (IFPAGE DEVCONFIG) OF \InterfacePage ))) (* ; "Toshiba JIS") (APPEND \MAIKOKEYACTIONST4 \TOSHIBA-KEYACTIONS)) (T (* ; "default is type3") \MAIKOKEYACTIONS)))) (\DAYBREAK (* ;  "Moving to a daybreak. Need to distinguish among the various kinds of keyboard.") (* ;; "For now, we only distinguish between the office keyboards (1 = US, 2 = Euro, 3 = Japanese, 4 = ADM-3), and some yet-to-be-determined Lisp-keyboard number") (COND ((ILEQ (\DoveMisc.ReadKeyboardType) 4) (* ;  "It's an office keyboard. Set it up right!") (APPEND \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)) (T (* ;  "Lisp keyboard. Leave the Dove keyactions as they were.") \DOVEKEYACTIONS))) NIL]) (\KEYACTION1 [LAMBDA (TI ACTION TABLE) (* ; "Edited 4-Mar-92 13:59 by jds") (PROG1 (SELECTC (TRANSITIONFLAGS TABLE TI) (IGNORE.TF 'IGNORE) ((LIST LOCKSHIFT.TF NOLOCKSHIFT.TF) [LET (CODE) (LIST (CHECKFORDEADKEY (TRANSITIONCODE TABLE TI) TABLE TI NIL) (CHECKFORDEADKEY (TRANSITIONSHIFTCODE TABLE TI) TABLE TI T) (TRANSITIONALTGRCODE TABLE TI) (COND ((EQ LOCKSHIFT.TF (TRANSITIONFLAGS TABLE TI)) 'LOCKSHIFT) (T 'NOLOCKSHIFT]) (EVENT.TF 'EVENT) (CTRLDOWN.TF 'CTRLDOWN) (CTRLUP.TF 'CTRLUP) (DEADKEY.TF (LIST 'DEADKEY (TRANSITIONDEADLIST TABLE TI) (TRANSITIONDEADLIST TABLE TI T))) (1SHIFTDOWN.TF '1SHIFTDOWN) (1SHIFTUP.TF '1SHIFTUP) (2SHIFTDOWN.TF '2SHIFTDOWN) (2SHIFTUP.TF '2SHIFTUP) (LOCKDOWN.TF 'LOCKDOWN) (LOCKUP.TF 'LOCKUP) (LOCKTOGGLE.TF 'LOCKTOGGLE) (METADOWN.TF 'METADOWN) (METAUP.TF 'METAUP) (FONTUP.TF 'FONTUP) (FONTDOWN.TF 'FONTDOWN) (FONTTOGGLE.TF 'FONTTOGGLE) (USERMODE1UP.TF 'USERMODE1UP) (USERMODE1DOWN.TF 'USERMODE1DOWN) (USERMODE1TOGGLE.TF 'USERMODE1TOGGLE) (USERMODE2UP.TF 'USERMODE2UP) (USERMODE2DOWN.TF 'USERMODE2DOWN) (USERMODE2TOGGLE.TF 'USERMODE2TOGGLE) (USERMODE3UP.TF 'USERMODE3UP) (USERMODE3DOWN.TF 'USERMODE3DOWN) (USERMODE3TOGGLE.TF 'USERMODE3TOGGLE) (ALTGRUP.TF 'ALTGRUP) (ALTGRDOWN.TF 'ALTGRDOWN) (ALTGRTOGGLE.TF 'ALTGRTOGGLE) (SHOULDNT)) [SELECTQ ACTION ((NIL NOCHANGE)) (IGNORE (change (TRANSITIONFLAGS TABLE TI) IGNORE.TF)) (EVENT (change (TRANSITIONFLAGS TABLE TI) EVENT.TF)) (CTRLUP (change (TRANSITIONFLAGS TABLE TI) CTRLUP.TF)) (CTRLDOWN (change (TRANSITIONFLAGS TABLE TI) CTRLDOWN.TF)) (1SHIFTUP (change (TRANSITIONFLAGS TABLE TI) 1SHIFTUP.TF)) (1SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI) 1SHIFTDOWN.TF)) (2SHIFTUP (change (TRANSITIONFLAGS TABLE TI) 2SHIFTUP.TF)) (2SHIFTDOWN (change (TRANSITIONFLAGS TABLE TI) 2SHIFTDOWN.TF)) (LOCKUP (change (TRANSITIONFLAGS TABLE TI) LOCKUP.TF)) (LOCKDOWN (change (TRANSITIONFLAGS TABLE TI) LOCKDOWN.TF)) (LOCKTOGGLE (change (TRANSITIONFLAGS TABLE TI) LOCKTOGGLE.TF)) (METAUP (change (TRANSITIONFLAGS TABLE TI) METAUP.TF)) (METADOWN (change (TRANSITIONFLAGS TABLE TI) METADOWN.TF)) (FONTUP (change (TRANSITIONFLAGS TABLE TI) FONTUP.TF)) (FONTDOWN (change (TRANSITIONFLAGS TABLE TI) FONTDOWN.TF)) (FONTTOGGLE (change (TRANSITIONFLAGS TABLE TI) FONTTOGGLE.TF)) (USERMODE1UP (change (TRANSITIONFLAGS TABLE TI) USERMODE1UP.TF)) (USERMODE1DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE1DOWN.TF)) (USERMODE1TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE1TOGGLE.TF)) (USERMODE2UP (change (TRANSITIONFLAGS TABLE TI) USERMODE2UP.TF)) (USERMODE2DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE2DOWN.TF)) (USERMODE2TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE2TOGGLE.TF)) (USERMODE3UP (change (TRANSITIONFLAGS TABLE TI) USERMODE3UP.TF)) (USERMODE3DOWN (change (TRANSITIONFLAGS TABLE TI) USERMODE3DOWN.TF)) (USERMODE3TOGGLE (change (TRANSITIONFLAGS TABLE TI) USERMODE3TOGGLE.TF)) (ALTGRUP (change (TRANSITIONFLAGS TABLE TI) ALTGRUP.TF)) (ALTGRDOWN (change (TRANSITIONFLAGS TABLE TI) ALTGRDOWN.TF)) (ALTGRTOGGLE (change (TRANSITIONFLAGS TABLE TI) ALTGRTOGGLE.TF)) (PROG (CODE SHIFTCODE ALTGRCODE ACT DEAD SHIFTDEAD) (COND ([AND [OR (AND (AND (LISTP (CAR (LISTP ACTION))) (EQ (CAAR (LISTP ACTION)) 'DEADKEY)) [SETQ DEAD (for PAIR in (CADAR (LISTP ACTION)) collect (* ;;  "Make sure we'll take string charcode specs in the deadkey list.") (CONS (OR (AND (\CHARCODEP (CAR PAIR)) (CAR PAIR)) (APPLY* (FUNCTION CHARCODE) (CAR PAIR))) (OR (AND (\CHARCODEP (CDR PAIR)) (CDR PAIR)) (APPLY* (FUNCTION CHARCODE) (CDR PAIR] (SETQ CODE 65535)) [\CHARCODEP (SETQ CODE (\GETCHARCODE (CAR (LISTP ACTION] (SETQ CODE (APPLY* (FUNCTION CHARCODE) (CAR (LISTP ACTION] [OR (AND (AND (LISTP (CADR (LISTP ACTION))) (EQ (CAADR (LISTP ACTION)) 'DEADKEY)) [SETQ SHIFTDEAD (for PAIR in (CADADR (LISTP ACTION)) collect (CONS (OR (AND (\CHARCODEP (CAR PAIR)) (CAR PAIR)) (APPLY* (FUNCTION CHARCODE) (CAR PAIR))) (OR (AND (\CHARCODEP (CDR PAIR)) (CDR PAIR)) (APPLY* (FUNCTION CHARCODE) (CDR PAIR] (SETQ SHIFTCODE 65535) (SETQ ACT (CDR ACTION))) [\CHARCODEP (SETQ SHIFTCODE (\GETCHARCODE (CAR (SETQ ACT (LISTP (CDR ACTION] (SETQ SHIFTCODE (APPLY* (FUNCTION CHARCODE) (CAR ACT] (OR (NULL (SETQ ACT (CDR ACT))) (LISTP ACT)) (SELECTQ (CAR ACT) ((LOCKSHIFT T) (change (TRANSITIONFLAGS TABLE TI) LOCKSHIFT.TF)) ((NOLOCKSHIFT NIL) (change (TRANSITIONFLAGS TABLE TI) NOLOCKSHIFT.TF)) (AND [OR [\CHARCODEP (SETQ ALTGRCODE (\GETCHARCODE (CAR ACT] (SETQ ALTGRCODE (APPLY* (FUNCTION CHARCODE) (CAR ACT] (OR (NULL (SETQ ACT (CDR ACT))) (LISTP ACT)) (SELECTQ (CAR ACT) ((LOCKSHIFT T) (change (TRANSITIONFLAGS TABLE TI) LOCKSHIFT.TF)) ((NOLOCKSHIFT NIL) (change (TRANSITIONFLAGS TABLE TI) NOLOCKSHIFT.TF)) NIL] (change (TRANSITIONCODE TABLE TI) CODE) (change (TRANSITIONSHIFTCODE TABLE TI) SHIFTCODE) (\RPLPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH TI 1) DEAD) (\RPLPTR (fetch (KEYACTION DEADKEYLIST) of TABLE) (LLSH (IPLUS \NKEYS \NKEYS TI) 1) SHIFTDEAD) (AND ALTGRCODE (change (TRANSITIONALTGRCODE TABLE TI) ALTGRCODE))) (T (\ILLEGAL.ARG ACTION])]) (KEYDOWNP [LAMBDA (KEYNAME) (* lmm "18-Apr-85 02:09") (* T if the indicated key is  instantaneously down.) (\NEWKEYDOWNP (\KEYNAMETONUMBER KEYNAME]) (KEYNUMBERP [LAMBDA (X) (* ; "Edited 16-Jan-96 13:16 by rmk") (AND (SMALLP X) (IGEQ X 0) (ILESSP X \NKEYS) X]) (\KEYNAMETONUMBER [LAMBDA (KEYNAME) (* rmk%: " 2-SEP-83 10:29") (DECLARE (GLOBALVARS \KEYNAMES)) (* The fast case is when KEYNAME is  lower-case) (for X N in \KEYNAMES as I from 0 when (EQMEMB KEYNAME X) do (RETURN I) finally (RETURN (OR (AND (NEQ KEYNAME (SETQ N (L-CASE KEYNAME))) (for Y in \KEYNAMES as I from 0 when (EQMEMB N Y) do (RETURN I))) (\ILLEGAL.ARG KEYNAME]) (MODIFY.KEYACTIONS [LAMBDA (KeyActions SaveCurrent?) (* ; "Edited 2-Feb-89 15:38 by GADENER") (PROG1 [if SaveCurrent? then (SETQ \MODIFIED.KEYACTIONS (for ITEM in KeyActions collect (CONS (CAR ITEM) (KEYACTION (CAR ITEM] [for action in KeyActions do (for table in '(\CURRENTKEYACTION \COMMANDKEYACTION) do (KEYACTION (CAR action) (CDR action) (EVAL table])]) (METASHIFT [LAMBDA FLG (* ; "Edited 19-Nov-87 16:59 by Snow") (* ;; "Sets interpretation of swat key to first arg, where T means meta-shift, NIL means original setting. Returns previous setting") (PROG ((METASTATUS '(METADOWN . METAUP)) OLDSETTING) [SETQ OLDSETTING (KEYACTION 'BLANK-BOTTOM (AND (IGREATERP FLG 0) (COND ((EQ (ARG FLG 1) T) METASTATUS) (T (OR (ARG FLG 1) (CDR (ASSOC 'BLANK-BOTTOM \ORIGKEYACTIONS] (RETURN (COND ((EQUAL OLDSETTING METASTATUS) T) (T OLDSETTING]) (SHIFTDOWNP [LAMBDA (SHIFT) (* lmm "18-Apr-85 01:07") (* Tells whether a given shift is  down) (SELECTQ SHIFT (LOCK (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)) (META (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE)) (SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE))) (1SHIFT (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)) (2SHIFT (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)) (SHIFTORLOCK (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))) (CTRL (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE)) (FONT (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE)) (USERMODE1 (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE)) (USERMODE2 (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE)) (USERMODE3 (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE)) (\ILLEGAL.ARG SHIFT]) ) (* ; "To support office style 1108 & 1186 keyboards") (DEFINEQ (SETUP.OFFICE.KEYBOARD [LAMBDA NIL (* jds " 8-Oct-85 16:27") (SELECTQ (MACHINETYPE) (DANDELION (MODIFY.KEYACTIONS \DLIONOSDKEYACTIONS)) (DOVE (MODIFY.KEYACTIONS \DOVEOSDKEYACTIONS)) NIL]) ) (DEFOPTIMIZER \KEYNAMETONUMBER (&REST X) [LET [(CE (CONSTANTEXPRESSIONP (CAR X] (COND (CE (\KEYNAMETONUMBER (CAR CE))) (T 'IGNOREMACRO]) (DECLARE%: EVAL@COMPILE (PUTPROPS \TEMPCOPYTIMER MACRO ((X) (PROGN (\BLT \MOUSETIMERTEMP (LOCF X) WORDSPERCELL) \MOUSETIMERTEMP))) ) (* ; "Don't copy this optimizer since it expands out to \getbasebit, but do exportit.") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DEFOPTIMIZER KEYDOWNP (KEYNAME) `(\NEWKEYDOWNP (\KEYNAMETONUMBER ,KEYNAME))) (* "END EXPORTED DEFINITIONS") ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS XKEYDOWNP MACRO ((KEYNAME) (KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME)))) (PUTPROPS KEYDOWNP1 MACRO [OPENLAMBDA (KEYNUMBER) (DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5)) (PROG NIL (RETURN (EQ 0 (LOGAND (LRSH (LLSH 1 15) (PROGN (* (IMOD KEYNUMBER BITSPERWORD) -  GETD cause IMOD and BITSPERWORD not  exported to user) (LOGAND KEYNUMBER 15))) (\GETBASE (SELECTQ (PROGN (* (FOLDLO KEYNUMBER BITSPERWORD)  GETD follows since FOLDLO and  BITSPERWORD not exported to user) (LRSH KEYNUMBER 4)) (0 \EM.KBDAD0) (1 \EM.KBDAD1) (2 \EM.KBDAD2) (3 \EM.KBDAD3) (4 \EM.UTILIN) (5 (OR \EM.KBDAD4 (RETURN))) (6 (OR \EM.KBDAD5 (RETURN))) (RETURN)) 0]) (PUTPROPS \NEWKEYDOWNP MACRO ((KEYNUMBER) (EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER)))) ) (* "END EXPORTED DEFINITIONS") (* ; "A raw keyboard device/stream") (DEFINEQ (\INIT.KEYBOARD.STREAM [LAMBDA NIL (* ; "Edited 4-Sep-87 10:25 by jds") (* ;; "Initialize the %"Keyboard%" device: Set up the FDEV and the prototype keyboard stream in their respective global variables.") (DECLARE (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)) [\DEFINEDEVICE 'KEYBOARD (SETQ \KEYBOARD.DEVICE (create FDEV DEVICENAME _ 'KEYBOARD CLOSEFILE _ (FUNCTION NILL) EVENTFN _ (FUNCTION \KEYBOARDEVENTFN) BIN _ (FUNCTION \GETKEY) PEEKBIN _ (FUNCTION \PEEKSYSBUF) READP _ (FUNCTION \SYSBUFP) EOFP _ (FUNCTION NILL) GETFILENAME _ (FUNCTION (LAMBDA (X MODE) (if (EQ MODE 'INPUT) then \KEYBOARD.STREAM] (SETQ \KEYBOARD.STREAM (create STREAM USERCLOSEABLE _ NIL USERVISIBLE _ NIL FULLFILENAME _ '{KEYBOARD} DEVICE _ \KEYBOARD.DEVICE ACCESS _ 'INPUT]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (\INIT.KEYBOARD.STREAM) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM) ) (* "END EXPORTED DEFINITIONS") (* ; "Hook for a periodic interrupt") (DEFINEQ (\DOBUFFEREDTRANSITIONS [LAMBDA (\INTERRUPTABLE) (DECLARE (SPECVARS \INTERRUPTABLE)) (* ; "Edited 1-Feb-92 11:59 by jds") (SETQ \KEYBUFFERING 'INPROGRESS) (LET ((PENDINGINTERRUPT)) (DECLARE (SPECVARS PENDINGINTERRUPT)) (* ; "Used by \DECODETRANSITION") [bind R RPTR until (EQ 0 (SETQ R (fetch (RING READ) of \KEYBOARDEVENTQUEUE)) ) do (SETQ RPTR (\ADDBASE \KEYBOARDEVENTQUEUE R)) (* ; "get pointer to this event") (* ;  "handle simple keyboard words by calling \DOTRANSITIONS for each word") [COND ((NEQ (fetch (KEYBOARDEVENT W0) of RPTR) (fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE )) (\DOTRANSITIONS 0 (fetch (KEYBOARDEVENT W0) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W0) of RPTR)) (replace (KEYBOARDEVENT W0) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W0) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W1) of RPTR) (fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE )) (\DOTRANSITIONS 16 (fetch (KEYBOARDEVENT W1) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W1) of RPTR)) (replace (KEYBOARDEVENT W1) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W1) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W2) of RPTR) (fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE )) (\DOTRANSITIONS 32 (fetch (KEYBOARDEVENT W2) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W2) of RPTR)) (replace (KEYBOARDEVENT W2) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W2) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W3) of RPTR) (fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE )) (\DOTRANSITIONS 48 (fetch (KEYBOARDEVENT W3) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W3) of RPTR)) (replace (KEYBOARDEVENT W3) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W3) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W4) of RPTR) (fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE )) (\DOTRANSITIONS 80 (fetch (KEYBOARDEVENT W4) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W4) of RPTR)) (replace (KEYBOARDEVENT W4) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W4) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT W5) of RPTR) (fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE )) (\DOTRANSITIONS 96 (fetch (KEYBOARDEVENT W5) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT W5) of RPTR)) (replace (KEYBOARDEVENT W5) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT W5) of RPTR] [COND ((NEQ (fetch (KEYBOARDEVENT WU) of RPTR) (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE )) (\DOTRANSITIONS 64 (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE) (fetch (KEYBOARDEVENT WU) of RPTR)) (replace (KEYBOARDEVENT WU) of \LASTKEYSTATE with (fetch (KEYBOARDEVENT WU) of RPTR] (* ;;; "now remove event from queue") (COND ((EQ [replace (RING READ) of \KEYBOARDEVENTQUEUE with (COND ((IGEQ R \KEYBOARDEVENT.LAST) \KEYBOARDEVENT.FIRST) (T (IPLUS \KEYBOARDEVENT.SIZE R] (fetch (RING WRITE) of \KEYBOARDEVENTQUEUE )) (replace (RING READ) of \KEYBOARDEVENTQUEUE with 0] (PROGN (* ; "update dummy shift state") (replace DUMMY1SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 1SHIFT ) of \LASTKEYSTATE )) (replace DUMMY2SHIFT of \SHIFTSTATE with (fetch (KEYBOARDEVENT 2SHIFT ) of \LASTKEYSTATE )) (replace DUMMYLOCK of \SHIFTSTATE with (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)) (replace DUMMYCTRL of \SHIFTSTATE with (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE)) (replace DUMMYMETA of \SHIFTSTATE with (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE)) (replace DUMMYFONT of \SHIFTSTATE with (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE)) (replace DUMMYUSERMODE1 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE)) (replace DUMMYUSERMODE2 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE2) of \LASTKEYSTATE)) (replace DUMMYUSERMODE3 of \SHIFTSTATE with (fetch (KEYBOARDEVENT USERMODE3) of \LASTKEYSTATE)) (replace DUMMYALTGRAPH of \SHIFTSTATE with (fetch (KEYBOARDEVENT ALTGRAPH) of \LASTKEYSTATE)) (replace DUMMYDEADKEYPENDING of \SHIFTSTATE with (fetch ( KEYBOARDEVENT DEADKEYPENDING ) of \LASTKEYSTATE) )) (* ;; "Note: there is a window between the test of READ above and the setting of \KEYBUFFERING below where a keyboard transition can be ignored until the next transition causes \KEYBUFFERING to be set again") (COND ((NOT (OR PENDINGINTERRUPT \PENDINGINTERRUPT)) (* ;  "No interrupt noticed this time or on any previous invocation") (SETQ \KEYBUFFERING NIL)) ((NOT (\GETBASEPTR (\STKSCAN '\INTERRUPTABLE) 0)) (* ;  "We're not interruptable, so try again later") (SETQ \PENDINGINTERRUPT T) (SETQ \KEYBUFFERING NIL)) (T (SETQ \PENDINGINTERRUPT NIL) (SETQ \KEYBUFFERING NIL) (LET ((\INTERRUPTABLE T)) (INTERRUPTED]) (\TIMER.INTERRUPTFRAME [LAMBDA NIL (* lmm "22-Apr-85 09:47") (* place holder for periodic  interrupts) (if NIL then (APPLY* \PERIODIC.INTERRUPT) (if \PERIODIC.INTERRUPT then (SETUPTIMER (QUOTIENT (TIMES \PERIODIC.INTERRUPT.FREQUENCY \RCLKSECOND) 77) (LOCF (fetch DLMOUSETIMER of \MISCSTATS)) 'TICKS) (SETQ \TIMER.INTERRUPT.PENDING T]) (\PERIODIC.INTERRUPTFRAME [LAMBDA NIL (DECLARE (GLOBALVARS \PERIODIC.INTERRUPT)) (* lmm "16-Jul-85 16:22") (LET ((FN \PERIODIC.INTERRUPT)) (AND FN (SPREADAPPLY* FN]) ) (RPAQ? \KEYBUFFERING ) (RPAQ? \PERIODIC.INTERRUPT ) (RPAQ? \TIMER.INTERRUPT.PENDING ) (RPAQ? \PERIODIC.INTERRUPT.FREQUENCY 77) (DECLARE%: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) (* ; "cursor and mouse related functions.") (DEFINEQ (\HARDCURSORUP [LAMBDA (NEWCURSOR INVERTFLG) (* ; "Edited 2-Jan-2000 18:10 by kaplan") (* ;  "version of \CURSORUP that knows about the possibility of the cursor being on the color screen.") (PROG (IMAGE) (SETQ \SOFTCURSORP NIL) (SETQ \CURRENTCURSOR NEWCURSOR) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR)) [COND ((NOT (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE) (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION))) (\CURSORBITSPERPIXEL NEWCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION )) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR] (BITBLT IMAGE 0 0 CursorBitMap 0 (IDIFFERENCE HARDCURSORHEIGHT (fetch (BITMAP BITMAPHEIGHT ) of IMAGE)) HARDCURSORWIDTH HARDCURSORHEIGHT (COND (INVERTFLG 'INVERT) (T 'INPUT)) 'REPLACE) (SELECTC \MACHINETYPE (\DAYBREAK (\DoveDisplay.SetCursorShape CursorBitMap)) (\MAIKO (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR))) NIL]) (\HARDCURSORPOSITION [LAMBDA (XPOS YPOS) (* kbr%: "13-Jun-85 21:24") (* sets cursor position, adjusts for hotspot and tty region limits.  XPOS and YPOS are the screen coordinates of the hotspot location.) (DECLARE (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURSORDESTWIDTH \CURSORDESTHEIGHT)) (* YPOS is reflected around CURSORYMAX because the screen has  (0,0) as the upper left corner. *) (SETQ YPOS (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) YPOS)) (* Clip coordinates *) (SETQ XPOS (UNSIGNED (IDIFFERENCE (COND ((ILESSP XPOS 0) 0) ((IGEQ XPOS \CURSORDESTWIDTH) (SUB1 \CURSORDESTWIDTH)) (T XPOS)) \CURSORHOTSPOTX) BITSPERWORD)) (SETQ YPOS (UNSIGNED (IDIFFERENCE (COND ((ILESSP YPOS 0) 0) ((IGEQ YPOS \CURSORDESTHEIGHT) (SUB1 \CURSORDESTHEIGHT)) (T YPOS)) \CURSORHOTSPOTY) BITSPERWORD)) [COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) (COND ((IGREATERP YPOS 32767) (SETQ YPOS 0))) (COND ((IGREATERP XPOS 32767) (SETQ XPOS 0] (\SETMOUSEXY XPOS YPOS) (PROGN (* change the cursor position too so that GETMOUSESTATE will get the correct  values if it is called before the next 60 cycle interrupt.) (\PUTBASE \EM.CURSORX 0 XPOS) (\PUTBASE \EM.CURSORY 0 YPOS)) NIL]) (\HARDCURSORDOWN [LAMBDA NIL (* kbr%: "23-Apr-85 18:26") (\CLEARBM (CURSORBITMAP]) ) (DEFINEQ (CURSOR.INIT [LAMBDA NIL (* kbr%: "23-Jan-86 17:34") (PROG (DESTBPL) (* Assorted globals for doing the  color cursor. *) (SETQ \CURSORDESTINATION ScreenBitMap) (SETQ \SOFTCURSORUPBM NIL) (SETQ \SOFTCURSORDOWNBM NIL) (SETQ \CURSORDESTLINE 0) (SETQ \CURSORDESTLINEBASE (fetch (BITMAP BITMAPBASE) of ScreenBitMap)) (SETQ \CURSORDESTWIDTH (fetch (BITMAP BITMAPWIDTH) of ScreenBitMap)) (SETQ \CURSORDESTHEIGHT (fetch (BITMAP BITMAPHEIGHT) of ScreenBitMap)) (SETQ \CURSORDESTRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of ScreenBitMap)) (* Initialize PILOTBBTs.  *) (SETQ DESTBPL (UNFOLD \CURSORDESTRASTERWIDTH BITSPERWORD)) (* These PILOTBBTs are the mixing areas for forming the color cursor image.  *) (* Does SCREEN to DOWNBM via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT1 (create PILOTBBT PBTSOURCEBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT1) (* Does DOWNBM to UPBM via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT2 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT2) (* Does MASK to UPBM via INPUT,  ERASE. *) (SETQ \SOFTCURSORBBT3 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 1 PBTOPERATION _ 1)) (\LOCKCELL \SOFTCURSORBBT3) (* Does IMAGE to UPBM via INPUT,  PAINT. *) (SETQ \SOFTCURSORBBT4 (create PILOTBBT PBTDESTBIT _ 0 PBTSOURCEBIT _ 0 PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 2)) (\LOCKCELL \SOFTCURSORBBT4) (* Does UPBM to SCREEN via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT5 (create PILOTBBT PBTDESTBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT5) (* Does DOWNBM to SCREEN via INPUT,  REPLACE. *) (SETQ \SOFTCURSORBBT6 (create PILOTBBT PBTDESTBPL _ DESTBPL PBTDISJOINT _ T PBTSOURCETYPE _ 0 PBTOPERATION _ 0)) (\LOCKCELL \SOFTCURSORBBT6) (* Lock things down.  *) ]) (\CURSORDESTINATION [LAMBDA (DESTINATION) (* kbr%: " 2-Sep-85 20:13") (* Change DESTINATION of  \CURRENTCURSOR, assuming it is down.  *) (PROG (DESTBPL) (COND ((NOT (EQ DESTINATION \CURSORDESTINATION)) (UNINTERRUPTABLY [COND ((NOT (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of (fetch (CURSOR CUIMAGE) of \CURRENTCURSOR )) (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATION))) (\CURSORBITSPERPIXEL \CURRENTCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of DESTINATION] (\SETMOUSEXY 0 0) (\PUTBASE \EM.CURSORX 0 0) (\PUTBASE \EM.CURSORY 0 0) (SETQ \CURSORDESTLINE 0) (SETQ.NOREF \CURSORDESTLINEBASE (fetch (BITMAP BITMAPBASE) of DESTINATION)) (SETQ \CURSORDESTWIDTH (fetch (BITMAP BITMAPWIDTH) of DESTINATION)) (SETQ \CURSORDESTHEIGHT (fetch (BITMAP BITMAPHEIGHT) of DESTINATION)) (SETQ \CURSORDESTRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of DESTINATION )) (SETQ DESTBPL (UNFOLD \CURSORDESTRASTERWIDTH BITSPERWORD)) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT1 with DESTBPL) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT5 with DESTBPL) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT6 with DESTBPL) (SETQ \CURSORDESTINATION DESTINATION))]) (\SOFTCURSORUP [LAMBDA (NEWCURSOR) (* kbr%: " 2-Sep-85 20:15") (* Put soft NEWCURSOR up, assuming soft cursor is down.  *) (PROG (IMAGE MASK WIDTH BWIDTH HEIGHT CURSORBITSPERPIXEL CURSORBPL UPBMBASE DOWNBMBASE) (* Get cursor IMAGE & MASK.  *) (SETQ IMAGE (fetch (CURSOR CUIMAGE) of NEWCURSOR)) (SETQ MASK (fetch (CURSOR CUMASK) of NEWCURSOR)) (SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of IMAGE)) (SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of IMAGE)) (SETQ CURSORBITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE)) (* Create new UPBM & DOWNBM caches  if necessary. *) (COND ((NOT (AND (type? BITMAP \SOFTCURSORUPBM) (EQ (fetch (BITMAP BITMAPWIDTH) of \SOFTCURSORUPBM) WIDTH) (EQ (fetch (BITMAP BITMAPHEIGHT) of \SOFTCURSORUPBM) HEIGHT) (EQ (fetch (BITMAP BITMAPBITSPERPIXEL) of \SOFTCURSORUPBM) CURSORBITSPERPIXEL))) (SETQ \SOFTCURSORWIDTH WIDTH) (SETQ \SOFTCURSORHEIGHT HEIGHT) (SETQ \SOFTCURSORUPBM (BITMAPCREATE WIDTH HEIGHT CURSORBITSPERPIXEL)) (SETQ \SOFTCURSORDOWNBM (BITMAPCREATE WIDTH HEIGHT CURSORBITSPERPIXEL)) (SETQ UPBMBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORUPBM)) (\TEMPLOCKPAGES UPBMBASE 1) (SETQ DOWNBMBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORDOWNBM)) (\TEMPLOCKPAGES DOWNBMBASE 1) (SETQ CURSORBPL (UNFOLD (fetch (BITMAP BITMAPRASTERWIDTH) of IMAGE) BITSPERWORD)) (SETQ BWIDTH (ITIMES (fetch (BITMAP BITMAPWIDTH) of IMAGE) (fetch (BITMAP BITMAPBITSPERPIXEL) of IMAGE))) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT1 with CURSORBPL) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT2 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT2 with CURSORBPL) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT2 with DOWNBMBASE) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT2 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT2 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT2 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT3 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT3 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT3 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT3 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT3 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT4 with UPBMBASE) (replace (PILOTBBT PBTDESTBPL) of \SOFTCURSORBBT4 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT4 with CURSORBPL) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT4 with BWIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT4 with HEIGHT) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT5 with CURSORBPL) (replace (PILOTBBT PBTSOURCEBPL) of \SOFTCURSORBBT6 with CURSORBPL))) (* Change PILOTBBTs.  *) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT3 with (fetch (BITMAP BITMAPBASE ) of MASK)) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT4 with (fetch (BITMAP BITMAPBASE ) of IMAGE)) (* Put up new \CURRENTCURSOR.  *) (SETQ \CURRENTCURSOR NEWCURSOR) (\TEMPLOCKPAGES \CURRENTCURSOR 1) (SETQ \SOFTCURSORP T) (\SOFTCURSORUPCURRENT]) (\SOFTCURSORUPCURRENT [LAMBDA NIL (* kbr%: "18-Aug-85 15:09") (* Put soft \CURRENTCURSOR up, assuming soft cursor is down.  *) (PROG (DISPINTERRUPT X Y XBASE YBASE WIDTH HEIGHT BITSPERPIXEL MINUSDESTRASTERWIDTH DEST DESTBIT SOURCEOFFSET UPBMSOURCE DOWNBMSOURCE SOURCEBIT) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) (SETQ \SOFTCURSORUPP T) (* Roughly, we want to  (BITBLT CURSOR XBASE YBASE SCREEN X  Y WIDTH HEIGHT) *) (SETQ X (SIGNED (\GETBASE \EM.MOUSEX 0) BITSPERWORD)) (SETQ Y (SIGNED (\GETBASE \EM.MOUSEY 0) BITSPERWORD)) (SETQ XBASE 0) (SETQ YBASE 0) (SETQ WIDTH \SOFTCURSORWIDTH) (SETQ HEIGHT \SOFTCURSORHEIGHT) (* Clip off screen parts of cursor.  *) [COND ((IGREATERP 0 X) (* Some of cursor is to left of  screen. *) (SETQ XBASE (IMINUS X)) (SETQ WIDTH (IDIFFERENCE WIDTH XBASE)) (SETQ X 0)) ((IGREATERP (IPLUS X WIDTH) \CURSORDESTWIDTH) (* Some of cursor is to right of  screen. *) (SETQ WIDTH (IDIFFERENCE \CURSORDESTWIDTH X] (COND ((ILESSP WIDTH 0) (GO EXIT))) [COND ((IGREATERP 0 Y) (* Some of cursor is to above of  screen. *) (SETQ YBASE (IMINUS Y)) (SETQ HEIGHT (IDIFFERENCE HEIGHT YBASE)) (SETQ Y 0)) ((IGREATERP (IPLUS Y HEIGHT) \CURSORDESTHEIGHT) (* Some of cursor is to below of  screen. *) (SETQ HEIGHT (IDIFFERENCE \CURSORDESTHEIGHT Y] (COND ((ILESSP HEIGHT 0) (GO EXIT))) (* These loops reset \CURSORDESTLINEBASE while avoiding large number  arithmetic. *) [COND [(IGREATERP \CURSORDESTLINE Y) (SETQ MINUSDESTRASTERWIDTH (IMINUS \CURSORDESTRASTERWIDTH)) (until (EQ \CURSORDESTLINE Y) do (SETQ \CURSORDESTLINE (SUB1 \CURSORDESTLINE)) (SETQ.NOREF \CURSORDESTLINEBASE (\ADDBASE \CURSORDESTLINEBASE MINUSDESTRASTERWIDTH] ((ILESSP \CURSORDESTLINE Y) (until (EQ \CURSORDESTLINE Y) do (SETQ \CURSORDESTLINE (ADD1 \CURSORDESTLINE)) (SETQ.NOREF \CURSORDESTLINEBASE (\ADDBASE \CURSORDESTLINEBASE \CURSORDESTRASTERWIDTH] (* Reset PILOTBBTs.  *) (SETQ BITSPERPIXEL (fetch (CURSOR CUBITSPERPIXEL) of \CURRENTCURSOR)) (SETQ X (ITIMES BITSPERPIXEL X)) (SETQ XBASE (ITIMES BITSPERPIXEL XBASE)) (SETQ WIDTH (ITIMES BITSPERPIXEL WIDTH)) (SETQ DEST \CURSORDESTLINEBASE) (SETQ DESTBIT X) (SETQ SOURCEOFFSET (ITIMES YBASE (fetch (BITMAP BITMAPRASTERWIDTH) of \SOFTCURSORUPBM ))) (SETQ UPBMSOURCE (\ADDBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORUPBM) SOURCEOFFSET)) (SETQ DOWNBMSOURCE (\ADDBASE (fetch (BITMAP BITMAPBASE) of \SOFTCURSORDOWNBM) SOURCEOFFSET)) (SETQ SOURCEBIT XBASE) (* TBW%: Most of these fields only need to be set if we are clipping this  time or the previous time we put the cursor up.  *) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT1 with DOWNBMSOURCE) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT1 with SOURCEBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT1 with DEST) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT1 with DESTBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT1 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT1 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT5 with DEST) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT5 with DESTBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT5 with UPBMSOURCE) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT5 with SOURCEBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT5 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT5 with HEIGHT) (replace (PILOTBBT PBTDEST) of \SOFTCURSORBBT6 with DEST) (replace (PILOTBBT PBTDESTBIT) of \SOFTCURSORBBT6 with DESTBIT) (replace (PILOTBBT PBTSOURCE) of \SOFTCURSORBBT6 with DOWNBMSOURCE) (replace (PILOTBBT PBTSOURCEBIT) of \SOFTCURSORBBT6 with SOURCEBIT) (replace (PILOTBBT PBTWIDTH) of \SOFTCURSORBBT6 with WIDTH) (replace (PILOTBBT PBTHEIGHT) of \SOFTCURSORBBT6 with HEIGHT) (* Save background behind cursor.  *) (\PILOTBITBLT \SOFTCURSORBBT1 0) (* Compute cursor appearance.  UPBM = (OR IMAGE (AND DOWNBM  (NOT MASK))) *) (\PILOTBITBLT \SOFTCURSORBBT2 0) (\PILOTBITBLT \SOFTCURSORBBT3 0) (\PILOTBITBLT \SOFTCURSORBBT4 0) (* Put color cursor up.  *) (\SOFTCURSORPILOTBITBLT \SOFTCURSORBBT5 0) EXIT (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) (\SOFTCURSORPOSITION [LAMBDA (X Y) (* kbr%: "18-Aug-85 14:50") (* Move soft cursor.  *) (PROG (DISPINTERRUPT) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) [COND ((OR (NOT (EQ (\GETBASE \EM.CURSORX 0) X)) (NOT (EQ (\GETBASE \EM.CURSORY 0) Y))) (COND (\SOFTCURSORUPP (\SOFTCURSORDOWN) (\SOFTCURSORUPCURRENT] (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) (\SOFTCURSORDOWN [LAMBDA NIL (* kbr%: " 6-Jul-85 00:09") (* Take COLOR cursor down.  *) (PROG (DISPINTERRUPT) (* \SOFTCURSORUPP must be set to NIL  before BITBLTing. *) (SETQ DISPINTERRUPT (\GETBASE \EM.DISPINTERRUPT 0)) (\PUTBASE \EM.DISPINTERRUPT 0 0) (SETQ \SOFTCURSORUPP NIL) (\SOFTCURSORPILOTBITBLT \SOFTCURSORBBT6 0) (\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]) (CURSORPROP [LAMBDA X (* kbr%: "11-Jan-86 20:03") (COND ((IGREATERP X 2) (PUTCURSORPROP (ARG X 1) (ARG X 2) (ARG X 3))) ((EQ X 2) (GETCURSORPROP (ARG X 1) (ARG X 2))) (T (\ILLEGAL.ARG NIL]) (GETCURSORPROP [LAMBDA (CURSOR PROP) (* kbr%: "26-Apr-85 11:18") (LISTGET (fetch (CURSOR CUDATA) of CURSOR) PROP]) (PUTCURSORPROP [LAMBDA (CURSOR PROP VALUE) (* kbr%: "26-Apr-85 11:18") (PROG (OLDDATA OLDVALUE) (SETQ OLDDATA (fetch (CURSOR CUDATA) of CURSOR)) [COND [OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP)) (COND (VALUE (LISTPUT OLDDATA PROP VALUE)) (OLDVALUE (COND [(EQ (CAR OLDDATA) PROP) (replace (CURSOR CUDATA) of CURSOR with (CDDR (fetch (CURSOR CUDATA) of CURSOR] (T (FOR TAIL ON (CDR OLDDATA) BY (CDDR TAIL) WHEN (EQ (CADR TAIL) PROP) DO (FRPLACD TAIL (CDDDR TAIL)) (RETURN] (VALUE (replace (CURSOR CUDATA) of CURSOR with (LIST PROP VALUE] (RETURN OLDVALUE]) (\CURSORBITSPERPIXEL [LAMBDA (CURSOR NEWBITSPERPIXEL) (* kbr%: "12-May-85 17:15") (* Swap in NEWBITSPERPIXEL IMAGE and MASK, creating them if necessary.  *) (PROG (OLDBITSPERPIXEL OLDIMAGE OLDMASK WHITE BLACK NEWIMAGE NEWMASK) (SETQ OLDBITSPERPIXEL (fetch (CURSOR CUBITSPERPIXEL) of CURSOR)) (COND ((EQ OLDBITSPERPIXEL NEWBITSPERPIXEL) (RETURN))) (* Save OLDIMAGE and OLDMASK.  *) (SETQ OLDIMAGE (fetch (CURSOR CUIMAGE) of CURSOR)) (SETQ OLDMASK (fetch (CURSOR CUMASK) of CURSOR)) (CURSORPROP CURSOR (\CURSORIMAGEPROPNAME OLDBITSPERPIXEL) OLDIMAGE) (CURSORPROP CURSOR (\CURSORMASKPROPNAME OLDBITSPERPIXEL) OLDMASK) (* Unsave NEWIMAGE and NEWMASK if possible, otherwise create them.  *) [COND [(SETQ NEWIMAGE (CURSORPROP CURSOR (\CURSORIMAGEPROPNAME NEWBITSPERPIXEL))) (* Use cached NEWIMAGE & NEWMASK.  *) (SETQ NEWMASK (CURSORPROP CURSOR (\CURSORMASKPROPNAME NEWBITSPERPIXEL] (T (* Create NEWIMAGE & NEWMASK.  *) (SETQ WHITE (MASK.1'S 0 NEWBITSPERPIXEL)) (SETQ BLACK 0) (SETQ NEWIMAGE (COLORIZEBITMAP (CURSORPROP CURSOR 'IMAGE1) BLACK WHITE NEWBITSPERPIXEL)) (SETQ NEWMASK (COLORIZEBITMAP (CURSORPROP CURSOR 'MASK1) BLACK WHITE NEWBITSPERPIXEL] (replace (CURSOR CUIMAGE) of CURSOR with NEWIMAGE) (replace (CURSOR CUMASK) of CURSOR with NEWMASK]) (\CURSORIMAGEPROPNAME [LAMBDA (BITSPERPIXEL) (* kbr%: "26-Apr-85 11:18") (SELECTQ BITSPERPIXEL (1 'IMAGE1) (4 'IMAGE4) (8 'IMAGE8) (SHOULDNT]) (\CURSORMASKPROPNAME [LAMBDA (BITSPERPIXEL) (* kbr%: "26-Apr-85 11:18") (SELECTQ BITSPERPIXEL (1 'MASK1) (4 'MASK4) (8 'MASK8) (SHOULDNT]) ) (DEFINEQ (CURSORCREATE [LAMBDA (IMAGE MASK HOTSPOTX HOTSPOTY DATA) (* ; "Edited 10-Jul-92 16:32 by cat") (* ; "Edited 31-Jul-87 10:01 by jds") (* ;; "creates a cursor from a bitmap. HOTSPOTX and HOTSPOTY specify the hotspot.") (* ;; "INVARIANTS: the hot spot X and Y must be in the range 0..(width - 1) and 0..(height - 1), respectively.") (PROG (CURSOR) (COND ((OR (FIXP MASK) (POSITIONP MASK)) (* ;; "If Mask is a fixp then we presume this is the old arg list (bitmap x y). the cursor filepkgtype has been changed to write the new arg list. The other is provided for (dubious) compatibility") (SETQ HOTSPOTY HOTSPOTX) (SETQ HOTSPOTX MASK) (SETQ MASK NIL))) (* ;; "Make sure that the image and mask bitmaps are no larger than the hardware cursor, i.e. 16x16 bits [AR 8916 7/31/87]:") (COND ((OR (IGREATERP (BITMAPWIDTH IMAGE) 16) (IGREATERP (BITMAPHEIGHT IMAGE) 16)) (* ; "IMAGE is too big.") (\ILLEGAL.ARG IMAGE)) ((NOT MASK) (* ; "No mask, so it's OK") ) ((OR (IGREATERP (BITMAPWIDTH MASK) 16) (IGREATERP (BITMAPHEIGHT MASK) 16)) (* ; "MASK is too big.") (\ILLEGAL.ARG MASK))) [COND ((POSITIONP HOTSPOTX) (* ;;  "The hot spot can be specified as a position in one arg, rather than X and Y in two:") (SETQ HOTSPOTY (fetch (POSITION YCOORD) of HOTSPOTX)) (SETQ HOTSPOTX (fetch (POSITION XCOORD) of HOTSPOTX] (SETQ CURSOR (create CURSOR CUIMAGE _ IMAGE CUMASK _ (OR MASK IMAGE) CUHOTSPOTX _ (IMAX 0 (IMIN (SUB1 (BITMAPWIDTH IMAGE)) (OR (FIXP HOTSPOTX) 0))) CUHOTSPOTY _ [IMAX 0 (IMIN (SUB1 (BITMAPHEIGHT IMAGE)) (OR (FIXP HOTSPOTY) (SUB1 (BITMAPHEIGHT IMAGE] CUDATA _ DATA)) (RETURN CURSOR]) (CURSOR [LAMBDA (NEWCURSOR INVERTFLG) (* ; "Edited 24-Mar-87 18:30 by jds") (* ;; "Installs NEWCURSOR as the cursor and returns the old cursor state. If INVERTFLG is non-NIL, the cursor image is inverted during installation. If NEWCURSOR is NIL, just returns the current cursor state.") (DECLARE (GLOBALVARS DEFAULTCURSOR \SOFTCURSORP)) (PROG (OLDCURSOR) (SETQ OLDCURSOR \CURRENTCURSOR) (COND ((EQ NEWCURSOR T) (* ;  "If NEWCURSOR is T, use the system default cursor.") (SETQ NEWCURSOR DEFAULTCURSOR))) (COND [(\CURSOR-VALID-P NEWCURSOR \SOFTCURSORP) (* ;  "Only install the cursor if it's a real, valid one.") (\CURSORDOWN) (\CURSORUP NEWCURSOR INVERTFLG) (* ;  "set after adjustment to avoid confusion about hotspot during adjustment.") (SETQ \CURSORHOTSPOTX (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR)) (SETQ \CURSORHOTSPOTY (IDIFFERENCE (SUB1 (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR))) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR] (NEWCURSOR (* ; "NEWCURSOR = NIL means just return the old one, so only error if one got specified that wasn't valid.") (\ILLEGAL.ARG NEWCURSOR))) (RETURN OLDCURSOR]) (\CURSOR-VALID-P [LAMBDA (CURSOR SOFT?) (* ; "Edited 25-Mar-87 09:41 by jds") (* ;; "It returns T if CURSOR is a valid cursor. Validity depends on whether it's meant to be displayed using the cursor hardware or the cursor software.") (* ;; "This is really wed to the D-machine display architecture. ") (AND (CURSORP CURSOR) (COND (SOFT? T) (T (LET ((IMAGE (fetch (CURSOR CUIMAGE) of CURSOR)) (HOTSPOT-X (fetch (CURSOR CUHOTSPOTX) of CURSOR)) (HOTSPOT-Y (fetch (CURSOR CUHOTSPOTY) of CURSOR))) (* ;; "The bitmap must be <= 16x16, and the hot spot must be within the cursor if we're using hardware cursor.") (AND (>= 16 (BITMAPWIDTH IMAGE)) (>= 16 (BITMAPHEIGHT IMAGE)) (<= 0 HOTSPOT-X) (< HOTSPOT-X 16) (<= 0 HOTSPOT-Y) (< HOTSPOT-Y 16]) (\CURSORUP [LAMBDA (NEWCURSOR INVERTFLG) (* kbr%: "18-Aug-85 14:38") (UNINTERRUPTABLY (\CURSORBITSPERPIXEL NEWCURSOR (fetch (BITMAP BITMAPBITSPERPIXEL) of \CURSORDESTINATION )) (COND ((AND (EQ (fetch (CURSOR CUIMAGE) of NEWCURSOR) (fetch (CURSOR CUMASK) of NEWCURSOR)) (ILEQ (fetch (BITMAP BITMAPWIDTH) of (fetch (CURSOR CUIMAGE) of NEWCURSOR)) HARDCURSORWIDTH) (ILEQ (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR)) HARDCURSORHEIGHT) (EQ \CURSORDESTINATION ScreenBitMap)) (\HARDCURSORUP NEWCURSOR INVERTFLG)) (T (\SOFTCURSORUP NEWCURSOR))) (ADJUSTCURSORPOSITION (IDIFFERENCE \CURSORHOTSPOTX (fetch (CURSOR CUHOTSPOTX) of NEWCURSOR)) (IDIFFERENCE (IDIFFERENCE (SUB1 (fetch (BITMAP BITMAPHEIGHT) of (fetch (CURSOR CUIMAGE) of NEWCURSOR))) (fetch (CURSOR CUHOTSPOTY) of NEWCURSOR)) \CURSORHOTSPOTY)))]) (\CURSORPOSITION [LAMBDA (XPOS YPOS) (* ; "Edited 19-Mar-98 14:41 by jds") (* sets cursor position, adjusts for hotspot and tty region limits.  XPOS and YPOS are the screen coordinates of the hotspot location.) (DECLARE (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURSORDESTWIDTH \CURSORDESTHEIGHT)) (* YPOS is reflected around CURSORYMAX because the screen has  (0,0) as the upper left corner. *) (SETQ YPOS (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) YPOS)) (* Clip coordinates *) (SETQ XPOS (UNSIGNED (IDIFFERENCE (COND (NIL (* ;; "Removed 2000/1/3 JDS so mousr cursors work.") (ILESSP XPOS 0) 0) ((IGEQ XPOS \CURSORDESTWIDTH) (SUB1 \CURSORDESTWIDTH)) (T XPOS)) \CURSORHOTSPOTX) BITSPERWORD)) (SETQ YPOS (UNSIGNED (IDIFFERENCE (COND (NIL (ILESSP YPOS 0) 0) ((IGEQ YPOS \CURSORDESTHEIGHT) (SUB1 \CURSORDESTHEIGHT)) (T YPOS)) \CURSORHOTSPOTY) BITSPERWORD)) [COND ((EQ \MACHINETYPE \DANDELION) (* Temporary workaround) (COND ((IGREATERP YPOS 32767) (SETQ YPOS 0))) (COND ((IGREATERP XPOS 32767) (SETQ XPOS 0] (\SETMOUSEXY XPOS YPOS) (COND (\SOFTCURSORP (\SOFTCURSORPOSITION XPOS YPOS))) [PROGN (* change the cursor position too so that GETMOUSESTATE will get the correct  values if it is called before the next 60 cycle interrupt.) (\PUTBASE \EM.CURSORX 0 XPOS) (\PUTBASE \EM.CURSORY 0 YPOS) (COND ((EQ \MACHINETYPE \DAYBREAK) (* Need to notify DAYBREAK IOP to  move cursor. *) (\DoveDisplay.SetCursorPosition XPOS YPOS] NIL]) (\CURSORDOWN [LAMBDA NIL (* kbr%: "12-Jun-85 17:21") (UNINTERRUPTABLY (COND (\SOFTCURSORP (\SOFTCURSORDOWN)) (T (\HARDCURSORDOWN))))]) (ADJUSTCURSORPOSITION [LAMBDA (DELTAX DELTAY) (* kbr%: " 6-Jan-86 11:55") (COND [(POSITIONP DELTAX) (\CURSORPOSITION (IPLUS (fetch (POSITION XCOORD) of DELTAX) (\XMOUSECOORD)) (IPLUS (fetch (POSITION YCOORD) of DELTAX) (\YMOUSECOORD] (T (\CURSORPOSITION (IPLUS (OR DELTAX 0) (\XMOUSECOORD)) (IPLUS (OR DELTAY 0) (\YMOUSECOORD]) (CURSORPOSITION [LAMBDA (NEWPOSITION DISPLAYSTREAM OLDPOSITION) (* kbr%: "13-Feb-86 15:53") (PROG (DD) (SETQ DD (\GETDISPLAYDATA DISPLAYSTREAM)) (OR (type? POSITION OLDPOSITION) (SETQ OLDPOSITION (create POSITION))) (freplace (POSITION XCOORD) of OLDPOSITION with (\DSPUNTRANSFORMX (\XMOUSECOORD ) DD)) (freplace (POSITION YCOORD) of OLDPOSITION with (\DSPUNTRANSFORMY (\YMOUSECOORD ) DD)) (COND ((type? POSITION NEWPOSITION) (\CURSORPOSITION (\DSPTRANSFORMX (fetch (POSITION XCOORD) of NEWPOSITION) DD) (\DSPTRANSFORMY (fetch (POSITION YCOORD) of NEWPOSITION) DD))) ((type? SCREENPOSITION NEWPOSITION) (CURSORSCREEN (fetch (SCREENPOSITION SCREEN) of NEWPOSITION) (fetch (SCREENPOSITION XCOORD) of NEWPOSITION) (fetch (SCREENPOSITION YCOORD) of NEWPOSITION))) (NEWPOSITION (\ILLEGAL.ARG NEWPOSITION))) (RETURN OLDPOSITION]) (CURSORSCREEN [LAMBDA (SCREEN XCOORD YCOORD) (* gbn%: "25-Jan-86 16:53") (* * sets up SCREEN to be the current screen, XCOORD %, YCOORD is initial pos  of cursor on SCREEN) (COND ((NULL XCOORD) (SETQ XCOORD 0))) (COND ((NULL YCOORD) (SETQ YCOORD 0))) (PROG (DESTINATION) (SETQ DESTINATION (fetch (SCREEN SCDESTINATION) of SCREEN)) (\CURSORDOWN) (SETQ \CURSORSCREEN SCREEN) (\CURSORDESTINATION DESTINATION) (\CURSORUP \CURRENTCURSOR) (\CURSORPOSITION XCOORD YCOORD]) (CURSOREXIT [LAMBDA NIL (* gbn%: "25-Jan-86 16:52") (* * called when cursor moves off the screen edge) (DECLARE (GLOBALVARS LASTSCREEN LASTMOUSEX LASTMOUSEY)) (PROG (SCREEN XCOORD YCOORD SCREEN2 XCOORD2 YCOORD2) (SETQ SCREEN LASTSCREEN) (SETQ XCOORD LASTMOUSEX) (SETQ YCOORD LASTMOUSEY) (SETQ SCREEN2 (COND ((EQ SCREEN \MAINSCREEN) \COLORSCREEN) (T \MAINSCREEN))) (* generalize for more than two  screens (or alternate physical  arrangement of screens.)) (COND ((EQ XCOORD 0) (SETQ XCOORD2 (IDIFFERENCE (fetch (SCREEN SCWIDTH) of SCREEN2) 2))) ((EQ XCOORD (SUB1 (fetch (SCREEN SCWIDTH) of SCREEN))) (SETQ XCOORD2 1)) (T (RETURN))) [SETQ YCOORD2 (IQUOTIENT (ITIMES YCOORD (SUB1 (fetch (SCREEN SCHEIGHT) of SCREEN2)) ) (SUB1 (fetch (SCREEN SCHEIGHT) of SCREEN] (CURSORSCREEN SCREEN2 XCOORD2 YCOORD2]) (FLIPCURSOR - [LAMBDA NIL (* ; "Edited 24-Apr-88 00:04 by MASINTER") - (PROG (ADDR) - (COND - ((NOT \SOFTCURSORP) - (SETQ ADDR \EM.CURSORBITMAP) - (FRPTQ HARDCURSORHEIGHT [\PUTBASE ADDR 0 (LOGXOR (\GETBASE ADDR 0) - (CONSTANT (SUB1 (EXPT 2 HARDCURSORWIDTH - ] - (SETQ ADDR (\ADDBASE ADDR 1))) - (SELECTC \MACHINETYPE - (\DAYBREAK (\DoveDisplay.SetCursorShape)) - (\MAIKO (AND \CURRENTCURSOR (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) - of \CURRENTCURSOR) - (fetch (CURSOR CUHOTSPOTY) of - \CURRENTCURSOR - )))) - NIL]) (FLIPCURSORBAR - [LAMBDA (N) (* ; "Edited 19-Mar-98 14:23 by jds") - -(* ;;; "Inverts the Nth line of the cursor, N = 0 being the top") - - (COND - ((NOT \SOFTCURSORP) - (\PUTBASE \EM.CURSORBITMAP N (LOGXOR (\GETBASE \EM.CURSORBITMAP N) - MAX.SMALLP)) - (SELECTC \MACHINETYPE - (\DAYBREAK (* ; "Notify IOP") - (\DoveDisplay.SetCursorShape)) - (\MAIKO (AND \CURRENTCURSOR (SUBRCALL DSPCURSOR (fetch (CURSOR CUHOTSPOTX) - of \CURRENTCURSOR) - (fetch (CURSOR CUHOTSPOTY) of - \CURRENTCURSOR - )))) - NIL]) (LASTMOUSEX [LAMBDA (DS) (* rmk%: "30-AUG-83 13:07") (* returns the mouse x position in the coordinates of the DisplayStream DS) (\DSPUNTRANSFORMX LASTMOUSEX (\GETDISPLAYDATA DS]) (LASTMOUSEY [LAMBDA (DS) (* rmk%: "30-AUG-83 13:07") (* returns the mouse y position in the coordinates of the DisplayStream DS) (\DSPUNTRANSFORMY LASTMOUSEY (\GETDISPLAYDATA DS]) (CREATEPOSITION [LAMBDA (XCOORD YCOORD) (* rmk%: " 6-Aug-84 13:43") (create POSITION XCOORD _ (OR XCOORD 0) YCOORD _ (OR YCOORD 0]) (POSITIONP [LAMBDA (X) (* rrb "25-AUG-82 11:04") (* is X a position? For now just a cons check but should be made a datatype.) (AND (LISTP X) (NUMBERP (CAR X)) (NUMBERP (CDR X)) X]) (CURSORHOTSPOT [LAMBDA (NEWPOSITION) (* gbn%: "26-Jan-86 15:36") (* returns the current cursor hot spot and sets the hot spot to NEWPOSITON if  one is given.) (PROG1 (create POSITION XCOORD _ \CURSORHOTSPOTX YCOORD _ \CURSORHOTSPOTY) (COND ((POSITIONP NEWPOSITION) (SETQ \CURSORHOTSPOTX (fetch (POSITION YCOORD) of NEWPOSITION)) (SETQ \CURSORHOTSPOTY (fetch (POSITION YCOORD) of NEWPOSITION]) ) (PUTPROPS CURSORPROP ARGNAMES (NIL (CURSOR PROP {NEWVALUE}) . U)) (RPAQ? \CURSORHOTSPOTX 0) (RPAQ? \CURSORHOTSPOTY 0) (RPAQ? \CURRENTCURSOR NIL) (RPAQ? \SOFTCURSORWIDTH NIL) (RPAQ? \SOFTCURSORHEIGHT NIL) (RPAQ? \SOFTCURSORP NIL) (RPAQ? \SOFTCURSORUPP NIL) (RPAQ? \SOFTCURSORUPBM NIL) (RPAQ? \SOFTCURSORDOWNBM NIL) (RPAQ? \SOFTCURSORBBT1 NIL) (RPAQ? \SOFTCURSORBBT2 NIL) (RPAQ? \SOFTCURSORBBT3 NIL) (RPAQ? \SOFTCURSORBBT4 NIL) (RPAQ? \SOFTCURSORBBT5 NIL) (RPAQ? \SOFTCURSORBBT6 NIL) (RPAQ? \CURSORSCREEN NIL) (RPAQ? \CURSORDESTINATION NIL) (RPAQ? \CURSORDESTHEIGHT 808) (RPAQ? \CURSORDESTWIDTH 1024) (RPAQ? \CURSORDESTRASTERWIDTH 64) (RPAQ? \CURSORDESTLINE 0) (RPAQ? \CURSORDESTLINEBASE NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE) ) (DEFINEQ (GETMOUSESTATE [LAMBDA NIL (* kbr%: " 6-Jul-85 14:16") (* Reads the current state of the  mouse and keyboard) (SETQ LASTMOUSEX (\XMOUSECOORD)) (SETQ LASTMOUSEY (\YMOUSECOORD)) (SETQ LASTMOUSEBUTTONS (LOGXOR (LOGAND (fetch (KEYBOARDEVENT WU) of \LASTKEYSTATE) \MOUSE.ALLBITS) \MOUSE.ALLBITS)) (SETQ LASTKEYBOARD (\EVENTKEYS)) (SETQ LASTSCREEN \CURSORSCREEN) NIL]) (\EVENTKEYS [LAMBDA NIL (* rmk%: " 4-JUN-81 22:58") (* Returns the state of the various keys that are represented in mouse events) (LOGOR (COND ((KEYDOWNP 'LOCK) 128) (T 0)) (COND ((KEYDOWNP 'LSHIFT) 64) (T 0)) (COND ((KEYDOWNP 'CTRL) 32) (T 0)) (COND ((KEYDOWNP 'RSHIFT) 8) (T 0)) (COND ((KEYDOWNP 'BLANK-TOP) 4) (T 0)) (COND ((KEYDOWNP 'BLANK-MIDDLE) 2) (T 0)) (COND ((KEYDOWNP 'BLANK-BOTTOM) 1) (T 0]) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (RPAQQ HARDCURSORHEIGHT 16) (RPAQQ HARDCURSORWIDTH 16) (CONSTANTS (HARDCURSORHEIGHT 16) (HARDCURSORWIDTH 16)) ) (DECLARE%: EVAL@COMPILE (ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTSCREEN LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD) ) (* "END EXPORTED DEFINITIONS") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS \SETMOUSEXY MACRO [(XPOS YPOS) (PROGN (SELECTC \MACHINETYPE (\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS)) (\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS)) (\DANDELION (do (PROGN (replace (IOPAGE NEWMOUSEX) of \IOPAGE with XPOS) (replace (IOPAGE NEWMOUSEY) of \IOPAGE with YPOS)) repeatuntil (ILESSP (fetch (IOPAGE NEWMOUSESTATE ) of \IOPAGE) 32768)) (* ;  "smash position until mouse says it is not busy") (replace (IOPAGE NEWMOUSEX) of \IOPAGE with XPOS) (replace (IOPAGE NEWMOUSEY) of \IOPAGE with YPOS) (replace (IOPAGE NEWMOUSESTATE) of \IOPAGE with 32768)) NIL) (PROGN (\PUTBASE \EM.MOUSEX 0 XPOS) (\PUTBASE \EM.MOUSEY 0 YPOS]) ) (* "END EXPORTED DEFINITIONS") (DECLARE%: EVAL@COMPILE (PUTPROPS \XMOUSECOORD MACRO (NIL (IPLUS \CURSORHOTSPOTX (SIGNED (\GETBASE \EM.CURSORX 0) BITSPERWORD)))) (PUTPROPS \YMOUSECOORD MACRO [NIL (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT) (IPLUS \CURSORHOTSPOTY (SIGNED (\GETBASE \EM.CURSORY 0) BITSPERWORD]) ) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (MOVD 'CURSOR 'SETCURSOR) (MOVD '\CURSORPOSITION '\SETCURSORPOSITION) (RPAQ \SFPosition (CREATEPOSITION)) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (BLOCKRECORD KEYBOARDEVENT ((W0 WORD) (W1 WORD) (W2 WORD) (W3 WORD) (WU WORD) (W4 WORD) (W5 WORD) (TIME FIXP) (MOUSESTATE BITS 3) (1SHIFT FLAG) (2SHIFT FLAG) (LOCK FLAG) (CTRL FLAG) (META FLAG) (FONT FLAG) (USERMODE1 FLAG) (USERMODE2 FLAG) (USERMODE3 FLAG) (ALTGRAPH FLAG) (DEADKEYPENDING FLAG) (* ; "T if the last key was a dead (accent) key, and we should generate an accented character if possible.") (NIL BITS 2) (MOUSEX WORD) (MOUSEY WORD) (DEADKEY-ALIST XPOINTER) (* ;  "The ALIST describing accents possible from teh last dead key.") ) (CREATE (\ALLOCBLOCK (FOLDHI \KEYBOARDEVENT.SIZE WORDSPERCELL))) W0 _ ALLUP W1 _ ALLUP W2 _ ALLUP W3 _ ALLUP W4 _ ALLUP W5 _ ALLUP WU _ ALLUP MOUSESTATE _ \DLMOUSE.UP [ACCESSFNS KEYBOARDEVENT ((SIZE (INDEXF (fetch MOUSEY of DATUM))) (SHIFT (OR (fetch (KEYBOARDEVENT 1SHIFT) DATUM) (fetch (KEYBOARDEVENT 2SHIFT) DATUM))) (SHIFTORLOCK (OR (fetch (KEYBOARDEVENT SHIFT) DATUM) (fetch (KEYBOARDEVENT LOCK) DATUM] LOCK _ (XKEYDOWNP 'LOCK) TIME _ 0 DEADKEYPENDING _ NIL) ) (DECLARE%: EVAL@COMPILE (RPAQ \KEYBOARDEVENT.FIRST NRINGINDEXWORDS) (RPAQQ \KEYBOARDEVENT.SIZE 14) (RPAQ \KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383))) [CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS) \KEYBOARDEVENT.SIZE (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383] ) ) (DEFINEQ (MACHINETYPE [LAMBDA NIL (* ; "Edited 30-Mar-88 10:27 by Snow") (SELECTC (fetch MachineType of \InterfacePage) (\DORADO 'DORADO) (\DANDELION 'DANDELION) (\DAYBREAK (* This is \DAYBREAK internally) 'DOVE) (\MAIKO 'MAIKO) NIL]) (SETMAINTPANEL [LAMBDA (N) (* mpl "21-Jul-85 18:15") (SELECTC \MACHINETYPE (\DANDELION (replace DLMAINTPANEL of \IOPAGE with N)) (\DOLPHIN ((OPCODES MISC1 3) (\DTEST N 'SMALLP))) (\DAYBREAK ((OPCODES DOVEMISC 2) (\DTEST N 'SMALLP))) NIL]) ) (* ; "DLion beeper") (DEFINEQ (BEEPON [LAMBDA (FREQ) (* ; "Edited 10-May-88 18:17 by MASINTER") (SELECTC \MACHINETYPE (\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE) 32768) do (BLOCK)) (replace DLBEEPFREQ of \IOPAGE with (IQUOTIENT 1843200 (IMAX FREQ 29))) (replace DLBEEPCMD of \IOPAGE with 32768)) (\DAYBREAK (\DoveMisc.BeepOn FREQ)) (\MAIKO (SUBRCALL KEYBOARDBEEP T FREQ)) (PROGN NIL)) NIL]) (BEEPOFF [LAMBDA NIL (* ; "Edited 10-May-88 18:17 by MASINTER") (SELECTC \MACHINETYPE (\DANDELION (while (IGEQ (fetch DLBEEPCMD of \IOPAGE) 32768) do (BLOCK)) (replace DLBEEPCMD of \IOPAGE with 32769)) (\DAYBREAK (\DoveMisc.BeepOff)) (\MAIKO (SUBRCALL KEYBOARDBEEP NIL NIL)) (PROGN NIL)) NIL]) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5 \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE \DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY) ) (* "END EXPORTED DEFINITIONS") (DEFINEQ (WITHOUT-INTERRUPTS [NLAMBDA (FORM) (* lmm "18-Apr-85 02:53") (PROG (VAL) (\KEYBOARDOFF) (SETQ VAL (DISPLAYDOWN FORM)) (\KEYBOARDON) (RETURN VAL]) ) (* ; "Compile locked fns together for locality") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (BLOCK%: NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS \HARDCURSORUP \DOMOUSECHORDING \KEYBOARDOFF \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN) ) (DECLARE%: DONTCOPY (ADDTOVAR INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS FLIPCURSORBAR \SETIOPOINTERS \KEYHANDLER \KEYHANDLER1 \CONTEXTAPPLY \LOCKPAGES \DECODETRANSITION \SMASHLINK \INCUSECOUNT LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER \ADDBASE \PERIODIC.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \CAUSEINTERRUPT \DOMOUSECHORDING \KEYBOARDOFF \TRACKCURSOR \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN \SOFTCURSORUP \SOFTCURSORUPCURRENT \SOFTCURSORPOSITION \SOFTCURSORDOWN \SOFTCURSORPILOTBITBLT) (LOCKEDVARS \InterfacePage \CURSORHOTSPOTX \CURSORHOTSPOTY \CURRENTCURSOR \SOFTCURSORWIDTH \SOFTCURSORHEIGHT \SOFTCURSORP \SOFTCURSORUPP \SOFTCURSORUPBM \SOFTCURSORDOWNBM \SOFTCURSORBBT1 \SOFTCURSORBBT2 \SOFTCURSORBBT3 \SOFTCURSORBBT4 \SOFTCURSORBBT5 \SOFTCURSORBBT6 \CURSORDESTINATION \CURSORDESTHEIGHT \CURSORDESTWIDTH \CURSORDESTRASTERWIDTH \CURSORDESTLINE \CURSORDESTLINEBASE \PENDINGINTERRUPT \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT \EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS \RCLKSECOND)))) (ADDTOVAR RDCOMS (FNS \SETIOPOINTERS)) ) (PUTPROPS LLKEY FILETYPE :BCOMPL) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML WITHOUT-INTERRUPTS) (ADDTOVAR LAMA CURSORPROP METASHIFT MOUSECHORDWAIT) ) (PUTPROPS LLKEY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1992 1999 1920 2000 2018)) (DECLARE%: DONTCOPY (FILEMAP (NIL (14799 21895 (BKSYSCHARCODE 14809 . 15158) (\CLEARSYSBUF 15160 . 15718) (\GETKEY 15720 . 16895) (\NSYSBUFCHARS 16897 . 17537) (\SAVESYSBUF 17539 . 19151) (\SYSBUFP 19153 . 19457) ( \GETSYSBUF 19459 . 19639) (\PUTSYSBUF 19641 . 20855) (\PEEKSYSBUF 20857 . 21893)) (23192 59371 ( \KEYBOARDINIT 23202 . 24925) (\KEYBOARDEVENTFN 24927 . 29627) (\ALLOCLOCKED 29629 . 30219) ( \SETIOPOINTERS 30221 . 34690) (\KEYBOARDOFF 34692 . 35039) (\KEYBOARDON 35041 . 35353) (\KEYHANDLER 35355 . 35486) (\KEYHANDLER1 35488 . 42806) (\RESETKEYBOARD 42808 . 44317) (\DOMOUSECHORDING 44319 . 47990) (\DOTRANSITIONS 47992 . 48669) (\DECODETRANSITION 48671 . 55360) (MOUSECHORDWAIT 55362 . 56045) (\TRACKCURSOR 56047 . 59369)) (93113 116472 (KEYACTION 93123 . 93967) (KEYACTIONTABLE 93969 . 95151) (KEYBOARDTYPE 95153 . 96255) (RESETKEYACTION 96257 . 98016) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 98018 . 101425) (\KEYACTION1 101427 . 112048) (KEYDOWNP 112050 . 112385) (KEYNUMBERP 112387 . 112585) (\KEYNAMETONUMBER 112587 . 113281) (MODIFY.KEYACTIONS 113283 . 114144) (METASHIFT 114146 . 115090) ( SHIFTDOWNP 115092 . 116470)) (116535 116831 (SETUP.OFFICE.KEYBOARD 116545 . 116829)) (119841 121553 ( \INIT.KEYBOARD.STREAM 119851 . 121551)) (121818 138195 (\DOBUFFEREDTRANSITIONS 121828 . 137258) ( \TIMER.INTERRUPTFRAME 137260 . 137985) (\PERIODIC.INTERRUPTFRAME 137987 . 138193)) (138449 142526 ( \HARDCURSORUP 138459 . 140341) (\HARDCURSORPOSITION 140343 . 142379) (\HARDCURSORDOWN 142381 . 142524) ) (142527 166587 (CURSOR.INIT 142537 . 146237) (\CURSORDESTINATION 146239 . 148557) (\SOFTCURSORUP 148559 . 153813) (\SOFTCURSORUPCURRENT 153815 . 160851) (\SOFTCURSORPOSITION 160853 . 161618) ( \SOFTCURSORDOWN 161620 . 162328) (CURSORPROP 162330 . 162672) (GETCURSORPROP 162674 . 162862) ( PUTCURSORPROP 162864 . 164019) (\CURSORBITSPERPIXEL 164021 . 166137) (\CURSORIMAGEPROPNAME 166139 . 166363) (\CURSORMASKPROPNAME 166365 . 166585)) (166588 184538 (CURSORCREATE 166598 . 169273) (CURSOR 169275 . 171087) (\CURSOR-VALID-P 171089 . 172176) (\CURSORUP 172178 . 173893) (\CURSORPOSITION 173895 . 176423) (\CURSORDOWN 176425 . 176658) (ADJUSTCURSORPOSITION 176660 . 177238) (CURSORPOSITION 177240 . 178782) (CURSORSCREEN 178784 . 179440) (CURSOREXIT 179442 . 180833) (FLIPCURSOR 180835 . 181961) ( FLIPCURSORBAR 181963 . 182943) (LASTMOUSEX 182945 . 183199) (LASTMOUSEY 183201 . 183455) ( CREATEPOSITION 183457 . 183663) (POSITIONP 183665 . 183949) (CURSORHOTSPOT 183951 . 184536)) (185776 187324 (GETMOUSESTATE 185786 . 186445) (\EVENTKEYS 186447 . 187322)) (193751 194547 (MACHINETYPE 193761 . 194161) (SETMAINTPANEL 194163 . 194545)) (194577 195716 (BEEPON 194587 . 195240) (BEEPOFF 195242 . 195714)) (196167 196430 (WITHOUT-INTERRUPTS 196177 . 196428))))) STOP \ No newline at end of file diff --git a/sources/MAKEINIT.LCOM.~9~ b/sources/MAKEINIT.LCOM.~9~ deleted file mode 100644 index 78c18b63287037aa1cb27cf07da9195bd7065b78..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12989 zcmb_jdu&_Rc_%OB#7RSkvJJOUjpRg$Q&OuGUXl_;WpH>!UYb|pOMK|zx@%;SjvlmV z=+QP9)&)bBqQ!tAZP29aiVX$YZdlPNas|xU00Q}^$R9=f#|9|ARA*Ur-;c7Cniv$9X^!@1nqp;L1P6<) zX1n#A&=bSP_OsM*WMpJeG#9r(!=PKMk50sr6N&M`yOt5Pm!Zcd5@Qq5=%DzWs1~s? zJsB6lrRBx-XIqQ&|777t@ZKL(YmCp7ilZqC!RK-saqDLoU zSnBV@zgQ$#C>vRup<*IC9t>L|DhfvRf|)B^hzQ?tpU>x~hi^IL3nv73n6_x6Yms2d zDg?u76jdolsbG|OkrTSGN0&W>FY5REd^5}U(~vulHU0g5-?Q|d=jSu@`T#xdqsJ*N zu=gvPIGz$!ljaujgdo|Z;Yvo)6l0=MvdSgwS}Y|pzqfbKSn@+x4x0Z2HC_qHPCRIL=OtfQ*JHx0R?Ah9N{LFN zUa6KVVtkCZK_nC6f>|dbS!c&|QK>>*MPiKVD_HEDuR+5^(JGA)B3v-5V%+J6QK0`xF}U8@5?4Cg>rH6b zXhMV++Z(OL=5wOmS!}kNkx0;%1|u4c>hy@YQkN@0V4~RPnpv;aF(X+2u+Q)FOWuA< z{&Xup3CcI-IAjAW%bL7{A{OJ_WWfOEGKF%@%!yG^u9zjPRf%g45psU+QL`o{h8m?g zuxS{KuA7YN$3(r%+|7x&;3m8h=eyLM zMkQ-iYiK?ya^+H86~=^-1I!Yv(GXw&S|mk%p<)(l^gb>a@<^_8A|+tuQEq-;n#uP1<+_I4HwuqqZE6UAw3#K>mrWud1avTg~eYt9-4*n)Ac z&Jv?_APTjS1zmQp7`2*I6-X$3g+Ny8Vk|*Y06i3=NfxSF9oDXR6qL{!dwBtBp{K?G zJY~77LLW;(X}Dv%kuvw9+ijjdG*#)1+QXOH!mR6Uj@r#6W- zDbwiDu0%qV%sB!4RD?rYTv&v@%+Jq5pa>j=y*N_mSX38bdps{;5nw4kg>#KkrcTfr zE*QnhtN{xK$&H9Guqs?D1DOe~dr5qcPLN%ZgS881fH)WyJ2Ha`5eB4Tyov~W(OxlD zge4bk!C#1w4%oG%%MpexyT(~?#A_iU5lqWAh31nZ))s11gD-V_rUnvHi99G5D6(6I z9jv2fvUO055^G3p#iUg-stfq$V4iImlOBizu#DXe78Rfaxm@#k3nE>?#&{(Iz!Nv~0RdvrB4X(+>cEJFfgI4WFp9H7a6Mf7vVeHJ1Tujhq;choz7o`=Tq=P! zwd0!a7-NCa3|v1o7doTu1r1hT*4%!hFR%F*@|x!V93Gng;@rvpM*o69H_rbSV zUOL%aIz4xWSvof$f6mGu!9Nnj2m5D^*UhobDxrhZ4@5n&&y5T$QAj+J3IG; z{4yZX`Wdnt{f{0m1@^XGwL6!n*MIxJaH8pFvJS7O{N)o(%^%o(T=VTr=&E#z?$CV^G~M?M^b zg#hhQ>1Ytz)s0fUCdOT@XD5(sgFYTZTnHCWhmTD!QezyOsgwo-GI$PCd`OPexEP`c z(kUlpnIlU2K86l5?4;5t>l`$Lu#bQYY@N0$vj!L7+?9(pf&__igmzUJTE}lErb9JI zGmGTPc_IT;OC7D5GYzv;x3Isci;1CfA&dA|1-!#dtXZ11s^wA-4|H%CTIHd8= z?io)sz=CwyxAX7mz+T`_Ui1BeWl%PlJIyYZ3KRmelE1f)&z+Hu)@2`$AbY97l>3uj zX|m!-m$$#)FXJRug5`mJ{n*^6?jfC9c++RSsabFK;s5@=`&cPIFIC}t#l1|yzk4q4 zI#HK>1;5lIIj8Mwo#K8>L8vKpw2KhzH_M^G^+)+zGoC*DJ07U06p>qZcmBMnUS5Ri zKtQr(@_Z3?#38ELOgU>-5rmA{cpMw0ok2VogBB24Inon@hoT(!82l5fMDA8hm#w5* zN6rcLv7Nk_tx*`B2PL0QX(NIbk`fsN=|Ea((Dfca5vuN37(`cc&Ln&$#0|>D8y$1w zC(!<0UJ0hUME>Qh4z-u_lV$-SJT71ocDfGW&=I8(t!8!DBVv$3j$&&frL%c9Ibx$A z06GuxBx@(hOTd|R;@ddQ0T&MPPL2bFpAm?zo<#VNZ%WDjx%Sm=zOAk8|3a33hR^8j z^L3Z*=^Agpz4q2>zot!DzrH?LV}XCuCx6?0EQeG3t3T~dt^M=GonO`9GU&7y2!aWE za@KrBfbEwG7IGGv+KA{h0gU-M~cX{VTWV#6!O_tR_n2Tz2mui7f# zok{cOB@GKgG*AaBXE@a0C?6O`QN9e~*)}kB4Be!96*sb0^gv_C;Q$F$Bw_sNW?=V> zzbQfDZ`AKko=S&E$9MlH-TXf5d1&SEB_t+hn3m@5r#0R+n9r5NAH_p^pWyy^M1`Od z?k{K}s{>k+qjs>9f_ABB0aUZ6jqhZ#l-rHK9FB6ST(>fW)HT~xrqG+cP)2Ak=5vs( z%mEg3S<|o}g2%vK9~_Sb{OlAp$>hV`umyLMm-Vn^dkC+hsyeXLw{s3J6yENfwQO$u zP;ujxuBAy>BiG~yzA)lRmrASwu4&fHAYW!8LkAgS;t_N4Z!9i`cuxovXiHRh=57pC zg8E?qIB&;eHo>RU$|rf%ehD2Xm=DFp?r+oJG;%w6vjC$=0WKvC0g(U}3OgyO100am zJikIpn9jSV4)WBRKdm8GKodZBJTbGAGXaJ>>r|2-C&{O{gVG~NIuwixcmV+MmZ_yZ z)kjNP=^qS$gU!DV`7a_icudON-%cquzuaB9vGb0s+~&tb{^h zBu$8&X%5`5`fS-Pf(1@NE&Q&`HWSauJ<0nAi2=)Lxq6+Ap=!RMs7lr0Y* z9o54oazyMDxC0R!x-c?ew^K-f62JX{>pK1Lq);kbk$4}ZnaAc+3*||iP#}tmb#tsaCRUmRy_Abt5i1;Rr3b}oeAS|y;D=MY)u;!F28$^cYmqdU)DoG+c zdKO=;7&ET!&aya=_v{&TDxg;1|EQMdr7!#ymMPOly!4$R<^(D)Hjlu}6kvv+#>uMs z!buVV5;nNyY>(JMhU$?dkW=RZBGx-kBVHo77 zsO8IzLKX>kc$+rgkj-gKG9D*Ish%fi3gQJZd{RjneS`Bci3GX>MP!mc%>zd?e4?50#==ita@cwCfo6ud%)WAG$1N|rHs85;qa@Tzu9fy^Y!-e!R=hp*M8d zsUAg;;c^x{p?F&|NWf-0tP*2!;KX=*bUZ=A0N1clAy-gs1;ojyO@lKrLAAuENy(@T zEI_rhucnPjiJ56*?JfFCu%O&m z`K#PlYyXXt8Eo{w9^9JD+&XCAx%F;;KzpC2Q$Ib0fzjrJnh@g<`S&=%h$(u?NQ3v3 z5w$3ufMLW$T;N=vOs> z$En^B7OFQGef5S=(r)K!fFt&`g^yG0U-pRocOjjO-2Z>s=WZWS0l4i)&;rP&m)l7G z(5aD&7U1oX7Vs&08jQw!M*#S`dP1?jw>9l141(f3>7aT|Ih9B;s5&G8)Ehv~t~;VP zbLDEbRxzvOb07%PIy!J?{!?aJmkI zTgJIg7U1-Rj{?r-?qG#IhP{DwQw1~M=+3;rqFJ$Ng|7)8TjpYkG)f|~i;(g}%OF|} zZl6F{rfJ$(NrveHwx^Lb*`VjD23d5(JIHO2ms*qA8Q80`44KKYzd@FLwb|@H6Sw@72vhuQ#gG#zSdb;-xBNFS1-3V1}W-~jzk3xbjOm&pO25hvv8bJmMIR3k-;M^v7;eA z_F?B$rDWnr$!IFeLK&9bvqoO~&mT($=QV>t$TbCt?l9XumnId@K_^ksteqc7sz zkwxsCa7kSbVL_}c5AFOH5*RUgafgVq=|4)aI#*EFUXG9vQ@o^GFUY47?zl{)qckW$ z0`vqtOx=4BAcFW&G0*tSUrPQOQttA$y9RvWvrRtgho|r5D&mXxqnA!y2E&z&&b8LY z)^o&A$>!z7O>w!^TDSSFIGk-1E3=+79o`9e=$;8^KTTI(82sefK}D(=IUGqbx3RL- z>TGXS7N2cV(w7p9I-oA0GEUCXj*Ds~3?8!we@LSQAmz(eZ-2MC%G+`yzxLMr&TWfk zfGW`tPB;qGgHz)mrLFu>);~dCVl-Ti)&hUU=5tpsciQ5Mguk1gB`LZl zaKUv8H$1mDNSLlJuC-RySGIEw` z4@kpQ$DRxN(L3KX2$K&Y{h35GN)&Tfx_03Cq>u6^If3Hln+D#BiMyn zx+-L!dJsr4{UVG^0;vz*8fz+Ee3g z=m3mtWf#3o7<%MqdOiB-X+}1MfJZ;hcs};@(r-vQxHCOM^WQd18 z+R*_yHL+9nj*d#8qPwIX%IKr#o420}p{jvQf})AUWQ-`mg4UyIspWg4hU~@P`Non5 z85lY|-w7cl-gp{G_^{`8Km=Fs*yHff^d5L%cO&Y^`EgOfGp!dIyd91r#2EdX1(yY$ z>mYOy(YYH!kY=~*0Sj6AwC8vi+HF^UFpfAfBR&R*IEoO?;57#YBqoICMR-!)bmW_s z$c9(VoH+Mc*e)Xr#{!P0D$x58T(C?C7-LHq1L4d+jG79L|M;4ts|1d3MTk?iF68U@ zcOSE@b%Y&Hi22q==gT6~*|^r(Ksd!$5mLA>qNi}#2@gbMsc}SODI`hoKungx9V9)4 T5D*VNNKa~=8mALuxSjt84Yc;X diff --git a/sources/MAKEINIT.~1~ b/sources/MAKEINIT.~1~ deleted file mode 100644 index 617a16be..00000000 --- a/sources/MAKEINIT.~1~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "27-Oct-92 14:10:38" "{Pele:mv:envos}Sources>MAKEINIT.;7" 26118 changes to%: (FNS I.ATOMNUMBER I.\ATOMCELL) (FILES MEM) previous date%: "25-Jan-91 16:00:30" "{Pele:mv:envos}Sources>MAKEINIT.;3") (* ; " Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT MAKEINITCOMS) (RPAQQ MAKEINITCOMS ((FNS LOADMAKEINIT LOADMKIFILES RELOAD MAKEINIT MKI.START) (COMS (* ;  "reading compiled files and processing well-known expressions") (FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS EVALFORMAKEINIT) (FNS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.FILECREATED I.PUTPROPS I.RPAQ I.RPAQQ I.RPAQ? I.SETTOPVAL I.NOUNDO) (PROP MKI ADDTOVAR DECLARE%: DEFINE-FILE-INFO FILECREATED PUTPROPS RPAQ RPAQ? RPAQQ LISPXPRINT PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL)) (FNS I.ATOMNUMBER I.\ATOMCELL I.FIXUPNUM I.FIXUPPTR I.FIXUPSYM I.WORDSPERNAMEENTRY I.SETSTKNTOFFSET) (COMS (* ; "stuff for MAXC") (FNS MKI.ATOM MKI.IEEE)) [COMS (* ;  "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (FNS MKI.DSET MKI.ADDTO MKI.PUTPROP) (VARS (MKI.ARRAY) (MKI.TVHA (HASHARRAY 400)) (MKI.PLHA (HASHARRAY 150)) (MKI.ATOMARRAY (HASHARRAY 5000)) (INIT.EXT 'SYSOUT] (COMS (FNS DUMPVP BOUTZEROS BIN16 BOUT16) (VARS (MKI.FirstDataByte 1024) (MKI.Page0Byte 512) (MKI.DATE (DATE)) MKI.CODESTARTOFFSET MKI.SEQUENTIAL PRINTEXPRS)) (INITVARS (PRINTEXPRS T) (REMOTECOMPILE.EXT COMPILE.EXT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PUTPROP (NAMEFIELD (INPUT) T) 'LOADDATE (GETFILEINFO (INPUT) 'ICREATIONDATE] (DECLARE%: EVAL@COMPILE (PROP MACRO SETXVAR IEQ) DONTCOPY (FILES (LOADCOMP) MEM)))) (DEFINEQ (LOADMAKEINIT (LAMBDA (LARGEFLG) (* lmm "31-JUL-81 14:27") (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (ADDTOVAR DIRECTORIES BLISP) (GCGAG 1000) (COND ((NOT LARGEFLG) (SETSEPR (QUOTE (%| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)) 1 FILERDTBL) (MINFS 45000 (QUOTE ARRAYP)) (MINFS 10000 (QUOTE FIXP)) (MINFS 3000 (QUOTE STRING.CHARS)) (MINFS 2000 (QUOTE ATOM.CHARS)))) (MOVD? (QUOTE NILL) (QUOTE MKNUMATOM)) (* ;; "This is a kludge to get around the problem that, while MKATOM is in LLNEW, MKNUMATOM is not, and MKATOM calls MKNUMATOM when given an atom beginning with a digit. It turns out that MKNUMATOM will always return NIL in the cases called from MAKEINIT because MAKEINIT is merely copying things which it knows are really LITATOM and spelled like it.") (MOVD? (QUOTE *) (QUOTE BLOCKRECORD)) (PUTDQ? FIXSPELL1 (LAMBDA (OLD NEW) (PRINT (LIST OLD (QUOTE ->) NEW) T T))))) (LOADMKIFILES) (SELECTQ (SYSTEMTYPE) ((D ALTO)) (PROGN (MINFS 10000 (QUOTE ALTOPOINTER)) (* ; "doesn't work until after datatype declaration has been loaded") (RECLAIM (QUOTE ARRAYP)) (RECLAIM (QUOTE ATOM.CHARS)) (MINFS 10000 (QUOTE ARRAYP)) (MINFS 5000 (QUOTE LISTP)) (SYSOUT (QUOTE MKI.SAV))))) ) (LOADMKIFILES (LAMBDA NIL (* mjs "13-Mar-84 14:41") (for X in (UNION MAKEINITFILES (SELECTQ (SYSTEMTYPE) ((ALTO D) NIL) MAXC.MAKEINITFILES)) do (RELOAD (PACKFILENAME (QUOTE BODY) X (QUOTE EXTENSION) COMPILE.EXT)))) ) (RELOAD (LAMBDA (FILE) (* lmm "13-APR-81 21:16") (PROG (DATE FULLFILENAME) RETRY (COND ((ILESSP (OR (GETPROP FILE (QUOTE LOADDATE)) MIN.INTEGER) (SETQ DATE (GETFILEINFO (SETQ FULLFILENAME (OR (FINDFILE FILE T) (GO NOTFOUND))) (QUOTE ICREATIONDATE)))) (LOAD FULLFILENAME T) (PUTPROP FILE (QUOTE LOADDATE) DATE))) (RETURN T) NOTFOUND (COND ((GETP (NAMEFIELD FILE) (QUOTE FILEDATES)) (PRINT (CONS FILE (QUOTE (already loaded))) T) (RETURN))) (ERROR FILE "not found.") (GO RETRY))) ) (MAKEINIT [LAMBDA (VERSIONS TYPE TOFILE LOADUPDIRS FONTDIRS) (* ; "Edited 19-Jul-90 17:26 by jds") (LOADMKIFILES) (* ;  "Load the files that have to be here to start making the init.") (PROG ([TYPELST (OR (LISTP TYPE) (OR (CDR (ASSOC TYPE MAKEINITTYPES)) (ERROR TYPE '?] FILES SIZEGUESS AFTERINITFILESET EXPRESSIONS) (* ;; "TYPELST is a list of the form (type file-list after-init-files init-size-guess)") (SETQ FILES (CADR TYPELST)) (SETQ AFTERINITFILESET (CADDR TYPELST)) (SETQ SIZEGUESS (CADDDR TYPELST)) (RESETLST [RESETSAVE (OUTPUT (SETQ TOFILE (OPENSTREAM (PACKFILENAME.STRING 'BODY (OR TOFILE (CAR TYPELST) 'XXX) 'EXTENSION INIT.EXT) 'OUTPUT 'NEW 8 (COND [NIL (* ;  "Can't do this until we can do GETFILEPTR on a sequential output file") (APPEND MKI.SEQUENTIAL '((TYPE BINARY)) (AND SIZEGUESS (CONS (LIST 'LENGTH (UNFOLD SIZEGUESS BYTESPERPAGE] (T '((TYPE BINARY] (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FL) (AND (OPENP FL) (CLOSEF FL)) (AND RESETSTATE (DELFILE (FULLNAME FL] TOFILE)) (PROG ((OUTX TOFILE)) (SETQ DIRECTORIES LOADUPDIRS) (MKI.START) (for X in FILES do (MKI.PASSFILE X)) (* ;; "Generally loads the files in 0LISPSET and 1LISPSET, with 2LISPSET getting loaded immediately after the init starts.") (AND LOADUPDIRS (MKI.DSET 'LOADUPDIRECTORIES LOADUPDIRS)) (AND FONTDIRS (MKI.DSET 'DISPLAYFONTDIRECTORIES FONTDIRS)) [COND (AFTERINITFILESET (* ; "Load stuff that has to be loaded before we can call LOADUP. Ugly expression here is because FILESLOAD is on MACHINEINDEPENDENT.") [MKI.ADDTO 'MAKEINIT.EXPRESSIONS `((MAPC ',(EVAL AFTERINITFILESET) (FUNCTION (LAMBDA (FILE) (OR [SOME LOADUPDIRECTORIES (FUNCTION (LAMBDA (DIR FL) (COND ((SETQ FL (INFILEP (PACKFILENAME.STRING 'DIRECTORY DIR 'NAME FILE 'EXTENSION COMPILE.EXT))) (LOAD FL 'SYSLOAD) T] (PRINT (CONS FILE '(not found)) T] (MKI.ADDTO 'BOOTFILES '(MAKEINIT.EXPRESSIONS] (I.MAKEINITLAST VERSIONS))) (RETURN (FULLNAME TOFILE]) (MKI.START (LAMBDA NIL (* bvm%: "12-Dec-84 15:23") (SETQ RESETPTR) (SETQ RESETPC) (BOUTZEROS MKI.FirstDataByte) (CLRHASH MKI.TVHA) (CLRHASH MKI.PLHA) (CLRHASH MKI.ATOMARRAY) (RESETMEMORY) (SETQ MKI.VALUES (for X in INITVALUES bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (EVAL (CADR X))) Y)) (SETQ MKI.PTRS (for X in INITPTRS bind Y collect (SET (SETQ Y (PACK* "I." (SUBSTRING (CAR X) 2 -1))) (CADR X)) Y)) (I.MAKEINITFIRST) (MKI.DSET NIL NIL) (MKI.DSET T T) (MKI.DSET (QUOTE MAKEINITDATES) (LIST MKI.DATE (DATE))) (for X in INITCONSTANTS when (NEQ (CAR X) (QUOTE *)) do (I.FSETVAL (CAR X) (COND ((LISTP (CADR X)) (I.VAG2 (CAADR X) (CADR (CADR X)))) (T (I.\COPY (CADR X))))))) ) ) (* ; "reading compiled files and processing well-known expressions") (DEFINEQ (MKI.PASSFILE (LAMBDA (FILESET) (* ; "Edited 30-Mar-87 17:17 by bvm:") (* ;;; "Read a DCOM file and load its contents into the INIT.") (* ;;; "FILESET can be one of a number, which is a LISPSET number, or a list of file names, or a file name") (COND ((NUMBERP FILESET) (* ; "We were given a nLISPSET number. Pack it up to get the list of files") (MKI.PASSFILE (EVALV (PACK* FILESET (QUOTE LISPSET))))) ((LISTP FILESET) (* ; "We were given a list of file names") (MAPC FILESET (FUNCTION MKI.PASSFILE))) (T (* ; "It's a file name. Read it in.") (INPUT (SETQ FILESET (OPENSTREAM (OR (FINDFILE (PACKFILENAME.STRING (QUOTE BODY) FILESET (QUOTE EXTENSION) REMOTECOMPILE.EXT) T) FILESET) (QUOTE INPUT) (QUOTE OLD) 8 MKI.SEQUENTIAL))) (MKI.ADDTO (QUOTE LOADEDFILELST) (LIST (SETQ FILESET (FULLNAME FILESET)))) (PRINT FILESET T T) (LET* ((FILEROOT (NAMEFIELD FILESET)) (COMSNAMES (LIST (PACK* FILEROOT (QUOTE COMS)))) SKIPVARS MEXPRS X) (DECLARE (SPECVARS COMSNAMES SKIPVARS MEXPRS)) (* ; " used by I.RPAQQ and DOFORM") (* ;;; "Loop here reading from the dcom file into the init.") (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (until (SELECTQ (SETQ X (READ)) ((STOP NIL) (* ; "End of file") T) NIL) do (COND ((NLISTP X) (* ;; "Start of a code object. Skip the code indicator (assume it says to read with DCODERD) and read the code") (IF (NOT (LITATOM (READ))) THEN (ERROR "Bad compiled function" X)) (I.DCODERD X)) (T (* ; "It's a form. go either do it now or add it to the forms to execute inside the init.") (DOFORM X))) finally (COND ((CAR MEXPRS) (* ; "There are expressions to be executed in the INIT when it comes up. Save them.") (MKI.ADDTO (SETQ FILESET (PACK* FILEROOT ".EXPRESSIONS")) (CAR MEXPRS)) (MKI.ADDTO (QUOTE BOOTFILES) (LIST FILESET)))))) (CLOSEF (INPUT)))))) ) (SCRATCHARRAY (LAMBDA (NBYTES ALIGN) (* ; "Edited 30-Mar-87 16:20 by bvm:") (COND ((OR (NULL MKI.ARRAY) (IGREATERP NBYTES (ARRAYSIZE MKI.ARRAY))) (* ;; "make sure the scratch array is big enough. Note that the scratch array is unboxed, not code, since we aren't going to be storing legitimate local code in it (let's not fool the garbage collector too much).") (SETQ MKI.ARRAY (create ARRAYP TYP _ \ST.BYTE BASE _ (\ALLOCBLOCK (FOLDHI NBYTES BYTESPERCELL) UNBOXEDBLOCK.GCT 0 CELLSPERQUAD) LENGTH _ NBYTES ORIG _ 0)))) (for I from 0 to (SUB1 (UNFOLD ALIGN BYTESPERCELL)) do (\BYTESETA MKI.ARRAY I 0)) (* ; "clear the fnheader area") MKI.ARRAY) ) (DOFORM (LAMBDA (X NOPROP) (* bvm%: "30-Aug-86 15:36") (* ;;; "Handle a raw form found in a dcom file that's going into a makeinit.") (LET ((FN (GETPROP (CAR X) (QUOTE MKI)))) (if (AND FN (NOT NOPROP)) then (* ; "it's a local command that can be run `renamed' . Execute it in the local context.") (* ASSERT%: (CALLS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.DEFLIST I.FILECREATED I.PRETTYDEFMACROS I.PUTPROPS I.RPAQ I.RPAQQ I.SETHASHQ)) (APPLY* FN X) else (* ;; "it's a command that has to be done remotely, since we don't know how to do it from here. Add it to the collection of init expressions.") (COND (PRINTEXPRS (PRINT X T T))) (SETQ MEXPRS (TCONC MEXPRS X))))) ) (CONSTFORMP (LAMBDA (X) (* lmm " 7-MAR-80 08:54") (COND ((LISTP X) (SELECTQ (CAR X) ((QUOTE FUNCTION) X) NIL)) ((LITATOM X) (SELECTQ X (NIL (QUOTE (QUOTE NIL))) (T T) (AND (SETQ X (GETHASH X MKI.TVHA)) (KWOTE (CDR X))))) (T X))) ) (NOTICECOMS (LAMBDA (VAL) (* lmm "10-Mar-85 14:51") (for X in VAL when (LISTP X) do (COND ((AND (EQ (CADR X) (QUOTE *)) (LITATOM (CADDR X))) (COND ((EQ (CAR X) (QUOTE COMS)) (push COMSNAMES (CADDR X))) (T (push SKIPVARS (CADDR X))))) (T (SELECTQ (CAR X) ((COMS DECLARE%:) (NOTICECOMS (CDR X))) NIL))))) ) (EVALFORMAKEINIT (LAMBDA (FORM) (* bvm%: " 2-NOV-83 15:22") (COND ((LISTP FORM) (SELECTQ (CAR FORM) (MKATOM (COND ((STRINGP (CADR FORM)) (MKATOM (CADR FORM))) (T (HELP)))) (HELP))) ((FIXP FORM) FORM) (T (HELP)))) ) ) (DEFINEQ (I.ADDTOVAR (LAMBDA (FORM) (* lmm " 2-DEC-81 23:58") (MKI.ADDTO (CADR FORM) (CDDR FORM)))) (I.DECLARE%: (LAMBDA (FORM) (* lmm "18-FEB-80 14:04") (PROG ((L FORM) (FLAG T) X FN) LP (COND ((NULL (SETQ L (CDR L))) (RETURN)) ((NLISTP (SETQ X (CAR L))) (SELECTQ X ((EVAL@LOAD DOEVAL@LOAD) (SETQ FLAG T)) (DONTEVAL@LOAD (SETQ FLAG NIL)) NIL)) (T (DOFORM X))) (GO LP))) ) (I.DEFINE-FILE-INFO (LAMBDA (FORM) (* bvm%: "30-Aug-86 15:32") (* ;;; "Set reader environment for reading rest of file") (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL (CDR FORM)))) ) (I.FILECREATED (LAMBDA (X) (* ; "Edited 12-Jan-88 11:00 by bvm") (* ;; "Form is (FILECREATED date filename . otherstuff)") (COND ((NLISTP (CADDR X)) (* ; "FILENAME a list is for the %"compiled on%" expression") (LET ((NAME (NAMEFIELD (CADDR X)))) (MKI.ADDTO (QUOTE BOOTLOADEDFILES) (LIST NAME)) (MKI.PUTPROP NAME (QUOTE FILEDATES) (LIST (CONS (CADR X) (CADDR X)))))))) ) (I.PUTPROPS (LAMBDA (FORM) (* lpd%: "29-APR-77 13:22") (MKI.PUTPROP (CADR FORM) (CADDR FORM) (CADDDR FORM)))) (I.RPAQ (LAMBDA (FORM) (* edited%: "10-Jul-84 14:05") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL) T))))) ) (I.RPAQQ (LAMBDA (FORM) (* lmm "30-APR-80 22:12") (PROG ((ATM (CADR FORM)) (VAL (CADDR FORM))) (COND ((FMEMB ATM COMSNAMES) (NOTICECOMS VAL)) ((FMEMB ATM SKIPVARS)) (T (MKI.DSET ATM VAL))))) ) (I.RPAQ? (LAMBDA (FORM) (* lmm " 7-MAR-80 08:36") (PROG ((VAL (CADDR FORM)) V) (COND ((SETQ V (CONSTFORMP VAL)) (MKI.DSET (CADR FORM) (EVAL V))) (T (DOFORM (LIST (QUOTE SETTOPVAL) (KWOTE (CADR FORM)) VAL)))))) ) (I.SETTOPVAL (LAMBDA (FORM) (* edited%: "10-Jul-84 14:07") (PROG (V) (if (AND (EQ (CAR (LISTP (CADR FORM))) (QUOTE QUOTE)) (SETQ V (CONSTFORMP (CADDR FORM)))) then (MKI.DSET (CADR (CADR FORM)) (EVAL V)) else (DOFORM FORM T)))) ) (I.NOUNDO (LAMBDA (FORM) (* edited%: "10-Jul-84 14:02") (if (EQ (NTHCHAR (CAR FORM) 1) (QUOTE /)) then (DOFORM (CONS (SUBATOM (CAR FORM) 2 -1) (CDR FORM))) else (SHOULDNT))) ) ) (PUTPROPS ADDTOVAR MKI I.ADDTOVAR) (PUTPROPS DECLARE%: MKI I.DECLARE%:) (PUTPROPS DEFINE-FILE-INFO MKI I.DEFINE-FILE-INFO) (PUTPROPS FILECREATED MKI I.FILECREATED) (PUTPROPS PUTPROPS MKI I.PUTPROPS) (PUTPROPS RPAQ MKI I.RPAQ) (PUTPROPS RPAQ? MKI I.RPAQ?) (PUTPROPS RPAQQ MKI I.RPAQQ) (PUTPROPS LISPXPRINT MKI NILL) (PUTPROPS PRETTYCOMPRINT MKI NILL) (PUTPROPS * MKI NILL) (PUTPROPS SETTOPVAL MKI I.SETTOPVAL) (PUTPROPS SETQQ MKI I.RPAQQ) (PUTPROPS SETQ MKI I.RPAQ) (PUTPROPS /SETTOPVAL MKI I.NOUNDO) (DEFINEQ (I.ATOMNUMBER [LAMBDA (A) (* ;  "Edited 27-Oct-92 14:10 by sybalsky:mv:envos") (* ;; "Given a symbol, return the symbol's atom #, in the INIT being made.") (* ;; "NB that this will work only so long as there are no NEW-SYMBOLs in the INIT, because of the LOLOC.") (I.LOLOC (COND ((LITATOM A) (MKI.ATOM A)) (T A]) (I.\ATOMCELL [LAMBDA (X N) (* ;  "Edited 26-Oct-92 14:24 by sybalsky:mv:envos") (LET ((ATOMNO (I.ATOMNUMBER X))) (COND (NIL (* ;; "THIS WAS THE PRE-BIGVM CODE:") (LET [(LOC (SELECTC N (10 (I.ATOMNUMBER X)) (12 (I.ATOMNUMBER X)) (2 (I.ATOMNUMBER X)) (8 (I.ATOMNUMBER X)) (SHOULDNT] (I.ADDBASE (I.VAG2 N LOC) LOC))) [(EQ (LRSH ATOMNO 16) 0) (* ; "Xerox Lisp traditional symbol") (LET [(LOC (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT] (I.ADDBASE (I.VAG2 8 0) (IPLUS LOC (ITIMES 10 ATOMNO] (T (* ;  "New symbol that appears after traditional symbol runs out.") (LET [(OFFSET (SELECTC N (10 4) (12 2) (2 6) (8 0) (SHOULDNT] (I.ADDBASE ATOMNO OFFSET]) (I.FIXUPNUM [LAMBDA (CA BN NUM MASK) (* ; "Edited 17-Jul-90 14:28 by jds") (* ;; "ÿ2ÿPerform atom-number fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN NUM)) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND NUM MASK) 8) 255))) (\BYTESETA CA BN (LOGAND NUM 255]) (I.FIXUPPTR [LAMBDA (CA BN PTR) (* ; "Edited 22-Jul-90 12:10 by jds") (* ;; "Specific for MAXC --- actual ptr is same as simulated ptr") (PROG ((LOLOC (I.LOLOC PTR))) (\BYTESETA CA (SUB1 BN) (LRSH LOLOC 8)) (\BYTESETA CA BN (LOGAND LOLOC 255)) (\BYTESETA CA (IDIFFERENCE BN 2) (LOGOR (\BYTELT CA (IDIFFERENCE BN 2)) (I.HILOC PTR]) (I.FIXUPSYM [LAMBDA (CA BN NUM MASK) (* ; "Edited 23-Jan-91 19:04 by jds") (* ;; "ÿ2ÿPerform SYMBOL fixup for a code block.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (* ;; "If it's on a machine wiht 3 byte atom numbers, treat it as a pointer.") (I.FIXUPPTR CA BN (I.ATOMNUMBER NUM))) (T (* ;; "Otherwise, fill in the two bytes.") (\BYTESETA CA (SUB1 BN) (LOGOR (LOGAND (\BYTELT CA (SUB1 BN)) (LRSH (LOGXOR MASK 65535) 8)) (LOGAND (LRSH (LOGAND (I.ATOMNUMBER NUM) MASK) 8) 255))) (\BYTESETA CA BN (LOGAND (I.ATOMNUMBER NUM) 255]) (I.WORDSPERNAMEENTRY [LAMBDA NIL (* ; "Edited 25-Jan-91 15:35 by jds") (* ;; "For MAKEINIT, returns the number of words in a name-table entry.") (* ;; "For the old 2-byte atom case, it's 1 word; for 3-byte atoms, 2 words.") (* ;; "An %"Entry%" means an entry in each half of the name table (symbol & type/offset).") (* ;; "While we're building the INIT, react to either :3-BYTE or :3-BYTE-INIT in the target architecture -- we're automatically CROSSCOMPILING as far as this function is concerned.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) 2) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) 2) (T 1]) (I.SETSTKNTOFFSET [LAMBDA (BASE OFFSET TYPE VAL) (* ; "Edited 25-Jan-91 16:00 by jds") (* ;; "FOR MAKEINIT: Set the offset entry for a name-table entry, from the symbol to fill in plus the variable-type marker value SHIFTED LEFT 14 BITS ALREADY.") (COND ((FMEMB :3-BYTE COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) ((FMEMB :3-BYTE-INIT COMPILER::*TARGET-ARCHITECTURE*) (I.FIXUPNUM BASE (IDIFFERENCE OFFSET BYTESPERWORD) TYPE) (I.FIXUPNUM BASE OFFSET VAL)) (T (I.FIXUPNUM BASE OFFSET (IPLUS TYPE VAL]) ) (* ; "stuff for MAXC") (DEFINEQ (MKI.ATOM (LAMBDA (X) (* lmm "29-JUL-81 22:46") (* ; "for MAXC") (AND X (OR (GETHASH X MKI.ATOMARRAY) (PUTHASH X (COND ((EQ X (QUOTE NOBIND)) PTRNOBIND) (T (I.COPYATOM X))) MKI.ATOMARRAY)))) ) (MKI.IEEE (LAMBDA (X BOX) (* bvm%: "16-Dec-80 00:44") (* ;; "Converts pdp-10 floating-point number X to IEEE standard for Dolphin, storing (with I.PUTBASE) into BOX. For MAXC only.") (PROG (MAGNITUDE (SIGN 0) (EXP 0) (FRAC 0)) RETRY (SETQ MAGNITUDE (COND ((MINUSP X) (SETQ SIGN 32768) (IMINUS (OPENR (LOC X)))) (T (OPENR (LOC X))))) (COND ((ZEROP MAGNITUDE) (GO DONE)) ((IEQP (LOGAND MAGNITUDE 67108864) 0) (* ; "unnormalized number???") (SETQ X (FPLUS X 0.0)) (GO RETRY))) (COND ((ILEQ (SETQ EXP (IDIFFERENCE (LRSH MAGNITUDE 27) 2)) 0) (* ;; "Exponent bias is off by 1, plus another 1 because of the implicit high bit. Thus have to watch for underflow") (ERROR "Unrepresentable floating-point number" X) (SETQ EXP (SETQ SIGN 0)) (* ; "If continued, make it zero") (GO DONE))) (SETQ FRAC (IPLUS (LOGAND (LRSH MAGNITUDE 3) 16777215) (COND ((OR (ILESSP (LOGAND MAGNITUDE 7) 4) (EQ (LOGAND MAGNITUDE 15) 4)) (* ; "Round down") 0) (T 1)))) (COND ((IGREATERP FRAC 16777215) (* ; "Rounding overflowed the high bit") (SETQ FRAC (LRSH FRAC 1)) (* ; "EXP can't overflow, because of bias difference") (SETQ EXP (ADD1 EXP)))) (* ; "FRAC is now a 24-bit fraction with its high bit on") DONE (I.PUTBASE BOX 0 (LOGOR SIGN (LLSH EXP 7) (LOGAND (LRSH FRAC 16) 127))) (I.PUTBASE BOX 1 (LOGAND FRAC 65535)))) ) ) (* ; "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.") (DEFINEQ (MKI.DSET (LAMBDA (A VAL) (* ; "Edited 12-Jan-88 11:03 by bvm") (LET ((LST (GETHASH A MKI.TVHA))) (COND (LST (COND ((NOT (EQUAL VAL (CDR LST))) (EXEC-FORMAT "(Value of ~S changed from ~S to ~S)~%%" A (CDR LST) VAL))) (RPLACD LST VAL)) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.ADDTO (LAMBDA (A VAL) (* lpd%: "29-APR-77 13:20") (PROG ((LST (GETHASH A MKI.TVHA))) (COND (LST (RPLACD LST (UNION VAL (CDR LST)))) (T (PUTHASH A (CONS NIL VAL) MKI.TVHA))))) ) (MKI.PUTPROP (LAMBDA (A PROP VAL) (* ; "Edited 12-Jan-88 11:04 by bvm") (LET ((LST (GETHASH A MKI.PLHA))) (COND (LST (COND ((LISTGET LST PROP) (EXEC-FORMAT "(Property ~S of ~S has been changed)~%%" A PROP))) (LISTPUT LST PROP VAL)) (T (PUTHASH A (LIST PROP VAL) MKI.PLHA))))) ) ) (RPAQQ MKI.ARRAY NIL) (RPAQ MKI.TVHA (HASHARRAY 400)) (RPAQ MKI.PLHA (HASHARRAY 150)) (RPAQ MKI.ATOMARRAY (HASHARRAY 5000)) (RPAQQ INIT.EXT SYSOUT) (DEFINEQ (DUMPVP (LAMBDA (VP) (* lpd%: "27-APR-77 20:24") (PRIN1 (QUOTE *) T) (WriteoutPage OUTX VP))) (BOUTZEROS (LAMBDA (N) (* lmm "16-MAY-81 16:49") (FRPTQ N (\BOUT OUTX 0)))) (BIN16 (LAMBDA (J) (* lmm "16-MAY-81 16:49") (IPLUS (LLSH (\BIN J) 8) (\BIN J)))) (BOUT16 (LAMBDA (J N) (* lmm "16-MAY-81 16:51") (\BOUT J (LRSH N 8)) (\BOUT J (LOGAND N 255)))) ) (RPAQQ MKI.FirstDataByte 1024) (RPAQQ MKI.Page0Byte 512) (RPAQ MKI.DATE (DATE)) (RPAQQ MKI.CODESTARTOFFSET 60) (RPAQQ MKI.SEQUENTIAL ((SEQUENTIAL T))) (RPAQQ PRINTEXPRS T) (RPAQ? PRINTEXPRS T) (RPAQ? REMOTECOMPILE.EXT COMPILE.EXT) (DECLARE%: DONTEVAL@LOAD DOCOPY (PUTPROP (NAMEFIELD (INPUT) T) 'LOADDATE (GETFILEINFO (INPUT) 'ICREATIONDATE)) ) (DECLARE%: EVAL@COMPILE (PUTPROPS SETXVAR MACRO [X `(SETQ.NOREF %, (CADAR X) %, (CADR X]) (PUTPROPS IEQ MACRO ((X Y) (IEQP X Y))) DONTCOPY (FILESLOAD (LOADCOMP) MEM) ) (PUTPROPS MAKEINIT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2698 9690 (LOADMAKEINIT 2708 . 3911) (LOADMKIFILES 3913 . 4133) (RELOAD 4135 . 4618) ( MAKEINIT 4620 . 8982) (MKI.START 8984 . 9688)) (9768 13669 (MKI.PASSFILE 9778 . 11571) (SCRATCHARRAY 11573 . 12222) (DOFORM 12224 . 12901) (CONSTFORMP 12903 . 13137) (NOTICECOMS 13139 . 13447) ( EVALFORMAKEINIT 13449 . 13667)) (13670 15790 (I.ADDTOVAR 13680 . 13774) (I.DECLARE%: 13776 . 14052) ( I.DEFINE-FILE-INFO 14054 . 14244) (I.FILECREATED 14246 . 14620) (I.PUTPROPS 14622 . 14735) (I.RPAQ 14737 . 14958) (I.RPAQQ 14960 . 15156) (I.RPAQ? 15158 . 15373) (I.SETTOPVAL 15375 . 15607) (I.NOUNDO 15609 . 15788)) (16426 22289 (I.ATOMNUMBER 16436 . 16927) (I.\ATOMCELL 16929 . 18545) (I.FIXUPNUM 18547 . 19364) (I.FIXUPPTR 19366 . 19847) (I.FIXUPSYM 19849 . 20797) (I.WORDSPERNAMEENTRY 20799 . 21554) (I.SETSTKNTOFFSET 21556 . 22287)) (22321 23829 (MKI.ATOM 22331 . 22527) (MKI.IEEE 22529 . 23827 )) (23926 24691 (MKI.DSET 23936 . 24219) (MKI.ADDTO 24221 . 24406) (MKI.PUTPROP 24408 . 24689)) (24865 25243 (DUMPVP 24875 . 24972) (BOUTZEROS 24974 . 25053) (BIN16 25055 . 25140) (BOUT16 25142 . 25241))) )) STOP \ No newline at end of file diff --git a/sunloadup/LLPARAMS b/sunloadup/LLPARAMS deleted file mode 100644 index 55b21afc..00000000 --- a/sunloadup/LLPARAMS +++ /dev/null @@ -1,1705 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 8) -(FILECREATED "31-Jan-98 09:16:51" {DSK}disk2>jdstools>lc3>lispcore3.0>sources>LLPARAMS.;15 232505Q - - changes to%: (VARS INITCONSTANTS) - - previous date%: "30-Jan-98 12:43:29" -{DSK}disk2>jdstools>lc3>lispcore3.0>sources>LLPARAMS.;14) - - -(* ; " -Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 1998 by Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. All rights reserved. -") - -(PRETTYCOMPRINT LLPARAMSCOMS) - -(RPAQQ LLPARAMSCOMS ( - (* ;; - "This file defines the constants that control how a SYSOUT is laid out.") - - (FNS MAKERECORD) - - (* ;; "When you change the SYSOUT's layout in this file, you must also") - - - (* ;; " Recreate RDSYS in the library, using (DORENAME 'R)") - - - (* ;; - " Recompile DLFIXINIT and anything else that uses the constants defined here.") - - - (* ;; " Recompile LLFAULT. recompile VMEM") - - (DECLARE%: DONTCOPY - (EXPORT (CONSTANTS (WINDFLG T)) - - (* ;; - "INITCONSTANTS are constants (e.g. \LISTPDTD) to be defined at init time.") - - (VARS INITCONSTANTS MISCSTATSLAYOUT IFPAGELAYOUT - MAIKO.IFPAGELAYOUT IOPAGELAYOUT) - [CONSTANTS * (for X in INITCONSTANTS when (FIXP (CADR X)) - collect - (LIST (CAR X) - (CADR X] - (CONSTANTS * \MPERRORS) - (GLOBALVARS * (for X in INITCONSTANTS when - [AND (NEQ (CAR X) - '*) - (NOT (FIXP (CADR X] - collect - (CAR X))) - (P * (LIST (MAKERECORD 'MISCSTATS MISCSTATSLAYOUT) - (COND ((EQ \MACHINETYPE \MAIKO) - (MAKERECORD 'IFPAGE MAIKO.IFPAGELAYOUT)) - (T (MAKERECORD 'IFPAGE IFPAGELAYOUT))) - (MAKERECORD 'IOPAGE IOPAGELAYOUT))) - (MACROS EMADDRESS EMGETBASE EMPUTBASE EMULATORSEGMENT - EMPOINTER EMADDRESSP))) - (PROP MAKEFILE-ENVIRONMENT LLPARAMS))) - - - -(* ;; "This file defines the constants that control how a SYSOUT is laid out.") - -(DEFINEQ - -(MAKERECORD [LAMBDA (NAME LAYOUT) (* bvm%: "29-NOV-82 17:40") (PROG ((I 0) PTRS M NAM) (RETURN `(BLOCKRECORD %, NAME %, [for X in LAYOUT collect (CONS (SETQ NAM (CAR X)) (COND ((EQ NAM '*) (CDR X)) (T (PROG1 [COND [[FIXP (SETQ M (CAR (SETQ X (CDR X] (LIST M (CAR (SETQ X (CDR X] (T (SETQ M (SELECTQ (CAR X) ((FIXP FULLXPOINTER) (OR (EVENP I WORDSPERCELL) (ERROR "Record field not aligned" (CONS NAM X))) 2) (WORD 1) (SHOULDNT))) (LIST (CAR X] [COND ((CADDR X) (SETQ PTRS (CONS (LIST (PACK* NAM 'PTR) `(\ADDBASE DATUM %, I)) PTRS] (add I M))] %,. [AND PTRS `((ACCESSFNS %, NAME %, PTRS] (CREATE (\ALLOCBLOCK %, (FOLDHI I WORDSPERCELL]) -) - - - -(* ;; "When you change the SYSOUT's layout in this file, you must also") - - - - -(* ;; " Recreate RDSYS in the library, using (DORENAME 'R)") - - - - -(* ;; " Recompile DLFIXINIT and anything else that uses the constants defined here.") - - - - -(* ;; " Recompile LLFAULT. recompile VMEM") - -(DECLARE%: DONTCOPY -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE - -(RPAQQ WINDFLG T) - - -(CONSTANTS (WINDFLG T)) -) - -(RPAQQ INITCONSTANTS ( - -(* ;;; "(LISPNAME VALUE BCPLNAME UCODENAME)") - - (CDRCODING 1 T T) - (* ; - "IF CDRCODING=0, CDR CODING IS OFF, OTHERWISE ON") - - (* ;; "type numbers -- repeated on LLBASIC too") - - (\SMALLP 1 SMALLTYPE SmallType) - (\FIXP 2 INTEGERTYPE FixpType) - (\FLOATP 3 FLTPTTYPE FloatpType) - (\LITATOM 4 ATOMTYPE AtomType) - (\LISTP 5 LISTTYPE ListType) - (\ARRAYP 6 ARRAYPTRTYPE ArrayType) - (\STRINGP 7 STRINGPTRTYPE) - (\STACKP 10Q) - (\CHARACTERP 11Q) - (\VMEMPAGEP 12Q NIL VMemPagePType) - (\STREAM 13Q NIL STREAMTYPE) - - (* ;; "TYPE TABLE CONSTANTS - - - - - - - - - - - - - - - - - - - - - -") - - (\TT.TYPEMASK 3777Q TTTypeMask T) - (\TT.NOREF 100000Q NIL T) - (\TT.SYMBOLP 40000Q NIL T) - (\TT.FIXP 20000Q) - (\TT.NUMBERP 10000Q) - (\TT.ATOM 4000Q) - - (* ;; - "page map - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -") - - (\PMblockSize 40Q PMBLOCKSIZE) - (\STATSsize 10Q T) - (\NumPMTpages 10Q) - (\EmptyPMTEntry 177777Q T) - (\FirstVmemBlock 2 T) - (\MAXVMPAGE 377775Q) - (\MAXVMSEGMENT 377Q) - - (* ;; "interface page") - - (\IFPValidKey 12743Q T) - - (* ;; "MDS") - - (\FirstMDSPage 77776Q) (* ; "Was 37776Q pre 16-meg intiial") - (\MaxMDSPage 1777775Q) - (\DefaultSecondMDSPage 177774Q) - (\MDSIncrement 1000Q) - (\PagesPerMDSUnit 2) - (* ; - "(FOLDLO \MDSIncrement WORDSPERPAGE)") - - (* ;; "arrays") - - (\ARRAYSPACE (56Q 0)) - (\FirstArraySegment 56Q) - (\FirstArrayPage 27000Q) - (\ARRAYSPACE2 (100Q 0)) - (\DefaultSecondArrayPage 100000Q) (* ; "Was 40000Q before 16meg initial") - - (* ;; "stack block constants") - - (\StackMask 160000Q T T) - (\FxtnBlock 140000Q T T) - (\GuardBlock 160000Q T T) - (\BFBlock 100000Q T T) - (\FreeStackBlock 120000Q T T) - (\NotStackBlock 0) - (* ; "none of the above") - (\MinExtraStackWords 40Q T T) - - (* ;; "backspace kludge") - - (ERASECHARCODE 0 T) - - (* ;; "GC constants") - - (\HT1CNT 2000Q NIL T) - (\HTSTKBIT 1000Q NIL T) - (\HTCNTMASK 176000Q NIL T) - (\HTMAINSIZE 200000Q NIL T) - (\HTCOLLSIZE 4000000Q NIL T) - (* ; "HTCOLL size in words") - (\HTENDFREE 1 NIL T) - (\HTFREEPTR 0 NIL T) - - (* ;; "pointers and lengths of various data spaces") - - (\ATOMSPACE (0 0) - (ATOMspace NIL) - (atomHiVal NIL)) - (\AtomHI 0) - (\CHARHI 7) - (* ; - "overlap character space and the atom hash table space") - (\AtomHashTable (25Q 0) - (AHTspace AHTbase)) - (\AtomHTpages 400Q AHTSIZE) - (\LastAtomPage 377Q) - (\MaxAtomFrLst 177777Q) - (\SMALLPOSPSPACE (16Q 0)) - (\SmallPosHi 16Q SMALLPOSspace smallpl) - (\SMALLNEGSPACE (17Q 0)) - (\SmallNegHi 17Q SMALLNEGspace smallneg) - (\NumSmallPages 1000Q) - - (* ;; "PNAME SPACEin the old world; used for initial atoms now.") - - (\PNPSPACE (10Q 0) - (PNPspace PNPbase)) - (\PNAME.HI 10Q) - (\OLDATOMSPACE (54Q 0)) - (* ; "NEW ATOM SPACE") - (\ATOM.HI 54Q) - (* ; "HI PART OF NEW ATOM SPACE") - - (* ;; "Definitions in old atom world") - - (\DEFSPACE (12Q 0) - (DEFspace DEFbase) - (DEFspace DEFbase)) - (\DEF.HI 12Q) - (\VALSPACE (14Q 0) - (TOPVALspace TOPVALbase) - (VALspace VALbase)) - (\VAL.HI 14Q) - (\PLISTSPACE (2 0) - (PLISTspace PLISTbase)) - (\PLIST.HI 2) - (\PAGEMAP (5 0) - (PAGEMAPspace PAGEMAPbase)) - (\NumPageMapPages 400Q) - (\PageMapTBL (24Q 1000Q) - (PMTspace PMTbase)) - (\InterfacePage (24Q 0) - (INTERFACEspace INTERFACEbase) - (INTERFACEspace INTERFACEbase)) - (\IOPAGE (0 177400Q)) - (\DoveIORegion (0 40000Q)) - (\IOCBPAGE (0 400Q)) - (\FPTOVP (2 0)) - (\MDSTypeTable (30Q 0) - (MDSTYPEspace MDSTYPEbase) - (MDSTYPEspace MDSTYPEbase)) - (\MDSTTsize 2000Q T) - (* ; "in Pages") - (\MISCSTATS (24Q 5000Q) - (STATSspace MISCSTATSbase)) - (\UFNTable (24Q 6000Q) - NIL - (STATSspace UFNTablebase)) - (\UFNTableSize 2) - (\DTDSpaceBase (24Q 10000Q) - (DTDspace DTDbase) - (DTDspace DTDbase)) - (\DTDSize 22Q T) - (\LISTPDTD (24Q 10132Q)) - (\EndTypeNumber 3777Q) - (\LOCKEDPAGETABLE (24Q 70000Q)) - (\NumLPTPages 20Q) - (\STACKSPACE (1 0) - (STACKspace NIL) - (STACKspace NIL)) - (\GuardStackAddr 170000Q) - (\LastStackAddr 177776Q) - (\STACKHI 1 T T) - (\HTMAIN (26Q 0) - (HTMAINspace HTMAINbase) - (HTMAINspace HTMAINbase)) - (\HTMAINnpages 400Q T) - (\HTOVERFLOW (27Q 0) - NIL - (NIL HTOVERFLOWbase)) - (\HTBIGCOUNT (27Q 100000Q)) - (\HTCOLL (34Q 0) - NIL - (HTCOLLspace HTCOLLbase)) - (\DISPLAYREGION (22Q 0)) - (\D1BCPLspace 0 T LEmubrHiVal) - (\D0BCPLspace 0 T) - - (* ;; "Interface Page locations") - - (\CurrentFXP 0 T T) - (\ResetFXP 1 T T) - (\SubovFXP 2 T T) - (\KbdFXP 3 T T) - (\HardReturnFXP 4 T T) - (\GCFXP 5) - (\FAULTFXP 6 T T) - (\MiscFXP 16Q T T) - (\TeleRaidFXP 30Q T T) - - (* ;; "emulator segment locations") - - (DCB.EM 420Q) - (DISPINTERRUPT.EM 421Q) - (CURSORBITMAP.EM 431Q) - (KBDAD0.EM 177034Q) - (KBDAD1.EM 177035Q) - (KBDAD2.EM 177036Q) - (KBDAD3.EM 177037Q) - (UTILIN.EM 177030Q) - (CURSORX.EM 426Q) - (CURSORY.EM 427Q) - (MOUSEX.EM 424Q) - (MOUSEY.EM 425Q) - (\LispKeyMask 20000Q T T) - (\BcplKeyMask 10400Q T T) - (* ; "Machine types") - (\MAIKO 3) - (\DOLPHIN 4) - (\DORADO 5) - (\DANDELION 6) - (\DAYBREAK 10Q) - - (* ;; "FOR DLION (AND DAYBREAK)") - - (\VP.DISPLAY 11000Q) - (\NP.DISPLAY 312Q) - (* ; - "for Dorado display 1024x808 pixels / (16 pixels/word x 256 words/page)") - (\NP.WIDEDOVEDISPLAY 363Q) - (* ; - "Wide Dove display 1152x864 pixels") - (\WIDEDOVEDISPLAYWIDTH 2200Q) - (\RP.AFTERDISPLAY 316Q) - (* ; "Includes 4 pages for cursor") - (\RP.AFTERDOVEDISPLAY 363Q) - (* ; "if big screen") - (\RP.DISPLAY 0) - (\RP.TEMPDISPLAY 5001Q) - (\RP.MISCLOCKED 5364Q) - (* ; - "(+ \RP.TEMPDISPLAY \NP.WIDEDOVEDISPLAY)") - (\RP.STACK 1400Q) - (\VP.STACK 400Q) - (\RP.MAP 400Q) - (\NP.MAP 400Q) - (\RP.IOPAGE 1000Q) - (* ; - "The DOVE IOCBPAGE can go anywhere, but should be under the 1mbyte range") - (\RP.DOVEIOCBPAGE 1037Q) - (\RP.DOVEIORGN 1040Q) - (\VP.DOVEIORGN 100Q) - (\DOVEIORGNSIZE 100Q) - (\VP.IOPAGE 377Q) - (\VP.IFPAGE 12000Q) - (\VP.FPTOVP 1000Q) - (\NP.FPTOVP 10000Q) - (\RP.FPTOVP 2000Q) - (\RP.STARTBUFFERS 1200Q) - (\VP.TYPETABLE 14000Q) - (\NP.TYPETABLE 2000Q) - (\RP.TYPETABLE 12000Q) - (\VP.GCTABLE 13000Q) - (\NP.GCTABLE 400Q) - (\RP.GCTABLE 14000Q) - (\VP.GCOVERFLOW 13400Q) - (\NP.GCOVERFLOW 1) - (\RP.GCOVERFLOW 14400Q) - (\FP.IFPAGE 2) - (\VP.IOCBS 1) - (\VP.PRIMARYMAP 12002Q) - (\VP.SECONDARYMAP 2400Q) - (\VP.LPT 12160Q) - (\VP.INITSCRATCH 10Q) - (\VP.RPT 200Q) - (\VP.BUFFERS 332Q) - (* ; "DLion processor commands") - (\DL.PROCESSORBUSY 100000Q) - (\DL.SETTOD 100001Q) - (\DL.READTOD 100002Q) - (\DL.READPID 100003Q) - (\DL.BOOTBUTTON 100004Q))) - -(RPAQQ MISCSTATSLAYOUT ((STARTTIME FIXP MSstrtTime) - (TOTALTIME FIXP) - (SWAPWAITTIME FIXP T) - (PAGEFAULTS FIXP T) - (SWAPWRITES FIXP T) - (DISKIOTIME FIXP T) - (DISKOPS FIXP T) - (KEYBOARDWAITTIME FIXP T) - (GCTIME FIXP T) - (NETIOTIME FIXP T) - (NETIOOPS FIXP T) - (SWAPTEMP0 FIXP) - (SWAPTEMP1 FIXP) - (RCLKSECOND FIXP) - (SECONDSCLOCK FIXP) - (MILLISECONDSCLOCK FIXP) - (BASECLOCK FIXP) - (RCLKTEMP0 FIXP) - (SECONDSTMP FIXP) - (MILLISECONDSTMP FIXP) - (BASETMP FIXP) - (EXCESSTIMETMP FIXP) - (CLOCKTEMP0 FIXP) - (DISKTEMP0 FIXP) - (DISKTEMP1 FIXP) - (TELERAIDTEMP1 FIXP) - (TELERAIDTEMP2 FIXP) - (TELERAIDTEMP3 FIXP) - (LASTUSERACTION FIXP) - (DLMOUSETIMER FIXP) - (DLMOUSETEMP FIXP))) - -(RPAQQ IFPAGELAYOUT ((CurrentFXP WORD) - (* ; - "First 7 items are FX values for user and 6 system contexts.") - (ResetFXP WORD) - (SubovFXP WORD) - (KbdFXP WORD) - (HardReturnFXP WORD) - (GCFXP WORD) - (FAULTFXP WORD) - (EndOfStack WORD) - (* ; - "Stack high-water mark: address of guard block at current end of stack") - (LVersion WORD) - (* ; - "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") - (MinRVersion WORD) - (MinBVersion WORD) - (RVersion WORD) - (* ; - "Bcpl fills in the actual microcode, Bcpl versions.") - (BVersion WORD) - (MachineType WORD) - (MiscFXP WORD) - (* ; "FX for MISC context") - (Key WORD) - (* ; - "= IFPValidKey if vmem consistent.") - (SerialNumber WORD) - (* ; - "Pup host number (Dorado/Dolphin)") - (EmulatorSpace WORD) - (* ; - "Hiloc of bcpl space (always zero now)") - (ScreenWidth WORD) - (NxtPMAddr WORD) - (* ; - "Next page to be allocated in secondary page map table") - (NActivePages WORD) - (* ; "Length of vmem in use") - (NDirtyPages WORD) - (* ; - "not used, but maintained as = NActivePages") - (filePnPMP0 WORD) - (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live") - (filePnPMT0 WORD) - (* ; - "Sysout page number of first page of primary page map table") - (TELERAIDFXP WORD) - (* ; "FX for TeleRaid server context") - (NATIVE-START-MEM-PAGE WORD) - (* ; - "Unix page where native code starts") - (NATIVE-LENGTH-PAGE WORD) - (* ; "Unix page length of native code") - (NATIVE-PAGE-OFFSET WORD) - (* ; - "Lisp Disk Page offset of native code") - (UserNameAddr WORD) - (* ; - "Addresses in bcpl space (seg 0) of global user name and password") - (UserPswdAddr WORD) - (StackBase WORD) - (* ; - "Stack address where user stack starts") - (FAULTHI WORD) - (* ; - "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") - (FAULTLO WORD) - (DEVCONFIG WORD) - (* ; "IT'S FOR KB,DISP TYPE") - (* ; - "Formerly REALPAGETABLE, back when it was always in Bcpl space.") - (RPTSIZE WORD) - (* ; - "Number of entries in Real Page Table") - (RPOFFSET WORD) - (* ; "RP-RPOFFSET => index in table") - (MAXETHERBYTES WORD) - (* ; - "Number of bytes available in a pbi, not counting encapsulation (Dorado)") - (EMBUFVP WORD) - (* ; - "VP of a one-page emulator buffer") - (NSHost0 WORD) - (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in.") - (NSHost1 WORD) - (NSHost2 WORD) - (MDSZone WORD) - (* ; - "Obsolete -- was used by Dolphin 10MB network code.") - (MDSZoneLength WORD) - (EMUBUFFERS WORD) - (* ; - "Buffer space in segment 0 for swapping/disk activity") - (EMUBUFLENGTH WORD) - (* ; "Number of words of said space") - (LASTNUMCHARS WORD) - (* ; "No longer used?") - (SYSDISK WORD) - (* ; - "Address of sysDisk in Bcpl space -- disk obj for boot partition.") - (ISFMAP WORD) - - (* ;; "The following 4 are for \MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!") - - (MISCSTACKFN FULLXPOINTER) - (MISCSTACKARG1 FULLXPOINTER) - (MISCSTACKARG2 FULLXPOINTER) - (MISCSTACKRESULT FULLXPOINTER) - (NRealPages WORD) - (* ; "Number pages of real memory") - (LastLockedFilePage WORD) - (* ; - "Last page of vmem that is locked--booting has to load at least that far.") - (LastDominoFilePage WORD) - (* ; - "Last sysout page reserved for Dandelion microcode") - (FPTOVPStart WORD) - (* ; "Sysout page where FPTOVP starts") - (FAKEMOUSEBITS WORD) - (* ; - "Used to implement fake middle button on 2-button Dandelion.") - (DL24BitAddressable WORD) - (* ; - "non-zero if DLion capable of addressing 32MB virtual memory") - (REALPAGETABLEPTR FULLXPOINTER) - (* ; - "Address of real page table, set up by Bcpl (but not chained together)") - (DLLastVmemPage WORD) - (* ; - "DLion booting microcode puts length of vmem file here.") - (FullSpaceUsed WORD) - (* ; - "Non-zero if vmem beyond initial 8MB has been allocated.") - (FAKEKBDAD4 WORD) - (FAKEKBDAD5 WORD) - - (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with.") - - (XVmemFmapBase WORD) - (* ; - "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") - (NIL WORD) - (NIL WORD) - (XVmemFmapHighBase WORD) - (* ; - "Bcpl stores the highest vm page contained in this or earlier partition.") - (NIL WORD) - (NIL WORD) - (XVmemDiskBase FULLXPOINTER) - (* ; - "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") - (NIL FULLXPOINTER) - (NIL FULLXPOINTER))) - -(RPAQQ MAIKO.IFPAGELAYOUT ((CurrentFXP WORD) - (* ; - "First 7 items are FX values for user and 6 system contexts.") - (ResetFXP WORD) - (SubovFXP WORD) - (KbdFXP WORD) - (HardReturnFXP WORD) - (GCFXP WORD) - (FAULTFXP WORD) - (EndOfStack WORD) - (* ; - "Stack high-water mark: address of guard block at current end of stack") - (LVersion WORD) - (* ; - "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") - (MinRVersion WORD) - (MinBVersion WORD) - (RVersion WORD) - (* ; - "Bcpl fills in the actual microcode, Bcpl versions.") - (BVersion WORD) - (MachineType WORD) - (MiscFXP WORD) - (* ; "FX for MISC context") - (Key WORD) - (* ; - "= IFPValidKey if vmem consistent.") - (SerialNumber WORD) - (* ; - "Pup host number (Dorado/Dolphin)") - (EmulatorSpace WORD) - (* ; - "Hiloc of bcpl space (always zero now)") - (ScreenWidth WORD) - (NxtPMAddr WORD) - (* ; - "Next page to be allocated in secondary page map table") - (NIL WORD) - (* ; - "WAS NActivePages, Length of vmem in use") - (NIL WORD) - (* ; - "WAS NDirtyPages, not used, but maintained as = NActivePages") - (filePnPMP0 WORD) - (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live") - (filePnPMT0 WORD) - (* ; - "Sysout page number of first page of primary page map table") - (TELERAIDFXP WORD) - (* ; "FX for TeleRaid server context") - (NATIVE-START-MEM-PAGE WORD) - (* ; - "Unix page where native code starts") - (NATIVE-LENGTH-PAGE WORD) - (* ; "Unix page length of native code") - (NATIVE-PAGE-OFFSET WORD) - (* ; - "Lisp Disk Page offset of native code") - (UserNameAddr WORD) - (* ; - "Addresses in bcpl space (seg 0) of global user name and password") - (UserPswdAddr WORD) - (StackBase WORD) - (* ; - "Stack address where user stack starts") - (FAULTHI WORD) - (* ; - "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") - (FAULTLO WORD) - (DEVCONFIG WORD) - (* ; "IT'S FOR KB,DISP TYPE") - (* ; - "Formerly REALPAGETABLE, back when it was always in Bcpl space.") - (RPTSIZE WORD) - (* ; - "Number of entries in Real Page Table") - (RPOFFSET WORD) - (* ; "RP-RPOFFSET => index in table") - (MAXETHERBYTES WORD) - (* ; - "Number of bytes available in a pbi, not counting encapsulation (Dorado)") - (EMBUFVP WORD) - (* ; - "VP of a one-page emulator buffer") - (NSHost0 WORD) - (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in.") - (NSHost1 WORD) - (NSHost2 WORD) - (MDSZone WORD) - (* ; - "Obsolete -- was used by Dolphin 10MB network code.") - (MDSZoneLength WORD) - (EMUBUFFERS WORD) - (* ; - "Buffer space in segment 0 for swapping/disk activity") - (EMUBUFLENGTH WORD) - (* ; "Number of words of said space") - - (* ;; - "The following 2 are available if NEW_STOARGE is specified in C") - - (ProcessSize WORD) - (* ; - "Process size for which can be use as LISP space") - (StorageFullState WORD) - (* ; "Save last storage state") - (ISFMAP WORD) - - (* ;; "The following 4 are for \MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!") - - (MISCSTACKFN FULLXPOINTER) - (MISCSTACKARG1 FULLXPOINTER) - (MISCSTACKARG2 FULLXPOINTER) - (MISCSTACKRESULT FULLXPOINTER) - (NRealPages WORD) - (* ; "Number pages of real memory") - (LastLockedFilePage WORD) - (* ; - "Last page of vmem that is locked--booting has to load at least that far.") - (LastDominoFilePage WORD) - (* ; - "Last sysout page reserved for Dandelion microcode") - (FPTOVPStart WORD) - (* ; "Sysout page where FPTOVP starts") - (FAKEMOUSEBITS WORD) - (* ; - "Used to implement fake middle button on 2-button Dandelion.") - (DL24BitAddressable WORD) - (* ; - "non-zero if DLion capable of addressing 32MB virtual memory") - (REALPAGETABLEPTR FULLXPOINTER) - (* ; - "Address of real page table, set up by Bcpl (but not chained together)") - (SYSDISK WORD) - (* ; - "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") - (FullSpaceUsed WORD) - (* ; - "Non-zero if vmem beyond initial 8MB has been allocated.") - (FAKEKBDAD4 WORD) - (FAKEKBDAD5 WORD) - - (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with.") - - (XVmemFmapBase WORD) - (* ; - "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") - (NIL WORD) - (NIL WORD) - (XVmemFmapHighBase WORD) - (* ; - "Bcpl stores the highest vm page contained in this or earlier partition.") - (NIL WORD) - (NIL WORD) - (XVmemDiskBase FULLXPOINTER) - (* ; - "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") - (NIL FULLXPOINTER) - (NIL FULLXPOINTER) - (DLLastVmemPage FIXP) - (* ; - "DLion booting microcode puts length of vmem file here.") - (NActivePages FIXP) - (* ; "Length of vmem in use") - (NDirtyPages FIXP) - (* ; - "not used, but maintained as = NActivePages") - )) - -(RPAQQ IOPAGELAYOUT ((NIL 22Q WORD) - (DLMAINTPANEL WORD NIL T) - (DLFLOPPYCMD WORD) - (DLTTYPORTCMD WORD) - (DLPROCESSORCMD WORD) - (NEWMOUSESTATE WORD) - (DLBEEPCMD WORD) - (DLRS232CMISCCOMMAND WORD) - (DLRS232CPUTFLAG WORD) - (DLRS232CGETFLAG WORD) - (NIL 6 WORD) - (DLFLOPPY WORD) - (DLTTYOUT WORD) - (NIL 1 WORD) - (DLTTYIN WORD) - (NIL 1 WORD) - (DLPROCESSOR2 WORD) - (DLPROCESSOR1 WORD) - (DLPROCESSOR0 WORD) - (NEWMOUSEX WORD) - (NEWMOUSEY WORD) - (DLBEEPFREQ WORD) - (DLRS232CPARAMETERCSBLO WORD) - (DLRS232CPARAMETERCSBHI WORD) - (DLRS232CSETRS366STATUS 3 WORD) - (DLRS232CPUTCSBLO WORD) - (DLRS232CPUTCSBHI WORD) - (DLRS232CGETCSBLO WORD) - (DLRS232CGETCSBHI WORD) - (DLRS232CDEVICESTATUS WORD) - (DLRS232CPARAMETEROUTCOME WORD) - (DLTODVALID WORD) - (DLTODLO WORD NIL T) - (DLTODHI WORD) - (DLTODLO2 WORD) - (DLMOUSEX WORD NIL T) - (DLMOUSEY WORD NIL T) - (DLUTILIN WORD NIL T) - (DLKBDAD0 WORD NIL T) - (DLKBDAD1 WORD NIL T) - (DLKBDAD2 WORD NIL T) - (DLKBDAD3 WORD NIL T) - (DLKBDAD4 WORD NIL T) - (DLKBDAD5 WORD NIL T) - (DLLSEPIMAGECSB 40Q WORD) - (DLIOPHARDWARECONFIG WORD) - (NIL 13Q WORD) - (DLRS232CPARAMETERCSBLO.11 WORD) - (DLRS232CPARAMETERCSBHI.11 WORD) - (DLRS232CSETRS366STATUS.11 16Q WORD) - (NIL 74Q WORD) - (DLMAGTAPE 4 WORD) - (DLETHERNET 14Q WORD NIL T) - (NIL 37Q WORD) - (DLDISPINTERRUPT WORD NIL T) - (DLDISPCONTROL WORD) - (DLDISPBORDER WORD) - (DLCURSORX WORD NIL T) - (DLCURSORY WORD NIL T) - (DLCURSORBITMAP 20Q WORD NIL T))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ CDRCODING 1) - -(RPAQQ \SMALLP 1) - -(RPAQQ \FIXP 2) - -(RPAQQ \FLOATP 3) - -(RPAQQ \LITATOM 4) - -(RPAQQ \LISTP 5) - -(RPAQQ \ARRAYP 6) - -(RPAQQ \STRINGP 7) - -(RPAQQ \STACKP 10Q) - -(RPAQQ \CHARACTERP 11Q) - -(RPAQQ \VMEMPAGEP 12Q) - -(RPAQQ \STREAM 13Q) - -(RPAQQ \TT.TYPEMASK 3777Q) - -(RPAQQ \TT.NOREF 100000Q) - -(RPAQQ \TT.SYMBOLP 40000Q) - -(RPAQQ \TT.FIXP 20000Q) - -(RPAQQ \TT.NUMBERP 10000Q) - -(RPAQQ \TT.ATOM 4000Q) - -(RPAQQ \PMblockSize 40Q) - -(RPAQQ \STATSsize 10Q) - -(RPAQQ \NumPMTpages 10Q) - -(RPAQQ \EmptyPMTEntry 177777Q) - -(RPAQQ \FirstVmemBlock 2) - -(RPAQQ \MAXVMPAGE 377775Q) - -(RPAQQ \MAXVMSEGMENT 377Q) - -(RPAQQ \IFPValidKey 12743Q) - -(RPAQQ \FirstMDSPage 77776Q) - -(RPAQQ \MaxMDSPage 1777775Q) - -(RPAQQ \DefaultSecondMDSPage 177774Q) - -(RPAQQ \MDSIncrement 1000Q) - -(RPAQQ \PagesPerMDSUnit 2) - -(RPAQQ \FirstArraySegment 56Q) - -(RPAQQ \FirstArrayPage 27000Q) - -(RPAQQ \DefaultSecondArrayPage 100000Q) - -(RPAQQ \StackMask 160000Q) - -(RPAQQ \FxtnBlock 140000Q) - -(RPAQQ \GuardBlock 160000Q) - -(RPAQQ \BFBlock 100000Q) - -(RPAQQ \FreeStackBlock 120000Q) - -(RPAQQ \NotStackBlock 0) - -(RPAQQ \MinExtraStackWords 40Q) - -(RPAQQ ERASECHARCODE 0) - -(RPAQQ \HT1CNT 2000Q) - -(RPAQQ \HTSTKBIT 1000Q) - -(RPAQQ \HTCNTMASK 176000Q) - -(RPAQQ \HTMAINSIZE 200000Q) - -(RPAQQ \HTCOLLSIZE 4000000Q) - -(RPAQQ \HTENDFREE 1) - -(RPAQQ \HTFREEPTR 0) - -(RPAQQ \AtomHI 0) - -(RPAQQ \CHARHI 7) - -(RPAQQ \AtomHTpages 400Q) - -(RPAQQ \LastAtomPage 377Q) - -(RPAQQ \MaxAtomFrLst 177777Q) - -(RPAQQ \SmallPosHi 16Q) - -(RPAQQ \SmallNegHi 17Q) - -(RPAQQ \NumSmallPages 1000Q) - -(RPAQQ \PNAME.HI 10Q) - -(RPAQQ \ATOM.HI 54Q) - -(RPAQQ \DEF.HI 12Q) - -(RPAQQ \VAL.HI 14Q) - -(RPAQQ \PLIST.HI 2) - -(RPAQQ \NumPageMapPages 400Q) - -(RPAQQ \MDSTTsize 2000Q) - -(RPAQQ \UFNTableSize 2) - -(RPAQQ \DTDSize 22Q) - -(RPAQQ \EndTypeNumber 3777Q) - -(RPAQQ \NumLPTPages 20Q) - -(RPAQQ \GuardStackAddr 170000Q) - -(RPAQQ \LastStackAddr 177776Q) - -(RPAQQ \STACKHI 1) - -(RPAQQ \HTMAINnpages 400Q) - -(RPAQQ \D1BCPLspace 0) - -(RPAQQ \D0BCPLspace 0) - -(RPAQQ \CurrentFXP 0) - -(RPAQQ \ResetFXP 1) - -(RPAQQ \SubovFXP 2) - -(RPAQQ \KbdFXP 3) - -(RPAQQ \HardReturnFXP 4) - -(RPAQQ \GCFXP 5) - -(RPAQQ \FAULTFXP 6) - -(RPAQQ \MiscFXP 16Q) - -(RPAQQ \TeleRaidFXP 30Q) - -(RPAQQ DCB.EM 420Q) - -(RPAQQ DISPINTERRUPT.EM 421Q) - -(RPAQQ CURSORBITMAP.EM 431Q) - -(RPAQQ KBDAD0.EM 177034Q) - -(RPAQQ KBDAD1.EM 177035Q) - -(RPAQQ KBDAD2.EM 177036Q) - -(RPAQQ KBDAD3.EM 177037Q) - -(RPAQQ UTILIN.EM 177030Q) - -(RPAQQ CURSORX.EM 426Q) - -(RPAQQ CURSORY.EM 427Q) - -(RPAQQ MOUSEX.EM 424Q) - -(RPAQQ MOUSEY.EM 425Q) - -(RPAQQ \LispKeyMask 20000Q) - -(RPAQQ \BcplKeyMask 10400Q) - -(RPAQQ \MAIKO 3) - -(RPAQQ \DOLPHIN 4) - -(RPAQQ \DORADO 5) - -(RPAQQ \DANDELION 6) - -(RPAQQ \DAYBREAK 10Q) - -(RPAQQ \VP.DISPLAY 11000Q) - -(RPAQQ \NP.DISPLAY 312Q) - -(RPAQQ \NP.WIDEDOVEDISPLAY 363Q) - -(RPAQQ \WIDEDOVEDISPLAYWIDTH 2200Q) - -(RPAQQ \RP.AFTERDISPLAY 316Q) - -(RPAQQ \RP.AFTERDOVEDISPLAY 363Q) - -(RPAQQ \RP.DISPLAY 0) - -(RPAQQ \RP.TEMPDISPLAY 5001Q) - -(RPAQQ \RP.MISCLOCKED 5364Q) - -(RPAQQ \RP.STACK 1400Q) - -(RPAQQ \VP.STACK 400Q) - -(RPAQQ \RP.MAP 400Q) - -(RPAQQ \NP.MAP 400Q) - -(RPAQQ \RP.IOPAGE 1000Q) - -(RPAQQ \RP.DOVEIOCBPAGE 1037Q) - -(RPAQQ \RP.DOVEIORGN 1040Q) - -(RPAQQ \VP.DOVEIORGN 100Q) - -(RPAQQ \DOVEIORGNSIZE 100Q) - -(RPAQQ \VP.IOPAGE 377Q) - -(RPAQQ \VP.IFPAGE 12000Q) - -(RPAQQ \VP.FPTOVP 1000Q) - -(RPAQQ \NP.FPTOVP 10000Q) - -(RPAQQ \RP.FPTOVP 2000Q) - -(RPAQQ \RP.STARTBUFFERS 1200Q) - -(RPAQQ \VP.TYPETABLE 14000Q) - -(RPAQQ \NP.TYPETABLE 2000Q) - -(RPAQQ \RP.TYPETABLE 12000Q) - -(RPAQQ \VP.GCTABLE 13000Q) - -(RPAQQ \NP.GCTABLE 400Q) - -(RPAQQ \RP.GCTABLE 14000Q) - -(RPAQQ \VP.GCOVERFLOW 13400Q) - -(RPAQQ \NP.GCOVERFLOW 1) - -(RPAQQ \RP.GCOVERFLOW 14400Q) - -(RPAQQ \FP.IFPAGE 2) - -(RPAQQ \VP.IOCBS 1) - -(RPAQQ \VP.PRIMARYMAP 12002Q) - -(RPAQQ \VP.SECONDARYMAP 2400Q) - -(RPAQQ \VP.LPT 12160Q) - -(RPAQQ \VP.INITSCRATCH 10Q) - -(RPAQQ \VP.RPT 200Q) - -(RPAQQ \VP.BUFFERS 332Q) - -(RPAQQ \DL.PROCESSORBUSY 100000Q) - -(RPAQQ \DL.SETTOD 100001Q) - -(RPAQQ \DL.READTOD 100002Q) - -(RPAQQ \DL.READPID 100003Q) - -(RPAQQ \DL.BOOTBUTTON 100004Q) - - -(CONSTANTS (CDRCODING 1) - (\SMALLP 1) - (\FIXP 2) - (\FLOATP 3) - (\LITATOM 4) - (\LISTP 5) - (\ARRAYP 6) - (\STRINGP 7) - (\STACKP 10Q) - (\CHARACTERP 11Q) - (\VMEMPAGEP 12Q) - (\STREAM 13Q) - (\TT.TYPEMASK 3777Q) - (\TT.NOREF 100000Q) - (\TT.SYMBOLP 40000Q) - (\TT.FIXP 20000Q) - (\TT.NUMBERP 10000Q) - (\TT.ATOM 4000Q) - (\PMblockSize 40Q) - (\STATSsize 10Q) - (\NumPMTpages 10Q) - (\EmptyPMTEntry 177777Q) - (\FirstVmemBlock 2) - (\MAXVMPAGE 377775Q) - (\MAXVMSEGMENT 377Q) - (\IFPValidKey 12743Q) - (\FirstMDSPage 77776Q) - (\MaxMDSPage 1777775Q) - (\DefaultSecondMDSPage 177774Q) - (\MDSIncrement 1000Q) - (\PagesPerMDSUnit 2) - (\FirstArraySegment 56Q) - (\FirstArrayPage 27000Q) - (\DefaultSecondArrayPage 100000Q) - (\StackMask 160000Q) - (\FxtnBlock 140000Q) - (\GuardBlock 160000Q) - (\BFBlock 100000Q) - (\FreeStackBlock 120000Q) - (\NotStackBlock 0) - (\MinExtraStackWords 40Q) - (ERASECHARCODE 0) - (\HT1CNT 2000Q) - (\HTSTKBIT 1000Q) - (\HTCNTMASK 176000Q) - (\HTMAINSIZE 200000Q) - (\HTCOLLSIZE 4000000Q) - (\HTENDFREE 1) - (\HTFREEPTR 0) - (\AtomHI 0) - (\CHARHI 7) - (\AtomHTpages 400Q) - (\LastAtomPage 377Q) - (\MaxAtomFrLst 177777Q) - (\SmallPosHi 16Q) - (\SmallNegHi 17Q) - (\NumSmallPages 1000Q) - (\PNAME.HI 10Q) - (\ATOM.HI 54Q) - (\DEF.HI 12Q) - (\VAL.HI 14Q) - (\PLIST.HI 2) - (\NumPageMapPages 400Q) - (\MDSTTsize 2000Q) - (\UFNTableSize 2) - (\DTDSize 22Q) - (\EndTypeNumber 3777Q) - (\NumLPTPages 20Q) - (\GuardStackAddr 170000Q) - (\LastStackAddr 177776Q) - (\STACKHI 1) - (\HTMAINnpages 400Q) - (\D1BCPLspace 0) - (\D0BCPLspace 0) - (\CurrentFXP 0) - (\ResetFXP 1) - (\SubovFXP 2) - (\KbdFXP 3) - (\HardReturnFXP 4) - (\GCFXP 5) - (\FAULTFXP 6) - (\MiscFXP 16Q) - (\TeleRaidFXP 30Q) - (DCB.EM 420Q) - (DISPINTERRUPT.EM 421Q) - (CURSORBITMAP.EM 431Q) - (KBDAD0.EM 177034Q) - (KBDAD1.EM 177035Q) - (KBDAD2.EM 177036Q) - (KBDAD3.EM 177037Q) - (UTILIN.EM 177030Q) - (CURSORX.EM 426Q) - (CURSORY.EM 427Q) - (MOUSEX.EM 424Q) - (MOUSEY.EM 425Q) - (\LispKeyMask 20000Q) - (\BcplKeyMask 10400Q) - (\MAIKO 3) - (\DOLPHIN 4) - (\DORADO 5) - (\DANDELION 6) - (\DAYBREAK 10Q) - (\VP.DISPLAY 11000Q) - (\NP.DISPLAY 312Q) - (\NP.WIDEDOVEDISPLAY 363Q) - (\WIDEDOVEDISPLAYWIDTH 2200Q) - (\RP.AFTERDISPLAY 316Q) - (\RP.AFTERDOVEDISPLAY 363Q) - (\RP.DISPLAY 0) - (\RP.TEMPDISPLAY 5001Q) - (\RP.MISCLOCKED 5364Q) - (\RP.STACK 1400Q) - (\VP.STACK 400Q) - (\RP.MAP 400Q) - (\NP.MAP 400Q) - (\RP.IOPAGE 1000Q) - (\RP.DOVEIOCBPAGE 1037Q) - (\RP.DOVEIORGN 1040Q) - (\VP.DOVEIORGN 100Q) - (\DOVEIORGNSIZE 100Q) - (\VP.IOPAGE 377Q) - (\VP.IFPAGE 12000Q) - (\VP.FPTOVP 1000Q) - (\NP.FPTOVP 10000Q) - (\RP.FPTOVP 2000Q) - (\RP.STARTBUFFERS 1200Q) - (\VP.TYPETABLE 14000Q) - (\NP.TYPETABLE 2000Q) - (\RP.TYPETABLE 12000Q) - (\VP.GCTABLE 13000Q) - (\NP.GCTABLE 400Q) - (\RP.GCTABLE 14000Q) - (\VP.GCOVERFLOW 13400Q) - (\NP.GCOVERFLOW 1) - (\RP.GCOVERFLOW 14400Q) - (\FP.IFPAGE 2) - (\VP.IOCBS 1) - (\VP.PRIMARYMAP 12002Q) - (\VP.SECONDARYMAP 2400Q) - (\VP.LPT 12160Q) - (\VP.INITSCRATCH 10Q) - (\VP.RPT 200Q) - (\VP.BUFFERS 332Q) - (\DL.PROCESSORBUSY 100000Q) - (\DL.SETTOD 100001Q) - (\DL.READTOD 100002Q) - (\DL.READPID 100003Q) - (\DL.BOOTBUTTON 100004Q)) -) - -(RPAQQ \MPERRORS ((\MP.OBSOLETEVMEM 1) - (\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") - (\MP.IOCBPAGE 3 "No place for IOCB page at startup") - (\MP.MOB 4 "Map out of bounds") - (\MP.INVALIDADDR 5) - (\MP.INVALIDVP 6) - (\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") - (\MP.SELECTLOOP 10Q "Loop in \SELECTREALPAGE") - (\MP.NEWPAGE 11Q "Attempt to allocate already existing page") - (\MP.NEWMAPPAGE 12Q "\DONEWPAGE failed to allocate new map page") - (\MP.BADLOCKED 13Q "Locked page occupies a file page needed to lock another") - (\MP.CLOCK0 14Q "Arg to CLOCK0 not an integer box") - (\MP.RESIDENT 15Q "Fault on resident page") - (\MP.STACKFAULT 16Q "Fault on stack") - (\MP.VMEMTOOLONG 20Q "Attempt to extend Vmem File beyond fixed limit (8mb)") - (\MP.WRITING.LOCKED.PAGE 21Q "Writing a locked page with UPDATEKEY = T") - (\MP.UNINTERRUPTABLE 22Q "Error in uninterruptable system code") - (\MP.STACKFULL 23Q) - (\MP.MDSFULL 24Q) - (\MP.UNKNOWN.UFN 25Q) - (\MP.ATOMSFULL 26Q) - (\MP.PNAMESFULL 27Q) - (\MP.USECOUNTOVERFLOW 30Q) - (\MP.MDSFULLWARNING 31Q) - (\MP.BADMDSFREELIST 32Q) - (\MP.BADARRAYBLOCK 33Q) - (\MP.BADDELETEBLOCK 34Q) - (\MP.BADARRAYRECLAIM 35Q) - (\MP.BIGREFCNTMISSING 36Q - "PTR refcnt previously overflowed, but not found in table.") - (\MP.BIGREFCNTALREADYPRESENT 37Q "PTR already in overflow table") - (\MP.DELREF0 40Q) - (\MP.PROCERROR 41Q) - (\MP.PROCNOFRAME 42Q "Failed to build frame for PROCESS use") - (\MP.32MBINUSE 43Q) - (\MP.TOPUNWOUND 44Q "Unexpected (RETTO T)") - (\MP.STACKRELEASED 45Q) - (\MP.FLUSHLOCKED 46Q) - (\MP.MAPNOTLOCKED 47Q) - (\MP.UNLOCKINGMAP 50Q) - (\MP.SWAPDISKERROR 51Q "Hard Disk Error in swapper") - (\MP.BADRUNTABLE 52Q "Malformed run table for vmem file"))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ \MP.OBSOLETEVMEM 1) - -(RPAQ \MP.INVALIDVMEM 2 "Vmem inconsistent at startup") - -(RPAQ \MP.IOCBPAGE 3 "No place for IOCB page at startup") - -(RPAQ \MP.MOB 4 "Map out of bounds") - -(RPAQQ \MP.INVALIDADDR 5) - -(RPAQQ \MP.INVALIDVP 6) - -(RPAQ \MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") - -(RPAQ \MP.SELECTLOOP 10Q "Loop in \SELECTREALPAGE") - -(RPAQ \MP.NEWPAGE 11Q "Attempt to allocate already existing page") - -(RPAQ \MP.NEWMAPPAGE 12Q "\DONEWPAGE failed to allocate new map page") - -(RPAQ \MP.BADLOCKED 13Q "Locked page occupies a file page needed to lock another") - -(RPAQ \MP.CLOCK0 14Q "Arg to CLOCK0 not an integer box") - -(RPAQ \MP.RESIDENT 15Q "Fault on resident page") - -(RPAQ \MP.STACKFAULT 16Q "Fault on stack") - -(RPAQ \MP.VMEMTOOLONG 20Q "Attempt to extend Vmem File beyond fixed limit (8mb)") - -(RPAQ \MP.WRITING.LOCKED.PAGE 21Q "Writing a locked page with UPDATEKEY = T") - -(RPAQ \MP.UNINTERRUPTABLE 22Q "Error in uninterruptable system code") - -(RPAQQ \MP.STACKFULL 23Q) - -(RPAQQ \MP.MDSFULL 24Q) - -(RPAQQ \MP.UNKNOWN.UFN 25Q) - -(RPAQQ \MP.ATOMSFULL 26Q) - -(RPAQQ \MP.PNAMESFULL 27Q) - -(RPAQQ \MP.USECOUNTOVERFLOW 30Q) - -(RPAQQ \MP.MDSFULLWARNING 31Q) - -(RPAQQ \MP.BADMDSFREELIST 32Q) - -(RPAQQ \MP.BADARRAYBLOCK 33Q) - -(RPAQQ \MP.BADDELETEBLOCK 34Q) - -(RPAQQ \MP.BADARRAYRECLAIM 35Q) - -(RPAQ \MP.BIGREFCNTMISSING 36Q "PTR refcnt previously overflowed, but not found in table.") - -(RPAQ \MP.BIGREFCNTALREADYPRESENT 37Q "PTR already in overflow table") - -(RPAQQ \MP.DELREF0 40Q) - -(RPAQQ \MP.PROCERROR 41Q) - -(RPAQ \MP.PROCNOFRAME 42Q "Failed to build frame for PROCESS use") - -(RPAQQ \MP.32MBINUSE 43Q) - -(RPAQ \MP.TOPUNWOUND 44Q "Unexpected (RETTO T)") - -(RPAQQ \MP.STACKRELEASED 45Q) - -(RPAQQ \MP.FLUSHLOCKED 46Q) - -(RPAQQ \MP.MAPNOTLOCKED 47Q) - -(RPAQQ \MP.UNLOCKINGMAP 50Q) - -(RPAQ \MP.SWAPDISKERROR 51Q "Hard Disk Error in swapper") - -(RPAQ \MP.BADRUNTABLE 52Q "Malformed run table for vmem file") - - -(CONSTANTS (\MP.OBSOLETEVMEM 1) - (\MP.INVALIDVMEM 2 "Vmem inconsistent at startup") - (\MP.IOCBPAGE 3 "No place for IOCB page at startup") - (\MP.MOB 4 "Map out of bounds") - (\MP.INVALIDADDR 5) - (\MP.INVALIDVP 6) - (\MP.CHAIN.UNAVAIL 7 "Unavailable page on real page table chain") - (\MP.SELECTLOOP 10Q "Loop in \SELECTREALPAGE") - (\MP.NEWPAGE 11Q "Attempt to allocate already existing page") - (\MP.NEWMAPPAGE 12Q "\DONEWPAGE failed to allocate new map page") - (\MP.BADLOCKED 13Q "Locked page occupies a file page needed to lock another") - (\MP.CLOCK0 14Q "Arg to CLOCK0 not an integer box") - (\MP.RESIDENT 15Q "Fault on resident page") - (\MP.STACKFAULT 16Q "Fault on stack") - (\MP.VMEMTOOLONG 20Q "Attempt to extend Vmem File beyond fixed limit (8mb)") - (\MP.WRITING.LOCKED.PAGE 21Q "Writing a locked page with UPDATEKEY = T") - (\MP.UNINTERRUPTABLE 22Q "Error in uninterruptable system code") - (\MP.STACKFULL 23Q) - (\MP.MDSFULL 24Q) - (\MP.UNKNOWN.UFN 25Q) - (\MP.ATOMSFULL 26Q) - (\MP.PNAMESFULL 27Q) - (\MP.USECOUNTOVERFLOW 30Q) - (\MP.MDSFULLWARNING 31Q) - (\MP.BADMDSFREELIST 32Q) - (\MP.BADARRAYBLOCK 33Q) - (\MP.BADDELETEBLOCK 34Q) - (\MP.BADARRAYRECLAIM 35Q) - (\MP.BIGREFCNTMISSING 36Q "PTR refcnt previously overflowed, but not found in table.") - (\MP.BIGREFCNTALREADYPRESENT 37Q "PTR already in overflow table") - (\MP.DELREF0 40Q) - (\MP.PROCERROR 41Q) - (\MP.PROCNOFRAME 42Q "Failed to build frame for PROCESS use") - (\MP.32MBINUSE 43Q) - (\MP.TOPUNWOUND 44Q "Unexpected (RETTO T)") - (\MP.STACKRELEASED 45Q) - (\MP.FLUSHLOCKED 46Q) - (\MP.MAPNOTLOCKED 47Q) - (\MP.UNLOCKINGMAP 50Q) - (\MP.SWAPDISKERROR 51Q "Hard Disk Error in swapper") - (\MP.BADRUNTABLE 52Q "Malformed run table for vmem file")) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \ARRAYSPACE \ARRAYSPACE2 \ATOMSPACE \AtomHashTable \SMALLPOSPSPACE \SMALLNEGSPACE - \PNPSPACE \OLDATOMSPACE \DEFSPACE \VALSPACE \PLISTSPACE \PAGEMAP \PageMapTBL \InterfacePage - \IOPAGE \DoveIORegion \IOCBPAGE \FPTOVP \MDSTypeTable \MISCSTATS \UFNTable \DTDSpaceBase - \LISTPDTD \LOCKEDPAGETABLE \STACKSPACE \HTMAIN \HTOVERFLOW \HTBIGCOUNT \HTCOLL \DISPLAYREGION) -) - -(BLOCKRECORD MISCSTATS ((STARTTIME FIXP) - (TOTALTIME FIXP) - (SWAPWAITTIME FIXP) - (PAGEFAULTS FIXP) - (SWAPWRITES FIXP) - (DISKIOTIME FIXP) - (DISKOPS FIXP) - (KEYBOARDWAITTIME FIXP) - (GCTIME FIXP) - (NETIOTIME FIXP) - (NETIOOPS FIXP) - (SWAPTEMP0 FIXP) - (SWAPTEMP1 FIXP) - (RCLKSECOND FIXP) - (SECONDSCLOCK FIXP) - (MILLISECONDSCLOCK FIXP) - (BASECLOCK FIXP) - (RCLKTEMP0 FIXP) - (SECONDSTMP FIXP) - (MILLISECONDSTMP FIXP) - (BASETMP FIXP) - (EXCESSTIMETMP FIXP) - (CLOCKTEMP0 FIXP) - (DISKTEMP0 FIXP) - (DISKTEMP1 FIXP) - (TELERAIDTEMP1 FIXP) - (TELERAIDTEMP2 FIXP) - (TELERAIDTEMP3 FIXP) - (LASTUSERACTION FIXP) - (DLMOUSETIMER FIXP) - (DLMOUSETEMP FIXP)) - (CREATE (\ALLOCBLOCK 37Q))) - -(BLOCKRECORD IFPAGE ((CurrentFXP WORD) (* ; - "First 7 items are FX values for user and 6 system contexts.") - (ResetFXP WORD) - (SubovFXP WORD) - (KbdFXP WORD) - (HardReturnFXP WORD) - (GCFXP WORD) - (FAULTFXP WORD) - (EndOfStack WORD) (* ; - "Stack high-water mark: address of guard block at current end of stack") - (LVersion WORD) (* ; - "Lisp version, followed by min versions of microcode and Bcpl compatible with this Lisp") - (MinRVersion WORD) - (MinBVersion WORD) - (RVersion WORD) (* ; - "Bcpl fills in the actual microcode, Bcpl versions.") - (BVersion WORD) - (MachineType WORD) - (MiscFXP WORD) (* ; "FX for MISC context") - (Key WORD) (* ; - "= IFPValidKey if vmem consistent.") - (SerialNumber WORD) (* ; - "Pup host number (Dorado/Dolphin)") - (EmulatorSpace WORD) (* ; - "Hiloc of bcpl space (always zero now)") - (ScreenWidth WORD) - (NxtPMAddr WORD) (* ; - "Next page to be allocated in secondary page map table") - (NIL WORD) (* ; - "WAS NActivePages, Length of vmem in use") - (NIL WORD) (* ; - "WAS NDirtyPages, not used, but maintained as = NActivePages") - (filePnPMP0 WORD) (* ; "Sysout page number of first page of secondary page map table (\PAGEMAP), which is where the secondary map pages themselves live") - (filePnPMT0 WORD) (* ; - "Sysout page number of first page of primary page map table") - (TELERAIDFXP WORD) (* ; "FX for TeleRaid server context") - (NATIVE-START-MEM-PAGE WORD) (* ; - "Unix page where native code starts") - (NATIVE-LENGTH-PAGE WORD) (* ; "Unix page length of native code") - (NATIVE-PAGE-OFFSET WORD) (* ; - "Lisp Disk Page offset of native code") - (UserNameAddr WORD) (* ; - "Addresses in bcpl space (seg 0) of global user name and password") - (UserPswdAddr WORD) - (StackBase WORD) (* ; - "Stack address where user stack starts") - (FAULTHI WORD) (* ; - "Microcode for page fault stores fault address here, then does context switch to FAULTFXP") - (FAULTLO WORD) - (DEVCONFIG WORD) (* ; "IT'S FOR KB,DISP TYPE") - (* ; - "Formerly REALPAGETABLE, back when it was always in Bcpl space.") - (RPTSIZE WORD) (* ; - "Number of entries in Real Page Table") - (RPOFFSET WORD) (* ; "RP-RPOFFSET => index in table") - (MAXETHERBYTES WORD) (* ; - "Number of bytes available in a pbi, not counting encapsulation (Dorado)") - (EMBUFVP WORD) (* ; - "VP of a one-page emulator buffer") - (NSHost0 WORD) (* ; "Machine's 48-bit NS host number. Lisp manages to compute this on all machines except Dolphin, where Bcpl fills it in.") - (NSHost1 WORD) - (NSHost2 WORD) - (MDSZone WORD) (* ; - "Obsolete -- was used by Dolphin 10MB network code.") - (MDSZoneLength WORD) - (EMUBUFFERS WORD) (* ; - "Buffer space in segment 0 for swapping/disk activity") - (EMUBUFLENGTH WORD) (* ; "Number of words of said space") - - (* ;; "The following 2 are available if NEW_STOARGE is specified in C") - - (ProcessSize WORD) (* ; - "Process size for which can be use as LISP space") - (StorageFullState WORD) (* ; "Save last storage state") - (ISFMAP WORD) - - (* ;; "The following 4 are for \MISCAPPLY* -- note that they are not ref counted, so don't pass the only pointer to something this way!") - - (MISCSTACKFN FULLXPOINTER) - (MISCSTACKARG1 FULLXPOINTER) - (MISCSTACKARG2 FULLXPOINTER) - (MISCSTACKRESULT FULLXPOINTER) - (NRealPages WORD) (* ; "Number pages of real memory") - (LastLockedFilePage WORD) (* ; - "Last page of vmem that is locked--booting has to load at least that far.") - (LastDominoFilePage WORD) (* ; - "Last sysout page reserved for Dandelion microcode") - (FPTOVPStart WORD) (* ; "Sysout page where FPTOVP starts") - (FAKEMOUSEBITS WORD) (* ; - "Used to implement fake middle button on 2-button Dandelion.") - (DL24BitAddressable WORD) (* ; - "non-zero if DLion capable of addressing 32MB virtual memory") - (REALPAGETABLEPTR FULLXPOINTER) (* ; - "Address of real page table, set up by Bcpl (but not chained together)") - (SYSDISK WORD) (* ; - "WAS DLLastVmemPage, DLion booting microcode puts length of vmem file here.") - (FullSpaceUsed WORD) (* ; - "Non-zero if vmem beyond initial 8MB has been allocated.") - (FAKEKBDAD4 WORD) - (FAKEKBDAD5 WORD) - - (* ;; "The following 9 items (6 words and 3 pointers) are 3 3-element vectors for the Dorado extended virtual memory code--indexed by 0,1,2 according to which of up to 3 virtual memory backing files you're working with.") - - (XVmemFmapBase WORD) (* ; - "Bcpl stores isf map pointer to each partition here. First is redundant with ISFMAP field above.") - (NIL WORD) - (NIL WORD) - (XVmemFmapHighBase WORD) (* ; - "Bcpl stores the highest vm page contained in this or earlier partition.") - (NIL WORD) - (NIL WORD) - (XVmemDiskBase FULLXPOINTER) (* ; - "Lisp stores disk objects here (just a convenient non-faulting contiguous block of storage).") - (NIL FULLXPOINTER) - (NIL FULLXPOINTER) - (DLLastVmemPage FIXP) (* ; - "DLion booting microcode puts length of vmem file here.") - (NActivePages FIXP) (* ; "Length of vmem in use") - (NDirtyPages FIXP) (* ; - "not used, but maintained as = NActivePages") - ) - (CREATE (\ALLOCBLOCK 53Q))) - -(BLOCKRECORD IOPAGE ((NIL 22Q WORD) - (DLMAINTPANEL WORD) - (DLFLOPPYCMD WORD) - (DLTTYPORTCMD WORD) - (DLPROCESSORCMD WORD) - (NEWMOUSESTATE WORD) - (DLBEEPCMD WORD) - (DLRS232CMISCCOMMAND WORD) - (DLRS232CPUTFLAG WORD) - (DLRS232CGETFLAG WORD) - (NIL 6 WORD) - (DLFLOPPY WORD) - (DLTTYOUT WORD) - (NIL 1 WORD) - (DLTTYIN WORD) - (NIL 1 WORD) - (DLPROCESSOR2 WORD) - (DLPROCESSOR1 WORD) - (DLPROCESSOR0 WORD) - (NEWMOUSEX WORD) - (NEWMOUSEY WORD) - (DLBEEPFREQ WORD) - (DLRS232CPARAMETERCSBLO WORD) - (DLRS232CPARAMETERCSBHI WORD) - (DLRS232CSETRS366STATUS 3 WORD) - (DLRS232CPUTCSBLO WORD) - (DLRS232CPUTCSBHI WORD) - (DLRS232CGETCSBLO WORD) - (DLRS232CGETCSBHI WORD) - (DLRS232CDEVICESTATUS WORD) - (DLRS232CPARAMETEROUTCOME WORD) - (DLTODVALID WORD) - (DLTODLO WORD) - (DLTODHI WORD) - (DLTODLO2 WORD) - (DLMOUSEX WORD) - (DLMOUSEY WORD) - (DLUTILIN WORD) - (DLKBDAD0 WORD) - (DLKBDAD1 WORD) - (DLKBDAD2 WORD) - (DLKBDAD3 WORD) - (DLKBDAD4 WORD) - (DLKBDAD5 WORD) - (DLLSEPIMAGECSB 40Q WORD) - (DLIOPHARDWARECONFIG WORD) - (NIL 13Q WORD) - (DLRS232CPARAMETERCSBLO.11 WORD) - (DLRS232CPARAMETERCSBHI.11 WORD) - (DLRS232CSETRS366STATUS.11 16Q WORD) - (NIL 74Q WORD) - (DLMAGTAPE 4 WORD) - (DLETHERNET 14Q WORD) - (NIL 37Q WORD) - (DLDISPINTERRUPT WORD) - (DLDISPCONTROL WORD) - (DLDISPBORDER WORD) - (DLCURSORX WORD) - (DLCURSORY WORD) - (DLCURSORBITMAP 20Q WORD)) - [ACCESSFNS IOPAGE ((DLCURSORBITMAPPTR (\ADDBASE DATUM 360Q)) - (DLCURSORYPTR (\ADDBASE DATUM 357Q)) - (DLCURSORXPTR (\ADDBASE DATUM 356Q)) - (DLDISPINTERRUPTPTR (\ADDBASE DATUM 353Q)) - (DLETHERNETPTR (\ADDBASE DATUM 300Q)) - (DLKBDAD5PTR (\ADDBASE DATUM 103Q)) - (DLKBDAD4PTR (\ADDBASE DATUM 102Q)) - (DLKBDAD3PTR (\ADDBASE DATUM 101Q)) - (DLKBDAD2PTR (\ADDBASE DATUM 100Q)) - (DLKBDAD1PTR (\ADDBASE DATUM 77Q)) - (DLKBDAD0PTR (\ADDBASE DATUM 76Q)) - (DLUTILINPTR (\ADDBASE DATUM 75Q)) - (DLMOUSEYPTR (\ADDBASE DATUM 74Q)) - (DLMOUSEXPTR (\ADDBASE DATUM 73Q)) - (DLTODLOPTR (\ADDBASE DATUM 70Q)) - (DLMAINTPANELPTR (\ADDBASE DATUM 22Q] - (CREATE (\ALLOCBLOCK 200Q))) -(DECLARE%: EVAL@COMPILE - -[PUTPROPS EMADDRESS MACRO (ARGS ([LAMBDA (ADDR) - (COND - [(EQ \D1BCPLspace \D0BCPLspace) - (LIST (BIG-VMEM-CODE (LIST 'OPCODES 'GCONST 0 0 - (LRSH ADDR 10Q) - (LOGAND ADDR 377Q)) - (LIST 'OPCODES 'GCONST 0 (LRSH ADDR 10Q) - (LOGAND ADDR 377Q] - (T `(\VAG2 (fetch EmulatorSpace of \InterfacePage) - %, ADDR] - (EVAL (CAR ARGS] - -(PUTPROPS EMGETBASE MACRO ((OFFSET) - (\GETBASE (EMADDRESS OFFSET) - 0))) - -(PUTPROPS EMPUTBASE MACRO ((OFFSET VAL) - (\PUTBASE (EMADDRESS OFFSET) - 0 VAL))) - -(PUTPROPS EMULATORSEGMENT MACRO (NIL (fetch EmulatorSpace of \InterfacePage))) - -[PUTPROPS EMPOINTER MACRO (X (COND - ((NEQ \D1BCPLspace \D0BCPLspace) - (LIST '\VAG2 '(fetch (IFPAGE EmulatorSpace) of - \InterfacePage - ) - (CAR X))) - ((ZEROP (CAR X)) - NIL) - (T (LIST '\VAG2 \D0BCPLspace (CAR X] - -[PUTPROPS EMADDRESSP MACRO (X (LIST 'EQ (LIST '\HILOC (CAR X)) - (COND - ((EQ \D1BCPLspace \D0BCPLspace) - \D0BCPLspace) - (T '(fetch (IFPAGE EmulatorSpace) of \InterfacePage] -) - -(* "END EXPORTED DEFINITIONS") - -) - -(PUTPROPS LLPARAMS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10Q)) -(PUTPROPS LLPARAMS COPYRIGHT ( -"Syntelligence Systems, Inc. This program or documentation contains confidential information and trade secrets of Syntelligence Systems, Inc. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Syntelligence Systems, Inc. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" - 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 3706Q 3707Q 3710Q 3712Q 3716Q)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (7177Q 13221Q (MAKERECORD 7211Q . 13217Q))))) -STOP