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