lisp/emulation/keypad.el

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