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