From 21fe7fc9c4fe9705080a20bc10f9d1961147efc7 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 25 Nov 2020 19:13:51 -0800 Subject: [PATCH] update SIMPLE-INIT simplifying it --- greetfiles/SIMPLE-INIT | 2 +- greetfiles/SIMPLE-INIT.~1~ | 1 + greetfiles/SIMPLE-INIT.~2~ | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 greetfiles/SIMPLE-INIT.~1~ create mode 100644 greetfiles/SIMPLE-INIT.~2~ diff --git a/greetfiles/SIMPLE-INIT b/greetfiles/SIMPLE-INIT index 4514f727..ce56e33b 100644 --- a/greetfiles/SIMPLE-INIT +++ b/greetfiles/SIMPLE-INIT @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "24-Nov-2020 11:05:36" {DSK}larry>SIMPLE-INIT.;3 40372 changes to%: (VARS SIMPLE-INITCOMS) (TEMPLATES WITHOUT.PAGEHOLD) (FNS FIXVERSION) previous date%: "24-Nov-2020 10:20:03" {DSK}larry>SIMPLE-INIT.;1) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [(FNS INTERLISPMODE) [VARS (COMPILEIGNOREDECL T) (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (P (INTERLISPMODE)) (FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES) (FUNCTIONS WITHOUT.PAGEHOLD) (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (CUTEFLG T) (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT] [VARS (*USEOLDFONTDIRECTORIES* NIL) [DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts] [INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts] (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (P (LOCAL-INIT)) (TEMPLATES WITHOUT.PAGEHOLD) (P (INTERLISPMODE)) (VARS (COMPILEIGNOREDECL T)) (COMMANDS cd cdd cdl cdll cdls cdlu cdm cdp phone pwd show) (FNS shell) (COMMANDS cdpg cdse cds cdsg) (VARS (DEFAULTFAXHOST) (DEFAULTCHATHOST) (DEFAULTCOPYRIGHTOWNER)) (ADDVARS (CHAT.ALLHOSTS) (FAXADDRESSES)) (P (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL)) (FNS INIT.SETUP FILE PPR PPV RELOAD LOADFOREDIT CLOSEI CLOSES CLOSET NTEDITWINDOWS CLOSEG CHANGED?) (ADDVARS (TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147"))) (DECLARE%: DONTEVAL@LOAD DOCOPY [P (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS] (* ( (* ;; "Must be loaded before NSDISPLAYSIZES") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VIRTUALKEYBOARDS))) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES)) (VARS (DEFAULTPRINTINGHOST "") (DEFAULTPRINTERTYPE 'POSTSCRIPT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "(FILES (SYSLOAD) UPCLISP MIME )") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (P (FILEWATCH 'ON] (COMS (FILEPKGCOMS MACROS) (ALISTS (PRETTYEQUIVLST OPENLAMBDA))) (P (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"]) (DEFINEQ (INTERLISPMODE [LAMBDA (OLD?) (* N.H.Briggs " 2-Feb-88 14:26") (PROCESSPROP 'EXEC 'PROFILE (XCL:COPY-PROFILE (if OLD? then "OLD-INTERLISP-T" else "INTERLISP"))) (XCL:SET-DEFAULT-EXEC-TYPE (if OLD? then "OLD-INTERLISP-T" else "INTERLISP")) (SETQ *DEFAULT-MAKEFILE-ENVIRONMENT* (LIST :READTABLE (if OLD? then "OLD-INTERLISP-FILE" else "INTERLISP") :PACKAGE "INTERLISP"]) ) (RPAQQ COMPILEIGNOREDECL T) (RPAQ MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR)) (INTERLISPMODE) (DEFINEQ (LOCAL-INIT [LAMBDA NIL (DECLARE (GLOBALVARS MAKESYSNAME LOCALPATCHDIRECTORY)) (* ;  "Edited 14-Jun-2017 14:45 by kaplan") (* ;  "Edited 14-Jun-2017 11:15 by kaplan") (* ;; "This is what gets called when LOCAL-INIT is loaded.") (BKSYSBUF " ") (* ;; "do the real work") (WITHOUT.PAGEHOLD (WFROMDS (GETSTREAM T 'OUTPUT)) (CL:WHEN LOCALPATCHDIRECTORY (LoadPatches LOCALPATCHDIRECTORY 'SYSLOAD MAKESYSDATE))]) (LoadPatches [LAMBDA (DIRECTORY LDFLG AFTERDATE) (* ; "Edited 7-Feb-92 11:50 by bbb") (* ;;; "Load all compiled files from the directory") (DECLARE (GLOBALVARS *COMPILED-EXTENSIONS*)) (LET [(files (SORT (for EXT in *COMPILED-EXTENSIONS* bind (AFTERIDATE _ (if AFTERDATE then (OR (IDATE AFTERDATE) 0) else 0)) join (COLLECT-PATCH-FILES (DIRECTORYNAME DIRECTORY) EXT AFTERIDATE)) (FUNCTION (LAMBDA (X Y) (LESSP (CDR X) (CDR Y] (* ;  "files are sorted by increasing date") (for file in files do (SELECTQ LDFLG (HIDDEN (* ;  "Load the file, but don't put it on FILELST") (LOAD? (CAR file) T) (SETQ FILELST (DREMOVE (FILENAMEFIELD (CAR file) 'NAME) FILELST))) (LOAD? (CAR file) LDFLG))) files]) (COLLECT-PATCH-FILES [LAMBDA (DIRECTORY EXT AFTERIDATE) (* ; "Edited 7-Feb-92 11:49 by bbb") (* ;; "Generate list of files in DIRECTORY with extension EXT more recent than idate AFTERIDATE. Return list of pairs (file . date). Omits subdirectories.") (RESETLST (LET ((FILING.ENUMERATION.DEPTH 1) (NAKED-DIR (UNPACKFILENAME.STRING DIRECTORY 'DIRECTORY)) FILE DATE) (bind [GEN _ (\GENERATEFILES (CONCAT DIRECTORY "*." EXT ";") '(ICREATIONDATE) '(SORT RESETLST] while (SETQ FILE (\GENERATENEXTFILE GEN)) when (AND (STRING-EQUAL (UNPACKFILENAME.STRING FILE 'DIRECTORY) NAKED-DIR) (> (SETQ DATE (\GENERATEFILEINFO GEN 'ICREATIONDATE)) AFTERIDATE)) collect (CONS FILE DATE))))]) ) (DEFMACRO WITHOUT.PAGEHOLD (WINDOW &BODY FORMS) `(RESETLST (LET* ((TTYWINDOW ,WINDOW) (ORIGINAL.PAGEFULLFN (WINDOWPROP TTYWINDOW 'PAGEFULLFN)) (NEW.PAGEFULLFN (FUNCTION NILL))) (RESETSAVE (WINDOWPROP TTYWINDOW 'PAGEFULLFN NEW.PAGEFULLFN) (LIST [FUNCTION (LAMBDA (TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN) (COND ((EQ (WINDOWPROP TTYWINDOW 'PAGEFULLFN) NEW.PAGEFULLFN) (WINDOWPROP TTYWINDOW 'PAGEFULLFN ORIGINAL.PAGEFULLFN] TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN))) ,@FORMS)) (RPAQ LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (RPAQ LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (RPAQ LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (RPAQ IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (RPAQ DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (RPAQQ CUTEFLG T) (RPAQQ USERGREETFILES (({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT))) (RPAQQ *USEOLDFONTDIRECTORIES* NIL) (RPAQ DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts))) (RPAQ INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts))) (RPAQ POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts))) (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE)) (LOCAL-INIT) (SETTEMPLATE 'WITHOUT.PAGEHOLD 'MACRO) (INTERLISPMODE) (RPAQQ COMPILEIGNOREDECL T) (DEFCOMMAND cd (DIR) (/CNDIR DIR)) (DEFCOMMAND cdd NIL (CNDIR DICTDIR)) (DEFCOMMAND cdl NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/"))) (DEFCOMMAND cdll NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/library/"))) (DEFCOMMAND cdls NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/sources/"))) (DEFCOMMAND cdlu NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/lispusers/"))) (DEFCOMMAND cdm NIL (CNDIR MEDLEYDIR)) (DEFCOMMAND cdp NIL (CNDIR LFGPARSERDIR)) (DEFCOMMAND phone (name) (ShellCommand (CONCAT "phone " name))) (DEFCOMMAND pwd NIL (DIRECTORYNAME T)) (DEFCOMMAND (show :QUIET) (&REST EVENTSPEC) (CL:PPRINT (VALUOF EVENTSPEC T) T)) (DEFINEQ (shell [NLAMBDA LINE (* ;  "Edited 7-Sep-2020 13:28 by rmk:") [SETQ LINE (CONCATLIST (FOR X IN LINE JOIN (LIST X " "] (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) (ShellCommand LINE STREAM) (SETFILEPTR STREAM 0) (UNTIL (EOFP STREAM) COLLECT (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL]) ) (DEFCOMMAND cdpg NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram_english/dev/src/"))) (DEFCOMMAND cdse NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram_english/dev/src/Standard/"))) (DEFCOMMAND cds NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/"))) (DEFCOMMAND cdsg NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram/pargram_german/standard/"))) (RPAQQ DEFAULTFAXHOST NIL) (RPAQQ DEFAULTCHATHOST NIL) (RPAQQ DEFAULTCOPYRIGHTOWNER NIL) (ADDTOVAR CHAT.ALLHOSTS ) (ADDTOVAR FAXADDRESSES ) (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL) (DEFINEQ (INIT.SETUP [NLAMBDA (LASTNAME FIRSTNAME INITIALS OPENFOLDER NSNAME) (* ;  "Edited 2-May-2020 13:44 by rmk:") (* ;  "Edited 26-Apr-2018 13:21 by rmk:") (* ; "Edited 6-Mar-99 11:56 by rmk:") (* ; "Edited 28-Feb-99 00:02 by rmk:") (* ; "Edited 4-Oct-98 10:02 by rmk:") (AND (LISTP (EVALV 'FB.DEFAULT.INFO)) (PUSHNEW FB.DEFAULT.INFO 'LENGTH)) (RPAQQ RECLAIMWAIT 20) (RPAQQ LCASEFLG NIL) (RPAQQ COPYRIGHTFLG NIL) (RPAQQ DWIMWAIT 30) (RPAQQ PFDEFAULT T) (RPAQQ CHANGESARRAY NIL) (RPAQQ AUTOBACKTRACEFLG T) (RPAQQ CLISPIFYENGLSHFLG NIL) (RPAQQ CUTEFLG NIL) (RPAQQ EDITCHARACTERS (J (H G) Z Y N (O NIL))) (RPAQQ **COMMENT**FLG " ; -- ") (RPAQQ EDITUNSAVEBLOCKFLG NIL) (RPAQQ NORMALCOMMENTSFLG T) (RPAQQ DEFAULTRENAMEMETHOD EDITCALLERS) (RPAQQ RECOMPILEDEFAULT EXPRS) (RPAQQ LINESPERPAGE 69) (RPAQQ CLEANUPOPTIONS (RC ST)) (RPAQQ TTYINCOMPLETEFLG NIL) (CL:WHEN (OPENWP LOGOW) (CLOSEW LOGOW)) (CL:UNLESS (WINDOWP (EVALV 'LFGLOGOW)) (WINDOWPROP PROMPTWINDOW 'TITLE NIL) (SHAPEW PROMPTWINDOW (CREATEREGION 20 (- SCREENHEIGHT 65) 542 63)) [LET ((PROMPTY (- SCREENHEIGHT 63))) (SHAPEW PROMPTWINDOW (CREATEREGION 20 PROMPTY 542 63)) (* ;  "Expand T only upwards to just below prompt") (SHAPEW T (CREATE REGION USING (WINDOWPROP T 'REGION) HEIGHT _ (- (- PROMPTY 4) (FETCH BOTTOM OF (WINDOWPROP T 'REGION]) (* ; "LAFITE") (SETQ OPENFOLDER (EVAL OPENFOLDER)) (CL:UNLESS (AND T (EQ OPENFOLDER 'NOMAIL)) (RPAQ LAFITEDEFAULTHOST&DIR (PACK* "{DSK}/TILDE/" LASTNAME "/MAIL/")) (RPAQQ LAFITEUSEHIGHESTVERSIONFLG T) (RPAQ LAFITESTATUSWINDOWPOSITION (CONS 585 (- SCREENHEIGHT 57))) (COND ((DEFINEDP 'LAFITE) (RPAQ LAFITEHARDCOPYFONT (FONTCREATE 'CLASSIC 10 NIL NIL 'DISPLAY)) (* ;; "Use bigger screen fonts on high-res monitor") (RPAQ LAFITEDISPLAYFONT (RPAQ LAFITEEDITORFONT (FONTCREATE 'CLASSIC (CL:IF (IGREATERP SCREENHEIGHT 1100) 14 10) NIL NIL 'DISPLAY))) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) LAFITEFIND) (RPAQ LAFITE.DONT.DISPLAY.HEADERS (RPAQ LAFITE.DONT.HARDCOPY.HEADERS (RPAQQ LAFITE.DONT.FORWARD.HEADERS ("Mime-Version" "Return-Path" "Redistributed" "Received" "Message-Id" "Format" "Errors-To" "Return-Receipt-To" "Posted-Date" "Postmark" "X-" "Line-Fold" "XNS-Transport-ID" "Illegal" :ORIGINAL)))) (SETQ NS.USER.NAME NSNAME) (SETQ UNIXMAIL.SEND.HOST 'fargo.parc.xerox.com) (SETQ UNIXMAIL.SPOOL.FILE (PACK* '/net/mailback/var/spool/mail/ (UNIX-USERNAME))) (LAFITEMODE 'UNIX) (LAFITE 'ON OPENFOLDER)))) (PUSH TEDIT.DEFAULT.PROPS `FONT `(CLASSIC 10)) (ADDTOVAR EDITMACROS [SHOWD NIL UP (ORR ((E (RESETFORM (OUTPUT T) (PROGN (PRINTDEF (OR [EDITGETD (%## 1) (AND (CDR L) (EDITL0 L '(!0] (ERROR!)) NIL T) (TERPRI))) T)) ((E 'SHOWD?]) (ADDTOVAR EDITCOMSA SHOWD) [EVAL `(ADDTOVAR INITIALSLST ,(LIST LASTNAME FIRSTNAME (PACK* INITIALS ":")))] (/PUSH DIRECTORIES LFGPARSERDIR DICTDIR NIL '{DSK}) (/PUSH LISPUSERSDIRECTORIES LFGPARSERDIR) (RPAQ LOGINHOST/DIR (PACK* "{dsk}/Users/" (L-CASE LASTNAME) "/lisp/")) (RPAQ EMPRESS.SCRATCH (LIST 5 (PACKFILENAME 'DIRECTORY '{DSK}/tmp/ 'BODY 'EMPRESS.SCRATCH))) (MOVD? 'EDITF 'EF) (MOVD? 'EDITV 'EV) (MOVD? 'EDITP 'EP) (MOVD? 'EDITREC 'ER) (RAISE) (* ;; "Now make sure that INIT isn't on FILELST--compensates for system 'feature'") (* ;; "(PUSH POSTGREETFORMS '(SMASHFILECOMS 'INIT) '(DELDEF 'INIT 'FILE))") (AND (NULL (EVALV 'TESTSYS)) (SETQ CLISPIFYPRETTYFLG 'CHANGES) (SETQ CLISPIFTRANFLG 'T]) (FILE [NLAMBDA ARGS (* rmk%: "18-Sep-87 15:35") [COND ((CDR ARGS) (/SETATOMVAL (FILECOMS (CAR ARGS)) (COND [(AND (LITATOM (CADR ARGS)) (NULL (CDDR ARGS))) (COPY (GETATOMVAL (CADR ARGS] (T (CDR ARGS] (RESETFORM (RADIX 10) (MAKEFILE (CAR ARGS]) (PPR [NLAMBDA X (* rmk%: "26-Sep-84 09:27") (for R D inside X do (AND (SETQ D (RECLOOK R)) (printout T .PPF D T)) (AND (SETQ D (FIELDLOOK R)) (printout T .PPFTL D T)) (AND (HASDEF 'DECLTYPES 'FILEPKGTYPE) (SETQ D (GETDEF R 'DECLTYPES 'CURRENT 'NOERROR)) (printout T .PPF D T]) (PPV [LAMBDA (X) (* ;  "Edited 6-Mar-2020 13:06 by rmk:") (PRINTDEF X) ""]) (RELOAD [LAMBDA (FILES NEWTOO) (* ; "Edited 7-Jun-93 17:33 by rmk:") (* ;; "Reloads new compiled versions and notices symbolics, skipping non-Lisp files in FILES. Only reloads already present files unless NEWTOO.") (* ;  "Get rid of versions, and also compile.ext extensions") [SETQ FILES (FOR F EXT INSIDE FILES COLLECT [SETQ EXT (U-CASE (FILENAMEFIELD F 'EXTENSION] (* ;  "Must wipe out NIL extension to eliminate period") (U-CASE (PACKFILENAME 'EXTENSION (AND (NOT (MEMB EXT *COMPILED-EXTENSIONS*)) EXT) 'VERSION NIL 'BODY F](* ;  "Eliminate duplicates, even through COMPILE.EXT") (SETQ FILES (FOR FTAIL ON FILES UNLESS (MEMB (CAR FTAIL) (CDR FTAIL)) COLLECT (CAR FTAIL))) (OR (MEMB NEWTOO LOADOPTIONS) (SETQ NEWTOO T)) (* ;  "NEWTOO is default LDFLG when file hasn't been loaded") (FOR F ROOTFNAME CNAME SNAME LDFLG IN FILES EACHTIME (SETQ ROOTFNAME (ROOTFILENAME F)) WHEN [SETQ LDFLG (OR NEWTOO (COND ((GETP ROOTFNAME 'FILE) T) ((GETP ROOTFNAME 'FILEDATES) 'SYSLOAD] WHEN (PROGN (IF (SETQ CNAME (FINDFILE-WITH-EXTENSIONS F NIL *COMPILED-EXTENSIONS*)) THEN (SETQ SNAME (INFILEP (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY CNAME))) ELSE (SETQ SNAME (FINDFILE F T))) (CL:WHEN SNAME (CL:UNLESS (LISPSOURCEFILEP SNAME) (SETQ SNAME NIL))) (OR CNAME SNAME (PROGN (PRINTOUT T "NOT FOUND: " F T) NIL))) COLLECT (* ;  "Don't fiddle properties at all if file isn't found") (* ;  "Don't do DELDEF, cause it will remove it from FILES commands in other files") [FOR LST IN '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES COPYRIGHT) DO (/SETTOPVAL LST (REMOVE ROOTFNAME (GETTOPVAL LST] (/REMPROP ROOTFNAME 'FILE) (/REMPROP ROOTFNAME 'FILECHANGES) (/REMPROP ROOTFNAME 'FILEMAP) (/REMPROP ROOTFNAME 'FILEDATES) (IF CNAME THEN (LOAD CNAME LDFLG)) (IF SNAME THEN (IF CNAME THEN (OR (EQ LDFLG 'SYSLOAD) (LOADFROM SNAME)) ELSE (LOAD SNAME LDFLG))) (FOR X IN (FILEFNSLST ROOTFNAME) DO (/REMPROP X 'EXPR)) (/RPLACD (GETP ROOTFNAME 'FILE)) (APPEND (MKLIST CNAME) (MKLIST SNAME]) (LOADFOREDIT [LAMBDA NIL (* ;  "Edited 24-Apr-2018 14:23 by rmk:") (* ;  "Edited 24-Apr-2018 14:23 by rmk:") (* ;  "Edited 22-Apr-2018 13:25 by rmk:") (* ;  "Edited 14-Jun-2017 13:36 by kaplan") (CL:WHEN (GETD 'TEDIT) (FILESLOAD (SYSLOAD FROM VALUEOF (APPEND '({dsk}/project/lfg/tedit/) LISPUSERSDIRECTORIES)) OBJECTOUTOFTEDIT MATRIX SUPSUB BOXOBJ UID TMAX TMAXPATCHES DOC-OBJECTS SKETCH GRAPHER SKETCHPATCH) (* ; "UID needed by TMAXPATCHES") (FILESLOAD (SYSLOAD FROM VALUEOF LFGPARSERDIR) LFGDISPLAY LFG-FSIMAGEOBJ TREEOBJECT SETIPCHARWIDTH))]) (CLOSEI [LAMBDA NIL (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all inspector windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'INSPECTW.REPAINTFN (WINDOWPROP W 'REPAINTFN)) DO (CLOSEW W]) (CLOSES [LAMBDA NIL (* ;  "Edited 17-Jan-2020 10:53 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all SEDIT windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'SEDIT::REPAINTFN (WINDOWPROP W 'REPAINTFN)) DO (CLOSEW W]) (CLOSET [LAMBDA (ASKFORDIRTY) (* ;  "Edited 17-May-2020 11:16 by rmk:") (* ;  "Edited 22-Apr-2020 14:20 by rmk:") (* ;  "Edited 17-Mar-2020 23:00 by rmk:") (* ;  "Edited 16-Mar-2020 12:49 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all TEDIT windows, except sentence input window") (FOR W IN (OPENWINDOWS) WHEN (TEDITWINDOWP W) UNLESS (STRPOS "LFGINPUTWINDOW" (WINDOWPROP W 'TEDIT.TITLEMENUFN)) DO (CL:UNLESS ASKFORDIRTY (TEDIT.STREAMCHANGEDP (TEXTSTREAM W) T)) (CLOSEW W]) (NTEDITWINDOWS [LAMBDA NIL (* ;  "Edited 22-Apr-2020 14:21 by rmk:") (FOR W IN (OPENWINDOWS) COUNT (TEDITWINDOWP W]) (CLOSEG [LAMBDA NIL (* ;  "Edited 16-Mar-2020 12:49 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all grammar (rules, lexentries. templates, configs...) windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'STRUCTEDITOR.MENUFN (WINDOWPROP W 'TEDIT.TITLEMENUFN)) DO (CLOSEW W]) (CHANGED? [LAMBDA (NAME TYPE) (* ;  "Edited 5-Jul-2020 08:26 by rmk:") (* ;  "Edited 9-Jun-2020 23:25 by rmk:") (CL:UNLESS TYPE (SETQ TYPE (IF (AND (GETATOMVAL NAME) (NOT (GETD NAME))) THEN 'VARS ELSE 'FNS))) (LET ((FILE (WHEREIS NAME TYPE))) (IF (NULL FILE) THEN (PRINTOUT T NAME " as " TYPE " doesn't belong to a file" T) ELSEIF (CDR FILE) THEN (PRINTOUT T NAME " belongs to several files: " FILE ", not testing" T) ELSE (SETQ FILE (CAR FILE)) (LET [[CURRENT (GETDEF NAME TYPE NIL '(NOERROR NOCOPY] (FROMFILE (GETDEF NAME TYPE FILE '(NOERROR NOCOPY] (CL:WHEN (EQ TYPE 'FNS) (* ;; "Skip the file dates") [SETQ CURRENT `(,(CAR CURRENT) ,(CADR CURRENT) ,@(FOR FORM IN (CDDR CURRENT) UNLESS (EDITDATE? FORM) COLLECT FORM] [SETQ FROMFILE `(,(CAR FROMFILE) ,(CADR FROMFILE) ,@(FOR FORM IN (CDDR FROMFILE) UNLESS (EDITDATE? FORM) COLLECT FORM]) (IF (COMPARELST CURRENT FROMFILE T) THEN (PRINTOUT T NAME " has not changed") (CL:WHEN (MEMB NAME (GETP FILE 'FILE)) (PRINTOUT T ", removing it from " FILE " changes") [/RPLACD (GETP FILE 'FILE) (REMOVE NAME (GETP FILE 'FILE]) (CL:WHEN (AND (MEMB TYPE '(FNS FUNCTION)) (EXPRP NAME) (GETP NAME 'CODE)) (PRINTOUT T ", restoring compiled definition" T) (UNSAVEDEF NAME 'CODE)) (TERPRI T) (UNMARKASCHANGED NAME TYPE) 'SAME ELSE (PRINTOUT T NAME " has changed" T) (COMPARELISTS CURRENT FROMFILE T) 'DIFFERENT]) ) (ADDTOVAR TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147")) (DECLARE%: DONTEVAL@LOAD DOCOPY (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS)) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES) ) (RPAQ DEFAULTPRINTINGHOST "") (RPAQQ DEFAULTPRINTERTYPE POSTSCRIPT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (FILEWATCH 'ON) ) (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)))) (ADDTOVAR PRETTYEQUIVLST (OPENLAMBDA . LAMBDA)) (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"))) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [(FNS INTERLISPMODE) [VARS (COMPILEIGNOREDECL T) (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (P (INTERLISPMODE)) (FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES) (FUNCTIONS WITHOUT.PAGEHOLD) (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (CUTEFLG T) (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT] [VARS (*USEOLDFONTDIRECTORIES* NIL) [DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts] [INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts] (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (P (LOCAL-INIT)) (TEMPLATES WITHOUT.PAGEHOLD) (P (INTERLISPMODE)) (VARS (COMPILEIGNOREDECL T)) (COMMANDS cd cdd cdl cdll cdls cdlu cdm cdp phone pwd show) (FNS shell) (COMMANDS cdpg cdse cds cdsg) (VARS (DEFAULTFAXHOST) (DEFAULTCHATHOST) (DEFAULTCOPYRIGHTOWNER)) (ADDVARS (CHAT.ALLHOSTS) (FAXADDRESSES)) (P (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL)) (FNS INIT.SETUP FILE PPR PPV RELOAD LOADFOREDIT CLOSEI CLOSES CLOSET NTEDITWINDOWS CLOSEG CHANGED?) (ADDVARS (TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147"))) (DECLARE%: DONTEVAL@LOAD DOCOPY [P (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS] (* ( (* ;; "Must be loaded before NSDISPLAYSIZES") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VIRTUALKEYBOARDS))) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES)) (VARS (DEFAULTPRINTINGHOST "") (DEFAULTPRINTERTYPE 'POSTSCRIPT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "(FILES (SYSLOAD) UPCLISP MIME )") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (P (FILEWATCH 'ON] (COMS (FILEPKGCOMS MACROS) (ALISTS (PRETTYEQUIVLST OPENLAMBDA))) [P (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PPR FILE shell) (NLAML INIT.SETUP) (LAMA]) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA PPR FILE shell) (ADDTOVAR NLAML INIT.SETUP) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (4563 5388 (INTERLISPMODE 4573 . 5386)) (5490 9168 (LOCAL-INIT 5500 . 6237) (LoadPatches 6239 . 8187) (COLLECT-PATCH-FILES 8189 . 9166)) (11881 12397 (shell 11891 . 12395)) (13199 31687 ( INIT.SETUP 13209 . 19451) (FILE 19453 . 19878) (PPR 19880 . 20467) (PPV 20469 . 20673) (RELOAD 20675 . 24455) (LOADFOREDIT 24457 . 25656) (CLOSEI 25658 . 26008) (CLOSES 26010 . 26524) (CLOSET 26526 . 27981) (NTEDITWINDOWS 27983 . 28235) (CLOSEG 28237 . 28885) (CHANGED? 28887 . 31685))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "25-Nov-2020 18:29:03" {DSK}larry>ilisp>medley>greetfiles>SIMPLE-INIT.;2 4356 changes to%: (VARS SIMPLE-INITCOMS) (FNS shell FIXVERSION) (TEMPLATES WITHOUT.PAGEHOLD) previous date%: "24-Nov-2020 10:20:03" {DSK}larry>SIMPLE-INIT.;1) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [[VARS (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo/")) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (LOGINHOST/DIR (OR (UNIX-GETENV "LOGINHOST/DIR") "{DSK}")) (USERGREETFILES (LET ((BASE (CONCAT LOGINHOST/DIR "/INIT"))) (LIST (CONCAT BASE ".LCOM") (CONCAT BASE ".DFASL") BASE] [VARS (DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/dispplayfonts") (CONCAT MEDLEYDIR "/fonts/altofonts"))) (INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/ipfonts"))) (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/postscriptfonts"] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (COMMANDS cd pwd) (FNS shell) [P (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash")))] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA shell) (NLAML) (LAMA]) (RPAQ MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR)) (RPAQ LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (RPAQ LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (RPAQ IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo/")) (RPAQ DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (RPAQ LOGINHOST/DIR (OR (UNIX-GETENV "LOGINHOST/DIR") "{DSK}")) (RPAQ USERGREETFILES (LET ((BASE (CONCAT LOGINHOST/DIR "/INIT"))) (LIST (CONCAT BASE ".LCOM") (CONCAT BASE ".DFASL") BASE))) (RPAQ DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/dispplayfonts") (CONCAT MEDLEYDIR "/fonts/altofonts"))) (RPAQ INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/ipfonts"))) (RPAQ POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/postscriptfonts"))) (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE)) (DEFCOMMAND cd (DIR) (/CNDIR DIR)) (DEFCOMMAND pwd NIL (DIRECTORYNAME T)) (DEFINEQ (shell [NLAMBDA LINE (* ;  "Edited 7-Sep-2020 13:28 by rmk:") [SETQ LINE (CONCATLIST (for X in LINE join (LIST X " "] (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) (ShellCommand LINE STREAM) (SETFILEPTR STREAM 0) (until (EOFP STREAM) collect (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL]) ) (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA shell) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (3482 3998 (shell 3492 . 3996))))) STOP \ No newline at end of file diff --git a/greetfiles/SIMPLE-INIT.~1~ b/greetfiles/SIMPLE-INIT.~1~ new file mode 100644 index 00000000..4514f727 --- /dev/null +++ b/greetfiles/SIMPLE-INIT.~1~ @@ -0,0 +1 @@ +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "24-Nov-2020 11:05:36" {DSK}larry>SIMPLE-INIT.;3 40372 changes to%: (VARS SIMPLE-INITCOMS) (TEMPLATES WITHOUT.PAGEHOLD) (FNS FIXVERSION) previous date%: "24-Nov-2020 10:20:03" {DSK}larry>SIMPLE-INIT.;1) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [(FNS INTERLISPMODE) [VARS (COMPILEIGNOREDECL T) (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (P (INTERLISPMODE)) (FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES) (FUNCTIONS WITHOUT.PAGEHOLD) (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (CUTEFLG T) (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT] [VARS (*USEOLDFONTDIRECTORIES* NIL) [DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts] [INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts] (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (P (LOCAL-INIT)) (TEMPLATES WITHOUT.PAGEHOLD) (P (INTERLISPMODE)) (VARS (COMPILEIGNOREDECL T)) (COMMANDS cd cdd cdl cdll cdls cdlu cdm cdp phone pwd show) (FNS shell) (COMMANDS cdpg cdse cds cdsg) (VARS (DEFAULTFAXHOST) (DEFAULTCHATHOST) (DEFAULTCOPYRIGHTOWNER)) (ADDVARS (CHAT.ALLHOSTS) (FAXADDRESSES)) (P (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL)) (FNS INIT.SETUP FILE PPR PPV RELOAD LOADFOREDIT CLOSEI CLOSES CLOSET NTEDITWINDOWS CLOSEG CHANGED?) (ADDVARS (TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147"))) (DECLARE%: DONTEVAL@LOAD DOCOPY [P (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS] (* ( (* ;; "Must be loaded before NSDISPLAYSIZES") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VIRTUALKEYBOARDS))) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES)) (VARS (DEFAULTPRINTINGHOST "") (DEFAULTPRINTERTYPE 'POSTSCRIPT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "(FILES (SYSLOAD) UPCLISP MIME )") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (P (FILEWATCH 'ON] (COMS (FILEPKGCOMS MACROS) (ALISTS (PRETTYEQUIVLST OPENLAMBDA))) (P (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"]) (DEFINEQ (INTERLISPMODE [LAMBDA (OLD?) (* N.H.Briggs " 2-Feb-88 14:26") (PROCESSPROP 'EXEC 'PROFILE (XCL:COPY-PROFILE (if OLD? then "OLD-INTERLISP-T" else "INTERLISP"))) (XCL:SET-DEFAULT-EXEC-TYPE (if OLD? then "OLD-INTERLISP-T" else "INTERLISP")) (SETQ *DEFAULT-MAKEFILE-ENVIRONMENT* (LIST :READTABLE (if OLD? then "OLD-INTERLISP-FILE" else "INTERLISP") :PACKAGE "INTERLISP"]) ) (RPAQQ COMPILEIGNOREDECL T) (RPAQ MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR)) (INTERLISPMODE) (DEFINEQ (LOCAL-INIT [LAMBDA NIL (DECLARE (GLOBALVARS MAKESYSNAME LOCALPATCHDIRECTORY)) (* ;  "Edited 14-Jun-2017 14:45 by kaplan") (* ;  "Edited 14-Jun-2017 11:15 by kaplan") (* ;; "This is what gets called when LOCAL-INIT is loaded.") (BKSYSBUF " ") (* ;; "do the real work") (WITHOUT.PAGEHOLD (WFROMDS (GETSTREAM T 'OUTPUT)) (CL:WHEN LOCALPATCHDIRECTORY (LoadPatches LOCALPATCHDIRECTORY 'SYSLOAD MAKESYSDATE))]) (LoadPatches [LAMBDA (DIRECTORY LDFLG AFTERDATE) (* ; "Edited 7-Feb-92 11:50 by bbb") (* ;;; "Load all compiled files from the directory") (DECLARE (GLOBALVARS *COMPILED-EXTENSIONS*)) (LET [(files (SORT (for EXT in *COMPILED-EXTENSIONS* bind (AFTERIDATE _ (if AFTERDATE then (OR (IDATE AFTERDATE) 0) else 0)) join (COLLECT-PATCH-FILES (DIRECTORYNAME DIRECTORY) EXT AFTERIDATE)) (FUNCTION (LAMBDA (X Y) (LESSP (CDR X) (CDR Y] (* ;  "files are sorted by increasing date") (for file in files do (SELECTQ LDFLG (HIDDEN (* ;  "Load the file, but don't put it on FILELST") (LOAD? (CAR file) T) (SETQ FILELST (DREMOVE (FILENAMEFIELD (CAR file) 'NAME) FILELST))) (LOAD? (CAR file) LDFLG))) files]) (COLLECT-PATCH-FILES [LAMBDA (DIRECTORY EXT AFTERIDATE) (* ; "Edited 7-Feb-92 11:49 by bbb") (* ;; "Generate list of files in DIRECTORY with extension EXT more recent than idate AFTERIDATE. Return list of pairs (file . date). Omits subdirectories.") (RESETLST (LET ((FILING.ENUMERATION.DEPTH 1) (NAKED-DIR (UNPACKFILENAME.STRING DIRECTORY 'DIRECTORY)) FILE DATE) (bind [GEN _ (\GENERATEFILES (CONCAT DIRECTORY "*." EXT ";") '(ICREATIONDATE) '(SORT RESETLST] while (SETQ FILE (\GENERATENEXTFILE GEN)) when (AND (STRING-EQUAL (UNPACKFILENAME.STRING FILE 'DIRECTORY) NAKED-DIR) (> (SETQ DATE (\GENERATEFILEINFO GEN 'ICREATIONDATE)) AFTERIDATE)) collect (CONS FILE DATE))))]) ) (DEFMACRO WITHOUT.PAGEHOLD (WINDOW &BODY FORMS) `(RESETLST (LET* ((TTYWINDOW ,WINDOW) (ORIGINAL.PAGEFULLFN (WINDOWPROP TTYWINDOW 'PAGEFULLFN)) (NEW.PAGEFULLFN (FUNCTION NILL))) (RESETSAVE (WINDOWPROP TTYWINDOW 'PAGEFULLFN NEW.PAGEFULLFN) (LIST [FUNCTION (LAMBDA (TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN) (COND ((EQ (WINDOWPROP TTYWINDOW 'PAGEFULLFN) NEW.PAGEFULLFN) (WINDOWPROP TTYWINDOW 'PAGEFULLFN ORIGINAL.PAGEFULLFN] TTYWINDOW NEW.PAGEFULLFN ORIGINAL.PAGEFULLFN))) ,@FORMS)) (RPAQ LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (RPAQ LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (RPAQ LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (RPAQ IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (RPAQ DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (RPAQQ CUTEFLG T) (RPAQQ USERGREETFILES (({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT))) (RPAQQ *USEOLDFONTDIRECTORIES* NIL) (RPAQ DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts))) (RPAQ INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts))) (RPAQ POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts))) (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE)) (LOCAL-INIT) (SETTEMPLATE 'WITHOUT.PAGEHOLD 'MACRO) (INTERLISPMODE) (RPAQQ COMPILEIGNOREDECL T) (DEFCOMMAND cd (DIR) (/CNDIR DIR)) (DEFCOMMAND cdd NIL (CNDIR DICTDIR)) (DEFCOMMAND cdl NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/"))) (DEFCOMMAND cdll NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/library/"))) (DEFCOMMAND cdls NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/sources/"))) (DEFCOMMAND cdlu NIL (CNDIR (CONCAT MEDLEYDIR "/lispcore/lispusers/"))) (DEFCOMMAND cdm NIL (CNDIR MEDLEYDIR)) (DEFCOMMAND cdp NIL (CNDIR LFGPARSERDIR)) (DEFCOMMAND phone (name) (ShellCommand (CONCAT "phone " name))) (DEFCOMMAND pwd NIL (DIRECTORYNAME T)) (DEFCOMMAND (show :QUIET) (&REST EVENTSPEC) (CL:PPRINT (VALUOF EVENTSPEC T) T)) (DEFINEQ (shell [NLAMBDA LINE (* ;  "Edited 7-Sep-2020 13:28 by rmk:") [SETQ LINE (CONCATLIST (FOR X IN LINE JOIN (LIST X " "] (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) (ShellCommand LINE STREAM) (SETFILEPTR STREAM 0) (UNTIL (EOFP STREAM) COLLECT (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL]) ) (DEFCOMMAND cdpg NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram_english/dev/src/"))) (DEFCOMMAND cdse NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram_english/dev/src/Standard/"))) (DEFCOMMAND cds NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/"))) (DEFCOMMAND cdsg NIL (CNDIR (CONCAT (UNIX-GETENV "HOME") "/sandbox/pargram/pargram_german/standard/"))) (RPAQQ DEFAULTFAXHOST NIL) (RPAQQ DEFAULTCHATHOST NIL) (RPAQQ DEFAULTCOPYRIGHTOWNER NIL) (ADDTOVAR CHAT.ALLHOSTS ) (ADDTOVAR FAXADDRESSES ) (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL) (DEFINEQ (INIT.SETUP [NLAMBDA (LASTNAME FIRSTNAME INITIALS OPENFOLDER NSNAME) (* ;  "Edited 2-May-2020 13:44 by rmk:") (* ;  "Edited 26-Apr-2018 13:21 by rmk:") (* ; "Edited 6-Mar-99 11:56 by rmk:") (* ; "Edited 28-Feb-99 00:02 by rmk:") (* ; "Edited 4-Oct-98 10:02 by rmk:") (AND (LISTP (EVALV 'FB.DEFAULT.INFO)) (PUSHNEW FB.DEFAULT.INFO 'LENGTH)) (RPAQQ RECLAIMWAIT 20) (RPAQQ LCASEFLG NIL) (RPAQQ COPYRIGHTFLG NIL) (RPAQQ DWIMWAIT 30) (RPAQQ PFDEFAULT T) (RPAQQ CHANGESARRAY NIL) (RPAQQ AUTOBACKTRACEFLG T) (RPAQQ CLISPIFYENGLSHFLG NIL) (RPAQQ CUTEFLG NIL) (RPAQQ EDITCHARACTERS (J (H G) Z Y N (O NIL))) (RPAQQ **COMMENT**FLG " ; -- ") (RPAQQ EDITUNSAVEBLOCKFLG NIL) (RPAQQ NORMALCOMMENTSFLG T) (RPAQQ DEFAULTRENAMEMETHOD EDITCALLERS) (RPAQQ RECOMPILEDEFAULT EXPRS) (RPAQQ LINESPERPAGE 69) (RPAQQ CLEANUPOPTIONS (RC ST)) (RPAQQ TTYINCOMPLETEFLG NIL) (CL:WHEN (OPENWP LOGOW) (CLOSEW LOGOW)) (CL:UNLESS (WINDOWP (EVALV 'LFGLOGOW)) (WINDOWPROP PROMPTWINDOW 'TITLE NIL) (SHAPEW PROMPTWINDOW (CREATEREGION 20 (- SCREENHEIGHT 65) 542 63)) [LET ((PROMPTY (- SCREENHEIGHT 63))) (SHAPEW PROMPTWINDOW (CREATEREGION 20 PROMPTY 542 63)) (* ;  "Expand T only upwards to just below prompt") (SHAPEW T (CREATE REGION USING (WINDOWPROP T 'REGION) HEIGHT _ (- (- PROMPTY 4) (FETCH BOTTOM OF (WINDOWPROP T 'REGION]) (* ; "LAFITE") (SETQ OPENFOLDER (EVAL OPENFOLDER)) (CL:UNLESS (AND T (EQ OPENFOLDER 'NOMAIL)) (RPAQ LAFITEDEFAULTHOST&DIR (PACK* "{DSK}/TILDE/" LASTNAME "/MAIL/")) (RPAQQ LAFITEUSEHIGHESTVERSIONFLG T) (RPAQ LAFITESTATUSWINDOWPOSITION (CONS 585 (- SCREENHEIGHT 57))) (COND ((DEFINEDP 'LAFITE) (RPAQ LAFITEHARDCOPYFONT (FONTCREATE 'CLASSIC 10 NIL NIL 'DISPLAY)) (* ;; "Use bigger screen fonts on high-res monitor") (RPAQ LAFITEDISPLAYFONT (RPAQ LAFITEEDITORFONT (FONTCREATE 'CLASSIC (CL:IF (IGREATERP SCREENHEIGHT 1100) 14 10) NIL NIL 'DISPLAY))) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) LAFITEFIND) (RPAQ LAFITE.DONT.DISPLAY.HEADERS (RPAQ LAFITE.DONT.HARDCOPY.HEADERS (RPAQQ LAFITE.DONT.FORWARD.HEADERS ("Mime-Version" "Return-Path" "Redistributed" "Received" "Message-Id" "Format" "Errors-To" "Return-Receipt-To" "Posted-Date" "Postmark" "X-" "Line-Fold" "XNS-Transport-ID" "Illegal" :ORIGINAL)))) (SETQ NS.USER.NAME NSNAME) (SETQ UNIXMAIL.SEND.HOST 'fargo.parc.xerox.com) (SETQ UNIXMAIL.SPOOL.FILE (PACK* '/net/mailback/var/spool/mail/ (UNIX-USERNAME))) (LAFITEMODE 'UNIX) (LAFITE 'ON OPENFOLDER)))) (PUSH TEDIT.DEFAULT.PROPS `FONT `(CLASSIC 10)) (ADDTOVAR EDITMACROS [SHOWD NIL UP (ORR ((E (RESETFORM (OUTPUT T) (PROGN (PRINTDEF (OR [EDITGETD (%## 1) (AND (CDR L) (EDITL0 L '(!0] (ERROR!)) NIL T) (TERPRI))) T)) ((E 'SHOWD?]) (ADDTOVAR EDITCOMSA SHOWD) [EVAL `(ADDTOVAR INITIALSLST ,(LIST LASTNAME FIRSTNAME (PACK* INITIALS ":")))] (/PUSH DIRECTORIES LFGPARSERDIR DICTDIR NIL '{DSK}) (/PUSH LISPUSERSDIRECTORIES LFGPARSERDIR) (RPAQ LOGINHOST/DIR (PACK* "{dsk}/Users/" (L-CASE LASTNAME) "/lisp/")) (RPAQ EMPRESS.SCRATCH (LIST 5 (PACKFILENAME 'DIRECTORY '{DSK}/tmp/ 'BODY 'EMPRESS.SCRATCH))) (MOVD? 'EDITF 'EF) (MOVD? 'EDITV 'EV) (MOVD? 'EDITP 'EP) (MOVD? 'EDITREC 'ER) (RAISE) (* ;; "Now make sure that INIT isn't on FILELST--compensates for system 'feature'") (* ;; "(PUSH POSTGREETFORMS '(SMASHFILECOMS 'INIT) '(DELDEF 'INIT 'FILE))") (AND (NULL (EVALV 'TESTSYS)) (SETQ CLISPIFYPRETTYFLG 'CHANGES) (SETQ CLISPIFTRANFLG 'T]) (FILE [NLAMBDA ARGS (* rmk%: "18-Sep-87 15:35") [COND ((CDR ARGS) (/SETATOMVAL (FILECOMS (CAR ARGS)) (COND [(AND (LITATOM (CADR ARGS)) (NULL (CDDR ARGS))) (COPY (GETATOMVAL (CADR ARGS] (T (CDR ARGS] (RESETFORM (RADIX 10) (MAKEFILE (CAR ARGS]) (PPR [NLAMBDA X (* rmk%: "26-Sep-84 09:27") (for R D inside X do (AND (SETQ D (RECLOOK R)) (printout T .PPF D T)) (AND (SETQ D (FIELDLOOK R)) (printout T .PPFTL D T)) (AND (HASDEF 'DECLTYPES 'FILEPKGTYPE) (SETQ D (GETDEF R 'DECLTYPES 'CURRENT 'NOERROR)) (printout T .PPF D T]) (PPV [LAMBDA (X) (* ;  "Edited 6-Mar-2020 13:06 by rmk:") (PRINTDEF X) ""]) (RELOAD [LAMBDA (FILES NEWTOO) (* ; "Edited 7-Jun-93 17:33 by rmk:") (* ;; "Reloads new compiled versions and notices symbolics, skipping non-Lisp files in FILES. Only reloads already present files unless NEWTOO.") (* ;  "Get rid of versions, and also compile.ext extensions") [SETQ FILES (FOR F EXT INSIDE FILES COLLECT [SETQ EXT (U-CASE (FILENAMEFIELD F 'EXTENSION] (* ;  "Must wipe out NIL extension to eliminate period") (U-CASE (PACKFILENAME 'EXTENSION (AND (NOT (MEMB EXT *COMPILED-EXTENSIONS*)) EXT) 'VERSION NIL 'BODY F](* ;  "Eliminate duplicates, even through COMPILE.EXT") (SETQ FILES (FOR FTAIL ON FILES UNLESS (MEMB (CAR FTAIL) (CDR FTAIL)) COLLECT (CAR FTAIL))) (OR (MEMB NEWTOO LOADOPTIONS) (SETQ NEWTOO T)) (* ;  "NEWTOO is default LDFLG when file hasn't been loaded") (FOR F ROOTFNAME CNAME SNAME LDFLG IN FILES EACHTIME (SETQ ROOTFNAME (ROOTFILENAME F)) WHEN [SETQ LDFLG (OR NEWTOO (COND ((GETP ROOTFNAME 'FILE) T) ((GETP ROOTFNAME 'FILEDATES) 'SYSLOAD] WHEN (PROGN (IF (SETQ CNAME (FINDFILE-WITH-EXTENSIONS F NIL *COMPILED-EXTENSIONS*)) THEN (SETQ SNAME (INFILEP (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY CNAME))) ELSE (SETQ SNAME (FINDFILE F T))) (CL:WHEN SNAME (CL:UNLESS (LISPSOURCEFILEP SNAME) (SETQ SNAME NIL))) (OR CNAME SNAME (PROGN (PRINTOUT T "NOT FOUND: " F T) NIL))) COLLECT (* ;  "Don't fiddle properties at all if file isn't found") (* ;  "Don't do DELDEF, cause it will remove it from FILES commands in other files") [FOR LST IN '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES COPYRIGHT) DO (/SETTOPVAL LST (REMOVE ROOTFNAME (GETTOPVAL LST] (/REMPROP ROOTFNAME 'FILE) (/REMPROP ROOTFNAME 'FILECHANGES) (/REMPROP ROOTFNAME 'FILEMAP) (/REMPROP ROOTFNAME 'FILEDATES) (IF CNAME THEN (LOAD CNAME LDFLG)) (IF SNAME THEN (IF CNAME THEN (OR (EQ LDFLG 'SYSLOAD) (LOADFROM SNAME)) ELSE (LOAD SNAME LDFLG))) (FOR X IN (FILEFNSLST ROOTFNAME) DO (/REMPROP X 'EXPR)) (/RPLACD (GETP ROOTFNAME 'FILE)) (APPEND (MKLIST CNAME) (MKLIST SNAME]) (LOADFOREDIT [LAMBDA NIL (* ;  "Edited 24-Apr-2018 14:23 by rmk:") (* ;  "Edited 24-Apr-2018 14:23 by rmk:") (* ;  "Edited 22-Apr-2018 13:25 by rmk:") (* ;  "Edited 14-Jun-2017 13:36 by kaplan") (CL:WHEN (GETD 'TEDIT) (FILESLOAD (SYSLOAD FROM VALUEOF (APPEND '({dsk}/project/lfg/tedit/) LISPUSERSDIRECTORIES)) OBJECTOUTOFTEDIT MATRIX SUPSUB BOXOBJ UID TMAX TMAXPATCHES DOC-OBJECTS SKETCH GRAPHER SKETCHPATCH) (* ; "UID needed by TMAXPATCHES") (FILESLOAD (SYSLOAD FROM VALUEOF LFGPARSERDIR) LFGDISPLAY LFG-FSIMAGEOBJ TREEOBJECT SETIPCHARWIDTH))]) (CLOSEI [LAMBDA NIL (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all inspector windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'INSPECTW.REPAINTFN (WINDOWPROP W 'REPAINTFN)) DO (CLOSEW W]) (CLOSES [LAMBDA NIL (* ;  "Edited 17-Jan-2020 10:53 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all SEDIT windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'SEDIT::REPAINTFN (WINDOWPROP W 'REPAINTFN)) DO (CLOSEW W]) (CLOSET [LAMBDA (ASKFORDIRTY) (* ;  "Edited 17-May-2020 11:16 by rmk:") (* ;  "Edited 22-Apr-2020 14:20 by rmk:") (* ;  "Edited 17-Mar-2020 23:00 by rmk:") (* ;  "Edited 16-Mar-2020 12:49 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all TEDIT windows, except sentence input window") (FOR W IN (OPENWINDOWS) WHEN (TEDITWINDOWP W) UNLESS (STRPOS "LFGINPUTWINDOW" (WINDOWPROP W 'TEDIT.TITLEMENUFN)) DO (CL:UNLESS ASKFORDIRTY (TEDIT.STREAMCHANGEDP (TEXTSTREAM W) T)) (CLOSEW W]) (NTEDITWINDOWS [LAMBDA NIL (* ;  "Edited 22-Apr-2020 14:21 by rmk:") (FOR W IN (OPENWINDOWS) COUNT (TEDITWINDOWP W]) (CLOSEG [LAMBDA NIL (* ;  "Edited 16-Mar-2020 12:49 by rmk:") (* ;  "Edited 27-Aug-2019 09:24 by rmk:") (* ;; "Close all grammar (rules, lexentries. templates, configs...) windows") (FOR W IN (OPENWINDOWS) WHEN (EQ 'STRUCTEDITOR.MENUFN (WINDOWPROP W 'TEDIT.TITLEMENUFN)) DO (CLOSEW W]) (CHANGED? [LAMBDA (NAME TYPE) (* ;  "Edited 5-Jul-2020 08:26 by rmk:") (* ;  "Edited 9-Jun-2020 23:25 by rmk:") (CL:UNLESS TYPE (SETQ TYPE (IF (AND (GETATOMVAL NAME) (NOT (GETD NAME))) THEN 'VARS ELSE 'FNS))) (LET ((FILE (WHEREIS NAME TYPE))) (IF (NULL FILE) THEN (PRINTOUT T NAME " as " TYPE " doesn't belong to a file" T) ELSEIF (CDR FILE) THEN (PRINTOUT T NAME " belongs to several files: " FILE ", not testing" T) ELSE (SETQ FILE (CAR FILE)) (LET [[CURRENT (GETDEF NAME TYPE NIL '(NOERROR NOCOPY] (FROMFILE (GETDEF NAME TYPE FILE '(NOERROR NOCOPY] (CL:WHEN (EQ TYPE 'FNS) (* ;; "Skip the file dates") [SETQ CURRENT `(,(CAR CURRENT) ,(CADR CURRENT) ,@(FOR FORM IN (CDDR CURRENT) UNLESS (EDITDATE? FORM) COLLECT FORM] [SETQ FROMFILE `(,(CAR FROMFILE) ,(CADR FROMFILE) ,@(FOR FORM IN (CDDR FROMFILE) UNLESS (EDITDATE? FORM) COLLECT FORM]) (IF (COMPARELST CURRENT FROMFILE T) THEN (PRINTOUT T NAME " has not changed") (CL:WHEN (MEMB NAME (GETP FILE 'FILE)) (PRINTOUT T ", removing it from " FILE " changes") [/RPLACD (GETP FILE 'FILE) (REMOVE NAME (GETP FILE 'FILE]) (CL:WHEN (AND (MEMB TYPE '(FNS FUNCTION)) (EXPRP NAME) (GETP NAME 'CODE)) (PRINTOUT T ", restoring compiled definition" T) (UNSAVEDEF NAME 'CODE)) (TERPRI T) (UNMARKASCHANGED NAME TYPE) 'SAME ELSE (PRINTOUT T NAME " has changed" T) (COMPARELISTS CURRENT FROMFILE T) 'DIFFERENT]) ) (ADDTOVAR TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147")) (DECLARE%: DONTEVAL@LOAD DOCOPY (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS)) (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES) ) (RPAQ DEFAULTPRINTINGHOST "") (RPAQQ DEFAULTPRINTERTYPE POSTSCRIPT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (FILEWATCH 'ON) ) (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)))) (ADDTOVAR PRETTYEQUIVLST (OPENLAMBDA . LAMBDA)) (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"))) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [(FNS INTERLISPMODE) [VARS (COMPILEIGNOREDECL T) (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (P (INTERLISPMODE)) (FNS LOCAL-INIT LoadPatches COLLECT-PATCH-FILES) (FUNCTIONS WITHOUT.PAGEHOLD) (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (LOCALPATCHDIRECTORY (CONCAT MEDLEYDIR "/patches")) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo")) (DIRECTORIES (APPEND (LIST LOCALPATCHDIRECTORY) LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (CUTEFLG T) (USERGREETFILES '(({DSK}/Users/ USER /Lisp/INIT.LCOM) ({DSK}/Users/ USER /Lisp/INIT.DFASL) ({DSK}/Users/ USER /Lisp/INIT] [VARS (*USEOLDFONTDIRECTORIES* NIL) [DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/displayfonts) (CONCAT MEDLEYDIR '/fonts/altofonts] [INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/ipfonts] (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR '/fonts/postscriptfonts] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (P (LOCAL-INIT)) (TEMPLATES WITHOUT.PAGEHOLD) (P (INTERLISPMODE)) (VARS (COMPILEIGNOREDECL T)) (COMMANDS cd cdd cdl cdll cdls cdlu cdm cdp phone pwd show) (FNS shell) (COMMANDS cdpg cdse cds cdsg) (VARS (DEFAULTFAXHOST) (DEFAULTCHATHOST) (DEFAULTCOPYRIGHTOWNER)) (ADDVARS (CHAT.ALLHOSTS) (FAXADDRESSES)) (P (LISTPUT IDLE.PROFILE 'ALLOWED.LOGINS NIL) (LISTPUT IDLE.PROFILE 'FORGET NIL) (LISTPUT IDLE.PROFILE 'TIMEOUT NIL)) (FNS INIT.SETUP FILE PPR PPV RELOAD LOADFOREDIT CLOSEI CLOSES CLOSET NTEDITWINDOWS CLOSEG CHANGED?) (ADDVARS (TEDIT.ABBREVS ("un" . "357,127") ("int" . "357,126") ("subset" . "357,131") ("superset" . "357,130") ("and" . "357,266") ("or" . "357,267") ("not" . "357,152") ("all" . "357,265") ("exist" . "357,264") ("def" . "357,162") ("compose" . "357,147"))) (DECLARE%: DONTEVAL@LOAD DOCOPY [P (* ;; "If Lisp sysout hasn't been updated with new code") (AND (ASSOC 'NS FONTDEFS) (FONTSET 'NS] (* ( (* ;; "Must be loaded before NSDISPLAYSIZES") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) VIRTUALKEYBOARDS))) (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) NSDISPLAYSIZES FILEBROWSER THINFILES)) (VARS (DEFAULTPRINTINGHOST "") (DEFAULTPRINTERTYPE 'POSTSCRIPT)) [DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "(FILES (SYSLOAD) UPCLISP MIME )") (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES) SAMEDIR COPYFILES COMPILEBANG WDWHACKS FILEWATCH WHO-LINE SETDEFAULTPRINTER) (P (FILEWATCH 'ON] (COMS (FILEPKGCOMS MACROS) (ALISTS (PRETTYEQUIVLST OPENLAMBDA))) [P (AND (GETD 'INSTALL-WHO-LINE-OPTIONS) (PROGN (SETQ *WHO-LINE-ANCHOR* '(:CENTER :TOP)) (INSTALL-WHO-LINE-OPTIONS))) (AND (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PPR FILE shell) (NLAML INIT.SETUP) (LAMA]) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA PPR FILE shell) (ADDTOVAR NLAML INIT.SETUP) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (4563 5388 (INTERLISPMODE 4573 . 5386)) (5490 9168 (LOCAL-INIT 5500 . 6237) (LoadPatches 6239 . 8187) (COLLECT-PATCH-FILES 8189 . 9166)) (11881 12397 (shell 11891 . 12395)) (13199 31687 ( INIT.SETUP 13209 . 19451) (FILE 19453 . 19878) (PPR 19880 . 20467) (PPV 20469 . 20673) (RELOAD 20675 . 24455) (LOADFOREDIT 24457 . 25656) (CLOSEI 25658 . 26008) (CLOSES 26010 . 26524) (CLOSET 26526 . 27981) (NTEDITWINDOWS 27983 . 28235) (CLOSEG 28237 . 28885) (CHANGED? 28887 . 31685))))) STOP \ No newline at end of file diff --git a/greetfiles/SIMPLE-INIT.~2~ b/greetfiles/SIMPLE-INIT.~2~ new file mode 100644 index 00000000..ce56e33b --- /dev/null +++ b/greetfiles/SIMPLE-INIT.~2~ @@ -0,0 +1 @@ +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "25-Nov-2020 18:29:03" {DSK}larry>ilisp>medley>greetfiles>SIMPLE-INIT.;2 4356 changes to%: (VARS SIMPLE-INITCOMS) (FNS shell FIXVERSION) (TEMPLATES WITHOUT.PAGEHOLD) previous date%: "24-Nov-2020 10:20:03" {DSK}larry>SIMPLE-INIT.;1) (PRETTYCOMPRINT SIMPLE-INITCOMS) (RPAQQ SIMPLE-INITCOMS [[VARS (MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR] (VARS (LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo/")) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))) [VARS (LOGINHOST/DIR (OR (UNIX-GETENV "LOGINHOST/DIR") "{DSK}")) (USERGREETFILES (LET ((BASE (CONCAT LOGINHOST/DIR "/INIT"))) (LIST (CONCAT BASE ".LCOM") (CONCAT BASE ".DFASL") BASE] [VARS (DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/dispplayfonts") (CONCAT MEDLEYDIR "/fonts/altofonts"))) (INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/ipfonts"))) (POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/postscriptfonts"] [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE] (COMMANDS cd pwd) (FNS shell) [P (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash")))] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA shell) (NLAML) (LAMA]) (RPAQ MEDLEYDIR (UNIX-GETENV 'MEDLEYDIR)) (RPAQ LISPUSERSDIRECTORIES (LIST (CONCAT MEDLEYDIR "/lispusers") (CONCAT MEDLEYDIR "/library") (CONCAT MEDLEYDIR "/internal/library"))) (RPAQ LISPSOURCEDIRECTORIES (LIST (CONCAT MEDLEYDIR "/sources"))) (RPAQ IRM.HOST&DIR (CONCAT MEDLEYDIR "/docs/dinfo/")) (RPAQ DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) (RPAQ LOGINHOST/DIR (OR (UNIX-GETENV "LOGINHOST/DIR") "{DSK}")) (RPAQ USERGREETFILES (LET ((BASE (CONCAT LOGINHOST/DIR "/INIT"))) (LIST (CONCAT BASE ".LCOM") (CONCAT BASE ".DFASL") BASE))) (RPAQ DISPLAYFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/dispplayfonts") (CONCAT MEDLEYDIR "/fonts/altofonts"))) (RPAQ INTERPRESSFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/ipfonts"))) (RPAQ POSTSCRIPTFONTDIRECTORIES (LIST (CONCAT MEDLEYDIR "/fonts/postscriptfonts"))) (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE)) (DEFCOMMAND cd (DIR) (/CNDIR DIR)) (DEFCOMMAND pwd NIL (DIRECTORYNAME T)) (DEFINEQ (shell [NLAMBDA LINE (* ;  "Edited 7-Sep-2020 13:28 by rmk:") [SETQ LINE (CONCATLIST (for X in LINE join (LIST X " "] (CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO) (ShellCommand LINE STREAM) (SETFILEPTR STREAM 0) (until (EOFP STREAM) collect (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL]) ) (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/WHEREIS.HASH")) (XCL::ADD-WHERE-IS-DATABASE (CONCAT MEDLEYDIR "/loadups/system.hash"))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA shell) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (3482 3998 (shell 3492 . 3996))))) STOP \ No newline at end of file