X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2ccf59411f334a41f2c64b1220a5d45f11071cae..44caa96dc5c16cbc4ee1bb26ec880af2e2ecf9f8:/lisp/double.el diff --git a/lisp/double.el b/lisp/double.el index bb2bf6577b..d6ccff8e96 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -1,17 +1,17 @@ ;;; double.el --- support for keyboard remapping with double clicking -;; Copyright (C) 1994, 1997, 1998, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1997-1998, 2001-2016 Free Software Foundation, +;; Inc. ;; Author: Per Abrahamsen ;; Keywords: i18n ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -75,7 +73,7 @@ Each entry is a list with three elements: (string :tag "Twice")))) (defcustom double-prefix-only t - "*Non-nil means that Double mode mapping only works for prefix keys. + "Non-nil means that Double mode mapping only works for prefix keys. That is, for any key `X' in `double-map', `X' alone will be mapped but not `C-u X' or `ESC X' since the X is not the prefix key." :group 'double @@ -95,7 +93,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (message "")) (read-event))) -(global-set-key [ignore] '(lambda () (interactive))) +(global-set-key [ignore] 'ignore) (or (boundp 'isearch-mode-map) (load-library "isearch")) @@ -105,7 +103,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (defun double-translate-key (prompt) ;; Translate input events using double map. - (let ((key last-input-char)) + (let ((key last-input-event)) (cond (unread-command-events ;; Artificial event, ignore it. (vector key)) @@ -124,9 +122,10 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (append (make-list (1- (length (nth 1 entry))) 127) (nth 2 entry) - '(magic-end))) + '(magic-end) + unread-command-events)) (vector 127)) - (setq unread-command-events (list new)) + (push new unread-command-events) [ignore]))) ((eq key 'magic-end) ;; End of double event. Ignore. @@ -136,79 +135,41 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (let ((exp (nth 1 (assoc key double-map)))) (setq double-last-event key) (setq unread-command-events - (append (substring exp 1) '(magic-start))) + (append (substring exp 1) '(magic-start) + unread-command-events)) (vector (aref exp 0))))))) -;;; Key Translation Map - -(defun double-setup (enable-flag) - (if enable-flag - (progn - ;; Set up key-translation-map as indicated by `double-map'. - ;; XXX I don't think key-translation-map should be made local here. -- Lorentey - (kill-local-variable 'key-translation-map) - (make-local-variable 'key-translation-map) - (setq key-translation-map (if (keymapp key-translation-map) - (copy-keymap key-translation-map) - (make-sparse-keymap))) - (mapcar (function (lambda (entry) - (define-key key-translation-map - (vector (nth 0 entry)) - 'double-translate-key))) - (append double-map '((magic-start) (magic-end))))) - (kill-local-variable 'key-translation-map))) - ;;; Mode -;;;###autoload -(defcustom double-mode nil - "Toggle Double mode. -Setting this variable directly does not take effect; -use either \\[customize] or the function `double-mode'." - :set (lambda (symbol value) - (double-mode (if value 1 0))) - :initialize 'custom-initialize-default - :link '(emacs-commentary-link "double") - :type 'boolean - :require 'double - :group 'double) -(make-variable-buffer-local 'double-mode) - -(or (assq 'double-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(double-mode " Double") minor-mode-alist))) - ;; This feature seemed useless and it confused describe-mode, -;; so I deleted it. -;;;(defvar double-mode-name "Double") -;;;;; Name of current double mode. -;;; (make-variable-buffer-local 'double-mode-name) +;; so I deleted it. +;; (defvar double-mode-name "Double") +;; ;; Name of current double mode. +;; (make-variable-buffer-local 'double-mode-name) ;;;###autoload -(defun double-mode (arg) - "Toggle Double mode. -With prefix arg, turn Double mode on iff arg is positive. - -When Double mode is on, some keys will insert different strings -when pressed twice. See variable `double-map' for details." - (interactive "P") - (if (or (and (null arg) double-mode) - (<= (prefix-numeric-value arg) 0)) - ;; Turn it off - (if double-mode - (progn - (let ((double-map)) - (double-setup nil)) - (setq double-mode nil) - (force-mode-line-update))) - ;;Turn it on - (if double-mode - () - (double-setup t) - (setq double-mode t) - (force-mode-line-update)))) +(define-minor-mode double-mode + "Toggle special insertion on double keypresses (Double mode). +With a prefix argument ARG, enable Double mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +When Double mode is enabled, some keys will insert different +strings when pressed twice. See `double-map' for details." + :lighter " Double" + :link '(emacs-commentary-link "double") + (kill-local-variable 'key-translation-map) + (when double-mode + ;; Set up key-translation-map as indicated by `double-map'. + ;; XXX I don't think key-translation-map should be made local here. -- Lorentey + (make-local-variable 'key-translation-map) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map key-translation-map) + (setq key-translation-map map) + (dolist (entry (append double-map '((magic-start) (magic-end)))) + (define-key map + (vector (nth 0 entry)) 'double-translate-key))))) (provide 'double) -;;; arch-tag: 2e170036-44cb-4493-bc32-ada0a4395221 ;;; double.el ends here