(FILECREATED " 2-Jun-85 17:03:59" {ERIS}<LISPCORE>LIBRARY>PUPCHAT.;2 10900
changes to: (VARS PUPCHATCOMS)
previous date: "29-Dec-84 15:00:06" {ERIS}<LISPCORE>LIBRARY>PUPCHAT.;1)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PUPCHATCOMS)
(RPAQQ PUPCHATCOMS [(COMS (* CHAT stream methods.)
(FNS PUPCHAT.HOST.FILTER PUPCHAT.OPEN PUPCHAT.SENDSCREENPARAMS
PUPCHAT.SETDISPLAYTYPE PUPCHAT.FLUSH&WAIT PUPCHAT.LOGINFO
\PUPCHAT.FLUSH))
(COMS (* BSP exceptions)
(FNS PUPCHAT.PUPHANDLER PUPCHAT.ERRORHANDLER PUPCHAT.HANDLEMARK))
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (\PT.WHEREISUSER 152)
(\PT.WHEREUSERRESPONSE 153)
(\PT.WHEREUSERERROR 154)
(\PUPSOCKET.TELNET 1)
(\PUPSOCKET.MISCSERVICES 4))
(CONSTANTS * CHATMARKTYPES))
(ALISTS (PUPPRINTMACROS 152 154))
(FILES CHAT BSP)
(ADDVARS (CHAT.PROTOCOLTYPES (PUP . PUPCHAT.HOST.FILTER])
(* CHAT stream methods.)
(DEFINEQ
(PUPCHAT.HOST.FILTER
(LAMBDA (NAME) (* ejs: "29-Dec-84 14:20")
(* * Return PUPCHAT.OPEN if NAME is a pup host with a telnet server.)
(AND (SETQ NAME (\CANONICAL.HOSTNAME NAME))
(LIST NAME (FUNCTION PUPCHAT.OPEN)))))
(PUPCHAT.OPEN
(LAMBDA (HOST) (* bvm: "25-Sep-84 16:06")
(* * Return a pair of BSP streams for a chat connection, or NIL. Add CHAT specific operations to the STREAM via
STREAMPROP.)
(PROG (STREAM PORT)
(RETURN (COND
((AND (SETQ PORT (BESTPUPADDRESS HOST PROMPTWINDOW))
(SETQ STREAM (OPENBSPSTREAM (COND
((ZEROP (CDR PORT))
(CONS (CAR PORT)
\PUPSOCKET.TELNET))
(T PORT))
(FUNCTION PUPCHAT.PUPHANDLER)
(FUNCTION PUPCHAT.ERRORHANDLER)
NIL NIL NIL "Can't open Chat connection")))
(STREAMPROP STREAM (QUOTE MARKCOUNT)
0)
(STREAMPROP STREAM (QUOTE SYNCHCOUNT)
0)
(STREAMPROP STREAM (QUOTE SETDISPLAYTYPE)
(FUNCTION PUPCHAT.SETDISPLAYTYPE))
(STREAMPROP STREAM (QUOTE LOGINFO)
(FUNCTION PUPCHAT.LOGINFO))
(STREAMPROP STREAM (QUOTE FLUSH&WAIT)
(FUNCTION PUPCHAT.FLUSH&WAIT))
(STREAMPROP STREAM (QUOTE SENDSCREENPARAMS)
(FUNCTION PUPCHAT.SENDSCREENPARAMS))
(CONS STREAM (BSPOUTPUTSTREAM STREAM))))))))
(PUPCHAT.SENDSCREENPARAMS
(LAMBDA (SOCKET HEIGHT WIDTH) (* rda: "21-Aug-84 14:30")
(* * Tell partner about screen dimens.)
(PROG ((OUTSTREAM (BSPOUTPUTSTREAM SOCKET)))
(BSPPUTMARK OUTSTREAM \MARK.PAGELENGTH)
(BSPBOUT OUTSTREAM HEIGHT)
(BSPPUTMARK OUTSTREAM \MARK.LINEWIDTH)
(BSPBOUT OUTSTREAM WIDTH)
(RETURN T))))
(PUPCHAT.SETDISPLAYTYPE
(LAMBDA (SOCKET CODE) (* rda: "21-Aug-84 14:31")
(PROG ((OUTSTREAM (BSPOUTPUTSTREAM SOCKET)))
(BSPPUTMARK OUTSTREAM \MARK.TERMTYPE)
(BSPBOUT OUTSTREAM CODE)
(RETURN T))))
(PUPCHAT.FLUSH&WAIT
(LAMBDA (SOCKET) (* rda: "21-Aug-84 14:35")
(* * Make sure all output to BSPSTREAM has been read by the remote process)
(PROG ((OUTSTREAM (BSPOUTPUTSTREAM SOCKET)))
(BSPFORCEOUTPUT OUTSTREAM)
(STREAMPROP SOCKET (QUOTE MARKCOUNT)
(ADD1 (STREAMPROP SOCKET (QUOTE MARKCOUNT))))
(BSPPUTMARK OUTSTREAM \MARK.TIMING)
(until (ILESSP (STREAMPROP SOCKET (QUOTE MARKCOUNT))
1)
do (BLOCK))
(RETURN T))))
(PUPCHAT.LOGINFO
(LAMBDA (HOST USER) (* bvm: "14-FEB-83 10:40")
(PROG ((OPUP (ALLOCATE.PUP))
SOC LEN IPUP)
(SETUPPUP OPUP HOST \PUPSOCKET.MISCSERVICES \PT.WHEREISUSER NIL (SETQ SOC (\GETMISCSOCKET))
T)
(PUTPUPSTRING OPUP USER)
(RETURN (to \MAXETHERTRIES when (SETQ IPUP (EXCHANGEPUPS SOC OPUP NIL T))
do (SELECTC (fetch PUPTYPE of IPUP)
(\PT.WHEREUSERRESPONSE
(RETURN (COND
((IGREATERP (SETQ LEN (IDIFFERENCE (fetch PUPLENGTH
of IPUP)
\PUPOVLEN))
0)
(for (I ← 1) to LEN by 2
bind (DATA ←(fetch PUPCONTENTS of IPUP))
JOB
do (COND
((EQ (\GETBASEBYTE DATA I)
255)
(* Term=377Q means detached)
(COND
(JOB
(* More than one detached job, punt)
(RETURN (QUOTE WHERE)))
(T (SETQ JOB (\GETBASEBYTE DATA
(SUB1 I)))))))
finally (RETURN (COND
(JOB (QUOTE ATTACH))
(T (QUOTE LOGIN))))))
(T (QUOTE LOGIN)))))
(\PT.WHEREUSERERROR (RETURN))
(\PT.ERROR (COND
((EQ (fetch ERRORPUPCODE of IPUP)
2) (* No such port)
(RETURN))))
NIL))))))
(\PUPCHAT.FLUSH
(LAMBDA (STREAM) (* bvm: "25-Sep-84 16:13")
(* * Read chars from STREAM until the SYNCHCOUNT prop goes to zero. Used as the temporary STRMBINFN of STREAM when a
synch attention is received)
(replace STRMBINFN of STREAM with (STREAMPROP STREAM (QUOTE OLDBINFN)))
(while (IGREATERP (STREAMPROP STREAM (QUOTE SYNCHCOUNT))
0)
do (if (EQ (BIN STREAM)
-1)
then (* Connection closed before timing mark arrived)
(RETURN -1))
finally (RETURN (BIN STREAM)))))
)
(* BSP exceptions)
(DEFINEQ
(PUPCHAT.PUPHANDLER
(LAMBDA (PUP SOCKET) (* bvm: "25-Sep-84 16:22")
(DECLARE (GLOBALVARS PUPTRACEFILE))
(* * called on error, interrupt and non-bsp pups. Anything that we'd be inclined to print to T is queued up for
CHAT.TYPEOUT to handle)
(PROG (OFFSET TYPE)
(if (SELECTC (fetch PUPTYPE of PUP)
(\PT.ERROR (* For now don't filter out abort errors)
(if (EQ (fetch ERRORPUPCODE of PUP)
2)
then (SETQ TYPE "Error")
(SETQ OFFSET 24)
T
elseif PUPTRACEFLG
then (PRINTERRORPUP PUP PUPTRACEFILE)
NIL))
(\PT.ABORT (SETQ TYPE "Abort")
(SETQ OFFSET 2))
(\PT.INTERRUPT
(* Synch. Means flush any output waiting to be processed up until the matching Synch Mark. Increment the count of
outstanding synchs and replace the BIN fn for the stream to cause incoming chars to be flushed.)
(if (EQ (STREAMPROP SOCKET (QUOTE SYNCHCOUNT)
(ADD1 (STREAMPROP SOCKET (QUOTE SYNCHCOUNT))
))
1)
then (STREAMPROP SOCKET (QUOTE OLDBINFN)
(fetch STRMBINFN of SOCKET))
(replace STRMBINFN of SOCKET
with (FUNCTION \PUPCHAT.FLUSH)))
NIL)
(COND
(PUPTRACEFLG (PRIN1 "{Strange pup: " PUPTRACEFILE)
(PRINTCONSTANT (fetch PUPTYPE of PUP)
PUPTYPES PUPTRACEFILE)
(PRIN1 "}" PUPTRACEFILE)
NIL)))
then (ADD.CHAT.MESSAGE SOCKET (CONCAT "[" TYPE " -- " (GETPUPSTRING PUP OFFSET)
"]")))
(RELEASE.PUP PUP))))
(PUPCHAT.ERRORHANDLER
(LAMBDA (SOCKET ERRCODE) (* rda: "24-Aug-84 22:53")
(PROG (STATE)
(RETURN (SELECTQ ERRCODE
(MARK.ENCOUNTERED (PUPCHAT.HANDLEMARK SOCKET PROMPTWINDOW)
(\BIN SOCKET))
(COND
((BSPOPENP SOCKET (QUOTE BOTH))
(* non-fatal error?)
(ADD.CHAT.MESSAGE SOCKET (CONCAT "[PUP error " ERRCODE "]"))
(\BIN SOCKET))
(T (\EOF.ACTION SOCKET))))))))
(PUPCHAT.HANDLEMARK
(LAMBDA (SOCKET CHATSTATE TTYFILE) (* bvm: "25-Sep-84 16:07")
(PROG ((MARK (BSPGETMARK SOCKET)))
(SELECTC MARK
(\MARK.TIMING (* For synchronization)
(BSPPUTMARK SOCKET \MARK.TIMINGREPLY))
(\MARK.SYNC (* Decrement the synchcount.
\PUPCHAT.FLUSH will notice if it's gone to zero and
reset the STRMBINFN.)
(STREAMPROP SOCKET (QUOTE SYNCHCOUNT)
(SUB1 (STREAMPROP SOCKET (QUOTE SYNCHCOUNT)))))
(\MARK.TIMINGREPLY (* For synchronization)
(STREAMPROP SOCKET (QUOTE MARKCOUNT)
(SUB1 (STREAMPROP SOCKET (QUOTE MARKCOUNT)))))
(PROGN (ADD.CHAT.MESSAGE SOCKET (CONCAT "[Mark " MARK "]")))))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \PT.WHEREISUSER 152)
(RPAQQ \PT.WHEREUSERRESPONSE 153)
(RPAQQ \PT.WHEREUSERERROR 154)
(RPAQQ \PUPSOCKET.TELNET 1)
(RPAQQ \PUPSOCKET.MISCSERVICES 4)
(CONSTANTS (\PT.WHEREISUSER 152)
(\PT.WHEREUSERRESPONSE 153)
(\PT.WHEREUSERERROR 154)
(\PUPSOCKET.TELNET 1)
(\PUPSOCKET.MISCSERVICES 4))
)
(RPAQQ CHATMARKTYPES ((\MARK.SYNC 1)
(\MARK.LINEWIDTH 2)
(\MARK.PAGELENGTH 3)
(\MARK.TERMTYPE 4)
(\MARK.TIMING 5)
(\MARK.TIMINGREPLY 6)))
(DECLARE: EVAL@COMPILE
(RPAQQ \MARK.SYNC 1)
(RPAQQ \MARK.LINEWIDTH 2)
(RPAQQ \MARK.PAGELENGTH 3)
(RPAQQ \MARK.TERMTYPE 4)
(RPAQQ \MARK.TIMING 5)
(RPAQQ \MARK.TIMINGREPLY 6)
(CONSTANTS (\MARK.SYNC 1)
(\MARK.LINEWIDTH 2)
(\MARK.PAGELENGTH 3)
(\MARK.TERMTYPE 4)
(\MARK.TIMING 5)
(\MARK.TIMINGREPLY 6))
)
)
(ADDTOVAR PUPPRINTMACROS (152 CHARS)
(154 CHARS))
(FILESLOAD CHAT BSP)
(ADDTOVAR CHAT.PROTOCOLTYPES (PUP . PUPCHAT.HOST.FILTER))
(PUTPROPS PUPCHAT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1057 6358 (PUPCHAT.HOST.FILTER 1067 . 1379) (PUPCHAT.OPEN 1381 . 2666) (
PUPCHAT.SENDSCREENPARAMS 2668 . 3119) (PUPCHAT.SETDISPLAYTYPE 3121 . 3416) (PUPCHAT.FLUSH&WAIT 3418 .
4035) (PUPCHAT.LOGINFO 4037 . 5649) (\PUPCHAT.FLUSH 5651 . 6356)) (6386 9742 (PUPCHAT.PUPHANDLER 6396
. 8252) (PUPCHAT.ERRORHANDLER 8254 . 8835) (PUPCHAT.HANDLEMARK 8837 . 9740)))))
STOP