3 <ENTRY SEND-PACKET RECEIVE-PACKET VSB-SEND VSB-DUMP VSB-WAIT>
5 <ENTRY PROCESS-EVENT NORMAL-KEYS FUNCTION-KEYS GET-EVENT FREE-MOUSE-EVENTS
6 FREE-WINDOW-EVENTS ANY-INPUT? MOUSE-GRABBED? REDISPLAY-ICON
11 <INCLUDE "VSTYPES" "VSUTYPES">
12 <INCLUDE-WHEN <COMPILING? "VSBASE"> "VSDEFS" "VSUDEFS">
14 <SETG SEND-PACKET <IUVECTOR 6>>
15 <SETG RECEIVE-PACKET <IUVECTOR 6>>
16 <GDECL (SEND-PACKET RECEIVE-PACKET) <UVECTOR [6 FIX]>>
18 <DEFINE VSB-SEND (VS:VS FORCE?:<OR ATOM FALSE> REPLY?:<OR ATOM FIX FALSE>
20 "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
21 (RES:<OR FIX FALSE> 0))
22 <VS-REQ .VS <+ <VS-REQ .VS> 1>>
23 <COND (<OR <NOT <VS-BUFFER .VS>>
24 <AND .FORCE? <0? <VS-BCT .VS>>>>
25 <COND (<AND <CHANNEL-OP .CHN WRITE-BUFFER !.STUFF> .REPLY?>
26 <VSB-WAIT .VS .REPLY?>)>)
28 <REPEAT (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
29 LEN:<OR FIX FALSE> NRES)
30 <COND (<EMPTY? .STUFF>
34 <RETURN <VSB-WAIT .VS .REPLY?>>)>
39 <COND (<==? <LENGTH .STUFF> 1>
41 <SET STUFF <REST .STUFF>>)
44 <SET STUFF <REST .STUFF 2>>)>
45 <COND (<SET NRES <STUFF .OBJ .LEN .VS>>
46 <SET RES <+ .RES .NRES>>)
50 <DEFINE STUFF ST (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
51 LEN:<OR FIX FALSE> VS:VS "AUX" (BUF:STRING <VS-BUFFER .VS>)
52 (CT <VS-BCT .VS>) NOBJ:STRING RES NRES
53 (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>))
54 <COND (<==? <ANDB <CALL TYPE .OBJ> *7*> 6>
59 <SET RES <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
60 <SET LEN <* 4 .RES>>)>
61 <SET NOBJ <CALL OBJECT <TYPE-C STRING>
62 <* 4 <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
68 <SET RES <SET LEN <LENGTH .OBJ:<PRIMTYPE STRING>>>>)>
69 <SET NOBJ <CHTYPE .OBJ:<PRIMTYPE STRING> STRING>>)>
70 <COND (<AND <G? .LEN <LENGTH .BUF>> <NOT <0? .CT>>>
71 <COND (<NOT <SET NRES <VSB-DUMP .VS>>>
73 <SET BUF <VS-BUFFER .VS>>
75 <COND (<G? .LEN <LENGTH .BUF>>
76 <COND (<CHANNEL-OP .CH WRITE-BUFFER .NOBJ .LEN> .RES)>)
78 <SUBSTRUC .NOBJ 0 .LEN .BUF>
79 <VS-BUFFER .VS <REST .BUF .LEN>>
80 <VS-BCT .VS <+ .CT .LEN>>
83 <DEFINE VSB-DUMP (VS:VS "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
84 (BUF:STRING <VS-BUFFER .VS>) (CT:FIX <VS-BCT .VS>))
86 <COND (<CHANNEL-OP .CHN WRITE-BUFFER <SET BUF <VS-BUFFER-TOP .VS>>
92 <DEFINE VSB-WAIT (VS:VS "OPT" (RACT <>) (NOT-REALLY?:<OR ATOM FALSE> <>)
93 "AUX" (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>) (ANY? <>)
94 (P:UVECTOR ,RECEIVE-PACKET) (REQ <VS-REQ .VS>) CODE)
97 <SET RES <AND <CHANNEL-OP .CH INPUT-WAITING>
98 <CHANNEL-OP .CH READ-BUFFER .P>>>)
100 <SET RES <CHANNEL-OP .CH READ-BUFFER .P>>)>
103 <COND (<==? <SET CODE <VSI-CODE .P>> ,X-ERROR>
105 <COND (<OR <NOT .RACT>
106 <N==? <I-LPAR0 .P> .REQ>>
107 ; "Out-of-band error"
108 <VSB-REPORT-ERROR .VS .P>
109 ; "Report, then try again"
112 ; "Error in response to request, so return it"
113 <CHTYPE (<I-SPAR2 .P> <I-SPAR3 .P>
114 <NTH ,VS-ERRORS <I-SPAR2 .P>>) FALSE>)>)
115 (<==? .CODE ,X-REPLY>
121 <PROG ((LEN <I-SPAR0 .P>) ST:STRING)
122 <COND (<NOT <GASSIGNED? RANDOM-STRING>>
123 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
124 (<L? <LENGTH <SET ST ,RANDOM-STRING>> .LEN>
125 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
126 (<G? <LENGTH .ST> .LEN>
127 <SET ST <REST .ST <- <LENGTH .ST> .LEN>>>)>
128 <CHANNEL-OP .CH READ-BUFFER .ST>
130 (<==? .RACT 1> <I-LPAR0 .P>)
133 <PROCESS-EVENT .VS .P>
136 <COND (<NOT <PROCESS-EVENT .VS .P>> <AGAIN>)
139 ; "This hack enables optimization of mouse-moved events"
140 <COND (.NOT-REALLY? <AGAIN>)>)>)>)
146 <ERROR VS100-CONNECTION-DIED!-ERRORS .CH VSB-WAIT>
149 <DEFINE VSB-REPORT-ERROR (VS:VS PACKET:UVECTOR)
150 <COND (<TYPE? <INTERRUPT "VS-ERROR" .VS <I-SPAR2 .PACKET>
151 <I-SPAR3 .PACKET> <I-LPAR0 .PACKET>>
154 <ERROR RANDOM-ERROR-FROM-X!-ERRORS
155 <NTH ,VS-ERRORS <I-SPAR2 .PACKET>>
160 <GDECL (FREE-MOUSE-EVENTS) <LIST [REST MOUSE-EVENT]>
161 (FREE-WINDOW-EVENTS) <LIST [REST WINDOW-EVENT]>
162 (FREE-RECTANGLES) <LIST [REST WE-RECTANGLE]>>
163 <COND (<NOT <GASSIGNED? FREE-MOUSE-EVENTS>>
164 <SETG FREE-MOUSE-EVENTS ()>
165 <SETG FREE-WINDOW-EVENTS ()>
167 <SETG FREE-RECTANGLES ()>)>
169 <DEFINE PROCESS-EVENT PE (VS:VS P:UVECTOR "AUX" WID:FIX (SW:ANY <>)
170 W:<OR VSCHAN FALSE> ML KIND:FIX (OUT <>) TL:<OR LIST FALSE>
171 ME:MOUSE-EVENT WE:WINDOW-EVENT MB:FIX VW:VSW NME
172 OWE:<OR WINDOW-EVENT FALSE>)
173 <COND (<==? <SET KIND <VSI-KIND .P>> ,KEY-RELEASED>
175 <COND (<NOT <0? <SET WID <VSI-SUBWINDOW .P>>>>
176 <COND (<NOT <SET W <GET-WINDOW .VS .WID>>>
178 <SET WID <VSI-WINDOW .P>>
179 <SET W <GET-WINDOW .VS .WID>>)>)
181 <SET W <GET-WINDOW .VS <VSI-WINDOW .P>>>)>
185 <OR <N==? .W <VS-TOPCHAN .VS>>
186 <AND <ASSIGNED? MOUSE-GRABBED?>
189 (<AND .SW <NOT <EMPTY? <SET ML <VW-MENU-WINDS <CHANNEL-DATA .W>:VSW>>>>>
191 <COND (<==? <MW-ID <1 .ML>> .SW>
194 <COND (<EMPTY? <SET ML <REST .ML>>> <RETURN>)>>)>
196 (<==? .KIND ,KEY-PRESSED>
198 (<SET OUT <TRANSLATE-KEY .VS
199 <ANDB <VSI-DETAIL .P>
200 %<XORB <ORB ,X-LEFT-MASK
204 <COND (<EMPTY? <SET TL ,FREE-CELLS>>
207 <SETG FREE-CELLS <REST .TL>>
212 (<OR <==? .KIND ,BUTTON-PRESSED>
213 <==? .KIND ,BUTTON-RELEASED>>
214 <SET ME <NULL-MOUSE-EVENT>>
215 <SET MB <ANDB <VSI-DETAIL .P> *377*>>
216 <ME-KIND .ME <COND (<==? .KIND ,BUTTON-PRESSED>
217 <COND (<0? .MB> ,ME-RIGHT-PRESSED)
218 (<1? .MB> ,ME-MIDDLE-PRESSED)
219 (T ,ME-LEFT-PRESSED)>)
224 (T ,ME-LEFT-RELEASED)>>
225 <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
226 <ME-X .ME <VSI-X .P>>
227 <ME-Y .ME <VSI-Y .P>>
228 <ME-TIME .ME <VSI-TIME .P>>
230 <ME-SUBWINDOW .ME .SW>
231 <ME-LOCATOR .ME <I-LPAR4 .P>>
232 <VS-LAST-MOUSE .VS .ME>
233 <SET OUT <1 <ME-CELL .ME> .ME>>)
234 (<AND <==? .KIND ,MOUSE-MOVED>
235 <SET NME <VS-LAST-MOUSE .VS>>
236 <==? <ME-KIND .NME> ,ME-MOVED>>
237 <ME-X .NME <VSI-X .P>>
238 <ME-Y .NME <VSI-Y .P>>)
239 (<OR <==? .KIND ,MOUSE-MOVED>
240 <==? .KIND ,ENTER-WINDOW>
241 <==? .KIND ,LEAVE-WINDOW>>
242 <COND (<==? <ANDB <VSI-DETAIL .P> *377*> 2>
243 ; "Intermediate event when moving around hierarchy"
245 <SET ME <NULL-MOUSE-EVENT>>
246 <ME-KIND .ME <COND (<==? .KIND ,MOUSE-MOVED>
248 (<==? .KIND ,ENTER-WINDOW>
252 <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
253 <ME-X .ME <VSI-X .P>>
254 <ME-Y .ME <VSI-Y .P>>
255 <ME-TIME .ME <VSI-TIME .P>>
257 <ME-SUBWINDOW .ME .SW>
258 <ME-LOCATOR .ME <I-LPAR4 .P>>
259 <VS-LAST-MOUSE .VS .ME>
260 <SET OUT <1 <ME-CELL .ME> .ME>>)
261 (<==? .KIND ,UNMAP-WINDOW>
262 <SET WE <NULL-WINDOW-EVENT>>
263 <WE-KIND .WE ,WE-UNMAP-WINDOW>
265 <WE-SUBWINDOW .WE .SW>
266 <VW-REDISPLAY <CHANNEL-DATA .W:CHANNEL>:VSW <>>
267 <ADD-CHANGE .WE 0 0 0 0>
268 <SET OUT <1 <WE-CELL .WE> .WE>>)
269 (<AND <OR <==? .KIND ,EXPOSE-WINDOW>
270 <==? .KIND ,EXPOSE-REGION>
271 <==? .KIND ,EXPOSE-COPY>>
272 <N==? .W <VS-TOPCHAN .VS>>>
273 <COND (<COND (<AND <TYPE? .SW MENU-WINDOW>
274 <TEST-VW-MODE <MW-BITS .SW> ,VWM-UNSEEN>>
275 <MW-BITS .SW <ANDB <MW-BITS .SW>
276 <XORB ,VWM-UNSEEN -1>>>)
278 <SET VW <CHANNEL-DATA .W:VSCHAN>>
279 <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNSEEN>>
280 <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW>
281 <XORB ,VWM-UNSEEN -1>>>)>
282 ; "Discard exposed events for new windows..."
284 <COND (<NOT <SET OWE <VW-REDISPLAY <SET VW <CHANNEL-DATA .W>>>>>
285 <SET WE <NULL-WINDOW-EVENT>>)
288 <COND (<==? .KIND ,EXPOSE-WINDOW>
290 ; "If full redisplay, we can nuke previous saved
292 <VW-REDISPLAY .VW <>>
293 <RECYCLE-RECTANGLES <WE-CHANGES .OWE>>
294 <WE-CHANGES .OWE ()>)>
295 <COND (<OR <N==? <I-SPAR4 .P> <VW-WIDTH .VW>>
296 <N==? <I-SPAR5 .P> <VW-HEIGHT .VW>>>
297 <SET KIND ,WE-RESIZE-WINDOW>
298 <WE-OLDH .WE <VW-HEIGHT .VW>>
299 <WE-OLDW .WE <VW-WIDTH .VW>>
300 <VW-WIDTH .VW <I-SPAR4 .P>>
301 <VW-HEIGHT .VW <I-SPAR5 .P>>)
303 <SET KIND ,WE-EXPOSE-WINDOW>)>
304 <ADD-CHANGE .WE 0 0 <VW-WIDTH .VW> <VW-HEIGHT .VW>>)
305 (<==? .KIND ,EXPOSE-COPY>
306 <SET KIND ,WE-EXPOSE-COPY>
308 <VW-REDISPLAY .VW <>>
309 <SET WE <NULL-WINDOW-EVENT>>)>
310 <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
311 <I-SPAR4 .P> <I-SPAR5 .P>>)
313 <SET KIND ,WE-EXPOSE-REGION>
314 ; "Remember this guy in case we need to catch some events later"
315 <VW-REDISPLAY .VW .WE>
316 <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
317 <I-SPAR4 .P> <I-SPAR5 .P>>)>
319 ; "This event is already on the queue, so don't return it"
325 <WE-SUBWINDOW .WE .SW>
326 <SET OUT <1 <WE-CELL .WE> .WE>>)>)>
328 <COND (<EMPTY? <SET TL <VS-ILIST .VS>>>
329 <VS-IBUFFER .VS .OUT>
333 <VS-ILIST .VS <REST .TL>>)>)>)>>
335 <DEFINE ADD-CHANGE (WE:WINDOW-EVENT TOP:FIX LEFT:FIX WIDTH:FIX HEIGHT:FIX
336 "AUX" (L:LIST <WE-CHANGES .WE>) (LL:LIST ,FREE-RECTANGLES)
337 REC:WE-RECTANGLE CELL:LIST)
340 (<SET REC <CHTYPE <UVECTOR
341 .TOP .LEFT .WIDTH .HEIGHT>
345 <SETG FREE-RECTANGLES <REST .LL>>
347 <REC-TOP <SET REC <1 .CELL>> .TOP>
348 <REC-LEFT .REC .LEFT>
349 <REC-WIDTH .REC .WIDTH>
350 <REC-HEIGHT .REC .HEIGHT>)>
351 <WE-CHANGES .WE <PUTREST .CELL .L>>>
353 <DEFINE RECYCLE-RECTANGLES (L:LIST)
354 <COND (<NOT <EMPTY? .L>>
355 <PUTREST <REST .L <- <LENGTH .L> 1>> ,FREE-RECTANGLES>
356 <SETG FREE-RECTANGLES .L>)>>
358 <DEFINE ANY-INPUT? (VS:VS)
359 <OR <NOT <EMPTY? <VS-IBUFFER .VS>>>
360 <CHANNEL-OP <VS-CHANNEL .VS> INPUT-WAITING>>>
362 <DEFINE GET-WINDOW (VS:VS WID:FIX "VALUE" <OR VSCHAN FALSE>)
363 <REPEAT ((L:<LIST [REST FIX VSCHAN]> <VS-ALL .VS>))
364 <COND (<EMPTY? .L> <RETURN <>>)>
365 <COND (<==? <1 .L> .WID> <RETURN <2 .L>>)>
366 <SET L <REST .L 2>>>>
368 <DEFINE GET-EVENT (VS:VS "OPT" (WAIT?:<OR ATOM FALSE> T)
369 "AUX" L TL (W:<OR VSCHAN FALSE> <>) FROB TCHN VW:VSW)
371 <COND (<EMPTY? <SET L <VS-IBUFFER .VS>>>
375 <SET L <VS-IBUFFER .VS>>)
376 (<NOT <VSB-WAIT .VS <> T>>
379 <SET L <VS-IBUFFER .VS>>)>)>
380 <VS-IBUFFER .VS <SET TL <REST .L>>>
383 <COND (<TYPE? <SET FROB <1 .L>> FIX CHARACTER>
384 <SETG FREE-CELLS <PUTREST .L ,FREE-CELLS>>
386 (<TYPE? .FROB MOUSE-EVENT>
387 <COND (<AND <==? <ME-KIND .FROB> ,ME-MOVED>
388 <==? .FROB <VS-LAST-MOUSE .VS>>>
389 <VSB-WAIT .VS <> T>)>
390 <COND (<==? .FROB <VS-LAST-MOUSE .VS>>
391 <VS-LAST-MOUSE .VS <>>)>
392 <COND (<CHANNEL-OPEN? <ME-WINDOW .FROB>>
393 <ME-CELL .FROB <1 .L 1>>)
395 <1 <SETG FREE-MOUSE-EVENTS
396 <PUTREST <ME-CELL .FROB> ,FREE-MOUSE-EVENTS>>
399 (<TYPE? .FROB WINDOW-EVENT>
400 <COND (<CHANNEL-OPEN? <SET TCHN <WE-WINDOW .FROB>>>
401 <COND (<VW-REAL <SET VW <CHANNEL-DATA .TCHN:CHANNEL>>:VSW>
402 ; "Handle window events for icons"
403 <CHANNEL-OP .TCHN:VSCHAN REDISPLAY-ICON>
404 <VW-REDISPLAY .VW <>>
405 <1 <SETG FREE-WINDOW-EVENTS
406 <PUTREST <WE-CELL .FROB>
407 ,FREE-WINDOW-EVENTS>>
409 <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
411 <COND (<==? <VW-REDISPLAY .VW>
414 <VW-REDISPLAY .VW <>>)>
415 <WE-CELL .FROB <1 .L 1>>)
417 <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
418 <1 <SETG FREE-WINDOW-EVENTS
419 <PUTREST <WE-CELL .FROB> ,FREE-WINDOW-EVENTS>>
424 <DEFINE NULL-MOUSE-EVENT ("AUX" (L:LIST ,FREE-MOUSE-EVENTS) ME:MOUSE-EVENT)
426 <CHTYPE [0 0 0 0 0 ,OUTCHAN <> 0 (1)] MOUSE-EVENT>)
429 <ME-CELL .ME <1 .L 1>>
430 <SETG FREE-MOUSE-EVENTS <REST .L>>
434 <DEFINE NULL-WINDOW-EVENT ("AUX" (L:LIST ,FREE-WINDOW-EVENTS) WE:WINDOW-EVENT)
436 <CHTYPE [0 ,OUTCHAN 0 () (1) 0 0] WINDOW-EVENT>)
439 <WE-CELL .WE <1 .L 1>>
440 <SETG FREE-WINDOW-EVENTS <REST .L>>
444 <DEFINE TRANSLATE-KEY (VS:VS DETAIL:FIX "AUX" (KEYNO:FIX <ANDB .DETAIL 255>)
445 (MAPS:<OR VECTOR FALSE> <VS-MAPS .VS>)
446 MAP KEY:<OR KEY FALSE> NUM:FIX)
447 <COND (<NOT .MAPS> <>)
448 (<AND <G=? .KEYNO ,KEY-MIN-SHIFT>
449 <L=? .KEYNO ,KEY-MAX-SHIFT>>
450 ; "Throw away shift key events"
453 <COND (<AND <G=? .KEYNO ,KEY-MIN-NORM>
454 <L=? .KEYNO ,KEY-MAX-NORM>>
457 <SET MAP <2 .MAPS>>)>
458 <SET KEYNO <- .KEYNO <1 .MAP> -1>>
460 (<AND <L=? .KEYNO <LENGTH <2 .MAP>:VECTOR>>
461 <SET KEY <NTH <2 .MAP>:VECTOR .KEYNO>>>
462 <COND (<NOT <0? <ANDB .DETAIL ,X-CONTROL-MASK>>>
463 <COND (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
464 <SET NUM <KD-CS .KEY>>)
466 <SET NUM <KD-CTRL .KEY>>)>)
467 (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
468 <SET NUM <KD-SHIFT .KEY>>)
469 (<NOT <0? <ANDB .DETAIL ,X-SHIFT-LOCK-MASK>>>
470 <SET NUM <KD-LOCK .KEY>>)
472 <SET NUM <KD-NORM .KEY>>)>
473 <COND (<G=? .NUM 0> <CHTYPE .NUM CHARACTER>)