From 2f7041ba2e60f9a667f747846c241e8fe610d06b Mon Sep 17 00:00:00 2001 From: Frank Halasz Date: Mon, 8 Sep 2025 15:55:59 -0700 Subject: [PATCH] Add workaround to (HCFILES) to close TEDIT files left open after errors in OPENTEXTSREAM cause premature exit without properly closing the underlying open file stream. This works around failures in HCFILES, especially when run in github actions. Will remove this workaround when bug is fixed in OPENTEXTSTREAM. --- internal/MEDLEY-UTILS | 133 +++++++++++++++++++----------------- internal/MEDLEY-UTILS.DFASL | Bin 20056 -> 20195 bytes 2 files changed, 70 insertions(+), 63 deletions(-) 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 405c8cc7058fad5c7d81206ab4a0a276574ee9a7..e5730f841fd00f990116e51485cf634d863f3d91 100644 GIT binary patch delta 1656 zcmZvcS!^3s6o%*C@sdPc5|iS@Sr{iKwN1S5CKS2xIB^(zT#vJWD!GYk8birq1r&ZLiXoYy3!r%ZOM-No6Q ze!Iu-a@2(alCTqtOimmheYTtPa+sb;KQ)%la-^r5HhKMaS83%#wsAK%l#{9H2Ebmv zBs+2d`mE(z%`yvpw(>`9clImv=NN|FKo?D3a1m{o3?PS8=9inSObPxZswNrysUu(K zl_Yfot(YH>6ZI~-ZMHTNl|4b~k5Fo<1bUF((%K)@WN7bjOw+)sL~eD0)h4?t(OSZe zYm)61+I3Fp1LLbIs()V;+vmnrV5!7>AE;(NXh(TVGgo4k8|oX6k=EfI#%j@sjo(36 zET+T`BRw`s?nC0f_XQpYW3k=O%J0cn~j@QTA0$`aiN}pU4`>`dBAG7+2H+HvQi=rbtq%g<~j?D z`8~#{An}PKAtBIbEQ+uLBm0f9xY*0{K~rx);w2;060pjdh62JMk3p`8Uk-2;-bdr- zu${&)U>l8J!WL{)C&u_Fp2r6wu=&3=tgxv#0@cNHXw&v*%fV_JtEcfQYrvRHkU}xm zi0T|Va1dD>O@^Da`d#sfc^i2p*Nammd|I3)VT~4pM4m!Z4s}kf=6kEbUkzp&;BVx9 zLRgAP;$Xa&4}}FjhCAVB#DtkAa&=q2Pvu`Edtqw|d?;pPgZu~uW*}K;j%cPrX6woo-x!2GZ@IH4g8vqM P123Z6k!kkLyLbNuX#3A7 delta 1578 zcmZuvUrbw77{BM-QUn=WYjx1kQU-z)ZfWT)y|9L?qqnr>_TJLlS^vb<3d~lJ0@+Lk zC>uVxbP3y$*_&)H#y<}xX4p+-K7ff2bCMVnHQSRhn&=iadzmrWGCb#0=}2gre!ug5 zzu)is&gu8dMR4N+SULcv&-$#-3Ds)u_{_+d?Pzvl%r-JJmOeH%YIF5)(ew$f+u7~0 zxjcPtZ=buTI_OuW?X=)bb~JsW6Vq*&ZXke*BN`^@wlh`(qR!3E$tfK18@yC(D*gnN8@#9rtuqC z|Nl&G6zP7juccIGpQP~`+ltFNNe#x>HZP`B4Lwn^E zM;7lbZHk0NZJLDFXfZ&bn@q06M45{Pf*gJU(H|xGM=29-mcrkqaJv*fA{r^I##E%| zYq>XR+f!HtkC$PV!h0n9!d5$IMzee;___EY?*$MyCUZA5i1^+*! zco0Rr60o3my!-1a3VGJyaNsn&gY~v!IUB*hqVK$>w)0eWmn7aOAb1kb1L=Fg(Q+@? zg=z#x)we85*&E2}HA7xNDZvif&}qQ}HqeB({SjDEazi(T7H}6m5as}bW_v#cw~?#Q zR70PDStGrgi^F{{LFjQ7ulS-Y^tg(;gY)|O_!9*L@EF7fDtPO(X$s>=3#M3?Q$Y8E zEv6J+I=aWzWUopqRqPlPz^)Xl*PdZ3spbfp3f1Y@K@VR%6KVyOba~a4K;yOv13Sr^|KIAgE`31IM0+~3N1yOG4*ovDp*80d78bjx%n?8 C2e_C3