-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathTALK
616 lines (560 loc) · 38.2 KB
/
TALK
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jul-88 15:43:07" |{MCS:MCS:STANFORD}<LANE>TALK.;10| 38505
previous date%: "16-Jun-88 09:25:17" |{MCS:MCS:STANFORD}<LANE>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