commit 2d790c6c57b244447390c023679752243e0049c9 (HEAD, refs/remotes/origin/master) Author: Dmitry Gutov Date: Sun Dec 13 04:12:35 2020 +0200 Bump project.el version * lisp/progmodes/project.el: Bump the version. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 98ad41487a..0ed5f1f907 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. -;; Version: 0.5.2 +;; Version: 0.5.3 ;; Package-Requires: ((emacs "26.3") (xref "1.0.2")) ;; This is a GNU ELPA :core package. Avoid using functionality that commit 6fc1b795c1bfaded853b1dff225b0c3628014dd7 Author: Andrii Kolomoiets Date: Fri Dec 11 15:55:22 2020 +0200 vc-create-tag: use vc-revision-history variable * lisp/vc/vc.el (vc-create-tag): Use 'vc-revision-history' variable. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b3b0583966..7d9af00de7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2325,7 +2325,8 @@ checked out in that new branch." ;; to ask for a directory, branches are created at repository level. default-directory (read-directory-name "Directory: " default-directory default-directory t)) - (read-string (if current-prefix-arg "New branch name: " "New tag name: ")) + (read-string (if current-prefix-arg "New branch name: " "New tag name: ") + nil 'vc-revision-history) current-prefix-arg))) (message "Making %s... " (if branchp "branch" "tag")) (when (file-directory-p dir) (setq dir (file-name-as-directory dir))) commit ebab7c48c3b78503b5341974c256388a26e5b880 Author: Dmitry Gutov Date: Sun Dec 13 03:58:32 2020 +0200 Fix test failure * test/lisp/vc/vc-tests.el (vc-test--working-revision): Accept working revision -1, expected for older Hg (bug#36534). diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 7b88b8d531..a2936cca82 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -439,8 +439,9 @@ This checks also `vc-backend' and `vc-responsible-backend'." ;; nil: Git Mtn ;; "0": Bzr CVS Hg SRC SVN ;; "1.1": RCS SCCS + ;; "-1": Hg versions before 5 (probably) (message "vc-working-revision4 %s" (vc-working-revision tmp-name)) - (should (member (vc-working-revision tmp-name) '(nil "0" "1.1"))) + (should (member (vc-working-revision tmp-name) '(nil "0" "1.1" "-1"))) ;; TODO: Call `vc-checkin', and check the resulting ;; working revision. None of the return values should be commit 185b0820b83b2021b4223c443effdd35be0adc2a Author: Stefan Monnier Date: Sat Dec 12 19:19:03 2020 -0500 * lisp/emacs-lisp/bytecomp.el: Allow a nil destination file (byte-compile--default-dest-file): New function, extracted from byte-compile-dest-file. (byte-compile-dest-file): Use it. (byte-compile-dest-file-function): Give it a non-nil default value. (byte-recompile-file, byte-compile-file): Handle a nil return value from `byte-compile-dest-file`. * lisp/progmodes/elisp-mode.el (elisp-flymake--batch-compile-for-flymake): Tell the compiler not to write the result, instead of writing it to a dummy temp file. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0acd527697..51accc0865 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)" ;; Eg is_elc in Fload. :type 'regexp) -(defcustom byte-compile-dest-file-function nil +(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file "Function for the function `byte-compile-dest-file' to call. It should take one argument, the name of an Emacs Lisp source file name, and return the name of the compiled file. @@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension \".el\"), replaces the matching part (and anything after it) with \".elc\"; otherwise adds \".elc\"." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc"))))) -) + (funcall (or byte-compile-dest-file-function + #'byte-compile--default-dest-file) + filename))) + +(defun byte-compile--default-dest-file (filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc")))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") @@ -1809,24 +1811,23 @@ If compilation is needed, this functions returns the result of (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults (filename (expand-file-name filename))) - (if (if (file-exists-p dest) - ;; File was already compiled - ;; Compile if forced to, or filename newer - (or force - (file-newer-than-file-p filename dest)) - (and arg - (or (eq 0 arg) - (y-or-n-p (concat "Compile " - filename "? "))))) - (progn - (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." filename)) - (byte-compile-file filename) - (when load - (load (if (file-exists-p dest) dest filename)))) + (prog1 + (if (if (and dest (file-exists-p dest)) + ;; File was already compiled + ;; Compile if forced to, or filename newer + (or force + (file-newer-than-file-p filename dest)) + (and arg + (or (eq 0 arg) + (y-or-n-p (concat "Compile " + filename "? "))))) + (progn + (if (and noninteractive (not byte-compile-verbose)) + (message "Compiling %s..." filename)) + (byte-compile-file filename)) + 'no-byte-compile) (when load - (load (if (file-exists-p dest) dest filename))) - 'no-byte-compile))) + (load (if (and dest (file-exists-p dest)) dest filename)))))) (defun byte-compile--load-dynvars (file) (and file (not (equal file "")) @@ -1936,7 +1937,7 @@ See also `emacs-lisp-byte-compile-and-load'." ;; (message "%s not compiled because of `no-byte-compile: %s'" ;; (byte-compile-abbreviate-file filename) ;; (with-current-buffer input-buffer no-byte-compile)) - (when (file-exists-p target-file) + (when (and target-file (file-exists-p target-file)) (message "%s deleted because of `no-byte-compile: %s'" (byte-compile-abbreviate-file target-file) (buffer-local-value 'no-byte-compile input-buffer)) @@ -1960,36 +1961,38 @@ See also `emacs-lisp-byte-compile-and-load'." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) - ;; We must disable any code conversion here. - (progn - (let* ((coding-system-for-write 'no-conversion) - ;; Write to a tempfile so that if another Emacs - ;; process is trying to load target-file (eg in a - ;; parallel bootstrap), it does not risk getting a - ;; half-finished file. (Bug#4196) - (tempfile - (make-temp-file (expand-file-name target-file))) - (default-modes (default-file-modes)) - (temp-modes (logand default-modes #o600)) - (desired-modes (logand default-modes #o666)) - (kill-emacs-hook - (cons (lambda () (ignore-errors - (delete-file tempfile))) - kill-emacs-hook))) - (unless (= temp-modes desired-modes) - (set-file-modes tempfile desired-modes 'nofollow)) - (write-region (point-min) (point-max) tempfile nil 1) - ;; This has the intentional side effect that any - ;; hard-links to target-file continue to - ;; point to the old file (this makes it possible - ;; for installed files to share disk space with - ;; the build tree, without causing problems when - ;; emacs-lisp files in the build tree are - ;; recompiled). Previously this was accomplished by - ;; deleting target-file before writing it. - (rename-file tempfile target-file t)) - (or noninteractive (message "Wrote %s" target-file))) + (cond + ((null target-file) nil) ;We only wanted the warnings! + ((file-writable-p target-file) + ;; We must disable any code conversion here. + (let* ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile + (make-temp-file (expand-file-name target-file))) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes #o666)) + (kill-emacs-hook + (cons (lambda () (ignore-errors + (delete-file tempfile))) + kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes 'nofollow)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t)) + (or noninteractive (message "Wrote %s" target-file))) + (t ;; This is just to give a better error message than write-region (let ((exists (file-exists-p target-file))) (signal (if exists 'file-error 'file-missing) @@ -1997,7 +2000,7 @@ See also `emacs-lisp-byte-compile-and-load'." (if exists "Cannot overwrite file" "Directory not writable or nonexistent") - target-file)))) + target-file))))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index fa360a8f3f..b7e0c45228 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1827,12 +1827,9 @@ Runs in a batch-mode Emacs. Interactively use variable (interactive (list buffer-file-name)) (let* ((file (or file (car command-line-args-left))) - (dummy-elc-file) (byte-compile-log-buffer (generate-new-buffer " *dummy-byte-compile-log-buffer*")) - (byte-compile-dest-file-function - (lambda (source) - (setq dummy-elc-file (make-temp-file (file-name-nondirectory source))))) + (byte-compile-dest-file-function #'ignore) (collected) (byte-compile-log-warning-function (lambda (string &optional position fill level) @@ -1842,7 +1839,6 @@ Runs in a batch-mode Emacs. Interactively use variable (unwind-protect (byte-compile-file file) (ignore-errors - (delete-file dummy-elc-file) (kill-buffer byte-compile-log-buffer))) (prin1 :elisp-flymake-output-start) (terpri) commit c6f21e2420202a19a590c66ecc09bf8bb277778d Author: Alan Third Date: Sat Dec 12 23:52:00 2020 +0000 Fix assertion on SVG load failure * src/image.c (svg_load_image): Move setting DPI to after rsvg_handle error checking. diff --git a/src/image.c b/src/image.c index 6b85ab78f6..a3301ad2dd 100644 --- a/src/image.c +++ b/src/image.c @@ -9872,8 +9872,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file, RSVG_HANDLE_FLAGS_NONE, NULL, &err); - rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, - FRAME_DISPLAY_INFO (f)->resy); if (base_file) g_object_unref (base_file); @@ -9881,6 +9879,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */ if (!rsvg_handle || err) goto rsvg_error; + + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); #else /* Make a handle to a new rsvg object. */ rsvg_handle = rsvg_handle_new (); @@ -10045,15 +10046,15 @@ svg_load_image (struct frame *f, struct image *img, char *contents, RSVG_HANDLE_FLAGS_NONE, NULL, &err); - rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, - FRAME_DISPLAY_INFO (f)->resy); - if (base_file) g_object_unref (base_file); g_object_unref (input_stream); /* Check rsvg_handle too, to avoid librsvg 2.40.13 bug (Bug#36773#26). */ if (!rsvg_handle || err) goto rsvg_error; + + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); #else /* Make a handle to a new rsvg object. */ rsvg_handle = rsvg_handle_new (); commit 89c6efc6903bd967930a192dfdaeed3551c08b51 Author: Stefan Kangas Date: Sat Dec 12 23:51:30 2020 +0100 Remove references to Emacs before version 22 from FAQ * doc/misc/efaq.texi (Escape sequences in shell output): Remove reference to versions before Emacs 21. (Basic editing, Latest version of Emacs) (Turning on abbrevs by default, Going to a line by number) (Security risks with Emacs): Remove references to versions before Emacs 22. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 1bc9d41f9b..462eb4cf3a 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -512,10 +512,10 @@ This chapter tells you how to get help with Emacs. @cindex Help system, entering the Type @kbd{C-h t} to invoke the self-paced tutorial. Just typing -@kbd{C-h} enters the help system. Starting with Emacs 22, the tutorial -is available in many foreign languages such as French, German, Japanese, -Russian, etc. Use @kbd{M-x help-with-tutorial-spec-language @key{RET}} -to choose your language and start the tutorial. +@kbd{C-h} enters the help system. The tutorial is available in many +foreign languages such as French, German, Japanese, Russian, etc. Use +@kbd{M-x help-with-tutorial-spec-language @key{RET}} to choose your +language and start the tutorial. Your system administrator may have changed @kbd{C-h} to act like @key{DEL} to deal with local keyboards. You can use @kbd{M-x @@ -966,9 +966,9 @@ latest features, you may want to stick to the releases. The following sections list some of the major new features in the last few Emacs releases. For full details of the changes in any version of -Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). As of Emacs 22, -you can give this command a prefix argument to read about which features -were new in older versions. +Emacs, type @kbd{C-h C-n} (@kbd{M-x view-emacs-news}). You can give +this command a prefix argument to read about which features were new +in older versions. @node New in Emacs 26 @section What is different about Emacs 26? @@ -1725,14 +1725,6 @@ buffer by default, put this in your @file{.emacs} file: (setq abbrev-mode t))) @end lisp -@noindent If your Emacs version is older then 22.1, you will also need to use: - -@lisp -(condition-case () - (quietly-read-abbrev-file) - (file-error nil)) -@end lisp - @node Associating modes with files @section How do I make Emacs use a certain major mode for certain files? @cindex Associating modes with files @@ -2583,16 +2575,14 @@ effective way of doing that. Emacs automatically intercepts the compile error messages, inserts them into a special buffer called @file{*compilation*}, and lets you visit the locus of each message in the source. Type @kbd{C-x `} to step through the offending lines one by -one (starting with Emacs 22, you can also use @kbd{M-g M-p} and -@kbd{M-g M-n} to go to the previous and next matches directly). Click -@kbd{mouse-2} or press @key{RET} on a message text in the -@file{*compilation*} buffer to go to the line whose number is mentioned -in that message. +one (you can also use @kbd{M-g M-p} and @kbd{M-g M-n} to go to the +previous and next matches directly). Click @kbd{mouse-2} or press +@key{RET} on a message text in the @file{*compilation*} buffer to go +to the line whose number is mentioned in that message. But if you indeed need to go to a certain text line, type @kbd{M-g M-g} -(which is the default binding of the @code{goto-line} function starting -with Emacs 22). Emacs will prompt you for the number of the line and go -to that line. +(which is the default binding of the @code{goto-line} function). +Emacs will prompt you for the number of the line and go to that line. You can do this faster by invoking @code{goto-line} with a numeric argument that is the line's number. For example, @kbd{C-u 286 M-g M-g} @@ -2825,13 +2815,13 @@ Add the following line to your @file{.emacs} file: @cindex @code{ls} in Shell mode In many systems, @code{ls} is aliased to @samp{ls --color}, which -prints using ANSI color escape sequences. Emacs version 21.1 and -later includes the @code{ansi-color} package, which lets Shell mode -recognize these escape sequences. In Emacs 23.2 and later, the -package is enabled by default; in earlier versions you can enable it -by typing @kbd{M-x ansi-color-for-comint-mode} in the Shell buffer, or -by adding @code{(add-hook 'shell-mode-hook -'ansi-color-for-comint-mode-on)} to your init file. +prints using ANSI color escape sequences. Emacs includes the +@code{ansi-color} package, which lets Shell mode recognize these +escape sequences. In Emacs 23.2 and later, the package is enabled by +default; in earlier versions you can enable it by typing @kbd{M-x +ansi-color-for-comint-mode} in the Shell buffer, or by adding +@code{(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)} to +your init file. @node Fullscreen mode on MS-Windows @section How can I start Emacs in fullscreen mode on MS-Windows? @@ -3210,12 +3200,11 @@ arbitrary Emacs Lisp code evaluated when the file is visited. Obviously, there is a potential for Trojan horses to exploit this feature. -As of Emacs 22, Emacs has a list of local variables that are known to -be safe to set. If a file tries to set any variable outside this -list, it asks the user to confirm whether the variables should be set. -You can also tell Emacs whether to allow the evaluation of Emacs Lisp -code found at the bottom of files by setting the variable -@code{enable-local-eval}. +Emacs has a list of local variables that are known to be safe to set. +If a file tries to set any variable outside this list, it asks the +user to confirm whether the variables should be set. You can also tell +Emacs whether to allow the evaluation of Emacs Lisp code found at the +bottom of files by setting the variable @code{enable-local-eval}. @xref{File Variables,,, emacs, The GNU Emacs Manual}. commit 52e3ac6303292fdea8f441821a40f8f5ca31e3de Author: Philipp Stephani Date: Sat Dec 12 23:21:18 2020 +0100 Document and enforce some properties for strings created by modules. When creating multibyte or unibyte strings, we should guarantee the following invariants: - When creating empty strings, a NULL data pointer should be allowed. This often arises in practice if the string length isn't known in advance, and we don't want to unnecessarily trigger undefined behavior. Since functions like memcpy might not accept NULL pointers, use the canonical empty string objects in this case. - Nonzero strings should be guaranteed to be unique and mutable. These are the same guarantees expected from Lisp functions such as 'make-string' or 'unibyte-string'. On the other hand, empty strings might not be unique. * src/emacs-module.c (module_make_string) (module_make_unibyte_string): Correctly handle empty strings. * test/src/emacs-module-resources/mod-test.c (Fmod_test_make_string): New test function. (emacs_module_init): Expose it. * test/src/emacs-module-tests.el (mod-test-make-string/empty) (mod-test-make-string/nonempty): New unit tests. * doc/lispref/internals.texi (Module Values): Document properties and corner cases for strings. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index fb24544c91..28a5fdb349 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1864,7 +1864,10 @@ byte, is @var{len}. The original string in @var{str} can be either an it can include embedded null bytes, and doesn't have to end in a terminating null byte at @code{@var{str}[@var{len}]}. The function raises the @code{overflow-error} error condition if @var{len} is -negative or exceeds the maximum length of an Emacs string. +negative or exceeds the maximum length of an Emacs string. If +@var{len} is zero, then @var{str} can be @code{NULL}, otherwise it +must point to valid memory. For nonzero @var{len}, @code{make_string} +returns unique mutable string objects. @end deftypefn @deftypefn Function emacs_value make_unibyte_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len}) diff --git a/src/emacs-module.c b/src/emacs-module.c index 0f3ef59fd8..b7cd835c83 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -784,7 +784,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= len && len <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = module_decode_utf_8 (str, len); + Lisp_Object lstr + = len == 0 ? empty_multibyte_string : module_decode_utf_8 (str, len); return lisp_to_value (env, lstr); } @@ -794,9 +795,8 @@ module_make_unibyte_string (emacs_env *env, const char *str, ptrdiff_t length) MODULE_FUNCTION_BEGIN (NULL); if (! (0 <= length && length <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_uninit_string (length); - memcpy (SDATA (lstr), str, length); - SDATA (lstr)[length] = 0; + Lisp_Object lstr + = length == 0 ? empty_unibyte_string : make_unibyte_string (str, length); return lisp_to_value (env, lstr); } diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index f855e9b6da..30ad352cf8 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include @@ -699,6 +700,34 @@ Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return env->funcall (env, args[0], nargs - 1, args + 1); } +static emacs_value +Fmod_test_make_string (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + assert (nargs == 2); + intmax_t length_arg = env->extract_integer (env, args[0]); + if (env->non_local_exit_check (env) != emacs_funcall_exit_return) + return args[0]; + if (length_arg < 0 || SIZE_MAX < length_arg) + { + signal_error (env, "Invalid string length"); + return args[0]; + } + size_t length = (size_t) length_arg; + bool multibyte = env->is_not_nil (env, args[1]); + char *buffer = length == 0 ? NULL : malloc (length); + if (buffer == NULL && length != 0) + { + memory_full (env); + return args[0]; + } + memset (buffer, 'a', length); + emacs_value ret = multibyte ? env->make_string (env, buffer, length) + : env->make_unibyte_string (env, buffer, length); + free (buffer); + return ret; +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -790,6 +819,7 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function, NULL, NULL); + DEFUN ("mod-test-make-string", Fmod_test_make_string, 2, 2, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 99d4cafb4a..bf26ffb935 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -30,6 +30,7 @@ (require 'ert) (require 'ert-x) (require 'help-fns) +(require 'subr-x) (defconst mod-test-emacs (expand-file-name invocation-name invocation-directory) @@ -556,4 +557,23 @@ See Bug#36226." (thread-join thread-1) (thread-join thread-2))) +(ert-deftest mod-test-make-string/empty () + (dolist (multibyte '(nil t)) + (ert-info ((format "Multibyte: %s" multibyte)) + (let ((got (mod-test-make-string 0 multibyte))) + (should (stringp got)) + (should (string-empty-p got)) + (should (eq (multibyte-string-p got) multibyte)))))) + +(ert-deftest mod-test-make-string/nonempty () + (dolist (multibyte '(nil t)) + (ert-info ((format "Multibyte: %s" multibyte)) + (let ((first (mod-test-make-string 1 multibyte)) + (second (mod-test-make-string 1 multibyte))) + (should (stringp first)) + (should (eql (length first) 1)) + (should (eq (multibyte-string-p first) multibyte)) + (should (string-equal first second)) + (should-not (eq first second)))))) + ;;; emacs-module-tests.el ends here commit 4bf98aecffe57648d15db90718134b00ac87ec3b Author: Lars Ingebrigtsen Date: Sat Dec 12 21:59:08 2020 +0100 Fix BSD .include etc syntax in Makefiles * lisp/progmodes/make-mode.el (makefile-bsdmake-statements): Fix the BSD conditional syntax (bug#24000). (makefile-make-font-lock-keywords): Allow calling without keywords. (makefile-bsdmake-font-lock-keywords): Add the conditional syntax. Makefile inclusion, conditional structures and for loops reminiscent of the C programming language are provided in make. All such structures are identified by a line beginning with a single dot (`.') character. Whitespace characters may follow this dot, e.g., .include and . include are identical constructs diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 3e49f84dbc..8b6a7fc1b4 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -343,8 +343,9 @@ not be enclosed in { } or ( )." "List of keywords understood by gmake.") (defconst makefile-bsdmake-statements - '(".elif" ".elifdef" ".elifmake" ".elifndef" ".elifnmake" ".else" ".endfor" - ".endif" ".for" ".if" ".ifdef" ".ifmake" ".ifndef" ".ifnmake" ".undef") + '("elif" "elifdef" "elifmake" "elifndef" "elifnmake" "else" "endfor" + "endif" "for" "if" "ifdef" "ifmake" "ifndef" "ifnmake" "poison" + "undef" "include") "List of keywords understood by BSD make.") (defun makefile-make-font-lock-keywords (var keywords space @@ -376,8 +377,9 @@ not be enclosed in { } or ( )." ("[^$]\\(\\$[@%*]\\)" 1 'makefile-targets append) - ;; Fontify conditionals and includes. - (,(concat "^\\(?: [ \t]*\\)?" + ,@(if keywords + ;; Fontify conditionals and includes. + `((,(concat "^\\(?: [ \t]*\\)?" (replace-regexp-in-string " " "[ \t]+" (if (eq (car keywords) t) @@ -385,7 +387,7 @@ not be enclosed in { } or ( )." (regexp-opt (cdr keywords) t)) (regexp-opt keywords t))) "\\>[ \t]*\\([^: \t\n#]*\\)") - (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) + (1 font-lock-keyword-face) (2 font-lock-variable-name-face)))) ,@(if negation `((,negation (1 font-lock-negation-char-face prepend) @@ -493,13 +495,17 @@ not be enclosed in { } or ( )." 1 'makefile-makepp-perl t))) (defconst makefile-bsdmake-font-lock-keywords - (makefile-make-font-lock-keywords - ;; A lot more could be done for variables here: - makefile-var-use-regex - makefile-bsdmake-statements - t - "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)" - '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face))) + (append + (makefile-make-font-lock-keywords + ;; A lot more could be done for variables here: + makefile-var-use-regex + nil + t + "^\\(?: [ \t]*\\)?\\.\\(?:el\\)?if\\(n?\\)\\(?:def\\|make\\)?\\>[ \t]*\\(!?\\)" + '("^[ \t]*\\.for[ \t].+[ \t]\\(in\\)\\>" 1 font-lock-keyword-face)) + `((,(concat "^\\. *" (regexp-opt makefile-bsdmake-statements) "\\>") 0 + font-lock-keyword-face)))) + (defconst makefile-imake-font-lock-keywords (append commit 180e309d8b15b66b588438d157ed1290ab2de7df Author: Lars Ingebrigtsen Date: Sat Dec 12 21:19:26 2020 +0100 Bind `C-c C-d' to rmail-epa-decrypt in rmail * doc/emacs/rmail.texi (Rmail Display): Mention the key binding (bug#25411). * lisp/mail/rmail.el (rmail-mode-map): Bind C-c C-d to rmail-epa-decrypt. (rmail-mode): Mention it. (rmail-epa-decrypt): Don't mark a mail as decrypted unless we're replacing it. * lisp/mail/rmailsum.el (rmail-summary-mode-map): Bind C-c C-d. (rmail-summary-epa-decrypt): New command. diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 14ee062b6c..467c526986 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1273,9 +1273,9 @@ temporary buffer to display the current @acronym{MIME} message. @findex rmail-epa-decrypt @cindex encrypted mails (reading in Rmail) - If the current message is an encrypted one, use the command @kbd{M-x -rmail-epa-decrypt} to decrypt it, using the EasyPG library -(@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}). + If the current message is an encrypted one, use the command +@kbd{C-c C-d} (@code{rmail-epa-decrypt}) to decrypt it, using the +EasyPG library (@pxref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}). You can highlight and activate URLs in the Rmail buffer using Goto Address mode: diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 63d992d271..3c74edd105 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1080,6 +1080,7 @@ The buffer is expected to be narrowed to just the header of the message." (define-key map [?\S-\ ] 'scroll-down-command) (define-key map "\177" 'scroll-down-command) (define-key map "?" 'describe-mode) + (define-key map "\C-c\C-d" 'rmail-epa-decrypt) (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) (define-key map "\C-c\C-s\C-a" 'rmail-sort-by-author) @@ -1272,6 +1273,7 @@ Instead, these commands are available: \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages till a deleted message is found. \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. +\\[rmail-epa-decrypt] Decrypt the current message. \\[rmail-expunge] Expunge deleted messages. \\[rmail-expunge-and-save] Expunge and save the file. \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. @@ -4610,11 +4612,10 @@ Argument MIME is non-nil if this is a mime message." "> ") (push (rmail-epa-decrypt-1 mime) decrypts)))) - (when (and decrypts (eq major-mode 'rmail-mode)) - (rmail-add-label "decrypt")) - (when (and decrypts (rmail-buffers-swapped-p)) (when (y-or-n-p "Replace the original message? ") + (when (eq major-mode 'rmail-mode) + (rmail-add-label "decrypt")) (setq decrypts (nreverse decrypts)) (let ((beg (rmail-msgbeg rmail-current-message)) (end (rmail-msgend rmail-current-message))) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index a085e0bc4f..9ccc0cfee9 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -121,6 +121,7 @@ Setting this option to nil might speed up the generation of summaries." (define-key map [?\S-\ ] 'rmail-summary-scroll-msg-down) (define-key map "\177" 'rmail-summary-scroll-msg-down) (define-key map "?" 'describe-mode) + (define-key map "\C-c\C-d" 'rmail-summary-epa-decrypt) (define-key map "\C-c\C-n" 'rmail-summary-next-same-subject) (define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject) (define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date) @@ -1482,6 +1483,12 @@ argument says to read a file name and use that file as the inbox." (rmail-edit-current-message) (use-local-map rmail-summary-edit-map)) +(defun rmail-summary-epa-decrypt () + "Decrypt this message." + (interactive) + (rmail-pop-to-buffer rmail-buffer) + (rmail-epa-decrypt)) + (defun rmail-summary-cease-edit () "Finish editing message, then go back to Rmail summary buffer." (interactive) commit 8a220d7c8f30fda7239c1dbf7522e0170ef53527 Author: Eric Abrahamsen Date: Thu Dec 3 15:58:57 2020 -0800 New option gnus-registry-register-all * lisp/gnus/gnus-registry.el (gnus-registry-register-all): If nil, the registry won't automatically create new entries for all seen messages. Defaults to t to preserve previous behavior. (gnus-registry-handle-action): Don't automatically create entries; if one doesn't exist, don't handle anything. (gnus-registry-register-message-ids): Only register if this option is t. (gnus-registry-get-or-make-entry): Add optional no-create argument. (gnus-registry-get-id-key): This "get" operation should only create an entry if this option is t. * doc/misc/gnus.texi: Documentation and news. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index cfd3ceda3f..3743b497da 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26287,6 +26287,16 @@ registry will keep. If the registry has reached or exceeded this size, it will reject insertion of new entries. @end defvar +@defvar gnus-registry-register-all +If this option is non-nil, the registry will register all messages, as +you see them. This is important to making split-to-parent and +Message-ID references work correctly, as the registry needs to know +where all messages are, but it can slow down group opening and the +saving of Gnus. If this option is nil, entries must be created +manually, for instance by storing a custom flag or keyword for the +message. +@end defvar + @defvar gnus-registry-prune-factor This option (a float between 0 and 1) controls how much the registry is cut back during pruning. In order to prevent constant pruning, the @@ -26376,8 +26386,14 @@ have to put a rule like this: "mail") @end lisp -in your fancy split setup. In addition, you may want to customize the -following variables. +in your fancy split setup. + +If @code{gnus-registry-register-all} is non-nil (the default), the +registry will perform splitting for all messages. If it is nil, +splitting will only happen for children of messages you've explicitly +registered. + +In addition, you may want to customize the following variables. @defvar gnus-registry-track-extra This is a list of symbols, so it's best to change it from the @@ -26450,7 +26466,9 @@ Store @code{value} under @code{key} for message @code{id}. @end defun @defun gnus-registry-get-id-key (id key) -Get the data under @code{key} for message @code{id}. +Get the data under @code{key} for message @code{id}. If the option +@code{gnus-registry-register-all} is non-nil, this function will also +create an entry for @code{id} if one doesn't exist. @end defun @defvar gnus-registry-extra-entries-precious diff --git a/etc/NEWS b/etc/NEWS index 514209516d..909473f4e7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -517,6 +517,13 @@ tags to be considered as well. ** Gnus ++++ +*** New user option 'gnus-registry-register-all'. + +If non-nil (the default), create registry entries for all messages. +If nil, don't automatically create entries, they must be created +manually. + +++ *** New user options to customise the summary line specs %[ and %]. Four new options introduced in customisation group diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 65bcd0e8a3..31aee0364c 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -54,6 +54,9 @@ ;; (: gnus-registry-split-fancy-with-parent) +;; This won't work as expected unless `gnus-registry-register-all' +;; is set to t. + ;; You should also consider using the nnregistry backend to look up ;; articles. See the Gnus manual for more information. @@ -160,6 +163,11 @@ nnmairix groups are specifically excluded because they are ephemeral." (const :tag "Always Install" t) (const :tag "Ask Me" ask))) +(defcustom gnus-registry-register-all nil + "If non-nil, register all articles in the registry." + :type 'boolean + :version "28.1") + (defvar gnus-registry-enabled nil) (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -478,8 +486,8 @@ This is not required after changing `gnus-registry-cache-file'." (let ((db gnus-registry-db) ;; if the group is ignored, set the destination to nil (same as delete) (to (if (gnus-registry-ignore-group-p to) nil to)) - ;; safe if not found - (entry (gnus-registry-get-or-make-entry id)) + ;; Only retrieve an existing entry, don't create a new one. + (entry (gnus-registry-get-or-make-entry id t)) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject subject))) (sender (gnus-string-remove-all-properties sender))) @@ -488,29 +496,30 @@ This is not required after changing `gnus-registry-cache-file'." ;; several times but it's better to bunch the transactions ;; together - (registry-delete db (list id) nil) - (when from - (setq entry (cons (delete from (assoc 'group entry)) - (assq-delete-all 'group entry)))) - ;; Only keep the entry if the message is going to a new group, or - ;; it's still in some previous group. - (when (or to (alist-get 'group entry)) - (dolist (kv `((group ,to) - (sender ,sender) - (recipient ,@recipients) - (subject ,subject))) - (when (cadr kv) - (let ((new (or (assq (car kv) entry) - (list (car kv))))) - (dolist (toadd (cdr kv)) - (unless (member toadd new) - (setq new (append new (list toadd))))) - (setq entry (cons new - (assq-delete-all (car kv) entry)))))) - (gnus-message 10 "Gnus registry: new entry for %s is %S" - id - entry) - (gnus-registry-insert db id entry)))) + (when entry + (registry-delete db (list id) nil) + (when from + (setq entry (cons (delete from (assoc 'group entry)) + (assq-delete-all 'group entry)))) + ;; Only keep the entry if the message is going to a new group, or + ;; it's still in some previous group. + (when (or to (alist-get 'group entry)) + (dolist (kv `((group ,to) + (sender ,sender) + (recipient ,@recipients) + (subject ,subject))) + (when (cadr kv) + (let ((new (or (assq (car kv) entry) + (list (car kv))))) + (dolist (toadd (cdr kv)) + (unless (member toadd new) + (setq new (append new (list toadd))))) + (setq entry (cons new + (assq-delete-all (car kv) entry)))))) + (gnus-message 10 "Gnus registry: new entry for %s is %S" + id + entry) + (gnus-registry-insert db id entry))))) ;; Function for nn{mail|imap}-split-fancy: look up all references in ;; the cache and if a match is found, return that group. @@ -846,7 +855,8 @@ Overrides existing keywords with FORCE set non-nil." (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group." - (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) + (unless (or (gnus-parameter-registry-ignore gnus-newsgroup-name) + (null gnus-registry-register-all)) (dolist (article gnus-newsgroup-articles) (let* ((id (gnus-registry-fetch-message-id-fast article)) (groups (gnus-registry-get-id-key id 'group))) @@ -1082,12 +1092,15 @@ only the last one's marks are returned." "Get the number of groups of a message, based on the message ID." (length (gnus-registry-get-id-key id 'group))) -(defun gnus-registry-get-or-make-entry (id) +(defun gnus-registry-get-or-make-entry (id &optional no-create) + "Return registry entry for ID. +If entry is not found, create a new one, unless NO-create is +non-nil." (let* ((db gnus-registry-db) ;; safe if not found (entries (registry-lookup db (list id)))) - (when (null entries) + (unless (or entries no-create) (gnus-registry-insert db id (list (list 'creation-time (current-time)) '(group) '(sender) '(subject))) (setq entries (registry-lookup db (list id)))) @@ -1098,7 +1111,8 @@ only the last one's marks are returned." (registry-delete gnus-registry-db idlist nil)) (defun gnus-registry-get-id-key (id key) - (cdr-safe (assq key (gnus-registry-get-or-make-entry id)))) + (cdr-safe (assq key (gnus-registry-get-or-make-entry + id (null gnus-registry-register-all))))) (defun gnus-registry-set-id-key (id key vals) (let* ((db gnus-registry-db) commit b1f2eada47adda8349e6f1ef55dfd7a3ed60e6aa Author: Stefan Monnier Date: Sat Dec 12 11:50:00 2020 -0500 * lisp/emacs-lisp/package.el (package-buffer-info): Improve error message (package-strip-rcs-id): Return canonicalized version string. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9c37ce429a..b7c48dfd3f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1115,14 +1115,15 @@ boundaries." ;; Use some headers we've invented to drive the process. (let* (;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) + (version-info + (or (lm-header "package-version") (lm-header "version"))) + (pkg-version (package-strip-rcs-id version-info)) (keywords (lm-keywords-list)) (homepage (lm-homepage))) (unless pkg-version - (error - "Package lacks a \"Version\" or \"Package-Version\" header")) + (if version-info + (error "Unrecognized package version: %s" version-info) + (error "Package lacks a \"Version\" or \"Package-Version\" header"))) (package-desc-from-define file-name pkg-version desc (and-let* ((require-lines (lm-header-multiline "package-requires"))) @@ -2112,7 +2113,10 @@ Otherwise return nil." (when str (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) (setq str (substring str (match-end 0)))) - (if (version-to-list str) str))) + (let ((l (version-to-list str))) + ;; Don't return `str' but (package-version-join (version-to-list str)) + ;; to make sure we use a "canonical name"! + (if l (package-version-join l))))) (declare-function lm-homepage "lisp-mnt" (&optional file)) commit 8eee54d23adfbd723805851e3904ec21294788ed Author: Stefan Monnier Date: Sat Dec 12 10:59:50 2020 -0500 * src/fns.c (hash_string): Tweak the code further Merge the two main branches; remove the `max` test and thus reduce the "most steps" to 8 as written diff --git a/src/fns.c b/src/fns.c index f77092972a..646c3ed083 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4525,40 +4525,36 @@ sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) EMACS_UINT hash_string (char const *ptr, ptrdiff_t len) { - if (len < 16) + EMACS_UINT const *p = (EMACS_UINT const *) ptr; + EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len); + EMACS_UINT hash = len; + /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, + * but dividing by 8 is cheaper. */ + ptrdiff_t step = 1 + ((end - p) >> 3); + + /* Beware: `end` might be unaligned, so `p < end` is not always the same + * as `p <= end - 1`. */ + while (p <= end - 1) { - char const *p = ptr; - char const *end = p + len; - EMACS_UINT hash = len; - - while (p < end) - { - unsigned char c = *p++; - hash = sxhash_combine (hash, c); - } - - return hash; + EMACS_UINT c = *p; + p += step; + hash = sxhash_combine (hash, c); } - else - { - EMACS_UINT const *p = (EMACS_UINT const *) ptr; - EMACS_UINT const *end = (EMACS_UINT const *) (ptr + len); - EMACS_UINT hash = len; - /* At most 8 steps. We could reuse SXHASH_MAX_LEN, of course, - * but dividing by 8 is cheaper. */ - ptrdiff_t step = max (1, (end - p) >> 3); - - /* Beware: `end` might be unaligned, so `p < end` is not always the same - * as `p <= end - 1`. */ - while (p <= end - 1) + if (p < end) + { /* A few last bytes remain (smaller than an EMACS_UINT). */ + /* FIXME: We could do this without a loop, but it'd require + endian-dependent code :-( */ + char const *p1 = (char const *)p; + char const *end1 = (char const *)end; + do { - EMACS_UINT c = *p; - p += step; + unsigned char c = *p1++; hash = sxhash_combine (hash, c); } - - return hash; + while (p1 < end1); } + + return hash; } /* Return a hash for string PTR which has length LEN. The hash commit a12fe07a8849da0fb68b7233cef839a6a60a6241 Author: Stefan Monnier Date: Sat Dec 12 10:37:42 2020 -0500 * lisp/vc/log-edit.el: Keep separator line thin even with line-numbers (log-edit-font-lock-keywords): Disable line-number display on the thin separator line. (log-edit-mode): Adjust `font-lock-extra-managed-props` accordingly. (log-edit-changelog-entries): Don't use a nil buffer-local `change-log-default-name`. diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index feafe5f5f0..5f978daec0 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -387,7 +387,8 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(:height 0.1 :inverse-video t :extend t)))) + (0 '(face (:height 0.1 :inverse-video t :extend t) + display-line-numbers-disable t rear-nonsticky t)))) (log-edit--match-first-line (0 'log-edit-summary)))) (defvar log-edit-font-lock-gnu-style nil @@ -490,6 +491,9 @@ commands (under C-x v for VC, for example). \\{log-edit-mode-map}" (setq-local font-lock-defaults '(log-edit-font-lock-keywords t)) + (make-local-variable 'font-lock-extra-managed-props) + (cl-pushnew 'rear-nonsticky font-lock-extra-managed-props) + (cl-pushnew 'display-line-numbers-disable font-lock-extra-managed-props) (setq-local jit-lock-contextually t) ;For the "first line is summary". (setq-local fill-paragraph-function #'log-edit-fill-entry) (make-local-variable 'log-edit-comment-ring-index) @@ -983,16 +987,17 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each (visiting-buffer (find-buffer-visiting file))) ;; If there is a buffer visiting FILE, and it has a local ;; value for `change-log-default-name', use that. - (if (and visiting-buffer + (or (and visiting-buffer (local-variable-p 'change-log-default-name - visiting-buffer)) - (with-current-buffer visiting-buffer - change-log-default-name) - ;; `find-change-log' uses `change-log-default-name' if set - ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here. - (setq change-log-default-name nil) - (find-change-log))))) + visiting-buffer) + (with-current-buffer visiting-buffer + change-log-default-name)) + ;; `find-change-log' uses `change-log-default-name' if set + ;; and sets it before exiting, so we need to work around + ;; that memoizing which is undesired here. + (progn + (setq change-log-default-name nil) + (find-change-log)))))) (when (or (find-buffer-visiting changelog-file-name) (file-exists-p changelog-file-name) add-log-dont-create-changelog-file) commit a83d8c9bbe5fbcdeccebfc54d72e1019a951fe52 Author: Eli Zaretskii Date: Sat Dec 12 17:32:55 2020 +0200 Followup to recent changes in keyboard.c * src/keyboard.c (prev_kbd_event): Now defined only if HAVE_X11. * lisp/subr.el (while-no-input-ignore-events): Remove 'buffer-switch': no longer used or defined. (Bug#5803) diff --git a/lisp/subr.el b/lisp/subr.el index c28807f694..ed235ee1f7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3964,7 +3964,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; Don't throw `throw-on-input' on those events by default. (setq while-no-input-ignore-events '(focus-in focus-out help-echo iconify-frame - make-frame-visible selection-request buffer-switch)) + make-frame-visible selection-request)) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. diff --git a/src/keyboard.c b/src/keyboard.c index 560d92c99f..dbca5be91e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -384,11 +384,13 @@ next_kbd_event (union buffered_input_event *ptr) return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1; } +#ifdef HAVE_X11 static union buffered_input_event * prev_kbd_event (union buffered_input_event *ptr) { return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1; } +#endif /* Like EVENT_START, but assume EVENT is an event. This pacifies gcc -Wnull-dereference, which might otherwise commit 734f37136558f9cc4ae0d2d3507125d7e65c9986 Author: Lars Ingebrigtsen Date: Sat Dec 12 16:24:12 2020 +0100 Remove some unused process.c variables * src/process.c (wait_reading_process_output): Remove some variables that are unused after the previous patch. diff --git a/src/process.c b/src/process.c index 48b727d9e3..4fe8ac7fc0 100644 --- a/src/process.c +++ b/src/process.c @@ -5328,8 +5328,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, do { unsigned old_timers_run = timers_run; - struct buffer *old_buffer = current_buffer; - Lisp_Object old_window = selected_window; timer_delay = timer_check (); @@ -5686,9 +5684,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (read_kbd != 0) { - unsigned old_timers_run = timers_run; - struct buffer *old_buffer = current_buffer; - Lisp_Object old_window = selected_window; bool leave = false; if (detect_input_pending_run_timers (do_display)) commit d165b5a46b2a84c637a80200ad6bcf164bbfa77b Author: Stefan Monnier Date: Sat Dec 12 10:16:42 2020 -0500 New variable `redisplay_adhoc_scroll_in_resize_mini_windows` * src/xdisp.c (syms_of_xdisp): Define it. (resize_mini_window): Obey it. diff --git a/etc/NEWS b/etc/NEWS index 901a432d99..514209516d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -88,6 +88,13 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". ** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. +In addition, there is a new variable +`redisplay-adhoc-scroll-in-resize-mini-windows` to disable the +ad-hoc auto-scrolling when resizing minibuffer windows. It has been +found that its heuristic can be counter productive in some corner +cases, tho the cure may be worse than the disease. This said, the +effect should be negligible in the vast majority of cases anyway. + +++ ** Improved handling of minibuffers on switching frames. By default, when you switch to another frame, an active minibuffer now diff --git a/src/xdisp.c b/src/xdisp.c index 689b87df42..96dd4fade2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -11751,9 +11751,10 @@ resize_mini_window (struct window *w, bool exact_p) return false; /* By default, start display at the beginning. */ - set_marker_both (w->start, w->contents, - BUF_BEGV (XBUFFER (w->contents)), - BUF_BEGV_BYTE (XBUFFER (w->contents))); + if (redisplay_adhoc_scroll_in_resize_mini_windows) + set_marker_both (w->start, w->contents, + BUF_BEGV (XBUFFER (w->contents)), + BUF_BEGV_BYTE (XBUFFER (w->contents))); /* Nil means don't try to resize. */ if ((NILP (Vresize_mini_windows) @@ -11812,27 +11813,32 @@ resize_mini_window (struct window *w, bool exact_p) if (height > max_height) { height = (max_height / unit) * unit; - init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID); - move_it_vertically_backward (&it, height - unit); - /* The following move is usually a no-op when the stuff - displayed in the mini-window comes entirely from buffer - text, but it is needed when some of it comes from overlay - strings, especially when there's an after-string at ZV. - This happens with some completion packages, like - icomplete, ido-vertical, etc. With those packages, if we - don't force w->start to be at the beginning of a screen - line, important parts of the stuff in the mini-window, - such as user prompt, will be hidden from view. */ - move_it_by_lines (&it, 0); - start = it.current.pos; - /* Prevent redisplay_window from recentering, and thus from - overriding the window-start point we computed here. */ - w->start_at_line_beg = false; + if (redisplay_adhoc_scroll_in_resize_mini_windows) + { + init_iterator (&it, w, ZV, ZV_BYTE, NULL, DEFAULT_FACE_ID); + move_it_vertically_backward (&it, height - unit); + /* The following move is usually a no-op when the stuff + displayed in the mini-window comes entirely from buffer + text, but it is needed when some of it comes from overlay + strings, especially when there's an after-string at ZV. + This happens with some completion packages, like + icomplete, ido-vertical, etc. With those packages, if we + don't force w->start to be at the beginning of a screen + line, important parts of the stuff in the mini-window, + such as user prompt, will be hidden from view. */ + move_it_by_lines (&it, 0); + start = it.current.pos; + /* Prevent redisplay_window from recentering, and thus from + overriding the window-start point we computed here. */ + w->start_at_line_beg = false; + SET_MARKER_FROM_TEXT_POS (w->start, start); + } } else - SET_TEXT_POS (start, BEGV, BEGV_BYTE); - - SET_MARKER_FROM_TEXT_POS (w->start, start); + { + SET_TEXT_POS (start, BEGV, BEGV_BYTE); + SET_MARKER_FROM_TEXT_POS (w->start, start); + } if (EQ (Vresize_mini_windows, Qgrow_only)) { @@ -35502,6 +35508,14 @@ The initial frame is not displayed anywhere, so skipping it is best except in special circumstances such as running redisplay tests in batch mode. */); redisplay_skip_initial_frame = true; + + DEFVAR_BOOL ("redisplay-adhoc-scroll-in-resize-mini-windows", + redisplay_adhoc_scroll_in_resize_mini_windows, + doc: /* If nil always use normal scrolling in minibuffer windows. +Otherwise, use custom-tailored code after resizing minibuffer windows to try +and display the most important part of the minibuffer. */); + /* See bug#43519 for some discussion around this. */ + redisplay_adhoc_scroll_in_resize_mini_windows = true; } commit adbb4eacc2a984c0fc0b65ec761368fd9067d6c5 Author: Stefan Monnier Date: Sat Dec 12 09:56:04 2020 -0500 * src/keyboard.c: Fix bug#5803. A long time ago, `read_key_sequence` used to read the keymaps at the start, so if something happened between this start and the moment the user actually hits a key, `read_key_sequence` could end up using the wrong keymaps. To work around this problem, the code used `record_asynch_buffer_change` to try and trigger `read_key_sequence` to re-read the keymaps in some known cases. Several years ago, `read_key_sequence` was changed so as to read the keymaps only once the user hits a key, making this machinery now redundant (and also harmful apparently in bug#5803 because it introduces "spurious" events). So we here remove `record_asynch_buffer_change` and the `BUFFER_SWITCH_EVENT` and `Qbuffer_switch` pseudo-events it generated. * src/termhooks.h (enum event_kind): Delete `BUFFER_SWITCH_EVENT`. * src/keyboard.c: (record_asynch_buffer_change): Delete function. (syms_of_keyboard): Delete `Qbuffer_switch`. (force_auto_save_soon, readable_events) (kbd_buffer_store_buffered_event, kbd_buffer_get_event) (make_lispy_event): * src/xterm.c (handle_one_xevent): * src/w32term.c (w32_read_socket): * src/process.c (wait_reading_process_output) (read_and_dispose_of_process_output, exec_sentinel): Simplify accordingly. diff --git a/src/keyboard.c b/src/keyboard.c index 49261fcc3e..560d92c99f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -741,9 +741,6 @@ void force_auto_save_soon (void) { last_auto_save = - auto_save_interval - 1; - /* FIXME: What's the relationship between forcing auto-save and adding - a buffer-switch event? */ - record_asynch_buffer_change (); } #endif @@ -3431,8 +3428,7 @@ readable_events (int flags) && event->ie.part == scroll_bar_handle && event->ie.modifiers == 0) #endif - && !((flags & READABLE_EVENTS_FILTER_EVENTS) - && event->kind == BUFFER_SWITCH_EVENT)) + ) return 1; event = next_kbd_event (event); } @@ -3583,12 +3579,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, return; } } - /* Don't insert two BUFFER_SWITCH_EVENT's in a row. - Just ignore the second one. */ - else if (event->kind == BUFFER_SWITCH_EVENT - && kbd_fetch_ptr != kbd_store_ptr - && prev_kbd_event (kbd_store_ptr)->kind == BUFFER_SWITCH_EVENT) - return; /* Don't let the very last slot in the buffer become full, since that would make the two pointers equal, @@ -3622,7 +3612,6 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; - case BUFFER_SWITCH_EVENT: ignore_event = Qbuffer_switch; break; default: ignore_event = Qnil; break; } @@ -3961,7 +3950,6 @@ kbd_buffer_get_event (KBOARD **kbp, #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: #endif - case BUFFER_SWITCH_EVENT: case SAVE_SESSION_EVENT: case NO_EVENT: case HELP_EVENT: @@ -5341,14 +5329,6 @@ make_lispy_event (struct input_event *event) return list2 (Qmove_frame, list1 (event->frame_or_window)); #endif - case BUFFER_SWITCH_EVENT: - { - /* The value doesn't matter here; only the type is tested. */ - Lisp_Object obj; - XSETBUFFER (obj, current_buffer); - return obj; - } - /* Just discard these, by returning nil. With MULTI_KBOARD, these events are used as placeholders when we need to randomly delete events from the queue. @@ -6805,41 +6785,6 @@ get_input_pending (int flags) return input_pending; } -/* Put a BUFFER_SWITCH_EVENT in the buffer - so that read_key_sequence will notice the new current buffer. */ - -void -record_asynch_buffer_change (void) -{ - /* We don't need a buffer-switch event unless Emacs is waiting for input. - The purpose of the event is to make read_key_sequence look up the - keymaps again. If we aren't in read_key_sequence, we don't need one, - and the event could cause trouble by messing up (input-pending-p). - Note: Fwaiting_for_user_input_p always returns nil when async - subprocesses aren't supported. */ - if (!NILP (Fwaiting_for_user_input_p ())) - { - struct input_event event; - - EVENT_INIT (event); - event.kind = BUFFER_SWITCH_EVENT; - event.frame_or_window = Qnil; - event.arg = Qnil; - - /* Make sure no interrupt happens while storing the event. */ -#ifdef USABLE_SIGIO - if (interrupt_input) - kbd_buffer_store_event (&event); - else -#endif - { - stop_polling (); - kbd_buffer_store_event (&event); - start_polling (); - } - } -} - /* Read any terminal input already buffered up by the system into the kbd_buffer, but do not wait. @@ -11573,8 +11518,6 @@ syms_of_keyboard (void) /* Menu and tool bar item parts. */ DEFSYM (Qmenu_enable, "menu-enable"); - DEFSYM (Qbuffer_switch, "buffer-switch"); - #ifdef HAVE_NTGUI DEFSYM (Qlanguage_change, "language-change"); DEFSYM (Qend_session, "end-session"); diff --git a/src/keyboard.h b/src/keyboard.h index 41da3a6bf4..24e9a00788 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -446,7 +446,6 @@ extern void push_kboard (struct kboard *); extern void push_frame_kboard (struct frame *); extern void pop_kboard (void); extern void temporarily_switch_to_single_kboard (struct frame *); -extern void record_asynch_buffer_change (void); extern void input_poll_signal (int); extern void start_polling (void); extern void stop_polling (void); diff --git a/src/process.c b/src/process.c index bf64ead24e..48b727d9e3 100644 --- a/src/process.c +++ b/src/process.c @@ -5333,14 +5333,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timer_delay = timer_check (); - /* If a timer has run, this might have changed buffers - an alike. Make read_key_sequence aware of that. */ - if (timers_run != old_timers_run - && (old_buffer != current_buffer - || !EQ (old_window, selected_window)) - && waiting_for_user_input_p == -1) - record_asynch_buffer_change (); - if (timers_run != old_timers_run && do_display) /* We must retry, since a timer may have requeued itself and that could alter the time_delay. */ @@ -5706,14 +5698,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, leave = true; } - /* If a timer has run, this might have changed buffers - an alike. Make read_key_sequence aware of that. */ - if (timers_run != old_timers_run - && waiting_for_user_input_p == -1 - && (old_buffer != current_buffer - || !EQ (old_window, selected_window))) - record_asynch_buffer_change (); - if (leave) break; } @@ -6213,18 +6197,6 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, /* Restore waiting_for_user_input_p as it was when we were called, in case the filter clobbered it. */ waiting_for_user_input_p = waiting; - -#if 0 /* Call record_asynch_buffer_change unconditionally, - because we might have changed minor modes or other things - that affect key bindings. */ - if (! EQ (Fcurrent_buffer (), obuffer) - || ! EQ (current_buffer->keymap, okeymap)) -#endif - /* But do it only if the caller is actually going to read events. - Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make sit_for return). */ - if (waiting_for_user_input_p == -1) - record_asynch_buffer_change (); } DEFUN ("internal-default-process-filter", Finternal_default_process_filter, @@ -7390,16 +7362,6 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) when we were called, in case the filter clobbered it. */ waiting_for_user_input_p = waiting; -#if 0 - if (! EQ (Fcurrent_buffer (), obuffer) - || ! EQ (current_buffer->keymap, okeymap)) -#endif - /* But do it only if the caller is actually going to read events. - Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make sit_for return). */ - if (waiting_for_user_input_p == -1) - record_asynch_buffer_change (); - unbind_to (count, Qnil); } diff --git a/src/termhooks.h b/src/termhooks.h index 44ab14225f..e94959ca9a 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -159,7 +159,6 @@ enum event_kind SELECTION_REQUEST_EVENT, /* Another X client wants a selection from us. See `struct selection_input_event'. */ SELECTION_CLEAR_EVENT, /* Another X client cleared our selection. */ - BUFFER_SWITCH_EVENT, /* A process filter has switched buffers. */ DELETE_WINDOW_EVENT, /* An X client said "delete this window". */ #ifdef HAVE_NTGUI END_SESSION_EVENT, /* The user is logging out or shutting down. */ diff --git a/src/thread.h b/src/thread.h index a09929fa44..9697e49f09 100644 --- a/src/thread.h +++ b/src/thread.h @@ -140,7 +140,6 @@ struct thread_state for user-input when that process-filter was called. waiting_for_input cannot be used as that is by definition 0 when lisp code is being evalled. - This is also used in record_asynch_buffer_change. For that purpose, this must be 0 when not inside wait_reading_process_output. */ int m_waiting_for_user_input_p; diff --git a/src/w32term.c b/src/w32term.c index dc5cd1f699..a038e4593f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -4858,10 +4858,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (!NILP (Vframe_list) && !NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later to update the - frame titles in case this is the second frame. */ - record_asynch_buffer_change (); } else { @@ -5479,12 +5475,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (! NILP (Vframe_list) - && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later - to update the frame titles - in case this is the second frame. */ - record_asynch_buffer_change (); /* Windows can send us a SIZE_MAXIMIZED message even when fullscreen is fullboth. The following is a @@ -5532,12 +5522,6 @@ w32_read_socket (struct terminal *terminal, inev.kind = DEICONIFY_EVENT; XSETFRAME (inev.frame_or_window, f); } - else if (! NILP (Vframe_list) - && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later - to update the frame titles - in case this is the second frame. */ - record_asynch_buffer_change (); } if (EQ (get_frame_param (f, Qfullscreen), Qmaximized)) @@ -5829,9 +5813,6 @@ w32_read_socket (struct terminal *terminal, SET_FRAME_GARBAGED (f); DebPrint (("obscured frame %p (%s) found to be visible\n", f, SDATA (f->name))); - - /* Force a redisplay sooner or later. */ - record_asynch_buffer_change (); } } } diff --git a/src/xterm.c b/src/xterm.c index 0d2452de92..3de0d2e73c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8383,10 +8383,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = DEICONIFY_EVENT; XSETFRAME (inev.ie.frame_or_window, f); } - else if (! NILP (Vframe_list) && ! NILP (XCDR (Vframe_list))) - /* Force a redisplay sooner or later to update the - frame titles in case this is the second frame. */ - record_asynch_buffer_change (); } goto OTHER; commit 7ee0fc0dc1a7cba8a3e965f411aca498a7db3f4f Author: Alan Mackenzie Date: Sat Dec 12 14:38:38 2020 +0000 CC Mode: Handle several K&R parameters per declaration This fixes bug #45160. * lisp/progmodes/cc-engine.el (c-in-knr-argdecl): Reformulate the latter part of this function using c-do-declarators. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5e2ce71f53..f14ffb38cd 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10837,11 +10837,11 @@ comment at the start of cc-engine.el for more info." (low-lim (max (or lim (point-min)) (or macro-start (point-min)))) before-lparen after-rparen (here (point)) - (pp-count-out 20) ; Max number of paren/brace constructs before - ; we give up. + (pp-count-out 20) ; Max number of paren/brace constructs before + ; we give up ids ; List of identifiers in the parenthesized list. id-start after-prec-token decl-or-cast decl-res - c-last-identifier-range identifier-ok) + c-last-identifier-range semi-position+1) (narrow-to-region low-lim (or macro-end (point-max))) ;; Search backwards for the defun's argument list. We give up if we @@ -10875,8 +10875,8 @@ comment at the start of cc-engine.el for more info." (setq after-rparen (point))) ((eq (char-before) ?\]) (setq after-rparen nil)) - (t ; either } (hit previous defun) or = or no more - ; parens/brackets. + (t ; either } (hit previous defun) or = or no more + ; parens/brackets. (throw 'knr nil))) (if after-rparen @@ -10933,31 +10933,35 @@ comment at the start of cc-engine.el for more info." (forward-char) ; over the ) (setq after-prec-token after-rparen) (c-forward-syntactic-ws) + ;; Each time around the following checks one + ;; declaration (which may contain several identifiers). (while (and - (or (consp (setq decl-or-cast - (c-forward-decl-or-cast-1 - after-prec-token - nil ; Or 'arglist ??? - nil))) - (progn - (goto-char after-prec-token) - (c-forward-syntactic-ws) - (setq identifier-ok (eq (char-after) ?{)) - nil)) - (eq (char-after) ?\;) - (setq after-prec-token (1+ (point))) + (consp (setq decl-or-cast + (c-forward-decl-or-cast-1 + after-prec-token + nil ; Or 'arglist ??? + nil))) + (memq (char-after) '(?\; ?\,)) (goto-char (car decl-or-cast)) - (setq decl-res (c-forward-declarator)) - (setq identifier-ok - (member (buffer-substring-no-properties - (car decl-res) (cadr decl-res)) - ids)) - (progn - (goto-char after-prec-token) - (prog1 (< (point) here) - (c-forward-syntactic-ws)))) - (setq identifier-ok nil)) - identifier-ok)) + (save-excursion + (setq semi-position+1 + (c-syntactic-re-search-forward + ";" (+ (point) 1000) t))) + (c-do-declarators + semi-position+1 t nil nil + (lambda (id-start id-end _next _not-top + _func _init) + (if (not (member + (buffer-substring-no-properties + id-start id-end) + ids)) + (throw 'knr nil)))) + + (progn (forward-char) + (<= (point) here)) + (progn (c-forward-syntactic-ws) + t))) + t)) ;; ...Yes. We've identified the function's argument list. (throw 'knr (progn (goto-char after-rparen) commit 4afef614cd6c93b4d4a57aa5bb211563649abc56 Author: Lars Ingebrigtsen Date: Sat Dec 12 14:22:58 2020 +0100 Alter the "Redundant pcase patter" warning message * lisp/emacs-lisp/pcase.el (pcase--expand): Make the "Redundant pcase pattern" warning less vague (bug#31350). diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e603900b09..206f0dd1a9 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -409,7 +409,8 @@ of the elements of LIST is performed as if by `pcase-let'. (dolist (case cases) (unless (or (memq case used-cases) (memq (car case) pcase--dontwarn-upats)) - (message "Redundant pcase pattern: %S" (car case)))) + (message "pcase pattern %S shadowed by previous pcase pattern" + (car case)))) (macroexp-let* defs main)))) (defun pcase--macroexpand (pat) commit 9a7bce6241f5fc9ed982e95084641f3021314829 Author: Lars Ingebrigtsen Date: Sat Dec 12 14:13:32 2020 +0100 Make elint load `require'd packages * lisp/emacs-lisp/elint.el (elint-require-form): New function to load files that are `require'd (bug#27006). (elint-special-forms): Add function. diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index ef97c8279d..79b72ff969 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -558,7 +558,8 @@ Return nil if there are no more forms, t otherwise." (when . elint-check-conditional-form) (unless . elint-check-conditional-form) (and . elint-check-conditional-form) - (or . elint-check-conditional-form)) + (or . elint-check-conditional-form) + (require . elint-require-form)) "Functions to call when some special form should be linted.") (defun elint-form (form env &optional nohandler) @@ -953,6 +954,13 @@ Does basic handling of `featurep' tests." (elint-form form env t)))) env) +(defun elint-require-form (form _env) + "Load `require'd files." + (pcase form + (`(require ',x) + (require x))) + nil) + ;;; ;;; Message functions ;;; commit db339f6dd1280cfd97309b1390cfa59c47e296b9 Author: Eli Zaretskii Date: Sat Dec 12 15:05:26 2020 +0200 ; * lisp/info.el (Info-toc-build): Fix last change. (Bug#28074) diff --git a/lisp/info.el b/lisp/info.el index ad94c9edee..c049aa88a5 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2473,7 +2473,7 @@ Table of contents is created from the tree structure of menus." (setq bound (or (and (equal nodename "Top") (save-excursion (re-search-forward - "^[ \t-—]*The Detailed Node Listing" nil t))) + "^[ \t—-]*The Detailed Node Listing" nil t))) bound)) (while (< (point) bound) (cond commit f45ce78c40e37bf2aab83d2d1183ed896c5c1c4c Author: Zajcev Evgeny Date: Thu Dec 3 18:37:18 2020 +0300 Explicitly specify svg base_uri using `:base-uri' image property * src/image.c (svg_load): Check `:base-uri' image property to explicitly set base_uri for images embedded into SVG (enum svg_keyword_index): (svg_format): Add :base-uri. * lisp/svg.el (svg-embed-base-uri-image): New function to embed images located relative to images `:base-uri' diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index b9b05a2a42..2b3119ea59 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5900,6 +5900,26 @@ string containing the image data as raw bytes. @var{image-type} should be a @end lisp @end defun +@defun svg-embed-base-uri-image svg relative-filename &rest args +To @var{svg} add an embedded (raster) image placed at +@var{relative-filename}. @var{relative-filename} is searched inside +@code{file-name-directory} of the @code{:base-uri} svg image property. +This improves the performance of embedding large images. + +@lisp +;; Embeding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg +(svg-embed-base-uri-image svg "subdir/rms.jpg" + :width "100px" :height "100px" + :x "50px" :y "75px") +(svg-embed-base-uri-image svg "another/rms.jpg" + :width "100px" :height "100px" + :x "75px" :y "50px") +(svg-image svg :scale 1.0 + :base-uri "/tmp/dummy" + :width 175 :height 175) +@end lisp +@end defun + @defun svg-clip-path svg &rest args Add a clipping path to @var{svg}. If applied to a shape via the @var{:clip-path} property, parts of that shape which lie outside of diff --git a/etc/NEWS b/etc/NEWS index 9aa735da72..901a432d99 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1111,6 +1111,18 @@ If 'shr-width' is non-nil, it overrides this variable. ** Images +--- +** Can explicitly specify base_uri for svg images. +':base-uri' image property can be used to explicitly specify base_uri +for embedded images into svg. ':base-uri' is supported for both file +and data svg images. + ++++ +** 'svg-embed-base-uri-image' added to embed images +'svg-embed-base-uri-image' can be used to embed images located +relatively to 'file-name-directory' of the ':base-uri' svg image property. +This works much faster then 'svg-embed'. + +++ *** New function 'image-cache-size'. This function returns the size of the current image cache, in bytes. diff --git a/lisp/svg.el b/lisp/svg.el index eeb945f53b..1ca59658aa 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -184,6 +184,19 @@ otherwise. IMAGE-TYPE should be a MIME image type, like `((xlink:href . ,(svg--image-data image image-type datap)) ,@(svg--arguments svg args))))) +(defun svg-embed-base-uri-image (svg relative-filename &rest args) + "Insert image placed at RELATIVE-FILENAME into the SVG structure. +RELATIVE-FILENAME will be searched in `file-name-directory' of the +image's `:base-uri' property. If `:base-uri' is not specified for the +image, then embedding won't work. Embedding large images using this +function is much faster than `svg-embed'." + (svg--append + svg + (dom-node + 'image + `((xlink:href . ,relative-filename) + ,@(svg--arguments svg args))))) + (defun svg-text (svg text &rest args) "Add TEXT to SVG." (svg--append diff --git a/src/image.c b/src/image.c index 54380d1cdf..6b85ab78f6 100644 --- a/src/image.c +++ b/src/image.c @@ -9492,6 +9492,7 @@ enum svg_keyword_index SVG_TYPE, SVG_DATA, SVG_FILE, + SVG_BASE_URI, SVG_ASCENT, SVG_MARGIN, SVG_RELIEF, @@ -9511,6 +9512,7 @@ static const struct image_keyword svg_format[SVG_LAST] = {":type", IMAGE_SYMBOL_VALUE, 1}, {":data", IMAGE_STRING_VALUE, 0}, {":file", IMAGE_STRING_VALUE, 0}, + {":base-uri", IMAGE_STRING_VALUE, 0}, {":ascent", IMAGE_ASCENT_VALUE, 0}, {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, {":relief", IMAGE_INTEGER_VALUE, 0}, @@ -9743,10 +9745,11 @@ static bool svg_load (struct frame *f, struct image *img) { bool success_p = 0; - Lisp_Object file_name; + Lisp_Object file_name, base_uri; /* If IMG->spec specifies a file name, create a non-file spec from it. */ file_name = image_spec_value (img->spec, QCfile, NULL); + base_uri = image_spec_value (img->spec, QCbase_uri, NULL); if (STRINGP (file_name)) { int fd; @@ -9766,15 +9769,16 @@ svg_load (struct frame *f, struct image *img) return 0; } /* If the file was slurped into memory properly, parse it. */ - success_p = svg_load_image (f, img, contents, size, - SSDATA (ENCODE_FILE (file))); + if (!STRINGP (base_uri)) + base_uri = ENCODE_FILE (file); + success_p = svg_load_image (f, img, contents, size, SSDATA (base_uri)); xfree (contents); } /* Else it's not a file, it's a Lisp object. Load the image from a Lisp object rather than a file. */ else { - Lisp_Object data, original_filename; + Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) @@ -9782,10 +9786,10 @@ svg_load (struct frame *f, struct image *img) image_error ("Invalid image data `%s'", data); return 0; } - original_filename = BVAR (current_buffer, filename); + if (!STRINGP (base_uri)) + base_uri = BVAR (current_buffer, filename); success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data), - (NILP (original_filename) ? NULL - : SSDATA (original_filename))); + (NILP (base_uri) ? NULL : SSDATA (base_uri))); } return success_p; @@ -9886,6 +9890,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, FRAME_DISPLAY_INFO (f)->resy); /* Set base_uri for properly handling referenced images (via 'href'). + Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10058,6 +10063,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, FRAME_DISPLAY_INFO (f)->resy); /* Set base_uri for properly handling referenced images (via 'href'). + Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10740,6 +10746,7 @@ non-numeric, there is no explicit limit on the size of images. */); #if defined (HAVE_RSVG) DEFSYM (Qsvg, "svg"); + DEFSYM (QCbase_uri, ":base-uri"); add_image_type (Qsvg); #ifdef HAVE_NTGUI /* Other libraries used directly by svg code. */ commit 8ff70045c371253b3c2c22c4f62bd9f911bccd51 Author: Alan Third Date: Sat Dec 12 12:30:57 2020 +0000 Revert "Explicitly specify svg base_uri using `:base-uri' image property" This reverts commit a8e2143a5c03785742464406306fda7fce6caf04. I applied the incorrect version of the patch. diff --git a/src/image.c b/src/image.c index bc354c1a66..54380d1cdf 100644 --- a/src/image.c +++ b/src/image.c @@ -9743,11 +9743,10 @@ static bool svg_load (struct frame *f, struct image *img) { bool success_p = 0; - Lisp_Object file_name, base_uri; + Lisp_Object file_name; /* If IMG->spec specifies a file name, create a non-file spec from it. */ file_name = image_spec_value (img->spec, QCfile, NULL); - base_uri = image_spec_value (img->spec, QCbase_uri, NULL); if (STRINGP (file_name)) { int fd; @@ -9767,16 +9766,15 @@ svg_load (struct frame *f, struct image *img) return 0; } /* If the file was slurped into memory properly, parse it. */ - if (!STRINGP (base_uri)) - base_uri = ENCODE_FILE (file); - success_p = svg_load_image (f, img, contents, size, SSDATA (base_uri)); + success_p = svg_load_image (f, img, contents, size, + SSDATA (ENCODE_FILE (file))); xfree (contents); } /* Else it's not a file, it's a Lisp object. Load the image from a Lisp object rather than a file. */ else { - Lisp_Object data; + Lisp_Object data, original_filename; data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) @@ -9784,10 +9782,10 @@ svg_load (struct frame *f, struct image *img) image_error ("Invalid image data `%s'", data); return 0; } - if (!STRINGP (base_uri)) - base_uri = BVAR (current_buffer, filename); + original_filename = BVAR (current_buffer, filename); success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data), - (NILP (base_uri) ? NULL : SSDATA (base_uri))); + (NILP (original_filename) ? NULL + : SSDATA (original_filename))); } return success_p; @@ -9888,7 +9886,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents, FRAME_DISPLAY_INFO (f)->resy); /* Set base_uri for properly handling referenced images (via 'href'). - Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10061,7 +10058,6 @@ svg_load_image (struct frame *f, struct image *img, char *contents, FRAME_DISPLAY_INFO (f)->resy); /* Set base_uri for properly handling referenced images (via 'href'). - Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10744,7 +10740,6 @@ non-numeric, there is no explicit limit on the size of images. */); #if defined (HAVE_RSVG) DEFSYM (Qsvg, "svg"); - DEFSYM (QCbase_uri, ":base-uri"); add_image_type (Qsvg); #ifdef HAVE_NTGUI /* Other libraries used directly by svg code. */ commit e005095e4130f43c36d75ceac4c3202534f02704 Author: Lars Ingebrigtsen Date: Sat Dec 12 13:46:33 2020 +0100 Offer to save tutorial position on Emacs exit * lisp/tutorial.el (tutorial--buffer): New variable (bug#27998). (tutorial--save-on-kill): Use it. (help-with-tutorial): Set it and add new function to kill-emacs-query-functions. diff --git a/lisp/tutorial.el b/lisp/tutorial.el index d07737e333..ca84f86f28 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -50,6 +50,9 @@ "Tutorial language.") (make-variable-buffer-local 'tutorial--lang) +(defvar tutorial--buffer nil + "The selected tutorial buffer.") + (defun tutorial--describe-nonstandard-key (value) "Give more information about a changed key binding. This is used in `help-with-tutorial'. The information includes @@ -655,6 +658,15 @@ with some explanatory links." (unless (eq prop-val 'key-sequence) (delete-region prop-start prop-end)))))) +(defun tutorial--save-on-kill () + "Query the user about saving the tutorial when killing Emacs." + (when (buffer-live-p tutorial--buffer) + (with-current-buffer tutorial--buffer + (if (y-or-n-p "Save your position in the tutorial? ") + (tutorial--save-tutorial-to (tutorial--saved-file)) + (message "Tutorial position not saved")))) + t) + (defun tutorial--save-tutorial () "Save the tutorial buffer. This saves the part of the tutorial before and after the area @@ -802,6 +814,7 @@ Run the Viper tutorial? ")) ;; (Re)build the tutorial buffer if it is not ok (unless old-tut-is-ok (switch-to-buffer (get-buffer-create tut-buf-name)) + (setq tutorial--buffer (current-buffer)) ;; (unless old-tut-buf (text-mode)) (unless lang (error "Variable lang is nil")) (setq tutorial--lang lang) @@ -814,6 +827,7 @@ Run the Viper tutorial? ")) ;; a hook to save it when the buffer is killed. (setq buffer-auto-save-file-name nil) (add-hook 'kill-buffer-hook 'tutorial--save-tutorial nil t) + (add-hook 'kill-emacs-query-functions 'tutorial--save-on-kill) ;; Insert the tutorial. First offer to resume last tutorial ;; editing session. commit ad0bbcd565743635a9c9a8dae176c7d38c532ef8 Author: Lars Ingebrigtsen Date: Sat Dec 12 13:33:09 2020 +0100 Update Info-toc-build parsing * lisp/info.el (Info-toc-build): Update to understand EMDASH instead of a hyphen in the detailed node listing (bug#28074). diff --git a/lisp/info.el b/lisp/info.el index 203f5db96d..ad94c9edee 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2473,7 +2473,7 @@ Table of contents is created from the tree structure of menus." (setq bound (or (and (equal nodename "Top") (save-excursion (re-search-forward - "^[ \t-]*The Detailed Node Listing" nil t))) + "^[ \t-—]*The Detailed Node Listing" nil t))) bound)) (while (< (point) bound) (cond commit f22e4bbf1cf351bf705b73418adf22949b280d0d Author: Stefan Kangas Date: Sat Dec 12 13:27:35 2020 +0100 Prefer setq-local in python.el * lisp/progmodes/python.el: Require Emacs 24.2 instead of 24.1. (python-indent-guess-indent-offset) (python-shell-font-lock-with-font-lock-buffer) (python-shell-font-lock-turn-on) (python-shell-font-lock-turn-off, python-shell-font-lock-toggle) (python-shell-comint-watch-for-first-prompt-output-filter) (inferior-python-mode, python-shell-completion-native-turn-off) (python-shell-completion-native-turn-on) (python-pdbtrack-comint-output-filter-function, python-mode): Prefer setq-local. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c761c95a96..d75944a702 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.27.1 -;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) +;; Package-Requires: ((emacs "24.2") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -875,7 +875,7 @@ work on `python-indent-calculate-indentation' instead." (python-util-forward-comment) (current-indentation)))) (if (and indentation (not (zerop indentation))) - (set (make-local-variable 'python-indent-offset) indentation) + (setq-local python-indent-offset indentation) (when python-indent-guess-indent-offset-verbose (message "Can't guess python-indent-offset, using defaults: %s" python-indent-offset)))))))) @@ -2623,7 +2623,7 @@ also `with-current-buffer'." (set-buffer python-shell--font-lock-buffer) (when (not font-lock-mode) (font-lock-mode 1)) - (set (make-local-variable 'delay-mode-hooks) t) + (setq-local delay-mode-hooks t) (let ((python-indent-guess-indent-offset nil)) (when (not (derived-mode-p 'python-mode)) (python-mode)) @@ -2702,7 +2702,7 @@ With argument MSG show activation message." (interactive "p") (python-shell-with-shell-buffer (python-shell-font-lock-kill-buffer) - (set (make-local-variable 'python-shell--font-lock-buffer) nil) + (setq-local python-shell--font-lock-buffer nil) (add-hook 'post-command-hook #'python-shell-font-lock-post-command-hook nil 'local) (add-hook 'kill-buffer-hook @@ -2725,7 +2725,7 @@ With argument MSG show deactivation message." (cdr (python-util-comint-last-prompt)) (line-end-position) '(face nil font-lock-face nil))) - (set (make-local-variable 'python-shell--font-lock-buffer) nil) + (setq-local python-shell--font-lock-buffer nil) (remove-hook 'post-command-hook #'python-shell-font-lock-post-command-hook 'local) (remove-hook 'kill-buffer-hook @@ -2741,8 +2741,8 @@ With argument MSG show deactivation message." With argument MSG show activation/deactivation message." (interactive "p") (python-shell-with-shell-buffer - (set (make-local-variable 'python-shell-font-lock-enable) - (not python-shell-font-lock-enable)) + (setq-local python-shell-font-lock-enable + (not python-shell-font-lock-enable)) (if python-shell-font-lock-enable (python-shell-font-lock-turn-on msg) (python-shell-font-lock-turn-off msg)) @@ -2765,9 +2765,9 @@ eventually provide a shell." (defun python-shell-comint-watch-for-first-prompt-output-filter (output) "Run `python-shell-first-prompt-hook' when first prompt is found in OUTPUT." (when (not python-shell--first-prompt-received) - (set (make-local-variable 'python-shell--first-prompt-received-output-buffer) - (concat python-shell--first-prompt-received-output-buffer - (ansi-color-filter-apply output))) + (setq-local python-shell--first-prompt-received-output-buffer + (concat python-shell--first-prompt-received-output-buffer + (ansi-color-filter-apply output))) (when (python-shell-comint-end-of-output-p python-shell--first-prompt-received-output-buffer) (if (string-match-p @@ -2775,7 +2775,7 @@ eventually provide a shell." (or python-shell--first-prompt-received-output-buffer "")) ;; Skip pdb prompts and reset the buffer. (setq python-shell--first-prompt-received-output-buffer nil) - (set (make-local-variable 'python-shell--first-prompt-received) t) + (setq-local python-shell--first-prompt-received t) (setq python-shell--first-prompt-received-output-buffer nil) (with-current-buffer (current-buffer) (let ((inhibit-quit nil)) @@ -2815,30 +2815,30 @@ variable. \(Type \\[describe-mode] in the process buffer for a list of commands.)" (when python-shell--parent-buffer (python-util-clone-local-variables python-shell--parent-buffer)) - (set (make-local-variable 'indent-tabs-mode) nil) + (setq-local indent-tabs-mode nil) ;; Users can interactively override default values for ;; `python-shell-interpreter' and `python-shell-interpreter-args' ;; when calling `run-python'. This ensures values let-bound in ;; `python-shell-make-comint' are locally set if needed. - (set (make-local-variable 'python-shell-interpreter) - (or python-shell--interpreter python-shell-interpreter)) - (set (make-local-variable 'python-shell-interpreter-args) - (or python-shell--interpreter-args python-shell-interpreter-args)) - (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil) - (set (make-local-variable 'python-shell--block-prompt) nil) - (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil) + (setq-local python-shell-interpreter + (or python-shell--interpreter python-shell-interpreter)) + (setq-local python-shell-interpreter-args + (or python-shell--interpreter-args python-shell-interpreter-args)) + (setq-local python-shell--prompt-calculated-input-regexp nil) + (setq-local python-shell--block-prompt nil) + (setq-local python-shell--prompt-calculated-output-regexp nil) (python-shell-prompt-set-calculated-regexps) (setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp) - (set (make-local-variable 'comint-prompt-read-only) t) + (setq-local comint-prompt-read-only t) (setq mode-line-process '(":%s")) - (set (make-local-variable 'comint-output-filter-functions) - '(ansi-color-process-output - python-shell-comint-watch-for-first-prompt-output-filter - python-comint-postoutput-scroll-to-bottom - comint-watch-for-password-prompt)) + (setq-local comint-output-filter-functions + '(ansi-color-process-output + python-shell-comint-watch-for-first-prompt-output-filter + python-comint-postoutput-scroll-to-bottom + comint-watch-for-password-prompt)) (setq-local comint-highlight-input nil) - (set (make-local-variable 'compilation-error-regexp-alist) - python-shell-compilation-regexp-alist) + (setq-local compilation-error-regexp-alist + python-shell-compilation-regexp-alist) (add-hook 'completion-at-point-functions #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" @@ -3605,7 +3605,7 @@ __PYTHON_EL_native_completion_setup()" process) With argument MSG show deactivation message." (interactive "p") (python-shell-with-shell-buffer - (set (make-local-variable 'python-shell-completion-native-enable) nil) + (setq-local python-shell-completion-native-enable nil) (when msg (message "Shell native completion is disabled, using fallback")))) @@ -3614,7 +3614,7 @@ With argument MSG show deactivation message." With argument MSG show deactivation message." (interactive "p") (python-shell-with-shell-buffer - (set (make-local-variable 'python-shell-completion-native-enable) t) + (setq-local python-shell-completion-native-enable t) (python-shell-completion-native-turn-on-maybe msg))) (defun python-shell-completion-native-turn-on-maybe (&optional msg) @@ -3994,7 +3994,7 @@ Argument OUTPUT is a string with the output from the comint process." (tracked-buffer-window (get-buffer-window tracked-buffer)) (tracked-buffer-line-pos)) (with-current-buffer tracked-buffer - (set (make-local-variable 'overlay-arrow-position) (make-marker)) + (setq-local overlay-arrow-position (make-marker)) (setq tracked-buffer-line-pos (progn (goto-char (point-min)) (forward-line (1- line-number)) @@ -5535,48 +5535,43 @@ REPORT-FN is Flymake's callback function." "Major mode for editing Python files. \\{python-mode-map}" - (set (make-local-variable 'tab-width) 8) - (set (make-local-variable 'indent-tabs-mode) nil) + (setq-local tab-width 8) + (setq-local indent-tabs-mode nil) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) "#+\\s-*") + (setq-local comment-start "# ") + (setq-local comment-start-skip "#+\\s-*") - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'parse-sexp-ignore-comments) t) + (setq-local parse-sexp-lookup-properties t) + (setq-local parse-sexp-ignore-comments t) - (set (make-local-variable 'forward-sexp-function) - 'python-nav-forward-sexp) + (setq-local forward-sexp-function #'python-nav-forward-sexp) - (set (make-local-variable 'font-lock-defaults) - `(,python-font-lock-keywords - nil nil nil nil - (font-lock-syntactic-face-function - . python-font-lock-syntactic-face-function))) + (setq-local font-lock-defaults + `(,python-font-lock-keywords + nil nil nil nil + (font-lock-syntactic-face-function + . python-font-lock-syntactic-face-function))) - (set (make-local-variable 'syntax-propertize-function) - python-syntax-propertize-function) + (setq-local syntax-propertize-function + python-syntax-propertize-function) - (set (make-local-variable 'indent-line-function) - #'python-indent-line-function) - (set (make-local-variable 'indent-region-function) #'python-indent-region) + (setq-local indent-line-function #'python-indent-line-function) + (setq-local indent-region-function #'python-indent-region) ;; Because indentation is not redundant, we cannot safely reindent code. - (set (make-local-variable 'electric-indent-inhibit) t) - (set (make-local-variable 'electric-indent-chars) - (cons ?: electric-indent-chars)) + (setq-local electric-indent-inhibit t) + (setq-local electric-indent-chars + (cons ?: electric-indent-chars)) ;; Add """ ... """ pairing to electric-pair-mode. (add-hook 'post-self-insert-hook #'python-electric-pair-string-delimiter 'append t) - (set (make-local-variable 'paragraph-start) "\\s-*$") - (set (make-local-variable 'fill-paragraph-function) - #'python-fill-paragraph) - (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill) + (setq-local paragraph-start "\\s-*$") + (setq-local fill-paragraph-function #'python-fill-paragraph) + (setq-local normal-auto-fill-function #'python-do-auto-fill) - (set (make-local-variable 'beginning-of-defun-function) - #'python-nav-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) - #'python-nav-end-of-defun) + (setq-local beginning-of-defun-function #'python-nav-beginning-of-defun) + (setq-local end-of-defun-function #'python-nav-end-of-defun) (add-hook 'completion-at-point-functions #'python-completion-at-point nil 'local) @@ -5584,26 +5579,25 @@ REPORT-FN is Flymake's callback function." (add-hook 'post-self-insert-hook #'python-indent-post-self-insert-function 'append 'local) - (set (make-local-variable 'imenu-create-index-function) - #'python-imenu-create-index) + (setq-local imenu-create-index-function + #'python-imenu-create-index) - (set (make-local-variable 'add-log-current-defun-function) - #'python-info-current-defun) + (setq-local add-log-current-defun-function + #'python-info-current-defun) (add-hook 'which-func-functions #'python-info-current-defun nil t) - (set (make-local-variable 'skeleton-further-elements) - '((abbrev-mode nil) - (< '(backward-delete-char-untabify (min python-indent-offset - (current-column)))) - (^ '(- (1+ (current-indentation)))))) + (setq-local skeleton-further-elements + '((abbrev-mode nil) + (< '(backward-delete-char-untabify (min python-indent-offset + (current-column)))) + (^ '(- (1+ (current-indentation)))))) (with-no-warnings ;; suppress warnings about eldoc-documentation-function being obsolete (if (null eldoc-documentation-function) ;; Emacs<25 - (set (make-local-variable 'eldoc-documentation-function) - #'python-eldoc-function) + (setq-local eldoc-documentation-function #'python-eldoc-function) (if (boundp 'eldoc-documentation-functions) (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t) (add-function :before-until (local 'eldoc-documentation-function) @@ -5620,16 +5614,14 @@ REPORT-FN is Flymake's callback function." python-hideshow-forward-sexp-function nil)) - (set (make-local-variable 'outline-regexp) - (python-rx (* space) block-start)) - (set (make-local-variable 'outline-heading-end-regexp) ":[^\n]*\n") - (set (make-local-variable 'outline-level) - #'(lambda () - "`outline-level' function for Python mode." - (1+ (/ (current-indentation) python-indent-offset)))) + (setq-local outline-regexp (python-rx (* space) block-start)) + (setq-local outline-heading-end-regexp ":[^\n]*\n") + (setq-local outline-level + (lambda () + "`outline-level' function for Python mode." + (1+ (/ (current-indentation) python-indent-offset)))) - (set (make-local-variable 'prettify-symbols-alist) - python-prettify-symbols-alist) + (setq-local prettify-symbols-alist python-prettify-symbols-alist) (python-skeleton-add-menu-items) commit 6e84addc51f3817052d852b73f00057a9af5b9c8 Author: Lars Ingebrigtsen Date: Sat Dec 12 12:48:53 2020 +0100 Preserve point in dired buffers in dired-*-find-file* commands * lisp/dired.el (dired--find-file): New function (bug#28949). (dired-find-file): Use it. (dired-mouse-find-file): Ditto. (dired-find-file-other-window): Ditto. diff --git a/lisp/dired.el b/lisp/dired.el index 6ad2497c9a..baf99da7b4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2501,6 +2501,10 @@ directory in another window." (defun dired-find-file () "In Dired, visit the file or directory named on this line." (interactive) + (dired--find-file #'find-file (dired-get-file-for-visit))) + +(defun dired--find-file (find-file-function file) + "Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables." ;; Bind `find-file-run-dired' so that the command works on directories ;; too, independent of the user's setting. (let ((find-file-run-dired t) @@ -2513,7 +2517,7 @@ directory in another window." (if dired-auto-revert-buffer nil switch-to-buffer-preserve-window-point))) - (find-file (dired-get-file-for-visit)))) + (funcall find-file-function file))) (defun dired-find-alternate-file () "In Dired, visit file or directory on current line via `find-alternate-file'. @@ -2549,7 +2553,7 @@ respectively." (select-window window) (funcall find-dir-func file))) (select-window window) - (funcall find-file-func (file-name-sans-versions file t))))) + (dired--find-file find-file-func (file-name-sans-versions file t))))) (defun dired-mouse-find-file-other-window (event) "In Dired, visit the file or directory name you click on in another window." @@ -2576,7 +2580,7 @@ Otherwise, display it in another buffer." (defun dired-find-file-other-window () "In Dired, visit this file or directory in another window." (interactive) - (find-file-other-window (dired-get-file-for-visit))) + (dired--find-file #'find-file-other-window (dired-get-file-for-visit))) (defun dired-display-file () "In Dired, display this file or directory in another window." commit f6cafe657402805f21a9651071f9768f92dacc76 Author: Lars Ingebrigtsen Date: Sat Dec 12 12:32:15 2020 +0100 Make dired-toggle-read-only check whether the directory is writable * lisp/dired.el (dired-toggle-read-only): Check that the directory is writable (bug#29412). diff --git a/lisp/dired.el b/lisp/dired.el index 30b9f5b8fa..6ad2497c9a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2419,6 +2419,8 @@ If the current buffer can be edited with Wdired, (i.e. the major mode is `dired-mode'), call `wdired-change-to-wdired-mode'. Otherwise, toggle `read-only-mode'." (interactive) + (unless (file-writable-p default-directory) + (user-error "Directory %s isn't writeable" default-directory)) (if (derived-mode-p 'dired-mode) (wdired-change-to-wdired-mode) (read-only-mode 'toggle))) commit 204d1519401571387a9d3046a2f79fe421404284 Author: Eli Zaretskii Date: Sat Dec 12 13:25:35 2020 +0200 Unbreak the MS-Windows build broken by recent changes * src/image.c (rsvg_handle_set_dpi_x_y) [WINDOWSNT]: DEF_DLL_FN it. (init_svg_functions): LOAD_DLL_FN rsvg_handle_set_dpi_x_y. : Define as a macro diff --git a/src/image.c b/src/image.c index 63033572ed..bc354c1a66 100644 --- a/src/image.c +++ b/src/image.c @@ -9583,6 +9583,9 @@ DEF_DLL_FN (gboolean, rsvg_handle_write, DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **)); # endif +DEF_DLL_FN (void, rsvg_handle_set_dpi_x_y, + (RsvgHandle * handle, double dpi_x, double dpi_y)); + # if LIBRSVG_CHECK_VERSION (2, 46, 0) DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions, (RsvgHandle *, gboolean *, RsvgLength *, gboolean *, @@ -9639,6 +9642,7 @@ init_svg_functions (void) LOAD_DLL_FN (library, rsvg_handle_write); LOAD_DLL_FN (library, rsvg_handle_close); #endif + LOAD_DLL_FN (library, rsvg_handle_set_dpi_x_y); #if LIBRSVG_CHECK_VERSION (2, 46, 0) LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); @@ -9694,6 +9698,7 @@ init_svg_functions (void) # undef rsvg_handle_set_base_uri # undef rsvg_handle_write # endif +# undef rsvg_handle_set_dpi_x_y # define gdk_pixbuf_get_bits_per_sample fn_gdk_pixbuf_get_bits_per_sample # define gdk_pixbuf_get_colorspace fn_gdk_pixbuf_get_colorspace @@ -9727,6 +9732,7 @@ init_svg_functions (void) # define rsvg_handle_set_base_uri fn_rsvg_handle_set_base_uri # define rsvg_handle_write fn_rsvg_handle_write # endif +# define rsvg_handle_set_dpi_x_y fn_rsvg_handle_set_dpi_x_y # endif /* !WINDOWSNT */ commit b41942fac93b3a817a7b7848c2bd05ee15a4f6f2 Author: Lars Ingebrigtsen Date: Sat Dec 12 12:20:38 2020 +0100 Improve the documentation of marker handling when reverting * doc/lispref/backups.texi (Reverting): Mention markers from non-file sources (bug#30028). * lisp/files.el (revert-buffer): Mention what happens with markers (bug#30028). * src/fileio.c (Finsert_file_contents): Say a bit more about what markers are restored (bug#30028). diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index 379279575c..c20ef6830a 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -706,7 +706,11 @@ contents and the file contents are identical before the revert operation, reverting preserves all the markers. If they are not identical, reverting does change the buffer; in that case, it preserves the markers in the unchanged text (if any) at the beginning and end of -the buffer. Preserving any additional markers would be problematical. +the buffer. Preserving any additional markers would be problematic. + +When reverting from non-file sources, markers are usually not +preserved, but this is up to the specific @code{revert-buffer-function} +implementation. @end deffn @defvar revert-buffer-in-progress-p diff --git a/lisp/files.el b/lisp/files.el index a89d39e784..093b5f92e5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6119,6 +6119,9 @@ This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. +Reverting a buffer will try to preserve markers in the buffer; +see the Info node `(elisp)Reverting' for details. + This command also implements an interface for special buffers that contain text that doesn't come from a file, but reflects some other data instead (e.g. Dired buffers, `buffer-list' diff --git a/src/fileio.c b/src/fileio.c index 283813ff89..702c143828 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3757,9 +3757,10 @@ characters in the buffer. If VISIT is non-nil, BEG and END must be nil. If optional fifth argument REPLACE is non-nil, replace the current buffer contents (in the accessible portion) with the file contents. This is better than simply deleting and inserting the whole thing -because (1) it preserves some marker positions and (2) it puts less data -in the undo list. When REPLACE is non-nil, the second return value is -the number of characters that replace previous buffer contents. +because (1) it preserves some marker positions (in unchanged portions +at the start and end of the buffer) and (2) it puts less data in the +undo list. When REPLACE is non-nil, the second return value is the +number of characters that replace previous buffer contents. This function does code conversion according to the value of `coding-system-for-read' or `file-coding-system-alist', and sets the commit 61b6cc401a9adf7f718c1c9c4350181ecd413f1c Author: Eli Zaretskii Date: Sat Dec 12 13:12:57 2020 +0200 Improve support for 'memory-report' on MS-Windows * src/w32term.c (w32_image_size): New function. * src/image.c (image_frame_cache_size) [HAVE_NTGUI]: Support reporting the size of frame image cache. (image_frame_cache_size, Fimage_cache_size): The total size is now of the type 'size_t', not 'int'. diff --git a/src/image.c b/src/image.c index 79b275cba9..63033572ed 100644 --- a/src/image.c +++ b/src/image.c @@ -1792,11 +1792,11 @@ which is then usually a filename. */) return Qnil; } -static int +static size_t image_frame_cache_size (struct frame *f) { - int total = 0; -#ifdef USE_CAIRO + size_t total = 0; +#if defined USE_CAIRO struct image_cache *c = FRAME_IMAGE_CACHE (f); if (!c) @@ -1810,6 +1810,19 @@ image_frame_cache_size (struct frame *f) total += img->pixmap->width * img->pixmap->height * img->pixmap->bits_per_pixel / 8; } +#elif defined HAVE_NTGUI + struct image_cache *c = FRAME_IMAGE_CACHE (f); + + if (!c) + return 0; + + for (ptrdiff_t i = 0; i < c->used; ++i) + { + struct image *img = c->images[i]; + + if (img && img->pixmap && img->pixmap != NO_PIXMAP) + total += w32_image_size (img); + } #endif return total; } @@ -1819,7 +1832,7 @@ DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0, (void) { Lisp_Object tail, frame; - int total = 0; + size_t total = 0; FOR_EACH_FRAME (tail, frame) if (FRAME_WINDOW_P (XFRAME (frame))) diff --git a/src/w32gui.h b/src/w32gui.h index dfec1f0861..fc8131130f 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -46,6 +46,7 @@ extern int w32_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data); extern bool w32_can_use_native_image_api (Lisp_Object); extern void w32_gdiplus_shutdown (void); +extern size_t w32_image_size (struct image *); #define FACE_DEFAULT (~0) diff --git a/src/w32term.c b/src/w32term.c index 23cb380040..dc5cd1f699 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1991,6 +1991,17 @@ w32_draw_image_foreground (struct glyph_string *s) RestoreDC (s->hdc ,-1); } +size_t +w32_image_size (struct image *img) +{ + BITMAP bm_info; + size_t rv = 0; + + if (GetObject (img->pixmap, sizeof (BITMAP), &bm_info)) + rv = bm_info.bmWidth * bm_info.bmHeight * bm_info.bmBitsPixel / 8; + return rv; +} + /* Draw a relief around the image glyph string S. */ commit dba74cb5ec1c1abfbee236bbcf811b023bb19d4f Author: Pankaj Jangid Date: Sat Dec 12 11:47:12 2020 +0100 Allow customizing the Gnus summary thread indicators * doc/misc/gnus.texi (Summary Buffer Lines): Document them. * lisp/gnus/gnus-sum.el (gnus-summary-prepare-threads): Use them. * lisp/gnus/gnus-sum.el (gnus-sum-opening-bracket) (gnus-sum-closing-bracket, gnus-sum-opening-bracket-adopted) (gnus-sum-closing-bracket-adopted): New variables. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 4aa07ce388..cfd3ceda3f 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -5028,10 +5028,37 @@ Nothing if the article is a root and lots of spaces if it isn't (it pushes everything after it off the screen). @item [ Opening bracket, which is normally @samp{[}, but can also be @samp{<} -for adopted articles (@pxref{Customizing Threading}). +for adopted articles (@pxref{Customizing Threading}). This can be +customized using following settings: + +@table @code +@item gnus-sum-opening-bracket +@vindex gnus-sum-opening-bracket +Opening bracket for normal (non-adopted) articles. The default is +@samp{[}. + +@item gnus-sum-opening-bracket-adopted +@vindex gnus-sum-opening-bracket-adopted +Opening bracket for adopted articles. The default is @samp{<}. + +@end table + @item ] Closing bracket, which is normally @samp{]}, but can also be @samp{>} -for adopted articles. +for adopted articles. This can be customised using following settings: + +@table @code +@item gnus-sum-closing-bracket +@vindex gnus-sum-closing-bracket +Closing bracket for normal (non-adopted) articles. The default is +@samp{]}. + +@item gnus-sum-closing-bracket-adopted +@vindex gnus-sum-opening-bracket-adopted +Closing bracket for adopted articles. The default is @samp{>}. + +@end table + @item > One space for each thread level. @item < diff --git a/etc/NEWS b/etc/NEWS index 26e4b8514f..9aa735da72 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -510,6 +510,19 @@ tags to be considered as well. ** Gnus ++++ +*** New user options to customise the summary line specs %[ and %]. +Four new options introduced in customisation group +'gnus-summary-format'. These are 'gnus-sum-opening-bracket', +'gnus-sum-closing-bracket', 'gnus-sum-opening-bracket-adopted', and +'gnus-sum-closing-bracket-adopted'. Their default values are '[', ']', +'<', '>' respectively. These variables control the appearance of '%[' +and '%]' specs in the summary line format. '%[' will normally display +the value of 'gnus-sum-opening-bracket', but can also be +'gnus-sum-opening-bracket-adopted' for the adopted articles. '%]' will +normally display the value of 'gnus-sum-closing-bracket', but can also +be 'gnus-sum-closing-bracket-adopted' for the adopted articles. + +++ *** New user option 'gnus-paging-select-next'. This controls what happens when using commands like 'SPC' and 'DEL' to diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9432eefcb4..9488b32487 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1460,8 +1460,8 @@ the normal Gnus MIME machinery." (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) (?R gnus-tmp-replied ?c) - (?\[ gnus-tmp-opening-bracket ?c) - (?\] gnus-tmp-closing-bracket ?c) + (?\[ gnus-tmp-opening-bracket ?s) + (?\] gnus-tmp-closing-bracket ?s) (?\> (make-string gnus-tmp-level ? ) ?s) (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) (?i gnus-tmp-score ?d) @@ -3748,6 +3748,30 @@ buffer that was in action when the last article was fetched." (inline (gnus-summary-extract-address-component gnus-tmp-from)))))) +(defcustom gnus-sum-opening-bracket "[" + "With %[ spec, used to identify normal (non-adopted) articles." + :version "28.1" + :type 'string + :group 'gnus-summary-format) + +(defcustom gnus-sum-closing-bracket "]" + "With %] spec, used to identify normal (non-adopted) articles." + :version "28.1" + :type 'string + :group 'gnus-summary-format) + +(defcustom gnus-sum-opening-bracket-adopted "<" + "With %[ spec, used to identify adopted articles." + :version "28.1" + :type 'string + :group 'gnus-summary-format) + +(defcustom gnus-sum-closing-bracket-adopted ">" + "With %] spec, used to identify adopted articles." + :version "28.1" + :type 'string + :group 'gnus-summary-format) + (defun gnus-summary-insert-line (header level current undownloaded unread replied expirable subject-or-nil &optional dummy score process) @@ -3805,8 +3829,14 @@ buffer that was in action when the last article was fetched." (1+ (match-beginning 0)) (1- (match-end 0)))) (t gnus-tmp-from))) (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) - (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) + (gnus-tmp-opening-bracket + (if gnus-tmp-dummy + gnus-sum-opening-bracket-adopted + gnus-sum-opening-bracket)) + (gnus-tmp-closing-bracket + (if gnus-tmp-dummy + gnus-sum-closing-bracket-adopted + gnus-sum-closing-bracket)) (inhibit-read-only t)) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) @@ -5439,10 +5469,10 @@ or a straight list of headers." (if (and (eq gnus-summary-make-false-root 'adopt) (= gnus-tmp-level 1) (memq number gnus-tmp-gathered)) - (setq gnus-tmp-opening-bracket ?\< - gnus-tmp-closing-bracket ?\>) - (setq gnus-tmp-opening-bracket ?\[ - gnus-tmp-closing-bracket ?\])) + (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket-adopted + gnus-tmp-closing-bracket gnus-sum-closing-bracket-adopted) + (setq gnus-tmp-opening-bracket gnus-sum-opening-bracket + gnus-tmp-closing-bracket gnus-sum-closing-bracket)) (if (>= gnus-tmp-level (length gnus-thread-indent-array)) (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array)) commit 404f12060ca43d100a0609f2658dd487f6a50ebd Author: Alan Third Date: Fri Dec 11 19:52:20 2020 +0000 Improve some NS drawing code * src/nsterm.m (ns_update_end): There's no need to schedule a redraw if nothing has been changed. (ns_set_vertical_scroll_bar): (ns_set_horizontal_scroll_bar): Fix the logic for clearing under the scrollbars. (ns_clear_under_internal_border): No need to clip, the default clipping rectangle will be fine. diff --git a/src/nsterm.m b/src/nsterm.m index 0729c961bd..7972fa4dab 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1166,7 +1166,6 @@ static NSRect constrain_frame_rect(NSRect frameRect, bool isFullscreen) { #endif [NSGraphicsContext setCurrentContext:nil]; - [view setNeedsDisplay:YES]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } else @@ -3056,7 +3055,7 @@ so some key presses (TAB) are swallowed by the system. */ if (!face) return; - ns_focus (f, &frame_rect, 1); + ns_focus (f, NULL, 1); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; for (int i = 0; i < 4 ; i++) { @@ -4987,8 +4986,8 @@ in certain situations (rapid incoming events). [bar removeFromSuperview]; wset_vertical_scroll_bar (window, Qnil); [bar release]; + ns_clear_frame_area (f, left, top, width, height); } - ns_clear_frame_area (f, left, top, width, height); unblock_input (); return; } @@ -5010,7 +5009,7 @@ in certain situations (rapid incoming events). r.size.width = oldRect.size.width; if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r)) { - if (oldRect.origin.x != r.origin.x) + if (! NSEqualRects (oldRect, r)) ns_clear_frame_area (f, left, top, width, height); [bar setFrame: r]; } @@ -5088,8 +5087,7 @@ in certain situations (rapid incoming events). oldRect = [bar frame]; if (FRAME_LIVE_P (f) && !NSEqualRects (oldRect, r)) { - if (oldRect.origin.y != r.origin.y) - ns_clear_frame_area (f, left, top, width, height); + ns_clear_frame_area (f, left, top, width, height); [bar setFrame: r]; update_p = YES; } commit 03ac24f23971d8b5c85ec9383135eb7768226bb6 Author: Alan Third Date: Wed Dec 9 00:02:44 2020 +0000 Use real DPI when rendering SVGs (bug#45124) * src/image.c (svg_css_length_to_pixels): Pass in a DPI value instead of using a hard coded value. (svg_load_image): Set the DPI on the rsvg_handle, and pass it to svg_css_length_to_pixels. diff --git a/src/image.c b/src/image.c index 7012003ea1..79b275cba9 100644 --- a/src/image.c +++ b/src/image.c @@ -9776,11 +9776,8 @@ svg_load (struct frame *f, struct image *img) #if LIBRSVG_CHECK_VERSION (2, 46, 0) static double -svg_css_length_to_pixels (RsvgLength length) +svg_css_length_to_pixels (RsvgLength length, double dpi) { - /* FIXME: 96 appears to be a pretty standard DPI but we should - probably use the real DPI if we can get it. */ - double dpi = 96; double value = length.length; switch (length.unit) @@ -9854,6 +9851,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file, RSVG_HANDLE_FLAGS_NONE, NULL, &err); + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); + if (base_file) g_object_unref (base_file); g_object_unref (input_stream); @@ -9865,6 +9865,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new (); eassume (rsvg_handle); + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); + /* Set base_uri for properly handling referenced images (via 'href'). Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" @@ -9889,6 +9892,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, /* Try the instrinsic dimensions first. */ gboolean has_width, has_height, has_viewbox; RsvgLength iwidth, iheight; + double dpi = FRAME_DISPLAY_INFO (f)->resx; rsvg_handle_get_intrinsic_dimensions (rsvg_handle, &has_width, &iwidth, @@ -9898,19 +9902,19 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (has_width && has_height) { /* Success! We can use these values directly. */ - viewbox_width = svg_css_length_to_pixels (iwidth); - viewbox_height = svg_css_length_to_pixels (iheight); + viewbox_width = svg_css_length_to_pixels (iwidth, dpi); + viewbox_height = svg_css_length_to_pixels (iheight, dpi); } else if (has_width && has_viewbox) { - viewbox_width = svg_css_length_to_pixels (iwidth); - viewbox_height = svg_css_length_to_pixels (iwidth) + viewbox_width = svg_css_length_to_pixels (iwidth, dpi); + viewbox_height = svg_css_length_to_pixels (iwidth, dpi) * viewbox.width / viewbox.height; } else if (has_height && has_viewbox) { - viewbox_height = svg_css_length_to_pixels (iheight); - viewbox_width = svg_css_length_to_pixels (iheight) + viewbox_height = svg_css_length_to_pixels (iheight, dpi); + viewbox_width = svg_css_length_to_pixels (iheight, dpi) * viewbox.height / viewbox.width; } else if (has_viewbox) @@ -10019,6 +10023,10 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new_from_stream_sync (input_stream, base_file, RSVG_HANDLE_FLAGS_NONE, NULL, &err); + + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); + if (base_file) g_object_unref (base_file); g_object_unref (input_stream); @@ -10030,6 +10038,9 @@ svg_load_image (struct frame *f, struct image *img, char *contents, rsvg_handle = rsvg_handle_new (); eassume (rsvg_handle); + rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx, + FRAME_DISPLAY_INFO (f)->resy); + /* Set base_uri for properly handling referenced images (via 'href'). Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" commit a8e2143a5c03785742464406306fda7fce6caf04 Author: Zajcev Evgeny Date: Thu Dec 3 18:37:18 2020 +0300 Explicitly specify svg base_uri using `:base-uri' image property * src/image.c (svg_load): Check `:base-uri' image property to explicitly set base_uri for images embedded into SVG diff --git a/src/image.c b/src/image.c index 0dd108a96b..7012003ea1 100644 --- a/src/image.c +++ b/src/image.c @@ -9724,10 +9724,11 @@ static bool svg_load (struct frame *f, struct image *img) { bool success_p = 0; - Lisp_Object file_name; + Lisp_Object file_name, base_uri; /* If IMG->spec specifies a file name, create a non-file spec from it. */ file_name = image_spec_value (img->spec, QCfile, NULL); + base_uri = image_spec_value (img->spec, QCbase_uri, NULL); if (STRINGP (file_name)) { int fd; @@ -9747,15 +9748,16 @@ svg_load (struct frame *f, struct image *img) return 0; } /* If the file was slurped into memory properly, parse it. */ - success_p = svg_load_image (f, img, contents, size, - SSDATA (ENCODE_FILE (file))); + if (!STRINGP (base_uri)) + base_uri = ENCODE_FILE (file); + success_p = svg_load_image (f, img, contents, size, SSDATA (base_uri)); xfree (contents); } /* Else it's not a file, it's a Lisp object. Load the image from a Lisp object rather than a file. */ else { - Lisp_Object data, original_filename; + Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) @@ -9763,10 +9765,10 @@ svg_load (struct frame *f, struct image *img) image_error ("Invalid image data `%s'", data); return 0; } - original_filename = BVAR (current_buffer, filename); + if (!STRINGP (base_uri)) + base_uri = BVAR (current_buffer, filename); success_p = svg_load_image (f, img, SSDATA (data), SBYTES (data), - (NILP (original_filename) ? NULL - : SSDATA (original_filename))); + (NILP (base_uri) ? NULL : SSDATA (base_uri))); } return success_p; @@ -9864,6 +9866,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, eassume (rsvg_handle); /* Set base_uri for properly handling referenced images (via 'href'). + Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10028,6 +10031,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, eassume (rsvg_handle); /* Set base_uri for properly handling referenced images (via 'href'). + Can be explicitly specified using `:base_uri' image property. See rsvg bug 596114 - "image refs are relative to curdir, not .svg file" . */ if (filename) @@ -10710,6 +10714,7 @@ non-numeric, there is no explicit limit on the size of images. */); #if defined (HAVE_RSVG) DEFSYM (Qsvg, "svg"); + DEFSYM (QCbase_uri, ":base-uri"); add_image_type (Qsvg); #ifdef HAVE_NTGUI /* Other libraries used directly by svg code. */