annotate src/device-x.c @ 5263:0d436a78c514

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