1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <h/kernel.h>
36 #include <h/graphics.h>
37 #include "include.h"
38 #include <sys/time.h>
39 #ifdef HAVE_UNISTD_H
40 #include <unistd.h>
41 #endif
42
43 #ifndef FD_ZERO
44 #include <sys/select.h>
45 #endif
46 #if defined(HAVE_POLL_H)
47 #include <poll.h>
48 #endif
49 #ifdef HAVE_BSTRING_H
50 #include <bstring.h>
51 #endif
52
53 #define MAX_DECORATION_NESTING 4
54
55 /********************************
56 * EVENT DISPATCHING *
57 ********************************/
58
59 void
resetDispatch()60 resetDispatch()
61 {
62 }
63
64
65 static void
is_pending(XtPointer ctx,int * source,XtInputId * id)66 is_pending(XtPointer ctx, int *source, XtInputId *id)
67 {
68 }
69
70 static void
is_timeout(XtPointer ctx,XtIntervalId * id)71 is_timeout(XtPointer ctx, XtIntervalId *id)
72 { status *p = (status *)ctx;
73
74 *p = FAIL;
75 }
76
77 #ifndef FD_ZERO
78 #define FD_ZERO(x) {(x)->fds_bits[0] = 0;}
79 #define FD_SET(n, x) {(x)->fds_bits[0] |= 1<<(n); }
80 #endif
81
82 static int dispatch_fd = -1;
83
84 status
ws_dispatch(Int FD,Any timeout)85 ws_dispatch(Int FD, Any timeout)
86 { XtIntervalId tid = 0;
87 XtInputId iid = 0;
88 status rval = SUCCEED;
89 int ofd = dispatch_fd;
90 int fd = (isDefault(FD) ? dispatch_fd :
91 isNil(FD) ? -1
92 : valInt(FD));
93
94 /* No context: wait for input */
95 /* timeout */
96 if ( ThePceXtAppContext == NULL )
97 { int ready;
98 #ifdef HAVE_POLL
99 int to;
100 struct pollfd fds[1];
101
102 if ( isNil(timeout) )
103 { to = -1;
104 } else if ( isDefault(timeout) )
105 { to = 250;
106 } else if ( isInteger(timeout) )
107 { to = valInt(timeout);
108 } else if ( instanceOfObject(timeout, ClassReal) )
109 { to = (int)(valReal(timeout)*1000.0);
110 } else
111 to = 256;
112
113 fds[0].fd = fd;
114 fds[0].events = POLLIN;
115
116 ready = poll(fds, 1, to);
117 #else
118 struct timeval to;
119 struct timeval *tp = &to;
120 fd_set readfds;
121 int setmax = 0;
122
123 if ( isNil(timeout) )
124 { tp = NULL;
125 } else if ( isDefault(timeout) )
126 { to.tv_sec = 0;
127 to.tv_usec = 250000;
128 } else
129 { double v;
130
131 if ( isInteger(timeout) )
132 v = (double)valInt(timeout)/1000.0;
133 else if ( instanceOfObject(timeout, ClassReal) )
134 v = valReal(timeout);
135 else
136 v = 0.25;
137
138 to.tv_sec = (long)v;
139 to.tv_usec = (long)(v * 1000000.0) % 1000000;
140 }
141
142 FD_ZERO(&readfds);
143 if ( fd >= 0 )
144 { FD_SET(fd, &readfds);
145 setmax = max(setmax, fd);
146 dispatch_fd = fd;
147 }
148
149 ready = select(setmax+1, &readfds, NULL, NULL, tp);
150 #endif
151 dispatch_fd = ofd;
152
153 return (ready > 0 ? SUCCEED : FAIL);
154 } /* A display: dispatch until there */
155 /* is input or a timeout */
156
157 if ( fd >= 0 )
158 { iid = XtAppAddInput(ThePceXtAppContext, fd,
159 (XtPointer) XtInputReadMask, is_pending, NULL);
160 dispatch_fd = fd;
161 }
162
163 if ( notNil(timeout) )
164 { long to = -1;
165
166 if ( isInteger(timeout) )
167 to = valInt(timeout);
168 else if ( instanceOfObject(timeout, ClassReal) )
169 to = (long)(valReal(timeout)*1000.0);
170
171 if ( to > 0 )
172 tid = XtAppAddTimeOut(ThePceXtAppContext, to, is_timeout,
173 (XtPointer) &rval);
174 }
175
176 DEBUG(NAME_dispatch, Cprintf("Dispatch: timeout = %s, tid = %p\n",
177 pp(timeout), (void*)tid));
178
179 if ( pceMTTryLock(LOCK_PCE) )
180 { RedrawDisplayManager(TheDisplayManager());
181 pceMTUnlock(LOCK_PCE);
182 }
183 /* All callbacks must be locked! */
184 XtAppProcessEvent(ThePceXtAppContext,
185 XtIMXEvent|XtIMTimer|XtIMAlternateInput);
186
187 if ( tid && rval ) /* if rval = FAIL, we had a timeout */
188 XtRemoveTimeOut(tid);
189 if ( iid )
190 XtRemoveInput(iid);
191 dispatch_fd = ofd;
192
193 considerLocStillEvent();
194
195 return rval;
196 }
197
198
199 static int
input_on_fd(int fd)200 input_on_fd(int fd)
201 {
202 #ifdef HAVE_POLL
203 struct pollfd fds[1];
204
205 fds[0].fd = fd;
206 fds[0].events = POLLIN;
207
208 return poll(fds, 1, 0) != 0;
209 #else
210 #ifndef __WINDOWS__
211 if ( fd < FD_SETSIZE )
212 #endif
213 { fd_set rfds;
214 struct timeval tv;
215
216 FD_ZERO(&rfds);
217 FD_SET(fd, &rfds);
218 tv.tv_sec = 0;
219 tv.tv_usec = 0;
220
221 return select(fd+1, &rfds, NULL, NULL, &tv) != 0;
222 } else
223 return 1;
224 #endif
225 }
226
227
228 void
ws_discard_input(const char * msg)229 ws_discard_input(const char *msg)
230 { if ( dispatch_fd >= 0 && input_on_fd(dispatch_fd) )
231 { char buf[1024];
232
233 Cprintf("%s; discarding input ...", msg);
234 if ( read(dispatch_fd, buf, sizeof(buf)) >= 0 )
235 Cprintf("ok\n");
236 else
237 Cprintf("failed\n");
238 }
239 }
240
241
242 /*******************************
243 * WINDOW TRANSLATIONS *
244 *******************************/
245
246 Any
ws_event_in_subwindow(EventObj ev,Any root)247 ws_event_in_subwindow(EventObj ev, Any root)
248 { DisplayObj d = getDisplayEvent(ev);
249 DisplayWsXref r = d->ws_ref;
250 Window src_w = XtWindow(widgetWindow(ev->window));
251 int dx, dy;
252 Window child;
253 int root_is_display;
254
255 if ( isDefault(root) )
256 root = d;
257
258 if ( (root_is_display = instanceOfObject(root, ClassDisplay)) )
259 { XWindowAttributes atts;
260 int depth = MAX_DECORATION_NESTING;
261
262 if ( d != root )
263 { errorPce(ev, NAME_notSameDisplay, root);
264 fail;
265 }
266
267 XGetWindowAttributes(r->display_xref, XtWindow(r->shell_xref), &atts);
268 XTranslateCoordinates(r->display_xref, src_w, atts.root,
269 valInt(ev->x), valInt(ev->y),
270 &dx, &dy, &child);
271
272 #if 0
273 DEBUG(NAME_pointer,
274 /* TEST STUFF */
275 ({ Window rr, cr;
276 int rx, ry, wx, wy, mask;
277
278 if ( XQueryPointer(r->display_xref, atts.root, &rr, &cr,
279 &rx, &ry, &wx, &wy, &mask) )
280 { Cprintf("XTranslateCoordinates --> %d\nXQueryPointer --> %d\n",
281 child, cr);
282 }
283 }));
284 #endif
285
286 while ( child != None && depth-- > 0 )
287 { Cell cell;
288
289 for_cell(cell, d->frames)
290 { FrameObj fr = cell->value;
291 Widget w;
292
293 if ( (w=widgetFrame(fr)) && child == XtWindow(w) )
294 answer(fr);
295 }
296
297 XTranslateCoordinates(r->display_xref, src_w, child,
298 valInt(ev->x), valInt(ev->y),
299 &dx, &dy, &child);
300 }
301
302 fail;
303 }
304
305 if ( instanceOfObject(root, ClassFrame) )
306 { FrameObj fr = root;
307 PceWindow sw;
308
309 XTranslateCoordinates(r->display_xref, src_w, XtWindow(widgetFrame(fr)),
310 valInt(ev->x), valInt(ev->y),
311 &dx, &dy, &child);
312 if ( child != None && (sw = getMemberHashTable(WindowTable, (Any) child)))
313 { if ( instanceOfObject(sw, ClassWindowDecorator) )
314 { XTranslateCoordinates(r->display_xref, src_w, child,
315 valInt(ev->x), valInt(ev->y), &dx, &dy,
316 &child);
317
318 if ( child != None )
319 answer(getMemberHashTable(WindowTable, (Any) child));
320 }
321 answer(sw);
322 }
323 } else /*if ( instanceOfObject(root, ClassWindow) )*/
324 { PceWindow sw = root;
325
326 XTranslateCoordinates(r->display_xref, src_w, XtWindow(widgetWindow(sw)),
327 valInt(ev->x), valInt(ev->y),
328 &dx, &dy, &child);
329 if ( child != None )
330 answer(getMemberHashTable(WindowTable, (Any) child));
331 }
332
333 fail;
334 }
335
336
337 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
338 We would like to wait for at most 0.25 seconds to distinguish between
339 C-x (cut) and C-xC-x (exchange-point-and-mark) commands for the
340 emulation of the CUA mode. This isn't really ideal as it waits
341 unconditionally without handling any messages. We inprove a bit
342 splitting it into a couple of shorter waits.
343
344 XCheckIfEvent() removes the matching event. Hence we always return
345 FALSE, but set a flag if we find the target event.
346 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
347
348 static int
is_key_event(Display * dsp,XEvent * ev,XPointer arg)349 is_key_event(Display *dsp, XEvent *ev, XPointer arg)
350 { if ( ev->xany.type == KeyPress )
351 { int *p = (int *)arg;
352
353 *p = TRUE;
354 }
355
356 return FALSE;
357 }
358
359
360 static int
key_waiting(DisplayObj d)361 key_waiting(DisplayObj d)
362 { DisplayWsXref r = d->ws_ref;
363 int waiting = FALSE;
364 XEvent event;
365
366 XCheckIfEvent(r->display_xref, &event, is_key_event, (XPointer) &waiting);
367
368 return waiting;
369 }
370
371
372 int
ws_wait_for_key(int maxwait)373 ws_wait_for_key(int maxwait)
374 { msleep(maxwait);
375
376 return key_waiting(CurrentDisplay(NIL));
377 }
378