commit ca36669c8884d1254206a1e3e919cf65ea427b7e (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Mon Dec 21 05:55:32 2020 +0100 Fix problem with entering Gnus groups when Gnus isn't running * lisp/gnus/gnus-sum.el (gnus-update-summary-mark-positions): Don't bug out when Gnus isn't running (bug#45330). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a0e7173998..38edc772f8 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3658,6 +3658,7 @@ buffer that was in action when the last article was fetched." ;; so we don't call gnus-data- accessors on nil. (gnus-newsgroup-data gnus--dummy-data-list) (gnus-newsgroup-downloadable '(0)) + (gnus-visual nil) case-fold-search ignores) ;; Here, all marks are bound to Z. (gnus-summary-insert-line gnus--dummy-mail-header commit b2ce94fa5eecee0afd0e6237956cfb2b02b8bb0b Author: Dario Gjorgjevski Date: Mon Dec 21 05:40:38 2020 +0100 Make python-mode fontify more assignment statements * lisp/progmodes/python.el (python-font-lock-assignment-matcher): New function to match assignment statements. (python-rx): Add `assignment-target' and `grouped-assignment-target'. (python-font-lock-keywords-maximum-decoration): Add new matchers (bug#45341). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d58b32f3c3..50bb841111 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -394,6 +394,12 @@ This variant of `rx' supports common Python named REGEXPS." (any ?' ?\") "__main__" (any ?' ?\") (* space) ?:)) (symbol-name (seq (any letter ?_) (* (any word ?_)))) + (assignment-target (seq (? ?*) + (* symbol-name ?.) symbol-name + (? ?\[ (+ (not ?\])) ?\]))) + (grouped-assignment-target (seq (? ?*) + (* symbol-name ?.) (group symbol-name) + (? ?\[ (+ (not ?\])) ?\]))) (open-paren (or "{" "[" "(")) (close-paren (or "}" "]" ")")) (simple-operator (any ?+ ?- ?/ ?& ?^ ?~ ?| ?* ?< ?> ?= ?%)) @@ -605,6 +611,18 @@ This is the medium decoration level, including everything in `python-font-lock-keywords-level-1', as well as keywords and builtins.") +(defun python-font-lock-assignment-matcher (regexp) + "Font lock matcher for assignments based on REGEXP. +Return nil if REGEXP matched within a `paren' context (to avoid, +e.g., default values for arguments or passing arguments by name +being treated as assignments) or is followed by an '=' sign (to +avoid '==' being treated as an assignment." + (lambda (limit) + (let ((res (re-search-forward regexp limit t))) + (unless (or (python-syntax-context 'paren) + (equal (char-after (point)) ?=)) + res)))) + (defvar python-font-lock-keywords-maximum-decoration `((python--font-lock-f-strings) ,@python-font-lock-keywords-level-2 @@ -652,33 +670,57 @@ builtins.") ) symbol-end) . font-lock-type-face) - ;; assignments - ;; support for a = b = c = 5 - (,(lambda (limit) - (let ((re (python-rx (group symbol-name) - ;; subscript, like "[5]" - (? ?\[ (+ (not ?\])) ?\]) (* space) - ;; type hint, like ": int" or ": Mapping[int, str]" - (? ?: (* space) (+ not-simple-operator) (* space)) - assignment-operator)) - (res nil)) - (while (and (setq res (re-search-forward re limit t)) - (or (python-syntax-context 'paren) - (equal (char-after (point)) ?=)))) - res)) - (1 font-lock-variable-name-face nil nil)) - ;; support for a, b, c = (1, 2, 3) - (,(lambda (limit) - (let ((re (python-rx (group symbol-name) (* space) - (* ?, (* space) symbol-name (* space)) - ?, (* space) symbol-name (* space) - assignment-operator)) - (res nil)) - (while (and (setq res (re-search-forward re limit t)) - (goto-char (match-end 1)) - (python-syntax-context 'paren))) - res)) - (1 font-lock-variable-name-face nil nil))) + ;; multiple assignment + ;; (note that type hints are not allowed for multiple assignments) + ;; a, b, c = 1, 2, 3 + ;; a, *b, c = 1, 2, 3, 4, 5 + ;; [a, b] = (1, 2) + ;; (l[1], l[2]) = (10, 11) + ;; (a, b, c, *d) = *x, y = 5, 6, 7, 8, 9 + ;; (a,) = 'foo' + ;; (*a,) = ['foo', 'bar', 'baz'] + ;; d.x, d.y[0], *d.z = 'a', 'b', 'c', 'd', 'e' + ;; and variants thereof + ;; the cases + ;; (a) = 5 + ;; [a] = 5 + ;; [*a] = 5, 6 + ;; are handled separately below + (,(python-font-lock-assignment-matcher + (python-rx (? (or "[" "(") (* space)) + grouped-assignment-target (* space) ?, (* space) + (* assignment-target (* space) ?, (* space)) + (? assignment-target (* space)) + (? ?, (* space)) + (? (or ")" "]") (* space)) + (group assignment-operator))) + (1 font-lock-variable-name-face) + (,(python-rx grouped-assignment-target) + (progn + (goto-char (match-end 1)) ; go back after the first symbol + (match-beginning 2)) ; limit the search until the assignment + nil + (1 font-lock-variable-name-face))) + ;; single assignment with type hints, e.g. + ;; a: int = 5 + ;; b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo') + ;; c: Collection = {1, 2, 3} + ;; d: Mapping[int, str] = {1: 'bar', 2: 'baz'} + (,(python-font-lock-assignment-matcher + (python-rx grouped-assignment-target (* space) + (? ?: (* space) (+ not-simple-operator) (* space)) + assignment-operator)) + (1 font-lock-variable-name-face)) + ;; special cases + ;; (a) = 5 + ;; [a] = 5 + ;; [*a] = 5, 6 + (,(python-font-lock-assignment-matcher + (python-rx (or "[" "(") (* space) + grouped-assignment-target (* space) + (or ")" "]") (* space) + assignment-operator)) + (1 font-lock-variable-name-face))) "Font lock keywords to use in python-mode for maximum decoration. This decoration level includes everything in commit 759ec257699d734de2ba733bcc204745500b9b23 Author: Dmitry Gutov Date: Mon Dec 21 03:38:37 2020 +0200 Generic-ify xref-location-column * lisp/progmodes/xref.el (xref-location-column): Create a generic from xref-file-location-column, to use in the common rendering code (bug#36967). (xref--insert-xrefs): Update accordingly. * test/lisp/progmodes/xref-tests.el (xref-matches-in-directory-finds-two-matches-on-the-same-line) (xref-matches-in-directory-finds-an-empty-line-regexp-match): Ditto. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index f33dfb4f5d..181f94b0bc 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -97,6 +97,10 @@ This is typically the filename.") "Return the line number corresponding to the location." nil) +(cl-defgeneric xref-location-column (_location) + "Return the exact column corresponding to the location." + nil) + (cl-defgeneric xref-match-length (_item) "Return the length of the match." nil) @@ -118,7 +122,7 @@ part of the file name." (defclass xref-file-location (xref-location) ((file :type string :initarg :file) (line :type fixnum :initarg :line :reader xref-location-line) - (column :type fixnum :initarg :column :reader xref-file-location-column)) + (column :type fixnum :initarg :column :reader xref-location-column)) :documentation "A file location is a file/line/column triple. Line numbers start from 1 and columns from 0.") @@ -869,7 +873,7 @@ GROUP is a string for decoration purposes and XREF is an " "))) ;; Render multiple matches on the same line, together. (when (and line (equal prev-line-key line-key)) - (let ((column (xref-file-location-column location))) + (when-let ((column (xref-location-column location))) (delete-region (save-excursion (forward-line -1) diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 038f9d0e30..e220d09dad 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -52,8 +52,8 @@ (should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 1 locs)))) - (should (equal 0 (xref-file-location-column (nth 0 locs)))) - (should (equal 4 (xref-file-location-column (nth 1 locs)))))) + (should (equal 0 (xref-location-column (nth 0 locs)))) + (should (equal 4 (xref-location-column (nth 1 locs)))))) (ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match () (let* ((matches (xref-matches-in-directory "^$" "*" xref-tests-data-dir nil)) @@ -61,7 +61,7 @@ (should (= 1 (length matches))) (should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) - (should (equal 0 (xref-file-location-column (nth 0 locs)))))) + (should (equal 0 (xref-location-column (nth 0 locs)))))) (ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 () (let* ((xrefs (xref-matches-in-directory "foo" "*" xref-tests-data-dir nil)) commit c3ad28c29098e3dd7c14dc2a8399d08e06d77f51 Author: Juri Linkov Date: Mon Dec 21 03:22:23 2020 +0200 De-duplicate lines in Xref buffers * lisp/progmodes/xref.el (xref--insert-xrefs): Render matches coming from the same line together (bug#36967). (xref--item-at-point): Account for the above. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 6e99e9d8ac..f33dfb4f5d 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -613,9 +613,9 @@ SELECT is `quit', also quit the *xref* window." (xref-show-location-at-point)) (defun xref--item-at-point () - (save-excursion - (back-to-indentation) - (get-text-property (point) 'xref-item))) + (get-text-property + (if (eolp) (1- (point)) (point)) + 'xref-item)) (defun xref-goto-xref (&optional quit) "Jump to the xref on the current line and select its window. @@ -853,17 +853,30 @@ GROUP is a string for decoration purposes and XREF is an (length (and line (format "%d" line))))) for line-format = (and max-line-width (format "%%%dd: " max-line-width)) + with prev-line-key = nil do (xref--insert-propertized '(face xref-file-header xref-group t) group "\n") (cl-loop for (xref . more2) on xrefs do (with-slots (summary location) xref (let* ((line (xref-location-line location)) + (new-summary summary) + (line-key (list (xref-location-group location) line)) (prefix (if line (propertize (format line-format line) 'face 'xref-line-number) " "))) + ;; Render multiple matches on the same line, together. + (when (and line (equal prev-line-key line-key)) + (let ((column (xref-file-location-column location))) + (delete-region + (save-excursion + (forward-line -1) + (move-to-column (+ (length prefix) column)) + (point)) + (point)) + (setq new-summary (substring summary column) prefix ""))) (xref--insert-propertized (list 'xref-item xref 'mouse-face 'highlight @@ -871,7 +884,8 @@ GROUP is a string for decoration purposes and XREF is an 'help-echo (concat "mouse-2: display in another window, " "RET or mouse-1: follow reference")) - prefix summary))) + prefix new-summary) + (setq prev-line-key line-key))) (insert "\n")))) (defun xref--analyze (xrefs) commit 174607e5ff014fb68bea4945f6199e8da1261788 Author: Philipp Stephani Date: Mon Dec 21 00:17:56 2020 +0100 Unbreak build after commit 1a0a11f7d2d1dbecb9f754b1e129d50e489058e6. The commit only changed a comment in 'struct buffer', so the portable dumper doesn't need to be adapted. * src/pdumper.c (dump_buffer): Update hash for 'struct buffer'. diff --git a/src/pdumper.c b/src/pdumper.c index 0096a4d45a..f31e588897 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2692,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_EE36B4292E +#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; commit 537e96f6ac58099d3f422eac9d78d54716aeb014 Author: Alan Third Date: Sun Dec 20 16:03:52 2020 +0000 Fix image cache lookup * src/image.c (lookup_image): ignore_colors should be false as we want to search for images with matching colors. diff --git a/src/image.c b/src/image.c index d0ae44e7df..29cd189f17 100644 --- a/src/image.c +++ b/src/image.c @@ -2414,7 +2414,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) /* Look up SPEC in the hash table of the image cache. */ hash = sxhash (spec); - img = search_image_cache (f, spec, hash, foreground, background, true); + img = search_image_cache (f, spec, hash, foreground, background, false); if (img && img->load_failed_p) { free_image (f, img); commit 2c9b488121b275873b2d6aae798007bd98f06744 Author: Alan Third Date: Sun Dec 20 15:57:23 2020 +0000 Remove unnecessary string conversion * src/nsfns.m (ns_set_represented_filename): NSString can load List strings directly now. diff --git a/src/nsfns.m b/src/nsfns.m index c7956497c4..1deddb0d38 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -456,7 +456,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. static void ns_set_represented_filename (struct frame *f) { - Lisp_Object filename, encoded_filename; + Lisp_Object filename; Lisp_Object buf = XWINDOW (f->selected_window)->contents; NSAutoreleasePool *pool; NSString *fstr; @@ -473,9 +473,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. if (! NILP (filename)) { - encoded_filename = ENCODE_UTF_8 (filename); - - fstr = [NSString stringWithLispString:encoded_filename]; + fstr = [NSString stringWithLispString:filename]; if (fstr == nil) fstr = @""; } else commit 1a7033f1f3de4ad8c1bfd68b54e6c9d8444a3bcc Author: Juri Linkov Date: Sun Dec 20 22:05:51 2020 +0200 * lisp/simple.el (goto-line-read-args): Use number-at-point (bug#45199) * lisp/subr.el (goto-char--read-natnum-interactive): Add the value of point to the end of default values, and move function slightly higher. diff --git a/lisp/simple.el b/lisp/simple.el index b1c949d7c6..2b13a0d486 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1264,7 +1264,6 @@ that uses or sets the mark." ;; minibuffer, this is at the end of the prompt. (goto-char (minibuffer-prompt-end))) - ;; Counting lines, one way or another. (defvar goto-line-history nil @@ -1276,15 +1275,8 @@ that uses or sets the mark." (if (and current-prefix-arg (not (consp current-prefix-arg))) (list (prefix-numeric-value current-prefix-arg)) ;; Look for a default, a number in the buffer at point. - (let* ((default - (save-excursion - (skip-chars-backward "0-9") - (if (looking-at "[0-9]") - (string-to-number - (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "0-9") - (point))))))) + (let* ((number (number-at-point)) + (default (and (natnump number) number)) ;; Decide if we're switching buffers. (buffer (if (consp current-prefix-arg) diff --git a/lisp/subr.el b/lisp/subr.el index cb64b3f6e7..9527f7120a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2719,6 +2719,15 @@ floating point support." (push (cons t read) unread-command-events) nil)))))) +(defun goto-char--read-natnum-interactive (prompt) + "Get a natural number argument, optionally prompting with PROMPT. +If there is a natural number at point, use it as default." + (if (and current-prefix-arg (not (consp current-prefix-arg))) + (list (prefix-numeric-value current-prefix-arg)) + (let* ((number (number-at-point)) + (default (and (natnump number) number))) + (list (read-number prompt (list default (point))))))) + (defvar read-char-history nil "The default history for the `read-char-from-minibuffer' function.") @@ -2820,15 +2829,6 @@ There is no need to explicitly add `help-char' to CHARS; (message "%s%s" prompt (char-to-string char)) char)) -(defun goto-char--read-natnum-interactive (prompt) - "Get a natural number argument, optionally prompting with PROMPT. -If there is a natural number at point, use it as default." - (if (and current-prefix-arg (not (consp current-prefix-arg))) - (list (prefix-numeric-value current-prefix-arg)) - (let* ((number (number-at-point)) - (default (and (natnump number) number))) - (list (read-number prompt default))))) - ;; Behind display-popup-menus-p test. (declare-function x-popup-dialog "menu.c" (position contents &optional header)) commit ecb5ebf156280be1859f181208306e4c55af3e80 Author: Michael Albinus Date: Sun Dec 20 19:45:11 2020 +0100 Improve make-process in Tramp * doc/misc/tramp.texi (Remote processes): Remove INSIDE_EMACS restriction. (Frequently Asked Questions, External packages): Add indices. * etc/NEWS: 'start-process-shell-command' and 'start-file-process-shell-command' do not support the old calling conventions any longer. * lisp/subr.el (start-process-shell-command) (start-file-process-shell-command): Remove old calling conventions. * lisp/net/tramp-compat.el (remote-file-error): Remove, it isn't necessary. * lisp/net/tramp.el (tramp-handle-make-process): Remove special shell handling. Support environment variables. * test/lisp/net/tramp-tests.el (tramp--test--deftest-direct-async-process): Skip for mock method. (tramp--test-async-shell-command): Suppress `shell-command-sentinel'. (tramp-test32-shell-command, tramp-test33-environment-variables): Adapt tests. (tramp-test32-shell-command-direct-async) (tramp-test33-environment-variables-direct-async): New tests. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 0557ca5469..dd350f10c0 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3584,9 +3584,6 @@ It does not set process property @code{remote-pid}. @item It does not use @code{tramp-remote-path} and @code{tramp-remote-process-environment}. - -@item -It does not set environment variable @env{INSIDE_EMACS}. @end itemize In order to gain even more performance, it is recommended to bind @@ -4880,6 +4877,8 @@ In case you have installed it from its Git repository, @ref{Recompilation}. @item I get an error @samp{Remote file error: Forbidden reentrant call of Tramp} +@vindex remote-file-error +@vindex debug-ignored-errors Timers, process filters and sentinels, and other event based functions can run at any time, when a remote file operation is still running. This can cause @value{tramp} to block. When such a situation is @@ -5021,6 +5020,7 @@ bind it to non-@code{nil} value. @subsection File attributes cache +@vindex process-file-side-effects Keeping a local cache of remote file attributes in sync with the remote host is a time-consuming operation. Flushing and re-querying these attributes can tax @value{tramp} to a grinding halt on busy @@ -5061,6 +5061,7 @@ root-directory, it is most likely sufficient to make the @subsection Timers +@vindex remote-file-error Timers run asynchronously at any time when Emacs is waiting for sending a string to a process, or waiting for process output. They can run any remote file operation, which would conflict with the diff --git a/etc/NEWS b/etc/NEWS index 1b4c21cb45..7411295e1b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1482,7 +1482,7 @@ This new option allows the user to customize how case is converted when unifying entries. --- -*** The user option `bibtex-maintain-sorted-entries' now permits +*** The user option 'bibtex-maintain-sorted-entries' now permits user-defined sorting schemes. +++ @@ -2170,6 +2170,7 @@ and 'play-sound-file'. If this variable is non-nil, character syntax is used for printing numbers when this makes sense, such as '?A' for 65. ++++ ** New error 'remote-file-error', a subcategory of 'file-error'. It is signaled if a remote file operation fails due to internal reasons, and could block Emacs. It does not replace 'file-error' @@ -2182,6 +2183,7 @@ Until it is solved you could ignore such errors by performing (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) ++++ ** The error 'ftp-error' belongs also to category 'remote-file-error'. +++ @@ -2193,6 +2195,10 @@ buffer does not run the hooks 'kill-buffer-hook', avoids slowing down internal or temporary buffers that are never presented to users or passed on to other applications. +--- +** 'start-process-shell-command' and 'start-file-process-shell-command' +do not support the old calling conventions any longer. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4c8d37d602..b44eabcfa8 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -348,11 +348,6 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) -;; Error symbol `remote-file-error' is defined in Emacs 28.1. We use -;; an adapted error message in order to see that compatible symbol. -(unless (get 'remote-file-error 'error-conditions) - (define-error 'remote-file-error "Remote file error (compat)" 'file-error)) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 6c1c09bc37..4d8118a728 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3790,23 +3790,31 @@ It does not support `:stderr'." (unless (or (null stderr) (bufferp stderr)) (signal 'wrong-type-argument (list #'bufferp stderr))) - ;; Quote shell command. - (when (and (= (length command) 3) - (stringp (nth 0 command)) - (string-match-p "sh$" (nth 0 command)) - (stringp (nth 1 command)) - (string-equal "-c" (nth 1 command)) - (stringp (nth 2 command))) - (setcar (cddr command) (tramp-shell-quote-argument (nth 2 command)))) - (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) + ;; We use as environment the difference to toplevel + ;; `process-environment'. + (env (mapcar + (lambda (elt) + (unless + (member + elt (default-toplevel-value 'process-environment)) + (when (string-match-p "=" elt) elt))) + process-environment)) + (env (setenv-internal + env "INSIDE_EMACS" + (concat (or (getenv "INSIDE_EMACS") emacs-version) + ",tramp:" tramp-version) + 'keep)) + (env (mapcar #'tramp-shell-quote-argument (delq nil env))) + ;; Quote command. + (command (mapconcat #'tramp-shell-quote-argument command " ")) + ;; Set cwd and environment variables. (command - (mapconcat - #'identity (append `("cd" ,localname "&&") command) " "))) + (append `("cd" ,localname "&&" "(" "env") env `(,command ")")))) ;; Check for `tramp-sh-file-name-handler', because something ;; is different between tramp-adb.el and tramp-sh.el. @@ -3861,7 +3869,7 @@ It does not support `:stderr'." (mapcar (lambda (x) (split-string x " ")) login-args)) p (make-process :name name :buffer buffer - :command (append `(,login-program) login-args `(,command)) + :command (append `(,login-program) login-args command) :coding coding :noquery noquery :connection-type connection-type :filter filter :sentinel sentinel :stderr stderr)) diff --git a/lisp/subr.el b/lisp/subr.el index 7461fa2a15..cb64b3f6e7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3560,7 +3560,7 @@ Do nothing if FACE is nil." ;;;; Synchronous shell commands. -(defun start-process-shell-command (name buffer &rest args) +(defun start-process-shell-command (name buffer command) "Start a program in a subprocess. Return the process object for it. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer name) to associate with the process. @@ -3568,27 +3568,18 @@ BUFFER is the buffer (or buffer name) to associate with the process. an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer -COMMAND is the shell command to run. - -An old calling convention accepted any number of arguments after COMMAND, -which were just concatenated to COMMAND. This is still supported but strongly -discouraged." - (declare (advertised-calling-convention (name buffer command) "23.1")) +COMMAND is the shell command to run." ;; We used to use `exec' to replace the shell with the command, ;; but that failed to handle (...) and semicolon, etc. - (start-process name buffer shell-file-name shell-command-switch - (mapconcat 'identity args " "))) + (start-process name buffer shell-file-name shell-command-switch command)) -(defun start-file-process-shell-command (name buffer &rest args) +(defun start-file-process-shell-command (name buffer command) "Start a program in a subprocess. Return the process object for it. Similar to `start-process-shell-command', but calls `start-file-process'." - (declare (advertised-calling-convention (name buffer command) "23.1")) ;; On remote hosts, the local `shell-file-name' might be useless. (with-connection-local-variables (start-file-process - name buffer - shell-file-name shell-command-switch - (mapconcat 'identity args " ")))) + name buffer shell-file-name shell-command-switch command))) (defun call-process-shell-command (command &optional infile buffer display &rest args) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0a5931d689..9dd98037a0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4459,6 +4459,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (start-file-process "test4" (current-buffer) nil) :type 'wrong-type-argument) + (setq proc (start-file-process "test4" (current-buffer) nil)) (should (processp proc)) (should (equal (process-status proc) 'run)) @@ -4483,6 +4484,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (tramp-connection-properties (cons '(nil "direct-async-process" t) tramp-connection-properties))) (skip-unless (tramp-direct-async-process-p)) + ;; For whatever reason, it doesn't cooperate with the "mock" method. + (skip-unless (not (tramp--test-mock-p))) ;; We do expect an established connection already, ;; `file-truename' does it by side-effect. Suppress ;; `tramp--test-enabled', in order to keep the connection. @@ -4703,12 +4706,14 @@ INPUT, if non-nil, is a string sent to the process." (async-shell-command command output-buffer error-buffer) (let ((proc (get-buffer-process output-buffer)) (delete-exited-processes t)) - (when (stringp input) - (process-send-string proc input)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (or (accept-process-output proc nil nil t) (process-live-p proc)))) - (accept-process-output proc nil nil t))) + (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore)) + (when (stringp input) + (process-send-string proc input)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while + (or (accept-process-output proc nil nil t) (process-live-p proc)))) + (accept-process-output proc nil nil t)))) (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." @@ -4762,19 +4767,20 @@ INPUT, if non-nil, is a string sent to the process." (ignore-errors (delete-file tmp-name))) ;; Test `{async-}shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) - (unwind-protect - (with-temp-buffer - (funcall - this-shell-command - "echo foo >&2; echo bar" (current-buffer) stderr) - (should (string-equal "bar\n" (buffer-string))) - ;; Check stderr. - (with-current-buffer stderr - (should (string-equal "foo\n" (buffer-string))))) + (unless (tramp-direct-async-process-p) + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (funcall + this-shell-command + "echo foo >&2; echo bar" (current-buffer) stderr) + (should (string-equal "bar\n" (buffer-string))) + ;; Check stderr. + (with-current-buffer stderr + (should (string-equal "foo\n" (buffer-string))))) - ;; Cleanup. - (ignore-errors (kill-buffer stderr))))) + ;; Cleanup. + (ignore-errors (kill-buffer stderr)))))) ;; Test sending string to `async-shell-command'. (unwind-protect @@ -4810,6 +4816,9 @@ INPUT, if non-nil, is a string sent to the process." (when (natnump cols) (should (= cols async-shell-command-width)))))) +(tramp--test--deftest-direct-async-process tramp-test32-shell-command + "Check direct async `shell-command'.") + ;; This test is inspired by Bug#39067. (ert-deftest tramp-test32-shell-command-dont-erase-buffer () "Check `shell-command-dont-erase-buffer'." @@ -4961,7 +4970,7 @@ INPUT, if non-nil, is a string sent to the process." (should (string-equal (format "%s,tramp:%s\n" emacs-version tramp-version) - (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))) + (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))) (let ((process-environment (cons (format "INSIDE_EMACS=%s,foo" emacs-version) process-environment))) @@ -4969,7 +4978,7 @@ INPUT, if non-nil, is a string sent to the process." (string-equal (format "%s,foo,tramp:%s\n" emacs-version tramp-version) (funcall - this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))) + this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))) ;; Set a value. (let ((process-environment @@ -4979,7 +4988,8 @@ INPUT, if non-nil, is a string sent to the process." (string-match "foo" (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))) + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar))))) ;; Set the empty value. (let ((process-environment @@ -4989,38 +4999,45 @@ INPUT, if non-nil, is a string sent to the process." (string-match "bla" (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) + this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar)))) ;; Variable is set. (should (string-match (regexp-quote envvar) (funcall this-shell-command-to-string "set")))) - ;; We force a reconnect, in order to have a clean environment. - (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - ;; Unset the variable. - (let ((tramp-remote-process-environment - (cons (concat envvar "=foo") tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) - (let ((process-environment (cons envvar process-environment))) - ;; Variable is unset. + (unless (tramp-direct-async-process-p) + ;; We force a reconnect, in order to have a clean environment. + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + ;; Unset the variable. + (let ((tramp-remote-process-environment + (cons (concat envvar "=foo") tramp-remote-process-environment))) + ;; Set the initial value, we want to unset below. (should (string-match - "bla" - (funcall - this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))) - ;; Variable is unset. - (should-not - (string-match - (regexp-quote envvar) - ;; We must remove PS1, the output is truncated otherwise. + "foo" (funcall - this-shell-command-to-string "printenv | grep -v PS1")))))))) + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar)))) + (let ((process-environment (cons envvar process-environment))) + ;; Variable is unset. + (should + (string-match + "bla" + (funcall + this-shell-command-to-string + (format "echo \"${%s:-bla}\"" envvar)))) + ;; Variable is unset. + (should-not + (string-match + (regexp-quote envvar) + ;; We must remove PS1, the output is truncated otherwise. + (funcall + this-shell-command-to-string "printenv | grep -v PS1"))))))))) + +(tramp--test--deftest-direct-async-process tramp-test33-environment-variables + "Check that remote processes set / unset environment variables properly. +Use direct async.") ;; This test is inspired by Bug#27009. (ert-deftest tramp-test33-environment-variables-and-port-numbers () @@ -6432,6 +6449,9 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) +;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests +;; "Check parallel direct asynchronous requests.") + ;; This test is inspired by Bug#29163. (ert-deftest tramp-test44-auto-load () "Check that Tramp autoloads properly." commit 1a0a11f7d2d1dbecb9f754b1e129d50e489058e6 Author: Basil L. Contovounesios Date: Sat Dec 19 12:39:45 2020 +0000 Inhibit buffer hooks in temporary buffers Give get-buffer-create an optional argument to inhibit buffer hooks in internal or temporary buffers for efficiency (bug#34765). * etc/NEWS: Announce new parameter of get-buffer-create and generate-new-buffer, and that with-temp-buffer and with-temp-file now inhibit buffer hooks. * doc/lispref/buffers.texi (Buffer Names): Fix typo. (Creating Buffers): Document new parameter of get-buffer-create and generate-new-buffer. (Buffer List, Killing Buffers): Document when buffer hooks are inhibited. (Current Buffer): * doc/lispref/files.texi (Writing to Files): Document that with-temp-buffer and with-temp-file inhibit buffer hooks. * doc/lispref/internals.texi (Buffer Internals): Document inhibit_buffer_hooks flag. Remove stale comment. * doc/misc/gnus-faq.texi (FAQ 5-8): * lisp/simple.el (shell-command-on-region): Fix indentation. * lisp/files.el (kill-buffer-hook): Document when hook is inhibited. (create-file-buffer): * lisp/gnus/gnus-uu.el (gnus-uu-unshar-article): * lisp/international/mule.el (load-with-code-conversion): * lisp/mh-e/mh-xface.el (mh-x-image-url-fetch-image): * lisp/net/imap.el (imap-open): * lisp/net/mailcap.el (mailcap-maybe-eval): * lisp/progmodes/flymake-proc.el (flymake-proc--read-file-to-temp-buffer) (flymake-proc--copy-buffer-to-temp-buffer): Simplify. * lisp/subr.el (generate-new-buffer): Forward new optional argument to inhibit buffer hooks to get-buffer-create. (with-temp-file, with-temp-buffer, with-output-to-string): * lisp/json.el (json-encode-string): Inhibit buffer hooks in buffer used. * src/buffer.c (run_buffer_list_update_hook): New helper function. (Fget_buffer_create): Use it. Add optional argument to set inhibit_buffer_hooks flag instead of comparing the buffer name to Vcode_conversion_workbuf_name. All callers changed. (Fmake_indirect_buffer, Frename_buffer, Fbury_buffer_internal) (record_buffer): Use run_buffer_list_update_hook. (Fkill_buffer): Document when buffer hooks are inhibited. Use run_buffer_list_update_hook. (init_buffer_once): Inhibit buffer hooks in Vprin1_to_string_buffer. (Vkill_buffer_query_functions, Vbuffer_list_update_hook): Document when hooks are inhibited. * src/buffer.h (struct buffer): Update inhibit_buffer_hooks commentary. * src/coding.h (Vcode_conversion_workbuf_name): * src/coding.c (Vcode_conversion_workbuf_name): Make static again since it is no longer needed in src/buffer.c. (code_conversion_restore, code_conversion_save, syms_of_coding): Prefer boolean over integer constants. * src/fileio.c (Finsert_file_contents): Inhibit buffer hooks in " *code-converting-work*" buffer. * src/window.c (Fselect_window): Fix grammar. Mention window-selection-change-functions alongside buffer-list-update-hook. * test/src/buffer-tests.el: Fix requires. (buffer-tests-inhibit-buffer-hooks): New test. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 2860343628..33eb23984d 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -225,13 +225,22 @@ current buffer is restored even in case of an abnormal exit via @defmac with-temp-buffer body@dots{} @anchor{Definition of with-temp-buffer} -The @code{with-temp-buffer} macro evaluates the @var{body} forms -with a temporary buffer as the current buffer. It saves the identity of +The @code{with-temp-buffer} macro evaluates the @var{body} forms with +a temporary buffer as the current buffer. It saves the identity of the current buffer, creates a temporary buffer and makes it current, evaluates the @var{body} forms, and finally restores the previous -current buffer while killing the temporary buffer. By default, undo -information (@pxref{Undo}) is not recorded in the buffer created by -this macro (but @var{body} can enable that, if needed). +current buffer while killing the temporary buffer. + +@cindex undo in temporary buffers +@cindex @code{kill-buffer-hook} in temporary buffers +@cindex @code{kill-buffer-query-functions} in temporary buffers +@cindex @code{buffer-list-update-hook} in temporary buffers +By default, undo information (@pxref{Undo}) is not recorded in the +buffer created by this macro (but @var{body} can enable that, if +needed). The temporary buffer also does not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). The return value is the value of the last form in @var{body}. You can return the contents of the temporary buffer by using @@ -345,9 +354,9 @@ incrementing the number until it is not the name of an existing buffer. If the optional second argument @var{ignore} is non-@code{nil}, it should be a string, a potential buffer name. It means to consider -that potential buffer acceptable, if it is tried, even it is the name -of an existing buffer (which would normally be rejected). Thus, if -buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and +that potential buffer acceptable, if it is tried, even if it is the +name of an existing buffer (which would normally be rejected). Thus, +if buffers named @samp{foo}, @samp{foo<2>}, @samp{foo<3>} and @samp{foo<4>} exist, @example @@ -932,13 +941,17 @@ window. @defvar buffer-list-update-hook This is a normal hook run whenever the buffer list changes. Functions (implicitly) running this hook are @code{get-buffer-create} -(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer Names}), -@code{kill-buffer} (@pxref{Killing Buffers}), @code{bury-buffer} (see -above) and @code{select-window} (@pxref{Selecting Windows}). +(@pxref{Creating Buffers}), @code{rename-buffer} (@pxref{Buffer +Names}), @code{kill-buffer} (@pxref{Killing Buffers}), +@code{bury-buffer} (see above), and @code{select-window} +(@pxref{Selecting Windows}). This hook is not run for internal or +temporary buffers created by @code{get-buffer-create} or +@code{generate-new-buffer} with a non-@code{nil} argument +@var{inhibit-buffer-hooks}. Functions run by this hook should avoid calling @code{select-window} -with a nil @var{norecord} argument or @code{with-temp-buffer} since -either may lead to infinite recursion. +with a @code{nil} @var{norecord} argument since this may lead to +infinite recursion. @end defvar @node Creating Buffers @@ -951,12 +964,20 @@ either may lead to infinite recursion. with the specified name; @code{generate-new-buffer} always creates a new buffer and gives it a unique name. + Both functions accept an optional argument @var{inhibit-buffer-hooks}. +If it is non-@code{nil}, the buffer they create does not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). This avoids slowing down internal or temporary +buffers that are never presented to users or passed on to other +applications. + Other functions you can use to create buffers include @code{with-output-to-temp-buffer} (@pxref{Temporary Displays}) and @code{create-file-buffer} (@pxref{Visiting Files}). Starting a subprocess can also create a buffer (@pxref{Processes}). -@defun get-buffer-create buffer-or-name +@defun get-buffer-create buffer-or-name &optional inhibit-buffer-hooks This function returns a buffer named @var{buffer-or-name}. The buffer returned does not become the current buffer---this function does not change which buffer is current. @@ -980,7 +1001,7 @@ level; see @ref{Auto Major Mode}.) If the name begins with a space, the buffer initially disables undo information recording (@pxref{Undo}). @end defun -@defun generate-new-buffer name +@defun generate-new-buffer name &optional inhibit-buffer-hooks This function returns a newly created, empty buffer, but does not make it current. The name of the buffer is generated by passing @var{name} to the function @code{generate-new-buffer-name} (@pxref{Buffer @@ -1092,6 +1113,10 @@ with no arguments. The buffer being killed is the current buffer when they are called. The idea of this feature is that these functions will ask for confirmation from the user. If any of them returns @code{nil}, @code{kill-buffer} spares the buffer's life. + +This hook is not run for internal or temporary buffers created by +@code{get-buffer-create} or @code{generate-new-buffer} with a +non-@code{nil} argument @var{inhibit-buffer-hooks}. @end defvar @defvar kill-buffer-hook @@ -1100,6 +1125,10 @@ questions it is going to ask, just before actually killing the buffer. The buffer to be killed is current when the hook functions run. @xref{Hooks}. This variable is a permanent local, so its local binding is not cleared by changing major modes. + +This hook is not run for internal or temporary buffers created by +@code{get-buffer-create} or @code{generate-new-buffer} with a +non-@code{nil} argument @var{inhibit-buffer-hooks}. @end defvar @defopt buffer-offer-save diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d49ac42bb4..6949ca29c6 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -701,8 +701,11 @@ in @var{body}. The current buffer is restored even in case of an abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}). -See also @code{with-temp-buffer} in @ref{Definition of -with-temp-buffer,, The Current Buffer}. +Like @code{with-temp-buffer} (@pxref{Definition of with-temp-buffer,, +Current Buffer}), the temporary buffer used by this macro does not run +the hooks @code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). @end defmac @node File Locks diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index fa3dacbb7a..0adbef33ca 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -2391,6 +2391,15 @@ This flag indicates that narrowing has changed in the buffer. This flag indicates that redisplay optimizations should not be used to display this buffer. +@item inhibit_buffer_hooks +This flag indicates that the buffer should not run the hooks +@code{kill-buffer-hook}, @code{kill-buffer-query-functions} +(@pxref{Killing Buffers}), and @code{buffer-list-update-hook} +(@pxref{Buffer List}). It is set at buffer creation (@pxref{Creating +Buffers}), and avoids slowing down internal or temporary buffers, such +as those created by @code{with-temp-buffer} (@pxref{Definition of +with-temp-buffer,, Current Buffer}). + @item overlay_center This field holds the current overlay center position. @xref{Managing Overlays}. @@ -2404,8 +2413,6 @@ after the current overlay center. @xref{Managing Overlays}. and @code{overlays_after} is sorted in order of increasing beginning position. -@c FIXME? the following are now all Lisp_Object BUFFER_INTERNAL_FIELD (foo). - @item name A Lisp string that names the buffer. It is guaranteed to be unique. @xref{Buffer Names}. This and the following fields have their names diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index adb812f572..c30e80ff56 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -1523,10 +1523,10 @@ Now you only have to tell Gnus to include the X-face in your postings by saying @example (setq message-default-headers - (with-temp-buffer - (insert "X-Face: ") - (insert-file-contents "~/.xface") - (buffer-string))) + (with-temp-buffer + (insert "X-Face: ") + (insert-file-contents "~/.xface") + (buffer-string))) @end example @noindent diff --git a/etc/NEWS b/etc/NEWS index 4a8e70e6a6..1b4c21cb45 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1821,6 +1821,13 @@ modifies the string's text properties; instead, it uses and returns a copy of the string. This helps avoid trouble when strings are shared or constants. ++++ +** Temporary buffers no longer run certain buffer hooks. +The macros 'with-temp-buffer' and 'with-temp-file' no longer run the +hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and +'buffer-list-update-hook' for the temporary buffers they create. This +avoids slowing them down when a lot of these hooks are defined. + --- ** The obsolete function 'thread-alive-p' has been removed. @@ -2177,6 +2184,15 @@ Until it is solved you could ignore such errors by performing ** The error 'ftp-error' belongs also to category 'remote-file-error'. ++++ +** Buffers can now be created with certain hooks disabled. +The functions 'get-buffer-create' and 'generate-new-buffer' accept a +new optional argument 'inhibit-buffer-hooks'. If non-nil, the new +buffer does not run the hooks 'kill-buffer-hook', +'kill-buffer-query-functions', and 'buffer-list-update-hook'. This +avoids slowing down internal or temporary buffers that are never +presented to users or passed on to other applications. + * Changes in Emacs 28.1 on Non-Free Operating Systems diff --git a/lisp/files.el b/lisp/files.el index 093b5f92e5..70d451cccf 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1850,6 +1850,10 @@ expand wildcards (if any) and replace the file with multiple files." The buffer being killed is current while the hook is running. See `kill-buffer'. +This hook is not run for internal or temporary buffers created by +`get-buffer-create' or `generate-new-buffer' with argument +INHIBIT-BUFFER-HOOKS non-nil. + Note: Be careful with let-binding this hook considering it is frequently used for cleanup.") @@ -1951,7 +1955,7 @@ this function prepends a \"|\" to the final result if necessary." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) - (generate-new-buffer (if (string-match-p "\\` " lastname) + (generate-new-buffer (if (string-prefix-p " " lastname) (concat "|" lastname) lastname)))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 5980051ee4..db01fb1352 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1587,8 +1587,7 @@ Gnus might fail to display all of it.") (save-excursion (switch-to-buffer (current-buffer)) (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) + (let ((buffer (generate-new-buffer "*Warning*"))) (unless (unwind-protect (with-current-buffer buffer diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 212e7232b4..6571454dff 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -307,12 +307,9 @@ Return t if file exists." (and (null noerror) (signal 'file-error (list "Cannot open load file" file))) ;; Read file with code conversion, and then eval. - (let* ((buffer - ;; We can't use `generate-new-buffer' because files.el - ;; is not yet loaded. - (get-buffer-create (generate-new-buffer-name " *load*"))) - (load-in-progress t) - (source (save-match-data (string-match "\\.el\\'" fullname)))) + (let ((buffer (generate-new-buffer " *load*")) + (load-in-progress t) + (source (string-suffix-p ".el" fullname))) (unless nomessage (if source (message "Loading %s (source)..." file) diff --git a/lisp/json.el b/lisp/json.el index c2fc1574fa..5f512b94cd 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -435,7 +435,7 @@ Initialized lazily by `json-encode-string'.") (concat "\"" (substring-no-properties string) "\"") (with-current-buffer (or json--string-buffer - (with-current-buffer (generate-new-buffer " *json-string*") + (with-current-buffer (generate-new-buffer " *json-string*" t) ;; This seems to afford decent performance gains. (setq-local inhibit-modification-hooks t) (setq json--string-buffer (current-buffer)))) diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 909f1fe95d..65039310e7 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -425,8 +425,7 @@ After the image is fetched, it is stored in CACHE-FILE. It will be displayed in a buffer and position specified by MARKER. The actual display is carried out by the SENTINEL function." (if mh-wget-executable - (let ((buffer (get-buffer-create (generate-new-buffer-name - mh-temp-fetch-buffer))) + (let ((buffer (generate-new-buffer mh-temp-fetch-buffer)) (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") (expand-file-name (make-temp-name "~/mhe-fetch"))))) (with-current-buffer buffer diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 27c2d869f6..fe895d7e23 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1033,8 +1033,7 @@ necessary. If nil, the buffer name is generated." (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer) ;; Stream changed? (if (not (eq imap-default-stream stream)) - (with-current-buffer (get-buffer-create - (generate-new-buffer-name " *temp*")) + (with-current-buffer (generate-new-buffer " *temp*") (mapc 'make-local-variable imap-local-variables) (set-buffer-multibyte nil) (buffer-disable-undo) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index d0f8c1272d..bc99f02fe3 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -386,8 +386,7 @@ Gnus might fail to display all of it.") (when (save-window-excursion (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) + (let ((buffer (generate-new-buffer "*Warning*"))) (unwind-protect (with-current-buffer buffer (insert (substitute-command-keys diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 744c110f6b..4975d4f35d 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -431,16 +431,15 @@ instead of reading master file from disk." (defun flymake-proc--read-file-to-temp-buffer (file-name) "Insert contents of FILE-NAME into newly created temp buffer." - (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) - (with-current-buffer temp-buffer - (insert-file-contents file-name)) - temp-buffer)) + (with-current-buffer (generate-new-buffer + (concat "flymake:" (file-name-nondirectory file-name))) + (insert-file-contents file-name) + (current-buffer))) (defun flymake-proc--copy-buffer-to-temp-buffer (buffer) "Copy contents of BUFFER into newly created temp buffer." - (with-current-buffer - (get-buffer-create (generate-new-buffer-name - (concat "flymake:" (buffer-name buffer)))) + (with-current-buffer (generate-new-buffer + (concat "flymake:" (buffer-name buffer))) (insert-buffer-substring buffer) (current-buffer))) diff --git a/lisp/simple.el b/lisp/simple.el index 9ed7a11de1..b1c949d7c6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4307,8 +4307,7 @@ characters." (defun shell-command-to-string (command) "Execute shell command COMMAND and return its output as a string." (with-output-to-string - (with-current-buffer - standard-output + (with-current-buffer standard-output (shell-command command t)))) (defun process-file (program &optional infile buffer display &rest args) diff --git a/lisp/subr.el b/lisp/subr.el index 1b2d778454..7461fa2a15 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3701,10 +3701,11 @@ also `with-temp-buffer'." (when (window-live-p (nth 1 state)) (select-window (nth 1 state) 'norecord))) -(defun generate-new-buffer (name) +(defun generate-new-buffer (name &optional inhibit-buffer-hooks) "Create and return a buffer with a name based on NAME. -Choose the buffer's name using `generate-new-buffer-name'." - (get-buffer-create (generate-new-buffer-name name))) +Choose the buffer's name using `generate-new-buffer-name'. +See `get-buffer-create' for the meaning of INHIBIT-BUFFER-HOOKS." + (get-buffer-create (generate-new-buffer-name name) inhibit-buffer-hooks)) (defmacro with-selected-window (window &rest body) "Execute the forms in BODY with WINDOW as the selected window. @@ -3866,12 +3867,14 @@ See the related form `with-temp-buffer-window'." (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. +The buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. See also `with-temp-buffer'." (declare (indent 1) (debug t)) (let ((temp-file (make-symbol "temp-file")) (temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-file ,file) - (,temp-buffer (generate-new-buffer " *temp file*"))) + (,temp-buffer (generate-new-buffer " *temp file*" t))) (unwind-protect (prog1 (with-current-buffer ,temp-buffer @@ -3906,10 +3909,12 @@ Use a MESSAGE of \"\" to temporarily clear the echo area." (defmacro with-temp-buffer (&rest body) "Create a temporary buffer, and evaluate BODY there like `progn'. +The buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. See also `with-temp-file' and `with-output-to-string'." (declare (indent 0) (debug t)) (let ((temp-buffer (make-symbol "temp-buffer"))) - `(let ((,temp-buffer (generate-new-buffer " *temp*"))) + `(let ((,temp-buffer (generate-new-buffer " *temp*" t))) ;; `kill-buffer' can change current-buffer in some odd cases. (with-current-buffer ,temp-buffer (unwind-protect @@ -3944,7 +3949,7 @@ of that nature." (defmacro with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." (declare (indent 0) (debug t)) - `(let ((standard-output (generate-new-buffer " *string-output*"))) + `(let ((standard-output (generate-new-buffer " *string-output*" t))) (unwind-protect (progn (let ((standard-output standard-output)) diff --git a/src/buffer.c b/src/buffer.c index dfc34faf6e..9e44345616 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -37,7 +37,6 @@ along with GNU Emacs. If not, see . */ #include "window.h" #include "commands.h" #include "character.h" -#include "coding.h" #include "buffer.h" #include "region-cache.h" #include "indent.h" @@ -514,16 +513,33 @@ get_truename_buffer (register Lisp_Object filename) return Qnil; } -DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0, +/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL + or does not have buffer hooks inhibited. BUF is NULL when called by + make-indirect-buffer, since it does not inhibit buffer hooks. */ + +static void +run_buffer_list_update_hook (struct buffer *buf) +{ + if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks))) + call1 (Vrun_hooks, Qbuffer_list_update_hook); +} + +DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 2, 0, doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed. If BUFFER-OR-NAME is a string and a live buffer with that name exists, return that buffer. If no such buffer exists, create a new buffer with -that name and return it. If BUFFER-OR-NAME starts with a space, the new -buffer does not keep undo information. +that name and return it. + +If BUFFER-OR-NAME starts with a space, the new buffer does not keep undo +information. If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the +new buffer does not run the hooks `kill-buffer-hook', +`kill-buffer-query-functions', and `buffer-list-update-hook'. This +avoids slowing down internal or temporary buffers that are never +presented to users or passed on to other applications. If BUFFER-OR-NAME is a buffer instead of a string, return it as given, even if it is dead. The return value is never nil. */) - (register Lisp_Object buffer_or_name) + (register Lisp_Object buffer_or_name, Lisp_Object inhibit_buffer_hooks) { register Lisp_Object buffer, name; register struct buffer *b; @@ -598,11 +614,7 @@ even if it is dead. The return value is never nil. */) set_string_intervals (name, NULL); bset_name (b, name); - b->inhibit_buffer_hooks - = (STRINGP (Vcode_conversion_workbuf_name) - && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name), - SBYTES (Vcode_conversion_workbuf_name)) == 0); - + b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks); bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); reset_buffer (b); @@ -614,9 +626,8 @@ even if it is dead. The return value is never nil. */) /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer))); - /* And run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + + run_buffer_list_update_hook (b); return buffer; } @@ -890,9 +901,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) set_buffer_internal_1 (old_b); } - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks)) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (NULL); return buf; } @@ -1536,9 +1545,7 @@ This does not change the name of the visited file (if any). */) && !NILP (BVAR (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !current_buffer->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (current_buffer); /* Refetch since that last call may have done GC. */ return BVAR (current_buffer, name); @@ -1612,7 +1619,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) buf = Fget_buffer (scratch); if (NILP (buf)) { - buf = Fget_buffer_create (scratch); + buf = Fget_buffer_create (scratch, Qnil); Fset_buffer_major_mode (buf); } return buf; @@ -1636,7 +1643,7 @@ other_buffer_safely (Lisp_Object buffer) buf = Fget_buffer (scratch); if (NILP (buf)) { - buf = Fget_buffer_create (scratch); + buf = Fget_buffer_create (scratch, Qnil); Fset_buffer_major_mode (buf); } @@ -1713,7 +1720,9 @@ buffer to be killed as the current buffer. If any of them returns nil, the buffer is not killed. The hook `kill-buffer-hook' is run before the buffer is actually killed. The buffer being killed will be current while the hook is running. Functions called by any of these hooks are -supposed to not change the current buffer. +supposed to not change the current buffer. Neither hook is run for +internal or temporary buffers created by `get-buffer-create' or +`generate-new-buffer' with argument INHIBIT-BUFFER-HOOKS non-nil. Any processes that have this buffer as the `process-buffer' are killed with SIGHUP. This function calls `replace-buffer-in-windows' for @@ -1973,9 +1982,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) bset_width_table (b, Qnil); unblock_input (); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (b); return Qt; } @@ -2015,9 +2022,7 @@ record_buffer (Lisp_Object buffer) fset_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buffer_list))); fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list)); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (XBUFFER (buffer)); } @@ -2054,9 +2059,7 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal, fset_buried_buffer_list (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list))); - /* Run buffer-list-update-hook. */ - if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks) - call1 (Vrun_hooks, Qbuffer_list_update_hook); + run_buffer_list_update_hook (XBUFFER (buffer)); return Qnil; } @@ -5349,10 +5352,11 @@ init_buffer_once (void) Fput (Qkill_buffer_hook, Qpermanent_local, Qt); /* Super-magic invisible buffer. */ - Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); + Vprin1_to_string_buffer = + Fget_buffer_create (build_pure_c_string (" prin1"), Qt); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"))); + Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil)); inhibit_modification_hooks = 0; } @@ -5397,7 +5401,7 @@ init_buffer (void) #endif /* USE_MMAP_FOR_BUFFERS */ AUTO_STRING (scratch, "*scratch*"); - Fset_buffer (Fget_buffer_create (scratch)); + Fset_buffer (Fget_buffer_create (scratch, Qnil)); if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); @@ -6300,9 +6304,14 @@ Use Custom to set this variable and update the display. */); DEFVAR_LISP ("kill-buffer-query-functions", Vkill_buffer_query_functions, doc: /* List of functions called with no args to query before killing a buffer. The buffer being killed will be current while the functions are running. +See `kill-buffer'. If any of them returns nil, the buffer is not killed. Functions run by -this hook are supposed to not change the current buffer. */); +this hook are supposed to not change the current buffer. + +This hook is not run for internal or temporary buffers created by +`get-buffer-create' or `generate-new-buffer' with argument +INHIBIT-BUFFER-HOOKS non-nil. */); Vkill_buffer_query_functions = Qnil; DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook, @@ -6315,9 +6324,12 @@ The function `kill-all-local-variables' runs this before doing anything else. * doc: /* Hook run when the buffer list changes. Functions (implicitly) running this hook are `get-buffer-create', `make-indirect-buffer', `rename-buffer', `kill-buffer', `bury-buffer' -and `select-window'. Functions run by this hook should avoid calling -`select-window' with a nil NORECORD argument or `with-temp-buffer' -since either may lead to infinite recursion. */); +and `select-window'. This hook is not run for internal or temporary +buffers created by `get-buffer-create' or `generate-new-buffer' with +argument INHIBIT-BUFFER-HOOKS non-nil. + +Functions run by this hook should avoid calling `select-window' with a +nil NORECORD argument since it may lead to infinite recursion. */); Vbuffer_list_update_hook = Qnil; DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); diff --git a/src/buffer.h b/src/buffer.h index fe549c5dac..b8c5162be4 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -663,11 +663,11 @@ struct buffer /* Non-zero whenever the narrowing is changed in this buffer. */ bool_bf clip_changed : 1; - /* Non-zero for internally used temporary buffers that don't need to - run hooks kill-buffer-hook, buffer-list-update-hook, and - kill-buffer-query-functions. This is used in coding.c to avoid - slowing down en/decoding when there are a lot of these hooks - defined. */ + /* Non-zero for internal or temporary buffers that don't need to + run hooks kill-buffer-hook, kill-buffer-query-functions, and + buffer-list-update-hook. This is used in coding.c to avoid + slowing down en/decoding when a lot of these hooks are + defined, as well as by with-temp-buffer, for example. */ bool_bf inhibit_buffer_hooks : 1; /* List of overlays that end at or before the current center, diff --git a/src/callproc.c b/src/callproc.c index e3346e2eab..4bca1e5ebd 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -405,9 +405,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer))) { - Lisp_Object spec_buffer; - spec_buffer = buffer; - buffer = Fget_buffer_create (buffer); + Lisp_Object spec_buffer = buffer; + buffer = Fget_buffer_create (buffer, Qnil); /* Mention the buffer name for a better error message. */ if (NILP (buffer)) CHECK_BUFFER (spec_buffer); diff --git a/src/coding.c b/src/coding.c index 2142e7fa51..1afa4aa474 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7821,7 +7821,7 @@ encode_coding (struct coding_system *coding) /* A string that serves as name of the reusable work buffer, and as base name of temporary work buffers used for code-conversion operations. */ -Lisp_Object Vcode_conversion_workbuf_name; +static Lisp_Object Vcode_conversion_workbuf_name; /* The reusable working buffer, created once and never killed. */ static Lisp_Object Vcode_conversion_reused_workbuf; @@ -7839,7 +7839,7 @@ code_conversion_restore (Lisp_Object arg) if (! NILP (workbuf)) { if (EQ (workbuf, Vcode_conversion_reused_workbuf)) - reused_workbuf_in_use = 0; + reused_workbuf_in_use = false; else Fkill_buffer (workbuf); } @@ -7857,13 +7857,13 @@ code_conversion_save (bool with_work_buf, bool multibyte) { Lisp_Object name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); - workbuf = Fget_buffer_create (name); + workbuf = Fget_buffer_create (name, Qt); } else { if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf))) Vcode_conversion_reused_workbuf - = Fget_buffer_create (Vcode_conversion_workbuf_name); + = Fget_buffer_create (Vcode_conversion_workbuf_name, Qt); workbuf = Vcode_conversion_reused_workbuf; } } @@ -7881,7 +7881,7 @@ code_conversion_save (bool with_work_buf, bool multibyte) bset_undo_list (current_buffer, Qt); bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil); if (EQ (workbuf, Vcode_conversion_reused_workbuf)) - reused_workbuf_in_use = 1; + reused_workbuf_in_use = true; set_buffer_internal (current); } @@ -11639,7 +11639,7 @@ syms_of_coding (void) staticpro (&Vcode_conversion_workbuf_name); Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); - reused_workbuf_in_use = 0; + reused_workbuf_in_use = false; PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use); DEFSYM (Qcharset, "charset"); diff --git a/src/coding.h b/src/coding.h index 4973cf89eb..9ad1e954f8 100644 --- a/src/coding.h +++ b/src/coding.h @@ -97,9 +97,6 @@ enum define_coding_undecided_arg_index extern Lisp_Object Vcoding_system_hash_table; -/* Name (or base name) of work buffer for code conversion. */ -extern Lisp_Object Vcode_conversion_workbuf_name; - /* Enumeration of index to an attribute vector of a coding system. */ enum coding_attr_index diff --git a/src/fileio.c b/src/fileio.c index c97f4daf20..51f12e104e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4004,7 +4004,7 @@ by calling `format-decode', which see. */) record_unwind_current_buffer (); - workbuf = Fget_buffer_create (name); + workbuf = Fget_buffer_create (name, Qt); buf = XBUFFER (workbuf); delete_all_overlays (buf); diff --git a/src/minibuf.c b/src/minibuf.c index fc3fd92a88..1940564a80 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -809,7 +809,7 @@ get_minibuffer (EMACS_INT depth) static char const name_fmt[] = " *Minibuf-%"pI"d*"; char name[sizeof name_fmt + INT_STRLEN_BOUND (EMACS_INT)]; AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, depth)); - buf = Fget_buffer_create (lname); + buf = Fget_buffer_create (lname, Qnil); /* Although the buffer's name starts with a space, undo should be enabled in it. */ diff --git a/src/print.c b/src/print.c index 008bf5e639..ec271d914c 100644 --- a/src/print.c +++ b/src/print.c @@ -562,7 +562,7 @@ temp_output_buffer_setup (const char *bufname) record_unwind_current_buffer (); - Fset_buffer (Fget_buffer_create (build_string (bufname))); + Fset_buffer (Fget_buffer_create (build_string (bufname), Qnil)); Fkill_all_local_variables (); delete_all_overlays (current_buffer); diff --git a/src/process.c b/src/process.c index 4fe8ac7fc0..9efefb1de7 100644 --- a/src/process.c +++ b/src/process.c @@ -1731,7 +1731,7 @@ usage: (make-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (!NILP (buffer)) - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); /* Make sure that the child will be able to chdir to the current buffer's current directory, or its unhandled equivalent. We @@ -1768,7 +1768,7 @@ usage: (make-process &rest ARGS) */) QCname, concat2 (name, build_string (" stderr")), QCbuffer, - Fget_buffer_create (xstderr), + Fget_buffer_create (xstderr, Qnil), QCnoquery, query_on_exit ? Qnil : Qt); } @@ -2443,7 +2443,7 @@ usage: (make-pipe-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); @@ -3173,7 +3173,7 @@ usage: (make-serial-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); if (NILP (buffer)) buffer = name; - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); pset_buffer (p, buffer); pset_childp (p, contact); @@ -4188,7 +4188,7 @@ usage: (make-network-process &rest ARGS) */) open_socket: if (!NILP (buffer)) - buffer = Fget_buffer_create (buffer); + buffer = Fget_buffer_create (buffer, Qnil); /* Unwind bind_polling_period. */ unbind_to (count, Qnil); @@ -4961,7 +4961,7 @@ server_accept_connection (Lisp_Object server, int channel) if (!NILP (buffer)) { args[1] = buffer; - buffer = Fget_buffer_create (Fformat (nargs, args)); + buffer = Fget_buffer_create (Fformat (nargs, args), Qnil); } } diff --git a/src/w32fns.c b/src/w32fns.c index a840f0e122..36bee0676b 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -7372,7 +7372,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, tip_f = XFRAME (tip_frame); window = FRAME_ROOT_WINDOW (tip_f); - tip_buf = Fget_buffer_create (tip); + tip_buf = Fget_buffer_create (tip, Qnil); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); diff --git a/src/window.c b/src/window.c index bcc989b5a7..5db166e345 100644 --- a/src/window.c +++ b/src/window.c @@ -617,11 +617,12 @@ equals the special symbol `mark-for-redisplay'. Run `buffer-list-update-hook' unless NORECORD is non-nil. Note that applications and internal routines often select a window temporarily for various purposes; mostly, to simplify coding. As a rule, such -selections should be not recorded and therefore will not pollute +selections should not be recorded and therefore will not pollute `buffer-list-update-hook'. Selections that "really count" are those causing a visible change in the next redisplay of WINDOW's frame and -should be always recorded. So if you think of running a function each -time a window gets selected put it on `buffer-list-update-hook'. +should always be recorded. So if you think of running a function each +time a window gets selected, put it on `buffer-list-update-hook' or +`window-selection-change-functions'. Also note that the main editor command loop sets the current buffer to the buffer of the selected window before each command. */) diff --git a/src/xdisp.c b/src/xdisp.c index 0fd5ec5ec5..b5adee5105 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10880,7 +10880,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) /* Ensure the Messages buffer exists, and switch to it. If we created it, set the major-mode. */ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); - Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); + Fset_buffer (Fget_buffer_create (Vmessages_buffer_name, Qnil)); if (newbuffer && !NILP (Ffboundp (intern ("messages-buffer-mode")))) call0 (intern ("messages-buffer-mode")); @@ -11366,7 +11366,7 @@ ensure_echo_area_buffers (void) static char const name_fmt[] = " *Echo Area %d*"; char name[sizeof name_fmt + INT_STRLEN_BOUND (int)]; AUTO_STRING_WITH_LEN (lname, name, sprintf (name, name_fmt, i)); - echo_buffer[i] = Fget_buffer_create (lname); + echo_buffer[i] = Fget_buffer_create (lname, Qnil); bset_truncate_lines (XBUFFER (echo_buffer[i]), Qnil); /* to force word wrap in echo area - it was decided to postpone this*/ diff --git a/src/xfns.c b/src/xfns.c index 46e4bd73a6..abe293e903 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7041,7 +7041,7 @@ Text larger than the specified size is clipped. */) tip_f = XFRAME (tip_frame); window = FRAME_ROOT_WINDOW (tip_f); - tip_buf = Fget_buffer_create (tip); + tip_buf = Fget_buffer_create (tip, Qnil); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); diff --git a/src/xwidget.c b/src/xwidget.c index e078a28a35..accde65b52 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -100,7 +100,8 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object val; xw->type = type; xw->title = title; - xw->buffer = NILP (buffer) ? Fcurrent_buffer () : Fget_buffer_create (buffer); + xw->buffer = (NILP (buffer) ? Fcurrent_buffer () + : Fget_buffer_create (buffer, Qnil)); xw->height = XFIXNAT (height); xw->width = XFIXNAT (width); xw->kill_without_query = false; diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 0db66f9751..dd8927457a 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -19,9 +19,7 @@ ;;; Code: -(require 'ert) -(require 'seq) -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (ert-deftest overlay-modification-hooks-message-other-buf () "Test for bug#21824. @@ -1334,4 +1332,33 @@ with parameters from the *Messages* buffer modification." (with-temp-buffer (should (assq 'buffer-undo-list (buffer-local-variables))))) +(ert-deftest buffer-tests-inhibit-buffer-hooks () + "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS." + (let* (run-bluh (bluh (lambda () (setq run-bluh t)))) + (unwind-protect + (let* ( run-kbh (kbh (lambda () (setq run-kbh t))) + run-kbqf (kbqf (lambda () (setq run-kbqf t))) ) + + ;; Inhibited. + (add-hook 'buffer-list-update-hook bluh) + (with-current-buffer (generate-new-buffer " foo" t) + (add-hook 'kill-buffer-hook kbh nil t) + (add-hook 'kill-buffer-query-functions kbqf nil t) + (kill-buffer)) + (with-temp-buffer) + (with-output-to-string) + (should-not run-bluh) + (should-not run-kbh) + (should-not run-kbqf) + + ;; Not inhibited. + (with-current-buffer (generate-new-buffer " foo") + (should run-bluh) + (add-hook 'kill-buffer-hook kbh nil t) + (add-hook 'kill-buffer-query-functions kbqf nil t) + (kill-buffer)) + (should run-kbh) + (should run-kbqf)) + (remove-hook 'buffer-list-update-hook bluh)))) + ;;; buffer-tests.el ends here commit 409a9dbe9da64b4d75fec1f511e168c94e60e35b Author: Mattias EngdegÄrd Date: Sat Dec 19 16:47:32 2020 +0100 image-cache-size improvements Implement for non-Cairo X11 and NS. Count masks as well, and XImage objects on X11. * src/image.c (image_size_in_bytes): New. (image_frame_cache_size): Use image_size_in_bytes. * src/nsterm.h: * src/nsimage.m (ns_image_size_in_bytes, [EmacsImage sizeInBytes]): New function and method. * src/w32gui.h: * src/w32term.c (w32_image_size): Update signature. diff --git a/src/image.c b/src/image.c index dc06e9ce20..d0ae44e7df 100644 --- a/src/image.c +++ b/src/image.c @@ -1793,37 +1793,61 @@ which is then usually a filename. */) } static size_t -image_frame_cache_size (struct frame *f) +image_size_in_bytes (struct image *img) { - size_t total = 0; + size_t size = 0; + #if defined USE_CAIRO - struct image_cache *c = FRAME_IMAGE_CACHE (f); + Emacs_Pixmap pm = img->pixmap; + if (pm) + size += pm->height * pm->bytes_per_line; + Emacs_Pixmap msk = img->mask; + if (msk) + size += msk->height * msk->bytes_per_line; - if (!c) - return 0; +#elif defined HAVE_X_WINDOWS + /* Use a nominal depth of 24 bpp for pixmap and 1 bpp for mask, + to avoid having to query the server. */ + if (img->pixmap != NO_PIXMAP) + size += img->width * img->height * 3; + if (img->mask != NO_PIXMAP) + size += img->width * img->height / 8; + + if (img->ximg && img->ximg->data) + size += img->ximg->bytes_per_line * img->ximg->height; + if (img->mask_img && img->mask_img->data) + size += img->mask_img->bytes_per_line * img->mask_img->height; - for (ptrdiff_t i = 0; i < c->used; ++i) - { - struct image *img = c->images[i]; +#elif defined HAVE_NS + if (img->pixmap) + size += ns_image_size_in_bytes (img->pixmap); + if (img->mask) + size += ns_image_size_in_bytes (img->mask); - if (img && img->pixmap && img->pixmap != NO_PIXMAP) - 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 (img->pixmap) + size += w32_image_size (img->pixmap); + if (img->mask) + size += w32_image_size (img->mask); + +#endif + + return size; +} +static size_t +image_frame_cache_size (struct frame *f) +{ + struct image_cache *c = FRAME_IMAGE_CACHE (f); if (!c) return 0; + size_t total = 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); + total += img ? image_size_in_bytes (img) : 0; } -#endif return total; } diff --git a/src/nsimage.m b/src/nsimage.m index da6f01cf6a..f9fb368ba8 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -235,6 +235,11 @@ Updated by Christian Limpach (chris@nice.ch) [(EmacsImage *)img setAlphaAtX: x Y: y to: a]; } +size_t +ns_image_size_in_bytes (void *img) +{ + return [(EmacsImage *)img sizeInBytes]; +} /* ========================================================================== @@ -610,5 +615,22 @@ - (void)setSmoothing: (BOOL) s smoothing = s; } +/* Approximate allocated size of image in bytes. */ +- (size_t) sizeInBytes +{ + size_t bytes = 0; + NSImageRep *rep; + NSEnumerator *reps = [[self representations] objectEnumerator]; + while ((rep = (NSImageRep *) [reps nextObject])) + { + if ([rep respondsToSelector: @selector (bytesPerRow)]) + { + NSBitmapImageRep *bmr = (NSBitmapImageRep *) rep; + bytes += [bmr bytesPerRow] * [bmr numberOfPlanes] * [bmr pixelsHigh]; + } + } + return bytes; +} + @end diff --git a/src/nsterm.h b/src/nsterm.h index f292993d8f..94472ec107 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -666,6 +666,7 @@ typedef id instancetype; - (BOOL)setFrame: (unsigned int) index; - (void)setTransform: (double[3][3]) m; - (void)setSmoothing: (BOOL)s; +- (size_t)sizeInBytes; @end @@ -1195,6 +1196,7 @@ extern void ns_set_alpha (void *img, int x, int y, unsigned char a); extern int ns_display_pixel_height (struct ns_display_info *); extern int ns_display_pixel_width (struct ns_display_info *); +extern size_t ns_image_size_in_bytes (void *img); /* This in nsterm.m */ extern float ns_antialias_threshold; diff --git a/src/w32gui.h b/src/w32gui.h index fc8131130f..f6cfa9fb87 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -46,7 +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 *); +extern size_t w32_image_size (Emacs_Pixmap); #define FACE_DEFAULT (~0) diff --git a/src/w32term.c b/src/w32term.c index a038e4593f..989b056ff2 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1992,12 +1992,12 @@ w32_draw_image_foreground (struct glyph_string *s) } size_t -w32_image_size (struct image *img) +w32_image_size (Emacs_Pixmap pixmap) { BITMAP bm_info; size_t rv = 0; - if (GetObject (img->pixmap, sizeof (BITMAP), &bm_info)) + if (GetObject (pixmap, sizeof (BITMAP), &bm_info)) rv = bm_info.bmWidth * bm_info.bmHeight * bm_info.bmBitsPixel / 8; return rv; }