3 <ENTRY SEND-PACKET RECEIVE-PACKET VSB-SEND VSB-DUMP VSB-WAIT
6 <ENTRY PROCESS-EVENT NORMAL-KEYS FUNCTION-KEYS GET-EVENT FREE-MOUSE-EVENTS
7 FREE-WINDOW-EVENTS ANY-INPUT? MOUSE-GRABBED? REDISPLAY-ICON
8 FREE-RECTANGLES CURRENT-ROOT-ID>
12 <INCLUDE "VSTYPES" "VSUTYPES">
13 <INCLUDE-WHEN <COMPILING? "VSBASE"> "VSDEFS" "VSUDEFS" "VSOPS">
16 <GDECL (VSB-DEBUG?) <OR ATOM !<FALSE>>
17 (VSB-PLIST REST-PLIST) LIST>
19 <SETG SEND-PACKET <IUVECTOR 6>>
20 <SETG RECEIVE-PACKET <IUVECTOR 6>>
21 <GDECL (RECEIVE-PACKET SEND-PACKET) <UVECTOR [6 FIX]>>
23 <DEFINE VSB-SEND (VS:VS FORCE?:<OR ATOM FALSE> REPLY?:<OR ATOM FIX FALSE>
25 "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
26 (RES:<OR FIX FALSE> 0) NVAL)
27 <VS-REQ .VS <+ <VS-REQ .VS> 1>>
29 <COND (<NOT <GASSIGNED? VSB-PLIST>>
31 <SETG REST-PLIST ,VSB-PLIST>)>
32 <SETG REST-PLIST <REST <PUTREST ,REST-PLIST
34 <SUBSTRUC <1 .STUFF>:UVECTOR>)>
37 <COND (<OR <NOT <VS-BUFFER .VS>>
38 <AND .FORCE? <0? <VS-BCT .VS>>>>
39 <COND (<REPEAT ((ST .STUFF) LEN OBJ)
40 <COND (<EMPTY? .ST> <RETURN T>)>
43 <COND (<NOT <SET LEN <CHANNEL-OP .CHN WRITE-BUFFER
47 <COND (<NOT <SET LEN <CHANNEL-OP .CHN WRITE-BUFFER
51 <SET ST <REST .ST 2>>)>
52 <COND (<AND <TYPE? .OBJ STRING BYTES>
53 <NOT <0? <MOD .LEN:FIX 4>>>>
54 <CHANNEL-OP .CHN WRITE-BUFFER
56 <- 4 <MOD .LEN:FIX 4>>>)>>
57 <COND (.REPLY? <VSB-WAIT .VS .REPLY?>)>)>)
59 <REPEAT (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
60 LEN:<OR FIX FALSE> NRES)
61 <COND (<EMPTY? .STUFF>
65 <RETURN <VSB-WAIT .VS .REPLY?>>)>
70 <COND (<==? <LENGTH .STUFF> 1>
72 <SET STUFF <REST .STUFF>>)
75 <SET STUFF <REST .STUFF 2>>)>
76 <COND (<SET NRES <STUFF .OBJ .LEN .VS>>
77 <SET RES <+ .RES .NRES>>)
80 <COND (<AND <NOT .REPLY?> ,VSB-DEBUG?>
81 <VSOP .VS X-QUERY-WINDOW
82 <COND (<ASSIGNED? CURRENT-ROOT-ID>
85 <VW-ID <CHANNEL-DATA <VS-TOPCHAN .VS>>>)>>)>
88 <DEFINE STUFF ST (OBJ:<OR <PRIMTYPE STRING> <PRIMTYPE UVECTOR>>
89 LEN:<OR FIX FALSE> VS:VS "OPT" (ALLOW-ODD? <>)
90 "AUX" (BUF:STRING <VS-BUFFER .VS>)
91 (CT <VS-BCT .VS>) NOBJ:STRING RES NRES
92 (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>))
93 <COND (<==? <ANDB <CALL TYPE .OBJ> *7*> 6>
98 <SET RES <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
99 <SET LEN <* 4 .RES>>)>
100 <SET NOBJ <CALL OBJECT <TYPE-C STRING>
101 <* 4 <LENGTH .OBJ:<PRIMTYPE UVECTOR>>>
107 <SET RES <SET LEN <LENGTH .OBJ:<PRIMTYPE STRING>>>>)>
108 <SET NOBJ <CHTYPE .OBJ:<PRIMTYPE STRING> STRING>>)>
109 <COND (<AND <G? .LEN <LENGTH .BUF>> <NOT <0? .CT>>>
110 <COND (<NOT <SET NRES <VSB-DUMP .VS>>>
112 <SET BUF <VS-BUFFER .VS>>
114 <COND (<G? .LEN <LENGTH .BUF>>
115 <COND (<CHANNEL-OP .CH WRITE-BUFFER .NOBJ .LEN>
116 <COND (<AND <NOT .ALLOW-ODD?> <NOT <0? <MOD .LEN 4>>>>
117 <STUFF " " <- 4 <MOD .LEN 4>> .VS T>)>
120 <SUBSTRUC .NOBJ 0 .LEN .BUF>
121 <VS-BUFFER .VS <REST .BUF .LEN>>
122 <VS-BCT .VS <+ .CT .LEN>>
123 <COND (<AND <NOT .ALLOW-ODD?> <NOT <0? <MOD .LEN 4>>>>
124 <STUFF " " <- 4 <MOD .LEN 4>> .VS T>)>
127 <DEFINE VSB-DUMP (VS:VS "AUX" (CHN:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>)
128 (BUF:STRING <VS-BUFFER .VS>) (CT:FIX <VS-BCT .VS>))
130 <COND (<CHANNEL-OP .CHN WRITE-BUFFER <SET BUF <VS-BUFFER-TOP .VS>>
136 <DEFINE VSB-WAIT (VS:VS "OPT" (RACT <>) (NOT-REALLY?:<OR ATOM FALSE> <>)
137 "AUX" (CH:<CHANNEL 'NETWORK> <VS-CHANNEL .VS>) (ANY? <>)
138 (P:UVECTOR ,RECEIVE-PACKET) (REQ <VS-REQ .VS>) CODE)
141 <SET RES <AND <CHANNEL-OP .CH INPUT-WAITING>
142 <CHANNEL-OP .CH READ-BUFFER .P>>>)
144 <SET RES <CHANNEL-OP .CH READ-BUFFER .P>>)>
147 <COND (<==? <SET CODE <VSI-CODE .P>> ,X-ERROR>
149 <COND (<OR <NOT .RACT>
150 <N==? <I-LPAR0 .P> .REQ>>
151 ; "Out-of-band error"
152 <VSB-REPORT-ERROR .VS .P>
153 ; "Report, then try again"
156 ; "Error in response to request, so return it"
157 <CHTYPE (<VSERR-ERRCODE .P> <VSERR-REQCODE .P>
158 <NTH ,VS-ERRORS <VSERR-ERRCODE .P>>) FALSE>)>)
159 (<==? .CODE ,X-REPLY>
165 <PROG ((LEN <I-SPAR0 .P>) ST:STRING)
166 <COND (<NOT <GASSIGNED? RANDOM-STRING>>
167 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
168 (<L? <LENGTH <SET ST ,RANDOM-STRING>> .LEN>
169 <SET ST <SETG RANDOM-STRING <ISTRING .LEN>>>)
170 (<G? <LENGTH .ST> .LEN>
171 <SET ST <REST .ST <- <LENGTH .ST> .LEN>>>)>
172 <CHANNEL-OP .CH READ-BUFFER .ST>
173 <COND (<NOT <0? <MOD .LEN 4>>>
174 <CHANNEL-OP .CH READ-BUFFER ,GSTRING
175 <- 4 <MOD .LEN 4>>>)>
177 (<==? .RACT 1> <I-LPAR0 .P>)
180 <PROCESS-EVENT .VS .P>
183 <COND (<NOT <PROCESS-EVENT .VS .P>> <AGAIN>)
186 ; "This hack enables optimization of mouse-moved events"
187 <COND (.NOT-REALLY? <AGAIN>)>)>)>)
193 <ERROR VS100-CONNECTION-DIED!-ERRORS .CH VSB-WAIT>
196 <SETG GSTRING <ISTRING 3>>
198 <DEFINE VSB-REPORT-ERROR (VS:VS PACKET:UVECTOR)
199 <COND (<TYPE? <INTERRUPT "VS-ERROR" .VS <VSERR-ERRCODE .PACKET>
200 <VSERR-REQCODE .PACKET>
201 <VSERR-REQNUM .PACKET>
202 <VSERR-REQFUNC .PACKET>
203 <OR <GET-WINDOW .VS <VSERR-WINDOW .PACKET>>
204 <VSERR-WINDOW .PACKET>>>
207 <ERROR RANDOM-ERROR-FROM-X!-ERRORS
208 <NTH ,VS-ERRORS <VSERR-ERRCODE .PACKET>>
209 <VSERR-REQCODE .PACKET>
210 <VSERR-REQNUM .PACKET>
211 <VSERR-REQFUNC .PACKET>
212 <OR <GET-WINDOW .VS <VSERR-WINDOW .PACKET>>
213 <VSERR-WINDOW .PACKET>>>)>>
215 <GDECL (FREE-MOUSE-EVENTS) <LIST [REST MOUSE-EVENT]>
216 (FREE-WINDOW-EVENTS) <LIST [REST WINDOW-EVENT]>
217 (FREE-RECTANGLES) <LIST [REST WE-RECTANGLE]>>
218 <COND (<NOT <GASSIGNED? FREE-MOUSE-EVENTS>>
219 <SETG FREE-MOUSE-EVENTS ()>
220 <SETG FREE-WINDOW-EVENTS ()>
222 <SETG FREE-RECTANGLES ()>)>
224 <DEFINE PROCESS-EVENT PE (VS:VS P:UVECTOR "AUX" WID:FIX (SW:ANY <>)
225 W:<OR VSCHAN FALSE> ML KIND:FIX (OUT <>) TL:<OR LIST FALSE>
226 ME:MOUSE-EVENT WE:WINDOW-EVENT MB:FIX VW:VSW NME
227 OWE:<OR WINDOW-EVENT FALSE>)
228 <COND (<==? <SET KIND <VSI-CODE .P>> ,KEY-RELEASED>
230 <COND (<NOT <0? <SET WID <VSI-SUBWINDOW .P>>>>
231 <COND (<NOT <SET W <GET-WINDOW .VS .WID>>>
233 <SET WID <VSI-WINDOW .P>>
234 <SET W <GET-WINDOW .VS .WID>>)>)
236 <SET W <GET-WINDOW .VS <VSI-WINDOW .P>>>)>
240 <OR <N==? .W <VS-TOPCHAN .VS>>
241 <AND <ASSIGNED? MOUSE-GRABBED?>
244 (<AND .SW <NOT <EMPTY? <SET ML <VW-MENU-WINDS <CHANNEL-DATA .W>:VSW>>>>>
246 <COND (<==? <MW-ID <1 .ML>> .SW>
249 <COND (<EMPTY? <SET ML <REST .ML>>> <RETURN>)>>)>
251 (<==? .KIND ,KEY-PRESSED>
253 (<SET OUT <TRANSLATE-KEY .VS
254 <ANDB <VSI-DETAIL .P>
255 %<XORB <ORB ,X-LEFT-MASK
259 <COND (<EMPTY? <SET TL ,FREE-CELLS>>
262 <SETG FREE-CELLS <REST .TL>>
267 (<OR <==? .KIND ,BUTTON-PRESSED>
268 <==? .KIND ,BUTTON-RELEASED>>
269 <SET ME <NULL-MOUSE-EVENT>>
270 <SET MB <ANDB <VSI-DETAIL .P> *377*>>
271 <ME-KIND .ME <COND (<==? .KIND ,BUTTON-PRESSED>
272 <COND (<0? .MB> ,ME-RIGHT-PRESSED)
273 (<1? .MB> ,ME-MIDDLE-PRESSED)
274 (T ,ME-LEFT-PRESSED)>)
279 (T ,ME-LEFT-RELEASED)>>
280 <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
281 <ME-X .ME <VSI-X .P>>
282 <ME-Y .ME <VSI-Y .P>>
283 <ME-TIME .ME <VSI-TIME .P>>
285 <ME-SUBWINDOW .ME .SW>
286 <ME-LOCATOR .ME <I-LPAR4 .P>>
287 <VS-LAST-MOUSE .VS .ME>
288 <SET OUT <1 <ME-CELL .ME> .ME>>)
289 (<AND <==? .KIND ,MOUSE-MOVED>
290 <SET NME <VS-LAST-MOUSE .VS>>
291 <==? <ME-KIND .NME> ,ME-MOVED>>
292 <ME-X .NME <VSI-X .P>>
293 <ME-Y .NME <VSI-Y .P>>)
294 (<OR <==? .KIND ,MOUSE-MOVED>
295 <==? .KIND ,ENTER-WINDOW>
296 <==? .KIND ,LEAVE-WINDOW>>
297 <COND (<==? <ANDB <VSI-DETAIL .P> *377*> 2>
298 ; "Intermediate event when moving around hierarchy"
300 <SET ME <NULL-MOUSE-EVENT>>
301 <ME-KIND .ME <COND (<==? .KIND ,MOUSE-MOVED>
303 (<==? .KIND ,ENTER-WINDOW>
307 <ME-STATE .ME <LSH <VSI-DETAIL .P> -8>>
308 <ME-X .ME <VSI-X .P>>
309 <ME-Y .ME <VSI-Y .P>>
310 <ME-TIME .ME <VSI-TIME .P>>
312 <ME-SUBWINDOW .ME .SW>
313 <ME-LOCATOR .ME <I-LPAR4 .P>>
314 <VS-LAST-MOUSE .VS .ME>
315 <SET OUT <1 <ME-CELL .ME> .ME>>)
316 (<==? .KIND ,UNMAP-WINDOW>
317 <SET WE <NULL-WINDOW-EVENT>>
318 <WE-KIND .WE ,WE-UNMAP-WINDOW>
320 <WE-SUBWINDOW .WE .SW>
321 <VW-REDISPLAY <CHANNEL-DATA .W:CHANNEL>:VSW <>>
322 <ADD-CHANGE .WE 0 0 0 0>
323 <SET OUT <1 <WE-CELL .WE> .WE>>)
324 (<AND <OR <==? .KIND ,EXPOSE-WINDOW>
325 <==? .KIND ,EXPOSE-REGION>
326 <==? .KIND ,EXPOSE-COPY>>
327 <N==? .W <VS-TOPCHAN .VS>>>
328 <COND (<COND (<AND <TYPE? .SW MENU-WINDOW>
329 <TEST-VW-MODE <MW-BITS .SW> ,VWM-UNSEEN>>
330 <MW-BITS .SW <ANDB <MW-BITS .SW>
331 <XORB ,VWM-UNSEEN -1>>>)
333 <SET VW <CHANNEL-DATA .W:VSCHAN>>
334 <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNSEEN>>
335 <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW>
336 <XORB ,VWM-UNSEEN -1>>>)>
337 ; "Discard exposed events for new windows..."
339 <COND (<NOT <SET OWE <VW-REDISPLAY <SET VW <CHANNEL-DATA .W>>>>>
340 <SET WE <NULL-WINDOW-EVENT>>)
343 <COND (<==? .KIND ,EXPOSE-WINDOW>
345 ; "If full redisplay, we can nuke previous saved
347 <VW-REDISPLAY .VW <>>
348 <RECYCLE-RECTANGLES <WE-CHANGES .OWE>>
349 <WE-CHANGES .OWE ()>)>
350 <COND (<OR <N==? <I-SPAR4 .P> <VW-WIDTH .VW>>
351 <N==? <I-SPAR5 .P> <VW-HEIGHT .VW>>>
352 <SET KIND ,WE-RESIZE-WINDOW>
353 <WE-OLDH .WE <VW-HEIGHT .VW>>
354 <WE-OLDW .WE <VW-WIDTH .VW>>
355 <VW-WIDTH .VW <I-SPAR4 .P>>
356 <VW-HEIGHT .VW <I-SPAR5 .P>>)
358 <SET KIND ,WE-EXPOSE-WINDOW>)>
359 <ADD-CHANGE .WE 0 0 <VW-WIDTH .VW> <VW-HEIGHT .VW>>)
360 (<==? .KIND ,EXPOSE-COPY>
361 <SET KIND ,WE-EXPOSE-COPY>
363 <VW-REDISPLAY .VW <>>
364 <SET WE <NULL-WINDOW-EVENT>>)>
365 <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
366 <I-SPAR4 .P> <I-SPAR5 .P>>)
368 <SET KIND ,WE-EXPOSE-REGION>
369 ; "Remember this guy in case we need to catch some events later"
370 <VW-REDISPLAY .VW .WE>
371 <ADD-CHANGE .WE <I-SPAR8 .P> <I-SPAR9 .P>
372 <I-SPAR4 .P> <I-SPAR5 .P>>)>
374 ; "This event is already on the queue, so don't return it"
380 <WE-SUBWINDOW .WE .SW>
381 <SET OUT <1 <WE-CELL .WE> .WE>>)>)>
383 <COND (<EMPTY? <SET TL <VS-ILIST .VS>>>
384 <VS-IBUFFER .VS .OUT>
388 <VS-ILIST .VS <REST .TL>>)>)>)>>
390 <DEFINE ADD-CHANGE (WE:WINDOW-EVENT TOP:FIX LEFT:FIX WIDTH:FIX HEIGHT:FIX
391 "AUX" (L:LIST <WE-CHANGES .WE>) (LL:LIST ,FREE-RECTANGLES)
392 REC:WE-RECTANGLE CELL:LIST)
395 (<SET REC <CHTYPE <UVECTOR
396 .TOP .LEFT .WIDTH .HEIGHT>
400 <SETG FREE-RECTANGLES <REST .LL>>
402 <REC-TOP <SET REC <1 .CELL>> .TOP>
403 <REC-LEFT .REC .LEFT>
404 <REC-WIDTH .REC .WIDTH>
405 <REC-HEIGHT .REC .HEIGHT>)>
406 <WE-CHANGES .WE <PUTREST .CELL .L>>>
408 <DEFINE RECYCLE-RECTANGLES (L:LIST)
409 <COND (<NOT <EMPTY? .L>>
410 <PUTREST <REST .L <- <LENGTH .L> 1>> ,FREE-RECTANGLES>
411 <SETG FREE-RECTANGLES .L>)>>
413 <DEFINE ANY-INPUT? (VS:VS)
414 <OR <NOT <EMPTY? <VS-IBUFFER .VS>>>
415 <CHANNEL-OP <VS-CHANNEL .VS> INPUT-WAITING>>>
417 <DEFINE GET-WINDOW (VS:VS WID:FIX "VALUE" <OR VSCHAN FALSE>)
418 <REPEAT ((L:<LIST [REST FIX VSCHAN]> <VS-ALL .VS>))
419 <COND (<EMPTY? .L> <RETURN <>>)>
420 <COND (<==? <1 .L> .WID> <RETURN <2 .L>>)>
421 <SET L <REST .L 2>>>>
423 <DEFINE GET-EVENT (VS:VS "OPT" (WAIT?:<OR ATOM FALSE> T)
424 "AUX" L TL (W:<OR VSCHAN FALSE> <>) FROB TCHN VW:VSW)
426 <COND (<EMPTY? <SET L <VS-IBUFFER .VS>>>
430 <SET L <VS-IBUFFER .VS>>)
431 (<NOT <VSB-WAIT .VS <> T>>
434 <SET L <VS-IBUFFER .VS>>)>)>
435 <VS-IBUFFER .VS <SET TL <REST .L>>>
438 <COND (<TYPE? <SET FROB <1 .L>> FIX CHARACTER>
439 <SETG FREE-CELLS <PUTREST .L ,FREE-CELLS>>
441 (<TYPE? .FROB MOUSE-EVENT>
442 <COND (<AND <==? <ME-KIND .FROB> ,ME-MOVED>
443 <==? .FROB <VS-LAST-MOUSE .VS>>>
444 <VSB-WAIT .VS <> T>)>
445 <COND (<==? .FROB <VS-LAST-MOUSE .VS>>
446 <VS-LAST-MOUSE .VS <>>)>
447 <COND (<CHANNEL-OPEN? <ME-WINDOW .FROB>>
448 <ME-CELL .FROB <1 .L 1>>)
450 <1 <SETG FREE-MOUSE-EVENTS
451 <PUTREST <ME-CELL .FROB> ,FREE-MOUSE-EVENTS>>
454 (<TYPE? .FROB WINDOW-EVENT>
455 <COND (<CHANNEL-OPEN? <SET TCHN <WE-WINDOW .FROB>>>
456 <COND (<VW-REAL <SET VW <CHANNEL-DATA .TCHN:CHANNEL>>:VSW>
457 ; "Handle window events for icons"
458 <CHANNEL-OP .TCHN:VSCHAN REDISPLAY-ICON>
459 <VW-REDISPLAY .VW <>>
460 <1 <SETG FREE-WINDOW-EVENTS
461 <PUTREST <WE-CELL .FROB>
462 ,FREE-WINDOW-EVENTS>>
464 <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
466 <COND (<==? <VW-REDISPLAY .VW>
469 <VW-REDISPLAY .VW <>>)>
470 <WE-CELL .FROB <1 .L 1>>)
472 <RECYCLE-RECTANGLES <WE-CHANGES .FROB>>
473 <1 <SETG FREE-WINDOW-EVENTS
474 <PUTREST <WE-CELL .FROB> ,FREE-WINDOW-EVENTS>>
479 <DEFINE NULL-MOUSE-EVENT ("AUX" (L:LIST ,FREE-MOUSE-EVENTS) ME:MOUSE-EVENT)
481 <CHTYPE [0 0 0 0 0 ,OUTCHAN <> 0 (1)] MOUSE-EVENT>)
484 <ME-CELL .ME <1 .L 1>>
485 <SETG FREE-MOUSE-EVENTS <REST .L>>
489 <DEFINE NULL-WINDOW-EVENT ("AUX" (L:LIST ,FREE-WINDOW-EVENTS) WE:WINDOW-EVENT)
491 <CHTYPE [0 ,OUTCHAN 0 () (1) 0 0] WINDOW-EVENT>)
494 <WE-CELL .WE <1 .L 1>>
495 <SETG FREE-WINDOW-EVENTS <REST .L>>
499 <DEFINE TRANSLATE-KEY (VS:VS DETAIL:FIX "AUX" (KEYNO:FIX <ANDB .DETAIL 255>)
500 (MAPS:<OR VECTOR FALSE> <VS-MAPS .VS>)
501 MAP KEY:<OR KEY FALSE> NUM:FIX)
502 <COND (<NOT .MAPS> <>)
503 (<AND <G=? .KEYNO ,KEY-MIN-SHIFT>
504 <L=? .KEYNO ,KEY-MAX-SHIFT>>
505 ; "Throw away shift key events"
508 <COND (<AND <G=? .KEYNO ,KEY-MIN-NORM>
509 <L=? .KEYNO ,KEY-MAX-NORM>>
512 <SET MAP <2 .MAPS>>)>
513 <SET KEYNO <- .KEYNO <1 .MAP> -1>>
515 (<AND <L=? .KEYNO <LENGTH <2 .MAP>:VECTOR>>
516 <SET KEY <NTH <2 .MAP>:VECTOR .KEYNO>>>
517 <COND (<NOT <0? <ANDB .DETAIL ,X-CONTROL-MASK>>>
518 <COND (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
519 <SET NUM <KD-CS .KEY>>)
521 <SET NUM <KD-CTRL .KEY>>)>)
522 (<NOT <0? <ANDB .DETAIL ,X-SHIFT-MASK>>>
523 <SET NUM <KD-SHIFT .KEY>>)
524 (<NOT <0? <ANDB .DETAIL ,X-SHIFT-LOCK-MASK>>>
525 <SET NUM <KD-LOCK .KEY>>)
527 <SET NUM <KD-NORM .KEY>>)>
528 <COND (<G=? .NUM 0> <CHTYPE .NUM CHARACTER>)