In MAKE-INDEX-HTMLS, make sure that the up-one button does not appear…

… in the top-level index.html
Interlisp · Jul 14, 2024 · a2518e1 · a2518e1
1 parent 37d8a1c
commit a2518e1
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 16 deletions.
diff --git a/internal/MEDLEY-UTILS b/internal/MEDLEY-UTILS
@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "13-Jul-2024 19:26:57" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;10 29404  
+(FILECREATED "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14 29833  
 
-      :EDIT-BY "frank"
+      :CHANGES-TO (FNS MAKE-INDEX-HTMLS)
 
-      :PREVIOUS-DATE "13-Jul-2024 19:15:20" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;6)
+      :PREVIOUS-DATE "13-Jul-2024 19:26:57" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;11)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -124,13 +124,16 @@
            "Welcome to Fuller sysout"])
 
 (MAKE-INDEX-HTMLS
-  [LAMBDA (BASE TOP)                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")
+  [LAMBDA (BASE TOP LEVEL)                                   (* ; "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]
     (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))
@@ -146,9 +149,10 @@
            (CL:FORMAT S "</SCRIPT>~%%")
            (CL:FORMAT S "</HEAD>~%%")
            (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
-           (CL:FORMAT S 
+           (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)
@@ -189,7 +193,8 @@
 
                    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])
+          (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")
@@ -342,13 +347,16 @@
                          (PRINTOUT T "DONE" T))])
 
 (MAKE-INDEX-HTMLS
-  [LAMBDA (BASE TOP)                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")
+  [LAMBDA (BASE TOP LEVEL)                                   (* ; "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]
     (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))
@@ -364,9 +372,10 @@
            (CL:FORMAT S "</SCRIPT>~%%")
            (CL:FORMAT S "</HEAD>~%%")
            (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
-           (CL:FORMAT S 
+           (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)
@@ -407,7 +416,8 @@
 
                    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])
+          (NCONC SUBDIRS (FOR D IN SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
+                                                       (ADD1 LEVEL])
 )
 
 (PUTPROPS MEDLEY-UTILS FILETYPE :COMPILE-FILE)
@@ -514,9 +524,9 @@
 (ADDTOVAR LAMA )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1067 11991 (GATHER-INFO 1077 . 6459) (MAKE-FULLER-DB 6461 . 7238) (MAKE-INDEX-HTMLS 
-7240 . 11360) (MEDLEY-FIX-LINKS 11362 . 11755) (MEDLEY-FIX-DATES 11757 . 11989)) (13170 15958 (
-MAKE-EXPORTS-ALL 13180 . 14239) (MAKE-WHEREIS-HASH 14241 . 15430) (MAKE-WHEREIS-LOOPS 15432 . 15956)) 
-(15959 24356 (HCFILES 15969 . 20232) (MAKE-INDEX-HTMLS 20234 . 24354)) (24606 29218 (RECOMPILE-ONE 
-24616 . 26513) (RECMPL 26515 . 27118) (COMPILE-SETUP 27120 . 27744) (REMAKEFILES 27746 . 29216)))))
+  (FILEMAP (NIL (1086 12215 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS 
+7259 . 11584) (MEDLEY-FIX-LINKS 11586 . 11979) (MEDLEY-FIX-DATES 11981 . 12213)) (13394 16182 (
+MAKE-EXPORTS-ALL 13404 . 14463) (MAKE-WHEREIS-HASH 14465 . 15654) (MAKE-WHEREIS-LOOPS 15656 . 16180)) 
+(16183 24785 (HCFILES 16193 . 20456) (MAKE-INDEX-HTMLS 20458 . 24783)) (25035 29647 (RECOMPILE-ONE 
+25045 . 26942) (RECMPL 26944 . 27547) (COMPILE-SETUP 27549 . 28173) (REMAKEFILES 28175 . 29645)))))
 STOP
diff --git a/internal/MEDLEY-UTILS.DFASL b/internal/MEDLEY-UTILS.DFASL