(FILECREATED "17-Sep-85 17:15:44" {ERIS}<LISPCORE>SOURCES>NSPRINT.;13 24074
changes to: (VARS NSPRINTCOMS)
(FNS NSPRINTER.HOSTNAMEP FAX.SEND.FILE FAX.STATUS FAX.PROPERTIES \FAX.PARSE.NAME
FAX.HOSTNAMEP \NSPRINT.INTERNAL NSPRINT)
previous date: "26-Jul-85 12:51:50" {ERIS}<LISPCORE>SOURCES>NSPRINT.;12)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSPRINTCOMS)
(RPAQQ NSPRINTCOMS [(COMS (COURIERPROGRAMS PRINTING)
(DECLARE: DONTCOPY (RECORDS NSPRINTER)
(GLOBALVARS NS.DEFAULT.PRINTER NSPRINT.DEFAULT.MEDIUM
NSPRINT.WATCHERFLG))
(INITVARS (NS.DEFAULT.PRINTER NIL)
(NSPRINT.DEFAULT.MEDIUM)
(NSPRINT.WATCHERFLG T))
(FNS GETNSPRINTER NSPRINT \NSPRINT.INTERNAL \NSPRINT.MEDIUM.CHECK
\NSPRINT.WATCHDOG \NSPRINT.FULL.REQUEST.STATUS NSPRINTER.HOSTNAMEP
NSPRINTER.STATUS NSPRINTER.PROPERTIES NSPRINTREQUEST.STATUS
\NSPRINT.ENQUIRE \NSPRINT.COURIER.OPEN))
(COMS (* FAX)
(FNS FAX.SEND.FILE FAX.STATUS FAX.PROPERTIES FAX.HOSTNAMEP \FAX.PARSE.NAME)
(INITVARS (DEFAULTFAXHOST)
(FAXADDRESSES)
(FAX.NO.WATCHER T))
(GLOBALVARS DEFAULTFAXHOST FAXADDRESSES FAX.NO.WATCHER)
(ADDVARS (PRINTERTYPES ((FAX TELECOPIER)
(CANPRINT (INTERPRESS))
(HOSTNAMEP FAX.HOSTNAMEP)
(STATUS FAX.STATUS)
(PROPERTIES FAX.PROPERTIES)
(SEND FAX.SEND.FILE)
(BITMAPSCALE INTERPRESS.BITMAPSCALE)
(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP
SCALEFACTOR REGION
ROTATION TITLE])
(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 NSPRINT.WATCHERFLG)
)
)
(RPAQ? NS.DEFAULT.PRINTER NIL)
(RPAQ? NSPRINT.DEFAULT.MEDIUM )
(RPAQ? NSPRINT.WATCHERFLG T)
(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: "17-Sep-85 14:50")
(* * 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
([AND PRINTRESULTS NSPRINT.WATCHERFLG (NOT (LISTGET OPTIONS
(QUOTE NO.WATCHER]
(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: "17-Sep-85 13:19")
(* * 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])
(\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.HOSTNAMEP
[LAMBDA (PRINTERNAME) (* bvm: "16-Sep-85 22:49")
(* True if PRINTERNAME names an NS printer. Do stupid test for now. Later on might want to test that random NS name
really is a printer)
(AND (STRPOS ":" PRINTERNAME)
(QUOTE INTERPRESS])
(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"])
)
(* FAX)
(DEFINEQ
(FAX.SEND.FILE
[LAMBDA (HOST FILE PRINTOPTIONS) (* bvm: "17-Sep-85 15:52")
(* * Sends Interpress document FILE to a FAX server specified by HOST, which is of the form person@place.
Simple front end to NSPRINT)
(LET ((HOST&OPTIONS (\FAX.PARSE.NAME HOST)))
(NSPRINT (CAR HOST&OPTIONS)
FILE
(APPEND (CDR HOST&OPTIONS)
PRINTOPTIONS
(AND FAX.NO.WATCHER (LIST (QUOTE NO.WATCHER)
T])
(FAX.STATUS
[LAMBDA (HOST) (* bvm: "16-Sep-85 23:29")
(* * Tests status of FAX server specified by HOST, which is of the form person@place. Simple front end to
NSPRINTER.STATUS)
(NSPRINTER.STATUS (CAR (\FAX.PARSE.NAME HOST])
(FAX.PROPERTIES
[LAMBDA (HOST) (* bvm: "16-Sep-85 23:33")
(* * Returns properties of FAX server specified by HOST, which is of the form person@place. Simple front end to
NSPRINTER.PROPERTIES)
(NSPRINTER.PROPERTIES (CAR (\FAX.PARSE.NAME HOST])
(FAX.HOSTNAMEP
[LAMBDA (PRINTERNAME) (* bvm: "16-Sep-85 22:51")
(* * True if PRINTERNAME is something that looks like a FAX spec, i.e., person@place, where place is a phone number
or something registered as a fax address. Stupid for now)
(AND (STRPOS "@" PRINTERNAME)
(QUOTE FAX])
(\FAX.PARSE.NAME
[LAMBDA (PLACE) (* bvm: "17-Sep-85 15:58")
(* * Parse a Fax spec "Person@Place" and return a dotted pair (FaxServer . PrintOptions))
(PROG (AT PERSON DESTINATION PHONE HOST MSG INFO)
RETRY
(SETQ AT (STRPOS "@" PLACE))
[COND
([SETQ PERSON (AND (NEQ AT 1)
(SUBSTRING PLACE 1 (SUB1 AT]
(SETQ PERSON (LIST (QUOTE RECIPIENT.NAME)
PERSON]
(SETQ DESTINATION (SUBSTRING PLACE (ADD1 AT)))
(COND
([for CH instring DESTINATION always (OR (DIGITCHARP CH)
(EQ CH (CHARCODE -))
(EQ CH (CHARCODE *))
(EQ CH (CHARCODE #]
(* Looks like a phone number)
(SETQ PHONE DESTINATION))
((AND (SETQ INFO (CDR (ASSOC (MKATOM (U-CASE DESTINATION))
FAXADDRESSES)))
(SETQ PHONE (CAR INFO)))
(SETQ HOST (CADR INFO)))
(T (SETQ MSG (CONCAT "The FAX destination %"" DESTINATION
"%" is unknown.
Edit the list FAXADDRESSES"))
(GO FAIL)))
(COND
((AND (NULL HOST)
(NULL (SETQ HOST DEFAULTFAXHOST)))
(SETQ MSG
"Don't know the name of your local FAX server.
Set the variable DEFAULTFAXHOST")
(GO FAIL)))
[RETURN (CONS HOST (CONS (QUOTE MESSAGE)
(CONS PHONE PERSON]
FAIL(ERROR (CONCAT "Don't understand " PLACE " because:")
(CONCAT MSG
" appropriately, then say OK.
Alternatively, RETURN %"name@CorrectPhoneOrDestination%""])
)
(RPAQ? DEFAULTFAXHOST )
(RPAQ? FAXADDRESSES )
(RPAQ? FAX.NO.WATCHER T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTFAXHOST FAXADDRESSES FAX.NO.WATCHER)
)
(ADDTOVAR PRINTERTYPES ((FAX TELECOPIER)
(CANPRINT (INTERPRESS))
(HOSTNAMEP FAX.HOSTNAMEP)
(STATUS FAX.STATUS)
(PROPERTIES FAX.PROPERTIES)
(SEND FAX.SEND.FILE)
(BITMAPSCALE INTERPRESS.BITMAPSCALE)
(BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
)
(PUTPROPS NSPRINT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6171 20151 (GETNSPRINTER 6181 . 7191) (NSPRINT 7193 . 9360) (\NSPRINT.INTERNAL 9362 .
15230) (\NSPRINT.MEDIUM.CHECK 15232 . 15856) (\NSPRINT.WATCHDOG 15858 . 16879) (
\NSPRINT.FULL.REQUEST.STATUS 16881 . 18315) (NSPRINTER.HOSTNAMEP 18317 . 18663) (NSPRINTER.STATUS
18665 . 18840) (NSPRINTER.PROPERTIES 18842 . 19025) (NSPRINTREQUEST.STATUS 19027 . 19238) (
\NSPRINT.ENQUIRE 19240 . 19857) (\NSPRINT.COURIER.OPEN 19859 . 20149)) (20168 23508 (FAX.SEND.FILE
20178 . 20687) (FAX.STATUS 20689 . 21008) (FAX.PROPERTIES 21010 . 21347) (FAX.HOSTNAMEP 21349 . 21719)
(\FAX.PARSE.NAME 21721 . 23506)))))
STOP