1;;; keypad.el --- simplified keypad bindings
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
4;;   2007 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 2, 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.
105When selecting the plain numeric keypad setup, the character returned by the
106decimal 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.
128When selecting the plain numeric keypad setup, the character returned by the
129decimal 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.
151When selecting the plain numeric keypad setup, the character returned by the
152decimal 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.
174When selecting the plain numeric keypad setup, the character returned by the
175decimal 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.
198If optional second argument NUMLOCK is non-nil, the NumLock On bindings
199are changed.  Otherwise, the NumLock Off bindings are changed.
200If optional third argument SHIFT is non-nil, the shifted keypad
201keys 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
213If SETUP is 'numeric and the optional fourth argument DECIMAL is non-nil,
214the 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
277