From a464813702e6c0af49d148ef3bc77e3727e148a1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 8 Jan 2013 15:15:15 -0500 Subject: [PATCH] * lisp/simple.el: Use lexical-binding. (primitive-undo): Use pcase. (minibuffer-history-isearch-push-state): Use a closure. --- lisp/ChangeLog | 6 ++ lisp/simple.el | 189 +++++++++++++++++++++++++-------------------------------- 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 + + * simple.el: Use lexical-binding. + (primitive-undo): Use pcase. + (minibuffer-history-isearch-push-state): Use a closure. + 2013-01-08 Aaron S. Hawley * 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 -- 2.11.4.GIT