Mercurial > hg > xemacs-beta
annotate src/device.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 | b5df3737028a |
| children | f965e31a35f0 |
| rev | line source |
|---|---|
| 442 | 1 /* Generic device functions. |
| 428 | 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. |
| 3 Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
4 Copyright (C) 1995, 1996, 2002, 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 | |
| 853 | 25 /* Written by Ben Wing, late 1995? |
| 26 Based on prototype by Chuck Thompson. | |
| 27 device-system-metric stuff added 1998? by Kirill Katsnelson. | |
| 28 */ | |
| 428 | 29 |
| 30 #include <config.h> | |
| 31 #include "lisp.h" | |
| 32 | |
| 33 #include "buffer.h" | |
| 34 #include "console.h" | |
| 872 | 35 #include "device-impl.h" |
| 428 | 36 #include "elhash.h" |
| 37 #include "events.h" | |
| 38 #include "faces.h" | |
| 872 | 39 #include "frame-impl.h" |
| 428 | 40 #include "keymap.h" |
| 872 | 41 #include "objects.h" |
| 428 | 42 #include "redisplay.h" |
| 43 #include "specifier.h" | |
| 44 #include "sysdep.h" | |
| 800 | 45 #include "toolbar.h" |
| 428 | 46 #include "window.h" |
| 47 | |
| 48 #ifdef HAVE_SCROLLBARS | |
| 49 #include "scrollbar.h" | |
| 50 #endif | |
| 51 | |
| 52 #include "syssignal.h" | |
| 53 | |
| 54 /* Vdefault_device is the firstly-created non-stream device that's still | |
| 55 around. We don't really use it anywhere currently, but it might | |
| 56 be used for resourcing at some point. (Currently we use | |
| 872 | 57 the default X device -- see Vdefault_device_plist.) */ |
| 428 | 58 Lisp_Object Vdefault_device; |
| 59 | |
| 60 Lisp_Object Vcreate_device_hook, Vdelete_device_hook; | |
| 61 | |
| 872 | 62 static Lisp_Object Vdefault_device_plist; |
| 63 | |
| 428 | 64 /* Device classes */ |
| 65 /* Qcolor defined in general.c */ | |
| 66 Lisp_Object Qgrayscale, Qmono; | |
| 67 | |
| 68 /* Device metrics symbols */ | |
| 69 Lisp_Object | |
| 70 Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face, | |
| 71 Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight, | |
| 72 Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar, | |
| 73 Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default, | |
| 74 Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar, | |
| 75 Qsize_menu, Qsize_toolbar, Qsize_toolbar_button, | |
| 76 Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device, | |
| 440 | 77 Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi, |
| 1942 | 78 Qnum_bit_planes, Qnum_color_cells, Qnum_screens, Qmouse_buttons, |
| 79 Qsave_under, Qswap_buttons, Qshow_sounds, Qslow_device, Qsecurity, | |
| 80 Qbacking_store; | |
| 428 | 81 |
| 82 Lisp_Object Qdevicep, Qdevice_live_p; | |
| 83 Lisp_Object Qcreate_device_hook; | |
| 84 Lisp_Object Qdelete_device_hook; | |
| 85 Lisp_Object Vdevice_class_list; | |
| 86 | |
| 87 | |
| 934 | 88 |
| 3092 | 89 #ifndef NEW_GC |
| 1204 | 90 extern const struct sized_memory_description gtk_device_data_description; |
| 91 extern const struct sized_memory_description mswindows_device_data_description; | |
| 1346 | 92 extern const struct sized_memory_description msprinter_device_data_description; |
| 1204 | 93 extern const struct sized_memory_description x_device_data_description; |
| 3092 | 94 #endif /* not NEW_GC */ |
| 934 | 95 |
| 1204 | 96 static const struct memory_description device_data_description_1 []= { |
| 3092 | 97 #ifdef NEW_GC |
| 98 #ifdef HAVE_GTK | |
| 99 { XD_LISP_OBJECT, gtk_console }, | |
| 100 #endif | |
| 101 #ifdef HAVE_MS_WINDOWS | |
| 102 { XD_LISP_OBJECT, mswindows_console }, | |
| 103 { XD_LISP_OBJECT, msprinter_console }, | |
| 104 #endif | |
| 105 #ifdef HAVE_X_WINDOWS | |
| 106 { XD_LISP_OBJECT, x_console }, | |
| 107 #endif | |
| 108 #else /* not NEW_GC */ | |
| 934 | 109 #ifdef HAVE_GTK |
| 2551 | 110 { XD_BLOCK_PTR, gtk_console, 1, { >k_device_data_description} }, |
| 934 | 111 #endif |
| 1204 | 112 #ifdef HAVE_MS_WINDOWS |
| 2551 | 113 { XD_BLOCK_PTR, mswindows_console, 1, { &mswindows_device_data_description} }, |
| 114 { XD_BLOCK_PTR, msprinter_console, 1, { &msprinter_device_data_description} }, | |
| 1204 | 115 #endif |
| 934 | 116 #ifdef HAVE_X_WINDOWS |
| 2551 | 117 { XD_BLOCK_PTR, x_console, 1, { &x_device_data_description} }, |
| 934 | 118 #endif |
| 3092 | 119 #endif /* not NEW_GC */ |
| 934 | 120 { XD_END } |
| 121 }; | |
| 122 | |
| 1204 | 123 static const struct sized_memory_description device_data_description = { |
| 124 sizeof (void *), device_data_description_1 | |
| 934 | 125 }; |
| 126 | |
| 1204 | 127 static const struct memory_description device_description [] = { |
| 934 | 128 { XD_INT, offsetof (struct device, devtype) }, |
| 1204 | 129 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (struct device, x) }, |
| 130 #include "devslots.h" | |
| 131 | |
| 2367 | 132 { XD_BLOCK_PTR, offsetof (struct device, devmeths), 1, |
| 2551 | 133 { &console_methods_description } }, |
| 934 | 134 { XD_UNION, offsetof (struct device, device_data), |
| 2551 | 135 XD_INDIRECT (0, 0), { &device_data_description } }, |
| 934 | 136 { XD_END } |
| 137 }; | |
| 138 | |
| 428 | 139 static Lisp_Object |
| 140 mark_device (Lisp_Object obj) | |
| 141 { | |
| 142 struct device *d = XDEVICE (obj); | |
| 143 | |
| 1204 | 144 #define MARKED_SLOT(x) mark_object (d->x); |
| 617 | 145 #include "devslots.h" |
| 428 | 146 |
| 147 if (d->devmeths) | |
| 148 { | |
| 149 mark_object (d->devmeths->symbol); | |
| 150 MAYBE_DEVMETH (d, mark_device, (d)); | |
| 151 } | |
| 152 | |
| 153 return (d->frame_list); | |
| 154 } | |
| 155 | |
| 156 static void | |
| 2286 | 157 print_device (Lisp_Object obj, Lisp_Object printcharfun, |
| 158 int UNUSED (escapeflag)) | |
| 428 | 159 { |
| 160 struct device *d = XDEVICE (obj); | |
| 161 | |
| 162 if (print_readably) | |
| 4846 | 163 printing_unreadable_lcrecord (obj, XSTRING_DATA (d->name)); |
| 428 | 164 |
| 800 | 165 write_fmt_string (printcharfun, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" : |
| 166 DEVICE_TYPE_NAME (d)); | |
| 440 | 167 if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d))) |
| 800 | 168 write_fmt_string_lisp (printcharfun, " on %S", 1, DEVICE_CONNECTION (d)); |
| 169 write_fmt_string (printcharfun, " 0x%x>", d->header.uid); | |
| 428 | 170 } |
| 171 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
172 DEFINE_NODUMP_LISP_OBJECT ("device", device, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
173 mark_device, print_device, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
174 device_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
175 struct device); |
| 428 | 176 |
| 177 int | |
| 1204 | 178 valid_device_class_p (Lisp_Object class_) |
| 428 | 179 { |
| 1204 | 180 return !NILP (memq_no_quit (class_, Vdevice_class_list)); |
| 428 | 181 } |
| 182 | |
| 183 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /* | |
| 184 Given a DEVICE-CLASS, return t if it is valid. | |
| 3025 | 185 Valid classes are `color', `grayscale', and `mono'. |
| 428 | 186 */ |
| 187 (device_class)) | |
| 188 { | |
| 189 return valid_device_class_p (device_class) ? Qt : Qnil; | |
| 190 } | |
| 191 | |
| 192 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /* | |
| 193 Return a list of valid device classes. | |
| 194 */ | |
| 195 ()) | |
| 196 { | |
| 197 return Fcopy_sequence (Vdevice_class_list); | |
| 198 } | |
| 199 | |
| 617 | 200 static void |
| 201 nuke_all_device_slots (struct device *d, Lisp_Object zap) | |
| 202 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
203 zero_nonsized_lisp_object (wrap_device (d)); |
| 617 | 204 |
| 1204 | 205 #define MARKED_SLOT(x) d->x = zap; |
| 617 | 206 #include "devslots.h" |
| 207 } | |
| 208 | |
| 428 | 209 static struct device * |
| 210 allocate_device (Lisp_Object console) | |
| 211 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
212 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (device); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
213 struct device *d = XDEVICE (obj); |
| 428 | 214 struct gcpro gcpro1; |
| 215 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
216 GCPRO1 (obj); |
| 428 | 217 |
| 617 | 218 nuke_all_device_slots (d, Qnil); |
| 219 | |
| 428 | 220 d->console = console; |
| 221 d->infd = d->outfd = -1; | |
| 222 | |
| 223 /* #### is 20 reasonable? */ | |
| 224 d->color_instance_cache = | |
| 225 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); | |
| 226 d->font_instance_cache = | |
| 227 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); | |
| 228 #ifdef MULE | |
| 872 | 229 initialize_charset_font_caches (d); |
| 428 | 230 #endif |
| 231 /* | |
| 232 Note that the image instance cache is actually bi-level. | |
| 233 See device.h. We use a low number here because most of the | |
| 234 time there aren't very many different masks that will be used. | |
| 235 */ | |
| 236 d->image_instance_cache = | |
| 237 make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 238 | |
| 239 UNGCPRO; | |
| 240 return d; | |
| 241 } | |
| 242 | |
| 243 struct device * | |
| 244 decode_device (Lisp_Object device) | |
| 245 { | |
| 246 if (NILP (device)) | |
| 247 device = Fselected_device (Qnil); | |
| 248 /* quietly accept frames for the device arg */ | |
| 249 else if (FRAMEP (device)) | |
| 250 device = FRAME_DEVICE (decode_frame (device)); | |
| 251 CHECK_LIVE_DEVICE (device); | |
| 252 return XDEVICE (device); | |
| 253 } | |
| 254 | |
| 255 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /* | |
| 256 Given a device, frame, or window, return the associated device. | |
| 257 Return nil otherwise. | |
| 258 */ | |
| 444 | 259 (object)) |
| 428 | 260 { |
| 444 | 261 return DFW_DEVICE (object); |
| 428 | 262 } |
| 263 | |
| 872 | 264 Lisp_Object |
| 265 device_console (struct device *d) | |
| 266 { | |
| 267 return DEVICE_CONSOLE (d); | |
| 268 } | |
| 269 | |
| 270 int | |
| 271 device_live_p (struct device *d) | |
| 272 { | |
| 273 return DEVICE_LIVE_P (d); | |
| 274 } | |
| 275 | |
| 276 Lisp_Object | |
| 277 device_frame_list (struct device *d) | |
| 278 { | |
| 279 return DEVICE_FRAME_LIST (d); | |
| 280 } | |
| 281 | |
| 428 | 282 |
| 283 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /* | |
| 284 Return the device which is currently active. | |
| 285 If optional CONSOLE is non-nil, return the device that would be currently | |
| 286 active if CONSOLE were the selected console. | |
| 287 */ | |
| 288 (console)) | |
| 289 { | |
| 290 if (NILP (console) && NILP (Vselected_console)) | |
| 291 return Qnil; /* happens early in temacs */ | |
| 292 return CONSOLE_SELECTED_DEVICE (decode_console (console)); | |
| 293 } | |
| 294 | |
| 295 /* Called from selected_frame_1(), called from Fselect_window() */ | |
| 296 void | |
| 297 select_device_1 (Lisp_Object device) | |
| 298 { | |
| 299 struct device *dev = XDEVICE (device); | |
| 300 Lisp_Object old_selected_device = Fselected_device (Qnil); | |
| 301 | |
| 302 if (EQ (device, old_selected_device)) | |
| 303 return; | |
| 304 | |
| 305 /* now select the device's console */ | |
| 306 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device; | |
| 307 select_console_1 (DEVICE_CONSOLE (dev)); | |
| 308 } | |
| 309 | |
| 310 DEFUN ("select-device", Fselect_device, 1, 1, 0, /* | |
| 311 Select the device DEVICE. | |
| 312 Subsequent editing commands apply to its console, selected frame, | |
| 313 and selected window. | |
| 314 The selection of DEVICE lasts until the next time the user does | |
| 315 something to select a different device, or until the next time this | |
| 316 function is called. | |
| 317 */ | |
| 318 (device)) | |
| 319 { | |
| 320 CHECK_LIVE_DEVICE (device); | |
| 321 | |
| 322 /* select the device's selected frame's selected window. This will call | |
| 323 selected_frame_1()->selected_device_1()->selected_console_1(). */ | |
| 324 if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device)))) | |
| 325 Fselect_window (FRAME_SELECTED_WINDOW | |
| 326 (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))), | |
| 327 Qnil); | |
| 328 else | |
| 563 | 329 invalid_operation ("Can't select a device with no frames", Qunbound); |
| 428 | 330 return Qnil; |
| 331 } | |
| 332 | |
| 333 void | |
| 334 set_device_selected_frame (struct device *d, Lisp_Object frame) | |
| 335 { | |
| 336 if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame))) | |
| 337 set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame); | |
| 338 d->selected_frame = frame; | |
| 339 } | |
| 340 | |
| 341 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /* | |
| 342 Set the selected frame of device object DEVICE to FRAME. | |
| 343 If DEVICE is nil, the selected device is used. | |
| 344 If DEVICE is the selected device, this makes FRAME the selected frame. | |
| 345 */ | |
| 346 (device, frame)) | |
| 347 { | |
| 793 | 348 device = wrap_device (decode_device (device)); |
| 428 | 349 CHECK_LIVE_FRAME (frame); |
| 350 | |
| 351 if (! EQ (device, FRAME_DEVICE (XFRAME (frame)))) | |
| 617 | 352 invalid_argument ("In `set-device-selected-frame', FRAME is not on DEVICE", |
| 353 Qunbound); | |
| 428 | 354 |
| 355 if (EQ (device, Fselected_device (Qnil))) | |
| 356 return Fselect_frame (frame); | |
| 357 | |
| 358 set_device_selected_frame (XDEVICE (device), frame); | |
| 359 return frame; | |
| 360 } | |
| 361 | |
| 362 DEFUN ("devicep", Fdevicep, 1, 1, 0, /* | |
| 363 Return non-nil if OBJECT is a device. | |
| 364 */ | |
| 365 (object)) | |
| 366 { | |
| 367 return DEVICEP (object) ? Qt : Qnil; | |
| 368 } | |
| 369 | |
| 370 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /* | |
| 371 Return non-nil if OBJECT is a device that has not been deleted. | |
| 372 */ | |
| 373 (object)) | |
| 374 { | |
| 375 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil; | |
| 376 } | |
| 377 | |
| 378 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /* | |
| 379 Return the name of the specified device. | |
| 380 DEVICE defaults to the selected device if omitted. | |
| 381 */ | |
| 382 (device)) | |
| 383 { | |
| 384 return DEVICE_NAME (decode_device (device)); | |
| 385 } | |
| 386 | |
| 387 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /* | |
| 388 Return the connection of the specified device. | |
| 389 DEVICE defaults to the selected device if omitted. | |
| 390 */ | |
| 391 (device)) | |
| 392 { | |
| 393 return DEVICE_CONNECTION (decode_device (device)); | |
| 394 } | |
| 395 | |
| 396 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /* | |
| 397 Return the console of the specified device. | |
| 398 DEVICE defaults to the selected device if omitted. | |
| 399 */ | |
| 400 (device)) | |
| 401 { | |
| 402 return DEVICE_CONSOLE (decode_device (device)); | |
| 403 } | |
| 404 | |
| 405 static void | |
| 406 init_global_resources (struct device *d) | |
| 407 { | |
| 408 init_global_faces (d); | |
| 409 #ifdef HAVE_SCROLLBARS | |
| 410 init_global_scrollbars (d); | |
| 411 #endif | |
| 412 #ifdef HAVE_TOOLBARS | |
| 413 init_global_toolbars (d); | |
| 414 #endif | |
| 415 } | |
| 416 | |
| 417 static void | |
| 418 init_device_resources (struct device *d) | |
| 419 { | |
| 420 init_device_faces (d); | |
| 421 #ifdef HAVE_SCROLLBARS | |
| 422 init_device_scrollbars (d); | |
| 423 #endif | |
| 424 #ifdef HAVE_TOOLBARS | |
| 425 init_device_toolbars (d); | |
| 426 #endif | |
| 427 } | |
| 428 | |
| 872 | 429 DEFUN ("default-device", Fdefault_device, 0, 1, 0, /* |
| 430 Return the default device of type TYPE. | |
| 431 This is generally the first-created device of that TYPE that still exists. | |
| 432 It is used for resourcing and certain other things. On MS Windows, it | |
| 433 is not very useful because there is generally only one device. | |
| 434 If TYPE is omitted, it is derived from the selected device. | |
| 435 If there is no default device of TYPE, nil is returned. | |
| 436 */ | |
| 437 (type)) | |
| 438 { | |
| 439 if (NILP (type)) | |
| 440 type = XDEVICE_TYPE (Fselected_device (Qnil)); | |
| 441 else | |
| 442 /* For errors */ | |
| 443 decode_console_type (type, ERROR_ME); | |
| 444 | |
| 445 return Fplist_get (Vdefault_device_plist, type, Qnil); | |
| 446 } | |
| 447 | |
| 448 /* Return the default device for a device type. */ | |
| 449 Lisp_Object | |
| 450 get_default_device (Lisp_Object type) | |
| 451 { | |
| 452 return Fplist_get (Vdefault_device_plist, type, Qnil); | |
| 453 } | |
| 454 | |
| 455 /* Set the default device for a device type. */ | |
| 456 void | |
| 457 set_default_device (Lisp_Object type, Lisp_Object device) | |
| 458 { | |
| 459 Vdefault_device_plist = Fplist_put (Vdefault_device_plist, type, device); | |
| 460 } | |
| 461 | |
| 462 void | |
| 463 clear_default_devices (void) | |
| 464 { | |
| 465 Vdefault_device_plist = Qnil; | |
| 466 } | |
| 467 | |
| 428 | 468 static Lisp_Object |
| 469 semi_canonicalize_device_connection (struct console_methods *meths, | |
| 578 | 470 Lisp_Object name, Error_Behavior errb) |
| 428 | 471 { |
| 440 | 472 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection)) |
| 473 return CONTYPE_METH (meths, semi_canonicalize_device_connection, | |
| 474 (name, errb)); | |
| 475 else | |
| 476 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection, | |
| 477 (name, errb), name); | |
| 428 | 478 } |
| 479 | |
| 480 static Lisp_Object | |
| 481 canonicalize_device_connection (struct console_methods *meths, | |
| 578 | 482 Lisp_Object name, Error_Behavior errb) |
| 428 | 483 { |
| 440 | 484 if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection)) |
| 485 return CONTYPE_METH (meths, canonicalize_device_connection, | |
| 486 (name, errb)); | |
| 487 else | |
| 488 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection, | |
| 489 (name, errb), name); | |
| 428 | 490 } |
| 491 | |
| 492 static Lisp_Object | |
| 493 find_device_of_type (struct console_methods *meths, Lisp_Object canon) | |
| 494 { | |
| 495 Lisp_Object devcons, concons; | |
| 496 | |
| 497 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 498 { | |
| 499 Lisp_Object device = XCAR (devcons); | |
| 500 | |
| 501 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device))) | |
| 502 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)), | |
| 503 canon, 0)) | |
| 504 return device; | |
| 505 } | |
| 506 | |
| 507 return Qnil; | |
| 508 } | |
| 509 | |
| 510 DEFUN ("find-device", Ffind_device, 1, 2, 0, /* | |
| 511 Look for an existing device attached to connection CONNECTION. | |
| 512 Return the device if found; otherwise, return nil. | |
| 513 | |
| 514 If TYPE is specified, only return devices of that type; otherwise, | |
| 515 return devices of any type. (It is possible, although unlikely, | |
| 516 that two devices of different types could have the same connection | |
| 517 name; in such a case, the first device found is returned.) | |
| 518 */ | |
| 519 (connection, type)) | |
| 520 { | |
| 521 Lisp_Object canon = Qnil; | |
| 522 struct gcpro gcpro1; | |
| 523 | |
| 524 GCPRO1 (canon); | |
| 525 | |
| 526 if (!NILP (type)) | |
| 527 { | |
| 528 struct console_methods *conmeths = decode_console_type (type, ERROR_ME); | |
| 529 canon = canonicalize_device_connection (conmeths, connection, | |
| 530 ERROR_ME_NOT); | |
| 531 if (UNBOUNDP (canon)) | |
| 532 RETURN_UNGCPRO (Qnil); | |
| 533 | |
| 534 RETURN_UNGCPRO (find_device_of_type (conmeths, canon)); | |
| 535 } | |
| 536 else | |
| 537 { | |
| 538 int i; | |
| 539 | |
| 540 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 541 { | |
| 542 struct console_methods *conmeths = | |
| 543 Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
| 544 canon = canonicalize_device_connection (conmeths, connection, | |
| 545 ERROR_ME_NOT); | |
| 546 if (!UNBOUNDP (canon)) | |
| 547 { | |
| 548 Lisp_Object device = find_device_of_type (conmeths, canon); | |
| 549 if (!NILP (device)) | |
| 550 RETURN_UNGCPRO (device); | |
| 551 } | |
| 552 } | |
| 553 | |
| 554 RETURN_UNGCPRO (Qnil); | |
| 555 } | |
| 556 } | |
| 557 | |
| 558 DEFUN ("get-device", Fget_device, 1, 2, 0, /* | |
| 559 Look for an existing device attached to connection CONNECTION. | |
| 560 Return the device if found; otherwise, signal an error. | |
| 561 | |
| 562 If TYPE is specified, only return devices of that type; otherwise, | |
| 563 return devices of any type. (It is possible, although unlikely, | |
| 564 that two devices of different types could have the same connection | |
| 565 name; in such a case, the first device found is returned.) | |
| 566 */ | |
| 567 (connection, type)) | |
| 568 { | |
| 569 Lisp_Object device = Ffind_device (connection, type); | |
| 570 if (NILP (device)) | |
| 571 { | |
| 572 if (NILP (type)) | |
| 563 | 573 invalid_argument ("No such device", connection); |
| 428 | 574 else |
| 563 | 575 invalid_argument_2 ("No such device", type, connection); |
| 428 | 576 } |
| 577 return device; | |
| 578 } | |
| 579 | |
| 580 static Lisp_Object | |
| 581 delete_deviceless_console (Lisp_Object console) | |
| 582 { | |
| 583 if (NILP (XCONSOLE (console)->device_list)) | |
| 584 Fdelete_console (console, Qnil); | |
| 585 return Qnil; | |
| 586 } | |
| 587 | |
| 588 DEFUN ("make-device", Fmake_device, 2, 3, 0, /* | |
| 589 Return a new device of type TYPE, attached to connection CONNECTION. | |
| 590 | |
| 591 The valid values for CONNECTION are device-specific; however, | |
| 592 CONNECTION is generally a string. (Specifically, for X devices, | |
| 593 CONNECTION should be a display specification such as "foo:0", and | |
| 594 for TTY devices, CONNECTION should be the filename of a TTY device | |
| 595 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard | |
| 596 input/output.) | |
| 597 | |
| 598 PROPS, if specified, should be a plist of properties controlling | |
| 599 device creation. | |
| 600 | |
| 601 If CONNECTION specifies an already-existing device connection, that | |
| 602 device is simply returned; no new device is created, and PROPS | |
| 603 have no effect. | |
| 604 */ | |
| 605 (type, connection, props)) | |
| 606 { | |
| 607 /* This function can GC */ | |
| 608 struct device *d; | |
| 609 struct console *con; | |
| 610 Lisp_Object device = Qnil; | |
| 611 Lisp_Object console = Qnil; | |
| 612 Lisp_Object name = Qnil; | |
| 613 struct console_methods *conmeths; | |
| 1204 | 614 int speccount = specpdl_depth (); |
| 428 | 615 |
| 616 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 872 | 617 /* If this is the first device we are creating of a particular type |
| 618 (e.g. X), then retrieve the global face resources. We have to do it | |
| 619 here, at the same time as (or just before) the device face resources | |
| 620 are retrieved; specifically, it needs to be done after the device has | |
| 621 been created but before any frames have been popped up or much | |
| 622 anything else has been done. It's possible for other devices to | |
| 623 specify different global resources (there's a property on each X | |
| 624 server's root window that holds some resources); tough luck for the | |
| 625 moment. */ | |
| 626 int first = NILP (get_default_device (type)); | |
| 428 | 627 |
| 628 GCPRO3 (device, console, name); | |
| 629 | |
| 630 conmeths = decode_console_type (type, ERROR_ME_NOT); | |
| 631 if (!conmeths) | |
| 563 | 632 invalid_constant ("Invalid device type", type); |
| 428 | 633 |
| 634 device = Ffind_device (connection, type); | |
| 635 if (!NILP (device)) | |
| 636 RETURN_UNGCPRO (device); | |
| 637 | |
| 638 name = Fplist_get (props, Qname, Qnil); | |
| 639 | |
| 640 { | |
| 641 Lisp_Object conconnect = | |
| 642 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ? | |
| 643 CONTYPE_METH (conmeths, device_to_console_connection, | |
| 644 (connection, ERROR_ME)) : | |
| 645 connection; | |
| 646 console = create_console (name, type, conconnect, props); | |
| 647 } | |
| 648 | |
| 872 | 649 record_unwind_protect (delete_deviceless_console, console); |
| 428 | 650 |
| 651 con = XCONSOLE (console); | |
| 652 d = allocate_device (console); | |
| 793 | 653 device = wrap_device (d); |
| 428 | 654 |
| 655 d->devmeths = con->conmeths; | |
| 934 | 656 d->devtype = get_console_variant (type); |
| 428 | 657 |
| 658 DEVICE_NAME (d) = name; | |
| 659 DEVICE_CONNECTION (d) = | |
| 660 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME); | |
| 661 DEVICE_CANON_CONNECTION (d) = | |
| 662 canonicalize_device_connection (conmeths, connection, ERROR_ME); | |
| 663 | |
| 664 MAYBE_DEVMETH (d, init_device, (d, props)); | |
| 665 | |
| 666 /* Do it this way so that the device list is in order of creation */ | |
| 667 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil)); | |
| 872 | 668 |
| 669 if (NILP (get_default_device (type))) | |
| 670 set_default_device (type, device); | |
| 671 | |
| 853 | 672 note_object_created (device); |
| 673 | |
| 428 | 674 RESET_CHANGED_SET_FLAGS; |
| 675 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device))) | |
| 676 Vdefault_device = device; | |
| 677 | |
| 678 init_device_sound (d); | |
| 679 | |
| 680 /* If this is the first device on the console, make it the selected one. */ | |
| 681 if (NILP (CONSOLE_SELECTED_DEVICE (con))) | |
| 682 CONSOLE_SELECTED_DEVICE (con) = device; | |
| 683 | |
| 872 | 684 /* Needed before initialization of resources because they may do things |
| 685 with the tags, esp. the face code. For example, | |
| 686 init-other-random-faces calls face-property-instance, and the | |
| 687 specifier code checks inst-pairs by seeing if the device matches the | |
| 688 tag; this fails for tags such as `default', if we haven't set up the | |
| 689 tags yet. */ | |
| 428 | 690 setup_device_initial_specifier_tags (d); |
| 691 | |
| 872 | 692 if (!EQ (type, Qstream)) |
| 693 { | |
| 694 if (first) | |
| 695 init_global_resources (d); | |
| 696 init_device_resources (d); | |
| 697 } | |
| 698 | |
| 699 MAYBE_DEVMETH (d, finish_init_device, (d, props)); | |
| 700 | |
| 428 | 701 UNGCPRO; |
| 771 | 702 unbind_to (speccount); |
| 428 | 703 return device; |
| 704 } | |
| 705 | |
| 706 /* find a device other than the selected one. Prefer non-stream | |
| 707 devices over stream devices. Maybe stay on the same console. */ | |
| 708 | |
| 709 static Lisp_Object | |
| 710 find_other_device (Lisp_Object device, int on_same_console) | |
| 711 { | |
| 712 Lisp_Object devcons = Qnil, concons; | |
| 713 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device)); | |
| 714 | |
| 715 /* look for a non-stream device */ | |
| 716 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 717 { | |
| 718 Lisp_Object dev = XCAR (devcons); | |
| 719 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) | |
| 720 continue; | |
| 721 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) && | |
| 722 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) | |
| 723 goto double_break_1; | |
| 724 } | |
| 725 | |
| 726 double_break_1: | |
| 727 if (!NILP (devcons)) | |
| 728 return XCAR (devcons); | |
| 729 | |
| 730 /* OK, now look for a stream device */ | |
| 731 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 732 { | |
| 733 Lisp_Object dev = XCAR (devcons); | |
| 734 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) | |
| 735 continue; | |
| 736 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) | |
| 737 goto double_break_2; | |
| 738 } | |
| 739 double_break_2: | |
| 740 if (!NILP (devcons)) | |
| 741 return XCAR (devcons); | |
| 742 | |
| 743 /* Sorry, there ain't none */ | |
| 744 return Qnil; | |
| 745 } | |
| 746 | |
| 747 static int | |
| 748 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame, | |
| 749 void *closure) | |
| 750 { | |
| 751 Lisp_Object device; | |
| 752 | |
| 5013 | 753 device = GET_LISP_FROM_VOID (closure); |
| 428 | 754 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) |
| 755 return 0; | |
| 756 if (EQ (device, FRAME_DEVICE (XFRAME (frame)))) | |
| 757 return 0; | |
| 758 return 1; | |
| 759 } | |
| 760 | |
| 761 Lisp_Object | |
| 762 find_nonminibuffer_frame_not_on_device (Lisp_Object device) | |
| 763 { | |
| 764 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate, | |
| 5013 | 765 STORE_LISP_IN_VOID (device)); |
| 428 | 766 } |
| 767 | |
| 768 | |
| 769 /* Delete device D. | |
| 770 | |
| 771 If FORCE is non-zero, allow deletion of the only frame. | |
| 772 | |
| 773 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if | |
| 774 deleting the last device on a console, just delete it, | |
| 775 instead of calling `delete-console'. | |
| 776 | |
| 777 If FROM_IO_ERROR is non-zero, then the device is gone due | |
| 778 to an I/O error. This affects what happens if we exit | |
| 779 (we do an emergency exit instead of `save-buffers-kill-emacs'.) | |
| 780 */ | |
| 781 | |
| 782 void | |
| 783 delete_device_internal (struct device *d, int force, | |
| 784 int called_from_delete_console, | |
| 785 int from_io_error) | |
| 786 { | |
| 787 /* This function can GC */ | |
| 788 struct console *c; | |
| 789 Lisp_Object device; | |
| 790 struct gcpro gcpro1; | |
| 791 | |
| 792 /* OK to delete an already-deleted device. */ | |
| 793 if (!DEVICE_LIVE_P (d)) | |
| 794 return; | |
| 795 | |
| 793 | 796 device = wrap_device (d); |
| 853 | 797 |
| 798 if (!force) | |
| 799 check_allowed_operation (OPERATION_DELETE_OBJECT, device, Qnil); | |
| 800 | |
| 428 | 801 GCPRO1 (device); |
| 802 | |
| 803 c = XCONSOLE (DEVICE_CONSOLE (d)); | |
| 804 | |
| 805 if (!called_from_delete_console) | |
| 806 { | |
| 807 int delete_console = 0; | |
| 808 /* If we're deleting the only device on the console, | |
| 809 delete the console. */ | |
| 810 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1) | |
| 811 /* if we just created the device, it might not be listed, | |
| 812 or something ... */ | |
| 813 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c)))) | |
| 814 delete_console = 1; | |
| 815 /* Or if there aren't any nonminibuffer frames that would be | |
| 816 left, delete the console (this will make XEmacs exit). */ | |
| 817 else if (NILP (find_nonminibuffer_frame_not_on_device (device))) | |
| 818 delete_console = 1; | |
| 819 | |
| 820 if (delete_console) | |
| 821 { | |
| 822 delete_console_internal (c, force, 0, from_io_error); | |
| 823 UNGCPRO; | |
| 824 return; | |
| 825 } | |
| 826 } | |
| 827 | |
| 828 reset_one_device (d); | |
| 829 | |
| 830 { | |
| 831 Lisp_Object frmcons; | |
| 832 | |
| 833 /* First delete all frames without their own minibuffers, | |
| 834 to avoid errors coming from attempting to delete a frame | |
| 835 that is a surrogate for another frame. */ | |
| 836 DEVICE_FRAME_LOOP (frmcons, d) | |
| 837 { | |
| 838 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 839 /* delete_frame_internal() might do anything such as run hooks, | |
| 840 so be defensive. */ | |
| 841 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) | |
| 842 delete_frame_internal (f, 1, 1, from_io_error); | |
| 843 | |
| 844 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 845 go ahead and delete anything */ | |
| 846 { | |
| 847 UNGCPRO; | |
| 848 return; | |
| 849 } | |
| 850 } | |
| 851 | |
| 852 /* #### This should probably be a device method but it is time for | |
| 853 19.14 to go out the door. */ | |
| 1204 | 854 /* #### BILL!!! Should this deal with HAVE_MS_WINDOWS as well? */ |
| 462 | 855 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) |
| 428 | 856 /* Next delete all frames which have the popup property to avoid |
| 857 deleting a child after its parent. */ | |
| 858 DEVICE_FRAME_LOOP (frmcons, d) | |
| 859 { | |
| 860 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 861 | |
| 862 if (FRAME_LIVE_P (f)) | |
| 863 { | |
| 864 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil); | |
| 865 if (!NILP (popup)) | |
| 866 delete_frame_internal (f, 1, 1, from_io_error); | |
| 867 | |
| 868 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 869 go ahead and delete anything */ | |
| 870 { | |
| 871 UNGCPRO; | |
| 872 return; | |
| 873 } | |
| 874 } | |
| 875 } | |
| 876 #endif /* HAVE_X_WINDOWS */ | |
| 877 | |
| 878 DEVICE_FRAME_LOOP (frmcons, d) | |
| 879 { | |
| 880 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 881 /* delete_frame_internal() might do anything such as run hooks, | |
| 882 so be defensive. */ | |
| 883 if (FRAME_LIVE_P (f)) | |
| 884 delete_frame_internal (f, 1, 1, from_io_error); | |
| 885 | |
| 886 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 887 go ahead and delete anything */ | |
| 888 { | |
| 889 UNGCPRO; | |
| 890 return; | |
| 891 } | |
| 892 } | |
| 893 } | |
| 894 | |
| 895 set_device_selected_frame (d, Qnil); | |
| 896 | |
| 897 /* try to select another device */ | |
| 898 | |
| 899 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d)))) | |
| 900 { | |
| 901 Lisp_Object other_dev = find_other_device (device, 1); | |
| 902 if (!NILP (other_dev)) | |
| 903 Fselect_device (other_dev); | |
| 904 } | |
| 905 | |
| 906 if (EQ (device, Vdefault_device)) | |
| 907 Vdefault_device = find_other_device (device, 0); | |
| 908 | |
| 909 MAYBE_DEVMETH (d, delete_device, (d)); | |
| 910 | |
| 872 | 911 /* Now see if we're the default device, and thus need to be changed. */ |
| 912 { | |
| 913 /* Device type still OK, not set to null till down below. */ | |
| 914 Lisp_Object dt = DEVICE_TYPE (d); | |
| 915 | |
| 916 if (EQ (device, get_default_device (dt))) | |
| 917 { | |
| 918 Lisp_Object devcons, concons; | |
| 919 /* #### handle deleting last device */ | |
| 920 set_default_device (dt, Qnil); | |
| 921 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 922 { | |
| 923 if (EQ (dt, XDEVICE_TYPE (XCAR (devcons))) && | |
| 924 !EQ (device, XCAR (devcons))) | |
| 925 { | |
| 926 set_default_device (dt, XCAR (devcons)); | |
| 927 goto double_break; | |
| 928 } | |
| 929 } | |
| 930 } | |
| 931 } | |
| 932 double_break: | |
| 933 | |
| 428 | 934 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c)); |
| 617 | 935 |
| 428 | 936 RESET_CHANGED_SET_FLAGS; |
| 617 | 937 |
| 938 /* Nobody should be accessing anything in this object any more, and | |
| 939 making all Lisp_Objects Qnil allows for better GC'ing in case a | |
| 940 pointer to the dead device continues to hang around. Zero all | |
| 941 other structs in case someone tries to access something through | |
| 942 them. */ | |
| 943 nuke_all_device_slots (d, Qnil); | |
| 428 | 944 d->devmeths = dead_console_methods; |
| 1204 | 945 d->devtype = dead_console; |
| 853 | 946 note_object_deleted (device); |
| 617 | 947 |
| 428 | 948 UNGCPRO; |
| 949 } | |
| 950 | |
| 951 /* delete a device as a result of an I/O error. Called from | |
| 952 an enqueued magic-eval event. */ | |
| 953 | |
| 954 void | |
| 955 io_error_delete_device (Lisp_Object device) | |
| 956 { | |
| 957 /* Note: it's the console that should get deleted, but | |
| 958 delete_device_internal() contains a hack that also deletes the | |
| 959 console when called from this function. */ | |
| 960 delete_device_internal (XDEVICE (device), 1, 0, 1); | |
| 961 } | |
| 962 | |
| 963 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /* | |
| 964 Delete DEVICE, permanently eliminating it from use. | |
| 965 Normally, you cannot delete the last non-minibuffer-only frame (you must | |
| 966 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional | |
| 967 second argument FORCE is non-nil, you can delete the last frame. (This | |
| 968 will automatically call `save-buffers-kill-emacs'.) | |
| 969 */ | |
| 970 (device, force)) | |
| 971 { | |
| 972 CHECK_DEVICE (device); | |
| 973 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0); | |
| 974 return Qnil; | |
| 975 } | |
| 976 | |
| 977 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /* | |
| 978 Return a list of all frames on DEVICE. | |
| 979 If DEVICE is nil, the selected device will be used. | |
| 980 */ | |
| 981 (device)) | |
| 982 { | |
| 983 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device))); | |
| 984 } | |
| 985 | |
| 986 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /* | |
| 987 Return the class (color behavior) of DEVICE. | |
| 3025 | 988 This will be one of `color', `grayscale', or `mono'. |
| 428 | 989 */ |
| 990 (device)) | |
| 991 { | |
| 992 return DEVICE_CLASS (decode_device (device)); | |
| 993 } | |
| 994 | |
| 995 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /* | |
| 996 Set the class (color behavior) of DEVICE. | |
| 3025 | 997 CLASS should be one of `color', `grayscale', or `mono'. |
| 428 | 998 This is only allowed on device such as TTY devices, where the color |
| 999 behavior cannot necessarily be determined automatically. | |
| 1000 */ | |
| 1204 | 1001 (device, class_)) |
| 428 | 1002 { |
| 1003 struct device *d = decode_device (device); | |
| 793 | 1004 device = wrap_device (d); |
| 428 | 1005 if (!DEVICE_TTY_P (d)) |
| 563 | 1006 gui_error ("Cannot change the class of this device", device); |
| 1204 | 1007 if (!EQ (class_, Qcolor) && !EQ (class_, Qmono) && !EQ (class_, Qgrayscale)) |
| 1008 invalid_constant ("Must be color, mono, or grayscale", class_); | |
| 1009 if (! EQ (DEVICE_CLASS (d), class_)) | |
| 428 | 1010 { |
| 1011 Lisp_Object frmcons; | |
| 1204 | 1012 DEVICE_CLASS (d) = class_; |
| 428 | 1013 DEVICE_FRAME_LOOP (frmcons, d) |
| 1014 { | |
| 1015 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 1016 | |
| 1017 recompute_all_cached_specifiers_in_frame (f); | |
| 1018 MARK_FRAME_FACES_CHANGED (f); | |
| 1019 MARK_FRAME_GLYPHS_CHANGED (f); | |
| 1020 MARK_FRAME_SUBWINDOWS_CHANGED (f); | |
| 1021 MARK_FRAME_TOOLBARS_CHANGED (f); | |
| 442 | 1022 MARK_FRAME_GUTTERS_CHANGED (f); |
| 428 | 1023 f->menubar_changed = 1; |
| 1024 } | |
| 1025 } | |
| 1026 return Qnil; | |
| 1027 } | |
| 1028 | |
| 1029 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /* | |
| 1030 Set the output baud rate of DEVICE to RATE. | |
| 1031 On most systems, changing this value will affect the amount of padding | |
| 1032 and other strategic decisions made during redisplay. | |
| 1033 */ | |
| 1034 (device, rate)) | |
| 1035 { | |
| 1036 CHECK_INT (rate); | |
| 1037 | |
| 1038 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate); | |
| 1039 | |
| 1040 return rate; | |
| 1041 } | |
| 1042 | |
| 1043 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /* | |
| 1044 Return the output baud rate of DEVICE. | |
| 1045 */ | |
| 1046 (device)) | |
| 1047 { | |
| 1048 return make_int (DEVICE_BAUD_RATE (decode_device (device))); | |
| 1049 } | |
| 1050 | |
| 440 | 1051 DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /* |
| 1052 Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults | |
| 1053 to selected device if omitted, and must be live if specified. | |
| 1054 */ | |
| 1055 (device)) | |
| 1056 { | |
| 442 | 1057 return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil; |
| 440 | 1058 } |
| 1059 | |
| 428 | 1060 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /* |
| 1061 Get a metric for DEVICE as provided by the system. | |
| 1062 | |
| 1063 METRIC must be a symbol specifying requested metric. Note that the metrics | |
| 1064 returned are these provided by the system internally, not read from resources, | |
| 1065 so obtained from the most internal level. | |
| 1066 | |
| 1067 If a metric is not provided by the system, then DEFAULT is returned. | |
| 1068 | |
| 1069 When DEVICE is nil, selected device is assumed | |
| 1070 | |
| 1071 Metrics, by group, are: | |
| 1072 | |
| 1073 COLORS. Colors are returned as valid color instantiators. No other assumption | |
| 1074 on the returned value should be made (i.e. it can be a string on one system but | |
| 1075 a color instance on another). For colors, returned value is a cons of | |
| 1076 foreground and background colors. Note that if the system provides only one | |
| 1077 color of the pair, the second one may be nil. | |
| 1078 | |
| 1079 color-default Standard window text foreground and background. | |
| 1080 color-select Selection highlight text and background colors. | |
| 1081 color-balloon Balloon popup text and background colors. | |
| 1082 color-3d-face 3-D object (button, modeline) text and surface colors. | |
| 1083 color-3d-light Fore and back colors for 3-D edges facing light source. | |
| 1084 color-3d-dark Fore and back colors for 3-D edges facing away from | |
| 1085 light source. | |
| 1086 color-menu Text and background for menus | |
| 1087 color-menu-highlight Selected menu item colors | |
| 1088 color-menu-button Menu button colors | |
| 1089 color-menu-disabled Unselectable menu item colors | |
| 1090 color-toolbar Toolbar foreground and background colors | |
| 1091 color-scrollbar Scrollbar foreground and background colors | |
| 1092 color-desktop Desktop window colors | |
| 1093 color-workspace Workspace window colors | |
| 1094 | |
| 1095 FONTS. Fonts are returned as valid font instantiators. No other assumption on | |
| 1096 the returned value should be made (i.e. it can be a string on one system but | |
| 1097 font instance on another). | |
| 1098 | |
| 1099 font-default Default fixed width font. | |
| 1100 font-menubar Menubar font | |
| 1101 font-dialog Dialog boxes font | |
| 1102 | |
| 1103 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors, | |
| 1104 either car or cdr of the cons may be nil if the system does not provide one | |
| 1105 of the corresponding dimensions. | |
| 1106 | |
| 1107 size-cursor Mouse cursor size. | |
| 1108 size-scrollbar Scrollbars (WIDTH . HEIGHT) | |
| 1109 size-menu Menubar height, as (nil . HEIGHT) | |
| 1110 size-toolbar Toolbar width and height. | |
| 1111 size-toolbar-button Toolbar button size. | |
| 1112 size-toolbar-border Toolbar border width and height. | |
| 1113 size-icon Icon dimensions. | |
| 1114 size-icon-small Small icon dimensions. | |
| 440 | 1115 size-device Device screen or paper size in pixels. |
| 1116 size-workspace Workspace size in pixels. This can be less than or | |
| 442 | 1117 equal to the above. For displays, this is the area |
| 1118 available to applications less window manager | |
| 440 | 1119 decorations. For printers, this is the size of |
| 1120 printable area. | |
| 1121 offset-workspace Offset of workspace area from the top left corner | |
| 442 | 1122 of screen or paper, in pixels. |
| 428 | 1123 size-device-mm Device screen size in millimeters. |
| 1124 device-dpi Device resolution, in dots per inch. | |
| 1125 num-bit-planes Integer, number of device bit planes. | |
| 1126 num-color-cells Integer, number of device color cells. | |
| 1942 | 1127 num-screens Integer, number of device screens. |
| 428 | 1128 |
| 1129 FEATURES. This group reports various device features. If a feature is | |
| 1130 present, integer 1 (one) is returned, if it is not present, then integer | |
| 1131 0 (zero) is returned. If the system is unaware of the feature, then | |
| 1132 DEFAULT is returned. | |
| 1133 | |
| 1134 mouse-buttons Integer, number of mouse buttons, or zero if no mouse. | |
| 1135 swap-buttons Non-zero if left and right mouse buttons are swapped. | |
| 1136 show-sounds User preference for visual over audible bell. | |
| 1137 slow-device Device is slow, avoid animation. | |
| 1138 security Non-zero if user environment is secure. | |
| 1139 */ | |
| 1140 (device, metric, default_)) | |
| 1141 { | |
| 1142 struct device *d = decode_device (device); | |
| 1143 enum device_metrics m; | |
| 1144 Lisp_Object res; | |
| 1145 | |
| 1146 /* Decode metric */ | |
| 1147 #define FROB(met) \ | |
| 1148 else if (EQ (metric, Q##met)) \ | |
| 1149 m = DM_##met | |
| 1150 | |
| 1151 if (0) | |
| 1152 ; | |
| 1153 FROB (color_default); | |
| 1154 FROB (color_select); | |
| 1155 FROB (color_balloon); | |
| 1156 FROB (color_3d_face); | |
| 1157 FROB (color_3d_light); | |
| 1158 FROB (color_3d_dark); | |
| 1159 FROB (color_menu); | |
| 1160 FROB (color_menu_highlight); | |
| 1161 FROB (color_menu_button); | |
| 1162 FROB (color_menu_disabled); | |
| 1163 FROB (color_toolbar); | |
| 1164 FROB (color_scrollbar); | |
| 1165 FROB (color_desktop); | |
| 1166 FROB (color_workspace); | |
| 1167 FROB (font_default); | |
| 1168 FROB (font_menubar); | |
| 1169 FROB (font_dialog); | |
| 1170 FROB (size_cursor); | |
| 1171 FROB (size_scrollbar); | |
| 1172 FROB (size_menu); | |
| 1173 FROB (size_toolbar); | |
| 1174 FROB (size_toolbar_button); | |
| 1175 FROB (size_toolbar_border); | |
| 1176 FROB (size_icon); | |
| 1177 FROB (size_icon_small); | |
| 1178 FROB (size_device); | |
| 1179 FROB (size_workspace); | |
| 440 | 1180 FROB (offset_workspace); |
| 428 | 1181 FROB (size_device_mm); |
| 1182 FROB (device_dpi); | |
| 1183 FROB (num_bit_planes); | |
| 1184 FROB (num_color_cells); | |
| 1942 | 1185 FROB (num_screens); |
| 428 | 1186 FROB (mouse_buttons); |
| 1187 FROB (swap_buttons); | |
| 1188 FROB (show_sounds); | |
| 1189 FROB (slow_device); | |
| 1190 FROB (security); | |
| 1942 | 1191 FROB (backing_store); |
| 1192 FROB (save_under); | |
| 428 | 1193 else |
| 563 | 1194 invalid_constant ("Invalid device metric symbol", metric); |
| 428 | 1195 |
| 1196 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound); | |
| 1197 return UNBOUNDP(res) ? default_ : res; | |
| 1198 | |
| 1199 #undef FROB | |
| 1200 } | |
| 1201 | |
| 1202 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /* | |
| 1203 Get a property list of device metric for DEVICE. | |
| 1204 | |
| 1205 See `device-system-metric' for the description of available metrics. | |
| 1206 DEVICE defaults to selected device when omitted. | |
| 1207 */ | |
| 1208 (device)) | |
| 1209 { | |
| 1210 struct device *d = decode_device (device); | |
| 1211 Lisp_Object plist = Qnil, one_metric; | |
| 1212 | |
| 1213 #define FROB(m) \ | |
| 1214 if (!UNBOUNDP ((one_metric = \ | |
| 1215 DEVMETH_OR_GIVEN (d, device_system_metrics, \ | |
| 1216 (d, DM_##m), Qunbound)))) \ | |
| 1217 plist = Fcons (Q##m, Fcons (one_metric, plist)); | |
| 1218 | |
| 1219 FROB (color_default); | |
| 1220 FROB (color_select); | |
| 1221 FROB (color_balloon); | |
| 1222 FROB (color_3d_face); | |
| 1223 FROB (color_3d_light); | |
| 1224 FROB (color_3d_dark); | |
| 1225 FROB (color_menu); | |
| 1226 FROB (color_menu_highlight); | |
| 1227 FROB (color_menu_button); | |
| 1228 FROB (color_menu_disabled); | |
| 1229 FROB (color_toolbar); | |
| 1230 FROB (color_scrollbar); | |
| 1231 FROB (color_desktop); | |
| 1232 FROB (color_workspace); | |
| 1233 FROB (font_default); | |
| 1234 FROB (font_menubar); | |
| 1235 FROB (font_dialog); | |
| 1236 FROB (size_cursor); | |
| 1237 FROB (size_scrollbar); | |
| 1238 FROB (size_menu); | |
| 1239 FROB (size_toolbar); | |
| 1240 FROB (size_toolbar_button); | |
| 1241 FROB (size_toolbar_border); | |
| 1242 FROB (size_icon); | |
| 1243 FROB (size_icon_small); | |
| 1244 FROB (size_device); | |
| 1245 FROB (size_workspace); | |
| 440 | 1246 FROB (offset_workspace); |
| 428 | 1247 FROB (size_device_mm); |
| 1248 FROB (device_dpi); | |
| 1249 FROB (num_bit_planes); | |
| 1250 FROB (num_color_cells); | |
| 1942 | 1251 FROB (num_screens); |
| 428 | 1252 FROB (mouse_buttons); |
| 1253 FROB (swap_buttons); | |
| 1254 FROB (show_sounds); | |
| 1255 FROB (slow_device); | |
| 1256 FROB (security); | |
| 1942 | 1257 FROB (backing_store); |
| 1258 FROB (save_under); | |
| 428 | 1259 |
| 1260 return plist; | |
| 1261 | |
| 1262 #undef FROB | |
| 1263 } | |
| 1264 | |
| 1265 Lisp_Object | |
| 1266 domain_device_type (Lisp_Object domain) | |
| 1267 { | |
| 1268 /* This cannot GC */ | |
| 1269 assert (WINDOWP (domain) || FRAMEP (domain) | |
| 1270 || DEVICEP (domain) || CONSOLEP (domain)); | |
| 1271 | |
| 1272 if (WINDOWP (domain)) | |
| 1273 { | |
| 1274 if (!WINDOW_LIVE_P (XWINDOW (domain))) | |
| 1275 return Qdead; | |
| 1276 domain = WINDOW_FRAME (XWINDOW (domain)); | |
| 1277 } | |
| 1278 if (FRAMEP (domain)) | |
| 1279 { | |
| 1280 if (!FRAME_LIVE_P (XFRAME (domain))) | |
| 1281 return Qdead; | |
| 1282 domain = FRAME_DEVICE (XFRAME (domain)); | |
| 1283 } | |
| 1284 if (DEVICEP (domain)) | |
| 1285 { | |
| 1286 if (!DEVICE_LIVE_P (XDEVICE (domain))) | |
| 1287 return Qdead; | |
| 1288 domain = DEVICE_CONSOLE (XDEVICE (domain)); | |
| 1289 } | |
| 1290 return CONSOLE_TYPE (XCONSOLE (domain)); | |
| 1291 } | |
| 1292 | |
| 1293 /* | |
| 1294 * Determine whether window system bases window geometry on character | |
| 1295 * or pixel counts. | |
| 1296 * Return non-zero for pixel-based geometry, zero for character-based. | |
| 1297 */ | |
| 1298 int | |
| 1299 window_system_pixelated_geometry (Lisp_Object domain) | |
| 1300 { | |
| 1301 /* This cannot GC */ | |
| 1302 Lisp_Object winsy = domain_device_type (domain); | |
| 1303 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT); | |
| 1304 assert (meth); | |
| 545 | 1305 return CONMETH_IMPL_FLAG (meth, XDEVIMPF_PIXEL_GEOMETRY); |
| 428 | 1306 } |
| 1307 | |
| 1308 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /* | |
| 3025 | 1309 Return the device type symbol for a DOMAIN, e.g. `x' or `tty'. |
| 428 | 1310 DOMAIN can be either a window, frame, device or console. |
| 1311 */ | |
| 1312 (domain)) | |
| 1313 { | |
| 1314 if (!WINDOWP (domain) && !FRAMEP (domain) | |
| 1315 && !DEVICEP (domain) && !CONSOLEP (domain)) | |
| 563 | 1316 invalid_argument |
| 428 | 1317 ("Domain must be either a window, frame, device or console", domain); |
| 1318 | |
| 1319 return domain_device_type (domain); | |
| 1320 } | |
| 1321 | |
| 1322 void | |
| 1323 handle_asynch_device_change (void) | |
| 1324 { | |
| 1325 int i; | |
| 1326 int old_asynch_device_change_pending = asynch_device_change_pending; | |
| 1327 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 1328 { | |
| 1329 if (Dynarr_at (the_console_type_entry_dynarr, i).meths-> | |
| 1330 asynch_device_change_method) | |
| 1331 (Dynarr_at (the_console_type_entry_dynarr, i).meths-> | |
| 1332 asynch_device_change_method) (); | |
| 1333 } | |
| 1334 /* reset the flag to 0 unless another notification occurred while | |
| 1335 we were processing this one. Block SIGWINCH during this | |
| 1336 check to prevent a possible race condition. */ | |
| 442 | 1337 #ifdef SIGWINCH |
| 428 | 1338 EMACS_BLOCK_SIGNAL (SIGWINCH); |
| 1339 #endif | |
| 1340 if (old_asynch_device_change_pending == asynch_device_change_pending) | |
| 1341 asynch_device_change_pending = 0; | |
| 442 | 1342 #ifdef SIGWINCH |
| 428 | 1343 EMACS_UNBLOCK_SIGNAL (SIGWINCH); |
| 1344 #endif | |
| 1345 } | |
| 1346 | |
| 771 | 1347 static Lisp_Object |
| 1348 unlock_device (Lisp_Object d) | |
| 1349 { | |
| 1350 UNLOCK_DEVICE (XDEVICE (d)); | |
| 1351 return Qnil; | |
| 1352 } | |
| 1353 | |
| 872 | 1354 Lisp_Object |
| 428 | 1355 call_critical_lisp_code (struct device *d, Lisp_Object function, |
| 1356 Lisp_Object object) | |
| 1357 { | |
| 853 | 1358 /* This function cannot GC */ |
| 771 | 1359 int count = begin_gc_forbidden (); |
| 853 | 1360 struct gcpro gcpro1; |
| 1361 Lisp_Object args[3]; | |
| 872 | 1362 Lisp_Object retval; |
| 853 | 1363 |
| 771 | 1364 specbind (Qinhibit_quit, Qt); |
| 1365 record_unwind_protect (unlock_device, wrap_device (d)); | |
| 428 | 1366 |
| 771 | 1367 /* [[There's no real reason to bother doing unwind-protects, because if |
| 428 | 1368 initialize-*-faces signals an error, emacs is going to crash |
| 771 | 1369 immediately.]] But this sucks! This code is called not only during |
| 1370 the initial device, but for other devices as well! #### When dealing | |
| 1371 with non-initial devices, we should signal an error but NOT kill | |
| 1372 ourselves! --ben | |
| 428 | 1373 */ |
| 1374 LOCK_DEVICE (d); | |
| 1375 | |
| 853 | 1376 args[0] = Qreally_early_error_handler; |
| 1377 args[1] = function; | |
| 1378 args[2] = object; | |
| 1379 | |
| 1380 GCPRO1_ARRAY (args, 3); | |
| 1381 | |
| 1382 /* It's useful to have an error handler; otherwise an infinite | |
| 428 | 1383 loop may result. */ |
| 872 | 1384 retval = Fcall_with_condition_handler (!NILP (object) ? 3 : 2, args); |
| 853 | 1385 |
| 1386 UNGCPRO; | |
| 428 | 1387 |
| 872 | 1388 return unbind_to_1 (count, retval); |
| 428 | 1389 } |
| 1390 | |
| 1391 | |
| 1392 /************************************************************************/ | |
| 1393 /* initialization */ | |
| 1394 /************************************************************************/ | |
| 1395 | |
| 1396 void | |
| 1397 syms_of_device (void) | |
| 1398 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1399 INIT_LISP_OBJECT (device); |
| 442 | 1400 |
| 428 | 1401 DEFSUBR (Fvalid_device_class_p); |
| 1402 DEFSUBR (Fdevice_class_list); | |
| 1403 | |
| 1404 DEFSUBR (Fdfw_device); | |
| 1405 DEFSUBR (Fselected_device); | |
| 1406 DEFSUBR (Fselect_device); | |
| 1407 DEFSUBR (Fset_device_selected_frame); | |
| 1408 DEFSUBR (Fdevicep); | |
| 1409 DEFSUBR (Fdevice_live_p); | |
| 1410 DEFSUBR (Fdevice_name); | |
| 1411 DEFSUBR (Fdevice_connection); | |
| 1412 DEFSUBR (Fdevice_console); | |
| 1413 DEFSUBR (Ffind_device); | |
| 1414 DEFSUBR (Fget_device); | |
| 1415 DEFSUBR (Fmake_device); | |
| 872 | 1416 DEFSUBR (Fdefault_device); |
| 428 | 1417 DEFSUBR (Fdelete_device); |
| 1418 DEFSUBR (Fdevice_frame_list); | |
| 1419 DEFSUBR (Fdevice_class); | |
| 1420 DEFSUBR (Fset_device_class); | |
| 1421 DEFSUBR (Fdevice_system_metrics); | |
| 1422 DEFSUBR (Fdevice_system_metric); | |
| 1423 DEFSUBR (Fset_device_baud_rate); | |
| 1424 DEFSUBR (Fdevice_baud_rate); | |
| 1425 DEFSUBR (Fdomain_device_type); | |
| 440 | 1426 DEFSUBR (Fdevice_printer_p); |
| 428 | 1427 |
| 563 | 1428 DEFSYMBOL (Qdevicep); |
| 1429 DEFSYMBOL (Qdevice_live_p); | |
| 428 | 1430 |
| 563 | 1431 DEFSYMBOL (Qcreate_device_hook); |
| 1432 DEFSYMBOL (Qdelete_device_hook); | |
| 428 | 1433 |
| 1434 /* Qcolor defined in general.c */ | |
| 563 | 1435 DEFSYMBOL (Qgrayscale); |
| 1436 DEFSYMBOL (Qmono); | |
| 428 | 1437 |
| 1438 /* Device metrics symbols */ | |
| 1942 | 1439 DEFSYMBOL (Qbacking_store); |
| 563 | 1440 DEFSYMBOL (Qcolor_default); |
| 1441 DEFSYMBOL (Qcolor_select); | |
| 1442 DEFSYMBOL (Qcolor_balloon); | |
| 1443 DEFSYMBOL (Qcolor_3d_face); | |
| 1444 DEFSYMBOL (Qcolor_3d_light); | |
| 1445 DEFSYMBOL (Qcolor_3d_dark); | |
| 1446 DEFSYMBOL (Qcolor_menu); | |
| 1447 DEFSYMBOL (Qcolor_menu_highlight); | |
| 1448 DEFSYMBOL (Qcolor_menu_button); | |
| 1449 DEFSYMBOL (Qcolor_menu_disabled); | |
| 1450 DEFSYMBOL (Qcolor_toolbar); | |
| 1451 DEFSYMBOL (Qcolor_scrollbar); | |
| 1452 DEFSYMBOL (Qcolor_desktop); | |
| 1453 DEFSYMBOL (Qcolor_workspace); | |
| 1454 DEFSYMBOL (Qfont_default); | |
| 1455 DEFSYMBOL (Qfont_menubar); | |
| 1456 DEFSYMBOL (Qfont_dialog); | |
| 1457 DEFSYMBOL (Qsize_cursor); | |
| 1458 DEFSYMBOL (Qsize_scrollbar); | |
| 1459 DEFSYMBOL (Qsize_menu); | |
| 1460 DEFSYMBOL (Qsize_toolbar); | |
| 1461 DEFSYMBOL (Qsize_toolbar_button); | |
| 1462 DEFSYMBOL (Qsize_toolbar_border); | |
| 1463 DEFSYMBOL (Qsize_icon); | |
| 1464 DEFSYMBOL (Qsize_icon_small); | |
| 1465 DEFSYMBOL (Qsize_device); | |
| 1466 DEFSYMBOL (Qsize_workspace); | |
| 1467 DEFSYMBOL (Qoffset_workspace); | |
| 1468 DEFSYMBOL (Qsize_device_mm); | |
| 1469 DEFSYMBOL (Qnum_bit_planes); | |
| 1470 DEFSYMBOL (Qnum_color_cells); | |
| 1942 | 1471 DEFSYMBOL (Qnum_screens); |
| 563 | 1472 DEFSYMBOL (Qdevice_dpi); |
| 1473 DEFSYMBOL (Qmouse_buttons); | |
| 1942 | 1474 DEFSYMBOL (Qsave_under); |
| 563 | 1475 DEFSYMBOL (Qswap_buttons); |
| 1476 DEFSYMBOL (Qshow_sounds); | |
| 1477 DEFSYMBOL (Qslow_device); | |
| 1478 DEFSYMBOL (Qsecurity); | |
| 428 | 1479 } |
| 1480 | |
| 1481 void | |
| 1482 reinit_vars_of_device (void) | |
| 1483 { | |
| 1484 staticpro_nodump (&Vdefault_device); | |
| 1485 Vdefault_device = Qnil; | |
| 1486 asynch_device_change_pending = 0; | |
| 1487 } | |
| 1488 | |
| 1489 void | |
| 1490 vars_of_device (void) | |
| 1491 { | |
| 1492 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /* | |
| 1493 Function or functions to call when a device is created. | |
| 1494 One argument, the newly-created device. | |
| 1495 This is called after the first frame has been created, but before | |
| 1496 calling the `create-frame-hook'. | |
| 1497 Note that in general the device will not be selected. | |
| 1498 */ ); | |
| 1499 Vcreate_device_hook = Qnil; | |
| 1500 | |
| 1501 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /* | |
| 1502 Function or functions to call when a device is deleted. | |
| 1503 One argument, the to-be-deleted device. | |
| 1504 */ ); | |
| 1505 Vdelete_device_hook = Qnil; | |
| 1506 | |
| 872 | 1507 /* Plist of device types and their default devices. */ |
| 1508 Vdefault_device_plist = Qnil; | |
| 1509 staticpro (&Vdefault_device_plist); | |
| 1510 | |
| 428 | 1511 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono); |
| 1512 staticpro (&Vdevice_class_list); | |
| 1513 | |
| 1514 /* Death to devices.el !!! */ | |
| 617 | 1515 Fprovide (intern ("devices")); |
| 428 | 1516 } |