lisp/emulation/keypad.el

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