lisp/emulation/keypad.el

   1 ;;; keypad.el --- simplified keypad bindings
   2
   3 ;; Copyright (C) 2002  Free Software Foundation, Inc.
   4
   5 ;; Author: Kim F. Storm <storm@cua.dk>
   6 ;; Keywords: keyboard convenience
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; The keypad package allows easy binding of the keypad keys to
  28 ;; various commonly used sets of commands.
  29 ;;
  30 ;; With the following setup, the keypad can be used for numeric data
  31 ;; entry when NumLock is off, and to give numeric prefix arguments to
  32 ;; emacs commands, when NumLock on on.
  33 ;;
  34 ;;  keypad-setup         => Plain Numeric Keypad
  35 ;;  keypad-numlock-setup => Prefix numeric args
  36 ;;
  37 ;;    +--------+--------+--------+
  38 ;;    |  M-7   |  M-8   |  M-9   | <- numlock on
  39 ;;    |   7    |   8    |   9    | <- numlock off
  40 ;;    +--------+--------+--------+
  41 ;;    |  M-4   |  M-5   |  M-6   |
  42 ;;    |   4    |   5    |   6    |
  43 ;;    +--------+--------+--------+
  44 ;;    |  M-1   |  M-2   |  M-3   |
  45 ;;    |   1    |   2    |   3    |
  46 ;;    +--------+--------+--------+
  47 ;;    |       M-0       |  M--   |
  48 ;;    |        0        |   .    |
  49 ;;    +-----------------+--------+
  50
  51 ;; The following keypad setup is used for navigation together with
  52 ;; modes like cua-mode which uses shifted movement keys to extend the
  53 ;; region.
  54 ;;
  55 ;;  keypad-setup         => Cursor keys
  56 ;;  keypad-shifted-setup => Shifted cursor keys
  57 ;;
  58 ;;    +--------+--------+--------+
  59 ;;    | S-home | S-up   | S-PgUp | <- shifted, numlock off
  60 ;;    |  Home  |  up    |  PgUp  | <- unshifted, numlock off
  61 ;;    +--------+--------+--------+
  62 ;;    | S-left |S-space |S-right |
  63 ;;    |  left  | space  | right  |
  64 ;;    +--------+--------+--------+
  65 ;;    | S-end  | S-down | S-PgDn |
  66 ;;    |  end   |  down  |  PgDn  |
  67 ;;    +--------+--------+--------+
  68 ;;    |    S-insert     |S-delete|
  69 ;;    |     insert      | delete |
  70 ;;    +-----------------+--------+
  71
  72 ;; The following setup binds the unshifted keypad keys to plain
  73 ;; numeric keys when NumLock is either on or off, but the decimal key
  74 ;; produces either a . (NumLock off) or a , (NumLock on).  This is
  75 ;; useful for e.g. Danish users where the decimal separator is a
  76 ;; comma.
  77 ;;
  78 ;;  keypad-setup         => Plain Numeric Keypad
  79 ;;  keypad-numlock-setup => Numeric Keypad with Decimal key: ,
  80 ;;
  81 ;;    +--------+--------+--------+
  82 ;;    |   7    |   8    |   9    | <- numlock on
  83 ;;    |   7    |   8    |   9    | <- numlock off
  84 ;;    +--------+--------+--------+
  85 ;;    |   4    |   5    |   6    |
  86 ;;    |   4    |   5    |   6    |
  87 ;;    +--------+--------+--------+
  88 ;;    |   1    |   2    |   3    |
  89 ;;    |   1    |   2    |   3    |
  90 ;;    +--------+--------+--------+
  91 ;;    |        0        |   ,    |
  92 ;;    |        0        |   .    |
  93 ;;    +-----------------+--------+
  94
  95 ;;; Code:
  96
  97 (provide 'keypad)
  98
  99 ;;; Customization
 100
 101 ;;;###autoload
 102 (defcustom keypad-setup nil
 103   "Specifies the keypad setup for unshifted keypad keys when NumLock is off.
 104 When selecting the plain numeric keypad setup, the character returned by the
 105 decimal key must be specified."
 106   :set (lambda (symbol value)
 107          (if value
 108              (keypad-setup value nil nil value)))
 109   :initialize 'custom-initialize-default
 110   :link '(emacs-commentary-link "keypad.el")
 111   :version "21.4"
 112   :type '(choice (const :tag "Plain numeric keypad" numeric)
 113                  (character :tag "Numeric Keypad with Decimal Key"
 114                             :match (lambda (widget value) (integerp value))
 115                             :value ?.)
 116                  (const :tag "Numeric prefix arguments" prefix)
 117                  (const :tag "Cursor keys" cursor)
 118                  (const :tag "Shifted cursor keys" S-cursor)
 119                  (const :tag "Unspecified/User-defined" none)
 120                  (other :tag "Keep existing bindings" nil))
 121   :require 'keypad
 122   :group 'keyboard)
 123
 124 ;;;###autoload
 125 (defcustom keypad-numlock-setup nil
 126   "Specifies the keypad setup for unshifted keypad keys when NumLock is on.
 127 When selecting the plain numeric keypad setup, the character returned by the
 128 decimal key must be specified."
 129   :set (lambda (symbol value)
 130          (if value
 131              (keypad-setup value t nil value)))
 132   :initialize 'custom-initialize-default
 133   :link '(emacs-commentary-link "keypad.el")
 134   :version "21.4"
 135   :type '(choice (const :tag "Plain numeric keypad" numeric)
 136                  (character :tag "Numeric Keypad with Decimal Key"
 137                             :match (lambda (widget value) (integerp value))
 138                             :value ?.)
 139                  (const :tag "Numeric prefix arguments" prefix)
 140                  (const :tag "Cursor keys" cursor)
 141                  (const :tag "Shifted cursor keys" S-cursor)
 142                  (const :tag "Unspecified/User-defined" none)
 143                  (other :tag "Keep existing bindings" nil))
 144   :require 'keypad
 145   :group 'keyboard)
 146
 147 ;;;###autoload
 148 (defcustom keypad-shifted-setup nil
 149   "Specifies the keypad setup for shifted keypad keys when NumLock is off.
 150 When selecting the plain numeric keypad setup, the character returned by the
 151 decimal key must be specified."
 152   :set (lambda (symbol value)
 153          (if value
 154              (keypad-setup value nil t value)))
 155   :initialize 'custom-initialize-default
 156   :link '(emacs-commentary-link "keypad.el")
 157   :version "21.4"
 158   :type '(choice (const :tag "Plain numeric keypad" numeric)
 159                  (character :tag "Numeric Keypad with Decimal Key"
 160                             :match (lambda (widget value) (integerp value))
 161                             :value ?.)
 162                  (const :tag "Numeric prefix arguments" prefix)
 163                  (const :tag "Cursor keys" cursor)
 164                  (const :tag "Shifted cursor keys" S-cursor)
 165                  (const :tag "Unspecified/User-defined" none)
 166                  (other :tag "Keep existing bindings" nil))
 167   :require 'keypad
 168   :group 'keyboard)
 169
 170 ;;;###autoload
 171 (defcustom keypad-numlock-shifted-setup nil
 172   "Specifies the keypad setup for shifted keypad keys when NumLock is off.
 173 When selecting the plain numeric keypad setup, the character returned by the
 174 decimal key must be specified."
 175   :set (lambda (symbol value)
 176          (if value
 177              (keypad-setup value t t value)))
 178   :initialize 'custom-initialize-default
 179   :link '(emacs-commentary-link "keypad.el")
 180   :version "21.4"
 181   :type '(choice (const :tag "Plain numeric keypad" numeric)
 182                  (character :tag "Numeric Keypad with Decimal Key"
 183                             :match (lambda (widget value) (integerp value))
 184                             :value ?.)
 185                  (const :tag "Numeric prefix arguments" prefix)
 186                  (const :tag "Cursor keys" cursor)
 187                  (const :tag "Shifted cursor keys" S-cursor)
 188                  (const :tag "Unspecified/User-defined" none)
 189                  (other :tag "Keep existing bindings" nil))
 190   :require 'keypad
 191   :group 'keyboard)
 192
 193
 194 ;;;###autoload
 195 (defun keypad-setup (setup &optional numlock shift decimal)
 196   "Set keypad bindings in function-key-map according to SETUP.
 197 If optional second argument NUMLOCK is non-nil, the NumLock On bindings
 198 are changed. Otherwise, the NumLock Off bindings are changed.
 199 If optional third argument SHIFT is non-nil, the shifted keypad
 200 keys are bound.
 201
 202  Setup      Binding
 203  -------------------------------------------------------------
 204  'prefix   Command prefix argument, i.e.  M-0 .. M-9 and M--
 205  'S-cursor Bind shifted keypad keys to the shifted cursor movement keys.
 206  'cursor   Bind keypad keys to the cursor movement keys.
 207  'numeric  Plain numeric keypad, i.e. 0 .. 9 and .  (or DECIMAL arg)
 208  'none     Removes all bindings for keypad keys in function-key-map;
 209            this enables any user-defined bindings for the keypad keys
 210            in the global and local keymaps.
 211
 212 If SETUP is 'numeric and the optional fourth argument DECIMAL is non-nil,
 213 the decimal key on the keypad is mapped to DECIMAL instead of `.'"
 214   (let* ((i 0)
 215          (var (cond
 216                ((and (not numlock) (not shift)) 'keypad-setup)
 217                ((and (not numlock) shift) 'keypad-shifted-setup)
 218                ((and numlock (not shift)) 'keypad-numlock-setup)
 219                ((and numlock shift) 'keypad-numlock-shifted-setup)))
 220          (kp (cond
 221               ((eq var 'keypad-setup)
 222                [kp-delete kp-insert kp-end kp-down kp-next kp-left
 223                           kp-space kp-right kp-home kp-up kp-prior])
 224               ((eq var 'keypad-shifted-setup)
 225                [S-kp-decimal S-kp-0 S-kp-1 S-kp-2 S-kp-3 S-kp-4
 226                              S-kp-5 S-kp-6 S-kp-7 S-kp-8 S-kp-9])
 227               ((eq var 'keypad-numlock-setup)
 228                [kp-decimal kp-0 kp-1 kp-2 kp-3 kp-4
 229                            kp-5 kp-6 kp-7 kp-8 kp-9])
 230               ((eq var 'keypad-numlock-shifted-setup)
 231                [S-kp-delete S-kp-insert S-kp-end S-kp-down S-kp-next S-kp-left
 232                             S-kp-space S-kp-right S-kp-home S-kp-up S-kp-prior])))
 233          (bind
 234           (cond
 235            ((or (eq setup 'numeric)
 236                 (char-valid-p setup))
 237             (if (eq decimal 'numeric)
 238                 (setq decimal nil))
 239             (vector (or decimal ?.) ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
 240            ((eq setup 'prefix)
 241             [?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4
 242                    ?\M-5 ?\M-6 ?\M-7 ?\M-8 ?\M-9])
 243            ((eq setup 'cursor)
 244             [delete insert end down next left
 245                     space right home up prior])
 246            ((eq setup 'S-cursor)
 247             [S-delete S-insert S-end S-down S-next S-left
 248                       S-space S-right S-home S-up S-prior])
 249            ((eq setup 'none)
 250             nil)
 251            (t
 252             (signal 'error (list "Unknown keypad setup: " setup))))))
 253
 254     (set var setup)
 255
 256     ;; Bind the keys in KP list to BIND list in function-key-map.
 257     ;; If BIND is nil, all bindings for the keys are removed.
 258     (if (not (boundp 'function-key-map))
 259         (setq function-key-map (make-sparse-keymap)))
 260
 261     (while (< i 11)
 262       (define-key function-key-map (vector (aref kp i))
 263         (if bind (vector (aref bind i))))
 264       (if (= i 6)
 265           (cond ((eq (aref kp i) 'kp-space)
 266                  (define-key function-key-map [kp-begin]
 267                    (if bind (vector (aref bind i)))))
 268                 ((eq (aref kp i) 'S-kp-space)
 269                  (define-key function-key-map [S-kp-begin]
 270                    (if bind (vector (aref bind i)))))))
 271
 272       (setq i (1+ i)))))
 273
 274 ;;; arch-tag: 0899d2bd-9e12-4b4e-9aef-d0014d3b6414
 275 ;;; keypad.el ends here