cgit.sxemacs.org Git - sxemacs/blob - lisp/x-win-sun.el

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