more odds and ends from promote-internal

internal/MAKE-PS

@@ -1,134 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-
(FILECREATED "17-Oct-2021 16:06:41" {DSK}<home>larry>medley>internal>library>MAKE-PS.;2
 5515   
-
-      changes to%:  (FILES DOC-OBJECTS)
-                    (VARS MAKE-PSCOMS)
-
-      previous date%: " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;1)
-
-
-(PRETTYCOMPRINT MAKE-PSCOMS)
-
-(RPAQQ MAKE-PSCOMS

-       [(FNS MAKE-PS MAKE-PS-INIT BADFILE)
-        
-        (* ;; " Load known used image object types")

-
-        (FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
-        (ADVISE TEDIT.PROMPTPRINT)
-        (INITVARS (BADFILESFILE)
-               (BADFS)
-               (BADFILES))
-        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-PS-INIT])
-(DEFINEQ
-
-(MAKE-PS

-  [LAMBDA (TFILE PREFIX DEST REDOFLG TOPDIRLEN)
        (* ; "Edited 21-Aug-2021 20:56 by larry")

-    (DECLARE
 (SPECVARS TFILE))
-    (COND
-       ((DIRECTORYNAMEP TFILE)
-        (SETQ TFILE (DIRECTORYNAME TFILE))
-        [OR TOPDIRLEN (SETQ TOPDIRLEN (IPLUS 1 (CL:LENGTH (MKSTRING (FILENAMEFIELD TFILE 'DIRECTORY]
-        [OR DEST (PROGN (ShellCommand (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
-                                             "/tmp/psfiles"))
-                        (SETQ DEST (MEDLEYDIR "tmp/psfiles"]
-
-        (* ;; "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*;")))
-           when
 (NOT (MEMB X BADFILES)) do
 (MAKE-PS
 X PREFIX DEST REDOFLG TOPDIRLEN))
-
-        (* ;; " then deal with subdirs ")

-
-        (for
 X in
 (IF
 (EQ REDOFLG 'REV)
-                              THEN
 (REVERSE (DIRECTORY (CONCAT TFILE "*")))
-                            ELSE
 (DIRECTORY (CONCAT TFILE "*")))
-           when
 [for
 SKIP in
 '(">." ">internal>test" ">dinfo>")
-                       always
 (NOT (STRPOS SKIP (L-CASE X] when
 (DIRECTORYNAMEP X)
-           do
 (MAKE-PS
 X PREFIX 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))
-               (TEXTSTREAM))
-              (if
 (MEMB TFILE BADFILES)
-                  then
 (RETURN))
-              (if
 (AND (NOT REDOFLG)
-                           (INFILEP PSFILE))
-                  then
                                   (* ; " do nothing")

-                        (PRINTOUT T PSFILE " already there" T)
-                elseif
 (EQ REDOFLG 'TEST)
-                  then
 (PRINTOUT T "TESTING " TFILE)
-                        (CLOSEF (OPENTEXTSTREAM TFILE))
-                else
 (PRINTOUT T "Converting " TFILE "...")
-                      (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
-                             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])
-
-(MAKE-PS-INIT

-  [LAMBDA NIL
                                          (* ; "Edited  1-Sep-2021 16:27 by larry")

-                                                             (* ; " initialize")

-    (SETQ BADFILESFILE (MEDLEYDIR "tmp" "badfiles.txt" T))
-    (SETQ BADFS (OPENSTREAM BADFILESFILE 'APPEND))
-    (POSTSCRIPT.INIT)
-    (SETQ BADFILES (SUBSET (READFILE BADFILESFILE)
-                          (FUNCTION INFILEP])
-
-(BADFILE

-  [LAMBDA (X)
                                          (* ; "Edited 16-Aug-2021 13:14 by larry")

-    ([LAMBDA ($$1)
-       (COND
-          ((FMEMB $$1 BADFILES)
-           BADFILES)
-          (T (NCONC1 BADFILES $$1]
-     (OR X TFILE))
-    (PRINT (OR X TFILE)
-           BADFS)
-    (FLUSHOUTPUT BADFS)
-    (CLOSEF? TEXTSTREAM)
-    (RETFROM 'MAKE-PS NIL])
-)
-
-
-
-(* ;; " Load known used image object types")

-
-
-(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
-
-[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T]
-
-(READVISE TEDIT.PROMPTPRINT)
-
-(RPAQ? BADFILESFILE
 )
-
-(RPAQ? BADFS
 )
-
-(RPAQ? BADFILES
 )
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(MAKE-PS-INIT
)
-)
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (793 5117 (MAKE-PS 803 . 4300) (MAKE-PS-INIT 4302 . 4738) (BADFILE 4740 . 5115)))))
-STOP