Mercurial > hg > xemacs-beta

comparison src/device-x.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 XtVaGetValues(), 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 "events.h"
43 #include "faces.h"
44 #include "frame.h"
45 #include "redisplay.h"
46 #include "sysdep.h"
47 #include "window.h"
48
49 #include "sysfile.h"
50 #include "systime.h"
51
52 Lisp_Object Vdefault_x_device;
53
54 /* Qdisplay in general.c */
55 Lisp_Object Qx_error;
56 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win;
57
58 /* The application class of Emacs. */
59 Lisp_Object Vx_emacs_application_class;
60
61 Lisp_Object Vx_initial_argv_list; /* #### ugh! */
62
63 static XrmOptionDescRec emacs_options[] =
64 {
65 {"-geometry", ".geometry", XrmoptionSepArg, NULL},
66 {"-iconic", ".iconic", XrmoptionNoArg, (XtPointer) "yes"},
67
68 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
69 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
70 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
71 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
72
73 /* #### Beware! If the type of the shell changes, update this. */
74 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
75 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
76 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
77 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
78 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
79 {"-mc", "*pointerColor", XrmoptionSepArg, NULL},
80 {"-cr", "*cursorColor", XrmoptionSepArg, NULL},
81 {"-fontset", "*FontSet", XrmoptionSepArg, NULL},
82 };
83
84 static void validify_resource_string (char *str);
85
86 /* Functions to synchronize mirroring resources and specifiers */
87 int in_resource_setting;
88 int in_specifier_change_function;
89
90
91 /************************************************************************/
92 /* helper functions */
93 /************************************************************************/
94
95 struct device *
96 get_device_from_display (Display *dpy)
97 {
98 Lisp_Object devcons, concons;
99
100 DEVICE_LOOP_NO_BREAK (devcons, concons)
101 {
102 struct device *d = XDEVICE (XCAR (devcons));
103 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy)
104 return d;
105 }
106
107 /* Only devices we are actually managing should ever be used as an
108 argument to this function. */
109 abort ();
110
111 return 0; /* suppress compiler warning */
112 }
113
114 struct device *
115 decode_x_device (Lisp_Object device)
116 {
117 XSETDEVICE (device, decode_device (device));
118 CHECK_X_DEVICE (device);
119 return XDEVICE (device);
120 }
121
122 Display *
123 get_x_display (Lisp_Object device)
124 {
125 return DEVICE_X_DISPLAY (decode_x_device (device));
126 }
127
128
129 /************************************************************************/
130 /* initializing an X connection */
131 /************************************************************************/
132
133 static void
134 allocate_x_device_struct (struct device *d)
135 {
136 d->device_data = (struct x_device *) xmalloc (sizeof (struct x_device));
137
138 /* zero out all slots. */
139 memset (d->device_data, 0, sizeof (struct x_device));
140 }
141
142 static void
143 Xatoms_of_device_x (struct device *d)
144 {
145 Display *display = DEVICE_X_DISPLAY (d);
146 #define ATOM(x) XInternAtom (display, (x), False)
147
148 DEVICE_XATOM_WM_PROTOCOLS (d) = ATOM ("WM_PROTOCOLS");
149 DEVICE_XATOM_WM_DELETE_WINDOW (d) = ATOM ("WM_DELETE_WINDOW");
150 DEVICE_XATOM_WM_SAVE_YOURSELF (d) = ATOM ("WM_SAVE_YOURSELF");
151 DEVICE_XATOM_WM_TAKE_FOCUS (d) = ATOM ("WM_TAKE_FOCUS");
152 DEVICE_XATOM_WM_STATE (d) = ATOM ("WM_STATE");
153 }
154
155 static void
156 sanity_check_geometry_resource (Display *dpy)
157 {
158 char *app_name, *app_class, *s;
159 char buf1 [255], buf2 [255];
160 char *type;
161 XrmValue value;
162 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
163 strcpy (buf1, app_name);
164 strcpy (buf2, app_class);
165 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
166 strcat (buf1, "._no_._such_._resource_.geometry");
167 strcat (buf2, "._no_._such_._resource_.Geometry");
168 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
169 {
170 warn_when_safe (Qgeometry, Qerror,
171 "\n"
172 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
173 "specified in the resource database. Specifying \"*geometry\" will make\n"
174 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n"
175 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n"
176 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
177 app_name, (char *) value.addr,
178 app_class, (char *) value.addr);
179 suppress_early_backtrace = 1;
180 error ("Invalid geometry resource");
181 }
182 }
183
184 static void
185 x_init_device_class (struct device *d)
186 {
187 Display *dpy = DEVICE_X_DISPLAY (d);
188 if (DisplayCells (dpy, DefaultScreen (dpy)) > 2)
189 {
190 switch (DefaultVisualOfScreen (DefaultScreenOfDisplay (dpy))->class)
191 {
192 case StaticGray:
193 case GrayScale:
194 DEVICE_CLASS (d) = Qgrayscale;
195 break;
196 default:
197 DEVICE_CLASS (d) = Qcolor;
198 }
199 }
200 else
201 DEVICE_CLASS (d) = Qmono;
202 }
203
204 static void
205 x_init_device (struct device *d, Lisp_Object props)
206 {
207 Lisp_Object display;
208 Lisp_Object device;
209 Display *dpy;
210 int argc;
211 char **argv;
212 CONST char *app_class;
213 CONST char *disp_name;
214
215 XSETDEVICE (device, d);
216 display = DEVICE_CONNECTION (d);
217
218 allocate_x_device_struct (d);
219
220 if (NILP (Vdefault_x_device))
221 Vdefault_x_device = device;
222
223 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
224
225 if (STRINGP (Vx_emacs_application_class) &&
226 string_length (XSTRING (Vx_emacs_application_class)) > 0)
227 GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class);
228 else
229 app_class = "Emacs";
230
231 GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name);
232
233 slow_down_interrupts ();
234 /* The Xt code can't deal with signals here. Yuck. */
235 dpy = DEVICE_X_DISPLAY (d) =
236 XtOpenDisplay (Xt_app_con, disp_name, NULL, app_class, emacs_options,
237 XtNumber (emacs_options), &argc, argv);
238 speed_up_interrupts ();
239
240 if (dpy == 0)
241 {
242 suppress_early_backtrace = 1;
243 signal_simple_error ("X server not responding\n", display);
244 }
245
246 if (NILP (DEVICE_NAME (d)))
247 DEVICE_NAME (d) = display;
248
249 /* We're going to modify the string in-place, so be a nice XEmacs */
250 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
251 /* colons and periods can't appear in individual elements of resource
252 strings */
253 validify_resource_string ((char *) string_data (XSTRING (DEVICE_NAME (d))));
254 DEVICE_XT_APP_SHELL (d) = XtAppCreateShell (NULL, app_class,
255 applicationShellWidgetClass,
256 dpy, NULL, 0);
257
258
259 Vx_initial_argv_list = make_arg_list (argc, argv);
260 free_argc_argv (argv);
261
262 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
263
264 sanity_check_geometry_resource (dpy);
265
266 /* In event-Xt.c */
267 x_init_modifier_mapping (d);
268
269 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
270 init_baud_rate (d);
271 init_one_device (d);
272
273 DEVICE_X_GC_CACHE (d) =
274 make_gc_cache (dpy, RootWindow (dpy, DefaultScreen (dpy)));
275 DEVICE_X_GRAY_PIXMAP (d) = None;
276 Xatoms_of_device_x (d);
277 Xatoms_of_xselect (d);
278 Xatoms_of_objects_x (d);
279 x_init_device_class (d);
280
281 /* Run the the elisp side of the X device initialization. */
282 call0 (Qinit_pre_x_win);
283 }
284
285 static void
286 x_finish_init_device (struct device *d, Lisp_Object props)
287 {
288 call0 (Qinit_post_x_win);
289 }
290
291 static void
292 x_mark_device (struct device *d, void (*markobj) (Lisp_Object))
293 {
294 ((markobj) (DEVICE_X_DATA (d)->WM_COMMAND_frame));
295 }
296
297
298 /************************************************************************/
299 /* closing an X connection */
300 /************************************************************************/
301
302 static void
303 free_x_device_struct (struct device *d)
304 {
305 xfree (d->device_data);
306 }
307
308 static void
309 x_delete_device (struct device *d)
310 {
311 Lisp_Object device;
312 Display *display;
313 #ifdef FREE_CHECKING
314 extern void (*__free_hook)();
315 int checking_free;
316 #endif
317
318 XSETDEVICE (device, d);
319 display = DEVICE_X_DISPLAY (d);
320
321 if (display)
322 {
323 #ifdef FREE_CHECKING
324 checking_free = (__free_hook != 0);
325
326 /* Disable strict free checking, to avoid bug in X library */
327 if (checking_free)
328 disable_strict_free_check ();
329 #endif
330
331 free_gc_cache (DEVICE_X_GC_CACHE (d));
332 if (DEVICE_X_DATA (d)->x_modifier_keymap)
333 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
334 if (DEVICE_X_DATA (d)->x_keysym_map)
335 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
336
337 XtCloseDisplay (display);
338 DEVICE_X_DISPLAY (d) = 0;
339 #ifdef FREE_CHECKING
340 if (checking_free)
341 enable_strict_free_check ();
342 #endif
343 }
344
345 if (EQ (device, Vdefault_x_device))
346 {
347 Lisp_Object devcons, concons;
348 /* #### handle deleting last X device */
349 Vdefault_x_device = Qnil;
350 DEVICE_LOOP_NO_BREAK (devcons, concons)
351 {
352 if (DEVICE_X_P (XDEVICE (XCAR (devcons))))
353 {
354 Vdefault_x_device = XCAR (devcons);
355 goto double_break;
356 }
357 }
358 }
359 double_break:
360 free_x_device_struct (d);
361 }
362
363
364 /************************************************************************/
365 /* handle X errors */
366 /************************************************************************/
367
368 static CONST char *events[] =
369 {
370 "0: ERROR!",
371 "1: REPLY",
372 "KeyPress",
373 "KeyRelease",
374 "ButtonPress",
375 "ButtonRelease",
376 "MotionNotify",
377 "EnterNotify",
378 "LeaveNotify",
379 "FocusIn",
380 "FocusOut",
381 "KeymapNotify",
382 "Expose",
383 "GraphicsExpose",
384 "NoExpose",
385 "VisibilityNotify",
386 "CreateNotify",
387 "DestroyNotify",
388 "UnmapNotify",
389 "MapNotify",
390 "MapRequest",
391 "ReparentNotify",
392 "ConfigureNotify",
393 "ConfigureRequest",
394 "GravityNotify",
395 "ResizeRequest",
396 "CirculateNotify",
397 "CirculateRequest",
398 "PropertyNotify",
399 "SelectionClear",
400 "SelectionRequest",
401 "SelectionNotify",
402 "ColormapNotify",
403 "ClientMessage",
404 "MappingNotify",
405 "LASTEvent"
406 };
407
408 CONST char *
409 x_event_name (int event_type)
410 {
411 if (event_type < 0) return 0;
412 if (event_type >= (sizeof (events) / sizeof (char *))) return 0;
413 return events [event_type];
414 }
415
416 /* Handling errors.
417
418 If an X error occurs which we are not expecting, we have no alternative
419 but to print it to stderr. It would be nice to stuff it into a pop-up
420 buffer, or to print it in the minibuffer, but that's not possible, because
421 one is not allowed to do any I/O on the display connection from an error
422 handler. The guts of Xlib expect these functions to either return or exit.
423
424 However, there are occasions when we might expect an error to reasonably
425 occur. The interface to this is as follows:
426
427 Before calling some X routine which may error, call
428 expect_x_error (dpy);
429
430 Just after calling the X routine, call either:
431
432 x_error_occurred_p (dpy);
433
434 to ask whether an error happened (and was ignored), or:
435
436 signal_if_x_error (dpy, resumable_p);
437
438 which will call Fsignal() with args appropriate to the X error, if there
439 was one. (Resumable_p is whether the debugger should be allowed to
440 continue from the call to signal.)
441
442 You must call one of these two routines immediately after calling the X
443 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
444 */
445
446 static int error_expected;
447 static int error_occurred;
448 static XErrorEvent last_error;
449
450 /* OVERKILL! */
451
452 #ifdef EXTERNAL_WIDGET
453 static Lisp_Object
454 x_error_handler_do_enqueue (Lisp_Object frame)
455 {
456 enqueue_magic_eval_event (io_error_delete_frame, frame);
457 return Qt;
458 }
459
460 static Lisp_Object
461 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
462 {
463 return Qnil;
464 }
465 #endif /* EXTERNAL_WIDGET */
466
467 int
468 x_error_handler (Display *disp, XErrorEvent *event)
469 {
470 if (error_expected)
471 {
472 error_expected = 0;
473 error_occurred = 1;
474 last_error = *event;
475 }
476 else
477 {
478 #ifdef EXTERNAL_WIDGET
479 struct frame *f;
480 struct device *d = get_device_from_display (disp);
481
482 if ((event->error_code == BadWindow ||
483 event->error_code == BadDrawable)
484 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
485 {
486 Lisp_Object frame;
487
488 /* one of the windows comprising one of our frames has died.
489 This occurs particularly with ExternalShell frames when the
490 client that owns the ExternalShell's window dies.
491
492 We cannot do any I/O on the display connection so we need
493 to enqueue an eval event so that the deletion happens
494 later.
495
496 Furthermore, we need to trap any errors (out-of-memory) that
497 may occur when Fenqueue_eval_event is called.
498 */
499
500 if (f->being_deleted)
501 return 0;
502 XSETFRAME (frame, f);
503 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
504 frame, x_error_handler_error, Qnil)))
505 {
506 f->being_deleted = 1;
507 f->visible = 0;
508 }
509 return 0;
510 }
511 #endif /* EXTERNAL_WIDGET */
512
513 stderr_out ("\n%s: ",
514 (STRINGP (Vinvocation_name)
515 ? (char *) string_data (XSTRING (Vinvocation_name))
516 : "xemacs"));
517 XmuPrintDefaultErrorMessage (disp, event, stderr);
518 }
519 return 0;
520 }
521
522 void
523 expect_x_error (Display *dpy)
524 {
525 assert (!error_expected);
526 XSync (dpy, 0); /* handle pending errors before setting flag */
527 error_expected = 1;
528 error_occurred = 0;
529 }
530
531 int
532 x_error_occurred_p (Display *dpy)
533 {
534 int val;
535 XSync (dpy, 0); /* handle pending errors before setting flag */
536 val = error_occurred;
537 error_expected = 0;
538 error_occurred = 0;
539 return val;
540 }
541
542 int
543 signal_if_x_error (Display *dpy, int resumable_p)
544 {
545 char buf[1024];
546 Lisp_Object data;
547 if (! x_error_occurred_p (dpy))
548 return 0;
549 data = Qnil;
550 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
551 data = Fcons (build_string (buf), data);
552 {
553 char num [32];
554 sprintf (num, "%d", last_error.request_code);
555 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
556 buf, sizeof (buf));
557 if (! *buf)
558 sprintf (buf, "Request-%d", last_error.request_code);
559 data = Fcons (build_string (buf), data);
560 }
561 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
562 data = Fcons (build_string (buf), data);
563 again:
564 Fsignal (Qx_error, data);
565 if (! resumable_p) goto again;
566 return 1;
567 }
568
569 int
570 x_IO_error_handler (Display *disp)
571 {
572 /* This function can GC */
573 Lisp_Object dev;
574 struct device *d = get_device_from_display (disp);
575 XSETDEVICE (dev, d);
576
577 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
578 {
579 /* We're going down. */
580 stderr_out
581 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
582 (STRINGP (Vinvocation_name) ?
583 (char *) string_data (XSTRING (Vinvocation_name)) : "xemacs"),
584 errno, strerror (errno), DisplayString (disp));
585 stderr_out
586 (" after %lu requests (%lu known processed) with %d events remaining.\n",
587 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
588 QLength (disp));
589 /* assert (!_Xdebug); */
590 }
591 else
592 {
593 warn_when_safe
594 (Qx, Qcritical,
595 "I/O Error %d (%s) on display connection \"%s\"\n"
596 " after %lu requests (%lu known processed) with "
597 "%d events remaining.\n",
598 errno, strerror (errno), DisplayString (disp),
599 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
600 QLength (disp));
601 }
602
603 enqueue_magic_eval_event (io_error_delete_device, dev);
604
605 return 0;
606 }
607
608 DEFUN ("x-debug-mode", Fx_debug_mode, Sx_debug_mode, 1, 2, 0 /*
609 With a true arg, make the connection to the X server synchronous.
610 With false, make it asynchronous. Synchronous connections are much slower,
611 but are useful for debugging. (If you get X errors, make the connection
612 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
613 Your backtrace of the C stack will now be useful. In asynchronous mode,
614 the stack above `x_error_handler' isn't helpful because of buffering.)
615 If DEVICE is not specified, the selected device is assumed.
616
617 Calling this function is the same as calling the C function `XSynchronize',
618 or starting the program with the `-sync' command line argument.
619 */ )
620 (arg, device)
621 Lisp_Object arg, device;
622 {
623 struct device *d = decode_x_device (device);
624
625 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
626
627 if (!NILP (arg))
628 message ("X connection is synchronous");
629 else
630 message ("X connection is asynchronous");
631
632 return arg;
633 }
634
635
636 /************************************************************************/
637 /* X resources */
638 /************************************************************************/
639
640 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
641 a crock of shit that I'm just going to ignore it all. */
642
643 /* If widget is NULL, we are retrieving device or global face data. */
644
645 static void
646 construct_name_list (Display *display, Widget widget, char *fake_name,
647 char *fake_class, char *name, char *class)
648 {
649 char *stack [100][2];
650 Widget this;
651 int count = 0;
652 char *name_tail, *class_tail;
653
654 if (widget)
655 {
656 for (this = widget; this; this = XtParent (this))
657 {
658 stack [count][0] = this->core.name;
659 stack [count][1] = XtClass (this)->core_class.class_name;
660 count++;
661 }
662 count--;
663 }
664 else if (fake_name && fake_class)
665 {
666 stack [count][0] = fake_name;
667 stack [count][1] = fake_class;
668 count++;
669 }
670
671 /* The root widget is an application shell; resource lookups use the
672 specified application name and application class in preference to
673 the name/class of that widget (which is argv[0] / "ApplicationShell").
674 Generally the app name and class will be argv[0] / "Emacs" but
675 the former can be set via the -name command-line option, and the
676 latter can be set by changing `x-emacs-application-class' in
677 lisp/term/x-win.el.
678 */
679 XtGetApplicationNameAndClass (display,
680 &stack [count][0],
681 &stack [count][1]);
682
683 name [0] = 0;
684 class [0] = 0;
685
686 name_tail = name;
687 class_tail = class;
688 for (; count >= 0; count--)
689 {
690 strcat (name_tail, stack [count][0]);
691 for (; *name_tail; name_tail++)
692 if (*name_tail == '.') *name_tail = '_';
693 strcat (name_tail, ".");
694 name_tail++;
695
696 strcat (class_tail, stack [count][1]);
697 for (; *class_tail; class_tail++)
698 if (*class_tail == '.') *class_tail = '_';
699 strcat (class_tail, ".");
700 class_tail++;
701 }
702 }
703
704 #endif
705
706 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
707 sections of a resource. Convert invalid characters to -. */
708
709 static void
710 validify_resource_string (char *str)
711 {
712 while (*str)
713 {
714 if (!strchr ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"
715 "abcdefghijklmnopqrstuvwxyz"
716 "0123456789-_", *str))
717 *str = '-';
718 str++;
719 }
720 }
721
722 /* Given a locale and device specification from x-get-resource or
723 x-get-resource-prefix, return the resource prefix and display to
724 fetch the resource on. */
725
726 static void
727 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
728 Display **display_out, char *name_out,
729 char *class_out)
730 {
731 char *appname, *appclass;
732
733 if (NILP (locale))
734 locale = Qglobal;
735 if (NILP (Fvalid_specifier_locale_p (locale)))
736 signal_simple_error ("Invalid locale", locale);
737 if (WINDOWP (locale))
738 /* #### I can't come up with any coherent way of naming windows.
739 By relative position? That seems tricky because windows
740 can change position, be split, etc. By order of creation?
741 That seems less than useful. */
742 signal_simple_error ("Windows currently can't be resourced", locale);
743
744 if (!NILP (device) && !DEVICEP (device))
745 CHECK_DEVICE (device);
746 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
747 device = Qnil;
748 if (NILP (device))
749 {
750 device = DFW_DEVICE (locale);
751 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
752 device = Qnil;
753 if (NILP (device))
754 device = Vdefault_x_device;
755 if (NILP (device))
756 {
757 *display_out = 0;
758 return;
759 }
760 }
761
762 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
763
764 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
765 strcpy (name_out, appname);
766 strcpy (class_out, appclass);
767 validify_resource_string (name_out);
768 validify_resource_string (class_out);
769
770 if (EQ (locale, Qglobal))
771 return;
772 if (BUFFERP (locale))
773 {
774 strcat (name_out, ".buffer.");
775 /* we know buffer is live; otherwise we got an error above. */
776 strcat (name_out,
777 (CONST char *) string_data (XSTRING (Fbuffer_name (locale))));
778 strcat (class_out, ".EmacsLocaleType.EmacsBuffer");
779 }
780 else if (FRAMEP (locale))
781 {
782 strcat (name_out, ".frame.");
783 /* we know frame is live; otherwise we got an error above. */
784 strcat (name_out,
785 (CONST char *) string_data (XSTRING (Fframe_name (locale))));
786 strcat (class_out, ".EmacsLocaleType.EmacsFrame");
787 }
788 else
789 {
790 assert (DEVICEP (locale));
791 strcat (name_out, ".device.");
792 /* we know device is live; otherwise we got an error above. */
793 strcat (name_out,
794 (CONST char *) string_data (XSTRING (Fdevice_name (locale))));
795 strcat (class_out, ".EmacsLocaleType.EmacsDevice");
796 }
797 return;
798 }
799
800 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 3, 6, 0 /*
801 Retrieve an X resource from the resource manager.
802
803 The first arg is the name of the resource to retrieve, such as \"font\".
804 The second arg is the class of the resource to retrieve, like \"Font\".
805 The third arg should be one of the symbols 'string, 'integer, 'natnum, or
806 'boolean, specifying the type of object that the database is searched for.
807 The fourth arg is the locale to search for the resources on, and can
808 currently be a a buffer, a frame, a device, or 'global. If omitted, it
809 defaults to 'global.
810 The fifth arg is the device to search for the resources on. (The resource
811 database for a particular device is constructed by combining non-device-
812 specific resources such any command-line resources specified and any
813 app-defaults files found [or the fallback resources supplied by XEmacs,
814 if no app-defaults file is found] with device-specific resources such as
815 those supplied using xrdb.) If omitted, it defaults to the device of
816 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
817 and otherwise defaults to the value of `default-x-device'.
818 The sixth arg NOERROR, if non-nil, means do not signal an error if a
819 bogus resource specification was retrieved (e.g. if a non-integer was
820 given when an integer was requested). In this case, a warning is issued
821 instead.
822
823 The resource names passed to this function are looked up relative to the
824 locale.
825
826 If you want to search for a subresource, you just need to specify the
827 resource levels in NAME and CLASS. For example, NAME could be
828 \"modeline.attributeFont\", and CLASS \"Face.AttributeFont\".
829
830 Specifically,
831
832 1) If LOCALE is a buffer, a call
833
834 (x-get-resource \"foreground\" \"Foreground\" 'string SOME-BUFFER)
835
836 is an interface to a C call something like
837
838 XrmGetResource (db, \"xemacs.buffer.BUFFER-NAME.foreground\",
839 \"Emacs.EmacsLocaleType.EmacsBuffer.Foreground\",
840 \"String\");
841
842 2) If LOCALE is a frame, a call
843
844 (x-get-resource \"foreground\" \"Foreground\" 'string SOME-FRAME)
845
846 is an interface to a C call something like
847
848 XrmGetResource (db, \"xemacs.frame.FRAME-NAME.foreground\",
849 \"Emacs.EmacsLocaleType.EmacsFrame.Foreground\",
850 \"String\");
851
852 3) If LOCALE is a device, a call
853
854 (x-get-resource \"foreground\" \"Foreground\" 'string SOME-DEVICE)
855
856 is an interface to a C call something like
857
858 XrmGetResource (db, \"xemacs.device.DEVICE-NAME.foreground\",
859 \"Emacs.EmacsLocaleType.EmacsDevice.Foreground\",
860 \"String\");
861
862 4) If LOCALE is 'global, a call
863
864 (x-get-resource \"foreground\" \"Foreground\" 'string 'global)
865
866 is an interface to a C call something like
867
868 XrmGetResource (db, \"xemacs.foreground\",
869 \"Emacs.Foreground\",
870 \"String\");
871
872 Note that for 'global, no prefix is added other than that of the
873 application itself; thus, you can use this locale to retrieve
874 arbitrary application resources, if you really want to.
875
876 The returned value of this function is nil if the queried resource is not
877 found. If the third arg is `string', a string is returned, and if it is
878 `integer', an integer is returned. If the third arg is `boolean', then the
879 returned value is the list (t) for true, (nil) for false, and is nil to
880 mean ``unspecified.''
881 */ )
882 (name, class, type, locale, device, no_error)
883 Lisp_Object name, class, type, locale, device, no_error;
884 {
885 /* #### fixed limit, could be overflowed */
886 char name_string[2048], class_string[2048];
887 char *raw_result;
888 XrmDatabase db;
889 Display *display;
890 Error_behavior errb = decode_error_behavior_flag (no_error);
891
892 CHECK_STRING (name);
893 CHECK_STRING (class);
894 CHECK_SYMBOL (type);
895
896 if (!EQ (type, Qstring) && !EQ (type, Qboolean) &&
897 !EQ (type, Qinteger) && !EQ (type, Qnatnum))
898 return maybe_signal_continuable_error
899 (Qwrong_type_argument,
900 list2 (build_translated_string
901 ("should be string, integer, natnum or boolean"),
902 type),
903 Qresource, errb);
904
905 x_get_resource_prefix (locale, device, &display, name_string,
906 class_string);
907 if (!display)
908 return Qnil;
909
910 db = XtDatabase (display);
911
912 strcat (name_string, ".");
913 strcat (name_string, (CONST char *) string_data (XSTRING (name)));
914 strcat (class_string, ".");
915 strcat (class_string, (CONST char *) string_data (XSTRING (class)));
916
917 {
918 XrmValue xrm_value;
919 XrmName namelist[100];
920 XrmClass classlist[100];
921 XrmName *namerest = namelist;
922 XrmClass *classrest = classlist;
923 XrmRepresentation xrm_type;
924 XrmRepresentation string_quark;
925 int result;
926 XrmStringToNameList (name_string, namelist);
927 XrmStringToClassList (class_string, classlist);
928 string_quark = XrmStringToQuark ("String");
929
930 /* ensure that they have the same length */
931 while (namerest[0] && classrest[0])
932 namerest++, classrest++;
933 if (namerest[0] || classrest[0])
934 signal_simple_error_2
935 ("class list and name list must be the same length", name, class);
936 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
937
938 if (result != True || xrm_type != string_quark)
939 return Qnil;
940 raw_result = (char *) xrm_value.addr;
941 }
942
943 if (EQ (type, Qstring))
944 return build_string (raw_result);
945 else if (EQ (type, Qboolean))
946 {
947 if (!strcasecmp (raw_result, "off") ||
948 !strcasecmp (raw_result, "false") ||
949 !strcasecmp (raw_result,"no"))
950 return Fcons (Qnil, Qnil);
951 else if (!strcasecmp (raw_result, "on") ||
952 !strcasecmp (raw_result, "true") ||
953 !strcasecmp (raw_result, "yes"))
954 return Fcons (Qt, Qnil);
955 else
956 return maybe_continuable_error (Qresource, errb,
957 "can't convert %s: %s to a Boolean",
958 name_string, raw_result);
959 }
960 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
961 {
962 int i;
963 char c;
964 if (1 != sscanf (raw_result, "%d%c", &i, &c))
965 return maybe_continuable_error
966 (Qresource, errb,
967 "can't convert %s: %s to an integer",
968 name_string, raw_result);
969 else if (EQ (type, Qnatnum) && i < 0)
970 return maybe_continuable_error
971 (Qresource, errb,
972 "invalid numerical value %d for resource %s",
973 i, name_string);
974 else
975 return make_int (i);
976 }
977 else
978 abort ();
979
980 /* Can't get here. */
981 return Qnil; /* shut up compiler */
982 }
983
984 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix,
985 Sx_get_resource_prefix, 1, 2, 0 /*
986 Return the resource prefix for LOCALE on DEVICE.
987 The resource prefix is the strings used to prefix resources if
988 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
989 The returned value is a cons of a name prefix and a class prefix.
990 For example, if LOCALE is a frame, the returned value might be
991 \(\"xemacs.frame.FRAME-NAME\" . \"Emacs.EmacsLocaleType.EmacsFrame\").
992 If no valid X device for resourcing can be obtained, this function
993 returns nil. (In such a case, `x-get-resource' would always return nil.)
994 */ )
995 (locale, device)
996 Lisp_Object locale, device;
997 {
998 /* #### fixed limit, could be overflowed */
999 char name[1024], class[1024];
1000 Display *display;
1001
1002 x_get_resource_prefix (locale, device, &display, name, class);
1003 if (!display)
1004 return Qnil;
1005 return Fcons (build_string (name), build_string (class));
1006 }
1007
1008 DEFUN ("x-put-resource", Fx_put_resource, Sx_put_resource, 1, 2, 0 /*
1009 Add a resource to the resource database for DEVICE.
1010 RESOURCE-LINE specifies the resource to add and should be a
1011 standard resource specification.
1012 */ )
1013 (resource_line, device)
1014 Lisp_Object resource_line, device;
1015 {
1016 struct device *d = decode_device (device);
1017 char *str, *colon_pos;
1018
1019 CHECK_STRING (resource_line);
1020 str = (char *) string_data (XSTRING (resource_line));
1021 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
1022 invalid:
1023 signal_simple_error ("Invalid resource line", resource_line);
1024 if (strspn (str,
1025 /* Only the following chars are allowed before the colon */
1026 " \t.*?abcdefghijklmnopqrstuvwxyz"
1027 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") != colon_pos - str)
1028 goto invalid;
1029
1030 if (DEVICE_X_P (d))
1031 {
1032 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
1033 XrmPutLineResource (&db, str);
1034 }
1035
1036 return Qnil;
1037 }
1038
1039
1040 /************************************************************************/
1041 /* display information functions */
1042 /************************************************************************/
1043
1044 DEFUN ("default-x-device", Fdefault_x_device, Sdefault_x_device, 0, 0, 0 /*
1045 Return the default X device for resourcing.
1046 This is the first-created X device that still exists.
1047 */ )
1048 ()
1049 {
1050 return Vdefault_x_device;
1051 }
1052
1053 DEFUN ("x-display-visual-class", Fx_display_visual_class,
1054 Sx_display_visual_class, 0, 1, 0 /*
1055 Return the visual class of the X display `device' is on.
1056 The returned value will be one of the symbols `static-gray', `gray-scale',
1057 `static-color', `pseudo-color', `true-color', or `direct-color'.
1058 */ )
1059 (device)
1060 Lisp_Object device;
1061 {
1062 switch (DefaultVisualOfScreen
1063 (DefaultScreenOfDisplay (get_x_display (device)))->class)
1064 {
1065 case StaticGray: return (intern ("static-gray"));
1066 case GrayScale: return (intern ("gray-scale"));
1067 case StaticColor: return (intern ("static-color"));
1068 case PseudoColor: return (intern ("pseudo-color"));
1069 case TrueColor: return (intern ("true-color"));
1070 case DirectColor: return (intern ("direct-color"));
1071 default:
1072 error ("display has an unknown visual class");
1073 }
1074
1075 return Qnil; /* suppress compiler warning */
1076 }
1077
1078 static int
1079 x_device_pixel_width (struct device *d)
1080 {
1081 Display *dpy = DEVICE_X_DISPLAY (d);
1082
1083 return DisplayWidth (dpy, DefaultScreen (dpy));
1084 }
1085
1086 static int
1087 x_device_pixel_height (struct device *d)
1088 {
1089 Display *dpy = DEVICE_X_DISPLAY (d);
1090
1091 return DisplayHeight (dpy, DefaultScreen (dpy));
1092 }
1093
1094 static int
1095 x_device_mm_width (struct device *d)
1096 {
1097 Display *dpy = DEVICE_X_DISPLAY (d);
1098
1099 return DisplayWidthMM (dpy, DefaultScreen (dpy));
1100 }
1101
1102 static int
1103 x_device_mm_height (struct device *d)
1104 {
1105 Display *dpy = DEVICE_X_DISPLAY (d);
1106
1107 return DisplayHeightMM (dpy, DefaultScreen (dpy));
1108 }
1109
1110 static int
1111 x_device_bitplanes (struct device *d)
1112 {
1113 Display *dpy = DEVICE_X_DISPLAY (d);
1114
1115 return DisplayPlanes (dpy, DefaultScreen (dpy));
1116 }
1117
1118 static int
1119 x_device_color_cells (struct device *d)
1120 {
1121 Display *dpy = DEVICE_X_DISPLAY (d);
1122
1123 return DisplayCells (dpy, DefaultScreen (dpy));
1124 }
1125
1126 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0 /*
1127 Return the vendor ID string of the X server `device' on.
1128 */ )
1129 (device)
1130 Lisp_Object device;
1131 {
1132 Display *dpy = get_x_display (device);
1133 char *vendor = ServerVendor (dpy);
1134
1135 if (vendor)
1136 return (build_string (vendor));
1137 else
1138 return (build_string (""));
1139 }
1140
1141 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0 /*
1142 Return the version numbers of the X server `device' is on.
1143 The returned value is a list of three integers: the major and minor
1144 version numbers of the X Protocol in use, and the vendor-specific release
1145 number. See also `x-server-vendor'.
1146 */ )
1147 (device)
1148 Lisp_Object device;
1149 {
1150 Display *dpy = get_x_display (device);
1151
1152 return list3 (make_int (ProtocolVersion (dpy)),
1153 make_int (ProtocolRevision (dpy)),
1154 make_int (VendorRelease (dpy)));
1155 }
1156
1157 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, Sx_valid_keysym_name_p,
1158 1, 1, 0 /*
1159 Return true if KEYSYM names a keysym that the X library knows about.
1160 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1161 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1162 */ )
1163 (keysym)
1164 Lisp_Object keysym;
1165 {
1166 CONST char *keysym_ext;
1167
1168 CHECK_STRING (keysym);
1169 GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext);
1170 if (XStringToKeysym (keysym_ext))
1171 return Qt;
1172 return Qnil;
1173 }
1174
1175 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, Sx_keysym_on_keyboard_p,
1176 1, 2, 0 /*
1177 Return true if KEYSYM names a key on the keyboard of DEVICE.
1178 More precisely, return true if pressing a physical key
1179 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1180 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1181 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1182 */ )
1183 (keysym, device)
1184 Lisp_Object keysym, device;
1185 {
1186 struct device *d = decode_device(device);
1187 CONST char *keysym_string;
1188 KeySym keysym_KeySym;
1189 KeySym *keysym_ptr, *keysym_last;
1190 int code, min_code, max_code, keysyms_per_code;
1191
1192 if (!DEVICE_X_P (d))
1193 signal_simple_error ("Not an X device", device);
1194 CHECK_STRING (keysym);
1195 GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_string);
1196 keysym_KeySym = XStringToKeysym (keysym_string);
1197 if (!keysym_KeySym) /* Invalid keysym */
1198 return Qnil;
1199
1200 XDisplayKeycodes (DEVICE_X_DISPLAY (d), &min_code, &max_code);
1201 keysyms_per_code = DEVICE_X_DATA (d)->x_keysym_map_keysyms_per_code;
1202 keysym_ptr = DEVICE_X_DATA (d)->x_keysym_map;
1203 keysym_last = keysym_ptr + (max_code - min_code) * keysyms_per_code;
1204 for ( ; keysym_ptr <= keysym_last; keysym_ptr += keysyms_per_code)
1205 {
1206 if (keysym_KeySym == *keysym_ptr)
1207 return Qt;
1208 }
1209
1210 return Qnil;
1211 }
1212
1213
1214 /************************************************************************/
1215 /* grabs and ungrabs */
1216 /************************************************************************/
1217
1218 DEFUN ("x-grab-pointer", Fx_grab_pointer, Sx_grab_pointer, 0, 3, 0 /*
1219 Grab the pointer and restrict it to its current window.
1220 If optional DEVICE argument is nil, the default device will be used.
1221 If optional CURSOR argument is non-nil, change the pointer shape to that
1222 until `x-ungrab-pointer' is called (it should be an object returned by the
1223 `make-cursor-glyph' function).
1224 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1225 keyboard events during the grab.
1226 Returns t if the grab is successful, nil otherwise.
1227 */ )
1228 (device, cursor, ignore_keyboard)
1229 Lisp_Object device, cursor, ignore_keyboard;
1230 {
1231 Window w;
1232 int pointer_mode, result;
1233 struct device *d = decode_x_device (device);
1234
1235 if (!NILP (cursor))
1236 {
1237 CHECK_POINTER_GLYPH (cursor);
1238 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
1239 }
1240
1241 if (!NILP (ignore_keyboard))
1242 pointer_mode = GrabModeSync;
1243 else
1244 pointer_mode = GrabModeAsync;
1245
1246 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1247
1248 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1249 seem to cause a problem if XFreeCursor is called on a cursor in use
1250 in a grab; I suppose the X server counts the grab as a reference
1251 and doesn't free it until it exits? */
1252 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
1253 False,
1254 ButtonMotionMask | ButtonPressMask
1255 | ButtonReleaseMask | PointerMotionHintMask,
1256 GrabModeAsync, /* Keep pointer events flowing */
1257 pointer_mode, /* Stall keyboard events */
1258 w, /* Stay in this window */
1259 (NILP (cursor) ? 0
1260 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
1261 CurrentTime);
1262 return ((result == GrabSuccess) ? Qt : Qnil);
1263 }
1264
1265 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, Sx_ungrab_pointer, 0, 1, 0 /*
1266 Release a pointer grab made with `x-grab-pointer'.
1267 If optional first arg DEVICE is nil the default device is used.
1268 If it is t the pointer will be released on all X devices.
1269 */ )
1270 (device)
1271 Lisp_Object device;
1272 {
1273 if (!EQ (device, Qt))
1274 {
1275 Display *dpy = get_x_display (device);
1276 XUngrabPointer (dpy, CurrentTime);
1277 }
1278 else
1279 {
1280 Lisp_Object devcons, concons;
1281
1282 DEVICE_LOOP_NO_BREAK (devcons, concons)
1283 {
1284 struct device *d = XDEVICE (XCAR (devcons));
1285
1286 if (DEVICE_X_P (d))
1287 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
1288 }
1289 }
1290
1291 return Qnil;
1292 }
1293
1294 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, Sx_grab_keyboard, 0, 1, 0 /*
1295 Grab the keyboard on the given device (defaulting to the selected one).
1296 So long as the keyboard is grabbed, all keyboard events will be delivered
1297 to emacs -- it is not possible for other X clients to eavesdrop on them.
1298 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1299 Returns t if the grab was successful; nil otherwise.
1300 */ )
1301 (device)
1302 Lisp_Object device;
1303 {
1304 struct device *d = decode_x_device (device);
1305 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1306 Display *dpy = DEVICE_X_DISPLAY (d);
1307 Status status;
1308 XSync (dpy, False);
1309 status = XGrabKeyboard (dpy, w, True,
1310 /* I don't really understand sync-vs-async
1311 grabs, but this is what xterm does. */
1312 GrabModeAsync, GrabModeAsync,
1313 /* Use the timestamp of the last user action
1314 read by emacs proper; xterm uses CurrentTime
1315 but there's a comment that says "wrong"...
1316 (Despite the name this is the time of the
1317 last key or mouse event.) */
1318 DEVICE_X_MOUSE_TIMESTAMP (d));
1319 if (status == GrabSuccess)
1320 {
1321 /* The XUngrabKeyboard should generate a FocusIn back to this
1322 window but it doesn't unless we explicitly set focus to the
1323 window first (which should already have it. The net result
1324 is that without this call when x-ungrab-keyboard is called
1325 the selected frame ends up not having focus. */
1326 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
1327 return Qt;
1328 }
1329 else
1330 return Qnil;
1331 }
1332
1333 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, Sx_ungrab_keyboard, 0, 1, 0 /*
1334 Release a keyboard grab made with `x-grab-keyboard'.
1335 */ )
1336 (device)
1337 Lisp_Object device;
1338 {
1339 Display *dpy = get_x_display (device);
1340 XUngrabKeyboard (dpy, CurrentTime);
1341 return Qnil;
1342 }
1343
1344
1345 /************************************************************************/
1346 /* initialization */
1347 /************************************************************************/
1348
1349 void
1350 syms_of_device_x (void)
1351 {
1352 defsubr (&Sx_debug_mode);
1353 defsubr (&Sx_get_resource);
1354 defsubr (&Sx_get_resource_prefix);
1355 defsubr (&Sx_put_resource);
1356
1357 defsubr (&Sdefault_x_device);
1358 defsubr (&Sx_display_visual_class);
1359 defsubr (&Sx_server_vendor);
1360 defsubr (&Sx_server_version);
1361 defsubr (&Sx_valid_keysym_name_p);
1362 defsubr (&Sx_keysym_on_keyboard_p);
1363
1364 defsubr (&Sx_grab_pointer);
1365 defsubr (&Sx_ungrab_pointer);
1366 defsubr (&Sx_grab_keyboard);
1367 defsubr (&Sx_ungrab_keyboard);
1368
1369 defsymbol (&Qx_error, "x-error");
1370 defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
1371 defsymbol (&Qinit_post_x_win, "init-post-x-win");
1372 }
1373
1374 void
1375 console_type_create_device_x (void)
1376 {
1377 CONSOLE_HAS_METHOD (x, init_device);
1378 CONSOLE_HAS_METHOD (x, finish_init_device);
1379 CONSOLE_HAS_METHOD (x, mark_device);
1380 CONSOLE_HAS_METHOD (x, delete_device);
1381 CONSOLE_HAS_METHOD (x, device_pixel_width);
1382 CONSOLE_HAS_METHOD (x, device_pixel_height);
1383 CONSOLE_HAS_METHOD (x, device_mm_width);
1384 CONSOLE_HAS_METHOD (x, device_mm_height);
1385 CONSOLE_HAS_METHOD (x, device_bitplanes);
1386 CONSOLE_HAS_METHOD (x, device_color_cells);
1387 }
1388
1389 void
1390 vars_of_device_x (void)
1391 {
1392 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
1393 The X application class of the XEmacs process.
1394 This controls, among other things, the name of the `app-defaults' file
1395 that XEmacs will use. For changes to this variable to take effect, they
1396 must be made before the connection to the X server is initialized, that is,
1397 this variable may only be changed before emacs is dumped, or by setting it
1398 in the file lisp/term/x-win.el.
1399 */ );
1400 Vx_emacs_application_class = Fpurecopy (build_string ("Emacs"));
1401
1402 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
1403 You don't want to know.
1404 This is used during startup to communicate the remaining arguments in
1405 `command-line-args-left' to the C code, which passes the args to
1406 the X initialization code, which removes some args, and then the
1407 args are placed back into `x-initial-arg-list' and thence into
1408 `command-line-args-left'. Perhaps `command-line-args-left' should
1409 just reside in C.
1410 */ );
1411 Vx_initial_argv_list = Qnil;
1412
1413 Fprovide (Qx);
1414
1415 staticpro (&Vdefault_x_device);
1416 Vdefault_x_device = Qnil;
1417
1418 error_expected = 0;
1419 error_occurred = 0;
1420
1421 in_resource_setting = 0;
1422 in_specifier_change_function = 0;
1423 }