* lisp/simple.el: Use lexical-binding.

(primitive-undo): Use pcase.
(minibuffer-history-isearch-push-state): Use a closure.

2 files changed, 89 insertions, 106 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 72390d1ff67..58dec6e41ec 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2013-01-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * simple.el: Use lexical-binding.
+        (primitive-undo): Use pcase.
+        (minibuffer-history-isearch-push-state): Use a closure.
+
 2013-01-08  Aaron S. Hawley  <aaron.s.hawley@gmail.com>
 
         * simple.el (primitive-undo): Move from undo.c.
diff --git a/lisp/simple.el b/lisp/simple.el
index 86c71cd2130..d06a04aa5dc 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,4 +1,4 @@
-;;; simple.el --- basic editing commands for Emacs
+;;; simple.el --- basic editing commands for Emacs  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
 
@@ -752,7 +752,7 @@ If N is negative, delete newlines as well, leaving -N spaces."
         (n (abs n)))
     (skip-chars-backward skip-characters)
     (constrain-to-field nil orig-pos)
-    (dotimes (i n)
+    (dotimes (_ n)
       (if (= (following-char) ?\s)
           (forward-char 1)
         (insert ?\s)))
@@ -1813,8 +1813,9 @@ or to the last history element for a backward search."
   "Save a function restoring the state of minibuffer history search.
 Save `minibuffer-history-position' to the additional state parameter
 in the search status stack."
-  `(lambda (cmd)
-     (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position)))
+  (let ((pos minibuffer-history-position))
+    (lambda (cmd)
+      (minibuffer-history-isearch-pop-state cmd pos))))
 
 (defun minibuffer-history-isearch-pop-state (_cmd hist-pos)
   "Restore the minibuffer history search state.
@@ -2001,109 +2002,85 @@ Return what remains of the list."
         (did-apply nil)
         (next nil))
     (while (> arg 0)
-      (while (and (consp list)
-                  (progn
-                    (setq next (car list))
-                    (setq list (cdr list))
-                    ;; Exit inner loop at undo boundary.
-                    (not (null next))))
+      (while (setq next (pop list))     ;Exit inner loop at undo boundary.
         ;; Handle an integer by setting point to that value.
-        (cond
-         ((integerp next) (goto-char next))
-         ((consp next)
-          (let ((car (car next))
-                (cdr (cdr next)))
-            (cond
-             ;; Element (t . TIME) records previous modtime.
-             ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
-             ;; UNKNOWN_MODTIME_NSECS.
-             ((eq t car)
-              ;; If this records an obsolete save
-              ;; (not matching the actual disk file)
-              ;; then don't mark unmodified.
-              (when (or (equal cdr (visited-file-modtime))
-                        (and (consp cdr)
-                             (equal (list (car cdr) (cdr cdr))
-                                    (visited-file-modtime))))
-                (when (fboundp 'unlock-buffer)
-                  (unlock-buffer))
-                (set-buffer-modified-p nil)))
-             ;; Element (nil PROP VAL BEG . END) is property change.
-             ((eq nil car)
-              (let ((beg (nth 2 cdr))
-                    (end (nthcdr 3 cdr))
-                    (prop (car cdr))
-                    (val (cadr cdr)))
-                (when (or (> (point-min) beg)
-                          (< (point-max) end))
-                  (error "Changes to be undone are outside visible portion of buffer"))
-                (put-text-property beg end prop val)))
-             ((and (integerp car) (integerp cdr))
-              ;; Element (BEG . END) means range was inserted.
-              (when (or (< car (point-min))
-                        (> cdr (point-max)))
-                (error "Changes to be undone are outside visible portion of buffer"))
-              ;; Set point first thing, so that undoing this undo
-              ;; does not send point back to where it is now.
-              (goto-char car)
-              (delete-region car cdr))
-             ((eq car 'apply)
-              ;; Element (apply FUN . ARGS) means call FUN to undo.
-              (let ((currbuff (current-buffer))
-                    (car (car cdr))
-                    (cdr (cdr cdr)))
-                (if (integerp car)
-                    ;; Long format: (apply DELTA START END FUN . ARGS).
-                    (let* ((delta car)
-                           (start (car cdr))
-                           (end (cadr cdr))
-                           (start-mark (copy-marker start nil))
-                           (end-mark (copy-marker end t))
-                           (cdr (cddr cdr))
-                           (fun (car cdr))
-                           (args (cdr cdr)))
-                      (apply fun args) ;; Use `save-current-buffer'?
-                      ;; Check that the function did what the entry
-                      ;; said it would do.
-                      (unless (and (eq start
-                                       (marker-position start-mark))
-                                   (eq (+ delta end)
-                                       (marker-position end-mark)))
-                        (error "Changes to be undone by function different than announced"))
-                      (set-marker start-mark nil)
-                      (set-marker end-mark nil))
-                  (apply car cdr))
-                (unless (eq currbuff (current-buffer))
-                  (error "Undo function switched buffer"))
-                (setq did-apply t)))
-             ((and (stringp car) (integerp cdr))
-              ;; Element (STRING . POS) means STRING was deleted.
-              (let ((membuf car)
-                    (pos cdr))
-                (when (or (< (abs pos) (point-min))
-                          (> (abs pos) (point-max)))
-                  (error "Changes to be undone are outside visible portion of buffer"))
-                (if (< pos 0)
-                    (progn
-                      (goto-char (- pos))
-                      (insert membuf))
-                  (goto-char pos)
-                  ;; Now that we record marker adjustments
-                  ;; (caused by deletion) for undo,
-                  ;; we should always insert after markers,
-                  ;; so that undoing the marker adjustments
-                  ;; put the markers back in the right place.
-                  (insert membuf)
-                  (goto-char pos))))
-             ((and (markerp car) (integerp cdr))
-              ;; (MARKER . INTEGER) means a marker MARKER
-              ;; was adjusted by INTEGER.
-              (when (marker-buffer car)
-                (set-marker car
-                            (- (marker-position car) cdr)
-                            (marker-buffer car))))
-             (t (error "Unrecognized entry in undo list %S" next)))))
-         (t (error "Unrecognized entry in undo list %S" next))))
+        (pcase next
+          ((pred integerp) (goto-char next))
+          ;; Element (t . TIME) records previous modtime.
+          ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+          ;; UNKNOWN_MODTIME_NSECS.
+          (`(t . ,time)
+           ;; If this records an obsolete save
+           ;; (not matching the actual disk file)
+           ;; then don't mark unmodified.
+           (when (or (equal time (visited-file-modtime))
+                     (and (consp time)
+                          (equal (list (car time) (cdr time))
+                                 (visited-file-modtime))))
+             (when (fboundp 'unlock-buffer)
+               (unlock-buffer))
+             (set-buffer-modified-p nil)))
+          ;; Element (nil PROP VAL BEG . END) is property change.
+          (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+           (when (or (> (point-min) beg) (< (point-max) end))
+             (error "Changes to be undone are outside visible portion of buffer"))
+           (put-text-property beg end prop val))
+          ;; Element (BEG . END) means range was inserted.
+          (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+           ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
+           ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
+           (when (or (> (point-min) beg) (< (point-max) end))
+             (error "Changes to be undone are outside visible portion of buffer"))
+           ;; Set point first thing, so that undoing this undo
+           ;; does not send point back to where it is now.
+           (goto-char beg)
+           (delete-region beg end))
+          ;; Element (apply FUN . ARGS) means call FUN to undo.
+          (`(apply . ,fun-args)
+           (let ((currbuff (current-buffer)))
+             (if (integerp (car fun-args))
+                 ;; Long format: (apply DELTA START END FUN . ARGS).
+                 (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
+                              (start-mark (copy-marker start nil))
+                              (end-mark (copy-marker end t)))
+                   (when (or (> (point-min) start) (< (point-max) end))
+                     (error "Changes to be undone are outside visible portion of buffer"))
+                   (apply fun args) ;; Use `save-current-buffer'?
+                   ;; Check that the function did what the entry
+                   ;; said it would do.
+                   (unless (and (= start start-mark)
+                                (= (+ delta end) end-mark))
+                     (error "Changes to be undone by function different than announced"))
+                   (set-marker start-mark nil)
+                   (set-marker end-mark nil))
+               (apply fun-args))
+             (unless (eq currbuff (current-buffer))
+               (error "Undo function switched buffer"))
+             (setq did-apply t)))
+          ;; Element (STRING . POS) means STRING was deleted.
+          (`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
+           (when (let ((apos (abs pos)))
+                   (or (< apos (point-min)) (> apos (point-max))))
+             (error "Changes to be undone are outside visible portion of buffer"))
+           (if (< pos 0)
+               (progn
+                 (goto-char (- pos))
+                 (insert string))
+             (goto-char pos)
+             ;; Now that we record marker adjustments
+             ;; (caused by deletion) for undo,
+             ;; we should always insert after markers,
+             ;; so that undoing the marker adjustments
+             ;; put the markers back in the right place.
+             (insert string)
+             (goto-char pos)))
+          ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
+          (`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+           (when (marker-buffer marker)
+             (set-marker marker
+                         (- marker offset)
+                         (marker-buffer marker))))
+          (_ (error "Unrecognized entry in undo list %S" next))))
       (setq arg (1- arg)))
     ;; Make sure an apply entry produces at least one undo entry,
     ;; so the test in `undo' for continuing an undo series