Now on revision 111453. ------------------------------------------------------------ revno: 111453 committer: Daiki Ueno branch nick: trunk timestamp: Wed 2013-01-09 14:11:16 +0900 message: * mml-smime.el (epg-sub-key-fingerprint): Autoload. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-01-08 04:40:09 +0000 +++ lisp/gnus/ChangeLog 2013-01-09 05:11:16 +0000 @@ -1,3 +1,8 @@ +2013-01-09 Daiki Ueno + + * mml-smime.el (epg-sub-key-fingerprint): Autoload for + mml-smime-epg-find-usable-secret-key. + 2013-01-08 Glenn Morris * mml-smime.el (mml-smime-sign-with-sender): Add :version. === modified file 'lisp/gnus/mml-smime.el' --- lisp/gnus/mml-smime.el 2013-01-08 04:40:09 +0000 +++ lisp/gnus/mml-smime.el 2013-01-09 05:11:16 +0000 @@ -329,6 +329,7 @@ (autoload 'epg-encrypt-string "epg") (autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-sub-key-fingerprint "epg") (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa")) ------------------------------------------------------------ revno: 111452 committer: Glenn Morris branch nick: trunk timestamp: Tue 2013-01-08 20:01:57 -0800 message: Remove some obsolete trace.el commentary diff: === modified file 'lisp/emacs-lisp/trace.el' --- lisp/emacs-lisp/trace.el 2013-01-02 16:13:04 +0000 +++ lisp/emacs-lisp/trace.el 2013-01-09 04:01:57 +0000 @@ -38,11 +38,6 @@ ;; generation of trace output won't interfere with what you are currently ;; doing. -;; Requirement: -;; ============ -;; trace.el needs advice.el version 2.0 or later which you can get from the -;; same place from where you got trace.el. - ;; Restrictions: ;; ============= ;; - Traced subrs when called interactively will always show nil as the @@ -55,17 +50,6 @@ ;; + Macros that were expanded during compilation ;; - All the restrictions that apply to advice.el -;; Installation: -;; ============= -;; Put this file together with advice.el (version 2.0 or later) somewhere -;; into your Emacs `load-path', byte-compile it/them for efficiency, and -;; put the following autoload declarations into your .emacs -;; -;; (autoload 'trace-function "trace" "Trace a function" t) -;; (autoload 'trace-function-background "trace" "Trace a function" t) -;; -;; or explicitly load it with (require 'trace) or (load "trace"). - ;; Usage: ;; ====== ;; - To trace a function say `M-x trace-function' which will ask you for the ------------------------------------------------------------ revno: 111451 committer: Glenn Morris branch nick: trunk timestamp: Tue 2013-01-08 20:00:57 -0800 message: Remove some of the more obsolete MAINTAINERS info diff: === modified file 'admin/MAINTAINERS' --- admin/MAINTAINERS 2012-08-02 06:17:21 +0000 +++ admin/MAINTAINERS 2013-01-09 04:00:57 +0000 @@ -16,9 +16,6 @@ 1. ============================================================================== -Richard Stallman - ??? - Jason Rumney W32 @@ -71,13 +68,6 @@ etc/calccard.tex doc/misc/calc.texi -Michael Olson - ERC - lisp/erc/* - etc/ERC-NEWS - doc/misc/erc.texi - lisp/emacs-lisp/tq.el - Bastien Guerry Org lisp/org/* @@ -87,9 +77,6 @@ 2. ============================================================================== -Steven Tamm - MacOS - Eli Zaretskii doc/* lispref/* ------------------------------------------------------------ revno: 111450 fixes bug: http://debbugs.gnu.org/13000 committer: Juri Linkov branch nick: trunk timestamp: Wed 2013-01-09 01:50:40 +0200 message: * lisp/textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): * lisp/progmodes/flymake.el (flymake-errline, flymake-warnline): Use underline style wave on terminals that support it. * src/xfaces.c (tty_supports_face_attributes_p): Return 0 for the case of (supports :underline (:style wave)). diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-01-08 07:14:51 +0000 +++ etc/NEWS 2013-01-08 23:50:40 +0000 @@ -205,6 +205,9 @@ *** Face specs set via Custom themes now replace the `defface' spec rather than inheriting from it (as do face specs set via Customize). +*** New face characteristic (supports :underline (:style wave)) +specifies whether or not the terminal can display a wavy line. + ** time-to-seconds is not obsolete any more. ** New function special-form-p. ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 22:26:21 +0000 +++ lisp/ChangeLog 2013-01-08 23:50:40 +0000 @@ -1,3 +1,9 @@ +2013-01-08 Juri Linkov + + * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): + * progmodes/flymake.el (flymake-errline, flymake-warnline): + Use underline style wave on terminals that support it. (Bug#13000) + 2013-01-08 Stefan Monnier * emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if === modified file 'lisp/progmodes/flymake.el' --- lisp/progmodes/flymake.el 2013-01-01 09:11:05 +0000 +++ lisp/progmodes/flymake.el 2013-01-08 23:50:40 +0000 @@ -844,13 +844,21 @@ has-flymake-overlays)) (defface flymake-errline - '((t :inherit error)) + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit error)) "Face used for marking error lines." + :version "24.4" :group 'flymake) (defface flymake-warnline - '((t :inherit warning)) + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :inherit warning)) "Face used for marking warning lines." + :version "24.4" :group 'flymake) (defun flymake-highlight-line (line-no line-err-info-list) === modified file 'lisp/textmodes/flyspell.el' --- lisp/textmodes/flyspell.el 2013-01-01 09:11:05 +0000 +++ lisp/textmodes/flyspell.el 2013-01-08 23:50:40 +0000 @@ -445,13 +445,23 @@ ;;*---------------------------------------------------------------------*/ ;;* Highlighting */ ;;*---------------------------------------------------------------------*/ -(defface flyspell-incorrect '((t :underline t :inherit error)) +(defface flyspell-incorrect + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :underline t :inherit error)) "Flyspell face for misspelled words." + :version "24.4" :group 'flyspell) -(defface flyspell-duplicate '((t :underline t :inherit warning)) +(defface flyspell-duplicate + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :underline t :inherit warning)) "Flyspell face for words that appear twice in a row. See also `flyspell-duplicate-distance'." + :version "24.4" :group 'flyspell) (defvar flyspell-overlay nil) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-08 19:13:31 +0000 +++ src/ChangeLog 2013-01-08 23:50:40 +0000 @@ -1,3 +1,8 @@ +2013-01-08 Juri Linkov + + * xfaces.c (tty_supports_face_attributes_p): Return 0 for the case + of (supports :underline (:style wave)). (Bug#13000) + 2013-01-08 Aaron S. Hawley * undo.c (Fprimitive_undo): Move to simple.el. === modified file 'src/xfaces.c' --- src/xfaces.c 2013-01-02 16:13:04 +0000 +++ src/xfaces.c 2013-01-08 23:50:40 +0000 @@ -4877,6 +4877,8 @@ { if (STRINGP (val)) return 0; /* ttys can't use colored underlines */ + else if (EQ (CAR_SAFE (val), QCstyle) && EQ (CAR_SAFE (CDR_SAFE (val)), Qwave)) + return 0; /* ttys can't use wave underlines */ else if (face_attr_equal_p (val, def_attrs[LFACE_UNDERLINE_INDEX])) return 0; /* same as default */ else ------------------------------------------------------------ revno: 111449 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 17:26:21 -0500 message: * lisp/emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if the predicate returns nil. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 20:15:15 +0000 +++ lisp/ChangeLog 2013-01-08 22:26:21 +0000 @@ -1,5 +1,8 @@ 2013-01-08 Stefan Monnier + * emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if + the predicate returns nil. + * simple.el: Use lexical-binding. (primitive-undo): Use pcase. (minibuffer-history-isearch-push-state): Use a closure. === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lisp/pcase.el 2013-01-08 22:26:21 +0000 @@ -431,30 +431,31 @@ (match ,symd . ,(pcase--upat (cdr qpat)))) :pcase--fail))) ;; A QPattern but not for a cons, can only go to the `else' side. - ((eq (car-safe pat) '\`) (cons :pcase--fail nil)) + ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (or (member (cons 'consp (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) 'consp) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)))) + '(:pcase--fail . nil)))) (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) - (cons :pcase--succeed :pcase--fail)) + '(:pcase--succeed . :pcase--fail)) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) - (get (cadr pat) 'side-effect-free) - (funcall (cadr pat) elem)) - (cons :pcase--succeed nil)))) + (get (cadr pat) 'side-effect-free)) + (if (funcall (cadr pat) elem) + '(:pcase--succeed . nil) + '(:pcase--fail . nil))))) (defun pcase--split-member (elems pat) ;; Based on pcase--split-equal. @@ -462,7 +463,7 @@ ;; The same match (or a match of membership in a superset) will ;; give the same result, but we don't know how to check it. ;; (??? - ;; (cons :pcase--succeed nil)) + ;; '(:pcase--succeed . nil)) ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) nil) @@ -471,7 +472,7 @@ ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) (get (cadr pat) 'side-effect-free) @@ -479,21 +480,21 @@ (dolist (elem elems) (unless (funcall p elem) (setq all nil))) all)) - (cons :pcase--succeed nil)))) + '(:pcase--succeed . nil)))) (defun pcase--split-pred (upat pat) ;; FIXME: For predicates like (pred (> a)), two such predicates may ;; actually refer to different variables `a'. (let (test) (cond - ((equal upat pat) (cons :pcase--succeed :pcase--fail)) + ((equal upat pat) '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (eq 'pred (car-safe pat)) (or (member (cons (cadr upat) (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) (cadr upat)) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq 'pred (car upat)) (eq '\` (car-safe pat)) (symbolp (cadr upat)) @@ -502,8 +503,8 @@ (ignore-errors (setq test (list (funcall (cadr upat) (cadr pat)))))) (if (car test) - (cons nil :pcase--fail) - (cons :pcase--fail nil)))))) + '(nil . :pcase--fail) + '(:pcase--fail . nil)))))) (defun pcase--fgrep (vars sexp) "Check which of the symbols VARS appear in SEXP." ------------------------------------------------------------ revno: 111448 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 15:15:15 -0500 message: * lisp/simple.el: Use lexical-binding. (primitive-undo): Use pcase. (minibuffer-history-isearch-push-state): Use a closure. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 19:13:31 +0000 +++ lisp/ChangeLog 2013-01-08 20:15:15 +0000 @@ -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. === modified file 'lisp/simple.el' --- lisp/simple.el 2013-01-08 19:13:31 +0000 +++ lisp/simple.el 2013-01-08 20:15:15 +0000 @@ -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 @@ (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 @@ "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 @@ (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 ------------------------------------------------------------ revno: 111447 author: Aaron S. Hawley committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 14:13:31 -0500 message: * lisp/simple.el (primitive-undo): Move from undo.c. * src/undo.c (Fprimitive_undo): Move to simple.el. (syms_of_undo): Remove declaration for Sprimitive_undo. * test/automated/undo-tests.el: New file. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 17:34:35 +0000 +++ lisp/ChangeLog 2013-01-08 19:13:31 +0000 @@ -1,3 +1,7 @@ +2013-01-08 Aaron S. Hawley + + * simple.el (primitive-undo): Move from undo.c. + 2013-01-08 Stefan Monnier * vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'. === modified file 'lisp/simple.el' --- lisp/simple.el 2013-01-02 16:13:04 +0000 +++ lisp/simple.el 2013-01-08 19:13:31 +0000 @@ -1979,6 +1979,141 @@ (if (null pending-undo-list) (setq pending-undo-list t)))) +(defun primitive-undo (n list) + "Undo N records from the front of the list LIST. +Return what remains of the list." + + ;; This is a good feature, but would make undo-start + ;; unable to do what is expected. + ;;(when (null (car (list))) + ;; ;; If the head of the list is a boundary, it is the boundary + ;; ;; preceding this command. Get rid of it and don't count it. + ;; (setq list (cdr list)))) + + (let ((arg n) + ;; In a writable buffer, enable undoing read-only text that is + ;; so because of text properties. + (inhibit-read-only t) + ;; Don't let `intangible' properties interfere with undo. + (inhibit-point-motion-hooks t) + ;; We use oldlist only to check for EQ. ++kfs + (oldlist buffer-undo-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)))) + ;; 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)))) + (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 + ;; will work right. + (if (and did-apply + (eq oldlist buffer-undo-list)) + (setq buffer-undo-list + (cons (list 'apply 'cdr nil) buffer-undo-list)))) + list) + ;; Deep copy of a list (defun undo-copy-list (list) "Make a copy of undo list LIST." === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-08 16:51:11 +0000 +++ src/ChangeLog 2013-01-08 19:13:31 +0000 @@ -1,3 +1,8 @@ +2013-01-08 Aaron S. Hawley + + * undo.c (Fprimitive_undo): Move to simple.el. + (syms_of_undo): Remove declarations for Sprimitive_undo. + 2013-01-08 Stefan Monnier * keyboard.c (echo_add_key): Rename from echo_add_char. === modified file 'src/undo.c' --- src/undo.c 2013-01-01 09:11:05 +0000 +++ src/undo.c 2013-01-08 19:13:31 +0000 @@ -452,217 +452,6 @@ } -DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, - doc: /* Undo N records from the front of the list LIST. -Return what remains of the list. */) - (Lisp_Object n, Lisp_Object list) -{ - struct gcpro gcpro1, gcpro2; - Lisp_Object next; - ptrdiff_t count = SPECPDL_INDEX (); - register EMACS_INT arg; - Lisp_Object oldlist; - int did_apply = 0; - -#if 0 /* This is a good feature, but would make undo-start - unable to do what is expected. */ - Lisp_Object tem; - - /* If the head of the list is a boundary, it is the boundary - preceding this command. Get rid of it and don't count it. */ - tem = Fcar (list); - if (NILP (tem)) - list = Fcdr (list); -#endif - - CHECK_NUMBER (n); - arg = XINT (n); - next = Qnil; - GCPRO2 (next, list); - /* I don't think we need to gcpro oldlist, as we use it only - to check for EQ. ++kfs */ - - /* In a writable buffer, enable undoing read-only text that is so - because of text properties. */ - if (NILP (BVAR (current_buffer, read_only))) - specbind (Qinhibit_read_only, Qt); - - /* Don't let `intangible' properties interfere with undo. */ - specbind (Qinhibit_point_motion_hooks, Qt); - - oldlist = BVAR (current_buffer, undo_list); - - while (arg > 0) - { - while (CONSP (list)) - { - next = XCAR (list); - list = XCDR (list); - /* Exit inner loop at undo boundary. */ - if (NILP (next)) - break; - /* Handle an integer by setting point to that value. */ - if (INTEGERP (next)) - SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); - else if (CONSP (next)) - { - Lisp_Object car, cdr; - - car = XCAR (next); - cdr = XCDR (next); - if (EQ (car, Qt)) - { - /* Element (t . TIME) records previous modtime. - Preserve any flag of NONEXISTENT_MODTIME_NSECS or - UNKNOWN_MODTIME_NSECS. */ - struct buffer *base_buffer = current_buffer; - EMACS_TIME mod_time; - - if (CONSP (cdr) - && CONSP (XCDR (cdr)) - && CONSP (XCDR (XCDR (cdr))) - && CONSP (XCDR (XCDR (XCDR (cdr)))) - && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr))))) - && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0) - mod_time = - (make_emacs_time - (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000)); - else - mod_time = lisp_time_argument (cdr); - - if (current_buffer->base_buffer) - base_buffer = current_buffer->base_buffer; - - /* If this records an obsolete save - (not matching the actual disk file) - then don't mark unmodified. */ - if (EMACS_TIME_NE (mod_time, base_buffer->modtime)) - continue; -#ifdef CLASH_DETECTION - Funlock_buffer (); -#endif /* CLASH_DETECTION */ - Fset_buffer_modified_p (Qnil); - } - else if (EQ (car, Qnil)) - { - /* Element (nil PROP VAL BEG . END) is property change. */ - Lisp_Object beg, end, prop, val; - - prop = Fcar (cdr); - cdr = Fcdr (cdr); - val = Fcar (cdr); - cdr = Fcdr (cdr); - beg = Fcar (cdr); - end = Fcdr (cdr); - - if (XINT (beg) < BEGV || XINT (end) > ZV) - user_error ("Changes to be undone are outside visible portion of buffer"); - Fput_text_property (beg, end, prop, val, Qnil); - } - else if (INTEGERP (car) && INTEGERP (cdr)) - { - /* Element (BEG . END) means range was inserted. */ - - if (XINT (car) < BEGV - || XINT (cdr) > ZV) - user_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. */ - Fgoto_char (car); - Fdelete_region (car, cdr); - } - else if (EQ (car, Qapply)) - { - /* Element (apply FUN . ARGS) means call FUN to undo. */ - struct buffer *save_buffer = current_buffer; - - car = Fcar (cdr); - cdr = Fcdr (cdr); - if (INTEGERP (car)) - { - /* Long format: (apply DELTA START END FUN . ARGS). */ - Lisp_Object delta = car; - Lisp_Object start = Fcar (cdr); - Lisp_Object end = Fcar (Fcdr (cdr)); - Lisp_Object start_mark = Fcopy_marker (start, Qnil); - Lisp_Object end_mark = Fcopy_marker (end, Qt); - - cdr = Fcdr (Fcdr (cdr)); - apply1 (Fcar (cdr), Fcdr (cdr)); - - /* Check that the function did what the entry said it - would do. */ - if (!EQ (start, Fmarker_position (start_mark)) - || (XINT (delta) + XINT (end) - != marker_position (end_mark))) - error ("Changes to be undone by function different than announced"); - Fset_marker (start_mark, Qnil, Qnil); - Fset_marker (end_mark, Qnil, Qnil); - } - else - apply1 (car, cdr); - - if (save_buffer != current_buffer) - error ("Undo function switched buffer"); - did_apply = 1; - } - else if (STRINGP (car) && INTEGERP (cdr)) - { - /* Element (STRING . POS) means STRING was deleted. */ - Lisp_Object membuf; - EMACS_INT pos = XINT (cdr); - - membuf = car; - if (pos < 0) - { - if (-pos < BEGV || -pos > ZV) - user_error ("Changes to be undone are outside visible portion of buffer"); - SET_PT (-pos); - Finsert (1, &membuf); - } - else - { - if (pos < BEGV || pos > ZV) - user_error ("Changes to be undone are outside visible portion of buffer"); - SET_PT (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. */ - Finsert (1, &membuf); - SET_PT (pos); - } - } - else if (MARKERP (car) && INTEGERP (cdr)) - { - /* (MARKER . INTEGER) means a marker MARKER - was adjusted by INTEGER. */ - if (XMARKER (car)->buffer) - Fset_marker (car, - make_number (marker_position (car) - XINT (cdr)), - Fmarker_buffer (car)); - } - } - } - arg--; - } - - - /* Make sure an apply entry produces at least one undo entry, - so the test in `undo' for continuing an undo series - will work right. */ - if (did_apply - && EQ (oldlist, BVAR (current_buffer, undo_list))) - bset_undo_list - (current_buffer, - Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list))); - - UNGCPRO; - return unbind_to (count, list); -} - void syms_of_undo (void) { @@ -675,7 +464,6 @@ last_undo_buffer = NULL; last_boundary_buffer = NULL; - defsubr (&Sprimitive_undo); defsubr (&Sundo_boundary); DEFVAR_INT ("undo-limit", undo_limit, === modified file 'test/ChangeLog' --- test/ChangeLog 2013-01-02 16:13:04 +0000 +++ test/ChangeLog 2013-01-08 19:13:31 +0000 @@ -1,3 +1,7 @@ +2013-01-08 Aaron S. Hawley + + * automated/undo-tests.el: New file. + 2012-12-27 Dmitry Gutov * automated/ruby-mode-tests.el === added file 'test/automated/undo-tests.el' --- test/automated/undo-tests.el 1970-01-01 00:00:00 +0000 +++ test/automated/undo-tests.el 2013-01-08 19:13:31 +0000 @@ -0,0 +1,231 @@ +;;; undo-tests.el --- Tests of primitive-undo + +;; Copyright (C) 2012 Aaron S. Hawley + +;; Author: Aaron S. Hawley + +;; This program 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 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; Profiling when the code was translate from C to Lisp on 2012-12-24. + +;;; C + +;; (elp-instrument-function 'primitive-undo) +;; (load-file "undo-test.elc") +;; (benchmark 100 '(let ((undo-test5-error nil)) (undo-test-all))) +;; Elapsed time: 305.218000s (104.841000s in 14804 GCs) +;; M-x elp-results +;; Function Name Call Count Elapsed Time Average Time +;; primitive-undo 2600 3.4889999999 0.0013419230 + +;;; Lisp + +;; (load-file "primundo.elc") +;; (elp-instrument-function 'primitive-undo) +;; (benchmark 100 '(undo-test-all)) +;; Elapsed time: 295.974000s (104.582000s in 14704 GCs) +;; M-x elp-results +;; Function Name Call Count Elapsed Time Average Time +;; primitive-undo 2700 3.6869999999 0.0013655555 + +;;; Code: + +(require 'ert) + +(ert-deftest undo-test0 () + "Test basics of \\[undo]." + (with-temp-buffer + (buffer-enable-undo) + (condition-case err + (undo) + (error + (unless (string= "No further undo information" + (cadr err)) + (error err)))) + (undo-boundary) + (insert "This") + (undo-boundary) + (erase-buffer) + (undo-boundary) + (insert "That") + (undo-boundary) + (forward-word -1) + (undo-boundary) + (insert "With ") + (undo-boundary) + (forward-word -1) + (undo-boundary) + (kill-word 1) + (undo-boundary) + (put-text-property (point-min) (point-max) 'face 'bold) + (undo-boundary) + (remove-text-properties (point-min) (point-max) '(face default)) + (undo-boundary) + (set-buffer-multibyte (not enable-multibyte-characters)) + (undo-boundary) + (undo) + (should + (equal (should-error (undo-more nil)) + '(wrong-type-argument integerp nil))) + (undo-more 7) + (should (string-equal "" (buffer-string))))) + +(ert-deftest undo-test1 () + "Test undo of \\[undo] command (redo)." + (with-temp-buffer + (buffer-enable-undo) + (undo-boundary) + (insert "This") + (undo-boundary) + (erase-buffer) + (undo-boundary) + (insert "That") + (undo-boundary) + (forward-word -1) + (undo-boundary) + (insert "With ") + (undo-boundary) + (forward-word -1) + (undo-boundary) + (kill-word 1) + (undo-boundary) + (facemenu-add-face 'bold (point-min) (point-max)) + (undo-boundary) + (set-buffer-multibyte (not enable-multibyte-characters)) + (undo-boundary) + (should + (string-equal (buffer-string) + (progn + (undo) + (undo-more 4) + (undo) + ;(undo-more -4) + (buffer-string)))))) + +(ert-deftest undo-test2 () + "Test basic redoing with \\[undo] command." + (with-temp-buffer + (buffer-enable-undo) + (undo-boundary) + (insert "One") + (undo-boundary) + (insert " Zero") + (undo-boundary) + (push-mark) + (delete-region (save-excursion + (forward-word -1) + (point)) (point)) + (undo-boundary) + (beginning-of-line) + (insert "Zero") + (undo-boundary) + (undo) + (should + (string-equal (buffer-string) + (progn + (undo-more 2) + (undo) + (buffer-string)))))) + +(ert-deftest undo-test3 () + "Test modtime with \\[undo] command." + (let ((tmpfile (make-temp-file "undo-test3"))) + (with-temp-file tmpfile + (let ((buffer-file-name tmpfile)) + (buffer-enable-undo) + (set (make-local-variable 'make-backup-files) nil) + (undo-boundary) + (insert ?\s) + (undo-boundary) + (basic-save-buffer) + (insert ?\t) + (undo) + (should + (string-equal (buffer-string) + (progn + (undo) + (buffer-string))))) + (delete-file tmpfile)))) + +(ert-deftest undo-test4 () + "Test \\[undo] of \\[flush-lines]." + (with-temp-buffer + (buffer-enable-undo) + (dotimes (i 1048576) + (if (zerop (% i 2)) + (insert "Evenses") + (insert "Oddses"))) + (undo-boundary) + (should + ;; Avoid string-equal because ERT will save the `buffer-string' + ;; to the explanation. Using `not' will record nil or non-nil. + (not + (null + (string-equal (buffer-string) + (progn + (flush-lines "oddses" (point-min) (point-max)) + (undo-boundary) + (undo) + (undo) + (buffer-string)))))))) + +(ert-deftest undo-test5 () + "Test basic redoing with \\[undo] command." + (with-temp-buffer + (buffer-enable-undo) + (undo-boundary) + (insert "AYE") + (undo-boundary) + (insert " BEE") + (undo-boundary) + (setq buffer-undo-list (cons '(0.0 bogus) buffer-undo-list)) + (push-mark) + (delete-region (save-excursion + (forward-word -1) + (point)) (point)) + (undo-boundary) + (beginning-of-line) + (insert "CEE") + (undo-boundary) + (undo) + (setq buffer-undo-list (cons "bogus" buffer-undo-list)) + (should + (string-equal + (buffer-string) + (progn + (if (and (boundp 'undo-test5-error) (not undo-test5-error)) + (progn + (should (null (undo-more 2))) + (should (undo))) + ;; Errors are generated by new Lisp version of + ;; `primitive-undo' not by built-in C version. + (should + (equal (should-error (undo-more 2)) + '(error "Unrecognized entry in undo list (0.0 bogus)"))) + (should + (equal (should-error (undo)) + '(error "Unrecognized entry in undo list \"bogus\"")))) + (buffer-string)))))) + +(defun undo-test-all (&optional interactive) + "Run all tests for \\[undo]." + (interactive "p") + (if interactive + (ert-run-tests-interactively "^undo-") + (ert-run-tests-batch "^undo-"))) + +(provide 'undo-tests) +;;; undo-tests.el ends here ------------------------------------------------------------ revno: 111446 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13380 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 12:34:35 -0500 message: * lisp/vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'. (cvs-mode-remove-handled): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 15:24:56 +0000 +++ lisp/ChangeLog 2013-01-08 17:34:35 +0000 @@ -1,5 +1,8 @@ 2013-01-08 Stefan Monnier + * vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'. + (cvs-mode-remove-handled): Use it (bug#13380). + * emacs-lisp/nadvice.el (advice--tweak): New function. (advice--remove-function, advice--subst-main): Use it. === modified file 'lisp/vc/pcvs.el' --- lisp/vc/pcvs.el 2013-01-01 09:11:05 +0000 +++ lisp/vc/pcvs.el 2013-01-08 17:34:35 +0000 @@ -856,7 +856,8 @@ (defun cvs-cleanup-collection (c rm-handled rm-dirs rm-msgs) "Remove undesired entries. C is the collection -RM-HANDLED if non-nil means remove handled entries. +RM-HANDLED if non-nil means remove handled entries (if file is currently + visited, only remove if value is `all'). RM-DIRS behaves like `cvs-auto-remove-directories'. RM-MSGS if non-nil means remove messages." (let (last-fi first-dir (rerun t)) @@ -870,16 +871,17 @@ (subtype (cvs-fileinfo->subtype fi)) (keep (pcase type - ;; remove temp messages and keep the others + ;; Remove temp messages and keep the others. (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) - ;; remove entries + ;; Remove dead entries. (`DEAD nil) - ;; handled also? + ;; Handled also? (`UP-TO-DATE - (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) - t - (not rm-handled))) - ;; keep the rest + (not + (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) + (eq rm-handled 'all) + rm-handled))) + ;; Keep the rest. (_ (not (run-hook-with-args-until-success 'cvs-cleanup-functions fi)))))) @@ -2121,7 +2123,7 @@ Empty directories are removed." (interactive) (cvs-cleanup-collection cvs-cookies - t (or cvs-auto-remove-directories 'handled) t)) + 'all (or cvs-auto-remove-directories 'handled) t)) (defun-cvs-mode cvs-mode-acknowledge () ------------------------------------------------------------ revno: 111445 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 11:51:11 -0500 message: * src/keyboard.c (echo_add_key): Rename from echo_add_char. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-06 02:38:04 +0000 +++ src/ChangeLog 2013-01-08 16:51:11 +0000 @@ -1,3 +1,7 @@ +2013-01-08 Stefan Monnier + + * keyboard.c (echo_add_key): Rename from echo_add_char. + 2013-01-06 Chong Yidong * keyboard.c (echo_add_char): New function, factored out from @@ -11,8 +15,8 @@ * xdisp.c (dump_glyph): Align glyph data better. Use "pD" instead of a non-portable "t" to print ptrdiff_t values. Allow up to 9 - digits for buffer positions, before misalignment starts. Display - "0" for integer "object" field. + digits for buffer positions, before misalignment starts. + Display "0" for integer "object" field. (dump_glyph_row): Adapt the header line to changes in dump_glyph. Display the newline glyph more unambiguously. @@ -53,8 +57,8 @@ 2012-12-31 Eli Zaretskii * w32.c (unsetenv): Set up the string passed to _putenv - correctly. See - http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00863.html + correctly. + See http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00863.html for the bug this caused. 2012-12-30 Paul Eggert @@ -126,8 +130,8 @@ 2012-12-27 Eli Zaretskii - * fileio.c (file_name_as_directory, directory_file_name): Accept - an additional argument MULTIBYTE to indicate whether the input C + * fileio.c (file_name_as_directory, directory_file_name): + Accept an additional argument MULTIBYTE to indicate whether the input C came from a multibyte or a unibyte Lisp string; all callers adjusted. Don't assume the input string is always multibyte. (Bug#13262) @@ -211,8 +215,8 @@ * w32.c (sys_close): Do not call delete_child on a subprocess whose handle is not yet closed. Instead, set its file descriptor to a negative value, so that reap_subprocess will call - delete_child on that subprocess when its SIGCHLD arrives. This - avoids closing handles used for communications between sys_select + delete_child on that subprocess when its SIGCHLD arrives. + This avoids closing handles used for communications between sys_select and reader_thread, which doesn't give sys_select a chance to notice that the process exited and invoke the SIGCHLD handler for it. === modified file 'src/keyboard.c' --- src/keyboard.c 2013-01-06 02:38:04 +0000 +++ src/keyboard.c 2013-01-08 16:51:11 +0000 @@ -502,7 +502,7 @@ printed. */ static void -echo_add_char (Lisp_Object c) +echo_add_key (Lisp_Object c) { int size = KEY_DESCRIPTION_SIZE + 100; char *buffer = alloca (size); @@ -586,7 +586,7 @@ { if (current_kboard->immediate_echo) { - echo_add_char (c); + echo_add_key (c); echo_now (); } } @@ -9227,7 +9227,7 @@ && NILP (Fzerop (Vecho_keystrokes)) && current_kboard->immediate_echo) { - echo_add_char (key); + echo_add_key (key); echo_dash (); } } ------------------------------------------------------------ revno: 111444 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-08 10:24:56 -0500 message: * lisp/emacs-lisp/nadvice.el (advice--tweak): New function. (advice--remove-function, advice--subst-main): Use it. * lisp/emacs-lisp/advice.el: Update commentary. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-08 11:02:58 +0000 +++ lisp/ChangeLog 2013-01-08 15:24:56 +0000 @@ -1,7 +1,14 @@ +2013-01-08 Stefan Monnier + + * emacs-lisp/nadvice.el (advice--tweak): New function. + (advice--remove-function, advice--subst-main): Use it. + + * emacs-lisp/advice.el: Update commentary. + 2013-01-08 Michael Albinus - * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Remove - spurious entry. + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + Remove spurious entry. 2013-01-08 Glenn Morris @@ -26,8 +33,8 @@ 2013-01-07 Bastien Guerry - * menu-bar.el (menu-bar-search-documentation-menu): Use - `apropos-user-option' and fix the help message. + * menu-bar.el (menu-bar-search-documentation-menu): + Use `apropos-user-option' and fix the help message. 2013-01-07 Bastien Guerry === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2013-01-07 18:03:01 +0000 +++ lisp/emacs-lisp/advice.el 2013-01-08 15:24:56 +0000 @@ -589,13 +589,11 @@ ;; Advice implements forward advice mainly via the following: 1) Separation ;; of advice definition and activation that makes it possible to accumulate ;; advice information without having the original function already defined, -;; 2) special versions of the built-in functions `fset/defalias' which check -;; for advice information whenever they define a function. If advice -;; information was found then the advice will immediately get activated when -;; the function gets defined. +;; 2) Use of the `defalias-fset-function' symbol property which lets +;; us advise the function when it gets defined. ;; Automatic advice activation means, that whenever a function gets defined -;; with either `defun', `defmacro', `fset' or by loading a byte-compiled +;; with either `defun', `defmacro', `defalias' or by loading a byte-compiled ;; file, and the function has some advice-info stored with it then that ;; advice will get activated right away. === modified file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 2013-01-02 16:30:50 +0000 +++ lisp/emacs-lisp/nadvice.el 2013-01-08 15:24:56 +0000 @@ -167,20 +167,26 @@ (setq definition (advice--cdr definition)))) found)) -;;;###autoload -(defun advice--remove-function (flist function) +(defun advice--tweak (flist tweaker) (if (not (advice--p flist)) - flist + (funcall tweaker nil flist nil) (let ((first (advice--car flist)) + (rest (advice--cdr flist)) (props (advice--props flist))) - (if (or (equal function first) - (equal function (cdr (assq 'name props)))) - (advice--cdr flist) - (let* ((rest (advice--cdr flist)) - (nrest (advice--remove-function rest function))) - (if (eq rest nrest) flist - (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props))))))) + (or (funcall tweaker first rest props) + (let ((nrest (advice--tweak rest tweaker))) + (if (eq rest nrest) flist + (advice--make-1 (aref flist 1) (aref flist 3) + first nrest props))))))) + +;;;###autoload +(defun advice--remove-function (flist function) + (advice--tweak flist + (lambda (first rest props) + (if (or (not first) + (equal function first) + (equal function (cdr (assq 'name props)))) + rest)))) (defvar advice--buffer-local-function-sample nil) @@ -269,15 +275,8 @@ ;;;; Specific application of add-function to `symbol-function' for advice. (defun advice--subst-main (old new) - (if (not (advice--p old)) - new - (let* ((first (advice--car old)) - (rest (advice--cdr old)) - (props (advice--props old)) - (nrest (advice--subst-main rest new))) - (if (equal rest nrest) old - (advice--make-1 (aref old 1) (aref old 3) - first nrest props))))) + (advice--tweak old + (lambda (first _rest _props) (if (not first) new)))) (defun advice--normalize (symbol def) (cond ------------------------------------------------------------ revno: 111443 committer: Michael Albinus + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Remove + spurious entry. + 2013-01-08 Glenn Morris * net/tramp.el (tramp-default-host-alist): Add :version. === modified file 'lisp/net/tramp-adb.el' --- lisp/net/tramp-adb.el 2013-01-07 19:44:48 +0000 +++ lisp/net/tramp-adb.el 2013-01-08 11:02:58 +0000 @@ -111,7 +111,6 @@ (directory-files . tramp-handle-directory-files) (directory-files-and-attributes . tramp-adb-handle-directory-files-and-attributes) - (file-name-all-completions . tramp-sh-handle-file-name-all-completions) (make-directory . tramp-adb-handle-make-directory) (delete-directory . tramp-adb-handle-delete-directory) (delete-file . tramp-adb-handle-delete-file) ------------------------------------------------------------ revno: 111442 committer: Bastien Guerry branch nick: trunk timestamp: Tue 2013-01-08 08:14:51 +0100 message: etc/NEWS: Document the change wrt `apropos-user-option' and `apropos-variable' diff: === modified file 'etc/NEWS' --- etc/NEWS 2013-01-02 16:13:04 +0000 +++ etc/NEWS 2013-01-08 07:14:51 +0000 @@ -32,6 +32,13 @@ * Changes in Emacs 24.4 +++ +** `apropos-variable' is now `apropos-user-option' +`apropos-user-option' shows all user options while `apropos-variable' +shows all variables. When called with a universal prefix argument, +the two commands swap their behaviors. When `apropos-do-all' is +non-nil, they output the same results. + ++++ ** `eval-defun' on an already defined defcustom calls the :set function, if there is one.