lisp/emulation/keypad.el

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