commit 09a985ae9f486b7bba933c17e99eeff22207a87e (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Thu Dec 15 05:11:34 2022 +0100 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 31db9289aa8..2639c5cceb4 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4628,6 +4628,16 @@ "cl-seq" (fn START END SUBST)" t) (register-definition-prefixes "cmacexp" '("c-macro-")) + +;;; Generated autoloads from progmodes/cmake-ts-mode.el + +(add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)$" . cmake-ts-mode)) +(autoload 'cmake-ts-mode "cmake-ts-mode" "\ +Major mode for editing CMake files, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "cmake-ts-mode" '("cmake-ts-mode-")) + ;;; Generated autoloads from cmuscheme.el @@ -7980,7 +7990,7 @@ "doc-view" ;;; Generated autoloads from progmodes/dockerfile-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)$" . dockerfile-ts-mode)) +(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode)) (autoload 'dockerfile-ts-mode "dockerfile-ts-mode" "\ Major mode for editing Dockerfiles, powered by tree-sitter. @@ -25067,7 +25077,7 @@ "ede/proj-shared" ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 9 2)) package--builtin-versions) +(push (purecopy '(project 0 9 3)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. commit 8ab1f09e0983f165e7081c8ea9f35ac9565e43db Author: Stefan Kangas Date: Wed Dec 14 23:46:38 2022 +0100 Mark flymake diagnostic modes as non-interactive * lisp/progmodes/flymake.el (flymake-diagnostics-buffer-mode) (flymake-project-diagnostics-mode): Mark modes as non-interactive. diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index a4a8cd84050..7af62c35358 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1635,6 +1635,7 @@ flymake--diagnostics-base-tabulated-list-format (define-derived-mode flymake-diagnostics-buffer-mode tabulated-list-mode "Flymake diagnostics" "A mode for listing Flymake diagnostics." + :interactive nil (setq tabulated-list-format flymake--diagnostics-base-tabulated-list-format) (setq tabulated-list-entries 'flymake--diagnostics-buffer-entries) @@ -1692,6 +1693,7 @@ flymake--project-diagnostic-list-project (define-derived-mode flymake-project-diagnostics-mode tabulated-list-mode "Flymake diagnostics" "A mode for listing Flymake diagnostics." + :interactive nil (setq tabulated-list-format (vconcat [("File" 25 t)] flymake--diagnostics-base-tabulated-list-format)) commit 537f78b537ddd56198059bc02b5abc6e51c5b523 Author: Mattias Engdegård Date: Wed Dec 14 17:48:17 2022 +0100 Warn about unmatchable constant args to `eq`, `memq` etc Add a byte-compiler warning about attempts to compare literal values with undefined identity relation to other values. For example: (eq x 2.0) (memq x '("a" (b) [c])) Such incomparable values include all literal conses, strings, vectors, records and (except for eql and memql) floats and bignums. The warning currently applies to eq, eql, memq, memql, assq, rassq, remq and delq. * lisp/emacs-lisp/bytecomp.el (bytecomp--dodgy-eq-arg) (bytecomp--value-type-description, bytecomp--arg-type-description) (bytecomp--warn-dodgy-eq-arg, bytecomp--check-eq-args) (bytecomp--check-memq-args): New. (eq, eql, memq, memql, assq, rassq, remq, delq): Set compiler-macro property. * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): Amend doc string. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test): Fix text-quoting-style and expand re-warning so that it doesn't need to be a literal. (bytecomp-warn-dodgy-args-eq, bytecomp-warn-dodgy-args-memq): New tests. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 1babf3ec2c4..b5e887db836 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -653,7 +653,8 @@ with-suppressed-warnings `suspicious'. For the `mapcar' case, only the `mapcar' function can be used in -the symbol list. For `suspicious', only `set-buffer' and `lsh' can be used." +the symbol list. For `suspicious', only `set-buffer', `lsh' and `eq' +can be used." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. (declare (debug (sexp body)) (indent 1)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f176e769bf5..9af32102c06 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5487,6 +5487,80 @@ batch-byte-recompile-directory (eval form) form))) +;; Check for (in)comparable constant values in calls to `eq', `memq' etc. + +(defun bytecomp--dodgy-eq-arg (x number-ok) + "Whether X is a bad argument to `eq' (or `eql' if NUMBER-OK is non-nil)." + (cond ((consp x) (and (eq (car x) 'quote) (consp (cadr x)))) + ((symbolp x) nil) + ((integerp x) (not (or (<= -536870912 x 536870911) number-ok))) + ((floatp x) (not number-ok)) + (t t))) + +(defun bytecomp--value-type-description (x) + (cond ((and x (proper-list-p x)) "list") + ((recordp x) "record") + (t (symbol-name (type-of x))))) + +(defun bytecomp--arg-type-description (x) + (bytecomp--value-type-description + (if (and (consp x) (eq (car x) 'quote)) + (cadr x) + x))) + +(defun bytecomp--warn-dodgy-eq-arg (form type parenthesis) + (macroexp-warn-and-return + (format "`%s' called with literal %s that may never match (%s)" + (car form) type parenthesis) + form '(suspicious eq) t)) + +(defun bytecomp--check-eq-args (form a b &rest _ignore) + (let* ((number-ok (eq (car form) 'eql)) + (bad-arg (cond ((bytecomp--dodgy-eq-arg a number-ok) 1) + ((bytecomp--dodgy-eq-arg b number-ok) 2)))) + (if bad-arg + (bytecomp--warn-dodgy-eq-arg + form + (bytecomp--arg-type-description (nth bad-arg form)) + (format "arg %d" bad-arg)) + form))) + +(put 'eq 'compiler-macro #'bytecomp--check-eq-args) +(put 'eql 'compiler-macro #'bytecomp--check-eq-args) + +(defun bytecomp--check-memq-args (form elem list &rest _ignore) + (let* ((fn (car form)) + (number-ok (eq fn 'memql))) + (cond + ((bytecomp--dodgy-eq-arg elem number-ok) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--arg-type-description elem) "arg 1")) + ((and (consp list) (eq (car list) 'quote) + (proper-list-p (cadr list))) + (named-let loop ((elts (cadr list)) (i 1)) + (if elts + (let* ((elt (car elts)) + (x (cond ((eq fn 'assq) (car-safe elt)) + ((eq fn 'rassq) (cdr-safe elt)) + (t elt)))) + (if (or (symbolp x) + (and (integerp x) + (or (<= -536870912 x 536870911) number-ok)) + (and (floatp x) number-ok)) + (loop (cdr elts) (1+ i)) + (bytecomp--warn-dodgy-eq-arg + form (bytecomp--value-type-description x) + (format "element %d of arg 2" i)))) + form))) + (t form)))) + +(put 'memq 'compiler-macro #'bytecomp--check-memq-args) +(put 'memql 'compiler-macro #'bytecomp--check-memq-args) +(put 'assq 'compiler-macro #'bytecomp--check-memq-args) +(put 'rassq 'compiler-macro #'bytecomp--check-memq-args) +(put 'remq 'compiler-macro #'bytecomp--check-memq-args) +(put 'delq 'compiler-macro #'bytecomp--check-memq-args) + (provide 'byte-compile) (provide 'bytecomp) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e7c308213e4..00361a4286b 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -837,9 +837,11 @@ bytecomp--with-warning-test (declare (indent 1)) `(with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) - (byte-compile ,@form) - (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") - (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) + (let ((text-quoting-style 'grave)) + (byte-compile ,@form) + (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") + (should (re-search-forward + (string-replace " " "[ \n]+" ,re-warning))))))) (ert-deftest bytecomp-warn-wrong-args () (bytecomp--with-warning-test "remq.*3.*2" @@ -863,6 +865,52 @@ bytecomp-warn-wide-docstring/defvar (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" `(defvar foo t ,bytecomp-tests--docstring))) +(ert-deftest bytecomp-warn-dodgy-args-eq () + (dolist (fn '(eq eql)) + (cl-flet ((msg (type arg) + (format + "`%s' called with literal %s that may never match (arg %d)" + fn type arg))) + (bytecomp--with-warning-test (msg "list" 1) `(,fn '(a) 'x)) + (bytecomp--with-warning-test (msg "string" 2) `(,fn 'x "a")) + (bytecomp--with-warning-test (msg "vector" 2) `(,fn 'x [a])) + (unless (eq fn 'eql) + (bytecomp--with-warning-test (msg "integer" 2) `(,fn 'x #x10000000000)) + (bytecomp--with-warning-test (msg "float" 2) `(,fn 'x 1.0)))))) + +(ert-deftest bytecomp-warn-dodgy-args-memq () + (dolist (fn '(memq memql remq delq assq rassq)) + (cl-labels + ((msg1 (type) + (format + "`%s' called with literal %s that may never match (arg 1)" + fn type)) + (msg2 (type) + (format + "`%s' called with literal %s that may never match (element 2 of arg 2)" + fn type)) + (lst (elt) + (cond ((eq fn 'assq) `((a . 1) (,elt . 2) (c . 3))) + ((eq fn 'rassq) `((1 . a) (2 . ,elt) (3 . c))) + (t `(a ,elt c)))) + (form2 (elt) + `(,fn 'x ',(lst elt)))) + + (bytecomp--with-warning-test (msg1 "list") `(,fn '(a) '(x))) + (bytecomp--with-warning-test (msg1 "string") `(,fn "a" '(x))) + (bytecomp--with-warning-test (msg1 "vector") `(,fn [a] '(x))) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg1 "integer") `(,fn #x10000000000 '(x))) + (bytecomp--with-warning-test (msg1 "float") `(,fn 1.0 '(x)))) + + (bytecomp--with-warning-test (msg2 "list") (form2 '(b))) + (bytecomp--with-warning-test (msg2 "list") (form2 ''b)) + (bytecomp--with-warning-test (msg2 "string") (form2 "b")) + (bytecomp--with-warning-test (msg2 "vector") (form2 [b])) + (unless (eq fn 'memql) + (bytecomp--with-warning-test (msg2 "integer") (form2 #x10000000000)) + (bytecomp--with-warning-test (msg2 "float") (form2 1.0)))))) + (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () (with-current-buffer (get-buffer-create "*Compile-Log*") commit 3b573f7d1f583d3c4169fa7d7dc1f4bcd22197c1 Author: Eli Zaretskii Date: Wed Dec 14 16:53:29 2022 +0200 Make proced-tests work on more systems * test/lisp/proced-tests.el (proced-format-test) (proced-update-test, proced-revert-test, proced-color-test): Remove the 'skip-unless' condition, as it is unnecessary. (proced-refine-test, proced-refine-with-update-test): Use PID, not Args, as the column to test, as PID is more portable. diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index 78d1b6aa400..3c1f5493e74 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) (require 'proced) +(require 'thingatpt) (cl-defmacro proced--within-buffer (format filter &body body) "Execute BODY within a proced buffer using format FORMAT and filter FILTER." @@ -44,7 +45,6 @@ proced--move-to-column (move-to-column (string-match attribute proced-header-line))) (ert-deftest proced-format-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (dolist (format '(short medium long verbose)) (proced--within-buffer format @@ -52,7 +52,6 @@ proced-format-test (proced--assert-emacs-pid-in-buffer)))) (ert-deftest proced-update-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (proced--within-buffer 'short 'user @@ -60,7 +59,6 @@ proced-update-test (proced--assert-emacs-pid-in-buffer))) (ert-deftest proced-revert-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (proced--within-buffer 'short 'user @@ -68,7 +66,6 @@ proced-revert-test (proced--assert-emacs-pid-in-buffer))) (ert-deftest proced-color-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (let ((proced-enable-color-flag t)) (proced--within-buffer 'short @@ -76,33 +73,32 @@ proced-color-test (proced--assert-emacs-pid-in-buffer)))) (ert-deftest proced-refine-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + ;;(skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (proced--within-buffer 'medium 'user - ;; When refining on Args for process A, a process is kept if and only - ;; if its args are the same as process A, which more or less guarentees + ;; When refining on PID for process A, a process is kept if and only + ;; if its PID are the same as process A, which more or less guarentees ;; the refinement will remove some processes. - (proced--move-to-column "Args") - (let ((args (buffer-substring-no-properties (point) (line-end-position)))) + (proced--move-to-column "PID") + (let ((pid (word-at-point))) (proced-refine) (while (not (eobp)) - (proced--move-to-column "Args") - (should (string= args (buffer-substring-no-properties (point) (line-end-position)))) + (proced--move-to-column "PID") + (should (string= pid (word-at-point))) (forward-line))))) (ert-deftest proced-refine-with-update-test () - (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) (proced--within-buffer 'medium 'user - (proced--move-to-column "Args") - (let ((args (buffer-substring-no-properties (point) (line-end-position)))) + (proced--move-to-column "PID") + (let ((pid (word-at-point))) (proced-refine) (proced-update t) (while (not (eobp)) - (proced--move-to-column "Args") - (should (string= args (buffer-substring-no-properties (point) (line-end-position)))) + (proced--move-to-column "PID") + (should (string= pid (word-at-point))) (forward-line))))) (provide 'proced-tests) commit e22a71443ac854ef58dbfdc6d2ee11969ff30607 Author: Laurence Warne Date: Thu Dec 8 13:39:00 2022 +0000 Add tests for proced * test/lisp/proced-tests.el: New file. diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el new file mode 100644 index 00000000000..78d1b6aa400 --- /dev/null +++ b/test/lisp/proced-tests.el @@ -0,0 +1,109 @@ +;;; proced-tests.el --- Test suite for proced.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: +(require 'ert) +(require 'proced) + +(cl-defmacro proced--within-buffer (format filter &body body) + "Execute BODY within a proced buffer using format FORMAT and filter FILTER." + `(let ((proced-format ,format) + (proced-filter ,filter) + (proced-auto-update-flag nil) + (inhibit-message t)) + (proced) + (unwind-protect + (with-current-buffer "*Proced*" + ,@body) + (kill-buffer "*Proced*")))) + +(defun proced--assert-emacs-pid-in-buffer () + "Fail unless the process ID of the current Emacs process exists in buffer." + (should (string-match-p + (number-to-string (emacs-pid)) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun proced--move-to-column (attribute) + "Move to the column under ATTRIBUTE in the current proced buffer." + (move-to-column (string-match attribute proced-header-line))) + +(ert-deftest proced-format-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (dolist (format '(short medium long verbose)) + (proced--within-buffer + format + 'user + (proced--assert-emacs-pid-in-buffer)))) + +(ert-deftest proced-update-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (proced--within-buffer + 'short + 'user + (proced-update) + (proced--assert-emacs-pid-in-buffer))) + +(ert-deftest proced-revert-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (proced--within-buffer + 'short + 'user + (proced-revert) + (proced--assert-emacs-pid-in-buffer))) + +(ert-deftest proced-color-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (let ((proced-enable-color-flag t)) + (proced--within-buffer + 'short + 'user + (proced--assert-emacs-pid-in-buffer)))) + +(ert-deftest proced-refine-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (proced--within-buffer + 'medium + 'user + ;; When refining on Args for process A, a process is kept if and only + ;; if its args are the same as process A, which more or less guarentees + ;; the refinement will remove some processes. + (proced--move-to-column "Args") + (let ((args (buffer-substring-no-properties (point) (line-end-position)))) + (proced-refine) + (while (not (eobp)) + (proced--move-to-column "Args") + (should (string= args (buffer-substring-no-properties (point) (line-end-position)))) + (forward-line))))) + +(ert-deftest proced-refine-with-update-test () + (skip-unless (memq system-type '(gnu/linux gnu/kfreebsd darwin))) + (proced--within-buffer + 'medium + 'user + (proced--move-to-column "Args") + (let ((args (buffer-substring-no-properties (point) (line-end-position)))) + (proced-refine) + (proced-update t) + (while (not (eobp)) + (proced--move-to-column "Args") + (should (string= args (buffer-substring-no-properties (point) (line-end-position)))) + (forward-line))))) + +(provide 'proced-tests) +;;; proced-tests.el ends here commit 7b8f3e00dd0ff1083f22d07b7ce3ecc3b5a6a032 Author: Laurence Warne Date: Sat Dec 3 21:41:57 2022 +0000 Make proced-update preserve refinements Make proced-update preserve refinements by creating a new buffer local variable proced-refinements which stores information about the current refinements and is used by proced-update to further refine proced-process-alist in the case it is non-nil. The result is that refinements are not immediately cleared when a proced buffer is updated with proced-auto-update-flag non-nil. proced-revert maintains its current behaviour of clearing any active refinements. * lisp/proced.el (proced-refinements): New buffer local variable which tracks the current refinements. (proced-refine): Set 'proced-refinements' variable and defer setting of 'proced-process-alist' to 'proced-update'. (proced-update): Take into account 'proced-refinements' when setting 'proced-process-alist'. (proced-revert): Set 'proced-refinements' to nil prior to calling 'proced-update'. diff --git a/lisp/proced.el b/lisp/proced.el index c7419288edf..c09ee18a8be 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -656,6 +656,14 @@ proced-mode-map ) (put 'proced-mark :advertised-binding "m") +(defvar-local proced-refinements nil + "Information about the current buffer refinements. + +It should be a list of elements of the form (REFINER PID KEY GRAMMAR), where +REFINER and GRAMMAR are as described in `proced-grammar-alist', PID is the +process ID of the process used to create the refinement, and KEY the attribute +of the process. A value of nil indicates that there are no active refinements.") + (easy-menu-define proced-menu proced-mode-map "Proced Menu." `("Proced" @@ -1337,20 +1345,7 @@ proced-refine (let* ((grammar (assq key proced-grammar-alist)) (refiner (nth 7 grammar))) (when refiner - (cond ((functionp (car refiner)) - (setq proced-process-alist (funcall (car refiner) pid))) - ((consp refiner) - (let ((predicate (nth 4 grammar)) - (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) - val new-alist) - (dolist (process proced-process-alist) - (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) - (if (cond ((not val) (nth 2 refiner)) - ((eq val 'equal) (nth 1 refiner)) - (val (car refiner))) - (push process new-alist))) - (setq proced-process-alist new-alist)))) - ;; Do not revert listing. + (add-to-list 'proced-refinements (list refiner pid key grammar) t) (proced-update))) (message "No refiner defined here.")))) @@ -1859,10 +1854,29 @@ proced-update "Updating process display..."))) (if revert ;; evaluate all processes (setq proced-process-alist (proced-process-attributes))) - ;; filtering and sorting + ;; filtering + (setq proced-process-alist (proced-filter proced-process-alist proced-filter)) + ;; refinements + (pcase-dolist (`(,refiner ,pid ,key ,grammar) proced-refinements) + ;; It's possible the process has exited since the refinement was made + (when (assq pid proced-process-alist) + (cond ((functionp (car refiner)) + (setq proced-process-alist (funcall (car refiner) pid))) + ((consp refiner) + (let ((predicate (nth 4 grammar)) + (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) + val new-alist) + (dolist (process proced-process-alist) + (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) + (when (cond ((not val) (nth 2 refiner)) + ((eq val 'equal) (nth 1 refiner)) + (val (car refiner))) + (push process new-alist))) + (setq proced-process-alist new-alist)))))) + + ;; sorting (setq proced-process-alist - (proced-sort (proced-filter proced-process-alist proced-filter) - proced-sort proced-descend)) + (proced-sort proced-process-alist proced-sort proced-descend)) ;; display as process tree? (setq proced-process-alist @@ -1976,7 +1990,9 @@ proced-update (defun proced-revert (&rest _args) "Reevaluate the process listing based on the currently running processes. -Preserves point and marks." +Preserves point and marks, but not refinements (see `proced-refine' for +information on refinements)." + (setq proced-refinements nil) (proced-update t)) (defun proced-marked-processes () commit 42c757913a4c6acc07f8904df7def6b720bb23b4 Author: Po Lu Date: Wed Dec 14 21:30:29 2022 +0800 Work around primary selection clobbering during xterm DND * src/xterm.c (x_dnd_do_unsupported_drop): Set `deactivate-mark' to `dont-save'. Explain why. (syms_of_xterm): New DEFSYM `dont-save'. diff --git a/src/xterm.c b/src/xterm.c index 08dd41c64e1..968dec6fbdd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4040,6 +4040,12 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, if (owner != FRAME_X_WINDOW (f)) return; + /* mouse-drag-and-drop-region will immediately deactivate the mark + after this is set. Make sure the primary selection is not + clobbered in that case by setting `deactivate-mark' to + Qdont_save. */ + Vdeactivate_mark = Qdont_save; + event.xbutton.window = child; event.xbutton.subwindow = None; event.xbutton.x = dest_x; @@ -31538,6 +31544,8 @@ syms_of_xterm (void) DEFSYM (Qnow, "now"); DEFSYM (Qx_dnd_targets_list, "x-dnd-targets-list"); DEFSYM (Qx_auto_preserve_selections, "x-auto-preserve-selections"); + DEFSYM (Qexpose, "expose"); + DEFSYM (Qdont_save, "dont-save"); #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); @@ -31707,7 +31715,6 @@ syms_of_xterm (void) This option is only effective when Emacs is built with XInput 2 support. */); Vx_scroll_event_delta_factor = make_float (1.0); - DEFSYM (Qexpose, "expose"); DEFVAR_BOOL ("x-gtk-use-native-input", x_gtk_use_native_input, doc: /* Non-nil means to use GTK for input method support.