-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathINTERPINKIE
217 lines (177 loc) · 11.8 KB
/
INTERPINKIE
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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Feb-2025 18:08:54" {DSK}<home>paolo>il>interpinkie>INTERPINKIE.;18 11803
:EDIT-BY "PA"
:CHANGES-TO (FNS PARSE.FINGER.QUERY)
:PREVIOUS-DATE "14-Jan-2025 16:42:58" {DSK}<home>paolo>il>interpinkie>INTERPINKIE.;17)
(PRETTYCOMPRINT INTERPINKIECOMS)
(RPAQQ INTERPINKIECOMS
((* A finger client. Requires the nc and tr Unix programs to be installed on the host
operating system.)
(FNS BEGIN.FINGER.OUTPUT CREATE.FINGER.STREAM END.FINGER.OUTPUT HANDLE.FINGER.MENU
PARSE.FINGER.QUERY PINKIE QUERY.FINGER.SERVER VALID.FINGER.CHARS.P)))
(* A finger client. Requires the nc and tr Unix programs to be installed on the host operating system.
)
(DEFINEQ
(BEGIN.FINGER.OUTPUT
[LAMBDA (DESTINATION USER HOST) (* ; "Edited 5-Jan-2025 16:49 by PA")
(* ; "Edited 1-Jan-2025 18:10 by PA")
(* ; "Edited 30-Dec-2024 10:50 by PA")
(* Prepares DESTINATION for sending the response of a Finger query about USER at
HOST. For example, if DESTINATION is associated with a window the function sets
it to read-write, clear it, and sets a title that reflects the queried user and
host. In CLOS this function would be a :BEFORE method of QUERY.FINGER.SERVER.)
[if (TYPENAMEP DESTINATION 'WINDOW)
then (LET ((OUTSTREAM (TEXTSTREAM DESTINATION))) (* Save query as input suggestion for
the Finger menu command.)
(WINDOWPROP DESTINATION 'FINGERQUERY (CONCAT (OR USER "")
"@" HOST))
(TEXTPROP OUTSTREAM 'READONLY NIL)
(TEDIT.DELETE OUTSTREAM 1 (TEDIT.NCHARS OUTSTREAM))
(WINDOWPROP DESTINATION 'TITLE (CONCAT "Finger " (OR USER "")
"@" HOST]
DESTINATION])
(CREATE.FINGER.STREAM
[LAMBDA (NEWINP) (* ; "Edited 14-Jan-2025 16:41 by PA")
(* ; "Edited 30-Dec-2024 12:41 by PA")
(* Creates if necessary an output destination suitable for printing a Finger
response to the primary output if NEWINP is NIL, to a new separate window
otherwise. Returns a stream if NEWINP is NIL, otherwise a window whose OUTSTREAM
property holds a stream to send the output to.)
(*)
(* The Terminal font handles ASCII better than Gacha as it has actual underscore
and caret. Command history is not necessary for non interactive sessions like
this.)
(if NEWINP
then (LET* ((MENUW (MENUWINDOW (create MENU
ITEMS _ '((Finger CMDFINGER "Query a Finger server")
(Exit CMDEXIT "Quit the program."))
MENUFONT _ '(MODERN 12)
TITLE _ "Commands"
CENTERFLG _ T
WHENSELECTEDFN _ (FUNCTION HANDLE.FINGER.MENU))
T))
[TEDIT.PROCESS (TEDIT NIL NIL NIL '(FONT (TERMINAL 10)
HISTORY OFF]
(OUT (TEXTSTREAM TEDIT.PROCESS))
(MAINW (WFROMDS OUT)))
(ATTACHWINDOW MENUW MAINW 'RIGHT 'TOP)
(TEXTPROP OUT 'READONLY 'QUIET)
(WINDOWPROP MAINW 'TITLE "Finger")
MAINW)
else (OUTPUT])
(END.FINGER.OUTPUT
[LAMBDA (DESTINATION) (* ; "Edited 5-Jan-2025 16:52 by PA")
(* ; "Edited 30-Dec-2024 10:51 by PA")
(* Cleans up DESTINATION after printing the output of a Finger query.
For example, if DESTINATION is a window the function marks it as not modified and
sets it read-only. In CLOS this function would be an :AFTER method of
QUERY.FINGER.SERVER.)
[if (TYPENAMEP DESTINATION 'WINDOW)
then (LET ((OUTSTREAM (TEXTSTREAM DESTINATION))) (* Clear TEdit's prompt area.)
(TEDIT.PROMPTPRINT OUTSTREAM "" T)
(* Mark buffer as not changed so the user is not prompted whether to save when
quitting the program.)
(TEDIT.STREAMCHANGEDP OUTSTREAM T)
(TEXTPROP OUTSTREAM 'READONLY 'QUIET]
DESTINATION])
(HANDLE.FINGER.MENU
[LAMBDA (ITEM MENU KEY) (* ; "Edited 9-Jan-2025 17:17 by PA")
(* ; "Edited 6-Jan-2025 11:38 by PA")
(* ; "Edited 1-Jan-2025 18:07 by PA")
(* ; "Edited 30-Dec-2024 16:54 by PA")
(* Handle Finger menu selection.)
(LET [(MAINW (MAINWINDOW (WFROMMENU MENU]
(if (MEMBER KEY '(MIDDLE RIGHT))
then NIL
else (SELECTQ (CADR ITEM)
(CMDFINGER (TEDIT.PROMPTPRINT (TEXTSTREAM MAINW)
"" T)
(* PROMPTFORWORD returns a string with no leading or trailing whitespace, so
PARSE.FINGER.QUERY needs not check for this.)
(LET* ((QUERY (PROMPTFORWORD "Finger query [username]@hostname:"
(WINDOWPROP MAINW 'FINGERQUERY)
NIL
(GETPROMPTWINDOW MAINW)))
(PARSED.QUERY (PARSE.FINGER.QUERY QUERY)))
(if PARSED.QUERY
then (LET ((USER (CAR PARSED.QUERY))
(HOST (CDR PARSED.QUERY)))
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(BEGIN.FINGER.OUTPUT MAINW USER HOST)
(QUERY.FINGER.SERVER USER HOST (TEXTSTREAM
MAINW))
(END.FINGER.OUTPUT MAINW)))
else (TEDIT.PROMPTPRINT (TEXTSTREAM MAINW)
"Invalid query." T))))
(CMDEXIT (TEDIT.QUIT (TEXTSTREAM MAINW)))
(T (PROMPTPRINT "Unknown menu item."])
(PARSE.FINGER.QUERY
[LAMBDA (RAW.QUERY) (* ; "Edited 7-Feb-2025 18:08 by PA")
(* ; "Edited 9-Jan-2025 17:15 by PA")
(* ; "Edited 1-Jan-2025 17:41 by PA")
(* ; "Edited 28-Dec-2024 19:00 by PA")
(* Checks RAW.QUERY and returns a cons of lowercase strings
(user . host) if it is a valid Finger query, NIL otherwise.
User is NIL if the username is missing from RAW.QUERY.
Assumes RAW.QUERY has no leading or trailing whitespace.)
(LET* ((QUERY (L-CASE (MKSTRING RAW.QUERY)))
(@POS (OR (STRPOS "@" QUERY)
0)))
(* QUERY must have a minimum length, contain only valid characters, and not
contain more than one @ character.)
(if [AND (GEQ (NCHARS QUERY)
10)
(VALID.FINGER.CHARS.P QUERY)
(NULL (STRPOS "@" QUERY (ADD1 @POS]
then (CONS (LET [(USER (SUBSTRING QUERY 1 (SUB1 @POS]
(if (AND (GREATERP @POS 0)
(GREATERP (NCHARS USER)
0))
then USER
else NIL))
(SUBSTRING QUERY (ADD1 @POS)))
else NIL])
(PINKIE
[LAMBDA (QUERY NEWINP) (* ; "Edited 9-Jan-2025 17:17 by PA")
(* ; "Edited 6-Jan-2025 11:37 by PA")
(* ; "Edited 1-Jan-2025 17:46 by PA")
(* ; "Edited 30-Dec-2024 12:24 by PA")
(* Performs Finger QUERY and print the response to the primary output if NEWINP
is NIL, to a new window otherwise.)
(LET ((PARSED.QUERY (PARSE.FINGER.QUERY QUERY)))
(if PARSED.QUERY
then (LET ((USER (CAR PARSED.QUERY))
(HOST (CDR PARSED.QUERY))
(DESTINATION (CREATE.FINGER.STREAM NEWINP)))
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(BEGIN.FINGER.OUTPUT DESTINATION USER HOST)
(QUERY.FINGER.SERVER USER HOST (if (TYPENAMEP DESTINATION 'WINDOW)
then (TEXTSTREAM DESTINATION)
else DESTINATION))
(END.FINGER.OUTPUT DESTINATION)))
else (PRINTOUT T "Invalid query: " QUERY])
(QUERY.FINGER.SERVER
[LAMBDA (USER HOST STREAM) (* ; "Edited 3-Jan-2025 20:47 by PA")
(* ; "Edited 2-Jan-2025 17:28 by PA")
(* ; "Edited 28-Dec-2024 19:20 by PA")
(* Queries Finger server HOST about USER and prints the response to STREAM which
defaults to the primary output if not supplied.
If USER is NIL requests a list of users at HOST.)
(ShellCommand (CONCAT "echo %"" (OR USER "")
"%"|nc -C -w 3 " HOST " finger|tr -d %"\r%"")
(OR STREAM (OUTPUT])
(VALID.FINGER.CHARS.P
[LAMBDA (QUERY) (* ; "Edited 9-Jan-2025 17:09 by PA")
(* Returns the QUERY string if it contains only valid characters for a Finger
query, NIL otherwise.)
(NOT (STRPOSL '(@ %. a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L
M N O P Q R S T U V W X Y Z |0| |1| |2| |3| |4| |5| |6| |7| |8| |9|)
QUERY NIL T])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (805 11780 (BEGIN.FINGER.OUTPUT 815 . 2219) (CREATE.FINGER.STREAM 2221 . 4132) (
END.FINGER.OUTPUT 4134 . 5127) (HANDLE.FINGER.MENU 5129 . 7538) (PARSE.FINGER.QUERY 7540 . 9140) (
PINKIE 9142 . 10568) (QUERY.FINGER.SERVER 10570 . 11291) (VALID.FINGER.CHARS.P 11293 . 11778)))))
STOP