annotate lisp/x-win-sun.el @ 4906:6ef8256a020a

implement equalp in C, fix case-folding, add equal() method for keymaps -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * cl-extra.el: * cl-extra.el (cl-string-vector-equalp): Removed. * cl-extra.el (cl-bit-vector-vector-equalp): Removed. * cl-extra.el (cl-vector-array-equalp): Removed. * cl-extra.el (cl-hash-table-contents-equalp): Removed. * cl-extra.el (equalp): Removed. * cl-extra.el (cl-mapcar-many): Comment out the whole `equalp' implementation for the moment; remove once we're sure the C implementation works. * cl-macs.el: * cl-macs.el (equalp): Simplify the compiler-macro for `equalp' -- once it's in C, we don't need to try so hard to expand it. src/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * abbrev.c (abbrev_match_mapper): * buffer.h (CANON_TABLE_OF): * buffer.h: * editfns.c (Fchar_equal): * minibuf.c (scmp_1): * text.c (qxestrcasecmp_i18n): * text.c (qxestrncasecmp_i18n): * text.c (qxetextcasecmp): * text.c (qxetextcasecmp_matching): Create new macro CANONCASE that converts to a canonical mapping and use it to do caseless comparisons instead of DOWNCASE. * alloc.c: * alloc.c (cons_equal): * alloc.c (vector_equal): * alloc.c (string_equal): * bytecode.c (compiled_function_equal): * chartab.c (char_table_entry_equal): * chartab.c (char_table_equal): * data.c (weak_list_equal): * data.c (weak_box_equal): * data.c (ephemeron_equal): * device-msw.c (equal_devmode): * elhash.c (hash_table_equal): * events.c (event_equal): * extents.c (properties_equal): * extents.c (extent_equal): * faces.c: * faces.c (face_equal): * faces.c (face_hash): * floatfns.c (float_equal): * fns.c: * fns.c (bit_vector_equal): * fns.c (plists_differ): * fns.c (Fplists_eq): * fns.c (Fplists_equal): * fns.c (Flax_plists_eq): * fns.c (Flax_plists_equal): * fns.c (internal_equal): * fns.c (internal_equalp): * fns.c (internal_equal_0): * fns.c (syms_of_fns): * glyphs.c (image_instance_equal): * glyphs.c (glyph_equal): * glyphs.c (glyph_hash): * gui.c (gui_item_equal): * lisp.h: * lrecord.h (struct lrecord_implementation): * marker.c (marker_equal): * number.c (bignum_equal): * number.c (ratio_equal): * number.c (bigfloat_equal): * objects.c (color_instance_equal): * objects.c (font_instance_equal): * opaque.c (equal_opaque): * opaque.c (equal_opaque_ptr): * rangetab.c (range_table_equal): * specifier.c (specifier_equal): Add a `foldcase' param to the equal() method and use it to implement `equalp' comparisons. Also add to plists_differ(), although we don't currently use it here. Rewrite internal_equalp(). Implement cross-type vector comparisons. Don't implement our own handling of numeric promotion -- just use the `=' primitive. Add internal_equal_0(), which takes a `foldcase' param and calls either internal_equal() or internal_equalp(). * buffer.h: When given a 0 for buffer (which is the norm when functions don't have a specific buffer available), use the current buffer's table, not `standard-case-table'; otherwise the current settings are ignored. * casetab.c: * casetab.c (set_case_table): When handling old-style vectors of 256 in `set-case-table' don't overwrite the existing table! Instead create a new table and populate. * device-msw.c (sync_printer_with_devmode): * lisp.h: * text.c (lisp_strcasecmp_ascii): Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use lisp_strcasecmp_i18n for caseless comparisons in some places. * elhash.c: Delete unused lisp_string_hash and lisp_string_equal(). * events.h: * keymap-buttons.h: * keymap.h: * keymap.c (keymap_lookup_directly): * keymap.c (keymap_store): * keymap.c (FROB): * keymap.c (key_desc_list_to_event): * keymap.c (describe_map_mapper): * keymap.c (INCLUDE_BUTTON_ZERO): New file keymap-buttons.h; use to handle buttons 1-26 in place of duplicating code 26 times. * frame-gtk.c (allocate_gtk_frame_struct): * frame-msw.c (mswindows_init_frame_1): Fix some comments about internal_equal() in redisplay that don't apply any more. * keymap-slots.h: * keymap.c: New file keymap-slots.h. Use it to notate the slots in a keymap structure, similar to frameslots.h or coding-system-slots.h. * keymap.c (MARKED_SLOT): * keymap.c (keymap_equal): * keymap.c (keymap_hash): Implement. tests/ChangeLog addition: 2010-02-01 Ben Wing <ben@xemacs.org> * automated/case-tests.el: * automated/case-tests.el (uni-mappings): * automated/search-tests.el: Delete old pristine-case-table code. Rewrite the Unicode torture test to take into account whether overlapping mappings exist for more than one character, and not doing the upcase/downcase comparisons in such cases. * automated/lisp-tests.el (foo): * automated/lisp-tests.el (string-variable): * automated/lisp-tests.el (featurep): Replace Assert (equal ... with Assert-equal; same for other types of equality. Replace some awkward equivalents of Assert-equalp with Assert-equalp. Add lots of equalp tests. * automated/case-tests.el: * automated/regexp-tests.el: * automated/search-tests.el: Fix up the comments at the top of the files. Move rules about where to put tests into case-tests.el. * automated/test-harness.el: * automated/test-harness.el (test-harness-aborted-summary-template): New. * automated/test-harness.el (test-harness-from-buffer): * automated/test-harness.el (batch-test-emacs): Fix Assert-test-not. Create Assert-not-equal and variants. Delete the doc strings from all these convenience functions to avoid excessive repetition; instead use one copy in a comment.
author Ben Wing <ben@xemacs.org>
date Mon, 01 Feb 2010 01:02:40 -0600
parents e3ef34f57070
children 91b3aa59f49b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Authors: jwz, ben, martin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Keywords: terminals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; This file is loaded by x-win.el at run-time when we are sure that XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; is running on the display of a Sun.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; The Sun X server (both the MIT and OpenWindows varieties) have extremely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; stupid names for their keypad and function keys. For example, the key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; labeled 3 / PgDn, with R15 written on the front, is actually called F35.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; There are 3 methods of dealing with the Sun key brokenness:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; - Use xmodmap to give all keys more sensible names for all apps:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; I use this shell script:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; for i in 0 1 2 3 4 5 6 7 8 9 Add Subtract Multiply Divide Decimal ; do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; echo "keysym KP-$i = KP-$i"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; done | xmodmap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; Clearly, as a good X11 citizen, we can't do this.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; - Use keyboard-translate-table to remap the keybindings at a low level.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; This approach is taken in the function `sun-x11-keyboard-translate'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; This is like running xmodmap within XEmacs only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; This is not the default, however, so that legacy keybindings in users'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; .emacs files like (global-set-key [(f35)] 'foo) continue to work
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; - Use keyboard macros to provide indirection for keybindings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; If we do (global-set-key [(f35)] [(kp-3)]), then the user's keybindings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; work whether he uses `f35' or `kp-3'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; This is also compatible with FSF Emacs and other X11 apps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; Although this has the disadvantage that these remappings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; only work with the global key map, we use this as the default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; - The Right Way to do this remains to be written...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; OK, here's another try at doing things the right way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; We use function-key-map, which honors explicit key-bindings for the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; stupid Sun names, but also allows indirection if no explicit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; key-binding exists.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 428
diff changeset
67 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 428
diff changeset
68 '(x-keysym-on-keyboard-sans-modifiers-p))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 428
diff changeset
69
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; help is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; num_lock is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; up is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; left is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; right is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; kp-add is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; down is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; insert is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; delete is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; kp-enter is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; Sun Function keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (loop for (from-key to-key) in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 `((f21 pause)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (f22 print)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (f23 scroll_lock)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; X11 R6 mappings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (SunProps props)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (SunFront front)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (SunOpen open)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (SunFind find)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (cancel stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (Undo undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (SunCopy copy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (SunPaste paste)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (SunCut cut)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (f13 props)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (f14 undo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (f15 front)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (f16 copy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (f17 open)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (f18 paste)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (f19 find)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (f20 cut)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (f25 kp-divide)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (f26 kp-multiply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (f31 kp-5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 ;; Map f33 and r13 to end or kp-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 '((f33 end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 '((f33 kp-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (r13 kp-end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 '((f36 stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (f37 again)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `='
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 'kp-equal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 'kp-subtract))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 '((f27 kp-home))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 ;; 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 '((f29 kp-prior))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 ;; 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 '((f35 kp-next))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 '((SunF36 f11)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (SunF37 f12)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (f11 stop)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (f12 again))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (dolist (prefix '(() (shift) (control) (meta) (alt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (shift control) (shift alt) (shift meta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (control alt) (control meta) (alt meta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (shift control alt) (shift control meta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (shift alt meta) (control alt meta)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (shift control alt meta)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (define-key function-key-map
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (append prefix (list from-key))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (vector (append prefix (list to-key)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 ;; for each element in the left column of the above table, alias it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 ;; to the thing in the right column. Then do the same for many, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 ;; not all, modifier combinations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 ;; (Well, we omit hyper and super. #### Handle this some other way!)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 ;; (while mapping
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 ;; (let ((mods '(() (shift) (control) (meta) (alt))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 ;; (while mods
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 ;; (let ((k1 (vector (append (car mods) (list (car (car mapping))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ;; (k2 (vector (append (car mods) (list (cdr (car mapping)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 ;; (define-key global-map k1 k2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 ;; (setq mods (cdr mods))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ;; (setq mapping (cdr mapping))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ;;; I've extended keyboard-translate-table to work over keysyms.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 ;;; [FSF Emacs has something called `system-key-alist' that is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 ;;; supposed to accomplish approximately the same thing. Unfortunately,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 ;;; it's brain-dead in the typically FSF way, and associates *numbers*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 ;;; (who knows where the hell they come from?) with symbols.] --ben
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ;;; And I've made it into a function which is NOT called by default --martin
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (defun sun-x11-keyboard-translate ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 "Remap Sun's X11 keyboard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Keys with names like `f35' are remapped, at a low level,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 to more mnemonic ones,like `kp-3'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (keyboard-translate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 'f11 'stop ; the type4 keyboard Sun/MIT name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 'f36 'stop ; the type5 keyboard Sun name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 'cancel 'stop ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 'f12 'again ; the type4 keyboard Sun/MIT name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 'f37 'again ; the type5 keyboard Sun name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 'f13 'props ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 'SunProps 'props ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 'f14 'undo ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 'f15 'front ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 'SunFront 'front ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 'f16 'copy ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 'SunCopy 'copy ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 'f17 'open ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 'SunOpen 'open ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 'f18 'paste ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 'SunPaste 'paste ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 'f19 'find ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 'f20 'cut ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 'SunCut 'cut ; R6 binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 ;; help is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 'f21 'pause
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 'f22 'prsc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 'f23 'scroll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 ;; num_lock is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 ;;'f24 'kp-equal) ; type4 only!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 'f25 'kp-divide ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 'f26 'kp-multiply ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 'f24 'kp-subtract ; type5 only!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 'f27 'kp-7 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 ;; up is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 'f29 'kp-9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 ;; left is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 'f31 'kp-5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 ;; right is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 ;; kp-add is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 'f33 'kp-1 ; the Sun name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 'r13 'end ; the MIT name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 ;; down is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 'f35 'kp-3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 ;; insert is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ;; delete is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 ;; kp-enter is ok
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 'SunF36 'f11 ; Type 5 keyboards
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 'SunF37 'f12 ; Used to be Stop & Again
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3171
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
249 ;; Initialise the information needed for processing of function keys on
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
250 ;; keyboards without Roman-alpabet characters available. This keyboard
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
251 ;; description was taken from gkb-new/xmodmap.sun/xmodmap.us in the
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
252 ;; gnome-applets 2.12.0 distribution.
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
253 (setq x-us-keymap-first-keycode 37
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
254 x-us-keymap-description
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
255 [[?1 ?!] [?2 ?@] [?3 ?\#] [?4 ?$] [?5 ?%] [?6 ?^] [?7 ?&] [?8 ?*]
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
256 [?9 ?\(] [?0 ?\)] [?- ?_] [?= ?+] [?\` ?~] nil nil nil ?/ ?* nil
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
257 nil ?\. nil nil ?\t [?q ?Q] [?w ?W] [?e ?E] [?r ?R] [?t ?T] [?y ?Y]
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
258 [?u ?U] [?i ?I] [?o ?O] [?p ?P] [?\[ ?{] [?\] ?}] nil nil ?7 ?8 ?9
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
259 ?- nil nil nil nil nil [?a ?A] [?s ?S] [?d ?D] [?f ?F] [?g ?G]
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
260 [?h ?H] [?j ?J] [?k ?K] [?l ?L] [?\; ?:] [?\' ?\"] [?\\ ?|] nil nil
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
261 ?4 ?5 ?6 ?0 nil nil nil nil nil [?z ?Z] [?x ?X] [?c ?C] [?v ?V]
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
262 [?b ?B] [?n ?N] [?m ?M] [?\, ?<] [?\. ?>] [?/ ?\?] nil nil ?1 ?2
4cad7ff4a200 [xemacs-hg @ 2005-12-24 19:53:53 by aidan]
aidan
parents: 502
diff changeset
263 ?3 nil nil nil nil nil nil ?\ nil nil nil ?+])
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 ;;; OpenWindows-like "find" processing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 ;;; As far as I know, the `find' key is a Sunism, so we do that binding
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 ;;; here. This is the only Sun-specific keybinding. (The functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 ;;; themselves are in x-win.el in case someone wants to use them when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 ;;; not running on a Sun display.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (or (lookup-key global-map 'find)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (define-key global-map 'find 'ow-find))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (or (lookup-key global-map '(shift find))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (define-key global-map '(shift find) 'ow-find-backward))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 ;;; x-win-sun.el ends here