Fixes to HCFILES from MEDLEY-UTILS to convert TEdit files to postscript

internal/MEDLEY-UTILS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "12-Mar-2022 12:46:25" 
-|{DSK}<Users>kaplan>Local>medley3.5>my-medley>internal>MEDLEY-UTILS.;2|
 12734  
+
(FILECREATED "31-May-2022 09:37:37" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;3|
 12695  
 
-      :CHANGES-TO (FNS MAKE-WHEREIS-HASH)
+      :CHANGES-TO (FNS HCFILES)
 
-      :PREVIOUS-DATE "20-Feb-2022 12:59:27" 
-|{DSK}<Users>kaplan>Local>medley3.5>my-medley>internal>MEDLEY-UTILS.;1|)
+      :PREVIOUS-DATE "12-Mar-2022 12:46:25" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -161,58 +159,65 @@
 (DEFINEQ
 
 (HCFILES

-  (LAMBDA (TFILE PREFIX DEST REDOFLG TOPDIRLEN)
           (* \; "Edited 20-Feb-2022 12:16 by larry")


+  (LAMBDA (TFILE DEST REDOFLG TOPDIRLEN)
                  (* \; "Edited 31-May-2022 09:31 by larry")


+                                                          (* \; "Edited 20-Feb-2022 12:16 by larry")


                                                           (* \; "Edited 21-Aug-2021 20:56 by larry")

     (DECLARE
 (SPECVARS TFILE))
+    (|if|
 (NULL TFILE)
+        |then|
 (SETQ TFILE MEDLEYDIR))
     (COND
-       ((NULL TFILE)
-        (HCFILES
 MEDLEYDIR))
        ((DIRECTORYNAMEP TFILE)
+
+        (* |;;| "canonicalize")

+
         (SETQ TFILE (DIRECTORYNAME TFILE))
-        (OR TOPDIRLEN (SETQ TOPDIRLEN (IPLUS 1 (CL:LENGTH (MKSTRING (FILENAMEFIELD TFILE 'DIRECTORY))
-                                                      ))))
-        (OR DEST (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
+        (OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE '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|
 X |in|
 (|if|
 (EQ REDOFLG 'REV)
-                          |then|
 (REVERSE (DIRECTORY (CONCAT TFILE "*.TED*;")))
-                        |else|
 (DIRECTORY (CONCAT TFILE "*.TED*;")))
-           |do|
 (HCFILES
 X PREFIX DEST REDOFLG TOPDIRLEN))
+        (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*.TED*;")) |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN))
 
         (* |;;| " then deal with subdirs ")

 
-        (|for|
 X |in|
 (|if|
 (EQ REDOFLG 'REV)
-                          |then|
 (REVERSE (DIRECTORY (CONCAT TFILE "*")))
-                        |else|
 (DIRECTORY (CONCAT TFILE "*")))
+        (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*"))
            |when|
 (|for|
 SKIP |in|
 '(">." ">dinfo>") |always|
 (NOT (STRPOS SKIP (L-CASE X))))
-           |when|
 (DIRECTORYNAMEP X) |do|
 (HCFILES
 X PREFIX DEST REDOFLG TOPDIRLEN)))
+           |when|
 (DIRECTORYNAMEP X) |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
        ((SETQ TFILE (INFILEP TFILE))
-        (PROG ((PSFILE (PACKFILENAME.STRING 'EXTENSION (|if|
 (EQ REDOFLG 'IP)
-                                                           |then|
 'IP
-                                                         |else|
 "PS")
-                              'NAME
-                              (CONCAT (OR PREFIX "")
-                                     (|if|
 PREFIX
-                                         |then|
 "-"
-                                       |else|
 "")
-                                     (PACK (SUBST '- '> (UNPACK (SUBSTRING (FILENAMEFIELD
-                                                                            TFILE
-                                                                            'DIRECTORY)
-                                                                       (IPLUS 1 TOPDIRLEN)
-                                                                       -1))))
-                                     "-"
-                                     (FILENAMEFIELD TFILE 'NAME))
-                              'DIRECTORY DEST))
+        (LET* ((TF (UNPACKFILENAME.STRING TFILE))
+               (NAME (LISTGET TF 'NAME))
+               (DIR (LISTGET TF 'DIRECTORY))
+               (PSFILE (PACKFILENAME.STRING
+                        'EXTENSION
+                        (|if|
 (EQ REDOFLG 'IP)
+                            |then|
 "IP"
+                          |else|
 "PS")
+                        'NAME
+                        (|if|
 (EQ DEST T)
+                            |then|
                           (* \; "with the tedit file")

+                                  NAME
+                          |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)))
                (TEXTSTREAM))
               (|if|
 (AND (NOT REDOFLG)
                          (INFILEP PSFILE))
                   |then|
                                     (* \; " do nothing")

                         (PRINTOUT T PSFILE " already there" T)
                 |elseif|
 (EQ REDOFLG 'TEST)
-                  |then|
 (PRINTOUT T "TESTING " TFILE)
+                  |then|
 (PRINTOUT T TFILE "-> " PSFILE T)
                         (CLOSEF (OPENTEXTSTREAM TFILE))
-                |else|
 (PRINTOUT T "Converting " TFILE "...")
+                |else|
 (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
                       (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
                              PSFILE T NIL NIL NIL (|if|
 (EQ REDOFLG 'IP)
                                                       |then|
 'INTERPRESS
@@ -224,7 +229,7 @@
 
 (RPAQ? HCFILES
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (753 7201 (GATHER-INFO 763 . 6303) (MEDLEY-FIX-LINKS 6305 . 6828) (MEDLEY-FIX-DATES 6830
- . 7199)) (7300 9150 (MAKE-EXPORTS-ALL 7310 . 8326) (MAKE-WHEREIS-HASH 8328 . 9148)) (9185 12689 (
-HCFILES 9195 . 12687)))))
+  (FILEMAP (NIL (699 7147 (GATHER-INFO 709 . 6249) (MEDLEY-FIX-LINKS 6251 . 6774) (MEDLEY-FIX-DATES 6776
+ . 7145)) (7246 9096 (MAKE-EXPORTS-ALL 7256 . 8272) (MAKE-WHEREIS-HASH 8274 . 9094)) (9131 12650 (
+HCFILES 9141 . 12648)))))
 STOP