(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "22-Jul-88 15:43:07" |{MCS:MCS:STANFORD}TALK.;10| 38505 previous date%: "16-Jun-88 09:25:17" |{MCS:MCS:STANFORD}TALK.;9|) (* " Copyright (c) 1987, 1988 by Stanford University. All rights reserved. ") (PRETTYCOMPRINT TALKCOMS) (RPAQQ TALKCOMS ((* TALK client/server code) (LOCALVARS . T) (FNS TALK) (FNS TALK.RECONNECT TALK.PROCESS TALK.DISPLAY TALK.LISTEN TALK.CLOSEFN TALK.ANSWER TALK.ANSWER.WINDOW TALK.ANSWER.USERNAME TALK.GET.NAME TALK.ADD.NAME TALK.FLASH.CARET TALK.WHENSELECTEDFN TALK.RINGBELLS TALK.START.SERVER) (FNS TALK.ICON.BUTTONEVENTFN TALK.ICON.CLOSEFN) (* TALK data) (DECLARE%: DONTCOPY (RECORDS TALK.SERVICETYPE TALK.PROTOCOLTYPE)) (VARS TALK.MENU.ITEMS TALK.USER.MESSAGES) (INITVARS TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES TALK.ICON.WINDOWS (TALK.ANSWER.WAIT 15) (TALK.READTABLE (COPYREADTABLE 'ORIG)) (TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500)) (TALK.CLOSED.STRING " -- Connection Closed") (TALK.ICON.FONT LITTLEFONT)) (GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION TALK.CLOSED.STRING TALK.ICON.FONT) (ALISTS (BackgroundMenuCommands Talk)) (VARS (BackgroundMenu)) (APPENDVARS (BACKGROUNDFNS TALK.START.SERVER) (AFTERMAKESYSFORMS (TALK.START.SERVER NIL T))) (BITMAPS TALK.ICON.BITMAP) (GLOBALVARS TALK.ICON.BITMAP) (P (SETSYNTAX (CHARCODE SPACE) (CHARCODE A) TALK.READTABLE)))) (* TALK client/server code) (DECLARE%: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) (DEFINEQ (TALK [LAMBDA (USER.OR.HOSTNAME SERVICE PROTOCOL) (* ; "Edited 9-Jun-88 12:32 by cdl") (* DECLARATIONS%: (RECORD RESULT  (SERVICETYPE INPUTSTREAM   . OUTPUTSTREAM))) (PROG (USER PROTOCOLTYPE PROTOCOLTYPES SERVICETYPE SERVICETYPES RESULT ADDRESSABLE?) (if (NULL USER.OR.HOSTNAME) then (if (SETQ USER.OR.HOSTNAME (TALK.GET.NAME)) then (if (LISTP USER.OR.HOSTNAME) then (RETURN (TALK.RECONNECT USER.OR.HOSTNAME))) else (RETURN))) (if SERVICE then (if [SETQ SERVICETYPE (for SERVICETYPE in TALK.SERVICETYPES thereis (with TALK.SERVICETYPE SERVICETYPE (STRING-EQUAL SERVICE TALK.SERVICENAME] then (SETQ SERVICETYPES (LIST SERVICETYPE)) else (RETURN (LIST "Unknown service type!" SERVICE))) else (if (NULL (SETQ SERVICETYPES TALK.SERVICETYPES)) then (RETURN "No services available!"))) (if PROTOCOL then (if (SETQ PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES)) then (SETQ PROTOCOLTYPES (LIST PROTOCOLTYPE)) else (RETURN (LIST "Unknown protocol!" PROTOCOL))) else (if (NULL (SETQ PROTOCOLTYPES TALK.PROTOCOLTYPES)) then (RETURN "No protocols available!"))) (if [SETQ PROTOCOLTYPE (bind ADDRESS for PROTOCOLTYPE in PROTOCOLTYPES when (with TALK.PROTOCOLTYPE PROTOCOLTYPE (SETQ ADDRESS (APPLY* TALK.HOSTNAMEFN USER.OR.HOSTNAME))) thereis (PROGN (TALK.ADD.NAME USER.OR.HOSTNAME ADDRESS (with TALK.PROTOCOLTYPE PROTOCOLTYPE TALK.PROTOCOLNAME)) (SETQ ADDRESSABLE? T) (SELECTQ (SETQ RESULT (with TALK.PROTOCOLTYPE PROTOCOLTYPE (APPLY* TALK.CONNECTFN ADDRESS SERVICETYPES))) (ANSWER (RETURN)) (LISTP RESULT] then (with RESULT RESULT (RETURN (TALK.PROCESS INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE 'CLIENT USER.OR.HOSTNAME T))) else (RETURN (if ADDRESSABLE? then (SELECTQ RESULT (ANSWER "No answer from TALK service!") (LIST "Can't connect to host!" USER.OR.HOSTNAME)) else (LIST "Host not found!" USER.OR.HOSTNAME]) ) (DEFINEQ (TALK.RECONNECT [LAMBDA (DESTINATION) (* ; "Edited 10-Jun-88 14:59 by cdl") (* DECLARATIONS%: (RECORD RESULT  (SERVICETYPE INPUTSTREAM   . OUTPUTSTREAM))  (RECORD DESTINATION  (NAME . ENTRIES)) (RECORD ENTRY  (PROTOCOL . ADDRESS))) (DECLARE (SPECVARS DESTINATION)) (if TALK.SERVICETYPES then [LET (PROTOCOLTYPE RESULT ENTRY ADDRESS) (* try all the protocols but prefer  those that have already succeeded) (if [SETQ PROTOCOLTYPE (for PROTOCOLTYPE in [SORT (APPEND TALK.PROTOCOLTYPES) (FUNCTION (LAMBDA (PROTOCOLTYPE) (* DECLARATIONS%: (RECORD  DESTINATION (NAME . ENTRIES))) (with TALK.PROTOCOLTYPE PROTOCOLTYPE (with DESTINATION DESTINATION (ASSOC TALK.PROTOCOLNAME ENTRIES] when [with TALK.PROTOCOLTYPE PROTOCOLTYPE (AND [SETQ ADDRESS (with DESTINATION DESTINATION (if (SETQ ENTRY (ASSOC TALK.PROTOCOLNAME ENTRIES)) then (with ENTRY ENTRY ADDRESS) else (APPLY* TALK.HOSTNAMEFN NAME] (SETQ RESULT (APPLY* TALK.CONNECTFN ADDRESS TALK.SERVICETYPES] thereis (SELECTQ RESULT (ANSWER (RETURN)) (LISTP RESULT] then (with RESULT RESULT (TALK.PROCESS INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE 'CLIENT (with DESTINATION DESTINATION NAME) T)) else (SELECTQ RESULT (ANSWER "No answer from TALK service!") (LIST "Can't connect to host!" (with DESTINATION DESTINATION NAME] else "No services available!"]) (TALK.PROCESS [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER SPAWN?) (* ; "Edited 9-Jun-88 12:35 by cdl") (if (LITATOM SERVICETYPE) then (SETQ SERVICETYPE (ASSOC SERVICETYPE TALK.SERVICETYPES))) (if (LITATOM PROTOCOLTYPE) then (SETQ PROTOCOLTYPE (ASSOC PROTOCOLTYPE TALK.PROTOCOLTYPES))) (LET ((DISPLAYSTREAM (TALK.DISPLAY INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER))) (if SPAWN? then [ADD.PROCESS `(TALK.LISTEN ,INPUTSTREAM ,OUTPUTSTREAM ,(KWOTE SERVICETYPE) ,(KWOTE PROTOCOLTYPE) ,DISPLAYSTREAM] else (TALK.LISTEN INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE DISPLAYSTREAM]) (TALK.DISPLAY [LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE PROTOCOLTYPE MODE USER) (* ; "Edited 9-Jun-88 14:46 by cdl") (* DECLARATIONS%: (ASSOCRECORD  MESSAGES (GREETING))) (LET (MAINWINDOW WINDOW REGION GREETING) (DECLARE (SPECVARS GREETING)) (SETQ USER (with TALK.PROTOCOLTYPE PROTOCOLTYPE (APPLY* TALK.USERNAMEFN INPUTSTREAM OUTPUTSTREAM SERVICETYPE 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 (" (with TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME) ")"))) (SETQ WINDOW (CREATEW REGION (CONCAT "(" (with TALK.PROTOCOLTYPE PROTOCOLTYPE TALK.PROTOCOLNAME) ") Talk from " USER))) (WINDOWPROP MAINWINDOW 'STREAMS (CONS INPUTSTREAM OUTPUTSTREAM)) (WINDOWADDPROP MAINWINDOW 'CLOSEFN (FUNCTION TALK.CLOSEFN)) (ATTACHWINDOW WINDOW MAINWINDOW 'BOTTOM) (ATTACHMENU (create MENU ITEMS _ TALK.MENU.ITEMS CENTERFLG _ T MENUBORDERSIZE _ 1 WHENSELECTEDFN _ (FUNCTION TALK.WHENSELECTEDFN)) WINDOW 'BOTTOM) (with TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.DISPLAYFN MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOLTYPE 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 SERVICETYPE PROTOCOLTYPE WINDOW) (* ; "Edited 7-Jun-88 08:42 by cdl") (PROG (ICON? (MAINWINDOW (MAINWINDOW WINDOW))) (with TALK.SERVICETYPE SERVICETYPE (APPLY* TALK.LISTENFN MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOLTYPE)) (TTY.PROCESS T) (CLOSEF? INPUTSTREAM) (if [OR (OPENWP WINDOW) (for PROP in '(ICON ICONWINDOW) thereis (SETQ ICON? (OPENWP (WINDOWPROP MAINWINDOW PROP] then (WINDOWPROP WINDOW 'TITLE (CONCAT (WINDOWPROP WINDOW 'TITLE) TALK.CLOSED.STRING)) (for WINDOW in (ATTACHEDWINDOWS WINDOW) when (WINDOWPROP WINDOW 'MENU) do (if (DETACHWINDOW WINDOW) then (CLOSEW WINDOW))) (if ICON? then (SHRINKW MAINWINDOW) else (FLASHWINDOW WINDOW]) (TALK.CLOSEFN [LAMBDA (WINDOW) (* ; "Edited 9-Jun-88 14:45 by cdl") (* DECLARATIONS%: (RECORD STREAMS  (INPUTSTREAM . OUTPUTSTREAM))) (LET ((STREAMS (WINDOWPROP WINDOW 'STREAMS NIL))) (if STREAMS then (with STREAMS STREAMS (CLOSEF? INPUTSTREAM) (CLOSEF? OUTPUTSTREAM]) (TALK.ANSWER [LAMBDA (USER SERVICE PROTOCOL ADDRESS) (* ; "Edited 9-Jun-88 09:20 by cdl") (LET [WINDOW REGION (EVENT (CREATE.EVENT)) (TIME (DATE '(DATEFORMAT NO.SECONDS] (DECLARE (GLOBALVARS \IDLING)) (PROGN (* Only really necessary if you're  talking to yourself) (SPAWN.MOUSE)) (WINDOWPROP (SETQ WINDOW (TALK.ANSWER.WINDOW USER)) '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 USER then (TALK.ADD.NAME USER ADDRESS PROTOCOL) (with REGION REGION (add BOTTOM HEIGHT) (TALK.ANSWER.USERNAME USER (CREATEREGION LEFT BOTTOM WIDTH (DIFFERENCE HEIGHT 7)) WINDOW))) (TALK.RINGBELLS WINDOW) (if (AND [STRINGP (AWAIT.EVENT EVENT (TIMES TALK.ANSWER.WAIT 1000 (if \IDLING then (* Provide extra time to login) 2 else 1] USER) then (* We timed out, leave the icon up  but change its functionality) (WINDOWPROP WINDOW 'TALK (LIST USER (CONS PROTOCOL ADDRESS))) (WINDOWPROP WINDOW 'EVENT NIL) (INVERTW WINDOW) else (WINDOWPROP WINDOW 'EVENT NIL) (CLOSEW WINDOW)) (WINDOWPROP WINDOW 'RESULT]) (TALK.ANSWER.WINDOW [LAMBDA (USER) (* ; "Edited 9-Jun-88 10:27 by cdl") (PROG (WINDOW REGION) [if TALK.ICON.WINDOWS then [if [AND USER (SETQ WINDOW (for WINDOW in TALK.ICON.WINDOWS thereis (EQUAL USER (CAR (WINDOWPROP WINDOW 'TALK] then (RETURN WINDOW) else (SETQ REGION (with REGION (WINDOWPROP (CAR TALK.ICON.WINDOWS) '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 'BUTTONEVENTFN (FUNCTION TALK.ICON.BUTTONEVENTFN)) (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION TALK.ICON.CLOSEFN)) (RETURN WINDOW]) (TALK.ANSWER.USERNAME [LAMBDA (USER REGION WINDOW) (* cdl "10-Jun-87 08:38") (LET (PTR FONTHEIGHT (FONT (DSPFONT NIL WINDOW))) (if (AND (GREATERP (NCHARS USER) (QUOTIENT (BITMAPWIDTH TALK.ICON.BITMAP) (CHARWIDTH (CHARCODE A) FONT))) (SETQ PTR (STRPOS (CONSTANT (CHARACTER (CHARCODE SPACE))) USER))) then (DSPFONT TALK.ICON.FONT WINDOW) (SETQ FONTHEIGHT (QUOTIENT (FONTPROP TALK.ICON.FONT 'HEIGHT) 2)) (CENTERPRINTINREGION (SUBSTRING USER 1 (SUB1 PTR)) (with REGION REGION (CREATEREGION LEFT (PLUS BOTTOM FONTHEIGHT) WIDTH HEIGHT)) WINDOW) (CENTERPRINTINREGION (SUBSTRING USER (ADD1 PTR) -1) (with REGION REGION (CREATEREGION LEFT (DIFFERENCE BOTTOM FONTHEIGHT) WIDTH HEIGHT)) WINDOW) (DSPFONT FONT WINDOW) else (CENTERPRINTINREGION USER REGION WINDOW]) (TALK.GET.NAME [LAMBDA NIL (* ; "Edited 16-Jun-88 09:24 by cdl") (* DECLARATIONS%: (RECORD ENTRY  (NAME . PAIRS)) (RECORD PAIR  (PROTOCOL . ADDRESS))) (LET [HOSTNAME HOSTNAMES MENU (ITEM '("" NIL ""] (if (SETQ HOSTNAMES (for ENTRY in TALK.HOSTNAMES collect (if (LISTP ENTRY) then [with ENTRY ENTRY `(,NAME ,(KWOTE ENTRY) NIL (SUBITEMS ,@(for PAIR in PAIRS collect (with PAIR PAIR `(,(CONCAT PROTOCOL " " ADDRESS) ,(KWOTE (LIST NAME PAIR] else ENTRY))) then (push HOSTNAMES ITEM)) [SETQ MENU (create MENU TITLE _ "TALK" ITEMS _ `(("Prompt for User/Host" 'PROMPT "Prompt for a new user or hostname." ) (,(if TALK.GAG then "Turn TALK On" else "Turn TALK Off") (PROGN (SETQ TALK.GAG (NOT TALK.GAG)) NIL) "Toggle TALK connection accept/refuse switch.") ,@HOSTNAMES] [if HOSTNAMES then (SHADEITEM ITEM MENU BLACKSHADE) (* Kludge to make entire line of  menu inverted, not just up to  subitem arrows) (with REGION (MENUITEMREGION ITEM MENU) (with MENU MENU (BLTSHADE BLACKSHADE (with WINDOW IMAGE SAVE) (PLUS LEFT MENUOUTLINESIZE) (PLUS BOTTOM MENUOUTLINESIZE) WIDTH HEIGHT] (SELECTQ (SETQ HOSTNAME (MENU MENU)) (PROMPT (SETQ HOSTNAME (MKATOM (PROMPTFORWORD "User or host?" NIL NIL PROMPTWINDOW))) (TERPRI PROMPTWINDOW)) NIL) HOSTNAME]) (TALK.ADD.NAME [LAMBDA (NAME ADDRESS PROTOCOL) (* ; "Edited 9-Jun-88 12:39 by cdl") (* DECLARATIONS%: (RECORD ENTRY  (NAME . PAIRS))) (LET (ENTRY) (if (NOT (EQUAL NAME ADDRESS)) then (if (SETQ ENTRY (bind HOSTNAME (NCHARS _ (NCHARS NAME)) for ENTRY in TALK.HOSTNAMES eachtime (SETQ HOSTNAME (if (LISTP ENTRY) then (with ENTRY ENTRY NAME) else ENTRY)) thereis (STRING-EQUAL HOSTNAME NAME))) then (if (NLISTP ENTRY) then (SETQ TALK.HOSTNAMES (DREMOVE ENTRY TALK.HOSTNAMES)) (push TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL ADDRESS))) else (PUTASSOC PROTOCOL ADDRESS (with ENTRY ENTRY PAIRS) )) else (push TALK.HOSTNAMES (LIST NAME (CONS PROTOCOL ADDRESS]) (TALK.FLASH.CARET [LAMBDA (WINDOW POSITION FLG) (* ; "Edited 2-Jun-88 15:17 by cdl") (DECLARE (GLOBALVARS DEFAULTCARET)) (if (OPENWP WINDOW) then (SELECTQ FLG (OFF [with POSITION POSITION (if XCOORD then (with CURSOR DEFAULTCARET (BITBLT CUIMAGE NIL NIL WINDOW XCOORD YCOORD NIL NIL NIL 'INVERT]) (ON [with POSITION POSITION (with CURSOR DEFAULTCARET (BITBLT CUIMAGE NIL NIL WINDOW (SETQ XCOORD (DIFFERENCE (DSPXPOSITION NIL WINDOW) CUHOTSPOTX)) (SETQ YCOORD (DIFFERENCE (DSPYPOSITION NIL WINDOW) CUHOTSPOTY)) NIL NIL NIL 'INVERT]) NIL]) (TALK.WHENSELECTEDFN [LAMBDA (ITEM FROMMENU BUTTON) (* ; "Edited 9-Jun-88 14:50 by cdl") (* 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)) 'TEXTSTREAM)) (if (AND (SETQ STREAMS (WINDOWPROP MAINWINDOW '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]) (TALK.START.SERVER [LAMBDA (PROTOCOL RESTART) (* ; "Edited 8-Jun-88 15:06 by cdl") (DECLARE (SPECVARS RESTART)) (if PROTOCOL then (LET ((PROTOCOLTYPE (ASSOC PROTOCOL TALK.PROTOCOLTYPES))) (DECLARE (SPECVARS PROTOCOLTYPE)) (if PROTOCOLTYPE then [with TALK.PROTOCOLTYPE PROTOCOLTYPE (if TALK.STARTSERVERFN then (CAR (NLSETQ (APPLY* TALK.STARTSERVERFN RESTART] else (ERROR PROTOCOL "Unknown protocol!"))) else (for PROTOCOLTYPE declare%: (SPECVARS PROTOCOLTYPE) in TALK.PROTOCOLTYPES do (with TALK.PROTOCOLTYPE PROTOCOLTYPE (if TALK.STARTSERVERFN then (NLSETQ (APPLY* TALK.STARTSERVERFN RESTART]) ) (DEFINEQ (TALK.ICON.BUTTONEVENTFN [LAMBDA (WINDOW) (* ; "Edited 9-Jun-88 10:02 by cdl") (* DECLARATIONS%: (RECORD  DESTINATION (NAME (PROTOCOL . ADDRESS)))) (RESETFORM (INVERTW WINDOW) (until (MOUSESTATE UP) do)) (ALLOW.BUTTON.EVENTS) (if (WINDOWPROP WINDOW 'EVENT) then (WINDOWPROP WINDOW 'RESULT T) (NOTIFY.EVENT (WINDOWPROP WINDOW 'EVENT NIL) T) else (LET ((DESTINATION (WINDOWPROP WINDOW 'TALK)) RESULT) (if (MOUSECONFIRM (CONCAT "(Re)Connect to " (with DESTINATION DESTINATION NAME) "?")) then (if (PROCESSP (SETQ RESULT (TALK.RECONNECT DESTINATION))) then (CLOSEW WINDOW) else (FLASHWINDOW WINDOW) (PROMPTPRINT RESULT]) (TALK.ICON.CLOSEFN [LAMBDA (WINDOW) (* cdl "10-May-87 10:07") (LET ((EVENT (WINDOWPROP WINDOW 'EVENT NIL))) (if EVENT then (NOTIFY.EVENT EVENT T))) (SETQ TALK.ICON.WINDOWS (DREMOVE WINDOW TALK.ICON.WINDOWS]) ) (* TALK data) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD TALK.SERVICETYPE (TALK.SERVICENAME TALK.DISPLAYFN TALK.LISTENFN)) (RECORD TALK.PROTOCOLTYPE (TALK.PROTOCOLNAME TALK.HOSTNAMEFN TALK.USERNAMEFN TALK.CONNECTFN TALK.EVENTFN TALK.STARTSERVERFN TALK.CASEARRAY)) ) ) (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)) "Execute a (RINGBELLS) on the remote machine.") (Message (LET [(MESSAGE (MENU (create MENU ITEMS _ TALK.USER.MESSAGES] (if [AND MESSAGE (TTY.PROCESSP (WINDOWPROP MAINWINDOW '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.")) (RPAQ? TALK.SERVICETYPES NIL) (RPAQ? TALK.PROTOCOLTYPES NIL) (RPAQ? TALK.GAG NIL) (RPAQ? TALK.HOSTNAMES NIL) (RPAQ? TALK.ICON.WINDOWS NIL) (RPAQ? TALK.ANSWER.WAIT 15) (RPAQ? TALK.READTABLE (COPYREADTABLE 'ORIG)) (RPAQ? TALK.DEFAULT.REGION (CREATEREGION 0 0 500 500)) (RPAQ? TALK.CLOSED.STRING " -- Connection Closed") (RPAQ? TALK.ICON.FONT LITTLEFONT) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TALK.MENU.ITEMS TALK.USER.MESSAGES TALK.SERVICETYPES TALK.PROTOCOLTYPES TALK.GAG TALK.HOSTNAMES TALK.ICON.WINDOWS TALK.ANSWER.WAIT TALK.READTABLE TALK.DEFAULT.REGION TALK.CLOSED.STRING TALK.ICON.FONT) ) (ADDTOVAR BackgroundMenuCommands (Talk '(PRINTOUT PROMPTWINDOW T (TALK) T) "Start a TALK session with another user/host.")) (RPAQQ BackgroundMenu NIL) (APPENDTOVAR BACKGROUNDFNS TALK.START.SERVER) (APPENDTOVAR AFTERMAKESYSFORMS (TALK.START.SERVER NIL T)) (RPAQQ TALK.ICON.BITMAP #*(80 78)OOOOOOOOOOOOOOOOOOOOLAIKKGHHDBNOOOOOOOOOOGFKJOKKEJDMOOOOOOOOOG@KHOHHEJJOOOOOOOOOOGFKJOKJMJNMOOOOOOOOOGFHKGKKDBNOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOLAKGDGOOOOOOOOOOOOOOOGKBENOOOOOOOOOOOOOOOGKEDGOOOOOOOOOOOOOOOGKGENOOOOOOOOOOOOOOOGKGDGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOLIFKENOOOOOOOOOOOOOOMEFKDGOOOOOOOOOOOOOOMMFKENOOOOOOOOOOOOOOMM@HLGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AH@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOOOOOOO ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TALK.ICON.BITMAP) ) (SETSYNTAX (CHARCODE SPACE) (CHARCODE A) TALK.READTABLE) (PUTPROPS TALK COPYRIGHT ("Stanford University" 1987 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2377 6659 (TALK 2387 . 6657)) (6660 31221 (TALK.RECONNECT 6670 . 10485) (TALK.PROCESS 10487 . 11403) (TALK.DISPLAY 11405 . 14118) (TALK.LISTEN 14120 . 15633) (TALK.CLOSEFN 15635 . 16150) ( TALK.ANSWER 16152 . 18935) (TALK.ANSWER.WINDOW 18937 . 21688) (TALK.ANSWER.USERNAME 21690 . 23092) ( TALK.GET.NAME 23094 . 25712) (TALK.ADD.NAME 25714 . 27266) (TALK.FLASH.CARET 27268 . 28866) ( TALK.WHENSELECTEDFN 28868 . 29649) (TALK.RINGBELLS 29651 . 30143) (TALK.START.SERVER 30145 . 31219)) ( 31222 32752 (TALK.ICON.BUTTONEVENTFN 31232 . 32451) (TALK.ICON.CLOSEFN 32453 . 32750))))) STOP