commit 7d5807277ff614a337c7e4530bb8d0e0188c189b (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Fri Aug 28 22:37:29 2020 -0700 Revert recent expand-file-name changes if DOS_NT * src/fileio.c (Fexpand_file_name): Restore pre-August-26 behavior, if DOS_NT. This should fix the recently-introduced expand-file-name bugs on DOS_NT (Bug#26911). diff --git a/src/fileio.c b/src/fileio.c index 66010b6878..c91af36fdf 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1372,6 +1372,14 @@ the root directory. */) length = newdirlim - newdir; +#ifdef DOS_NT + /* Ignore any slash at the end of newdir, unless newdir is + just "/" or "//". */ + while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) + && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0]))) + length--; +#endif + /* Now concatenate the directory and name to new space in the stack frame. */ tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1; eassert (tlen >= file_name_as_directory_slop + 1); @@ -1388,22 +1396,40 @@ the root directory. */) if (newdir) { - if (!collapse_newdir) +#ifndef DOS_NT + bool treat_as_absolute = !collapse_newdir; +#else + bool treat_as_absolute = !nm[0] || IS_DIRECTORY_SEP (nm[0]); +#endif + if (treat_as_absolute) { - /* With ~ or ~user, leave NEWDIR as-is to avoid transforming - it from a symlink (or a regular file!) into a directory. */ - memcpy (target, newdir, length); - nbytes = length; +#ifdef DOS_NT + /* If newdir is effectively "C:/", then the drive letter will have + been stripped and newdir will be "/". Concatenating with an + absolute directory in nm produces "//", which will then be + incorrectly treated as a network share. Ignore newdir in + this case (keeping the drive letter). */ + if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) + && newdir[1] == '\0')) +#endif + { + /* With ~ or ~user, leave NEWDIR as-is to avoid transforming + it from a symlink (or a regular file!) into a directory. */ + memcpy (target, newdir, length); + nbytes = length; + } } else nbytes = file_name_as_directory (target, newdir, length, multibyte); +#ifndef DOS_NT /* If TARGET ends in a directory separator, omit leading directory separators from NM so that concatenating a TARGET "/" to an NM "/foo" does not result in the incorrect "//foo". */ if (nbytes && IS_DIRECTORY_SEP (target[nbytes - 1])) while (IS_DIRECTORY_SEP (nm[0])) nm++; +#endif } memcpy (target + nbytes, nm, nmlim - nm + 1); @@ -1420,6 +1446,7 @@ the root directory. */) { *o++ = *p++; } +#ifndef DOS_NT else if (p[1] == '.' && IS_DIRECTORY_SEP (p[2])) { /* Replace "/./" with "/". */ @@ -1432,6 +1459,18 @@ the root directory. */) *o++ = *p; p += 2; } +#else + else if (p[1] == '.' + && (IS_DIRECTORY_SEP (p[2]) + || p[2] == 0)) + { + /* If "/." is the entire filename, keep the "/". Otherwise, + just delete the whole "/.". */ + if (o == target && p[2] == '\0') + *o++ = *p; + p += 2; + } +#endif else if (p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. Turned off on DOS_NT systems because they have no @@ -1445,9 +1484,7 @@ the root directory. */) #endif && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) { -#ifdef WINDOWSNT - char *prev_o = o; -#endif +#ifndef DOS_NT while (o != target) { o--; @@ -1459,11 +1496,22 @@ the root directory. */) break; } } -#ifdef WINDOWSNT +#else +# ifdef WINDOWSNT + char *prev_o = o; +# endif + while (o != target && (--o, !IS_DIRECTORY_SEP (*o))) + continue; +# ifdef WINDOWSNT /* Don't go below server level in UNC filenames. */ if (o == target + 1 && IS_DIRECTORY_SEP (*o) && IS_DIRECTORY_SEP (*target)) o = prev_o; + else +# endif + /* Keep initial / only if this is the whole name. */ + if (o == target && IS_ANY_SEP (*o) && p[3] == 0) + ++o; #endif p += 3; } commit 2b59cfaaa35283900f28d755d34b5049c5c67603 Author: Paul Eggert Date: Fri Aug 28 22:35:54 2020 -0700 * src/fileio.c (Fexpand_file_name): Omit unnecessary assignment. diff --git a/src/fileio.c b/src/fileio.c index 47e5e46a00..66010b6878 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1384,7 +1384,6 @@ the root directory. */) #else /* not DOS_NT */ target = SAFE_ALLOCA (tlen); #endif /* not DOS_NT */ - *target = 0; nbytes = 0; if (newdir) commit 726b758005ead50e9c98ef50a59304646652b994 Author: Andrew G Cohen Date: Sat Aug 29 12:22:40 2020 +0800 Allow direct choice of smtp authentication method * lisp/mail/smtpmail.el (smtpmail-try-auth-methods): Let the authorization credentials have an entry with key :smtp-auth containing a preferred authentication mechanism. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 666395e0b9..1786608dd6 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -512,8 +512,9 @@ for `smtpmail-try-auth-method'.") (if port (format "%s" port) "smtp")) - (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) - (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) + (let* ((mechs (smtpmail-intersection + (cdr-safe (assoc 'auth supported-extensions)) + smtpmail-auth-supported)) (auth-source-creation-prompts '((user . "SMTP user name for %h: ") (secret . "SMTP password for %u@%h: "))) @@ -526,6 +527,7 @@ for `smtpmail-try-auth-method'.") :require (and ask-for-password '(:user :secret)) :create ask-for-password))) + (mech (or (plist-get auth-info :smtp-auth) (car mechs))) (user (plist-get auth-info :user)) (password (plist-get auth-info :secret)) (save-function (and ask-for-password commit a811a618e0ef1f0018c1f98ec5096b4df48656fa Author: Stefan Kangas Date: Sat Aug 29 00:38:57 2020 +0200 ; Bump seq version to 2.22 diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 1cc68e19ed..d60f974aee 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.21 +;; Version: 2.22 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org commit 72f66f70eef18e3b25cc989d67711887304f184b Author: Alan Third Date: Thu Aug 27 20:50:42 2020 +0100 Fix Objective-C C99 build problem * configure.ac (NS_IMPL_GNUSTEP): GCC appears to need to be told to use C99 when compiling Objective-C. diff --git a/configure.ac b/configure.ac index 9a51ea1f7e..dd2adb7e74 100644 --- a/configure.ac +++ b/configure.ac @@ -1900,7 +1900,8 @@ tmp_CPPFLAGS="$CPPFLAGS" tmp_CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS -x objective-c" CFLAGS="$CFLAGS -x objective-c" -GNU_OBJC_CFLAGS= +# Recent versions of GCC don't use C99 to compile Obj-C. +GNU_OBJC_CFLAGS="-std=c99" LIBS_GNUSTEP= if test "${with_ns}" != no; then # macfont.o requires macuvs.h which is absent after 'make extraclean', @@ -1916,7 +1917,7 @@ if test "${with_ns}" != no; then elif flags=$( (gnustep-config --objc-flags) 2>/dev/null); then NS_IMPL_GNUSTEP=yes NS_GNUSTEP_CONFIG=yes - GNU_OBJC_CFLAGS=$flags + GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS $flags" LIBS_GNUSTEP=$(gnustep-config --gui-libs) || exit elif test -f $GNUSTEP_CONFIG_FILE; then NS_IMPL_GNUSTEP=yes @@ -1961,7 +1962,7 @@ fail; dnl _NATIVE_OBJC_EXCEPTIONS is used by the GNUstep headers. AC_DEFINE(_NATIVE_OBJC_EXCEPTIONS, 1, [Define if GNUstep uses ObjC exceptions.]) - GNU_OBJC_CFLAGS="-fobjc-exceptions" + GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fobjc-exceptions" fi fi if test $NS_IMPL_GNUSTEP = yes; then commit 89286b1f45571c8b7853e6f348b7f711d437ed74 Author: Alan Third Date: Thu Aug 27 18:33:31 2020 +0100 Add GNUstep build to Gitlab CI/CD * .gitlab-ci.yml (test-gnustep): New test target. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 9a62137c16..566efb1409 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -65,3 +65,29 @@ test-filenotify-gio: - ./configure --without-makeinfo --with-file-notification=gfile - make bootstrap - make -C test autorevert-tests filenotify-tests + +test-gnustep: + stage: test + # This tests the GNUstep build process + only: + changes: + - .gitlab-ci.yml + - configure.ac + - src/nsfns.m + - src/nsfont.m + - src/nsgui.h + - src/nsimage.m + - src/nsmenu.m + - src/nsselect.m + - src/nsterm.h + - src/nsterm.m + - src/nsxwidget.h + - src/nsxwidget.m + - src/macfont.h + - src/macfont.m + script: + - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 gnustep-devel + - ./autogen.sh autoconf + - ./configure --without-makeinfo --with-ns + - make bootstrap + - make install commit 6e25d615449733d12ef82940903f3fda6f8744dc Author: Daniel Martín Date: Sun Jul 26 15:24:59 2020 +0200 Add support for parsing column numbers in Visual Studio messages * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Extend regular expression to match optional column numbers. * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data): Add a test. * test/lisp/progmodes/compile-tests.el (compile-test-error-regexps): Update the total number of compilation errors in a test. * etc/compilation.txt: Update compilation.txt with the newly supported message format. * etc/NEWS: Advertise the feature. diff --git a/etc/NEWS b/etc/NEWS index 658e2a35d7..ad63955f7b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -557,6 +557,9 @@ case-insensitive matching of messages when the old behavior is required, but the recommended solution is to use a correctly matching regexp instead. +--- +*** Messages from Visual Studio that mention column numbers are now recognized. + ** Hi Lock mode --- diff --git a/etc/compilation.txt b/etc/compilation.txt index 8f7e290678..11aefc6bc6 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -381,6 +381,7 @@ made it more strict about the error message that follows. keyboard handler.c(537) : warning C4005: 'min' : macro redefinition d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if' d:\tmp\test.c(1145) : see declaration of 'nsRefPtr' +c:\tmp\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [c:\tmp\project.vcxproj] 1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';' 1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int 1> diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a043bbcfa3..731db0fd6d 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -221,9 +221,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; considered before EDG. ;; The message may be a "warning", "error", or "fatal error" with ;; an error code, or "see declaration of" without an error code. - "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)) ?\ + "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?) ?\ : \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)" - 2 3 nil (4)) + 2 3 4 (5)) (edg-1 "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)" diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index d566e7dd86..819f2e78c2 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -267,6 +267,8 @@ 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" 3 nil 29 "test_main.cpp") + ("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 '{'" 1 nil 109 "..\\src\\ctrl\\lister.c") @@ -434,7 +436,7 @@ The test data is in `compile-tests--test-regexps-data'." (compilation-num-warnings-found 0) (compilation-num-infos-found 0)) (mapc #'compile--test-error-line compile-tests--test-regexps-data) - (should (eq compilation-num-errors-found 94)) + (should (eq compilation-num-errors-found 95)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) commit 2af8f7a1e42fa5ae5b87ccada63360c8969a83cf Author: Michael Albinus Date: Fri Aug 28 19:54:50 2020 +0200 Fix Bug#43052 * test/lisp/net/tramp-tests.el (tramp-test04-substitute-in-file-name): Make user name unique. (Bug#43052) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 297167416d..71c6302e0e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2024,8 +2024,12 @@ is greater than 10. "Check `substitute-in-file-name'." (skip-unless (eq tramp-syntax 'default)) - ;; Suppress method name check. - (let ((tramp-methods (cons '("method") tramp-methods))) + ;; Suppress method name check. We cannot use the string "foo" as + ;; user name, because (substitute-in-string "/~foo") returns + ;; different values depending on the existence of user "foo" (see + ;; Bug#43052). + (let ((tramp-methods (cons '("method") tramp-methods)) + (foo (downcase (md5 (current-time-string))))) (should (string-equal (substitute-in-file-name "/method:host:///foo") "/foo")) (should @@ -2057,36 +2061,40 @@ is greater than 10. ;; Emacs 25, occasionally. No idea what's up. (when (tramp--test-emacs26-p) (should - (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo")) + (string-equal + (substitute-in-file-name (concat "/method:host://~" foo)) + (concat "/~" foo))) (should (string-equal - (substitute-in-file-name "/method:host:/~foo") "/method:host:/~foo")) + (substitute-in-file-name (concat "/method:host:/~" foo)) + (concat "/method:host:/~" foo))) (should (string-equal - (substitute-in-file-name "/method:host:/path//~foo") "/~foo")) + (substitute-in-file-name (concat "/method:host:/path//~" foo)) + (concat "/~" foo))) ;; (substitute-in-file-name "/path/~foo") expands only for a local ;; user "foo" to "/~foo"". Otherwise, it doesn't expand. (should (string-equal - (substitute-in-file-name - "/method:host:/path/~foo") "/method:host:/path/~foo")) + (substitute-in-file-name (concat "/method:host:/path/~" foo)) + (concat "/method:host:/path/~" foo))) ;; Quoting local part. (should (string-equal - (substitute-in-file-name "/method:host:/://~foo") - "/method:host:/://~foo")) + (substitute-in-file-name (concat "/method:host:/://~" foo)) + (concat "/method:host:/://~" foo))) (should (string-equal - (substitute-in-file-name - "/method:host:/:/~foo") "/method:host:/:/~foo")) + (substitute-in-file-name (concat "/method:host:/:/~" foo)) + (concat "/method:host:/:/~" foo))) (should (string-equal - (substitute-in-file-name - "/method:host:/:/path//~foo") "/method:host:/:/path//~foo")) + (substitute-in-file-name (concat "/method:host:/:/path//~" foo)) + (concat "/method:host:/:/path//~" foo))) (should (string-equal - (substitute-in-file-name - "/method:host:/:/path/~foo") "/method:host:/:/path/~foo"))) + (substitute-in-file-name (concat "/method:host:/:/path/~" foo)) + (concat "/method:host:/:/path/~" foo)))) (let (process-environment) (should commit 8d3160ec0856dba42ac39296e7191a51c1e8b7e8 Author: Stefan Kangas Date: Fri Aug 28 19:23:01 2020 +0200 Add commands to run shell commands in project root * lisp/progmodes/project.el (project-async-shell-command) (project-shell-command): New commands to run 'async-shell-command' and 'shell-command' in project's root directory. (project-prefix-map): Bind commands to '!' and '&'. * doc/emacs/maintaining.texi (Project File Commands): Document the new commands. * etc/NEWS: Announce the new commands. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 9f550b4987..a9b0da5aff 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1693,6 +1693,12 @@ Start Eshell in the current project's root directory @item C-x p c Run compilation in the current project's root directory (@code{project-compile}). +@item C-x p ! +Run shell command in the current project's root directory +(@code{project-shell-command}). +@item C-x p & +Run shell command asynchronously in the current project's root +directory (@code{project-async-shell-command}). @end table Emacs provides commands for handling project files conveniently. @@ -1770,6 +1776,14 @@ directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The Emacs Shell}. The command @kbd{C-x p c} (@code{project-compile}) runs compilation (@pxref{Compilation}) in the current project's root directory. +@findex project-shell-command + The command @kbd{C-x p !} (@code{project-shell-command}) runs +@code{shell-command} in the current project's root directory. + +@findex project-async-shell-command + The command @kbd{C-x p &} (@code{project-async-shell-command}) runs +@code{async-shell-command} in the current project's root directory. + @node Project Buffer Commands @subsection Project Commands That Operate on Buffers diff --git a/etc/NEWS b/etc/NEWS index 964b626d7b..658e2a35d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -778,6 +778,11 @@ directory. This command lets you "switch" to another project and run a project command chosen from a dispatch menu. ++++ +*** New commands 'project-shell-command' and 'project-async-shell-command'. +These commands run 'shell-command' and 'async-shell-command' in a +project's root directory, respectively. + +++ *** New user option 'project-list-file'. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 8afd5ce795..4fae3e9186 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -581,6 +581,8 @@ DIRS must contain directory names." ;;;###autoload (defvar project-prefix-map (let ((map (make-sparse-keymap))) + (define-key map "!" 'project-shell-command) + (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) @@ -882,6 +884,20 @@ if one already exists." (pop-to-buffer eshell-buffer) (eshell t)))) +;;;###autoload +(defun project-async-shell-command () + "Run `async-shell-command' in the current project's root directory." + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'async-shell-command))) + +;;;###autoload +(defun project-shell-command () + "Run `shell-command' in the current project's root directory." + (interactive) + (let ((default-directory (project-root (project-current t)))) + (call-interactively #'shell-command))) + (declare-function fileloop-continue "fileloop" ()) ;;;###autoload commit d2412492cad18c1ffd91d3f6dbd3b08b8859e18a Author: Stefan Kangas Date: Fri Aug 28 17:29:31 2020 +0200 Make XEmacs compat aliases obsolete in warnings.el * lisp/emacs-lisp/warnings.el (display-warning-minimum-level) (log-warning-minimum-level): Make XEmacs compat aliases into obsolete aliases for 'warning-minimum-level' and 'warning-minimum-log-level'. diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 07b4543330..b1fd6ed80a 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -68,7 +68,8 @@ Each element looks like (ALIAS . LEVEL) and defines ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels'; it may not itself be an alias.") -(defvaralias 'display-warning-minimum-level 'warning-minimum-level) +(define-obsolete-variable-alias 'display-warning-minimum-level + 'warning-minimum-level "28.1") (defcustom warning-minimum-level :warning "Minimum severity level for displaying the warning buffer. If a warning's severity level is lower than this, @@ -78,7 +79,8 @@ is not immediately displayed. See also `warning-minimum-log-level'." (const :warning) (const :debug)) :version "22.1") -(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level) +(define-obsolete-variable-alias 'log-warning-minimum-level + 'warning-minimum-log-level "28.1") (defcustom warning-minimum-log-level :warning "Minimum severity level for logging a warning. If a warning severity level is lower than this, commit 766cd0c7c337d34aeb7ec43b80a5008c713ddf0f Author: Stefan Kangas Date: Fri Aug 28 17:18:15 2020 +0200 Use lexical-binding in warnings.el and add tests * lisp/warnings.el: Use lexical-binding. Remove redundant :group args. * test/lisp/warnings-tests.el: New file. diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index cd960618a0..07b4543330 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -1,4 +1,4 @@ -;;; warnings.el --- log and display warnings +;;; warnings.el --- log and display warnings -*- lexical-binding:t -*- ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. @@ -74,7 +74,6 @@ it may not itself be an alias.") If a warning's severity level is lower than this, the warning is logged in the warnings buffer, but the buffer is not immediately displayed. See also `warning-minimum-log-level'." - :group 'warnings :type '(choice (const :emergency) (const :error) (const :warning) (const :debug)) :version "22.1") @@ -86,7 +85,6 @@ If a warning severity level is lower than this, the warning is completely ignored. Value must be lower or equal than `warning-minimum-level', because warnings not logged aren't displayed either." - :group 'warnings :type '(choice (const :emergency) (const :error) (const :warning) (const :debug)) :version "22.1") @@ -100,7 +98,6 @@ Thus, (foo bar) as an element matches (foo bar) or (foo bar ANYTHING...) as TYPE. If TYPE is a symbol FOO, that is equivalent to the list (FOO), so only the element (FOO) will match it." - :group 'warnings :type '(repeat (repeat symbol)) :version "22.1") @@ -115,7 +112,6 @@ or (foo bar ANYTHING...) as TYPE. If TYPE is a symbol FOO, that is equivalent to the list (FOO), so only the element (FOO) will match it. See also `warning-suppress-log-types'." - :group 'warnings :type '(repeat (repeat symbol)) :version "22.1") diff --git a/test/lisp/emacs-lisp/warnings-tests.el b/test/lisp/emacs-lisp/warnings-tests.el new file mode 100644 index 0000000000..02c09b41ca --- /dev/null +++ b/test/lisp/emacs-lisp/warnings-tests.el @@ -0,0 +1,60 @@ +;;; warnings-tests.el --- tests for warnings.el -*- lexical-binding: t; -*- + +;; Author: Stefan Kangas + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'warnings) + +(ert-deftest test-warning-suppress-p () + (should (warning-suppress-p 'foo '((foo)))) + (should (warning-suppress-p '(foo bar) '((foo bar)))) + (should (warning-suppress-p '(foo bar baz) '((foo bar)))) + (should-not (warning-suppress-p '(foo bar baz) '((foo bax)))) + (should-not (warning-suppress-p 'foobar nil))) + +(ert-deftest test-display-warning () + (dolist (level '(:emergency :error :warning)) + (with-temp-buffer + (display-warning '(foo) "Hello123" level (current-buffer)) + (should (string-match "foo" (buffer-string))) + (should (string-match "Hello123" (buffer-string)))) + (with-current-buffer "*Messages*" + (should (string-match "Hello123" (buffer-string)))))) + +(ert-deftest test-display-warning/warning-minimum-level () + ;; This test only works interactively: + :expected-result :failed + (let ((warning-minimum-level :emergency)) + (with-temp-buffer + (display-warning '(foo) "baz" :warning (current-buffer))) + (with-current-buffer "*Messages*" + (should-not (string-match "baz" (buffer-string)))))) + +(ert-deftest test-display-warning/warning-minimum-log-level () + (let ((warning-minimum-log-level :error)) + (with-temp-buffer + (display-warning '(foo) "hello" :warning (current-buffer)) + (should-not (string-match "hello" (buffer-string)))))) + +(provide 'warnings-tests) + +;;; warnings-tests.el ends here commit 7974422dfc59419503c588dd96ec2a083bdd5c34 Author: Eric Abrahamsen Date: Thu Aug 27 17:58:03 2020 -0700 New eieio-persistent-make-instance generic function This allows override of the read process for eieio-persistent objects, providing the possibility of matching read/write customization for eieio-persistent subclasses. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-make-instance): New generic function for constructing instances from object data written to disk. Previously known as eieio-persistent-convert-list-to-object. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index f09d1997ee..39ad30afc5 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -252,44 +252,41 @@ being pedantic." (error "Invalid object: %s is not an object of class %s nor a subclass" (car ret) class)) - (setq ret (eieio-persistent-convert-list-to-object ret)) + (setq ret (eieio-persistent-make-instance (car ret) (cdr ret))) (oset ret file filename)) (kill-buffer " *tmp eieio read*")) ret)) -(defun eieio-persistent-convert-list-to-object (inputlist) - "Convert the INPUTLIST, representing object creation to an object. -While it is possible to just `eval' the INPUTLIST, this code instead -validates the existing list, and explicitly creates objects instead of -calling eval. This avoids the possibility of accidentally running -malicious code. - -Note: This function recurses when a slot of :type of some object is -identified, and needing more object creation." - (let ((objclass (nth 0 inputlist)) - ;; Earlier versions of `object-write' added a string name for - ;; the object, now obsolete. - (slots (nthcdr - (if (stringp (nth 1 inputlist)) 2 1) - inputlist)) - (createslots nil)) - ;; If OBJCLASS is an eieio autoload object, then we need to - ;; load it (we don't need the return value). - (eieio--full-class-object objclass) - (while slots - (let ((initarg (car slots)) - (value (car (cdr slots)))) - - ;; Strip out quotes, list functions, and update object - ;; constructors as needed. - (setq value (eieio-persistent-fix-value value)) - - (push initarg createslots) - (push value createslots)) - - (setq slots (cdr (cdr slots)))) - - (apply #'make-instance objclass (nreverse createslots)))) +(cl-defgeneric eieio-persistent-make-instance (objclass inputlist) + "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS. +Clean slot values, and possibly recursively create additional +objects found there." + (:method + ((objclass (subclass eieio-default-superclass)) inputlist) + + (let ((slots (if (stringp (car inputlist)) + ;; Earlier versions of `object-write' added a + ;; string name for the object, now obsolete. + (cdr inputlist) + inputlist)) + (createslots nil)) + ;; If OBJCLASS is an eieio autoload object, then we need to + ;; load it (we don't need the return value). + (eieio--full-class-object objclass) + (while slots + (let ((initarg (car slots)) + (value (car (cdr slots)))) + + ;; Strip out quotes, list functions, and update object + ;; constructors as needed. + (setq value (eieio-persistent-fix-value value)) + + (push initarg createslots) + (push value createslots)) + + (setq slots (cdr (cdr slots)))) + + (apply #'make-instance objclass (nreverse createslots))))) (defun eieio-persistent-fix-value (proposed-value) "Fix PROPOSED-VALUE. @@ -323,7 +320,8 @@ tables, and vectors." ;; in. (let ((objlist nil)) (dolist (subobj (cdr proposed-value)) - (push (eieio-persistent-convert-list-to-object subobj) + (push (eieio-persistent-make-instance + (car subobj) (cdr subobj)) objlist)) ;; return the list of objects ... reversed. (nreverse objlist))) @@ -331,8 +329,8 @@ tables, and vectors." ;; saved here. Recurse and evaluate that ;; sub-object. ((class-p (car proposed-value)) - (eieio-persistent-convert-list-to-object - proposed-value)) + (eieio-persistent-make-instance + (car proposed-value) (cdr proposed-value))) (t proposed-value))) ;; For hash-tables and vectors, the top-level `read' will not @@ -345,8 +343,8 @@ tables, and vectors." (lambda (key value) (setf (gethash key proposed-value) (if (class-p (car-safe value)) - (eieio-persistent-convert-list-to-object - value) + (eieio-persistent-make-instance + (car value) (cdr value)) (eieio-persistent-fix-value value)))) proposed-value) proposed-value) @@ -356,8 +354,8 @@ tables, and vectors." (let ((val (aref proposed-value i))) (aset proposed-value i (if (class-p (car-safe val)) - (eieio-persistent-convert-list-to-object - val) + (eieio-persistent-make-instance + (car val) (cdr val)) (eieio-persistent-fix-value val))))) proposed-value) commit 4d741e577fbab8adf444c6c1930525bb7e8fc08d Author: Eric Abrahamsen Date: Thu Aug 27 17:17:19 2020 -0700 Remove redundant slot validation in eieio-persistent-read Actual object creation (in `make-instance') will later run all slot values through cl-typep, which does a better job of validation. This validation is redundant, and slows the read process down. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-fix-value): Rename from `eieio-persistent-validate/fix-slot-value', as we no longer validate, and we don't care about the slot definition. (eieio-persistent-slot-type-is-class-p): Delete function. (eieio-persistent-convert-list-to-object): Still call `eieio--full-class-object', to trigger an autoload if necessary, but discard the return value. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 2cb1f614ce..f09d1997ee 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -266,105 +266,75 @@ malicious code. Note: This function recurses when a slot of :type of some object is identified, and needing more object creation." - (let* ((objclass (nth 0 inputlist)) - ;; Earlier versions of `object-write' added a string name for - ;; the object, now obsolete. - (slots (nthcdr - (if (stringp (nth 1 inputlist)) 2 1) - inputlist)) - (createslots nil) - (class - (progn - ;; If OBJCLASS is an eieio autoload object, then we need to - ;; load it. - (eieio--full-class-object objclass)))) - + (let ((objclass (nth 0 inputlist)) + ;; Earlier versions of `object-write' added a string name for + ;; the object, now obsolete. + (slots (nthcdr + (if (stringp (nth 1 inputlist)) 2 1) + inputlist)) + (createslots nil)) + ;; If OBJCLASS is an eieio autoload object, then we need to + ;; load it (we don't need the return value). + (eieio--full-class-object objclass) (while slots (let ((initarg (car slots)) (value (car (cdr slots)))) - ;; Make sure that the value proposed for SLOT is valid. - ;; In addition, strip out quotes, list functions, and update - ;; object constructors as needed. - (setq value (eieio-persistent-validate/fix-slot-value - class (eieio--initarg-to-attribute class initarg) value)) + ;; Strip out quotes, list functions, and update object + ;; constructors as needed. + (setq value (eieio-persistent-fix-value value)) (push initarg createslots) - (push value createslots) - ) + (push value createslots)) (setq slots (cdr (cdr slots)))) - (apply #'make-instance objclass (nreverse createslots)) + (apply #'make-instance objclass (nreverse createslots)))) - ;;(eval inputlist) - )) +(defun eieio-persistent-fix-value (proposed-value) + "Fix PROPOSED-VALUE. +Remove leading quotes from lists, and the symbol `list' from the +head of lists. Explicitly construct any objects found, and strip +any text properties from string values. -(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value) - "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix. -A limited number of functions, such as quote, list, and valid object -constructor functions are considered valid. -Second, any text properties will be stripped from strings." +This function will descend into the contents of lists, hash +tables, and vectors." (cond ((consp proposed-value) ;; Lists with something in them need special treatment. - (let* ((slot-idx (- (eieio--slot-name-index class slot) - (eval-when-compile eieio--object-num-slots))) - (type (cl--slot-descriptor-type (aref (eieio--class-slots class) - slot-idx))) - (classtype (eieio-persistent-slot-type-is-class-p type))) - - (cond ((eq (car proposed-value) 'quote) - (car (cdr proposed-value))) - - ;; An empty list sometimes shows up as (list), which is dumb, but - ;; we need to support it for backward compat. - ((and (eq (car proposed-value) 'list) - (= (length proposed-value) 1)) - nil) - - ;; List of object constructors. - ((and (eq (car proposed-value) 'list) - ;; 2nd item is a list. - (consp (car (cdr proposed-value))) - ;; 1st elt of 2nd item is a class name. - (class-p (car (car (cdr proposed-value)))) - ) - - ;; Check the value against the input class type. - ;; If something goes wrong, issue a smart warning - ;; about how a :type is needed for this to work. - (unless (and - ;; Do we have a type? - (consp classtype) (class-p (car classtype))) - (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S" - slot classtype)) - - ;; We have a predicate, but it doesn't satisfy the predicate? - (dolist (PV (cdr proposed-value)) - (unless (child-of-class-p (car PV) (car classtype)) - (error "Invalid object: slot member %s does not match class %s" - (car PV) (car classtype)))) - - ;; We have a list of objects here. Lets load them - ;; in. - (let ((objlist nil)) - (dolist (subobj (cdr proposed-value)) - (push (eieio-persistent-convert-list-to-object subobj) - objlist)) - ;; return the list of objects ... reversed. - (nreverse objlist))) - ;; We have a slot with a single object that can be - ;; saved here. Recurse and evaluate that - ;; sub-object. - ((and classtype - (seq-some - (lambda (elt) - (child-of-class-p (car proposed-value) elt)) - (if (listp classtype) classtype (list classtype)))) - (eieio-persistent-convert-list-to-object - proposed-value)) - (t - proposed-value)))) + (cond ((eq (car proposed-value) 'quote) + (while (eq (car-safe proposed-value) 'quote) + (setq proposed-value (car (cdr proposed-value)))) + proposed-value) + + ;; An empty list sometimes shows up as (list), which is dumb, but + ;; we need to support it for backward compar. + ((and (eq (car proposed-value) 'list) + (= (length proposed-value) 1)) + nil) + + ;; List of object constructors. + ((and (eq (car proposed-value) 'list) + ;; 2nd item is a list. + (consp (car (cdr proposed-value))) + ;; 1st elt of 2nd item is a class name. + (class-p (car (car (cdr proposed-value))))) + + ;; We have a list of objects here. Lets load them + ;; in. + (let ((objlist nil)) + (dolist (subobj (cdr proposed-value)) + (push (eieio-persistent-convert-list-to-object subobj) + objlist)) + ;; return the list of objects ... reversed. + (nreverse objlist))) + ;; We have a slot with a single object that can be + ;; saved here. Recurse and evaluate that + ;; sub-object. + ((class-p (car proposed-value)) + (eieio-persistent-convert-list-to-object + proposed-value)) + (t + proposed-value))) ;; For hash-tables and vectors, the top-level `read' will not ;; "look inside" member values, so we need to do that ;; explicitly. Because `eieio-override-prin1' is recursive in @@ -377,8 +347,7 @@ Second, any text properties will be stripped from strings." (if (class-p (car-safe value)) (eieio-persistent-convert-list-to-object value) - (eieio-persistent-validate/fix-slot-value - class slot value)))) + (eieio-persistent-fix-value value)))) proposed-value) proposed-value) @@ -389,70 +358,16 @@ Second, any text properties will be stripped from strings." (if (class-p (car-safe val)) (eieio-persistent-convert-list-to-object val) - (eieio-persistent-validate/fix-slot-value - class slot val))))) + (eieio-persistent-fix-value val))))) proposed-value) - ((stringp proposed-value) - ;; Else, check for strings, remove properties. - (substring-no-properties proposed-value)) - - (t - ;; Else, just return whatever the constant was. - proposed-value)) - ) - -(defun eieio-persistent-slot-type-is-class-p (type) - "Return the class referred to in TYPE. -If no class is referenced there, then return nil." - (cond ((class-p type) - ;; If the type is a class, then return it. - type) - ((and (eq 'list-of (car-safe type)) (class-p (cadr type))) - ;; If it is the type of a list of a class, then return that class and - ;; the type. - (cons (cadr type) type)) - - ((and (symbolp type) (get type 'cl-deftype-handler)) - ;; Macro-expand the type according to cl-deftype definitions. - (eieio-persistent-slot-type-is-class-p - (funcall (get type 'cl-deftype-handler)))) - - ;; FIXME: foo-child should not be a valid type! - ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) - (class-p (intern-soft (substring (symbol-name type) 0 - (match-beginning 0))))) - (unless eieio-backward-compatibility - (error "Use of bogus %S type instead of %S" - type (intern-soft (substring (symbol-name type) 0 - (match-beginning 0))))) - ;; If it is the predicate ending with -child, then return - ;; that class. Unfortunately, in EIEIO, typep of just the - ;; class is the same as if we used -child, so no further work needed. - (intern-soft (substring (symbol-name type) 0 - (match-beginning 0)))) - ;; FIXME: foo-list should not be a valid type! - ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) - (class-p (intern-soft (substring (symbol-name type) 0 - (match-beginning 0))))) - (unless eieio-backward-compatibility - (error "Use of bogus %S type instead of (list-of %S)" - type (intern-soft (substring (symbol-name type) 0 - (match-beginning 0))))) - ;; If it is the predicate ending with -list, then return - ;; that class and the predicate to use. - (cons (intern-soft (substring (symbol-name type) 0 - (match-beginning 0))) - type)) - - ((eq (car-safe type) 'or) - ;; If type is a list, and is an `or', return all valid class - ;; types within the `or' statement. - (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type))) + ((stringp proposed-value) + ;; Else, check for strings, remove properties. + (substring-no-properties proposed-value)) (t - ;; No match, not a class. - nil))) + ;; Else, just return whatever the constant was. + proposed-value))) (cl-defmethod object-write ((this eieio-persistent) &optional comment) "Write persistent object THIS out to the current stream. commit 649a52822f207e1d302f0e089010b84d5e882281 Author: Harald Jörg Date: Fri Aug 28 16:33:13 2020 +0200 Fix indent-region for identifiers with underscores in cperl-mode * lisp/progmodes/cperl-mode.el (cperl-fix-line-spacing): Fix Bug#18985. Hash keys or function names starting with a Perl keyword followed by an underscore (as in "for_me" are no longer split into two words by M-x indent-region. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c47aa2ea8c..44579cfd38 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -4876,7 +4876,7 @@ Returns some position at the last line." ;; }? continue ;; blah; } (if (not - (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") + (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|unless\\|until\\)\\_>") (setq have-brace (save-excursion (search-forward "}" ee t))))) nil ; Do not need to do anything ;; Looking at: @@ -4884,7 +4884,7 @@ Returns some position at the last line." ;; else (if cperl-merge-trailing-else (if (looking-at - "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (setq p (point)) @@ -4892,7 +4892,7 @@ Returns some position at the last line." (delete-region p (point)) (insert (make-string cperl-indent-region-fix-constructs ?\s)) (beginning-of-line))) - (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (save-excursion (search-forward "}") (delete-horizontal-space) @@ -4904,7 +4904,7 @@ Returns some position at the last line." (setq ret (point))))))) ;; Looking at: ;; } else - (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (delete-horizontal-space) commit d77dc2609f6b1cc61a044b535f3d473592b883fc Author: Stefan Kangas Date: Fri Aug 28 16:10:09 2020 +0200 * lisp/mwheel.el: Improve package description. diff --git a/lisp/mwheel.el b/lisp/mwheel.el index c385fdfc26..d5172ba0bf 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -25,8 +25,8 @@ ;; Under X11/X.Org, the wheel events are sent as button4/button5 ;; events. -;; It is already enabled by default on most graphical displays. You -;; can toggle it with M-x mouse-wheel-mode. +;; Mouse wheel support is already enabled by default on most graphical +;; displays. You can toggle it using `M-x mouse-wheel-mode'. ;;; Code: