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

Fix Issue 2139 (large parts of Medley tree not showing up in files.interlisp.org) and more improvements to files.interlisp.org (#2156)

Browse Source 
Here is what this PR does:

Fix Issue 2139: (MAKE-INDEX-HTMLS) was not handling pseudohosts correctly and an errant LI pseudohost was causing MAKE-INDEX-HTMLS to terminate early. Adjusted MAKE-INDEX-HTML so it uses psuedohosts only for the top level directory and everything further down in the tree uses the truenames relative to the top-level pseudohost, Results in a MAKE-INDEX-HTMLS run that works in the presence of random pseudohosts and in a collection of index.html files without difficult to understand and out of context references to pseudohosts.

Remove loadups/build directory from all HCFILES runs (on desktop and via github actions)

Added maiko source code and removed maiko lde executables from HCFILES outputs for github actions - thus adding maiko code and removing maiki executables @ files.interlisp.org.

Fixed scripts/clean_hcfiles.sh so that it actually cleans off all of the index.html files - was missing some.

.github/workflow directory was being left out of HCFILES. Put it back it.
This commit is contained in:
Frank Halasz
2025-05-26 10:18:10 -07:00
committed by GitHub
parent 9dc408c81a
commit 04d98d232f
5 changed files with 174 additions and 142 deletions
Download Patch File Download Diff File Expand all files Collapse all files

298
internal/MEDLEY-UTILS
View File

@@ -1,12 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 08:53:43" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;2 30243
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
:EDIT-BY "lmm"
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
:CHANGES-TO (FNS MAKE-FULLER-DB)
:PREVIOUS-DATE "14-Jul-2024 12:51:12" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;1)
:PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -128,79 +126,89 @@
"Welcome to Fuller sysout"])
(MAKE-INDEX-HTMLS
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
(* ; "Edited 26-Apr-2024 16:15 by lmm")
(* ; "Edited 20-Apr-2024 12:34 by lmm")
(* ; "Edited 13-Apr-2024 21:18 by lmm")
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
(* ; "Edited 13-Apr-2024 21:18 by lmm")
(* ; " Edited 16-May-2025 13:17 by fgh")
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
(OR (DIRECTORYNAMEP BASE)
(ERROR BASE "not a directory name"))
(OR (AND (NUMBERP LEVEL)
(IGREATERP LEVEL 0))
(SETQ LEVEL 1))
(LET* ((SUBDIRS NIL)
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
(RESETLST
(if (EQ LEVEL 1)
then (RESETSAVE (PSEUDOHOSTS T))
(PSEUDOHOST ROOT.NAME BASE))
(SETQ BASE (PSEUDOFILENAME BASE))
[LET*
((SUBDIRS NIL)
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
DO (IF (EQ (NTHCHAR FULLNAME -1)
'>)
THEN
(* ;; "A directory")
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
do (if (EQ (NTHCHAR FULLNAME -1)
'>)
then
(* ;; "A directory")
(IF (NOT (DIRECTORYNAMEP FULLNAME))
THEN (HELP "NOT DIRNAME"))
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
(+ (NCHARS BASE)
(IF PSEUDOHOST
THEN 2
ELSE 1))
-2)))
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
(STRPOS ".git" FULLNAME)
(INFILEP (CONCAT FULLNAME ".skip")))
(if (NOT (DIRECTORYNAMEP FULLNAME))
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
(+ (NCHARS BASE)
(if PSEUDOHOST
then 2
else 1))
-2)))
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
(MEMB SHORTNAME '(.GIT))
[AND (STRPOS ".git" (L-CASE FULLNAME))
(NOT (STRPOS ".github" (L-CASE FULLNAME]
(INFILEP (CONCAT FULLNAME ".skip")))
(* ;; ".skip in the directory itself -- don't index any of it")
(* ;; ".skip in the directory itself -- don't index any of it")
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
ELSEIF (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
(SUB1 (OR (STRPOS ".;" FULLNAME)
(STRPOS ";" FULLNAME)
(HELP
"No ; in non-directory"
]
'(index.html .skip))
THEN
(* ;; "dont index the index")
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
(SUB1 (OR (STRPOS ".;" FULLNAME)
(STRPOS ";" FULLNAME)
(HELP (CONCAT
"No ; in non-directory "
FULLNAME]
'(index.html .skip))
then
(* ;; "dont index the index")
ELSEIF (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
'(IMPTR SKIP skip imptr))
THEN
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
'(IMPTR SKIP skip imptr))
then
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
(ADD1 LEVEL])
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
(ADD1 LEVEL])])
(MEDLEY-FIX-LINKS
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
@@ -293,11 +301,11 @@
(PHASES (OR SUBSETS '(TEDIT PRETTY INDEX HRULE]
(FILESLOAD PDFSTREAM SKETCH)
(FONTSET 'STANDARD)
(WHILE DIRLIST
DO
(SETQ BASE (POP DIRLIST))
(FOR SRCPATH IN (DIRECTORY (CONCAT BASE "*.*;"))
DO (PROG* [(SRC (UNPACKFILENAME SRCPATH))
(while DIRLIST
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]
@@ -330,13 +338,13 @@
(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))
(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)
(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)
else (OR [NLSETQ (CL:WITH-OPEN-STREAM (S (OPENTEXTSTREAM SRCPATH)
)
(TEDIT.FORMAT.HARDCOPY S DEST T NIL NIL
NIL 'PDF]
@@ -353,79 +361,89 @@
(PRINTOUT T "DONE" T))])
(MAKE-INDEX-HTMLS
[LAMBDA (BASE TOP LEVEL) (* ; "Edited 29-Apr-2024 14:18 by lmm")
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
(* ; "Edited 26-Apr-2024 16:15 by lmm")
(* ; "Edited 20-Apr-2024 12:34 by lmm")
(* ; "Edited 13-Apr-2024 21:18 by lmm")
[OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
(* ; "Edited 13-Apr-2024 21:18 by lmm")
(* ; " Edited 16-May-2025 13:17 by fgh")
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
(OR (DIRECTORYNAMEP BASE)
(ERROR BASE "not a directory name"))
(OR (AND (NUMBERP LEVEL)
(IGREATERP LEVEL 0))
(SETQ LEVEL 1))
(LET* ((SUBDIRS NIL)
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
(RESETLST
(if (EQ LEVEL 1)
then (RESETSAVE (PSEUDOHOSTS T))
(PSEUDOHOST ROOT.NAME BASE))
(SETQ BASE (PSEUDOFILENAME BASE))
[LET*
((SUBDIRS NIL)
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
'}))
SLASHED SHORTNAME)
(CL:WITH-OPEN-FILE
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
(CL:FORMAT S "<SCRIPT>~%%")
(CL:FORMAT S " function up_onclick(){~%%")
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
(CL:FORMAT S " }~%%")
(CL:FORMAT S "</SCRIPT>~%%")
(CL:FORMAT S "</HEAD>~%%")
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
(CL:UNLESS (EQ LEVEL 1)
(CL:FORMAT S
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(FOR FULLNAME IN (DIRECTORY (CONCAT BASE "*.*;"))
DO (IF (EQ (NTHCHAR FULLNAME -1)
'>)
THEN
(* ;; "A directory")
))
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
do (if (EQ (NTHCHAR FULLNAME -1)
'>)
then
(* ;; "A directory")
(IF (NOT (DIRECTORYNAMEP FULLNAME))
THEN (HELP "NOT DIRNAME"))
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
(+ (NCHARS BASE)
(IF PSEUDOHOST
THEN 2
ELSE 1))
-2)))
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
(STRPOS ".git" FULLNAME)
(INFILEP (CONCAT FULLNAME ".skip")))
(if (NOT (DIRECTORYNAMEP FULLNAME))
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
(+ (NCHARS BASE)
(if PSEUDOHOST
then 2
else 1))
-2)))
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
(MEMB SHORTNAME '(.GIT))
[AND (STRPOS ".git" (L-CASE FULLNAME))
(NOT (STRPOS ".github" (L-CASE FULLNAME]
(INFILEP (CONCAT FULLNAME ".skip")))
(* ;; ".skip in the directory itself -- don't index any of it")
(* ;; ".skip in the directory itself -- don't index any of it")
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
ELSEIF (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
(SUB1 (OR (STRPOS ".;" FULLNAME)
(STRPOS ";" FULLNAME)
(HELP
"No ; in non-directory"
]
'(index.html .skip))
THEN
(* ;; "dont index the index")
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
(SUB1 (OR (STRPOS ".;" FULLNAME)
(STRPOS ";" FULLNAME)
(HELP (CONCAT
"No ; in non-directory "
FULLNAME]
'(index.html .skip))
then
(* ;; "dont index the index")
ELSEIF (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
'(IMPTR SKIP skip imptr))
THEN
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
'(IMPTR SKIP skip imptr))
then
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
ELSE (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
(NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
(ADD1 LEVEL])
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
(ADD1 LEVEL])])
)
(PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
@@ -532,9 +550,9 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1104 12495 (GATHER-INFO 1114 . 6496) (MAKE-FULLER-DB 6498 . 7407) (MAKE-INDEX-HTMLS
7409 . 11864) (MEDLEY-FIX-LINKS 11866 . 12259) (MEDLEY-FIX-DATES 12261 . 12493)) (13674 16462 (
MAKE-EXPORTS-ALL 13684 . 14743) (MAKE-WHEREIS-HASH 14745 . 15934) (MAKE-WHEREIS-LOOPS 15936 . 16460))
(16463 25195 (HCFILES 16473 . 20736) (MAKE-INDEX-HTMLS 20738 . 25193)) (25445 30057 (RECOMPILE-ONE
25455 . 27352) (RECMPL 27354 . 27957) (COMPILE-SETUP 27959 . 28583) (REMAKEFILES 28585 . 30055)))))
(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)))))
STOP

BIN
internal/MEDLEY-UTILS.DFASL
View File

Binary file not shown.