(FILECREATED "18-Sep-84 20:15:47" {ERIS}<LISPCORE>SOURCES>NSPRINT.;8 15220
changes to: (FNS \NSPRINT.INTERNAL \NSPRINT.MEDIUM.CHECK)
(VARS NSPRINTCOMS)
previous date: "14-Sep-84 18:17:33" {ERIS}<LISPCORE>SOURCES>NSPRINT.;5)
(* Copyright (c) 1984 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 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) (* bvm: "14-Sep-84 18:17")
(RESETLST (PROG (DOCUMENT.NAME FULLFILENAME PRINTRESULTS INSTREAM)
(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))
FULLFILENAME])
(\NSPRINT.INTERNAL
[LAMBDA (PRINTER OPTIONS TRANSFERFN) (* lmm "18-Sep-84 19:53")
(* * 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.DEFAU T.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)))
PROPERTIES ATTRIBUTES COURIERSTREAM VALUE PRINTOPTIONS)
[SETQ ATTRIBUTES (BQUOTE ((PRINT.OBJECT.NAME , (OR (LISTGET OPTIONS (QUOTE DOCUMENT.NAME))
"Document"))
(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]
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))
[COND
((OR MEDIUM STAPLE? TWO.SIDED?) (* Check that the printer supports these options.)
(SETQ PROPERTIES (COURIER.CALL COURIERSTREAM (QUOTE PRINTING)
(QUOTE GET.PRINTER.PROPERTIES)))
[COND
(MEDIUM (COND
((SETQ VALUE (\NSPRINT.MEDIUM.CHECK MEDIUM (CADR (ASSOC (QUOTE MEDIA)
PROPERTIES))
PRINTER))
(push PRINTOPTIONS (LIST (QUOTE MEDIUM.HINT)
VALUE]
[COND
(STAPLE? (COND
((CADR (ASSOC (QUOTE STAPLE)
PROPERTIES))
(push PRINTOPTIONS (LIST (QUOTE STAPLE)
T)))
(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))
(T (printout PROMPTWINDOW .TAB0 0
"Printer does not support two-sided copies"]
(* Check the status of the printer.)
(bind (LASTSTATUS ← 0)
STATUS
do [COND
((NEQ [SETQ STATUS (CADR (ASSOC (QUOTE SPOOLER)
(COURIER.CALL COURIERSTREAM (QUOTE PRINTING)
(QUOTE GET.PRINTER.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))
(RETURN (COURIER.CALL COURIERSTREAM (QUOTE PRINTING)
(QUOTE PRINT)
TRANSFERFN ATTRIBUTES PRINTOPTIONS])
(\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: "20-Jul-84 16:40")
(BLOCK 15000)
(bind RESULT MSG STATUS (LASTSTATUS ← 0)
(GIVEUPCNT ← 0)
(TIMER ←(SETUPTIMER 0))
do (COND
((OR (NEQ [SETQ STATUS (AND (SETQ RESULT (NSPRINTREQUEST.STATUS ID PRINTER))
(CADR (ASSOC (QUOTE STATUS)
RESULT]
LASTSTATUS)
(TIMEREXPIRED? TIMER))
(printout PROMPTWINDOW .TAB0 0)
(COND
(JOBNAME (printout PROMPTWINDOW JOBNAME " on ")))
(printout PROMPTWINDOW (fetch NSPRINTERNAME of PRINTER)
" -- "
(OR STATUS "No response"))
(COND
((AND (SETQ MSG (CADR (ASSOC (QUOTE STATUS.MESSAGE)
RESULT)))
(NOT (STREQUAL MSG "")))
(printout PROMPTWINDOW " (" MSG ")")))
(SELECTQ (SETQ LASTSTATUS STATUS)
((Pending InProgress)
(SETQ GIVEUPCNT 0))
[NIL (COND
((IGREATERP (add GIVEUPCNT 1)
5)
(RETURN]
(RETURN))
(SETUPTIMER 300000 TIMER)))
(BLOCK 30000])
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5298 15142 (GETNSPRINTER 5308 . 6318) (NSPRINT 6320 . 7889) (\NSPRINT.INTERNAL 7891 .
11947) (\NSPRINT.MEDIUM.CHECK 11949 . 12573) (\NSPRINT.WATCHDOG 12575 . 13654) (NSPRINTER.STATUS 13656
. 13831) (NSPRINTER.PROPERTIES 13833 . 14016) (NSPRINTREQUEST.STATUS 14018 . 14229) (\NSPRINT.ENQUIRE
14231 . 14848) (\NSPRINT.COURIER.OPEN 14850 . 15140)))))
STOP