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


(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4
 13651  

      :CHANGES-TO (VARS UNIXPRINTCOMS)

      :PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
)


(* ; "
Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
")

(PRETTYCOMPRINT UNIXPRINTCOMS)

(RPAQQ UNIXPRINTCOMS

       [(FILES UNIXUTILS)
        (FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
        (INITVARS (UnixPrinterName NIL)
               (UNIXPRINTSWITCHES " -r -s "))
        (P 
           (* ;; 

           "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")


           (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

(InstallUnixPrinter

  [LAMBDA (PrinterTypes)
                                     (* ; "Edited  8-Feb-97 11:33 by rmk:")


    (* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")


    (DECLARE
 (GLOBALVARS PRINTERTYPES))
    (for
 type inside
 (OR PrinterTypes '(POSTSCRIPT))
       do
 (for
 x in
 PRINTERTYPES when
 (EQMEMB type (CAR x))
             do
 (LET ((PRINTERTYPE type))
                     (PUTASSOC 'SEND (LIST 'UnixPrint)
                            (CDR x])

(UnixPrint

  [LAMBDA (HOST FILE PRINTOPTIONS)
                          (* ; "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 (OR HOST UnixPrinterName))
      (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)
             (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 "Spooling output to Unix printer"
                          (COND
                             (PRINTER (CONCAT " '" PRINTER "'"))
                             (T ""))
                          "...")
                   (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)
                 (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])
)

(RPAQ? UnixPrinterName
 NIL)

(RPAQ? UNIXPRINTSWITCHES
 " -r -s ")


(* ;; "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")



(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
 )
)
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote 
6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
UnixPrintCommand 11560 . 13241)))))
STOP