From 5445a12b7e6e803322cf8715fb30401f4a3f633a Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 12 Jan 2022 15:06:10 -0800 Subject: [PATCH] phase 0 of GATHER-INFO is setup for rest --- internal/library/MEDLEY-UTILS | 105 ++++++++++++++--------------- internal/library/MEDLEY-UTILS.LCOM | Bin 5569 -> 5533 bytes 2 files changed, 49 insertions(+), 56 deletions(-) diff --git a/internal/library/MEDLEY-UTILS b/internal/library/MEDLEY-UTILS index c292f4a4..b2d0df42 100644 --- a/internal/library/MEDLEY-UTILS +++ b/internal/library/MEDLEY-UTILS @@ -1,43 +1,41 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "25-Oct-2021 14:54:43" |{DSK}larry>medley>internal>library>MEDLEY-UTILS.;14| 9472 +(FILECREATED "26-Dec-2021 18:58:43" |{DSK}larry>medley>internal>library>MEDLEY-UTILS.;2| 9049 - |changes| |to:| (VARS MEDLEY-UTILSCOMS) - (FNS GATHER-INFO) + :CHANGES-TO (FNS GATHER-INFO) - |previous| |date:| "23-Oct-2021 14:53:16" -|{DSK}larry>medley>internal>library>MEDLEY-UTILS.;2|) + :PREVIOUS-DATE "25-Oct-2021 14:54:43" |{DSK}larry>medley>internal>library>MEDLEY-UTILS.;1| +) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) (RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) - (VARS MEDLEY-FIX-DIRS) - (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) + (VARS MEDLEY-FIX-DIRS) + (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (DEFINEQ (GATHER-INFO (LAMBDA (PHASE) (* \; - "Edited 24-Oct-2021 09:43 by larry") + "Edited 26-Dec-2021 18:56 by larry") + (* \; + "Edited 24-Oct-2021 09:43 by larry") (SELECTQ PHASE - (ALL (SETQ SYSFILES (UNION SYSFILES FILELST)) - (SETQ FILELST NIL) - (FILESLOAD (SOURCE) - SYSEDIT) - (|for| I |from| 1 |to| 4 |do| (GATHER-INFO I))) - (1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD - X - 'NAME))) + (ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I))) + (0 (SETQ SYSFILES (UNION SYSFILES FILELST)) + (SETQ FILELST NIL) + (FILESLOAD (SOURCE) + SYSEDIT)) + (1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD X 'NAME))) (FILESLOAD FILESETS) (SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X)))) (SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T)) |when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION) - '(LCOM DFASL TEDIT TXT))) + '(LCOM DFASL TEDIT TXT))) |collect| (FILENAMEFIELD X 'NAME)))) (-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: " (|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES) - (FMEMB X FILELST))) - |collect| X) + (FMEMB X FILELST))) |collect| X) T) (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES LOADEDFILES)) @@ -52,50 +50,45 @@ DEFD)) (|for| X |in| DEFINEDFNS |when| (CCODEP X) |do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X)))) - (|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY) - |as| VAL |in| Y - |do| (|for| S |in| VAL - |do| (PUTPROP S REV (CONS X (GETPROP S REV))))))) + (|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY) + |as| VAL |in| Y |do| (|for| S |in| VAL + |do| (PUTPROP S REV (CONS X (GETPROP S REV))))))) (SETQ CALLEDFNS NIL) (MAPATOMS (FUNCTION (LAMBDA (X) (|if| (AND (NOT (GETD X)) - (GETPROP X 'CALLED-BY)) + (GETPROP X 'CALLED-BY)) |then| (CL:PUSH X CALLEDFNS)))))) (-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T)) (3 (|for| X |in| SYSFILES - |do| - (LOAD X 'PROP) - (PUTPROP X 'CONTENT (READFILE X)) - (|for| EXR |in| (GETPROP X 'CONTENT) - |do| (SELECTQ (CAR EXR) - (DEFINEQ (|for| DFN |in| (CDR EXR) - |do| (|if| (EQUAL (CADR DFN) - (GETPROP (CAR DFN) - 'EXPR)) - |then| (PRINTOUT T (CAR DFN) - " ") - (PUTPROP (CAR DFN) - 'EXPR - (CADR DFN)) - |else| (PRINTOUT T (CAR DFN) - "* ")))) - NIL))) - (SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP - X - 'CONTENT)))) + |do| (LOAD X 'PROP) + (PUTPROP X 'CONTENT (READFILE X)) + (|for| EXR |in| (GETPROP X 'CONTENT) + |do| (SELECTQ (CAR EXR) + (DEFINEQ (|for| DFN |in| (CDR EXR) + |do| (|if| (EQUAL (CADR DFN) + (GETPROP (CAR DFN) + 'EXPR)) + |then| (PRINTOUT T (CAR DFN) + " ") + (PUTPROP (CAR DFN) + 'EXPR + (CADR DFN)) + |else| (PRINTOUT T (CAR DFN) + "* ")))) + NIL))) + (SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP X 'CONTENT)))) (* \; " don't edit with SEDIT") (LET (DUPS) (|for| X |in| SYSFILES |do| (|for| FN |in| (FILEFNSLST X) - |do| (|if| (GETPROP FN 'WHEREIS) - |then| (NCONC1 (GETPROP FN 'WHEREIS) - X) - (OR (FMEMB FN DUPS) - (SETQ DUPS (CONS FN DUPS))) - |else| (PUTPROP FN 'WHEREIS (LIST X))))) + |do| (|if| (GETPROP FN 'WHEREIS) + |then| (NCONC1 (GETPROP FN 'WHEREIS) + X) + (OR (FMEMB FN DUPS) + (SETQ DUPS (CONS FN DUPS))) + |else| (PUTPROP FN 'WHEREIS (LIST X))))) (SETQ DUPFNS DUPS)) - (SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) - |collect| X))) + (SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) |collect| X))) (-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T) (PRINTOUT T "Functions on more than one file: " DUPFNS T)) (4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE) @@ -104,7 +97,7 @@ SYSEDIT) (|for| X |in| SYSFILES |do| (MSNOTICEFILE X)) (|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T) - (MASTERSCOPE `(ANALYZE ON ,(KWOTE X))))) + (MASTERSCOPE `(ANALYZE ON ,(KWOTE X))))) (-4 "No queries yet") (HELP)))) @@ -124,7 +117,7 @@ ) (RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles" - "docs>Documentation Tools")) + "docs>Documentation Tools")) (DEFINEQ (MAKE-EXPORTS-ALL @@ -157,6 +150,6 @@ (DRIBBLE)))) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049 - . 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447))))) + (FILEMAP (NIL (553 7001 (GATHER-INFO 563 . 6103) (MEDLEY-FIX-LINKS 6105 . 6628) (MEDLEY-FIX-DATES 6630 + . 6999)) (7155 9026 (MAKE-EXPORTS-ALL 7165 . 8181) (MAKE-WHEREIS-HASH 8183 . 9024))))) STOP diff --git a/internal/library/MEDLEY-UTILS.LCOM b/internal/library/MEDLEY-UTILS.LCOM index 4b376dc9b68d78921a6f83cea361f2642f3a79cd..b26edd4b066cb9540c8ae52a34d2a6c034d8de92 100644 GIT binary patch delta 232 zcmX@8Jy&}|kg%DqOKP&Nk%5t+f}w?#sfCq^*~CQ&>b?_m(kYLs7Arkz{FC4%gWiq(a+sASU1F9LBq{2Si#*f#KSd6*VE6< jUsJ&MLjCK8!OLUD4j0_bFO{`2!tqd$Do|KVwcMS1x z4bt`WbMsfI$;_)!P;v|P@lh}`0x6%wD6Rn4Wn^S!Xli9>uB6GO;pXY%>Kx?i7~<+O zc@Lw+WPe7BdZ0ZDmL}##3S2eG8Hsu6sl_!4H6{60H3}MGjzPf+zOF7lu93Q-A)Y?L z&i=l^nhF|je!&Vz4$xGnDJV)U%giqYX-!EiNd;=gaJjLSp_vlUl4_S=?^>IT{M=N# RoW!D{$?=R@oB5gggaM=ENPYkS