github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-25 12:05:41 +00:00
Code Issues Projects Releases Wiki Activity

Move pick to lispusers (#881)

Browse Source 
* Make PICK a Lispusers module

* PICK moved to lispusers, HCFILES moved to test repo (currently new/printing)

* redo PICK documentation

* Update documents and projects choices

* more testing and restore lost edits to TEDIT

* fix some typos
This commit is contained in:
Larry Masinter
2022-08-14 13:25:17 -07:00
committed by GitHub
parent d379bcc102
commit b90bf65be9
5 changed files with 96 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files

140
internal/MEDLEY-UTILS
View File

@@ -1,25 +1,17 @@
(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 " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
:CHANGES-TO (FNS HCFILES)
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
:PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{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 OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(DEFINEQ
(GATHER-INFO
@@ -130,24 +122,6 @@
(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"))
@@ -195,104 +169,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 (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
9367 . 10187)))))
STOP

BIN
internal/MEDLEY-UTILS.LCOM
View File

Binary file not shown.