diff --git a/internal/MEDLEY-UTILS b/internal/MEDLEY-UTILS index 14fce7b99..8ef92d36c 100644 --- a/internal/MEDLEY-UTILS +++ b/internal/MEDLEY-UTILS @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-May-2025 15:37:36" {DSK}frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221 +(FILECREATED " 8-Sep-2025 14:27:53" {DSK}frank>il>xmedley>internal>MEDLEY-UTILS.;2 31479 - :CHANGES-TO (FNS MAKE-INDEX-HTMLS) + :EDIT-BY "FGH" - :PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}frank>il>qmedley>internal>MEDLEY-UTILS.;7) + :CHANGES-TO (FNS HCFILES) + + :PREVIOUS-DATE "16-May-2025 15:37:36" {DSK}frank>il>xmedley>internal>MEDLEY-UTILS.;1) (PRETTYCOMPRINT MEDLEY-UTILSCOMS) @@ -285,7 +287,8 @@ (DEFINEQ (HCFILES - [LAMBDA (BASE REDO SUBSETS) (* ; "Edited 30-Jun-2024 08:27 by lmm") + [LAMBDA (BASE REDO SUBSETS) (* ; "Edited 8-Sep-2025 14:20 by FGH") + (* ; "Edited 30-Jun-2024 08:27 by lmm") (* ; "Edited 23-Apr-2024 23:15 by lmm") (* ; "Edited 22-Apr-2024 13:22 by lmm") (* ; "Edited 5-Feb-2024 12:16 by lmm") @@ -305,60 +308,64 @@ do (SETQ BASE (pop DIRLIST)) (for SRCPATH in (DIRECTORY (CONCAT BASE "*.*;")) - do (PROG* [(SRC (UNPACKFILENAME SRCPATH)) - [EXT (U-CASE (LISTGET SRC 'EXTENSION] - (DIR (LISTGET SRC 'DIRECTORY)) - FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC] - (CL:FORMAT T "Starting on ~a :~%%" SRCPATH) - (CL:WHEN (DIRECTORYNAMEP SRCPATH) - - (* ;; "any directory names, push them off and do them in another phase") - - (CL:UNLESS (OR (STRPOS ">." NOV) - (INFILEP (CONCAT NOV ".skip"))) - (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH))) - (RETURN)) - (CL:WHEN - (MEMB EXT - '(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT ALL - DATABASE)) - - (* ;; "ignore any of these extensions") - - (RETURN)) - - (* ;; - " doesnt (yet) implement / to - translattion. .readme should show up as -.readme.") - - (SETQ DEST (CONCAT NOV ".pdf")) - (CL:WHEN (AND (NOT REDO) - (INFILEP DEST)) - (CL:FORMAT T "~a already there~%%" DEST) - (RETURN)) - (CL:WHEN (INFILEP (CONCAT DEST ".skip")) - (PRINTOUT T "Explicit .skip " DEST T) - (RETURN)) - (if (MEMB 'TEDIT PHASES) - then (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO)) - (CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH] - (if (EQ REDO 'TEST) - then (CL:FORMAT T "Testing open ~a..." SRCPATH) - (CLOSEF? (OPENTEXTSTREAM SRCPATH)) - else (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH) - ) - (TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL - NIL 'PDF] - (PRINT 'FAIL T))) - (CL:FORMAT T "DONE"))) - (CL:WHEN (AND (MEMB 'PRETTY PHASES) - (MEMB EXT '(NIL IL)) - [SETQ LSFP (CAR (NLSETQ (LISPSOURCEFILEP SRCPATH] - (NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*)) - (PRINTOUT T "PDF printing " " to " DEST "...") - (OR (NLSETQ (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST)) - (PRETTYFILEINDEX SRCPATH NIL STR))) - (PRINT 'FAIL T)) - (PRINTOUT T "DONE" T))]) + do + (PROG* [(SRC (UNPACKFILENAME SRCPATH)) + [EXT (U-CASE (LISTGET SRC 'EXTENSION] + (DIR (LISTGET SRC 'DIRECTORY)) + FRDY LDGP DEST (NOV (PACKFILENAME `(VERSION NIL ,@SRC] + (CL:FORMAT T "Starting on ~a :~%%" SRCPATH) + (CL:WHEN (DIRECTORYNAMEP SRCPATH) + + (* ;; "any directory names, push them off and do them in another phase") + + (CL:UNLESS (OR (STRPOS ">." NOV) + (INFILEP (CONCAT NOV ".skip"))) + (SETQ DIRLIST (NCONC1 DIRLIST SRCPATH))) + (RETURN)) + (CL:WHEN + (MEMB EXT '(PDF SKIP HTML LCOM DFASL SH SYSOUT DRIBBLE IMPTR DISPLAYFONT ALL + DATABASE)) + + (* ;; "ignore any of these extensions") + + (RETURN)) + + (* ;; " doesnt (yet) implement / to - translattion. .readme should show up as -.readme.") + + (SETQ DEST (CONCAT NOV ".pdf")) + (CL:WHEN (AND (NOT REDO) + (INFILEP DEST)) + (CL:FORMAT T "~a already there~%%" DEST) + (RETURN)) + (CL:WHEN (INFILEP (CONCAT DEST ".skip")) + (PRINTOUT T "Explicit .skip " DEST T) + (RETURN)) + (if (MEMB 'TEDIT PHASES) + then + (CL:WHEN [OR (MEMB EXT '(TEDIT TED SKETCH BRAVO)) + (CAR (NLSETQ (TEDIT.FORMATTEDFILEP SRCPATH] + (if (EQ REDO 'TEST) + then (CL:FORMAT T "Testing open ~a..." SRCPATH) + (CLOSEF? (OPENTEXTSTREAM SRCPATH)) + else (OR (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)) + (TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL NIL + 'PDF] + (for OPENSTREAM in (OPENP) + do (if (EQUAL (FULLNAME OPENSTREAM) + (FULLNAME SRCPATH)) + then (CLOSEF OPENSTREAM)) + finally (RETURN NIL))) + (PRINT 'FAIL T))) + (CL:FORMAT T "DONE"))) + (CL:WHEN (AND (MEMB 'PRETTY PHASES) + (MEMB EXT '(NIL IL)) + [SETQ LSFP (CAR (NLSETQ (LISPSOURCEFILEP SRCPATH] + (NEQ LSFP *COMMON-LISP-READ-ENVIRONMENT*)) + (PRINTOUT T "PDF printing " " to " DEST "...") + (OR (NLSETQ (CL:WITH-OPEN-STREAM (STR (OPEN-PDF-STREAM DEST)) + (PRETTYFILEINDEX SRCPATH NIL STR))) + (PRINT 'FAIL T)) + (PRINTOUT T "DONE" T))]) (MAKE-INDEX-HTMLS [LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm") @@ -550,9 +557,9 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS -7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 ( -MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940)) -(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE -26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033))))) + (FILEMAP (NIL (1099 12988 (GATHER-INFO 1109 . 6491) (MAKE-FULLER-DB 6493 . 7402) (MAKE-INDEX-HTMLS +7404 . 12357) (MEDLEY-FIX-LINKS 12359 . 12752) (MEDLEY-FIX-DATES 12754 . 12986)) (14167 16955 ( +MAKE-EXPORTS-ALL 14177 . 15236) (MAKE-WHEREIS-HASH 15238 . 16427) (MAKE-WHEREIS-LOOPS 16429 . 16953)) +(16956 26431 (HCFILES 16966 . 21474) (MAKE-INDEX-HTMLS 21476 . 26429)) (26681 31293 (RECOMPILE-ONE +26691 . 28588) (RECMPL 28590 . 29193) (COMPILE-SETUP 29195 . 29819) (REMAKEFILES 29821 . 31291))))) STOP diff --git a/internal/MEDLEY-UTILS.DFASL b/internal/MEDLEY-UTILS.DFASL index 405c8cc70..e5730f841 100644 Binary files a/internal/MEDLEY-UTILS.DFASL and b/internal/MEDLEY-UTILS.DFASL differ