Mercurial > hg > xemacs-beta
annotate lisp/x-win-sun.el @ 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 | e3ef34f57070 |
| children | 91b3aa59f49b |
| rev | line source |
|---|---|
| 428 | 1 ;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards |
| 2 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. | |
| 3 | |
| 4 ;; Authors: jwz, ben, martin | |
| 5 ;; Keywords: terminals | |
| 6 | |
| 7 ;; This file is part of XEmacs. | |
| 8 | |
| 9 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 10 ;; under the terms of the GNU General Public License as published by | |
| 11 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 12 ;; any later version. | |
| 13 | |
| 14 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 17 ;; General Public License for more details. | |
| 18 | |
| 19 ;; You should have received a copy of the GNU General Public License | |
| 20 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 ;; Boston, MA 02111-1307, USA. | |
| 23 | |
| 24 ;;; Commentary: | |
| 25 | |
| 26 ;; This file is loaded by x-win.el at run-time when we are sure that XEmacs | |
| 27 ;; is running on the display of a Sun. | |
| 28 | |
| 29 ;; The Sun X server (both the MIT and OpenWindows varieties) have extremely | |
| 30 ;; stupid names for their keypad and function keys. For example, the key | |
| 31 ;; labeled 3 / PgDn, with R15 written on the front, is actually called F35. | |
| 32 | |
| 33 ;; There are 3 methods of dealing with the Sun key brokenness: | |
| 34 ;; | |
| 35 ;; - Use xmodmap to give all keys more sensible names for all apps: | |
| 36 ;; I use this shell script: | |
| 37 ;; | |
| 38 ;; for i in 0 1 2 3 4 5 6 7 8 9 Add Subtract Multiply Divide Decimal ; do | |
| 39 ;; echo "keysym KP-$i = KP-$i" | |
| 40 ;; done | xmodmap | |
| 41 ;; | |
| 42 ;; Clearly, as a good X11 citizen, we can't do this. | |
| 43 ;; | |
| 44 ;; - Use keyboard-translate-table to remap the keybindings at a low level. | |
| 45 ;; This approach is taken in the function `sun-x11-keyboard-translate'. | |
| 46 ;; This is like running xmodmap within XEmacs only. | |
| 47 ;; This is not the default, however, so that legacy keybindings in users' | |
| 48 ;; .emacs files like (global-set-key [(f35)] 'foo) continue to work | |
| 49 ;; | |
| 50 ;; - Use keyboard macros to provide indirection for keybindings. | |
| 51 ;; If we do (global-set-key [(f35)] [(kp-3)]), then the user's keybindings | |
| 52 ;; work whether he uses `f35' or `kp-3'. | |
| 53 ;; This is also compatible with FSF Emacs and other X11 apps. | |
| 54 ;; Although this has the disadvantage that these remappings | |
| 55 ;; only work with the global key map, we use this as the default. | |
| 56 ;; | |
| 57 ;; - The Right Way to do this remains to be written... | |
| 58 | |
| 59 ;; OK, here's another try at doing things the right way. | |
| 60 | |
| 61 ;; We use function-key-map, which honors explicit key-bindings for the | |
| 62 ;; stupid Sun names, but also allows indirection if no explicit | |
| 63 ;; key-binding exists. | |
| 64 | |
| 65 ;;; Code: | |
| 66 | |
| 502 | 67 (globally-declare-fboundp |
| 68 '(x-keysym-on-keyboard-sans-modifiers-p)) | |
| 69 | |
| 428 | 70 ;;;###autoload |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
71 (defun x-win-init-sun (device) |
| 428 | 72 |
| 73 ;; help is ok | |
| 74 ;; num_lock is ok | |
| 75 ;; up is ok | |
| 76 ;; left is ok | |
| 77 ;; right is ok | |
| 78 ;; kp-add is ok | |
| 79 ;; down is ok | |
| 80 ;; insert is ok | |
| 81 ;; delete is ok | |
| 82 ;; kp-enter is ok | |
| 83 ;; Sun Function keys | |
| 84 (loop for (from-key to-key) in | |
| 85 `((f21 pause) | |
| 86 (f22 print) | |
| 87 (f23 scroll_lock) | |
| 88 | |
| 89 ;; X11 R6 mappings | |
| 90 (SunProps props) | |
| 91 (SunFront front) | |
| 92 (SunOpen open) | |
| 93 (SunFind find) | |
| 94 (cancel stop) | |
| 95 (Undo undo) | |
| 96 (SunCopy copy) | |
| 97 (SunPaste paste) | |
| 98 (SunCut cut) | |
| 99 | |
| 100 (f13 props) | |
| 101 (f14 undo) | |
| 102 (f15 front) | |
| 103 (f16 copy) | |
| 104 (f17 open) | |
| 105 (f18 paste) | |
| 106 (f19 find) | |
| 107 (f20 cut) | |
| 108 | |
| 109 (f25 kp-divide) | |
| 110 (f26 kp-multiply) | |
| 111 (f31 kp-5) | |
| 112 | |
| 113 ;; Map f33 and r13 to end or kp-end | |
| 114 ,@(cond | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
115 ((not (x-keysym-on-keyboard-sans-modifiers-p 'end device)) |
| 428 | 116 '((f33 end) |
| 117 (r13 end))) | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
118 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end device)) |
| 428 | 119 '((f33 kp-end) |
| 120 (r13 kp-end)))) | |
| 121 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
122 ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f36 device) |
| 428 | 123 '((f36 stop) |
| 124 (f37 again))) | |
| 125 | |
| 126 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' | |
| 127 ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
128 ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f24 device) |
|
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
129 `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract device) |
| 428 | 130 'kp-equal |
| 131 'kp-subtract)))) | |
| 132 | |
| 133 ;; Map f27 to home or kp-home, as appropriate | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
134 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home device)) |
| 428 | 135 '((f27 home))) |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
136 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home device)) |
| 428 | 137 '((f27 kp-home)))) |
| 138 | |
| 139 ;; Map f29 to prior or kp-prior, as appropriate | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
140 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior device)) |
| 428 | 141 '((f29 prior))) |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
142 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior device)) |
| 428 | 143 '((f29 kp-prior)))) |
| 144 | |
| 145 ;; Map f35 to next or kp-next, as appropriate | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
146 ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next device)) |
| 428 | 147 '((f35 next))) |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
148 ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next device)) |
| 428 | 149 '((f35 kp-next)))) |
| 150 | |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
151 ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead device) ; SunOS 4.1.1 |
| 428 | 152 '((apRead f11) (apEdit f12))) |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
153 ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36 device) ; SunOS 5 |
| 428 | 154 '((SunF36 f11) |
| 155 (SunF37 f12) | |
| 156 (f11 stop) | |
| 157 (f12 again)))) | |
| 158 ) | |
|
4482
e3ef34f57070
Bind function-key-map correctly in device-specific startup code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4477
diff
changeset
|
159 ;; Get the correct value for function-key-map |
|
e3ef34f57070
Bind function-key-map correctly in device-specific startup code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4477
diff
changeset
|
160 with function-key-map = (symbol-value-in-console 'function-key-map |
|
e3ef34f57070
Bind function-key-map correctly in device-specific startup code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4477
diff
changeset
|
161 (device-console device) |
|
e3ef34f57070
Bind function-key-map correctly in device-specific startup code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4477
diff
changeset
|
162 function-key-map) |
|
4477
e34711681f30
Don't determine whether to call general device-type code at startup,
Aidan Kehoe <kehoea@parhasard.net>
parents:
3171
diff
changeset
|
163 do (when (x-keysym-on-keyboard-sans-modifiers-p from-key device) |
| 428 | 164 (dolist (prefix '(() (shift) (control) (meta) (alt) |
| 165 (shift control) (shift alt) (shift meta) | |
| 166 (control alt) (control meta) (alt meta) | |
| 167 (shift control alt) (shift control meta) | |
| 168 (shift alt meta) (control alt meta) | |
| 169 (shift control alt meta))) | |
| 170 (define-key function-key-map | |
| 171 (append prefix (list from-key)) | |
| 172 (vector (append prefix (list to-key))))))) | |
| 173 | |
| 174 ;; for each element in the left column of the above table, alias it | |
| 175 ;; to the thing in the right column. Then do the same for many, but | |
| 176 ;; not all, modifier combinations. | |
| 177 ;; | |
| 178 ;; (Well, we omit hyper and super. #### Handle this some other way!) | |
| 179 ;; (while mapping | |
| 180 ;; (let ((mods '(() (shift) (control) (meta) (alt)))) | |
| 181 ;; (while mods | |
| 182 ;; (let ((k1 (vector (append (car mods) (list (car (car mapping)))))) | |
| 183 ;; (k2 (vector (append (car mods) (list (cdr (car mapping))))))) | |
| 184 ;; (define-key global-map k1 k2)) | |
| 185 ;; (setq mods (cdr mods)))) | |
| 186 ;; (setq mapping (cdr mapping)))) | |
| 187 | |
| 188 ;;; I've extended keyboard-translate-table to work over keysyms. | |
| 189 ;;; [FSF Emacs has something called `system-key-alist' that is | |
| 190 ;;; supposed to accomplish approximately the same thing. Unfortunately, | |
| 191 ;;; it's brain-dead in the typically FSF way, and associates *numbers* | |
| 192 ;;; (who knows where the hell they come from?) with symbols.] --ben | |
| 193 | |
| 194 ;;; And I've made it into a function which is NOT called by default --martin | |
| 195 | |
| 196 (defun sun-x11-keyboard-translate () | |
| 197 "Remap Sun's X11 keyboard. | |
| 198 Keys with names like `f35' are remapped, at a low level, | |
| 199 to more mnemonic ones,like `kp-3'." | |
| 200 (interactive) | |
| 201 | |
| 202 (keyboard-translate | |
| 203 'f11 'stop ; the type4 keyboard Sun/MIT name | |
| 204 'f36 'stop ; the type5 keyboard Sun name | |
| 205 'cancel 'stop ; R6 binding | |
| 206 'f12 'again ; the type4 keyboard Sun/MIT name | |
| 207 'f37 'again ; the type5 keyboard Sun name | |
| 208 'f13 'props ; | |
| 209 'SunProps 'props ; R6 binding | |
| 210 'f14 'undo ; | |
| 211 'f15 'front ; | |
| 212 'SunFront 'front ; R6 binding | |
| 213 'f16 'copy ; | |
| 214 'SunCopy 'copy ; R6 binding | |
| 215 'f17 'open ; | |
| 216 'SunOpen 'open ; R6 binding | |
| 217 'f18 'paste ; | |
| 218 'SunPaste 'paste ; R6 binding | |
| 219 'f19 'find ; | |
| 220 'f20 'cut ; | |
| 221 'SunCut 'cut ; R6 binding | |
| 222 ;; help is ok | |
| 223 'f21 'pause | |
| 224 'f22 'prsc | |
| 225 'f23 'scroll | |
| 226 ;; num_lock is ok | |
| 227 ;;'f24 'kp-equal) ; type4 only! | |
| 228 'f25 'kp-divide ; | |
| 229 'f26 'kp-multiply ; | |
| 230 'f24 'kp-subtract ; type5 only! | |
| 231 'f27 'kp-7 ; | |
| 232 ;; up is ok | |
| 233 'f29 'kp-9 | |
| 234 ;; left is ok | |
| 235 'f31 'kp-5 | |
| 236 ;; right is ok | |
| 237 ;; kp-add is ok | |
| 238 'f33 'kp-1 ; the Sun name | |
| 239 'r13 'end ; the MIT name | |
| 240 ;; down is ok | |
| 241 'f35 'kp-3 | |
| 242 ;; insert is ok | |
| 243 ;; delete is ok | |
| 244 ;; kp-enter is ok | |
| 245 'SunF36 'f11 ; Type 5 keyboards | |
| 246 'SunF37 'f12 ; Used to be Stop & Again | |
| 247 )) | |
| 248 | |
| 3171 | 249 ;; Initialise the information needed for processing of function keys on |
| 250 ;; keyboards without Roman-alpabet characters available. This keyboard | |
| 251 ;; description was taken from gkb-new/xmodmap.sun/xmodmap.us in the | |
| 252 ;; gnome-applets 2.12.0 distribution. | |
| 253 (setq x-us-keymap-first-keycode 37 | |
| 254 x-us-keymap-description | |
| 255 [[?1 ?!] [?2 ?@] [?3 ?\#] [?4 ?$] [?5 ?%] [?6 ?^] [?7 ?&] [?8 ?*] | |
| 256 [?9 ?\(] [?0 ?\)] [?- ?_] [?= ?+] [?\` ?~] nil nil nil ?/ ?* nil | |
| 257 nil ?\. nil nil ?\t [?q ?Q] [?w ?W] [?e ?E] [?r ?R] [?t ?T] [?y ?Y] | |
| 258 [?u ?U] [?i ?I] [?o ?O] [?p ?P] [?\[ ?{] [?\] ?}] nil nil ?7 ?8 ?9 | |
| 259 ?- nil nil nil nil nil [?a ?A] [?s ?S] [?d ?D] [?f ?F] [?g ?G] | |
| 260 [?h ?H] [?j ?J] [?k ?K] [?l ?L] [?\; ?:] [?\' ?\"] [?\\ ?|] nil nil | |
| 261 ?4 ?5 ?6 ?0 nil nil nil nil nil [?z ?Z] [?x ?X] [?c ?C] [?v ?V] | |
| 262 [?b ?B] [?n ?N] [?m ?M] [?\, ?<] [?\. ?>] [?/ ?\?] nil nil ?1 ?2 | |
| 263 ?3 nil nil nil nil nil nil ?\ nil nil nil ?+]) | |
| 428 | 264 |
| 265 ;;; OpenWindows-like "find" processing. | |
| 266 ;;; As far as I know, the `find' key is a Sunism, so we do that binding | |
| 267 ;;; here. This is the only Sun-specific keybinding. (The functions | |
| 268 ;;; themselves are in x-win.el in case someone wants to use them when | |
| 269 ;;; not running on a Sun display.) | |
| 270 | |
| 271 (or (lookup-key global-map 'find) | |
| 272 (define-key global-map 'find 'ow-find)) | |
| 273 (or (lookup-key global-map '(shift find)) | |
| 274 (define-key global-map '(shift find) 'ow-find-backward)) | |
| 275 | |
| 276 ) | |
| 277 | |
| 278 ;;; x-win-sun.el ends here |