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