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