(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)


(FILECREATED "12-Dec-2025 19:31:07" {WMEDLEY}<library>UNIXPRINT.;10
 13362  

      :EDIT-BY rmk

      :PREVIOUS-DATE "11-Dec-2025 23:19:04" {WMEDLEY}<library>UNIXPRINT.;9)


(PRETTYCOMPRINT UNIXPRINTCOMS)

(RPAQQ UNIXPRINTCOMS

       [(FILES UNIXUTILS)
        (FNS UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
        (ALISTS (PRINTERTYPES (UNIX)))
        (INITVARS (UnixPrinterName NIL)
               (UNIXPRINTSWITCHES " -r -s ")
               (DEFAULTPRINTERTYPE 'UNIX))
        (P (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
        (PROP FILETYPE UNIXPRINT)
        (DECLARE%: DONTEVAL@COMPILE DOCOPY (FNS UnixPrintCommand))
        (DECLARE%: EVAL@COMPILE DOCOPY (FILES UNIXCOMM))
        (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS UnixPrinterName))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA])

(FILESLOAD UNIXUTILS)
(DEFINEQ

(UnixPrint

  [LAMBDA (HOST FILE PRINTOPTIONS)
                           (* ; "Edited  5-Dec-2025 11:46 by rmk")


                                                             (* ; "Edited 13-Sep-2025 20:28 by rmk")


                                                             (* ; "Edited 11-Sep-2025 20:48 by rmk")


                                                            (* ; "Edited  7-Dec-2001 14:55 by rmk:")


                                                           (* ; "Edited 20-May-92 14:13 by nilsson")


    (* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")


    (* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")


    [LET*
     ((PRINTER (CL:IF (MEMB HOST '(NIL LPT '{LPT})
                            UnixPrinterName HOST)))
      (COPIES (LISTGET PRINTOPTIONS '%#COPIES))
      (NAME (LISTGET PRINTOPTIONS 'DOCUMENT.NAME))
      (NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
      (TYPE (PRINTERTYPE PRINTER)))

     (* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")


     (* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype  for %" PRINTER %" is not Postscript%"))))")


     [COND
        ((OR (NULL NAME)
             (EQ NAME 'LPT)
             (STRPOS "{LPT}" NAME 1 NIL T))
         (SETQ NAME "Medley Output"))
        ((EQ (CHCON1 NAME)
             (CHARCODE {))
         (SETQ NAME (UNPACKFILENAME.STRING NAME 'NAME))
         (COND
            ((EQ (NCHARS NAME)
                 0)
             (SETQ NAME "Medley Output"]

     (* ;; "Don't break if you have trouble with preexisting files, e.g. because of protection.")


     (FOR
 F IN
 [CAR (NLSETQ (FILDIR (PACKFILENAME 'HOST 'DSK 'EXTENSION '* 'BODY (UnixTempFile

                                                                                  'medleyprint. T]
        WHEN
 (CAR (NLSETQ (IGREATERP (DIFFERENCE (IDATE)
                                            (GETFILEINFO F 'ICREATIONDATE))
                                 120))) DO
 (NLSETQ (DELFILE F)))

     (* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by.  If we delete immediately, it may happen before lpr has done its thing.  ")


     (CL:MULTIPLE-VALUE-BIND
      (tmpstream tmpname)
      (UnixTempFile
 'medleyprint.)
      (COND
         (tmpstream 

                (* ;; "First, copy the lisp file to /tmp so lpr can find it.")


                [CL:WITH-OPEN-STREAM
                 (out tmpstream)
                 (CL:WITH-OPEN-STREAM
                  (in
 (OPENSTREAM FILE 'INPUT))
                  (printout PROMPTWINDOW .TAB0 0 "Sending output to Unix printer " (OR PRINTER "")
                         " ")
                  (IF
 NSIDES
                      THEN
 
                           (* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")


                           (BIND
 C SAWCR
                              DO
 (SETQ C (BIN in))
                                 (IF
 (MEMB C (CHARCODE (CR LF)))
                                     THEN
 (BOUT out C)
                                          (SETQ SAWCR T)
                                   ELSEIF
 SAWCR
                                     THEN
 
                                          (* ;; "First char of 2nd line:  nonCR/LF after CR/LF")


                                          (* ;; "Put out simplex header, then print character in C")


                                          (PRINTOUT out "%%BeginSetup" T)
                                          (PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
                                                 "<< /Duplex " (CL:IF (EQ NSIDES 1)
                                                                   "false"
                                                                   "true")
                                                 " /Tumble false >> setpagedevice" T "%%%%EndFeature"
                                                 T "} stopped cleartomark" T)
                                          (PRINTOUT out "%%EndSetup" T)
                                          (BOUT out C)
                                          (COPYCHARS in out (GETFILEPTR in)
                                                 -1)
                                          (RETURN)
                                   ELSE
 (BOUT out C)))
                    ELSE
 (COPYCHARS in out 0 -1]

                (* ;; "Now make Unix print the /tmp file.")


                (ShellCommand (UnixPrintCommand
 PRINTER COPIES NAME tmpname)
                       PROMPTWINDOW)
                (CL:WHEN NIL                                 (* ; "This should be conditioned an error code--don't want to say %"done%" if it didn't happen.  If we put this back, then put in ... in the Sending printout above")

                    (printout PROMPTWINDOW "done" T)))
         (T (ERROR "Couldn't create unix temp file"]
    T])

(UnixShellQuote

  [LAMBDA (STRING)
    (DECLARE
 (LOCALVARS . T))
                                (* ; "Edited 19-Apr-89 21:14 by TAL")

    (LET* ((X (CHCON STRING))
           (CT X)
           C FLG)
          [while
 (LISTP CT) do
 (SETQ C (CAR CT))
                               (COND
                                  ([OR (<= (CHARCODE a)
                                           C
                                           (CHARCODE z))
                                       (<= (CHARCODE A)
                                           C
                                           (CHARCODE Z))
                                       (<= (CHARCODE 0)
                                           C
                                           (CHARCODE 9))
                                       (FMEMB C (CHARCODE (- /]
                                   (SETQ CT (CDR CT)))
                                  (T (SETQ FLG T)
                                     (RPLNODE CT (CHARCODE \)
                                            (CONS (COND
                                                     ((FMEMB C (CHARCODE (CR LF)))
                                                      (CHARCODE SPACE))
                                                     (T C))
                                                  (SETQ CT (CDR CT]
          (COND
             (FLG (CONCATCODES X))
             (T STRING])

(UnixTempFile

  [LAMBDA (Prefix DontOpen)
                                  (* ; "Edited 28-Apr-93 13:49 by rmk:")


                                                             (* ; "Edited 12-Jan-89 19:07 by TAL")

    (LET* ([host (AND (BOUNDP 'FISTempDir)
                      (UNPACKFILENAME.STRING FISTempDir 'HOST]
           (dir (OR [COND
                       ((OR (STRING-EQUAL host "UNIX")
                            (STRING-EQUAL host "DSK"))
                        (UNPACKFILENAME.STRING FISTempDir 'DIRECTORY]
                    "tmp"))
           (str (CONCAT (OR Prefix "")
                       (IDATE)))
           file unix)
          (COND
             ([for
 i from
 1 to
 100
                 thereis
 (NOT (INFILEP (SETQ file (CONCAT "{UNIX}" (SETQ unix
                                                                    (CONCAT "/" dir "/" str i]
              (CL:VALUES [COND
                            (DontOpen file)
                            (T 
                               (* ;; "Type TEXT seems to be important for Apple LaserWriters at PARC")


                               (OPENSTREAM file 'OUTPUT NIL '((TYPE TEXT]
                     unix])

(UnixPrintCommand

  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                     (* ; "Edited  4-May-2018 17:17 by rmk:")


                                                           (* ; "Edited 20-May-92 14:26 by nilsson")


    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")


    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")


    (* ;; "COPIES - how many copies of this job to be printed.")


    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")


    (* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")


    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")


    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")


    (* ;; "Use raw lpr, let system decide where it is located.")


    (CONCAT "lpr " (COND
                      ((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
                       (CONCAT "-P" (UnixShellQuote
 PRINTER)
                              " "))
                      (T ""))
           (COND
              ((AND (FIXP COPIES)
                    (NEQ COPIES 1))
               (CONCAT "-#" COPIES " "))
              (T ""))
           " -J"
           (UnixShellQuote
 NAME)
           " "
           (OR UNIXPRINTSWITCHES "")
           " " TMPNAME])
)

(ADDTOVAR PRINTERTYPES
 ((UNIX)
                        (CANPRINT (PDF))
                        (STATUS TRUE)
                        (PROPERTIES NILL)
                        (SEND UnixPrint)))

(RPAQ? UnixPrinterName
 NIL)

(RPAQ? UNIXPRINTSWITCHES
 " -r -s ")

(RPAQ? DEFAULTPRINTERTYPE
 'UNIX)

(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)

(PUTPROPS UNIXPRINT
 FILETYPE
 :COMPILE-FILE)
(DECLARE%: DONTEVAL@COMPILE DOCOPY 
(DEFINEQ

(UnixPrintCommand

  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                     (* ; "Edited  4-May-2018 17:17 by rmk:")


                                                           (* ; "Edited 20-May-92 14:26 by nilsson")


    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")


    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")


    (* ;; "COPIES - how many copies of this job to be printed.")


    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")


    (* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")


    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")


    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")


    (* ;; "Use raw lpr, let system decide where it is located.")


    (CONCAT "lpr " (COND
                      ((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
                       (CONCAT "-P" (UnixShellQuote
 PRINTER)
                              " "))
                      (T ""))
           (COND
              ((AND (FIXP COPIES)
                    (NEQ COPIES 1))
               (CONCAT "-#" COPIES " "))
              (T ""))
           " -J"
           (UnixShellQuote
 NAME)
           " "
           (OR UNIXPRINTSWITCHES "")
           " " TMPNAME])
)
)
(DECLARE%: EVAL@COMPILE DOCOPY 

(FILESLOAD UNIXCOMM)
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS UnixPrinterName)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1160 10883 (UnixPrint 1170 . 6542) (UnixShellQuote 6544 . 7973) (UnixTempFile 7975 . 
9198) (UnixPrintCommand 9200 . 10881)) (11352 13045 (UnixPrintCommand 11362 . 13043)))))
STOP