(FILECREATED "29-May-87 10:26:45" {MCS:MCS:STANFORD}<LANE>TALK.LSP;175
changes to: (VARS TALKCOMS (PROGN TALK.TEDIT.ADVISEDFNS))
(FNS TALK.IP.PROTOCOLP TALK.TEDIT.READVISE)
previous date: "21-May-87 10:31:34" {MCS:MCS:STANFORD}<LANE>TALK.LSP;173)
(* Copyright (c) 1987 by Stanford University. All rights reserved.)
(PRETTYCOMPRINT TALKCOMS)
(RPAQQ TALKCOMS [(* * TALK server/client code)
(LOCALVARS . T)
(FNS TALK)
(FNS TALK.PROCESS TALK.DISPLAY TALK.LISTEN TALK.CLOSEFN TALK.USERFN TALK.ANSWER
TALK.ANSWER.WINDOW TALK.ANSWER.USERNAME TALK.GET.NAME TALK.ADD.NAME TALK.FLASH.CARET
TALK.WHENSELECTEDFN TALK.RINGBELLS)
(FNS TALK.TEDIT.DISPLAY TALK.TEDIT.LISTEN TALK.TEDIT.CHARFN)
(FNS TALK.TTY.DISPLAY TALK.TTY.LISTEN TALK.TTY.CHARFN)
(FNS TALK.ICON.BUTTONEVENTFN TALK.ICON.CLOSEFN)
(* * TALK TEdit hooks)
(FNS TALK.TEDIT.INSERT TALK.TEDIT.DELETE TALK.TEDIT.BACKSPACE TALK.TEDIT.UNDO TALK.TEDIT.REDO
TALK.TEDIT.WORDDELETE TALK.SELFN TALK.SETSELFN TALK.TEDIT.SETSEL TALK.IMAGEOBJFN
TALK.TEDIT.INSERT.OBJECT TALK.LOOKSFN TALK.TEDIT.LOOKS TALK.PARAFN TALK.TEDIT.PARALOOKS
TALK.INSERTFN TALK.TEDIT.INSERT.TEXT TALK.INCLUDEFN TALK.TEDIT.INCLUDE TALK.DELETEFN
TALK.TEDIT.DELETE.TEXT TALK.GETFN TALK.TEDIT.GET)
(FNS TALK.ENCODE.SEL TALK.DECODE.SEL)
(* * TALK data)
(DECLARE: DONTCOPY (MACROS TALKOPCODE)
(RECORDS TALK.SERVICETYPE TALK.PROTOCOLTYPE))
(VARS TALK.ACTIONS TALK.MENU.ITEMS TALK.USER.MESSAGES)
(ADDVARS (TALK.SERVICETYPES (TEdit [LAMBDA NIL (FGETD (QUOTE OPENTEXTSTREAM]
TALK.TEDIT.DISPLAY TALK.TEDIT.LISTEN)
(TTY TRUE TALK.TTY.DISPLAY TALK.TTY.LISTEN)))
(INITVARS TALK.GAG TALK.PROTOCOLTYPES TALK.HOSTNAMES TALK.ICON.WINDOWS (TALK.ANSWER.WAIT
15)
(TALK.READTABLE (COPYREADTABLE (QUOTE ORIG)))
(TALK.TERMTABLE (COPYTERMTABLE (QUOTE ORIG)))
(TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500))
(TALK.TTY.FONT DEFAULTFONT)
(TALK.ICON.FONT LITTLEFONT))
(VARS TALK.FROM.TEDIT.PROPS TALK.TO.TEDIT.PROPS)
(GLOBALVARS TALK.ACTIONS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.GAG
TALK.PROTOCOLTYPES TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT
TALK.READTABLE TALK.TERMTABLE TALK.DEFAULT.REGION TALK.TTY.FONT TALK.ICON.FONT
TALK.TO.TEDIT.PROPS TALK.FROM.TEDIT.PROPS)
(* * NS GAP Interface)
(FNS CH.USER.WORKSTATION)
(FNS TALK.NS.HOSTNAME TALK.NS.USERNAME TALK.NS.CONNECT TALK.NS.EVENT TALK.NS.CREDENTIALS)
(FNS TALK.TEDIT.SERVER TALK.TTY.SERVER)
(FNS GAP.SERVER DEFINE.GAP.SERVER)
(ADDVARS (GAP.SERVICETYPES (5 TTY TALK.TTY.SERVER)
(6 TEdit TALK.TEDIT.SERVER))
(TALK.PROTOCOLTYPES (NS TRUE TALK.NS.HOSTNAME TALK.NS.USERNAME TALK.NS.CONNECT
TALK.NS.EVENT)))
[INITVARS (TALK.GAP.HANDLE (QUOTE ((0 0]
(VARS TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT GAP.ADDITIONAL.ERRORS)
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT
GAP.ADDITIONAL.ERRORS)
(DECLARE: DONTCOPY (RECORDS GAP.SERVICETYPE))
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE (FILES ETHERRECORDS (LOADCOMP)
SPP))
(* * Interim IP Interface)
(FNS TALK.START.IP.SERVER TALK.IP.SERVER TALK.IP.USERNAME TALK.IP.EVENT TALK.IP.CONNECT
TALK.IP.PROTOCOLP)
(INITVARS (TALK.UDP.PORT 517))
(APPENDVARS (TALK.PROTOCOLTYPES (IP TALK.IP.PROTOCOLP DODIP.HOSTP TALK.IP.USERNAME
TALK.IP.CONNECT TALK.IP.EVENT)))
(GLOBALVARS TALK.UDP.PORT)
(DECLARE: DONTCOPY (RECORDS TALK.IP.PACKET))
(* * etc.)
(DECLARE: DONTCOPY (CONSTANTS (COURIER.SOCKET 5)))
(FILES COURIERSERVE)
(FNS TALK.TEDIT.READVISE COURIER.RESET.SOCKET)
(APPENDVARS (BACKGROUNDFNS COURIER.START.SERVER)
(BEFORELOGOUTFORMS (COURIER.RESET.SOCKET)))
(ADDVARS (TALK.TEDIT.ADVISEDFNS TEDIT.SETSEL TEDIT.INSERT TEDIT.DELETE TEDIT.INSERT.OBJECT
TEDIT.LOOKS TEDIT.PARALOOKS OPENFILE-IN-TEDIT.INCLUDE))
(ADVICE * (PROGN TALK.TEDIT.ADVISEDFNS))
(DECLARE: DONTCOPY DOEVAL@COMPILE
(ALISTS (CHARACTERNAMES UNDO REDO NEXT MARGINS FONT SHIFT.UNDO SHIFT.REDO
SHIFT.NEXT SHIFT.MARGINS SHIFT.FONT SHIFT.DEL)))
(ALISTS (BackgroundMenuCommands Talk))
(VARS (BackgroundMenu))
(BITMAPS TALK.ICON.BITMAP)
(GLOBALVARS TALK.TEDIT.ADVISEDFNS TALK.ICON.BITMAP COURIER.SOCKET)
(P (if (FGETD (QUOTE OPENTEXTSTREAM))
then
(TALK.TEDIT.READVISE))
(SETSYNTAX (CHARCODE SPACE)
(CHARCODE A)
TALK.READTABLE)
(ECHOCHAR (CHARCODE BS)
(QUOTE IGNORE)
TALK.TERMTABLE)
(COURIER.START.SERVER)
(TALK.START.IP.SERVER))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA TALK.USERFN])
(* * TALK server/client code)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DEFINEQ
(TALK
[LAMBDA (USER.OR.HOSTNAME SERVICE PROTOCOL) (* cdl "21-May-87 09:19")
(* DECLARATIONS: (RECORD RESULT
(SERVICE INPUTSTREAM . OUTPUTSTREAM)))
(PROG (USER ADDRESS PROTOCOLTYPE PROTOCOLTYPES SERVICETYPE RESULT)
(if (NULL USER.OR.HOSTNAME)
then (if (NULL (SETQ USER.OR.HOSTNAME (TALK.GET.NAME)))
then (RETURN)))
[if PROTOCOL
then (if (SETQ PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES))
then (if (with TALK.PROTOCOLTYPE PROTOCOLTYPE (APPLY*
TALK.PROTOCOLP))
then (SETQ PROTOCOLTYPES (LIST PROTOCOLTYPE))
else (RETURN (LIST "Protocol not available!" PROTOCOL)))
else (RETURN (LIST "Unknown protocol!" PROTOCOL)))
else (if (NULL (SETQ PROTOCOLTYPES (for PROTOCOLTYPE in TALK.PROTOCOLTYPES
when (with TALK.PROTOCOLTYPE
PROTOCOLTYPE (APPLY*
TALK.PROTOCOLP))
collect PROTOCOLTYPE)))
then (RETURN (LIST "No protocols available!" PROTOCOL]
(if [SETQ PROTOCOLTYPE (for PROTOCOLTYPE in PROTOCOLTYPES
thereis (with TALK.PROTOCOLTYPE PROTOCOLTYPE
(SETQ ADDRESS (APPLY* TALK.HOSTNAMEFN
USER.OR.HOSTNAME]
then (TALK.ADD.NAME USER.OR.HOSTNAME ADDRESS)
else (RETURN (LIST "Host not found!" USER.OR.HOSTNAME)))
[if SERVICE
then (if (NOT (ASSOC SERVICE TALK.SERVICETYPES))
then (RETURN (LIST "Unknown service type!" SERVICE)))
else (SETQ SERVICE (for SERVICETYPE in TALK.SERVICETYPES
when (with TALK.SERVICETYPE SERVICETYPE (APPLY*
TALK.SERVICEP))
collect (with TALK.SERVICETYPE SERVICETYPE
TALK.SERVICENAME]
(SELECTQ (SETQ RESULT (APPLY* (with TALK.PROTOCOLTYPE PROTOCOLTYPE TALK.CONNECTFN)
ADDRESS SERVICE))
((NIL CONNECT)
(RETURN "Can't connect to host!"))
(ANSWER (RETURN "No answer from TALK service!"))
(with RESULT RESULT (with TALK.PROTOCOLTYPE PROTOCOLTYPE
(RETURN (TALK.PROCESS INPUTSTREAM
OUTPUTSTREAM SERVICE
TALK.PROTOCOLNAME
(QUOTE CLIENT)
USER.OR.HOSTNAME T])
)
(DEFINEQ
(TALK.PROCESS
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICE PROTOCOL MODE USER SPAWN?)
(* cdl "10-May-87 10:27")
(LET ((DISPLAYSTREAM (TALK.DISPLAY INPUTSTREAM OUTPUTSTREAM SERVICE PROTOCOL MODE USER)))
(if SPAWN?
then (ADD.PROCESS (BQUOTE (TALK.LISTEN , INPUTSTREAM , OUTPUTSTREAM ,
(KWOTE SERVICE)
,
(KWOTE PROTOCOL)
, DISPLAYSTREAM)))
else (TALK.LISTEN INPUTSTREAM OUTPUTSTREAM SERVICE PROTOCOL DISPLAYSTREAM])
(TALK.DISPLAY
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICE PROTOCOL MODE USER)
(* cdl "10-May-87 10:14")
(* DECLARATIONS: (ASSOCRECORD MESSAGES
(GREETING)))
(LET (MAINWINDOW WINDOW REGION GREETING)
(DECLARE (SPECVARS GREETING))
(SETQ USER (with TALK.PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)
(APPLY* TALK.USERNAMEFN INPUTSTREAM OUTPUTSTREAM SERVICE MODE USER)))
(with REGION (SETQ REGION (if (REGIONP TALK.DEFAULT.REGION)
then (with REGION TALK.DEFAULT.REGION
(GETBOXREGION WIDTH HEIGHT))
else (GETREGION)))
(SETQ HEIGHT (QUOTIENT HEIGHT 2)))
(SETQ MAINWINDOW (CREATEW (with REGION REGION (create REGION
BOTTOM ←(PLUS BOTTOM HEIGHT)
using REGION))
(PACK* "TALK (" SERVICE ")")))
(SETQ WINDOW (CREATEW REGION (CONCAT "(" PROTOCOL ") Talk from " USER)))
(WINDOWPROP MAINWINDOW (QUOTE STREAMS)
(CONS INPUTSTREAM OUTPUTSTREAM))
(WINDOWADDPROP MAINWINDOW (QUOTE CLOSEFN)
(FUNCTION TALK.CLOSEFN))
(ATTACHWINDOW WINDOW MAINWINDOW (QUOTE BOTTOM))
(ATTACHMENU (create MENU
ITEMS ← TALK.MENU.ITEMS
CENTERFLG ← T
MENUBORDERSIZE ← 1
WHENSELECTEDFN ←(FUNCTION TALK.WHENSELECTEDFN))
WINDOW
(QUOTE BOTTOM))
(with TALK.SERVICETYPE (ASSOC SERVICE TALK.SERVICETYPES)
(APPLY* TALK.DISPLAYFN MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL USER))
(if (AND (SETQ GREETING (CAR (with MESSAGES TALK.USER.MESSAGES GREETING)))
(SETQ GREETING (ERRORSET GREETING)))
then (BKSYSBUF (CAR GREETING)))
WINDOW])
(TALK.LISTEN
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICE PROTOCOL WINDOW)
(* cdl "10-May-87 10:28")
(PROG ((MAINWINDOW (MAINWINDOW WINDOW))
(STRING " -- Connection Closed")
ICON TEXTOBJ PROCESS)
(with TALK.SERVICETYPE (ASSOC SERVICE TALK.SERVICETYPES)
(APPLY* TALK.LISTENFN WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL))
(TTY.PROCESS T)
(CLOSEF? INPUTSTREAM)
(if [OR (OPENWP WINDOW)
(for PROP in (QUOTE (ICON ICONWINDOW))
thereis (OPENWP (SETQ ICON (WINDOWPROP MAINWINDOW PROP]
then (WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (WINDOWPROP WINDOW (QUOTE TITLE))
STRING))
(for WINDOW in (ATTACHEDWINDOWS WINDOW) when (WINDOWPROP
WINDOW
(QUOTE MENU))
do (if (DETACHWINDOW WINDOW)
then (CLOSEW WINDOW)))
(if (SETQ TEXTOBJ (WINDOWPROP MAINWINDOW (QUOTE TEXTOBJ)))
then (with TEXTOBJ TEXTOBJ (SETQ TXTFILE (CONCAT TXTFILE STRING)))
else (WINDOWPROP MAINWINDOW (QUOTE ICON)
(CONCAT (WINDOWPROP MAINWINDOW (QUOTE ICON))
STRING)))
(if ICON
then (SHRINKW MAINWINDOW)
else (FLASHWINDOW WINDOW)))
(if (PROCESSP (SETQ PROCESS (WINDOWPROP MAINWINDOW (QUOTE TALK.TTY.PROCESS)
NIL)))
then (DEL.PROCESS PROCESS])
(TALK.CLOSEFN
[LAMBDA (WINDOW) (* cdl " 7-May-87 19:37")
(* DECLARATIONS: (RECORD STREAMS
(INPUTSTREAM . OUTPUTSTREAM)))
(LET ((STREAMS (WINDOWPROP WINDOW (QUOTE STREAMS)
NIL)))
(if STREAMS
then (with STREAMS STREAMS (CLOSEF? INPUTSTREAM)
(CLOSEF? OUTPUTSTREAM])
(TALK.USERFN
[LAMBDA VAR (* cdl " 2-Mar-87 09:53")
(LET [(USERFN (TEXTPROP (ARG VAR 2)
(ARG VAR 1]
(if USERFN
then (APPLY USERFN (for M from 2 to VAR collect (ARG VAR M])
(TALK.ANSWER
[LAMBDA (USERNAME SERVICE PROTOCOL ADDRESS) (* cdl "13-May-87 14:12")
(LET [WINDOW REGION (EVENT (CREATE.EVENT))
(TIME (DATE (QUOTE (DATEFORMAT NO.SECONDS]
(DECLARE (GLOBALVARS \IDLING))
(PROGN (* Only really necessary if you're talking to
yourself)
(SPAWN.MOUSE))
(WINDOWPROP (SETQ WINDOW (TALK.ANSWER.WINDOW USERNAME))
(QUOTE EVENT)
EVENT)
(BITBLT TALK.ICON.BITMAP NIL NIL WINDOW)
[SETQ REGION (with REGION (DSPCLIPPINGREGION NIL WINDOW)
(CREATEREGION LEFT BOTTOM WIDTH (QUOTIENT HEIGHT 3]
(CENTERPRINTINREGION (CONCAT SERVICE "(" PROTOCOL ")")
(with REGION REGION (CREATEREGION LEFT BOTTOM WIDTH
(DIFFERENCE HEIGHT 7)))
WINDOW)
(DSPFONT (PROG1 (DSPFONT TALK.ICON.FONT WINDOW)
(CENTERPRINTINREGION (CONCAT (SUBSTRING TIME 1 6)
(SUBSTRING TIME 10 -1))
(with REGION REGION (add BOTTOM HEIGHT)
(CREATEREGION LEFT BOTTOM WIDTH
(DIFFERENCE HEIGHT 7)))
WINDOW))
WINDOW)
(if USERNAME
then (TALK.ADD.NAME USERNAME ADDRESS)
(with REGION REGION (add BOTTOM HEIGHT)
(TALK.ANSWER.USERNAME USERNAME (CREATEREGION LEFT BOTTOM WIDTH
(DIFFERENCE HEIGHT 7))
WINDOW)))
(TALK.RINGBELLS WINDOW)
(if (AND [STRINGP (AWAIT.EVENT EVENT (TIMES TALK.ANSWER.WAIT (if \IDLING
then
(* Provide extra time to login)
2000
else 1000]
USERNAME)
then (* We timed out, leave the icon up but change its
functionality)
(WINDOWPROP WINDOW (QUOTE ADDRESS)
ADDRESS)
(WINDOWPROP WINDOW (QUOTE USERNAME)
USERNAME)
(WINDOWPROP WINDOW (QUOTE PROTOCOL)
PROTOCOL)
(WINDOWPROP WINDOW (QUOTE EVENT)
NIL)
(INVERTW WINDOW)
else (WINDOWPROP WINDOW (QUOTE EVENT)
NIL)
(CLOSEW WINDOW))
(WINDOWPROP WINDOW (QUOTE RESULT])
(TALK.ANSWER.WINDOW
[LAMBDA (USERNAME) (* cdl " 6-May-87 16:02")
(PROG (WINDOW REGION)
[if TALK.ICON.WINDOWS
then [if [AND USERNAME (SETQ WINDOW (for WINDOW in TALK.ICON.WINDOWS
thereis (EQUAL
(WINDOWPROP
WINDOW
(QUOTE USERNAME))
USERNAME]
then (RETURN WINDOW)
else (SETQ REGION
(with REGION (WINDOWPROP (CAR TALK.ICON.WINDOWS)
(QUOTE REGION))
(if (LESSP (PLUS PRIGHT WIDTH)
SCREENWIDTH)
then (CREATEREGION PRIGHT BOTTOM WIDTH HEIGHT)
else (CREATEREGION (OR (fetch (REGION LEFT)
of (REGIONP
TALK.DEFAULT.REGION))
0)
(if (LESSP (PLUS PTOP HEIGHT)
SCREENHEIGHT)
then PTOP
else
(OR (fetch (REGION BOTTOM)
of (REGIONP
TALK.DEFAULT.REGION))
0))
WIDTH HEIGHT]
else (SETQ REGION (with BITMAP TALK.ICON.BITMAP
(if (REGIONP TALK.DEFAULT.REGION)
then (with REGION TALK.DEFAULT.REGION
(CREATEREGION LEFT BOTTOM
BITMAPWIDTH
BITMAPHEIGHT))
else (CREATEREGION 0 0 BITMAPWIDTH BITMAPHEIGHT]
(push TALK.ICON.WINDOWS (SETQ WINDOW (CREATEW REGION NIL 0 T)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION TALK.ICON.BUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION TALK.ICON.CLOSEFN))
(RETURN WINDOW])
(TALK.ANSWER.USERNAME
[LAMBDA (USERNAME REGION WINDOW) (* cdl "10-May-87 15:34")
(LET (PTR FONTHEIGHT (FONT (DSPFONT NIL WINDOW)))
(if (AND (GREATERP (NCHARS USERNAME)
(QUOTIENT (BITMAPWIDTH TALK.ICON.BITMAP)
(CHARWIDTH (CHARCODE A)
FONT)))
(SETQ PTR (STRPOS (CONSTANT (CHARACTER (CHARCODE SPACE)))
USERNAME)))
then (DSPFONT TALK.ICON.FONT WINDOW)
(SETQ FONTHEIGHT (QUOTIENT (FONTPROP TALK.ICON.FONT (QUOTE HEIGHT))
2))
(CENTERPRINTINREGION (SUBSTRING USERNAME 1 (SUB1 PTR))
(with REGION REGION (CREATEREGION LEFT
(PLUS BOTTOM
FONTHEIGHT)
WIDTH HEIGHT))
WINDOW)
(CENTERPRINTINREGION (SUBSTRING USERNAME (ADD1 PTR)
-1)
(with REGION REGION (CREATEREGION LEFT
(DIFFERENCE BOTTOM
FONTHEIGHT)
WIDTH HEIGHT))
WINDOW)
(DSPFONT FONT WINDOW)
else (CENTERPRINTINREGION USERNAME REGION WINDOW])
(TALK.GET.NAME
[LAMBDA NIL (* cdl " 8-May-87 12:11")
(LET (HOSTNAME)
[if [OR (NULL TALK.HOSTNAMES)
(EQ (QUOTE OTHER)
(SETQ HOSTNAME (MENU (create MENU
ITEMS ←(APPEND
TALK.HOSTNAMES
(QUOTE ((Other (QUOTE OTHER)
"Enter new user or hostname."]
then (SETQ HOSTNAME (RESETFORM (CLRPROMPT)
(MKATOM (PROMPTFORWORD "User or host?" NIL NIL
PROMPTWINDOW]
HOSTNAME])
(TALK.ADD.NAME
[LAMBDA (NAME ADDRESS) (* cdl " 8-May-87 12:33")
(* DECLARATIONS: (RECORD PAIR
(HOST ADDR)))
(DECLARE (GLOBALVARS UPPERCASEARRAY))
(LET (ENTRY)
(if (NOT (EQUAL NAME ADDRESS))
then (if [SETQ ENTRY (bind HOSTNAME (NCHARS ←(NCHARS NAME)) for ENTRY
in TALK.HOSTNAMES
thereis (AND [EQP NCHARS
(NCHARS (SETQ HOSTNAME
(if (LISTP ENTRY)
then
(with PAIR
ENTRY
HOST)
else ENTRY]
(STRPOS NAME HOSTNAME 1 NIL T NIL
UPPERCASEARRAY]
then (if (NLISTP ENTRY)
then (SETQ TALK.HOSTNAMES (DREMOVE ENTRY TALK.HOSTNAMES))
(push TALK.HOSTNAMES (LIST NAME ADDRESS)))
else (push TALK.HOSTNAMES (LIST NAME ADDRESS])
(TALK.FLASH.CARET
[LAMBDA (WINDOW POSITION FLG) (* cdl "26-Mar-87 08:24")
(* DECLARATIONS: (RECORD CARET
(CUIMAGE CUHOTSPOTX . CUHOTSPOTY)))
(DECLARE (GLOBALVARS DEFAULTCARET))
(if (OPENWP WINDOW)
then (SELECTQ FLG
[OFF (with POSITION POSITION (if XCOORD
then (BITBLT (fetch CUIMAGE
of DEFAULTCARET)
NIL NIL WINDOW XCOORD
YCOORD NIL NIL NIL
(QUOTE INVERT]
[ON (with POSITION POSITION (BITBLT (fetch CUIMAGE of DEFAULTCARET)
NIL NIL WINDOW
(SETQ XCOORD
(DIFFERENCE (DSPXPOSITION
NIL WINDOW)
(fetch CUHOTSPOTX
of
DEFAULTCARET)))
(SETQ YCOORD
(DIFFERENCE (DSPYPOSITION
NIL WINDOW)
(fetch CUHOTSPOTY
of
DEFAULTCARET)))
NIL NIL NIL (QUOTE INVERT]
NIL])
(TALK.WHENSELECTEDFN
[LAMBDA (ITEM FROMMENU BUTTON) (* cdl " 6-May-87 18:08")
(* DECLARATIONS: (RECORD STREAMS
(INPUTSTREAM . OUTPUTSTREAM)))
(LET [MAINWINDOW TEXTSTREAM STREAMS (WINDOW (MAINWINDOW (WFROMMENU FROMMENU]
(DECLARE (SPECVARS WINDOW MAINWINDOW TEXTSTREAM STREAMS))
(SETQ TEXTSTREAM (WINDOWPROP (SETQ MAINWINDOW (MAINWINDOW WINDOW))
(QUOTE TEXTSTREAM)))
(if (AND (SETQ STREAMS (WINDOWPROP MAINWINDOW (QUOTE STREAMS)))
(OPENP (with STREAMS STREAMS OUTPUTSTREAM)))
then (ERRORSET (CADR ITEM])
(TALK.RINGBELLS
[LAMBDA (WINDOW) (* cdl "16-Mar-87 08:01")
(DECLARE (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2))
(PLAYTUNE RINGBELLS.L1) (* Dorados and Dolphins can't do PLAYTUNE but let
BEEPON/BEEPOFF handle that)
(FLASHWINDOW WINDOW)
(PLAYTUNE RINGBELLS.L2])
)
(DEFINEQ
(TALK.TEDIT.DISPLAY
[LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL USER)
(* cdl " 6-May-87 17:18")
(LET (TEXTOBJ)
(TEDIT NIL MAINWINDOW NIL TALK.TO.TEDIT.PROPS)
(TEXTPROP (SETQ TEXTOBJ (WINDOWPROP MAINWINDOW (QUOTE TEXTOBJ)))
(QUOTE TALK)
OUTPUTSTREAM)
(with TEXTOBJ TEXTOBJ (SETQ TXTFILE (CONCAT "Talk with " USER)))
(TEDIT.SETSEL (OPENTEXTSTREAM NIL WINDOW NIL NIL TALK.FROM.TEDIT.PROPS)
1 0 (QUOTE LEFT))
(replace (TEXTOBJ PROMPTWINDOW) of (WINDOWPROP WINDOW (QUOTE TEXTOBJ))
with (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ])
(TALK.TEDIT.LISTEN
[LAMBDA (WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL) (* cdl "18-May-87 16:27")
(* DECLARATIONS: (RECORD ACTION
(CCODES ACTIONFN)))
(DECLARE (SPECVARS INPUTSTREAM))
(PROG ((POSITION (create POSITION))
(TEXTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM)))
(SCRATCHPTR (ALLOCSTRING 0))
(STRING (ALLOCSTRING 128))
(EVENTFN (with TALK.PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)
TALK.EVENTFN))
STRINGSTREAM EOFPTR BYTE ACTION CCODE)
(SETQ EOFPTR (DIFFERENCE [GETEOFPTR (SETQ STRINGSTREAM (OPENSTRINGSTREAM
STRING
(QUOTE BOTH]
(PROGN (* Leave room for multiple byte NS characters)
8)))
(while (AND (OPENP TEXTSTREAM)
(OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM))
do (APPLY* EVENTFN INPUTSTREAM OUTPUTSTREAM)
(if (NOT (OPENP INPUTSTREAM))
then (RETURN))
(TALK.FLASH.CARET WINDOW POSITION (QUOTE OFF))
(while (AND (OPENP INPUTSTREAM)
(READP INPUTSTREAM))
do (SELCHARQ (SETQ BYTE (LOGAND (SETQ CCODE (READCCODE INPUTSTREAM))
(MASK.1'S 0 8)))
((↑G BS) (* Flush text buffer)
(TALK.TEDIT.INSERT TEXTSTREAM STRING STRINGSTREAM
SCRATCHPTR)
(SELCHARQ BYTE
(↑G (TALK.RINGBELLS WINDOW))
[BS (* the escape code)
(SETQ CCODE (LOGAND (SETQ CCODE
(READCCODE
INPUTSTREAM))
(MASK.1'S 0 10)))
(if [SETQ ACTION
(for ACTION in TALK.ACTIONS
thereis (with ACTION ACTION
(EQMEMB CCODE
CCODES]
then (with ACTION ACTION
(APPLY* ACTIONFN
TEXTSTREAM
INPUTSTREAM]
(SHOULDNT)))
(if (LESSP CCODE (MASK.1'S 0 8))
then (PRINTCCODE CCODE STRINGSTREAM)
(if (LEQ EOFPTR (GETFILEPTR STRINGSTREAM))
then (TALK.TEDIT.INSERT TEXTSTREAM STRING
STRINGSTREAM
SCRATCHPTR))
else (TALK.TEDIT.INSERT TEXTSTREAM STRING STRINGSTREAM
SCRATCHPTR)
(* String streams don't handle NS charaters so don't
buffer)
(TALK.TEDIT.INSERT TEXTSTREAM CCODE)))
finally (TALK.TEDIT.INSERT TEXTSTREAM STRING STRINGSTREAM SCRATCHPTR))
(TALK.FLASH.CARET WINDOW POSITION (QUOTE ON])
(TALK.TEDIT.CHARFN
[LAMBDA (TEXTOBJ CCODE) (* cdl " 5-May-87 17:31")
(PROG [(STREAM (TEXTPROP TEXTOBJ (QUOTE TALK]
(if (OPENP STREAM)
then (SELCHARQ CCODE
((BS ↑W DEL UNDO REDO NEXT)
(TALKOPCODE CCODE STREAM))
((SHIFT.UNDO SHIFT.REDO SHIFT.NEXT)
(TALKOPCODE (BITCLEAR CCODE (MASK.1'S 5 1))
STREAM))
(↑O (RETURN T))
(↑A (RETURN))
((SHIFT.DEL FONT SHIFT.FONT MARGINS SHIFT.MARGINS)
(* Unimplemented function keys, pass through)
(PRINTCCODE CCODE STREAM))
(if (OR (LESSP CCODE (CHARCODE 2,0))
(GEQ CCODE (CHARCODE 3,0)))
then (* Filter out function keys in the 2,0 range)
(PRINTCCODE CCODE STREAM)))
(if (NOT (READP))
then (FORCEOUTPUT STREAM)))
(RETURN T])
)
(DEFINEQ
(TALK.TTY.DISPLAY
[LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL USER)
(* cdl " 7-May-87 10:48")
(LET (PROCESS)
(DSPFONT TALK.TTY.FONT MAINWINDOW)
(DSPFONT TALK.TTY.FONT WINDOW)
(DSPSCROLL (QUOTE ON)
MAINWINDOW)
(DSPSCROLL (QUOTE ON)
WINDOW)
(if USER
then (WINDOWPROP MAINWINDOW (QUOTE ICON)
(CONCAT "Talk with " USER)))
[WINDOWPROP MAINWINDOW (QUOTE TALK.TTY.PROCESS)
(SETQ PROCESS (ADD.PROCESS (BQUOTE (TALK.TTY.CHARFN
, MAINWINDOW , OUTPUTSTREAM ,
(with TALK.PROTOCOLTYPE
(ASSOC PROTOCOL
TALK.PROTOCOLTYPES)
TALK.CASEARRAY]
(TTY.PROCESS PROCESS])
(TALK.TTY.LISTEN
[LAMBDA (WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL) (* cdl "18-May-87 16:28")
(DECLARE (SPECVARS INPUTSTREAM))
(PROG ((POSITION (create POSITION))
(CHARWIDTH (CHARWIDTH (CHARCODE A)
TALK.TTY.FONT))
BYTE EVENTFN CASEARRAY)
(with TALK.PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)
(SETQ EVENTFN TALK.EVENTFN)
(SETQ CASEARRAY TALK.CASEARRAY))
(while (AND (OPENWP WINDOW)
(OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM))
do (APPLY* EVENTFN INPUTSTREAM OUTPUTSTREAM)
(if (NOT (OPENP INPUTSTREAM))
then (RETURN))
(TALK.FLASH.CARET WINDOW POSITION (QUOTE OFF))
(bind CCODE while (AND (OPENP INPUTSTREAM)
(PROGN (if (EQ PROTOCOL (QUOTE NS))
then (SPP.CLEAREOM INPUTSTREAM T))
(READP INPUTSTREAM)))
do (SETQ BYTE (LOGAND (SETQ CCODE (READCCODE INPUTSTREAM))
(MASK.1'S 0 8)))
[if CASEARRAY
then (SETQ BYTE (SETQ CCODE (ELT CASEARRAY BYTE]
(SELCHARQ BYTE
(LF NIL)
(↑G (TALK.RINGBELLS WINDOW))
(BS (if (GEQ (DSPXPOSITION NIL WINDOW)
CHARWIDTH)
then (DSPBACKUP CHARWIDTH WINDOW)))
(PRINTCCODE CCODE WINDOW)))
(TALK.FLASH.CARET WINDOW POSITION (QUOTE ON])
(TALK.TTY.CHARFN
[LAMBDA (DISPLAYSTREAM OUTPUTSTREAM CHARARRAY) (* cdl " 8-May-87 12:33")
(DECLARE (SPECVARS DISPLAYSTREAM OUTPUTSTREAM CHARARRAY))
[RESETFORM (TTYDISPLAYSTREAM DISPLAYSTREAM)
(bind CCODE (CHARWIDTH ←(CHARWIDTH (CHARCODE A)
TALK.TTY.FONT))
while (AND (OPENP OUTPUTSTREAM)
(OPENWP DISPLAYSTREAM))
do (if (SETQ CCODE (RESETLST (RESETSAVE (SETTERMTABLE TALK.TERMTABLE))
(RESETSAVE (CONTROL T))
(READCCODE)))
then (SELCHARQ CCODE
(BS (if (GEQ (DSPXPOSITION NIL DISPLAYSTREAM)
CHARWIDTH)
then (DSPBACKUP CHARWIDTH DISPLAYSTREAM)))
NIL)
(if CHARARRAY
then (SETQ CCODE (ELT CHARARRAY CCODE)))
(PRINTCCODE CCODE OUTPUTSTREAM)
(if (NOT (READP NIL T))
then (FORCEOUTPUT OUTPUTSTREAM]
(TTY.PROCESS T])
)
(DEFINEQ
(TALK.ICON.BUTTONEVENTFN
[LAMBDA (WINDOW) (* cdl " 8-May-87 12:24")
(LET (RESULT USERNAME (EVENT (WINDOWPROP WINDOW (QUOTE EVENT)
NIL)))
(until (MOUSESTATE UP) do)
(ALLOW.BUTTON.EVENTS)
(if EVENT
then (WINDOWPROP WINDOW (QUOTE RESULT)
T)
(NOTIFY.EVENT EVENT T)
elseif (MOUSECONFIRM (CONCAT "(Re)Connect to " (SETQ USERNAME (WINDOWPROP
WINDOW
(QUOTE USERNAME)))
"?"))
then (if [PROCESSP (SETQ RESULT (TALK (WINDOWPROP WINDOW (QUOTE ADDRESS))
NIL
(WINDOWPROP WINDOW (QUOTE PROTOCOL]
then (CLOSEW WINDOW)
else (FLASHWINDOW WINDOW)
(PROMPTPRINT RESULT])
(TALK.ICON.CLOSEFN
[LAMBDA (WINDOW) (* cdl "10-May-87 10:07")
(LET ((EVENT (WINDOWPROP WINDOW (QUOTE EVENT)
NIL)))
(if EVENT
then (NOTIFY.EVENT EVENT T)))
(SETQ TALK.ICON.WINDOWS (DREMOVE WINDOW TALK.ICON.WINDOWS])
)
(* * TALK TEdit hooks)
(DEFINEQ
(TALK.TEDIT.INSERT
[LAMBDA (TEXTSTREAM STRING.OR.CCODE STRINGSTREAM SCRATCHPTR)
(* cdl "24-Mar-87 08:45")
(if STRINGSTREAM
then (LET ((FILEPTR (GETFILEPTR STRINGSTREAM)))
(if (NOT (ZEROP FILEPTR))
then (TEDIT.INSERT TEXTSTREAM (SUBSTRING STRING.OR.CCODE 1 FILEPTR
SCRATCHPTR))
(SETFILEPTR STRINGSTREAM 0)))
else (TEDIT.INSERT TEXTSTREAM (MKSTRING (CHARACTER STRING.OR.CCODE])
(TALK.TEDIT.DELETE
[LAMBDA (TEXTSTREAM) (* cdl " 1-Mar-87 10:34")
(TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM])
(TALK.TEDIT.BACKSPACE
[LAMBDA (TEXTSTREAM) (* cdl " 5-May-87 18:07")
(with SELECTION (TEDIT.GETSEL TEXTSTREAM)
(TEDIT.DELETE TEXTSTREAM (SUB1 (SELECTQ POINT
(LEFT CH#)
CHLIM))
1])
(TALK.TEDIT.UNDO
[LAMBDA (TEXTSTREAM) (* cdl " 1-Mar-87 10:36")
(TEDIT.UNDO (TEXTOBJ TEXTSTREAM])
(TALK.TEDIT.REDO
[LAMBDA (TEXTSTREAM) (* cdl " 2-Mar-87 14:37")
(TEDIT.REDO (TEXTOBJ TEXTSTREAM])
(TALK.TEDIT.WORDDELETE
[LAMBDA (TEXTSTREAM) (* cdl "27-Feb-87 15:36")
(\TEDIT.WORDDELETE (TEXTOBJ TEXTSTREAM])
(TALK.SELFN
[LAMBDA (TEXTOBJ SELECTION SELECTMODE FINAL?) (* cdl " 1-Mar-87 09:53")
(SELECTQ FINAL?
(FINAL (SELECTQ SELECTMODE
[(NORMAL PENDINGDEL DELETE)
(PROG [(STREAM (TEXTPROP TEXTOBJ (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑S)
STREAM)
(PRIN2 (LIST (TALK.ENCODE.SEL SELECTION)
SELECTMODE)
STREAM)
(FORCEOUTPUT STREAM]
NIL))
NIL])
(TALK.SETSELFN
[LAMBDA (TEXTSTREAM CH#ORSEL LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION)
(* cdl " 2-Mar-87 07:45")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑S)
STREAM)
(PRIN2 (LIST (TALK.ENCODE.SEL CH#ORSEL LEN POINT)
(if OPERATION
then OPERATION
elseif PENDINGDELFLG
then (QUOTE PENDINGDEL)
else (QUOTE NORMAL)))
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.SETSEL
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 1-Mar-87 10:33")
(* DECLARATIONS: (RECORD DATA
(PLST SELECTMODE)))
(with DATA (READ STREAM)
(TALK.DECODE.SEL TEXTSTREAM PLST SELECTMODE])
(TALK.IMAGEOBJFN
[LAMBDA (TEXTSTREAM OBJECT CH#ORSEL) (* cdl " 2-Mar-87 10:23")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑T)
STREAM)
(WRITEIMAGEOBJ OBJECT STREAM)
(PRIN2 (with SELECTION (TEDIT.GETSEL TEXTSTREAM)
(TALK.ENCODE.SEL CH#ORSEL DCH POINT))
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.INSERT.OBJECT
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 5-May-87 18:04")
(LET (OBJECT)
(if [SETQ OBJECT (RESETFORM (INPUT STREAM)
(ERRORSET (READ]
then (TEDIT.INSERT.OBJECT (CAR OBJECT)
TEXTSTREAM
(TALK.DECODE.SEL TEXTSTREAM (READ STREAM])
(TALK.LOOKSFN
[LAMBDA (TEXTSTREAM NEWLOOKS CH#ORSEL LEN) (* cdl " 2-Mar-87 07:41")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑U)
STREAM)
(PRIN2 (LIST NEWLOOKS (TALK.ENCODE.SEL CH#ORSEL LEN))
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.LOOKS
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 1-Mar-87 12:19")
(* DECLARATIONS: (RECORD DATA
(NEWLOOKS PLST)))
(with DATA (READ STREAM)
(TEDIT.LOOKS TEXTSTREAM NEWLOOKS (TALK.DECODE.SEL TEXTSTREAM PLST])
(TALK.PARAFN
[LAMBDA (TEXTOBJ NEWLOOKS CH#ORSEL LEN) (* cdl " 1-Mar-87 11:52")
(PROG [(STREAM (TEXTPROP TEXTOBJ (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑V)
STREAM)
(PRIN2 (LIST NEWLOOKS (TALK.ENCODE.SEL CH#ORSEL LEN))
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.PARALOOKS
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 1-Mar-87 12:22")
(* DECLARATIONS: (RECORD DATA
(NEWLOOKS PLST)))
(with DATA (READ STREAM)
(TEDIT.PARALOOKS (TEXTOBJ TEXTSTREAM)
NEWLOOKS
(TALK.DECODE.SEL TEXTSTREAM PLST])
(TALK.INSERTFN
[LAMBDA (TEXTSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* cdl "11-Mar-87 15:56")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑R)
STREAM)
(PRIN2 (LIST TEXT (TALK.ENCODE.SEL CH#ORSEL)
LOOKS DONTSCROLL)
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.INSERT.TEXT
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 2-Mar-87 11:42")
(* DECLARATIONS: (RECORD DATA
(TEXT PLST LOOKS DONTSCROLL)))
(with DATA (READ STREAM)
(TEDIT.INSERT TEXTSTREAM TEXT (TALK.DECODE.SEL TEXTSTREAM PLST)
LOOKS DONTSCROLL])
(TALK.INCLUDEFN
[LAMBDA (TEXTSTREAM FILE START END) (* cdl "10-Mar-87 17:05")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑O)
STREAM)
(PRIN2 (LIST FILE START END)
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.INCLUDE
[LAMBDA (TEXTSTREAM STREAM) (* cdl "10-Mar-87 17:04")
(* DECLARATIONS: (RECORD DATA
(FILE START END)))
(with DATA (READ STREAM)
(TEDIT.INCLUDE TEXTSTREAM FILE START END])
(TALK.DELETEFN
[LAMBDA (TEXTSTREAM CH#ORSEL LEN) (* cdl " 2-Mar-87 13:51")
(PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑P)
STREAM)
(PRIN2 (LIST (TALK.ENCODE.SEL (OR CH#ORSEL (TEDIT.GETSEL TEXTSTREAM))
LEN)
LEN)
STREAM)
(FORCEOUTPUT STREAM])
(TALK.TEDIT.DELETE.TEXT
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 2-Mar-87 12:06")
(* DECLARATIONS: (RECORD DATA
(PLST LEN)))
(with DATA (READ STREAM)
(TEDIT.DELETE TEXTSTREAM (TALK.DECODE.SEL TEXTSTREAM PLST)
LEN])
(TALK.GETFN
[LAMBDA (TEXTSTREAM FULLFILENAME WHEN) (* cdl "16-Mar-87 08:25")
(SELECTQ WHEN
[BEFORE (PROG [(STREAM (TEXTPROP TEXTSTREAM (QUOTE TALK]
(if (OPENP STREAM)
then (* the function code)
(TALKOPCODE (CHARCODE ↑Q)
STREAM)
(PRIN2 (LIST FULLFILENAME)
STREAM)
(FORCEOUTPUT STREAM]
NIL])
(TALK.TEDIT.GET
[LAMBDA (TEXTSTREAM STREAM) (* cdl " 2-Mar-87 09:42")
(* DECLARATIONS: (RECORD DATA
(FULLFILENAME)))
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)))
(with TEXTOBJ TEXTOBJ (SETQ \XDIRTY NIL))
(with DATA (READ STREAM)
(TEDIT.GET TEXTOBJ FULLFILENAME])
)
(DEFINEQ
(TALK.ENCODE.SEL
[LAMBDA (CH#ORSEL LEN POINT) (* cdl "16-Mar-87 08:18")
(* DECLARATIONS: (PROPRECORD PLST
(CH# DCH POINT)))
(if (type? SELECTION CH#ORSEL)
then [for FIELD
in [CONSTANT (LDIFFERENCE (RECORDFIELDNAMES (QUOTE SELECTION))
(QUOTE (X0 Y0 XLIM YLIM L1 LN DX \TEXTOBJ
SELOBJINFO]
join (LIST FIELD (RECORDACCESS FIELD CH#ORSEL (CONSTANT
(RECLOOK (QUOTE SELECTION)))
(QUOTE FETCH]
else (create PLST
CH# ← CH#ORSEL
DCH ←(OR LEN 0)
POINT ←(OR POINT (QUOTE LEFT])
(TALK.DECODE.SEL
[LAMBDA (TEXTSTREAM PLST SELECTMODE) (* cdl "16-Mar-87 08:12")
(* DECLARATIONS: (PROPRECORD PLST
(CH# DCH POINT)))
(with PLST PLST (TEDIT.SETSEL TEXTSTREAM (OR CH# (fetch (SELECTION CH#)
of (TEDIT.GETSEL TEXTSTREAM)))
DCH POINT (EQ (QUOTE PENDINGDEL)
SELECTMODE)
NIL SELECTMODE])
)
(* * TALK data)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS TALKOPCODE MACRO (OPENLAMBDA (CCODE STREAM)
(PRINTCCODE (CHARCODE BS)
STREAM)
(PRINTCCODE CCODE STREAM)))
)
[DECLARE: EVAL@COMPILE
(RECORD TALK.SERVICETYPE (TALK.SERVICENAME TALK.SERVICEP TALK.DISPLAYFN TALK.LISTENFN))
(RECORD TALK.PROTOCOLTYPE (TALK.PROTOCOLNAME TALK.PROTOCOLP TALK.HOSTNAMEFN TALK.USERNAMEFN
TALK.CONNECTFN TALK.EVENTFN TALK.CASEARRAY))
]
)
(RPAQQ TALK.ACTIONS ((8 TALK.TEDIT.BACKSPACE)
(15 TALK.TEDIT.INCLUDE)
(16 TALK.TEDIT.DELETE.TEXT)
(17 TALK.TEDIT.GET)
(18 TALK.TEDIT.INSERT.TEXT)
(19 TALK.TEDIT.SETSEL)
(20 TALK.TEDIT.INSERT.OBJECT)
(21 TALK.TEDIT.LOOKS)
(22 TALK.TEDIT.PARALOOKS)
(23 TALK.TEDIT.WORDDELETE)
(127 TALK.TEDIT.DELETE)
(516 TALK.TEDIT.UNDO)
(520 TALK.TEDIT.REDO)
(530 TEDIT.NEXT)))
(RPAQQ TALK.MENU.ITEMS ((Disconnect (TALK.CLOSEFN MAINWINDOW)
"Close TALK connection and keep window open.")
(RingBells (PROGN (PRINTCCODE (CHARCODE ↑G)
(CDR STREAMS))
(FORCEOUTPUT (CDR STREAMS))
(FLASHWINDOW MAINWINDOW)))
(Message (LET [(MESSAGE (MENU (create MENU ITEMS ← TALK.USER.MESSAGES]
(if [AND MESSAGE (TTY.PROCESSP (WINDOWPROP MAINWINDOW
(QUOTE PROCESS]
then
(BKSYSBUF MESSAGE)))
"Insert a generic message.")))
(RPAQQ TALK.USER.MESSAGES (("One moment please" "One moment please..." NIL (SUBITEMS (
"the phone's ringing" "One moment please, the phone's ringing...")
(
"there's someone at the door" "One moment please, there's someone at the door...")
(
"someone is trying to TALK to me" "One moment please, someone is trying to TALK to me...")))
(DATE (DATE)
"The current date and time.")
"Bye."))
(ADDTOVAR TALK.SERVICETYPES (TEdit [LAMBDA NIL (FGETD (QUOTE OPENTEXTSTREAM]
TALK.TEDIT.DISPLAY TALK.TEDIT.LISTEN)
(TTY TRUE TALK.TTY.DISPLAY TALK.TTY.LISTEN))
(RPAQ? TALK.GAG NIL)
(RPAQ? TALK.PROTOCOLTYPES NIL)
(RPAQ? TALK.HOSTNAMES NIL)
(RPAQ? TALK.ICON.WINDOWS NIL)
(RPAQ? TALK.ANSWER.WAIT 15)
(RPAQ? TALK.READTABLE (COPYREADTABLE (QUOTE ORIG)))
(RPAQ? TALK.TERMTABLE (COPYTERMTABLE (QUOTE ORIG)))
(RPAQ? TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500))
(RPAQ? TALK.TTY.FONT DEFAULTFONT)
(RPAQ? TALK.ICON.FONT LITTLEFONT)
(RPAQQ TALK.FROM.TEDIT.PROPS (READONLY T NOTITLE T COPYBYBKSYSBUF T MENU ((Put (QUOTE Put)
NIL
(SUBITEMS Plain-Text
Old-Format))
Find Quit)))
(RPAQQ TALK.TO.TEDIT.PROPS (CHARFN TALK.TEDIT.CHARFN SELFN TALK.SELFN GETFN TALK.GETFN IMAGEOBJFN
TALK.IMAGEOBJFN LOOKSFN TALK.LOOKSFN PARAFN TALK.PARAFN INSERTFN
TALK.INSERTFN SETSELFN TALK.SETSELFN DELETEFN TALK.DELETEFN
INCLUDEFN TALK.INCLUDEFN NOTITLE T QUITFN TRUE COPYBYBKSYSBUF T))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.ACTIONS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.GAG
TALK.PROTOCOLTYPES TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT TALK.READTABLE
TALK.TERMTABLE TALK.DEFAULT.REGION TALK.TTY.FONT TALK.ICON.FONT TALK.TO.TEDIT.PROPS
TALK.FROM.TEDIT.PROPS)
)
(* * NS GAP Interface)
(DEFINEQ
(CH.USER.WORKSTATION
[LAMBDA (USER WORKSTATION) (* cdl " 5-May-87 17:46")
(if WORKSTATION
then (LET (NSADDRESS)
(if (type? NSADDRESS (SETQ NSADDRESS (\COERCE.TO.NSADDRESS WORKSTATION)))
then (with NSADDRESS NSADDRESS (SETQ NSSOCKET 0))
(CH.DELETE.PROPERTY USER (QUOTE ADDRESS.LIST))
(CH.ADD.ITEM.PROPERTY USER (QUOTE ADDRESS.LIST)
(SETQ NSADDRESS (CONS NSADDRESS))
(QUOTE (SEQUENCE NSADDRESS)))
(CONS USER NSADDRESS)
else (ERROR WORKSTATION "Address for host not found!")))
else (CH.DELETE.PROPERTY USER (QUOTE ADDRESS.LIST])
)
(DEFINEQ
(TALK.NS.HOSTNAME
[LAMBDA (HOSTNAME) (* cdl " 7-May-87 08:41")
(if (type? NSADDRESS HOSTNAME)
then HOSTNAME
else (\COERCE.TO.NSADDRESS HOSTNAME])
(TALK.NS.USERNAME
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICE MODE USER) (* cdl "10-May-87 10:15")
(LET (OBJECT NAME)
(DECLARE (GLOBALVARS LOCAL.CLEARINGHOUSE CH.NET.HINT))
(if (OR (EQ SERVICE (QUOTE TEdit))
(EQ MODE (QUOTE CLIENT)))
then (if (STREQUAL (SETQ NAME (USERNAME))
(CONSTANT null))
then (SETQ NAME NIL)
elseif (OR LOCAL.CLEARINGHOUSE CH.NET.HINT)
then (if (SETQ OBJECT (CH.LOOKUP.OBJECT NAME))
then (SETQ NAME OBJECT)))
(PRINTOUT OUTPUTSTREAM NAME T)
(FORCEOUTPUT OUTPUTSTREAM))
(if (OR (EQ SERVICE (QUOTE TEdit))
(EQ MODE (QUOTE SERVER)))
then (if (SETQ OBJECT (RATOM INPUTSTREAM TALK.READTABLE))
then (SETQ USER OBJECT)) (* Eat EOL)
(BIN INPUTSTREAM))
(SELECTQ SERVICE
(TTY (with SPPCON (with SPPSTREAM OUTPUTSTREAM SPP.CONNECTION)
(SETQ SPPEOMONFORCEOUT T)))
NIL)
USER])
(TALK.NS.CONNECT
[LAMBDA (HOST SERVICE) (* cdl " 8-May-87 14:28")
(* DECLARATIONS: (RECORD AUTHENTICATOR
(CREDENTIALS VERIFIER)))
(PROG (USER STREAM SERVICETYPE RESULT (CREDENTIALS (with AUTHENTICATOR (CH.GETAUTHENTICATOR
T)
CREDENTIALS))
(VERIFIER (with AUTHENTICATOR (CH.GETAUTHENTICATOR)
VERIFIER)))
(DECLARE (GLOBALVARS SPP.USER.TIMEOUT))
(if (SETQ STREAM (COURIER.OPEN HOST NIL T (PACK* (QUOTE TALK#)
HOST)))
then
(if
(SETQ SERVICETYPE
(for SERVICETYPE inside SERVICE
thereis
(SELECTQ
[CAR (SETQ RESULT
(COURIER.CALL
STREAM
(QUOTE GAP)
(QUOTE Create)
TALK.GAP.PARAMETERS
(BQUOTE ((service (, (with GAP.SERVICETYPE
(for TYPE in
GAP.SERVICETYPES
thereis
(with GAP.SERVICETYPE TYPE
(EQ SERVICETYPE
GAP.SERVICENAME)))
GAP.UNSPECIFIED)))
,@ TALK.GAP.TRANSPORT))
SPP.USER.TIMEOUT CREDENTIALS VERIFIER (QUOTE RETURNERRORS]
(ERROR (SELECTQ (CADR RESULT)
(noAnswerOrBusy
(* User hung up or didn't answer, don't try another
protocol)
(RETURN))
NIL))
RESULT)))
then [RETURN (CONS SERVICETYPE (CONS STREAM (SPPOUTPUTSTREAM STREAM]
else (CLOSEF? STREAM)
(RETURN (QUOTE ANSWER)))
else (RETURN (QUOTE CONNECT])
(TALK.NS.EVENT
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "21-May-87 10:26")
(LET ((EVENT (with SPPCON (with SPPSTREAM INPUTSTREAM SPP.CONNECTION)
SPPINPUTEVENT)))
(while (AND (OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM)
(NOT (READP INPUTSTREAM))
(NEQ EVENT (AWAIT.EVENT EVENT 500)))
do))
(if (OPENP INPUTSTREAM)
then (SELECTQ (EOFP INPUTSTREAM)
(ATTENTION (SPP.CLEARATTENTION INPUTSTREAM)
(BIN INPUTSTREAM))
(EOM (SPP.CLEAREOM INPUTSTREAM))
NIL])
(TALK.NS.CREDENTIALS
[LAMBDA (CREDENTIALS) (* cdl " 6-May-87 15:58")
(if (AND CREDENTIALS (SETQ CREDENTIALS (CADR CREDENTIALS)))
then (SUBATOM (COURIER.READ.REP CREDENTIALS (QUOTE CLEARINGHOUSE)
(QUOTE NAME))
1 -2])
)
(DEFINEQ
(TALK.TEDIT.SERVER
[LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* cdl "18-May-87 16:24")
(LET ((USER (TALK.NS.CREDENTIALS CREDENTIALS))
(ADDRESS (SPP.DESTADDRESS INPUTSTREAM)))
(with NSADDRESS ADDRESS (SETQ NSSOCKET 0))
(if (with TALK.SERVICETYPE (ASSOC (QUOTE TEdit)
TALK.SERVICETYPES)
(APPLY* TALK.SERVICEP))
then (if (OR TALK.GAG (NOT (TALK.ANSWER USER (QUOTE TEdit)
(QUOTE NS)
ADDRESS)))
then (QUOTE (ABORT noAnswerOrBusy))
else (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
(TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
(QUOTE TEdit)
(QUOTE NS)
(QUOTE SERVER)
USER))
else (QUOTE (ABORT serviceNotFound])
(TALK.TTY.SERVER
[LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* cdl "18-May-87 16:24")
(LET ((USER (TALK.NS.CREDENTIALS CREDENTIALS))
(ADDRESS (SPP.DESTADDRESS INPUTSTREAM)))
(with NSADDRESS ADDRESS (SETQ NSSOCKET 0))
(if (OR TALK.GAG (NOT (TALK.ANSWER USER (QUOTE TTY)
(QUOTE NS)
ADDRESS)))
then (* Should be noAnswerOrBusy, but that 915's XDE/Tajo)
(QUOTE (ABORT serviceNotFound))
else (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
(TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
(QUOTE TTY)
(QUOTE NS)
(QUOTE SERVER)
USER])
)
(DEFINEQ
(GAP.SERVER
[LAMBDA (STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
(* cdl " 8-May-87 14:26")
(* DECLARATIONS: (ASSOCRECORD ALST
(service)))
(LET (SERVICETYPE)
(if [OR [for NUMBER in (CAR (with ALST TRANSPORT service))
thereis (SETQ SERVICETYPE (for SERVICETYPE in GAP.SERVICETYPES
thereis (with GAP.SERVICETYPE
SERVICETYPE
(AND (EQP NUMBER
GAP.UNSPECIFIED)
GAP.SERVERFN]
(AND (SETQ SERVICETYPE (ASSOC T GAP.SERVICETYPES))
(with GAP.SERVICETYPE SERVICETYPE
(* There was a server in place before TALK was loaded)
(FGETD GAP.SERVERFN]
then (APPLY* (with GAP.SERVICETYPE SERVICETYPE GAP.SERVERFN)
STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS
VERIFIER)
else (QUOTE (ABORT serviceNotFound])
(DEFINE.GAP.SERVER
[LAMBDA NIL (* cdl " 5-May-87 18:16")
(* DECLARATIONS: (RECORD GAP.ERROR (DESCRIPTION . NUMBER)) (PROPRECORD COURIERDEF (TYPES INHERITS PROCEDURES
ERRORS)) (ASSOCRECORD PROCEDURES (Create)) (PROPRECORD PROCEDURE (IMPLEMENTEDBY)))
(if (HASDEF (QUOTE GAP)
(QUOTE COURIERPROGRAM))
then (LET [SERVERFN PROCEDURE (COURIERDEF (GETDEF (QUOTE GAP)
(QUOTE COURIERPROGRAM]
[with COURIERDEF (CDR COURIERDEF)
(SETQ PROCEDURE (with PROCEDURES PROCEDURES Create))
(if (AND (SETQ SERVERFN (with PROCEDURE PROCEDURE IMPLEMENTEDBY))
(NEQ SERVERFN (QUOTE GAP.SERVER)))
then (* Make the existing GAP server the default)
(PUTASSOC T (BQUOTE (DEFAULT , SERVERFN))
GAP.SERVICETYPES))
(with PROCEDURE PROCEDURE (SETQ IMPLEMENTEDBY (QUOTE GAP.SERVER)))
(bind (ALST ← ERRORS) for GAP.ERROR in GAP.ADDITIONAL.ERRORS
do (with GAP.ERROR GAP.ERROR (PUTASSOC DESCRIPTION NUMBER ALST]
(PUTDEF (QUOTE GAP)
(QUOTE COURIERPROGRAM)
COURIERDEF))
else (COPYDEF (QUOTE TALKGAP)
(QUOTE GAP)
(QUOTE COURIERPROGRAM)))
(UNMARKASCHANGED (QUOTE GAP)
(QUOTE COURIERPROGRAM))
(DELDEF (QUOTE TALKGAP)
(QUOTE COURIERPROGRAM))
(UNMARKASCHANGED (QUOTE TALKGAP)
(QUOTE COURIERPROGRAM])
)
(ADDTOVAR GAP.SERVICETYPES (5 TTY TALK.TTY.SERVER)
(6 TEdit TALK.TEDIT.SERVER))
(ADDTOVAR TALK.PROTOCOLTYPES (NS TRUE TALK.NS.HOSTNAME TALK.NS.USERNAME TALK.NS.CONNECT
TALK.NS.EVENT))
(RPAQ? TALK.GAP.HANDLE (QUOTE ((0 0))))
(RPAQQ TALK.GAP.PARAMETERS (ttyHost (seven even two 100 (none 0 0))))
(RPAQQ TALK.GAP.TRANSPORT ((teletype)))
(RPAQQ GAP.ADDITIONAL.ERRORS ((serviceTooBusy 17)
(userNotAuthenticated 18)
(userNotAuthorized 19)
(serviceNotFound 20)
(registeredTwice 21)
(transmissionMediumHardwareProblem 22)
(transmissionMediumUnavailable 23)
(transmissionMediumNotReady 24)
(noAnswerOrBusy 25)
(noRouteToGAPService 26)
(gapServiceNotResponding 27)
(courierProtocolMismatch 28)
(gapVersionMismatch 29)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT
GAP.ADDITIONAL.ERRORS)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD GAP.SERVICETYPE (GAP.UNSPECIFIED GAP.SERVICENAME GAP.SERVERFN))
]
)
(DECLARE: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(FILESLOAD ETHERRECORDS (LOADCOMP)
SPP)
)
(* * Interim IP Interface)
(DEFINEQ
(TALK.START.IP.SERVER
[LAMBDA NIL (* cdl " 8-May-87 14:32")
(if (AND (NOT (FIND.PROCESS (QUOTE TALK.IP.SERVER)))
(with TALK.PROTOCOLTYPE (ASSOC (QUOTE IP)
TALK.PROTOCOLTYPES)
(APPLY* TALK.PROTOCOLP)))
then (ADD.PROCESS (QUOTE (TALK.IP.SERVER))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM])
(TALK.IP.SERVER
[LAMBDA NIL (* cdl "10-May-87 10:18")
(LET (SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST [RESETSAVE NIL (BQUOTE (UDP.CLOSE.SOCKET , (SETQ SOCKET (
UDP.OPEN.SOCKET
TALK.UDP.PORT]
(bind PACKET RESPONSE SERVICE GAP.SERVICETYPE TALK.SERVICETYPE INPUTSTREAM
OUTPUTSTREAM PORT USER
do (SETQ PACKET (UDP.GET SOCKET T))
(UDP.SETUP (SETQ RESPONSE (\ALLOCATE.ETHERPACKET))
(with IP PACKET IPSOURCEADDRESS)
(with UDP PACKET UDPSOURCEPORT)
0 SOCKET (QUOTE FREE))
(UDP.APPEND.BYTE RESPONSE (with TALK.IP.PACKET PACKET
TALK.SERVICE.BYTE))
(if [OR [NULL (if (SETQ GAP.SERVICETYPE
(ASSOC (with TALK.IP.PACKET PACKET
TALK.SERVICE.BYTE)
GAP.SERVICETYPES))
then (SETQ SERVICE (with GAP.SERVICETYPE
GAP.SERVICETYPE
GAP.SERVICENAME]
(OR (NOT (SETQ TALK.SERVICETYPE (ASSOC SERVICE
TALK.SERVICETYPES)))
(NOT (with TALK.SERVICETYPE TALK.SERVICETYPE
(APPLY* TALK.SERVICEP]
then (UDP.APPEND.BYTE RESPONSE 1)
(UDP.SEND SOCKET RESPONSE)
elseif [OR TALK.GAG (NOT (TALK.ANSWER (SETQ USER
(with TALK.IP.PACKET
PACKET
TALK.IP.USERNAME))
SERVICE
(QUOTE IP)
(with IP PACKET
IPSOURCEADDRESS]
then (* FAILED)
(UDP.APPEND.BYTE RESPONSE 2)
(UDP.SEND SOCKET RESPONSE)
else (UDP.APPEND.BYTE RESPONSE 0)
(UDP.APPEND.WORD RESPONSE (SETQ PORT (\TCP.SELECT.PORT)))
(UDP.SEND SOCKET RESPONSE)
[SETQ OUTPUTSTREAM (TCP.OTHER.STREAM (SETQ INPUTSTREAM
(TCP.OPEN
(with IP PACKET
IPSOURCEADDRESS)
NIL PORT
(QUOTE PASSIVE)
(QUOTE INPUT]
(TALK.PROCESS INPUTSTREAM OUTPUTSTREAM SERVICE (QUOTE
IP)
(QUOTE SERVER)
USER T])
(TALK.IP.USERNAME
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICE MODE USER) (* cdl "10-May-87 10:15")
(LET (NAME)
(if (EQ SERVICE (QUOTE TEdit))
then (if (STREQUAL (SETQ NAME (USERNAME))
(CONSTANT null))
then (SETQ NAME NIL))
(PRINTOUT OUTPUTSTREAM NAME T)
(FORCEOUTPUT OUTPUTSTREAM)
(if (SETQ NAME (RATOM INPUTSTREAM TALK.READTABLE))
then (SETQ USER NAME)) (* Eat EOL)
(BIN INPUTSTREAM))
USER])
(TALK.IP.EVENT
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "18-May-87 16:29")
(while (AND (OPENP INPUTSTREAM)
(OPENP OUTPUTSTREAM)
(NOT (READP INPUTSTREAM)))
do (if (EOFP INPUTSTREAM)
then (CLOSEF? INPUTSTREAM))
(BLOCK])
(TALK.IP.CONNECT
[LAMBDA (HOST SERVICE) (* cdl "18-May-87 16:26")
(DECLARE (SPECVARS HOST SERVICE))
(LET (SOCKET)
(DECLARE (SPECVARS SOCKET))
(RESETLST [RESETSAVE NIL (BQUOTE (UDP.CLOSE.SOCKET , (SETQ SOCKET (
UDP.OPEN.SOCKET]
(PROG (REQUEST RESPONSE INPUTSTREAM NAME SERVICETYPE)
(if (STREQUAL (SETQ NAME (USERNAME))
(CONSTANT null))
then (SETQ NAME NIL))
(if [SETQ SERVICETYPE
(for SERVICE inside SERVICE
thereis (PROGN (UDP.SETUP (SETQ REQUEST (
\ALLOCATE.ETHERPACKET))
HOST TALK.UDP.PORT 0 SOCKET
(QUOTE FREE))
(UDP.APPEND.BYTE
REQUEST
(with GAP.SERVICETYPE
(for GAP.SERVICETYPE
in GAP.SERVICETYPES
thereis
(with GAP.SERVICETYPE
GAP.SERVICETYPE
(EQ SERVICE
GAP.SERVICENAME)))
GAP.UNSPECIFIED))
(UDP.APPEND.BYTE REQUEST 0)
(UDP.APPEND.WORD REQUEST 0)
(UDP.APPEND.WORD REQUEST (NCHARS
NAME))
(UDP.APPEND.STRING REQUEST NAME)
(if (SETQ RESPONSE
(UDP.EXCHANGE SOCKET REQUEST
SPP.USER.TIMEOUT))
then (SELECTQ (with
TALK.IP.PACKET
RESPONSE
TALK.STATUS)
(1
(* Didn't like that service type)
NIL)
(2
(* Can't connect)
(RETURN))
T)
else
(* Can't connect)
(RETURN]
then (if (STREAMP (SETQ INPUTSTREAM
(TCP.OPEN HOST (with TALK.IP.PACKET
RESPONSE
TALK.TEDIT.PORT)
NIL
(QUOTE ACTIVE)
(QUOTE INPUT)
T)))
then [RETURN (CONS SERVICETYPE (CONS
INPUTSTREAM
(TCP.OTHER.STREAM
INPUTSTREAM]
else (RETURN (QUOTE CONNECT)))
else (RETURN (QUOTE ANSWER])
(TALK.IP.PROTOCOLP
[LAMBDA NIL (* cdl "13-May-87 14:22")
(EVERY (QUOTE (UDP.GET TCP.OPEN))
(FUNCTION FGETD])
)
(RPAQ? TALK.UDP.PORT 517)
(APPENDTOVAR TALK.PROTOCOLTYPES (IP TALK.IP.PROTOCOLP DODIP.HOSTP TALK.IP.USERNAME TALK.IP.CONNECT
TALK.IP.EVENT))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.UDP.PORT)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS TALK.IP.PACKET [(TALK.PACKET.BASE (with UDP DATUM UDPCONTENTS))
(TALK.IP.USERNAME (\GETBASESTRING (with UDP DATUM UDPCONTENTS)
6
(with TALK.IP.PACKET DATUM
TALK.USERNAME.LENGTH]
(BLOCKRECORD TALK.PACKET.BASE ((TALK.SERVICE.BYTE BYTE)
(TALK.STATUS BYTE)
(TALK.TEDIT.PORT WORD)
(TALK.USERNAME.LENGTH WORD))))
]
)
(* * etc.)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ COURIER.SOCKET 5)
(CONSTANTS (COURIER.SOCKET 5))
)
)
(FILESLOAD COURIERSERVE)
(DEFINEQ
(TALK.TEDIT.READVISE
[LAMBDA NIL (* cdl "29-May-87 08:59")
(DECLARE (GLOBALVARS ADVISEDFNS))
(LET ((FNS (for FN in TALK.TEDIT.ADVISEDFNS unless (MEMB FN ADVISEDFNS) collect FN)))
(if FNS
then (APPLY (FUNCTION READVISE)
FNS])
(COURIER.RESET.SOCKET
[LAMBDA NIL (* cdl "26-Mar-87 08:28")
(CLOSENSOCKET (OPENNSOCKET COURIER.SOCKET (QUOTE ACCEPT))
T])
)
(APPENDTOVAR BACKGROUNDFNS COURIER.START.SERVER)
(APPENDTOVAR BEFORELOGOUTFORMS (COURIER.RESET.SOCKET))
(ADDTOVAR TALK.TEDIT.ADVISEDFNS TEDIT.SETSEL TEDIT.INSERT TEDIT.DELETE TEDIT.INSERT.OBJECT
TEDIT.LOOKS TEDIT.PARALOOKS OPENFILE-IN-TEDIT.INCLUDE)
(PUTPROPS TEDIT.SETSEL READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE SETSELFN)
STREAM CH# LEN POINT PENDINGDELFLG
LEAVECARETLOOKS OPERATION))))
(PUTPROPS TEDIT.INSERT READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE INSERTFN)
STREAM TEXT CH#ORSEL LOOKS DONTSCROLL)
)))
(PUTPROPS TEDIT.DELETE READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE DELETEFN)
STREAM SEL LEN))))
(PUTPROPS TEDIT.INSERT.OBJECT READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE IMAGEOBJFN)
STREAM OBJECT CH#))))
(PUTPROPS TEDIT.LOOKS READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE LOOKSFN)
STREAM NEWLOOKS SELORCH# LEN))))
(PUTPROPS TEDIT.PARALOOKS READVICE (NIL (BEFORE NIL (TALK.USERFN (QUOTE PARAFN)
TEXTOBJ NEWLOOKS SEL LEN))))
(PUTPROPS OPENFILE-IN-TEDIT.INCLUDE READVICE ((TEDIT.INCLUDE . OPENFILE)
(BEFORE NIL (TALK.USERFN (QUOTE INCLUDEFN)
STREAM FILE START END))))
(DECLARE: DONTCOPY DOEVAL@COMPILE
(ADDTOVAR CHARACTERNAMES (UNDO 2,4)
(REDO 2,10)
(NEXT 2,22)
(MARGINS 2,111)
(FONT 2,112)
(SHIFT.UNDO 2,44)
(SHIFT.REDO 2,50)
(SHIFT.NEXT 2,62)
(SHIFT.MARGINS 2,151)
(SHIFT.FONT 2,152)
(SHIFT.DEL 2,27))
)
(ADDTOVAR BackgroundMenuCommands (Talk (QUOTE (PROMPTPRINT (TALK)))
"Start a TALK session with another user/host."
(SUBITEMS (On (QUOTE (SETQ TALK.GAG NIL))
"Enable TALK server.")
(Off (QUOTE (SETQ TALK.GAG T))
"Disable TALK server."))))
(RPAQQ BackgroundMenu NIL)
(RPAQ TALK.ICON.BITMAP (READBITMAP))
(72 72
"OOOOOOOOOOOOOOOOOO@@"
"LAIKKGHHDBNOOOOOOO@@"
"OGFKJOKKEJDMOOOOOO@@"
"OG@KHOHHEJJOOOOOOO@@"
"OGFKJOKJMJNMOOOOOO@@"
"OGFHKGKKDBNOOOOOOO@@"
"OOOOOOOOOOOOOOOOOO@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"OOOOOOOOOOOOOOOOOO@@"
"LAKGDGOOOOOOOOOOOO@@"
"OGKBENOOOOOOOOOOOO@@"
"OGKEDGOOOOOOOOOOOO@@"
"OGKGENOOOOOOOOOOOO@@"
"OGKGDGOOOOOOOOOOOO@@"
"OOOOOOOOOOOOOOOOOO@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"OOOOOOOOOOOOOOOOOO@@"
"MM@HLGOOOOOOOOOOOO@@"
"LIFKENOOOOOOOOOOOO@@"
"MEFKDGOOOOOOOOOOOO@@"
"MMFKENOOOOOOOOOOOO@@"
"MM@HLGOOOOOOOOOOOO@@"
"OOOOOOOOOOOOOOOOOO@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"H@@@@@@@@@@@@@@@@A@@"
"OOOOOOOOOOOOOOOOOO@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TALK.TEDIT.ADVISEDFNS TALK.ICON.BITMAP COURIER.SOCKET)
)
(if (FGETD (QUOTE OPENTEXTSTREAM))
then
(TALK.TEDIT.READVISE))
(SETSYNTAX (CHARCODE SPACE)
(CHARCODE A)
TALK.READTABLE)
(ECHOCHAR (CHARCODE BS)
(QUOTE IGNORE)
TALK.TERMTABLE)
(COURIER.START.SERVER)
(TALK.START.IP.SERVER)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA TALK.USERFN)
)
(PUTPROPS TALK.LSP COPYRIGHT ("Stanford University" 1987))
STOP