Mercurial > hg > xemacs-beta
comparison src/device-x.c @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:28:15 +0200 |
parents | |
children | a5df635868b2 |
comparison
equal
deleted
inserted
replaced
427:0a0253eac470 | 428:3ecd8885ac67 |
---|---|
1 /* Device functions for X windows. | |
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
3 Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
4 | |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: Not in FSF. */ | |
23 | |
24 /* Original authors: Jamie Zawinski and the FSF */ | |
25 /* Rewritten by Ben Wing and Chuck Thompson. */ | |
26 | |
27 #include <config.h> | |
28 #include "lisp.h" | |
29 | |
30 #include "console-x.h" | |
31 #include "xintrinsicp.h" /* CoreP.h needs this */ | |
32 #include <X11/CoreP.h> /* Numerous places access the fields of | |
33 a core widget directly. We could | |
34 use XtGetValues(), but ... */ | |
35 #include "xgccache.h" | |
36 #include <X11/Shell.h> | |
37 #include "xmu.h" | |
38 #include "glyphs-x.h" | |
39 #include "objects-x.h" | |
40 | |
41 #include "buffer.h" | |
42 #include "elhash.h" | |
43 #include "events.h" | |
44 #include "faces.h" | |
45 #include "frame.h" | |
46 #include "redisplay.h" | |
47 #include "sysdep.h" | |
48 #include "window.h" | |
49 | |
50 #include "sysfile.h" | |
51 #include "systime.h" | |
52 | |
53 #ifdef HAVE_OFFIX_DND | |
54 #include "offix.h" | |
55 #endif | |
56 | |
57 Lisp_Object Vdefault_x_device; | |
58 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)) | |
59 Lisp_Object Vx_app_defaults_directory; | |
60 #endif | |
61 | |
62 /* Qdisplay in general.c */ | |
63 Lisp_Object Qx_error; | |
64 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win; | |
65 | |
66 /* The application class of Emacs. */ | |
67 Lisp_Object Vx_emacs_application_class; | |
68 | |
69 Lisp_Object Vx_initial_argv_list; /* #### ugh! */ | |
70 | |
71 static XrmOptionDescRec emacs_options[] = | |
72 { | |
73 {"-geometry", ".geometry", XrmoptionSepArg, NULL}, | |
74 {"-iconic", ".iconic", XrmoptionNoArg, "yes"}, | |
75 | |
76 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL}, | |
77 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL}, | |
78 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL}, | |
79 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL}, | |
80 | |
81 {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"}, | |
82 {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL}, | |
83 | |
84 /* #### Beware! If the type of the shell changes, update this. */ | |
85 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, | |
86 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, | |
87 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, | |
88 | |
89 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL}, | |
90 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL}, | |
91 {"-mc", "*pointerColor", XrmoptionSepArg, NULL}, | |
92 {"-cr", "*cursorColor", XrmoptionSepArg, NULL}, | |
93 {"-fontset", "*FontSet", XrmoptionSepArg, NULL}, | |
94 }; | |
95 | |
96 /* Functions to synchronize mirroring resources and specifiers */ | |
97 int in_resource_setting; | |
98 | |
99 /************************************************************************/ | |
100 /* helper functions */ | |
101 /************************************************************************/ | |
102 | |
103 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */ | |
104 struct device * get_device_from_display_1 (Display *dpy); | |
105 struct device * | |
106 get_device_from_display_1 (Display *dpy) | |
107 { | |
108 Lisp_Object devcons, concons; | |
109 | |
110 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
111 { | |
112 struct device *d = XDEVICE (XCAR (devcons)); | |
113 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy) | |
114 return d; | |
115 } | |
116 | |
117 return 0; | |
118 } | |
119 | |
120 struct device * | |
121 get_device_from_display (Display *dpy) | |
122 { | |
123 struct device *d = get_device_from_display_1 (dpy); | |
124 | |
125 #if !defined(INFODOCK) | |
126 # define FALLBACK_RESOURCE_NAME "xemacs" | |
127 # else | |
128 # define FALLBACK_RESOURCE_NAME "infodock" | |
129 #endif | |
130 | |
131 if (!d) { | |
132 /* This isn't one of our displays. Let's crash? */ | |
133 stderr_out | |
134 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n", | |
135 (STRINGP (Vinvocation_name) ? | |
136 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME), | |
137 DisplayString (dpy) ? DisplayString (dpy) : "???"); | |
138 abort(); | |
139 } | |
140 | |
141 #undef FALLBACK_RESOURCE_NAME | |
142 | |
143 return d; | |
144 } | |
145 | |
146 struct device * | |
147 decode_x_device (Lisp_Object device) | |
148 { | |
149 XSETDEVICE (device, decode_device (device)); | |
150 CHECK_X_DEVICE (device); | |
151 return XDEVICE (device); | |
152 } | |
153 | |
154 static Display * | |
155 get_x_display (Lisp_Object device) | |
156 { | |
157 return DEVICE_X_DISPLAY (decode_x_device (device)); | |
158 } | |
159 | |
160 | |
161 /************************************************************************/ | |
162 /* initializing an X connection */ | |
163 /************************************************************************/ | |
164 | |
165 static void | |
166 allocate_x_device_struct (struct device *d) | |
167 { | |
168 d->device_data = xnew_and_zero (struct x_device); | |
169 } | |
170 | |
171 static void | |
172 Xatoms_of_device_x (struct device *d) | |
173 { | |
174 Display *D = DEVICE_X_DISPLAY (d); | |
175 | |
176 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False); | |
177 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False); | |
178 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False); | |
179 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False); | |
180 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False); | |
181 } | |
182 | |
183 static void | |
184 sanity_check_geometry_resource (Display *dpy) | |
185 { | |
186 char *app_name, *app_class, *s; | |
187 char buf1 [255], buf2 [255]; | |
188 char *type; | |
189 XrmValue value; | |
190 XtGetApplicationNameAndClass (dpy, &app_name, &app_class); | |
191 strcpy (buf1, app_name); | |
192 strcpy (buf2, app_class); | |
193 for (s = buf1; *s; s++) if (*s == '.') *s = '_'; | |
194 strcat (buf1, "._no_._such_._resource_.geometry"); | |
195 strcat (buf2, "._no_._such_._resource_.Geometry"); | |
196 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
197 { | |
198 warn_when_safe (Qgeometry, Qerror, | |
199 "\n" | |
200 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n" | |
201 "specified in the resource database. Specifying \"*geometry\" will make\n" | |
202 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n" | |
203 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n" | |
204 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n", | |
205 app_name, (char *) value.addr, | |
206 app_class, (char *) value.addr); | |
207 suppress_early_error_handler_backtrace = 1; | |
208 error ("Invalid geometry resource"); | |
209 } | |
210 } | |
211 | |
212 static void | |
213 x_init_device_class (struct device *d) | |
214 { | |
215 if (DEVICE_X_DEPTH(d) > 2) | |
216 { | |
217 switch (DEVICE_X_VISUAL(d)->class) | |
218 { | |
219 case StaticGray: | |
220 case GrayScale: | |
221 DEVICE_CLASS (d) = Qgrayscale; | |
222 break; | |
223 default: | |
224 DEVICE_CLASS (d) = Qcolor; | |
225 } | |
226 } | |
227 else | |
228 DEVICE_CLASS (d) = Qmono; | |
229 } | |
230 | |
231 /* | |
232 * Figure out what application name to use for xemacs | |
233 * | |
234 * Since we have decomposed XtOpenDisplay into XOpenDisplay and | |
235 * XtDisplayInitialize, we no longer get this for free. | |
236 * | |
237 * If there is a `-name' argument in argv, use that. | |
238 * Otherwise use the last component of argv[0]. | |
239 * | |
240 * I have removed the gratuitous use of getenv("RESOURCE_NAME") | |
241 * which was in X11R5, but left the matching of any prefix of `-name'. | |
242 * Finally, if all else fails, return `xemacs', as it is more | |
243 * appropriate (X11R5 returns `main'). | |
244 */ | |
245 static char * | |
246 compute_x_app_name (int argc, char **argv) | |
247 { | |
248 int i; | |
249 char *ptr; | |
250 | |
251 for (i = 1; i < argc - 1; i++) | |
252 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1])))) | |
253 return argv[i+1]; | |
254 | |
255 if (argc > 0 && argv[0] && *argv[0]) | |
256 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0]; | |
257 | |
258 return "xemacs"; | |
259 } | |
260 | |
261 /* | |
262 * This function figures out whether the user has any resources of the | |
263 * form "XEmacs.foo" or "XEmacs*foo". | |
264 * | |
265 * Currently we only consult the display's global resources; to look | |
266 * for screen specific resources, we would need to also consult: | |
267 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno)); | |
268 */ | |
269 static int | |
270 have_xemacs_resources_in_xrdb (Display *dpy) | |
271 { | |
272 char *xdefs, *key; | |
273 int len; | |
274 | |
275 #ifdef INFODOCK | |
276 key = "InfoDock"; | |
277 #else | |
278 key = "XEmacs"; | |
279 #endif | |
280 len = strlen (key); | |
281 | |
282 if (!dpy) | |
283 return 0; | |
284 | |
285 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */ | |
286 while (xdefs && *xdefs) | |
287 { | |
288 if (strncmp (xdefs, key, len) == 0 && | |
289 (xdefs[len] == '*' || xdefs[len] == '.')) | |
290 return 1; | |
291 | |
292 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */ | |
293 ; | |
294 } | |
295 | |
296 return 0; | |
297 } | |
298 | |
299 /* Only the characters [-_A-Za-z0-9] are allowed in the individual | |
300 components of a resource. Convert invalid characters to `-' */ | |
301 | |
302 static char valid_resource_char_p[256]; | |
303 | |
304 static void | |
305 validify_resource_component (char *str, size_t len) | |
306 { | |
307 for (; len; len--, str++) | |
308 if (!valid_resource_char_p[(unsigned char) (*str)]) | |
309 *str = '-'; | |
310 } | |
311 | |
312 static void | |
313 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str) | |
314 { | |
315 Bytecount len = XSTRING_LENGTH (str); | |
316 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len); | |
317 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len); | |
318 } | |
319 | |
320 #if 0 | |
321 /* compare visual info for qsorting */ | |
322 static int | |
323 x_comp_visual_info (const void *elem1, const void *elem2) | |
324 { | |
325 XVisualInfo *left, *right; | |
326 | |
327 left = (XVisualInfo *)elem1; | |
328 right = (XVisualInfo *)elem2; | |
329 | |
330 if ( left == NULL ) | |
331 return -1; | |
332 if ( right == NULL ) | |
333 return 1; | |
334 | |
335 if ( left->depth > right->depth ) { | |
336 return 1; | |
337 } | |
338 else if ( left->depth == right->depth ) { | |
339 if ( left->colormap_size > right->colormap_size ) | |
340 return 1; | |
341 if ( left->class > right->class ) | |
342 return 1; | |
343 else if ( left->class < right->class ) | |
344 return -1; | |
345 else | |
346 return 0; | |
347 } | |
348 else { | |
349 return -1; | |
350 } | |
351 | |
352 } | |
353 #endif /* if 0 */ | |
354 | |
355 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
356 static Visual * | |
357 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class) | |
358 { | |
359 Display *dpy = DisplayOfScreen (screen); | |
360 XVisualInfo vi_in; | |
361 XVisualInfo *vi_out = NULL; | |
362 int out_count; | |
363 | |
364 vi_in.class = visual_class; | |
365 vi_in.screen = scrnum; | |
366 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask), | |
367 &vi_in, &out_count); | |
368 if ( vi_out ) | |
369 { | |
370 int i, best; | |
371 Visual *visual; | |
372 for (i = 0, best = 0; i < out_count; i++) | |
373 /* It's better if it's deeper, or if it's the same depth with | |
374 more cells (does that ever happen? Well, it could...) | |
375 NOTE: don't allow pseudo color to get larger than 8! */ | |
376 if (((vi_out [i].depth > vi_out [best].depth) || | |
377 ((vi_out [i].depth == vi_out [best].depth) && | |
378 (vi_out [i].colormap_size > vi_out [best].colormap_size))) | |
379 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN | |
380 /* For now, the image library doesn't like PseudoColor visuals | |
381 of depths other than 1 or 8. Depths greater than 8 only occur | |
382 on machines which have TrueColor anyway, so probably we'll end | |
383 up using that (it is the one that `Best' would pick) but if a | |
384 PseudoColor visual is explicitly specified, pick the 8 bit one. | |
385 */ | |
386 && (visual_class != PseudoColor || | |
387 vi_out [i].depth == 1 || | |
388 vi_out [i].depth == 8) | |
389 #endif | |
390 | |
391 /* SGI has 30-bit deep visuals. Ignore them. | |
392 (We only have 24-bit data anyway.) | |
393 */ | |
394 && (vi_out [i].depth <= 24) | |
395 ) | |
396 best = i; | |
397 visual = vi_out[best].visual; | |
398 XFree ((char *) vi_out); | |
399 return visual; | |
400 } | |
401 else | |
402 return 0; | |
403 } | |
404 | |
405 static int | |
406 x_get_visual_depth (Display *dpy, Visual *visual) | |
407 { | |
408 XVisualInfo vi_in; | |
409 XVisualInfo *vi_out; | |
410 int out_count, d; | |
411 | |
412 vi_in.visualid = XVisualIDFromVisual (visual); | |
413 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask, | |
414 &vi_in, &out_count); | |
415 if (! vi_out) abort (); | |
416 d = vi_out [0].depth; | |
417 XFree ((char *) vi_out); | |
418 return d; | |
419 } | |
420 | |
421 static Visual * | |
422 x_try_best_visual (Display *dpy, int scrnum) | |
423 { | |
424 Visual *visual = NULL; | |
425 Screen *screen = ScreenOfDisplay (dpy, scrnum); | |
426 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)) | |
427 && x_get_visual_depth (dpy, visual) >= 16 ) | |
428 return visual; | |
429 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor))) | |
430 return visual; | |
431 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))) | |
432 return visual; | |
433 #ifdef DIRECTCOLOR_WORKS | |
434 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor))) | |
435 return visual; | |
436 #endif | |
437 | |
438 visual = DefaultVisualOfScreen (screen); | |
439 if ( x_get_visual_depth (dpy, visual) >= 8 ) | |
440 return visual; | |
441 | |
442 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray))) | |
443 return visual; | |
444 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale))) | |
445 return visual; | |
446 return DefaultVisualOfScreen (screen); | |
447 } | |
448 | |
449 | |
450 static void | |
451 x_init_device (struct device *d, Lisp_Object props) | |
452 { | |
453 Lisp_Object display; | |
454 Lisp_Object device; | |
455 Display *dpy; | |
456 Widget app_shell; | |
457 int argc; | |
458 char **argv; | |
459 CONST char *app_class; | |
460 CONST char *app_name; | |
461 CONST char *disp_name; | |
462 Visual *visual = NULL; | |
463 int depth = 8; /* shut up the compiler */ | |
464 Colormap cmap; | |
465 int screen; | |
466 /* */ | |
467 int best_visual_found = 0; | |
468 | |
469 XSETDEVICE (device, d); | |
470 display = DEVICE_CONNECTION (d); | |
471 | |
472 allocate_x_device_struct (d); | |
473 | |
474 make_argc_argv (Vx_initial_argv_list, &argc, &argv); | |
475 | |
476 GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name); | |
477 | |
478 /* | |
479 * Break apart the old XtOpenDisplay call into XOpenDisplay and | |
480 * XtDisplayInitialize so we can figure out whether there | |
481 * are any XEmacs resources in the resource database before | |
482 * we initialize Xt. This is so we can automagically support | |
483 * both `Emacs' and `XEmacs' application classes. | |
484 */ | |
485 slow_down_interrupts (); | |
486 /* May not be needed but XtOpenDisplay could not deal with signals here. */ | |
487 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name); | |
488 speed_up_interrupts (); | |
489 | |
490 if (dpy == 0) | |
491 { | |
492 suppress_early_error_handler_backtrace = 1; | |
493 signal_simple_error ("X server not responding\n", display); | |
494 } | |
495 | |
496 if (STRINGP (Vx_emacs_application_class) && | |
497 XSTRING_LENGTH (Vx_emacs_application_class) > 0) | |
498 GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class); | |
499 else | |
500 { | |
501 app_class = (NILP (Vx_emacs_application_class) && | |
502 have_xemacs_resources_in_xrdb (dpy)) | |
503 #ifdef INFODOCK | |
504 ? "InfoDock" | |
505 #else | |
506 ? "XEmacs" | |
507 #endif | |
508 : "Emacs"; | |
509 /* need to update Vx_emacs_application_class: */ | |
510 Vx_emacs_application_class = build_string (app_class); | |
511 } | |
512 | |
513 slow_down_interrupts (); | |
514 /* May not be needed but XtOpenDisplay could not deal with signals here. | |
515 Yuck. */ | |
516 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv), | |
517 app_class, emacs_options, | |
518 XtNumber (emacs_options), &argc, argv); | |
519 speed_up_interrupts (); | |
520 | |
521 screen = DefaultScreen (dpy); | |
522 if (NILP (Vdefault_x_device)) | |
523 Vdefault_x_device = device; | |
524 | |
525 #ifdef MULE | |
526 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET) | |
527 { | |
528 /* Read in locale-specific resources from | |
529 data-directory/app-defaults/$LANG/Emacs. | |
530 This is in addition to the standard app-defaults files, and | |
531 does not override resources defined elsewhere */ | |
532 CONST char *data_dir; | |
533 char *path; | |
534 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ | |
535 CONST char *locale = XrmLocaleOfDatabase (db); | |
536 | |
537 if (STRINGP (Vx_app_defaults_directory) && | |
538 XSTRING_LENGTH (Vx_app_defaults_directory) > 0) | |
539 { | |
540 GET_C_STRING_FILENAME_DATA_ALLOCA(Vx_app_defaults_directory, data_dir); | |
541 path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7); | |
542 sprintf (path, "%s%s/Emacs", data_dir, locale); | |
543 if (!access (path, R_OK)) | |
544 XrmCombineFileDatabase (path, &db, False); | |
545 } | |
546 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) | |
547 { | |
548 GET_C_STRING_FILENAME_DATA_ALLOCA (Vdata_directory, data_dir); | |
549 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7); | |
550 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale); | |
551 if (!access (path, R_OK)) | |
552 XrmCombineFileDatabase (path, &db, False); | |
553 } | |
554 } | |
555 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */ | |
556 #endif /* MULE */ | |
557 | |
558 if (NILP (DEVICE_NAME (d))) | |
559 DEVICE_NAME (d) = display; | |
560 | |
561 /* We're going to modify the string in-place, so be a nice XEmacs */ | |
562 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d)); | |
563 /* colons and periods can't appear in individual elements of resource | |
564 strings */ | |
565 | |
566 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class); | |
567 /* search for a matching visual if requested by the user, or setup the display default */ | |
568 { | |
569 int resource_name_length = max (sizeof (".emacsVisual"), | |
570 sizeof (".privateColormap")); | |
571 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length); | |
572 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length); | |
573 char *type; | |
574 XrmValue value; | |
575 | |
576 sprintf (buf1, "%s.emacsVisual", app_name); | |
577 sprintf (buf2, "%s.EmacsVisual", app_class); | |
578 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) | |
579 { | |
580 int cnt = 0; | |
581 int vis_class = PseudoColor; | |
582 XVisualInfo vinfo; | |
583 char *str = (char*) value.addr; | |
584 | |
585 #define CHECK_VIS_CLASS(visual_class) \ | |
586 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \ | |
587 cnt = sizeof (#visual_class) - 1, vis_class = visual_class | |
588 | |
589 if (1) | |
590 ; | |
591 CHECK_VIS_CLASS (StaticGray); | |
592 CHECK_VIS_CLASS (StaticColor); | |
593 CHECK_VIS_CLASS (TrueColor); | |
594 CHECK_VIS_CLASS (GrayScale); | |
595 CHECK_VIS_CLASS (PseudoColor); | |
596 CHECK_VIS_CLASS (DirectColor); | |
597 | |
598 if (cnt) | |
599 { | |
600 depth = atoi (str + cnt); | |
601 if (depth == 0) | |
602 { | |
603 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str); | |
604 } | |
605 else | |
606 { | |
607 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo)) | |
608 { | |
609 visual = vinfo.visual; | |
610 } | |
611 else | |
612 { | |
613 stderr_out ("Can't match the requested visual %s... using defaults\n", str); | |
614 } | |
615 } | |
616 } | |
617 else | |
618 { | |
619 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str); | |
620 } | |
621 } | |
622 if (visual == NULL) | |
623 { | |
624 /* | |
625 visual = DefaultVisual(dpy, screen); | |
626 depth = DefaultDepth(dpy, screen); | |
627 */ | |
628 visual = x_try_best_visual (dpy, screen); | |
629 depth = x_get_visual_depth (dpy, visual); | |
630 best_visual_found = (visual != DefaultVisual (dpy, screen)); | |
631 } | |
632 | |
633 /* If we've got the same visual as the default and it's PseudoColor, | |
634 check to see if the user specified that we need a private colormap */ | |
635 if (visual == DefaultVisual (dpy, screen)) | |
636 { | |
637 sprintf (buf1, "%s.privateColormap", app_name); | |
638 sprintf (buf2, "%s.PrivateColormap", app_class); | |
639 if ((visual->class == PseudoColor) && | |
640 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)) | |
641 { | |
642 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen)); | |
643 } | |
644 else | |
645 { | |
646 cmap = DefaultColormap (dpy, screen); | |
647 } | |
648 } | |
649 else | |
650 { | |
651 if ( best_visual_found ) | |
652 { | |
653 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone); | |
654 } | |
655 else | |
656 { | |
657 /* We have to create a matching colormap anyway... | |
658 ### think about using standard colormaps (need the Xmu libs?) */ | |
659 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone); | |
660 XInstallColormap(dpy, cmap); | |
661 } | |
662 } | |
663 } | |
664 | |
665 DEVICE_X_VISUAL (d) = visual; | |
666 DEVICE_X_COLORMAP (d) = cmap; | |
667 DEVICE_X_DEPTH (d) = depth; | |
668 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)), | |
669 XSTRING_LENGTH (DEVICE_NAME (d))); | |
670 | |
671 { | |
672 Arg al[3]; | |
673 XtSetArg (al[0], XtNvisual, visual); | |
674 XtSetArg (al[1], XtNdepth, depth); | |
675 XtSetArg (al[2], XtNcolormap, cmap); | |
676 | |
677 app_shell = XtAppCreateShell (NULL, app_class, | |
678 applicationShellWidgetClass, | |
679 dpy, al, countof (al)); | |
680 } | |
681 | |
682 DEVICE_XT_APP_SHELL (d) = app_shell; | |
683 | |
684 #ifdef HAVE_XIM | |
685 XIM_init_device(d); | |
686 #endif /* HAVE_XIM */ | |
687 | |
688 /* Realize the app_shell so that its window exists for GC creation purposes, | |
689 and set it to the size of the root window for child placement purposes */ | |
690 { | |
691 Arg al[5]; | |
692 XtSetArg (al[0], XtNmappedWhenManaged, False); | |
693 XtSetArg (al[1], XtNx, 0); | |
694 XtSetArg (al[2], XtNy, 0); | |
695 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen))); | |
696 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen))); | |
697 XtSetValues (app_shell, al, countof (al)); | |
698 XtRealizeWidget (app_shell); | |
699 } | |
700 | |
701 #ifdef HAVE_WMCOMMAND | |
702 { | |
703 int new_argc; | |
704 char **new_argv; | |
705 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv); | |
706 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc); | |
707 free_argc_argv (new_argv); | |
708 } | |
709 #endif /* HAVE_WMCOMMAND */ | |
710 | |
711 | |
712 #ifdef HAVE_OFFIX_DND | |
713 DndInitialize ( app_shell ); | |
714 #endif | |
715 | |
716 Vx_initial_argv_list = make_arg_list (argc, argv); | |
717 free_argc_argv (argv); | |
718 | |
719 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil; | |
720 | |
721 sanity_check_geometry_resource (dpy); | |
722 | |
723 /* In event-Xt.c */ | |
724 x_init_modifier_mapping (d); | |
725 | |
726 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy); | |
727 init_baud_rate (d); | |
728 init_one_device (d); | |
729 | |
730 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell)); | |
731 DEVICE_X_GRAY_PIXMAP (d) = None; | |
732 Xatoms_of_device_x (d); | |
733 Xatoms_of_xselect (d); | |
734 Xatoms_of_objects_x (d); | |
735 x_init_device_class (d); | |
736 | |
737 /* Run the elisp side of the X device initialization. */ | |
738 call0 (Qinit_pre_x_win); | |
739 } | |
740 | |
741 static void | |
742 x_finish_init_device (struct device *d, Lisp_Object props) | |
743 { | |
744 call0 (Qinit_post_x_win); | |
745 } | |
746 | |
747 static void | |
748 x_mark_device (struct device *d) | |
749 { | |
750 mark_object (DEVICE_X_WM_COMMAND_FRAME (d)); | |
751 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table); | |
752 } | |
753 | |
754 | |
755 /************************************************************************/ | |
756 /* closing an X connection */ | |
757 /************************************************************************/ | |
758 | |
759 static void | |
760 free_x_device_struct (struct device *d) | |
761 { | |
762 xfree (d->device_data); | |
763 } | |
764 | |
765 static void | |
766 x_delete_device (struct device *d) | |
767 { | |
768 Lisp_Object device; | |
769 Display *display; | |
770 #ifdef FREE_CHECKING | |
771 extern void (*__free_hook) (void *); | |
772 int checking_free; | |
773 #endif | |
774 | |
775 XSETDEVICE (device, d); | |
776 display = DEVICE_X_DISPLAY (d); | |
777 | |
778 if (display) | |
779 { | |
780 #ifdef FREE_CHECKING | |
781 checking_free = (__free_hook != 0); | |
782 | |
783 /* Disable strict free checking, to avoid bug in X library */ | |
784 if (checking_free) | |
785 disable_strict_free_check (); | |
786 #endif | |
787 | |
788 free_gc_cache (DEVICE_X_GC_CACHE (d)); | |
789 if (DEVICE_X_DATA (d)->x_modifier_keymap) | |
790 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); | |
791 if (DEVICE_X_DATA (d)->x_keysym_map) | |
792 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map); | |
793 | |
794 if (DEVICE_XT_APP_SHELL (d)) | |
795 { | |
796 XtDestroyWidget (DEVICE_XT_APP_SHELL (d)); | |
797 DEVICE_XT_APP_SHELL (d) = NULL; | |
798 } | |
799 | |
800 XtCloseDisplay (display); | |
801 DEVICE_X_DISPLAY (d) = 0; | |
802 #ifdef FREE_CHECKING | |
803 if (checking_free) | |
804 enable_strict_free_check (); | |
805 #endif | |
806 } | |
807 | |
808 if (EQ (device, Vdefault_x_device)) | |
809 { | |
810 Lisp_Object devcons, concons; | |
811 /* #### handle deleting last X device */ | |
812 Vdefault_x_device = Qnil; | |
813 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
814 { | |
815 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) && | |
816 !EQ (device, XCAR (devcons))) | |
817 { | |
818 Vdefault_x_device = XCAR (devcons); | |
819 goto double_break; | |
820 } | |
821 } | |
822 } | |
823 double_break: | |
824 free_x_device_struct (d); | |
825 } | |
826 | |
827 | |
828 /************************************************************************/ | |
829 /* handle X errors */ | |
830 /************************************************************************/ | |
831 | |
832 CONST char * | |
833 x_event_name (int event_type) | |
834 { | |
835 static CONST char *events[] = | |
836 { | |
837 "0: ERROR!", | |
838 "1: REPLY", | |
839 "KeyPress", | |
840 "KeyRelease", | |
841 "ButtonPress", | |
842 "ButtonRelease", | |
843 "MotionNotify", | |
844 "EnterNotify", | |
845 "LeaveNotify", | |
846 "FocusIn", | |
847 "FocusOut", | |
848 "KeymapNotify", | |
849 "Expose", | |
850 "GraphicsExpose", | |
851 "NoExpose", | |
852 "VisibilityNotify", | |
853 "CreateNotify", | |
854 "DestroyNotify", | |
855 "UnmapNotify", | |
856 "MapNotify", | |
857 "MapRequest", | |
858 "ReparentNotify", | |
859 "ConfigureNotify", | |
860 "ConfigureRequest", | |
861 "GravityNotify", | |
862 "ResizeRequest", | |
863 "CirculateNotify", | |
864 "CirculateRequest", | |
865 "PropertyNotify", | |
866 "SelectionClear", | |
867 "SelectionRequest", | |
868 "SelectionNotify", | |
869 "ColormapNotify", | |
870 "ClientMessage", | |
871 "MappingNotify", | |
872 "LASTEvent" | |
873 }; | |
874 | |
875 if (event_type < 0 || event_type >= countof (events)) | |
876 return NULL; | |
877 return events [event_type]; | |
878 } | |
879 | |
880 /* Handling errors. | |
881 | |
882 If an X error occurs which we are not expecting, we have no alternative | |
883 but to print it to stderr. It would be nice to stuff it into a pop-up | |
884 buffer, or to print it in the minibuffer, but that's not possible, because | |
885 one is not allowed to do any I/O on the display connection from an error | |
886 handler. The guts of Xlib expect these functions to either return or exit. | |
887 | |
888 However, there are occasions when we might expect an error to reasonably | |
889 occur. The interface to this is as follows: | |
890 | |
891 Before calling some X routine which may error, call | |
892 expect_x_error (dpy); | |
893 | |
894 Just after calling the X routine, call either: | |
895 | |
896 x_error_occurred_p (dpy); | |
897 | |
898 to ask whether an error happened (and was ignored), or: | |
899 | |
900 signal_if_x_error (dpy, resumable_p); | |
901 | |
902 which will call Fsignal() with args appropriate to the X error, if there | |
903 was one. (Resumable_p is whether the debugger should be allowed to | |
904 continue from the call to signal.) | |
905 | |
906 You must call one of these two routines immediately after calling the X | |
907 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT. | |
908 */ | |
909 | |
910 static int error_expected; | |
911 static int error_occurred; | |
912 static XErrorEvent last_error; | |
913 | |
914 /* OVERKILL! */ | |
915 | |
916 #ifdef EXTERNAL_WIDGET | |
917 static Lisp_Object | |
918 x_error_handler_do_enqueue (Lisp_Object frame) | |
919 { | |
920 enqueue_magic_eval_event (io_error_delete_frame, frame); | |
921 return Qt; | |
922 } | |
923 | |
924 static Lisp_Object | |
925 x_error_handler_error (Lisp_Object data, Lisp_Object dummy) | |
926 { | |
927 return Qnil; | |
928 } | |
929 #endif /* EXTERNAL_WIDGET */ | |
930 | |
931 int | |
932 x_error_handler (Display *disp, XErrorEvent *event) | |
933 { | |
934 if (error_expected) | |
935 { | |
936 error_expected = 0; | |
937 error_occurred = 1; | |
938 last_error = *event; | |
939 } | |
940 else | |
941 { | |
942 #ifdef EXTERNAL_WIDGET | |
943 struct frame *f; | |
944 struct device *d = get_device_from_display (disp); | |
945 | |
946 if ((event->error_code == BadWindow || | |
947 event->error_code == BadDrawable) | |
948 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0)) | |
949 { | |
950 Lisp_Object frame; | |
951 | |
952 /* one of the windows comprising one of our frames has died. | |
953 This occurs particularly with ExternalShell frames when the | |
954 client that owns the ExternalShell's window dies. | |
955 | |
956 We cannot do any I/O on the display connection so we need | |
957 to enqueue an eval event so that the deletion happens | |
958 later. | |
959 | |
960 Furthermore, we need to trap any errors (out-of-memory) that | |
961 may occur when Fenqueue_eval_event is called. | |
962 */ | |
963 | |
964 if (f->being_deleted) | |
965 return 0; | |
966 XSETFRAME (frame, f); | |
967 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue, | |
968 frame, x_error_handler_error, Qnil))) | |
969 { | |
970 f->being_deleted = 1; | |
971 f->visible = 0; | |
972 } | |
973 return 0; | |
974 } | |
975 #endif /* EXTERNAL_WIDGET */ | |
976 | |
977 stderr_out ("\n%s: ", | |
978 (STRINGP (Vinvocation_name) | |
979 ? (char *) XSTRING_DATA (Vinvocation_name) | |
980 : "xemacs")); | |
981 XmuPrintDefaultErrorMessage (disp, event, stderr); | |
982 } | |
983 return 0; | |
984 } | |
985 | |
986 void | |
987 expect_x_error (Display *dpy) | |
988 { | |
989 assert (!error_expected); | |
990 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
991 error_expected = 1; | |
992 error_occurred = 0; | |
993 } | |
994 | |
995 int | |
996 x_error_occurred_p (Display *dpy) | |
997 { | |
998 int val; | |
999 XSync (dpy, 0); /* handle pending errors before setting flag */ | |
1000 val = error_occurred; | |
1001 error_expected = 0; | |
1002 error_occurred = 0; | |
1003 return val; | |
1004 } | |
1005 | |
1006 int | |
1007 signal_if_x_error (Display *dpy, int resumable_p) | |
1008 { | |
1009 char buf[1024]; | |
1010 Lisp_Object data; | |
1011 if (! x_error_occurred_p (dpy)) | |
1012 return 0; | |
1013 data = Qnil; | |
1014 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid); | |
1015 data = Fcons (build_string (buf), data); | |
1016 { | |
1017 char num [32]; | |
1018 sprintf (num, "%d", last_error.request_code); | |
1019 XGetErrorDatabaseText (last_error.display, "XRequest", num, "", | |
1020 buf, sizeof (buf)); | |
1021 if (! *buf) | |
1022 sprintf (buf, "Request-%d", last_error.request_code); | |
1023 data = Fcons (build_string (buf), data); | |
1024 } | |
1025 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf)); | |
1026 data = Fcons (build_string (buf), data); | |
1027 again: | |
1028 Fsignal (Qx_error, data); | |
1029 if (! resumable_p) goto again; | |
1030 return 1; | |
1031 } | |
1032 | |
1033 int | |
1034 x_IO_error_handler (Display *disp) | |
1035 { | |
1036 /* This function can GC */ | |
1037 Lisp_Object dev; | |
1038 struct device *d = get_device_from_display_1 (disp); | |
1039 | |
1040 assert (d != NULL); | |
1041 XSETDEVICE (dev, d); | |
1042 | |
1043 if (NILP (find_nonminibuffer_frame_not_on_device (dev))) | |
1044 { | |
1045 /* We're going down. */ | |
1046 stderr_out | |
1047 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n", | |
1048 (STRINGP (Vinvocation_name) ? | |
1049 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"), | |
1050 errno, strerror (errno), DisplayString (disp)); | |
1051 stderr_out | |
1052 (" after %lu requests (%lu known processed) with %d events remaining.\n", | |
1053 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), | |
1054 QLength (disp)); | |
1055 /* assert (!_Xdebug); */ | |
1056 } | |
1057 else | |
1058 { | |
1059 warn_when_safe | |
1060 (Qx, Qcritical, | |
1061 "I/O Error %d (%s) on display connection\n" | |
1062 " \"%s\" after after %lu requests (%lu known processed)\n" | |
1063 " with %d events remaining.\n" | |
1064 " Throwing to top level.\n", | |
1065 errno, strerror (errno), DisplayString (disp), | |
1066 NextRequest (disp) - 1, LastKnownRequestProcessed (disp), | |
1067 QLength (disp)); | |
1068 } | |
1069 | |
1070 /* According to X specs, we should not return from this function, or | |
1071 Xlib might just decide to exit(). So we mark the offending | |
1072 console for deletion and throw to top level. */ | |
1073 if (d) | |
1074 enqueue_magic_eval_event (io_error_delete_device, dev); | |
1075 DEVICE_X_BEING_DELETED (d) = 1; | |
1076 Fthrow (Qtop_level, Qnil); | |
1077 | |
1078 return 0; /* not reached */ | |
1079 } | |
1080 | |
1081 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /* | |
1082 With a true arg, make the connection to the X server synchronous. | |
1083 With false, make it asynchronous. Synchronous connections are much slower, | |
1084 but are useful for debugging. (If you get X errors, make the connection | |
1085 synchronous, and use a debugger to set a breakpoint on `x_error_handler'. | |
1086 Your backtrace of the C stack will now be useful. In asynchronous mode, | |
1087 the stack above `x_error_handler' isn't helpful because of buffering.) | |
1088 If DEVICE is not specified, the selected device is assumed. | |
1089 | |
1090 Calling this function is the same as calling the C function `XSynchronize', | |
1091 or starting the program with the `-sync' command line argument. | |
1092 */ | |
1093 (arg, device)) | |
1094 { | |
1095 struct device *d = decode_x_device (device); | |
1096 | |
1097 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg)); | |
1098 | |
1099 if (!NILP (arg)) | |
1100 message ("X connection is synchronous"); | |
1101 else | |
1102 message ("X connection is asynchronous"); | |
1103 | |
1104 return arg; | |
1105 } | |
1106 | |
1107 | |
1108 /************************************************************************/ | |
1109 /* X resources */ | |
1110 /************************************************************************/ | |
1111 | |
1112 #if 0 /* bah humbug. The whole "widget == resource" stuff is such | |
1113 a crock of shit that I'm just going to ignore it all. */ | |
1114 | |
1115 /* If widget is NULL, we are retrieving device or global face data. */ | |
1116 | |
1117 static void | |
1118 construct_name_list (Display *display, Widget widget, char *fake_name, | |
1119 char *fake_class, char *name, char *class) | |
1120 { | |
1121 char *stack [100][2]; | |
1122 Widget this; | |
1123 int count = 0; | |
1124 char *name_tail, *class_tail; | |
1125 | |
1126 if (widget) | |
1127 { | |
1128 for (this = widget; this; this = XtParent (this)) | |
1129 { | |
1130 stack [count][0] = this->core.name; | |
1131 stack [count][1] = XtClass (this)->core_class.class_name; | |
1132 count++; | |
1133 } | |
1134 count--; | |
1135 } | |
1136 else if (fake_name && fake_class) | |
1137 { | |
1138 stack [count][0] = fake_name; | |
1139 stack [count][1] = fake_class; | |
1140 count++; | |
1141 } | |
1142 | |
1143 /* The root widget is an application shell; resource lookups use the | |
1144 specified application name and application class in preference to | |
1145 the name/class of that widget (which is argv[0] / "ApplicationShell"). | |
1146 Generally the app name and class will be argv[0] / "Emacs" but | |
1147 the former can be set via the -name command-line option, and the | |
1148 latter can be set by changing `x-emacs-application-class' in | |
1149 lisp/term/x-win.el. | |
1150 */ | |
1151 XtGetApplicationNameAndClass (display, | |
1152 &stack [count][0], | |
1153 &stack [count][1]); | |
1154 | |
1155 name [0] = 0; | |
1156 class [0] = 0; | |
1157 | |
1158 name_tail = name; | |
1159 class_tail = class; | |
1160 for (; count >= 0; count--) | |
1161 { | |
1162 strcat (name_tail, stack [count][0]); | |
1163 for (; *name_tail; name_tail++) | |
1164 if (*name_tail == '.') *name_tail = '_'; | |
1165 strcat (name_tail, "."); | |
1166 name_tail++; | |
1167 | |
1168 strcat (class_tail, stack [count][1]); | |
1169 for (; *class_tail; class_tail++) | |
1170 if (*class_tail == '.') *class_tail = '_'; | |
1171 strcat (class_tail, "."); | |
1172 class_tail++; | |
1173 } | |
1174 } | |
1175 | |
1176 #endif /* 0 */ | |
1177 | |
1178 static char_dynarr *name_char_dynarr; | |
1179 static char_dynarr *class_char_dynarr; | |
1180 | |
1181 /* Given a locale and device specification from x-get-resource or | |
1182 x-get-resource-prefix, return the resource prefix and display to | |
1183 fetch the resource on. */ | |
1184 | |
1185 static void | |
1186 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device, | |
1187 Display **display_out, char_dynarr *name, | |
1188 char_dynarr *class) | |
1189 { | |
1190 if (NILP (locale)) | |
1191 locale = Qglobal; | |
1192 if (NILP (Fvalid_specifier_locale_p (locale))) | |
1193 signal_simple_error ("Invalid locale", locale); | |
1194 if (WINDOWP (locale)) | |
1195 /* #### I can't come up with any coherent way of naming windows. | |
1196 By relative position? That seems tricky because windows | |
1197 can change position, be split, etc. By order of creation? | |
1198 That seems less than useful. */ | |
1199 signal_simple_error ("Windows currently can't be resourced", locale); | |
1200 | |
1201 if (!NILP (device) && !DEVICEP (device)) | |
1202 CHECK_DEVICE (device); | |
1203 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1204 device = Qnil; | |
1205 if (NILP (device)) | |
1206 { | |
1207 device = DFW_DEVICE (locale); | |
1208 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) | |
1209 device = Qnil; | |
1210 if (NILP (device)) | |
1211 device = Vdefault_x_device; | |
1212 if (NILP (device)) | |
1213 { | |
1214 *display_out = 0; | |
1215 return; | |
1216 } | |
1217 } | |
1218 | |
1219 *display_out = DEVICE_X_DISPLAY (XDEVICE (device)); | |
1220 | |
1221 { | |
1222 char *appname, *appclass; | |
1223 int name_len, class_len; | |
1224 XtGetApplicationNameAndClass (*display_out, &appname, &appclass); | |
1225 name_len = strlen (appname); | |
1226 class_len = strlen (appclass); | |
1227 Dynarr_add_many (name , appname, name_len); | |
1228 Dynarr_add_many (class, appclass, class_len); | |
1229 validify_resource_component (Dynarr_atp (name, 0), name_len); | |
1230 validify_resource_component (Dynarr_atp (class, 0), class_len); | |
1231 } | |
1232 | |
1233 if (EQ (locale, Qglobal)) | |
1234 return; | |
1235 if (BUFFERP (locale)) | |
1236 { | |
1237 Dynarr_add_literal_string (name, ".buffer."); | |
1238 /* we know buffer is live; otherwise we got an error above. */ | |
1239 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale)); | |
1240 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer"); | |
1241 } | |
1242 else if (FRAMEP (locale)) | |
1243 { | |
1244 Dynarr_add_literal_string (name, ".frame."); | |
1245 /* we know frame is live; otherwise we got an error above. */ | |
1246 Dynarr_add_validified_lisp_string (name, Fframe_name (locale)); | |
1247 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame"); | |
1248 } | |
1249 else | |
1250 { | |
1251 assert (DEVICEP (locale)); | |
1252 Dynarr_add_literal_string (name, ".device."); | |
1253 /* we know device is live; otherwise we got an error above. */ | |
1254 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale)); | |
1255 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice"); | |
1256 } | |
1257 return; | |
1258 } | |
1259 | |
1260 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /* | |
1261 Retrieve an X resource from the resource manager. | |
1262 | |
1263 The first arg is the name of the resource to retrieve, such as "font". | |
1264 The second arg is the class of the resource to retrieve, such as "Font". | |
1265 The third arg must be one of the symbols 'string, 'integer, 'natnum, or | |
1266 'boolean, specifying the type of object that the database is searched for. | |
1267 The fourth arg is the locale to search for the resources on, and can | |
1268 currently be a buffer, a frame, a device, or 'global. If omitted, it | |
1269 defaults to 'global. | |
1270 The fifth arg is the device to search for the resources on. (The resource | |
1271 database for a particular device is constructed by combining non-device- | |
1272 specific resources such as any command-line resources specified and any | |
1273 app-defaults files found [or the fallback resources supplied by XEmacs, | |
1274 if no app-defaults file is found] with device-specific resources such as | |
1275 those supplied using xrdb.) If omitted, it defaults to the device of | |
1276 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device), | |
1277 and otherwise defaults to the value of `default-x-device'. | |
1278 The sixth arg NOERROR, if non-nil, means do not signal an error if a | |
1279 bogus resource specification was retrieved (e.g. if a non-integer was | |
1280 given when an integer was requested). In this case, a warning is issued | |
1281 instead. | |
1282 | |
1283 The resource names passed to this function are looked up relative to the | |
1284 locale. | |
1285 | |
1286 If you want to search for a subresource, you just need to specify the | |
1287 resource levels in NAME and CLASS. For example, NAME could be | |
1288 "modeline.attributeFont", and CLASS "Face.AttributeFont". | |
1289 | |
1290 Specifically, | |
1291 | |
1292 1) If LOCALE is a buffer, a call | |
1293 | |
1294 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER) | |
1295 | |
1296 is an interface to a C call something like | |
1297 | |
1298 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground", | |
1299 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", | |
1300 "String"); | |
1301 | |
1302 2) If LOCALE is a frame, a call | |
1303 | |
1304 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME) | |
1305 | |
1306 is an interface to a C call something like | |
1307 | |
1308 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground", | |
1309 "Emacs.EmacsLocaleType.EmacsFrame.Foreground", | |
1310 "String"); | |
1311 | |
1312 3) If LOCALE is a device, a call | |
1313 | |
1314 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE) | |
1315 | |
1316 is an interface to a C call something like | |
1317 | |
1318 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground", | |
1319 "Emacs.EmacsLocaleType.EmacsDevice.Foreground", | |
1320 "String"); | |
1321 | |
1322 4) If LOCALE is 'global, a call | |
1323 | |
1324 (x-get-resource "foreground" "Foreground" 'string 'global) | |
1325 | |
1326 is an interface to a C call something like | |
1327 | |
1328 XrmGetResource (db, "xemacs.foreground", | |
1329 "Emacs.Foreground", | |
1330 "String"); | |
1331 | |
1332 Note that for 'global, no prefix is added other than that of the | |
1333 application itself; thus, you can use this locale to retrieve | |
1334 arbitrary application resources, if you really want to. | |
1335 | |
1336 The returned value of this function is nil if the queried resource is not | |
1337 found. If the third arg is `string', a string is returned, and if it is | |
1338 `integer', an integer is returned. If the third arg is `boolean', then the | |
1339 returned value is the list (t) for true, (nil) for false, and is nil to | |
1340 mean ``unspecified.'' | |
1341 */ | |
1342 (name, class, type, locale, device, no_error)) | |
1343 { | |
1344 char* name_string, *class_string; | |
1345 char *raw_result; | |
1346 XrmDatabase db; | |
1347 Display *display; | |
1348 Error_behavior errb = decode_error_behavior_flag (no_error); | |
1349 | |
1350 CHECK_STRING (name); | |
1351 CHECK_STRING (class); | |
1352 CHECK_SYMBOL (type); | |
1353 | |
1354 Dynarr_reset (name_char_dynarr); | |
1355 Dynarr_reset (class_char_dynarr); | |
1356 | |
1357 x_get_resource_prefix (locale, device, &display, | |
1358 name_char_dynarr, class_char_dynarr); | |
1359 if (!display) | |
1360 return Qnil; | |
1361 | |
1362 db = XtDatabase (display); | |
1363 | |
1364 Dynarr_add (name_char_dynarr, '.'); | |
1365 Dynarr_add_lisp_string (name_char_dynarr, name); | |
1366 Dynarr_add (class_char_dynarr, '.'); | |
1367 Dynarr_add_lisp_string (class_char_dynarr, class); | |
1368 Dynarr_add (name_char_dynarr, '\0'); | |
1369 Dynarr_add (class_char_dynarr, '\0'); | |
1370 | |
1371 name_string = Dynarr_atp (name_char_dynarr, 0); | |
1372 class_string = Dynarr_atp (class_char_dynarr, 0); | |
1373 | |
1374 { | |
1375 XrmValue xrm_value; | |
1376 XrmName namelist[100]; | |
1377 XrmClass classlist[100]; | |
1378 XrmName *namerest = namelist; | |
1379 XrmClass *classrest = classlist; | |
1380 XrmRepresentation xrm_type; | |
1381 XrmRepresentation string_quark; | |
1382 int result; | |
1383 XrmStringToNameList (name_string, namelist); | |
1384 XrmStringToClassList (class_string, classlist); | |
1385 string_quark = XrmStringToQuark ("String"); | |
1386 | |
1387 /* ensure that they have the same length */ | |
1388 while (namerest[0] && classrest[0]) | |
1389 namerest++, classrest++; | |
1390 if (namerest[0] || classrest[0]) | |
1391 signal_simple_error_2 | |
1392 ("class list and name list must be the same length", name, class); | |
1393 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value); | |
1394 | |
1395 if (result != True || xrm_type != string_quark) | |
1396 return Qnil; | |
1397 raw_result = (char *) xrm_value.addr; | |
1398 } | |
1399 | |
1400 if (EQ (type, Qstring)) | |
1401 return build_string (raw_result); | |
1402 else if (EQ (type, Qboolean)) | |
1403 { | |
1404 if (!strcasecmp (raw_result, "off") || | |
1405 !strcasecmp (raw_result, "false") || | |
1406 !strcasecmp (raw_result, "no")) | |
1407 return Fcons (Qnil, Qnil); | |
1408 if (!strcasecmp (raw_result, "on") || | |
1409 !strcasecmp (raw_result, "true") || | |
1410 !strcasecmp (raw_result, "yes")) | |
1411 return Fcons (Qt, Qnil); | |
1412 return maybe_continuable_error | |
1413 (Qresource, errb, | |
1414 "can't convert %s: %s to a Boolean", name_string, raw_result); | |
1415 } | |
1416 else if (EQ (type, Qinteger) || EQ (type, Qnatnum)) | |
1417 { | |
1418 int i; | |
1419 char c; | |
1420 if (1 != sscanf (raw_result, "%d%c", &i, &c)) | |
1421 return maybe_continuable_error | |
1422 (Qresource, errb, | |
1423 "can't convert %s: %s to an integer", name_string, raw_result); | |
1424 else if (EQ (type, Qnatnum) && i < 0) | |
1425 return maybe_continuable_error | |
1426 (Qresource, errb, | |
1427 "invalid numerical value %d for resource %s", i, name_string); | |
1428 else | |
1429 return make_int (i); | |
1430 } | |
1431 else | |
1432 { | |
1433 return maybe_signal_continuable_error | |
1434 (Qwrong_type_argument, | |
1435 list2 (build_translated_string | |
1436 ("should be string, integer, natnum or boolean"), | |
1437 type), | |
1438 Qresource, errb); | |
1439 } | |
1440 } | |
1441 | |
1442 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /* | |
1443 Return the resource prefix for LOCALE on DEVICE. | |
1444 The resource prefix is the strings used to prefix resources if | |
1445 the LOCALE and DEVICE arguments were passed to `x-get-resource'. | |
1446 The returned value is a cons of a name prefix and a class prefix. | |
1447 For example, if LOCALE is a frame, the returned value might be | |
1448 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame"). | |
1449 If no valid X device for resourcing can be obtained, this function | |
1450 returns nil. (In such a case, `x-get-resource' would always return nil.) | |
1451 */ | |
1452 (locale, device)) | |
1453 { | |
1454 Display *display; | |
1455 | |
1456 Dynarr_reset (name_char_dynarr ); | |
1457 Dynarr_reset (class_char_dynarr); | |
1458 | |
1459 x_get_resource_prefix (locale, device, &display, | |
1460 name_char_dynarr, class_char_dynarr); | |
1461 if (!display) | |
1462 return Qnil; | |
1463 | |
1464 return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0), | |
1465 Dynarr_length (name_char_dynarr)), | |
1466 make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0), | |
1467 Dynarr_length (class_char_dynarr))); | |
1468 } | |
1469 | |
1470 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /* | |
1471 Add a resource to the resource database for DEVICE. | |
1472 RESOURCE-LINE specifies the resource to add and should be a | |
1473 standard resource specification. | |
1474 */ | |
1475 (resource_line, device)) | |
1476 { | |
1477 struct device *d = decode_device (device); | |
1478 char *str, *colon_pos; | |
1479 | |
1480 CHECK_STRING (resource_line); | |
1481 str = (char *) XSTRING_DATA (resource_line); | |
1482 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n')) | |
1483 invalid: | |
1484 signal_simple_error ("Invalid resource line", resource_line); | |
1485 if (strspn (str, | |
1486 /* Only the following chars are allowed before the colon */ | |
1487 " \t.*?abcdefghijklmnopqrstuvwxyz" | |
1488 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") | |
1489 != (size_t) (colon_pos - str)) | |
1490 goto invalid; | |
1491 | |
1492 if (DEVICE_X_P (d)) | |
1493 { | |
1494 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d)); | |
1495 XrmPutLineResource (&db, str); | |
1496 } | |
1497 | |
1498 return Qnil; | |
1499 } | |
1500 | |
1501 | |
1502 /************************************************************************/ | |
1503 /* display information functions */ | |
1504 /************************************************************************/ | |
1505 | |
1506 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* | |
1507 Return the default X device for resourcing. | |
1508 This is the first-created X device that still exists. | |
1509 */ | |
1510 ()) | |
1511 { | |
1512 return Vdefault_x_device; | |
1513 } | |
1514 | |
1515 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* | |
1516 Return the visual class of the X display DEVICE is using. | |
1517 This can be altered from the default at startup using the XResource "EmacsVisual". | |
1518 The returned value will be one of the symbols `static-gray', `gray-scale', | |
1519 `static-color', `pseudo-color', `true-color', or `direct-color'. | |
1520 */ | |
1521 (device)) | |
1522 { | |
1523 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device)); | |
1524 switch (vis->class) | |
1525 { | |
1526 case StaticGray: return intern ("static-gray"); | |
1527 case GrayScale: return intern ("gray-scale"); | |
1528 case StaticColor: return intern ("static-color"); | |
1529 case PseudoColor: return intern ("pseudo-color"); | |
1530 case TrueColor: return intern ("true-color"); | |
1531 case DirectColor: return intern ("direct-color"); | |
1532 default: | |
1533 error ("display has an unknown visual class"); | |
1534 return Qnil; /* suppress compiler warning */ | |
1535 } | |
1536 } | |
1537 | |
1538 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /* | |
1539 Return the bitplane depth of the visual the X display DEVICE is using. | |
1540 */ | |
1541 (device)) | |
1542 { | |
1543 return make_int (DEVICE_X_DEPTH (decode_x_device (device))); | |
1544 } | |
1545 | |
1546 static Lisp_Object | |
1547 x_device_system_metrics (struct device *d, | |
1548 enum device_metrics m) | |
1549 { | |
1550 Display *dpy = DEVICE_X_DISPLAY (d); | |
1551 | |
1552 switch (m) | |
1553 { | |
1554 case DM_size_device: | |
1555 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))), | |
1556 make_int (DisplayHeight (dpy, DefaultScreen (dpy)))); | |
1557 case DM_size_device_mm: | |
1558 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))), | |
1559 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy)))); | |
1560 case DM_num_bit_planes: | |
1561 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy))); | |
1562 case DM_num_color_cells: | |
1563 return make_int (DisplayCells (dpy, DefaultScreen (dpy))); | |
1564 default: /* No such device metric property for X devices */ | |
1565 return Qunbound; | |
1566 } | |
1567 } | |
1568 | |
1569 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /* | |
1570 Return the vendor ID string of the X server DEVICE is on. | |
1571 Return the empty string if the vendor ID string cannot be determined. | |
1572 */ | |
1573 (device)) | |
1574 { | |
1575 Display *dpy = get_x_display (device); | |
1576 char *vendor = ServerVendor (dpy); | |
1577 | |
1578 return build_string (vendor ? vendor : ""); | |
1579 } | |
1580 | |
1581 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /* | |
1582 Return the version numbers of the X server DEVICE is on. | |
1583 The returned value is a list of three integers: the major and minor | |
1584 version numbers of the X Protocol in use, and the vendor-specific release | |
1585 number. See also `x-server-vendor'. | |
1586 */ | |
1587 (device)) | |
1588 { | |
1589 Display *dpy = get_x_display (device); | |
1590 | |
1591 return list3 (make_int (ProtocolVersion (dpy)), | |
1592 make_int (ProtocolRevision (dpy)), | |
1593 make_int (VendorRelease (dpy))); | |
1594 } | |
1595 | |
1596 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /* | |
1597 Return true if KEYSYM names a keysym that the X library knows about. | |
1598 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1599 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1600 */ | |
1601 (keysym)) | |
1602 { | |
1603 CONST char *keysym_ext; | |
1604 | |
1605 CHECK_STRING (keysym); | |
1606 GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext); | |
1607 | |
1608 return XStringToKeysym (keysym_ext) ? Qt : Qnil; | |
1609 } | |
1610 | |
1611 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /* | |
1612 Return a hash table which contains a hash key for all keysyms which | |
1613 name keys on the keyboard. See `x-keysym-on-keyboard-p'. | |
1614 */ | |
1615 (device)) | |
1616 { | |
1617 struct device *d = decode_device (device); | |
1618 if (!DEVICE_X_P (d)) | |
1619 signal_simple_error ("Not an X device", device); | |
1620 | |
1621 return DEVICE_X_DATA (d)->x_keysym_map_hash_table; | |
1622 } | |
1623 | |
1624 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p, | |
1625 1, 2, 0, /* | |
1626 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1627 More precisely, return true if pressing a physical key | |
1628 on the keyboard of DEVICE without any modifier keys generates KEYSYM. | |
1629 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1630 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1631 The keysym name can be provided in two forms: | |
1632 - if keysym is a string, it must be the name as known to X windows. | |
1633 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1634 The two names differ in capitalization and underscoring. | |
1635 */ | |
1636 (keysym, device)) | |
1637 { | |
1638 struct device *d = decode_device (device); | |
1639 if (!DEVICE_X_P (d)) | |
1640 signal_simple_error ("Not an X device", device); | |
1641 | |
1642 return (EQ (Qsans_modifiers, | |
1643 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1644 Qt : Qnil); | |
1645 } | |
1646 | |
1647 | |
1648 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /* | |
1649 Return true if KEYSYM names a key on the keyboard of DEVICE. | |
1650 More precisely, return true if some keystroke (possibly including modifiers) | |
1651 on the keyboard of DEVICE keys generates KEYSYM. | |
1652 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in | |
1653 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. | |
1654 The keysym name can be provided in two forms: | |
1655 - if keysym is a string, it must be the name as known to X windows. | |
1656 - if keysym is a symbol, it must be the name as known to XEmacs. | |
1657 The two names differ in capitalization and underscoring. | |
1658 */ | |
1659 (keysym, device)) | |
1660 { | |
1661 struct device *d = decode_device (device); | |
1662 if (!DEVICE_X_P (d)) | |
1663 signal_simple_error ("Not an X device", device); | |
1664 | |
1665 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? | |
1666 Qnil : Qt); | |
1667 } | |
1668 | |
1669 | |
1670 /************************************************************************/ | |
1671 /* grabs and ungrabs */ | |
1672 /************************************************************************/ | |
1673 | |
1674 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /* | |
1675 Grab the pointer and restrict it to its current window. | |
1676 If optional DEVICE argument is nil, the default device will be used. | |
1677 If optional CURSOR argument is non-nil, change the pointer shape to that | |
1678 until `x-ungrab-pointer' is called (it should be an object returned by the | |
1679 `make-cursor-glyph' function). | |
1680 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all | |
1681 keyboard events during the grab. | |
1682 Returns t if the grab is successful, nil otherwise. | |
1683 */ | |
1684 (device, cursor, ignore_keyboard)) | |
1685 { | |
1686 Window w; | |
1687 int pointer_mode, result; | |
1688 struct device *d = decode_x_device (device); | |
1689 | |
1690 if (!NILP (cursor)) | |
1691 { | |
1692 CHECK_POINTER_GLYPH (cursor); | |
1693 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); | |
1694 } | |
1695 | |
1696 if (!NILP (ignore_keyboard)) | |
1697 pointer_mode = GrabModeSync; | |
1698 else | |
1699 pointer_mode = GrabModeAsync; | |
1700 | |
1701 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1702 | |
1703 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't | |
1704 seem to cause a problem if XFreeCursor is called on a cursor in use | |
1705 in a grab; I suppose the X server counts the grab as a reference | |
1706 and doesn't free it until it exits? */ | |
1707 result = XGrabPointer (DEVICE_X_DISPLAY (d), w, | |
1708 False, | |
1709 ButtonMotionMask | | |
1710 ButtonPressMask | | |
1711 ButtonReleaseMask | | |
1712 PointerMotionHintMask, | |
1713 GrabModeAsync, /* Keep pointer events flowing */ | |
1714 pointer_mode, /* Stall keyboard events */ | |
1715 w, /* Stay in this window */ | |
1716 (NILP (cursor) ? 0 | |
1717 : XIMAGE_INSTANCE_X_CURSOR (cursor)), | |
1718 CurrentTime); | |
1719 return (result == GrabSuccess) ? Qt : Qnil; | |
1720 } | |
1721 | |
1722 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /* | |
1723 Release a pointer grab made with `x-grab-pointer'. | |
1724 If optional first arg DEVICE is nil the default device is used. | |
1725 If it is t the pointer will be released on all X devices. | |
1726 */ | |
1727 (device)) | |
1728 { | |
1729 if (!EQ (device, Qt)) | |
1730 { | |
1731 Display *dpy = get_x_display (device); | |
1732 XUngrabPointer (dpy, CurrentTime); | |
1733 } | |
1734 else | |
1735 { | |
1736 Lisp_Object devcons, concons; | |
1737 | |
1738 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
1739 { | |
1740 struct device *d = XDEVICE (XCAR (devcons)); | |
1741 | |
1742 if (DEVICE_X_P (d)) | |
1743 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime); | |
1744 } | |
1745 } | |
1746 | |
1747 return Qnil; | |
1748 } | |
1749 | |
1750 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /* | |
1751 Grab the keyboard on the given device (defaulting to the selected one). | |
1752 So long as the keyboard is grabbed, all keyboard events will be delivered | |
1753 to emacs -- it is not possible for other X clients to eavesdrop on them. | |
1754 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). | |
1755 Returns t if the grab is successful, nil otherwise. | |
1756 */ | |
1757 (device)) | |
1758 { | |
1759 struct device *d = decode_x_device (device); | |
1760 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); | |
1761 Display *dpy = DEVICE_X_DISPLAY (d); | |
1762 Status status; | |
1763 XSync (dpy, False); | |
1764 status = XGrabKeyboard (dpy, w, True, | |
1765 /* I don't really understand sync-vs-async | |
1766 grabs, but this is what xterm does. */ | |
1767 GrabModeAsync, GrabModeAsync, | |
1768 /* Use the timestamp of the last user action | |
1769 read by emacs proper; xterm uses CurrentTime | |
1770 but there's a comment that says "wrong"... | |
1771 (Despite the name this is the time of the | |
1772 last key or mouse event.) */ | |
1773 DEVICE_X_MOUSE_TIMESTAMP (d)); | |
1774 if (status == GrabSuccess) | |
1775 { | |
1776 /* The XUngrabKeyboard should generate a FocusIn back to this | |
1777 window but it doesn't unless we explicitly set focus to the | |
1778 window first (which should already have it. The net result | |
1779 is that without this call when x-ungrab-keyboard is called | |
1780 the selected frame ends up not having focus. */ | |
1781 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d)); | |
1782 return Qt; | |
1783 } | |
1784 else | |
1785 return Qnil; | |
1786 } | |
1787 | |
1788 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /* | |
1789 Release a keyboard grab made with `x-grab-keyboard'. | |
1790 */ | |
1791 (device)) | |
1792 { | |
1793 Display *dpy = get_x_display (device); | |
1794 XUngrabKeyboard (dpy, CurrentTime); | |
1795 return Qnil; | |
1796 } | |
1797 | |
1798 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /* | |
1799 Get the X Server's font path. | |
1800 | |
1801 See also `x-set-font-path'. | |
1802 */ | |
1803 (device)) | |
1804 { | |
1805 Display *dpy = get_x_display (device); | |
1806 int ndirs_return; | |
1807 CONST char **directories = (CONST char **) XGetFontPath (dpy, &ndirs_return); | |
1808 Lisp_Object font_path = Qnil; | |
1809 | |
1810 if (!directories) | |
1811 signal_simple_error ("Can't get X font path", device); | |
1812 | |
1813 while (ndirs_return--) | |
1814 font_path = Fcons (build_ext_string (directories[ndirs_return], | |
1815 FORMAT_FILENAME), font_path); | |
1816 | |
1817 return font_path; | |
1818 } | |
1819 | |
1820 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /* | |
1821 Set the X Server's font path to FONT-PATH. | |
1822 | |
1823 There is only one font path per server, not one per client. Use this | |
1824 sparingly. It uncaches all of the X server's font information. | |
1825 | |
1826 Font directories should end in the path separator and should contain | |
1827 a file called fonts.dir usually created with the program mkfontdir. | |
1828 | |
1829 Setting the FONT-PATH to nil tells the X server to use the default | |
1830 font path. | |
1831 | |
1832 See also `x-get-font-path'. | |
1833 */ | |
1834 (font_path, device)) | |
1835 { | |
1836 Display *dpy = get_x_display (device); | |
1837 Lisp_Object path_entry; | |
1838 CONST char **directories; | |
1839 int i=0,ndirs=0; | |
1840 | |
1841 EXTERNAL_LIST_LOOP (path_entry, font_path) | |
1842 { | |
1843 CHECK_STRING (XCAR (path_entry)); | |
1844 ndirs++; | |
1845 } | |
1846 | |
1847 directories = alloca_array (CONST char *, ndirs); | |
1848 | |
1849 EXTERNAL_LIST_LOOP (path_entry, font_path) | |
1850 { | |
1851 GET_C_STRING_FILENAME_DATA_ALLOCA (XCAR (path_entry), directories[i++]); | |
1852 } | |
1853 | |
1854 expect_x_error (dpy); | |
1855 XSetFontPath (dpy, (char **) directories, ndirs); | |
1856 signal_if_x_error (dpy, 1/*resumable_p*/); | |
1857 | |
1858 return Qnil; | |
1859 } | |
1860 | |
1861 | |
1862 /************************************************************************/ | |
1863 /* initialization */ | |
1864 /************************************************************************/ | |
1865 | |
1866 void | |
1867 syms_of_device_x (void) | |
1868 { | |
1869 DEFSUBR (Fx_debug_mode); | |
1870 DEFSUBR (Fx_get_resource); | |
1871 DEFSUBR (Fx_get_resource_prefix); | |
1872 DEFSUBR (Fx_put_resource); | |
1873 | |
1874 DEFSUBR (Fdefault_x_device); | |
1875 DEFSUBR (Fx_display_visual_class); | |
1876 DEFSUBR (Fx_display_visual_depth); | |
1877 DEFSUBR (Fx_server_vendor); | |
1878 DEFSUBR (Fx_server_version); | |
1879 DEFSUBR (Fx_valid_keysym_name_p); | |
1880 DEFSUBR (Fx_keysym_hash_table); | |
1881 DEFSUBR (Fx_keysym_on_keyboard_p); | |
1882 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p); | |
1883 | |
1884 DEFSUBR (Fx_grab_pointer); | |
1885 DEFSUBR (Fx_ungrab_pointer); | |
1886 DEFSUBR (Fx_grab_keyboard); | |
1887 DEFSUBR (Fx_ungrab_keyboard); | |
1888 | |
1889 DEFSUBR (Fx_get_font_path); | |
1890 DEFSUBR (Fx_set_font_path); | |
1891 | |
1892 defsymbol (&Qx_error, "x-error"); | |
1893 defsymbol (&Qinit_pre_x_win, "init-pre-x-win"); | |
1894 defsymbol (&Qinit_post_x_win, "init-post-x-win"); | |
1895 } | |
1896 | |
1897 void | |
1898 reinit_console_type_create_device_x (void) | |
1899 { | |
1900 /* Initialize variables to speed up X resource interactions */ | |
1901 CONST char *valid_resource_chars = | |
1902 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; | |
1903 while (*valid_resource_chars) | |
1904 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; | |
1905 | |
1906 name_char_dynarr = Dynarr_new (char); | |
1907 class_char_dynarr = Dynarr_new (char); | |
1908 } | |
1909 | |
1910 void | |
1911 console_type_create_device_x (void) | |
1912 { | |
1913 reinit_console_type_create_device_x (); | |
1914 CONSOLE_HAS_METHOD (x, init_device); | |
1915 CONSOLE_HAS_METHOD (x, finish_init_device); | |
1916 CONSOLE_HAS_METHOD (x, mark_device); | |
1917 CONSOLE_HAS_METHOD (x, delete_device); | |
1918 CONSOLE_HAS_METHOD (x, device_system_metrics); | |
1919 } | |
1920 | |
1921 void | |
1922 reinit_vars_of_device_x (void) | |
1923 { | |
1924 error_expected = 0; | |
1925 error_occurred = 0; | |
1926 | |
1927 in_resource_setting = 0; | |
1928 } | |
1929 | |
1930 void | |
1931 vars_of_device_x (void) | |
1932 { | |
1933 reinit_vars_of_device_x (); | |
1934 | |
1935 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /* | |
1936 The X application class of the XEmacs process. | |
1937 This controls, among other things, the name of the `app-defaults' file | |
1938 that XEmacs will use. For changes to this variable to take effect, they | |
1939 must be made before the connection to the X server is initialized, that is, | |
1940 this variable may only be changed before emacs is dumped, or by setting it | |
1941 in the file lisp/term/x-win.el. | |
1942 | |
1943 If this variable is nil before the connection to the X server is first | |
1944 initialized (which it is by default), the X resource database will be | |
1945 consulted and the value will be set according to whether any resources | |
1946 are found for the application class `XEmacs'. If the user has set any | |
1947 resources for the XEmacs application class, the XEmacs process will use | |
1948 the application class `XEmacs'. Otherwise, the XEmacs process will use | |
1949 the application class `Emacs' which is backwards compatible to previous | |
1950 XEmacs versions but may conflict with resources intended for GNU Emacs. | |
1951 */ ); | |
1952 Vx_emacs_application_class = Qnil; | |
1953 | |
1954 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /* | |
1955 You don't want to know. | |
1956 This is used during startup to communicate the remaining arguments in | |
1957 `command-line-args-left' to the C code, which passes the args to | |
1958 the X initialization code, which removes some args, and then the | |
1959 args are placed back into `x-initial-arg-list' and thence into | |
1960 `command-line-args-left'. Perhaps `command-line-args-left' should | |
1961 just reside in C. | |
1962 */ ); | |
1963 Vx_initial_argv_list = Qnil; | |
1964 | |
1965 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)) | |
1966 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /* | |
1967 Used by the Lisp code to communicate to the low level X initialization | |
1968 where the localized init files are. | |
1969 */ ); | |
1970 Vx_app_defaults_directory = Qnil; | |
1971 #endif | |
1972 | |
1973 Fprovide (Qx); | |
1974 | |
1975 staticpro (&Vdefault_x_device); | |
1976 Vdefault_x_device = Qnil; | |
1977 } |