(FILECREATED "30-Jan-85 22:25:27" {ERIS}<LISPCORE>SOURCES>PUPPRINT.;1 13573
changes to: (VARS PUPPRINTCOMS))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PUPPRINTCOMS)
(RPAQQ PUPPRINTCOMS ((FNS EFTP \ABORT.EFTP PUP.PRINTER.STATUS PUP.PRINTER.PROPERTIES)
(DECLARE: DONTCOPY (CONSTANTS * EFTPPUPTYPES)
(CONSTANTS * EFTPCONSTANTS)
(ADDVARS * (LIST (CONS (QUOTE PUPTYPES)
EFTPPUPTYPES)))
(GLOBALVARS \EFTP.TIMEOUT \EFTP.LONGTIMEOUT))
(INITVARS (\EFTP.TIMEOUT 5000)
(\EFTP.LONGTIMEOUT 15000))))
(DEFINEQ
(EFTP
[LAMBDA (HOST FILE PRINTOPTIONS) (* bvm: " 5-Jan-85 23:47")
(RESETLST (PROG ((HOSTPORT (BESTPUPADDRESS HOST (QUOTE ERROR)))
(TIMEOUT \EFTP.TIMEOUT)
(CHECKSTATUS PRINTOPTIONS)
(OPUP (ALLOCATE.PUP))
(#SIDES (LISTGET (LISTP PRINTOPTIONS)
(QUOTE #SIDES)))
STREAM DATA RESULT ENDING NAMESTRING NC HOSTNAME STATUS NEWSTATUS CURPAGE# ID
SOC LASTPAGE# LASTPAGELENGTH LENGTH THISPAGELENGTH PRESSDATAPAGE# ABORTER CLOSER
CAPABILITIES IPUP)
[SETQ STREAM (COND
((TYPENAMEP FILE (QUOTE STREAM))
FILE)
(T (OPENSTREAM FILE (QUOTE INPUT]
(RESETSAVE NIL (SETQ CLOSER (LIST (QUOTE CLOSEF)
STREAM)))
(SETQ LENGTH (GETFILEINFO STREAM (QUOTE LENGTH)))
(SETQ LASTPAGELENGTH (fetch (BYTEPTR OFFSET) of LENGTH))
(SETQ LASTPAGE# (fetch (BYTEPTR PAGE) of LENGTH))
[COND
(PRINTOPTIONS (COND
((NEQ LASTPAGELENGTH 0)
(HELP "Press file with non-integral number of pages?" FILE)))
(* Final page of press file holds special printing
parameters)
(SETQ PRESSDATAPAGE# (SUB1 LASTPAGE#))
(COND
((IGREATERP [SETQ NC (NCHARS (SETQ NAMESTRING
(USERNAME NIL NIL T]
31)
(SETQ NAMESTRING (SUBSTRING NAMESTRING 1 31)))
((ILESSP [IPLUS NC (NCHARS (SETQ HOSTNAME (ETHERHOSTNAME NIL T]
36)
(SETQ NAMESTRING (CONCAT NAMESTRING " on " HOSTNAME]
[RESETSAVE NIL (LIST (QUOTE CLOSEPUPSOCKET)
(SETQ SOC (OPENPUPSOCKET]
(SETUPPUP OPUP HOSTPORT \PUPSOCKET.EFTP \EFTP.DATA -1 SOC T)
(RESETSAVE NIL (SETQ ABORTER (LIST (QUOTE \ABORT.EFTP)
SOC OPUP)))
RESTART
(COND
((AND CURPAGE# PUPTRACEFLG)
(PRIN1 " (restarting)" PUPTRACEFILE)))
(SETQ ID 0)
(COND
((NEQ CURPAGE# 0)
[COND
((EQ (GETFILEPTR STREAM)
0))
((RANDACCESSP STREAM)
(SETFILEPTR STREAM 0))
(T (RPLACA (CDR CLOSER)
(SETQ STREAM (OPENSTREAM (CLOSEF STREAM)
(QUOTE INPUT]
(SETQ CURPAGE# 0)))
(replace PUPTYPE of OPUP with \EFTP.DATA)
[COND
((FIXP #SIDES)
[while (NOT CAPABILITIES)
do [do (* Printer capability request only honored while
printer is idle)
[COND
((SETQ NEWSTATUS (PUP.PRINTER.STATUS HOSTPORT))
(COND
((NOT (EQUAL NEWSTATUS STATUS))
(printout PROMPTWINDOW .TAB0 0 (CDR (SETQ STATUS NEWSTATUS]
(COND
((EQ (CAR STATUS)
\PS.IDLE)
(RETURN))
(T (BLOCK \EFTP.TIMEOUT]
(SETQ CHECKSTATUS NIL)
(COND
((NOT (SETQ CAPABILITIES (PUP.PRINTER.PROPERTIES HOSTPORT)))
(printout PROMPTWINDOW .TAB0 0 "[No response from " HOST "]")
(SETQ STATUS]
(COND
([AND (EQ (CHCON1 (CADR (ASSOC (QUOTE PRINT-INSTANCE)
CAPABILITIES)))
(CHARCODE T))
(OR (EQ #SIDES 1)
(EQ (CHCON1 (CADR (ASSOC (QUOTE DUPLEX)
CAPABILITIES)))
(CHARCODE T] (* Prepare capabilities)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(\PUTBASE DATA 0 \SPRUCEPWD1)
(\PUTBASE DATA 1 \SPRUCEPWD2)
(replace PUPLENGTH of OPUP
with (IPLUS (\STOREPLIST [LIST (LIST (QUOTE DUPLEX)
(COND
((EQ #SIDES 1)
(QUOTE FALSE))
(T (QUOTE TRUE]
(\ADDBASE DATA 2))
\PUPOVLEN 4)) (* Length of pup = length of plist plus overhead plus
two code words)
(SETQ CURPAGE# -1)
(GO SENDPAGE))
(T (printout T HOST " does not support #sides specification" T]
NEWPAGE
(COND
[(EQ CURPAGE# LASTPAGE#)
(COND
((EQ LASTPAGELENGTH 0)
(SETQ ENDING T))
(T (replace PUPLENGTH of OPUP with (IPLUS \PUPOVLEN (SETQ THISPAGELENGTH
LASTPAGELENGTH]
[(ILESSP CURPAGE# LASTPAGE#)
(replace PUPLENGTH of OPUP with (IPLUS \PUPOVLEN (SETQ THISPAGELENGTH
BYTESPERPAGE]
(T (SETQ ENDING T)))
(COND
(ENDING (replace PUPTYPE of OPUP with \EFTP.END)
(replace PUPLENGTH of OPUP with \PUPOVLEN))
((NEQ (fetch PUPID of OPUP)
ID) (* Read CURPAGE#'th page of file into pup's data part)
(\BINS STREAM (SETQ DATA (fetch PUPCONTENTS of OPUP))
0 THISPAGELENGTH)
(COND
((EQ CURPAGE# PRESSDATAPAGE#) (* Fill in print parameters for this run)
(\PUTBASE DATA 8 1) (* First copy to print = 1)
(\PUTBASE DATA 9 (OR (FIXP PRINTOPTIONS)
(FIXP (LISTGET PRINTOPTIONS (QUOTE #COPIES)))
1)) (* Number of copies)
(SetBcplString (\ADDBASE DATA 154)
NAMESTRING))) (* Set "printed by")
))
SENDPAGE
(replace PUPID of OPUP with ID)
[to \MAXETHERTRIES
do (COND
(CHECKSTATUS (COND
((AND (SETQ NEWSTATUS (PUP.PRINTER.STATUS HOSTPORT))
(NOT (EQUAL NEWSTATUS STATUS)))
(printout PROMPTWINDOW .TAB0 0 (CDR (SETQ STATUS
NEWSTATUS)))
(SELECTC (CAR STATUS)
((LIST \PS.BUSY \PS.NOTSPOOLING)
(* It may be a while. Maybe I should abort in case of
NOT SPOOLING, but by convention we just wait)
(SETQ TIMEOUT \EFTP.LONGTIMEOUT))
NIL)))
(SETQ CHECKSTATUS NIL)))
[COND
((SETQ IPUP (EXCHANGEPUPS SOC OPUP NIL NIL TIMEOUT))
(SELECTC (fetch PUPTYPE of IPUP)
[\EFTP.ACK (COND
((EQ (PROG1 (fetch PUPID of IPUP)
(RELEASE.PUP IPUP))
ID)
(* Packet acknowledged, proceed normally)
(add ID 1)
(add CURPAGE# 1)
(COND
(ENDING
(* Acknowledged the END signal.
We now echo the END one bigger, so that the receiver
can stop dallying)
(replace PUPID of OPUP with ID)
(SENDPUP SOC OPUP)
(GO DONE))
(T (GO NEWPAGE]
(\EFTP.ABORT (COND
(PUPTRACEFLG (PRIN1 "[abort]" PUPTRACEFILE)))
(SELECTC (PROG1 (\GETPUPWORD IPUP 0)
(* EFTP abort code)
(RELEASE.PUP IPUP))
(\EABORT.RECEIVER
(* it didn't like the file for some reason)
(SETQ RESULT
(CONS (QUOTE REJECT)
(GETPUPSTRING
IPUP 2)))
(GO ABORT))
(\EABORT.BUSY (DISMISS \EFTP.LONGTIMEOUT)
)
(\EABORT.SYNCH
(* Out of synch--start over))
NIL)
(GO RESTART))
(RELEASE.PUP IPUP]
(COND
((AND PRINTOPTIONS (EQ ID 0)) (* What's going on? Check status again)
(SETQ CHECKSTATUS T)))
finally (COND
(ENDING (* Well , we never got the end acknowledged, but it
probably worked)
(GO DONE))
(T (printout PROMPTWINDOW .TAB0 0 "[No response from " HOST "]")
(GO RESTART]
DONE (* succeeded, flush abort code)
(FRPLACA ABORTER (QUOTE *))
(SETQ RESULT (fetch FULLNAME of STREAM))
ABORT
(RETURN RESULT])
(\ABORT.EFTP
[LAMBDA (SOC PUP) (* bvm: " 3-NOV-82 11:17")
(* * Aborts the EFTP transfer in progress to SOC, using PUP for an output pup)
(replace PUPTYPE of PUP with \EFTP.ABORT)
(replace PUPLENGTH of PUP with (ADD1 \PUPOVLEN))
(\PUTBASE (fetch PUPCONTENTS of PUP)
0 \EABORT.SENDER)
(SENDPUP SOC PUP])
(PUP.PRINTER.STATUS
[LAMBDA (PRINTER) (* bvm: "13-Dec-83 15:55")
(* * Checks status of printer, returns a dotted pair (statuscode . string))
(PROG ((HOSTPORT (BESTPUPADDRESS PRINTER PROMPTWINDOW))
(SOC (\GETMISCSOCKET))
(OPUP (ALLOCATE.PUP))
RESULT IPUP)
(OR HOSTPORT (RETURN))
(SETUPPUP OPUP HOSTPORT \PUPSOCKET.PRINTERSTATUS \PT.PRINTERSTATUS NIL SOC)
(to \MAXETHERTRIES when (SETQ IPUP (EXCHANGEPUPS SOC OPUP NIL T))
do (SELECTC (fetch PUPTYPE of IPUP)
[\PT.STATUSRESPONSE (RETURN (PROG1 (SETQ RESULT
(CONS (\GETBASE (fetch PUPCONTENTS
of IPUP)
0)
(GETPUPSTRING IPUP 2)))
(RELEASE.PUP IPUP]
(\PT.ERROR (AND PUPTRACEFLG (PRINTERRORPUP IPUP PUPTRACEFILE))
(RETURN (RELEASE.PUP IPUP)))
(RELEASE.PUP IPUP))
finally (PUPDEBUGGING "Printer status request timed out" T))
(RELEASE.PUP OPUP)
(RETURN RESULT])
(PUP.PRINTER.PROPERTIES
[LAMBDA (PRINTER) (* bvm: " 1-NOV-83 16:00")
(* * Asks printer about its capabilities, returns property list)
(PROG ((HOSTPORT (BESTPUPADDRESS PRINTER PROMPTWINDOW))
(SOC (\GETMISCSOCKET))
(OPUP (ALLOCATE.PUP))
RESULT IPUP)
(OR HOSTPORT (RETURN))
(SETUPPUP OPUP HOSTPORT \PUPSOCKET.PRINTERSTATUS \PT.PRINTERCAPABILITY NIL SOC)
(to \MAXETHERTRIES when (SETQ IPUP (EXCHANGEPUPS SOC OPUP NIL T))
do (SELECTC (fetch PUPTYPE of IPUP)
[\PT.CAPABILITYRESPONSE (RETURN (SETQ RESULT (READPLIST (GETPUPSTREAM IPUP]
(\PT.ERROR (AND PUPTRACEFLG (PRINTERRORPUP IPUP PUPTRACEFILE))
(RETURN))
NIL)
finally (PUPDEBUGGING "Printer capability request timed out" T))
(AND IPUP (RELEASE.PUP IPUP))
(RETURN RESULT])
)
(DECLARE: DONTCOPY
(RPAQQ EFTPPUPTYPES ((\EFTP.DATA 24)
(\EFTP.ACK 25)
(\EFTP.END 26)
(\EFTP.ABORT 27)))
(DECLARE: EVAL@COMPILE
(RPAQQ \EFTP.DATA 24)
(RPAQQ \EFTP.ACK 25)
(RPAQQ \EFTP.END 26)
(RPAQQ \EFTP.ABORT 27)
(CONSTANTS (\EFTP.DATA 24)
(\EFTP.ACK 25)
(\EFTP.END 26)
(\EFTP.ABORT 27))
)
(RPAQQ EFTPCONSTANTS ((\EABORT.SENDER 1)
(\EABORT.RECEIVER 2)
(\EABORT.BUSY 3)
(\EABORT.SYNCH 4)
(\EABORT.LONGWAIT 6)
(\EABORT.MEDWAIT 7)
(\EABORT.SUSPEND 8)
(\PS.NOTSPOOLING 1)
(\PS.IDLE 2)
(\PS.BUSY 3)
(\SPRUCEPWD1 43724)
(\SPRUCEPWD2 61695)))
(DECLARE: EVAL@COMPILE
(RPAQQ \EABORT.SENDER 1)
(RPAQQ \EABORT.RECEIVER 2)
(RPAQQ \EABORT.BUSY 3)
(RPAQQ \EABORT.SYNCH 4)
(RPAQQ \EABORT.LONGWAIT 6)
(RPAQQ \EABORT.MEDWAIT 7)
(RPAQQ \EABORT.SUSPEND 8)
(RPAQQ \PS.NOTSPOOLING 1)
(RPAQQ \PS.IDLE 2)
(RPAQQ \PS.BUSY 3)
(RPAQQ \SPRUCEPWD1 43724)
(RPAQQ \SPRUCEPWD2 61695)
(CONSTANTS (\EABORT.SENDER 1)
(\EABORT.RECEIVER 2)
(\EABORT.BUSY 3)
(\EABORT.SYNCH 4)
(\EABORT.LONGWAIT 6)
(\EABORT.MEDWAIT 7)
(\EABORT.SUSPEND 8)
(\PS.NOTSPOOLING 1)
(\PS.IDLE 2)
(\PS.BUSY 3)
(\SPRUCEPWD1 43724)
(\SPRUCEPWD2 61695))
)
(ADDTOVAR PUPTYPES (\EFTP.DATA 24)
(\EFTP.ACK 25)
(\EFTP.END 26)
(\EFTP.ABORT 27))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \EFTP.TIMEOUT \EFTP.LONGTIMEOUT)
)
)
(RPAQ? \EFTP.TIMEOUT 5000)
(RPAQ? \EFTP.LONGTIMEOUT 15000)
(PUTPROPS PUPPRINT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (617 11884 (EFTP 627 . 9294) (\ABORT.EFTP 9296 . 9732) (PUP.PRINTER.STATUS 9734 . 10892)
(PUP.PRINTER.PROPERTIES 10894 . 11882)))))
STOP