(FILECREATED " 1-Sep-87 11:23:23" {ERINYES}<LISPUSERS>KOTO>PATCH-TWOSIDED.;1
 6479   

      previous date: "15-Oct-86 12:20:47" {QV}<BRIGGS>LISP>PATCH-TWOSIDED.;1)


(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PATCH-TWOSIDEDCOMS)

(RPAQQ PATCH-TWOSIDEDCOMS
 ((FNS \NSPRINT.INTERNAL)
			     (DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP)
										  NSPRINT))))
(DEFINEQ

(\NSPRINT.INTERNAL

  [LAMBDA (PRINTER OPTIONS TRANSFERFN)                       (* N.H.Briggs "27-Sep-86 16:31")


          (* * Calls the PRINT program for PRINTER, interpreting OPTIONS as a plist of print options.

	  TRANSFERFN is a function applied to the transfer stream to actually send the Interpress master)



    (
PROG
 ((MEDIUM (
OR
 (
LISTGET
 OPTIONS (
QUOTE
 MEDIUM))
			   NSPRINT.DEFAULT.MEDIUM))
	     (STAPLE? (
LISTGET
 OPTIONS (
QUOTE
 STAPLE?)))
	     (TWO.SIDED? (
EQ
 2 (
OR
 (
LISTGET
 OPTIONS (
QUOTE
 #SIDES))
				       EMPRESS#SIDES)))
	     (SENDER.NAME (
OR
 (
LISTGET
 OPTIONS (
QUOTE
 SENDER.NAME))
				(
USERNAME
 NIL NIL T)))
	     (DOCNAME (
OR
 (
LISTGET
 OPTIONS (
QUOTE
 DOCUMENT.NAME))
			    "Document"))
	     PROPERTIES ATTRIBUTES COURIERSTREAM VALUE PRINTOPTIONS STATUS)
	    [
SETQ
 ATTRIBUTES (
BQUOTE
 ((PRINT.OBJECT.NAME , DOCNAME)
					  (PRINT.OBJECT.CREATE.DATE , (
OR
 (
LISTGET
 OPTIONS
										       (
QUOTE

											 
									   DOCUMENT.CREATION.DATE))
									    (
IDATE
)))
					  (SENDER.NAME , SENDER.NAME]
	    [
SETQ
 PRINTOPTIONS (
BQUOTE
 ((COPY.COUNT , (
FIX
 (
OR
 (
LISTGET
 OPTIONS
										  (
QUOTE
 #COPIES))
								       1]
                                                             (* This "option" seems to be required)

	    [
COND

	      ((
SETQ
 VALUE (
LISTGET
 OPTIONS (
QUOTE
 RECIPIENT.NAME)))
		(push
 PRINTOPTIONS (
LIST
 (
QUOTE
 RECIPIENT.NAME)
					     (
OR
 (
STRINGP
 VALUE)
						   (
MKSTRING
 VALUE]
	    [
COND

	      ((
SETQ
 VALUE (
LISTGET
 OPTIONS (
QUOTE
 PRIORITY)))
		(push
 PRINTOPTIONS (
LIST
 (
QUOTE
 PRIORITY.HINT)
					     (
SELECTQ
 VALUE
							((HOLD LOW NORMAL HIGH)
							  VALUE)
							(
\ILLEGAL.ARG
 VALUE]
	    [
COND

	      ((
SETQ
 VALUE (
LISTGET
 OPTIONS (
QUOTE
 MESSAGE)))
		(push
 PRINTOPTIONS (
LIST
 (
QUOTE
 MESSAGE)
					     (
OR
 (
STRINGP
 VALUE)
						   (
MKSTRING
 VALUE]
	    [
COND

	      ((
SETQ
 VALUE (
LISTGET
 OPTIONS (
QUOTE
 PAGES.TO.PRINT)))
                                                             (* A page range to print, (first# last#))

		(
COND

		  ((
AND
 (
LISTP
 VALUE)
			  (
LISTP
 (
CDR
 VALUE))
			  (
NULL
 (
CDDR
 VALUE))
			  (SMALLPOSP (
CAR
 VALUE))
			  (SMALLPOSP (
CADR
 VALUE)))
		    (push
 PRINTOPTIONS (
LIST
 (
QUOTE
 PAGES.TO.PRINT)
						 VALUE)))
		  (T (
\ILLEGAL.ARG
 VALUE]
	RETRY
	    (
COND

	      ((
NOT
 (
SETQ
 COURIERSTREAM (
\NSPRINT.COURIER.OPEN
 PRINTER)))
		(printout PROMPTWINDOW .TAB0 0 "No response from printer " (fetch
 NSPRINTERNAME
									      of
 PRINTER))
		(
DISMISS
 5000)
		(
GO
 RETRY)))
	    (
RESETSAVE
 NIL (
LIST
 (
FUNCTION
 \SPP.RESETCLOSE)
				     COURIERSTREAM))         (* Check the status of the printer.)

	    (bind
 (LASTSTATUS _
 0)
	       do
 (
SETQ
 STATUS (
COURIER.CALL
 COURIERSTREAM (
QUOTE
 PRINTING)
						   (
QUOTE
 GET.PRINTER.STATUS)
						   (
QUOTE
 RETURNERRORS)))
		    [
COND

		      ((
EQ
 (
CAR
 STATUS)
			     (
QUOTE
 ERROR))
			(
COND

			  ((
NOT
 (
EQUAL
 STATUS LASTSTATUS))
			    (printout PROMPTWINDOW T "[From " (fetch
 NSPRINTERNAME of
 PRINTER)
				      " Error: "
				      (
SUBSTRING
 (
CDR
 STATUS)
						   2 -2)
				      "; will retry]")))     (* Wait longer for this problem)

			(
DISMISS
 30000))
		      ((
NEQ
 (
SETQ
 STATUS (
CADR
 (
ASSOC
 (
QUOTE
 SPOOLER)
							      STATUS)))
			      LASTSTATUS)
			(
SELECTQ
 STATUS
				   (Available (
RETURN
))
				   (Busy (printout PROMPTWINDOW T "[From " (fetch
 NSPRINTERNAME
									      of
 PRINTER)
						   " Status: Spooler busy; will retry]"))
				   (
ERROR
 "Printer spooler" STATUS]
		    (
SETQ
 LASTSTATUS STATUS)
		    (
DISMISS
 5000))
	    [
COND

	      ((
OR
 MEDIUM STAPLE? TWO.SIDED?)              (* Check that the printer supports these options.)

		(
SETQ
 PROPERTIES (
COURIER.CALL
 COURIERSTREAM (
QUOTE
 PRINTING)
						   (
QUOTE
 GET.PRINTER.PROPERTIES)
						   (
QUOTE
 RETURNERRORS)))
		(
COND

		  ((
EQ
 (
CAR
 PROPERTIES)
			 (
QUOTE
 ERROR))
		    (
SETQ
 STATUS PROPERTIES)
		    (
GO
 HANDLE.ERROR)))
		[
COND

		  (MEDIUM (
COND

			    ((
SETQ
 VALUE (
\NSPRINT.MEDIUM.CHECK
 MEDIUM
								    (
CADR
 (
ASSOC
 (
QUOTE
 MEDIA)
										     PROPERTIES))
								    PRINTER))
			      (push
 PRINTOPTIONS (
LIST
 (
QUOTE
 MEDIUM.HINT)
							   VALUE))
			      (
SETQ
 MEDIUM]
		[
COND

		  (STAPLE? (
COND

			     ((
CADR
 (
ASSOC
 (
QUOTE
 STAPLE)
					       PROPERTIES))
			       (push
 PRINTOPTIONS (
LIST
 (
QUOTE
 STAPLE)
							    T))
			       (
SETQ
 STAPLE?))
			     (T (printout PROMPTWINDOW .TAB0 0 
					  "[Printer does not support stapled copies]"]
		(
COND

		  (TWO.SIDED? (
COND

				((
CADR
 (
ASSOC
 (
QUOTE
 TWO.SIDED)
						  PROPERTIES))
				  (push
 PRINTOPTIONS (
QUOTE
 (TWO.SIDED T)))
				  (
SETQ
 TWO.SIDED?))
				(T (printout PROMPTWINDOW .TAB0 0 
					     "Printer does not support two-sided copies"]

          (* * Finally, send the print document)



	    (
SETQ
 STATUS (
COURIER.CALL
 COURIERSTREAM (
QUOTE
 PRINTING)
					   (
QUOTE
 PRINT)
					   TRANSFERFN ATTRIBUTES PRINTOPTIONS (
QUOTE
 RETURNERRORS)))
	    (
COND

	      ((
NEQ
 (
CAR
 STATUS)
		      (
QUOTE
 ERROR))
		(
RETURN
 STATUS)))
	HANDLE.ERROR
	    (
ERROR
 (
CONCAT
 "Unexpected error from " (fetch
 NSPRINTERNAME of
 PRINTER)
			       " attempting to print " DOCNAME "
RETURN to try again.")
		     (
CDR
 STATUS))
	    (
CLOSEF
 COURIERSTREAM)
	    (
GO
 RETRY])
)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY 
(FILESLOAD (LOADCOMP)
	   NSPRINT)
)
(PUTPROPS PATCH-TWOSIDED COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (433 6305 (\NSPRINT.INTERNAL 443 . 6303)))))
STOP