[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108129: Use set-temporary-overlay-map.

[Stefan Monnier]

------------------------------------------------------------
revno: 108129
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2012-05-04 22:50:20 -0400
message:
  Use set-temporary-overlay-map.
  * lisp/repeat.el: Use lexical-binding.
  (repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
  (repeat-undo-count): Remove.
  (repeat):
  * lisp/progmodes/octave-mod.el (octave-abbrev-start):
  * lisp/progmodes/f90.el (f90-abbrev-start):
  * lisp/face-remap.el (text-scale-adjust):
  * lisp/kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
modified:
  lisp/ChangeLog
  lisp/face-remap.el
  lisp/kmacro.el
  lisp/progmodes/f90.el
  lisp/progmodes/octave-mod.el
  lisp/repeat.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-05 02:05:49 +0000
+++ b/lisp/ChangeLog    2012-05-05 02:50:20 +0000
@@ -1,5 +1,14 @@
 2012-05-05  Stefan Monnier  <address@hidden>
 
+       * repeat.el: Use lexical-binding.
+       (repeat-last-self-insert, repeat-num-input-keys-at-self-insert)
+       (repeat-undo-count): Remove.
+       (repeat):
+       * progmodes/octave-mod.el (octave-abbrev-start):
+       * progmodes/f90.el (f90-abbrev-start):
+       * face-remap.el (text-scale-adjust):
+       * kmacro.el (kmacro-call-macro): Use set-temporary-overlay-map.
+
        * emacs-lisp/pcase.el (pcase--let*): New function.
        (pcase--expand, pcase-codegen, pcase--q1): Use it to reduce nesting
        a bit more.

=== modified file 'lisp/face-remap.el'
--- a/lisp/face-remap.el        2012-03-21 07:02:13 +0000
+++ b/lisp/face-remap.el        2012-05-05 02:50:20 +0000
@@ -303,26 +303,29 @@
 `text-scale-decrease' may be more appropriate."
   (interactive "p")
   (let ((first t)
-       (step t)
        (ev last-command-event)
        (echo-keystrokes nil))
-    (while step
-      (let ((base (event-basic-type ev)))
-       (cond ((or (eq base ?+) (eq base ?=))
-              (setq step inc))
-             ((eq base ?-)
-              (setq step (- inc)))
-             ((eq base ?0)
-              (setq step 0))
-             (first
-              (setq step inc))
-             (t
-              (setq step nil))))
-      (when step
-       (text-scale-increase step)
-       (setq inc 1 first nil)
-       (setq ev (read-event "+,-,0 for further adjustment: "))))
-    (push ev unread-command-events)))
+    (let* ((base (event-basic-type ev))
+           (step
+            (pcase base
+              ((or `?+ `?=) inc)
+              (`?- (- inc))
+              (`?0 0)
+              (t inc))))
+      (text-scale-increase step)
+      ;; FIXME: do it after everu "iteration of the loop".
+      (message "+,-,0 for further adjustment: ")
+      (set-temporary-overlay-map
+       (let ((map (make-sparse-keymap)))
+         (dolist (mods '(() (control)))
+           (define-key map (vector (append mods '(?-))) 'text-scale-decrease)
+           (define-key map (vector (append mods '(?+))) 'text-scale-increase)
+           ;; = is unshifted + on most keyboards.
+           (define-key map (vector (append mods '(?=))) 'text-scale-increase)
+           (define-key map (vector (append mods '(?0)))
+             (lambda () (interactive) (text-scale-increase 0))))
+         map)
+       t))))
 
 
 ;; ----------------------------------------------------------------

=== modified file 'lisp/kmacro.el'
--- a/lisp/kmacro.el    2012-04-09 13:05:48 +0000
+++ b/lisp/kmacro.el    2012-05-05 02:50:20 +0000
@@ -625,8 +625,10 @@
 To make a macro permanent so you can call it even after defining
 others, use \\[kmacro-name-last-macro]."
   (interactive "p")
-  (let ((repeat-key (and (null no-repeat)
-                        (> (length (this-single-command-keys)) 1)
+  (let ((repeat-key (and (or (and (null no-repeat)
+                                  (> (length (this-single-command-keys)) 1))
+                             ;; Used when we're in the process of repeating.
+                             (eq no-repeat 'repeating))
                         last-input-event))
        repeat-key-str)
     (if end-macro
@@ -640,24 +642,16 @@
                         repeat-key
                       kmacro-call-repeat-key)))
       (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil))
-      (while repeat-key
-       ;; Issue a hint to the user, if the echo area isn't in use.
-       (unless (current-message)
-         (message "(Type %s to repeat macro%s)"
-                  repeat-key-str
-                  (if (and kmacro-call-repeat-with-arg
-                           arg (> arg 1))
-                      (format " %d times" arg) "")))
-       (if (equal repeat-key (read-event))
-           (progn
-             (clear-this-command-keys t)
-             (call-last-kbd-macro (and kmacro-call-repeat-with-arg arg)
-                                  #'kmacro-loop-setup-function)
-             (setq last-input-event nil))
-         (setq repeat-key nil)))
-      (when last-input-event
-       (clear-this-command-keys t)
-       (setq unread-command-events (list last-input-event))))))
+      ;; Can't use the `keep-pred' arg because this overlay keymap needs to be
+      ;; removed during the next run of the kmacro (i.e. we need to add&remove
+      ;; this overlay-map at each repetition).
+      (set-temporary-overlay-map
+       (let ((map (make-sparse-keymap)))
+         (define-key map (vector repeat-key)
+           `(lambda () (interactive)
+              (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
+                                 'repeating)))
+         map)))))
 
 
 ;;; Combined function key bindings:

=== modified file 'lisp/progmodes/f90.el'
--- a/lisp/progmodes/f90.el     2012-04-09 13:05:48 +0000
+++ b/lisp/progmodes/f90.el     2012-05-05 02:50:20 +0000
@@ -2204,18 +2204,13 @@
   "Typing `\\[help-command] or `? lists all the F90 abbrevs.
 Any other key combination is executed normally."
   (interactive "*")
-  (insert last-command-event)
-  (let (char event)
-    (if (fboundp 'next-command-event) ; XEmacs
-        (setq event (next-command-event)
-              char (and (fboundp 'event-to-character)
-                        (event-to-character event)))
-      (setq event (read-event)
-            char event))
-    ;; Insert char if not equal to `?', or if abbrev-mode is off.
-    (if (and abbrev-mode (memq char (list ?? help-char)))
-        (f90-abbrev-help)
-      (setq unread-command-events (list event)))))
+  (self-insert-command 1)
+  (when abbrev-mode
+    (set-temporary-overlay-map
+     (let ((map (make-sparse-keymap)))
+       (define-key map [??] 'f90-abbrev-help)
+       (define-key map (vector help-char) 'f90-abbrev-help)
+       map))))
 
 (defun f90-abbrev-help ()
   "List the currently defined abbrevs in F90 mode."

=== modified file 'lisp/progmodes/octave-mod.el'
--- a/lisp/progmodes/octave-mod.el      2012-02-20 20:24:24 +0000
+++ b/lisp/progmodes/octave-mod.el      2012-05-05 02:50:20 +0000
@@ -989,18 +989,13 @@
 executed normally.
 Note that all Octave mode abbrevs start with a grave accent."
   (interactive)
-  (if (not abbrev-mode)
-      (self-insert-command 1)
-    (let (c)
-      (insert last-command-event)
-      (if (if (featurep 'xemacs)
-             (or (eq (event-to-character (setq c (next-event))) ??)
-                 (eq (event-to-character c) help-char))
-           (or (eq (setq c (read-event)) ??)
-               (eq c help-char)))
-         (let ((abbrev-table-name-list '(octave-abbrev-table)))
-           (list-abbrevs))
-       (setq unread-command-events (list c))))))
+  (self-insert-command 1)
+  (when abbrev-mode
+    (set-temporary-overlay-map
+     (let ((map (make-sparse-keymap)))
+       (define-key map [??] 'list-abbrevs)
+       (define-key map (vector help-char) 'list-abbrevs)
+       map))))
 
 (define-skeleton octave-insert-defun
   "Insert an Octave function skeleton.

=== modified file 'lisp/repeat.el'
--- a/lisp/repeat.el    2012-01-19 07:21:25 +0000
+++ b/lisp/repeat.el    2012-05-05 02:50:20 +0000
@@ -1,4 +1,4 @@
-;;; repeat.el --- convenient way to repeat the previous command
+;;; repeat.el --- convenient way to repeat the previous command  -*- 
lexical-binding: t -*-
 
 ;; Copyright (C) 1998, 2001-2012 Free Software Foundation, Inc.
 
@@ -156,15 +156,6 @@
 ;; `repeat' now repeats that command instead of `real-last-command' to
 ;; avoid a "... must be bound to an event with parameters" error.
 
-(defvar repeat-last-self-insert nil
-  "If last repeated command was `self-insert-command', it inserted this.")
-
-;; That'll require another keystroke count so we know we're in a string of
-;; repetitions of self-insert commands:
-
-(defvar repeat-num-input-keys-at-self-insert -1
-  "# key sequences read in Emacs session when `self-insert-command' repeated.")
-
 ;;;;; *************** ANALOGOUS HACKS TO `repeat' ITSELF **************** ;;;;;
 
 ;; That mechanism of checking num-input-keys to figure out what's really
@@ -199,14 +190,6 @@
 (defvar repeat-previous-repeated-command nil
   "The previous repeated command.")
 
-;; The following variable counts repeated self-insertions.  The idea is
-;; that repeating a self-insertion command and subsequently undoing it
-;; should have almost the same effect as if the characters were inserted
-;; manually.  The basic difference is that we leave in one undo-boundary
-;; between the original insertion and its first repetition.
-(defvar repeat-undo-count nil
-  "Number of self-insertions since last `undo-boundary'.")
-
 ;;;###autoload
 (defun repeat (repeat-arg)
   "Repeat most recently executed command.
@@ -254,7 +237,7 @@
   (let ((repeat-repeat-char
          (if (eq repeat-on-final-keystroke t)
             last-command-event
-           ;; allow only specified final keystrokes
+           ;; Allow only specified final keystrokes.
            (car (memq last-command-event
                       (listify-key-sequence
                        repeat-on-final-keystroke))))))
@@ -269,90 +252,45 @@
         (setq current-prefix-arg repeat-arg)
         (repeat-message
         "Repeating command %S %S" repeat-arg last-repeatable-command))
-      (if (eq last-repeatable-command 'self-insert-command)
-          (let ((insertion
-                 (if (<= (- num-input-keys
-                            repeat-num-input-keys-at-self-insert)
-                         1)
-                     repeat-last-self-insert
-                   (let ((range (nth 1 buffer-undo-list)))
-                     (condition-case nil
-                         (setq repeat-last-self-insert
-                               (buffer-substring (car range)
-                                                 (cdr range)))
-                       (error (error "%s %s %s" ;Danger, Will Robinson!
-                                     "repeat can't intuit what you"
-                                     "inserted before auto-fill"
-                                     "clobbered it, sorry")))))))
-            (setq repeat-num-input-keys-at-self-insert num-input-keys)
-           ;; If the self-insert had a repeat count, INSERTION
-           ;; includes that many copies of the same character.
-           ;; So use just the first character
-           ;; and repeat it the right number of times.
-           (setq insertion (substring insertion -1))
-           (let ((count (prefix-numeric-value repeat-arg))
-                 (i 0))
-             ;; Run pre- and post-command hooks for self-insertion too.
-             (run-hooks 'pre-command-hook)
-             (cond
-              ((not repeat-undo-count))
-              ((< repeat-undo-count 20)
-               ;; Don't make an undo-boundary here.
-               (setq repeat-undo-count (1+ repeat-undo-count)))
-              (t
-               ;; Make an undo-boundary after 20 repetitions only.
-               (undo-boundary)
-               (setq repeat-undo-count 1)))
-             (while (< i count)
-               (repeat-self-insert insertion)
-               (setq i (1+ i)))
-             (run-hooks 'post-command-hook)))
-       (let ((indirect (indirect-function last-repeatable-command)))
-         ;; Make each repetition undo separately.
-         (undo-boundary)
-         (if (or (stringp indirect)
-                 (vectorp indirect))
-             ;; Bind real-last-command so that executing the macro does
-             ;; not alter it.  Do the same for last-repeatable-command.
-             (let ((real-last-command real-last-command)
-                   (last-repeatable-command last-repeatable-command))
-               (execute-kbd-macro last-repeatable-command))
-            (run-hooks 'pre-command-hook)
-           (call-interactively last-repeatable-command)
-            (run-hooks 'post-command-hook)))))
+      (when (eq last-repeatable-command 'self-insert-command)
+        ;; We used to use a much more complex code to try and figure out
+        ;; what key was used to run that self-insert-command:
+        ;; (if (<= (- num-input-keys
+        ;;            repeat-num-input-keys-at-self-insert)
+        ;;         1)
+        ;;     repeat-last-self-insert
+        ;;   (let ((range (nth 1 buffer-undo-list)))
+        ;;     (condition-case nil
+        ;;         (setq repeat-last-self-insert
+        ;;               (buffer-substring (car range)
+        ;;                                 (cdr range)))
+        ;;       (error (error "%s %s %s"  ;Danger, Will Robinson!
+        ;;                     "repeat can't intuit what you"
+        ;;                     "inserted before auto-fill"
+        ;;                     "clobbered it, sorry")))))
+        (setq last-command-event (char-before)))
+      (let ((indirect (indirect-function last-repeatable-command)))
+        (if (or (stringp indirect)
+                (vectorp indirect))
+            ;; Bind last-repeatable-command so that executing the macro does
+            ;; not alter it.
+            (let ((last-repeatable-command last-repeatable-command))
+              (execute-kbd-macro last-repeatable-command))
+          (call-interactively last-repeatable-command))))
     (when repeat-repeat-char
-      ;; A simple recursion here gets into trouble with max-lisp-eval-depth
-      ;; on long sequences of repetitions of a command like `forward-word'
-      ;; (only 32 repetitions are possible given the default value of 200 for
-      ;; max-lisp-eval-depth), but if I now locally disable the repeat char I
-      ;; can iterate indefinitely here around a single level of recursion.
-      (let (repeat-on-final-keystroke
-           ;; Bind `undo-inhibit-record-point' to t in order to avoid
-           ;; recording point in `buffer-undo-list' here.  We have to
-           ;; do this since the command loop does not set the last
-           ;; position of point thus confusing the point recording
-           ;; mechanism when inserting or deleting text.
-           (undo-inhibit-record-point t))
-       (setq real-last-command 'repeat)
-       (setq repeat-undo-count 1)
-       (unwind-protect
-           (while (let ((evt (read-key)))
-                     ;; For clicks, we need to strip the meta-data to
-                     ;; check the underlying event name.
-                     (eq (or (car-safe evt) evt)
-                         (or (car-safe repeat-repeat-char)
-                             repeat-repeat-char)))
-             (repeat repeat-arg))
-         ;; Make sure `repeat-undo-count' is reset.
-         (setq repeat-undo-count nil))
-        (setq unread-command-events (list last-input-event))))))
-
-(defun repeat-self-insert (string)
-  (let ((i 0))
-    (while (< i (length string))
-      (let ((last-command-event (aref string i)))
-       (self-insert-command 1))
-      (setq i (1+ i)))))
+      (set-temporary-overlay-map
+       (let ((map (make-sparse-keymap)))
+         (define-key map (vector repeat-repeat-char)
+           (if (null repeat-message-function) 'repeat
+             ;; If repeat-message-function is let-bound, preserve it for the
+             ;; next "iterations of the loop".
+             (let ((fun repeat-message-function))
+               (lambda ()
+                 (interactive)
+                 (let ((repeat-message-function fun))
+                   (setq this-command 'repeat)
+                   (call-interactively 'repeat))))))
+         map)))))
 
 (defun repeat-message (format &rest args)
   "Like `message' but displays with `repeat-message-function' if non-nil."