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