Skip to content

Workaround added to (HCFILES) to close TEDIT files left open after breaks in OPENTEXTSTREAM. Temporary fix for HCFiles github action. #2282

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

Closed
wants to merge 1 commit into from
Closed

Workaround added to (HCFILES) to close TEDIT files left open after breaks in OPENTEXTSTREAM. Temporary fix for HCFiles github action. #2282

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
133 changes: 70 additions & 63 deletions internal/MEDLEY-UTILS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
(FILECREATED " 8-Sep-2025 14:27:53" {DSK}<home>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}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
:CHANGES-TO (FNS HCFILES)

:PREVIOUS-DATE "16-May-2025 15:37:36" {DSK}<home>frank>il>xmedley>internal>MEDLEY-UTILS.;1)


(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
Expand Down Expand Up @@ -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")
Expand All @@ -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")
Expand Down Expand Up @@ -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
Binary file modified internal/MEDLEY-UTILS.DFASL
View file
Open in desktop
Binary file not shown.