(FILECREATED "26-Jul-85 12:51:50" {ERIS}<LISPCORE>SOURCES>NSPRINT.;12 18970
changes to: (FNS \NSPRINT.WATCHDOG \NSPRINT.FULL.REQUEST.STATUS)
previous date: "17-Jul-85 12:34:41" {ERIS}<LISPCORE>SOURCES>NSPRINT.;11)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSPRINTCOMS)
(RPAQQ NSPRINTCOMS ((COURIERPROGRAMS PRINTING)
(DECLARE: DONTCOPY (RECORDS NSPRINTER)
(GLOBALVARS NS.DEFAULT.PRINTER NSPRINT.DEFAULT.MEDIUM))
(INITVARS (NS.DEFAULT.PRINTER NIL)
(NSPRINT.DEFAULT.MEDIUM))
(FNS GETNSPRINTER NSPRINT \NSPRINT.INTERNAL \NSPRINT.MEDIUM.CHECK
\NSPRINT.WATCHDOG \NSPRINT.FULL.REQUEST.STATUS NSPRINTER.STATUS
NSPRINTER.PROPERTIES NSPRINTREQUEST.STATUS \NSPRINT.ENQUIRE
\NSPRINT.COURIER.OPEN)))
(COURIERPROGRAM PRINTING (4 3)
TYPES
[(REQUEST.ID (ARRAY 5 UNSPECIFIED))
[PRINT.ATTRIBUTES (SEQUENCE (CHOICE (PRINT.OBJECT.NAME 0 STRING)
(PRINT.OBJECT.CREATE.DATE 1 TIME)
(SENDER.NAME 2 STRING]
[PRINT.OPTIONS (SEQUENCE (CHOICE (PRINT.OBJECT.SIZE 0 LONGCARDINAL)
(RECIPIENT.NAME 1 STRING)
(MESSAGE 2 STRING)
(COPY.COUNT 3 CARDINAL)
(PAGES.TO.PRINT 4 (RECORD (BEGINNING.PAGE.NUMBER CARDINAL)
(ENDING.PAGE.NUMBER CARDINAL)))
(MEDIUM.HINT 5 MEDIUM)
(PRIORITY.HINT 6 (ENUMERATION (HOLD 0)
(LOW 1)
(NORMAL 2)
(HIGH 3)))
(RELEASE.KEY 7 HASHED.PASSWORD)
(STAPLE 8 BOOLEAN)
(TWO.SIDED 9 BOOLEAN]
[PRINTER.PROPERTIES (SEQUENCE (CHOICE (MEDIA 0 MEDIA)
(STAPLE 1 BOOLEAN)
(TWO.SIDED 2 BOOLEAN]
[PRINTER.STATUS (SEQUENCE (CHOICE (SPOOLER 0 (ENUMERATION (Available 0)
(Busy 1)
(Disabled 2)
(Full 3)))
(FORMATTER 1 (ENUMERATION (Available 0)
(Busy 1)
(Disabled 2)))
(PRINTER 2 (ENUMERATION (Available 0)
(Busy 1)
(Disabled 2)
(NeedsAttention 3)
(NeedKeyOperator 4)))
(MEDIA 3 MEDIA]
[REQUEST.STATUS (SEQUENCE (CHOICE (STATUS 0 (ENUMERATION (Pending 0)
(InProgress 1)
(Completed 2)
(Unknown 3)
(Rejected 4)
(Aborted 5)
(Cancelled 6)
(Held 7)))
(STATUS.MESSAGE 1 STRING]
(MEDIA (SEQUENCE MEDIUM))
(MEDIUM (CHOICE (PAPER 0 PAPER)))
[PAPER (CHOICE (UNKNOWN 0 NIL)
(KNOWN.SIZE 1 (ENUMERATION ("US.LETTER" 1)
("US.LEGAL" 2)
("A0" 3)
("A1" 4)
("A2" 5)
("A3" 6)
("A4" 7)
("A5" 8)
("A6" 9)
("A7" 10)
("A8" 11)
("A9" 12)
("A10" 35)
("ISO.B0" 13)
("ISO.B1" 14)
("ISO.B2" 15)
("ISO.B3" 16)
("ISO.B4" 17)
("ISO.B5" 18)
("ISO.B6" 19)
("ISO.B7" 20)
("ISO.B8" 21)
("ISO.B9" 22)
("ISO.B10" 23)
("JIS.B0" 24)
("JIS.B1" 25)
("JIS.B2" 26)
("JIS.B3" 27)
("JIS.B4" 28)
("JIS.B5" 29)
("JIS.B6" 30)
("JIS.B7" 31)
("JIS.B8" 32)
("JIS.B9" 33)
("JIS.B10" 34)))
(OTHER.SIZE 2 (RECORD (WIDTH CARDINAL)
(LENGTH CARDINAL]
(CONNECTION.PROBLEM (ENUMERATION (NoRoute 0)
(NoResponse 1)
(TransmissionHardware 2)
(TransportTimeout 3)
(TooManyLocalConnections 4)
(TooManyRemoteConnections 5)
(MissingCourier 6)
(MissingProgram 7)
(MissingProcedure 8)
(ProtocolMismatch 9)
(ParameterInconsistency 10)
(InvalidMessage 11)
(ReturnTimedOut 12)
(Other 65535)))
(TRANSFER.PROBLEM (ENUMERATION (Aborted 0)
(ChecksumIncorrect 1)
(FormatIncorrect 2)
(NoRendezvous 3)
(WrongDirection 4]
PROCEDURES
((PRINT 0 (BULK.DATA.SOURCE PRINT.ATTRIBUTES PRINT.OPTIONS)
RETURNS
(REQUEST.ID)
REPORTS
(BUSY CONNECTION.ERROR INSUFFICIENT.SPOOL.SPACE INVALID.PRINT.PARAMETERS
MASTER.TOO.LARGE MEDIUM.UNAVAILABLE SERVICE.UNAVAILABLE SPOOLING.DISABLED
SPOOLING.QUEUE.FULL SYSTEM.ERROR TOO.MANY.CLIENTS TRANSFER.ERROR UNDEFINED.ERROR))
(GET.PRINTER.PROPERTIES 1 NIL RETURNS (PRINTER.PROPERTIES)
REPORTS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR))
(GET.PRINT.REQUEST.STATUS 2 (REQUEST.ID)
RETURNS
(REQUEST.STATUS)
REPORTS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR))
(GET.PRINTER.STATUS 3 NIL RETURNS (PRINTER.STATUS)
REPORTS
(SERVICE.UNAVAILABLE SYSTEM.ERROR UNDEFINED.ERROR)))
ERRORS
((BUSY 0)
(INSUFFICIENT.SPOOL.SPACE 1)
(INVALID.PRINT.PARAMETERS 2)
(MASTER.TOO.LARGE 3)
(MEDIUM.UNAVAILABLE 4)
(SERVICE.UNAVAILABLE 5)
(SPOOLING.DISABLED 6)
(SPOOLING.QUEUE.FULL 7)
(SYSTEM.ERROR 8)
(TOO.MANY.CLIENTS 9)
(UNDEFINED.ERROR 10 (CARDINAL))
(CONNECTION.ERROR 11 (CONNECTION.PROBLEM))
(TRANSFER.ERROR 12 (TRANSFER.PROBLEM))))
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD NSPRINTER (NSPRINTERNAME NSPRINTERADDRESS))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NS.DEFAULT.PRINTER NSPRINT.DEFAULT.MEDIUM)
)
)
(RPAQ? NS.DEFAULT.PRINTER NIL)
(RPAQ? NSPRINT.DEFAULT.MEDIUM )
(DEFINEQ
(GETNSPRINTER
[LAMBDA (HOST) (* bvm: "21-Jul-84 17:12")
(COND
((AND (LISTP HOST)
(type? NSNAME (fetch NSPRINTERNAME of HOST))
(type? NSADDRESS (fetch NSPRINTERADDRESS of HOST)))
(* Already in standard form)
HOST)
(T (PROG ((NAME (COND
(HOST)
(NS.DEFAULT.PRINTER)
([SETQ NS.DEFAULT.PRINTER (CAR (CH.LIST.OBJECTS "*" (QUOTE PRINTSERVER]
(printout PROMPTWINDOW .TAB0 0 "[Default NS printer set to "
NS.DEFAULT.PRINTER "]")
NS.DEFAULT.PRINTER)))
INFO)
(RETURN (COND
((NULL NAME)
(ERROR "Can't find an NS printserver" NIL T))
((NULL (SETQ INFO (LOOKUP.NS.SERVER (SETQ NAME (PARSE.NSNAME NAME))
(QUOTE PRINTSERVER)
T)))
(ERROR "Can't find address of " NAME))
(T (create NSPRINTER
NSPRINTERNAME ←(CAR INFO)
NSPRINTERADDRESS ←(CADR INFO])
(NSPRINT
[LAMBDA (PRINTER FILE OPTIONS) (* jds "17-Jul-85 12:11")
(* * Transmit the interpress file FILE to server PRINTER. OPTIONS controls some of the printing, e.g., what title
should appear on the header page, etc.)
(RESETLST (PROG (DOCUMENT.NAME FULLFILENAME PRINTRESULTS INSTREAM JOBNAME)
(DECLARE (SPECVARS INSTREAM))
(SETQ PRINTER (GETNSPRINTER PRINTER))
[SETQ INSTREAM (OPENSTREAM FILE (QUOTE INPUT)
NIL NIL (QUOTE ((SEQUENTIAL T]
(SETQ FULLFILENAME (FULLNAME INSTREAM))
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
INSTREAM))
(COND
((SETQ DOCUMENT.NAME (LISTGET OPTIONS (QUOTE DOCUMENT.NAME)))
(SETQ JOBNAME DOCUMENT.NAME))
(T (push OPTIONS (QUOTE DOCUMENT.NAME)
FULLFILENAME)))
(OR DOCUMENT.NAME (SETQ DOCUMENT.NAME FULLFILENAME))
[OR (LISTGET OPTIONS (QUOTE DOCUMENT.CREATION.DATE))
(push OPTIONS (QUOTE DOCUMENT.CREATION.DATE)
(GETFILEINFO INSTREAM (QUOTE ICREATIONDATE]
[SETQ PRINTRESULTS (\NSPRINT.INTERNAL PRINTER OPTIONS (FUNCTION (LAMBDA (
DATASTREAM)
(DECLARE (USEDFREE INSTREAM))
(COPYBYTES INSTREAM DATASTREAM)
NIL]
(RETURN (COND
(PRINTRESULTS (ADD.PROCESS (LIST (FUNCTION \NSPRINT.WATCHDOG)
(KWOTE PRINTRESULTS)
(KWOTE PRINTER)
(KWOTE (OR JOBNAME (ROOTFILENAME
FULLFILENAME)
FULLFILENAME)))
(QUOTE NAME)
(PACK* (fetch NSOBJECT
of (fetch NSPRINTERNAME
of PRINTER))
" WATCHER")
(QUOTE AFTEREXIT)
(QUOTE DELETE))
(* Set up a "watchdog" process to keep the guy informed
of the print job's status)
FULLFILENAME])
(\NSPRINT.INTERNAL
[LAMBDA (PRINTER OPTIONS TRANSFERFN) (* bvm: "20-May-85 17: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 RECIPENT.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])
(\NSPRINT.MEDIUM.CHECK
[LAMBDA (MEDIUM MEDIA PRINTER) (* lmm "18-Sep-84 19:51")
(if (EQ MEDIUM T)
then (CAR MEDIA)
else (for X in MEDIA when [OR (EQUAL X MEDIUM)
(AND (EQ (CAR X)
(QUOTE PAPER))
(STRPOS MEDIUM (CADR (CADR X))
NIL NIL NIL NIL (UPPERCASEARRAY]
do (RETURN X)
finally (printout PROMPTWINDOW .TAB0 0 "printer " (fetch NSPRINTERNAME of PRINTER)
" doesn't have print medium: " MEDIUM)
(RETURN (CAR MEDIA])
(\NSPRINT.WATCHDOG
[LAMBDA (ID PRINTER JOBNAME) (* bvm: "26-Jul-85 12:39")
(BLOCK 15000)
(bind MSG STATUS (LASTSTATUS ← 0)
(GIVEUPCNT ← 0)
do [COND
((NOT (EQUAL (SETQ STATUS (\NSPRINT.FULL.REQUEST.STATUS ID PRINTER))
LASTSTATUS))
(printout PROMPTWINDOW .TAB0 0)
(COND
(JOBNAME (printout PROMPTWINDOW JOBNAME " on ")))
(printout PROMPTWINDOW (fetch NSPRINTERNAME of PRINTER)
" -- "
(OR (CAR STATUS)
"No response"))
(COND
((SETQ MSG (CADR STATUS))
(printout PROMPTWINDOW " (" MSG ")")))
(COND
((SETQ MSG (CADDR STATUS))
(printout PROMPTWINDOW " (" MSG ")")))
(SELECTQ (CAR (SETQ LASTSTATUS STATUS))
((Pending InProgress)
(SETQ GIVEUPCNT 0))
[NIL (COND
((IGREATERP (add GIVEUPCNT 1)
5)
(RETURN]
(RETURN]
(BLOCK 30000])
(\NSPRINT.FULL.REQUEST.STATUS
[LAMBDA (ID PRINTER) (* bvm: "26-Jul-85 12:38")
(* * Returns a triple (RequestStatus StatusMessage PrinterStatus), with the last two items being NIL when they are
uninteresting)
(SETQ PRINTER (GETNSPRINTER PRINTER))
(CAR (NLSETQ (RESETLST (LET ((STREAM (\NSPRINT.COURIER.OPEN PRINTER))
RESULT STATUS)
(COND
((AND STREAM [PROGN (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE)
STREAM))
(SETQ RESULT (COURIER.CALL STREAM (QUOTE
PRINTING)
(QUOTE
GET.PRINT.REQUEST.STATUS)
ID
(QUOTE NOERROR]
(LIST (CADR (ASSOC (QUOTE STATUS)
RESULT))
(AND (SETQ STATUS (CADR (ASSOC (QUOTE STATUS.MESSAGE)
RESULT)))
(NOT (STREQUAL STATUS ""))
STATUS)
(SELECTQ [SETQ STATUS
(CADR (ASSOC (QUOTE PRINTER)
(COURIER.CALL STREAM
(QUOTE PRINTING)
(QUOTE
GET.PRINTER.STATUS)
(QUOTE NOERROR]
((NIL Busy Available)
(* Expected status values)
NIL)
STATUS])
(NSPRINTER.STATUS
[LAMBDA (PRINTER) (* bvm: "29-Jun-84 17:02")
(\NSPRINT.ENQUIRE PRINTER (QUOTE GET.PRINTER.STATUS])
(NSPRINTER.PROPERTIES
[LAMBDA (PRINTER) (* bvm: "29-Jun-84 17:02")
(\NSPRINT.ENQUIRE PRINTER (QUOTE GET.PRINTER.PROPERTIES])
(NSPRINTREQUEST.STATUS
[LAMBDA (REQUESTID PRINTER) (* bvm: "29-Jun-84 16:38")
(\NSPRINT.ENQUIRE PRINTER (LIST (QUOTE GET.PRINT.REQUEST.STATUS)
REQUESTID])
(\NSPRINT.ENQUIRE
[LAMBDA (PRINTER OP) (* bvm: "20-Jul-84 17:56")
(* * Perform a printing Courier op to PRINTER. OP is (FN . ARGS) to perform a COURIER.CALL on)
(SETQ PRINTER (GETNSPRINTER PRINTER))
(PROG ((STREAM (\NSPRINT.COURIER.OPEN PRINTER)))
(RETURN (COND
(STREAM (RESETLST (RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE)
STREAM))
(APPLY (FUNCTION COURIER.CALL)
(CONS STREAM (CONS (QUOTE PRINTING)
(APPEND (OR (LISTP OP)
(LIST OP))
(LIST (QUOTE NOERROR])
(\NSPRINT.COURIER.OPEN
[LAMBDA (PRINTER) (* bvm: "20-Jul-84 10:31")
(COURIER.OPEN (fetch NSPRINTERADDRESS of PRINTER)
NIL T (PACK* (fetch NSOBJECT of (fetch NSPRINTERNAME of PRINTER))
"#Printing"])
)
(PUTPROPS NSPRINT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5323 18887 (GETNSPRINTER 5333 . 6343) (NSPRINT 6345 . 8445) (\NSPRINT.INTERNAL 8447 .
14314) (\NSPRINT.MEDIUM.CHECK 14316 . 14940) (\NSPRINT.WATCHDOG 14942 . 15963) (
\NSPRINT.FULL.REQUEST.STATUS 15965 . 17399) (NSPRINTER.STATUS 17401 . 17576) (NSPRINTER.PROPERTIES
17578 . 17761) (NSPRINTREQUEST.STATUS 17763 . 17974) (\NSPRINT.ENQUIRE 17976 . 18593) (
\NSPRINT.COURIER.OPEN 18595 . 18885)))))
STOP