comparison lisp/x11/x-win-xfree86.el @ 187:b405438285a2 r20-3b20

Import from CVS: tag r20-3b20
author cvs
date Mon, 13 Aug 2007 09:56:28 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
186:24ac94803b48 187:b405438285a2
1 ;;; x-win-xfree86.el --- runtime initialization for XFree86 servers 1 ;;; x-win-xfree86.el --- runtime initialization for XFree86 servers
2 ;; Copyright (C) 1995 Sun Microsystems, Inc. 2 ;; Copyright (C) 1995 Sun Microsystems, Inc.
3 ;; Copyright (C) 1995 Ben Wing. 3 ;; Copyright (C) 1995 Ben Wing.
4 4
5 ;; Author: Ben Wing 5 ;; Author: Ben Wing
6 ;; Author: Martin Buchholz (rewritten to use function-key-map)
6 ;; Keywords: terminals 7 ;; Keywords: terminals
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
9 10
10 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 19 ;; General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 22 ;; along with XEmacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
28 ;; is running on the display of something running XFree86 (Linux, 29 ;; is running on the display of something running XFree86 (Linux,
29 ;; NetBSD, FreeBSD, and perhaps other Intel Unixen). 30 ;; NetBSD, FreeBSD, and perhaps other Intel Unixen).
30 31
31 ;;; #### bleck!!! Use key-translation-map! 32 ;;; #### bleck!!! Use key-translation-map!
32 33
34 ;;; #### Counter-bleck!! We shouldn't override a user binding for F13.
35 ;;; So we use function-key-map for now.
36 ;;; When we've implemented a fallback-style equivalent of
37 ;;; keyboard-translate-table, we'll use that instead. (mrb)
38
33 ;; For no obvious reason, shift-F1 is called F13, although Meta-F1 and 39 ;; For no obvious reason, shift-F1 is called F13, although Meta-F1 and
34 ;; Control-F1 have normal names. 40 ;; Control-F1 have normal names.
35 41
36 (let ((mapping '((f13 . (shift f1)) 42 (loop for (x-key key sane-key) in
37 (f14 . (shift f2)) 43 '(("F13" f13 f1)
38 (f15 . (shift f3)) 44 ("F14" f14 f2)
39 (f16 . (shift f4)) 45 ("F15" f15 f3)
40 (f17 . (shift f5)) 46 ("F16" f16 f4)
41 (f18 . (shift f6)) 47 ("F17" f17 f5)
42 (f19 . (shift f7)) 48 ("F18" f18 f6)
43 (f20 . (shift f8)) 49 ("F19" f19 f7)
44 (f21 . (shift f9)) 50 ("F20" f20 f8)
45 (f22 . (shift f10)) 51 ("F21" f21 f9)
46 (f23 . (shift f11)) 52 ("F22" f22 f10)
47 (f24 . (shift f12))))) 53 ("F23" f23 f11)
54 ("F24" f24 f12))
55 do
56 (when (and (x-keysym-on-keyboard-p x-key)
57 (not (x-keysym-on-keyboard-sans-modifiers-p x-key)))
58 ;; define also the control, meta, and meta-control versions.
59 (loop for mods in '(() (control) (meta) (meta control)) do
60 (define-key function-key-map `[(,@mods ,key)] `[(shift ,@mods ,sane-key)])
61 )))
48 62
49 ;; now define them and also the control, meta, and meta-control versions. 63 ;; (let ((mapping '((f13 . (shift f1))
50 (while mapping 64 ;; (f14 . (shift f2))
51 (let* ((foo (caar mapping)) 65 ;; (f15 . (shift f3))
52 (bar (cdar mapping)) 66 ;; (f16 . (shift f4))
53 (foo (if (listp foo) foo (list foo))) 67 ;; (f17 . (shift f5))
54 (bar (if (listp bar) bar (list bar)))) 68 ;; (f18 . (shift f6))
55 (let ((mods '(() (control) (meta) (meta control)))) 69 ;; (f19 . (shift f7))
56 (while mods 70 ;; (f20 . (shift f8))
57 (let ((k1 (vector (append (car mods) foo))) 71 ;; (f21 . (shift f9))
58 (k2 (vector (append (car mods) bar)))) 72 ;; (f22 . (shift f10))
59 (define-key global-map k1 k2)) 73 ;; (f23 . (shift f11))
60 (setq mods (cdr mods)))) 74 ;; (f24 . (shift f12)))))
61 (setq mapping (cdr mapping))))) 75 ;;
76 ;; ;; now define them and also the control, meta, and meta-control versions.
77 ;; (while mapping
78 ;; (let* ((foo (caar mapping))
79 ;; (bar (cdar mapping))
80 ;; (foo (if (listp foo) foo (list foo)))
81 ;; (bar (if (listp bar) bar (list bar))))
82 ;; (let ((mods '(() (control) (meta) (meta control))))
83 ;; (while mods
84 ;; (let ((k1 (vector (append (car mods) foo)))
85 ;; (k2 (vector (append (car mods) bar))))
86 ;; (define-key global-map k1 k2))
87 ;; (setq mods (cdr mods))))
88 ;; (setq mapping (cdr mapping)))))