commit e7b8c93f94a2f7ccab5a872d6454f312a2a37a70 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Tue Oct 20 03:21:16 2020 +0200 * lisp/image-file.el: Use lexical-binding. diff --git a/lisp/image-file.el b/lisp/image-file.el index 22366c89e6..3b4f572251 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -1,4 +1,4 @@ -;;; image-file.el --- support for visiting image files +;;; image-file.el --- support for visiting image files -*- lexical-binding:t -*- ;; ;; Copyright (C) 2000-2020 Free Software Foundation, Inc. ;; @@ -90,7 +90,7 @@ the variable is set using \\[customize]." t) "\\'")))) (mapconcat - 'identity + #'identity (delq nil (list exts-regexp image-file-name-regexps (car (rassq 'imagemagick image-type-file-name-regexps)))) commit 196d6c851c7d154f6e660456e287a46eed2c8898 Author: Stefan Kangas Date: Tue Oct 20 03:14:36 2020 +0200 Make a bookmark test more robust * test/lisp/bookmark-tests.el (bookmark-tests-insert-annotation): Make test more robust by not being timing dependent. diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index d0162889a8..6745e4c1d8 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -312,7 +312,7 @@ the lexically-bound variable `buffer'." (with-bookmark-test (should-error (bookmark-insert-annotation "a missing bookmark")) (bookmark-insert-annotation "name") - (should (equal (buffer-string) (bookmark-default-annotation-text "name")))) + (should (string-match "Type the annotation" (buffer-string)))) (with-bookmark-test (bookmark-set-annotation "name" "some stuff") (bookmark-insert-annotation "name") commit 72bdc44caefc5b77fb7fafeb15e9c58ee6e5f7a8 Author: Basil L. Contovounesios Date: Mon Oct 19 21:12:04 2020 +0100 ; Fix last change in modus-themes.texi * doc/misc/modus-themes.texi (How do the themes look like): Update xref with new spelling. diff --git a/doc/misc/modus-themes.texi b/doc/misc/modus-themes.texi index 383073c00d..de3ccd27c4 100644 --- a/doc/misc/modus-themes.texi +++ b/doc/misc/modus-themes.texi @@ -177,7 +177,7 @@ display that draw attention to details and important aspects in the design of the themes. They also showcase the numerous customization options. -@xref{Customisation Options, , Customisation options}. +@xref{Customization Options}. @node Learn about the latest changes @section Learn about the latest changes commit 8c96c720fa5ee67b902778199ee35991779300dc Author: Stefan Kangas Date: Mon Oct 19 20:30:52 2020 +0200 Add command package-menu-filter-upgradable * lisp/emacs-lisp/package.el (package-menu-filter-upgradable): New command. (Bug#41436) (package-menu-mode-map): Bind the new command. * doc/emacs/package.texi (Package Menu): Document the new command. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 453d9eb401..56e8ee1363 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -222,6 +222,12 @@ lower, equal or higher version than the one specified. Filter package list by non-empty mark (@code{package-menu-filter-marked}). This shows only the packages that have been marked to be installed or deleted. +@item / u +@kindex / u @r{(Package Menu)} +@findex package-menu-filter-upgradable +Filter package list to show only packages for which there are +available upgrades (@code{package-menu-filter-upgradable}). + @item / / @kindex / / @r{(Package Menu)} @findex package-menu-filter-clear diff --git a/etc/NEWS b/etc/NEWS index 390cccbff3..c571fa95d1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -736,6 +736,7 @@ key binding / s package-menu-filter-by-status / v package-menu-filter-by-version / m package-menu-filter-marked +/ u package-menu-filter-upgradable / / package-menu-filter-clear --- diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7b192d640b..23692aab32 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2708,6 +2708,7 @@ either a full name or nil, and EMAIL is a valid email address." (define-key map (kbd "/ s") 'package-menu-filter-by-status) (define-key map (kbd "/ v") 'package-menu-filter-by-version) (define-key map (kbd "/ m") 'package-menu-filter-marked) + (define-key map (kbd "/ u") 'package-menu-filter-upgradable) map) "Local keymap for `package-menu-mode' buffers.") @@ -3904,6 +3905,15 @@ Unlike other filters, this leaves the marks intact." (tabulated-list-put-tag (char-to-string mark) t))) (user-error "No packages found"))))) +(defun package-menu-filter-upgradable () + "Filter \"*Packages*\" buffer to show only upgradable packages." + (interactive) + (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) + (package-menu--filter-by + (lambda (pkg) + (memql (package-desc-name pkg) pkgs)) + "upgradable"))) + (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." (interactive) commit f831fa174425d3f945dcbd399290ce9cc68e8ea2 Author: Stefan Monnier Date: Mon Oct 19 13:39:42 2020 -0400 * lisp/progmodes/python.el: Bump version to release the f-string support diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d1871c93a7..7f4d2251fd 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el -;; Version: 0.26.1 +;; Version: 0.27 ;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 commit ed9520b38e1fb8dc45a9eb4227ceb49387843de2 Author: Stefan Monnier Date: Mon Oct 19 13:03:41 2020 -0400 * lisp/mail/rfc2231.el (rfc2231-decode-encoded-string): Fix match data error Get (match-string 3 string) earlier, in case `mm-charset-to-coding-system` clobbers the match data. Also, check that `string-match` succeeded before using its match data. diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index add099745b..17da60e0be 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -215,23 +215,25 @@ These look like: \"\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", \"\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", or \"This is ***fun***\"." - (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) - (let ((coding-system (mm-charset-to-coding-system - (match-string 1 string) nil t)) - ;;(language (match-string 2 string)) - (value (match-string 3 string))) - (mm-with-unibyte-buffer - (insert value) - (goto-char (point-min)) - (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t) - (insert - (prog1 - (string-to-number (match-string 1) 16) - (delete-region (match-beginning 0) (match-end 0))))) - ;; Decode using the charset, if any. - (if (memq coding-system '(nil ascii)) - (buffer-string) - (decode-coding-string (buffer-string) coding-system))))) + (if (not (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)\\'" + string)) + (error "Unrecognized RFC2231 format: %S" string) + (let ((value (match-string 3 string)) + ;;(language (match-string 2 string)) + (coding-system (mm-charset-to-coding-system + (match-string 1 string) nil t))) + (mm-with-unibyte-buffer + (insert value) + (goto-char (point-min)) + (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t) + (insert + (prog1 + (string-to-number (match-string 1) 16) + (delete-region (match-beginning 0) (match-end 0))))) + ;; Decode using the charset, if any. + (if (memq coding-system '(nil ascii)) + (buffer-string) + (decode-coding-string (buffer-string) coding-system)))))) (defun rfc2231-encode-string (param value) "Return a PARAM=VALUE string encoded according to RFC2231. commit 4970e2c7ea1ec144f152829cb88416616b719d4a Author: Protesilaos Stavrou Date: Mon Oct 19 15:48:10 2020 +0300 Fix documentation of the Modus Themes (Bug#43944) * doc/misc/modus-themes.texi (Installation): Remove reference to MELPA. (Top) (Install from the archives, GNU Guix) (Load at a given time or at sunset/sunrise) (Configure options prior to loading, Command prompts) (Headings' font, Will NOT be supported): Fix spelling, wording, markup. (Acknowledgements): Spell contributor's surname correctly. diff --git a/doc/misc/modus-themes.texi b/doc/misc/modus-themes.texi index c34ee15229..383073c00d 100644 --- a/doc/misc/modus-themes.texi +++ b/doc/misc/modus-themes.texi @@ -50,8 +50,8 @@ and with no Back-Cover Texts. * Overview:: * Installation:: * Enable and load:: -* Customisation Options:: -* Advanced customisation (do-it-yourself):: +* Customization Options:: +* Advanced customization (do-it-yourself):: * Face coverage:: * Notes for individual packages:: * Contributing:: @@ -85,7 +85,7 @@ Enable and load * Toggle between the themes on demand:: * Configure options prior to loading:: -Customisation Options +Customization Options * Bold constructs:: Toggle bold constructs in code * Slanted constructs:: Toggle slanted constructs (italics) in code @@ -108,7 +108,7 @@ Scaled headings * Scaled heading sizes:: Specify rate of increase for scaled headings -Advanced customisation (do-it-yourself) +Advanced customization (do-it-yourself) * Tweak colors (DIY):: Declare your own palette overrides * Font configs (DIY):: Optimise for mixed typeface buffers @@ -193,9 +193,8 @@ On older versions of Emacs, they can be installed using Emacs' package manager or manually from their code repository. Modus Operandi (light theme) and Modus Vivendi (dark) are normally -distributed as standalone packages in Emacs-specific archives: GNU ELPA, -MELPA, and MELPA Stable. There also exist packages for GNU/Linux -distributions. +distributed as standalone packages in Emacs-specific archives. There +also exist packages for GNU/Linux distributions. @menu * Install from the archives:: @@ -206,14 +205,12 @@ distributions. @section Install from the archives @samp{modus-operandi-theme} and @samp{modus-vivendi-theme} are -available from GNU ELPA. +available from the GNU ELPA archive, which is configured by default. Prior to querying any package archive, make sure to have updated the index, with @samp{M-x package-refresh-contents}. Then all you need to do is type @samp{M-x package-install} and specify the theme of your choice. -GNU ELPA contains the last tagged release. - @node Install on GNU/Linux @section Install on GNU/Linux @@ -247,22 +244,22 @@ Users of either the Guix System (the distro) or just Guix (the package manager) can get each theme as a standalone package. @example -guix package -i modus-operandi-theme +guix package -i emacs-modus-operandi-theme @end example And/or: @example -guix package -i modus-vivendi-theme +guix package -i emacs-modus-vivendi-theme @end example @node Enable and load @chapter Enable and load -This section documents how to load the theme of your -choice and how to further control its initialization. It also includes -some sample code snippets that could help you in the task, especially if -you intend to use both Modus Operandi and Modus Vivendi. +This section documents how to load the theme of your choice and how to +further control its initialization. It also includes some sample code +snippets that could help you in the task, especially if you intend to +use both Modus Operandi and Modus Vivendi. @menu * Load automatically:: @@ -298,7 +295,7 @@ evaluate the expression: @section Load at a given time or at sunset/sunrise It is possible to schedule a time during the day at or after which a -given theme will be loaded.@footnote{Contributed on Reddit by user b3n +given theme will be loaded.@footnote{Contributed on Reddit by user @samp{b3n} @uref{https://www.reddit.com/r/emacs/comments/gdtqov/weekly_tipstricketc_thread/fq9186h/}.} @lisp @@ -373,7 +370,7 @@ disabling a single target, but you get the idea. @section Configure options prior to loading If you plan to use both themes and wish to apply styles consistently -(see @ref{Customisation Options}), you could define wrapper functions around +(see @ref{Customization Options}), you could define wrapper functions around the standard @samp{load-theme} command. These extend the simple function we presented in @ref{Toggle between the themes on demand}. @@ -427,8 +424,8 @@ method were contributed on Reddit by user @samp{b3n}, (modus-operandi-theme-load))) @end lisp -@node Customisation Options -@chapter Customisation Options +@node Customization Options +@chapter Customization Options The Modus themes are highly configurable, though they should work well without any further tweaks. @@ -639,7 +636,7 @@ background and foreground to the minibuffer and other REPL prompts (like @samp{M-x shell} and @samp{M-x eshell}). The difference between the two is that the latter has a more pronounced/noticeable effect than the former. -The default is not to use any background for such prompts, while relying +The default does not use any background for such prompts, while relying exclusively on an accented foreground color. @node Mode line @@ -1182,13 +1179,13 @@ main font family. @ref{Font configs (DIY), , Font configurations for Org (and others)}. -@node Advanced customisation (do-it-yourself) -@chapter Advanced customisation (do-it-yourself) +@node Advanced customization (do-it-yourself) +@chapter Advanced customization (do-it-yourself) Unlike the predefined customization options which follow a straightforward pattern of allowing the user to quickly specify their preference, the themes also provide a more flexible, albeit difficult, -mechanism to control things with precision (see @ref{Customisation Options}). +mechanism to control things with precision (see @ref{Customization Options}). This section is of interest only to users who are prepared to maintain their own local tweaks and who are willing to deal with any possible @@ -2043,7 +2040,7 @@ that secondary elements like sidebars can have the default (pure white/black) background. I will only cover this package if it ever supports the inverse effect: -less intense colors (but still accessible) for supportive interfaces +less intense colors (but still accessible) for ancillary interfaces and the intended styles for the content you are actually working on. @node Notes for individual packages @@ -2302,13 +2299,13 @@ The Modus themes are a collective effort. Every contribution counts. Protesilaos Stavrou. @item Code contributions -Anders Johansson, Basil L@. Contovounisios, +Anders Johansson, Basil L@. Contovounesios, Markus Beppler, Matthew Stevenson. @item Ideas and user feedback Aaron Jensen, Adam Spiers, Alex Griffin, Alex Peitsinis, Alexey Shmalko, Anders Johansson, André Alexandre -Gomes, Arif Rezai, Basil L@. Contovounisios, Damien Cassou, Dario +Gomes, Arif Rezai, Basil L@. Contovounesios, Damien Cassou, Dario Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Gerry Agbobada, Gianluca Recchia, Iris Garcia, Len Trigg, Manuel Uberti, Mark Burton, Markus Beppler, Michael Goldenberg, Murilo Pereira, commit fe16248b77067281e25ac90b393a1e0da77d445e Author: Stefan Kangas Date: Sat Sep 12 19:49:20 2020 +0200 Make auto-revert-mode tests run faster * test/lisp/autorevert-tests.el (auto-revert--timeout): Make into defun and shorten timeout by a factor 10. (auto-revert--wait-for-revert): Cut timeouts in half. (with-auto-revert-test): New macro to set timeout to 0.1. (auto-revert-tests--write-file): New defun. (auto-revert-test00-auto-revert-mode) (auto-revert-test01-auto-revert-several-files) (auto-revert-test02-auto-revert-deleted-file) (auto-revert-test03-auto-revert-tail-mode) (auto-revert-test04-auto-revert-mode-dired) (auto-revert-test05-global-notify) (auto-revert-test06-write-file): Adapt test to run faster. Remove :expensive-test marks. This was discussed in: https://lists.gnu.org/r/emacs-devel/2020-10/msg01233.html diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 3243a80e52..1b26a3d246 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -61,8 +61,9 @@ file-notify-debug nil tramp-verbose 0) -(defconst auto-revert--timeout (1+ auto-revert-interval) - "Time to wait for a message.") +(defun auto-revert--timeout () + "Time to wait for a message." + (+ auto-revert-interval 0.1)) (defvar auto-revert--messages nil "Used to collect messages issued during a section of a test.") @@ -125,14 +126,14 @@ This expects `auto-revert--messages' to be bound by ;; Remote files do not cooperate well with timers. So we count ourselves. (let ((ct (current-time))) (while (and (< (float-time (time-subtract (current-time) ct)) - auto-revert--timeout) + (auto-revert--timeout)) (null (string-match (format-message "Reverting buffer `%s'\\." (buffer-name buffer)) auto-revert--messages))) (if (with-current-buffer buffer auto-revert-use-notify) - (read-event nil nil 0.1) - (sleep-for 0.1))))) + (read-event nil nil 0.05) + (sleep-for 0.05))))) (defmacro auto-revert--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." @@ -152,51 +153,59 @@ This expects `auto-revert--messages' to be bound by (funcall (ert-test-body ert-test)) (error (message "%s" err) (signal (car err) (cdr err))))))) +(defmacro with-auto-revert-test (&rest body) + `(let ((auto-revert-interval-orig auto-revert-interval)) + (unwind-protect + (progn + (customize-set-variable 'auto-revert-interval 0.1) + ,@body) + (customize-set-variable 'auto-revert-interval auto-revert-interval-orig)))) + +(defun auto-revert-tests--write-file (text file time-delta &optional append) + (write-region text nil file append 'no-message) + (set-file-times file (time-subtract (current-time) time-delta))) + (ert-deftest auto-revert-test00-auto-revert-mode () "Check autorevert for a file." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. - :tags '(:expensive-test) - (let ((tmpfile (make-temp-file "auto-revert-test")) - buf) - (unwind-protect - (progn - (write-region "any text" nil tmpfile nil 'no-message) - (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (ert-with-message-capture auto-revert--messages - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf)) - (should (string-match "another text" (buffer-string))) - - ;; When the buffer is modified, it shall not be reverted. - (ert-with-message-capture auto-revert--messages - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer hasn't been reverted. - (auto-revert--wait-for-revert buf)) - (should-not (string-match "any text" (buffer-string))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let ((tmpfile (make-temp-file "auto-revert-test")) + (times '(60 30 15)) + buf) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf)) + (should (string-match "another text" (buffer-string))) + + ;; When the buffer is modified, it shall not be reverted. + (ert-with-message-capture auto-revert--messages + (set-buffer-modified-p t) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf)) + (should-not (string-match "any text" (buffer-string))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test00-auto-revert-mode "Check autorevert for a remote file.") @@ -204,66 +213,65 @@ This expects `auto-revert--messages' to be bound by ;; This is inspired by Bug#21841. (ert-deftest auto-revert-test01-auto-revert-several-files () "Check autorevert for several files at once." - :tags '(:expensive-test) (skip-unless (executable-find "cp" (file-remote-p temporary-file-directory))) - (let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory))) - (tmpdir1 (make-temp-file "auto-revert-test" 'dir)) - (tmpdir2 (make-temp-file "auto-revert-test" 'dir)) - (tmpfile1 - (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) - (tmpfile2 - (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) - buf1 buf2) - (unwind-protect - (ert-with-message-capture auto-revert--messages - (write-region "any text" nil tmpfile1 nil 'no-message) - (setq buf1 (find-file-noselect tmpfile1)) - (write-region "any text" nil tmpfile2 nil 'no-message) - (setq buf2 (find-file-noselect tmpfile2)) - - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that - ;; it returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode))) - - ;; Modify files. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region - "another text" nil - (expand-file-name (file-name-nondirectory tmpfile1) tmpdir2) - nil 'no-message) - (write-region - "another text" nil - (expand-file-name (file-name-nondirectory tmpfile2) tmpdir2) - nil 'no-message) - ;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents) - ;; Strange, that `copy-directory' does not work as expected. - ;; The following shell command is not portable on all - ;; platforms, unfortunately. - (shell-command - (format "%s -f %s/* %s" - cp (file-local-name tmpdir2) (file-local-name tmpdir1))) - - ;; Check, that the buffers have been reverted. - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf - (auto-revert--wait-for-revert buf) - (should (string-match "another text" (buffer-string)))))) - - ;; Exit. - (ignore-errors - (dolist (buf (list buf1 buf2)) - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf))) - (ignore-errors (delete-directory tmpdir1 'recursive)) - (ignore-errors (delete-directory tmpdir2 'recursive))))) + (with-auto-revert-test + (let* ((cp (executable-find "cp" (file-remote-p temporary-file-directory))) + (tmpdir1 (make-temp-file "auto-revert-test" 'dir)) + (tmpdir2 (make-temp-file "auto-revert-test" 'dir)) + (tmpfile1 + (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) + (tmpfile2 + (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) + (times '(120 60 30 15)) + buf1 buf2) + (unwind-protect + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "any text" tmpfile1 (pop times)) + (setq buf1 (find-file-noselect tmpfile1)) + (auto-revert-tests--write-file "any text" tmpfile2 (pop times)) + (setq buf2 (find-file-noselect tmpfile2)) + + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that + ;; it returns nil. + (auto-revert-mode 1) + (should auto-revert-mode))) + + ;; Modify files. We wait for a second, in order to have + ;; another timestamp. + (auto-revert-tests--write-file + "another text" + (expand-file-name (file-name-nondirectory tmpfile1) tmpdir2) + (pop times)) + (auto-revert-tests--write-file + "another text" + (expand-file-name (file-name-nondirectory tmpfile2) tmpdir2) + (pop times)) + ;;(copy-directory tmpdir2 tmpdir1 nil 'copy-contents) + ;; Strange, that `copy-directory' does not work as expected. + ;; The following shell command is not portable on all + ;; platforms, unfortunately. + (shell-command + (format "%s -f %s/* %s" + cp (file-local-name tmpdir2) (file-local-name tmpdir1))) + + ;; Check, that the buffers have been reverted. + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf + (auto-revert--wait-for-revert buf) + (should (string-match "another text" (buffer-string)))))) + + ;; Exit. + (ignore-errors + (dolist (buf (list buf1 buf2)) + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf))) + (ignore-errors (delete-directory tmpdir1 'recursive)) + (ignore-errors (delete-directory tmpdir2 'recursive)))))) (auto-revert--deftest-remote auto-revert-test01-auto-revert-several-files "Check autorevert for several remote files at once.") @@ -271,84 +279,81 @@ This expects `auto-revert--messages' to be bound by ;; This is inspired by Bug#23276. (ert-deftest auto-revert-test02-auto-revert-deleted-file () "Check autorevert for a deleted file." - :tags '(:expensive-test) ;; Repeated unpredictable failures, bug#32645. ;; Unlikely to be hydra-specific? ; (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - (let ((tmpfile (make-temp-file "auto-revert-test")) - ;; Try to catch bug#32645. - (auto-revert-debug (getenv "EMACS_HYDRA_CI")) - (file-notify-debug (getenv "EMACS_HYDRA_CI")) - buf desc) - (unwind-protect - (progn - (write-region "any text" nil tmpfile nil 'no-message) - (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (should-not - (file-notify-valid-p auto-revert-notify-watch-descriptor)) - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that - ;; it returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - (setq desc auto-revert-notify-watch-descriptor) - - ;; Remove file while reverting. We simulate this by - ;; modifying `before-revert-hook'. - (add-hook - 'before-revert-hook - (lambda () - (when auto-revert-debug - (message "%s deleted" buffer-file-name)) - (delete-file buffer-file-name)) - nil t) - - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer hasn't been reverted. File - ;; notification should be disabled, falling back to - ;; polling. - (should (string-match "any text" (buffer-string))) - ;; With w32notify, and on emba, the `stopped' events are not sent. - (or (eq file-notify--library 'w32notify) - (getenv "EMACS_EMBA_CI") - (should-not - (file-notify-valid-p auto-revert-notify-watch-descriptor))) - - ;; Once the file has been recreated, the buffer shall be - ;; reverted. - (kill-local-variable 'before-revert-hook) - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should (string-match "another text" (buffer-string))) - ;; When file notification is used, it must be reenabled - ;; after recreation of the file. We cannot expect that - ;; the descriptor is the same, so we just check the - ;; existence. - (should (eq (null desc) (null auto-revert-notify-watch-descriptor))) - - ;; An empty file shall still be reverted. - (ert-with-message-capture auto-revert--messages - (sleep-for 1) - (write-region "" nil tmpfile nil 'no-message) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should (string-equal "" (buffer-string))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let ((tmpfile (make-temp-file "auto-revert-test")) + ;; Try to catch bug#32645. + (auto-revert-debug (getenv "EMACS_HYDRA_CI")) + (file-notify-debug (getenv "EMACS_HYDRA_CI")) + (times '(120 60 30 15)) + buf desc) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (should-not + (file-notify-valid-p auto-revert-notify-watch-descriptor)) + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that + ;; it returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + (setq desc auto-revert-notify-watch-descriptor) + + ;; Remove file while reverting. We simulate this by + ;; modifying `before-revert-hook'. + (add-hook + 'before-revert-hook + (lambda () + (when auto-revert-debug + (message "%s deleted" buffer-file-name)) + (delete-file buffer-file-name)) + nil t) + + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer hasn't been reverted. File + ;; notification should be disabled, falling back to + ;; polling. + (should (string-match "any text" (buffer-string))) + ;; With w32notify, and on emba, the `stopped' events are not sent. + (or (eq file-notify--library 'w32notify) + (getenv "EMACS_EMBA_CI") + (should-not + (file-notify-valid-p auto-revert-notify-watch-descriptor))) + + ;; Once the file has been recreated, the buffer shall be + ;; reverted. + (kill-local-variable 'before-revert-hook) + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should (string-match "another text" (buffer-string))) + ;; When file notification is used, it must be reenabled + ;; after recreation of the file. We cannot expect that + ;; the descriptor is the same, so we just check the + ;; existence. + (should (eq (null desc) (null auto-revert-notify-watch-descriptor))) + + ;; An empty file shall still be reverted. + (ert-with-message-capture auto-revert--messages + (auto-revert-tests--write-file "" tmpfile (pop times)) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should (string-equal "" (buffer-string))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test02-auto-revert-deleted-file "Check autorevert for a deleted remote file.") @@ -357,28 +362,25 @@ This expects `auto-revert--messages' to be bound by "Check autorevert tail mode." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. - :tags '(:expensive-test) (let ((tmpfile (make-temp-file "auto-revert-test")) + (times '(30 15)) buf) (unwind-protect (ert-with-message-capture auto-revert--messages - (write-region "any text" nil tmpfile nil 'no-message) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf ;; `buffer-stale--default-function' checks for ;; `verify-visited-file-modtime'. We must ensure that it ;; returns nil. - (sleep-for 1) (auto-revert-tail-mode 1) (should auto-revert-tail-mode) (erase-buffer) (insert "modified text\n") (set-buffer-modified-p nil) - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile 'append 'no-message) + ;; Modify file. + (auto-revert-tests--write-file "another text" tmpfile (pop times) 'append) ;; Check, that the buffer has been reverted. (auto-revert--wait-for-revert buf) @@ -396,50 +398,47 @@ This expects `auto-revert--messages' to be bound by "Check autorevert for dired." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. - :tags '(:expensive-test) - (let* ((tmpfile (make-temp-file "auto-revert-test")) - (name (file-name-nondirectory tmpfile)) - buf) - (unwind-protect - (progn - (setq buf (dired-noselect temporary-file-directory)) - (with-current-buffer buf - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) - (should - (string-match name (substring-no-properties (buffer-string)))) - - (ert-with-message-capture auto-revert--messages - ;; Delete file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (delete-file tmpfile) - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should-not - (string-match name (substring-no-properties (buffer-string)))) - - (ert-with-message-capture auto-revert--messages - ;; Make dired buffer modified. Check, that the buffer has - ;; been still reverted. - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) - - (auto-revert--wait-for-revert buf)) - ;; Check, that the buffer has been reverted. - (should - (string-match name (substring-no-properties (buffer-string)))))) - - ;; Exit. - (ignore-errors - (with-current-buffer buf (set-buffer-modified-p nil)) - (kill-buffer buf)) - (ignore-errors (delete-file tmpfile))))) + (with-auto-revert-test + (let* ((tmpfile (make-temp-file "auto-revert-test")) + (name (file-name-nondirectory tmpfile)) + (times '(30)) + buf) + (unwind-protect + (progn + (setq buf (dired-noselect temporary-file-directory)) + (with-current-buffer buf + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (auto-revert-mode 1) + (should auto-revert-mode) + (should + (string-match name (substring-no-properties (buffer-string)))) + + (ert-with-message-capture auto-revert--messages + ;; Delete file. + (delete-file tmpfile) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should-not + (string-match name (substring-no-properties (buffer-string)))) + + (ert-with-message-capture auto-revert--messages + ;; Make dired buffer modified. Check, that the buffer has + ;; been still reverted. + (set-buffer-modified-p t) + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. + (should + (string-match name (substring-no-properties (buffer-string)))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile)))))) (auto-revert--deftest-remote auto-revert-test04-auto-revert-mode-dired "Check remote autorevert for dired.") @@ -468,117 +467,116 @@ This expects `auto-revert--messages' to be bound by (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")) - require-final-newline 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--timeout) - (should (buffer-local-value + (with-auto-revert-test + (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")) + require-final-newline 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-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--timeout) - (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--timeout) - (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--timeout)) + (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) + (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--timeout)) + (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--timeout)) + (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-test05-global-notify "Test `global-auto-revert-mode' without polling for remote buffers.") (ert-deftest auto-revert-test06-write-file () "Verify that notification follows `write-file' correctly." - :tags '(:expensive-test) (skip-unless (or file-notify--library (file-remote-p temporary-file-directory))) - (let* ((auto-revert-use-notify t) - (file-1 (make-temp-file "auto-revert-test")) - (file-2 (concat file-1 "-2")) - require-final-newline buf) - (unwind-protect - (progn - (setq buf (find-file-noselect file-1)) - (with-current-buffer buf - (insert "A") - (save-buffer) - - (auto-revert-mode 1) - - (insert "B") - (write-file file-2) - - (auto-revert-test--write-file "C" file-2) - (auto-revert-test--wait-for-buffer-text - buf "C" auto-revert--timeout) - (should (equal (buffer-string) "C")))) - - ;; Clean up. - (ignore-errors (kill-buffer buf)) - (ignore-errors (delete-file file-1)) - (ignore-errors (delete-file file-2))))) + (with-auto-revert-test + (let* ((auto-revert-use-notify t) + (file-1 (make-temp-file "auto-revert-test")) + (file-2 (concat file-1 "-2")) + require-final-newline buf) + (unwind-protect + (progn + (setq buf (find-file-noselect file-1)) + (with-current-buffer buf + (insert "A") + (save-buffer) + + (auto-revert-mode 1) + + (insert "B") + (write-file file-2) + + (auto-revert-test--write-file "C" file-2) + (auto-revert-test--wait-for-buffer-text + buf "C" (auto-revert--timeout)) + (should (equal (buffer-string) "C")))) + + ;; Clean up. + (ignore-errors (kill-buffer buf)) + (ignore-errors (delete-file file-1)) + (ignore-errors (delete-file file-2)))))) (auto-revert--deftest-remote auto-revert-test06-write-file "Test `write-file' in `auto-revert-mode' for remote buffers.") commit 74519db6dfcffad8ac7a273d43992d2535320a8c Author: Michael Albinus Date: Mon Oct 19 13:31:33 2020 +0200 Further clarification of directory-files* doc * doc/lispref/files.texi (Contents of Directories): Precise description of MATCH-REGEXP of directory-files. Add directory-files-no-dot-files-regexp. * lisp/files.el (directory-files-no-dot-files-regexp): Revert last fix. * src/dired.c (Fdirectory_files) (Fdirectory_files_and_attributes): Fix wording in docstring. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 3b8b4fb3a9..fc66d1c085 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2926,11 +2926,11 @@ absolute file names. Otherwise, it returns the names relative to the specified directory. If @var{match-regexp} is non-@code{nil}, this function returns only -those file names that contain a match for that regular expression---the -other file names are excluded from the list. On case-insensitive -filesystems, the regular expression matching is case-insensitive. +those file names whose non-directory part contain a match for that +regular expression---the other file names are excluded from the list. +On case-insensitive filesystems, the regular expression matching is +case-insensitive. -@c Emacs 19 feature If @var{nosort} is non-@code{nil}, @code{directory-files} does not sort the list, so you get the file names in no particular order. Use this if you want the utmost possible speed and don't care what order the files @@ -3007,6 +3007,19 @@ corresponding argument to @code{file-attributes} (@pxref{Definition of file-attributes}). @end defun +@defvr Constant directory-files-no-dot-files-regexp +This regular expression matches any file name except @samp{.} and +@samp{..}. More precisely, it matches parts of any nonempty string +except those two. It is useful as the @var{match-regexp} argument to +@code{directory-files} and @code{directory-files-and-attributes}: + +@example +(directory-files "/foo" nil directory-files-no-dot-files-regexp) +@end example + +returns @code{nil}, if directory @samp{/foo} is empty. +@end defvr + @defun file-expand-wildcards pattern &optional full This function expands the wildcard pattern @var{pattern}, returning a list of file names that match it. diff --git a/lisp/files.el b/lisp/files.el index 78ccb9ba91..c2c58dae93 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5787,7 +5787,7 @@ If called interactively, then PARENTS is non-nil." (defconst directory-files-no-dot-files-regexp "[^.]\\|\\.\\.\\." - "Regexp matching any non-directory part of a file name except \".\" and \"..\". + "Regexp matching any file name except \".\" and \"..\". More precisely, it matches parts of any nonempty string except those two. It is useful as the regexp argument to `directory-files' and `directory-files-and-attributes'.") diff --git a/src/dired.c b/src/dired.c index 442d3aa48f..8256f2626d 100644 --- a/src/dired.c +++ b/src/dired.c @@ -293,7 +293,7 @@ DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0, There are three optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. -If MATCH is non-nil, mention only file names which non-directory part +If MATCH is non-nil, mention only file names whose non-directory part matches the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. Otherwise, the list returned is sorted with `string-lessp'. @@ -326,7 +326,7 @@ by `file-attributes'. This function accepts four optional arguments: If FULL is non-nil, return absolute file names. Otherwise return names that are relative to the specified directory. -If MATCH is non-nil, mention only file names which non-directory part +If MATCH is non-nil, mention only file names whose non-directory part matches the regexp MATCH. If NOSORT is non-nil, the list is not sorted--its order is unpredictable. NOSORT is useful if you plan to sort the result yourself. commit 653eab4788010b2c070dadea652a99e89c0ad3ac Author: Mattias Engdegård Date: Mon Oct 19 12:14:37 2020 +0200 Keep track of matching rules in compilation-mode When matching messages in compilation-mode, keep track of the rule employed for each match. This facilitates debugging and allows us to verify that each test case really exercises the rule that we expect it to. Naturally this uncovered several test cases that didn't check what the author thought they did; the rules affixed to compile-tests--test-regexps-data are those actually used, so that the tests still pass. * lisp/progmodes/compile.el (compilation--message): Add 'rule' slot. (compilation-directory-properties, compilation-error-properties) (compilation-internal-error-properties, compilation-parse-errors) (compilation--compat-parse-errors): Set the rule slot. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data) (compile-tests--grep-regexp-testcases) (compile-tests--grep-regexp-tricky-testcases): Add rules to test cases. (compile--test-error-line): Check that the rule matches what we expect. (compile-test-grep-regexps): Adapt to test case format. Remove now superfluous ert-info. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 6c819db50d..9188a08e78 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1063,9 +1063,9 @@ from a different message." (:constructor nil) (:copier nil) ;; (:type list) ;Old representation. - (:constructor compilation--make-message (loc type end-loc)) + (:constructor compilation--make-message (loc type end-loc rule)) (:conc-name compilation--message->)) - loc type end-loc) + loc type end-loc rule) (defvar compilation--previous-directory-cache nil "A pair (POS . RES) caching the result of previous directory search. @@ -1138,7 +1138,7 @@ POS and RES.") (cons (match-string-no-properties idx) dir)) ;; Place a `compilation-message' everywhere we change text-properties ;; so compilation--remove-properties can know what to remove. - compilation-message ,(compilation--make-message nil 0 nil) + compilation-message ,(compilation--make-message nil 0 nil nil) mouse-face highlight keymap compilation-button-map help-echo "mouse-2: visit destination directory"))) @@ -1177,7 +1177,8 @@ POS and RES.") ;; all information needed to later jump to corresponding source code. ;; Return a property list with all meta information on this error location. -(defun compilation-error-properties (file line end-line col end-col type fmt) +(defun compilation-error-properties (file line end-line col end-col type fmt + rule) (unless (text-property-not-all (match-beginning 0) (point) 'compilation-message nil) (if file @@ -1265,7 +1266,7 @@ POS and RES.") (current-buffer) (match-beginning 0))) (compilation-internal-error-properties - file line end-line col end-col type fmt)))) + file line end-line col end-col type fmt rule)))) (defun compilation-beginning-of-line (&optional n) "Like `beginning-of-line', but accounts for lines hidden by `selective-display'." @@ -1288,13 +1289,15 @@ just char-counts." (let ((tab-width 8)) (move-to-column (max col 0))) (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) -(defun compilation-internal-error-properties (file line end-line col end-col type fmts) +(defun compilation-internal-error-properties (file line end-line col end-col + type fmts rule) "Get the meta-info that will be added as text-properties. LINE, END-LINE, COL, END-COL are integers or nil. TYPE can be 0, 1, or 2, meaning error, warning, or just info. FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or (BUFFER) or nil. FMTS is a list of format specs for transforming the file name. +RULE is the name (symbol) of the rule used or nil if anonymous. (See `compilation-error-regexp-alist'.)" (unless file (setq file '("*unknown*"))) (let* ((file-struct (compilation-get-file-structure file fmts)) @@ -1381,7 +1384,7 @@ FMTS is a list of format specs for transforming the file name. ;; Must start with face `(font-lock-face ,compilation-message-face - compilation-message ,(compilation--make-message loc type end-loc) + compilation-message ,(compilation--make-message loc type end-loc rule) help-echo ,(if col "mouse-2: visit this file, line and column" (if line @@ -1475,17 +1478,19 @@ The errors recognized are the ones specified in RULES which default to `compilation-error-regexp-alist' if RULES is nil." (let ((case-fold-search compilation-error-case-fold-search) (omake-included (memq 'omake compilation-error-regexp-alist))) - (dolist (item (or rules compilation-error-regexp-alist)) - (if (symbolp item) - (setq item (cdr (assq item - compilation-error-regexp-alist-alist)))) - (let ((file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item)) - (type (nth 4 item)) - (pat (car item)) - end-line end-col fmt - props) + (dolist (rule-item (or rules compilation-error-regexp-alist)) + (let* ((item + (if (symbolp rule-item) + (cdr (assq rule-item compilation-error-regexp-alist-alist)) + rule-item)) + (pat (car item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + (rule (and (symbolp rule-item) rule-item)) + end-line end-col fmt + props) ;; omake reports some error indented, so skip the indentation. ;; another solution is to modify (some?) regexps in @@ -1515,7 +1520,8 @@ to `compilation-error-regexp-alist' if RULES is nil." (goto-char start) (while (re-search-forward pat end t) (when (setq props (compilation-error-properties - file line end-line col end-col (or type 2) fmt)) + file line end-line col end-col + (or type 2) fmt rule)) (when (integerp file) (let ((this-type (if (consp type) @@ -3114,7 +3120,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." ;; 'font-lock-face 'font-lock-warning-face) (put-text-property src (line-end-position) 'compilation-message - (compilation--make-message loc 2 nil))))))) + (compilation--make-message loc 2 nil nil))))))) (goto-char limit) nil) diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 45eebac036..b8ed6e0e76 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -35,319 +35,358 @@ ;; what's reported in the string. The end column numbers are for ;; the character after, so it matches what's reported in the string. '(;; absoft - ("Error on line 3 of t.f: Execution error unclassifiable statement" + (absoft + "Error on line 3 of t.f: Execution error unclassifiable statement" 1 nil 3 "t.f") - ("Line 45 of \"foo.c\": bloofle undefined" + (absoft "Line 45 of \"foo.c\": bloofle undefined" 1 nil 45 "foo.c") - ("error on line 19 of fplot.f: spelling error?" + (absoft "error on line 19 of fplot.f: spelling error?" 1 nil 19 "fplot.f") - ("warning on line 17 of fplot.f: data type is undefined for variable d" + (absoft + "warning on line 17 of fplot.f: data type is undefined for variable d" 1 nil 17 "fplot.f") ;; Ada & Mpatrol - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (gnu "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 1 11 61 "foo.adb") - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (ada "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 52 nil 11 "foo.ads") - (" 0x8008621 main+16 at error.c:17" + (ada " 0x8008621 main+16 at error.c:17" 23 nil 17 "error.c") ;; aix - ("****** Error number 140 in line 8 of file errors.c ******" + (aix "****** Error number 140 in line 8 of file errors.c ******" 25 nil 8 "errors.c") ;; ant - ("[javac] /src/DataBaseTestCase.java:27: unreported exception ..." + (ant "[javac] /src/DataBaseTestCase.java:27: unreported exception ..." 13 nil 27 "/src/DataBaseTestCase.java" 2) - ("[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" + (ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" 13 nil 49 "/src/DataBaseTestCase.java" 1) - ("[jikes] foo.java:3:5:7:9: blah blah" + (ant "[jikes] foo.java:3:5:7:9: blah blah" 14 (5 . 10) (3 . 7) "foo.java" 2) - ("[javac] c:/cygwin/Test.java:12: error: foo: bar" + (ant "[javac] c:/cygwin/Test.java:12: error: foo: bar" 9 nil 12 "c:/cygwin/Test.java" 2) - ("[javac] c:\\cygwin\\Test.java:87: error: foo: bar" + (ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar" 9 nil 87 "c:\\cygwin\\Test.java" 2) ;; Checkstyle error, but ant reports a warning (note additional ;; severity level after task name) - ("[checkstyle] [ERROR] /src/Test.java:38: warning: foo" + (ant "[checkstyle] [ERROR] /src/Test.java:38: warning: foo" 22 nil 38 "/src/Test.java" 1) ;; bash - ("a.sh: line 1: ls-l: command not found" + (bash "a.sh: line 1: ls-l: command not found" 1 nil 1 "a.sh") ;; borland - ("Error ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning pong.c 68: Call to function 'func' with no prototype" + (borland "Warning pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") - ("Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning W1022 pong.c 68: Call to function 'func' with no prototype" + (borland + "Warning W1022 pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") ;; caml - ("File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" + (python-tracebacks-and-caml + "File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" 1 (20 . 156) (5 . 8) "foobar.ml") - ("File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." + (python-tracebacks-and-caml + "File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml") - ("File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" + (python-tracebacks-and-caml + "File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py") - ("File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" + (python-tracebacks-and-caml + "File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py") - ("File \"/tmp/foo.py\", line 10" + (python-tracebacks-and-caml + "File \"/tmp/foo.py\", line 10" 1 nil 10 "/tmp/foo.py") ;; clang-include - ("In file included from foo.cpp:2:" + (clang-include "In file included from foo.cpp:2:" 1 nil 2 "foo.cpp" 0) ;; cmake cmake-info - ("CMake Error at CMakeLists.txt:23 (hurz):" + (cmake "CMake Error at CMakeLists.txt:23 (hurz):" 1 nil 23 "CMakeLists.txt") - ("CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" + (cmake "CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" 1 nil 73 "cmake/modules/UseUG.cmake") - (" cmake/modules/DuneGridMacros.cmake:19 (include)" + (cmake-info " cmake/modules/DuneGridMacros.cmake:19 (include)" 1 nil 19 "cmake/modules/DuneGridMacros.cmake") ;; comma - ("\"foo.f\", line 3: Error: syntax error near end of statement" + (comma "\"foo.f\", line 3: Error: syntax error near end of statement" 1 nil 3 "foo.f") - ("\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." + (comma "\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." 1 5 19 "vvouch.c") - ("\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" + (comma "\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" 1 1 32 "foo.c") - ("\"foo.adb\", line 2(11): warning: file name does not match ..." + (comma "\"foo.adb\", line 2(11): warning: file name does not match ..." 1 11 2 "foo.adb") - ("\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." + (comma + "\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." 1 34 30 "src/swapping.c") ;; cucumber - ("Scenario: undefined step # features/cucumber.feature:3" + (cucumber "Scenario: undefined step # features/cucumber.feature:3" 29 nil 3 "features/cucumber.feature") - (" /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" + (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") ;; edg-1 edg-2 - ("build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" + (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" 1 nil 42 "build/intel/debug/../../../struct.cpp") - ("build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" + (edg-1 "build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" 1 nil 44 "build/intel/debug/struct.cpp") - ("build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" + (edg-1 "build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" 1 nil 302 "build/intel/debug/iptr.h") - (" detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" + (edg-2 " detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" 31 nil 62 "build/intel/debug/../../../trace.h") ;; epc - ("Error 24 at (2:progran.f90) : syntax error" + (epc "Error 24 at (2:progran.f90) : syntax error" 1 nil 2 "progran.f90") ;; ftnchek - (" Dummy arg W in module SUBA line 8 file arrayclash.f is array" + (ftnchek " Dummy arg W in module SUBA line 8 file arrayclash.f is array" 32 nil 8 "arrayclash.f") - (" L4 used at line 55 file test/assign.f; never set" + (ftnchek " L4 used at line 55 file test/assign.f; never set" 16 nil 55 "test/assign.f") - ("Warning near line 10 file arrayclash.f: Module contains no executable" + (ftnchek + "Warning near line 10 file arrayclash.f: Module contains no executable" 1 nil 10 "arrayclash.f") - ("Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" + (ftnchek "Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" 24 9 31 "assign.f") ;; iar - ("\"foo.c\",3 Error[32]: Error message" + (iar "\"foo.c\",3 Error[32]: Error message" 1 nil 3 "foo.c") - ("\"foo.c\",3 Warning[32]: Error message" + (iar "\"foo.c\",3 Warning[32]: Error message" 1 nil 3 "foo.c") ;; ibm - ("foo.c(2:0) : informational EDC0804: Function foo is not referenced." + (ibm "foo.c(2:0) : informational EDC0804: Function foo is not referenced." 1 0 2 "foo.c") - ("foo.c(3:8) : warning EDC0833: Implicit return statement encountered." + (ibm "foo.c(3:8) : warning EDC0833: Implicit return statement encountered." 1 8 3 "foo.c") - ("foo.c(5:5) : error EDC0350: Syntax error." + (ibm "foo.c(5:5) : error EDC0350: Syntax error." 1 5 5 "foo.c") ;; irix - ("ccom: Error: foo.c, line 2: syntax error" + (irix "ccom: Error: foo.c, line 2: syntax error" 1 nil 2 "foo.c") - ("cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file ..." + (irix "cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file ..." 1 nil 17 "/src/Python-2.3.3/Modules/_curses_panel.c") - ("cc: Info: foo.c, line 27: ..." + (irix "cc: Info: foo.c, line 27: ..." 1 nil 27 "foo.c") - ("cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." + (irix + "cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." 1 nil 2 "foo.c") - ("cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." + (irix + "cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." 1 nil 170 "xfe.c") - ("/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("foo bar: baz.f, line 27: ..." + (irix "foo bar: baz.f, line 27: ..." 1 nil 27 "baz.f") ;; java - ("\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" + (java "\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" 5 nil 172 "ComponentGateway.java") - ("\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" + (java "\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" 5 nil 740 "HttpServlet.java") - ("==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" + (java "==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" 13 nil 217 "../src/Lib/System.cpp") - ("==1332== by 0x8008621: main (vtest.c:180)" + (java "==1332== by 0x8008621: main (vtest.c:180)" 13 nil 180 "vtest.c") ;; javac - ("/src/Test.java:5: ';' expected\n foo foo\n ^\n" 1 15 5 "/src/Test.java" 2) - ("e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" 1 10 7 "e:\\src\\Test.java" 1) + (javac + "/src/Test.java:5: ';' expected\n foo foo\n ^\n" + 1 15 5 "/src/Test.java" 2) + (javac + "e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" + 1 10 7 "e:\\src\\Test.java" 1) ;; jikes-file jikes-line - ("Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" + (jikes-file + "Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" 1 nil nil "../javax/swing/BorderFactory.java") - ("Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" + (jikes-file "Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" 1 nil nil "java/awt/Toolkit.java") ;; gcc-include - ("In file included from /usr/include/c++/3.3/backward/warn.h:4," + (gcc-include "In file included from /usr/include/c++/3.3/backward/warn.h:4," 1 nil 4 "/usr/include/c++/3.3/backward/warn.h") - (" from /usr/include/c++/3.3/backward/iostream.h:31:0," + (gcc-include + " from /usr/include/c++/3.3/backward/iostream.h:31:0," 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") - (" from test_clt.cc:1:" + (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") ;; gmake - ("make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) - ("make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 "sub/make.mk" 0) - ("gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 "sub/make.mk" 0) - ("gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 "make.mk" 0) - ("Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 "make.INC" 0) + (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) + (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 + "sub/make.mk" 0) + (gmake "gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 + "sub/make.mk" 0) + (gmake "gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 + "make.mk" 0) + (gmake "Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 + "make.INC" 0) ;; gnu - ("foo.c:8: message" 1 nil 8 "foo.c") - ("../foo.c:8: W: message" 1 nil 8 "../foo.c") - ("/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") - ("foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") - ("foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") - ("foo.c:8:I: message" 1 nil 8 "foo.c") - ("foo.c:8.23: note: message" 1 23 8 "foo.c") - ("foo.c:8.23: info: message" 1 23 8 "foo.c") - ("foo.c:8:23:information: message" 1 23 8 "foo.c") - ("foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") - ("foo.c:8-23: message" 1 nil (8 . 23) "foo.c") + (gnu "foo.c:8: message" 1 nil 8 "foo.c") + (gnu "../foo.c:8: W: message" 1 nil 8 "../foo.c") + (gnu "/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") + (gnu "foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") + (gnu "foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") + (gnu "foo.c:8:I: message" 1 nil 8 "foo.c") + (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c") + (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") + (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. - ("foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") - ("foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") - ("jade:dbcommon.dsl:133:17:E: missing argument for function call" + (gnu "foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") + (gnu "foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") + (gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call" 1 17 133 "dbcommon.dsl") - ("G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("{standard input}:27041: Warning: end of file not at end of a line; newline inserted" + (gnu "{standard input}:27041: Warning: end of file not at end of a line; newline inserted" 1 nil 27041 "{standard input}") - ("boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" + (gnu "boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" 1 25 589 "boost/container/detail/flat_tree.hpp" 0) ;; gradle-kotlin - ("e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) - ("w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) - ("e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" 4 15 34 "e:/cygwin/src/Test.kt" 2) - ("w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" 4 98 11 "e:/cygwin/src/Test.kt" 1) - ("e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) - ("w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) + (gradle-kotlin + "e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) + (gradle-kotlin + "w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) + (gradle-kotlin + "e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" + 4 15 34 "e:/cygwin/src/Test.kt" 2) + (gradle-kotlin + "w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" + 4 98 11 "e:/cygwin/src/Test.kt" 1) + (gradle-kotlin + "e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) + (gradle-kotlin + "w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) ;; Guile - ("In foo.scm:\n" 1 nil nil "foo.scm") - (" 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) - ("1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) + (guile-file "In foo.scm:\n" 1 nil nil "foo.scm") + (guile-line " 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) + (guile-line "1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) ;; lcc - ("E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") - ("W, file.cc(36,52) blah blah" 1 52 36 "file.cc") + (lcc "E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") + (lcc "W, file.cc(36,52) blah blah" 1 52 36 "file.cc") ;; makepp - ("makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") - ("makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" 27 nil nil "/foo/bar.c") - ("makepp: bla bla `/foo/Makeppfile:12' bla" 18 nil 12 "/foo/Makeppfile") - ("makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" 35 nil nil "/foo/bar.h") + (makepp "makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") + (makepp "makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" + 27 nil nil "/foo/bar.c") + (makepp "makepp: bla bla `/foo/Makeppfile:12' bla" + 18 nil 12 "/foo/Makeppfile") + (nil "makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" + 35 nil nil "/foo/bar.h") ;; maven - ("FooBar.java:[111,53] no interface expected here" + (maven "FooBar.java:[111,53] no interface expected here" 1 53 111 "FooBar.java" 2) - ("[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" + (maven "[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" 15 96 651 "/Users/cinsk/hello.java" 2) ;Bug#11517. - ("[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" + (maven "[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" 11 43 27 "/foo/bar/Test.java" 1) ;Bug#20556 ;; mips-1 mips-2 - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 11 nil 255 "solomon.c") - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 70 nil 93 "solomo.c") - ("name defined but never used: LinInt in cmap_calc.c(199)" + (mips-2 "name defined but never used: LinInt in cmap_calc.c(199)" 40 nil 199 "cmap_calc.c") ;; msft - ("keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" + (msft "keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" 1 nil 537 "keyboard handler.c") - ("d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" + (msft + "d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" 1 nil 23 "d:\\tmp\\test.c") - ("d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" + (msft "d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" 1 nil 1145 "d:\\tmp\\test.c") - ("1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" + (msft "1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" 3 nil 29 "test_main.cpp") - ("1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" + (msft "1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" 3 nil 29 "test_main.cpp") - ("C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" + (msft "C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" 1 11 101 "C:\\tmp\\test.cpp") ;; watcom - ("..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" + (watcom + "..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" 1 nil 109 "..\\src\\ctrl\\lister.c") - ("..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" + (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" 1 nil 120 "..\\src\\ctrl\\lister.c") ;; omake - (" alpha.c:5:15: error: expected ';' after expression" + ;; FIXME: This doesn't actually test the omake rule. + (gnu " alpha.c:5:15: error: expected ';' after expression" 1 15 5 "alpha.c") ;; oracle - ("Semantic error at line 528, column 5, file erosacqdb.pc:" + (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" 1 5 528 "erosacqdb.pc") - ("Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" 1 10 41 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" + (oracle + "PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" 1 27 49 "/usr/src/sb/ODBI_dxfgh.pc") - ("PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" 1 nil 12 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" 1 nil 27 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" + (oracle "PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" 1 40 21 "/usr/src/sb/ODBI_BHP.hpp") ;; perl - ("syntax error at automake line 922, near \"':'\"" + (perl "syntax error at automake line 922, near \"':'\"" 14 nil 922 "automake") - ("Died at test.pl line 27." + (perl "Died at test.pl line 27." 6 nil 27 "test.pl") - ("store::odrecall('File_A', 'x2') called at store.pm line 90" + (perl "store::odrecall('File_A', 'x2') called at store.pm line 90" 40 nil 90 "store.pm") - ("\t(in cleanup) something bad at foo.pl line 3 during global destruction." + (perl + "\t(in cleanup) something bad at foo.pl line 3 during global destruction." 29 nil 3 "foo.pl") - ("GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." + (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." 130 nil 3 "t-compilation-perl-gtk.pl") ;; php - ("Parse error: parse error, unexpected $ in main.php on line 59" + (php "Parse error: parse error, unexpected $ in main.php on line 59" 1 nil 59 "main.php") - ("Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" + (php "Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" 1 nil 66 "db.inc") - ;; ruby - ("plain-exception.rb:7:in `fun': unhandled exception" + ;; ruby (uses gnu) + (gnu "plain-exception.rb:7:in `fun': unhandled exception" 1 nil 7 "plain-exception.rb") - ("\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") - ("\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") + (gcc-include + "\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") + (gcc-include "\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") ;; ruby-Test::Unit ;; FIXME - (" [examples/test-unit.rb:28:in `here_is_a_deep_assert'" + (ruby-Test::Unit " [examples/test-unit.rb:28:in `here_is_a_deep_assert'" 5 nil 28 "examples/test-unit.rb") - (" examples/test-unit.rb:19:in `test_a_deep_assert']:" + (ruby-Test::Unit " examples/test-unit.rb:19:in `test_a_deep_assert']:" 6 nil 19 "examples/test-unit.rb") - ("examples/test-unit.rb:10:in `test_assert_raise'" + (gnu "examples/test-unit.rb:10:in `test_assert_raise'" 1 nil 10 "examples/test-unit.rb") ;; rxp - ("Error: Mismatched end tag: expected , got \nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" + (rxp "Error: Mismatched end tag: expected , got \nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" 1 8 71 "/home/reto/test/group.xml") - ("Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" + (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" 1 8 4 "/home/reto/test/group.xml") ;; shellcheck - ("In autogen.sh line 48:" + (shellcheck "In autogen.sh line 48:" 1 nil 48 "autogen.sh") ;; sparc-pascal-file sparc-pascal-line sparc-pascal-example - ("Thu May 14 10:46:12 1992 mom3.p:" + (sparc-pascal-file "Thu May 14 10:46:12 1992 mom3.p:" 1 nil nil "mom3.p") ;; sun - ("cc-1020 CC: REMARK File = CUI_App.h, Line = 735" + (sun "cc-1020 CC: REMARK File = CUI_App.h, Line = 735" 13 nil 735 "CUI_App.h") - ("cc-1070 cc: WARNING File = linkl.c, Line = 38" + (sun "cc-1070 cc: WARNING File = linkl.c, Line = 38" 13 nil 38 "linkl.c") - ("cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" + (sun "cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" 18 3 16 "Hoved.f90") ;; sun-ada - ("/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" + (sun-ada "/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" 1 6 361 "/home3/xdhar/rcds_rc/main.a") ;; 4bsd - ("/usr/src/foo/foo.c(8): warning: w may be used before set" + (edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set" 1 nil 8 "/usr/src/foo/foo.c") - ("/usr/src/foo/foo.c(9): error: w is used before set" + (edg-1 "/usr/src/foo/foo.c(9): error: w is used before set" 1 nil 9 "/usr/src/foo/foo.c") - ("strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" + (4bsd "strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" 44 nil 8 "/usr/src/foo/foo.c") - ("bloofle defined( /users/wolfgang/foo.c(4) ), but never used" + (4bsd "bloofle defined( /users/wolfgang/foo.c(4) ), but never used" 18 nil 4 "/users/wolfgang/foo.c") ;; perl--Pod::Checker ;; FIXME @@ -355,21 +394,21 @@ ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod ;; perl--Test - ("# Failed test 1 in foo.t at line 6" + (perl--Test "# Failed test 1 in foo.t at line 6" 1 nil 6 "foo.t") ;; perl--Test::Harness - ("NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" + (perl--Test2 "NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" 1 nil 46 "t/foo.t") ;; weblint - ("index.html (13:1) Unknown element " + (weblint "index.html (13:1) Unknown element " 1 1 13 "index.html")) "List of tests for `compilation-error-regexp-alist'. -Each element has the form (STR POS COLUMN LINE FILENAME [TYPE]), -where STR is an error string, POS is the position of the error in -STR, COLUMN and LINE are the reported column and line numbers (or -nil) for that error, FILENAME is the reported filename, and TYPE -is 0 for an information message, 1 for a warning, and 2 for an -error. +Each element has the form (RULE STR POS COLUMN LINE FILENAME +[TYPE]), where RULE is the rule (as a symbol), STR is an error +string, POS is the position of the error in STR, COLUMN and LINE +are the reported column and line numbers (or nil) for that error, +FILENAME is the reported filename, and TYPE is 0 for an +information message, 1 for a warning, and 2 for an error. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) @@ -379,11 +418,14 @@ any message type is accepted.") (defconst compile-tests--grep-regexp-testcases ;; Bug#32051. - '(("c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include " + '((nil + "c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include " 1 nil 29 "c:/Users/my.name/src/project\\src\\kbhit.hpp") - ("d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + (nil + "d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" 1 nil 214 "d:/gnu/emacs/branch/src/callproc.c") - ("/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + (nil + "/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" 1 nil 214 "/gnu/emacs/branch/src/callproc.c")) "List of tests for `grep-regexp-list'. The format is the same as `compile-tests--test-regexps-data', but @@ -392,43 +434,51 @@ with colon.") (defconst compile-tests--grep-regexp-tricky-testcases ;; Bug#7378. - '(("./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" + '((nil + "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" 1 nil 42 "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0") - ("2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" + (nil + "2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" 1 nil 7 "2011-08-31_11:57:03_1")) "List of tricky tests for `grep-regexp-list'. Same as `compile-tests--grep-regexp-testcases', but these cases can only work with the NUL byte to disambiguate colons.") (defun compile--test-error-line (test) - (erase-buffer) - (setq compilation-locs (make-hash-table)) - (insert (car test)) - (compilation-parse-errors (point-min) (point-max)) - (let ((msg (get-text-property (nth 1 test) 'compilation-message))) - (should msg) - (let ((loc (compilation--message->loc msg)) - (col (nth 2 test)) - (line (nth 3 test)) - (file (nth 4 test)) - (type (nth 5 test)) - end-col end-line) - (if (consp col) - (setq end-col (cdr col) col (car col))) - (if (consp line) - (setq end-line (cdr line) line (car line))) - (should (equal (compilation--loc->col loc) col)) - (should (equal (compilation--loc->line loc) line)) - (when file - (should (equal (caar (compilation--loc->file-struct loc)) file))) - (when end-col - (should (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) - end-col))) - (should (equal (car (nth 2 (compilation--loc->file-struct loc))) - (or end-line line))) - (when type - (should (equal type (compilation--message->type msg))))) - msg)) + (ert-info ((format "%S" test) :prefix "testcase: ") + (erase-buffer) + (setq compilation-locs (make-hash-table)) + (let ((rule (nth 0 test)) + (str (nth 1 test)) + (pos (nth 2 test)) + (col (nth 3 test)) + (line (nth 4 test)) + (file (nth 5 test)) + (type (nth 6 test))) + (insert str) + (compilation-parse-errors (point-min) (point-max)) + (let ((msg (get-text-property pos 'compilation-message))) + (should msg) + (let ((loc (compilation--message->loc msg)) + end-col end-line) + (if (consp col) + (setq end-col (cdr col) col (car col))) + (if (consp line) + (setq end-line (cdr line) line (car line))) + (should (equal (compilation--loc->col loc) col)) + (should (equal (compilation--loc->line loc) line)) + (when file + (should (equal (caar (compilation--loc->file-struct loc)) file))) + (when end-col + (should (equal + (car (cadr (nth 2 (compilation--loc->file-struct loc)))) + end-col))) + (should (equal (car (nth 2 (compilation--loc->file-struct loc))) + (or end-line line))) + (when type + (should (equal type (compilation--message->type msg)))) + (should (equal rule (compilation--message->rule msg)))) + msg)))) (ert-deftest compile-test-error-regexps () "Test the `compilation-error-regexp-alist' regexps. @@ -452,16 +502,15 @@ The test data is in `compile-tests--grep-regexp-testcases'." (font-lock-mode -1) (dolist (testcase compile-tests--grep-regexp-testcases) (let (msg1 msg2) - (setq msg1 (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (setq msg1 (compile--test-error-line testcase)) ;; Make sure replacing the NUL character with a colon still matches. - (setf (car testcase) (replace-regexp-in-string "\0" ":" (car testcase))) - (setq msg2 (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (let ((testcase2 (copy-sequence testcase))) + (setf (nth 1 testcase2) + (string-replace "\0" ":" (nth 1 testcase2))) + (setq msg2 (compile--test-error-line testcase2))) (should (equal msg1 msg2)))) (dolist (testcase compile-tests--grep-regexp-tricky-testcases) - (ert-info ((format "%S" testcase) :prefix "testcase: ") - (compile--test-error-line testcase))) + (compile--test-error-line testcase)) (should (eq compilation-num-errors-found 8)))) ;;; compile-tests.el ends here commit b16cd3f1e57239887d393129969bdb702feb10d4 Author: Mattias Engdegård Date: Mon Oct 19 12:39:51 2020 +0200 Hoist some loop-invariant variable bindings in compile.el * lisp/progmodes/compile.el (compilation-parse-errors): Hoist the binding of case-fold-search and a memq call out of the loop, eliminating a minor but unnecessary quadratic term. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index bc0fe6d63a..6c819db50d 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1473,105 +1473,106 @@ This updates the appropriate variable used by the mode-line." "Parse errors between START and END. The errors recognized are the ones specified in RULES which default to `compilation-error-regexp-alist' if RULES is nil." - (dolist (item (or rules compilation-error-regexp-alist)) - (if (symbolp item) - (setq item (cdr (assq item - compilation-error-regexp-alist-alist)))) - (let ((case-fold-search compilation-error-case-fold-search) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item)) - (type (nth 4 item)) - (pat (car item)) - end-line end-col fmt - props) - - ;; omake reports some error indented, so skip the indentation. - ;; another solution is to modify (some?) regexps in - ;; `compilation-error-regexp-alist'. - ;; note that omake usage is not limited to ocaml and C (for stubs). - ;; FIXME-omake: Doing it here seems wrong, at least it should depend on - ;; whether or not omake's own error messages are recognized. - (cond - ((not (memq 'omake compilation-error-regexp-alist)) nil) - ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) - nil) ;; Not anchored or anchored but already allows empty spaces. - (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) - - (if (and (consp file) (not (functionp file))) - (setq fmt (cdr file) - file (car file))) - (if (and (consp line) (not (functionp line))) - (setq end-line (cdr line) - line (car line))) - (if (and (consp col) (not (functionp col))) - (setq end-col (cdr col) - col (car col))) - - (unless (or (null (nth 5 item)) (integerp (nth 5 item))) - (error "HYPERLINK should be an integer: %s" (nth 5 item))) - - (goto-char start) - (while (re-search-forward pat end t) - (when (setq props (compilation-error-properties - file line end-line col end-col (or type 2) fmt)) - - (when (integerp file) - (let ((this-type (if (consp type) - (compilation-type type) - (or type 2)))) - (compilation--note-type this-type) - - (compilation--put-prop - file 'font-lock-face - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - this-type))))) - - (compilation--put-prop - line 'font-lock-face compilation-line-face) - (compilation--put-prop - end-line 'font-lock-face compilation-line-face) - - (compilation--put-prop - col 'font-lock-face compilation-column-face) - (compilation--put-prop - end-col 'font-lock-face compilation-column-face) - - ;; Obey HIGHLIGHT. - (dolist (extra-item (nthcdr 6 item)) - (let ((mn (pop extra-item))) - (when (match-beginning mn) - (let ((face (eval (car extra-item)))) - (cond - ((null face)) - ((or (symbolp face) (stringp face)) - (put-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face face)) - ((and (listp face) - (eq (car face) 'face) - (or (symbolp (cadr face)) - (stringp (cadr face)))) - (compilation--put-prop mn 'font-lock-face (cadr face)) - (add-text-properties - (match-beginning mn) (match-end mn) - (nthcdr 2 face))) - (t - (error "Don't know how to handle face %S" - face))))))) - (let ((mn (or (nth 5 item) 0))) - (when compilation-debug + (let ((case-fold-search compilation-error-case-fold-search) + (omake-included (memq 'omake compilation-error-regexp-alist))) + (dolist (item (or rules compilation-error-regexp-alist)) + (if (symbolp item) + (setq item (cdr (assq item + compilation-error-regexp-alist-alist)))) + (let ((file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + (pat (car item)) + end-line end-col fmt + props) + + ;; omake reports some error indented, so skip the indentation. + ;; another solution is to modify (some?) regexps in + ;; `compilation-error-regexp-alist'. + ;; note that omake usage is not limited to ocaml and C (for stubs). + ;; FIXME-omake: Doing it here seems wrong, at least it should depend on + ;; whether or not omake's own error messages are recognized. + (cond + ((not omake-included) nil) + ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) + nil) ;; Not anchored or anchored but already allows empty spaces. + (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) + + (if (and (consp file) (not (functionp file))) + (setq fmt (cdr file) + file (car file))) + (if (and (consp line) (not (functionp line))) + (setq end-line (cdr line) + line (car line))) + (if (and (consp col) (not (functionp col))) + (setq end-col (cdr col) + col (car col))) + + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) + + (goto-char start) + (while (re-search-forward pat end t) + (when (setq props (compilation-error-properties + file line end-line col end-col (or type 2) fmt)) + + (when (integerp file) + (let ((this-type (if (consp type) + (compilation-type type) + (or type 2)))) + (compilation--note-type this-type) + + (compilation--put-prop + file 'font-lock-face + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + this-type))))) + + (compilation--put-prop + line 'font-lock-face compilation-line-face) + (compilation--put-prop + end-line 'font-lock-face compilation-line-face) + + (compilation--put-prop + col 'font-lock-face compilation-column-face) + (compilation--put-prop + end-col 'font-lock-face compilation-column-face) + + ;; Obey HIGHLIGHT. + (dolist (extra-item (nthcdr 6 item)) + (let ((mn (pop extra-item))) + (when (match-beginning mn) + (let ((face (eval (car extra-item)))) + (cond + ((null face)) + ((or (symbolp face) (stringp face)) + (put-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face face)) + ((and (listp face) + (eq (car face) 'face) + (or (symbolp (cadr face)) + (stringp (cadr face)))) + (compilation--put-prop mn 'font-lock-face (cadr face)) + (add-text-properties + (match-beginning mn) (match-end mn) + (nthcdr 2 face))) + (t + (error "Don't know how to handle face %S" + face))))))) + (let ((mn (or (nth 5 item) 0))) + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'std item props))) + (add-text-properties + (match-beginning mn) (match-end mn) + (cddr props)) (font-lock-append-text-property - (match-beginning 0) (match-end 0) - 'compilation-debug (vector 'std item props))) - (add-text-properties - (match-beginning mn) (match-end mn) - (cddr props)) - (font-lock-append-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face (cadr props)))))))) + (match-beginning mn) (match-end mn) + 'font-lock-face (cadr props))))))))) (defvar compilation--parsed -1) (make-variable-buffer-local 'compilation--parsed) commit bacebc89afcf2f6c47ad18842e7916af4623b4b2 Author: Stefan Kangas Date: Mon Oct 19 12:18:40 2020 +0200 * lisp/info.el: Remove redundant :group args. diff --git a/lisp/info.el b/lisp/info.el index 3fd8108132..c3684deb96 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -67,7 +67,6 @@ Intermediate Info nodes are nodes visited by Info internally in the process of searching the node to display. Intermediate nodes are not presented to the user." :type 'boolean - :group 'info :version "24.1") (defvar Info-enable-active-nodes nil @@ -79,8 +78,7 @@ The Lisp code is executed when the node is selected.") '((((class color) (background light)) :foreground "brown" :weight bold :slant italic) (((class color) (background dark)) :foreground "white" :weight bold :slant italic) (t :weight bold :slant italic)) - "Face for Info node names." - :group 'info) + "Face for Info node names.") (defface info-title-1 '((((type tty pc) (class color) (background light)) @@ -88,26 +86,22 @@ The Lisp code is executed when the node is selected.") (((type tty pc) (class color) (background dark)) :foreground "yellow" :weight bold) (t :height 1.2 :inherit info-title-2)) - "Face for info titles at level 1." - :group 'info) + "Face for info titles at level 1.") (defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) (t :height 1.2 :inherit info-title-3)) - "Face for info titles at level 2." - :group 'info) + "Face for info titles at level 2.") (defface info-title-3 '((((type tty pc) (class color)) :weight bold) (t :height 1.2 :inherit info-title-4)) - "Face for info titles at level 3." - :group 'info) + "Face for info titles at level 3.") (defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) - "Face for info titles at level 4." - :group 'info) + "Face for info titles at level 4.") (defface info-menu-header '((((type tty pc)) @@ -116,31 +110,26 @@ The Lisp code is executed when the node is selected.") (t :inherit variable-pitch :weight bold)) - "Face for headers in Info menus." - :group 'info) + "Face for headers in Info menus.") (defface info-menu-star '((((class color)) :foreground "red1") (t :underline t)) - "Face for every third `*' in an Info menu." - :group 'info) + "Face for every third `*' in an Info menu.") (defface info-xref '((t :inherit link)) - "Face for unvisited Info cross-references." - :group 'info) + "Face for unvisited Info cross-references.") (defface info-xref-visited '((t :inherit (link-visited info-xref))) "Face for visited Info cross-references." - :version "22.1" - :group 'info) + :version "22.1") (defcustom Info-fontify-visited-nodes t "Non-nil to fontify references to visited nodes in `info-xref-visited' face." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) ;; It's unfortunate that nil means no fontification, as opposed to no limit, ;; since that differs from font-lock-maximum-size. @@ -150,29 +139,24 @@ Set to nil to disable node fontification; set to t for no limit." :type '(choice (const :tag "No fontification" nil) (const :tag "No size limit" t) (integer :tag "Up to this many characters")) - :version "25.1" ; 100k -> 400k - :group 'info) + :version "25.1") ; 100k -> 400k (defcustom Info-use-header-line t "Non-nil means to put the beginning-of-node links in an Emacs header-line. A header-line does not scroll with the rest of the buffer." - :type 'boolean - :group 'info) + :type 'boolean) (defface info-header-xref '((t :inherit info-xref)) - "Face for Info cross-references in a node header." - :group 'info) + "Face for Info cross-references in a node header.") (defface info-header-node '((t :inherit info-node)) - "Face for Info nodes in a node header." - :group 'info) + "Face for Info nodes in a node header.") (defface info-index-match '((t :inherit match)) "Face used to highlight matches in an index entry." - :group 'info :version "24.4") ;; This is a defcustom largely so that we can get the benefit @@ -249,8 +233,7 @@ Although this is a customizable variable, that is mainly for technical reasons. Normally, you should either set INFOPATH or customize `Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay - :type '(repeat directory) - :group 'info)) + :type '(repeat directory))) (defvar Info-directory-list nil "List of directories to search for Info documentation files. @@ -285,8 +268,7 @@ a version of Emacs without installing it.") (defcustom Info-additional-directory-list nil "List of additional directories to search for Info documentation files. These directories are searched after those in `Info-directory-list'." - :type '(repeat directory) - :group 'info) + :type '(repeat directory)) (defcustom Info-scroll-prefer-subnodes nil "If non-nil, \\\\[Info-scroll-up] in a menu visits subnodes. @@ -300,8 +282,7 @@ Setting this option to nil results in behavior similar to the stand-alone Info reader program, which visits the first subnode from the menu only when you hit the end of the current node." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defcustom Info-hide-note-references t "If non-nil, hide the tag and section reference in *note and * menu items. @@ -320,8 +301,7 @@ If this is non-nil, you may wish setting `Info-refill-paragraphs' non-nil." (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (derived-mode-p 'Info-mode) - (revert-buffer t t))))) - :group 'info) + (revert-buffer t t)))))) (defcustom Info-refill-paragraphs nil "If non-nil, attempt to refill paragraphs with hidden references. @@ -329,15 +309,13 @@ This refilling may accidentally remove explicit line breaks in the Info file, so be prepared for a few surprises if you enable this feature. This only has an effect if `Info-hide-note-references' is non-nil." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defcustom Info-breadcrumbs-depth 4 "Depth of breadcrumbs to display. 0 means do not display breadcrumbs." :version "23.1" - :type 'integer - :group 'info) + :type 'integer) (defcustom Info-search-whitespace-regexp "\\s-+" "If non-nil, regular expression to match a sequence of whitespace chars. @@ -347,8 +325,7 @@ In the Customization buffer, that is `[' followed by a space, a tab, a carriage return (control-M), a newline, and `]+'. Don't add any capturing groups into this value; that can change the numbering of existing capture groups in unexpected ways." - :type 'regexp - :group 'info) + :type 'regexp) (defcustom Info-isearch-search t "If non-nil, isearch in Info searches through multiple nodes. @@ -363,8 +340,7 @@ node depending on search direction. Setting this option to nil restores the default isearch behavior with wrapping around the current Info node." :version "22.1" - :type 'boolean - :group 'info) + :type 'boolean) (defvar Info-isearch-initial-node nil) (defvar Info-isearch-initial-history nil) @@ -375,13 +351,11 @@ with wrapping around the current Info node." (unless (and (boundp 'Info-fontify) (null Info-fontify)) '(turn-on-font-lock)) "Hook run when activating Info Mode." - :type 'hook - :group 'info) + :type 'hook) (defcustom Info-selection-hook nil "Hook run when an Info node is selected as the current node." - :type 'hook - :group 'info) + :type 'hook) (defvar-local Info-current-file nil "Info file that Info is now looking at, or nil. commit a83e4a929b4637426597e1c34e525a2d7dbf15b0 Author: Stefan Kangas Date: Mon Oct 19 12:12:15 2020 +0200 Improve Info-streamline-headings defaults * lisp/info.el (Info-streamline-headings): Improve defaults. These produce somewhat more consistent results on my system, and seems slightly more in line with current GNU practices. For example, gcc uses the "Software development" heading instead of "Programming". diff --git a/lisp/info.el b/lisp/info.el index 8ea47d2dbe..3fd8108132 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1474,9 +1474,10 @@ is non-nil)." (defvar Info-streamline-headings '(("Emacs" . "Emacs") - ("Programming" . "Programming") + ("Software development\\|Programming" . "Software development") ("Libraries" . "Libraries") - ("World Wide Web\\|Net Utilities" . "Net Utilities")) + ("Network applications\\|World Wide Web\\|Net Utilities" + . "Network applications")) "List of elements (RE . NAME) to merge headings matching RE to NAME.") (defun Info-dir-remove-duplicates () commit 8cdbd84ebe72091ed02984ce85e9a3c4fbad7c54 Author: dickmao Date: Mon Oct 19 11:56:36 2020 +0200 `ffap-gopher-at-point' interminable without newlines * lisp/ffap.el (ffap-gopher-at-point): Stop when we get to the end of the buffer. * test/lisp/ffap-tests.el (ffap-test-no-newlines): Ensure termination for corner case (bug#44048). diff --git a/lisp/ffap.el b/lisp/ffap.el index ccba291144..2c1d3d5bd9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1383,7 +1383,8 @@ Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any." (point))) (bookmark (cl-loop for keyval = (ffap--gopher-var-on-line) while keyval collect keyval - do (forward-line 1)))) + do (forward-line 1) + until (eobp)))) (when bookmark (setq ffap-string-at-point-region (list beg (point))) (let-alist (nconc bookmark '((type . "1") (port . "70"))) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index e8c12669c1..ca8c10831f 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -117,6 +117,12 @@ left alone when opening a URL in an external browser." t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.") "\\temp\\program.log"))) +(ert-deftest ffap-test-no-newlines () + (should-not + (with-temp-buffer + (save-excursion (insert "type=")) + (ffap-guess-file-name-at-point)))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here commit 1f6f09c85bb5ec4d450edac910183345f3fdc500 Author: Robert Pluim Date: Mon Oct 19 11:34:38 2020 +0200 Explain difference between Unicode and Emacs scripts * nonascii.texi (Character Properties): Document that Emacs' scripts and Unicode's scripts do not necessarily correspond. diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 8e9d62429c..97bc85f152 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -722,7 +722,10 @@ The value of this variable is a char-table that specifies, for each character, a symbol whose name is the script to which the character belongs, according to the Unicode Standard classification of the Unicode code space into script-specific blocks. This char-table has a -single extra slot whose value is the list of all script symbols. +single extra slot whose value is the list of all script symbols. Note +that Emacs' classification of characters into scripts is not a 1-for-1 +reflection of the Unicode standard, e.g. there is no @samp{symbol} +script in Unicode. @end defvar @defvar char-width-table commit fb26dc130db99cda4227257c10b9b8c38079b83f Author: Harald Jörg Date: Mon Oct 19 10:57:57 2020 +0200 cperl-mode: Delete a misleading comment, add tests for verification * lisp/progmodes/cperl-mode.el: Delete a comment which explains a bug which has been fixed a long time ago (bug#44073). * test/lisp/progmodes/cperl-mode-tests.el (cperl-mode-fontify-punct-vars): Add regression tests to verify that fontification of punctuation variables doesn't start strings. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5b6e50c820..ebbea6bed9 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -71,13 +71,6 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;;; Font lock bugs as of v4.32: - -;; The following kinds of Perl code erroneously start strings: -;; \$` \$' \$" -;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ -;; likewise with m, tr, y, q, qX instead of s - ;;; Code: ;;; Compatibility with older versions (for publishing on ELPA) diff --git a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl new file mode 100644 index 0000000000..fa328438cb --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl @@ -0,0 +1,20 @@ +# The following Perl punctiation variables contain characters which +# are classified as string delimiters in the syntax table. The mode +# should not be confused by these. +# The corresponding tests check that two consecutive '#' characters +# are seen as comments, not as strings. +my $pre = $`; ## $PREMATCH, use another ` # to balance out +my $pos = $'; ## $POSTMATCH, use another ' # to balance out +my $lsp = $"; ## $LIST_SEPARATOR use another " # to balance out + +# In the second level, we use the reference constructor \ on these +# variables. The backslash is an escape character *only* in strings. +my $ref = \$`; ## \$PREMATCH, use another ` # to balance out +my $rif = \$'; ## \$POSTMATCH, use another ' # to balance out +my $raf = \$"; ## \$LIST_SEPARATOR use another " # to balance out + +my $opt::s = 0; ## s is no substitution here +my $opt_s = 0; ## s is no substitution here +my %opt = (s => 0); ## s is no substitution here +$opt{s} = 0; ## s is no substitution here +$opt_s =~ /\s+.../ ## s is no substitution here diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index e2af2b5b8d..e67678cf6b 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -196,4 +196,26 @@ Perl Best Practices sets some indentation values different from (should (equal got expected))))) (cperl-set-style "CPerl")))) +(ert-deftest cperl-mode-fontify-punct-vars () + "Test fontification of Perl's punctiation variables. +Perl has variable names containing unbalanced quotes for the list +separator $\" and pre- and postmatch $` and $'. A reference to +these variables, for example \\$\", should not cause the dollar +to be escaped, which would then start a string beginning with the +quote character. This used to be broken in cperl-mode at some +point in the distant past, and is still broken in perl-mode. " + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "fontify-punctuation-vars.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (while (search-forward "##" nil t) + ;; The third element of syntax-ppss is true if in a string, + ;; which would indicate bad interpretation of the quote. The + ;; fourth element is true if in a comment, which should be the + ;; case. + (should (equal (nth 3 (syntax-ppss)) nil)) + (should (equal (nth 4 (syntax-ppss)) t)))))) + ;;; cperl-mode-tests.el ends here commit 422fdabe7bcaa9eac9aa5ae688ccf9f30cf6765c Author: Yuan Fu Date: Mon Oct 19 10:45:14 2020 +0200 Handle "Before first headings" error in outline-cycle * lisp/outline.el (outline-before-first-heading): New error. (outline-back-to-heading): Signal the new error. (outline-cycle): Ignore the error. (outline-cycle-buffer): Simply pass 1 to 'outline-hide-sublevels' (bug#41130). diff --git a/lisp/outline.el b/lisp/outline.el index a4ce9afb44..b9806bc187 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -402,6 +402,8 @@ at the end of the buffer." If POS is nil, use `point' instead." (eq (get-char-property (or pos (point)) 'invisible) 'outline)) +(define-error 'outline-before-first-heading "Before first heading") + (defun outline-back-to-heading (&optional invisible-ok) "Move to previous heading line, or beg of this line if it's a heading. Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." @@ -412,7 +414,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (while (not found) (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") nil t) - (error "Before first heading")) + (signal 'outline-before-first-heading nil)) (setq found (and (or invisible-ok (not (outline-invisible-p))) (point))))) (goto-char found) @@ -1167,19 +1169,21 @@ Return either 'hide-all, 'headings-only, or 'show-all." `Headings only' means show sub headings but not their bodies. `Show all' means show all subheadings and their bodies." (interactive) - (pcase (outline--cycle-state) - ('hide-all - (if (outline-has-subheading-p) - (progn (outline-show-children) - (message "Only headings")) - (outline-show-subtree) - (message "Show all"))) - ('headings-only - (outline-show-subtree) - (message "Show all")) - ('show-all - (outline-hide-subtree) - (message "Hide all")))) + (condition-case nil + (pcase (outline--cycle-state) + ('hide-all + (if (outline-has-subheading-p) + (progn (outline-show-children) + (message "Only headings")) + (outline-show-subtree) + (message "Show all"))) + ('headings-only + (outline-show-subtree) + (message "Show all")) + ('show-all + (outline-hide-subtree) + (message "Hide all"))) + (outline-before-first-heading nil))) (defvar-local outline--cycle-buffer-state 'show-all "Internal variable used for tracking buffer cycle state.") @@ -1189,13 +1193,7 @@ Return either 'hide-all, 'headings-only, or 'show-all." (interactive) (pcase outline--cycle-buffer-state ('show-all - (save-excursion - (let ((start-point (point))) - (while (not (eq (point) start-point)) - (outline-up-heading 1)) - (outline-hide-sublevels - (progn (outline-back-to-heading) - (funcall 'outline-level))))) + (outline-hide-sublevels 1) (setq outline--cycle-buffer-state 'top-level) (message "Top level headings")) ('top-level