From 0c3fc71d3bef37bac6a766d319c4574cd24c20c0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 30 Aug 2019 10:04:23 +0300 Subject: [PATCH 001/105] ; Bump Emacs version to 26.3.50 * README: * etc/NEWS: * configure.ac: * msdos/sed2v2.inp: * nt/README.W32: Bump Emacs version to 26.3.50. --- README | 2 +- configure.ac | 2 +- etc/NEWS | 27 +++++++++++++++++++++++++++ msdos/sed2v2.inp | 2 +- nt/README.W32 | 2 +- 5 files changed, 31 insertions(+), 4 deletions(-) diff --git a/README b/README index 1c4341de037..5462db0400b 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2019 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 26.3 of GNU Emacs, the extensible, +This directory tree holds version 26.3.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index ebf24c8657e..b4a41ba78ca 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 26.3, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 26.3.50, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/etc/NEWS b/etc/NEWS index de42606d2b8..61d5115cdc5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,33 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. + +* Installation Changes in Emacs 26.4 + + +* Startup Changes in Emacs 26.4 + + +* Changes in Emacs 26.4 + + +* Editing Changes in Emacs 26.4 + + +* Changes in Specialized Modes and Packages in Emacs 26.4 + + +* New Modes and Packages in Emacs 26.4 + + +* Incompatible Lisp Changes in Emacs 26.4 + + +* Lisp Changes in Emacs 26.4 + + +* Changes in Emacs 26.4 on Non-Free Operating Systems + * Changes in Emacs 26.3 diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index f0108921295..f2ed3ff9857 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.3"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "26.3.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 1ba4081a682..47c9bd7aa9d 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2019 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 26.3 for MS-Windows + Emacs version 26.3.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You From 8e420c09bcef1bf2a08b03deb74d5c663d898e33 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 31 Aug 2019 14:32:13 +0000 Subject: [PATCH 002/105] Clarify the use of left/right-margin-width in determining current margin width * doc/lispref/display.texi (Display-Margins): Clarify that left/right-margin-width can not be used to determine the current margin width, and that window-margins must be used instead. --- doc/lispref/display.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9eb406b3c6a..853f69fa330 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4928,7 +4928,9 @@ means no right marginal area. Setting these variables does not immediately affect the window. These variables are checked when a new buffer is displayed in the window. Thus, you can make changes take effect by calling -@code{set-window-buffer}. +@code{set-window-buffer}. Do not use these variables to try to +determine the current width of the left or right margin. Instead, use +the function @code{window-margins}. You can also set the margin widths immediately. From 7e527af72cae65fdb3f61c7d92907cfdfd1e6ea3 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 22 Aug 2019 20:48:19 -0400 Subject: [PATCH 003/105] Fix non-deterministic process test * test/src/process-tests.el (set-process-filter-t): Don't assume subprocess output will come in a single chunk, keep waiting for more data until next "prompt" is read from subprocess. (cherry picked from commit aa49aa884053d0e8b33efe265f2aade19d1f3f3d) --- test/src/process-tests.el | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 7a6762a9226..ef057af6b79 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -154,24 +154,30 @@ (concat invocation-directory invocation-name) "-Q" "--batch" "--eval" (prin1-to-string - '(let (s) - (while (setq s (read-from-minibuffer "$ ")) + '(let ((s nil) (count 0)) + (while (setq s (read-from-minibuffer + (format "%d> " count))) (princ s) - (princ "\n"))))))) + (princ "\n") + (setq count (1+ count)))))))) (set-process-query-on-exit-flag proc nil) (send-string proc "one\n") - (should - (accept-process-output proc 1)) ; Read "one". - (should (equal (buffer-string) "$ one\n$ ")) + (while (not (equal (buffer-substring + (line-beginning-position) (point-max)) + "1> ")) + (accept-process-output proc)) ; Read "one". + (should (equal (buffer-string) "0> one\n1> ")) (set-process-filter proc t) ; Stop reading from proc. (send-string proc "two\n") (should-not (accept-process-output proc 1)) ; Can't read "two" yet. - (should (equal (buffer-string) "$ one\n$ ")) + (should (equal (buffer-string) "0> one\n1> ")) (set-process-filter proc nil) ; Resume reading from proc. - (should - (accept-process-output proc 1)) ; Read "two" from proc. - (should (equal (buffer-string) "$ one\n$ two\n$ "))))) + (while (not (equal (buffer-substring + (line-beginning-position) (point-max)) + "2> ")) + (accept-process-output proc)) ; Read "Two". + (should (equal (buffer-string) "0> one\n1> two\n2> "))))) (ert-deftest start-process-should-not-modify-arguments () "`start-process' must not modify its arguments in-place." From 13b951001c15a78f7f8cb4bff1825cc77b2c8456 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 22 Aug 2019 16:14:26 +0200 Subject: [PATCH 004/105] Add description of chinese-sisheng MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/emacs/mule.texi (Input Methods): Add description of chinese-sisheng method for entering characters using pīnyīn. --- doc/emacs/mule.texi | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index b3e7d218c62..4ed13b8787c 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -497,6 +497,10 @@ one of them selects that alternative. The keys @kbd{C-f}, @kbd{C-b}, do the highlighting in the buffer showing the possible characters, rather than in the echo area. + To enter characters according to the @dfn{pīnyīn} transliteration +method instead, use the @code{chinese-sisheng} input method. This is +a composition based method, where e.g. @kbd{pi1} results in @samp{pī}. + In Japanese input methods, first you input a whole word using phonetic spelling; then, after the word is in the buffer, Emacs converts it into one or more characters using a large dictionary. One From c596be08f71e8118ddaa3e330997716de4c109ab Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 7 Sep 2019 18:15:40 +0000 Subject: [PATCH 005/105] Amend the menu caption for page "Display Property" in the Elisp manual. * doc/lispref/display.texi (Emacs Display): Replace a content-free menu caption with one mentioning images, margins and text size. --- doc/lispref/display.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 853f69fa330..55a0a2f9243 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -25,7 +25,7 @@ that Emacs presents to the user. * Fringes:: Controlling window fringes. * Scroll Bars:: Controlling scroll bars. * Window Dividers:: Separating windows visually. -* Display Property:: Enabling special display features. +* Display Property:: Images, margins, text size, etc. * Images:: Displaying images in Emacs buffers. * Xwidgets:: Displaying native widgets in Emacs buffers. * Buttons:: Adding clickable buttons to Emacs buffers. From 30c4f35a6fc8a6507930923766c3126ac1c2063f Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Mon, 9 Sep 2019 08:21:18 +0200 Subject: [PATCH 006/105] query-replace-regexp undo: Update next-replacement after undo * lisp/replace.el (perform-replace): Rename the local binding to not shadow next-replacement. Update next-replacement after undo (Bug#37287). * test/lisp/replace-tests.el (query-replace-undo-bug37287): Add test. (query-replace-undo-bug37073): Tweak this test. --- lisp/replace.el | 14 ++++++++------ test/lisp/replace-tests.el | 18 +++++++++++++++++- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 0ddebb12704..dd24d8ba923 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2584,7 +2584,7 @@ It must return a string." (num-replacements 0) (nocasify t) ; Undo must preserve case (Bug#31073). search-string - next-replacement) + last-replacement) (while (and (< stack-idx stack-len) stack (or (null replaced) last-was-act-and-show)) @@ -2595,9 +2595,9 @@ It must return a string." ;; Bind swapped values ;; (search-string <--> replacement) search-string (nth (if replaced 4 3) elt) - next-replacement (nth (if replaced 3 4) elt) + last-replacement (nth (if replaced 3 4) elt) search-string-replaced search-string - next-replacement-replaced next-replacement + last-replacement-replaced last-replacement last-was-act-and-show nil) (when (and (= stack-idx stack-len) @@ -2619,16 +2619,18 @@ It must return a string." (match-data t (nth 2 elt))) noedit (replace-match-maybe-edit - next-replacement nocasify literal + last-replacement nocasify literal noedit real-match-data backward) replace-count (1- replace-count) real-match-data (save-excursion (goto-char (match-beginning 0)) (if regexp-flag - (looking-at next-replacement) - (looking-at (regexp-quote next-replacement))) + (looking-at last-replacement) + (looking-at (regexp-quote last-replacement))) (match-data t (nth 2 elt)))) + (when regexp-flag + (setq next-replacement (nth 4 elt))) ;; Set replaced nil to keep in loop (when (eq def 'undo-all) (setq replaced nil diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index cd08a522e39..2a3f207e47b 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -463,7 +463,9 @@ Return the last evalled form in BODY." (should (replace-tests-with-undo input "theorem \\([0-9]+\\)" - "theorem \\\\ref{theo_\\1}" + '(replace-eval-replacement + replace-quote + (format "theorem \\\\ref{theo_%d}" (1+ (string-to-number (match-string 1))))) ((?\s . (1 2)) (?U . (3))) ?q (string= input (buffer-string))))) @@ -479,4 +481,18 @@ Return the last evalled form in BODY." ?q (string= expected (buffer-string)))))) +(ert-deftest query-replace-undo-bug37287 () + "Test for https://debbugs.gnu.org/37287 ." + (let ((input "foo-1\nfoo-2\nfoo-3") + (expected "foo-2\nfoo-2\nfoo-3")) + (should + (replace-tests-with-undo + input "\\([0-9]\\)" + '(replace-eval-replacement + replace-quote + (format "%d" (1+ (string-to-number (match-string 1))))) + ((?\s . (1 2 4)) (?U . (3))) + ?q + (string= expected (buffer-string)))))) + ;;; replace-tests.el ends here From 4b9f9324a87388ceb7ce1359feb5686efcb2523e Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Wed, 11 Sep 2019 02:41:34 +0000 Subject: [PATCH 007/105] Create a new overlay used to mark Attachment header (bug#37370) * lisp/gnus/gnus-art.el (gnus-mime-inline-part) (gnus-mm-display-part, gnus-mime-buttonize-attachments-in-header): Create a new overlay used to mark Attachment header instead of using existing overlays. --- lisp/gnus/gnus-art.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 04cb087737f..eba66c1c3aa 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5378,9 +5378,9 @@ Compressed files like .gz and .bz2 are decompressed." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (overlays-in btn (point))) + (let ((ovl (make-overlay btn (point)))) (overlay-put ovl 'gnus-button-attachment-extra t) - (overlay-put ovl 'face nil)) + (overlay-put ovl 'evaporate t)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -5763,9 +5763,9 @@ all parts." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (overlays-in point (point))) + (let ((ovl (make-overlay point (point)))) (overlay-put ovl 'gnus-button-attachment-extra t) - (overlay-put ovl 'face nil)) + (overlay-put ovl 'evaporate t)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -6379,9 +6379,9 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." (insert "\n") (end-of-line))) (insert "\n") - (dolist (ovl (overlays-in (point-min) (point))) + (let ((ovl (make-overlay (point-min) (point)))) (overlay-put ovl 'gnus-button-attachment-extra t) - (overlay-put ovl 'face nil)) + (overlay-put ovl 'evaporate t)) (let ((gnus-treatment-function-alist '((gnus-treat-highlight-headers gnus-article-highlight-headers)))) From 4d90fadf27ccbb98e0e174304cb4e3008bf364fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 11 Sep 2019 11:18:38 +0200 Subject: [PATCH 008/105] * lisp/emacs-lisp/elint.el (elint-directory-skip-re): Fix doc typo. --- lisp/emacs-lisp/elint.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index b7ef6eeb2ae..187d619f1bc 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -106,7 +106,7 @@ are as follows, and suppress messages about the indicated features: :group 'elint) (defcustom elint-directory-skip-re "\\(ldefs-boot\\|loaddefs\\)\\.el\\'" - "If nil, a regexp matching files to skip when linting a directory." + "If non-nil, a regexp matching files to skip when linting a directory." :type '(choice (const :tag "Lint all files" nil) (regexp :tag "Regexp to skip")) :safe 'string-or-null-p From 636856faa4de78912bf41eeaf0e639664a323424 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 08:50:02 -0700 Subject: [PATCH 009/105] Fix auto-save with user-emacs-directory * lisp/startup.el (auto-save-list-file-prefix): Delay initialization, since the value depends on user-emacs-directory (Bug#37354). --- lisp/startup.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/startup.el b/lisp/startup.el index a16db242da0..ef6234128aa 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -406,6 +406,7 @@ if you have not already set `auto-save-list-file-name' yourself. Directories in the prefix will be created if necessary. Set this to nil if you want to prevent `auto-save-list-file-name' from being initialized." + :initialize #'custom-initialize-delay :type '(choice (const :tag "Don't record a session's auto save list" nil) string) :group 'auto-save) From a6daae7b3df3a964b3dcde85987c02fd0af66a89 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 10:19:07 -0700 Subject: [PATCH 010/105] Reset dbus registered buses on dump load Problem reported by Leonard Lausen (Bug#37331). * src/dbusbind.c: Include pdumper.h. (syms_of_dbusbind_for_pdumper): New function, to reset the registered buses. (syms_of_dbusbind): Use it, fixing a TODO. --- src/dbusbind.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/dbusbind.c b/src/dbusbind.c index 7f4c8717f42..de67dc94f9e 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "termhooks.h" #include "keyboard.h" +#include "pdumper.h" #include "process.h" #ifndef DBUS_NUM_MESSAGE_TYPES @@ -1681,6 +1682,12 @@ init_dbusbind (void) xputenv ("DBUS_FATAL_WARNINGS=0"); } +static void +syms_of_dbusbind_for_pdumper (void) +{ + xd_registered_buses = Qnil; +} + void syms_of_dbusbind (void) { @@ -1829,13 +1836,10 @@ be called when the D-Bus reply message arrives. */); #endif /* Initialize internal objects. */ - xd_registered_buses = Qnil; + pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper); staticpro (&xd_registered_buses); - // TODO: reset buses on dump load - Fprovide (intern_c_string ("dbusbind"), Qnil); - } #endif /* HAVE_DBUS */ From 5fafa40d076ee24baf880e97d4290b6196cf838a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 11:26:07 -0700 Subject: [PATCH 011/105] Improve checking of pdump load failures * src/alloc.c (memory_full): Just report "memory exhausted" if failure occurs during initialization, since fancier recovery schemes are not likely to work when not initialized. * src/emacs.c (dump_error_to_string): Accept int, not enum pdumper_load_result, since the result might not fit in the enum. Use strerror if it was derived from errno. This is for better diagnostics of pdump load failures. (load_pdump_find_executable): Return char *, not enum. 2nd arg is now pointer to buffer size, rather than pointer to pointer to buffer. All callers changed. Use Emacs allocator since they should now be OK even during early startup. Use check_executable instead access, to use effective rather than real permissions. (load_pdump): Return void since callers ignore result. Use int where enum could be too narrow. Use heap rather than stack for possibly-long string. Prefer ptrdiff_t to size_t. * src/fileio.c (check_executable): Now extern. * src/pdumper.c (pdumper_load): Return int that may have errno added to it, for better diagnostics when loads fail. --- src/alloc.c | 3 + src/emacs.c | 182 +++++++++++++++++++++----------------------------- src/fileio.c | 2 +- src/lisp.h | 1 + src/pdumper.c | 11 ++- src/pdumper.h | 4 +- 6 files changed, 91 insertions(+), 112 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index be98cfd5f53..2d490f3bb75 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3844,6 +3844,9 @@ set_interval_marked (INTERVAL i) void memory_full (size_t nbytes) { + if (!initialized) + fatal ("memory exhausted"); + /* Do not go into hysterics merely because a large request failed. */ bool enough_free_memory = false; if (SPARE_MEMORY < nbytes) diff --git a/src/emacs.c b/src/emacs.c index 53572d7f0c8..5a526687b14 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -662,7 +662,7 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr, #ifdef HAVE_PDUMPER static const char * -dump_error_to_string (enum pdumper_load_result result) +dump_error_to_string (int result) { switch (result) { @@ -681,37 +681,29 @@ dump_error_to_string (enum pdumper_load_result result) case PDUMPER_LOAD_VERSION_MISMATCH: return "not built for this Emacs executable"; default: - return "generic error"; + return (result <= PDUMPER_LOAD_ERROR + ? "generic error" + : strerror (result - PDUMPER_LOAD_ERROR)); } } -/* Find a path (absolute or relative) to the Emacs executable. - Called early in initialization by portable dumper loading code, so we - can't use lisp and associated machinery. On success, *EXENAME is - set to a heap-allocated string giving a path to the Emacs - executable or to NULL if we can't determine the path immediately. - */ -static enum pdumper_load_result -load_pdump_find_executable (const char* argv0, char **exename) +/* Find a name (absolute or relative) of the Emacs executable whose + name (as passed into this program) is ARGV0. Called early in + initialization by portable dumper loading code, so avoid Lisp and + associated machinery. Return a heap-allocated string giving a name + of the Emacs executable, or an empty heap-allocated string or NULL + if not found. Store into *CANDIDATE_SIZE a lower bound on the size + of any heap allocation. */ +static char * +load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) { - enum pdumper_load_result result; + *candidate_size = 0; + + /* Use xstrdup etc. to allocate storage, so as to call our private + implementation of malloc, since the caller calls our free. */ #ifdef WINDOWSNT - result = PDUMPER_LOAD_ERROR; - *exename = NULL; char *prog_fname = w32_my_exename (); - if (prog_fname) - { - result = PDUMPER_LOAD_OOM; - /* Use xstrdup, so as to call our private implementation of - malloc, since the caller calls our free. */ - char *ret = xstrdup (prog_fname); - if (ret) - { - *exename = ret; - result = PDUMPER_LOAD_SUCCESS; - } - } - return result; + return prog_fname ? xstrdup (prog_fname) : NULL; #else /* !WINDOWSNT */ char *candidate = NULL; @@ -719,33 +711,23 @@ load_pdump_find_executable (const char* argv0, char **exename) path already, so just copy it. */ eassert (argv0); if (strchr (argv0, DIRECTORY_SEP)) - { - result = PDUMPER_LOAD_OOM; - char *ret = strdup (argv0); - if (!ret) - goto out; - result = PDUMPER_LOAD_SUCCESS; - *exename = ret; - goto out; - } - size_t argv0_length = strlen (argv0); + return xstrdup (argv0); + ptrdiff_t argv0_length = strlen (argv0); const char *path = getenv ("PATH"); if (!path) { /* Default PATH is implementation-defined, so we don't know how to conduct the search. */ - result = PDUMPER_LOAD_SUCCESS; - *exename = NULL; - goto out; + return NULL; } /* Actually try each concatenation of a path element and the executable basename. */ - const char path_sep[] = { SEPCHAR, '\0' }; do { - size_t path_part_length = strcspn (path, path_sep); + static char const path_sep[] = { SEPCHAR, '\0' }; + ptrdiff_t path_part_length = strcspn (path, path_sep); const char *path_part = path; path += path_part_length; if (path_part_length == 0) @@ -753,46 +735,34 @@ load_pdump_find_executable (const char* argv0, char **exename) path_part = "."; path_part_length = 1; } - size_t candidate_length = path_part_length + 1 + argv0_length; - { - char *new_candidate = realloc (candidate, candidate_length + 1); - if (!new_candidate) - { - result = PDUMPER_LOAD_OOM; - goto out; - } - candidate = new_candidate; - } + ptrdiff_t needed = path_part_length + 1 + argv0_length + 1; + if (*candidate_size <= needed) + { + xfree (candidate); + candidate = xpalloc (NULL, candidate_size, + needed - *candidate_size + 1, -1, 1); + } memcpy (candidate + 0, path_part, path_part_length); candidate[path_part_length] = DIRECTORY_SEP; memcpy (candidate + path_part_length + 1, argv0, argv0_length + 1); struct stat st; - if (!access (candidate, X_OK) && - !stat (candidate, &st) && - S_ISREG (st.st_mode)) - { - *exename = candidate; - candidate = NULL; - break; - } - } while ((path++)[0] != '\0'); + if (check_executable (candidate) + && stat (candidate, &st) == 0 && S_ISREG (st.st_mode)) + return candidate; + *candidate = '\0'; + } + while (*path++ != '\0'); - result = PDUMPER_LOAD_SUCCESS; - - out: - free (candidate); - return result; + return candidate; #endif /* !WINDOWSNT */ } -static enum pdumper_load_result +static void load_pdump (int argc, char **argv) { const char *const suffix = ".pdmp"; - enum pdumper_load_result result; - char *exename = NULL; - char *real_exename = NULL; - const char* strip_suffix = + int result; + const char *strip_suffix = #if defined DOS_NT || defined CYGWIN ".exe" #else @@ -821,7 +791,6 @@ load_pdump (int argc, char **argv) skip_args++; } - result = PDUMPER_NOT_LOADED; if (dump_file) { result = pdumper_load (dump_file); @@ -829,8 +798,7 @@ load_pdump (int argc, char **argv) if (result != PDUMPER_LOAD_SUCCESS) fatal ("could not load dump file \"%s\": %s", dump_file, dump_error_to_string (result)); - else - goto out; + return; } /* Look for a dump file in the same directory as the executable; it @@ -839,44 +807,41 @@ load_pdump (int argc, char **argv) so we can't use decode_env_path. We're working in whatever encoding the system natively uses for filesystem access, so there's no need for character set conversion. */ - result = load_pdump_find_executable (argv[0], &exename); - if (result != PDUMPER_LOAD_SUCCESS) - goto out; + ptrdiff_t bufsize; + dump_file = load_pdump_find_executable (argv[0], &bufsize); /* If we couldn't find our executable, go straight to looking for the dump in the hardcoded location. */ - if (exename) + if (dump_file && *dump_file) { #ifdef WINDOWSNT /* w32_my_exename resolves symlinks internally, so no need to call realpath. */ - real_exename = exename; - exename = NULL; #else - real_exename = realpath (exename, NULL); + char *real_exename = realpath (dump_file, NULL); if (!real_exename) fatal ("could not resolve realpath of \"%s\": %s", - exename, strerror (errno)); + dump_file, strerror (errno)); + xfree (dump_file); + dump_file = real_exename; +#endif + ptrdiff_t exenamelen = strlen (dump_file); +#ifndef WINDOWSNT + bufsize = exenamelen + 1; #endif - size_t real_exename_length = strlen (real_exename); if (strip_suffix) { - size_t strip_suffix_length = strlen (strip_suffix); - if (real_exename_length >= strip_suffix_length) - { - size_t prefix_length = - real_exename_length - strip_suffix_length; - if (!memcmp (&real_exename[prefix_length], - strip_suffix, - strip_suffix_length)) - real_exename_length = prefix_length; - } + ptrdiff_t strip_suffix_length = strlen (strip_suffix); + ptrdiff_t prefix_length = exenamelen - strip_suffix_length; + if (0 <= prefix_length + && !memcmp (&dump_file[prefix_length], strip_suffix, + strip_suffix_length)) + exenamelen = prefix_length; } - dump_file = alloca (real_exename_length + strlen (suffix) + 1); - memcpy (dump_file, real_exename, real_exename_length); - memcpy (dump_file + real_exename_length, - suffix, - strlen (suffix) + 1); + ptrdiff_t needed = exenamelen + strlen (suffix) + 1; + if (bufsize < needed) + dump_file = xpalloc (dump_file, &bufsize, needed - bufsize, -1, 1); + strcpy (dump_file + exenamelen, suffix); result = pdumper_load (dump_file); if (result == PDUMPER_LOAD_SUCCESS) goto out; @@ -896,16 +861,19 @@ load_pdump (int argc, char **argv) "emacs.pdmp" so that the Emacs binary still works if the user copies and renames it. */ const char *argv0_base = "emacs"; - dump_file = alloca (strlen (path_exec) + ptrdiff_t needed = (strlen (path_exec) + 1 + strlen (argv0_base) + strlen (suffix) + 1); + if (bufsize < needed) + { + xfree (dump_file); + dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1); + } sprintf (dump_file, "%s%c%s%s", path_exec, DIRECTORY_SEP, argv0_base, suffix); result = pdumper_load (dump_file); - if (result == PDUMPER_LOAD_SUCCESS) - goto out; if (result == PDUMPER_LOAD_FILE_NOT_FOUND) { @@ -920,13 +888,18 @@ load_pdump (int argc, char **argv) last_sep = p; } argv0_base = last_sep ? last_sep + 1 : argv[0]; - dump_file = alloca (strlen (path_exec) + ptrdiff_t needed = (strlen (path_exec) + 1 + strlen (argv0_base) + strlen (suffix) + 1); + if (bufsize < needed) + { + xfree (dump_file); + dump_file = xmalloc (needed); + } #ifdef DOS_NT - size_t argv0_len = strlen (argv0_base); + ptrdiff_t argv0_len = strlen (argv0_base); if (argv0_len >= 4 && c_strcasecmp (argv0_base + argv0_len - 4, ".exe") == 0) sprintf (dump_file, "%s%c%.*s%s", path_exec, DIRECTORY_SEP, @@ -943,13 +916,10 @@ load_pdump (int argc, char **argv) if (result != PDUMPER_LOAD_FILE_NOT_FOUND) fatal ("could not load dump file \"%s\": %s", dump_file, dump_error_to_string (result)); - dump_file = NULL; } out: - free (exename); - free (real_exename); - return result; + xfree (dump_file); } #endif /* HAVE_PDUMPER */ diff --git a/src/fileio.c b/src/fileio.c index 968a55e5956..cbc0c89cf3e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -150,7 +150,7 @@ check_existing (const char *filename) /* Return true if file FILENAME exists and can be executed. */ -static bool +bool check_executable (char *filename) { return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0; diff --git a/src/lisp.h b/src/lisp.h index a7b19ab576e..024e5edb26e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4298,6 +4298,7 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ +extern bool check_executable (char *); extern char *splice_dir_file (char *, char const *, char const *); extern bool file_name_absolute_p (const char *); extern char const *get_homedir (void); diff --git a/src/pdumper.c b/src/pdumper.c index 98090238b1a..2e382145be2 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5303,7 +5303,7 @@ enum dump_section N.B. We run very early in initialization, so we can't use lisp, unwinding, xmalloc, and so on. */ -enum pdumper_load_result +int pdumper_load (const char *dump_filename) { intptr_t dump_size; @@ -5328,10 +5328,15 @@ pdumper_load (const char *dump_filename) /* We can load only one dump. */ eassert (!dump_loaded_p ()); - enum pdumper_load_result err = PDUMPER_LOAD_FILE_NOT_FOUND; + int err; int dump_fd = emacs_open (dump_filename, O_RDONLY, 0); if (dump_fd < 0) - goto out; + { + err = (errno == ENOENT || errno == ENOTDIR + ? PDUMPER_LOAD_FILE_NOT_FOUND + : PDUMPER_LOAD_ERROR + errno); + goto out; + } err = PDUMPER_LOAD_FILE_NOT_FOUND; if (fstat (dump_fd, &stat) < 0) diff --git a/src/pdumper.h b/src/pdumper.h index 83c094f3caa..31b0d53b073 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -124,10 +124,10 @@ enum pdumper_load_result PDUMPER_LOAD_FAILED_DUMP, PDUMPER_LOAD_OOM, PDUMPER_LOAD_VERSION_MISMATCH, - PDUMPER_LOAD_ERROR, + PDUMPER_LOAD_ERROR /* Must be last, as errno may be added. */ }; -enum pdumper_load_result pdumper_load (const char *dump_filename); +int pdumper_load (const char *dump_filename); struct pdumper_loaded_dump { From ef926ce3b6a078039303ae210e599dc4d3faa13b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 14:24:03 -0700 Subject: [PATCH 012/105] Omit duplicate test of current directory * src/callproc.c (encode_current_directory): Remove redundant call to Ffile_accessible_directory_p. The code checks the encoded name with file_accessible_directory_p anyway. --- src/callproc.c | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/src/callproc.c b/src/callproc.c index b296bdb088b..4473b19a297 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -108,11 +108,8 @@ static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t); Lisp_Object encode_current_directory (void) { - Lisp_Object dir; - - dir = BVAR (current_buffer, directory); - - dir = Funhandled_file_name_directory (dir); + Lisp_Object curdir = BVAR (current_buffer, directory); + Lisp_Object dir = Funhandled_file_name_directory (curdir); /* If the file name handler says that dir is unreachable, use a sensible default. */ @@ -120,17 +117,10 @@ encode_current_directory (void) dir = build_string ("~"); dir = expand_and_dir_to_file (dir); - - if (NILP (Ffile_accessible_directory_p (dir))) - report_file_error ("Setting current directory", - BVAR (current_buffer, directory)); - - /* Remove "/:" from DIR and encode it. */ dir = ENCODE_FILE (remove_slash_colon (dir)); if (! file_accessible_directory_p (dir)) - report_file_error ("Setting current directory", - BVAR (current_buffer, directory)); + report_file_error ("Setting current directory", curdir); return dir; } From f7228a6479cc8c88a23138980d958c4c431dd6a5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 23:22:46 -0700 Subject: [PATCH 013/105] Fix directory-files-and-attributes race * src/dired.c (directory_files_internal): Fix race condition: when some other process removed a file between the readdir and the ensuing lstat, directory-files-and-attributes would return a list containing nil. --- src/dired.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/dired.c b/src/dired.c index 7bc4b83fd77..58fa848e2e3 100644 --- a/src/dired.c +++ b/src/dired.c @@ -295,7 +295,8 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, { Lisp_Object fileattrs = file_attributes (fd, dp->d_name, directory, name, id_format); - list = Fcons (Fcons (finalname, fileattrs), list); + if (!NILP (fileattrs)) + list = Fcons (Fcons (finalname, fileattrs), list); } else list = Fcons (finalname, list); From ffa870fc806451b9bd4504bebbf9085f4b4c0be8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 11 Sep 2019 23:45:32 -0700 Subject: [PATCH 014/105] Improve error reporting for DOC file problems * src/doc.c (get_doc_string): Report all serious errors when DOC cannot be opened, not just fd-exhaustion errors. --- src/doc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/doc.c b/src/doc.c index 247be79adaf..b06b87c6114 100644 --- a/src/doc.c +++ b/src/doc.c @@ -136,7 +136,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } if (fd < 0) { - if (errno == EMFILE || errno == ENFILE) + if (errno != ENOENT && errno != ENOTDIR) report_file_error ("Read error on documentation file", file); SAFE_FREE (); From c19f5dcd474bfc883fc7555eef7d8f50a0df3157 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 12 Sep 2019 00:25:47 -0700 Subject: [PATCH 015/105] Fix file name encoding when open_directory signals * src/dired.c (open_directory): New arg ENCODED_DIRNAME. All callers changed. Signal error with original name, not encoded name. --- src/dired.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/dired.c b/src/dired.c index 58fa848e2e3..cec79ab46be 100644 --- a/src/dired.c +++ b/src/dired.c @@ -79,9 +79,9 @@ dirent_type (struct dirent *dp) } static DIR * -open_directory (Lisp_Object dirname, int *fdp) +open_directory (Lisp_Object dirname, Lisp_Object encoded_dirname, int *fdp) { - char *name = SSDATA (dirname); + char *name = SSDATA (encoded_dirname); DIR *d; int fd, opendir_errno; @@ -187,11 +187,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ - dirfilename = ENCODE_FILE (dirfilename); + Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename); encoded_directory = ENCODE_FILE (directory); int fd; - DIR *d = open_directory (dirfilename, &fd); + DIR *d = open_directory (dirfilename, encoded_dirfilename, &fd); /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must @@ -210,7 +210,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, { /* w32.c:stat will notice these bindings and avoid calling GetDriveType for each file. */ - if (is_slow_fs (SSDATA (dirfilename))) + if (is_slow_fs (SSDATA (encoded_dirfilename))) Vw32_get_true_file_attributes = Qnil; else Vw32_get_true_file_attributes = Qt; @@ -509,7 +509,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, } } int fd; - DIR *d = open_directory (encoded_dir, &fd); + DIR *d = open_directory (dirname, encoded_dir, &fd); record_unwind_protect_ptr (directory_files_internal_unwind, d); /* Loop reading directory entries. */ From 997415504c37b4dc1f486b9d9925c4e16ade015c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Sep 2019 08:25:13 -0400 Subject: [PATCH 016/105] * src/profiler.c: Leave `key` hashslots as Qunbound (bug#37382) Now that "key == Qunbound" is used to determine if a hash table entry is available, we can't stash pre-allocated vectors into the `key` slot anymore, so use the `value` slot instead. (make_log): Pre-fill the `value` slots i.s.o `key`. (evict_lower_half): Stash key back into `value`, i.s.o `key`. (record_backtrace): Get pre-allocated vector for `value` i.s.o `key`. --- src/profiler.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/profiler.c b/src/profiler.c index 6943905062c..84583cec765 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -66,11 +66,11 @@ make_log (void) Qnil, false); struct Lisp_Hash_Table *h = XHASH_TABLE (log); - /* What is special about our hash-tables is that the keys are pre-filled - with the vectors we'll put in them. */ + /* What is special about our hash-tables is that the values are pre-filled + with the vectors we'll use as keys. */ ptrdiff_t i = ASIZE (h->key_and_value) >> 1; while (i > 0) - set_hash_key_slot (h, --i, make_nil_vector (max_stack_depth)); + set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth)); return log; } @@ -132,13 +132,14 @@ static void evict_lower_half (log_t *log) XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ Fremhash (key, tmp); } + eassert (EQ (Qunbound, HASH_KEY (log, i))); eassert (log->next_free == i); eassert (VECTORP (key)); for (ptrdiff_t j = 0; j < ASIZE (key); j++) ASET (key, j, Qnil); - set_hash_key_slot (log, i, key); + set_hash_value_slot (log, i, key); } } @@ -156,7 +157,8 @@ record_backtrace (log_t *log, EMACS_INT count) ptrdiff_t index = log->next_free; /* Get a "working memory" vector. */ - Lisp_Object backtrace = HASH_KEY (log, index); + Lisp_Object backtrace = HASH_VALUE (log, index); + eassert (EQ (Qunbound, HASH_KEY (log, index))); get_backtrace (backtrace); { /* We basically do a `gethash+puthash' here, except that we have to be From 5e8d477d63496ada8eb2c42d23735df0cf05ee2d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 12 Sep 2019 16:38:48 +0200 Subject: [PATCH 017/105] Optimize host name completion in Tramp * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection): Throw `non-essential' at the beginning of the function. * lisp/net/tramp.el (tramp-handle-file-exists-p): * lisp/net/tramp-sh.el (tramp-sh-handle-file-exists-p): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-exists-p): Run only when host is connectable. This is due to host name completion, which shall be optimized. * lisp/net/tramp-smb.el (tramp-smb-do-file-attributes-with-stat) (tramp-smb-get-file-entries): Access connection buffer only after sending the command. * lisp/net/tramp.el (tramp-get-buffer, tramp-get-connection-buffer): New argument DONT-CREATE. (tramp-message): Use it. (tramp-get-mutex): Check, whether host is connectable. (tramp-file-name-handler): Set thread only when host is connectable. (tramp-connectable-p): Allow also VEC as argument. (tramp-completion-handle-file-name-completion): Do not expand directory. --- lisp/net/tramp-adb.el | 12 +++---- lisp/net/tramp-gvfs.el | 4 +++ lisp/net/tramp-rclone.el | 13 +++---- lisp/net/tramp-sh.el | 41 +++++++++++----------- lisp/net/tramp-smb.el | 67 +++++++++++++++++------------------- lisp/net/tramp-sudoedit.el | 25 +++++++------- lisp/net/tramp.el | 70 ++++++++++++++++++++++---------------- 7 files changed, 116 insertions(+), 116 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index df4778c9c96..982522bdaf4 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1191,6 +1191,10 @@ FMT and ARGS are passed to `error'." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf)) (host (tramp-file-name-host vec)) @@ -1204,14 +1208,6 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (unless (process-live-p p) - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data (when (and p (processp p)) (delete-process p)) (if (zerop (length device)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b9b6b4b6d18..1036865e4ec 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1787,6 +1787,10 @@ This is relevant for GNOME Online Accounts." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We set the file name, in case there are incoming D-Bus signals or ;; D-Bus errors. (setq tramp-gvfs-dbus-event-vector vec) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 866e7791bf8..1f0c7eadbc5 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -520,19 +520,14 @@ file names." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((host (tramp-file-name-host vec))) (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) (if (zerop (length host)) (tramp-error vec 'file-error "Storage %s not connected" host)) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - ;; We need a process bound to the connection buffer. Therefore, ;; we create a dummy process. Maybe there is a better solution? (unless (get-buffer-process (tramp-get-connection-buffer vec)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bcfac78ee65..4bc37f01694 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1198,18 +1198,22 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (or (not (null (tramp-get-file-property - v localname "file-attributes-integer" nil))) - (not (null (tramp-get-file-property - v localname "file-attributes-string" nil))) - (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname))))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (or (not (null (tramp-get-file-property + v localname "file-attributes-integer" nil))) + (not (null (tramp-get-file-property + v localname "file-attributes-string" nil))) + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname)))))))) (defun tramp-sh-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -4762,6 +4766,10 @@ If there is just some editing, retry it after 5 seconds." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) (process-environment (copy-sequence process-environment)) @@ -4806,15 +4814,6 @@ connection if a previous connection has died for some reason." ;; New connection must be opened. (condition-case err (unless (process-live-p p) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5df26a1e33e..b008e6b25eb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -832,12 +832,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Implement `file-attributes' for Tramp files using stat command." (tramp-message vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) - (with-current-buffer (tramp-get-connection-buffer vec) - (let* (size id link uid gid atime mtime ctime mode inode) - (when (tramp-smb-send-command - vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) + (let* (size id link uid gid atime mtime ctime mode inode) + (when (tramp-smb-send-command + vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) - ;; Loop the listing. + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) (unless (re-search-forward tramp-smb-errors nil t) (while (not (eobp)) @@ -1628,40 +1628,40 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) (with-tramp-file-property v localname "file-entries" - (with-current-buffer (tramp-get-connection-buffer v) - (let* ((share (tramp-smb-get-share v)) - (cache (tramp-get-connection-property v "share-cache" nil)) - res entry) + (let* ((share (tramp-smb-get-share v)) + (cache (tramp-get-connection-property v "share-cache" nil)) + res entry) - (if (and (not share) cache) - ;; Return cached shares. - (setq res cache) + (if (and (not share) cache) + ;; Return cached shares. + (setq res cache) - ;; Read entries. - (if share - (tramp-smb-send-command - v (format "dir \"%s*\"" (tramp-smb-get-localname v))) - ;; `tramp-smb-maybe-open-connection' lists also the share names. - (tramp-smb-maybe-open-connection v)) + ;; Read entries. + (if share + (tramp-smb-send-command + v (format "dir \"%s*\"" (tramp-smb-get-localname v))) + ;; `tramp-smb-maybe-open-connection' lists also the share names. + (tramp-smb-maybe-open-connection v)) - ;; Loop the listing. + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (if (re-search-forward tramp-smb-errors nil t) (tramp-error v 'file-error "%s `%s'" (match-string 0) directory) (while (not (eobp)) (setq entry (tramp-smb-read-file-entry share)) (forward-line) - (when entry (push entry res)))) + (when entry (push entry res))))) - ;; Cache share entries. - (unless share - (tramp-set-connection-property v "share-cache" res))) + ;; Cache share entries. + (unless share + (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) + ;; Add directory itself. + (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. - (delq nil res)))))) + ;; Return entries. + (delq nil res))))) ;; Return either a share name (if SHARE is nil), or a file name. ;; @@ -1855,6 +1855,10 @@ Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason. If ARGUMENT is non-nil, use it as argument for `tramp-smb-winexe-program', and suppress any checks." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((share (tramp-smb-get-share vec)) (buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf))) @@ -1909,15 +1913,6 @@ If ARGUMENT is non-nil, use it as argument for (string-equal share (tramp-get-connection-property p "smb-share" "")))) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data ;; There might be unread output from checking for share names. (when buf (with-current-buffer buf (erase-buffer))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 80ce8f78747..bfc9b3bdc3a 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -424,10 +424,14 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (tramp-sudoedit-send-command - v "test" "-e" (tramp-compat-file-name-unquote localname))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (tramp-sudoedit-send-command + v "test" "-e" (tramp-compat-file-name-unquote localname)))))) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -760,18 +764,13 @@ Remove unneeded output." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We need a process bound to the connection buffer. Therefore, we ;; create a dummy process. Maybe there is a better solution? (unless (tramp-get-connection-process vec) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; otherwise - ;; `start-file-process' wouldn't run ever when `non-essential' is - ;; non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (let ((p (make-network-process :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ed0f1def181..8903d38d20f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1566,25 +1566,27 @@ necessary only. This function will be used in file name completion." tramp-postfix-host-format)) (when localname localname))) -(defun tramp-get-buffer (vec) +(defun tramp-get-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC." (or (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - ;; We use the existence of connection property "process-buffer" - ;; as indication, whether a connection is active. - (tramp-set-connection-property - vec "process-buffer" - (tramp-get-connection-property vec "process-buffer" nil)) - (setq buffer-undo-list t - default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop)) - (current-buffer)))) + (unless dont-create + (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + ;; We use the existence of connection property "process-buffer" + ;; as indication, whether a connection is active. + (tramp-set-connection-property + vec "process-buffer" + (tramp-get-connection-property vec "process-buffer" nil)) + (setq buffer-undo-list t + default-directory + (tramp-make-tramp-file-name vec 'noloc 'nohop)) + (current-buffer))))) -(defun tramp-get-connection-buffer (vec) +(defun tramp-get-connection-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC. In case a second asynchronous communication has been started, it is different from `tramp-get-buffer'." (or (tramp-get-connection-property vec "process-buffer" nil) - (tramp-get-buffer vec))) + (tramp-get-buffer vec dont-create))) (defun tramp-get-connection-name (vec) "Get the connection name to be used for VEC. @@ -1770,14 +1772,15 @@ applicable)." ;; Log only when there is a minimum level. (when (>= tramp-verbose 4) (let ((tramp-verbose 0)) - ;; Append connection buffer for error messages. + ;; Append connection buffer for error messages, if exists. (when (= level 1) - (with-current-buffer - (if (processp vec-or-proc) - (process-buffer vec-or-proc) - (tramp-get-connection-buffer vec-or-proc)) - (setq fmt-string (concat fmt-string "\n%s") - arguments (append arguments (list (buffer-string)))))) + (ignore-errors + (with-current-buffer + (if (processp vec-or-proc) + (process-buffer vec-or-proc) + (tramp-get-connection-buffer vec-or-proc 'dont-create)) + (setq fmt-string (concat fmt-string "\n%s") + arguments (append arguments (list (buffer-string))))))) ;; Translate proc to vec. (when (processp vec-or-proc) (setq vec-or-proc (process-get vec-or-proc 'vector)))) @@ -2517,16 +2520,22 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;; This variable has been obsoleted in Emacs 26. tramp-completion-mode)) -(defun tramp-connectable-p (filename) +(defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (let (tramp-verbose) - (and (tramp-tramp-file-p filename) - (or (not (tramp-completion-mode-p)) - (process-live-p - (tramp-get-connection-process - (tramp-dissect-file-name filename))))))) + (let (tramp-verbose + (vec + (cond + ((tramp-file-name-p vec-or-filename) vec-or-filename) + ((tramp-tramp-file-p vec-or-filename) + (tramp-dissect-file-name vec-or-filename))))) + (when vec + (or ;; We check this for the process related to + ;; `tramp-buffer-name'; otherwise `start-file-process' + ;; wouldn't run ever when `non-essential' is non-nil. + (process-live-p (get-process (tramp-buffer-name vec))) + (not (tramp-completion-mode-p)))))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of @@ -2606,8 +2615,7 @@ not in completion mode." (try-completion filename (mapcar #'list (file-name-all-completions filename directory)) - (when (and predicate - (tramp-connectable-p (expand-file-name filename directory))) + (when (and predicate (tramp-connectable-p directory)) (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) ;; I misuse a little bit the `tramp-file-name' structure in order to @@ -3096,7 +3104,11 @@ User is always nil." (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (not (null (file-attributes filename)))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." From bbadc6e05f4321466fe8bcd91df6b65fbc6c7d69 Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Thu, 12 Sep 2019 12:42:13 -0500 Subject: [PATCH 018/105] Add `isearch-yank-until-char' * lisp/isearch.el (isearch-yank-until-char): New function. (isearch-mode-map, isearch-menu-bar-yank-map): Add it. (isearch-forward): Document the new binding. * doc/emacs/search.texi (Isearch Yanking): Document the feature. * etc/NEWS: Mention the above. --- doc/emacs/search.texi | 10 +++++++++- etc/NEWS | 5 +++++ lisp/isearch.el | 23 +++++++++++++++++++++++ 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 66af5d40162..38ef49ed64d 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -262,11 +262,19 @@ of whether to copy a character or a symbol is heuristic.) @kindex M-s C-e @r{(Incremental search)} @findex isearch-yank-line - Similarly, @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest + @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest of the current line to the search string. If point is already at the end of a line, it appends the next line. With a prefix argument @var{n}, it appends the next @var{n} lines. +@kindex C-M-z @r{(Incremental search)} +@findex isearch-yank-until-char + Similarly, @kbd{C-M-z} (@code{isearch-yank-until-char}) appends to +the search string everything from point until the next occurence of +a specified character (not including that character). This is especially +useful for keyboard macros, for example in programming languages or +markup languages in which that character marks a token boundary. + @kindex C-y @r{(Incremental search)} @kindex M-y @r{(Incremental search)} @kindex mouse-2 @r{in the minibuffer (Incremental search)} diff --git a/etc/NEWS b/etc/NEWS index 87666740df6..1bde9c442b7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1255,6 +1255,11 @@ highlight in one iteration while processing the full buffer. +++ *** New isearch bindings. +'C-M-z' invokes new function 'isearch-yank-until-char', which yanks +everything from point up to but not including the specified +character into the search string. This is especially useful for +keyboard macros. + 'C-M-w' in isearch changed from 'isearch-del-char' to the new function 'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to 'C-M-d'. diff --git a/lisp/isearch.el b/lisp/isearch.el index 30f7fc7254c..9401e8c06d3 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -514,6 +514,9 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map [isearch-yank-kill] '(menu-item "Current kill" isearch-yank-kill :help "Append current kill to search string")) + (define-key map [isearch-yank-until-char] + '(menu-item "Until char..." isearch-yank-until-char + :help "Yank from point to specified character into search string")) (define-key map [isearch-yank-line] '(menu-item "Rest of line" isearch-yank-line :help "Yank the rest of the current line on search string")) @@ -705,6 +708,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-\C-d" 'isearch-del-char) (define-key map "\M-\C-y" 'isearch-yank-char) (define-key map "\C-y" 'isearch-yank-kill) + (define-key map "\M-\C-z" 'isearch-yank-until-char) (define-key map "\M-s\C-e" 'isearch-yank-line) (define-key map "\M-s\M-<" 'isearch-beginning-of-buffer) @@ -998,6 +1002,8 @@ Type \\[isearch-yank-word-or-char] to yank next word or character in buffer Type \\[isearch-del-char] to delete character from end of search string. Type \\[isearch-yank-char] to yank char from buffer onto end of search\ string and search for it. +Type \\[isearch-yank-until-char] to yank from point until the next instance of a + specified character onto end of search string and search for it. Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. Type \\[isearch-yank-kill] to yank the last string of killed text. @@ -2562,6 +2568,23 @@ If optional ARG is non-nil, pull in the next ARG words." (interactive "p") (isearch-yank-internal (lambda () (forward-word arg) (point)))) +(defun isearch-yank-until-char (char) + "Pull everything until next instance of CHAR from buffer into search string. +Interactively, prompt for CHAR. +This is often useful for keyboard macros, for example in programming +languages or markup languages in which CHAR marks a token boundary." + (interactive "cYank until character: ") + (isearch-yank-internal + (lambda () (let ((inhibit-field-text-motion t)) + (condition-case nil + (progn + (search-forward (char-to-string char)) + (forward-char -1)) + (search-failed + (message "`%c' not found" char) + (sit-for 2))) + (point))))) + (defun isearch-yank-line (&optional arg) "Pull rest of line from buffer into search string. If optional ARG is non-nil, yank the next ARG lines." From 7fbabaf96ab55437b42e6365885c9c780726594c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Sep 2019 14:26:40 -0400 Subject: [PATCH 019/105] * lisp/progmodes/sh-script.el (sh-mode-map): Don't bind `=` (sh-shell-initialize-variables): Use sh--assignment-collect on post-self-insert-hook instead. (sh--assignment-collect): New function, extracted from sh-assignment. (sh-assignment): Use it and mark as obsolete. --- lisp/progmodes/sh-script.el | 45 ++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index aad38b94d76..230789eb6cd 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -112,7 +112,7 @@ ;; would make this unnecessary; simply learn the values when you visit ;; the buffer. ;; You can do this automatically like this: -;; (add-hook 'sh-set-shell-hook 'sh-learn-buffer-indent) +;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent) ;; ;; However... `sh-learn-buffer-indent' is extremely slow, ;; especially on large-ish buffer. Also, if there are conflicts the @@ -480,7 +480,6 @@ This is buffer-local in every such buffer.") (define-key map "\C-c>" 'sh-learn-buffer-indent) (define-key map "\C-c\C-\\" 'sh-backslash-region) - (define-key map "=" 'sh-assignment) (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) @@ -1059,7 +1058,7 @@ subshells can nest." (when (< startpos (line-beginning-position)) (put-text-property startpos (point) 'syntax-multiline t) (add-hook 'syntax-propertize-extend-region-functions - 'syntax-propertize-multiline nil t)) + #'syntax-propertize-multiline nil t)) ))) @@ -1603,25 +1602,25 @@ with your script for an edit-interpret-debug cycle." (setq-local local-abbrev-table sh-mode-abbrev-table) (setq-local comint-dynamic-complete-functions sh-dynamic-complete-functions) - (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) + (add-hook 'completion-at-point-functions #'comint-completion-at-point nil t) ;; we can't look if previous line ended with `\' (setq-local comint-prompt-regexp "^[ \t]*") (setq-local imenu-case-fold-search nil) (setq font-lock-defaults - '((sh-font-lock-keywords + `((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil (font-lock-syntactic-face-function - . sh-font-lock-syntactic-face-function))) + . ,#'sh-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) (setq-local skeleton-pair-alist '((?` _ ?`))) - (setq-local skeleton-pair-filter-function 'sh-quoted-p) + (setq-local skeleton-pair-filter-function #'sh-quoted-p) (setq-local skeleton-further-elements '((< '(- (min sh-basic-offset (current-column)))))) - (setq-local skeleton-filter-function 'sh-feature) + (setq-local skeleton-filter-function #'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp (concat @@ -2408,12 +2407,12 @@ whose value is the shell name (don't quote it)." (message "setting up indent stuff") ;; sh-mode has already made indent-line-function local ;; but do it in case this is called before that. - (setq-local indent-line-function 'sh-indent-line)) + (setq-local indent-line-function #'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) (message "No indentation for this shell type.") - (setq-local indent-line-function 'sh-basic-indent-line)) + (setq-local indent-line-function #'sh-basic-indent-line)) (when font-lock-mode (setq font-lock-set-defaults nil) (font-lock-set-defaults) @@ -3586,7 +3585,7 @@ so that `occur-next' and `occur-prev' will work." ;; (insert ")\n") ;; ))) ;; -;; (add-hook 'sh-learned-buffer-hook 'what-i-learned) +;; (add-hook 'sh-learned-buffer-hook #'what-i-learned) ;; Originally this was sh-learn-region-indent (beg end) @@ -4055,7 +4054,8 @@ Add these variables to `sh-shell-variables'." (goto-char (point-min)) (setq sh-shell-variables-initialized t) (while (search-forward "=" nil t) - (sh-assignment 0))) + (sh--assignment-collect))) + (add-hook 'post-self-insert-hook #'sh--assignment-collect nil t) (message "Scanning buffer `%s' for variable assignments...done" (buffer-name))) @@ -4328,20 +4328,23 @@ option followed by a colon `:' if the option accepts an argument." +(put 'sh-assignment 'delete-selection t) (defun sh-assignment (arg) "Remember preceding identifier for future completion and do self-insert." (interactive "p") + (declare (obsolete nil "27.1")) (self-insert-command arg) - (if (<= arg 1) - (sh-remember-variable - (save-excursion - (if (re-search-forward (sh-feature sh-assignment-regexp) - (prog1 (point) - (beginning-of-line 1)) - t) - (match-string 1)))))) + (sh--assignment-collect)) + +(defun sh--assignment-collect () + (sh-remember-variable + (save-excursion + (if (re-search-forward (sh-feature sh-assignment-regexp) + (prog1 (point) + (beginning-of-line 1)) + t) + (match-string 1))))) -(put 'sh-assignment 'delete-selection t) (defun sh-maybe-here-document (arg) "Insert self. Without prefix, following unquoted `<' inserts here document. From 421084d2cb160261b259bddb687bb2c234f8f1ef Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 12 Sep 2019 15:43:50 -0400 Subject: [PATCH 020/105] * lisp/progmodes/sh-script.el (sh--assignment-collect): Only after `=`! --- lisp/progmodes/sh-script.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 230789eb6cd..cbc0ac74f09 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4338,12 +4338,13 @@ option followed by a colon `:' if the option accepts an argument." (defun sh--assignment-collect () (sh-remember-variable - (save-excursion - (if (re-search-forward (sh-feature sh-assignment-regexp) - (prog1 (point) - (beginning-of-line 1)) - t) - (match-string 1))))) + (when (eq ?= (char-before)) + (save-excursion + (if (re-search-forward (sh-feature sh-assignment-regexp) + (prog1 (point) + (beginning-of-line 1)) + t) + (match-string 1)))))) (defun sh-maybe-here-document (arg) From cbb8a8ad979ed7975bfc7e9fa6aeeb4d9d6b7084 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 8 Sep 2019 10:42:19 -0400 Subject: [PATCH 021/105] Fix fill-paragraph in python docstrings (Bug#36056) * lisp/progmodes/python.el (python-do-auto-fill): New function. (python-mode): Set it as normal-auto-fill-function, and don't set fill-indent-according-to-mode. Having the latter set during fill-paragraph gives wrongs result, because python-indent-line doesn't remove indentation added by filling. * test/lisp/progmodes/python-tests.el (python-fill-docstring): New test. --- lisp/progmodes/python.el | 8 +++++++- test/lisp/progmodes/python-tests.el | 13 ++++++++++++- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 14b65669c4b..ec5d8c55512 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4084,6 +4084,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (goto-char (line-end-position)))) t) +(defun python-do-auto-fill () + "Like `do-auto-fill', but bind `fill-indent-according-to-mode'." + ;; See Bug#36056. + (let ((fill-indent-according-to-mode t)) + (do-auto-fill))) + ;;; Skeletons @@ -5379,7 +5385,7 @@ REPORT-FN is Flymake's callback function." (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) #'python-fill-paragraph) - (set (make-local-variable 'fill-indent-according-to-mode) t) ; Bug#36056. + (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill) (set (make-local-variable 'beginning-of-defun-function) #'python-nav-beginning-of-defun) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b1cf7e8806a..c5ad1dfb862 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -1351,7 +1351,7 @@ this is an arbitrarily expected))))) -;;; Autofill +;;; Filling (ert-deftest python-auto-fill-docstring () (python-tests-with-temp-buffer @@ -1368,6 +1368,17 @@ def some_function(arg1, (forward-line 1) (should (= docindent (current-indentation)))))) +(ert-deftest python-fill-docstring () + (python-tests-with-temp-buffer + "\ +r'''aaa + +this is a test this is a test this is a test this is a test this is a test this is a test. +'''" + (search-forward "test.") + (fill-paragraph) + (should (= (current-indentation) 0)))) + ;;; Mark From a4c471c98474a249948793aad386e4efc64a1c96 Mon Sep 17 00:00:00 2001 From: Jack Coughlin Date: Thu, 18 Jul 2019 08:16:50 -0700 Subject: [PATCH 022/105] Fix saving user-defined calc commands with compositions (Bug#36720) * lisp/calc/calc-prog.el (calc-user-define-permanent): Correctly save the composition when the user specifies their formula by its command name or key. Copyright-paperwork-exempt: yes --- lisp/calc/calc-prog.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index ba8efd43b8e..37e10e8dfac 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1097,7 +1097,7 @@ Redefine the corresponding command." (or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd))) (if (get func 'math-compose-forms) (let ((pt (point))) - (insert "(put '" (symbol-name cmd) + (insert "(put '" (symbol-name func) " 'math-compose-forms '" (prin1-to-string (get func 'math-compose-forms)) ")\n") From 5940ac63300c71b983b173c99c718920c179cbf8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Sep 2019 10:47:28 +0300 Subject: [PATCH 023/105] Fix assertion violations due to non-ASCII text in menus * src/xdisp.c (tool_bar_height, redisplay_tool_bar) (display_menu_bar): If the Lisp string to be displayed in the menu-bar or tool-bar window is multibyte, tell the display engine to treat it as multibyte, instead of relying on the initial determination by init_iterator (which is based on the multibyteness of the current buffer). (Bug#37385) --- src/xdisp.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 94f969f37cf..6626fbcf63e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12907,7 +12907,8 @@ tool_bar_height (struct frame *f, int *n_rows, bool pixelwise) temp_row->reversed_p = false; it.first_visible_x = 0; it.last_visible_x = WINDOW_PIXEL_WIDTH (w); - reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, + 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string)); it.paragraph_embedding = L2R; while (!ITERATOR_AT_END_P (&it)) @@ -12994,7 +12995,8 @@ redisplay_tool_bar (struct frame *f) /* Build a string that represents the contents of the tool-bar. */ build_desired_tool_bar_string (f); - reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, + 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string)); /* FIXME: This should be controlled by a user option. But it doesn't make sense to have an R2L tool bar if the menu bar cannot be drawn also R2L, and making the menu bar R2L is tricky due @@ -23531,7 +23533,7 @@ display_menu_bar (struct window *w) /* Display the item, pad with one space. */ if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string) + 1, 0, 0, -1); + SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string)); } /* Fill out the line with spaces. */ From d8c7bf6683a16b4830fc1de1af49c58cd6163269 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 13 Sep 2019 12:08:02 +0200 Subject: [PATCH 024/105] Make recent Tramp patch work for tramp-archive.el * lisp/net/tramp.el (tramp-connectable-p): Make it work also for tramp-archive.el. --- lisp/net/tramp.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8903d38d20f..aefb84bb4e4 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2530,12 +2530,11 @@ not in completion mode." ((tramp-file-name-p vec-or-filename) vec-or-filename) ((tramp-tramp-file-p vec-or-filename) (tramp-dissect-file-name vec-or-filename))))) - (when vec - (or ;; We check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (process-live-p (get-process (tramp-buffer-name vec))) - (not (tramp-completion-mode-p)))))) + (or ;; We check this for the process related to + ;; `tramp-buffer-name'; otherwise `start-file-process' + ;; wouldn't run ever when `non-essential' is non-nil. + (and vec (process-live-p (get-process (tramp-buffer-name vec)))) + (not (tramp-completion-mode-p))))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of From 8806c196ab12a0805c5afce6ccc5a36e4911a6a3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 13 Sep 2019 12:08:34 +0200 Subject: [PATCH 025/105] Fix problems in tramp-test33-environment-variables * test/lisp/net/tramp-tests.el (tramp-test33-environment-variables): Use ${parameter:-word} construct. Remove PS1 entry from "printenv" output. (tramp--test-check-files): Use "printenv". --- test/lisp/net/tramp-tests.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dd6b9edd000..1554d3b70b1 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4407,7 +4407,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "foo" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))))) + (format "echo -n ${%s:-bla}" envvar)))))) (unwind-protect ;; Set the empty value. @@ -4419,7 +4419,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "bla" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) ;; Variable is set. (should (string-match @@ -4441,7 +4441,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "foo" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) (let ((process-environment (cons envvar process-environment))) ;; Variable is unset. @@ -4450,12 +4450,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "bla" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) ;; Variable is unset. (should-not (string-match (regexp-quote envvar) - (funcall this-shell-command-to-string "env"))))))))) + ;; We must remove PS1, the output is truncated otherwise. + (funcall + this-shell-command-to-string "printenv | grep -v PS1"))))))))) ;; This test is inspired by Bug#27009. (ert-deftest tramp-test33-environment-variables-and-port-numbers () @@ -5303,7 +5305,7 @@ This requires restrictions of file name syntax." ;; of process output. So we unset it temporarily. (setenv "PS1") (with-temp-buffer - (should (zerop (process-file "env" nil t nil))) + (should (zerop (process-file "printenv" nil t nil))) (goto-char (point-min)) (should (re-search-forward From 89a63c9186da693a81773eeb65bb8b17a1721d5d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 13 Sep 2019 14:25:56 +0200 Subject: [PATCH 026/105] ; Add traces in shadowfile.el --- lisp/shadowfile.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 2778e583674..3bee4115a68 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -207,7 +207,7 @@ PREFIX." ;;; I use the term `site' to refer to a string which may be the ;;; cluster identification "/name:", a remote identification -;;; "/method:user@host:", or "/system-name:' (the value of +;;; "/method:user@host:", or "/system-name:" (the value of ;;; `shadow-system-name') for the location of local files. All ;;; user-level commands should accept either. @@ -607,6 +607,11 @@ and to are absolute file names." canonical-file shadow-literal-groups nil) (shadow-shadows-of-1 canonical-file shadow-regexp-groups t))))) + (when shadow-debug + (message + "shadow-shadows-of: %s %s %s %s %s" + file (shadow-local-file file) shadow-homedir + absolute-file canonical-file)) (set (intern file shadow-hashtable) shadows)))) (defun shadow-shadows-of-1 (file groups regexp) @@ -621,6 +626,10 @@ Consider them as regular expressions if third arg REGEXP is true." (let ((realname (tramp-file-name-localname (shadow-parse-name file)))) + (when shadow-debug + (message + "shadow-shadows-of: %s %s %s" + file (shadow-parse-name file) realname)) (mapcar (function (lambda (x) @@ -631,6 +640,11 @@ Consider them as regular expressions if third arg REGEXP is true." (defun shadow-add-to-todo () "If current buffer has shadows, add them to the list needing to be copied." + (when shadow-debug + (message + "shadow-add-to-todo: %s %s" + (buffer-file-name (current-buffer)) + (shadow-expand-file-name (buffer-file-name (current-buffer))))) (let ((shadows (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))) From 8af6b3ef425bb1f74d8d32b92731d32b8600e745 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 13 Sep 2019 14:33:06 +0200 Subject: [PATCH 027/105] ; Fix a typo by last commit --- lisp/shadowfile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 3bee4115a68..72491b99807 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -628,7 +628,7 @@ Consider them as regular expressions if third arg REGEXP is true." (shadow-parse-name file)))) (when shadow-debug (message - "shadow-shadows-of: %s %s %s" + "shadow-shadows-of-1: %s %s %s" file (shadow-parse-name file) realname)) (mapcar (function From 897540069fb09d091802046046daca821079aac5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 13 Sep 2019 14:53:41 +0200 Subject: [PATCH 028/105] Change gui--selection-value-internal comment into doc string * lisp/select.el (gui--selection-value-internal): Change comment into doc string. (Bug#25528) --- lisp/select.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/select.el b/lisp/select.el index 59bcf7da664..334e10f41ba 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -160,12 +160,11 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." (const TEXT))) :group 'killing) -;; Get a selection value of type TYPE by calling gui-get-selection with -;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. -;; The return value is already decoded. If gui-get-selection causes an -;; error, this function return nil. - (defun gui--selection-value-internal (type) + "Get a selection value of type TYPE. +Call `gui-get-selection' with an appropriate DATA-TYPE argument +decided by `x-select-request-type'. The return value is already +decoded. If `gui-get-selection' signals an error, return nil." (let ((request-type (if (eq window-system 'x) (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING)) From 45b01f2d7fc9929fccf2e173291001ab04387947 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 13 Sep 2019 18:06:31 +0200 Subject: [PATCH 029/105] Remove leftover XEmacs compat code and doc fixes * lisp/mail/feedmail.el (top-level): Remove outdated comment. (feedmail-run-the-queue): Remove leftover XEmacs compat code. (feedmail-nuke-bcc): Doc fix. * lisp/emulation/viper.el (top-level, viper-mode) * lisp/net/rfc2104.el (top-level): Doc fix. * lisp/textmodes/table.el (top-level): Remove obsolete todo. --- lisp/emulation/viper.el | 6 +++--- lisp/mail/feedmail.el | 17 ++--------------- lisp/net/rfc2104.el | 2 -- lisp/textmodes/table.el | 4 ---- 4 files changed, 5 insertions(+), 24 deletions(-) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 521edbe6048..0f5c92c2c9e 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1,4 +1,4 @@ -;;; viper.el --- A full-featured Vi emulator for Emacs and XEmacs, -*-lexical-binding:t -*- +;;; viper.el --- A full-featured Vi emulator for Emacs -*- lexical-binding:t -*- ;; a VI Plan for Emacs Rescue, ;; and a venomous VI PERil. ;; Viper Is also a Package for Emacs Rebels. @@ -34,7 +34,7 @@ ;;; Commentary: -;; Viper is a full-featured Vi emulator for Emacs and XEmacs. It emulates and +;; Viper is a full-featured Vi emulator for Emacs. It emulates and ;; improves upon the standard features of Vi and, at the same time, allows ;; full access to all Emacs facilities. Viper supports multiple undo, ;; file name completion, command, file, and search history and it extends @@ -541,7 +541,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on." "Viper Is a Package for Emacs Rebels, a VI Plan for Emacs Rescue, and a venomous VI PERil. -Incidentally, Viper emulates Vi under Emacs/XEmacs 20. +Incidentally, Viper emulates Vi under Emacs. It supports all of what is good in Vi and Ex, while extending and improving upon much of it. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index babc3fc212a..b362614d3a0 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -17,15 +17,6 @@ ;; ability to queue messages for later sending. This replaces ;; the standalone fakemail program that used to be distributed with Emacs. -;; feedmail works with recent versions of Emacs (20.x series) and -;; XEmacs (tested with 20.4 and later betas). It probably no longer -;; works with Emacs v18, though I haven't tried that in a long -;; time. Makoto.Nakagawa@jp.compaq.com reports: "I have a report -;; that with a help of APEL library, feedmail works fine under emacs -;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/. -;; you need apel-10.2 or later to make feedmail work under emacs -;; 19.28." - ;; Sorry, no manual yet in this release. Look for one with the next ;; release. Or the one after that. Or maybe later. @@ -437,9 +428,7 @@ shuttled robotically onward." (defcustom feedmail-confirm-outgoing-timeout nil "If non-nil, a timeout in seconds at the send confirmation prompt. If a positive number, it's a timeout before sending. If a negative -number, it's a timeout before not sending. This will not work if your -version of Emacs doesn't include the function `y-or-n-p-with-timeout' -\(e.g., some versions of XEmacs)." +number, it's a timeout before not sending." :version "24.1" :group 'feedmail-misc :type '(choice (const nil) integer) @@ -2004,9 +1993,7 @@ backup file names and the like)." ((feedmail-fqm-p blobby) (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby))) (setq already-buffer - (if (fboundp 'find-buffer-visiting) ; missing from XEmacs - (find-buffer-visiting maybe-file) - (get-file-buffer maybe-file))) + (find-buffer-visiting maybe-file)) (if (and already-buffer (buffer-modified-p already-buffer)) (save-window-excursion (display-buffer (set-buffer already-buffer)) diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el index 5de8401d5b6..fadc979bc15 100644 --- a/lisp/net/rfc2104.el +++ b/lisp/net/rfc2104.el @@ -37,8 +37,6 @@ ;; 64 is block length of hash function (64 for MD5 and SHA), 16 is ;; resulting hash length (16 for MD5, 20 for SHA). ;; -;; Tested with Emacs 20.2 and XEmacs 20.3. -;; ;; Test case reference: RFC 2202. ;;; History: diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 1f185e0f216..f684f4e4ca9 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -567,10 +567,6 @@ ;; Consider the use of `:box' face attribute under Emacs 21 ;; Consider the use of `modification-hooks' text property instead of ;; rebinding the keymap -;; Maybe provide complete XEmacs support in the future however the -;; "extent" is the single largest obstacle lying ahead, read the -;; document in Emacs info. -;; (progn (require 'info) (Info-find-node "elisp" "Not Intervals")) ;; ;; ;; --------------- From 9ad3f5d1d26a672763fc289ecb7a8443ad564252 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 22 Aug 2019 16:11:52 +0200 Subject: [PATCH 030/105] * doc/misc/efaq.texi: Update ancient formats. (Bug#37143) --- doc/misc/efaq.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index e5673daf3a9..a591b882017 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -21,7 +21,7 @@ Copyright @copyright{} 1990, 1991, 1992 Joseph Brian Wells@* @quotation This list of frequently asked questions about GNU Emacs with answers (``FAQ'') may be translated into other languages, transformed into other -formats (e.g., Texinfo, Info, WWW, WAIS), and updated with new information. +formats (e.g., Texinfo, Info, HTML, PDF), and updated with new information. The same conditions apply to any derivative of the FAQ as apply to the FAQ itself. Every copy of the FAQ must include this notice or an approved From 224534ab8d3f60fea28b271859f8eaf373f95089 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 1 Jul 2019 08:45:24 +0200 Subject: [PATCH 031/105] * lisp/help-mode.el (help-mode-menu): Fix typo. (Bug#36485) --- lisp/help-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index fb29bd2be4f..efc0b8ffa9e 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -59,7 +59,7 @@ ["Next Topic" help-go-forward :help "Go back to next topic in this help buffer"] ["Move to Previous Button" backward-button - :help "Move to the Next Button in the help buffer"] + :help "Move to the Previous Button in the help buffer"] ["Move to Next Button" forward-button :help "Move to the Next Button in the help buffer"])) From 2093395dbf8563af38f206950d95f0bc20183b9c Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Tue, 30 Jul 2019 10:00:27 -0700 Subject: [PATCH 032/105] Improve print output options commands in backtrace-mode (bug#36566) * lisp/emacs-lisp/backtrace.el (backtrace-view): Mention :print-gensym in docstring. (backtrace-mode-map): Add keyboard binding for backtrace-toggle-print-gensym. Add menu entries for backtrace-toggle-print-circle and backtrace-toggle-print-gensym. (backtrace--with-output-variables): Bind print-gensym with value of :print-gensym found in view plist. (backtrace-toggle-print-circle): Remove description of implementation details from docstring. (backtrace-toggle-print-gensym): New command. (backtrace--toggle-feature): Add echo area message describing result of command. * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--print-circle): New test. * doc/lispref/debugging.texi (Backtraces): Document keyboard binding for backtrace-toggle-print-gensym. --- doc/lispref/debugging.texi | 3 ++ lisp/emacs-lisp/backtrace.el | 44 +++++++++++++++++----- test/lisp/emacs-lisp/backtrace-tests.el | 49 +++++++++++++++++++++++++ 3 files changed, 86 insertions(+), 10 deletions(-) diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 12caeaf1289..71e767d0a66 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -457,6 +457,9 @@ Collapse the top-level Lisp form at point back to a single line. @item # Toggle @code{print-circle} for the frame at point. +@item : +Toggle @code{print-gensym} for the frame at point. + @item . Expand all the forms abbreviated with ``...'' in the frame at point. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 60d146e24a8..0c4c7987c3c 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -175,7 +175,8 @@ This should be a list of `backtrace-frame' objects.") (defvar-local backtrace-view nil "A plist describing how to render backtrace frames. -Possible entries are :show-flags, :show-locals and :print-circle.") +Possible entries are :show-flags, :show-locals, :print-circle +and :print-gensym.") (defvar-local backtrace-insert-header-function nil "Function for inserting a header for the current Backtrace buffer. @@ -205,6 +206,7 @@ frames where the source code location is known.") (define-key map "p" 'backtrace-backward-frame) (define-key map "v" 'backtrace-toggle-locals) (define-key map "#" 'backtrace-toggle-print-circle) + (define-key map ":" 'backtrace-toggle-print-gensym) (define-key map "s" 'backtrace-goto-source) (define-key map "\C-m" 'backtrace-help-follow-symbol) (define-key map "+" 'backtrace-multi-line) @@ -224,6 +226,18 @@ frames where the source code location is known.") :active (backtrace-get-index) :selected (plist-get (backtrace-get-view) :show-locals) :help "Show or hide the local variables for the frame at point"] + ["Show Circular Structures" backtrace-toggle-print-circle + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-circle) + :help + "Condense or expand shared or circular structures in the frame at point"] + ["Show Uninterned Symbols" backtrace-toggle-print-gensym + :style toggle + :active (backtrace-get-index) + :selected (plist-get (backtrace-get-view) :print-gensym) + :help + "Toggle unique printing of uninterned symbols in the frame at point"] ["Expand \"...\"s" backtrace-expand-ellipses :help "Expand all the abbreviated forms in the current frame"] ["Show on Multiple Lines" backtrace-multi-line @@ -339,6 +353,7 @@ It runs `backtrace-revert-hook', then calls `backtrace-print'." `(let ((print-escape-control-characters t) (print-escape-newlines t) (print-circle (plist-get ,view :print-circle)) + (print-gensym (plist-get ,view :print-gensym)) (standard-output (current-buffer))) ,@body)) @@ -420,12 +435,18 @@ Set it to VALUE unless the button is a `backtrace-ellipsis' button." (defun backtrace-toggle-print-circle (&optional all) "Toggle `print-circle' for the backtrace frame at point. -With prefix argument ALL, toggle the value of :print-circle in -`backtrace-view', which affects all of the backtrace frames in -the buffer." +With prefix argument ALL, toggle the default value bound to +`print-circle' for all the frames in the buffer." (interactive "P") (backtrace--toggle-feature :print-circle all)) +(defun backtrace-toggle-print-gensym (&optional all) + "Toggle `print-gensym' for the backtrace frame at point. +With prefix argument ALL, toggle the default value bound to +`print-gensym' for all the frames in the buffer." + (interactive "P") + (backtrace--toggle-feature :print-gensym all)) + (defun backtrace--toggle-feature (feature all) "Toggle FEATURE for the current backtrace frame or for the buffer. FEATURE should be one of the options in `backtrace-view'. If ALL @@ -450,12 +471,15 @@ position point at the start of the frame it was in before." (goto-char (point-min)) (while (and (not (eql index (backtrace-get-index))) (< (point) (point-max))) - (goto-char (backtrace-get-frame-end))))) - (let ((index (backtrace-get-index))) - (unless index - (user-error "Not in a stack frame")) - (backtrace--set-feature feature - (not (plist-get (backtrace-get-view) feature)))))) + (goto-char (backtrace-get-frame-end)))) + (message "%s is now %s for all frames" + (substring (symbol-name feature) 1) value)) + (unless (backtrace-get-index) + (user-error "Not in a stack frame")) + (let ((value (not (plist-get (backtrace-get-view) feature)))) + (backtrace--set-feature feature value) + (message "%s is now %s for this frame" + (substring (symbol-name feature) 1) value)))) (defun backtrace--set-feature (feature value) "Set FEATURE in the view plist of the frame at point to VALUE. diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index ce827e0166f..be154953423 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"." (should (string-match-p results (backtrace-tests--get-substring (point-min) (point-max))))))) +(ert-deftest backtrace-tests--print-gensym () + "Backtrace buffers can toggle `print-gensym' syntax." + (ert-with-test-buffer (:name "print-gensym") + (let* ((print-gensym nil) + (arg (list (gensym "first") (gensym) (gensym "last"))) + (results (backtrace-tests--make-regexp + (backtrace-tests--result arg))) + (results-gensym (regexp-quote (let ((print-gensym t)) + (backtrace-tests--result arg)))) + (last-frame (backtrace-tests--make-regexp + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))) + (last-frame-gensym (regexp-quote + (let ((print-gensym t)) + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))))) + (backtrace-tests--make-backtrace arg) + (backtrace-print) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Go to the last frame. + (goto-char (point-max)) + (forward-line -1) + ;; Turn on print-gensym for that frame. + (backtrace-toggle-print-gensym) + (should (string-match-p last-frame-gensym + (backtrace-tests--get-substring (point) (point-max)))) + ;; Turn off print-gensym for the frame. + (backtrace-toggle-print-gensym) + (should (string-match-p last-frame + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-gensym on for the buffer. + (backtrace-toggle-print-gensym '(4)) + (should (string-match-p last-frame-gensym + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results-gensym + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-gensym off. + (backtrace-toggle-print-gensym '(4)) + (should (string-match-p last-frame + (backtrace-tests--get-substring + (point) (+ (point) (length last-frame))))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max))))))) + (defun backtrace-tests--make-regexp (str) "Make regexp from STR for `backtrace-tests--print-circle'. Used for results of printing circular objects without From 5c40c21a47062782bc983f41e8eeb97180dca693 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Tue, 30 Jul 2019 11:56:51 -0700 Subject: [PATCH 033/105] Improve performance of backtrace printing (bug#36566) * lisp/emacs-lisp/cl-print.el (cl-print-to-string-with-limit): Reduce print-level and print-length more quickly when the structure being printed is very large. --- lisp/emacs-lisp/cl-print.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 5fe3dd1b912..530770128e6 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -548,21 +548,22 @@ limit." ;; call_debugger (bug#31919). (let* ((print-length (when limit (min limit 50))) (print-level (when limit (min 8 (truncate (log limit))))) - (delta (when limit - (max 1 (truncate (/ print-length print-level)))))) + (delta-length (when limit + (max 1 (truncate (/ print-length print-level)))))) (with-temp-buffer (catch 'done (while t (erase-buffer) (funcall print-function value (current-buffer)) - ;; Stop when either print-level is too low or the value is - ;; successfully printed in the space allowed. - (when (or (not limit) - (< (- (point-max) (point-min)) limit) - (= print-level 2)) - (throw 'done (buffer-string))) - (cl-decf print-level) - (cl-decf print-length delta)))))) + (let ((result (- (point-max) (point-min)))) + ;; Stop when either print-level is too low or the value is + ;; successfully printed in the space allowed. + (when (or (not limit) (< result limit) (<= print-level 2)) + (throw 'done (buffer-string))) + (let* ((ratio (/ result limit)) + (delta-level (max 1 (min (- print-level 2) ratio)))) + (cl-decf print-level delta-level) + (cl-decf print-length (* delta-length delta-level))))))))) (provide 'cl-print) ;;; cl-print.el ends here From 6eaf39d21b70802e6bc607ee2fc2fff67b79231a Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 3 Aug 2019 12:33:20 -0700 Subject: [PATCH 034/105] Fix unnecessary hash table creation in cl-prin1 (bug#36566) cl-prin1 prints all its punctuation by passing strings to prin1. When print-circle was set, print_preprocess was creating a new hash table for each string, causing excessive garbage collection when printing large Lisp objects with cl-prin1. * src/print.c (print_number_index): Fix typo in comment above. (PRINT_CIRCLE_CANDIDATE_P): Don't create print_number_table for top-level strings with no properties, except when print_continuous_numbering is on. --- src/print.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/print.c b/src/print.c index 7c3da68fc98..18330b0fbf4 100644 --- a/src/print.c +++ b/src/print.c @@ -81,7 +81,7 @@ static ptrdiff_t print_buffer_pos_byte; -N the object will be printed several times and will take number N. N the object has been printed so we can refer to it as #N#. print_number_index holds the largest N already used. - N has to be striclty larger than 0 since we need to distinguish -N. */ + N has to be strictly larger than 0 since we need to distinguish -N. */ static ptrdiff_t print_number_index; static void print_interval (INTERVAL interval, Lisp_Object printcharfun); @@ -1149,7 +1149,11 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } #define PRINT_CIRCLE_CANDIDATE_P(obj) \ - (STRINGP (obj) || CONSP (obj) \ + ((STRINGP (obj) \ + && (string_intervals (obj) \ + || print_depth > 1 \ + || Vprint_continuous_numbering)) \ + || CONSP (obj) \ || (VECTORLIKEP (obj) \ && (VECTORP (obj) || COMPILEDP (obj) \ || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ From 3bd6ef40b55e429a321c87a09fd94e6ca0e50ae7 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sun, 4 Aug 2019 15:56:12 -0700 Subject: [PATCH 035/105] Create common tests for print.c and cl-print.el * test/lisp/emacs-lisp/cl-print-tests.el (cl-print--test, cl-print-tests-1, cl-print-tests-2) (cl-print-tests-3, cl-print-tests-4, cl-print-tests-5) (cl-print-tests-strings, cl-print-circle, cl-print-circle-2): Remove. * test/src/print-tests.el (print-tests--prin1-to-string): New alias. (print-tests--deftest): New macro. (print-hex-backslash, print-read-roundtrip, print-bignum): Define with print-tests--deftest and use print-tests--prin1-to-string. (print-tests--prints-with-charset-p): Use print-tests--prin1-to-string. (print-tests--print-charset-text-property-nil) (print-tests--print-charset-text-property-t) (print-tests--print-charset-text-property-default): Define with print-tests--deftest. (print-tests-print-gensym) (print-tests-continuous-numbering, print-tests-1, print-tests-2) (print-tests-3, print-tests-4, print-tests-5) (print-tests-strings, print-circle, print-circle-2): New tests. (print--test, print-tests-struct): New cl-defstructs. --- test/lisp/emacs-lisp/cl-print-tests.el | 115 +---------- test/src/print-tests.el | 259 +++++++++++++++++++++++-- 2 files changed, 250 insertions(+), 124 deletions(-) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 406c528dce5..31d79df71b5 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -19,109 +19,17 @@ ;;; Commentary: +;; See test/src/print-tests.el for tests which apply to both +;; cl-print.el and src/print.c. + ;;; Code: (require 'ert) -(cl-defstruct cl-print--test a b) - -(ert-deftest cl-print-tests-1 () - "Test cl-print code." - (let ((x (make-cl-print--test :a 1 :b 2))) - (let ((print-circle nil)) - (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) - "((x . #s(cl-print--test :a 1 :b 2)) (y . #s(cl-print--test :a 1 :b 2)))"))) - (let ((print-circle t)) - (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) - "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) - (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^)]*)\\'" - (cl-prin1-to-string (symbol-function #'caar)))))) - -(ert-deftest cl-print-tests-2 () - (let ((x (record 'foo 1 2 3))) - (should (equal - x - (car (read-from-string (with-output-to-string (prin1 x)))))) - (let ((print-circle t)) - (should (string-match - "\\`(#1=#s(foo 1 2 3) #1#)\\'" - (cl-prin1-to-string (list x x))))))) - (cl-defstruct (cl-print-tests-struct (:constructor cl-print-tests-con)) a b c d e) -(ert-deftest cl-print-tests-3 () - "CL printing observes `print-length'." - (let ((long-list (make-list 5 'a)) - (long-vec (make-vector 5 'b)) - (long-struct (cl-print-tests-con)) - (long-string (make-string 5 ?a)) - (print-length 4)) - (should (equal "(a a a a ...)" (cl-prin1-to-string long-list))) - (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec))) - (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" - (cl-prin1-to-string long-struct))) - (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string))))) - -(ert-deftest cl-print-tests-4 () - "CL printing observes `print-level'." - (let* ((deep-list '(a (b (c (d (e)))))) - (buried-vector '(a (b (c (d [e]))))) - (deep-struct (cl-print-tests-con)) - (buried-struct `(a (b (c (d ,deep-struct))))) - (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t))))))) - (buried-simple-string '(a (b (c (d "hello"))))) - (print-level 4)) - (setf (cl-print-tests-struct-a deep-struct) deep-list) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string))) - (should (equal "(a (b (c (d \"hello\"))))" - (cl-prin1-to-string buried-simple-string))) - (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" - (cl-prin1-to-string deep-struct))))) - -(ert-deftest cl-print-tests-5 () - "CL printing observes `print-quoted'." - (let ((quoted-stuff '('a #'b `(,c ,@d)))) - (let ((print-quoted t)) - (should (equal "('a #'b `(,c ,@d))" - (cl-prin1-to-string quoted-stuff)))) - (let ((print-quoted nil)) - (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))" - (cl-prin1-to-string quoted-stuff)))))) - -(ert-deftest cl-print-tests-strings () - "CL printing prints strings and propertized strings." - (let* ((str1 "abcdefghij") - (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t))) - (str3 #("abcdefghij" 0 10 (test t))) - (obj '(a b)) - ;; Since the byte compiler reuses string literals, - ;; and the put-text-property call is destructive, use - ;; copy-sequence to make a new string. - (str4 (copy-sequence "abcdefghij"))) - (put-text-property 0 5 'test obj str4) - (put-text-property 7 10 'test obj str4) - - (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1))) - (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))" - (cl-prin1-to-string str2))) - (should (equal "#(\"abcdefghij\" 0 10 (test t))" - (cl-prin1-to-string str3))) - (let ((print-circle nil)) - (should - (equal - "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))" - (cl-prin1-to-string str4)))) - (let ((print-circle t)) - (should - (equal - "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))" - (cl-prin1-to-string str4)))))) - (ert-deftest cl-print-tests-ellipsis-cons () "Ellipsis expansion works in conses." (let ((print-length 4) @@ -216,23 +124,6 @@ (should (string-match expanded (with-output-to-string (cl-print-expand-ellipsis value nil)))))) -(ert-deftest cl-print-circle () - (let ((x '(#1=(a . #1#) #1#))) - (let ((print-circle nil)) - (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" - (cl-prin1-to-string x)))) - (let ((print-circle t)) - (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x)))))) - -(ert-deftest cl-print-circle-2 () - ;; Bug#31146. - (let ((x '(0 . #1=(0 . #1#)))) - (let ((print-circle nil)) - (should (string-match "\\`(0 0 . #[0-9])\\'" - (cl-prin1-to-string x)))) - (let ((print-circle t)) - (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x)))))) - (ert-deftest cl-print-tests-print-to-string-with-limit () (let* ((thing10 (make-list 10 'a)) (thing100 (make-list 100 'a)) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 8e377d71808..26d49a5ffba 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -21,42 +21,86 @@ (require 'ert) -(ert-deftest print-hex-backslash () +;; Support sharing test code with cl-print-tests. + +(defalias 'print-tests--prin1-to-string #'identity + "The function to print to a string which is under test.") + +(defmacro print-tests--deftest (name arg &rest docstring-keys-and-body) + "Test both print.c and cl-print.el at once." + (declare (debug ert-deftest) + (doc-string 3) + (indent 2)) + (let ((clname (intern (concat (symbol-name name) "-cl-print"))) + (doc (when (stringp (car-safe docstring-keys-and-body)) + (list (pop docstring-keys-and-body)))) + (keys-and-values nil)) + (while (keywordp (car-safe docstring-keys-and-body)) + (let ((key (pop docstring-keys-and-body)) + (val (pop docstring-keys-and-body))) + (push val keys-and-values) + (push key keys-and-values))) + `(progn + ;; Set print-tests--prin1-to-string at both declaration and + ;; runtime, so that it can be used by the :expected-result + ;; keyword. + (cl-letf (((symbol-function #'print-tests--prin1-to-string) + #'prin1-to-string)) + (ert-deftest ,name ,arg + ,@doc + ,@keys-and-values + (cl-letf (((symbol-function #'print-tests--prin1-to-string) + #'prin1-to-string)) + ,@docstring-keys-and-body))) + (cl-letf (((symbol-function #'print-tests--prin1-to-string) + #'cl-prin1-to-string)) + (ert-deftest ,clname ,arg + ,@doc + ,@keys-and-values + (cl-letf (((symbol-function #'print-tests--prin1-to-string) + #'cl-prin1-to-string)) + ,@docstring-keys-and-body)))))) + +(print-tests--deftest print-hex-backslash () (should (string= (let ((print-escape-multibyte t) (print-escape-newlines t)) - (prin1-to-string "\u00A2\ff")) + (print-tests--prin1-to-string "\u00A2\ff")) "\"\\x00a2\\ff\""))) (defun print-tests--prints-with-charset-p (ch odd-charset) - "Return t if `prin1-to-string' prints CH with the `charset' property. + "Return t if print function being tested prints CH with the `charset' property. CH is propertized with a `charset' value according to ODD-CHARSET: if nil, then use the one returned by `char-charset', otherwise, use a different charset." (integerp (string-match "charset" - (prin1-to-string + (print-tests--prin1-to-string (propertize (string ch) 'charset (if odd-charset (cl-find (char-charset ch) charset-list :test-not #'eq) (char-charset ch))))))) -(ert-deftest print-charset-text-property-nil () +(print-tests--deftest print-charset-text-property-nil () + :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string) + #'cl-prin1-to-string) :failed :passed) (let ((print-charset-text-property nil)) (should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376. (should-not (print-tests--prints-with-charset-p ?a t)) (should-not (print-tests--prints-with-charset-p ?\xf6 nil)) (should-not (print-tests--prints-with-charset-p ?a nil)))) -(ert-deftest print-charset-text-property-default () +(print-tests--deftest print-charset-text-property-default () + :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string) + #'cl-prin1-to-string) :failed :passed) (let ((print-charset-text-property 'default)) (should (print-tests--prints-with-charset-p ?\xf6 t)) (should-not (print-tests--prints-with-charset-p ?a t)) (should-not (print-tests--prints-with-charset-p ?\xf6 nil)) (should-not (print-tests--prints-with-charset-p ?a nil)))) -(ert-deftest print-charset-text-property-t () +(print-tests--deftest print-charset-text-property-t () (let ((print-charset-text-property t)) (should (print-tests--prints-with-charset-p ?\xf6 t)) (should (print-tests--prints-with-charset-p ?a t)) @@ -94,7 +138,7 @@ otherwise, use a different charset." (buffer-string)) "--------\n")))) -(ert-deftest print-read-roundtrip () +(print-tests--deftest print-read-roundtrip () (let ((syms (list '## '& '* '+ '- '/ '0E '0e '< '= '> 'E 'E0 'NaN '\" '\# '\#x0 '\' '\'\' '\( '\) '\+00 '\, '\-0 '\. '\.0 '\0 '\0.0 '\0E0 '\0e0 '\1E+ '\1E+NaN '\1e+ '\1e+NaN @@ -105,16 +149,207 @@ otherwise, use a different charset." (intern "\N{ZERO WIDTH SPACE}") (intern "\0")))) (dolist (sym syms) - (should (eq (read (prin1-to-string sym)) sym)) + (should (eq (read (print-tests--prin1-to-string sym)) sym)) (dolist (sym1 syms) (let ((sym2 (intern (concat (symbol-name sym) (symbol-name sym1))))) - (should (eq (read (prin1-to-string sym2)) sym2))))))) + (should (eq (read (print-tests--prin1-to-string sym2)) sym2))))))) -(ert-deftest print-bignum () +(print-tests--deftest print-bignum () (let* ((str "999999999999999999999999999999999") (val (read str))) (should (> val most-positive-fixnum)) - (should (equal (prin1-to-string val) str)))) + (should (equal (print-tests--prin1-to-string val) str)))) + +(print-tests--deftest print-tests-print-gensym () + "Printing observes `print-gensym'." + (let* ((sym1 (gensym)) + (syms (list sym1 (gensym "x") (make-symbol "y") sym1))) + (let* ((print-circle nil) + (printed-with (let ((print-gensym t)) + (print-tests--prin1-to-string syms))) + (printed-without (let ((print-gensym nil)) + (print-tests--prin1-to-string syms)))) + (should (string-match + "(#:\\(g[[:digit:]]+\\) #:x[[:digit:]]+ #:y #:\\(g[[:digit:]]+\\))$" + printed-with)) + (should (string= (match-string 1 printed-with) + (match-string 2 printed-with))) + (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$" + printed-without))) + (let* ((print-circle t) + (printed-with (let ((print-gensym t)) + (print-tests--prin1-to-string syms))) + (printed-without (let ((print-gensym nil)) + (print-tests--prin1-to-string syms)))) + (should (string-match "(#1=#:g[[:digit:]]+ #:x[[:digit:]]+ #:y #1#)$" + printed-with)) + (should (string-match "(g[[:digit:]]+ x[[:digit:]]+ y g[[:digit:]]+)$" + printed-without))))) + +(print-tests--deftest print-tests-continuous-numbering () + "Printing observes `print-continuous-numbering'." + ;; cl-print does not support print-continuous-numbering. + :expected-result (if (eq (symbol-function #'print-tests--prin1-to-string) + #'cl-prin1-to-string) :failed :passed) + (let* ((x (list 1)) + (y "hello") + (g (gensym)) + (g2 (gensym)) + (print-circle t) + (print-gensym t)) + (let ((print-continuous-numbering t) + (print-number-table nil)) + (should (string-match + "(#1=(1) #1# #2=\"hello\" #2#)(#3=#:g[[:digit:]]+ #3#)(#1# #2# #3#)#2#$" + (mapconcat #'print-tests--prin1-to-string `((,x ,x ,y ,y) (,g ,g) (,x ,y ,g) ,y) "")))) + + ;; This is the special case for byte-compile-output-docform + ;; mentioned in a comment in print_preprocess. When + ;; print-continuous-numbering and print-circle and print-gensym + ;; are all non-nil, print all gensyms with numbers even if they + ;; only occur once. + (let ((print-continuous-numbering t) + (print-number-table nil)) + (should (string-match + "(#1=#:g[[:digit:]]+ #2=#:g[[:digit:]]+)$" + (print-tests--prin1-to-string (list g g2))))))) + +(cl-defstruct print--test a b) + +(print-tests--deftest print-tests-1 () + "Test print code." + (let ((x (make-print--test :a 1 :b 2)) + (rec (cond + ((eq (symbol-function #'print-tests--prin1-to-string) 'prin1-to-string) + "#s(print--test 1 2)") + ((eq (symbol-function #'print-tests--prin1-to-string) 'cl-prin1-to-string) + "#s(print--test :a 1 :b 2)") + (t (cl-assert nil))))) + + (let ((print-circle nil)) + (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x))) + (format "((x . %s) (y . %s))" rec rec)))) + (let ((print-circle t)) + (should (equal (print-tests--prin1-to-string `((x . ,x) (y . ,x))) + (format "((x . #1=%s) (y . #1#))" rec)))))) + +(print-tests--deftest print-tests-2 () + (let ((x (record 'foo 1 2 3))) + (should (equal + x + (car (read-from-string (with-output-to-string (prin1 x)))))) + (let ((print-circle t)) + (should (string-match + "\\`(#1=#s(foo 1 2 3) #1#)\\'" + (print-tests--prin1-to-string (list x x))))))) + +(cl-defstruct (print-tests-struct + (:constructor print-tests-con)) + a b c d e) + +(print-tests--deftest print-tests-3 () + "Printing observes `print-length'." + (let ((long-list (make-list 5 'a)) + (long-vec (make-vector 5 'b)) + ;; (long-struct (print-tests-con)) + ;; (long-string (make-string 5 ?a)) + (print-length 4)) + (should (equal "(a a a a ...)" (print-tests--prin1-to-string long-list))) + (should (equal "[b b b b ...]" (print-tests--prin1-to-string long-vec))) + ;; This one only prints 3 nils. Should it print 4? + ;; (should (equal "#s(print-tests-struct nil nil nil nil ...)" + ;; (print-tests--prin1-to-string long-struct))) + ;; This one is only supported by cl-print + ;; (should (equal "\"aaaa...\"" (cl-print-tests--prin1-to-string long-string))) + )) + +(print-tests--deftest print-tests-4 () + "Printing observes `print-level'." + (let* ((deep-list '(a (b (c (d (e)))))) + (buried-vector '(a (b (c (d [e]))))) + (deep-struct (print-tests-con)) + (buried-struct `(a (b (c (d ,deep-struct))))) + (buried-string '(a (b (c (d #("hello" 0 5 (print-test t))))))) + (buried-simple-string '(a (b (c (d "hello"))))) + (print-level 4)) + (setf (print-tests-struct-a deep-struct) deep-list) + (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string deep-list))) + (should (equal "(a (b (c (d \"hello\"))))" + (print-tests--prin1-to-string buried-simple-string))) + (cond + ((eq (symbol-function #'print-tests--prin1-to-string) #'prin1-to-string) + (should (equal "(a (b (c (d [e]))))" (print-tests--prin1-to-string buried-vector))) + (should (equal "(a (b (c (d #s(print-tests-struct ... nil nil nil nil)))))" + (print-tests--prin1-to-string buried-struct))) + (should (equal "(a (b (c (d #(\"hello\" 0 5 ...)))))" + (print-tests--prin1-to-string buried-string))) + (should (equal "#s(print-tests-struct (a (b (c ...))) nil nil nil nil)" + (print-tests--prin1-to-string deep-struct)))) + + ((eq (symbol-function #'print-tests--prin1-to-string) #'cl-prin1-to-string) + (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-vector))) + (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-struct))) + (should (equal "(a (b (c (d ...))))" (print-tests--prin1-to-string buried-string))) + (should (equal "#s(print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" + (print-tests--prin1-to-string deep-struct)))) + (t (cl-assert nil))))) + +(print-tests--deftest print-tests-5 () + "Printing observes `print-quoted'." + (let ((quoted-stuff '('a #'b `(,c ,@d)))) + (let ((print-quoted t)) + (should (equal "('a #'b `(,c ,@d))" + (print-tests--prin1-to-string quoted-stuff)))) + (let ((print-quoted nil)) + (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))" + (print-tests--prin1-to-string quoted-stuff)))))) + +(print-tests--deftest print-tests-strings () + "Can print strings and propertized strings." + (let* ((str1 "abcdefghij") + (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t))) + (str3 #("abcdefghij" 0 10 (test t))) + (obj '(a b)) + ;; Since the byte compiler reuses string literals, + ;; and the put-text-property call is destructive, use + ;; copy-sequence to make a new string. + (str4 (copy-sequence "abcdefghij"))) + (put-text-property 0 5 'test obj str4) + (put-text-property 7 10 'test obj str4) + + (should (equal "\"abcdefghij\"" (print-tests--prin1-to-string str1))) + (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))" + (print-tests--prin1-to-string str2))) + (should (equal "#(\"abcdefghij\" 0 10 (test t))" + (print-tests--prin1-to-string str3))) + (let ((print-circle nil)) + (should + (equal + "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))" + (print-tests--prin1-to-string str4)))) + (let ((print-circle t)) + (should + (equal + "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))" + (print-tests--prin1-to-string str4)))))) + +(print-tests--deftest print-circle () + (let ((x '(#1=(a . #1#) #1#))) + (let ((print-circle nil)) + (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" + (print-tests--prin1-to-string x)))) + (let ((print-circle t)) + (should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x)))))) + +(print-tests--deftest print-circle-2 () + ;; Bug#31146. + (let ((x '(0 . #1=(0 . #1#)))) + (let ((print-circle nil)) + (should (string-match "\\`(0 0 . #[0-9])\\'" + (print-tests--prin1-to-string x)))) + (let ((print-circle t)) + (should (equal "(0 . #1=(0 . #1#))" (print-tests--prin1-to-string x)))))) + (provide 'print-tests) ;;; print-tests.el ends here From 0dba340da54f129750096a5a8704805a94f5535c Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 3 Aug 2019 21:39:29 -0700 Subject: [PATCH 036/105] Don't build print-number-table unless it will be used There are only a few users of print-number-table, and none of them use it when print-circle is nil. A couple of them used to. print_object was changed in 2012-04-20 "* src/print.c (print_preprocess): Only check print_depth if print-circle is nil". byte-compile-output-docform which uses print-number-table binds print-circle to t before printing unless byte-compile-disable-print-circle is set, but that variable has been marked obsolete since 24.1. * src/print.c (print_preprocess): Assert Vprint_circle is non-nil. Remove code handling the case when Vprint_circle is nil. (print, Fprint_preprocess): Don't call print_preprocess unless Vprint_circle is non-nil. (print_object): Remove comment referencing removed code in print_preprocess. --- src/print.c | 92 +++++++++++++++++++++++------------------------------ 1 file changed, 39 insertions(+), 53 deletions(-) diff --git a/src/print.c b/src/print.c index 18330b0fbf4..c870aa5a088 100644 --- a/src/print.c +++ b/src/print.c @@ -1120,8 +1120,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) Vprint_number_table = Qnil; } - /* Construct Vprint_number_table for print-gensym and print-circle. */ - if (!NILP (Vprint_gensym) || !NILP (Vprint_circle)) + /* Construct Vprint_number_table for print-circle. */ + if (!NILP (Vprint_circle)) { /* Construct Vprint_number_table. This increments print_number_index for the objects added. */ @@ -1163,13 +1163,14 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) && SYMBOLP (obj) \ && !SYMBOL_INTERNED_P (obj))) -/* Construct Vprint_number_table according to the structure of OBJ. - OBJ itself and all its elements will be added to Vprint_number_table - recursively if it is a list, vector, compiled function, char-table, - string (its text properties will be traced), or a symbol that has - no obarray (this is for the print-gensym feature). - The status fields of Vprint_number_table mean whether each object appears - more than once in OBJ: Qnil at the first time, and Qt after that. */ +/* Construct Vprint_number_table for the print-circle feature + according to the structure of OBJ. OBJ itself and all its elements + will be added to Vprint_number_table recursively if it is a list, + vector, compiled function, char-table, string (its text properties + will be traced), or a symbol that has no obarray (this is for the + print-gensym feature). The status fields of Vprint_number_table + mean whether each object appears more than once in OBJ: Qnil at the + first time, and Qt after that. */ static void print_preprocess (Lisp_Object obj) { @@ -1178,20 +1179,7 @@ print_preprocess (Lisp_Object obj) int loop_count = 0; Lisp_Object halftail; - /* Avoid infinite recursion for circular nested structure - in the case where Vprint_circle is nil. */ - if (NILP (Vprint_circle)) - { - /* Give up if we go so deep that print_object will get an error. */ - /* See similar code in print_object. */ - if (print_depth >= PRINT_CIRCLE) - error ("Apparently circular structure being printed"); - - for (i = 0; i < print_depth; i++) - if (EQ (obj, being_printed[i])) - return; - being_printed[print_depth] = obj; - } + eassert (!NILP (Vprint_circle)); print_depth++; halftail = obj; @@ -1202,33 +1190,28 @@ print_preprocess (Lisp_Object obj) if (!HASH_TABLE_P (Vprint_number_table)) Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); - /* In case print-circle is nil and print-gensym is t, - add OBJ to Vprint_number_table only when OBJ is a symbol. */ - if (! NILP (Vprint_circle) || SYMBOLP (obj)) - { - Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); - if (!NILP (num) - /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, - always print the gensym with a number. This is a special for - the lisp function byte-compile-output-docform. */ - || (!NILP (Vprint_continuous_numbering) - && SYMBOLP (obj) - && !SYMBOL_INTERNED_P (obj))) - { /* OBJ appears more than once. Let's remember that. */ - if (!FIXNUMP (num)) - { - print_number_index++; - /* Negative number indicates it hasn't been printed yet. */ - Fputhash (obj, make_fixnum (- print_number_index), - Vprint_number_table); - } - print_depth--; - return; + Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); + if (!NILP (num) + /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym, + always print the gensym with a number. This is a special for + the lisp function byte-compile-output-docform. */ + || (!NILP (Vprint_continuous_numbering) + && SYMBOLP (obj) + && !SYMBOL_INTERNED_P (obj))) + { /* OBJ appears more than once. Let's remember that. */ + if (!FIXNUMP (num)) + { + print_number_index++; + /* Negative number indicates it hasn't been printed yet. */ + Fputhash (obj, make_fixnum (- print_number_index), + Vprint_number_table); } - else - /* OBJ is not yet recorded. Let's add to the table. */ - Fputhash (obj, Qt, Vprint_number_table); + print_depth--; + return; } + else + /* OBJ is not yet recorded. Let's add to the table. */ + Fputhash (obj, Qt, Vprint_number_table); switch (XTYPE (obj)) { @@ -1275,11 +1258,15 @@ print_preprocess (Lisp_Object obj) DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0, doc: /* Extract sharing info from OBJECT needed to print it. -Fills `print-number-table'. */) - (Lisp_Object object) +Fills `print-number-table' if `print-circle' is non-nil. Does nothing +if `print-circle' is nil. */) + (Lisp_Object object) { - print_number_index = 0; - print_preprocess (object); + if (!NILP (Vprint_circle)) + { + print_number_index = 0; + print_preprocess (object); + } return Qnil; } @@ -1864,7 +1851,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) /* Simple but incomplete way. */ int i; - /* See similar code in print_preprocess. */ if (print_depth >= PRINT_CIRCLE) error ("Apparently circular structure being printed"); From e4fb98b542c57fa4856fbeb14230ace34d910117 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 13 Sep 2019 16:09:48 -0700 Subject: [PATCH 037/105] Simplify GC statistics-gathering * src/alloc.c (make_interval, allocate_string, make_float) (free_cons, Fcons, setup_on_free_list) (allocate_vector_from_block, Fmake_symbol): Do not update gcstat, since it is for statistics from the most recent GC, not for a partially-updated hodgepodge. (sweep_vectors): Update gcstat, since setup_on_free_list no longer does. (garbage_collect_1): Rename to garbage_collect and adopt its API. Remove the old garbage_collect, which is no longer needed. All callers changed. --- src/alloc.c | 66 ++++++++++++----------------------------------------- 1 file changed, 15 insertions(+), 51 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 2d490f3bb75..ca8311cc00a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -241,7 +241,7 @@ bool gc_in_progress; typedef uintptr_t byte_ct; typedef intptr_t object_ct; -/* Number of live and free conses etc. */ +/* Number of live and free conses etc. counted by the most-recent GC. */ static struct gcstat { @@ -560,7 +560,7 @@ struct Lisp_Finalizer finalizers; /* Head of a circularly-linked list of finalizers that must be invoked because we deemed them unreachable. This list must be global, and - not a local inside garbage_collect_1, in case we GC again while + not a local inside garbage_collect, in case we GC again while running finalizers. */ struct Lisp_Finalizer doomed_finalizers; @@ -1366,7 +1366,6 @@ make_interval (void) newi->next = interval_block; interval_block = newi; interval_block_index = 0; - gcstat.total_free_intervals += INTERVAL_BLOCK_SIZE; } val = &interval_block->intervals[interval_block_index++]; } @@ -1375,7 +1374,6 @@ make_interval (void) consing_until_gc -= sizeof (struct interval); intervals_consed++; - gcstat.total_free_intervals--; RESET_INTERVAL (val); val->gcmarkbit = 0; return val; @@ -1730,8 +1728,6 @@ allocate_string (void) NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = ptr_bounds_clip (s, sizeof *s); } - - gcstat.total_free_strings += STRING_BLOCK_SIZE; } check_string_free_list (); @@ -1742,8 +1738,6 @@ allocate_string (void) MALLOC_UNBLOCK_INPUT; - gcstat.total_free_strings--; - gcstat.total_strings++; ++strings_consed; consing_until_gc -= sizeof *s; @@ -2461,7 +2455,6 @@ make_float (double float_value) memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); float_block = new; float_block_index = 0; - gcstat.total_free_floats += FLOAT_BLOCK_SIZE; } XSETFLOAT (val, &float_block->floats[float_block_index]); float_block_index++; @@ -2473,7 +2466,6 @@ make_float (double float_value) eassert (!XFLOAT_MARKED_P (XFLOAT (val))); consing_until_gc -= sizeof (struct Lisp_Float); floats_consed++; - gcstat.total_free_floats--; return val; } @@ -2545,7 +2537,6 @@ free_cons (struct Lisp_Cons *ptr) cons_free_list = ptr; if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc)) consing_until_gc = INTMAX_MAX; - gcstat.total_free_conses++; } DEFUN ("cons", Fcons, Scons, 2, 2, 0, @@ -2565,26 +2556,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, { if (cons_block_index == CONS_BLOCK_SIZE) { - /* Maximum number of conses that should be active at any - given time, so that list lengths fit into a ptrdiff_t and - into a fixnum. */ - ptrdiff_t max_conses = min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM); - - /* This check is typically optimized away, as a runtime - check is needed only on weird platforms where a count of - distinct conses might not fit. */ - if (max_conses < INTPTR_MAX / sizeof (struct Lisp_Cons) - && (max_conses - CONS_BLOCK_SIZE - < gcstat.total_free_conses + gcstat.total_conses)) - memory_full (sizeof (struct cons_block)); - struct cons_block *new = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); new->next = cons_block; cons_block = new; cons_block_index = 0; - gcstat.total_free_conses += CONS_BLOCK_SIZE; } XSETCONS (val, &cons_block->conses[cons_block_index]); cons_block_index++; @@ -2596,7 +2573,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, XSETCDR (val, cdr); eassert (!XCONS_MARKED_P (XCONS (val))); consing_until_gc -= sizeof (struct Lisp_Cons); - gcstat.total_free_conses--; cons_cells_consed++; return val; } @@ -2855,7 +2831,6 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX); set_next_vector (v, vector_free_lists[vindex]); vector_free_lists[vindex] = v; - gcstat.total_free_vector_slots += nbytes / word_size; } /* Get a new vector block. */ @@ -2903,7 +2878,6 @@ allocate_vector_from_block (ptrdiff_t nbytes) { vector = vector_free_lists[index]; vector_free_lists[index] = next_vector (vector); - gcstat.total_free_vector_slots -= nbytes / word_size; return vector; } @@ -2917,7 +2891,6 @@ allocate_vector_from_block (ptrdiff_t nbytes) /* This vector is larger than requested. */ vector = vector_free_lists[index]; vector_free_lists[index] = next_vector (vector); - gcstat.total_free_vector_slots -= nbytes / word_size; /* Excess bytes are used for the smaller vector, which should be set on an appropriate free list. */ @@ -3092,7 +3065,10 @@ sweep_vectors (void) space was coalesced into the only free vector. */ free_this_block = true; else - setup_on_free_list (vector, total_bytes); + { + setup_on_free_list (vector, total_bytes); + gcstat.total_free_vector_slots += total_bytes / word_size; + } } } @@ -3454,7 +3430,6 @@ Its value is void, and its function definition and property list are nil. */) new->next = symbol_block; symbol_block = new; symbol_block_index = 0; - gcstat.total_free_symbols += SYMBOL_BLOCK_SIZE; } XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; @@ -3465,7 +3440,6 @@ Its value is void, and its function definition and property list are nil. */) init_symbol (val, name); consing_until_gc -= sizeof (struct Lisp_Symbol); symbols_consed++; - gcstat.total_free_symbols--; return val; } @@ -5723,7 +5697,7 @@ visit_buffer_root (struct gc_root_visitor visitor, There are other GC roots of course, but these roots are dynamic runtime data structures that pdump doesn't care about and so we can - continue to mark those directly in garbage_collect_1. */ + continue to mark those directly in garbage_collect. */ void visit_static_gc_roots (struct gc_root_visitor visitor) { @@ -5753,8 +5727,7 @@ mark_object_root_visitor (Lisp_Object const *root_ptr, } /* List of weak hash tables we found during marking the Lisp heap. - Will be NULL on entry to garbage_collect_1 and after it - returns. */ + NULL on entry to garbage_collect and after it returns. */ static struct Lisp_Hash_Table *weak_hash_tables; NO_INLINE /* For better stack traces */ @@ -5860,8 +5833,8 @@ watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval, } /* Subroutine of Fgarbage_collect that does most of the work. */ -static bool -garbage_collect_1 (struct gcstat *gcst) +void +garbage_collect (void) { struct buffer *nextb; char stack_top_variable; @@ -5873,7 +5846,7 @@ garbage_collect_1 (struct gcstat *gcst) eassert (weak_hash_tables == NULL); if (garbage_collection_inhibited) - return false; + return; /* Record this function, so it appears on the profiler's backtraces. */ record_in_backtrace (QAutomatic_GC, 0, 0); @@ -6014,8 +5987,6 @@ garbage_collect_1 (struct gcstat *gcst) unbind_to (count, Qnil); - *gcst = gcstat; - /* GC is complete: now we can run our finalizer callbacks. */ run_finalizers (&doomed_finalizers); @@ -6043,15 +6014,6 @@ garbage_collect_1 (struct gcstat *gcst) byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after; malloc_probe (min (swept, SIZE_MAX)); } - - return true; -} - -void -garbage_collect (void) -{ - struct gcstat gcst; - garbage_collect_1 (&gcst); } DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", @@ -6071,10 +6033,12 @@ returns nil, because real GC can't be done. See Info node `(elisp)Garbage Collection'. */) (void) { - struct gcstat gcst; - if (!garbage_collect_1 (&gcst)) + if (garbage_collection_inhibited) return Qnil; + garbage_collect (); + struct gcstat gcst = gcstat; + Lisp_Object total[] = { list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)), make_int (gcst.total_conses), From bac66302e92bdd3a353102d2076548e7e83d92e5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 14 Sep 2019 00:32:01 -0700 Subject: [PATCH 038/105] Improve gc-cons-percentage calculation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The old calculation relied on a hodgpodge of partly updated GC stats to find a number to multiply gc-cons-percentage by. The new one counts data found by the previous GC, plus half of the data allocated since then; this is more systematic albeit still ad hoc. * src/alloc.c (consing_until_gc, gc_threshold, consing_threshold): Now EMACS_INT, not intmax_t. (HI_THRESHOLD): New macro. (tally_consing): New function. (make_interval, allocate_string, allocate_string_data) (make_float, free_cons, allocate_vectorlike, Fmake_symbol): Use it. (allow_garbage_collection, inhibit_garbage_collection) (consing_threshold, garbage_collect): Use HI_THRESHOLD rather than INTMAX_MAX. (consing_threshold): New arg SINCE_GC. All callers changed. (bump_consing_until_gc): Return new consing_until_gc, instead of nil. All callers changed. Don’t worry about overflow since we now saturate at HI_THRESHOLD. Guess that half of recently-allocated objects are still alive, instead of relying on the previous (even less-accurate) hodgepodge. (maybe_garbage_collect): New function. (garbage_collect): Work even if a finalizer disables or enables memory profiling. Do not use malloc_probe if GC reclaimed nothing. * src/lisp.h (maybe_gc): Call maybe_garbage_collect instead of garbage_collect. --- src/alloc.c | 127 ++++++++++++++++++++++++++++++---------------------- src/lisp.h | 5 ++- 2 files changed, 77 insertions(+), 55 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index ca8311cc00a..497f600551e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -224,7 +224,7 @@ struct emacs_globals globals; /* maybe_gc collects garbage if this goes negative. */ -intmax_t consing_until_gc; +EMACS_INT consing_until_gc; #ifdef HAVE_PDUMPER /* Number of finalizers run: used to loop over GC until we stop @@ -238,9 +238,16 @@ bool gc_in_progress; /* System byte and object counts reported by GC. */ +/* Assume byte counts fit in uintptr_t and object counts fit into + intptr_t. */ typedef uintptr_t byte_ct; typedef intptr_t object_ct; +/* Large-magnitude value for a threshold count, which fits in EMACS_INT. + Using only half the EMACS_INT range avoids overflow hassles. + There is no need to fit these counts into fixnums. */ +#define HI_THRESHOLD (EMACS_INT_MAX / 2) + /* Number of live and free conses etc. counted by the most-recent GC. */ static struct gcstat @@ -299,7 +306,7 @@ static intptr_t garbage_collection_inhibited; /* The GC threshold in bytes, the last time it was calculated from gc-cons-threshold and gc-cons-percentage. */ -static intmax_t gc_threshold; +static EMACS_INT gc_threshold; /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ @@ -536,6 +543,15 @@ XFLOAT_INIT (Lisp_Object f, double n) XFLOAT (f)->u.data = n; } +/* Account for allocation of NBYTES in the heap. This is a separate + function to avoid hassles with implementation-defined conversion + from unsigned to signed types. */ +static void +tally_consing (ptrdiff_t nbytes) +{ + consing_until_gc -= nbytes; +} + #ifdef DOUG_LEA_MALLOC static bool pointers_fit_in_lispobj_p (void) @@ -1372,7 +1388,7 @@ make_interval (void) MALLOC_UNBLOCK_INPUT; - consing_until_gc -= sizeof (struct interval); + tally_consing (sizeof (struct interval)); intervals_consed++; RESET_INTERVAL (val); val->gcmarkbit = 0; @@ -1739,7 +1755,7 @@ allocate_string (void) MALLOC_UNBLOCK_INPUT; ++strings_consed; - consing_until_gc -= sizeof *s; + tally_consing (sizeof *s); #ifdef GC_CHECK_STRING_BYTES if (!noninteractive) @@ -1859,7 +1875,7 @@ allocate_string_data (struct Lisp_String *s, old_data->string = NULL; } - consing_until_gc -= needed; + tally_consing (needed); } @@ -2464,7 +2480,7 @@ make_float (double float_value) XFLOAT_INIT (val, float_value); eassert (!XFLOAT_MARKED_P (XFLOAT (val))); - consing_until_gc -= sizeof (struct Lisp_Float); + tally_consing (sizeof (struct Lisp_Float)); floats_consed++; return val; } @@ -2535,8 +2551,8 @@ free_cons (struct Lisp_Cons *ptr) ptr->u.s.u.chain = cons_free_list; ptr->u.s.car = dead_object (); cons_free_list = ptr; - if (INT_ADD_WRAPV (consing_until_gc, sizeof *ptr, &consing_until_gc)) - consing_until_gc = INTMAX_MAX; + ptrdiff_t nbytes = sizeof *ptr; + tally_consing (-nbytes); } DEFUN ("cons", Fcons, Scons, 2, 2, 0, @@ -3153,7 +3169,7 @@ allocate_vectorlike (ptrdiff_t len) if (find_suspicious_object_in_range (p, (char *) p + nbytes)) emacs_abort (); - consing_until_gc -= nbytes; + tally_consing (nbytes); vector_cells_consed += len; MALLOC_UNBLOCK_INPUT; @@ -3438,7 +3454,7 @@ Its value is void, and its function definition and property list are nil. */) MALLOC_UNBLOCK_INPUT; init_symbol (val, name); - consing_until_gc -= sizeof (struct Lisp_Symbol); + tally_consing (sizeof (struct Lisp_Symbol)); symbols_consed++; return val; } @@ -5477,7 +5493,7 @@ staticpro (Lisp_Object const *varaddress) static void allow_garbage_collection (intmax_t consing) { - consing_until_gc = consing - (INTMAX_MAX - consing_until_gc); + consing_until_gc = consing - (HI_THRESHOLD - consing_until_gc); garbage_collection_inhibited--; } @@ -5487,7 +5503,7 @@ inhibit_garbage_collection (void) ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc); garbage_collection_inhibited++; - consing_until_gc = INTMAX_MAX; + consing_until_gc = HI_THRESHOLD; return count; } @@ -5761,11 +5777,13 @@ mark_and_sweep_weak_table_contents (void) } } -/* Return the number of bytes to cons between GCs, assuming - gc-cons-threshold is THRESHOLD and gc-cons-percentage is - PERCENTAGE. */ -static intmax_t -consing_threshold (intmax_t threshold, Lisp_Object percentage) +/* Return the number of bytes to cons between GCs, given THRESHOLD and + PERCENTAGE. When calculating a threshold based on PERCENTAGE, + assume SINCE_GC bytes have been allocated since the most recent GC. + The returned value is positive and no greater than HI_THRESHOLD. */ +static EMACS_INT +consing_threshold (intmax_t threshold, Lisp_Object percentage, + intmax_t since_gc) { if (!NILP (Vmemory_full)) return memory_full_cons_threshold; @@ -5775,42 +5793,33 @@ consing_threshold (intmax_t threshold, Lisp_Object percentage) if (FLOATP (percentage)) { double tot = (XFLOAT_DATA (percentage) - * total_bytes_of_live_objects ()); + * (total_bytes_of_live_objects () + since_gc)); if (threshold < tot) { - if (tot < INTMAX_MAX) - threshold = tot; + if (tot < HI_THRESHOLD) + return tot; else - threshold = INTMAX_MAX; + return HI_THRESHOLD; } } - return threshold; + return min (threshold, HI_THRESHOLD); } } -/* Adjust consing_until_gc, assuming gc-cons-threshold is THRESHOLD and - gc-cons-percentage is PERCENTAGE. */ -static Lisp_Object +/* Adjust consing_until_gc and gc_threshold, given THRESHOLD and PERCENTAGE. + Return the updated consing_until_gc. */ + +static EMACS_INT bump_consing_until_gc (intmax_t threshold, Lisp_Object percentage) { - /* If consing_until_gc is negative leave it alone, since this prevents - negative integer overflow and a GC would have been done soon anyway. */ - if (0 <= consing_until_gc) - { - threshold = consing_threshold (threshold, percentage); - intmax_t sum; - if (INT_ADD_WRAPV (consing_until_gc, threshold - gc_threshold, &sum)) - { - /* Scale the threshold down so that consing_until_gc does - not overflow. */ - sum = INTMAX_MAX; - threshold = INTMAX_MAX - consing_until_gc + gc_threshold; - } - consing_until_gc = sum; - gc_threshold = threshold; - } - - return Qnil; + /* Guesstimate that half the bytes allocated since the most + recent GC are still in use. */ + EMACS_INT since_gc = (gc_threshold - consing_until_gc) >> 1; + EMACS_INT new_gc_threshold = consing_threshold (threshold, percentage, + since_gc); + consing_until_gc += new_gc_threshold - gc_threshold; + gc_threshold = new_gc_threshold; + return consing_until_gc; } /* Watch changes to gc-cons-threshold. */ @@ -5821,7 +5830,8 @@ watch_gc_cons_threshold (Lisp_Object symbol, Lisp_Object newval, intmax_t threshold; if (! (INTEGERP (newval) && integer_to_intmax (newval, &threshold))) return Qnil; - return bump_consing_until_gc (threshold, Vgc_cons_percentage); + bump_consing_until_gc (threshold, Vgc_cons_percentage); + return Qnil; } /* Watch changes to gc-cons-percentage. */ @@ -5829,7 +5839,18 @@ static Lisp_Object watch_gc_cons_percentage (Lisp_Object symbol, Lisp_Object newval, Lisp_Object operation, Lisp_Object where) { - return bump_consing_until_gc (gc_cons_threshold, newval); + bump_consing_until_gc (gc_cons_threshold, newval); + return Qnil; +} + +/* It may be time to collect garbage. Recalculate consing_until_gc, + since it might depend on current usage, and do the garbage + collection if the recalculation says so. */ +void +maybe_garbage_collect (void) +{ + if (bump_consing_until_gc (gc_cons_threshold, Vgc_cons_percentage) < 0) + garbage_collect (); } /* Subroutine of Fgarbage_collect that does most of the work. */ @@ -5841,7 +5862,6 @@ garbage_collect (void) bool message_p; ptrdiff_t count = SPECPDL_INDEX (); struct timespec start; - byte_ct tot_before = 0; eassert (weak_hash_tables == NULL); @@ -5856,14 +5876,15 @@ garbage_collect (void) FOR_EACH_BUFFER (nextb) compact_buffer (nextb); - if (profiler_memory_running) - tot_before = total_bytes_of_live_objects (); + byte_ct tot_before = (profiler_memory_running + ? total_bytes_of_live_objects () + : (byte_ct) -1); start = current_timespec (); /* In case user calls debug_print during GC, don't let that cause a recursive GC. */ - consing_until_gc = INTMAX_MAX; + consing_until_gc = HI_THRESHOLD; /* Save what's currently displayed in the echo area. Don't do that if we are GC'ing because we've run out of memory, since @@ -5975,7 +5996,7 @@ garbage_collect (void) unblock_input (); consing_until_gc = gc_threshold - = consing_threshold (gc_cons_threshold, Vgc_cons_percentage); + = consing_threshold (gc_cons_threshold, Vgc_cons_percentage, 0); if (garbage_collection_messages && NILP (Vmemory_full)) { @@ -6008,11 +6029,11 @@ garbage_collect (void) gcs_done++; /* Collect profiling data. */ - if (profiler_memory_running) + if (tot_before != (byte_ct) -1) { byte_ct tot_after = total_bytes_of_live_objects (); - byte_ct swept = tot_before <= tot_after ? 0 : tot_before - tot_after; - malloc_probe (min (swept, SIZE_MAX)); + if (tot_after < tot_before) + malloc_probe (min (tot_before - tot_after, SIZE_MAX)); } } diff --git a/src/lisp.h b/src/lisp.h index 024e5edb26e..02f8a7b6686 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3824,9 +3824,10 @@ extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t); extern void mark_stack (char const *, char const *); extern void flush_stack_call_func (void (*func) (void *arg), void *arg); extern void garbage_collect (void); +extern void maybe_garbage_collect (void); extern const char *pending_malloc_warning; extern Lisp_Object zero_vector; -extern intmax_t consing_until_gc; +extern EMACS_INT consing_until_gc; #ifdef HAVE_PDUMPER extern int number_finalizers_run; #endif @@ -5056,7 +5057,7 @@ INLINE void maybe_gc (void) { if (consing_until_gc < 0) - garbage_collect (); + maybe_garbage_collect (); } INLINE_HEADER_END From 36bf5534bf9034860ee6ffda94fa71d4eec8a671 Mon Sep 17 00:00:00 2001 From: Federico Tedin Date: Wed, 4 Sep 2019 00:18:11 +0200 Subject: [PATCH 039/105] Allow gamegrid-add-score to treat lower scores as better. * lisp/play/gamegrid.el (gamegrid-add-score): Add 'reverse' parameter. (gamegrid-add-score-with-update-game-score): Add 'reverse' parameter. (gamegrid-add-score-with-update-game-score-1): Add 'reverse' parameter. Pass on "-r" argument to update-game-score. (gamegrid-add-score-insecure): Add 'reverse' parameter, reverse scores when it's non-nil. (Bug#36867) * etc/NEWS: Announce the change. --- etc/NEWS | 3 +++ lisp/play/gamegrid.el | 49 ++++++++++++++++++++++++------------------- 2 files changed, 30 insertions(+), 22 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 1bde9c442b7..d3338bf57d4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1375,6 +1375,9 @@ the Elisp manual for documentation of the new mode and its commands. dimensions, instead of always using 16 pixels. As a result, Tetris, Snake and Pong are more playable on HiDPI displays. +*** 'gamegrid-add-score' can now sort scores from lower to higher. +This is useful for games where lower scores are better, like time-based games. + ** Filecache --- diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index be09a73a1f1..df9b1352480 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -505,9 +505,12 @@ format." ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun gamegrid-add-score (file score) +(defun gamegrid-add-score (file score &optional reverse) "Add the current score to the high score file. +If REVERSE is non-nil, treat lower scores as better than higher +scores. This is useful for games where lower scores are better. + On POSIX systems there may be a shared game directory for all users in which the scorefiles are kept. On such systems Emacs doesn't create the score file FILE in this directory, if it doesn't already exist. @@ -525,9 +528,9 @@ specified by the variable `temporary-file-directory'. If necessary, FILE is created there." (pcase system-type ((or 'ms-dos 'windows-nt) - (gamegrid-add-score-insecure file score)) + (gamegrid-add-score-insecure file score reverse)) (_ - (gamegrid-add-score-with-update-game-score file score)))) + (gamegrid-add-score-with-update-game-score file score reverse)))) ;; On POSIX systems there are four cases to distinguish: @@ -556,20 +559,21 @@ FILE is created there." (defvar gamegrid-shared-game-dir) -(defun gamegrid-add-score-with-update-game-score (file score) +(defun gamegrid-add-score-with-update-game-score (file score &optional reverse) (let* ((update-game-score-modes (file-modes (expand-file-name "update-game-score" exec-directory))) (gamegrid-shared-game-dir (not (zerop (logand #o6000 (or update-game-score-modes 0)))))) (cond ((or (not update-game-score-modes) (file-name-absolute-p file)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory)) + gamegrid-user-score-file-directory + reverse)) ((and gamegrid-shared-game-dir (file-exists-p (expand-file-name file shared-game-score-directory))) ;; Use the setgid (or setuid) "update-game-score" program ;; to update a system-wide score file. (gamegrid-add-score-with-update-game-score-1 file - (expand-file-name file shared-game-score-directory) score)) + (expand-file-name file shared-game-score-directory) score reverse)) ;; Else: Add the score to a score file in the user's home ;; directory. (gamegrid-shared-game-dir @@ -579,7 +583,8 @@ FILE is created there." (directory-file-name gamegrid-user-score-file-directory)) (make-directory gamegrid-user-score-file-directory t)) (gamegrid-add-score-insecure file score - gamegrid-user-score-file-directory)) + gamegrid-user-score-file-directory + reverse)) (t (unless (file-exists-p (directory-file-name gamegrid-user-score-file-directory)) @@ -588,9 +593,9 @@ FILE is created there." gamegrid-user-score-file-directory))) (unless (file-exists-p f) (write-region "" nil f nil 'silent nil 'excl)) - (gamegrid-add-score-with-update-game-score-1 file f score)))))) + (gamegrid-add-score-with-update-game-score-1 file f score reverse)))))) -(defun gamegrid-add-score-with-update-game-score-1 (file target score) +(defun gamegrid-add-score-with-update-game-score-1 (file target score &optional reverse) (let ((default-directory "/") (errbuf (generate-new-buffer " *update-game-score loss*")) (marker-string (concat @@ -601,17 +606,16 @@ FILE is created there." (with-local-quit (apply 'call-process - (append - (list - (expand-file-name "update-game-score" exec-directory) - nil errbuf nil - "-m" (int-to-string gamegrid-score-file-length) - "-d" (if gamegrid-shared-game-dir - (expand-file-name shared-game-score-directory) - (file-name-directory target)) - file - (int-to-string score) - marker-string)))) + `(,(expand-file-name "update-game-score" exec-directory) + nil ,errbuf nil + "-m" ,(int-to-string gamegrid-score-file-length) + "-d" ,(if gamegrid-shared-game-dir + (expand-file-name shared-game-score-directory) + (file-name-directory target)) + ,@(if reverse '("-r")) + ,file + ,(int-to-string score) + ,marker-string))) (if (buffer-modified-p errbuf) (progn (display-buffer errbuf) @@ -632,7 +636,7 @@ FILE is created there." marker-string) nil t) (beginning-of-line))))) -(defun gamegrid-add-score-insecure (file score &optional directory) +(defun gamegrid-add-score-insecure (file score &optional directory reverse) (save-excursion (setq file (expand-file-name file (or directory temporary-file-directory))) @@ -645,7 +649,8 @@ FILE is created there." (user-full-name) user-mail-address)) (sort-fields 1 (point-min) (point-max)) - (reverse-region (point-min) (point-max)) + (unless reverse + (reverse-region (point-min) (point-max))) (goto-char (point-min)) (forward-line gamegrid-score-file-length) (delete-region (point) (point-max)) From 53a1a29bec4d19b4a5ecc66f532bb3cc289b1869 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Sep 2019 11:21:40 +0300 Subject: [PATCH 040/105] ; * etc/NEWS: Fix last change. --- etc/NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/etc/NEWS b/etc/NEWS index d3338bf57d4..94c98a7ebe0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1375,6 +1375,7 @@ the Elisp manual for documentation of the new mode and its commands. dimensions, instead of always using 16 pixels. As a result, Tetris, Snake and Pong are more playable on HiDPI displays. +--- *** 'gamegrid-add-score' can now sort scores from lower to higher. This is useful for games where lower scores are better, like time-based games. From 5f7531f9e9b1d3d645d64937a9d5df80fc5b1222 Mon Sep 17 00:00:00 2001 From: Tobias Zawada Date: Sat, 14 Sep 2019 14:20:03 +0200 Subject: [PATCH 041/105] Add a debug declaration to widget-specify-insert * lisp/wid-edit.el (widget-specify-insert): Add a debug declaration (bug#37368). Copyright-paperwork-exempt: yes --- lisp/wid-edit.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 9bc7a076eec..7ed7b81280b 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -414,6 +414,7 @@ the :notify function can't know the new value.") (defmacro widget-specify-insert (&rest form) "Execute FORM without inheriting any text properties." + (declare (debug body)) `(save-restriction (let ((inhibit-read-only t) (inhibit-modification-hooks t)) From 49a4b86925f1338268a2e79d0ef164a3cb368ec2 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 14 Sep 2019 17:04:30 +0300 Subject: [PATCH 042/105] * src/print.c (PRINT_CIRCLE_CANDIDATE_P): Fix a thinko. (Bug#36566) --- src/print.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/print.c b/src/print.c index c870aa5a088..7e5aed82877 100644 --- a/src/print.c +++ b/src/print.c @@ -1151,8 +1151,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) #define PRINT_CIRCLE_CANDIDATE_P(obj) \ ((STRINGP (obj) \ && (string_intervals (obj) \ - || print_depth > 1 \ - || Vprint_continuous_numbering)) \ + || print_depth > 1 \ + || !NILP (Vprint_continuous_numbering))) \ || CONSP (obj) \ || (VECTORLIKEP (obj) \ && (VECTORP (obj) || COMPILEDP (obj) \ From 568f1488a69e8cb0961571ff8f158df8891c3c44 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 14 Sep 2019 16:07:34 +0200 Subject: [PATCH 043/105] Make eww more liberal when interpreting some invalid HTML * lisp/net/eww.el (eww--preprocess-html): New function (bug#37009) to be more lenient with invalid HTML and translate common invalid HTML like "a <= b" into "a <= b" to be more liberal in what we accept before parsing. (eww-display-html): Use it. (eww-readable): Ditto. --- lisp/net/eww.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 77e6cec9b04..2013604c9e7 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -326,6 +326,18 @@ the default EWW buffer." #'url-hexify-string (split-string url) "+")))))) url) +(defun eww--preprocess-html (start end) + "Translate all < characters that do not look like start of tags into <." + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let ((case-fold-search t)) + (while (re-search-forward "<[^0-9a-z!/]" nil t) + (goto-char (match-beginning 0)) + (delete-region (point) (1+ (point))) + (insert "<")))))) + ;;;###autoload (defalias 'browse-web 'eww) ;;;###autoload @@ -479,6 +491,7 @@ Currently this means either text/html or application/xhtml+xml." ;; Remove CRLF and replace NUL with � before parsing. (while (re-search-forward "\\(\r$\\)\\|\0" nil t) (replace-match (if (match-beginning 1) "" "�") t t))) + (eww--preprocess-html (point) (point-max)) (libxml-parse-html-region (point) (point-max)))))) (source (and (null document) (buffer-substring (point) (point-max))))) @@ -716,6 +729,7 @@ the like." (condition-case nil (decode-coding-region (point-min) (point-max) 'utf-8) (coding-system-error nil)) + (eww--preprocess-html (point-min) (point-max)) (libxml-parse-html-region (point-min) (point-max)))) (base (plist-get eww-data :url))) (eww-score-readability dom) From 5a0ab88cc984e8a5e66f85cb5acfa362fc66bdb6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 14 Sep 2019 16:48:21 +0200 Subject: [PATCH 044/105] Add default foreground colours to SVG images * lisp/net/shr.el (svg--wrap-svg): Add a default foreground colour to SVG images (bug#37159). This helps with images like the ones in https://en.wikipedia.org/wiki/Banach_fixed-point_theorem that specify no foreground or background colours. (shr-parse-image-data): Use it. --- lisp/net/shr.el | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 81c3fb4aa52..1dff129b9dc 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1180,8 +1180,24 @@ Return a string with image data." ;; so glitches may occur during this transformation. (shr-dom-to-xml (libxml-parse-xml-region (point) (point-max))))) + ;; SVG images often do not have a specified foreground/background + ;; color, so wrap them in styles. + (when (eq content-type 'image/svg+xml) + (setq data (svg--wrap-svg data))) (list data content-type))) +(defun svg--wrap-svg (data) + "Add a default foreground colour to SVG images." + (with-temp-buffer + (insert "" + "") + (buffer-string))) + (defun shr-image-displayer (content-function) "Return a function to display an image. CONTENT-FUNCTION is a function to retrieve an image for a cid url that From c6d814345370307be3de802c65152c887a01359a Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 14 Sep 2019 16:55:24 +0200 Subject: [PATCH 045/105] Fix fileless eww form submission * lisp/net/eww.el (eww-submit): Ignore file inputs with no associated file name (bug#36520). --- lisp/net/eww.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2013604c9e7..fb495a98582 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1447,15 +1447,15 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (push (cons name (plist-get input :value)) values))) ((equal (plist-get input :type) "file") - (push (cons "file" - (list (cons "filedata" - (with-temp-buffer - (insert-file-contents - (plist-get input :filename)) - (buffer-string))) - (cons "name" (plist-get input :name)) - (cons "filename" (plist-get input :filename)))) - values)) + (when-let ((file (plist-get input :filename))) + (push (list "file" + (cons "filedata" + (with-temp-buffer + (insert-file-contents file) + (buffer-string))) + (cons "name" name) + (cons "filename" file)) + values))) ((equal (plist-get input :type) "submit") ;; We want the values from buttons if we hit a button if ;; we hit enter on it, or if it's the first button after From 3f43adac495364aa76703acb86b07b47fe64b422 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bruno=20F=C3=A9lix=20Rezende=20Ribeiro?= Date: Sat, 14 Sep 2019 17:00:40 +0200 Subject: [PATCH 046/105] Fix picon installation instructions in the Gnus manual * doc/misc/gnus.texi (Picons): Fix instructions for installing picons on Debian (bug#37247). Copyright-paperwork-exempt: yes --- doc/misc/gnus.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 28a5eccc6ae..fb9581f9853 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -23682,7 +23682,7 @@ point your Web browser at @uref{http://www.cs.indiana.edu/picons/ftp/index.html}. If you are using Debian GNU/Linux, saying @samp{apt-get install -picons.*} will install the picons where Gnus can find them. +picon-.*} will install the picons where Gnus can find them. To enable displaying picons, simply make sure that @code{gnus-picon-databases} points to the directory containing the From 1acc0cc9aaf25c808a60cf09cf8a4d1c653c3aa9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 14 Sep 2019 10:53:24 -0700 Subject: [PATCH 047/105] Improve doc of GC thresholds * doc/lispref/internals.texi (Garbage Collection), etc/NEWS: Warn that control over GC is only approximate. --- doc/lispref/internals.texi | 13 ++++++++++--- etc/NEWS | 7 +++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index f85c266edef..c52999e1cd2 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -533,9 +533,6 @@ be allocated for Lisp objects after one garbage collection in order to trigger another garbage collection. You can use the result returned by @code{garbage-collect} to get an information about size of the particular object type; space allocated to the contents of buffers does not count. -Note that the subsequent garbage collection does not happen immediately -when the threshold is exhausted, but only the next time the Lisp interpreter -is called. The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in @file{alloc.c}. Since it's defined in @code{word_size} units, the value @@ -562,6 +559,16 @@ increases. Thus, it can be desirable to do them less frequently in proportion. @end defopt + Control over the garbage collector via @code{gc-cons-threshold} and +@code{gc-cons-percentage} is only approximate. Although Emacs checks +for threshold exhaustion regularly, for efficiency reasons it does not +do so immediately after every change to the heap or to +@code{gc-cons-threshold} or @code{gc-cons-percentage}, so exhausting +the threshold does not immediately trigger garbage collection. Also, +for efficency in threshold calculations Emacs approximates the heap +size, which counts the bytes used by currently-accessible objects in +the heap. + The value returned by @code{garbage-collect} describes the amount of memory used by Lisp data, broken down by data type. By contrast, the function @code{memory-limit} provides information on the total amount of diff --git a/etc/NEWS b/etc/NEWS index 94c98a7ebe0..252c6bf9b9f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2429,6 +2429,13 @@ remote systems, which support this check. +++ ** 'memory-limit' now returns a better estimate of memory consumption. ++++ +** When interpreting 'gc-cons-percentage', Emacs now estimates the +heap size more often and (we hope) more accurately. E.g., formerly +(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2) continued to use +the 0.8 value during BODY2 until the next garbage collection, but that +is no longer true. Applications may need to re-tune their GC tricks. + +++ ** New macro 'combine-change-calls' arranges to call the change hooks ('before-change-functions' and 'after-change-functions') just once From 52172d234015776bcc595c731477b98fa2949e50 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 14 Sep 2019 10:55:53 -0700 Subject: [PATCH 048/105] Fix gc-elapsed rounding bug MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/alloc.c (garbage_collect): Don’t accumulate rounding errors when computing gc-elapsed. --- src/alloc.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 497f600551e..9fbd0d05739 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6021,9 +6021,10 @@ garbage_collect (void) /* Accumulate statistics. */ if (FLOATP (Vgc_elapsed)) { - struct timespec since_start = timespec_sub (current_timespec (), start); - Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) - + timespectod (since_start)); + static struct timespec gc_elapsed; + gc_elapsed = timespec_add (gc_elapsed, + timespec_sub (current_timespec (), start)); + Vgc_elapsed = make_float (timespectod (gc_elapsed)); } gcs_done++; From dbc57b5573e2978581439fe8b81da80672c4ecd8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 14 Sep 2019 22:00:20 -0700 Subject: [PATCH 049/105] file_name_case_insensitive_p int->long fix MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/fileio.c (file_name_case_insensitive_p): Don’t assume ‘long int’ fits in ‘int’. --- src/fileio.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fileio.c b/src/fileio.c index cbc0c89cf3e..da32d6c095c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2391,11 +2391,11 @@ file_name_case_insensitive_p (const char *filename) support the latter. */ #ifdef _PC_CASE_INSENSITIVE - int res = pathconf (filename, _PC_CASE_INSENSITIVE); + long int res = pathconf (filename, _PC_CASE_INSENSITIVE); if (res >= 0) return res > 0; #elif defined _PC_CASE_SENSITIVE - int res = pathconf (filename, _PC_CASE_SENSITIVE); + long int res = pathconf (filename, _PC_CASE_SENSITIVE); if (res >= 0) return res == 0; #endif From f198a5c5144fdded1400df6e8454e4b1b912c7de Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 15 Sep 2019 14:11:14 +0200 Subject: [PATCH 050/105] Revert "emacsclient: ignore --eval parameters when starting alternate editor" This reverts commit 6fe661342a24edcaea255c3ba9a37613031554da. The alternate editor may be Emacs, which is useful when you want to eval something in an existing Emacs (if it exists), or in a new Emacs if there's no server running. --- lib-src/emacsclient.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index e9469f77c5e..65effc6910f 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -700,11 +700,7 @@ fail (void) { if (alternate_editor) { - /* If the user has said --eval, then those aren't file name - parameters, so don't put them on the alternate_editor command - line. */ - size_t extra_args_size = - (eval? 0: (main_argc - optind + 1) * sizeof (char *)); + size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *); size_t new_argv_size = extra_args_size; char **new_argv = xmalloc (new_argv_size); char *s = xstrdup (alternate_editor); From c99c9ec28c440d42a66b737651b1095151d85957 Mon Sep 17 00:00:00 2001 From: Wolfgang Scherer Date: Sun, 15 Sep 2019 15:00:20 +0200 Subject: [PATCH 051/105] Provide facility to ignore all marked files in vc * lisp/vc/vc-dir.el: (vc-dir-ignore) With prefix argument, ignore all marked files (bug#37240). --- etc/NEWS | 4 ++++ lisp/vc/vc-dir.el | 16 ++++++++++++---- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 252c6bf9b9f..09535a56b9d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -743,6 +743,10 @@ file. *** New customizable variable 'vc-find-revision-no-save'. With non-nil, 'vc-find-revision' doesn't write the created buffer to file. +--- +*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked +files. + *** New customizable variable 'vc-git-grep-template'. This new variable allows customizing the default arguments passed to 'git-grep' when 'vc-git-grep' is used. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9a6f6bb6874..e2259785923 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -864,10 +864,18 @@ with the command \\[tags-loop-continue]." delimited) (fileloop-continue)) -(defun vc-dir-ignore () - "Ignore the current file." - (interactive) - (vc-ignore (vc-dir-current-file))) +(defun vc-dir-ignore (&optional arg) + "Ignore the current file. +If a prefix argument is given, ignore all marked files." + (interactive "P") + (if arg + (ewoc-map + (lambda (filearg) + (when (vc-dir-fileinfo->marked filearg) + (vc-ignore (vc-dir-fileinfo->name filearg)) + t)) + vc-ewoc) + (vc-ignore (vc-dir-current-file)))) (defun vc-dir-current-file () (let ((node (ewoc-locate vc-ewoc))) From f144c87f92bb9930c9fdafc39bbcdfbb7c7bb983 Mon Sep 17 00:00:00 2001 From: Wolfgang Scherer Date: Sun, 15 Sep 2019 15:03:33 +0200 Subject: [PATCH 052/105] Fix vc-default-ignore * lisp/vc/vc.el: (vc-default-ignore) Treat FILE parameter as relative to DIRECTORY parameter. Construct a file-path relative to directory of ignore file. When removing, use properly anchored regexp. Remove entire line, not just the match (bug#37217). --- lisp/vc/vc.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4cac1539289..c982b0220e3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1417,17 +1417,22 @@ remove from the list of ignored files." (defun vc-default-ignore (backend file &optional directory remove) "Ignore FILE under the VCS of DIRECTORY (default is `default-directory'). -FILE is a file wildcard, relative to the root directory of DIRECTORY. +FILE is a wildcard specification, either relative to +DIRECTORY or absolute. When called from Lisp code, if DIRECTORY is non-nil, the repository to use will be deduced by DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files. Argument BACKEND is the backend you are using." (let ((ignore (vc-call-backend backend 'find-ignore-file (or directory default-directory))) - (pattern (file-relative-name - (expand-file-name file) (file-name-directory file)))) + file-path root-dir pattern) + (setq file-path (expand-file-name file directory)) + (setq root-dir (file-name-directory ignore)) + (when (not (string= (substring file-path 0 (length root-dir)) root-dir)) + (error "Ignore spec %s is not below project root %s" file-path root-dir)) + (setq pattern (substring file-path (length root-dir))) (if remove - (vc--remove-regexp pattern ignore) + (vc--remove-regexp (concat "^" (regexp-quote pattern ) "\\(\n\\|$\\)") ignore) (vc--add-line pattern ignore)))) (defun vc-default-ignore-completion-table (backend file) From 12b1cce925bb56c699ff9160642b8598f6fb9d9b Mon Sep 17 00:00:00 2001 From: Wolfgang Scherer Date: Sun, 15 Sep 2019 15:14:44 +0200 Subject: [PATCH 053/105] Do not use error messages as list of ignored files in vc-svn * lisp/vc/vc-svn.el: (vc-svn-ignore-completion-table) Ignore buffer contents, if exit status is not 0. Split buffer by lines (bug#37214). --- lisp/vc/vc-svn.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 3c50c8fff64..88a280d10f3 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -366,8 +366,9 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY." (defun vc-svn-ignore-completion-table (directory) "Return the list of ignored files in DIRECTORY." (with-temp-buffer - (vc-svn-command t t nil "propget" "svn:ignore" (expand-file-name directory)) - (split-string (buffer-string)))) + (when (zerop (vc-svn-command + t t nil "propget" "svn:ignore" (expand-file-name directory))) + (split-string (buffer-string) "\n")))) (defun vc-svn-find-admin-dir (file) "Return the administrative directory of FILE." From 24e0546bc1daa407843427e2e2ac59100c9e62e1 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sun, 15 Sep 2019 15:21:08 +0200 Subject: [PATCH 054/105] Make widget-browse-at always detect an editable-field * lisp/wid-browse.el (widget-browse-at): Also look for the real-field property when detecting a field (bug#37199). --- lisp/wid-browse.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index dbc41009c77..3124a9c01e5 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -89,7 +89,11 @@ if that value is non-nil." (defun widget-browse-at (pos) "Browse the widget under point." (interactive "d") - (let* ((field (get-char-property pos 'field)) + (let* ((field (or + ;; See comments in `widget-specify-field' to know why we + ;; need this. + (get-char-property pos 'real-field) + (get-char-property pos 'field))) (button (get-char-property pos 'button)) (doc (get-char-property pos 'widget-doc)) (text (cond (field "This is an editable text area.") From 6d3cb263f941545c09acb7fb86b8336ad130aa8e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 15 Sep 2019 16:52:22 +0200 Subject: [PATCH 055/105] Use also truname of temporary-file-directory in shadowfile-tests.el * test/lisp/shadowfile-tests.el (top): Use truename of `temporary-file-directory' and `shadow-test-remote-temporary-file-directory'. (Bug#37202) (shadow-test08-shadow-todo, shadow-test09-shadow-copy-files): Do not bind `shadow-test-remote-temporary-file-directory'. --- test/lisp/shadowfile-tests.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index a93664f6536..d09c15e9919 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -66,7 +66,12 @@ (setq password-cache-expiry nil shadow-debug t tramp-verbose 0 - tramp-message-show-message nil) + tramp-message-show-message nil + ;; On macOS, `temporary-file-directory' is a symlinked directory. + temporary-file-directory (file-truename temporary-file-directory) + shadow-test-remote-temporary-file-directory + (ignore-errors + (file-truename shadow-test-remote-temporary-file-directory))) ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") @@ -718,8 +723,6 @@ guaranteed by the originator of a cluster definition." (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) - (shadow-test-remote-temporary-file-directory - (file-truename shadow-test-remote-temporary-file-directory)) shadow-clusters shadow-literal-groups shadow-regexp-groups shadow-files-to-copy cluster1 cluster2 primary regexp file) @@ -858,8 +861,6 @@ guaranteed by the originator of a cluster definition." (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) - (shadow-test-remote-temporary-file-directory - (file-truename shadow-test-remote-temporary-file-directory)) (shadow-noquery t) shadow-clusters shadow-files-to-copy cluster1 cluster2 primary regexp file mocked-input) From b3e4b50578778e03327b049f7a595981bfbf3713 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sun, 15 Sep 2019 20:37:26 +0200 Subject: [PATCH 056/105] * lisp/subr.el (major-mode-suspend): Doc fix --- lisp/subr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index 0d7bffb35f3..0b47da884b7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2045,7 +2045,7 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (put 'major-mode--suspended 'permanent-local t) (defun major-mode-suspend () - "Exit current major, remembering it." + "Exit current major mode, remembering it." (let* ((prev-major-mode (or major-mode--suspended (unless (eq major-mode 'fundamental-mode) major-mode)))) From 84c7d4bccca41810ae28e3f13382b1021502cb4b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 15 Sep 2019 16:36:06 -0700 Subject: [PATCH 057/105] * admin/upload-manuals: Move a basic check earlier. --- admin/upload-manuals | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/admin/upload-manuals b/admin/upload-manuals index 08b47d741d7..e37128a2076 100755 --- a/admin/upload-manuals +++ b/admin/upload-manuals @@ -87,6 +87,9 @@ OPTIND=1 [ $# -eq 1 ] || usage +[ -e html_mono/emacs.html ] && [ -e html_node/emacs/index.html ] || \ + die "Current directory does not look like the manual/ directory" + [ "$version$umessage" ] || \ die "Could not get version to use for commit message" @@ -95,9 +98,6 @@ webdir=$1 [ -e $webdir/CVS/Entries ] && [ -e $webdir/refcards/pdf/refcard.pdf ] || \ die "$webdir does not look like a checkout of the Emacs webpages" -[ -e html_mono/emacs.html ] && [ -e html_node/emacs/index.html ] || \ - die "Current directory does not like the manual/ directory" - echo "Doing refcards..." From de3daf063987dfc2a28cd5071b8f77446c7312e0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 15 Sep 2019 20:12:07 -0700 Subject: [PATCH 058/105] Improve directory-access diagnostics * src/callproc.c (init_callproc): Diagnose I/O errors, access errors, etc. for the game directory. * src/charset.c (init_charset): Improve quality of diagnostic when the charsets directory has I/O errors, access errors, etc. --- src/callproc.c | 2 ++ src/charset.c | 20 ++++++++++++-------- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/callproc.c b/src/callproc.c index 4473b19a297..20e0bc50dab 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1598,6 +1598,8 @@ init_callproc (void) Lisp_Object path_game = build_unibyte_string (PATH_GAME); if (file_accessible_directory_p (path_game)) gamedir = path_game; + else if (errno != ENOENT && errno != ENOTDIR) + dir_warning ("game dir", path_game); } Vshared_game_score_directory = gamedir; } diff --git a/src/charset.c b/src/charset.c index 8c54381dc48..93206aa29b0 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2292,14 +2292,18 @@ init_charset (void) { /* This used to be non-fatal (dir_warning), but it should not happen, and if it does sooner or later it will cause some - obscure problem (eg bug#6401), so better abort. */ - fprintf (stderr, "Error: charsets directory not found:\n\ -%s\n\ -Emacs will not function correctly without the character map files.\n%s\ -Please check your installation!\n", - SDATA (tempdir), - egetenv("EMACSDATA") ? "The EMACSDATA environment \ -variable is set, maybe it has the wrong value?\n" : ""); + obscure problem (eg bug#6401), so better exit. */ + fprintf (stderr, + ("Error: %s: %s\n" + "Emacs will not function correctly " + "without the character map files.\n" + "%s" + "Please check your installation!\n"), + SDATA (tempdir), strerror (errno), + (egetenv ("EMACSDATA") + ? ("The EMACSDATA environment variable is set. " + "Maybe it has the wrong value?\n") + : "")); exit (1); } From ba0605779e0e207161441c08afdfac57ed603f69 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 15 Sep 2019 20:17:43 -0700 Subject: [PATCH 059/105] Fix unknown-vs-nonexistent glitch for file timestamps * src/fileio.c (time_error_value): EACCES means the file timestamp is unknown, not that the file does not exist. --- src/fileio.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index da32d6c095c..34afbc23da7 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3612,7 +3612,7 @@ file_offset (Lisp_Object val) static struct timespec time_error_value (int errnum) { - int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR + int ns = (errnum == ENOENT || errnum == ENOTDIR ? NONEXISTENT_MODTIME_NSECS : UNKNOWN_MODTIME_NSECS); return make_timespec (0, ns); From 5711c076dc63ecc0907f2b9cfe04035e0bd6a0b4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 16 Sep 2019 06:55:02 +0200 Subject: [PATCH 060/105] ; * etc/NEWS: Fix typo. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 09535a56b9d..1153daf9ac5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1903,7 +1903,7 @@ and 'gravatar-force-default'. ** ada-mode -*** The built-in ada-mode is now deleted. The Gnu ELPA package is a +*** The built-in ada-mode is now deleted. The GNU ELPA package is a good replacement, even in very large source files. ** xref From be828883475eddff0bb8cf6825f0d3383391c122 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 15 Sep 2019 22:15:04 -0700 Subject: [PATCH 061/105] Fix some file-name-case-insensitive glitches MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/fileio.c (file_name_directory): New static function, broken out of Ffile_name_directory. (file_name_case_insensitive_err, Ffile_writable_p, Fdo_auto_save): Use it. (file_name_case_insensitive_err): Rename from file_name_case_insensitive_p. Accept an unencoded Lisp_Object rather than an encoded char *, so that platforms other than Cygwin and macOS need not encode the file name. Return an int -1, 0, errno rather than a bool (setting errno if false), so that the caller can distinguish an error from false. All callers changed. (Ffile_name_case_insensitive_p): Don’t issue system calls on platforms other than Cygwin and macOS. Fix bug that broke the attempt to move up the filesystem tree (it moved up only one level). --- src/fileio.c | 86 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 50 insertions(+), 36 deletions(-) diff --git a/src/fileio.c b/src/fileio.c index 34afbc23da7..c129f19872e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -134,6 +134,7 @@ static dev_t timestamp_file_system; is added here. */ static Lisp_Object Vwrite_region_annotation_buffers; +static Lisp_Object file_name_directory (Lisp_Object); static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, Lisp_Object *, struct coding_system *); static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, @@ -356,6 +357,15 @@ Given a Unix syntax file name, returns a string ending in slash. */) return STRINGP (handled_name) ? handled_name : Qnil; } + return file_name_directory (filename); +} + +/* Return the directory component of FILENAME, or nil if FILENAME does + not contain a directory component. */ + +static Lisp_Object +file_name_directory (Lisp_Object filename) +{ char *beg = SSDATA (filename); char const *p = beg + SBYTES (filename); @@ -2369,41 +2379,48 @@ internal_delete_file (Lisp_Object filename) return NILP (tem); } -/* Filesystems are case-sensitive on all supported systems except - MS-Windows, MS-DOS, Cygwin, and Mac OS X. They are always - case-insensitive on the first two, but they may or may not be - case-insensitive on Cygwin and OS X. The following function - attempts to provide a runtime test on those two systems. If the - test is not conclusive, we assume case-insensitivity on Cygwin and - case-sensitivity on Mac OS X. +/* Return -1 if FILE is a case-insensitive file name, 0 if not, + and a positive errno value if the result cannot be determined. */ - FIXME: Mounted filesystems on Posix hosts, like Samba shares or - NFS-mounted Windows volumes, might be case-insensitive. Can we - detect this? */ - -static bool -file_name_case_insensitive_p (const char *filename) +static int +file_name_case_insensitive_err (Lisp_Object file) { - /* Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if - those flags are available. As of this writing (2017-05-20), + /* Filesystems are case-sensitive on all supported systems except + MS-Windows, MS-DOS, Cygwin, and macOS. They are always + case-insensitive on the first two, but they may or may not be + case-insensitive on Cygwin and macOS so do a runtime test on + those two systems. If the test is not conclusive, assume + case-insensitivity on Cygwin and case-sensitivity on macOS. + + FIXME: Mounted filesystems on Posix hosts, like Samba shares or + NFS-mounted Windows volumes, might be case-insensitive. Can we + detect this? + + Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if + those flags are available. As of this writing (2019-09-15), Cygwin is the only platform known to support the former (starting with Cygwin-2.6.1), and macOS is the only platform known to support the latter. */ -#ifdef _PC_CASE_INSENSITIVE +#if defined _PC_CASE_INSENSITIVE || defined _PC_CASE_SENSITIVE + char *filename = SSDATA (ENCODE_FILE (file)); +# ifdef _PC_CASE_INSENSITIVE long int res = pathconf (filename, _PC_CASE_INSENSITIVE); if (res >= 0) - return res > 0; -#elif defined _PC_CASE_SENSITIVE + return - (res > 0); +# else long int res = pathconf (filename, _PC_CASE_SENSITIVE); if (res >= 0) - return res == 0; + return - (res == 0); +# endif + if (errno != EINVAL) + return errno; #endif #if defined CYGWIN || defined DOS_NT - return true; + return -1; #else - return false; + return 0; #endif } @@ -2426,21 +2443,18 @@ The arg must be a string. */) /* If the file doesn't exist, move up the filesystem tree until we reach an existing directory or the root. */ - if (NILP (Ffile_exists_p (filename))) + while (true) { - filename = Ffile_name_directory (filename); - while (NILP (Ffile_exists_p (filename))) - { - Lisp_Object newname = expand_and_dir_to_file (filename); - /* Avoid infinite loop if the root is reported as non-existing - (impossible?). */ - if (!NILP (Fstring_equal (newname, filename))) - break; - filename = newname; - } + int err = file_name_case_insensitive_err (filename); + if (! (err == ENOENT || err == ENOTDIR)) + return err < 0 ? Qt : Qnil; + Lisp_Object parent = file_name_directory (filename); + /* Avoid infinite loop if the root is reported as non-existing + (impossible?). */ + if (!NILP (Fstring_equal (parent, filename))) + return Qnil; + filename = parent; } - filename = ENCODE_FILE (filename); - return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil; } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, @@ -2790,7 +2804,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, if (errno != ENOENT) return Qnil; - dir = Ffile_name_directory (absname); + dir = file_name_directory (absname); eassert (!NILP (dir)); #ifdef MSDOS dir = Fdirectory_file_name (dir); @@ -5822,7 +5836,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) if (!NILP (Vrun_hooks)) { Lisp_Object dir; - dir = Ffile_name_directory (listfile); + dir = file_name_directory (listfile); if (NILP (Ffile_directory_p (dir))) internal_condition_case_1 (do_auto_save_make_dir, dir, Qt, From 3a18c82b8e08d12cf3f5817bd830950416e51d2b Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Mon, 16 Sep 2019 09:58:09 +0200 Subject: [PATCH 062/105] Add bindings for ligature oe to iso-transl-char-map * lisp/international/iso-transl.el (iso-transl-char-map): Add bindings for small and capital ligature oe. (Bug#23420) --- lisp/international/iso-transl.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index b573e1e47c5..3530e6f2538 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -177,6 +177,8 @@ ("c" . [?¢]) ("*o" . [?°]) ("o" . [?°]) + ("Oe" . [?œ]) + ("OE" . [?Œ]) ("*u" . [?µ]) ("u" . [?µ]) ("*m" . [?µ]) From dfc17fc02e9e9f724c8ec86e3fd3a91a5ff638f6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 14:32:17 +0200 Subject: [PATCH 063/105] Remove NEWS entry that talks about a change that was reverted (bug#37257) --- etc/NEWS | 4 ---- 1 file changed, 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 1153daf9ac5..e7d054fd60e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -196,10 +196,6 @@ the new version of the file again.) ** emacsclient -*** emacsclient no longer passes '--eval' arguments to an alternate editor. -Previously, '--eval' arguments were passed as file names to any -alternate editor started by '--alternate-editor'. - +++ *** emacsclient now supports an 'EMACS_SOCKET_NAME' environment variable. The command-line argument '--socket-name' overrides it. From 6684db8cea9793051e71460eba87312bab461d7f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 16 Sep 2019 15:00:37 +0200 Subject: [PATCH 064/105] ; Disable traces in shadowfile-tests --- test/lisp/shadowfile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index d09c15e9919..7caddc53d75 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -64,7 +64,7 @@ "Temporary directory for Tramp tests.") (setq password-cache-expiry nil - shadow-debug t + shadow-debug nil tramp-verbose 0 tramp-message-show-message nil ;; On macOS, `temporary-file-directory' is a symlinked directory. From 169d04b8ac416c71a8b89a9c4a975d0f014265e0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 16 Sep 2019 17:51:25 +0300 Subject: [PATCH 065/105] Fix initialization of shared-game-score-directory on MS-Windows * src/callproc.c (init_callproc) [WINDOWSNT]: Run PATH_GAME through w32_relocate, to expand %emacs_dir%. [DOS_NT]: Accept EACCES as not "unusual" errno value. Reported by Richard Copley . --- src/callproc.c | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/callproc.c b/src/callproc.c index 20e0bc50dab..1ac0bdc710a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1595,10 +1595,21 @@ init_callproc (void) Lisp_Object gamedir = Qnil; if (PATH_GAME) { - Lisp_Object path_game = build_unibyte_string (PATH_GAME); + const char *cpath_game = PATH_GAME; +#ifdef WINDOWSNT + /* On MS-Windows, PATH_GAME normally starts with a literal + "%emacs_dir%", so it will never work without some tweaking. */ + cpath_game = w32_relocate (cpath_game); +#endif + Lisp_Object path_game = build_unibyte_string (cpath_game); if (file_accessible_directory_p (path_game)) gamedir = path_game; - else if (errno != ENOENT && errno != ENOTDIR) + else if (errno != ENOENT && errno != ENOTDIR +#ifdef DOS_NT + /* DOS/Windows sometimes return EACCES for bad file names */ + && errno != EACCES +#endif + ) dir_warning ("game dir", path_game); } Vshared_game_score_directory = gamedir; From facd6d5affaa897e7efe4018ede054489268b065 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 16 Sep 2019 22:19:16 +0300 Subject: [PATCH 066/105] Improve error reporting in file_accessible_directory_p * src/w32.c (w32_accessible_directory_p): Set errno, so that file_accessible_directory_p does on MS-Windows, to live up to its callers' expectations. --- src/w32.c | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/src/w32.c b/src/w32.c index d7a91692c63..88e9aef338f 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4151,13 +4151,36 @@ w32_accessible_directory_p (const char *dirname, ptrdiff_t dirlen) /* In case DIRNAME cannot be expressed in characters from the current ANSI codepage. */ if (_mbspbrk (pat_a, "?")) - dh = INVALID_HANDLE_VALUE; - else - dh = FindFirstFileA (pat_a, &dfd_a); + { + errno = ENOENT; + return 0; + } + dh = FindFirstFileA (pat_a, &dfd_a); } if (dh == INVALID_HANDLE_VALUE) + { + DWORD w32err = GetLastError (); + + switch (w32err) + { + case ERROR_INVALID_NAME: + case ERROR_BAD_PATHNAME: + case ERROR_FILE_NOT_FOUND: + case ERROR_PATH_NOT_FOUND: + case ERROR_NO_MORE_FILES: + case ERROR_BAD_NETPATH: + errno = ENOENT; + break; + case ERROR_NOT_READY: + errno = ENODEV; + break; + default: + errno = EACCES; + break; + } return 0; + } FindClose (dh); return 1; } From dbf2f18f170d5de05a80b12fa538e14b540780a5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 22:02:19 +0200 Subject: [PATCH 067/105] Document vc-dir-ignore * doc/emacs/maintaining.texi (VC Directory Commands): Document vc-dir-ignore. --- doc/emacs/maintaining.texi | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index e92a959d99c..ae4b7bbafff 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1281,6 +1281,12 @@ point is on a directory entry, mark all files in that directory tree (@code{vc-dir-mark-all-files}). With a prefix argument, mark all listed files and directories. +@item G +Add the file under point to the list of files that the VC should +ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it +will append this file to the @samp{.gitignore} file. If given a +prefix, do this with all the marked files. + @item q Quit the VC Directory buffer, and bury it (@code{quit-window}). From 72ad41c05994a67679c7bd54a3d73726bcca0597 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 22:08:57 +0200 Subject: [PATCH 068/105] Minor fix for previous maintaining.texi change * doc/emacs/maintaining.texi (VC Directory Commands): Use @file for files. --- doc/emacs/maintaining.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index ae4b7bbafff..9a9957069fd 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1284,7 +1284,7 @@ listed files and directories. @item G Add the file under point to the list of files that the VC should ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it -will append this file to the @samp{.gitignore} file. If given a +will append this file to the @file{.gitignore} file. If given a prefix, do this with all the marked files. @item q From f22346fe5abdbdac2ba5f690c11fda4d4f5d22d6 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Mon, 16 Sep 2019 22:17:51 +0200 Subject: [PATCH 069/105] With tooltip-mode disabled, don't unconditionally clear the echo area * lisp/tooltip.el (tooltip-show-help-non-mode): Only clear the echo area when the current message displayed is a tooltip message (Bug#3192). --- lisp/tooltip.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index b1c69ae7368..eac510ba7ba 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -365,7 +365,10 @@ It is also called if Tooltip mode is on, for text-only displays." (let ((message-log-max nil)) (message "%s" tooltip-previous-message) (setq tooltip-previous-message nil))) - (t + ;; Only stop displaying the message when the current message is our own. + ;; This has the advantage of not clearing the echo area when + ;; running after an error message was displayed (Bug#3192). + ((equal-including-properties tooltip-help-message (current-message)) (message nil))))) (defun tooltip-show-help (msg) From f1e5877a6b2f577f85c893a8f05475e213a212c2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 22:22:54 +0200 Subject: [PATCH 070/105] mm-inline-large-images doc string clarification * lisp/gnus/mm-decode.el (mm-inline-large-images): Clarify doc string. --- lisp/gnus/mm-decode.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index cba9633b539..a763e34785d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -382,8 +382,9 @@ enables you to choose manually one of two types those mails include." :group 'mime-display) (defcustom mm-inline-large-images nil - "If t, then all images fit in the buffer. -If `resize', try to resize the images so they fit." + "If nil, images larger than the window aren't displayed in the buffer. +If `resize', try to resize the images so they fit in the buffer. +If t, show the images as they are without resizing." :type '(radio (const :tag "Inline large images as they are." t) (const :tag "Resize large images." resize) From e46831507556639ecb9db2f864d4cb3a2c11ec4a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 22:30:04 +0200 Subject: [PATCH 071/105] Default to rescaling images in mm buffers * doc/misc/emacs-mime.texi (Display Customization): Document it. * lisp/gnus/mm-decode.el (mm-inline-large-images): Change default to `resize'. --- doc/misc/emacs-mime.texi | 17 +++++++---------- etc/NEWS | 5 +++++ lisp/gnus/mm-decode.el | 3 ++- 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 131a358ba59..8a1ba969ed9 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -375,16 +375,13 @@ message as follows: @item mm-inline-large-images @vindex mm-inline-large-images -When displaying inline images that are larger than the window, Emacs -does not enable scrolling, which means that you cannot see the whole -image. To prevent this, the library tries to determine the image size -before displaying it inline, and if it doesn't fit the window, the -library will display it externally (e.g., with @samp{ImageMagick} or -@samp{xv}). Setting this variable to @code{t} disables this check and -makes the library display all inline images as inline, regardless of -their size. If you set this variable to @code{resize}, the image will -be displayed resized to fit in the window, if Emacs has the ability to -resize images. +This variable is @code{resize} by default, which means that images +that are bigger than the Emacs window are resized so that they fit. +If you set this to @code{nil}, large images are not displayed in +Emacs, but can instead be displayed externally (e.g., with +@samp{ImageMagick} or @samp{xv}). Setting this variable to @code{t} +disables this check and makes the library display all inline images as +inline, regardless of their size. @item mm-inline-large-images-proportion @vindex mm-inline-images-max-proportion diff --git a/etc/NEWS b/etc/NEWS index e7d054fd60e..12182694d1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1062,6 +1062,11 @@ See the concept index in the Gnus manual for the 'match-list' entry. +++ *** nil is no longer an allowed value for 'mm-text-html-renderer'. ++++ +The default value of 'mm-inline-large-images' has changed from nil to +'resize', which means that large images will be resized instead of +displayed with an external program by default. + +++ *** A new Gnus summary mode command, 'S A' ('gnus-summary-attach-article') can be used to attach the current diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a763e34785d..5636b8eca47 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -381,10 +381,11 @@ enables you to choose manually one of two types those mails include." :type 'directory :group 'mime-display) -(defcustom mm-inline-large-images nil +(defcustom mm-inline-large-images 'resize "If nil, images larger than the window aren't displayed in the buffer. If `resize', try to resize the images so they fit in the buffer. If t, show the images as they are without resizing." + :version "27.1" :type '(radio (const :tag "Inline large images as they are." t) (const :tag "Resize large images." resize) From 1a84d8fba4b526f7c8f240b8163e66714a41cca6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 22:31:29 +0200 Subject: [PATCH 072/105] mm-inline-large-images-proportion doc clarification * lisp/gnus/mm-view.el (mm-inline-large-images-proportion): Doc clarification. --- lisp/gnus/mm-view.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 6ffa1fc168d..02d99200a35 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -65,8 +65,9 @@ :group 'mime-display) (defcustom mm-inline-large-images-proportion 0.9 - "Maximum proportion of large image resized when -`mm-inline-large-images' is set to resize." + "Maximum proportion large images can occupy in the buffer. +This is only used if `mm-inline-large-images' is set to +`resize'." :type 'float :version "24.1" :group 'mime-display) From 2335704fccc2a5088c864bea1f10b4f0ef788e6b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 16 Sep 2019 13:54:57 -0700 Subject: [PATCH 073/105] directory-files cleanup and speed tweaking MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/dired.c (directory_files_internal): Check ‘match’ before doing anything heavyweight. Move decls closer to use. Remove obsolete comments about GC. No need to encode ‘directory’ or to call multibyte_chars_in_text. Remove no-longer-needed bug check. Skip finalname construction if file_attributes fails. --- src/dired.c | 131 ++++++++++++++++++++-------------------------------- 1 file changed, 50 insertions(+), 81 deletions(-) diff --git a/src/dired.c b/src/dired.c index cec79ab46be..5fc6ccd3ead 100644 --- a/src/dired.c +++ b/src/dired.c @@ -167,28 +167,19 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, bool attrs, Lisp_Object id_format) { - ptrdiff_t directory_nbytes; - Lisp_Object list, dirfilename, encoded_directory; - bool needsep = 0; - ptrdiff_t count = SPECPDL_INDEX (); -#ifdef WINDOWSNT - Lisp_Object w32_save = Qnil; -#endif + if (!NILP (match)) + CHECK_STRING (match); /* Don't let the compiler optimize away all copies of DIRECTORY, which would break GC; see Bug#16986. */ Lisp_Object volatile directory_volatile = directory; - /* Because of file name handlers, these functions might call - Ffuncall, and cause a GC. */ - list = encoded_directory = dirfilename = Qnil; - dirfilename = Fdirectory_file_name (directory); + Lisp_Object dirfilename = Fdirectory_file_name (directory); /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run run_pre_post_conversion_on_str which calls Lisp directly and indirectly. */ Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename); - encoded_directory = ENCODE_FILE (directory); int fd; DIR *d = open_directory (dirfilename, encoded_dirfilename, &fd); @@ -196,9 +187,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ + ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT + Lisp_Object w32_save = Qnil; if (attrs) { /* Do this only once to avoid doing it (in w32.c:stat) for each @@ -218,89 +211,63 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, } #endif - directory_nbytes = SBYTES (directory); + ptrdiff_t directory_nbytes = SBYTES (directory); re_match_object = Qt; /* Decide whether we need to add a directory separator. */ - if (directory_nbytes == 0 - || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))) - needsep = 1; + bool needsep = (directory_nbytes == 0 + || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1))); /* Windows users want case-insensitive wildcards. */ - Lisp_Object case_table = + Lisp_Object case_table = Qnil; #ifdef WINDOWSNT - BVAR (&buffer_defaults, case_canon_table) -#else - Qnil + case_table = BVAR (&buffer_defaults, case_canon_table); #endif - ; - if (!NILP (match)) - CHECK_STRING (match); - - /* Loop reading directory entries. */ + /* Read directory entries and accumulate them into LIST. */ + Lisp_Object list = Qnil; for (struct dirent *dp; (dp = read_dirent (d, directory)); ) { ptrdiff_t len = dirent_namelen (dp); Lisp_Object name = make_unibyte_string (dp->d_name, len); Lisp_Object finalname = name; - /* Note: DECODE_FILE can GC; it should protect its argument, - though. */ + /* This can GC. */ name = DECODE_FILE (name); - len = SBYTES (name); - /* Now that we have unwind_protect in place, we might as well - allow matching to be interrupted. */ maybe_quit (); - bool wanted = (NILP (match) || - fast_string_match_internal ( - match, name, case_table) >= 0); + if (!NILP (match) + && fast_string_match_internal (match, name, case_table) < 0) + continue; - if (wanted) + Lisp_Object fileattrs; + if (attrs) { - if (!NILP (full)) - { - Lisp_Object fullname; - ptrdiff_t nbytes = len + directory_nbytes + needsep; - ptrdiff_t nchars; - - fullname = make_uninit_multibyte_string (nbytes, nbytes); - memcpy (SDATA (fullname), SDATA (directory), - directory_nbytes); - - if (needsep) - SSET (fullname, directory_nbytes, DIRECTORY_SEP); - - memcpy (SDATA (fullname) + directory_nbytes + needsep, - SDATA (name), len); - - nchars = multibyte_chars_in_text (SDATA (fullname), nbytes); - - /* Some bug somewhere. */ - if (nchars > nbytes) - emacs_abort (); - - STRING_SET_CHARS (fullname, nchars); - if (nchars == nbytes) - STRING_SET_UNIBYTE (fullname); - - finalname = fullname; - } - else - finalname = name; - - if (attrs) - { - Lisp_Object fileattrs - = file_attributes (fd, dp->d_name, directory, name, id_format); - if (!NILP (fileattrs)) - list = Fcons (Fcons (finalname, fileattrs), list); - } - else - list = Fcons (finalname, list); + fileattrs = file_attributes (fd, dp->d_name, directory, name, + id_format); + if (NILP (fileattrs)) + continue; } + + if (!NILP (full)) + { + ptrdiff_t name_nbytes = SBYTES (name); + ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes; + ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name); + finalname = make_uninit_multibyte_string (nchars, nbytes); + if (nchars == nbytes) + STRING_SET_UNIBYTE (finalname); + memcpy (SDATA (finalname), SDATA (directory), directory_nbytes); + if (needsep) + SSET (finalname, directory_nbytes, DIRECTORY_SEP); + memcpy (SDATA (finalname) + directory_nbytes + needsep, + SDATA (name), name_nbytes); + } + else + finalname = name; + + list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list); } closedir (d); @@ -330,14 +297,14 @@ If MATCH is non-nil, mention only file names that match 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'. NOSORT is useful if you plan to sort the result yourself. */) - (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort) + (Lisp_Object directory, Lisp_Object full, Lisp_Object match, + Lisp_Object nosort) { - Lisp_Object handler; directory = Fexpand_file_name (directory, Qnil); /* If the file name has special constructs in it, call the corresponding file name handler. */ - handler = Ffind_file_name_handler (directory, Qdirectory_files); + Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files); if (!NILP (handler)) return call5 (handler, Qdirectory_files, directory, full, match, nosort); @@ -365,14 +332,15 @@ ID-FORMAT specifies the preferred format of attributes uid and gid, see `file-attributes' for further documentation. On MS-Windows, performance depends on `w32-get-true-file-attributes', which see. */) - (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format) + (Lisp_Object directory, Lisp_Object full, Lisp_Object match, + Lisp_Object nosort, Lisp_Object id_format) { - Lisp_Object handler; directory = Fexpand_file_name (directory, Qnil); /* If the file name has special constructs in it, call the corresponding file name handler. */ - handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes); + Lisp_Object handler + = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes); if (!NILP (handler)) return call6 (handler, Qdirectory_files_and_attributes, directory, full, match, nosort, id_format); @@ -1032,7 +1000,8 @@ file_attributes (int fd, char const *name, INT_TO_INTEGER (s.st_dev)); } -DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0, +DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, + Sfile_attributes_lessp, 2, 2, 0, doc: /* Return t if first arg file attributes list is less than second. Comparison is in lexicographic order and case is significant. */) (Lisp_Object f1, Lisp_Object f2) From 57ac6523af76efe6f6767c5480b2832cdd3adc4d Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Mon, 16 Sep 2019 22:57:25 +0200 Subject: [PATCH 074/105] Add backquote tests * test/lisp/emacs-lisp/backquote-tests.el: New file (bug#37432). --- test/lisp/emacs-lisp/backquote-tests.el | 47 +++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 test/lisp/emacs-lisp/backquote-tests.el diff --git a/test/lisp/emacs-lisp/backquote-tests.el b/test/lisp/emacs-lisp/backquote-tests.el new file mode 100644 index 00000000000..01f2c4a897e --- /dev/null +++ b/test/lisp/emacs-lisp/backquote-tests.el @@ -0,0 +1,47 @@ +;;; backquote-tests.el --- Tests for backquote.el -*- lexical-binding: t -*- + +;; Copyright (C) 2019 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) + +(ert-deftest backquote-test-basic () + (let ((lst '(ba bb bc)) + (vec [ba bb bc])) + (should (equal 3 `,(eval '(+ x y) '((x . 1) (y . 2))))) + (should (equal vec `[,@lst])) + (should (equal `(a lst c) '(a lst c))) + (should (equal `(a ,lst c) '(a (ba bb bc) c))) + (should (equal `(a ,@lst c) '(a ba bb bc c))) + ;; Vectors work just like lists. + (should (equal `(a vec c) '(a vec c))) + (should (equal `(a ,vec c) '(a [ba bb bc] c))) + (should (equal `(a ,@vec c) '(a ba bb bc c))))) + +(ert-deftest backquote-test-nested () + "Test nested backquotes." + (let ((lst '(ba bb bc)) + (vec [ba bb bc])) + (should (equal `(a ,`(,@lst) c) `(a ,lst c))) + (should (equal `(a ,`[,@lst] c) `(a ,vec c))) + (should (equal `(a ,@`[,@lst] c) `(a ,@lst c))))) + +;;; backquote-tests.el ends here From 2c2f0eb9fcdfb644c106679999501b9c7edf51e2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 16 Sep 2019 14:04:04 -0700 Subject: [PATCH 075/105] Remove obsolete Lint directives MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Most of the directives were wrong anyway. Apparently traditional lint hasn’t been used to check Emacs for years. * src/callint.c (Finteractive): * src/cm.c (evalcost): * src/emacs.c (main): * src/eval.c (call1, call2, call3, call4, call5, call6, call7, call8): * src/fns.c (concat2, concat3, nconc2): * src/term.c (calculate_ins_del_char_costs): Omit ARGSUSED comments. * src/eval.c (call1): Omit VARARGS comment. --- src/callint.c | 1 - src/cm.c | 1 - src/emacs.c | 1 - src/eval.c | 9 --------- src/fns.c | 3 --- src/term.c | 1 - 6 files changed, 16 deletions(-) diff --git a/src/callint.c b/src/callint.c index d76836f32b2..449b5048609 100644 --- a/src/callint.c +++ b/src/callint.c @@ -35,7 +35,6 @@ static Lisp_Object point_marker; /* String for the prompt text used in Fcall_interactively. */ static Lisp_Object callint_message; -/* ARGSUSED */ DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, doc: /* Specify a way of parsing arguments for interactive use of a function. For example, write diff --git a/src/cm.c b/src/cm.c index e09216a854b..7947d3565c5 100644 --- a/src/cm.c +++ b/src/cm.c @@ -30,7 +30,6 @@ along with GNU Emacs. If not, see . */ int cost; /* sums up costs */ -/* ARGSUSED */ int evalcost (int c) { diff --git a/src/emacs.c b/src/emacs.c index 5a526687b14..558dd11a351 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -923,7 +923,6 @@ load_pdump (int argc, char **argv) } #endif /* HAVE_PDUMPER */ -/* ARGSUSED */ int main (int argc, char **argv) { diff --git a/src/eval.c b/src/eval.c index 06d5c63f7f7..2bfc16eae0e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1890,7 +1890,6 @@ verror (const char *m, va_list ap) /* Dump an error message; called like printf. */ -/* VARARGS 1 */ void error (const char *m, ...) { @@ -2649,7 +2648,6 @@ call0 (Lisp_Object fn) } /* Call function fn with 1 argument arg1. */ -/* ARGSUSED */ Lisp_Object call1 (Lisp_Object fn, Lisp_Object arg1) { @@ -2657,7 +2655,6 @@ call1 (Lisp_Object fn, Lisp_Object arg1) } /* Call function fn with 2 arguments arg1, arg2. */ -/* ARGSUSED */ Lisp_Object call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) { @@ -2665,7 +2662,6 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) } /* Call function fn with 3 arguments arg1, arg2, arg3. */ -/* ARGSUSED */ Lisp_Object call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) { @@ -2673,7 +2669,6 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) } /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ -/* ARGSUSED */ Lisp_Object call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4) @@ -2682,7 +2677,6 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, } /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ -/* ARGSUSED */ Lisp_Object call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5) @@ -2691,7 +2685,6 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, } /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ -/* ARGSUSED */ Lisp_Object call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) @@ -2700,7 +2693,6 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, } /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ -/* ARGSUSED */ Lisp_Object call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) @@ -2710,7 +2702,6 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, /* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8. */ -/* ARGSUSED */ Lisp_Object call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, diff --git a/src/fns.c b/src/fns.c index df921e28f3b..f45c729cfaf 100644 --- a/src/fns.c +++ b/src/fns.c @@ -532,14 +532,12 @@ Do NOT use this function to compare file names for equality. */) static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, enum Lisp_Type target_type, bool last_special); -/* ARGSUSED */ Lisp_Object concat2 (Lisp_Object s1, Lisp_Object s2) { return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0); } -/* ARGSUSED */ Lisp_Object concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) { @@ -2577,7 +2575,6 @@ This makes STRING unibyte and may change its length. */) return Qnil; } -/* ARGSUSED */ Lisp_Object nconc2 (Lisp_Object s1, Lisp_Object s2) { diff --git a/src/term.c b/src/term.c index a88d47f9238..5f70c7a3d4f 100644 --- a/src/term.c +++ b/src/term.c @@ -1084,7 +1084,6 @@ int *char_ins_del_vector; #define char_ins_del_cost(f) (&char_ins_del_vector[FRAME_COLS ((f))]) -/* ARGSUSED */ static void calculate_ins_del_char_costs (struct frame *f) { From 603e70483b844201a46f13e0a9e7acf50d3fd273 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 16 Sep 2019 23:45:34 +0200 Subject: [PATCH 076/105] Try resending when getting a transient 4xx SMTP code * lisp/mail/smtpmail.el (smtpmail-via-smtp): Try resending when getting a transient error message (bug#34177). --- etc/NEWS | 4 ++++ lisp/mail/smtpmail.el | 21 ++++++++++++++++++++- 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 12182694d1d..adb2b642ba9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1162,6 +1162,10 @@ defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. attempt when communicating with the SMTP server(s), the 'smtpmail-servers-requiring-authorization' variable can be used. +--- +*** smtpmail will now try resending mail when getting a transient 4xx +error message from the SMTP server. + ** Footnote mode *** Support Hebrew-style footnotes diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f6fd1cd65eb..57913c1f0f0 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -654,10 +654,12 @@ Returns an error if the server cannot be contacted." user-mail-address)))) (defun smtpmail-via-smtp (recipient smtpmail-text-buffer - &optional ask-for-password) + &optional ask-for-password + send-attempts) (unless smtpmail-smtp-server (smtpmail-query-smtp-server)) (let ((process nil) + (send-attempts (or send-attempts 1)) (host (or smtpmail-smtp-server (error "`smtpmail-smtp-server' not defined"))) (port smtpmail-smtp-service) @@ -819,6 +821,23 @@ Returns an error if the server cannot be contacted." ((smtpmail-ok-p (setq result (smtpmail-read-response process))) ;; Success. ) + ((and (numberp (car result)) + (<= 400 (car result) 499) + (< send-attempts 10)) + (message "Got transient error code %s when sending; retrying attempt %d..." + (car result) send-attempts) + ;; Retry on getting a transient 4xx code; see + ;; https://tools.ietf.org/html/rfc5321#section-4.2.1 + (ignore-errors + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process)) + (delete-process process) + (sleep-for 1) + (setq process nil) + (throw 'done + (smtpmail-via-smtp recipient smtpmail-text-buffer + ask-for-password + (1+ send-attempts)))) ((and auth-mechanisms (not ask-for-password) (eq (car result) 530)) From 90ddad804a34b70af7d849f1fdd1f069a3c30f54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Kondraciuk?= Date: Tue, 17 Sep 2019 01:13:08 +0200 Subject: [PATCH 077/105] Allow `M-u' to work when editing fields in Customize * lisp/cus-edit.el (custom-notify): Allow more editing commands to work in the Customize buffers (bug#31205). Copyright-paperwork-exempt: yes --- lisp/cus-edit.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8a8bad91137..24969633373 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2212,7 +2212,12 @@ and `face'." (unless (eq state 'modified) (unless (memq state '(nil unknown hidden)) (widget-put widget :custom-state 'modified)) - (custom-magic-reset widget) + ;; Update the status text (usually from "STANDARD" to "EDITED + ;; bla bla" in the buffer after the command has run. Otherwise + ;; commands like `M-u' (that work on a region in the buffer) + ;; will upcase the wrong part of the buffer, since more text has + ;; been inserted before point. + (run-with-idle-timer 0.0 nil #'custom-magic-reset widget) (apply 'widget-default-notify widget args)))) (defun custom-redraw (widget) From 3a6b5e6ad0173dfe164640e8a09bf465f78836cb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Sep 2019 01:26:43 +0200 Subject: [PATCH 078/105] Add a new variable smtpmail-retries * doc/misc/smtpmail.texi (Server workarounds): Mention it (bug#34177). * lisp/mail/smtpmail.el (smtpmail-retries): New variable. (smtpmail-via-smtp): Use it. --- doc/misc/smtpmail.texi | 7 +++++++ etc/NEWS | 3 ++- lisp/mail/smtpmail.el | 9 ++++++++- 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index b2fc90a337a..7fa7b24e162 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -372,6 +372,13 @@ implement support for common requirements. @table @code +@item smtpmail-retries +@vindex smtpmail-retries +An SMTP server may return an error code saying that there's a +transient error (a @samp{4xx} code). In that case, smtpmail will try +to resend the message automatically, and the number of times it tries +before giving up is determined by this variable, which defaults to 10. + @item smtpmail-local-domain @vindex smtpmail-local-domain The variable @code{smtpmail-local-domain} controls the hostname sent diff --git a/etc/NEWS b/etc/NEWS index adb2b642ba9..33a7d12b7ef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1164,7 +1164,8 @@ attempt when communicating with the SMTP server(s), the --- *** smtpmail will now try resending mail when getting a transient 4xx -error message from the SMTP server. +error message from the SMTP server. The new 'smtpmail-retries' +variable says how many times to retry. ** Footnote mode diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 57913c1f0f0..802c9ba788d 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -165,6 +165,13 @@ attempt." :type '(choice regexp (const :tag "None" nil)) :version "27.1") +(defcustom smtpmail-retries 10 + "The number of times smtpmail will retry sending when getting transient errors. +These are errors with a code of 4xx from the SMTP server, which +mean \"try again\"." + :type 'integer + :version "27.1") + ;; End of customizable variables. @@ -823,7 +830,7 @@ Returns an error if the server cannot be contacted." ) ((and (numberp (car result)) (<= 400 (car result) 499) - (< send-attempts 10)) + (< send-attempts smtpmail-retries)) (message "Got transient error code %s when sending; retrying attempt %d..." (car result) send-attempts) ;; Retry on getting a transient 4xx code; see From 8635147ccba1fc8e1010010da8c3f8e467562f76 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Sep 2019 01:39:37 +0200 Subject: [PATCH 079/105] Fix imenu menu when we're auto-refreshing * lisp/imenu.el (imenu--make-index-alist): Don't add a *Refresh* item if we're auto-refreshing (bug#30449). --- lisp/imenu.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/imenu.el b/lisp/imenu.el index 5084fe61eff..9df597b4d63 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -510,8 +510,9 @@ See `imenu--index-alist' for the format of the index alist." "No items suitable for an index found in this buffer")) (or imenu--index-alist (setq imenu--index-alist (list nil))) - ;; Add a rescan option to the index. - (cons imenu--rescan-item imenu--index-alist)) + (unless imenu-auto-rescan + ;; Add a rescan option to the index. + (cons imenu--rescan-item imenu--index-alist))) (defvar imenu--cleanup-seen nil) From b124cb8f30d575fcda97507c40f16a499640bcd5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 16 Sep 2019 17:22:48 -0700 Subject: [PATCH 080/105] vc-cvs-revert: fix off-by-one file mode * lisp/vc/vc-cvs.el (vc-cvs-revert): 3950 (#o7556) is wrong as it keeps other-write but disables other-execute permissions. 3949 (#o7555) was intended here. Use octal notation for clarity. --- lisp/vc/vc-cvs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index d84700fc176..a9e79d7956c 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -440,7 +440,7 @@ REV is the revision to check out." (if vc-cvs-use-edit (vc-cvs-command nil 0 file "unedit") ;; Make the file read-only by switching off all w-bits - (set-file-modes file (logand (file-modes file) 3950))))) + (set-file-modes file (logand (file-modes file) #o7555))))) (defun vc-cvs-merge-file (file) "Accept a file merge request, prompting for revisions." From bc1c2cf009e30af77523fd87a8910fdbc4284704 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 16 Sep 2019 17:43:56 -0700 Subject: [PATCH 081/105] Fix some file-mode races * lisp/emacs-lisp/autoload.el (autoload-ensure-file-writeable): * lisp/files.el (after-find-file): * lisp/gnus/gnus-start.el (gnus-dribble-read-file): * lisp/htmlfontify.el (hfy-copy-and-fontify-file): * lisp/server.el (server-ensure-safe-dir): Avoid a race when getting file permissions. --- lisp/emacs-lisp/autoload.el | 3 +-- lisp/files.el | 10 +++++----- lisp/gnus/gnus-start.el | 5 ++--- lisp/htmlfontify.el | 6 +++--- lisp/server.el | 6 +++--- 5 files changed, 14 insertions(+), 16 deletions(-) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index a2dbd402c52..ce2827162b9 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -398,9 +398,8 @@ FILE's name." ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, ;; which was designed to handle CVSREAD=1 and equivalent. (and autoload-ensure-writable - (file-exists-p file) (let ((modes (file-modes file))) - (if (zerop (logand modes #o0200)) + (if (and modes (zerop (logand modes #o0200))) ;; Ignore any errors here, and let subsequent attempts ;; to write the file raise any real error. (ignore-errors (set-file-modes file (logior modes #o0200)))))) diff --git a/lisp/files.el b/lisp/files.el index ce4dd99bd53..5ceaacd744e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2554,13 +2554,13 @@ unless NOMODES is non-nil." (auto-save-mode 1))) ;; Make people do a little extra work (C-x C-q) ;; before altering a backup file. - (when (backup-file-name-p buffer-file-name) - (setq buffer-read-only t)) ;; When a file is marked read-only, ;; make the buffer read-only even if root is looking at it. - (when (and (file-modes (buffer-file-name)) - (zerop (logand (file-modes (buffer-file-name)) #o222))) - (setq buffer-read-only t)) + (unless buffer-read-only + (when (or (backup-file-name-p buffer-file-name) + (let ((modes (file-modes (buffer-file-name)))) + (and modes (zerop (logand modes #o222))))) + (setq buffer-read-only t))) (unless nomodes (when (and view-read-only view-mode) (view-mode -1)) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e8775c66673..cb369f07b92 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -897,9 +897,8 @@ If REGEXP is given, lines that match it will be deleted." (set-buffer-modified-p t)) ;; Set the file modes to reflect the .newsrc file modes. (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (file-exists-p dribble-file) - (setq modes (file-modes gnus-current-startup-file))) + (when (and (setq modes (file-modes gnus-current-startup-file)) + (file-exists-p dribble-file)) (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index b8442be1e89..c1aaab5e211 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1938,9 +1938,9 @@ adding an extension of `hfy-extn'. Fontification is actually done by (set-buffer html) (write-file (concat target hfy-extn)) (kill-buffer html)) - ;; #o0200 == 128, but emacs20 doesn't know that - (if (and (file-exists-p target) (not (file-writable-p target))) - (set-file-modes target (logior (file-modes target) 128))) + (let ((modes (file-modes target))) + (if (and modes (not (file-writable-p target))) + (set-file-modes target (logior modes #o0200)))) (copy-file (buffer-file-name source) target 'overwrite)) (kill-buffer source)) )) diff --git a/lisp/server.el b/lisp/server.el index ac81cdbd483..45fa55ad6b0 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -563,9 +563,9 @@ See variable `server-auth-dir' for details." (format "it is not owned by you (owner = %s (%d))" (user-full-name uid) uid)) (w32 nil) ; on NTFS? - ((/= 0 (logand ?\077 (file-modes dir))) - (format "it is accessible by others (%03o)" - (file-modes dir))) + ((let ((modes (file-modes dir))) + (unless (zerop (logand (or modes 0) #o077)) + (format "it is accessible by others (%03o)" modes)))) (t nil)))) (when unsafe (error "`%s' is not a safe directory because %s" From e80e037eec371e02e8160e4a9230e9a2822dd3e0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 17 Sep 2019 12:45:04 +0300 Subject: [PATCH 082/105] ; * etc/NEWS: Minor copyedits. --- etc/NEWS | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 33a7d12b7ef..2db5db3978a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,6 +1018,9 @@ only one hit. This can be altered by changing *** Xref buffers support refreshing the search results. A new command 'xref-revert-buffer' is bound to 'g'. +--- +*** Imenu support has been added to 'xref--xref-buffer-mode'. + ** Ecomplete *** The ecomplete sorting has changed to a decay-based algorithm. @@ -1912,11 +1915,6 @@ and 'gravatar-force-default'. *** The built-in ada-mode is now deleted. The GNU ELPA package is a good replacement, even in very large source files. -** xref - ---- -*** Imenu support has been added to 'xref--xref-buffer-mode'. - * New Modes and Packages in Emacs 27.1 @@ -1952,6 +1950,7 @@ long lines will (subject to configuration) cause the user's preferred major mode is replaced by 'so-long-mode'). In extreme cases this can prevent delays of several minutes, and make Emacs responsive almost immediately. Type 'M-x so-long-commentary' for full documentation. + * Incompatible Lisp Changes in Emacs 27.1 From d27fb533ffe8aa40285daecd8e3eab0ca0b7484e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 17 Sep 2019 12:01:15 +0200 Subject: [PATCH 083/105] * doc/lispref/searching.texi (Rx Constructs): Fix typo. --- doc/lispref/searching.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 2088f16e47c..1286b63446a 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1183,7 +1183,7 @@ Match @var{rx}, with @code{zero-or-more}, @code{0+}, @cindex @code{maximal-match} in rx Match @var{rx}, with @code{zero-or-more}, @code{0+}, @code{one-or-more}, @code{1+}, @code{zero-or-one}, @code{opt} and -@code{optional} using non-greedy matching. This is the default. +@code{optional} using greedy matching. This is the default. @end table @subsubheading Matching single characters From c108d8ecc65c8e9626ce782213764d5d12508b43 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 17 Sep 2019 03:54:41 -0700 Subject: [PATCH 084/105] =?UTF-8?q?Don=E2=80=99t=20round=20file-system-inf?= =?UTF-8?q?o=20counts?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/fileio.c (blocks_to_bytes): Convert the byte count to an integer, since we have bignums now. This avoids possible rounding errors for file systems containing more than 8 PiB or so. --- src/fileio.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/fileio.c b/src/fileio.c index c129f19872e..81c29ca0cca 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6081,16 +6081,18 @@ effect except for flushing STREAM's data. */) #ifndef DOS_NT -/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with - the result negated if NEGATE. */ +/* Yield a Lisp number equal to BLOCKSIZE * BLOCKS, with the result + negated if NEGATE. */ static Lisp_Object blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate) { - /* On typical platforms the following code is accurate to 53 bits, - which is close enough. BLOCKSIZE is invariably a power of 2, so - converting it to double does not lose information. */ - double bs = blocksize; - return make_float (negate ? -bs * -blocks : bs * blocks); + intmax_t n; + if (!INT_MULTIPLY_WRAPV (blocksize, blocks, &n)) + return make_int (negate ? -n : n); + Lisp_Object bs = make_uint (blocksize); + if (negate) + bs = CALLN (Fminus, bs); + return CALLN (Ftimes, bs, make_uint (blocks)); } DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, From 01c929bc640b48674d98feae1e821fb4924bf520 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 17 Sep 2019 04:01:00 -0700 Subject: [PATCH 085/105] Pacify GCC -Wmaybe-uninitialized * src/dired.c (directory_files_internal): Pacify GCC 7.4.0-1ubuntu1~18.04.1 x86-64. --- src/dired.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dired.c b/src/dired.c index 5fc6ccd3ead..df03bc32cef 100644 --- a/src/dired.c +++ b/src/dired.c @@ -241,7 +241,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, && fast_string_match_internal (match, name, case_table) < 0) continue; - Lisp_Object fileattrs; + Lisp_Object fileattrs UNINIT; if (attrs) { fileattrs = file_attributes (fd, dp->d_name, directory, name, From 8054935c6130c88152387f8a35d436704dbde780 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 17 Sep 2019 14:19:54 +0300 Subject: [PATCH 086/105] Improve font lookup on MS-Windows * src/w32font.c (struct font_callback_data): New member 'known_fonts'. (w32font_list_internal, w32font_match_internal): Set up match_data.known_fonts if the font spec includes :script that names one of the non-USB scripts. (add_font_entity_to_list): If font_matches_spec returns zero for a font, and we have some fonts in match_data->known_fonts, consider the font to be a match if it is named in known_fonts. (font_supported_scripts): Update the Unicode Subranges. In particular, map bit 74 to 'burmese', as this is the name Emacs uses, not 'myanmar'. Add a list of scripts that have no USBs defined for them. (syms_of_w32font) : New symbols. * lisp/term/w32-win.el (w32-no-usb-subranges): New defconst. (w32--filter-USB-scripts, w32-find-non-USB-fonts): New functions. (w32-non-USB-fonts): New defvar. * lisp/international/fontset.el (setup-default-fontset): Add more scripts to automatic setup by representative characters. * doc/emacs/msdos.texi (Windows Fonts): Document 'w32-find-non-USB-fonts' and 'w32-non-USB-fonts'. * etc/NEWS: Mention 'w32-find-non-USB-fonts' and 'w32-non-USB-fonts'. --- doc/emacs/msdos.texi | 65 +++++++++++------ etc/NEWS | 8 +++ lisp/international/fontset.el | 9 +++ lisp/term/w32-win.el | 130 ++++++++++++++++++++++++++++++++++ src/w32font.c | 125 +++++++++++++++++++++++++++----- 5 files changed, 299 insertions(+), 38 deletions(-) diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi index 6933130d5bd..5377df91d10 100644 --- a/doc/emacs/msdos.texi +++ b/doc/emacs/msdos.texi @@ -1025,7 +1025,7 @@ symbols, as in @code{(uniscribe)} or @w{@code{(harfbuzz uniscribe gdi)}}. @cindex font properties (MS Windows) @noindent -Optional properties common to all font backends on MS-Windows are: +Optional font properties supported on MS-Windows are: @table @code @@ -1078,40 +1078,61 @@ Not used on Windows, but for informational purposes and to prevent problems with code that expects it to be set, is set internally to @code{raster} for bitmapped fonts, @code{outline} for scalable fonts, or @code{unknown} if the type cannot be determined as one of those. -@end table - -@cindex font properties (MS Windows gdi backend) -Options specific to @code{GDI} fonts: - -@table @code @cindex font scripts (MS Windows) @cindex font Unicode subranges (MS Windows) @item script Specifies a Unicode subrange the font should support. -The following scripts are recognized on Windows: @code{latin}, @code{greek}, -@code{coptic}, @code{cyrillic}, @code{armenian}, @code{hebrew}, @code{arabic}, -@code{syriac}, @code{nko}, @code{thaana}, @code{devanagari}, @code{bengali}, -@code{gurmukhi}, @code{gujarati}, @code{oriya}, @code{tamil}, @code{telugu}, -@code{kannada}, @code{malayam}, @code{sinhala}, @code{thai}, @code{lao}, -@code{tibetan}, @code{myanmar}, @code{georgian}, @code{hangul}, -@code{ethiopic}, @code{cherokee}, @code{canadian-aboriginal}, @code{ogham}, -@code{runic}, @code{khmer}, @code{mongolian}, @code{symbol}, @code{braille}, -@code{han}, @code{ideographic-description}, @code{cjk-misc}, @code{kana}, -@code{bopomofo}, @code{kanbun}, @code{yi}, @code{byzantine-musical-symbol}, -@code{musical-symbol}, and @code{mathematical}. +All the scripts known to Emacs (which generally means all the scripts +defined by the latest Unicode Standard) are recognized on MS-Windows. +However, @code{GDI} fonts support only a subset of the known scripts: +@code{greek}, @code{hangul}, @code{kana}, @code{kanbun}, +@code{bopomofo}, @code{tibetan}, @code{yi}, @code{mongolian}, +@code{hebrew}, @code{arabic}, and @code{thai}. @cindex font antialiasing (MS Windows) +@cindex Cleartype @item antialias Specifies the antialiasing method. The value @code{none} means no antialiasing, @code{standard} means use standard antialiasing, -@code{subpixel} means use subpixel antialiasing (known as Cleartype on -Windows), and @code{natural} means use subpixel antialiasing with -adjusted spacing between letters. If unspecified, the font will use -the system default antialiasing. +@code{subpixel} means use subpixel antialiasing (known as +@dfn{Cleartype} on Windows), and @code{natural} means use subpixel +antialiasing with adjusted spacing between letters. If unspecified, +the font will use the system default antialiasing. @end table +@cindex font lookup, MS-Windows +@findex w32-find-non-USB-fonts +The method used by Emacs on MS-Windows to look for fonts suitable for +displaying a given non-@sc{ascii} character might fail for some rare +scripts, specifically those added by Unicode relatively recently, even +if you have fonts installed on your system that support those scripts. +That is because these scripts have no Unicode Subrange Bits (USBs) +defined for them in the information used by Emacs on MS-Windows to +look for fonts. You can use the @code{w32-find-non-USB-fonts} +function to overcome these problems. It needs to be run once at the +beginning of the Emacs session, and again if you install new fonts. +You can add the following line to your init file to have this function +run every time you start Emacs: + +@lisp +(w32-find-non-USB-fonts) +@end lisp + +@noindent +@vindex w32-non-USB-fonts +Alternatively, you can run this function manually via @kbd{M-:} +(@pxref{Lisp Eval}) at any time. On a system that has many fonts +installed, running @code{w32-find-non-USB-fonts} might take a couple +of seconds; if you consider that to be too long to be run during +startup, and if you install new fonts only rarely, run this function +once via @kbd{M-:}, and then assign the value it returns, if +non-@code{nil}, to the variable @code{w32-non-USB-fonts} in your init +file. (If the function returns @code{nil}, you have no fonts +installed that can display characters from the scripts which need this +facility.) + @node Windows Misc @section Miscellaneous Windows-specific features diff --git a/etc/NEWS b/etc/NEWS index 2db5db3978a..693a690f17a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2703,6 +2703,14 @@ corresponding encoding, instead of using 'w32-ansi-code-page'. Experience shows that compacting font caches causes more trouble on MS-Windows than it helps. ++++ +** Font lookup on MS-Windows was improved to support rare scripts. +To activate the improvement, run the new function +'w32-find-non-USB-fonts' once per Emacs session, or assign to the new +variable 'w32-non-USB-fonts' the list of scripts and the corresponding +fonts. See the documentation of this function and variable in the +Emacs manual for more details. + +++ ** On NS the behaviour of drag and drop can now be modified by use of modifier keys in line with Apples guidelines. This makes the drag and diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index f3ab81633dc..1debec7f469 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -719,6 +719,7 @@ symbol braille yi + tai-viet aegean-number ancient-greek-number ancient-symbol @@ -731,18 +732,26 @@ deseret shavian osmanya + osage cypriot-syllabary phoenician lydian kharoshthi + manichaean + elymaic + makasar cuneiform-numbers-and-punctuation cuneiform egyptian + bassa-vah + pahawh-hmong + medefaidrin byzantine-musical-symbol musical-symbol ancient-greek-musical-notation tai-xuan-jing-symbol counting-rod-numeral + adlam mahjong-tile domino-tile)) (set-fontset-font "fontset-default" diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 198182fca72..e2c019fc548 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -485,6 +485,136 @@ numbers, and the build number." That includes all Windows systems except for 9X/Me." (getenv "SystemRoot")) +;; The value of the following variable was calculated using the table in +;; https://docs.microsoft.com/windows/desktop/Intl/unicode-subset-bitfields, +;; by looking for Unicode subranges for which no USB bits are defined. +(defconst w32-no-usb-subranges + '((#x000800 . #x0008ff) + (#x0018b0 . #x0018ff) + (#x001a20 . #x001aff) + (#x001bc0 . #x001bff) + (#x001c80 . #x001cff) + (#x002fe0 . #x002fef) + (#x00a4d0 . #x00a4ff) + (#x00a6a0 . #x00a6ff) + (#x00a830 . #x00a83f) + (#x00a8e0 . #x00a8ff) + (#x00a960 . #x00a9ff) + (#x00aa60 . #x00abff) + (#x00d7b0 . #x00d7ff) + (#x010200 . #x01027f) + (#x0102e0 . #x0102ff) + (#x010350 . #x01037f) + (#x0103e0 . #x0103ff) + (#x0104b0 . #x0107ff) + (#x010840 . #x0108ff) + (#x010940 . #x0109ff) + (#x010a60 . #x011fff) + (#x012480 . #x01cfff) + (#x01d250 . #x01d2ff) + (#x01d380 . #x01d3ff) + (#x01d800 . #x01efff) + (#x01f0a0 . #x01ffff) + (#x02a6e0 . #x02f7ff) + (#x02fa20 . #x0dffff) + (#x0e0080 . #x0e00ff) + (#x0e01f0 . #x0fefff)) + "List of Unicode subranges whose support cannot be announced by a font. +The FONTSIGNATURE structure reported by MS-Windows for a font +includes 123 Unicode Subset bits (USBs) to identify subranges of +the Unicode codepoint space supported by the font. Since the +number of bits is fixed, not every Unicode block can have a +corresponding USB bit; fonts that support characters from blocks +that have no USBs cannot communicate their support to Emacs, +unless the font is opened and physically tested for glyphs for +characters from these blocks.") + +(defun w32--filter-USB-scripts () + "Filter USB scripts out of `script-representative-chars'." + (let (val) + (dolist (elt script-representative-chars) + (let ((subranges w32-no-usb-subranges) + (chars (cdr elt)) + ch found subrange) + (while (and (consp chars) (not found)) + (setq ch (car chars) + chars (cdr chars)) + (while (and (consp subranges) (not found)) + (setq subrange (car subranges) + subranges (cdr subranges)) + (when (and (>= ch (car subrange)) (<= ch (cdr subrange))) + (setq found t) + (push elt val)))))) + (nreverse val))) + +(defvar w32-non-USB-fonts nil + "Alist of script symbols and corresponding fonts. +Each element of the alist has the form (SCRIPT FONTS...), where +SCRIPT is a symbol of a script and FONTS are one or more fonts installed +on the system that can display SCRIPT's characters. FONTS are +specified as symbols. +Only scripts that have no corresponding Unicode Subset Bits (USBs) can +be found in this alist. +This alist is used by w32font.c when it looks for fonts that can display +characters from scripts for which no USBs are defined.") + +(defun w32-find-non-USB-fonts (&optional frame size) + "Compute the value of `w32-non-USB-fonts' for specified SIZE and FRAME. +FRAME defaults to the selected frame. +SIZE is the required font size and defaults to the nominal size of the +default font on FRAME, or its best approximation." + (let* ((inhibit-compacting-font-caches t) + (all-fonts + (delete-dups + (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" + 'default frame))) + val) + (mapc (function + (lambda (script-desc) + (let* ((script (car script-desc)) + (script-chars (vconcat (cdr script-desc))) + (nchars (length script-chars)) + (fntlist all-fonts) + (entry (list script)) + fspec ffont font-obj glyphs idx) + ;; For each font in FNTLIST, determine whether it + ;; supports the representative character(s) of any + ;; scripts that have no USBs defined for it. + (dolist (fnt fntlist) + (setq fspec (ignore-errors (font-spec :name fnt))) + (if fspec + (setq ffont (find-font fspec frame))) + (when ffont + (setq font-obj + (open-font ffont size frame)) + ;; Ignore fonts for which open-font returns nil: + ;; they are buggy fonts that we cannot use anyway. + (setq glyphs + (if font-obj + (font-get-glyphs font-obj + 0 nchars script-chars) + '[nil])) + ;; Does this font support ALL of the script's + ;; representative characters? + (setq idx 0) + (while (and (< idx nchars) (not (null (aref glyphs idx)))) + (setq idx (1+ idx))) + (if (= idx nchars) + ;; It does; add this font to the script's entry in alist. + (let ((font-family (font-get font-obj :family))) + ;; Unifont is an ugly font, and it is already + ;; present in the default fontset. + (unless (string= (downcase (symbol-name font-family)) + "unifont") + (push font-family entry)))))) + (if (> (length entry) 1) + (push (nreverse entry) val))))) + (w32--filter-USB-scripts)) + ;; We've opened a lot of fonts, so clear the font caches to free + ;; some memory. + (clear-font-cache) + (and val (setq w32-non-USB-fonts val)))) + (provide 'w32-win) (provide 'term/w32-win) diff --git a/src/w32font.c b/src/w32font.c index 14d49b24d9b..9a334717c12 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -90,6 +90,8 @@ struct font_callback_data Lisp_Object orig_font_spec; /* The frame the font is being loaded on. */ Lisp_Object frame; + /* Fonts known to support the font spec, or nil if none. */ + Lisp_Object known_fonts; /* The list to add matches to. */ Lisp_Object list; /* Whether to match only opentype fonts. */ @@ -841,6 +843,25 @@ w32font_list_internal (struct frame *f, Lisp_Object font_spec, match_data.opentype_only = opentype_only; if (opentype_only) match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + match_data.known_fonts = Qnil; + Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val; + if (CONSP (vw32_non_USB_fonts)) + { + Lisp_Object extra; + for (extra = AREF (font_spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object tem = XCAR (extra); + if (CONSP (tem) + && EQ (XCAR (tem), QCscript) + && SYMBOLP (XCDR (tem)) + && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts))) + { + match_data.known_fonts = XCDR (val); + break; + } + } + } if (match_data.pattern.lfFaceName[0] == '\0') { @@ -890,6 +911,26 @@ w32font_match_internal (struct frame *f, Lisp_Object font_spec, if (opentype_only) match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + match_data.known_fonts = Qnil; + Lisp_Object vw32_non_USB_fonts = Fsymbol_value (Qw32_non_USB_fonts), val; + if (CONSP (vw32_non_USB_fonts)) + { + Lisp_Object extra; + for (extra = AREF (font_spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object tem = XCAR (extra); + if (CONSP (tem) + && EQ (XCAR (tem), QCscript) + && SYMBOLP (XCDR (tem)) + && !NILP (val = assq_no_quit (XCDR (tem), vw32_non_USB_fonts))) + { + match_data.known_fonts = XCDR (val); + break; + } + } + } + /* Prevent quitting while EnumFontFamiliesEx runs and conses the list it will return. That's because get_frame_dc acquires the critical section, so we cannot quit before we release it in @@ -1511,9 +1552,13 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, /* Ensure a match. */ if (!logfonts_match (&logical_font->elfLogFont, &match_data->pattern) - || !font_matches_spec (font_type, physical_font, - match_data->orig_font_spec, backend, - &logical_font->elfLogFont) + || !(font_matches_spec (font_type, physical_font, + match_data->orig_font_spec, backend, + &logical_font->elfLogFont) + || (!NILP (match_data->known_fonts) + && memq_no_quit + (intern_font_name (logical_font->elfLogFont.lfFaceName), + match_data->known_fonts))) || !w32font_coverage_ok (&physical_font->ntmFontSig, match_data->pattern.lfCharSet)) return 1; @@ -2214,8 +2259,9 @@ font_supported_scripts (FONTSIGNATURE * sig) || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \ supported = Fcons ((sym), supported) - SUBRANGE (0, Qlatin); - /* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */ + /* 0: ASCII (a.k.a. "Basic Latin"), + 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B, + 29: Latin Extended Additional. */ /* Most fonts that support Latin will have good coverage of the Extended blocks, so in practice marking them below is not really needed, or useful: if a font claims support for, say, Latin @@ -2224,12 +2270,11 @@ font_supported_scripts (FONTSIGNATURE * sig) fontset to display those few characters. But we mark these subranges here anyway, for the marginal use cases where they might make a difference. */ - SUBRANGE (1, Qlatin); - SUBRANGE (2, Qlatin); - SUBRANGE (3, Qlatin); + MASK_ANY (0x2000000F, 0, 0, 0, Qlatin); SUBRANGE (4, Qphonetic); /* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */ - SUBRANGE (7, Qgreek); + /* 7: Greek and Coptic, 30: Greek Extended. */ + MASK_ANY (0x40000080, 0, 0, 0, Qgreek); SUBRANGE (8, Qcoptic); SUBRANGE (9, Qcyrillic); SUBRANGE (10, Qarmenian); @@ -2246,7 +2291,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (16, Qbengali); SUBRANGE (17, Qgurmukhi); SUBRANGE (18, Qgujarati); - SUBRANGE (19, Qoriya); + SUBRANGE (19, Qoriya); /* a.k.a. "Odia" */ SUBRANGE (20, Qtamil); SUBRANGE (21, Qtelugu); SUBRANGE (22, Qkannada); @@ -2259,8 +2304,7 @@ font_supported_scripts (FONTSIGNATURE * sig) /* 29: Latin Extended, 30: Greek Extended -- covered above. */ /* 31: Supplemental Punctuation -- most probably be masked by Courier New, so fontset customization is needed. */ - SUBRANGE (31, Qsymbol); - /* 32-47: Symbols (defined below). */ + /* 31-47: Symbols (defined below). */ SUBRANGE (48, Qcjk_misc); /* Match either 49: katakana or 50: hiragana for kana. */ MASK_ANY (0, 0x00060000, 0, 0, Qkana); @@ -2286,7 +2330,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (71, Qsyriac); SUBRANGE (72, Qthaana); SUBRANGE (73, Qsinhala); - SUBRANGE (74, Qmyanmar); + SUBRANGE (74, Qburmese); /* a.k.a. "Myanmar" */ SUBRANGE (75, Qethiopic); SUBRANGE (76, Qcherokee); SUBRANGE (77, Qcanadian_aboriginal); @@ -2329,6 +2373,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (99, Qhan); SUBRANGE (100, Qsyloti_nagri); SUBRANGE (101, Qlinear_b); + SUBRANGE (101, Qaegean_number); SUBRANGE (102, Qancient_greek_number); SUBRANGE (103, Qugaritic); SUBRANGE (104, Qold_persian); @@ -2338,6 +2383,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (108, Qkharoshthi); SUBRANGE (109, Qtai_xuan_jing_symbol); SUBRANGE (110, Qcuneiform); + SUBRANGE (111, Qcuneiform_numbers_and_punctuation); SUBRANGE (111, Qcounting_rod_numeral); SUBRANGE (112, Qsundanese); SUBRANGE (113, Qlepcha); @@ -2357,9 +2403,52 @@ font_supported_scripts (FONTSIGNATURE * sig) /* There isn't really a main symbol range, so include symbol if any relevant range is set. */ - MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol); + MASK_ANY (0x80000000, 0x0000FFFF, 0, 0, Qsymbol); - /* Missing: Tai Viet (U+AA80-U+AADF). */ + /* Missing: + Tai Viet + Old Permic + Palmyrene + Nabatean + Manichean + Hanifi Rohingya + Sogdian + Elymaic + Mahajani + Khojki + Khudawadi + Grantha + Newa + Tirhuta + Siddham + Modi + Takri + Dogra + Warang Citi + Nandinagari + Zanabazar Square + Soyombo + Pau Cin Hau + Bhaiksuki + Marchen + Masaram Gondi + Makasar + Egyptian + Mro + Bassa-Vah + Pahawh Hmong + Medefaidrin + Tangut + Tangut Components + Nushu + Duployan Shorthand + Ancient Greek Musical Notation + Nyiakeng Puachue Hmong + Wancho + Mende Kikakui + Adlam + Indic Siyaq Number + Ottoman Siyaq Number. */ #undef SUBRANGE #undef MASK_ANY @@ -2698,7 +2787,7 @@ syms_of_w32font (void) DEFSYM (Qthai, "thai"); DEFSYM (Qlao, "lao"); DEFSYM (Qtibetan, "tibetan"); - DEFSYM (Qmyanmar, "myanmar"); + DEFSYM (Qburmese, "burmese"); DEFSYM (Qgeorgian, "georgian"); DEFSYM (Qhangul, "hangul"); DEFSYM (Qethiopic, "ethiopic"); @@ -2737,6 +2826,8 @@ syms_of_w32font (void) DEFSYM (Qbuginese, "buginese"); DEFSYM (Qbuhid, "buhid"); DEFSYM (Qcuneiform, "cuneiform"); + DEFSYM (Qcuneiform_numbers_and_punctuation, + "cuneiform-numbers-and-punctuation"); DEFSYM (Qcypriot, "cypriot"); DEFSYM (Qdeseret, "deseret"); DEFSYM (Qglagolitic, "glagolitic"); @@ -2745,6 +2836,7 @@ syms_of_w32font (void) DEFSYM (Qkharoshthi, "kharoshthi"); DEFSYM (Qlimbu, "limbu"); DEFSYM (Qlinear_b, "linear_b"); + DEFSYM (Qaegean_number, "aegean-number"); DEFSYM (Qold_italic, "old_italic"); DEFSYM (Qold_persian, "old_persian"); DEFSYM (Qosmanya, "osmanya"); @@ -2818,6 +2910,7 @@ versions of Windows) characters. */); DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese"); DEFSYM (Qw32_charset_thai, "w32-charset-thai"); DEFSYM (Qw32_charset_mac, "w32-charset-mac"); + DEFSYM (Qw32_non_USB_fonts, "w32-non-USB-fonts"); defsubr (&Sx_select_font); From f52c13ff8212e46e5b5f034eade316a733c9e4a4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Sep 2019 13:54:19 +0200 Subject: [PATCH 087/105] Update doc marker -- smtpmail-retries is documented --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 693a690f17a..9aec8da5663 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1165,7 +1165,7 @@ defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. attempt when communicating with the SMTP server(s), the 'smtpmail-servers-requiring-authorization' variable can be used. ---- ++++ *** smtpmail will now try resending mail when getting a transient 4xx error message from the SMTP server. The new 'smtpmail-retries' variable says how many times to retry. From 0e5e816a09cddb0577e5d7c6187b872876b2f759 Mon Sep 17 00:00:00 2001 From: "W. Garrett Mitchener" Date: Tue, 17 Sep 2019 13:56:28 +0200 Subject: [PATCH 088/105] Updated to match more recent versions of Praat. * lisp/leim/quail/ipa-praat.el ("ipa-praat"): Update to match more recent versions of Praat (bug#36198). - \rh was used for ram's horns (a vowel) and rhoticity hook (a diacritic). Praat uses \hr for the hook, so I made that changed. - \e3v for the slightly rounded diacritic seems to have been a typo related to the use of e in the example. Changed it to \3v to match Praat. - Added examples to the table of tone diacritics - Added \^h for superscript h - Added \^H for superscript h with hook - Added \^w for superscript w (labialization) - Added \^j for superscript j (palatalization) - Added \^g for superscript symbol (velarization) - Added \^9 for superscript symbol (pharyngealization) --- lisp/leim/quail/ipa-praat.el | 37 ++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 74a2dccc060..169dbcf0e22 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -148,7 +148,14 @@ input | example | description \\'1 | ˈ | primary stress \\'2 | ˌ | secondary stress \\cn | t̚ | unreleased plosive -\\rh | ɜ˞ | rhotacized vowel +\\hr | ɜ˞ | rhotacized vowel +\\^h | ʰ | aspiration +\\^H | ʱ | voiced aspiration +\\^w | ʷ | labialized, rounded +\\^j | ʲ | palatalized +\\^g | ˠ | velarized +\\^9 | ˤ | pharyngealized + - Understrikes @@ -168,7 +175,7 @@ input | example | description \\Uv | d̺ | apical \\Dv | d̻ | laminal \\nv | u̯ | nonsyllabic -\\e3v | e̹ | slightly rounded +\\3v | e̹ | slightly rounded \\cv | u̜ | slightly unrounded - Overstrikes @@ -176,14 +183,14 @@ input | example | description input | example | description ------+---------+-------------------------------------------- \\0^ | ɣ̊ | voiceless -\\'^ | | high tone -\\`^ | | low tone -\\-^ | | mid tone -\\~^ | | nasalized -\\v^ | | rising tone -\\^^ | | falling tone -\\:^ | | centralized -\\N^ | | short +\\'^ | é | high tone +\\`^ | è | low tone +\\-^ | ē | mid tone +\\~^ | ẽ | nasalized +\\v^ | ě | rising tone +\\^^ | ê | falling tone +\\:^ | ë | centralized +\\N^ | ĕ | short \\li | k͡p | simultaneous articulation or single segment " nil t nil nil nil nil nil nil nil nil t) @@ -308,7 +315,13 @@ input | example | description ("\\'1" ?ˈ) ; primary stress ("\\'2" ?ˌ) ; secondary stress ("\\cn" #x031A) ; t̚ unreleased plosive - ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel + ("\\hr" #x02DE) ; ɜ˞ rhotacized vowel + ("\\^h" ?ʰ) ; ʰ aspiration (usually following a plosive) + ("\\^H" ?ʱ) ; ʱ voiced aspiration (usually following a plosive) + ("\\^w" ?ʷ) ; labialized + ("\\^j" ?ʲ) ; palatalized + ("\\^g" ?ˠ) ; velarized + ("\\^9" ?ˤ) ; pharyngealized ("\\|v" #x0329) ; n̩ syllabic consonant ("\\0v" #x0325) ; b̥ voiceless @@ -324,7 +337,7 @@ input | example | description ("\\Uv" #x033A) ; d̺ apical ("\\Dv" #x033B) ; d̻ laminal ("\\nv" #x032F) ; u̯ nonsyllabic - ("\\e3v" #x0339) ; e̹ slightly rounded + ("\\3v" #x0339) ; e̹ slightly rounded ("\\cv" #x031C) ; u̜ slightly unrounded ("\\0^" #x030A) ; ɣ̊ voiceless From 4b73a937e08334a8304f876b598b662d6a0aaef5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Sep 2019 14:11:53 +0200 Subject: [PATCH 089/105] Touch up naming of ipv6-expand * lisp/net/net-utils.el (nslookup--ipv6-expand): Rename to avoid make prefix more regular. (nslookup-host-ipv6): Rename call. --- lisp/net/net-utils.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 4f68e5db61d..03ed4a59575 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -563,7 +563,7 @@ This command uses `nslookup-program' to look up DNS records." (apply #'vector (mapcar #'string-to-number (split-string ip "\\.")))) (t (error "Invalid format: %s" format))))) -(defun ipv6-expand (ipv6-vector) +(defun nslookup--ipv6-expand (ipv6-vector) (let ((len (length ipv6-vector))) (if (< len 8) (let* ((pivot (cl-position 0 ipv6-vector)) @@ -598,9 +598,10 @@ This command uses `nslookup-program' to look up DNS records." (cond ((memq format '(string nil)) ip) ((eq format 'vector) - (ipv6-expand (apply #'vector - (cl-loop for hextet in (split-string ip "[:]") - collect (string-to-number hextet 16))))) + (nslookup--ipv6-expand + (apply #'vector + (cl-loop for hextet in (split-string ip "[:]") + collect (string-to-number hextet 16))))) (t (error "Invalid format: %s" format))))) ;;;###autoload From 57fd3709b21da6b4281c4e96e3361e5cf2355957 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 17 Sep 2019 14:18:52 +0200 Subject: [PATCH 090/105] Suppress some warnings about un-prefixed dynamic variables * lisp/mh-e/mh-mime.el (mh-insert-mime-security-button): Suppress warnings about un-prefixed dynamic variables. (mh-insert-mime-button): Ditto. --- lisp/mh-e/mh-mime.el | 112 ++++++++++++++++++++++--------------------- 1 file changed, 57 insertions(+), 55 deletions(-) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index d74e79f1cb0..c6b5aaec347 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -859,23 +859,24 @@ by commands like \"K v\" which operate on individual MIME parts." (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) ;; These vars are passed by dynamic-scoping to ;; mh-mime-button-line-format-alist via gnus-eval-format. - (mh-dlet* ((index index) - (description (mail-decode-encoded-word-string - (or (mm-handle-description handle) ""))) - (dots (if (or displayed (mm-handle-displayed-p handle)) - " " "...")) - (long-type (concat type (and (not (equal name "")) - (concat "; " name))))) - (unless (equal description "") - (setq long-type (concat " --- " long-type))) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-button-map) - mh-callback mh-mm-display-part - mh-part ,index - mh-data ,handle))) + (with-suppressed-warnings ((lexical index description dots)) + (mh-dlet* ((index index) + (description (mail-decode-encoded-word-string + (or (mm-handle-description handle) ""))) + (dots (if (or displayed (mm-handle-displayed-p handle)) + " " "...")) + (long-type (concat type (and (not (equal name "")) + (concat "; " name))))) + (unless (equal description "") + (setq long-type (concat " --- " long-type))) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-button-line-format mh-mime-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-button-map) + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle)))) (setq end (point)) (widget-convert-button 'link begin end @@ -900,44 +901,45 @@ by commands like \"K v\" which operate on individual MIME parts." begin end face) ;; These vars are passed by dynamic-scoping to ;; mh-mime-security-button-line-format-alist via gnus-eval-format. - (mh-dlet* ((type (concat crypto-type - (if (equal (car handle) "multipart/signed") - " Signed" " Encrypted") - " Part")) - (info (or (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-info) - "Undecided")) - (details (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-details)) - pressed-details) - (setq details (if details (concat "\n" details) "")) - (setq pressed-details (if mh-mime-security-button-pressed details "")) - (setq face (mh-mime-security-button-face info)) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-security-button-line-format - mh-mime-security-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-security-button-map) - mh-button-pressed ,mh-mime-security-button-pressed - mh-callback mh-mime-security-press-button - mh-line-format ,mh-mime-security-button-line-format - mh-data ,handle)) - (setq end (point)) - (widget-convert-button 'link begin end - :mime-handle handle - :action 'mh-widget-press-button - :button-keymap mh-mime-security-button-map - :button-face face - :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") - (dolist (ov (mh-funcall-if-exists overlays-in begin end)) - (mh-funcall-if-exists overlay-put ov 'evaporate t)) - (when (equal info "Failed") - (let* ((type (if (equal (car handle) "multipart/signed") - "verification" "decryption")) - (warning (if (equal type "decryption") - "(passphrase may be incorrect)" ""))) - (message "%s %s failed %s" crypto-type type warning)))))) + (with-suppressed-warnings ((lexical type info details)) + (mh-dlet* ((type (concat crypto-type + (if (equal (car handle) "multipart/signed") + " Signed" " Encrypted") + " Part")) + (info (or (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-info) + "Undecided")) + (details (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-details)) + pressed-details) + (setq details (if details (concat "\n" details) "")) + (setq pressed-details (if mh-mime-security-button-pressed details "")) + (setq face (mh-mime-security-button-face info)) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-security-button-line-format + mh-mime-security-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-security-button-map) + mh-button-pressed ,mh-mime-security-button-pressed + mh-callback mh-mime-security-press-button + mh-line-format ,mh-mime-security-button-line-format + mh-data ,handle)) + (setq end (point)) + (widget-convert-button 'link begin end + :mime-handle handle + :action 'mh-widget-press-button + :button-keymap mh-mime-security-button-map + :button-face face + :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") + (dolist (ov (mh-funcall-if-exists overlays-in begin end)) + (mh-funcall-if-exists overlay-put ov 'evaporate t)) + (when (equal info "Failed") + (let* ((type (if (equal (car handle) "multipart/signed") + "verification" "decryption")) + (warning (if (equal type "decryption") + "(passphrase may be incorrect)" ""))) + (message "%s %s failed %s" crypto-type type warning))))))) (defun mh-mime-security-button-face (info) "Return the button face to use for encrypted/signed mail based on INFO." From 746b20c23733c36c26e8962d685b01385e58e94d Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Tue, 17 Sep 2019 16:29:23 +0200 Subject: [PATCH 091/105] * src/w32fns.c (Fw32_read_registry): Doc fix --- src/w32fns.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/w32fns.c b/src/w32fns.c index d6fd8f53490..34abd026f95 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10109,8 +10109,8 @@ KEY can use either forward- or back-slashes. To access the default value of KEY (if it is defined), use NAME that is an empty string. -If the the named KEY or its subkey called NAME don't exist, or cannot -be accessed by the current user, the function returns nil. Otherwise, +If the named KEY or its subkey called NAME don't exist, or cannot be +accessed by the current user, the function returns nil. Otherwise, the return value depends on the type of the data stored in Registry: If the data type is REG_NONE, the function returns t. From cbc10ec71e9f189e8d6fd5c6927aec4872e0fd96 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Tue, 17 Sep 2019 18:07:50 +0200 Subject: [PATCH 092/105] Fix an assignment to free variable warning It fixes a bug introduced by commit 'query-replace-regexp undo: Update next-replacement after undo' (30c4f35a6fc8a6507930923766c3126ac1c2063f) See https://lists.gnu.org/archive/html/emacs-devel/2019-09/msg00364.html * lisp/replace.el(perform-replace): Rename variable to next-replacement-replaced. --- lisp/replace.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/replace.el b/lisp/replace.el index a82780fc47e..5c0616e25f0 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2711,7 +2711,7 @@ characters." search-string (nth (if replaced 4 3) elt) last-replacement (nth (if replaced 3 4) elt) search-string-replaced search-string - last-replacement-replaced last-replacement + next-replacement-replaced last-replacement last-was-act-and-show nil) (when (and (= stack-idx stack-len) From ae3edf0ac3f1e893338917497b55859d6aca7d42 Mon Sep 17 00:00:00 2001 From: Jimmy Aguilar Mena Date: Tue, 17 Sep 2019 22:00:21 +0200 Subject: [PATCH 093/105] Substituted deprecated WebKitGTK+ api. * src/xwidget.c : Substituted WebKitGTK+ API calls and use JavaScriptCore GLib API instead. --- src/xwidget.c | 211 +++++++++++++++++++++----------------------------- 1 file changed, 88 insertions(+), 123 deletions(-) diff --git a/src/xwidget.c b/src/xwidget.c index 121510ebac0..ecb37936293 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -31,14 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -/* Suppress GCC deprecation warnings starting in WebKitGTK+ 2.21.1 for - webkit_javascript_result_get_global_context and - webkit_javascript_result_get_value (Bug#33679). - FIXME: Use the JavaScriptCore GLib API instead, and remove this hack. */ -#if WEBKIT_CHECK_VERSION (2, 21, 1) && GNUC_PREREQ (4, 2, 0) -# pragma GCC diagnostic ignored "-Wdeprecated-declarations" -#endif - static struct xwidget * allocate_xwidget (void) { @@ -284,95 +276,70 @@ webkit_view_load_changed_cb (WebKitWebView *webkitwebview, /* Recursively convert a JavaScript value to a Lisp value. */ static Lisp_Object -webkit_js_to_lisp (JSContextRef context, JSValueRef value) +webkit_js_to_lisp (JSCValue *value) { - switch (JSValueGetType (context, value)) + if (jsc_value_is_string (value)) { - case kJSTypeString: - { - JSStringRef js_str_value; - gchar *str_value; - gsize str_length; + gchar *str_value = jsc_value_to_string (value); + Lisp_Object ret = build_string (str_value); + g_free (str_value); - js_str_value = JSValueToStringCopy (context, value, NULL); - str_length = JSStringGetMaximumUTF8CStringSize (js_str_value); - str_value = (gchar *)g_malloc (str_length); - JSStringGetUTF8CString (js_str_value, str_value, str_length); - JSStringRelease (js_str_value); - return build_string (str_value); - } - case kJSTypeBoolean: - return (JSValueToBoolean (context, value)) ? Qt : Qnil; - case kJSTypeNumber: - return make_fixnum (JSValueToNumber (context, value, NULL)); - case kJSTypeObject: - { - if (JSValueIsArray (context, value)) - { - JSStringRef pname = JSStringCreateWithUTF8CString("length"); - JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, - pname, NULL); - double dlen = JSValueToNumber (context, len, NULL); - JSStringRelease(pname); - - Lisp_Object obj; - if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) - memory_full (SIZE_MAX); - ptrdiff_t n = dlen; - struct Lisp_Vector *p = allocate_vector (n); - - for (ptrdiff_t i = 0; i < n; ++i) - { - p->contents[i] = - webkit_js_to_lisp (context, - JSObjectGetPropertyAtIndex (context, - (JSObjectRef) value, - i, NULL)); - } - XSETVECTOR (obj, p); - return obj; - } - else - { - JSPropertyNameArrayRef properties = - JSObjectCopyPropertyNames (context, (JSObjectRef) value); - - size_t n = JSPropertyNameArrayGetCount (properties); - Lisp_Object obj; - - /* TODO: can we use a regular list here? */ - if (PTRDIFF_MAX < n) - memory_full (n); - struct Lisp_Vector *p = allocate_vector (n); - - for (ptrdiff_t i = 0; i < n; ++i) - { - JSStringRef name = JSPropertyNameArrayGetNameAtIndex (properties, i); - JSValueRef property = JSObjectGetProperty (context, - (JSObjectRef) value, - name, NULL); - gchar *str_name; - gsize str_length; - str_length = JSStringGetMaximumUTF8CStringSize (name); - str_name = (gchar *)g_malloc (str_length); - JSStringGetUTF8CString (name, str_name, str_length); - JSStringRelease (name); - - p->contents[i] = - Fcons (build_string (str_name), - webkit_js_to_lisp (context, property)); - } - - JSPropertyNameArrayRelease (properties); - XSETVECTOR (obj, p); - return obj; - } - } - case kJSTypeUndefined: - case kJSTypeNull: - default: - return Qnil; + return ret; } + else if (jsc_value_is_boolean (value)) + { + return (jsc_value_to_boolean (value)) ? Qt : Qnil; + } + else if (jsc_value_is_number (value)) + { + return make_fixnum (jsc_value_to_int32 (value)); + } + else if (jsc_value_is_array (value)) + { + JSCValue *len = jsc_value_object_get_property (value, "length"); + const gint32 dlen = jsc_value_to_int32 (len); + + Lisp_Object obj; + if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) + memory_full (SIZE_MAX); + + ptrdiff_t n = dlen; + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + p->contents[i] = + webkit_js_to_lisp (jsc_value_object_get_property_at_index (value, i)); + } + XSETVECTOR (obj, p); + return obj; + } + else if (jsc_value_is_object (value)) + { + char **properties_names = jsc_value_object_enumerate_properties (value); + guint n = g_strv_length (properties_names); + + Lisp_Object obj; + if (PTRDIFF_MAX < n) + memory_full (n); + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + const char *name = properties_names[i]; + JSCValue *property = jsc_value_object_get_property (value, name); + + p->contents[i] = + Fcons (build_string (name), webkit_js_to_lisp (property)); + } + + g_strfreev (properties_names); + + XSETVECTOR (obj, p); + return obj; + } + + return Qnil; } static void @@ -380,41 +347,39 @@ webkit_javascript_finished_cb (GObject *webview, GAsyncResult *result, gpointer arg) { - WebKitJavascriptResult *js_result; - JSValueRef value; - JSGlobalContextRef context; - GError *error = NULL; - struct xwidget *xw = g_object_get_data (G_OBJECT (webview), - XG_XWIDGET); - ptrdiff_t script_idx = (intptr_t) arg; - Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx); - ASET (xw->script_callbacks, script_idx, Qnil); - if (!NILP (script_callback)) - xfree (xmint_pointer (XCAR (script_callback))); + GError *error = NULL; + struct xwidget *xw = g_object_get_data (G_OBJECT (webview), XG_XWIDGET); - js_result = webkit_web_view_run_javascript_finish - (WEBKIT_WEB_VIEW (webview), result, &error); + ptrdiff_t script_idx = (intptr_t) arg; + Lisp_Object script_callback = AREF (xw->script_callbacks, script_idx); + ASET (xw->script_callbacks, script_idx, Qnil); + if (!NILP (script_callback)) + xfree (xmint_pointer (XCAR (script_callback))); - if (!js_result) - { - g_warning ("Error running javascript: %s", error->message); - g_error_free (error); - return; - } + WebKitJavascriptResult *js_result = + webkit_web_view_run_javascript_finish + (WEBKIT_WEB_VIEW (webview), result, &error); - if (!NILP (script_callback) && !NILP (XCDR (script_callback))) - { - context = webkit_javascript_result_get_global_context (js_result); - value = webkit_javascript_result_get_value (js_result); - Lisp_Object lisp_value = webkit_js_to_lisp (context, value); + if (!js_result) + { + g_warning ("Error running javascript: %s", error->message); + g_error_free (error); + return; + } - /* Register an xwidget event here, which then runs the callback. - This ensures that the callback runs in sync with the Emacs - event loop. */ - store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value); - } + if (!NILP (script_callback) && !NILP (XCDR (script_callback))) + { + JSCValue *value = webkit_javascript_result_get_js_value (js_result); - webkit_javascript_result_unref (js_result); + Lisp_Object lisp_value = webkit_js_to_lisp (value); + + /* Register an xwidget event here, which then runs the callback. + This ensures that the callback runs in sync with the Emacs + event loop. */ + store_xwidget_js_callback_event (xw, XCDR (script_callback), lisp_value); + } + + webkit_javascript_result_unref (js_result); } From 9dc306b1db08196684d05a474148e16305adbad0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 17 Sep 2019 19:18:14 -0700 Subject: [PATCH 094/105] Improve reporting of I/O, access errors Signal an error for file-oriented errors that are not tame errors like ENOENT and ENOTDIR (Bug#37389). Do this for primitives exposed to Lisp; the lower level internal C API merely makes errno values available to higher-level C code. * doc/lispref/files.texi (Testing Accessibility) (File Attributes, Extended Attributes): Do not say that the functions return nil when the return value cannot be determined. * etc/NEWS: Mention the change. * src/dired.c (Ffile_attributes): Fix doc string confusion about opening a file vs getting its attributes. (file_attributes): Signal serious errors. * src/fileio.c (check_existing, check_executable) (check_writable): Remove. All callers changed to use check_file_access or file_access_p. (file_access_p, file_metadata_errno, file_attribute_errno) (file_test_errno, check_file_access, check_emacs_readlinkat): New functions. * src/fileio.c (Ffile_executable_p, Ffile_readable_p) (Ffile_name_case_insensitive_p, Frename_file, Ffile_exists_p): (Ffile_symlink_p, Ffile_directory_p) (Ffile_accessible_directory_p, Ffile_regular_p) (Ffile_selinux_context, Ffile_acl, Ffile_modes) (Ffile_newer_than_file_p, Fset_visited_file_modtime) (Ffile_system_info): * src/filelock.c (unlock_file, Ffile_locked_p): * src/lread.c (Fload): Signal serious errors. * src/fileio.c (Ffile_writable_p): Remove unnecessary CHECK_STRING. (emacs_readlinkat): Now static. * src/filelock.c (current_lock_owner, lock_if_free): Return a positive errno on error, and the negative of the old old value on success. All callers changed. * src/lread.c (openp): Propagate serious errno values to caller. --- doc/lispref/files.texi | 13 +- etc/NEWS | 10 ++ src/dired.c | 9 +- src/emacs.c | 2 +- src/fileio.c | 359 +++++++++++++++++++++++------------------ src/filelock.c | 86 +++++----- src/lisp.h | 5 +- src/lread.c | 21 ++- 8 files changed, 282 insertions(+), 223 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 18a1f4908d6..fba9622fecf 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -856,8 +856,7 @@ systems, this is true if the file exists and you have execute permission on the containing directories, regardless of the permissions of the file itself.) -If the file does not exist, or if access control policies prevent you -from finding its attributes, this function returns @code{nil}. +If the file does not exist, this function returns @code{nil}. Directories are files, so @code{file-exists-p} can return @code{t} when given a directory. However, because @code{file-exists-p} follows @@ -1262,7 +1261,7 @@ on the 19th, @file{aug-20} was written on the 20th, and the file @defun file-attributes filename &optional id-format @anchor{Definition of file-attributes} This function returns a list of attributes of file @var{filename}. If -the specified file's attributes cannot be accessed, it returns @code{nil}. +the specified file does not exist, it returns @code{nil}. This function does not follow symbolic links. The optional parameter @var{id-format} specifies the preferred format of attributes @acronym{UID} and @acronym{GID} (see below)---the @@ -1464,9 +1463,8 @@ The underlying ACL implementation is platform-specific; on GNU/Linux and BSD, Emacs uses the POSIX ACL interface, while on MS-Windows Emacs emulates the POSIX ACL interface with native file security APIs. -If Emacs was not compiled with ACL support, or the file does not exist -or is inaccessible, or Emacs was unable to determine the ACL entries -for any other reason, then the return value is @code{nil}. +If ACLs are not supported or the file does not exist, +then the return value is @code{nil}. @end defun @defun file-selinux-context filename @@ -1478,8 +1476,7 @@ for details about what these actually mean. The return value has the same form as what @code{set-file-selinux-context} takes for its @var{context} argument (@pxref{Changing Files}). -If Emacs was not compiled with SELinux support, or the file does not -exist or is inaccessible, or if the system does not support SELinux, +If SELinux is not supported or the file does not exist, then the return value is @code{(nil nil nil nil)}. @end defun diff --git a/etc/NEWS b/etc/NEWS index 9aec8da5663..dce4903384f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2005,6 +2005,16 @@ file name if there is no user named "foo". ** The FILENAME argument to 'file-name-base' is now mandatory and no longer defaults to 'buffer-file-name'. ++++ +** File metadata primitives now signal an error if I/O, access, or +other serious errors prevent them from determining the result. +Formerly, these functions often (though not always) returned nil. +For example, if the directory /etc/firewalld is not searchable, +(file-symlink-p "/etc/firewalld/firewalld.conf") now signals an error +instead of returning nil, because file-symlink-p cannot determine +whether a symbolic link exists there. These functions still behave as +before if the only problem is that the file does not exist. + --- ** The function 'eldoc-message' now accepts a single argument. Programs that called it with multiple arguments before should pass diff --git a/src/dired.c b/src/dired.c index df03bc32cef..3768b6dbb7c 100644 --- a/src/dired.c +++ b/src/dired.c @@ -819,7 +819,7 @@ stat_gname (struct stat *st) DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0, doc: /* Return a list of attributes of file FILENAME. -Value is nil if specified file cannot be opened. +Value is nil if specified file does not exist. ID-FORMAT specifies the preferred format of attributes uid and gid (see below) - valid values are `string' and `integer'. The latter is the @@ -939,15 +939,14 @@ file_attributes (int fd, char const *name, information to be accurate. */ w32_stat_get_owner_group = 1; #endif - if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0) - err = 0; + err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; #ifdef WINDOWSNT w32_stat_get_owner_group = 0; #endif } if (err != 0) - return unbind_to (count, Qnil); + return unbind_to (count, file_attribute_errno (filename, err)); Lisp_Object file_type; if (S_ISLNK (s.st_mode)) @@ -956,7 +955,7 @@ file_attributes (int fd, char const *name, symlink is replaced between the call to fstatat and the call to emacs_readlinkat. Detect this race unless the replacement is also a symlink. */ - file_type = emacs_readlinkat (fd, name); + file_type = check_emacs_readlinkat (fd, filename, name); if (NILP (file_type)) return unbind_to (count, Qnil); } diff --git a/src/emacs.c b/src/emacs.c index 558dd11a351..eb732810db4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -746,7 +746,7 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) candidate[path_part_length] = DIRECTORY_SEP; memcpy (candidate + path_part_length + 1, argv0, argv0_length + 1); struct stat st; - if (check_executable (candidate) + if (file_access_p (candidate, X_OK) && stat (candidate, &st) == 0 && S_ISREG (st.st_mode)) return candidate; *candidate = '\0'; diff --git a/src/fileio.c b/src/fileio.c index 81c29ca0cca..0977516f019 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -141,54 +141,38 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, struct coding_system *); -/* Return true if FILENAME exists, otherwise return false and set errno. */ - -static bool -check_existing (const char *filename) -{ - return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0; -} - -/* Return true if file FILENAME exists and can be executed. */ +/* Test whether FILE is accessible for AMODE. + Return true if successful, false (setting errno) otherwise. */ bool -check_executable (char *filename) -{ - return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0; -} - -/* Return true if file FILENAME exists and can be accessed - according to AMODE, which should include W_OK. - On failure, return false and set errno. */ - -static bool -check_writable (const char *filename, int amode) +file_access_p (char const *file, int amode) { #ifdef MSDOS - /* FIXME: an faccessat implementation should be added to the - DOS/Windows ports and this #ifdef branch should be removed. */ - struct stat st; - if (stat (filename, &st) < 0) - return 0; - errno = EPERM; - return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode)); -#else /* not MSDOS */ - bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0; -#ifdef CYGWIN - /* faccessat may have returned failure because Cygwin couldn't - determine the file's UID or GID; if so, we return success. */ - if (!res) + if (amode & W_OK) { - int faccessat_errno = errno; + /* FIXME: The MS-DOS faccessat implementation should handle this. */ struct stat st; - if (stat (filename, &st) < 0) - return 0; - res = (st.st_uid == -1 || st.st_gid == -1); - errno = faccessat_errno; + if (stat (file, &st) != 0) + return false; + errno = EPERM; + return st.st_mode & S_IWRITE || S_ISDIR (st.st_mode); } -#endif /* CYGWIN */ - return res; -#endif /* not MSDOS */ +#endif + + if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0) + return true; + +#ifdef CYGWIN + /* Return success if faccessat failed because Cygwin couldn't + determine the file's UID or GID. */ + int err = errno; + struct stat st; + if (stat (file, &st) == 0 && (st.st_uid == -1 || st.st_gid == -1)) + return true; + errno = err; +#endif + + return false; } /* Signal a file-access failure. STRING describes the failure, @@ -251,6 +235,30 @@ report_file_notify_error (const char *string, Lisp_Object name) } #endif +/* ACTION failed for FILE with errno ERR. Signal an error if ERR + means the file's metadata could not be retrieved even though it may + exist, otherwise return nil. */ + +static Lisp_Object +file_metadata_errno (char const *action, Lisp_Object file, int err) +{ + if (err == ENOENT || err == ENOTDIR || err == 0) + return Qnil; + report_file_errno (action, file, err); +} + +Lisp_Object +file_attribute_errno (Lisp_Object file, int err) +{ + return file_metadata_errno ("Getting attributes", file, err); +} + +static Lisp_Object +file_test_errno (Lisp_Object file, int err) +{ + return file_metadata_errno ("Testing file", file, err); +} + void close_file_unwind (int fd) { @@ -2446,8 +2454,12 @@ The arg must be a string. */) while (true) { int err = file_name_case_insensitive_err (filename); - if (! (err == ENOENT || err == ENOTDIR)) - return err < 0 ? Qt : Qnil; + switch (err) + { + case -1: return Qt; + default: return file_test_errno (filename, err); + case ENOENT: case ENOTDIR: break; + } Lisp_Object parent = file_name_directory (filename); /* Avoid infinite loop if the root is reported as non-existing (impossible?). */ @@ -2560,7 +2572,7 @@ This is what happens in interactive use with M-x. */) { Lisp_Object symlink_target = (S_ISLNK (file_st.st_mode) - ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file)) + ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file)) : Qnil); if (!NILP (symlink_target)) Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); @@ -2708,6 +2720,40 @@ file_name_absolute_p (char const *filename) || user_homedir (&filename[1])))); } +/* Return t if FILE exists and is accessible via OPERATION and AMODE, + nil (setting errno) if not. Signal an error if the result cannot + be determined. */ + +static Lisp_Object +check_file_access (Lisp_Object file, Lisp_Object operation, int amode) +{ + file = Fexpand_file_name (file, Qnil); + Lisp_Object handler = Ffind_file_name_handler (file, operation); + if (!NILP (handler)) + { + Lisp_Object ok = call2 (handler, operation, file); + /* This errno value is bogus. Any caller that depends on errno + should be rethought anyway, to avoid a race between testing a + handled file's accessibility and using the file. */ + errno = 0; + return ok; + } + + char *encoded_file = SSDATA (ENCODE_FILE (file)); + bool ok = file_access_p (encoded_file, amode); + if (ok) + return Qt; + int err = errno; + if (err == EROFS || err == ETXTBSY + || (err == EACCES && amode != F_OK + && file_access_p (encoded_file, F_OK))) + { + errno = err; + return Qnil; + } + return file_test_errno (file, err); +} + DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, doc: /* Return t if file FILENAME exists (whether or not you can read it). See also `file-readable-p' and `file-attributes'. @@ -2715,25 +2761,7 @@ This returns nil for a symlink to a nonexistent file. Use `file-symlink-p' to test for such links. */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_exists_p); - if (!NILP (handler)) - { - Lisp_Object result = call2 (handler, Qfile_exists_p, absname); - errno = 0; - return result; - } - - absname = ENCODE_FILE (absname); - - return check_existing (SSDATA (absname)) ? Qt : Qnil; + return check_file_access (filename, Qfile_exists_p, F_OK); } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, @@ -2743,21 +2771,7 @@ For a directory, this means you can access files in that directory. purpose, though.) */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_executable_p); - if (!NILP (handler)) - return call2 (handler, Qfile_executable_p, absname); - - absname = ENCODE_FILE (absname); - - return (check_executable (SSDATA (absname)) ? Qt : Qnil); + return check_file_access (filename, Qfile_executable_p, X_OK); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, @@ -2765,21 +2779,7 @@ DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, See also `file-exists-p' and `file-attributes'. */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - CHECK_STRING (filename); - absname = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qfile_readable_p); - if (!NILP (handler)) - return call2 (handler, Qfile_readable_p, absname); - - absname = ENCODE_FILE (absname); - return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0 - ? Qt : Qnil); + return check_file_access (filename, Qfile_readable_p, R_OK); } DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, @@ -2789,7 +2789,6 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, Lisp_Object absname, dir, encoded; Lisp_Object handler; - CHECK_STRING (filename); absname = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, @@ -2799,7 +2798,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, return call2 (handler, Qfile_writable_p, absname); encoded = ENCODE_FILE (absname); - if (check_writable (SSDATA (encoded), W_OK)) + if (file_access_p (SSDATA (encoded), W_OK)) return Qt; if (errno != ENOENT) return Qnil; @@ -2810,14 +2809,23 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, dir = Fdirectory_file_name (dir); #endif /* MSDOS */ - dir = ENCODE_FILE (dir); + encoded = ENCODE_FILE (dir); #ifdef WINDOWSNT /* The read-only attribute of the parent directory doesn't affect whether a file or directory can be created within it. Some day we should check ACLs though, which do affect this. */ - return file_directory_p (dir) ? Qt : Qnil; + return file_directory_p (encoded) ? Qt : Qnil; #else - return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil; + if (file_access_p (SSDATA (encoded), W_OK | X_OK)) + return Qt; + int err = errno; + if (err == EROFS + || (err == EACCES && file_access_p (SSDATA (encoded), F_OK))) + { + errno = err; + return Qnil; + } + return file_test_errno (absname, err); #endif } @@ -2849,8 +2857,8 @@ If there is no error, returns nil. */) } /* Relative to directory FD, return the symbolic link value of FILENAME. - On failure, return nil. */ -Lisp_Object + On failure, return nil (setting errno). */ +static Lisp_Object emacs_readlinkat (int fd, char const *filename) { static struct allocator const emacs_norealloc_allocator = @@ -2869,6 +2877,27 @@ emacs_readlinkat (int fd, char const *filename) return val; } +/* Relative to directory FD, return the symbolic link value of FILE. + If FILE is not a symbolic link, return nil (setting errno). + Signal an error if the result cannot be determined. */ +Lisp_Object +check_emacs_readlinkat (int fd, Lisp_Object file, char const *encoded_file) +{ + Lisp_Object val = emacs_readlinkat (fd, encoded_file); + if (NILP (val)) + { + if (errno == EINVAL) + return val; +#ifdef CYGWIN + /* Work around Cygwin bugs. */ + if (errno == EIO || errno == EACCES) + return val; +#endif + return file_metadata_errno ("Reading symbolic link", file, errno); + } + return val; +} + DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, doc: /* Return non-nil if file FILENAME is the name of a symbolic link. The value is the link target, as a string. @@ -2888,9 +2917,8 @@ This function does not check whether the link target exists. */) if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); - filename = ENCODE_FILE (filename); - - return emacs_readlinkat (AT_FDCWD, SSDATA (filename)); + return check_emacs_readlinkat (AT_FDCWD, filename, + SSDATA (ENCODE_FILE (filename))); } DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, @@ -2907,9 +2935,9 @@ See `file-symlink-p' to distinguish symlinks. */) if (!NILP (handler)) return call2 (handler, Qfile_directory_p, absname); - absname = ENCODE_FILE (absname); - - return file_directory_p (absname) ? Qt : Qnil; + if (file_directory_p (absname)) + return Qt; + return file_test_errno (absname, errno); } /* Return true if FILE is a directory or a symlink to a directory. @@ -2934,7 +2962,7 @@ file_directory_p (Lisp_Object file) /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. Fall back on generic POSIX code. */ # endif - /* Use file_accessible_directory, as it avoids stat EOVERFLOW + /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW problems and could be cheaper. However, if it fails because FILE is inaccessible, fall back on stat; if the latter fails with EOVERFLOW then FILE must have been a directory unless a race @@ -2990,8 +3018,13 @@ really is a readable and searchable directory. */) return r; } - absname = ENCODE_FILE (absname); - return file_accessible_directory_p (absname) ? Qt : Qnil; + Lisp_Object encoded_absname = ENCODE_FILE (absname); + if (file_accessible_directory_p (encoded_absname)) + return Qt; + int err = errno; + if (err == EACCES && file_access_p (SSDATA (encoded_absname), F_OK)) + return Qnil; + return file_test_errno (absname, err); } /* If FILE is a searchable directory or a symlink to a @@ -3043,7 +3076,7 @@ file_accessible_directory_p (Lisp_Object file) dir = buf; } - ok = check_existing (dir); + ok = file_access_p (dir, F_OK); saved_errno = errno; SAFE_FREE (); errno = saved_errno; @@ -3067,27 +3100,21 @@ See `file-symlink-p' to distinguish symlinks. */) if (!NILP (handler)) return call2 (handler, Qfile_regular_p, absname); - absname = ENCODE_FILE (absname); +#ifdef WINDOWSNT + /* Tell stat to use expensive method to get accurate info. */ + Lisp_Object true_attributes = Vw32_get_true_file_attributes; + Vw32_get_true_file_attributes = Qt; +#endif + + int stat_result = stat (SSDATA (absname), &st); #ifdef WINDOWSNT - { - int result; - Lisp_Object tem = Vw32_get_true_file_attributes; - - /* Tell stat to use expensive method to get accurate info. */ - Vw32_get_true_file_attributes = Qt; - result = stat (SSDATA (absname), &st); - Vw32_get_true_file_attributes = tem; - - if (result < 0) - return Qnil; - return S_ISREG (st.st_mode) ? Qt : Qnil; - } -#else - if (stat (SSDATA (absname), &st) < 0) - return Qnil; - return S_ISREG (st.st_mode) ? Qt : Qnil; + Vw32_get_true_file_attributes = true_attributes; #endif + + if (stat_result == 0) + return S_ISREG (st.st_mode) ? Qt : Qnil; + return file_test_errno (absname, errno); } DEFUN ("file-selinux-context", Ffile_selinux_context, @@ -3097,7 +3124,7 @@ The return value is a list (USER ROLE TYPE RANGE), where the list elements are strings naming the user, role, type, and range of the file's SELinux security context. -Return (nil nil nil nil) if the file is nonexistent or inaccessible, +Return (nil nil nil nil) if the file is nonexistent, or if SELinux is disabled, or if Emacs lacks SELinux support. */) (Lisp_Object filename) { @@ -3111,13 +3138,11 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) if (!NILP (handler)) return call2 (handler, Qfile_selinux_context, absname); - absname = ENCODE_FILE (absname); - #if HAVE_LIBSELINUX if (is_selinux_enabled ()) { security_context_t con; - int conlength = lgetfilecon (SSDATA (absname), &con); + int conlength = lgetfilecon (SSDATA (ENCODE_FILE (absname)), &con); if (conlength > 0) { context_t context = context_new (con); @@ -3132,6 +3157,9 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) context_free (context); freecon (con); } + else if (! (errno == ENOENT || errno == ENOTDIR || errno == ENODATA + || errno == ENOTSUP)) + report_file_error ("getting SELinux context", absname); } #endif @@ -3227,8 +3255,7 @@ DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0, doc: /* Return ACL entries of file named FILENAME. The entries are returned in a format suitable for use in `set-file-acl' but is otherwise undocumented and subject to change. -Return nil if file does not exist or is not accessible, or if Emacs -was unable to determine the ACL entries. */) +Return nil if file does not exist. */) (Lisp_Object filename) { Lisp_Object acl_string = Qnil; @@ -3243,20 +3270,22 @@ was unable to determine the ACL entries. */) return call2 (handler, Qfile_acl, absname); # ifdef HAVE_ACL_SET_FILE - absname = ENCODE_FILE (absname); - # ifndef HAVE_ACL_TYPE_EXTENDED acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS; # endif - acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED); + acl_t acl = acl_get_file (SSDATA (ENCODE_FILE (absname)), ACL_TYPE_EXTENDED); if (acl == NULL) - return Qnil; - + { + if (errno == ENOENT || errno == ENOTDIR || errno == ENOTSUP) + return Qnil; + report_file_error ("Getting ACLs", absname); + } char *str = acl_to_text (acl, NULL); if (str == NULL) { + int err = errno; acl_free (acl); - return Qnil; + report_file_errno ("Getting ACLs", absname, err); } acl_string = build_string (str); @@ -3327,7 +3356,7 @@ support. */) DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, doc: /* Return mode bits of file named FILENAME, as an integer. -Return nil, if file does not exist or is not accessible. */) +Return nil if FILENAME does not exist. */) (Lisp_Object filename) { struct stat st; @@ -3339,11 +3368,8 @@ Return nil, if file does not exist or is not accessible. */) if (!NILP (handler)) return call2 (handler, Qfile_modes, absname); - absname = ENCODE_FILE (absname); - - if (stat (SSDATA (absname), &st) < 0) - return Qnil; - + if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0) + return file_attribute_errno (absname, errno); return make_fixnum (st.st_mode & 07777); } @@ -3487,14 +3513,27 @@ otherwise, if FILE2 does not exist, the answer is t. */) if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); - absname1 = ENCODE_FILE (absname1); - absname2 = ENCODE_FILE (absname2); + int err1; + if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0) + err1 = 0; + else + { + err1 = errno; + if (err1 != EOVERFLOW) + return file_test_errno (absname1, err1); + } - if (stat (SSDATA (absname1), &st1) < 0) - return Qnil; + if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0) + { + file_test_errno (absname2, errno); + return Qt; + } - if (stat (SSDATA (absname2), &st2) < 0) - return Qt; + if (err1) + { + file_test_errno (absname1, err1); + eassume (false); + } return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0 ? Qt : Qnil); @@ -5686,13 +5725,13 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); - filename = ENCODE_FILE (filename); - - if (stat (SSDATA (filename), &st) >= 0) + if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0) { current_buffer->modtime = get_stat_mtime (&st); current_buffer->modtime_size = st.st_size; } + else + file_attribute_errno (filename, errno); } return Qnil; @@ -6103,22 +6142,22 @@ storage available to a non-superuser. All 3 numbers are in bytes. If the underlying system call fails, value is nil. */) (Lisp_Object filename) { - Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil)); + filename = Fexpand_file_name (filename, Qnil); /* If the file name has special constructs in it, call the corresponding file name handler. */ - Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); + Lisp_Object handler = Ffind_file_name_handler (filename, Qfile_system_info); if (!NILP (handler)) { - Lisp_Object result = call2 (handler, Qfile_system_info, encoded); + Lisp_Object result = call2 (handler, Qfile_system_info, filename); if (CONSP (result) || NILP (result)) return result; error ("Invalid handler in `file-name-handler-alist'"); } struct fs_usage u; - if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0) - return Qnil; + if (get_fs_usage (SSDATA (ENCODE_FILE (filename)), NULL, &u) != 0) + return errno == ENOSYS ? Qnil : file_attribute_errno (filename, errno); return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false), blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false), blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail, diff --git a/src/filelock.c b/src/filelock.c index 46349a63e4a..ff25d6475de 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -504,9 +504,9 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) } /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, - 1 if another process owns it (and set OWNER (if non-null) to info), - 2 if the current process owns it, - or -1 if something is wrong with the locking mechanism. */ + -1 if another process owns it (and set OWNER (if non-null) to info), + -2 if the current process owns it, + or an errno value if something is wrong with the locking mechanism. */ static int current_lock_owner (lock_info_type *owner, char *lfname) @@ -525,23 +525,23 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* If nonexistent lock file, all is well; otherwise, got strange error. */ lfinfolen = read_lock_data (lfname, owner->user); if (lfinfolen < 0) - return errno == ENOENT ? 0 : -1; + return errno == ENOENT ? 0 : errno; if (MAX_LFINFO < lfinfolen) - return -1; + return ENAMETOOLONG; owner->user[lfinfolen] = 0; - /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return -1. */ + /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */ /* The USER is everything before the last @. */ owner->at = at = memrchr (owner->user, '@', lfinfolen); if (!at) - return -1; + return EINVAL; owner->dot = dot = strrchr (at, '.'); if (!dot) - return -1; + return EINVAL; /* The PID is everything from the last '.' to the ':' or equivalent. */ if (! c_isdigit (dot[1])) - return -1; + return EINVAL; errno = 0; pid = strtoimax (dot + 1, &owner->colon, 10); if (errno == ERANGE) @@ -562,20 +562,20 @@ current_lock_owner (lock_info_type *owner, char *lfname) mistakenly transliterate ':' to U+F022 in symlink contents. See . */ if (! (boot[0] == '\200' && boot[1] == '\242')) - return -1; + return EINVAL; boot += 2; FALLTHROUGH; case ':': if (! c_isdigit (boot[0])) - return -1; + return EINVAL; boot_time = strtoimax (boot, &lfinfo_end, 10); break; default: - return -1; + return EINVAL; } if (lfinfo_end != owner->user + lfinfolen) - return -1; + return EINVAL; /* On current host? */ Lisp_Object system_name = Fsystem_name (); @@ -584,22 +584,22 @@ current_lock_owner (lock_info_type *owner, char *lfname) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) { if (pid == getpid ()) - ret = 2; /* We own it. */ + ret = -2; /* We own it. */ else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t) && (kill (pid, 0) >= 0 || errno == EPERM) && (boot_time == 0 || (boot_time <= TYPE_MAXIMUM (time_t) && within_one_second (boot_time, get_boot_time ())))) - ret = 1; /* An existing process on this machine owns it. */ + ret = -1; /* An existing process on this machine owns it. */ /* The owner process is dead or has a strange pid, so try to zap the lockfile. */ else - return unlink (lfname); + return unlink (lfname) < 0 ? errno : 0; } else { /* If we wanted to support the check for stale locks on remote machines, here's where we'd do it. */ - ret = 1; + ret = -1; } return ret; @@ -608,9 +608,9 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* Lock the lock named LFNAME if possible. Return 0 in that case. - Return positive if some other process owns the lock, and info about + Return negative if some other process owns the lock, and info about that process in CLASHER. - Return -1 if cannot lock for any other reason. */ + Return positive errno value if cannot lock for any other reason. */ static int lock_if_free (lock_info_type *clasher, char *lfname) @@ -618,20 +618,18 @@ lock_if_free (lock_info_type *clasher, char *lfname) int err; while ((err = lock_file_1 (lfname, 0)) == EEXIST) { - switch (current_lock_owner (clasher, lfname)) + err = current_lock_owner (clasher, lfname); + if (err != 0) { - case 2: - return 0; /* We ourselves locked it. */ - case 1: - return 1; /* Someone else has it. */ - case -1: - return -1; /* current_lock_owner returned strange error. */ + if (err < 0) + return -2 - err; /* We locked it, or someone else has it. */ + break; /* current_lock_owner returned strange error. */ } /* We deleted a stale lock; try again to lock the file. */ } - return err ? -1 : 0; + return err; } /* lock_file locks file FN, @@ -697,8 +695,9 @@ lock_file (Lisp_Object fn) /* Create the name of the lock-file for file fn */ MAKE_LOCK_NAME (lfname, encoded_fn); - /* Try to lock the lock. */ - if (0 < lock_if_free (&lock_info, lfname)) + /* Try to lock the lock. FIXME: This ignores errors when + lock_if_free returns a positive errno value. */ + if (lock_if_free (&lock_info, lfname) < 0) { /* Someone else has the lock. Consider breaking it. */ Lisp_Object attack; @@ -725,13 +724,16 @@ unlock_file (Lisp_Object fn) char *lfname; USE_SAFE_ALLOCA; - fn = Fexpand_file_name (fn, Qnil); - fn = ENCODE_FILE (fn); + Lisp_Object filename = Fexpand_file_name (fn, Qnil); + fn = ENCODE_FILE (filename); MAKE_LOCK_NAME (lfname, fn); - if (current_lock_owner (0, lfname) == 2) - unlink (lfname); + int err = current_lock_owner (0, lfname); + if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) + err = errno; + if (0 < err) + report_file_errno ("Unlocking file", filename, err); SAFE_FREE (); } @@ -822,17 +824,17 @@ t if it is locked by you, else a string saying which user has locked it. */) USE_SAFE_ALLOCA; filename = Fexpand_file_name (filename, Qnil); - filename = ENCODE_FILE (filename); - - MAKE_LOCK_NAME (lfname, filename); + Lisp_Object encoded_filename = ENCODE_FILE (filename); + MAKE_LOCK_NAME (lfname, encoded_filename); owner = current_lock_owner (&locker, lfname); - if (owner <= 0) - ret = Qnil; - else if (owner == 2) - ret = Qt; - else - ret = make_string (locker.user, locker.at - locker.user); + switch (owner) + { + case -2: ret = Qt; break; + case -1: ret = make_string (locker.user, locker.at - locker.user); break; + case 0: ret = Qnil; break; + default: report_file_errno ("Testing file lock", filename, owner); + } SAFE_FREE (); return ret; diff --git a/src/lisp.h b/src/lisp.h index 02f8a7b6686..e68d2732e21 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4299,7 +4299,6 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern bool check_executable (char *); extern char *splice_dir_file (char *, char const *, char const *); extern bool file_name_absolute_p (const char *); extern char const *get_homedir (void); @@ -4310,12 +4309,14 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, extern void close_file_unwind (int); extern void fclose_unwind (void *); extern void restore_point_unwind (Lisp_Object); +extern bool file_access_p (char const *, int); extern Lisp_Object get_file_errno_data (const char *, Lisp_Object, int); extern AVOID report_file_errno (const char *, Lisp_Object, int); extern AVOID report_file_error (const char *, Lisp_Object); extern AVOID report_file_notify_error (const char *, Lisp_Object); +extern Lisp_Object file_attribute_errno (Lisp_Object, int); extern bool internal_delete_file (Lisp_Object); -extern Lisp_Object emacs_readlinkat (int, const char *); +extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *); extern bool file_directory_p (Lisp_Object); extern bool file_accessible_directory_p (Lisp_Object); extern void init_fileio (void); diff --git a/src/lread.c b/src/lread.c index 6ae7a0d8ba0..d8883db46c1 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1346,15 +1346,22 @@ Return t if the file exists and loads successfully. */) if (!load_prefer_newer && is_elc) { result = stat (SSDATA (efound), &s1); + int err = errno; if (result == 0) { SSET (efound, SBYTES (efound) - 1, 0); result = stat (SSDATA (efound), &s2); + err = errno; SSET (efound, SBYTES (efound) - 1, 'c'); + if (result != 0) + found = Fsubstring (found, make_fixnum (0), + make_fixnum (-1)); } - - if (result == 0 - && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) + if (result != 0) + file_attribute_errno (found, err); + else if (timespec_cmp (get_stat_mtime (&s1), + get_stat_mtime (&s2)) + < 0) { /* Make the progress messages mention that source is newer. */ newer = 1; @@ -1748,16 +1755,20 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { if (file_directory_p (encoded_fn)) last_errno = EISDIR; - else + else if (errno == ENOENT || errno == ENOTDIR) fd = 1; + else + last_errno = errno; } + else if (! (errno == ENOENT || errno == ENOTDIR)) + last_errno = errno; } else { fd = emacs_open (pfn, O_RDONLY, 0); if (fd < 0) { - if (errno != ENOENT) + if (! (errno == ENOENT || errno == ENOTDIR)) last_errno = errno; } else From 94ca934a5c4ef4908fdb7bcd78950bacf9c4ce88 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 18 Sep 2019 03:06:10 -0700 Subject: [PATCH 095/105] Fix permission-denied issue in MS-Windows startup * src/callproc.c (init_callproc): Use file_access_p rather than Ffile_exists_p during startup (Bug#37445). --- src/callproc.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/callproc.c b/src/callproc.c index 1ac0bdc710a..dbbf15c792a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1560,20 +1560,19 @@ init_callproc (void) source directory. */ if (data_dir == 0) { - Lisp_Object tem, tem1, srcdir; + Lisp_Object tem, srcdir; Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)); srcdir = Fexpand_file_name (build_string ("../src/"), lispdir); tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory); - tem1 = Ffile_exists_p (tem); - if (!NILP (Fequal (srcdir, Vinvocation_directory)) || NILP (tem1)) + if (!NILP (Fequal (srcdir, Vinvocation_directory)) + || !file_access_p (SSDATA (tem), F_OK)) { Lisp_Object newdir; newdir = Fexpand_file_name (build_string ("../etc/"), lispdir); tem = Fexpand_file_name (build_string ("NEWS"), newdir); - tem1 = Ffile_exists_p (tem); - if (!NILP (tem1)) + if (file_access_p (SSDATA (tem), F_OK)) Vdata_directory = newdir; } } From 735940f4551a43f3b4381105dc074cd7d494f2f3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 18 Sep 2019 04:21:19 -0700 Subject: [PATCH 096/105] Be less picky about EACCES in file test predicates Problem reported by Tino Calancha (Bug#37445) and others. * src/fileio.c (PICKY_EACCES): New constant, false by default. (file_test_errno): Ignore EACCES if not picky. (check_file_access): Investigate EACCES problems further if picky. --- src/fileio.c | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index 0977516f019..58bc6b7ee8c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -253,9 +253,23 @@ file_attribute_errno (Lisp_Object file, int err) return file_metadata_errno ("Getting attributes", file, err); } +/* In theory, EACCES errors for predicates like file-readable-p should + be checked further because they may be problems with an ancestor + directory instead of with the file itself, which means that we + don't have reliable info about the requested file. In practice, + though, such errors are common enough that signaling them can be + annoying even if the errors are real (e.g., Bug#37445). So return + nil for EACCES unless compiling with -DPICKY_EACCES, which is off + by default. */ +#ifndef PICKY_EACCES +enum { PICKY_EACCES = false }; +#endif + static Lisp_Object file_test_errno (Lisp_Object file, int err) { + if (!PICKY_EACCES && err == EACCES) + return Qnil; return file_metadata_errno ("Testing file", file, err); } @@ -2745,7 +2759,7 @@ check_file_access (Lisp_Object file, Lisp_Object operation, int amode) return Qt; int err = errno; if (err == EROFS || err == ETXTBSY - || (err == EACCES && amode != F_OK + || (PICKY_EACCES && err == EACCES && amode != F_OK && file_access_p (encoded_file, F_OK))) { errno = err; From 5ec42d5cb5219a73b5f4e9e17624bd01a138aea4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 18 Sep 2019 14:11:55 +0200 Subject: [PATCH 097/105] Add extra args for zsh in Tramp * doc/misc/tramp.texi (Remote shell setup): New subsection "Changing the default remote shell". * lisp/net/tramp-sh.el (tramp-sh-extra-args): Add entry for zsh. --- doc/misc/tramp.texi | 29 +++++++++++++++++++++++++++++ lisp/net/tramp-sh.el | 4 +++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e6a454be4c8..1ed334b6bde 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1591,6 +1591,7 @@ via the @command{CONNECT} command (conforming to RFC 2616, 2817 specifications). Proxy servers using HTTP 1.1 or later protocol support this command. + @subsection Tunneling with ssh With ssh, you could use the @code{ProxyCommand} entry in @@ -1609,6 +1610,7 @@ Any other program with such a feature could be used as well. In the example, opening @file{@trampfn{ssh,host.your.domain,}} passes the HTTP proxy server @samp{proxy.your.domain} on port 3128. + @subsection Tunneling with PuTTY PuTTY does not need an external program, HTTP tunnel support is @@ -2092,6 +2094,33 @@ be recomputed. To force @value{tramp} to recompute afresh, call @node Remote shell setup @section Remote shell setup hints + + +@subsection Changing the default remote shell +@cindex zsh setup + +Per default, @value{tramp} uses the command @command{/bin/sh} for +strting a shell on the remote host. This can be changed by setting +the connection property @option{remote-shell}, see @xref{Predefined +connection information}. Other properties might be adapted as well, +like @option{remote-shell-login} or @option{remote-shell-args}. If +you want, for example, use @command{/usr/bin/zsh} on a remote host, +you might apply + +@lisp +@group +(add-to-list 'tramp-connection-properties + (list (regexp-quote "@trampfn{ssh,user@@host,}") + "remote-shell" "/usr/bin/zsh")) +@end group +@end lisp + +This approach has also the advantage, that settings in +@code{tramp-sh-extra-args} will be applied. For zsh, the trouble +with the shell prompt due to set zle options will be avoided. + + +@subsection Other remote shell setup hints @cindex remote shell setup @cindex @file{.profile} file @cindex @file{.login} file diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4bc37f01694..8092f6a5cf1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -525,7 +525,9 @@ based on the Tramp and Emacs versions, and should not be set here." :type '(repeat string)) ;;;###tramp-autoload -(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile")) +(defcustom tramp-sh-extra-args + '(("/bash\\'" . "-norc -noprofile") + ("/zsh\\'" . "-f +Z")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the From ffcec7cd4be83d03c21e7378efc55911b33696b1 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 18 Sep 2019 14:12:54 +0200 Subject: [PATCH 098/105] Simplify tramp-tests.el check for owncloud/nextcloud * test/lisp/net/tramp-tests.el (tramp-test11-copy-file): Simplify check for owncloud/nextcloud connections. --- test/lisp/net/tramp-tests.el | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1554d3b70b1..d7e0a045106 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2412,9 +2412,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (and (tramp--test-nextcloud-p) - (or (not (file-remote-p source)) - (not (file-remote-p target)))) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2437,8 +2435,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless - (and (tramp--test-nextcloud-p) (not (file-remote-p source))) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) From 7ff2eef926f933c79c3913c18f9403a4a987756b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 18 Sep 2019 15:14:15 +0300 Subject: [PATCH 099/105] Fix the MS-Windows build broken by recent errno changes * src/fileio.c (file_directory_p): If the file exists, but is not a directory, set errno to ENOTDIR, like the Posix branch does; openp expects that. --- src/fileio.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/fileio.c b/src/fileio.c index 58bc6b7ee8c..53eecc31aaf 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2961,7 +2961,10 @@ file_directory_p (Lisp_Object file) { #ifdef DOS_NT /* This is cheaper than 'stat'. */ - return faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0; + bool retval = faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0; + if (!retval && errno == EACCES) + errno = ENOTDIR; /* like the non-DOS_NT branch below does */ + return retval; #else # ifdef O_PATH /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */ From 9597ee68d999d43145d47ff53e1474f1493f8727 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 18 Sep 2019 05:17:03 -0700 Subject: [PATCH 100/105] Out-of-datedness .elc check is merely a file test * src/fileio.c (file_test_errno): Now extern. * src/lread.c (Fload): Use file_test_errno instead, since this is really just a file test (the attributes are not given to the user). --- etc/NEWS | 2 +- src/fileio.c | 2 +- src/lisp.h | 1 + src/lread.c | 2 +- 4 files changed, 4 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index dce4903384f..f8322104d42 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2009,7 +2009,7 @@ longer defaults to 'buffer-file-name'. ** File metadata primitives now signal an error if I/O, access, or other serious errors prevent them from determining the result. Formerly, these functions often (though not always) returned nil. -For example, if the directory /etc/firewalld is not searchable, +For example, if searching /etc/firewalld results in an I/O error, (file-symlink-p "/etc/firewalld/firewalld.conf") now signals an error instead of returning nil, because file-symlink-p cannot determine whether a symbolic link exists there. These functions still behave as diff --git a/src/fileio.c b/src/fileio.c index 53eecc31aaf..5337ea5c800 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -265,7 +265,7 @@ file_attribute_errno (Lisp_Object file, int err) enum { PICKY_EACCES = false }; #endif -static Lisp_Object +Lisp_Object file_test_errno (Lisp_Object file, int err) { if (!PICKY_EACCES && err == EACCES) diff --git a/src/lisp.h b/src/lisp.h index e68d2732e21..b081ae1cee8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4315,6 +4315,7 @@ extern AVOID report_file_errno (const char *, Lisp_Object, int); extern AVOID report_file_error (const char *, Lisp_Object); extern AVOID report_file_notify_error (const char *, Lisp_Object); extern Lisp_Object file_attribute_errno (Lisp_Object, int); +extern Lisp_Object file_test_errno (Lisp_Object, int); extern bool internal_delete_file (Lisp_Object); extern Lisp_Object check_emacs_readlinkat (int, Lisp_Object, char const *); extern bool file_directory_p (Lisp_Object); diff --git a/src/lread.c b/src/lread.c index d8883db46c1..ab0fab47a98 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1358,7 +1358,7 @@ Return t if the file exists and loads successfully. */) make_fixnum (-1)); } if (result != 0) - file_attribute_errno (found, err); + file_test_errno (found, err); else if (timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) From a39652b49d93cf1556c0b10378e04bf0634c1ee1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 18 Sep 2019 15:55:08 +0300 Subject: [PATCH 101/105] Improve support of the Tai-Viet script * lisp/language/tai-viet.el ("TaiViet"): Update the doc string. Suggested by Jim Brase . (Bug#5806) * etc/HELLO: Add a Tai Viet entry. --- etc/HELLO | 4 +++- lisp/language/tai-viet.el | 23 +++++++++++------------ 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/etc/HELLO b/etc/HELLO index 39c39651b4b..5102c595785 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -79,7 +79,9 @@ Spanish (espalatin-iso8859-1ñol) ¡Hola! Swedish (svenska) Hej / Goddag / Hallå mule-unicode-0100-24ffTamil (தமிழ்) வணக்கம் Telugu (తెలుగు) నమస్కారం -thai-tis620Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ +TaiViet (ꪁꪫꪱꪣ ꪼꪕ) ꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ + +thai-tis620Thai (ภาษาไทย) สวัสดีครับ / สวัสดีค่ะ tibetanTibetan (བོད་སྐད་) བཀྲ་ཤིས་བདེ་ལེགས༎ mule-unicode-0100-24ffTigrigna (ትግርኛ) ሰላማት latin-iso8859-9Turkish (Türkçe) Merhaba diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index b202abf029c..086483da813 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -39,21 +39,20 @@ (input-method . "tai-sonla") (sample-text . "TaiViet (ꪁꪫꪱꪣ ꪼꪕ)\t\tꪅꪰꪙꫂ ꪨꪮꫂ ꪁꪫꪱ / ꪅꪽ ꪨꪷ ꪁꪫꪱ") (documentation . "\ -TaiViet refers to the Tai language used by Tai people in -Vietnam, and also refers to the script used for this language. -Both the script and language have the same origin as that of Thai +TaiViet refers to the Tai script, which is used to write several +Tai languages of northwestern Vietnam and surrounding areas. These +languages are Tai Dam (also known as Black Tai or Tai Noir), +Tai Dón (also known as White Tai or Tai Blanc), Tày Tac, +Tai Daeng (also known as Red Tai or Tai Rouge), +and Thai Song (also known as Lao Song). However, some people +consider Tai Dam, Tai Dón and Tai Daeng to be dialects of the +same language, and call them collectively \"Tai Viet\". + +Both the script and languages have the same origin as that of Thai language/script used in Thailand, but now they differ from each other in a significant way (especially the scripts are). The language name is spelled as \"ꪁꪫꪱꪣ ꪼꪕ\", and the script name is -spelled as \"ꪎ ꪼꪕ\" in the modern form, \"ꪎꪳ ꪼꪕ\" in the traditional -form. - -As the proposal for TaiViet script to the Unicode is still on -the progress, we use the Private Use Area for TaiViet -characters (U+F000..U+F07E). A TaiViet font encoded accordingly -is available at this web page: - http://www.m17n.org/viettai/ -"))) +spelled as \"ꪎꪳ ꪼꪕ\"."))) (provide 'tai-viet) From 37a4233a366797360c2f4f475591a3406586bcfb Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 18 Sep 2019 15:21:25 +0200 Subject: [PATCH 102/105] Fix up the previous mh-mime warning suppression * lisp/mh-e/mh-acros.el (mh-dlet*): Suppress warnings about prefix-less bindings. * lisp/mh-e/mh-mime.el (mh-insert-mime-security-button): Remove the warning removal here. (mh-insert-mime-button): And here. --- lisp/mh-e/mh-acros.el | 14 ++++-- lisp/mh-e/mh-mime.el | 112 +++++++++++++++++++++--------------------- 2 files changed, 65 insertions(+), 61 deletions(-) diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index c017419df2e..0f15d3eb71b 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -270,10 +270,16 @@ MH-E functions." (declare (debug let) (indent 1)) ;; Works in both lexical and non-lexical mode. `(progn - ,@(mapcar (lambda (binder) - `(defvar ,(if (consp binder) (car binder) binder))) - binders) - (let* ,binders ,@body))) + (with-suppressed-warnings ((lexical + ,@(mapcar (lambda (binder) + (if (consp binder) + (car binder) + binder)) + binders))) + ,@(mapcar (lambda (binder) + `(defvar ,(if (consp binder) (car binder) binder))) + binders) + (let* ,binders ,@body)))) (provide 'mh-acros) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index c6b5aaec347..d74e79f1cb0 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -859,24 +859,23 @@ by commands like \"K v\" which operate on individual MIME parts." (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) ;; These vars are passed by dynamic-scoping to ;; mh-mime-button-line-format-alist via gnus-eval-format. - (with-suppressed-warnings ((lexical index description dots)) - (mh-dlet* ((index index) - (description (mail-decode-encoded-word-string - (or (mm-handle-description handle) ""))) - (dots (if (or displayed (mm-handle-displayed-p handle)) - " " "...")) - (long-type (concat type (and (not (equal name "")) - (concat "; " name))))) - (unless (equal description "") - (setq long-type (concat " --- " long-type))) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-button-line-format mh-mime-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-button-map) - mh-callback mh-mm-display-part - mh-part ,index - mh-data ,handle)))) + (mh-dlet* ((index index) + (description (mail-decode-encoded-word-string + (or (mm-handle-description handle) ""))) + (dots (if (or displayed (mm-handle-displayed-p handle)) + " " "...")) + (long-type (concat type (and (not (equal name "")) + (concat "; " name))))) + (unless (equal description "") + (setq long-type (concat " --- " long-type))) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-button-line-format mh-mime-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-button-map) + mh-callback mh-mm-display-part + mh-part ,index + mh-data ,handle))) (setq end (point)) (widget-convert-button 'link begin end @@ -901,45 +900,44 @@ by commands like \"K v\" which operate on individual MIME parts." begin end face) ;; These vars are passed by dynamic-scoping to ;; mh-mime-security-button-line-format-alist via gnus-eval-format. - (with-suppressed-warnings ((lexical type info details)) - (mh-dlet* ((type (concat crypto-type - (if (equal (car handle) "multipart/signed") - " Signed" " Encrypted") - " Part")) - (info (or (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-info) - "Undecided")) - (details (mh-mm-handle-multipart-ctl-parameter - handle 'gnus-details)) - pressed-details) - (setq details (if details (concat "\n" details) "")) - (setq pressed-details (if mh-mime-security-button-pressed details "")) - (setq face (mh-mime-security-button-face info)) - (unless (bolp) (insert "\n")) - (setq begin (point)) - (gnus-eval-format - mh-mime-security-button-line-format - mh-mime-security-button-line-format-alist - `(,@(mh-gnus-local-map-property mh-mime-security-button-map) - mh-button-pressed ,mh-mime-security-button-pressed - mh-callback mh-mime-security-press-button - mh-line-format ,mh-mime-security-button-line-format - mh-data ,handle)) - (setq end (point)) - (widget-convert-button 'link begin end - :mime-handle handle - :action 'mh-widget-press-button - :button-keymap mh-mime-security-button-map - :button-face face - :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") - (dolist (ov (mh-funcall-if-exists overlays-in begin end)) - (mh-funcall-if-exists overlay-put ov 'evaporate t)) - (when (equal info "Failed") - (let* ((type (if (equal (car handle) "multipart/signed") - "verification" "decryption")) - (warning (if (equal type "decryption") - "(passphrase may be incorrect)" ""))) - (message "%s %s failed %s" crypto-type type warning))))))) + (mh-dlet* ((type (concat crypto-type + (if (equal (car handle) "multipart/signed") + " Signed" " Encrypted") + " Part")) + (info (or (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-info) + "Undecided")) + (details (mh-mm-handle-multipart-ctl-parameter + handle 'gnus-details)) + pressed-details) + (setq details (if details (concat "\n" details) "")) + (setq pressed-details (if mh-mime-security-button-pressed details "")) + (setq face (mh-mime-security-button-face info)) + (unless (bolp) (insert "\n")) + (setq begin (point)) + (gnus-eval-format + mh-mime-security-button-line-format + mh-mime-security-button-line-format-alist + `(,@(mh-gnus-local-map-property mh-mime-security-button-map) + mh-button-pressed ,mh-mime-security-button-pressed + mh-callback mh-mime-security-press-button + mh-line-format ,mh-mime-security-button-line-format + mh-data ,handle)) + (setq end (point)) + (widget-convert-button 'link begin end + :mime-handle handle + :action 'mh-widget-press-button + :button-keymap mh-mime-security-button-map + :button-face face + :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") + (dolist (ov (mh-funcall-if-exists overlays-in begin end)) + (mh-funcall-if-exists overlay-put ov 'evaporate t)) + (when (equal info "Failed") + (let* ((type (if (equal (car handle) "multipart/signed") + "verification" "decryption")) + (warning (if (equal type "decryption") + "(passphrase may be incorrect)" ""))) + (message "%s %s failed %s" crypto-type type warning)))))) (defun mh-mime-security-button-face (info) "Return the button face to use for encrypted/signed mail based on INFO." From 61c2183a440c94ab797696d0f0c76a7dc4007eeb Mon Sep 17 00:00:00 2001 From: Phillip Lord Date: Tue, 4 Jun 2019 15:02:33 +0100 Subject: [PATCH 103/105] Improve logic for dependencies checking * admin/nt/dist-build/build-dep-zips.py: --- admin/nt/dist-build/build-dep-zips.py | 103 +++++++++++++++++++------- 1 file changed, 75 insertions(+), 28 deletions(-) diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py index f0e96f43c8c..5698f5179c8 100755 --- a/admin/nt/dist-build/build-dep-zips.py +++ b/admin/nt/dist-build/build-dep-zips.py @@ -28,13 +28,33 @@ ## Constants EMACS_MAJOR_VERSION="27" +# This list derives from the features we want Emacs to compile with. +PKG_REQ='''mingw-w64-x86_64-giflib +mingw-w64-x86_64-gnutls +mingw-w64-x86_64-lcms2 +mingw-w64-x86_64-libjpeg-turbo +mingw-w64-x86_64-libpng +mingw-w64-x86_64-librsvg +mingw-w64-x86_64-libtiff +mingw-w64-x86_64-libxml2 +mingw-w64-x86_64-xpm-nox'''.split() + ## Options DRY_RUN=False ## Packages to fiddle with -SKIP_PKGS=["mingw-w64-gcc-libs"] -MUNGE_PKGS ={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"} +## Source for gcc-libs is part of gcc +SKIP_SRC_PKGS=["mingw-w64-gcc-libs"] +SKIP_DEP_PKGS=["mingw-w64-x86_64-glib2"] +MUNGE_SRC_PKGS={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"} +MUNGE_DEP_PKGS={ + "mingw-w64-i686-libwinpthread":"mingw-w64-i686-libwinpthread-git", + "mingw-w64-x86_64-libwinpthread":"mingw-w64-x86_64-libwinpthread-git", + + "mingw-w64-x86_64-libtre": "mingw-w64-x86_64-libtre-git", + "mingw-w64-i686-libtre": "mingw-w64-i686-libtre-git" +} ## Currently no packages seem to require this! ARCH_PKGS=[] @@ -47,28 +67,40 @@ def check_output_maybe(*args,**kwargs): else: return check_output(*args,**kwargs) +def immediate_deps(pkg): + package_info = check_output(["pacman", "-Si", pkg]).decode("utf-8").split("\n") + + ## Extract the "Depends On" line + depends_on = [x for x in package_info if x.startswith("Depends On")][0] + ## Remove "Depends On" prefix + dependencies = depends_on.split(":")[1] + + ## Split into dependencies + dependencies = dependencies.strip().split(" ") + + ## Remove > signs TODO can we get any other punctation here? + dependencies = [d.split(">")[0] for d in dependencies if d] + dependencies = [d for d in dependencies if not d == "None"] + + dependencies = [MUNGE_DEP_PKGS.get(d, d) for d in dependencies] + return dependencies + + def extract_deps(): print( "Extracting deps" ) - # This list derives from the features we want Emacs to compile with. - PKG_REQ='''mingw-w64-x86_64-giflib -mingw-w64-x86_64-gnutls -mingw-w64-x86_64-harfbuzz -mingw-w64-x86_64-lcms2 -mingw-w64-x86_64-libjpeg-turbo -mingw-w64-x86_64-libpng -mingw-w64-x86_64-librsvg -mingw-w64-x86_64-libtiff -mingw-w64-x86_64-libxml2 -mingw-w64-x86_64-xpm-nox'''.split() # Get a list of all dependencies needed for packages mentioned above. - # Run `pactree -lu' for each element of $PKG_REQ. - pkgs = set() - for x in PKG_REQ: - pkgs.update( - check_output(["pactree", "-lu", x]).decode("utf-8").split() - ) + pkgs = PKG_REQ[:] + print("Initial pkgs", pkgs) + n = 0 + while n < len(pkgs): + subdeps = immediate_deps(pkgs[n]) + for p in subdeps: + if not (p in pkgs or p in SKIP_DEP_PKGS): + print("adding", p) + pkgs.append(p) + n = n + 1 return sorted(pkgs) @@ -112,13 +144,20 @@ def gather_deps(deps, arch, directory): def download_source(tarball): - print("Downloading {}...".format(tarball)) - check_output_maybe( - "wget -a ../download.log -O {} {}/{}/download" - .format(tarball, SRC_REPO, tarball), - shell=True - ) - print("Downloading {}... done".format(tarball)) + print("Acquiring {}...".format(tarball)) + + if os.path.exists("../emacs-src-cache/{}".format(tarball)): + print("Copying {} from local".format(tarball)) + shutil.copyfile("../emacs-src-cache/{}".format(tarball), + "{}".format(tarball)) + else: + print("Downloading {}...".format(tarball)) + check_output_maybe( + "wget -a ../download.log -O {} {}/{}/download" + .format(tarball, SRC_REPO, tarball), + shell=True + ) + print("Downloading {}... done".format(tarball)) def gather_source(deps): @@ -146,7 +185,7 @@ def gather_source(deps): ## make a simple name to make lookup easier simple_pkg_name = re.sub(r"x86_64-","",pkg_name) - if(simple_pkg_name in SKIP_PKGS): + if(simple_pkg_name in SKIP_SRC_PKGS): continue ## Some packages have different source files for different @@ -159,7 +198,7 @@ def gather_source(deps): for d in downloads: ## Switch names if necessary - d = MUNGE_PKGS.get(d,d) + d = MUNGE_SRC_PKGS.get(d,d) tarball = "{}-{}.src.tar.gz".format(d,pkg_version) @@ -209,6 +248,9 @@ def clean(): parser.add_argument("-d", help="dry run", action="store_true") +parser.add_argument("-l", help="list dependencies only", + action="store_true") + args = parser.parse_args() do_all=not (args.c or args.r or args.f or args.t) @@ -216,6 +258,11 @@ def clean(): DRY_RUN=args.d +if( args.l ): + print("List of dependencies") + print( extract_deps() ) + exit(0) + if args.s: DATE="{}-".format(check_output(["date", "+%Y-%m-%d"]).decode("utf-8").strip()) else: From 617f4f31a09f974b0c9cbac903643ee553e5eaa8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 18 Sep 2019 21:46:11 +0300 Subject: [PATCH 104/105] Fix loading .elc files on MS-Windows * src/lread.c (Fload): Don't clobber 'found' if the .el file was not found, as it is used by WINDOWSNT later on. --- src/lread.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/lread.c b/src/lread.c index ab0fab47a98..99e0ce30ba6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1343,6 +1343,7 @@ Return t if the file exists and loads successfully. */) /* openp already checked for newness, no point doing it again. FIXME would be nice to get a message when openp ignores suffix order due to load_prefer_newer. */ + Lisp_Object notfound = found; if (!load_prefer_newer && is_elc) { result = stat (SSDATA (efound), &s1); @@ -1354,11 +1355,11 @@ Return t if the file exists and loads successfully. */) err = errno; SSET (efound, SBYTES (efound) - 1, 'c'); if (result != 0) - found = Fsubstring (found, make_fixnum (0), - make_fixnum (-1)); + notfound = Fsubstring (found, make_fixnum (0), + make_fixnum (-1)); } if (result != 0) - file_test_errno (found, err); + file_test_errno (notfound, err); else if (timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) From 107ce3050fc37b9a13d8304ae1bb73fac9de5f61 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 19 Sep 2019 01:12:36 +0300 Subject: [PATCH 105/105] * lisp/isearch.el (isearch-lazy-highlight-update): Remember timer object in isearch-lazy-highlight-timer to cancel it in lazy-highlight-cleanup. (isearch-done): No need to set isearch-lazy-highlight-start to nil - it used to reset lazy-highlight loop like isearch-lazy-highlight-window-start, but now other packages set isearch-lazy-highlight-last-string to nil to reset lazy-highlight loop. --- lisp/isearch.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/isearch.el b/lisp/isearch.el index 9401e8c06d3..ec51c2cf4cc 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1370,7 +1370,6 @@ NOPUSH is t and EDIT is t." (remove-hook 'post-command-hook 'isearch-post-command-hook) (remove-hook 'mouse-leave-buffer-hook 'isearch-mouse-leave-buffer) (remove-hook 'kbd-macro-termination-hook 'isearch-done) - (setq isearch-lazy-highlight-start nil) (when (buffer-live-p isearch--current-buffer) (with-current-buffer isearch--current-buffer (setq isearch--current-buffer nil) @@ -3970,8 +3969,9 @@ Attempt to do the search exactly the way the pending Isearch would." (if isearch-lazy-highlight-forward (setq isearch-lazy-highlight-end (point-min)) (setq isearch-lazy-highlight-start (point-max))) - (run-at-time lazy-highlight-interval nil - 'isearch-lazy-highlight-buffer-update)) + (setq isearch-lazy-highlight-timer + (run-at-time lazy-highlight-interval nil + 'isearch-lazy-highlight-buffer-update))) (setq isearch-lazy-highlight-timer (run-at-time lazy-highlight-interval nil 'isearch-lazy-highlight-update)))))))))