commit 5950160584b944c4cf9bb99c1804bf3b11fccc29 (HEAD, refs/remotes/origin/master) Author: YAMAMOTO Mitsuharu Date: Tue May 21 08:49:07 2019 +0900 * src/ftcrfont.c (ftcrfont_open): Skip zero glyph index. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 606db0b949..2d5a766557 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -190,7 +190,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { if (glyphs != &stack_glyph) cairo_glyph_free (glyphs); - else + else if (stack_glyph.index) { int this_width = ftcrfont_glyph_extents (font, stack_glyph.index, NULL); commit fb3b78f7b0a1391a5c20c8f795a3c514c7545d64 Author: Stephen Leake Date: Mon May 20 15:24:47 2019 -0700 Revert recent project-find-file change * lisp/progmodes/project.el (project-find-file): Delete recently added 'filename' arg; just use project-find-file-in. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index e44cee2133..ec7df78efc 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -443,14 +443,14 @@ pattern to search for." (read-regexp "Find regexp" (and id (regexp-quote id))))) ;;;###autoload -(defun project-find-file (&optional filename) +(defun project-find-file () "Visit a file (with completion) in the current project's roots. The completion default is the filename at point, if one is recognized." (interactive) (let* ((pr (project-current t)) (dirs (project-roots pr))) - (project-find-file-in (or filename (thing-at-point 'filename)) dirs pr))) + (project-find-file-in (thing-at-point 'filename) dirs pr))) ;;;###autoload (defun project-or-external-find-file () commit afdc20d73c8588e5a744ecf7bffaf4401a557d20 Author: Mattias Engdegård Date: Wed May 15 22:44:00 2019 +0200 Allow zero-argument rx `or' and `seq' forms Make the rx `or' and `seq' forms accept zero arguments to produce a never-matching regexp and an empty string, respectively. * lisp/emacs-lisp/rx.el: Require cl-extra. (rx-constituents, rx-or): Permit zero args. (rx): Amend doc string for `or' and `seq'. * test/lisp/emacs-lisp/rx-tests.el (rx-or, rx-seq): Test the change. * etc/NEWS (Changes in Specialized Modes and Packages): Mention the change. diff --git a/etc/NEWS b/etc/NEWS index 9ca98c370e..72702a9aaa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1321,6 +1321,12 @@ when given in a string. Previously, '(any "\x80-\xff")' would match characters U+0080...U+00FF. Now the expression matches raw bytes in the 128...255 range, as expected. +*** The rx 'or' and 'seq' forms no longer require any arguments. +(or) produces a regexp that never matches anything, while (seq) +matches the empty string, each being an identity for the operation. +This also works for their aliases: '|' for 'or'; ':', 'and' and +'sequence' for 'seq'. + ** Frames +++ diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 9d9028d87d..ed32490cee 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -106,15 +106,16 @@ ;;; Code: (require 'cl-lib) +(require 'cl-extra) ;; FIXME: support macros. (defvar rx-constituents ;Not `const' because some modes extend it. - '((and . (rx-and 1 nil)) + '((and . (rx-and 0 nil)) (seq . and) ; SRE (: . and) ; SRE (sequence . and) ; sregex - (or . (rx-or 1 nil)) + (or . (rx-or 0 nil)) (| . or) ; SRE (not-newline . ".") (nonl . not-newline) ; SRE @@ -390,9 +391,11 @@ FORM is of the form `(and FORM1 ...)'." "Parse and produce code from FORM, which is `(or FORM1 ...)'." (rx-check form) (rx-group-if - (if (memq nil (mapcar 'stringp (cdr form))) - (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|") + (cond + ((null (cdr form)) regexp-unmatchable) + ((cl-every #'stringp (cdr form)) (regexp-opt (cdr form) nil t)) + (t (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|"))) (and (memq rx-parent '(: * t)) rx-parent))) @@ -1121,6 +1124,7 @@ CHAR `(seq SEXP1 SEXP2 ...)' `(sequence SEXP1 SEXP2 ...)' matches what SEXP1 matches, followed by what SEXP2 matches, etc. + Without arguments, matches the empty string. `(submatch SEXP1 SEXP2 ...)' `(group SEXP1 SEXP2 ...)' @@ -1136,7 +1140,7 @@ CHAR `(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all args are strings, use `regexp-opt' to optimize the resulting - regular expression. + regular expression. Without arguments, never matches anything. `(minimal-match SEXP)' produce a non-greedy regexp for SEXP. Normally, regexps matching diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 4a5919edf0..6f392d616d 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -107,7 +107,13 @@ "ab")) (should (equal (and (string-match (rx (or "a" "ab" "abc")) s) (match-string 0 s)) - "a")))) + "a"))) + ;; Test zero-argument `or'. + (should (equal (rx (or)) regexp-unmatchable))) + +(ert-deftest rx-seq () + ;; Test zero-argument `seq'. + (should (equal (rx (seq)) ""))) (provide 'rx-tests) ;; rx-tests.el ends here. commit c2cda3ff4025e8c27bdfc2a5279f3b635c8df260 Author: Mattias Engdegård Date: Mon May 20 17:38:03 2019 +0200 Revert "Allow zero-argument rx `or' and `seq' forms" This reverts commit b552fc05c231ca6800330a318d3a74ddd0f5a13c. It caused a bootstrapping failure which I have yet to resolve - sorry. diff --git a/etc/NEWS b/etc/NEWS index 72702a9aaa..9ca98c370e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1321,12 +1321,6 @@ when given in a string. Previously, '(any "\x80-\xff")' would match characters U+0080...U+00FF. Now the expression matches raw bytes in the 128...255 range, as expected. -*** The rx 'or' and 'seq' forms no longer require any arguments. -(or) produces a regexp that never matches anything, while (seq) -matches the empty string, each being an identity for the operation. -This also works for their aliases: '|' for 'or'; ':', 'and' and -'sequence' for 'seq'. - ** Frames +++ diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 9478bd3bbd..9d9028d87d 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -110,11 +110,11 @@ ;; FIXME: support macros. (defvar rx-constituents ;Not `const' because some modes extend it. - '((and . (rx-and 0 nil)) + '((and . (rx-and 1 nil)) (seq . and) ; SRE (: . and) ; SRE (sequence . and) ; sregex - (or . (rx-or 0 nil)) + (or . (rx-or 1 nil)) (| . or) ; SRE (not-newline . ".") (nonl . not-newline) ; SRE @@ -390,11 +390,9 @@ FORM is of the form `(and FORM1 ...)'." "Parse and produce code from FORM, which is `(or FORM1 ...)'." (rx-check form) (rx-group-if - (cond - ((null (cdr form)) regexp-unmatchable) - ((cl-every #'stringp (cdr form)) + (if (memq nil (mapcar 'stringp (cdr form))) + (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|") (regexp-opt (cdr form) nil t)) - (t (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|"))) (and (memq rx-parent '(: * t)) rx-parent))) @@ -1123,7 +1121,6 @@ CHAR `(seq SEXP1 SEXP2 ...)' `(sequence SEXP1 SEXP2 ...)' matches what SEXP1 matches, followed by what SEXP2 matches, etc. - Without arguments, matches the empty string. `(submatch SEXP1 SEXP2 ...)' `(group SEXP1 SEXP2 ...)' @@ -1139,7 +1136,7 @@ CHAR `(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all args are strings, use `regexp-opt' to optimize the resulting - regular expression. Without arguments, never matches anything. + regular expression. `(minimal-match SEXP)' produce a non-greedy regexp for SEXP. Normally, regexps matching diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 6f392d616d..4a5919edf0 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -107,13 +107,7 @@ "ab")) (should (equal (and (string-match (rx (or "a" "ab" "abc")) s) (match-string 0 s)) - "a"))) - ;; Test zero-argument `or'. - (should (equal (rx (or)) regexp-unmatchable))) - -(ert-deftest rx-seq () - ;; Test zero-argument `seq'. - (should (equal (rx (seq)) ""))) + "a")))) (provide 'rx-tests) ;; rx-tests.el ends here. commit d3a0ddedba53b9e2c99274c8ec125d53f991da5d Author: Basil L. Contovounesios Date: Mon May 20 15:53:49 2019 +0100 Improve C and Elisp Git diff hunk headers For discussion, see the following threads: https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg00457.html https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00369.html * autogen.sh: Extend the built-in Git xfuncname pattern 'cpp' to match preprocessor and DEFUN macros, and the 'elisp' pattern to match cl-lib and other top-level defuns. diff --git a/autogen.sh b/autogen.sh index f390b1a777..d0f60dc68a 100755 --- a/autogen.sh +++ b/autogen.sh @@ -315,8 +315,16 @@ git_config transfer.fsckObjects true # Configure 'git diff' hunk header format. +# This xfuncname is based on Git's built-in 'cpp' pattern. +# The first line rejects jump targets and access declarations. +# The second line matches top-level functions and methods. +# The third line matches preprocessor and DEFUN macros. +git_config diff.cpp.xfuncname \ +'!^[ \t]*[A-Za-z_][A-Za-z_0-9]*:[[:space:]]*($|/[/*]) +^((::[[:space:]]*)?[A-Za-z_][A-Za-z_0-9]*[[:space:]]*\(.*)$ +^((#define[[:space:]]|DEFUN).*)$' git_config diff.elisp.xfuncname \ - '^\(def[^[:space:]]+[[:space:]]+([^()[:space:]]+)' + '^\([^[:space:]]*def[^[:space:]]+[[:space:]]+([^()[:space:]]+)' git_config 'diff.m4.xfuncname' '^((m4_)?define|A._DEFUN(_ONCE)?)\([^),]*' git_config 'diff.make.xfuncname' \ '^([$.[:alnum:]_].*:|[[:alnum:]_]+[[:space:]]*([*:+]?[:?]?|!?)=|define .*)' commit 4498e5a13a3b63a3024ceef102ae3b5c50f58be1 Author: Stefan Kangas Date: Sun May 5 15:48:57 2019 +0200 Use lexical-binding in delim-col.el and add tests Thanks to Basil L. Contovounesios for additional cleanups. For discussion, see the following thread: https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00177.html * lisp/delim-col.el: Use lexical-binding. * test/lisp/delim-col-tests.el: New file. (delim-col-tests-delimit-colummns-before-after) (delim-col-tests-delimit-columns) (delim-col-tests-delimit-columns-format/nil) (delim-col-tests-delimit-columns-format/padding) (delim-col-tests-delimit-columns-format/separator) (delim-col-tests-delimit-columns-separator) (delim-col-tests-delimit-columns-str-before-after) (delim-col-tests-delimit-columns-str-separator) (delim-col-tests-delimit-rectangle): New unit tests. diff --git a/lisp/delim-col.el b/lisp/delim-col.el index a968b32052..4b4fc7fe96 100644 --- a/lisp/delim-col.el +++ b/lisp/delim-col.el @@ -1,12 +1,12 @@ -;;; delim-col.el --- prettify all columns in a region or rectangle +;;; delim-col.el --- prettify all columns in a region or rectangle -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2019 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Maintainer: Vinicius Jose Latorre ;; Version: 2.1 -;; Keywords: internal -;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; Keywords: convenience text +;; X-URL: https://www.emacswiki.org/emacs/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -27,11 +27,6 @@ ;; delim-col helps to prettify columns in a text region or rectangle. ;; -;; To use it, make sure that this file is in load-path and insert in your -;; .emacs: -;; -;; (require 'delim-col) -;; ;; If you have, for example, the following columns: ;; ;; a b c d @@ -91,9 +86,9 @@ ;; aaa [ , ] dddd ;; aa [ , ] ddd ;; -;; Note that `delimit-columns-region' operates over all text region -;; selected, extending the region start to the beginning of line and the -;; region end to the end of line. While `delimit-columns-rectangle' +;; Note that `delimit-columns-region' operates over the entire selected +;; text region, extending the region start to the beginning of line and +;; the region end to the end of line. While `delimit-columns-rectangle' ;; operates over the text rectangle selected which rectangle diagonal is ;; given by the region start and end. ;; @@ -117,6 +112,7 @@ ;;; Code: +(require 'rect) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Options: @@ -125,6 +121,7 @@ "Prettify columns." :link '(emacs-library-link :tag "Source Lisp File" "delim-col.el") :prefix "delimit-columns-" + :group 'convenience :group 'text) (defcustom delimit-columns-str-before "" @@ -213,10 +210,11 @@ See also `delimit-columns-end' for documentation. The following relation must hold: 0 <= delimit-columns-start <= delimit-columns-end -The column number start from 0 and it's relative to the beginning of selected -region. So if you selected a text region, the first column (column 0) is -located at beginning of line. If you selected a text rectangle, the first -column (column 0) is located at left corner." +The column number starts at 0 and is relative to the beginning of +the selected region. So if you select a text region, the first +column (column 0) is located at the beginning of line. If you +select a text rectangle, the first column (column 0) is located +at the left corner." :type '(integer :tag "Column Start") :group 'columns) @@ -228,10 +226,11 @@ See also `delimit-columns-start' for documentation. The following relation must hold: 0 <= delimit-columns-start <= delimit-columns-end -The column number start from 0 and it's relative to the beginning of selected -region. So if you selected a text region, the first column (column 0) is -located at beginning of line. If you selected a text rectangle, the first -column (column 0) is located at left corner." +The column number starts at 0 and is relative to the beginning of +the selected region. So if you select a text region, the first +column (column 0) is located at the beginning of line. If you +select a text rectangle, the first column (column 0) is located +at the left corner." :type '(integer :tag "Column End") :group 'columns) @@ -247,20 +246,20 @@ column (column 0) is located at left corner." ;;;###autoload (defun delimit-columns-customize () - "Customization of `columns' group." + "Customize the `columns' group." (interactive) (customize-group 'columns)) -(defmacro delimit-columns-str (str) - `(if (stringp ,str) ,str "")) +(defun delimit-columns-str (str) + (if (stringp str) str "")) ;;;###autoload (defun delimit-columns-region (start end) "Prettify all columns in a text region. -START and END delimits the text region." +START and END delimit the text region." (interactive "*r") (let ((delimit-columns-str-before (delimit-columns-str delimit-columns-str-before)) @@ -273,8 +272,7 @@ START and END delimits the text region." (delimit-columns-after (delimit-columns-str delimit-columns-after)) (delimit-columns-start - (if (and (integerp delimit-columns-start) - (>= delimit-columns-start 0)) + (if (natnump delimit-columns-start) delimit-columns-start 0)) (delimit-columns-end @@ -309,14 +307,11 @@ START and END delimits the text region." (set-marker the-end nil))))) -(require 'rect) - - ;;;###autoload (defun delimit-columns-rectangle (start end) "Prettify all columns in a text rectangle. -START and END delimits the corners of text rectangle." +START and END delimit the corners of the text rectangle." (interactive "*r") (let ((delimit-columns-str-before (delimit-columns-str delimit-columns-str-before)) @@ -329,8 +324,7 @@ START and END delimits the corners of text rectangle." (delimit-columns-after (delimit-columns-str delimit-columns-after)) (delimit-columns-start - (if (and (integerp delimit-columns-start) - (>= delimit-columns-start 0)) + (if (natnump delimit-columns-start) delimit-columns-start 0)) (delimit-columns-end @@ -344,11 +338,11 @@ START and END delimits the corners of text rectangle." ;; get maximum length for each column (and delimit-columns-format (save-excursion - (operate-on-rectangle 'delimit-columns-rectangle-max + (operate-on-rectangle #'delimit-columns-rectangle-max start the-end nil))) ;; prettify columns (save-excursion - (operate-on-rectangle 'delimit-columns-rectangle-line + (operate-on-rectangle #'delimit-columns-rectangle-line start the-end nil)) ;; nullify markers (set-marker delimit-columns-limit nil) @@ -359,7 +353,7 @@ START and END delimits the corners of text rectangle." ;; Internal Variables and Functions: -(defun delimit-columns-rectangle-max (startpos &optional _ignore1 _ignore2) +(defun delimit-columns-rectangle-max (startpos &optional _begextra _endextra) (set-marker delimit-columns-limit (point)) (goto-char startpos) (let ((ncol 1) @@ -392,7 +386,7 @@ START and END delimits the corners of text rectangle." (setq values (cdr values))))) -(defun delimit-columns-rectangle-line (startpos &optional _ignore1 _ignore2) +(defun delimit-columns-rectangle-line (startpos &optional _begextra _endextra) (let ((len (length delimit-columns-max)) (ncol 0) origin) @@ -442,8 +436,7 @@ START and END delimits the corners of text rectangle." ((eq delimit-columns-format 'padding) (insert spaces delimit-columns-after delimit-columns-str-after)) (t - (insert delimit-columns-after spaces delimit-columns-str-after)) - )) + (insert delimit-columns-after spaces delimit-columns-str-after)))) (goto-char (max (point) delimit-columns-limit)))) @@ -466,8 +459,7 @@ START and END delimits the corners of text rectangle." (insert delimit-columns-after delimit-columns-str-separator spaces - delimit-columns-before)) - )) + delimit-columns-before)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/test/lisp/delim-col-tests.el b/test/lisp/delim-col-tests.el new file mode 100644 index 0000000000..f2a0377b07 --- /dev/null +++ b/test/lisp/delim-col-tests.el @@ -0,0 +1,181 @@ +;;; delim-col-tests.el --- Tests for delim-col.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; 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 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 +;; 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 GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'delim-col) + +(ert-deftest delim-col-tests-delimit-columns () + (with-temp-buffer + (insert "a b c\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) "a, b, c\n"))) + (with-temp-buffer + (insert "a b c d\n" + "aaaa bb ccc ddddd\n" + "aaa bbb cccc dddd\n" + "aa bb ccccccc ddd\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) + (concat "a, b, c, d \n" + "aaaa, bb, ccc, ddddd\n" + "aaa, bbb, cccc, dddd \n" + "aa, bb, ccccccc, ddd \n"))))) + +(ert-deftest delim-col-tests-delimit-rectangle () + (with-temp-buffer + (insert "a b c d\n" + "aaaa bb ccc ddddd\n" + "aaa bbb cccc dddd\n" + "aa bb ccccccc ddd\n") + (delimit-columns-rectangle 3 58) ; from first b to last c + (should (equal (buffer-string) + (concat "a b, c d\n" + "aaaa bb, ccc ddddd\n" + "aaa bbb, cccc dddd\n" + "aa bb, ccccccc ddd\n"))))) + +(ert-deftest delim-col-tests-delimit-columns-str-separator () + (let ((delimit-columns-str-separator ":")) + (with-temp-buffer + (insert "a b\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) "a:b\n"))) + (with-temp-buffer + (insert "a b c d\n" + "aa bb cc dd\n") + (delimit-columns-rectangle 3 16) ; from first b to last c + (should (equal (buffer-string) + (concat "a b: c d\n" + "aa bb:cc dd\n")))))) + +(ert-deftest delim-col-tests-delimit-columns-str-before-after () + (let ((delimit-columns-str-before "[ ") + (delimit-columns-str-after " ]")) + (with-temp-buffer + (insert "a b c\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) "[ a, b, c ]\n"))) + (with-temp-buffer + (insert "a b c d\n" + "aaaa bb ccc ddddd\n" + "aaa bbb cccc dddd\n" + "aa bb ccccccc ddd\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) + (concat "[ a, b, c, d ]\n" + "[ aaaa, bb, ccc, ddddd ]\n" + "[ aaa, bbb, cccc, dddd ]\n" + "[ aa, bb, ccccccc, ddd ]\n")))) + (with-temp-buffer + (insert "a b c d\n" + "aaaa bb ccc ddddd\n" + "aaa bbb cccc dddd\n" + "aa bb ccccccc ddd\n") + (delimit-columns-rectangle 3 58) ; from first b to last c + (should (equal (buffer-string) + (concat "a [ b, c ] d\n" + "aaaa [ bb, ccc ] ddddd\n" + "aaa [ bbb, cccc ] dddd\n" + "aa [ bb, ccccccc ] ddd\n")))))) + +(ert-deftest delim-col-tests-delimit-colummns-before-after () + (let ((delimit-columns-before "<") + (delimit-columns-after ">")) + (with-temp-buffer + (insert "a b\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) ", \n"))) + (with-temp-buffer + (insert "a b c d\n" + "aa bb cc dd\n") + (delimit-columns-rectangle 3 17) + (should (equal (buffer-string) + (concat "a , d\n" + "aa , dd\n")))))) + +(ert-deftest delim-col-tests-delimit-columns-separator () + (let ((delimit-columns-separator ",")) + (with-temp-buffer + (insert "a,b,c\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) "a, b, c\n"))))) + +(ert-deftest delim-col-tests-delimit-columns-format/nil () + (let ((delimit-columns-format nil)) + (with-temp-buffer + (insert "a b\n" + "aa bb\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) + (concat "a, b\n" + "aa, bb\n")))) + (with-temp-buffer + (insert "a b c d\n" + "aa bb cc dd\n") + (delimit-columns-rectangle 3 17) ; from first b to last c + (should (equal (buffer-string) + (concat "a b, c d\n" + "aa bb, cc dd\n")))))) + +(ert-deftest delim-col-tests-delimit-columns-format/separator () + (let ((delimit-columns-format 'separator) + (delimit-columns-before "<") + (delimit-columns-after ">")) + (with-temp-buffer + (insert "a b\n" + "aa bb\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) + (concat " , \n" + ", \n")))) + (with-temp-buffer + (insert "a b c d\n" + "aa bb cc dd\n") + (delimit-columns-rectangle 3 17) ; from first b to last c + (should (equal (buffer-string) + (concat "a , d\n" + "aa , dd\n")))))) + +(ert-deftest delim-col-tests-delimit-columns-format/padding () + (let ((delimit-columns-format 'padding) + (delimit-columns-before "<") + (delimit-columns-after ">")) + (with-temp-buffer + (insert "a b\n" + "aa bb\n") + (delimit-columns-region (point-min) (point-max)) + (should (equal (buffer-string) + (concat ", \n" + ", \n")))) + (with-temp-buffer + (insert "a b c d\n" + "aa bb cc dd\n") + (delimit-columns-rectangle 3 17) ; from first b to last c + (should (equal (buffer-string) + (concat "a , d\n" + "aa , dd\n")))))) + +(provide 'delim-col-tests) +;;; delim-col-tests.el ends here commit 9813905f834aa43eb194023f579c7e7951d96d0f Author: Alan Mackenzie Date: Mon May 20 12:46:37 2019 +0000 CC Mode: Remove unused code from c-maybe-re-mark-raw-string Acknowledge that when the function is called, it is always at the start of a string, never in the middle or at the end of one. * lisp/progmodes/cc-engine.el (c-maybe-re-mark-raw-string): Reformulate the cond form into a `when' form, with all but the first arm of the cond discarded. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c0f044ddfe..c0433672f9 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7245,78 +7245,33 @@ comment at the start of cc-engine.el for more info." (c-depropertize-raw-strings-in-region found-beg (point)))))) (defun c-maybe-re-mark-raw-string () - ;; When this function is called, point is immediately after a ". If this " - ;; is the characteristic " of of a raw string delimiter, apply the pertinent - ;; `syntax-table' text properties to the entire raw string (when properly - ;; terminated) or just the delimiter (otherwise). + ;; When this function is called, point is immediately after a " which opens + ;; a string. If this " is the characteristic " of of a raw string + ;; opener, apply the pertinent `syntax-table' text properties to the + ;; entire raw string (when properly terminated) or just the delimiter + ;; (otherwise). In either of these cases, return t, otherwise return nil. ;; - ;; If the " is in any way part of a raw string, return non-nil. Otherwise - ;; return nil. (let ((here (point)) in-macro macro-end id Rquote found) - (cond - ((and - (eq (char-before (1- (point))) ?R) - (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) + (when + (and + (eq (char-before (1- (point))) ?R) + (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) (save-excursion (setq in-macro (c-beginning-of-macro)) (setq macro-end (when in-macro (c-end-of-macro) (point) ;; (min (1+ (point)) (point-max)) ))) - (if (not + (when + (not (c-propertize-raw-string-opener (match-string-no-properties 1) ; id (1- (point)) ; open quote (match-end 1) ; open paren macro-end)) ; bound (end of macro) or nil. - (goto-char (or macro-end (point-max)))) - t) - ((save-excursion - (and - (search-backward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\"\\=" - (c-point 'bol) t) - (setq id (match-string-no-properties 1)) - (let* ((quoted-id (regexp-quote id)) - (quoted-id-depth (regexp-opt-depth quoted-id))) - (while - (and - ;; Search back for an opening delimiter with identifier `id'. - ;; A closing delimiter with `id' "blocks" our search. - (search-backward-regexp ; This could be slow. - (concat "\\(R\"" quoted-id "(\\)" - "\\|" - "\\()" quoted-id "\"\\)") - nil t) - (setq found t) - (if (eq (c-in-literal) 'string) - (match-beginning 1) - (match-beginning (+ 2 quoted-id-depth))))) - (and found - (null (c-in-literal)) - (match-beginning 1))) - (setq Rquote (point)))) - (save-excursion - (goto-char Rquote) - (setq in-macro (c-beginning-of-macro)) - (setq macro-end (when in-macro - (c-end-of-macro) - (point)))) - (if (or (not in-macro) - (<= here macro-end)) - (progn - (c-propertize-raw-string-opener - id (1+ (point)) (match-end 1) macro-end) - (goto-char here) - t) - (goto-char here) - nil)) - - (t - ;; If the " is in another part of a raw string (whether as part of the - ;; identifier, or in the string itself) the `syntax-table' text - ;; properties on the raw string will be current. So, we can use... - (c-raw-string-pos))))) + (goto-char (or macro-end (point-max)))) + t))) ;; Handling of small scale constructs like types and names. commit ec2e5a54b3b6324f1039f355fa646034918f6dba Author: Basil L. Contovounesios Date: Mon May 20 13:38:32 2019 +0100 ; Fix last change to nnheader-cancel-timer * lisp/gnus/nnheader.el (nnheader-cancel-timer) (nnheader-cancel-function-timers): Remove defalias calls made redundant by subsequent define-obsolete-function-alias calls. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index bb870746d7..6ef324ae91 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -969,10 +969,7 @@ See `find-file-noselect' for the arguments." "Strip all \r's from the current buffer." (nnheader-skeleton-replace "\r")) -(defalias 'nnheader-cancel-timer 'cancel-timer) (define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") - -(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) (define-obsolete-function-alias 'nnheader-cancel-function-timers 'cancel-function-timers "27.1") commit 4a04046b7200b9c7201c252c23a8c313d4687b5f Author: Lars Ingebrigtsen Date: Mon May 20 14:34:36 2019 +0200 w32--os-description: Fix previous change * lisp/w32-fns.el (w32--os-description): Fix inadvertant "o" added to the end of the function name in the previous patch (bug#35807). diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 2b6464ab98..443a995cb8 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -308,7 +308,7 @@ names." (declare-function w32-version "w32-win" ()) (declare-function w32-read-registry "w32fns" (root key name)) -(defun w32--os-descriptiono () +(defun w32--os-description () "Return a string describing the underlying OS and its version." (let* ((w32ver (car (w32-version))) (w9x-p (< w32ver 5)) commit bfcff8f88a472bd1a64922da094cd007d3b7a70a Author: Lars Ingebrigtsen Date: Mon May 20 13:47:16 2019 +0200 Mark nnheader-cancel-timer as obsolete and adjust callers * lisp/gnus/nnheader.el (nnheader-cancel-timer) (nnheader-cancel-function-timers): Mark as obsolete. * lisp/gnus/nntp.el (nntp-with-open-group-function) (nntp-async-stop): Adjust caller. * lisp/gnus/gnus-art.el (gnus-stop-date-timer): Ditto. * lisp/gnus/gnus-async.el (gnus-async-prefetch-next): Ditto. * lisp/gnus/gnus-demon.el (gnus-demon-run-callback) (gnus-demon-cancel): Ditto. * lisp/gnus/mail-source.el (mail-source-report-new-mail): Ditto. * lisp/gnus/nnmaildir.el (nnmaildir-request-accept-article): Ditto. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index baa8a244c0..a1b82f8aab 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3733,7 +3733,7 @@ is to run." "Stop the Date timer." (interactive) (when article-lapsed-timer - (nnheader-cancel-timer article-lapsed-timer) + (cancel-timer article-lapsed-timer) (setq article-lapsed-timer nil))) (defun article-date-user (&optional highlight) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 4e2723e8d2..b3da3505da 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -146,7 +146,7 @@ that was fetched." (when next (when gnus-async-timer (ignore-errors - (nnheader-cancel-timer 'gnus-async-timer))) + (cancel-timer 'gnus-async-timer))) (setq gnus-async-timer (run-with-idle-timer 0.1 nil 'gnus-async-prefetch-article diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 6c5e0b7f5d..cb70d9525c 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -111,7 +111,7 @@ marked with SPECIAL." func idle time)))) ((and idle (> idle (gnus-demon-idle-since))) (when time - (nnheader-cancel-timer (plist-get gnus-demon-timers func)) + (cancel-timer (plist-get gnus-demon-timers func)) (setq gnus-demon-timers (plist-put gnus-demon-timers func (run-with-idle-timer idle nil @@ -202,7 +202,7 @@ marked with SPECIAL." "Cancel any Gnus daemons." (interactive) (dotimes (i (/ (length gnus-demon-timers) 2)) - (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers))) + (cancel-timer (nth (1+ (* i 2)) gnus-demon-timers))) (setq gnus-demon-timers nil)) (defun gnus-demon-add-disconnection () diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 7514e64e7c..9d70bd5afa 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -31,7 +31,6 @@ (autoload 'auth-source-search "auth-source") (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") -(autoload 'nnheader-cancel-timer "nnheader") (require 'mm-util) (require 'message) ;; for `message-directory' @@ -989,9 +988,9 @@ This only works when `display-time' is enabled." (> (prefix-numeric-value arg) 0)))) (setq mail-source-report-new-mail on) (and mail-source-report-new-mail-timer - (nnheader-cancel-timer mail-source-report-new-mail-timer)) + (cancel-timer mail-source-report-new-mail-timer)) (and mail-source-report-new-mail-idle-timer - (nnheader-cancel-timer mail-source-report-new-mail-idle-timer)) + (cancel-timer mail-source-report-new-mail-idle-timer)) (setq mail-source-report-new-mail-timer nil) (setq mail-source-report-new-mail-idle-timer nil) (if on diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 2686cf9305..bb870746d7 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -970,7 +970,11 @@ See `find-file-noselect' for the arguments." (nnheader-skeleton-replace "\r")) (defalias 'nnheader-cancel-timer 'cancel-timer) +(define-obsolete-function-alias 'nnheader-cancel-timer 'cancel-timer "27.1") + (defalias 'nnheader-cancel-function-timers 'cancel-function-timers) +(define-obsolete-function-alias 'nnheader-cancel-function-timers + 'cancel-function-timers "27.1") ;; When changing this function, consider changing `pop3-accept-process-output' ;; as well. diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 9d02773d6f..ac125c905a 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1490,7 +1490,7 @@ This variable is set by `nnmaildir-request-article'.") 'excl) (when (fboundp 'unix-sync) (unix-sync)))) ;; no fsync :( - (nnheader-cancel-timer 24h) + (cancel-timer 24h) (condition-case err (add-name-to-file tmpfile curfile) (error diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index e2fa1d85a3..0e5057e1a4 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -647,7 +647,7 @@ command whose response triggered the error." (nntp-close-server)) (signal 'quit nil)))) (when -timer - (nnheader-cancel-timer -timer))) + (cancel-timer -timer))) nil)) (setq nntp--report-1 nntp-report-n)) nntp-with-open-group-internal)) @@ -1280,7 +1280,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (signal 'quit nil) nil)))) (when timer - (nnheader-cancel-timer timer)) + (cancel-timer timer)) (when (and process (not (memq (process-status process) '(open run)))) (with-current-buffer pbuffer @@ -1339,7 +1339,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (defun nntp-async-stop (proc) (setq nntp-async-process-list (delq proc nntp-async-process-list)) (when (and nntp-async-timer (not nntp-async-process-list)) - (nnheader-cancel-timer nntp-async-timer) + (cancel-timer nntp-async-timer) (setq nntp-async-timer nil))) (defun nntp-after-change-function (beg end len) commit b552fc05c231ca6800330a318d3a74ddd0f5a13c Author: Mattias Engdegård Date: Wed May 15 22:44:00 2019 +0200 Allow zero-argument rx `or' and `seq' forms Make the rx `or' and `seq' forms accept zero arguments to produce a never-matching regexp and an empty string, respectively. * lisp/emacs-lisp/rx.el (rx-constituents, rx-or): Permit zero args. (rx): Amend doc string for `or' and `seq'. * test/lisp/emacs-lisp/rx-tests.el (rx-or, rx-seq): Test the change. * etc/NEWS (Changes in Specialized Modes and Packages): Mention the change. diff --git a/etc/NEWS b/etc/NEWS index 9ca98c370e..72702a9aaa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1321,6 +1321,12 @@ when given in a string. Previously, '(any "\x80-\xff")' would match characters U+0080...U+00FF. Now the expression matches raw bytes in the 128...255 range, as expected. +*** The rx 'or' and 'seq' forms no longer require any arguments. +(or) produces a regexp that never matches anything, while (seq) +matches the empty string, each being an identity for the operation. +This also works for their aliases: '|' for 'or'; ':', 'and' and +'sequence' for 'seq'. + ** Frames +++ diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 9d9028d87d..9478bd3bbd 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -110,11 +110,11 @@ ;; FIXME: support macros. (defvar rx-constituents ;Not `const' because some modes extend it. - '((and . (rx-and 1 nil)) + '((and . (rx-and 0 nil)) (seq . and) ; SRE (: . and) ; SRE (sequence . and) ; sregex - (or . (rx-or 1 nil)) + (or . (rx-or 0 nil)) (| . or) ; SRE (not-newline . ".") (nonl . not-newline) ; SRE @@ -390,9 +390,11 @@ FORM is of the form `(and FORM1 ...)'." "Parse and produce code from FORM, which is `(or FORM1 ...)'." (rx-check form) (rx-group-if - (if (memq nil (mapcar 'stringp (cdr form))) - (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|") + (cond + ((null (cdr form)) regexp-unmatchable) + ((cl-every #'stringp (cdr form)) (regexp-opt (cdr form) nil t)) + (t (mapconcat (lambda (x) (rx-form x '|)) (cdr form) "\\|"))) (and (memq rx-parent '(: * t)) rx-parent))) @@ -1121,6 +1123,7 @@ CHAR `(seq SEXP1 SEXP2 ...)' `(sequence SEXP1 SEXP2 ...)' matches what SEXP1 matches, followed by what SEXP2 matches, etc. + Without arguments, matches the empty string. `(submatch SEXP1 SEXP2 ...)' `(group SEXP1 SEXP2 ...)' @@ -1136,7 +1139,7 @@ CHAR `(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all args are strings, use `regexp-opt' to optimize the resulting - regular expression. + regular expression. Without arguments, never matches anything. `(minimal-match SEXP)' produce a non-greedy regexp for SEXP. Normally, regexps matching diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 4a5919edf0..6f392d616d 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -107,7 +107,13 @@ "ab")) (should (equal (and (string-match (rx (or "a" "ab" "abc")) s) (match-string 0 s)) - "a")))) + "a"))) + ;; Test zero-argument `or'. + (should (equal (rx (or)) regexp-unmatchable))) + +(ert-deftest rx-seq () + ;; Test zero-argument `seq'. + (should (equal (rx (seq)) ""))) (provide 'rx-tests) ;; rx-tests.el ends here. commit e9f9827eb01a382bead6c180f6703322167e6f89 Author: Mattias Engdegård Date: Thu May 9 09:40:46 2019 +0200 Avoid polling in global-auto-revert-mode (bug#35418) Make `auto-revert-avoid-polling' have effect in global-auto-revert-mode. Buffers actually handled by that mode are marked with a non-nil value of `auto-revert--global-mode'. When global-auto-revert-mode is entered, eligible buffers are marked in that way, and hooks are set up to mark new buffers and take care of buffers whose file names change. This way the existing poll-avoidance logic can be used, since the entire set of buffers in auto-revert is known. A new hook, `after-set-visited-file-name-hook', was added to handle the case when the file name of a tracked buffer changes. * lisp/autorevert.el (auto-revert-avoid-polling): Amend doc string. (auto-revert--global-mode): New buffer-local variable. (global-auto-revert-mode): Mark existing buffers and set up hooks when mode is entered; do the opposite when exited. (auto-revert--global-add-current-buffer) (auto-revert--global-adopt-current-buffer) (auto-revert--set-visited-file-name-advice): New functions. (auto-revert--polled-buffers, auto-revert--need-polling-p) (auto-revert-notify-handler) (auto-revert-active-p): Modify logic to cover global-auto-revert-mode. * lisp/files.el (after-set-visited-file-name-hook): New hook. (set-visited-file-name-hook): Call new hook. * test/lisp/autorevert-tests.el (top): Use lexical-binding. (auto-revert-test--write-file, auto-revert-test--buffer-string) (auto-revert-test--wait-for, auto-revert-test--wait-for-buffer-text) (auto-revert-test05-global-notify): New test. * doc/lispref/hooks.texi (Standard Hooks): Mention new hook (in a comment, since it's unclear whether it should actually be documented here) * etc/NEWS (Changes in Specialized Modes and Packages): Update entry. diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi index 71992464e0..f775aa4d4b 100644 --- a/doc/lispref/hooks.texi +++ b/doc/lispref/hooks.texi @@ -251,6 +251,7 @@ I thought did not need to be mentioned here: Lisp: after-load-functions +after-set-visited-file-name-hook auto-coding-functions choose-completion-string-functions completing-read-function diff --git a/etc/NEWS b/etc/NEWS index d70cda179e..9ca98c370e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1443,8 +1443,7 @@ When set to a non-nil value, buffers in Auto Revert mode are no longer polled for changes periodically. This reduces the power consumption of an idle Emacs, but may fail on some network file systems; set 'auto-revert-notify-exclude-dir-regexp' to match files where -notification is not supported. The new variable currently has no -effect in 'global-auto-revert-mode'. The default value is nil. +notification is not supported. The default value is nil. *** New variable 'buffer-auto-revert-by-notification' A major mode can declare that notification on the buffer's default diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 197a2bf157..2de855b303 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -312,10 +312,7 @@ when those files are modified from another computer. When nil, buffers in Auto-Revert Mode will always be polled for changes to their files on disk every `auto-revert-interval' -seconds, in addition to using notification for those files. - -In Global Auto-Revert Mode, polling is always done regardless of -the value of this variable." +seconds, in addition to using notification for those files." :group 'auto-revert :type 'boolean :set (lambda (variable value) @@ -335,6 +332,9 @@ buffers to this list. The timer function `auto-revert-buffers' is responsible for purging the list of old buffers.") +(defvar-local auto-revert--global-mode nil + "Non-nil if buffer is handled by Global Auto-Revert mode.") + (defvar auto-revert-remaining-buffers () "Buffers not checked when user input stopped execution.") @@ -501,34 +501,107 @@ specifies in the mode line." :global t :group 'auto-revert :lighter global-auto-revert-mode-text (auto-revert-set-timer) (if global-auto-revert-mode - (auto-revert-buffers) + ;; Turn global-auto-revert-mode ON. + (progn + (dolist (buf (buffer-list)) + (with-current-buffer buf + (auto-revert--global-add-current-buffer))) + ;; Make sure future buffers are added as well. + (add-hook 'find-file-hook #'auto-revert--global-adopt-current-buffer) + (add-hook 'after-set-visited-file-name-hook + #'auto-revert--global-set-visited-file-name) + ;; To track non-file buffers, we need to listen in to buffer + ;; creation in general. Listening to major-mode changes is + ;; suitable, since we then know whether it's a mode that is tracked. + (when global-auto-revert-non-file-buffers + (add-hook 'after-change-major-mode-hook + #'auto-revert--global-adopt-current-buffer)) + (auto-revert-buffers)) + ;; Turn global-auto-revert-mode OFF. + (remove-hook 'after-change-major-mode-hook + #'auto-revert--global-adopt-current-buffer) + (remove-hook 'after-set-visited-file-name-hook + #'auto-revert--global-set-visited-file-name) + (remove-hook 'find-file-hook #'auto-revert--global-adopt-current-buffer) (dolist (buf (buffer-list)) (with-current-buffer buf - (when (and auto-revert-notify-watch-descriptor - (not (memq buf auto-revert-buffer-list))) - (auto-revert-notify-rm-watch)))))) + (when auto-revert--global-mode + (setq auto-revert--global-mode nil) + (when (and auto-revert-notify-watch-descriptor + (not (or auto-revert-mode auto-revert-tail-mode))) + (auto-revert-notify-rm-watch))))))) + +(defun auto-revert--global-add-current-buffer () + "Set current buffer to be tracked by Global Auto-Revert if appropriate." + (when (and (not auto-revert--global-mode) + (or buffer-file-name + (and global-auto-revert-non-file-buffers + (not (string-prefix-p " " (buffer-name))) + ;; Any non-file buffer must have a custom + ;; `buffer-stale-function' to be tracked, since + ;; we wouldn't know when to revert it otherwise. + (not (eq buffer-stale-function + #'buffer-stale--default-function)))) + (not (memq 'major-mode global-auto-revert-ignore-modes)) + (not global-auto-revert-ignore-buffer)) + (setq auto-revert--global-mode t))) + +(defun auto-revert--global-adopt-current-buffer () + "Consider tracking current buffer in a running Global Auto-Revert mode." + (auto-revert--global-add-current-buffer) + (auto-revert-set-timer)) + +(defun auto-revert--global-set-visited-file-name () + "Update Global Auto-Revert management of the current buffer. +Called after `set-visited-file-name'." + ;; Remove any existing notifier first so that we don't track the + ;; wrong file in case the file name was changed. + (when auto-revert-notify-watch-descriptor + (auto-revert-notify-rm-watch)) + (auto-revert--global-adopt-current-buffer)) (defun auto-revert--polled-buffers () "List of buffers that need to be polled." - (cond (global-auto-revert-mode (buffer-list)) + (cond (global-auto-revert-mode + (mapcan (lambda (buffer) + (and (not (and auto-revert-avoid-polling + (buffer-local-value + 'auto-revert-notify-watch-descriptor + buffer))) + (or (buffer-local-value + 'auto-revert--global-mode buffer) + (buffer-local-value 'auto-revert-mode buffer) + (buffer-local-value 'auto-revert-tail-mode buffer)) + (list buffer))) + (buffer-list))) (auto-revert-avoid-polling (mapcan (lambda (buffer) - (and (not (buffer-local-value - 'auto-revert-notify-watch-descriptor buffer)) - (list buffer))) - auto-revert-buffer-list)) + (and (not (buffer-local-value + 'auto-revert-notify-watch-descriptor buffer)) + (list buffer))) + auto-revert-buffer-list)) (t auto-revert-buffer-list))) ;; Same as above in a boolean context, but cheaper. (defun auto-revert--need-polling-p () "Whether periodic polling is required." - (or global-auto-revert-mode - (if auto-revert-avoid-polling - (not (cl-every (lambda (buffer) - (buffer-local-value - 'auto-revert-notify-watch-descriptor buffer)) - auto-revert-buffer-list)) - auto-revert-buffer-list))) + (cond (global-auto-revert-mode + (or (not auto-revert-avoid-polling) + (cl-some + (lambda (buffer) + (and (not (buffer-local-value + 'auto-revert-notify-watch-descriptor buffer)) + (or (buffer-local-value 'auto-revert--global-mode buffer) + (buffer-local-value 'auto-revert-mode buffer) + (buffer-local-value 'auto-revert-tail-mode buffer)))) + (buffer-list)))) + (auto-revert-avoid-polling + (not (cl-every + (lambda (buffer) + (buffer-local-value + 'auto-revert-notify-watch-descriptor buffer)) + auto-revert-buffer-list))) + (t auto-revert-buffer-list))) (defun auto-revert-set-timer () "Restart or cancel the timer used by Auto-Revert Mode. @@ -652,9 +725,8 @@ system.") (null buffer-file-name)) (auto-revert-notify-rm-watch) ;; Restart the timer if it wasn't running. - (when (and (memq buffer auto-revert-buffer-list) - (not auto-revert-timer)) - (auto-revert-set-timer))))) + (unless auto-revert-timer) + (auto-revert-set-timer)))) ;; Loop over all buffers, in order to find the intended one. (cl-dolist (buffer buffers) @@ -697,12 +769,10 @@ If the buffer needs to be reverted, do it now." (auto-revert-handler))))) (defun auto-revert-active-p () - "Check if auto-revert is active (in current buffer or globally)." + "Check if auto-revert is active in current buffer." (or auto-revert-mode auto-revert-tail-mode - (and global-auto-revert-mode - (not global-auto-revert-ignore-buffer) - (not (memq major-mode global-auto-revert-ignore-modes))))) + auto-revert--global-mode)) (defun auto-revert-handler () "Revert current buffer, if appropriate. diff --git a/lisp/files.el b/lisp/files.el index 21fa6143e3..989d1cb465 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4268,6 +4268,9 @@ However, the mode will not be changed if :type 'boolean :group 'editing-basics) +(defvar after-set-visited-file-name-hook nil + "Normal hook run just after setting visited file name of current buffer.") + (defun set-visited-file-name (filename &optional no-query along-with-file) "Change name of file visited in current buffer to FILENAME. This also renames the buffer to correspond to the new file. @@ -4388,7 +4391,8 @@ the old visited file has been renamed to the new name FILENAME." (set-auto-mode t) (or (eq old major-mode) (hack-local-variables)))) - (error nil)))) + (error nil)) + (run-hooks 'after-set-visited-file-name-hook))) (defun write-file (filename &optional confirm) "Write current buffer into file FILENAME. diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 040dbb45a9..5024a2daf0 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -1,4 +1,4 @@ -;;; auto-revert-tests.el --- Tests of auto-revert +;;; auto-revert-tests.el --- Tests of auto-revert -*- lexical-binding: t -*- ;; Copyright (C) 2015-2019 Free Software Foundation, Inc. @@ -436,6 +436,111 @@ This expects `auto-revert--messages' to be bound by (auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired "Check remote autorevert for dired.") +(defun auto-revert-test--write-file (string file) + "Write STRING to FILE." + (write-region string nil file nil 'no-message)) + +(defun auto-revert-test--buffer-string (buffer) + "Contents of BUFFER as a string." + (with-current-buffer buffer + (buffer-string))) + +(defun auto-revert-test--wait-for (pred max-wait) + "Wait until PRED is true, or MAX-WAIT seconds elapsed." + (let ((ct (current-time))) + (while (and (< (float-time (time-subtract (current-time) ct)) max-wait) + (not (funcall pred))) + (read-event nil nil 0.1)))) + +(defun auto-revert-test--wait-for-buffer-text (buffer string max-wait) + "Wait until BUFFER has the contents STRING, or MAX-WAIT seconds elapsed." + (auto-revert-test--wait-for + (lambda () (string-equal (auto-revert-test--buffer-string buffer) string)) + max-wait)) + +(ert-deftest auto-revert-test05-global-notify () + "Test `global-auto-revert-mode' without polling." + :tags '(:expensive-test) + (skip-unless (or file-notify--library + (file-remote-p temporary-file-directory))) + (let* ((auto-revert-use-notify t) + (auto-revert-avoid-polling t) + (was-in-global-auto-revert-mode global-auto-revert-mode) + (file-1 (make-temp-file "global-auto-revert-test-1")) + (file-2 (make-temp-file "global-auto-revert-test-2")) + (file-3 (make-temp-file "global-auto-revert-test-3")) + (file-2b (concat file-2 "-b")) + buf-1 buf-2 buf-3) + (unwind-protect + (progn + (setq buf-1 (find-file-noselect file-1)) + (setq buf-2 (find-file-noselect file-2)) + (auto-revert-test--write-file "1-a" file-1) + (should (equal (auto-revert-test--buffer-string buf-1) "")) + + (global-auto-revert-mode 1) ; Turn it on. + + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-1)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-2)) + + ;; buf-1 should have been reverted immediately when the mode + ;; was enabled. + (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) + + ;; Alter a file. + (auto-revert-test--write-file "2-a" file-2) + ;; Allow for some time to handle notification events. + (auto-revert-test--wait-for-buffer-text buf-2 "2-a" 1) + (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) + + ;; Visit a file, and modify it on disk. + (setq buf-3 (find-file-noselect file-3)) + ;; Newly opened buffers won't be use notification until the + ;; first poll cycle; wait for it. + (auto-revert-test--wait-for + (lambda () (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-3)) + (+ auto-revert-interval 1)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-3)) + (auto-revert-test--write-file "3-a" file-3) + (auto-revert-test--wait-for-buffer-text buf-3 "3-a" 1) + (should (equal (auto-revert-test--buffer-string buf-3) "3-a")) + + ;; Delete a visited file, and re-create it with new contents. + (delete-file file-1) + (sleep-for 0.5) + (should (equal (auto-revert-test--buffer-string buf-1) "1-a")) + (auto-revert-test--write-file "1-b" file-1) + (auto-revert-test--wait-for-buffer-text buf-1 "1-b" + (+ auto-revert-interval 1)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-1)) + + ;; Write a buffer to a new file, then modify the new file on disk. + (with-current-buffer buf-2 + (write-file file-2b)) + (should (equal (auto-revert-test--buffer-string buf-2) "2-a")) + (auto-revert-test--write-file "2-b" file-2b) + (auto-revert-test--wait-for-buffer-text buf-2 "2-b" + (+ auto-revert-interval 1)) + (should (buffer-local-value + 'auto-revert-notify-watch-descriptor buf-2))) + + ;; Clean up. + (unless was-in-global-auto-revert-mode + (global-auto-revert-mode 0)) ; Turn it off. + (dolist (buf (list buf-1 buf-2 buf-3)) + (ignore-errors (kill-buffer buf))) + (dolist (file (list file-1 file-2 file-2b file-3)) + (ignore-errors (delete-file file))) + ))) + +(auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired + "Test `global-auto-revert-mode' without polling for remote buffers.") + (defun auto-revert-test-all (&optional interactive) "Run all tests for \\[auto-revert]." (interactive "p")