-
-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathFINGER
610 lines (487 loc) · 30.7 KB
/
FINGER
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
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Sep-88 10:44:56" |{EG:PARC:XEROX}<LANNING>LISP>USERS>FINGER.;5| 30905
changes to%: (FNS FINGER SEND.FINGER.REQUEST REFINGER FINGER.CONTAINS? FINGER.SETUP.WINDOW
FINGER.MENU.SELECTED FINGER.SETUP.MENU \FINGER.PRINTFN STRING.NOT.NUMERIC
FINGER.SERVER WAIT.FOR.FINGER.PACKET END.FINGER BACKGROUND.FINGER.SERVER
TRACE.FINGER)
(VARS FINGERCOMS)
(FUNCTIONS NETS.WITHIN)
previous date%: "14-Sep-88 18:05:53" |{EG:PARC:XEROX}<LANNING>LISP>USERS>FINGER.;4|)
(* "
Copyright (c) 1985, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT FINGERCOMS)
(RPAQQ FINGERCOMS
(
(* ;; "Modified 6-April-87 by smL to interface to TALK; 14-Sep-88 to work in Medley")
(P (IF (BOUNDP 'FINGER.WINDOW)
THEN
(END.FINGER)))
(FNS FINGER REFINGER FINGER.CONTAINS? SEND.FINGER.REQUEST STRING.NOT.NUMERIC)
(FUNCTIONS NETS.WITHIN)
(INITVARS (FINGER.TIMEOUT 1000)
(FINGER.NET.HOPS 2)
(FINGER.BASE.DATE (IDATE "14-Mar-84 00:00:00"))
(FINGER.CROWD NIL)
(FINGER.INFINITY.MINUTES 90)
(FINGER.CAPABILITIES '(TALK (AND (GETD 'TALK)
(NOT TALK.GAG)
(FIND.PROCESS 'COURIER.LISTENER)
T)
IDLING \IDLING SYSTEM 'Lisp)))
(* ;; "Tablebrowser and window stuff")
(FNS FINGER.SETUP.WINDOW FINGER.MENU.SELECTED FINGER.SETUP.MENU \FINGER.PRINTFN)
(FILES ICONW TABLEBROWSER)
(BITMAPS FINGER.ICON.BITMAP FINGER.ICON.MASK FINGER.INFINITY.BITMAP)
(VARS (FINGER.MENU))
(INITVARS (FINGER.ICON.POSITION (CREATE POSITION XCOORD _ 900 YCOORD _ 500))
(FINGER.ICON (ICONW FINGER.ICON.BITMAP FINGER.ICON.MASK FINGER.ICON.POSITION T))
(FINGER.DISPLAY.WIDTH 290)
(FINGER.DISPLAY.HEIGHT 140)
(FINGER.DISPLAY.POSITION (CREATE POSITION XCOORD _ (IDIFFERENCE SCREENWIDTH
FINGER.DISPLAY.WIDTH)
YCOORD _ 0)))
(* ;; "Responding to finger requests on the net")
(FNS FINGER.SERVER WAIT.FOR.FINGER.PACKET END.FINGER BACKGROUND.FINGER.SERVER)
(* ;; "Ether info")
(CONSTANTS (FINGER.SERVER.SOCKET# 199)
(\XIPT.FINGERRESPONSE 20)
(\XIPT.FINGERREQUEST 21))
(ALISTS (XIPTYPES \XIPT.FINGERRESPONSE \XIPT.FINGERREQUEST))
(FNS TRACE.FINGER)
(* ;; "Start up Finger")
(DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (P (FINGER.SERVER)
(FINGER)))
(* ;; "Compiler stuff")
(DECLARE%: EVAL@LOAD DONTCOPY (P (LOADCOMP 'LLNS))
(FILES TABLEBROWSERDECLS)
(RECORDS FINGER.HOST)
(GLOBALVARS FINGER.TIMEOUT FINGER.NET.HOPS FINGER.BASE.DATE FINGER.INFINITY.MINUTES
FINGER.ICON.POSITION FINGER.ICON FINGER.ICON.BITMAP FINGER.ICON.MASK
FINGER.INFINITY.BITMAP FINGER.DISPLAY.WIDTH FINGER.DISPLAY.HEIGHT
FINGER.DISPLAY.POSITION))
(* ;; "hints to the file manager")
(PROP MAKEFILE-ENVIRONMENT FINGER)))
(* ;; "Modified 6-April-87 by smL to interface to TALK; 14-Sep-88 to work in Medley")
(IF (BOUNDP 'FINGER.WINDOW)
THEN (END.FINGER))
(DEFINEQ
(FINGER
(LAMBDA (WHO HOST HOPS ICON?) (* ; "Edited 15-Sep-88 10:43 by smL")
(LET ((USERS (CL:SORT (SEND.FINGER.REQUEST (OR HOPS FINGER.NET.HOPS))
#'(CL:LAMBDA (USER1 USER2)
(CL:STRING< (FETCH (FINGER.HOST USERNAME) OF USER1)
(FETCH (FINGER.HOST USERNAME) OF USER2)))))
(WHOM (OR WHO FINGER.CROWD)))
(if (OR (NOT (BOUNDP 'FINGER.BROWSER))
(NOT (BOUNDP 'FINGER.WINDOW)))
then (FINGER.SETUP.WINDOW ICON?))
(if ICON?
then
(* ;;
"if the icon? is true then just set up the window without opening it or sending a request")
(if (NOT (OPENWP FINGER.ICON))
then (TOTOPW FINGER.ICON))
else (WINDOWPROP FINGER.WINDOW 'TITLE (CONCAT "Finger Display at " (SUBSTRING (DATE)
11 15)))
(TB.REPLACE.ITEMS FINGER.BROWSER)
(for P in USERS when (COND
((AND WHOM HOST)
(OR (FINGER.CONTAINS? (CADR P)
WHOM)
(FINGER.CONTAINS? (CAR P)
HOST)))
(WHOM (FINGER.CONTAINS? (CADR P)
WHOM))
(HOST (FINGER.CONTAINS? (CAR P)
HOST))
(T T))
do (TB.INSERT.ITEM FINGER.BROWSER
(create TABLEITEM
TIDATA _ P
TIUNDELETABLE _ T
TIUNSELECTABLE _ (NOT (LISTGET (fetch CAPABILITIES of P)
'TALK)))))
(TB.REDISPLAY.ITEMS FINGER.BROWSER)))))
(REFINGER
(LAMBDA (W) (* ; "Edited 14-Sep-88 18:03 by smL")
(* ;; "dummy fun to call finger w/ no args, so can use as redisplayfn, etc.")
(FINGER)))
(FINGER.CONTAINS?
(LAMBDA (ELEMENT L) (* ; "Edited 14-Sep-88 18:03 by smL")
(* ;;
"returns non-nil if element is list or is contained in list. case-insensitive compare used")
(COND
((TYPENAMEP L 'LISTP)
(MEMB (U-CASE ELEMENT)
(for X in L collect (U-CASE X))))
(T (EQ (U-CASE ELEMENT)
(U-CASE L))))))
(SEND.FINGER.REQUEST
(LAMBDA (NET.HOPS) (* ; "Edited 15-Sep-88 10:44 by smL")
(LET (FINGER.PACKET FINGER.USER.SOCKET NETS RESPONSES UNIQUERESULTS)
(RESETLST
(RESETSAVE NIL (LIST 'CLOSENSOCKET (SETQ FINGER.USER.SOCKET (OPENNSOCKET))))
(* ;; "Allocate a socket to send on")
(SETQ NETS (NETS.WITHIN NET.HOPS))
(* ;; "send this to every one on the net in question TWICE")
(for NET in (APPEND NETS NETS) do
(* ;; "Get the xip")
(SETQ FINGER.PACKET (ALLOCATE.XIP))
(\FILLINXIP \XIPT.FINGERREQUEST FINGER.USER.SOCKET
BROADCASTNSHOSTNUMBER FINGER.SERVER.SOCKET# NET
\XIPOVLEN FINGER.PACKET)
(SENDXIP FINGER.USER.SOCKET FINGER.PACKET)
(RELEASE.XIP FINGER.PACKET)
(BLOCK))
(SETQ RESPONSES (for P in (bind PACKET while (SETQ PACKET (GETXIP FINGER.USER.SOCKET
FINGER.TIMEOUT))
collect PACKET) bind PACKET.STREAM DATA
collect (SETQ PACKET.STREAM
(OPENSTRINGSTREAM (\GETBASESTRING (fetch XIPCONTENTS
of P)
0
(IDIFFERENCE (fetch XIPLENGTH
of P)
\XIPOVLEN))))
(SETQ DATA (CAR (NLSETQ (READ PACKET.STREAM))))
(CLOSEF? PACKET.STREAM)
(* ;;
"don't die on old finger packets when the user was not logged in")
(if (NUMBERP (CADR DATA))
then (SETQ DATA (CONS (CAR DATA)
(CONS "[none]" (CDR DATA)))))
DATA))
(* ;; "The responses are not necessarily eq for the same machine")
(for DATALIST in RESPONSES when (AND DATALIST (NOT (SASSOC (CAR DATALIST)
UNIQUERESULTS)))
do (SETQ UNIQUERESULTS (CONS DATALIST UNIQUERESULTS)))
UNIQUERESULTS))))
(STRING.NOT.NUMERIC
(LAMBDA (S) (* edited%: " 3-Aug-84 10:21")
(AND (STRPOSL (CONSTANT (MAKEBITTABLE (CHCON "0123456789")
T))
S)
S)))
)
(CL:DEFUN NETS.WITHIN (HOPS)
(DECLARE (GLOBAL \NS.ROUTING.TABLE))
(LET ((NETS NIL))
(\MAP.ROUTING.TABLE \NS.ROUTING.TABLE #'(CL:LAMBDA (ENTRY)
(CL:WHEN (<= (fetch (ROUTING RTHOPCOUNT)
of ENTRY)
HOPS)
(CL:SETQ NETS (CONS (fetch (ROUTING RTNET#
)
of ENTRY)
NETS)))))
NETS))
(RPAQ? FINGER.TIMEOUT 1000)
(RPAQ? FINGER.NET.HOPS 2)
(RPAQ? FINGER.BASE.DATE (IDATE "14-Mar-84 00:00:00"))
(RPAQ? FINGER.CROWD NIL)
(RPAQ? FINGER.INFINITY.MINUTES 90)
(RPAQ? FINGER.CAPABILITIES '(TALK (AND (GETD 'TALK)
(NOT TALK.GAG)
(FIND.PROCESS 'COURIER.LISTENER)
T)
IDLING \IDLING SYSTEM 'Lisp))
(* ;; "Tablebrowser and window stuff")
(DEFINEQ
(FINGER.SETUP.WINDOW
(LAMBDA (ICON?) (* ; "Edited 14-Sep-88 18:04 by smL")
(SETQ FINGER.WINDOW (CREATEW (CREATEREGION (fetch XCOORD of FINGER.DISPLAY.POSITION)
(fetch YCOORD of FINGER.DISPLAY.POSITION)
FINGER.DISPLAY.WIDTH
(HEIGHTIFWINDOW FINGER.DISPLAY.HEIGHT T))
"Finger Display Window" NIL NIL))
(SETQ FINGER.BROWSER (TB.MAKE.BROWSER NIL FINGER.WINDOW '(PRINTFN \FINGER.PRINTFN)))
(WINDOWPROP FINGER.WINDOW 'ICON FINGER.ICON)
(WINDOWPROP FINGER.WINDOW 'SCROLLEXTENTUSE (CONS 'LIMIT 'LIMIT))
(WINDOWADDPROP FINGER.WINDOW 'EXPANDFN 'REFINGER)
(WINDOWADDPROP FINGER.WINDOW 'CLOSEFN '(LAMBDA NIL
(SETQ FINGER.WINDOW 'NOBIND)))
(* ;
"REFINGER is a dummy fn to call FINGER with no arguments.")
(WINDOWADDPROP FINGER.WINDOW 'RESHAPEFN 'REFINGER)
(FINGER.SETUP.MENU FINGER.WINDOW FINGER.BROWSER)
(LET ((FINGER.PROMPT.WINDOW (GETPROMPTWINDOW FINGER.WINDOW 1 (FONTCREATE 'HELVETICA 10))))
(WINDOWPROP FINGER.PROMPT.WINDOW 'MINSIZE (CONS 0 (fetch (REGION HEIGHT)
of (WINDOWPROP FINGER.PROMPT.WINDOW
'REGION))))
(WINDOWPROP FINGER.PROMPT.WINDOW 'MAXSIZE (CONS 64000 (fetch (REGION HEIGHT)
of (WINDOWPROP FINGER.PROMPT.WINDOW
'REGION))))
(LINELENGTH MAX.SMALLP FINGER.PROMPT.WINDOW))
(if ICON?
then (SHRINKW FINGER.WINDOW NIL FINGER.ICON.POSITION)
else (* ;
"shouldn't need to open this, but for the moment, one has to")
(OPENW FINGER.ICON)
(MOVEW FINGER.ICON FINGER.ICON.POSITION)
(CLOSEW FINGER.ICON))))
(FINGER.MENU.SELECTED
(LAMBDA (ITEM MENU MOUSE) (* ; "Edited 14-Sep-88 18:04 by smL")
(if ITEM
then
(LET*
((browser (GETMENUPROP MENU 'TB))
(promptwindow (GETPROMPTWINDOW (TB.WINDOW browser))))
(DECLARE%: (SPECVARS promptwindow))
(ALLOW.BUTTON.EVENTS)
(SHADEITEM ITEM MENU MENUSELECTSHADE)
(SELECTQ (CAR ITEM)
(Update (FINGER))
(Talk (if (GETD 'TALK)
then (TB.MAP.SELECTED.ITEMS
browser
(FUNCTION (LAMBDA (browser item)
(DECLARE%: (SPECVARS promptwindow))
(LET ((host (fetch TIDATA of item))
talkresult)
(if (NOT (NULL (LISTGET (fetch CAPABILITIES
of host)
'TALK)))
then (printout promptwindow T "Trying to talk to "
(fetch USERNAME of host)
"...")
(SETQ talkresult (TALK (fetch (FINGER.HOST
NSHOSTNUMBER)
of host)))
(SELECTQ talkresult
(T (printout promptwindow T "Talking to "
(fetch USERNAME of host)
"."))
(NIL (printout promptwindow T "Talk to "
(fetch USERNAME of host)
" aborted."))
(printout promptwindow T talkresult))
else (printout promptwindow T (fetch USERNAME
of host)
" on "
(fetch HOSTNAME of host)
" is not running TALK.")))))
(FUNCTION (LAMBDA (browser)
(DECLARE%: (SPECVARS promptwindow))
(printout promptwindow T "No hosts selected to TALK to."))))
else (printout promptwindow T "Can't -- TALK is not loaded")))
NIL)
(SHADEITEM ITEM MENU WHITESHADE)))))
(FINGER.SETUP.MENU
(LAMBDA (WINDOW TABLE.BROWSER) (* ; "Edited 14-Sep-88 18:04 by smL")
(SETQ FINGER.MENU (create MENU
ITEMS _ '((Update NIL "Will update the finger display.")
(Talk NIL "Open a TALK connection to the selected people"))
WHENSELECTEDFN _ 'FINGER.MENU.SELECTED
CENTERFLG _ T
MENUOUTLINESIZE _ (IDIFFERENCE WBorder 3)
MENUFONT _ (FONTCREATE '(HELVETICA 8 BOLD))))
(ATTACHMENU FINGER.MENU WINDOW)
(PUTMENUPROP FINGER.MENU 'TB TABLE.BROWSER)))
(\FINGER.PRINTFN
(LAMBDA (browser item window) (* ; "Edited 14-Sep-88 18:04 by smL")
(NLSETQ (LET* ((FINGER.HOST (fetch TIDATA of item))
(IDLE (fetch IDLE of FINGER.HOST))
(INFINITE.IDLE NIL)) (* ; "seconds of idle time")
(if (IGEQ (IQUOTIENT IDLE 60)
FINGER.INFINITY.MINUTES)
then (SETQ INFINITE.IDLE T)
else (SETQ IDLE (SUBSTRING (GDATE (IPLUS FINGER.BASE.DATE IDLE))
11 15)))
(printout window (if (LISTGET (fetch CAPABILITIES of FINGER.HOST)
'TALK)
then "+"
else " ")
(fetch USERNAME of FINGER.HOST)
15
(L-CASE (fetch HOSTNAME of FINGER.HOST)
T)
30)
(if INFINITE.IDLE
then (BITBLT FINGER.INFINITY.BITMAP NIL NIL window (DSPXPOSITION NIL window)
(DSPYPOSITION NIL window))
(DSPXPOSITION (IPLUS (BITMAPWIDTH FINGER.INFINITY.BITMAP)
(DSPXPOSITION NIL window))
window)
else (PRIN1 IDLE window))))))
)
(FILESLOAD ICONW TABLEBROWSER)
(RPAQQ FINGER.ICON.BITMAP #*(71 48)@@@@@@@O@@@@@@@@@@@@@@@@@@AOL@@@@@@@@@@@@@@@@@AHN@@@@@@@@@@@@@@@@@AHG@@@@@@@@@@@@@@@@@AHG@@@@@@@@@@@@@@@@@AHC@@@@@@@@@@@@@@@@@CHAH@@@@@@@@@@@@@@@@CHAH@@@@@@@@@@@@@@@@G@AH@@@@@@@@@@@@@@@@OBAH@@@@@@@@@@@@@@@ALCKH@@@@@@@@@@@@@@@CL@C@@@@@@@@@@@@@@@@GH@G@@@@@@AO@@@@@@@@O@@N@@@@@GOOL@@@@@@CN@AL@@@AOOO@N@@@@@@OH@AH@@OOON@@F@@@@@AN@@CKOOOO@@H@F@@@@@GL@@COOOH@@@L@F@@@@@OH@@CN@@@B@@DCN@@@@AN@@@@@@@@C@@GOL@@@@CL@@@@@@@@A@GON@@@@@CH@@B@@@@@COON@@@@@@O@@@B@@@@COON@@@@@OON@@@F@@@@CO@@@@@@@OOH@@@L@@@@GOH@@@@@@L@@@@AH@@@GLCH@@@@@@F@@@@B@@AOL@AH@@@@@@F@@@@D@AO@@@AH@@@@@@F@@@AHDB@@@@AH@@@@@@F@@@G@LDN@@@G@@@@@@@G@@CL@HIC@@GN@@@@@@@C@@F@@HIN@OLGH@@@@@@C@@@@@HL@O@@AH@@@@@@C@@@@@HGOH@@AH@@@@@@C@@@@A@@LD@@AH@@@@@@C@@@@A@AIJ@@G@@@@@@@C@@@@C@AJF@OO@@@@@@@C@@@@B@@IHGHCH@@@@@@C@@@@F@@LCL@AH@@@@@@C@@@@D@@GL@@AH@@@@@@C@@@@D@@@IN@AH@@@@@@C@@@@D@@ABB@GH@@@@@@C@CO@@@@AKLAN@@@@@@@CAOOL@@@@HAOL@@@@@@@CONAO@@@@OOOH@@@@@@@CO@@GO@AOOO@@@@@@@@@@@@@COOOOL@@@@@@@@@@@@@@@AOO@@@@@@@@@@@@
)
(RPAQQ FINGER.ICON.MASK #*(71 48)@@@@@@@O@@@@@@@@@@@@@@@@@@AOL@@@@@@@@@@@@@@@@@AON@@@@@@@@@@@@@@@@@AOO@@@@@@@@@@@@@@@@@AOO@@@@@@@@@@@@@@@@@AOO@@@@@@@@@@@@@@@@@COOH@@@@@@@@@@@@@@@@COOH@@@@@@@@@@@@@@@@GOOH@@@@@@@@@@@@@@@@OOOH@@@@@@@@@@@@@@@AOOOH@@@@@@@@@@@@@@@COOO@@@@@@@@@@@@@@@@GOOO@@@@@@AO@@@@@@@@OOON@@@@@GOOL@@@@@@COOOL@@@AOOOON@@@@@@OOOOH@@OOOOOON@@@@@AOOOOKOOOOOOOON@@@@@GOOOOOOOOOOOOON@@@@@OOOOOOOOOOOOOON@@@@AOOOOOOOOOOOOOOL@@@@COOOOOOOOOOOOON@@@@@COOOOOOOOOOOON@@@@@@OOOOOOOOOOOON@@@@@OOOOOOOOOOOOO@@@@@@@OOOOOOOOOOOOOH@@@@@@OOOOOOOOOOOOOH@@@@@@GOOOOOOOOOOOOH@@@@@@GOOOOOOOOOOOOH@@@@@@GOOOOOOOOOOOOH@@@@@@GOOOOOOOOOOOO@@@@@@@GOOOOOOOOOOON@@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOO@@@@@@@COOOOOOOOOOOO@@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOH@@@@@@COOOOOOOOOOON@@@@@@@COOOOOOOOOOOL@@@@@@@CONAOOOOOOOOH@@@@@@@CO@@GOOOOOO@@@@@@@@@@@@@COOOOL@@@@@@@@@@@@@@@AOO@@@@@@@@@@@@
)
(RPAQQ FINGER.INFINITY.BITMAP
#*(20 10)@@@@@@@@@@@@@@@@CL@O@@@@GNCOH@@@LCG@L@@@LAN@L@@@LAL@L@@@LCN@L@@@GOCAH@@@CLAO@@@@)
(RPAQQ FINGER.MENU NIL)
(RPAQ? FINGER.ICON.POSITION (CREATE POSITION XCOORD _ 900 YCOORD _ 500))
(RPAQ? FINGER.ICON (ICONW FINGER.ICON.BITMAP FINGER.ICON.MASK FINGER.ICON.POSITION T))
(RPAQ? FINGER.DISPLAY.WIDTH 290)
(RPAQ? FINGER.DISPLAY.HEIGHT 140)
(RPAQ? FINGER.DISPLAY.POSITION (CREATE POSITION XCOORD _ (IDIFFERENCE SCREENWIDTH
FINGER.DISPLAY.WIDTH)
YCOORD _ 0))
(* ;; "Responding to finger requests on the net")
(DEFINEQ
(FINGER.SERVER
(LAMBDA NIL (* ; "Edited 7-Apr-87 15:04 by Briggs")
(* ;;; "spawn the process which will wait for finger requests, ensuring that there is only one finger server process.")
(DEL.PROCESS (FIND.PROCESS 'Finger% Server))
(while (FIND.PROCESS 'Finger% Server) do (BLOCK)) (* ;
"wait for the process to really die")
(ADD.PROCESS '(WAIT.FOR.FINGER.PACKET)
'NAME
'Finger% Server
'RESTARTABLE
'HARDRESET)
NIL))
(WAIT.FOR.FINGER.PACKET
(LAMBDA NIL (* N.H.Briggs " 7-Apr-87 23:39")
(* ;; "this function wakes up each time a finger request packet is received, it then sends back etherhostname (or address if no (pup) nameserver) ,the username, and the time since the last keyboard or mouse action.")
(LET ((FINGER.SERVER.SOCKET))
(RESETLST
(SETQ FINGER.SERVER.SOCKET (OPENNSOCKET FINGER.SERVER.SOCKET# 'ACCEPT))
(RESETSAVE NIL (LIST 'CLOSENSOCKET FINGER.SERVER.SOCKET T))
(DISCARDXIPS FINGER.SERVER.SOCKET)
(while T
do (AWAIT.EVENT (NSOCKETEVENT FINGER.SERVER.SOCKET))
(NLSETQ (PROG (RESPONSE.XIP DATA IDLETIME)
(SETQ RESPONSE.XIP (GETXIP FINGER.SERVER.SOCKET))
(if (OR (NOT RESPONSE.XIP)
(NEQ (fetch XIPTYPE of RESPONSE.XIP)
\XIPT.FINGERREQUEST))
then (* ; "false alarm, go back to sleep")
(RETURN))
(* ;;
"format of response is a string containing a list of the data elements")
(replace XIPLENGTH of RESPONSE.XIP with \XIPOVLEN)
(SETQ IDLETIME (IDIFFERENCE (IDATE)
(ALTO.TO.LISP.DATE \LASTUSERACTION)))
(SETQ DATA (MKSTRING (create FINGER.HOST
HOSTNAME _
(OR (STRING.NOT.NUMERIC (ETHERHOSTNAME
NIL T))
(PORTSTRING (ETHERHOSTNUMBER)))
USERNAME _
(if (STRING-EQUAL (USERNAME NIL NIL T)
"")
then "[none]"
else (USERNAME NIL NIL T))
IDLE _ IDLETIME
NSHOSTNUMBER _ \MY.NSADDRESS
CAPABILITIES _
(for CAPABILITY on FINGER.CAPABILITIES
by (CDDR CAPABILITY)
join (LIST (CAR CAPABILITY)
(EVAL (CADR CAPABILITY))))
)
T))
(XIPAPPEND.STRING RESPONSE.XIP DATA)
(SWAPXIPADDRESSES RESPONSE.XIP)
(* ;;
"now have to set the correct source since original dest was nsbroadcastnumber")
(replace XIPTYPE of RESPONSE.XIP with \XIPT.FINGERRESPONSE)
(replace XIPSOURCEHOST of RESPONSE.XIP with \MY.NSHOSTNUMBER)
(replace XIPSOURCENET of RESPONSE.XIP with 0)
(replace XIPSOURCESOCKET of RESPONSE.XIP with FINGER.SERVER.SOCKET#)
(SENDXIP FINGER.SERVER.SOCKET# RESPONSE.XIP))))))))
(END.FINGER
(LAMBDA NIL (* ; "Edited 7-Apr-87 14:52 by Briggs")
(DEL.PROCESS (FIND.PROCESS 'Finger% Server))
(if (BOUNDP 'FINGER.ICON)
then (if (WINDOWP FINGER.ICON)
then (CLOSEW FINGER.ICON)))
(if (BOUNDP 'FINGER.WINDOW)
then (if (WINDOWP FINGER.WINDOW)
then (CLOSEW FINGER.WINDOW))
(SETQ FINGER.WINDOW 'NOBIND))
(if (BOUNDP 'FINGER.BROWSER)
then (SETQ FINGER.BROWSER 'NOBIND))
NIL))
(BACKGROUND.FINGER.SERVER
(LAMBDA NIL (* N.H.Briggs "15-Apr-87 18:44")
(* ;; "this function wakes up each time a finger request packet is received, it then sends back etherhostname (or address if no (pup) nameserver) ,the username, and the time since the last keyboard or mouse action.")
(SETQ FINGER.SERVER.SOCKET (OPENNSOCKET FINGER.SERVER.SOCKET# 'ACCEPT))
(AWAIT.EVENT (NSOCKETEVENT FINGER.SERVER.SOCKET)
20)
(NLSETQ (PROG (RESPONSE.XIP DATA IDLETIME)
(SETQ RESPONSE.XIP (GETXIP FINGER.SERVER.SOCKET))
(if (OR (NOT RESPONSE.XIP)
(NEQ (fetch XIPTYPE of RESPONSE.XIP)
\XIPT.FINGERREQUEST))
then (* ; "false alarm, go back to sleep")
(RETURN))
(* ;; "format of response is a string containing a list of the data elements")
(replace XIPLENGTH of RESPONSE.XIP with \XIPOVLEN)
(SETQ IDLETIME (IDIFFERENCE (IDATE)
(ALTO.TO.LISP.DATE \LASTUSERACTION)))
(SETQ DATA (MKSTRING (create FINGER.HOST
HOSTNAME _ (OR (STRING.NOT.NUMERIC (ETHERHOSTNAME
NIL T))
(PORTSTRING (ETHERHOSTNUMBER)))
USERNAME _ (if (STRING-EQUAL (USERNAME NIL NIL T)
"")
then "[none]"
else (USERNAME NIL NIL T))
IDLE _ IDLETIME
NSHOSTNUMBER _ \MY.NSADDRESS
CAPABILITIES _ (for CAPABILITY on FINGER.CAPABILITIES
by (CDDR CAPABILITY)
join (LIST (CAR CAPABILITY)
(EVAL (CADR CAPABILITY))))
)
T))
(XIPAPPEND.STRING RESPONSE.XIP DATA)
(SWAPXIPADDRESSES RESPONSE.XIP)
(* ;; "now have to set the correct source since original dest was nsbroadcastnumber")
(replace XIPTYPE of RESPONSE.XIP with \XIPT.FINGERRESPONSE)
(replace XIPSOURCEHOST of RESPONSE.XIP with \MY.NSHOSTNUMBER)
(replace XIPSOURCENET of RESPONSE.XIP with 0)
(replace XIPSOURCESOCKET of RESPONSE.XIP with FINGER.SERVER.SOCKET#)
(SENDXIP FINGER.SERVER.SOCKET# RESPONSE.XIP)))))
)
(* ;; "Ether info")
(DECLARE%: EVAL@COMPILE
(RPAQQ FINGER.SERVER.SOCKET# 199)
(RPAQQ \XIPT.FINGERRESPONSE 20)
(RPAQQ \XIPT.FINGERREQUEST 21)
(CONSTANTS (FINGER.SERVER.SOCKET# 199)
(\XIPT.FINGERRESPONSE 20)
(\XIPT.FINGERREQUEST 21))
)
(ADDTOVAR XIPTYPES (\XIPT.FINGERRESPONSE 20)
(\XIPT.FINGERREQUEST 21))
(DEFINEQ
(TRACE.FINGER
(LAMBDA NIL (* smL " 6-Apr-87 17:17")
(SETQ XIPONLYTYPES (LIST \XIPT.FINGERREQUEST \XIPT.FINGERRESPONSE))
(XIPTRACE T)))
)
(* ;; "Start up Finger")
(DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY
(FINGER.SERVER)
(FINGER)
)
(* ;; "Compiler stuff")
(DECLARE%: EVAL@LOAD DONTCOPY
(LOADCOMP 'LLNS)
(FILESLOAD TABLEBROWSERDECLS)
(DECLARE%: EVAL@COMPILE
(RECORD FINGER.HOST (HOSTNAME USERNAME IDLE NSHOSTNUMBER CAPABILITIES))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FINGER.TIMEOUT FINGER.NET.HOPS FINGER.BASE.DATE FINGER.INFINITY.MINUTES
FINGER.ICON.POSITION FINGER.ICON FINGER.ICON.BITMAP FINGER.ICON.MASK FINGER.INFINITY.BITMAP
FINGER.DISPLAY.WIDTH FINGER.DISPLAY.HEIGHT FINGER.DISPLAY.POSITION)
)
)
(* ;; "hints to the file manager")
(PUTPROPS FINGER MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS FINGER COPYRIGHT ("Xerox Corporation" 1985 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3811 9845 (FINGER 3821 . 6008) (REFINGER 6010 . 6217) (FINGER.CONTAINS? 6219 . 6625) (
SEND.FINGER.REQUEST 6627 . 9595) (STRING.NOT.NUMERIC 9597 . 9843)) (11149 18743 (FINGER.SETUP.WINDOW
11159 . 13381) (FINGER.MENU.SELECTED 13383 . 16560) (FINGER.SETUP.MENU 16562 . 17242) (\FINGER.PRINTFN
17244 . 18741)) (21438 29521 (FINGER.SERVER 21448 . 22044) (WAIT.FOR.FINGER.PACKET 22046 . 25945) (
END.FINGER 25947 . 26471) (BACKGROUND.FINGER.SERVER 26473 . 29519)) (29871 30074 (TRACE.FINGER 29881
. 30072)))))
STOP