Mercurial > hg > xemacs-beta
diff lisp/x-win-sun.el @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:28:15 +0200 |
parents | |
children | 7039e6323819 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/x-win-sun.el Mon Aug 13 11:28:15 2007 +0200 @@ -0,0 +1,256 @@ +;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards +;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. + +;; Authors: jwz, ben, martin +;; Keywords: terminals + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file is loaded by x-win.el at run-time when we are sure that XEmacs +;; is running on the display of a Sun. + +;; The Sun X server (both the MIT and OpenWindows varieties) have extremely +;; stupid names for their keypad and function keys. For example, the key +;; labeled 3 / PgDn, with R15 written on the front, is actually called F35. + +;; There are 3 methods of dealing with the Sun key brokenness: +;; +;; - Use xmodmap to give all keys more sensible names for all apps: +;; I use this shell script: +;; +;; for i in 0 1 2 3 4 5 6 7 8 9 Add Subtract Multiply Divide Decimal ; do +;; echo "keysym KP-$i = KP-$i" +;; done | xmodmap +;; +;; Clearly, as a good X11 citizen, we can't do this. +;; +;; - Use keyboard-translate-table to remap the keybindings at a low level. +;; This approach is taken in the function `sun-x11-keyboard-translate'. +;; This is like running xmodmap within XEmacs only. +;; This is not the default, however, so that legacy keybindings in users' +;; .emacs files like (global-set-key [(f35)] 'foo) continue to work +;; +;; - Use keyboard macros to provide indirection for keybindings. +;; If we do (global-set-key [(f35)] [(kp-3)]), then the user's keybindings +;; work whether he uses `f35' or `kp-3'. +;; This is also compatible with FSF Emacs and other X11 apps. +;; Although this has the disadvantage that these remappings +;; only work with the global key map, we use this as the default. +;; +;; - The Right Way to do this remains to be written... + +;; OK, here's another try at doing things the right way. + +;; We use function-key-map, which honors explicit key-bindings for the +;; stupid Sun names, but also allows indirection if no explicit +;; key-binding exists. + +;;; Code: + +;;;###autoload +(defun x-win-init-sun () + + ;; help is ok + ;; num_lock is ok + ;; up is ok + ;; left is ok + ;; right is ok + ;; kp-add is ok + ;; down is ok + ;; insert is ok + ;; delete is ok + ;; kp-enter is ok + ;; Sun Function keys + (loop for (from-key to-key) in + `((f21 pause) + (f22 print) + (f23 scroll_lock) + + ;; X11 R6 mappings + (SunProps props) + (SunFront front) + (SunOpen open) + (SunFind find) + (cancel stop) + (Undo undo) + (SunCopy copy) + (SunPaste paste) + (SunCut cut) + + (f13 props) + (f14 undo) + (f15 front) + (f16 copy) + (f17 open) + (f18 paste) + (f19 find) + (f20 cut) + + (f25 kp-divide) + (f26 kp-multiply) + (f31 kp-5) + + ;; Map f33 and r13 to end or kp-end + ,@(cond + ((not (x-keysym-on-keyboard-sans-modifiers-p 'end)) + '((f33 end) + (r13 end))) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end)) + '((f33 kp-end) + (r13 kp-end)))) + + ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f36) + '((f36 stop) + (f37 again))) + + ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' + ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' + ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f24) + `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract) + 'kp-equal + 'kp-subtract)))) + + ;; Map f27 to home or kp-home, as appropriate + ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home)) + '((f27 home))) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home)) + '((f27 kp-home)))) + + ;; Map f29 to prior or kp-prior, as appropriate + ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior)) + '((f29 prior))) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior)) + '((f29 kp-prior)))) + + ;; Map f35 to next or kp-next, as appropriate + ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next)) + '((f35 next))) + ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next)) + '((f35 kp-next)))) + + ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead) ; SunOS 4.1.1 + '((apRead f11) (apEdit f12))) + ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36) ; SunOS 5 + '((SunF36 f11) + (SunF37 f12) + (f11 stop) + (f12 again)))) + ) + do (when (x-keysym-on-keyboard-sans-modifiers-p from-key) + (dolist (prefix '(() (shift) (control) (meta) (alt) + (shift control) (shift alt) (shift meta) + (control alt) (control meta) (alt meta) + (shift control alt) (shift control meta) + (shift alt meta) (control alt meta) + (shift control alt meta))) + (define-key function-key-map + (append prefix (list from-key)) + (vector (append prefix (list to-key))))))) + + ;; for each element in the left column of the above table, alias it + ;; to the thing in the right column. Then do the same for many, but + ;; not all, modifier combinations. + ;; + ;; (Well, we omit hyper and super. #### Handle this some other way!) + ;; (while mapping + ;; (let ((mods '(() (shift) (control) (meta) (alt)))) + ;; (while mods + ;; (let ((k1 (vector (append (car mods) (list (car (car mapping)))))) + ;; (k2 (vector (append (car mods) (list (cdr (car mapping))))))) + ;; (define-key global-map k1 k2)) + ;; (setq mods (cdr mods)))) + ;; (setq mapping (cdr mapping)))) + +;;; I've extended keyboard-translate-table to work over keysyms. +;;; [FSF Emacs has something called `system-key-alist' that is +;;; supposed to accomplish approximately the same thing. Unfortunately, +;;; it's brain-dead in the typically FSF way, and associates *numbers* +;;; (who knows where the hell they come from?) with symbols.] --ben + +;;; And I've made it into a function which is NOT called by default --martin + + (defun sun-x11-keyboard-translate () + "Remap Sun's X11 keyboard. +Keys with names like `f35' are remapped, at a low level, +to more mnemonic ones,like `kp-3'." + (interactive) + + (keyboard-translate + 'f11 'stop ; the type4 keyboard Sun/MIT name + 'f36 'stop ; the type5 keyboard Sun name + 'cancel 'stop ; R6 binding + 'f12 'again ; the type4 keyboard Sun/MIT name + 'f37 'again ; the type5 keyboard Sun name + 'f13 'props ; + 'SunProps 'props ; R6 binding + 'f14 'undo ; + 'f15 'front ; + 'SunFront 'front ; R6 binding + 'f16 'copy ; + 'SunCopy 'copy ; R6 binding + 'f17 'open ; + 'SunOpen 'open ; R6 binding + 'f18 'paste ; + 'SunPaste 'paste ; R6 binding + 'f19 'find ; + 'f20 'cut ; + 'SunCut 'cut ; R6 binding + ;; help is ok + 'f21 'pause + 'f22 'prsc + 'f23 'scroll + ;; num_lock is ok + ;;'f24 'kp-equal) ; type4 only! + 'f25 'kp-divide ; + 'f26 'kp-multiply ; + 'f24 'kp-subtract ; type5 only! + 'f27 'kp-7 ; + ;; up is ok + 'f29 'kp-9 + ;; left is ok + 'f31 'kp-5 + ;; right is ok + ;; kp-add is ok + 'f33 'kp-1 ; the Sun name + 'r13 'end ; the MIT name + ;; down is ok + 'f35 'kp-3 + ;; insert is ok + ;; delete is ok + ;; kp-enter is ok + 'SunF36 'f11 ; Type 5 keyboards + 'SunF37 'f12 ; Used to be Stop & Again + )) + + +;;; OpenWindows-like "find" processing. +;;; As far as I know, the `find' key is a Sunism, so we do that binding +;;; here. This is the only Sun-specific keybinding. (The functions +;;; themselves are in x-win.el in case someone wants to use them when +;;; not running on a Sun display.) + + (or (lookup-key global-map 'find) + (define-key global-map 'find 'ow-find)) + (or (lookup-key global-map '(shift find)) + (define-key global-map '(shift find) 'ow-find-backward)) + + ) + +;;; x-win-sun.el ends here