Add HCFILES for printing readable versions of Lisp source

Author: masinter

Diff for: new/printing/HCFILES

@@ -1,57 +1,62 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 9-Aug-2022 20:44:48" {DSK}<home>larry>medley>test>new>printing>HCFILES.;3
 4231   
+
(FILECREATED "20-Oct-2022 16:13:17" {DSK}<home>larry>ilisp>test>new>printing>HCFILES.;5
 7943   
 
-      :CHANGES-TO (FNS HCFILES)
+      :CHANGES-TO (FNS PRETTYFILES HCFILES BADFILE)
+                  (VARS HCFILESCOMS)
 
-      :PREVIOUS-DATE " 7-Aug-2022 22:40:13" {DSK}<home>larry>medley>test>new>printing>HCFILES.;2)
+      :PREVIOUS-DATE " 9-Aug-2022 20:44:48" {DSK}<home>larry>ilisp>test>new>printing>HCFILES.;1)
 
 
 (PRETTYCOMPRINT HCFILESCOMS)
 
-(RPAQQ HCFILESCOMS
 ((FNS BADFILE HCFILES)
+(RPAQQ HCFILESCOMS
 ((FNS BADFILE HCFILES PRETTYFILES)
                     (INITVARS (HCFILES)
                            (BADFILES))))
 (DEFINEQ
 
 (BADFILE

-  [LAMBDA NIL
                                              (* ; "Edited 22-Jun-2022 09:40 by larry")

-    (pushnew
 BADFILES TFILE)
+  [LAMBDA NIL
                                                (* ; "Edited 20-Oct-2022 15:40 by lmm")


+                                                           (* ; "Edited 22-Jun-2022 09:40 by larry")

+    (pushnew
 BADFILES *FILE*)
     (LET [(STR (OPENSTREAM "BADFILES.TXT" 'APPEND]
          (SETFILEPTR STR -1)
-         (PRINT TFILE STR)
+         (PRINT *FILE* STR)
          (CLOSEF STR))
-    (RETFROM 'HCFILES])
+    (RETFROM (OR (STKPOS 'PRETTYFILES)
+                 'HCFILES])
 
 (HCFILES

-  [LAMBDA (TFILE DEST REDOFLG TOPDIRLEN)
-    (DECLARE
 (SPECVARS TFILE))
                               (* ; "Edited  9-Aug-2022 20:44 by lmm")

-    (if
 (NULL TFILE)
-        then
 (SETQ TFILE MEDLEYDIR))
+  [LAMBDA (*FILE* DEST REDOFLG TOPDIRLEN)
+    (DECLARE
 (SPECVARS *FILE*)
+           (GLOBALVARS BADFILE))
                             (* ; "Edited 20-Oct-2022 16:11 by lmm")


+                                                             (* ; "Edited  9-Aug-2022 20:44 by lmm")

+    (if
 (NULL *FILE*)
+        then
 (SETQ *FILE* MEDLEYDIR))
     (COND
-       ((DIRECTORYNAMEP TFILE)
+       ((DIRECTORYNAMEP *FILE*)
 
         (* ;; "canonicalize")

 
-        (SETQ TFILE (DIRECTORYNAME TFILE))
-        [OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY]
+        (SETQ *FILE* (DIRECTORYNAME *FILE*))
+        [OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING *FILE* 'DIRECTORY]
         (CL:UNLESS DEST
             (ShellCommand (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
                                  "/tmp/psfiles/"))
             (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
 
         (* ;; "first deal with files in this directory")

 
-        (for
 EXT in
 '("TED*" "SKETCH") do
 (for
 X in
 (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
+        (for
 EXT in
 '("TED*" "SKETCH") do
 (for
 X in
 (DIRECTORY (CONCAT *FILE* "*." EXT ";*"))
                                              do
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
 
         (* ;; " then deal with subdirs ")

 
-        (for
 X in
 (DIRECTORY (CONCAT TFILE "*")) when
 [for
 SKIP in
 '(">." ">dinfo>")
-                                                         always
 (NOT (STRPOS SKIP (L-CASE X]
+        (for
 X in
 (DIRECTORY (CONCAT *FILE* "*"))
+           when
 [for
 SKIP in
 '(">." ">dinfo>") always
 (NOT (STRPOS SKIP (L-CASE X]
            when
 (DIRECTORYNAMEP X) do
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
-       [(SETQ TFILE (INFILEP TFILE))
-        (LET* ((TF (UNPACKFILENAME.STRING TFILE))
+       [(SETQ *FILE* (INFILEP *FILE*))
+        (LET* ((TF (UNPACKFILENAME.STRING *FILE*))
                (NAME (LISTGET TF 'NAME))
                (DIR (LISTGET TF 'DIRECTORY))
                (PSFILE (PACKFILENAME.STRING
@@ -78,23 +83,87 @@
                   then
                                       (* ; " do nothing")

                        (PRINTOUT T PSFILE " already there" T)
                 elseif
 (EQ REDOFLG 'TEST)
-                  then
 (PRINTOUT T TFILE "-> " PSFILE T)
-                       (CLOSEF (OPENTEXTSTREAM TFILE))
-                elseif
 (MEMBER TFILE BADFILES)
-                  then
 (PRINTOUT T "Skipping " TFILE " on BADFILES")
-                else
 (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
-                     (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
+                  then
 (PRINTOUT T *FILE* "-> " PSFILE T)
+                       (CLOSEF (OPENTEXTSTREAM *FILE*))
+                elseif
 (MEMBER *FILE* BADFILES)
+                  then
 (PRINTOUT T "Skipping " *FILE* " on BADFILES")
+                else
 (PRINTOUT T "Converting " *FILE* " to " PSFILE "...")
+                     (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM *FILE*))
                             PSFILE T NIL NIL NIL (if
 (EQ REDOFLG 'IP)
                                                      then
 'INTERPRESS
                                                    else
 'POSTSCRIPT))
                      (printout T " DONE" T)
                      (CLOSEF? TEXTSTREAM]
        (T (PRINTOUT T "no such file " T])
+
+(PRETTYFILES

+  [LAMBDA (*FILE* DEST REDOFLG TOPDIRLEN)
+    (DECLARE
 (SPECVARS *FILE*)
+           (GLOBALVARS BADFILES))
                            (* ; "Edited 20-Oct-2022 16:12 by lmm")


+                                                             (* ; "Edited  9-Aug-2022 20:44 by lmm")

+    (if
 (NULL *FILE*)
+        then
 (SETQ *FILE* MEDLEYDIR))
+    (COND
+       ((DIRECTORYNAMEP *FILE*)
+
+        (* ;; "canonicalize")

+
+        (SETQ *FILE* (DIRECTORYNAME *FILE*))
+        [OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING *FILE* 'DIRECTORY]
+        (CL:UNLESS DEST
+            (ShellCommand (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
+                                 "/tmp/psfiles/"))
+            (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
+
+        (* ;; "first deal with files in this directory; ignore files with extensions for now%"*.LISP%" %"*.ILISP%"")

+
+        (for
 PAT in
 '("*.;") do
 (for
 X in
 (DIRECTORY (CONCAT *FILE* PAT))
+                                   WHEN
 (NOT (DIRECTORYNAMEP X)) WHEN
 (INFILEP X)
+                                   WHEN
 (CAR (OR (NLSETQ (LISPSOURCEFILEP X))
+                                                 (PROGN (PRINTOUT T "LISPSOURCEFILEP error" X)
+                                                        NIL)))
+                                   do
 (PRETTYFILES
 X DEST REDOFLG TOPDIRLEN)))
+
+        (* ;; " then deal with subdirs ")

+
+        (for
 X in
 (DIRECTORY (CONCAT *FILE* "*"))
+           when
 [for
 SKIP IN
 '("clos" "cltl2" "rooms>" ".>") always
 (NOT (STRPOS SKIP (L-CASE X]
+           when
 (DIRECTORYNAMEP X) do
 (PRETTYFILES
 X DEST REDOFLG TOPDIRLEN)))
+       [(AND (SETQ *FILE* (INFILEP *FILE*))
+             (LISPSOURCEFILEP *FILE*))
+        (LET* [(TF (UNPACKFILENAME.STRING *FILE*))
+               (NAME (LISTGET TF 'NAME))
+               (DIR (LISTGET TF 'DIRECTORY))
+               (PSFILE (PACKFILENAME.STRING
+                        'EXTENSION "ps" 'NAME
+                        (if
 (EQ DEST T)
+                            then
                             (* ; "with the source file")

+                                 (CONCAT NAME ".pfi")
+                          else
 (CONCAT [PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN)
+                                                                         -1]
+                                      "-" NAME))
+                        'HOST
+                        (LISTGET TF 'HOST)
+                        'DIRECTORY
+                        (if
 (EQ DEST T)
+                            then
 DIR
+                          else
 DEST]
+              (if
 (AND (NOT REDOFLG)
+                       (INFILEP PSFILE))
+                  then
                                       (* ; " do nothing")

+                       (PRINTOUT T PSFILE " already there" T)
+                elseif
 (MEMBER *FILE* BADFILES)
+                  then
 (PRINTOUT T "Skipping " *FILE* " on BADFILES")
+                else
 (PRINTOUT T "Converting " *FILE* " to " PSFILE "...")
+                     (CL:WITH-OPEN-STREAM (STR (OPENPOSTSCRIPTSTREAM PSFILE))
+                            (PRETTYFILEINDEX *FILE* NIL STR))
+                     (printout T " DONE" T]
+       (T (PRINTOUT T "no such file " T])
 )
 
 (RPAQ? HCFILES
 )
 
 (RPAQ? BADFILES
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (467 4163 (BADFILE 477 . 785) (HCFILES 787 . 4161)))))
+  (FILEMAP (NIL (534 7875 (BADFILE 544 . 1006) (HCFILES 1008 . 4494) (PRETTYFILES 4496 . 7873)))))
 STOP