Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

set up list for classifying files without moving them -- for gather-info #891

Closed
wants to merge 1 commit into from
Closed

set up list for classifying files without moving them -- for gather-info #891

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
285 changes: 117 additions & 168 deletions internal/MEDLEY-UTILS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,53 +1,57 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;9| 15959
(FILECREATED "12-Aug-2022 10:11:51" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;3| 12120

:CHANGES-TO (FNS HCFILES)
:CHANGES-TO (FNS GATHER-INFO MAKE-FULLER-DB)
(VARS MEDLEY-UTILSCOMS)

:PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
:PREVIOUS-DATE " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)


(PRETTYCOMPRINT MEDLEY-UTILSCOMS)

(RPAQQ MEDLEY-UTILSCOMS
((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)

(* |;;| "hardcopy files")

(FNS HCFILES BADFILE)
(INITVARS (HCFILES)
(BADFILES))
(COMMANDS "pick")))
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
(VARS MEDLEY-FIX-DIRS CHECKEDFILES)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(DEFINEQ

(GATHER-INFO
(LAMBDA (PHASE) (* \; "Edited 26-Dec-2021 18:56 by larry")
(* \; "Edited 24-Oct-2021 09:43 by larry")
(LAMBDA (PHASE) (* \; "Edited 12-Aug-2022 10:09 by lmm")
(SELECTQ PHASE
(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)))
|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)
T)
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
LOADEDFILES))
T)
(PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES
LOADEDFILES)
T))
(1 (SETQ FILESTATUS (COPY CHECKEDFILES)) (* \;
 " Start with manual cultivated lispusers/library")
(* \; " uaing FILESTATUS")
(FOR X IN FILESETS
DO (FOR Y IN (EVAL X) |do| (CL:PUSH (CDR (OR (ASSOC Y FILESTATUS)
(CAR (CL:PUSH (LIST Y)
FILESTATUS))))
X))) (* \; "add the 0LISPSET etc")
(|for| DIR |in| '(SOURCES LIBRARY LISPUSERS GREETFILES ROOMS DOCTOOLS)
DO (LET (NAME (FILING.ENUMERATION.DEPTH T))
(|for| F |in| (DIRECTORY (MEDLEYDIR DIR "*.;" T T))
|do| (CL:PUSH DIR (CDR (OR (ASSOC (SETQ F (FILENAMEFIELD F 'NAME))
FILESTATUS)
(CAR (CL:PUSH (LIST F)
FILESTATUS))))))))
(|for| X |in| LOADEDFILELST |do| (CL:PUSH 'LOADED
(CDR (OR (ASSOC (SETQ X (FILENAMEFIELD
X
'NAME))
FILESTATUS)
(CAR (CL:PUSH (LIST X)
FILESTATUS)))))))
(-1 (FOR X IN FILESTATUS |do| (CL:WHEN (AND (MEMB 'LOADED X)
(NOT (OR (MEMB (CAR X)
SYSFILES)
(MEMB (CAR X)
FILELST))))
(CL:FORMAT T "~S loaded not in SYSFILES or FILELST ~n"
(CAR X)))))
(2 (SETQ DEFINEDFNS (LET ((DEFD NIL))
(MAPATOMS (FUNCTION (CL:LAMBDA (X)
(CL:WHEN (GETD X)
Expand All @@ -64,7 +68,7 @@
(GETPROP X 'CALLED-BY))
|then| (CL:PUSH X CALLEDFNS))))))
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
(3 (|for| X |in| SYSFILES
(3 (|for| X |in| SYSFILES WHEN (FINDFILE X)
|do| (LOAD X 'PROP)
(PUTPROP X 'CONTENT (READFILE X))
(|for| EXR |in| (GETPROP X 'CONTENT)
Expand Down Expand Up @@ -107,13 +111,14 @@
(HELP))))

(MAKE-FULLER-DB
(LAMBDA NIL (* \; "Edited 16-Jul-2022 22:07 by larry")
(LAMBDA NIL (* \; "Edited 12-Aug-2022 10:02 by lmm")
(* \; "Edited 16-Jul-2022 22:07 by larry")
(* \; "Edited 20-Jun-2022 17:23 by larry")
(FILESLOAD (SOURCE)
FILESETS)
(DRIBBLE (MEDLEYDIR "tmp" "fuller.dribble" T T))
(DOFILESLOAD (SUBSET (APPEND OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
'FINDFILE))
(DOFILESLOAD (FOR X IN CHECKEDFILES WHEN (MEMB 'OK (CDR X)) WHEN (FINDFILE (CAR X))
COLLECT (CAR X)))
(GATHER-INFO 'ALL)
(MASTERSCOPE '(WHO CALLS XYZZY))
(DUMPDATABASE NIL (MKATOM (MEDLEYDIR "tmp" "fuller.database" T T)))
Expand All @@ -130,42 +135,82 @@
(MEDLEY-FIX-DATES
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))

(PICK
(LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry")
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
(NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT))))
(ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
"gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
))))
(STR (OPENTEXTSTREAM)))
(|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
|do| (CL:FORMAT STR "~a~&" S)
|finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a"
ISSUE))))))
(DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
(FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR)))))
(PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
(ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
(HELP TYPE "Unknown type"))))
)

(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))

(RPAQQ OKSOURCES (RENAMEFNS VMEM READSYS CASH-FILE HASH-FILE MEDLEYDIR MAKEINIT))

(RPAQQ OKLIBRARY
(POSTSCRIPTSTREAM CHATTERMINAL DMCHAT CHAT PRESS READNUMBER EDITBITMAP IMAGEOBJ TEDIT HRULE
TABLEBROWSER FILEBROWSER GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MSCOMMON
MASTERSCOPE UNIXCOMM UNIXPRINT UNICODE HASH CLIPBOARD UNIXCHAT VT100KP VTCHAT SKETCH
SKETCHBMELT SCALEBITMAP SKETCHOBJ SKETCHEDIT SKETCHELEMENTS SKETCHOPS MATMULT SAMEDIR))

(RPAQQ OKLISPUSERS (THINFILES ISO8859IO DINFO HELPSYS MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE
BACKGROUND-YIELD OBJECTWINDOW REGIONMANAGER COMPARETEXT EXAMINEDEFS
COMPARESOURCES COMPAREDIRECTORIES PSEUDOHOSTS DATEFORMAT-EDITOR DOC-OBJECTS
EQUATIONS BICLOCK FILEWATCH LIFE IDLEHAX GITFNS TMAX IMTOOLS))

(RPAQQ OKINTERNAL (MEDLEY-UTILS))
(RPAQQ CHECKEDFILES
((POSTSCRIPTSTREAM OK)
(CHATTERMINAL OK)
(DMCHAT OK)
(CHAT OK)
(PRESS OK)
(READNUMBER OK)
(EDITBITMAP OK)
(IMAGEOBJ OK)
(TEDIT OK)
(HRULE OK)
(TABLEBROWSER OK)
(FILEBROWSER OK)
(GRAPHER OK)
(SPY OK)
(WHERE-IS OK)
(COPYFILES OK)
(MSANALYZE OK)
(MSPARSE OK)
(MSCOMMON OK)
(MASTERSCOPE OK)
(UNIXCOMM OK)
(UNIXPRINT OK)
(UNICODE OK)
(HASH OK)
(CLIPBOARD OK)
(UNIXCHAT OK)
(VT100KP OK)
(VTCHAT OK)
(SKETCH OK)
(SKETCHBMELT OK)
(SCALEBITMAP OK)
(SKETCHOBJ OK)
(SKETCHEDIT OK)
(SKETCHELEMENTS OK)
(SKETCHOPS OK)
(MATMULT OK)
(SAMEDIR OK)
(THINFILES OK)
(ISO8859IO OK)
(DINFO OK)
(HELPSYS OK)
(MODERNIZE OK)
(WHEELSCROLL OK)
(PRETTYFILEINDEX OK)
(WHO-LINE OK)
(BACKGROUND-YIELD OK)
(OBJECTWINDOW OK)
(REGIONMANAGER OK)
(COMPARETEXT OK)
(EXAMINEDEFS OK)
(COMPARESOURCES OK)
(COMPAREDIRECTORIES OK)
(PSEUDOHOSTS OK)
(DATEFORMAT-EDITOR OK)
(DOC-OBJECTS OK)
(EQUATIONS OK)
(BICLOCK OK)
(FILEWATCH OK)
(LIFE OK)
(IDLEHAX OK)
(GITFNS OK)
(TMAX OK)
(IMTOOLS OK)
(RENAMEFNS OK)
(VMEM OK)
(READSYS OK)
(CASH-FILE OK)
(HASH-FILE OK)
(MEDLEYDIR OK)
(MAKEINIT OK)
(MEDLEY-UTILS OK)))
(DEFINEQ

(MAKE-EXPORTS-ALL
Expand Down Expand Up @@ -195,104 +240,8 @@
(RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
(DRIBBLE))))
)



(* |;;| "hardcopy files")

(DEFINEQ

(HCFILES
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 17-Jul-2022 12:44 by larry")
(* \; "Edited 21-Jun-2022 22:59 by larry")
(* \; "Edited 31-May-2022 09:31 by larry")
(* \; "Edited 20-Feb-2022 12:16 by larry")
(* \; "Edited 21-Aug-2021 20:56 by larry")
(DECLARE (SPECVARS TFILE))
(|if| (NULL TFILE)
|then| (SETQ TFILE MEDLEYDIR))
(COND
((DIRECTORYNAMEP TFILE)

(* |;;| "canonicalize")

(SETQ TFILE (DIRECTORYNAME TFILE))
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
(CL:UNLESS DEST
(|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
"/tmp/psfiles/"))
(SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))

(* |;;| "first deal with files in this directory")

(FOR EXT IN '("TED*" "SKETCH" "T*XT")
DO (|for| X |in| (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
|do| (HCFILES X DEST REDOFLG TOPDIRLEN)))

(* |;;| " then deal with subdirs ")

(|for| X |in| (DIRECTORY (CONCAT TFILE "*"))
|when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X))))
|when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
((SETQ TFILE (INFILEP TFILE))
(LET* ((TF (UNPACKFILENAME.STRING TFILE))
(NAME (LISTGET TF 'NAME))
(DIR (LISTGET TF 'DIRECTORY))
(PSFILE (PACKFILENAME.STRING
'EXTENSION
(|if| (EQ REDOFLG 'IP)
|then| "IP"
|else| "PS")
'NAME
(|if| (EQ DEST T)
|then| (* \; "with the tedit file")
NAME
|else| (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
)
-1))))
"-" NAME))
'HOST
(LISTGET TF 'HOST)
'DIRECTORY
(|if| (EQ DEST T)
|then| DIR
|else| DEST)))
(TEXTSTREAM))
(|if| (AND (NOT REDOFLG)
(INFILEP PSFILE))
|then| (* \; " do nothing")
(PRINTOUT T PSFILE " already there" T)
|elseif| (EQ REDOFLG 'TEST)
|then| (PRINTOUT T TFILE "-> " PSFILE T)
(CLOSEF (OPENTEXTSTREAM TFILE))
ELSEIF (MEMBER TFILE BADFILES)
THEN (PRINTOUT T "Skipping " TFILE " on BADFILES")
|else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP)
|then| 'INTERPRESS
|else| 'POSTSCRIPT))
(|printout| T " DONE" T)
(CLOSEF? TEXTSTREAM))))
(T (PRINTOUT T "no such file " T)))))

(BADFILE
(LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry")
(PUSHNEW BADFILES TFILE)
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
(SETFILEPTR STR -1)
(PRINT TFILE STR)
(CLOSEF STR))
(RETFROM 'HCFILES)))
)

(RPAQ? HCFILES )

(RPAQ? BADFILES )

(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841
. 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710
) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827)))))
(FILEMAP (NIL (621 8549 (GATHER-INFO 631 . 7070) (MAKE-FULLER-DB 7072 . 7904) (MEDLEY-FIX-LINKS 7906
. 8303) (MEDLEY-FIX-DATES 8305 . 8547)) (10304 12097 (MAKE-EXPORTS-ALL 10314 . 11273) (
MAKE-WHEREIS-HASH 11275 . 12095)))))
STOP
Binary file modified internal/MEDLEY-UTILS.LCOM
View file
Open in desktop
Binary file not shown.
19 changes: 5 additions & 14 deletions sources/LOADUP-FULL
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,25 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "14-Jul-2022 12:33:11" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;6 4656
(FILECREATED "12-Aug-2022 11:14:26" {DSK}<home>larry>medley>sources>LOADUP-FULL.;2 4412

:CHANGES-TO (FNS LOADUP-FULL)
:CHANGES-TO (VARS LOADUP-FULLCOMS)

:PREVIOUS-DATE "12-Jul-2022 21:57:39"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;5)
:PREVIOUS-DATE "14-Jul-2022 12:33:11" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)


(PRETTYCOMPRINT LOADUP-FULLCOMS)

(RPAQQ LOADUP-FULLCOMS ((COMMANDS "cd" "pwd" "ls")
(FNS LOADFULLFONTS LOADUP-FULL FIXMETA)
(RPAQQ LOADUP-FULLCOMS ((FNS LOADFULLFONTS LOADUP-FULL FIXMETA)
(P (FIXMETA))))

(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))

(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))

(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
(DEFINEQ

(LOADFULLFONTS
Expand Down Expand Up @@ -95,5 +86,5 @@

(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (693 4618 (LOADFULLFONTS 703 . 2144) (LOADUP-FULL 2146 . 4368) (FIXMETA 4370 . 4616)))))
(FILEMAP (NIL (449 4374 (LOADFULLFONTS 459 . 1900) (LOADUP-FULL 1902 . 4124) (FIXMETA 4126 . 4372)))))
STOP
Binary file modified sources/LOADUP-FULL.LCOM
View file
Open in desktop
Binary file not shown.
Loading