commit f681b76a7c43ff54f1aba276f09b8fa0e0dea578 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Thu Dec 22 15:50:12 2022 +0800 Simplify X premultipled pixel allocation code * src/xterm.c (x_premultiply_pixel): New function. (x_query_colors): Improve documentation. (x_draw_fringe_bitmap, x_query_frame_background_color): Use x_premultiply_pixel. diff --git a/src/xterm.c b/src/xterm.c index 60d48165650..5947145ce06 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7645,6 +7645,46 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) #endif } +/* Generate a premultiplied pixel value for COLOR with ALPHA applied + on the given display. COLOR will be modified. The display must + use a visual that supports an alpha channel. + + This is possibly dead code on builds which do not support + XRender. */ + +#ifndef USE_CAIRO + +static unsigned long +x_premultiply_pixel (struct x_display_info *dpyinfo, + XColor *color, double alpha) +{ + unsigned long pixel; + + eassert (dpyinfo->alpha_bits); + + /* Multiply the RGB channels. */ + color->red *= alpha; + color->green *= alpha; + color->blue *= alpha; + + /* First, allocate a fully opaque pixel. */ + pixel = x_make_truecolor_pixel (dpyinfo, color->red, + color->green, + color->blue); + + /* Next, erase the alpha component. */ + pixel &= ~dpyinfo->alpha_mask; + + /* And add an alpha channel. */ + pixel |= (((unsigned long) (alpha * 65535) + >> (16 - dpyinfo->alpha_bits)) + << dpyinfo->alpha_offset); + + return pixel; +} + +#endif + static void x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) @@ -7734,18 +7774,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, if (FRAME_DISPLAY_INFO (f)->alpha_bits && f->alpha_background < 1.0) { + /* Extend the background color with an alpha channel + according to f->alpha_background. */ bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, + f->alpha_background); } /* Draw the bitmap. I believe these small pixmaps can be cached @@ -8894,7 +8931,11 @@ x_color_cells (Display *dpy, int *ncells) /* On frame F, translate pixel colors to RGB values for the NCOLORS - colors in COLORS. Use cached information, if available. */ + colors in COLORS. Use cached information, if available. + + Pixel values are in unsigned normalized format, meaning that + extending missing bits is done straightforwardly without any + complex colorspace conversions. */ void x_query_colors (struct frame *f, XColor *colors, int ncolors) @@ -8942,6 +8983,7 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) colors[i].green = (g * gmult) >> 16; colors[i].blue = (b * bmult) >> 16; } + return; } @@ -8984,16 +9026,10 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) { bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, f->alpha_background); } #endif } commit e98ab3f458b25812eff1b3a7ce6429caece4c891 Merge: 08bb91c7df4 d6c8d5dbc9f Author: Stefan Kangas Date: Thu Dec 22 06:30:10 2022 +0100 ; Merge from origin/emacs-29 The following commit was skipped: d6c8d5dbc9f When redirecting in Eshell, check for "/dev/null" specifi... commit 08bb91c7df4ebf0dd9de4d55575aaaed87a9b339 Merge: ad5a67996dd e59216d3be8 Author: Stefan Kangas Date: Thu Dec 22 06:30:09 2022 +0100 Merge from origin/emacs-29 e59216d3be8 * Invoke spawed Emacs processes with '-Q' when native com... 777b383dd0f Fix Eshell electric slash when used from the root directo... c088cdad9e9 Fix the --without-all build with tree-sitter ec9fbad908d Fix write-region to null device on MS-Windows f35da111990 message: Do not default to eudc-capf-complete yet 98c16a8c883 ; * lisp/tab-bar.el: Remaining renaming of "fixed-width" ... d76d7a3bebf whitespace: Avoid mutating original buffer's markers in c... commit d6c8d5dbc9fc4786e91b76654058e904c96f0e11 Author: Jim Porter Date: Tue Dec 20 16:20:50 2022 -0800 When redirecting in Eshell, check for "/dev/null" specifically This is so that users can type "cmd ... > /dev/null" in Eshell no matter what their system's null device is called. (Users can still use their system's null device name when redirecting, too. Eshell doesn't need to do anything special to support that.) This partially reverts 67a8bdb90c9b5865b7f17290c7135b1a5458c36d. See bug#59545. Do not merge to master. * lisp/eshell/esh-io.el (eshell-set-output-handle): Use "/dev/null" literally. diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 4620565f857..d223be680f9 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -342,7 +342,11 @@ eshell-set-output-handle (when target (let ((handles (or handles eshell-current-handles))) (if (and (stringp target) - (string= target (null-device))) + ;; The literal string "/dev/null" is intentional here. + ;; It just provides compatibility so that users can + ;; redirect to "/dev/null" no matter the actual value + ;; of `null-device'. + (string= target "/dev/null")) (aset handles index nil) (let ((where (eshell-get-target target mode)) (current (car (aref handles index)))) commit e59216d3be86918b995bd63273c851ebc6176a83 Author: Andrea Corallo Date: Wed Dec 21 23:26:52 2022 +0100 * Invoke spawed Emacs processes with '-Q' when native compiling (bug#60208) * lisp/emacs-lisp/comp.el (comp-final): Invoke spawned Emacs with '-Q'. (comp-run-async-workers): Likewise. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2c306d892c7..7fec370d474 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3716,7 +3716,7 @@ comp-final (if (zerop (call-process (expand-file-name invocation-name invocation-directory) - nil t t "-no-comp-spawn" "--batch" "-l" + nil t t "-no-comp-spawn" "-Q" "--batch" "-l" temp-file)) (progn (delete-file temp-file) @@ -4005,7 +4005,7 @@ comp-run-async-workers :command (list (expand-file-name invocation-name invocation-directory) - "-no-comp-spawn" "--batch" + "-no-comp-spawn" "-Q" "--batch" "--eval" ;; Suppress Abort dialogs on MS-Windows "(setq w32-disable-abort-dialog t)" commit 777b383dd0f61488ba4e43756cf43521f994f906 Author: montag451 Date: Wed Dec 21 14:21:20 2022 -0800 Fix Eshell electric slash when used from the root directory of a remote host * lisp/eshell/em-elecslash.el (eshell-electric-forward-slash): Insert the remote prefix as determined by 'file-remote-p'. Copyright-paperwork-exempt: Yes diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el index 091acb9a861..0ce3a4cc963 100644 --- a/lisp/eshell/em-elecslash.el +++ b/lisp/eshell/em-elecslash.el @@ -74,8 +74,9 @@ eshell-electric-forward-slash (command (save-excursion (eshell-bol) (skip-syntax-forward " ") - (thing-at-point 'sexp)))) - (if (and (file-remote-p default-directory) + (thing-at-point 'sexp))) + (prefix (file-remote-p default-directory))) + (if (and prefix ;; We can't formally parse the input. But if there is ;; one of these operators behind us, then looking at ;; the first command would not be sensible. So be @@ -93,14 +94,9 @@ eshell-electric-forward-slash (or eshell-prefer-lisp-functions (not (eshell-search-path command)))))))) (let ((map (make-sparse-keymap)) - (start (if tilde-before (1- (point)) (point))) - (localname - (tramp-file-name-localname - (tramp-dissect-file-name default-directory)))) + (start (if tilde-before (1- (point)) (point)))) (when tilde-before (delete-char -1)) - (insert - (substring default-directory 0 - (string-search localname default-directory))) + (insert prefix) (unless tilde-before (insert "/")) ;; Typing a second slash undoes the insertion, for when ;; you really do want to type a local absolute file name. commit c088cdad9e94f905c23783d7d02c6ca44aed8310 Author: Eli Zaretskii Date: Wed Dec 21 21:52:18 2022 +0200 Fix the --without-all build with tree-sitter * configure.ac (HAVE_TREE_SITTER): Set NEED_DYNLIB=yes, since tree-sitter support requires dynlib.o. (Bug#60061) diff --git a/configure.ac b/configure.ac index 432638f8721..ac29f351fb3 100644 --- a/configure.ac +++ b/configure.ac @@ -3220,6 +3220,7 @@ AC_DEFUN HAVE_TREE_SITTER=no TREE_SITTER_OBJ= +NEED_DYNLIB=no if test "${with_tree_sitter}" != "no"; then dnl Tree-sitter 0.20.2 added support to change the malloc it uses @@ -3245,6 +3246,7 @@ AC_DEFUN LIBS=$OLD_LIBS if test "$ac_cv_func_ts_set_allocator" = yes; then AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.]) + NEED_DYNLIB=yes else AC_MSG_ERROR([Tree-sitter library exists but its version is too old]); TREE_SITTER_CFLAGS= @@ -4154,7 +4156,6 @@ AC_DEFUN LIBMODULES= HAVE_MODULES=no MODULES_OBJ= -NEED_DYNLIB=no MODULES_SUFFIX="${DYNAMIC_LIB_SUFFIX}" MODULES_SECONDARY_SUFFIX="${DYNAMIC_LIB_SECONDARY_SUFFIX}" commit ec9fbad908d5f65f71717506d070a40acca89f5b Author: Eli Zaretskii Date: Wed Dec 21 21:23:51 2022 +0200 Fix write-region to null device on MS-Windows * src/fileio.c (write_region) [WINDOWSNT]: Ignore EBADF errors from fsync -- this means fsync is not supported for this file. Happens, for example, with the null device. (Bug#59545) diff --git a/src/fileio.c b/src/fileio.c index 835c42cc0a4..31353be5d5a 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5387,12 +5387,16 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, { /* Transfer data and metadata to disk, retrying if interrupted. fsync can report a write failure here, e.g., due to disk full - under NFS. But ignore EINVAL, which means fsync is not - supported on this file. */ + under NFS. But ignore EINVAL (and EBADF on Windows), which + means fsync is not supported on this file. */ while (fsync (desc) != 0) if (errno != EINTR) { - if (errno != EINVAL) + if (errno != EINVAL +#ifdef WINDOWSNT + && errno != EBADF +#endif + ) ok = 0, save_errno = errno; break; } commit f35da111990e17eea84febcff35763c40d3e393a Author: Alexander Adolf Date: Wed Dec 21 12:32:36 2022 -0500 message: Do not default to eudc-capf-complete yet * lisp/gnus/message.el (message-mode): No longer add eudc-capf-complete to the buffer-local value of completion-at-point-functions. (Bug#59314) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e7d11b597b3..6c10a4ae976 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3191,7 +3191,6 @@ message-mode (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) - (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t) (add-hook 'completion-at-point-functions #'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) commit 98c16a8c8838f068b9930d37d747ed2a357ba1c2 Author: Juri Linkov Date: Wed Dec 21 19:30:24 2022 +0200 ; * lisp/tab-bar.el: Remaining renaming of "fixed-width" to "auto-width". diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index f040bc9786d..a4779af04aa 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1021,7 +1021,7 @@ tab-bar-auto-width-max :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) - (setq tab-bar--fixed-width-hash nil)) + (setq tab-bar--auto-width-hash nil)) :group 'tab-bar :version "29.1") @@ -1040,17 +1040,17 @@ tab-bar-auto-width-faces tab-bar-tab-group-inactive) "Resize tabs only with these faces.") -(defvar tab-bar--fixed-width-hash nil +(defvar tab-bar--auto-width-hash nil "Memoization table for `tab-bar-auto-width'.") (defun tab-bar-auto-width (items) "Return tab-bar items with resized tab names." - (unless tab-bar--fixed-width-hash - (define-hash-table-test 'tab-bar--fixed-width-hash-test + (unless tab-bar--auto-width-hash + (define-hash-table-test 'tab-bar--auto-width-hash-test #'equal-including-properties #'sxhash-equal-including-properties) - (setq tab-bar--fixed-width-hash - (make-hash-table :test 'tab-bar--fixed-width-hash-test))) + (setq tab-bar--auto-width-hash + (make-hash-table :test 'tab-bar--auto-width-hash-test))) (let ((tabs nil) ;; list of resizable tabs (non-tabs "") ;; concatenated names of non-resizable tabs (width 0)) ;; resize tab names to this width @@ -1078,7 +1078,7 @@ tab-bar-auto-width (setf (nth 2 item) (with-memoization (gethash (list (selected-frame) width (nth 2 item)) - tab-bar--fixed-width-hash) + tab-bar--auto-width-hash) (let* ((name (nth 2 item)) (len (length name)) (close-p (get-text-property (1- len) 'close-tab name)) commit d76d7a3bebf1ff0b06a38f7f96d316752844ed10 Author: Richard Hansen Date: Tue Dec 13 01:33:43 2022 -0500 whitespace: Avoid mutating original buffer's markers in clones * lisp/whitespace.el (whitespace--clone): New hook function that is run after cloning a buffer that copies `whitespace-bob-marker' and `whitespace-eob-marker' and changes the copies to point to the new buffer (Bug#59618). (whitespace-color-on): Register the hook function. (whitespace-color-off): Unregister the hook function. * test/lisp/whitespace-tests.el (whitespace-tests--with-test-buffer): New macro. (whitespace-tests--check-markers): New function. (whitespace-tests--indirect-clone-breaks-base-markers) (whitespace-tests--indirect-clone-markers) (whitespace-tests--regular-clone-markers): New tests. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9bc6ad9db46..558be1841ab 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2093,6 +2093,17 @@ whitespace-style-face-p t)) +(defun whitespace--clone () + "Hook function run after `make-indirect-buffer' and `clone-buffer'." + (when (whitespace-style-face-p) + (setq-local whitespace-bob-marker + (copy-marker (marker-position whitespace-bob-marker) + (marker-insertion-type whitespace-bob-marker))) + (setq-local whitespace-eob-marker + (copy-marker (marker-position whitespace-eob-marker) + (marker-insertion-type whitespace-eob-marker))))) + + (defun whitespace-color-on () "Turn on color visualization." (when (whitespace-style-face-p) @@ -2111,6 +2122,8 @@ whitespace-color-on ;; The -1 ensures that it runs before any ;; `font-lock-mode' hook functions. -1 t) + (add-hook 'clone-buffer-hook #'whitespace--clone nil t) + (add-hook 'clone-indirect-buffer-hook #'whitespace--clone nil t) ;; Add whitespace-mode color into font lock. (setq whitespace-font-lock-keywords @@ -2204,6 +2217,8 @@ whitespace-color-off (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (remove-hook 'after-change-functions #'whitespace--update-bob-eob t) + (remove-hook 'clone-buffer-hook #'whitespace--clone t) + (remove-hook 'clone-indirect-buffer-hook #'whitespace--clone t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) (font-lock-flush))) diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 3e94d7e921b..12f6cb99a23 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -42,6 +42,13 @@ whitespace-tests--with-test-buffer '(whitespace-mode 1)) ,@body))) +(defmacro whitespace--with-buffer-selected (buffer-or-name &rest body) + (declare (debug (form body)) (indent 1)) + `(save-window-excursion + (with-current-buffer (or ,buffer-or-name (current-buffer)) + (with-selected-window (display-buffer (current-buffer)) + ,@body)))) + (defun whitespace-tests--faceup (&rest lines) "Convenience wrapper around `faceup-test-font-lock-buffer'. Returns non-nil if the concatenated LINES match the current @@ -337,6 +344,74 @@ whitespace-tests--empty-bob-eob-modified (whitespace-mode 1) (should (not (buffer-modified-p)))))) +(ert-deftest whitespace-tests--indirect-clone-breaks-base-markers () + "Specific regression test for Bug#59618." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((base (current-buffer)) + ;; `unwind-protect' is not used to clean up `indirect' + ;; because the buffer should only be killed on success. + (indirect (clone-indirect-buffer (buffer-name) nil))) + (should (eq (marker-buffer whitespace-bob-marker) base)) + (should (eq (marker-buffer whitespace-eob-marker) base)) + (whitespace--with-buffer-selected indirect + ;; Mutate the indirect buffer to update its bob/eob markers. + (execute-kbd-macro (kbd "z RET M-< a"))) + ;; With Bug#59618, the above mutation would cause the base + ;; buffer's markers to point inside the indirect buffer because + ;; the indirect buffer erroneously shared marker objects with + ;; the base buffer. Killing the indirect buffer would then + ;; invalidate those markers (make them point nowhere). + (kill-buffer indirect) + (should (eq (marker-buffer whitespace-bob-marker) base)) + (should (eq (marker-buffer whitespace-eob-marker) base))))) + +(defun whitespace-tests--check-markers (buf bpos epos) + (with-current-buffer buf + (should (eq (marker-buffer whitespace-bob-marker) buf)) + (should (eq (marker-position whitespace-bob-marker) bpos)) + (should (eq (marker-buffer whitespace-eob-marker) buf)) + (should (eq (marker-position whitespace-eob-marker) epos)))) + +(ert-deftest whitespace-tests--indirect-clone-markers () + "Test `whitespace--clone' on indirect clones." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((base (current-buffer)) + ;; `unwind-protect' is not used to clean up `indirect' + ;; because the buffer should only be killed on success. + (indirect (clone-indirect-buffer nil nil))) + (whitespace-tests--check-markers base 2 4) + (whitespace--with-buffer-selected indirect + (whitespace-tests--check-markers indirect 2 4) + ;; Mutate the buffer to trigger `after-change-functions' and + ;; thus `whitespace--update-bob-eob'. + (execute-kbd-macro (kbd "z RET M-< a")) + (whitespace-tests--check-markers indirect 1 8)) + (kill-buffer indirect) + ;; When the buffer was modified above, the new "a" character at + ;; the beginning moved the base buffer's markers by one. Emacs + ;; did not run the base buffer's `after-change-functions' after + ;; the indirect buffer was edited (Bug#46982), so the end result + ;; is just the shift by one. + (whitespace-tests--check-markers base 3 5)))) + +(ert-deftest whitespace-tests--regular-clone-markers () + "Test `whitespace--clone' on regular clones." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((orig (current-buffer)) + ;; `unwind-protect' is not used to clean up `clone' because + ;; the buffer should only be killed on success. + (clone (clone-buffer))) + (whitespace-tests--check-markers orig 2 4) + (whitespace--with-buffer-selected clone + (whitespace-tests--check-markers clone 2 4) + (execute-kbd-macro (kbd "z RET M-< a")) + (whitespace-tests--check-markers clone 1 8)) + (kill-buffer clone) + (whitespace-tests--check-markers orig 2 4)))) + (provide 'whitespace-tests) ;;; whitespace-tests.el ends here commit ad5a67996ddf23df904c09165475759e2e0a68b1 Author: Mattias Engdegård Date: Wed Dec 21 12:33:25 2022 +0100 Fix broken eww desktop restore reload prompt message insertion * lisp/net/eww.el (eww-restore-desktop): Repair a malformed `cl-case` clause. This code probably never worked as intended. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 3799ef96e84..a8a985b8dea 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2498,10 +2498,10 @@ eww-restore-desktop (when (plist-get eww-data :url) (cl-case eww-restore-desktop ((t auto) (eww (plist-get eww-data :url))) - ((zerop (buffer-size)) - (let ((inhibit-read-only t)) - (insert (substitute-command-keys - eww-restore-reload-prompt))))))) + ((nil) (when (zerop (buffer-size)) + (let ((inhibit-read-only t)) + (insert (substitute-command-keys + eww-restore-reload-prompt)))))))) ;; . (current-buffer))) commit c2f04019bff4085a09a993995ab8a9d71484dcb0 Author: Mattias Engdegård Date: Wed Dec 21 12:05:08 2022 +0100 soap-client: fix validation against byte[] * lisp/net/soap-client.el (soap-validate-xs-basic-type): `byte[]` is read as the two Lisp values `byte` and `[]` but here the symbol `byte[]` is intended: the brackets need escaping. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 5e7bdbe6c6a..6e9200e4656 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1317,7 +1317,7 @@ soap-validate-xs-basic-type "Validate VALUE against the basic type TYPE." (let* ((kind (soap-xs-basic-type-kind type))) (cl-case kind - ((anyType Array byte[]) + ((anyType Array byte\[\]) value) (t (let ((convert (get kind 'rng-xsd-convert)))