commit bc33b70b280933470b252f2a877fd50e4aed42ba (HEAD, refs/remotes/origin/master) Author: Łukasz Stelmach Date: Wed Feb 7 14:37:39 2024 +0100 Fix handling of delta values with negative month field * lisp/calendar/time-date.el (decoded-time-add): If the new variable is less then zero, the year needs to be decremented by quotient of new and 12 increased by one. * test/lisp/calendar/time-date-tests.el (test-decoded-add): Add applicable test cases. (Bug#68969) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index ce8c668c8cd..01f96305edb 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -547,7 +547,7 @@ changes in daylight saving time are not taken into account." (when (decoded-time-month delta) (let ((new (+ (1- (decoded-time-month time)) (decoded-time-month delta)))) (setf (decoded-time-month time) (1+ (mod new 12))) - (incf (decoded-time-year time) (/ new 12)))) + (incf (decoded-time-year time) (- (/ new 12) (if (< new 0) 1 0))))) ;; Adjust for month length (as described in the doc string). (setf (decoded-time-day time) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index b8d3381528e..7df1e1b0da7 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -161,6 +161,18 @@ (should (equal (decoded-time-add time (mdec :month 10)) '(12 15 16 8 5 2020 1 t 7200))) + (should (equal (decoded-time-add time (mdec :month -1)) + '(12 15 16 8 6 2019 1 t 7200))) + + (should (equal (decoded-time-add time (mdec :month -10)) + '(12 15 16 8 9 2018 1 t 7200))) + + (should (equal (decoded-time-add time (mdec :month -14)) + '(12 15 16 8 5 2018 1 t 7200))) + + (should (equal (decoded-time-add time (mdec :month -24)) + '(12 15 16 8 7 2017 1 t 7200))) + (should (equal (decoded-time-add time (mdec :day 1)) '(12 15 16 9 7 2019 1 t 7200))) commit c0ca272bd7cbab5a2013e112f171e1d7fda65216 Author: Stefan Kangas Date: Sat Mar 1 03:22:30 2025 +0100 grep: Signal error if unable to access directory * lisp/progmodes/grep.el (lgrep, rgrep): grep: Signal error if unable to access directory, instead of just trying to use default-directory, because that level of DWIMishness is confusing. (Bug#71078) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 951663e049a..b0105f08ea2 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1332,7 +1332,7 @@ command before it's run." (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) (unless (and dir (file-accessible-directory-p dir)) - (setq dir default-directory)) + (user-error "Unable to open directory: %s" dir)) (unless (string-equal (file-remote-p dir) (file-remote-p default-directory)) (let ((default-directory dir)) (grep-compute-defaults))) @@ -1437,7 +1437,7 @@ to indicate whether the grep should be case sensitive or not." (grep-compute-defaults)) (when (and (stringp regexp) (> (length regexp) 0)) (unless (and dir (file-accessible-directory-p dir)) - (setq dir default-directory)) + (user-error "Unable to open directory: %s" dir)) (unless (string-equal (file-remote-p dir) (file-remote-p default-directory)) (let ((default-directory dir)) (grep-compute-defaults))) commit 22c98747601dfdc7ac90b22168a6ec1ca13e0e59 Author: Stefan Kangas Date: Sat Mar 1 03:10:35 2025 +0100 ; Fix an interactive spec (Bug#71373) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 1939aa84bfa..807c4e17a33 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -678,7 +678,7 @@ network. The corresponding back end must have a `request-post' method." If ARG, don't do that. If ARG is 1, prompt for a group name to post to. Depending on the selected group, the message might be either a mail or a news." - (interactive "P" gnus-summary-mode) + (interactive "P" gnus-summary-mode gnus-article-mode) ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg commit 77f597ee3de04f6a8dee27b5a5f601911d74c6f5 Author: Stefan Kangas Date: Sat Mar 1 02:05:28 2025 +0100 Make '(setf (process-get ...) VAL)' return VAL * lisp/emacs-lisp/gv.el (process-get): Return only the last value when set as a generalized variable. (Bug#76643) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index d9ba786aa7d..b2390d65817 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -406,7 +406,7 @@ See also `incf'." (gv-define-simple-setter process-buffer set-process-buffer) (gv-define-simple-setter process-filter set-process-filter) (gv-define-simple-setter process-sentinel set-process-sentinel) -(gv-define-simple-setter process-get process-put) +(gv-define-simple-setter process-get process-put 'fix) (gv-define-simple-setter window-parameter set-window-parameter) (gv-define-setter window-buffer (v &optional w) (macroexp-let2 nil v v commit 1cfbbcfaf657e767ed5743565b62eeecde3a4ef5 Author: Stefan Monnier Date: Fri Feb 28 17:10:56 2025 -0500 * test/src/editfns-tests.el (editfns--replace-region): New test This test fails, sadly, because `replace-buffer-contents` is not careful enough to something like `replace_range`. diff --git a/src/editfns.c b/src/editfns.c index 3dff49fb00c..12700527ef3 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2050,6 +2050,7 @@ nil. */) if (early_abort) { + /* FIXME: Use 'replace_range'! */ del_range (min_a, ZV); Finsert_buffer_substring (source, Qnil,Qnil); SAFE_FREE_UNBIND_TO (count, Qnil); @@ -2099,6 +2100,7 @@ nil. */) eassert (beg_a <= end_a); eassert (beg_b <= end_b); eassert (beg_a < end_a || beg_b < end_b); + /* FIXME: Use 'replace_range'! */ if (beg_a < end_a) del_range (beg_a, end_a); if (beg_b < end_b) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 29b7a850838..09af179a180 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -320,6 +320,41 @@ (should (equal (buffer-substring-no-properties (point-min) (point-max)) (concat (string (char-from-name "SMILE")) "1234")))) +(defun editfns--replace-region (from to string) + (save-excursion + (save-restriction + (narrow-to-region from to) + (let ((buf (current-buffer))) + (with-temp-buffer + (let ((str-buf (current-buffer))) + (insert string) + (with-current-buffer buf + (replace-buffer-contents str-buf)))))))) + +(ert-deftest editfns-tests--replace-region () + :expected-result :failed + (with-temp-buffer + (insert "here is some text") + (let ((m5n (copy-marker (+ (point-min) 5))) + (m5a (copy-marker (+ (point-min) 5) t)) + (m6n (copy-marker (+ (point-min) 6))) + (m6a (copy-marker (+ (point-min) 6) t)) + (m7n (copy-marker (+ (point-min) 7))) + (m7a (copy-marker (+ (point-min) 7) t))) + (editfns--replace-region (+ (point-min) 5) (+ (point-min) 7) "be") + (should (equal (buffer-string) "here be some text")) + (should (equal (point) (point-max))) + ;; Markers before the replaced text stay before. + (should (= m5n (+ (point-min) 5))) + (should (= m5a (+ (point-min) 5))) + ;; Markers in the replaced text can end up at either end, depending + ;; on whether they're advance-after-insert or not. + (should (= m6n (+ (point-min) 5))) + (should (<= (+ (point-min) 5) m6a (+ (point-min) 7))) + ;; Markers after the replaced text stay after. + (should (= m7n (+ (point-min) 7))) + (should (= m7a (+ (point-min) 7)))))) + (ert-deftest delete-region-undo-markers-1 () "Make sure we don't end up with freed markers reachable from Lisp." ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=30931#40 commit 5f165caf316f9da6f04f4d6c5a0fa786f6f197b9 Author: Stefan Monnier Date: Fri Feb 28 17:03:21 2025 -0500 (internal--c-header-file-path): Move to ffap.el This function is used so rarely that it's really best not to preload it. * lisp/ffap.el (ffap-url-regexp): Precompute. (ffap-c-path): Use `ffap--c-path`. (ffap--gcc-is-clang-p, ffap--c-path): Move and rename from subr.el's * lisp/subr.el (internal--gcc-is-clang-p) (internal--c-header-file-path): Move to ffap.el and rename. * lisp/man.el (Man-header-file-path): Default to a new value that delegates to ffap. (Man-header-file-path): Obey that new value. * lisp/emacs-lisp/ert-x.el (ert-gcc-is-clang-p): Use `ffap--gcc-is-clang-p`. * test/lisp/ffap-tests.el (ffap-tests--c-path) (ffap-tests--c-path/gcc-mocked, ffap-tests--c-path/clang-mocked): Move and rename from `subr-tests.el`. * test/lisp/subr-tests.el (subr-tests-internal--c-header-file-path) (subr-tests-internal--c-header-file-path/gcc-mocked) (subr-tests-internal--c-header-file-path/clang-mocked): Move to `ffap-tests.el` and rename. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index ec2106dda22..98e6b2cb1b6 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -374,7 +374,9 @@ The same keyword arguments are supported as in (defun ert-gcc-is-clang-p () "Return non-nil if the `gcc' command actually runs the Clang compiler." - (internal--gcc-is-clang-p)) + (require 'ffap) + (declare-function ffap--gcc-is-clang-p "ffap" ()) + (ffap--gcc-is-clang-p)) (defvar tramp-default-host-alist) (defvar tramp-methods) diff --git a/lisp/ffap.el b/lisp/ffap.el index 890a227fca9..f892bb81e40 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -179,12 +179,13 @@ Note this name may be omitted if it equals the default :group 'ffap) (defvar ffap-url-regexp - (concat - "\\(" - "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok - "\\|" - "\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://" ; needs host - "\\)") + (eval-when-compile + (concat + "\\(" + "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok + "\\|" + "\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://" ;Needs host + "\\)")) "Regexp matching the beginning of a URI, for ffap. If the value is nil, disable URL-matching features in ffap.") @@ -831,13 +832,79 @@ to extract substrings.") (and (not (string-match "\\.el\\'" name)) (ffap-locate-file name '(".el") load-path))) -(defvar ffap-c-path (internal--c-header-file-path) +(defun ffap--gcc-is-clang-p () + "Return non-nil if the `gcc' command actually runs the Clang compiler." + ;; Recent macOS machines run llvm when you type gcc by default. (!) + ;; We can't even check if it's a symlink; it's a binary placed in + ;; "/usr/bin/gcc". So we need to check the output. + (when-let* ((out (ignore-errors + (with-temp-buffer + (call-process "gcc" nil t nil "--version") + (buffer-string))))) + (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" out))) + +(defun ffap--c-path () + "Return search path for C header files (a list of strings)." + ;; FIXME: It's not clear that this is a good place to put this, or + ;; even that this should necessarily be internal. + ;; See also (Bug#10702): + ;; cc-search-directories, semantic-c-dependency-system-include-path, + ;; semantic-gcc-setup + (delete-dups + ;; We treat MS-Windows/MS-DOS specially, since there's no + ;; widely-accepted canonical directory for C include files. + (let ((base (if (not (memq system-type '(windows-nt ms-dos))) + '("/usr/include" "/usr/local/include"))) + (call-clang-p (or (ffap--gcc-is-clang-p) + (and (executable-find "clang") + (not (executable-find "gcc")))))) + (cond ((or call-clang-p + (memq system-type '(windows-nt ms-dos))) + ;; This is either macOS, or MS-Windows/MS-DOS, or a system + ;; with clang only. + (with-temp-buffer + (ignore-errors + (call-process (if call-clang-p "clang" "gcc") + nil t nil + "-v" "-E" "-")) + (goto-char (point-min)) + (narrow-to-region + (save-excursion + (re-search-forward + "^#include <\\.\\.\\.> search starts here:\n" nil t) + (point)) + (save-excursion + (re-search-forward "^End of search list.$" nil t) + (pos-bol))) + (while (search-forward "(framework directory)" nil t) + (delete-line)) + ;; "gcc -v" reports file names with many "..", so we + ;; normalize it. + (or (mapcar #'expand-file-name + (append base + (split-string (buffer-substring-no-properties + (point-min) (point-max))))) + ;; Fallback for whedn the compiler is not available. + (list (expand-file-name "/usr/include") + (expand-file-name "/usr/local/include"))))) + ;; Prefer GCC. + ((let ((arch (with-temp-buffer + (when (eq 0 (ignore-errors + (call-process "gcc" nil '(t nil) nil + "-print-multiarch"))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position)))))) + (if (zerop (length arch)) + base + (append base (list (expand-file-name arch "/usr/include")))))))))) + +(defvar ffap-c-path (ffap--c-path) ;FIXME: Delay initialization? "List of directories to search for include files.") (defun ffap-c-mode (name) (ffap-locate-file name t ffap-c-path)) -(defvar ffap-c++-path +(defvar ffap-c++-path ;FIXME: Delay initialization? (let ((c++-include-dir (with-temp-buffer (when (eq 0 (ignore-errors (call-process "g++" nil t nil "-v"))) diff --git a/lisp/man.el b/lisp/man.el index 681758cadf5..4d5e8e323ca 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -230,10 +230,11 @@ the associated section number." :type '(repeat (cons (string :tag "Bogus Section") (string :tag "Real Section")))) -(defcustom Man-header-file-path (internal--c-header-file-path) +(defcustom Man-header-file-path t "C Header file search path used in Man." :version "31.1" - :type '(repeat string)) + :type '(choice (repeat string) + (const :tag "Use 'ffap-c-path'" t))) (defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$") "Regexp that matches the text that precedes the command's name. @@ -571,7 +572,11 @@ list of directories where the remote system has the C header files." (let ((remote-id (file-remote-p default-directory))) (if (null remote-id) ;; The local case. - Man-header-file-path + (if (not (eq t Man-header-file-path)) + Man-header-file-path + (require 'ffap) + (defvar ffap-c-path) + ffap-c-path) ;; The remote case. Use connection-local variables. (mapcar (lambda (elt) (concat remote-id elt)) diff --git a/lisp/subr.el b/lisp/subr.el index c7be73224cf..2395d1bd85a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7627,70 +7627,4 @@ and return the value found in PLACE instead." ,(funcall setter val) ,val))))) -(defun internal--gcc-is-clang-p () - "Return non-nil if the `gcc' command actually runs the Clang compiler." - ;; Recent macOS machines run llvm when you type gcc by default. (!) - ;; We can't even check if it's a symlink; it's a binary placed in - ;; "/usr/bin/gcc". So we need to check the output. - (when-let* ((out (ignore-errors - (with-temp-buffer - (call-process "gcc" nil t nil "--version") - (buffer-string))))) - (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" out))) - -(defun internal--c-header-file-path () - "Return search path for C header files (a list of strings)." - ;; FIXME: It's not clear that this is a good place to put this, or - ;; even that this should necessarily be internal. - ;; See also (Bug#10702): - ;; cc-search-directories, semantic-c-dependency-system-include-path, - ;; semantic-gcc-setup - (delete-dups - ;; We treat MS-Windows/MS-DOS specially, since there's no - ;; widely-accepted canonical directory for C include files. - (let ((base (if (not (memq system-type '(windows-nt ms-dos))) - '("/usr/include" "/usr/local/include"))) - (call-clang-p (or (internal--gcc-is-clang-p) - (and (executable-find "clang") - (not (executable-find "gcc")))))) - (cond ((or call-clang-p - (memq system-type '(windows-nt ms-dos))) - ;; This is either macOS, or MS-Windows/MS-DOS, or a system - ;; with clang only. - (with-temp-buffer - (ignore-errors - (call-process (if call-clang-p "clang" "gcc") - nil t nil - "-v" "-E" "-")) - (goto-char (point-min)) - (narrow-to-region - (save-excursion - (re-search-forward - "^#include <\\.\\.\\.> search starts here:\n" nil t) - (point)) - (save-excursion - (re-search-forward "^End of search list.$" nil t) - (pos-bol))) - (while (search-forward "(framework directory)" nil t) - (delete-line)) - ;; "gcc -v" reports file names with many "..", so we - ;; normalize it. - (or (mapcar #'expand-file-name - (append base - (split-string (buffer-substring-no-properties - (point-min) (point-max))))) - ;; Fallback for whedn the compiler is not available. - (list (expand-file-name "/usr/include") - (expand-file-name "/usr/local/include"))))) - ;; Prefer GCC. - ((let ((arch (with-temp-buffer - (when (eq 0 (ignore-errors - (call-process "gcc" nil '(t nil) nil - "-print-multiarch"))) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position)))))) - (if (zerop (length arch)) - base - (append base (list (expand-file-name arch "/usr/include")))))))))) - ;;; subr.el ends here diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 9bd78ae0425..b07a4c4fbc6 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -182,6 +182,71 @@ left alone when opening a URL in an external browser." (goto-char (point-min)) (should (equal (ffap-file-at-point) nil)))) +(ert-deftest ffap-tests--c-path () + (should (seq-every-p #'stringp (ffap--c-path))) + (should (locate-file "stdio.h" (ffap--c-path))) + (or (memq system-type '(windows-nt ms-dos)) + (should (member "/usr/include" (ffap--c-path)))) + (should (equal (ffap--c-path) + (delete-dups (ffap--c-path)))) + ;; Return a meaningful result even if calling some compiler fails. + (cl-letf (((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest _args) 1))) + (should (seq-every-p #'stringp (ffap--c-path))) + (should (member (expand-file-name "/usr/include") + (ffap--c-path))) + (should (equal (ffap--c-path) + (delete-dups (ffap--c-path)))))) + +(ert-deftest ffap-tests--c-path/gcc-mocked () + ;; Handle empty values of "gcc -print-multiarch". + (cl-letf (((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest args) + (when (equal (car args) "-print-multiarch") + (insert "\n") 0)))) + (should (member (expand-file-name "/usr/include") + (ffap--c-path)))) + ;; Handle single values of "gcc -print-multiarch". + (cl-letf ((system-type 'foo) + ((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest args) + (when (equal (car args) "-print-multiarch") + (insert "x86_64-linux-gnu\n") 0)))) + (should (member (expand-file-name "/usr/include/x86_64-linux-gnu") + (ffap--c-path))))) + +(ert-deftest ffap-tests--c-path/clang-mocked () + ;; Handle clang 15.0.0 output on macOS 15.2. + (cl-letf (((symbol-function 'ffap--gcc-is-clang-p) (lambda () t)) + ((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest _args) + (insert "\ +Apple clang version 15.0.0 (clang-1500.3.9.4) +Target: arm64-apple-darwin24.2.0 +Thread model: posix +InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin + \"/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang\" +[[[...Emacs test omits some verbose junk from the output here...]]] +clang -cc1 version 15.0.0 (clang-1500.3.9.4) default target arm64-apple-darwin24.2.0 +ignoring nonexistent directory \"/usr/local/include\" +#include \"...\" search starts here: +#include <...> search starts here: + /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include + /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include + /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include + /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks (framework directory) +End of search list. +# 1 \"\" +# 1 \"\" 1 +# 1 \"\" 3 +# 418 \"\" 3 +# 1 \"\" 1 +# 1 \"\" 2 +# 1 \"\" 2") + 0))) + (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include") + (ffap--c-path))))) + (provide 'ffap-tests) ;;; ffap-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index c2f64867d90..98fd1cad894 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1463,70 +1463,5 @@ final or penultimate step during initialization.")) (props-out (object-intervals out))) (should (equal props-out props-in)))))))) -(ert-deftest subr-tests-internal--c-header-file-path () - (should (seq-every-p #'stringp (internal--c-header-file-path))) - (should (locate-file "stdio.h" (internal--c-header-file-path))) - (or (memq system-type '(windows-nt ms-dos)) - (should (member "/usr/include" (internal--c-header-file-path)))) - (should (equal (internal--c-header-file-path) - (delete-dups (internal--c-header-file-path)))) - ;; Return a meaningful result even if calling some compiler fails. - (cl-letf (((symbol-function 'call-process) - (lambda (_program &optional _infile _destination _display &rest _args) 1))) - (should (seq-every-p #'stringp (internal--c-header-file-path))) - (should (member (expand-file-name "/usr/include") - (internal--c-header-file-path))) - (should (equal (internal--c-header-file-path) - (delete-dups (internal--c-header-file-path)))))) - -(ert-deftest subr-tests-internal--c-header-file-path/gcc-mocked () - ;; Handle empty values of "gcc -print-multiarch". - (cl-letf (((symbol-function 'call-process) - (lambda (_program &optional _infile _destination _display &rest args) - (when (equal (car args) "-print-multiarch") - (insert "\n") 0)))) - (should (member (expand-file-name "/usr/include") - (internal--c-header-file-path)))) - ;; Handle single values of "gcc -print-multiarch". - (cl-letf ((system-type 'foo) - ((symbol-function 'call-process) - (lambda (_program &optional _infile _destination _display &rest args) - (when (equal (car args) "-print-multiarch") - (insert "x86_64-linux-gnu\n") 0)))) - (should (member (expand-file-name "/usr/include/x86_64-linux-gnu") - (internal--c-header-file-path))))) - -(ert-deftest subr-tests-internal--c-header-file-path/clang-mocked () - ;; Handle clang 15.0.0 output on macOS 15.2. - (cl-letf (((symbol-function 'internal--gcc-is-clang-p) (lambda () t)) - ((symbol-function 'call-process) - (lambda (_program &optional _infile _destination _display &rest _args) - (insert "\ -Apple clang version 15.0.0 (clang-1500.3.9.4) -Target: arm64-apple-darwin24.2.0 -Thread model: posix -InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin - \"/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang\" -[[[...Emacs test omits some verbose junk from the output here...]]] -clang -cc1 version 15.0.0 (clang-1500.3.9.4) default target arm64-apple-darwin24.2.0 -ignoring nonexistent directory \"/usr/local/include\" -#include \"...\" search starts here: -#include <...> search starts here: - /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include - /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include - /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include - /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/System/Library/Frameworks (framework directory) -End of search list. -# 1 \"\" -# 1 \"\" 1 -# 1 \"\" 3 -# 418 \"\" 3 -# 1 \"\" 1 -# 1 \"\" 2 -# 1 \"\" 2") - 0))) - (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include") - (internal--c-header-file-path))))) - (provide 'subr-tests) ;;; subr-tests.el ends here commit 678fdcc16594aaedb319fe145d039aa118174f5d Author: Stefan Kangas Date: Fri Feb 28 19:59:12 2025 +0100 ; Grammar fixes for "native-compiled" 1. Prefer "native-compiled" to "native compiled". The adjective "native-compiled" with the hyphen is generally more consistent with the typical pattern in English, especially when the compound modifies a noun (e.g., "native-compiled code"). 2. Prefer "natively compiled" to "natively-compiled". The adverb "natively" modifies "compiled", and it is standard not to hyphenate an adverb + adjective combination when the adverb ends in -ly (e.g., "code that is natively compiled"). For example, note that we say "high-speed internet" but "highly performant code". * Makefile.in (dest): * configure.ac (HAVE_NATIVE_COMP): * doc/emacs/building.texi (Lisp Libraries): * doc/lispref/compile.texi (Native Compilation) (Native-Compilation Functions, Native-Compilation Variables): * doc/lispref/functions.texi (What Is a Function, Declare Form): * doc/lispref/loading.texi (How Programs Do Loading, Library Search): * etc/NEWS: * etc/NEWS.28: * etc/NEWS.29: * etc/NEWS.30: * lisp/emacs-lisp/comp-common.el (native-comp-never-optimize-functions) (comp-function-type-spec): * lisp/emacs-lisp/comp-cstr.el: * lisp/subr.el (locate-eln-file): * src/comp.c (SETJMP_NAME, syms_of_comp): * src/data.c (Fsubrp, Fnative_comp_function_p, Fsubr_native_lambda_list): * src/lread.c (Fload): * src/pdumper.c (dump_do_dump_relocation): * test/src/comp-tests.el (lambda-return2): Avoid grammatically incorrect variations on "natively compiled" and "native-compiled". (Bug#56727) diff --git a/Makefile.in b/Makefile.in index 57cfcfd1605..cf51a468987 100644 --- a/Makefile.in +++ b/Makefile.in @@ -909,7 +909,7 @@ install-etc: done ; \ done -### Install native compiled Lisp files. +### Install native-compiled Lisp files. install-eln: lisp ifeq ($(HAVE_NATIVE_COMP),yes) umask 022 ; \ diff --git a/configure.ac b/configure.ac index 6b4d3ee914a..13e2d7e16ad 100644 --- a/configure.ac +++ b/configure.ac @@ -5179,7 +5179,7 @@ if test "${with_native_compilation}" != "no"; then LIBS=$SAVE_LIBS fi AC_DEFINE_UNQUOTED([NATIVE_ELISP_SUFFIX], [".eln"], - [System extension for native compiled elisp]) + [System extension for native-compiled elisp]) AC_SUBST([HAVE_NATIVE_COMP]) AC_SUBST([LIBGCCJIT_CFLAGS]) AC_SUBST([LIBGCCJIT_LIBS]) diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 1ee46d91a12..02ca71f069b 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1580,7 +1580,7 @@ Emacs Lisp Reference Manual}. @cindex native compilation Emacs Lisp code can also be compiled into @dfn{native code}: machine code not unlike the one produced by a C or Fortran compiler. Native -code runs even faster than byte-code. Natively-compiled Emacs Lisp +code runs even faster than byte-code. Natively compiled Emacs Lisp code is stored in files whose names end in @samp{.eln}. @xref{Native Compilation,, Native Compilation, elisp, the Emacs Lisp Reference Manual}. @@ -1660,7 +1660,7 @@ way, you don't need to modify the default value of @code{load-path}. @vindex native-comp-eln-load-path Similarly to @code{load-path}, the list of directories where Emacs -looks for @file{*.eln} files with natively-compiled Lisp code is +looks for @file{*.eln} files with native-compiled Lisp code is specified by the variable @code{native-comp-eln-load-path}. @cindex autoload diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 060b5ccae4c..57e67001847 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -764,32 +764,32 @@ you to be able to native-compile Lisp code. @vindex native-compile@r{, a Lisp feature} To determine whether the current Emacs process can produce and load -natively-compiled Lisp code, call +natively compiled Lisp code, call @code{native-comp-available-p} (@pxref{Native-Compilation Functions}). - Unlike byte-compiled code, natively-compiled Lisp code is executed + Unlike byte-compiled code, native-compiled Lisp code is executed directly by the machine's hardware, and therefore runs at full speed that the host CPU can provide. The resulting speedup generally depends on what the Lisp code does, but is usually 2.5 to 5 times faster than the corresponding byte-compiled code. Since native code is generally incompatible between different -systems, the natively-compiled code is @emph{not} transportable from +systems, the native-compiled code is @emph{not} transportable from one machine to another, it can only be used on the same machine where it was produced or on very similar ones (having the same CPU and -run-time libraries). The transportability of natively-compiled code +run-time libraries). The transportability of native-compiled code is the same as that of shared libraries (@file{.so} or @file{.dll} files). - Libraries of natively-compiled code include crucial dependencies on + Libraries of native-compiled code include crucial dependencies on Emacs Lisp primitives (@pxref{What Is a Function}) and their calling -conventions, and thus Emacs usually won't load natively-compiled code +conventions, and thus Emacs usually won't load native-compiled code produced by earlier or later Emacs versions; native compilation of the same Lisp code by a different Emacs version will usually produce a -natively-compiled library under a unique file name that only that +natively compiled library under a unique file name that only that version of Emacs will be able to load. However, the use of unique file names enables several versions of the same Lisp library -natively-compiled by several different versions of Emacs to be placed +natively compiled by several different versions of Emacs to be placed within the same directory. @vindex no-native-compile @@ -882,7 +882,7 @@ non-@code{nil}, tells the function to place the resulting @file{.eln} files in the last directory mentioned in @code{native-comp-eln-load-path} (@pxref{Library Search}); this is meant to be used as part of building an Emacs source tarball for the -first time, when the natively-compiled files, which are absent from +first time, when the native-compiled files, which are absent from the source tarball, should be generated in the build tree instead of the user's cache directory. @end defun @@ -891,7 +891,7 @@ Native compilation can be run entirely asynchronously, in a subprocess of the main Emacs process. This leaves the main Emacs process free to use while the compilation runs in the background. This is the method used by Emacs to natively-compile any Lisp file or byte-compiled Lisp -file that is loaded into Emacs, when no natively-compiled file for it +file that is loaded into Emacs, when no native-compiled file for it is available. Note that because of this use of a subprocess, native compilation may produce warning and errors which byte-compilation does not, and Lisp code may thus need to be modified to work correctly. See @@ -938,7 +938,7 @@ in any of the directories mentioned in the @deffn Command emacs-lisp-native-compile This command compiles the file visited by the current buffer into native code, if the file was changed since the last time it was -natively-compiled. +natively compiled. @end deffn @deffn Command emacs-lisp-native-compile-and-load @@ -1125,13 +1125,13 @@ control this, use a separate variable, described below. This variable controls generation of trampolines. A trampoline is a small piece of native code required to allow calling Lisp primitives, which were advised or redefined, from Lisp code that was -natively-compiled with @code{native-comp-speed} set to 2 or greater. +natively compiled with @code{native-comp-speed} set to 2 or greater. Emacs stores the generated trampolines on separate @file{*.eln} files. By default, this variable's value is @code{t}, which enables the generation of trampoline files; setting it to @code{nil} disables the generation of trampolines. Note that if a trampoline needed for advising or redefining a primitive is not available and cannot be -generated, calls to that primitive from natively-compiled Lisp will +generated, calls to that primitive from native-compiled Lisp will ignore redefinitions and advices, and will behave as if the primitive was called directly from C. Therefore, we don't recommend disabling the trampoline generation, unless you know that all the trampolines diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 8ed992d3e79..024ff2b7d5a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -223,7 +223,7 @@ that is not in the form of ELisp source code but something like machine code or byte code instead. More specifically it returns @code{t} if the function is built-in (a.k.a.@: ``primitive'', @pxref{What Is a Function}), or byte-compiled (@pxref{Byte -Compilation}), or natively-compiled (@pxref{Native Compilation}), or +Compilation}), or native-compiled (@pxref{Native Compilation}), or a function loaded from a dynamic module (@pxref{Dynamic Modules}). @end defun @@ -2868,7 +2868,7 @@ For description of additional types, see @ref{Lisp Data Types}). Declaring a function with an incorrect type produces undefined behavior and could lead to unexpected results or might even crash Emacs when -natively-compiled code is loaded, if it was compiled with +native-compiled code is loaded, if it was compiled with @code{compilation-safety} level of zero (@pxref{compilation-safety}). Note also that when redefining (or advising) a type-declared function, the replacement should respect the original signature to avoid such diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 15922cf1e89..87ebb787250 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -117,7 +117,7 @@ If the option @code{load-prefer-newer} is non-@code{nil}, then when searching suffixes, @code{load} selects whichever version of a file (@samp{.elc}, @samp{.el}, etc.)@: has been modified most recently. In this case, @code{load} doesn't load the @samp{.eln} -natively-compiled file even if it exists. +native-compiled file even if it exists. If @var{filename} is a relative file name, such as @file{foo} or @file{baz/foo.bar}, @code{load} searches for the file using the variable @@ -161,7 +161,7 @@ during compilation. @xref{Compiling Macros}. Messages like @samp{Loading foo...} and @samp{Loading foo...done} appear in the echo area during loading unless @var{nomessage} is -non-@code{nil}. If a natively-compiled @samp{.eln} file is loaded, +non-@code{nil}. If a native-compiled @samp{.eln} file is loaded, the message says so. @cindex load errors @@ -462,13 +462,13 @@ the shadowed files as a string. (@pxref{Native Compilation}), then when a @samp{.elc} byte-compiled file is found by searching @code{load-path}, Emacs will try to look for a corresponding @samp{.eln} file holding the corresponding -natively-compiled code. The natively-compiled files are looked up in +native-compiled code. The native-compiled files are looked up in the directories listed by the @code{native-comp-eln-load-path}. @vindex comp-native-version-dir @defvar native-comp-eln-load-path This variable holds a list of directories where Emacs looks for -natively-compiled @samp{.eln} files. File names in the list that are +native-compiled @samp{.eln} files. File names in the list that are not absolute are interpreted as relative to @code{invocation-directory} (@pxref{System Environment}). The last directory in the list is the system directory, i.e.@: the directory with @samp{.eln} files diff --git a/etc/NEWS b/etc/NEWS index 76c8290fe32..0867822a7d8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1470,8 +1470,8 @@ strings in a variety of formats, for example "6 months 3 weeks" or "5m ** The function 'purecopy' is now an obsolete alias for 'identity'. ** New function 'native-compile-directory'. -This function natively-compiles all Lisp files in a directory and in its -sub-directories, recursively, which were not already natively-compiled. +This function natively compiles all Lisp files in a directory and in its +sub-directories, recursively, which were not already natively compiled. --- ** New function 'color-blend'. diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 2c0009e1902..f8f8664f00b 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -32,7 +32,7 @@ It is no longer enough to specify 'bindir=DIRECTORY' on the command line of the "make install" command. The reason for this new requirement is that Emacs needs to locate at -startup the directory with its "*.eln" natively-compiled files for the +startup the directory with its "*.eln" natively compiled files for the preloaded Lisp packages, and the relative name of that directory needs therefore to be recorded in the executable as part of the build. diff --git a/etc/NEWS.29 b/etc/NEWS.29 index f99a6fbe7c4..00641ef1e16 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -3487,7 +3487,7 @@ These are like 'line-end-position' and 'line-beginning-position' ** New function 'compiled-function-p'. This returns non-nil if its argument is either a built-in, or a -byte-compiled, or a natively-compiled function object, or a function +byte-compiled, or a native-compiled function object, or a function loaded from a dynamic module. ** 'deactivate-mark' can have new value 'dont-save'. @@ -3580,7 +3580,7 @@ things to be saved. ** New function 'string-equal-ignore-case'. This compares strings ignoring case differences. -** 'symbol-file' can now report natively-compiled ".eln" files. +** 'symbol-file' can now report native-compiled ".eln" files. If Emacs was built with native-compilation enabled, Lisp programs can now call 'symbol-file' with the new optional 3rd argument non-nil to request the name of the ".eln" file which defined a given symbol. diff --git a/etc/NEWS.30 b/etc/NEWS.30 index ec14e447859..8369aa05423 100644 --- a/etc/NEWS.30 +++ b/etc/NEWS.30 @@ -425,7 +425,7 @@ This user option controls outline visibility in the output buffer of 'describe-bindings' when 'describe-bindings-outline' is non-nil. *** 'describe-function' shows the function's inferred type when available. -For native compiled Lisp functions, 'describe-function' prints (after +For native-compiled Lisp functions, 'describe-function' prints (after the signature) the automatically inferred function type as well. If the function's type was explicitly declared (via the 'declare' form's 'ftype' property), 'describe-function' shows the declared type. This is diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index bffadd9bd09..faf368bb858 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -56,7 +56,7 @@ This is intended for debugging the compiler itself. "Primitive functions to exclude from trampoline optimization. Primitive functions included in this list will not be called -directly by the natively-compiled code, which makes trampolines for +directly by the native-compiled code, which makes trampolines for those primitives unnecessary in case of function redefinition/advice." :type '(repeat symbol) :version "30.1") @@ -520,7 +520,7 @@ itself." ;; Declared Lisp function (setf type-spec delc-type) (when (native-comp-function-p f) - ;; Native compiled inferred + ;; Natively compiled inferred (setf kind 'inferred type-spec (subr-type f)))))) (when type-spec diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index dfbef785ee6..67c72c8ce2b 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -216,7 +216,7 @@ Return them as multiple value." collect cstr into positives finally return (cl-values positives negatives))) -;; So we can load comp-cstr.el and comp.el in non native compiled +;; So we can load comp-cstr.el and comp.el in non natively compiled ;; builds. (defvar comp-ctxt nil) diff --git a/lisp/subr.el b/lisp/subr.el index f52264d3158..c7be73224cf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3112,7 +3112,7 @@ This is to `put' what `defalias' is to `fset'." (declare-function comp-el-to-eln-rel-filename "comp.c") (defun locate-eln-file (eln-file) - "Locate a natively-compiled ELN-FILE by searching its load path. + "Locate a native-compiled ELN-FILE by searching its load path. This function looks in directories named by `native-comp-eln-load-path'." (declare (important-return-value t)) (or (locate-file-internal (concat comp-native-version-dir "/" eln-file) diff --git a/src/comp.c b/src/comp.c index 692b28e00cb..219a482931e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -518,7 +518,7 @@ load_gccjit_if_necessary (bool mandatory) #endif #define SETJMP_NAME SETJMP -/* Max number function importable by native compiled code. */ +/* Max number function importable by native-compiled code. */ #define F_RELOC_MAX_SIZE 1600 typedef struct { @@ -5556,7 +5556,7 @@ syms_of_comp (void) doc: /* If non-nil, compile loaded .elc files asynchronously. After compilation, each function definition is updated to use the -natively-compiled one. */); +natively compiled one. */); native_comp_jit_compilation = true; DEFSYM (Qnative_comp_speed, "native-comp-speed"); @@ -5726,7 +5726,7 @@ For internal use. */); Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal); DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path, - doc: /* List of directories to look for natively-compiled *.eln files. + doc: /* List of directories to look for native-compiled *.eln files. The *.eln files are actually looked for in a version-specific subdirectory of each directory in this list. That subdirectory @@ -5746,11 +5746,11 @@ Emacs. */); Vnative_comp_enable_subr_trampolines, doc: /* If non-nil, enable generation of trampolines for calling primitives. Trampolines are needed so that Emacs respects redefinition or advice of -primitive functions when they are called from Lisp code natively-compiled +primitive functions when they are called from native-compiled Lisp code at `native-comp-speed' of 2. By default, the value is t, and when Emacs sees a redefined or advised -primitive called from natively-compiled Lisp, it generates a trampoline +primitive called from native-compiled Lisp, it generates a trampoline for it on-the-fly. If the value is a file name (a string), it specifies the directory in @@ -5762,8 +5762,8 @@ When this variable is nil, generation of trampolines is disabled. Disabling the generation of trampolines, when a trampoline for a redefined or advised primitive is not already available from previous compilations, means that such redefinition or advice will not have effect when calling -primitives from natively-compiled Lisp code. That is, calls to primitives -without existing trampolines from natively-compiled Lisp will behave as if +primitives from native-compiled Lisp code. That is, calls to primitives +without existing trampolines from native-compiled Lisp will behave as if the primitive was called directly from C, and will ignore its redefinition and advice. */); diff --git a/src/data.c b/src/data.c index 5fcdda1b6e8..b2e5ffe4eed 100644 --- a/src/data.c +++ b/src/data.c @@ -499,7 +499,7 @@ DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0, #endif DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, - doc: /* Return t if OBJECT is a built-in or native compiled Lisp function. + doc: /* Return t if OBJECT is a built-in or native-compiled Lisp function. See also `primitive-function-p' and `native-comp-function-p'. */) (Lisp_Object object) @@ -1046,7 +1046,7 @@ SUBR must be a built-in function. */) } DEFUN ("native-comp-function-p", Fnative_comp_function_p, Snative_comp_function_p, 1, 1, - 0, doc: /* Return t if the object is native compiled Lisp function, nil otherwise. */) + 0, doc: /* Return t if the object is native-compiled Lisp function, nil otherwise. */) (Lisp_Object object) { return NATIVE_COMP_FUNCTIONP (object) ? Qt : Qnil; @@ -1054,7 +1054,7 @@ DEFUN ("native-comp-function-p", Fnative_comp_function_p, Snative_comp_function_ DEFUN ("subr-native-lambda-list", Fsubr_native_lambda_list, Ssubr_native_lambda_list, 1, 1, 0, - doc: /* Return the lambda list for a native compiled lisp/d + doc: /* Return the lambda list for a native-compiled lisp/d function or t otherwise. */) (Lisp_Object subr) { diff --git a/src/lread.c b/src/lread.c index df1caaf5732..d45860fd470 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1680,7 +1680,7 @@ Return t if the file exists and loads successfully. */) if (is_module) message_with_string ("Loading %s (module)...", file, 1); else if (is_native_elisp) - message_with_string ("Loading %s (native compiled elisp)...", file, 1); + message_with_string ("Loading %s (native-compiled elisp)...", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...", file, 1); else if (newer) @@ -1759,7 +1759,7 @@ Return t if the file exists and loads successfully. */) if (is_module) message_with_string ("Loading %s (module)...done", file, 1); else if (is_native_elisp) - message_with_string ("Loading %s (native compiled elisp)...done", file, 1); + message_with_string ("Loading %s (native-compiled elisp)...done", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...done", file, 1); else if (newer) diff --git a/src/pdumper.c b/src/pdumper.c index b954421e225..7a8c5bba9ad 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5503,7 +5503,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, case RELOC_NATIVE_SUBR: { /* When resurrecting from a dump given non all the original - native compiled subrs may be still around we can't rely on + native-compiled subrs may be still around we can't rely on a 'top_level_run' mechanism, we revive them one-by-one here. */ struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index e8ea2fde9e2..2991a05d771 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -329,7 +329,7 @@ Check that the resulting binaries do not differ." (should (= (funcall f 3) 4)))) (comp-deftest lambda-return2 () - "Check a nested lambda function gets native compiled." + "Check a nested lambda function gets natively compiled." (let ((f (comp-tests-lambda-return-f2))) (should (native-comp-function-p f)) (let ((f2 (funcall f))) commit 0b0bf7c07f2ecaca1e9b25d72139af0dd7e49832 Author: Eshel Yaron Date: Fri Feb 28 18:59:11 2025 +0100 (completion-preview-sort-function): Refine ':type'. * lisp/completion-preview.el (completion-preview-sort-function): Add some specific sort functions as available choices for this user option. Suggested by Robert Pluim . diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 6ccf235dbc5..b2efb8caf62 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -238,7 +238,13 @@ To disable sorting, set this option to `identity'. If the completion table that produces the candidates already specifies a sort function, it takes precedence over this option." - :type 'function + :type '(choice + (function-item :tag "Sort alphabetically" + minibuffer-sort-alphabetically) + (function-item :tag "First by length, then alphabetically" + minibuffer--sort-by-length-alpha) + (function-item :tag "Disable sorting" identity) + (function :tag "Custom sort function")) :version "31.1") (defface completion-preview commit 3a5cf24735809d79a8603f6b17079708fa0cce0a Author: Stefan Kangas Date: Fri Feb 28 18:42:18 2025 +0100 ; Silence byte-compiler during bootstrap diff --git a/lisp/custom.el b/lisp/custom.el index 9e6eb930467..dee55d9ed11 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -81,6 +81,7 @@ if any, or the value of EXP." (eval (let ((sv (get symbol 'saved-value))) (if sv (car sv) exp))))))) +(declare-function widget-apply "wid-edit" (widget property &rest args)) (defun custom-initialize-reset (symbol exp) "Initialize SYMBOL based on EXP. Set the symbol, using its `:set' function (or `set-default-toplevel-value' diff --git a/lisp/electric.el b/lisp/electric.el index 8ddd982930e..39e13e1ca0c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -514,6 +514,7 @@ The variable `electric-layout-rules' says when and how to insert newlines." ;; The default :value-create produces "list of numbers" when given "list ;; of characters", this prints them as characters. +(declare-function widget-get "wid-edit" (widget property)) (defun electric--print-list-of-chars (widget) (let ((print-integers-as-characters t)) (princ (widget-get widget :value) (current-buffer)))) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 11a7a8bbd61..5293cff93ed 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -93,7 +93,6 @@ ARGS are passed to `message'." (get symbol 'widget-type)) (autoload 'widget-create-child-value "wid-edit") -(autoload 'widget-convert "wid-edit") (autoload 'widget-default-get "wid-edit") ;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 8b373ec11a5..6a4bc590922 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -33,6 +33,7 @@ (eval-when-compile (require 'cl-lib)) (defvar dos-codepage) +(autoload 'widget-put "wid-edit") (autoload 'widget-value "wid-edit") ;;; MULE related key bindings and menus. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 76061652161..8caf696a21b 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -88,6 +88,8 @@ (eval-when-compile (require 'cl-lib)) +(declare-function widget-put "wid-edit" (widget property value)) + ;;; Completion table manipulation ;; New completion-table operation. diff --git a/lisp/simple.el b/lisp/simple.el index 25c4bd36123..2d36062e9c2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -30,6 +30,7 @@ (eval-when-compile (require 'cl-lib)) +(declare-function widget-apply "wid-edit" (widget property &rest args)) (declare-function widget-convert "wid-edit" (type &rest args)) ;;; From compile.el commit 85ef06392a07e2405dd03c7a1efe76348e001d19 Author: Stefan Kangas Date: Fri Feb 28 18:37:27 2025 +0100 ; * lisp/subr.el (apply-partially): Fix last commit. (I accidentally pushed an old version of the patch.) diff --git a/lisp/subr.el b/lisp/subr.el index bc5f8943fb4..f52264d3158 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -541,8 +541,7 @@ was called." (compiler-macro (lambda (_) `(lambda (&rest args2) - ,(let ((l (length args))) - `(apply ,fun ,@args args2)))))) + ,`(apply ,fun ,@args args2))))) (lambda (&rest args2) (apply fun (append args args2)))) commit 2435749efa5b082b520bb1e40db3d3c839023c04 Author: Stefan Kangas Date: Fri Feb 28 18:30:57 2025 +0100 Add compiler macro to apply-partially * lisp/subr.el (apply-partially): Add compiler macro. diff --git a/lisp/subr.el b/lisp/subr.el index 128bf258ab6..bc5f8943fb4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -537,7 +537,12 @@ ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." - (declare (side-effect-free error-free)) + (declare (side-effect-free error-free) + (compiler-macro + (lambda (_) + `(lambda (&rest args2) + ,(let ((l (length args))) + `(apply ,fun ,@args args2)))))) (lambda (&rest args2) (apply fun (append args args2)))) commit 8b659313b83c82cfe09af1638289fccdfc9af23d Author: Stefan Kangas Date: Fri Feb 28 18:28:58 2025 +0100 Lift widget functions from C to Lisp In the mid-1990s, these functions were moved from Lisp to C to "improve performance". However, Moore's Law, and perhaps other improvements too, has made this rationale irrelevant. On this machine, with --native-compilation=no, I observed only a slight ~4% performance difference. For example, displaying a buffer full of widgets (e.g., 'M-x customize RET browse-url RET') takes 4ms here, meaning the performance gap is under 0.1ms. Even on less powerful machines, this difference would remain imperceptible. Given this, let's lift these functions back to to Lisp, which offers the usual benefits. We already have solid test coverage, but let's add a more focused test for 'widget-get' and 'widget-put' to be thorough. * lisp/wid-edit.el (widget-put, widget-get, widget-apply): Move to Lisp from... * src/fns.c (Fwidget_put, Fwidget_get, Fwidget_apply): ...here. (syms_of_fns): Remove defsubrs for the above functions. * test/lisp/wid-edit-tests.el (widget-test-editable-field-widget-get/put): New test. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 7cf7ae43b73..d6fd1156123 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -621,6 +621,28 @@ and saves that overlay under the :inactive property for WIDGET." (symbolp (car widget)) (get (car widget) 'widget-type)))) +;;;###autoload +(defun widget-put (widget property value) + "In WIDGET, set PROPERTY to VALUE. +The value can later be retrieved with `widget-get'." + (setcdr widget (plist-put (cdr widget) property value))) + +;;;###autoload +(defun widget-get (widget property) + "In WIDGET, get the value of PROPERTY. +The value could either be specified when the widget was created, or +later with `widget-put'." + (let (tmp) + (catch 'found + (while widget + (cond ((and (setq tmp (plist-member (cdr widget) property)) + (consp tmp)) + (throw 'found (cadr tmp))) + ((setq tmp (widget-type widget)) + (setq widget (get tmp 'widget-type))) + (t + (throw 'found nil))))))) + (defun widget-get-indirect (widget property) "In WIDGET, get the value of PROPERTY. If the value is a symbol, return its binding. @@ -638,6 +660,13 @@ Otherwise, just return the value." (widget-member (get (car widget) 'widget-type) property)) (t nil))) +;;;###autoload +(defun widget-apply (widget property &rest args) + "Apply the value of WIDGET's PROPERTY to the widget itself. +Return the result of applying the value of PROPERTY to WIDGET. +ARGS are passed as extra arguments to the function." + (apply (widget-get widget property) widget args)) + (defun widget-value (widget) "Extract the current value of WIDGET." (widget-apply widget diff --git a/src/fns.c b/src/fns.c index 1d94eb3b73d..329a4e124b3 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3831,65 +3831,8 @@ FILENAME are suppressed. */) return feature; } - -/* Primitives for work of the "widget" library. - In an ideal world, this section would not have been necessary. - However, lisp function calls being as slow as they are, it turns - out that some functions in the widget library (wid-edit.el) are the - bottleneck of Widget operation. Here is their translation to C, - for the sole reason of efficiency. */ - -DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0, - doc: /* In WIDGET, set PROPERTY to VALUE. -The value can later be retrieved with `widget-get'. */) - (Lisp_Object widget, Lisp_Object property, Lisp_Object value) -{ - CHECK_CONS (widget); - XSETCDR (widget, plist_put (XCDR (widget), property, value)); - return value; -} - -DEFUN ("widget-get", Fwidget_get, Swidget_get, 2, 2, 0, - doc: /* In WIDGET, get the value of PROPERTY. -The value could either be specified when the widget was created, or -later with `widget-put'. */) - (Lisp_Object widget, Lisp_Object property) -{ - Lisp_Object tmp; - - while (1) - { - if (NILP (widget)) - return Qnil; - CHECK_CONS (widget); - tmp = plist_member (XCDR (widget), property); - if (CONSP (tmp)) - { - tmp = XCDR (tmp); - return CAR (tmp); - } - tmp = XCAR (widget); - if (NILP (tmp)) - return Qnil; - widget = Fget (tmp, Qwidget_type); - } -} - -DEFUN ("widget-apply", Fwidget_apply, Swidget_apply, 2, MANY, 0, - doc: /* Apply the value of WIDGET's PROPERTY to the widget itself. -Return the result of applying the value of PROPERTY to WIDGET. -ARGS are passed as extra arguments to the function. -usage: (widget-apply WIDGET PROPERTY &rest ARGS) */) - (ptrdiff_t nargs, Lisp_Object *args) -{ - Lisp_Object widget = args[0]; - Lisp_Object property = args[1]; - Lisp_Object propval = Fwidget_get (widget, property); - Lisp_Object trailing_args = Flist (nargs - 2, args + 2); - Lisp_Object result = CALLN (Fapply, propval, widget, trailing_args); - return result; -} + #ifdef HAVE_LANGINFO_CODESET #include #endif @@ -6903,9 +6846,6 @@ For best results this should end in a space. */); defsubr (&Srequire); defsubr (&Sprovide); defsubr (&Splist_member); - defsubr (&Swidget_put); - defsubr (&Swidget_get); - defsubr (&Swidget_apply); defsubr (&Sbase64_encode_region); defsubr (&Sbase64_decode_region); defsubr (&Sbase64_encode_string); diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el index 755bd12201f..e99347f1666 100644 --- a/test/lisp/wid-edit-tests.el +++ b/test/lisp/wid-edit-tests.el @@ -22,8 +22,20 @@ (require 'ert) (require 'wid-edit) +(ert-deftest widget-test-editable-field-widget-get/put () + (with-temp-buffer + (let ((widget (widget-create 'editable-field + :size 13 + :format "Name: %v " + "My Name"))) + (should (eq (widget-get widget :size) 13)) + (should (equal (widget-get widget :format) "Name: %v ")) + (widget-put widget :size 1) + (widget-put widget :format "foo") + (should (eq (widget-get widget :size) 1)) + (should (equal (widget-get widget :format) "foo"))))) + (ert-deftest widget-at () - "Test `widget-at' behavior." (with-temp-buffer (should-not (widget-at)) (let ((marco (widget-create 'link "link widget")) commit 92a8d24e4948dd9e7fa8bdbadac48f9eed19fa49 Author: Michael Albinus Date: Fri Feb 28 17:47:42 2025 +0100 ; Adapt last change diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 26716ed8b66..e66693d51f6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -120,9 +120,8 @@ :version "22.1" :link '(info-link :tag "Tramp manual" "(tramp) Top")) -;; On MS-DOS, there is no process support. ;;;###autoload -(defvar tramp-mode (not (eq system-type 'ms-dos)) +(defvar tramp-mode (fboundp 'make-process) ; Disable on MS-DOS. "Whether Tramp is enabled. If it is set to nil, all remote file names are used literally. Don't set it manually, use `inhibit-remote-files' or `without-remote-files' commit 68a37760dec83a8126b03bcacc60a96644a6831f Author: Eli Zaretskii Date: Fri Feb 28 16:22:30 2025 +0200 Fix the values and documentation of 'printable-chars' table * src/character.c (syms_of_character) : Doc fix. * lisp/international/characters.el (printable-chars): Fix values for non-ASCII characters. * doc/lispref/nonascii.texi (Character Properties): Add cross-reference for what is a printable character. * doc/lispref/display.texi (Usual Display): * doc/lispref/searching.texi (Char Classes): Add indexing. (Bug#76611) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 3bf9f3bd2ac..1089f695856 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -8585,6 +8585,7 @@ The newline character (character code 10) has a special effect: it ends the preceding line and starts a new line. @cindex ASCII control characters +@cindex non-printable ASCII characters @item The non-printable @dfn{@acronym{ASCII} control characters}---character codes 0 through 31, as well as the @key{DEL} character (character code diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 884f54b32ac..cc1f9d61401 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -754,7 +754,10 @@ each character in columns that it will occupy on the screen. The value of this variable is a char-table that specifies, for each character, whether it is printable or not. That is, if evaluating @code{(aref printable-chars char)} results in @code{t}, the character -is printable, and if it results in @code{nil}, it is not. +is printable, and if it results in @code{nil}, it is not. The +definition of what is a printable character is the same as for the +@samp{[:print:]} character class in regular expressions, @pxref{Char +Classes}. @end defvar @node Character Sets diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 09ff6202afa..7840fe77e60 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -622,6 +622,7 @@ This matches any character whose code is in the range 0--31. @item [:digit:] This matches @samp{0} through @samp{9}. Thus, @samp{[-+[:digit:]]} matches any digit, as well as @samp{+} and @samp{-}. +@cindex graphic characters @item [:graph:] This matches graphic characters---everything except spaces, @acronym{ASCII} and non-@acronym{ASCII} control characters, @@ -638,6 +639,7 @@ one. This matches any multibyte character (@pxref{Text Representations}). @item [:nonascii:] This matches any non-@acronym{ASCII} character. +@cindex printable characters @item [:print:] This matches any printing character---either spaces or graphic characters matched by @samp{[:graph:]}. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 09932af58e5..66f9bef1a74 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1608,6 +1608,22 @@ with L, LRE, or LRO Unicode bidi character type.") (lambda (range _ignore) (set-char-table-range char-width-table range 2)) 'arabic-2-column) + +;;; Setting printable-chars. The default is nil for control characters, +;;; otherwise t. +;;; The table is initialized in character.c with a crude approximation, +;;; which considers any non-ASCII character above U+009F to be printable. +;;; Note: this should be consistent with [:print:] character class, +;;; see character.c:printablep. +(let ((table (unicode-property-table-internal 'general-category))) + (when table + (map-char-table (lambda (key val) + ;; Cs: Surrogates + ;; Cn: Unassigned + (when (memq val '(Cs Cn)) + (set-char-table-range printable-chars key nil))) + table))) + ;; Internal use only. ;; Alist of locale symbol vs charsets. In a language environment ;; corresponding to the locale, width of characters in the charsets is diff --git a/src/character.c b/src/character.c index 4e6cc280b40..f3c06da37e7 100644 --- a/src/character.c +++ b/src/character.c @@ -1104,7 +1104,7 @@ symbol naming it. The ID of a translation table is an index into this vector. DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars, doc: /* A char-table for characters which invoke auto-filling. -Such characters have value t in this table. */); +Such characters have the value t in this table. */); Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil); CHAR_TABLE_SET (Vauto_fill_chars, ' ', Qt); CHAR_TABLE_SET (Vauto_fill_chars, '\n', Qt); @@ -1126,7 +1126,8 @@ value of `cjk-ambiguous-chars-are-wide'. */); Vambiguous_width_chars = Fmake_char_table (Qnil, Qnil); DEFVAR_LISP ("printable-chars", Vprintable_chars, - doc: /* A char-table for each printable character. */); + doc: /* A char-table for printable characters. +Such characters have the value t in this table. */); Vprintable_chars = Fmake_char_table (Qnil, Qnil); Fset_char_table_range (Vprintable_chars, Fcons (make_fixnum (32), make_fixnum (126)), Qt); commit 18c8c44bef9b85adf3cff65f08b7f6a8c59687db Author: Po Lu Date: Fri Feb 28 21:05:55 2025 +0800 Adapt process-tests to Android * src/android.c (android_init_thread_events) (android_run_select_thread): Guarantee that the select thread is initialized before returning. * test/src/process-tests.el (process-tests/fd-setsize-no-crash/make-process) (process-tests/fd-setsize-no-crash/make-pipe-process) (process-tests/fd-setsize-no-crash/make-network-process) (process-tests/fd-setsize-no-crash/make-serial-process): Skip on Android. diff --git a/src/android.c b/src/android.c index 15edca94fdf..b7d68def467 100644 --- a/src/android.c +++ b/src/android.c @@ -388,6 +388,10 @@ android_init_thread_events (struct android_thread_event_queue *thread) strerror (errno)); emacs_abort (); } + + /* Wait for the thread to be initialized. */ + while (sem_wait (&thread->select_sem) < 0) + ;; } #ifdef THREADS_ENABLED @@ -521,6 +525,9 @@ android_run_select_thread (void *thread_data) inside pselect, a file descriptor is selected. Data is written to the file descriptor whenever select is supposed to return. */ + /* Release the user after initialization. */ + sem_post (&data->select_sem); + while (true) { /* Wait for the thread to be released. */ @@ -603,6 +610,8 @@ android_run_select_thread (void *thread_data) #ifdef THREADS_ENABLED pthread_setspecific (poll_thread_internal, thread_data); #endif /* THREADS_ENABLED */ + /* Release the user after initialization. */ + sem_post (&data->select_sem); while (true) { diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 7634cec2207..0693bbe8924 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -663,6 +663,10 @@ FD_SETSIZE." (ert-deftest process-tests/fd-setsize-no-crash/make-process () "Check that Emacs doesn't crash when trying to use more than FD_SETSIZE file descriptors (Bug#24325)." + ;; Emacs is terminated on Android or aborts when the toolkit fails to + ;; allocate sufficient graphics buffer handles long before FD_SETSIZE + ;; is exceeded. + (skip-when (eq system-type 'android)) (with-timeout (60 (ert-fail "Test timed out")) (let ((cat (executable-find "cat"))) (skip-unless cat) @@ -708,6 +712,10 @@ FD_SETSIZE file descriptors (Bug#24325)." (ert-deftest process-tests/fd-setsize-no-crash/make-pipe-process () "Check that Emacs doesn't crash when trying to use more than FD_SETSIZE file descriptors (Bug#24325)." + ;; Emacs is terminated on Android or aborts when the toolkit fails to + ;; allocate sufficient graphics buffer handles long before FD_SETSIZE + ;; is exceeded. + (skip-when (eq system-type 'android)) (with-timeout (60 (ert-fail "Test timed out")) (process-tests--fd-setsize-test (process-tests--with-buffers buffers @@ -735,6 +743,10 @@ FD_SETSIZE file descriptors (Bug#24325)." (ert-deftest process-tests/fd-setsize-no-crash/make-network-process () "Check that Emacs doesn't crash when trying to use more than FD_SETSIZE file descriptors (Bug#24325)." + ;; Emacs is terminated on Android or aborts when the toolkit fails to + ;; allocate sufficient graphics buffer handles long before FD_SETSIZE + ;; is exceeded. + (skip-when (eq system-type 'android)) (skip-unless (featurep 'make-network-process '(:server t))) (skip-unless (featurep 'make-network-process '(:family local))) ;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496). @@ -777,6 +789,10 @@ FD_SETSIZE file descriptors (Bug#24325)." (ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () "Check that Emacs doesn't crash when trying to use more than FD_SETSIZE file descriptors (Bug#24325)." + ;; Emacs is terminated on Android or aborts when the toolkit fails to + ;; allocate sufficient graphics buffer handles long before FD_SETSIZE + ;; is exceeded. + (skip-when (eq system-type 'android)) ;; This test cannot be run if PTYs aren't supported. (skip-when (eq system-type 'windows-nt)) (with-timeout (60 (ert-fail "Test timed out")) commit a04e8812ee0dfb7f2984d0b57b380cf15c73567c Author: Eli Zaretskii Date: Fri Feb 28 14:45:39 2025 +0200 Fix 'internal--c-header-file-path' * lisp/subr.el (internal--c-header-file-path): Fix for MS-Windows: don't prepend the (usually non-existent) "/usr/include", and run each directory through 'expand-file-name' to remove the many ".." elements and mirror any backslashes. Invoke "clang" if "gcc" is not available or is actually clang. * test/lisp/subr-tests.el (subr-tests-internal--c-header-file-path): Fix for MS-Windows: test the path by looking for stdio.h, and expand all directory names to compare to expected results. diff --git a/lisp/subr.el b/lisp/subr.el index 7263817711b..128bf258ab6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7642,14 +7642,20 @@ and return the value found in PLACE instead." ;; cc-search-directories, semantic-c-dependency-system-include-path, ;; semantic-gcc-setup (delete-dups - (let ((base '("/usr/include" "/usr/local/include"))) - (cond ((or (internal--gcc-is-clang-p) - (and (executable-find "clang") - (not (executable-find "gcc")))) - ;; This is either macOS, or a system with clang only. + ;; We treat MS-Windows/MS-DOS specially, since there's no + ;; widely-accepted canonical directory for C include files. + (let ((base (if (not (memq system-type '(windows-nt ms-dos))) + '("/usr/include" "/usr/local/include"))) + (call-clang-p (or (internal--gcc-is-clang-p) + (and (executable-find "clang") + (not (executable-find "gcc")))))) + (cond ((or call-clang-p + (memq system-type '(windows-nt ms-dos))) + ;; This is either macOS, or MS-Windows/MS-DOS, or a system + ;; with clang only. (with-temp-buffer (ignore-errors - (call-process (if (internal--gcc-is-clang-p) "gcc" "clang") + (call-process (if call-clang-p "clang" "gcc") nil t nil "-v" "-E" "-")) (goto-char (point-min)) @@ -7663,10 +7669,15 @@ and return the value found in PLACE instead." (pos-bol))) (while (search-forward "(framework directory)" nil t) (delete-line)) - (append base - (reverse - (split-string (buffer-substring-no-properties - (point-min) (point-max))))))) + ;; "gcc -v" reports file names with many "..", so we + ;; normalize it. + (or (mapcar #'expand-file-name + (append base + (split-string (buffer-substring-no-properties + (point-min) (point-max))))) + ;; Fallback for whedn the compiler is not available. + (list (expand-file-name "/usr/include") + (expand-file-name "/usr/local/include"))))) ;; Prefer GCC. ((let ((arch (with-temp-buffer (when (eq 0 (ignore-errors diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index b21f90226c6..c2f64867d90 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1465,14 +1465,17 @@ final or penultimate step during initialization.")) (ert-deftest subr-tests-internal--c-header-file-path () (should (seq-every-p #'stringp (internal--c-header-file-path))) - (should (member "/usr/include" (internal--c-header-file-path))) + (should (locate-file "stdio.h" (internal--c-header-file-path))) + (or (memq system-type '(windows-nt ms-dos)) + (should (member "/usr/include" (internal--c-header-file-path)))) (should (equal (internal--c-header-file-path) (delete-dups (internal--c-header-file-path)))) ;; Return a meaningful result even if calling some compiler fails. (cl-letf (((symbol-function 'call-process) (lambda (_program &optional _infile _destination _display &rest _args) 1))) (should (seq-every-p #'stringp (internal--c-header-file-path))) - (should (member "/usr/include" (internal--c-header-file-path))) + (should (member (expand-file-name "/usr/include") + (internal--c-header-file-path))) (should (equal (internal--c-header-file-path) (delete-dups (internal--c-header-file-path)))))) @@ -1482,13 +1485,16 @@ final or penultimate step during initialization.")) (lambda (_program &optional _infile _destination _display &rest args) (when (equal (car args) "-print-multiarch") (insert "\n") 0)))) - (should (member "/usr/include" (internal--c-header-file-path)))) + (should (member (expand-file-name "/usr/include") + (internal--c-header-file-path)))) ;; Handle single values of "gcc -print-multiarch". - (cl-letf (((symbol-function 'call-process) + (cl-letf ((system-type 'foo) + ((symbol-function 'call-process) (lambda (_program &optional _infile _destination _display &rest args) (when (equal (car args) "-print-multiarch") (insert "x86_64-linux-gnu\n") 0)))) - (should (member "/usr/include/x86_64-linux-gnu" (internal--c-header-file-path))))) + (should (member (expand-file-name "/usr/include/x86_64-linux-gnu") + (internal--c-header-file-path))))) (ert-deftest subr-tests-internal--c-header-file-path/clang-mocked () ;; Handle clang 15.0.0 output on macOS 15.2. @@ -1519,8 +1525,7 @@ End of search list. # 1 \"\" 2 # 1 \"\" 2") 0))) - (should (member "/usr/include" (internal--c-header-file-path))) - (should (member "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include" + (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include") (internal--c-header-file-path))))) (provide 'subr-tests) commit 387dcb1be88168f2683af52041b4f5a6e3bde146 Author: Po Lu Date: Fri Feb 28 19:52:14 2025 +0800 ; * etc/NEWS: Announce previous change. diff --git a/etc/NEWS b/etc/NEWS index ae267c4c5dd..76c8290fe32 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1704,6 +1704,12 @@ The run-time performance of subprocesses on recent Android releases, where a userspace executable loader is required, has been optimized on systems featuring Linux 3.5.0 and above. +--- +** It is now possible to read GUI events from non-main Lisp threads on Android. +Put differently, this enables input events to be read and recursive +editing sessions to be started from non-main threads. The only platform +where this remains unsupported is Nextstep (GNUstep or Mac OS). + --- ** 'NSSpeechRecognitionUsageDescription' now included in "Info.plist" (macOS). Should Emacs (or any built-in shell) invoke a process using macOS speech commit 8df582a46836e312ef3bfc36c8038b5f4a2c0d9b Author: Po Lu Date: Fri Feb 28 19:49:34 2025 +0800 Fully support Lisp threads on Android * src/android.c (struct android_thread_event_queue): New structure. Move global pselect arguments, mutexes, and semaphores, and pipes here. (struct android_event_queue) : Remove to the above-named struct. (android_init_thread_events, android_finalize_thread_events) (android_get_poll_thread): New functions. (android_run_select_thread): Accept a set of mutexes and thread-local data as the first argument, and operate with them rather than globals. (android_handle_sigusr1): Rename to `android_handle_poll_signal'. Set thread-specific cancellation indicator. (android_init_events): Properly abort after a fatal condition. Enable interruptible polling on Android 5.1 and later, not 4.2. (android_select): Never check for queries here, but in thread_select, if threads are enabled. Adapt to per-thread polling threads and only enable interruptible polling on Android 5.1 and later. (android_before_select): New function. * src/android.h (android_before_select): New declaration. * src/thread.c (thread_select): Call `android_before_select' before the global lock is released. diff --git a/src/android.c b/src/android.c index 05b593f0f31..15edca94fdf 100644 --- a/src/android.c +++ b/src/android.c @@ -266,57 +266,191 @@ struct android_event_container union android_event event; }; -struct android_event_queue -{ - /* Mutex protecting the event queue. */ - pthread_mutex_t mutex; +/* Thread-specific component of the Android event queue. */ +struct android_thread_event_queue +{ /* Mutex protecting the select data. */ pthread_mutex_t select_mutex; /* The thread used to run select. */ pthread_t select_thread; + /* Arguments to pselect used by the select thread. */ + fd_set *select_readfds; + fd_set *select_writefds; + fd_set *select_exceptfds; + struct timespec *select_timeout; + int select_nfds; + + /* Semaphores posted around invocations of pselect. */ + sem_t start_sem; + sem_t select_sem; + + /* Value of pselect. */ + int select_rc; + +#if __ANDROID_API__ < 21 + /* Select self-pipe. */ + int select_pipe[2]; +#else /* __ANDROID_API__ >= 21 */ + /* Whether a signal has been received to cancel pselect in this + thread. */ + volatile sig_atomic_t cancel_signal_received; +#endif /* __ANDROID_API__ >= 21 */ + + /* Whether this thread must exit. */ + int canceled; +}; + +#if __ANDROID_API__ >= 21 +#define SELECT_SIGNAL SIGUSR1 +#endif /* __ANDROID_API__ >= 21 */ + +struct android_event_queue +{ + /* Mutex protecting the event queue. */ + pthread_mutex_t mutex; + /* Condition variables for the reading side. */ pthread_cond_t read_var; - /* The number of events in the queue. If this is greater than 1024, - writing will block. */ - int num_events; - /* Circular queue of events. */ struct android_event_container events; -}; -/* Arguments to pselect used by the select thread. */ -static int android_pselect_nfds; -static fd_set *android_pselect_readfds; -static fd_set *android_pselect_writefds; -static fd_set *android_pselect_exceptfds; -static struct timespec *android_pselect_timeout; +#ifndef THREADS_ENABLED + /* If threads are disabled, the thread-specific component of the main + and only thread. */ + struct android_thread_event_queue thread; +#endif /* !THREADS_ENABLED */ -/* Value of pselect. */ -static int android_pselect_rc; + /* The number of events in the queue. */ + int num_events; +}; /* The global event queue. */ static struct android_event_queue event_queue; -/* Semaphores used to signal select completion and start. */ -static sem_t android_pselect_sem, android_pselect_start_sem; +/* Main select loop of select threads. */ +static void *android_run_select_thread (void *); -#if __ANDROID_API__ < 16 +/* Initialize a thread-local component of the Android event queue + THREAD. Create and initialize a thread whose purpose is to execute + `select' in an interruptible manner, and initialize variables or file + descriptors with which to communicate with it. */ -/* Select self-pipe. */ -static int select_pipe[2]; +static void +android_init_thread_events (struct android_thread_event_queue *thread) +{ + thread->canceled = false; + thread->select_readfds = NULL; + thread->select_writefds = NULL; + thread->select_exceptfds = NULL; + thread->select_timeout = NULL; + thread->select_nfds = 0; -#else + if (pthread_mutex_init (&thread->select_mutex, NULL)) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pthread_mutex_init: %s", + strerror (errno)); + emacs_abort (); + } -/* Whether or not pselect has been interrupted. */ -static volatile sig_atomic_t android_pselect_interrupted; + sem_init (&thread->select_sem, 0, 0); + sem_init (&thread->start_sem, 0, 0); -#endif +#if __ANDROID_API__ < 21 + /* Set up the file descriptor used to wake up pselect. */ + if (pipe2 (thread->select_pipe, O_CLOEXEC) < 0) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pipe2: %s", strerror (errno)); + emacs_abort (); + } + + /* Make sure the read end will fit in fd_set. */ + if (thread->select_pipe[0] >= FD_SETSIZE) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "read end of select pipe" + " exceeds FD_SETSIZE!"); + emacs_abort (); + } +#endif /* __ANDROID_API__ < 21 */ + + /* Start the select thread. */ + if (pthread_create (&thread->select_thread, NULL, + android_run_select_thread, thread)) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pthread_create: %s", + strerror (errno)); + emacs_abort (); + } +} + +#ifdef THREADS_ENABLED + +/* Destroy a thread-local component of the Android event queue provided + as DATA, and release DATA's storage itself. Must be invoked at a + time when the select thread is idle, i.e., awaiting + DATA->start_sem. */ + +static void +android_finalize_thread_events (void *data) +{ + int rc; + struct android_thread_event_queue *thread; + + /* Cancel the thread and pause till it exits. */ + thread = data; + thread->canceled = 1; + sem_post (&thread->start_sem); + rc = pthread_join (thread->select_thread, NULL); + if (rc) + emacs_abort (); + + /* Release the select thread, semaphores, etc. */ + pthread_mutex_destroy (&thread->select_mutex); + sem_close (&thread->select_sem); + sem_close (&thread->start_sem); +#if __ANDROID_API__ < 21 + close (thread->select_pipe[0]); + close (thread->select_pipe[1]); +#endif /* __ANDROID_API__ < 21 */ + xfree (thread); +} + +/* TLS keys associating polling threads with Emacs threads. */ +static pthread_key_t poll_thread, poll_thread_internal; + +#endif /* THREADS_ENABLED */ + +/* Return the thread-specific component of the event queue appertaining + to this thread, or create it as well as a polling thread if + absent. */ -/* Set the task name of the current task to NAME, a string at most 16 +static struct android_thread_event_queue * +android_get_poll_thread (void) +{ +#ifndef THREADS_ENABLED + return &event_queue.thread; +#else /* THREADS_ENABLED */ + struct android_thread_event_queue *queue; + + queue = pthread_getspecific (poll_thread); + if (!queue) + { + queue = xmalloc (sizeof *queue); + android_init_thread_events (queue); + pthread_setspecific (poll_thread, queue); + } + return queue; +#endif /* !THREADS_ENABLED */ +} + +/* Set the task name of the current task to NAME, a string at most 21 characters in length. This name is displayed as that of the task (LWP)'s pthread in @@ -357,67 +491,73 @@ android_set_task_name (const char *name) } static void * -android_run_select_thread (void *data) +android_run_select_thread (void *thread_data) { /* Apparently this is required too. */ JNI_STACK_ALIGNMENT_PROLOGUE; int rc; -#if __ANDROID_API__ < 16 + struct android_thread_event_queue *data; +#if __ANDROID_API__ < 21 int nfds; fd_set readfds; char byte; -#else +#else /* __ANDROID_API__ >= 21 */ sigset_t signals, waitset; int sig; -#endif +#endif /* __ANDROID_API__ >= 21 */ /* Set the name of this thread's LWP for debugging purposes. */ - android_set_task_name ("`android_select'"); + android_set_task_name ("Emacs polling thread"); + data = thread_data; -#if __ANDROID_API__ < 16 +#if __ANDROID_API__ < 21 /* A completely different implementation is used when building for - Android versions earlier than 16, because pselect with a signal - mask does not work there. Instead of blocking SIGUSR1 and - unblocking it inside pselect, a file descriptor is used instead. - Something is written to the file descriptor every time select is - supposed to return. */ + Android versions earlier than 21, because pselect with a signal + mask does not work properly: the signal mask is truncated on APIs + <= 16, and elsewhere, the signal mask is applied in userspace + before issuing a select system call, between which SELECT_SIGNAL + may arrive. Instead of blocking SELECT_SIGNAL and unblocking it + inside pselect, a file descriptor is selected. Data is written to + the file descriptor whenever select is supposed to return. */ while (true) { /* Wait for the thread to be released. */ - while (sem_wait (&android_pselect_start_sem) < 0) + while (sem_wait (&data->start_sem) < 0) ;; + if (data->canceled) + return NULL; /* Get the select lock and call pselect. API 8 does not have working pselect in any sense. Instead, pselect wakes up on select_pipe[0]. */ - pthread_mutex_lock (&event_queue.select_mutex); - nfds = android_pselect_nfds; + pthread_mutex_lock (&data->select_mutex); + nfds = data->select_nfds; - if (android_pselect_readfds) - readfds = *android_pselect_readfds; + if (data->select_readfds) + readfds = *data->select_readfds; else FD_ZERO (&readfds); - if (nfds < select_pipe[0] + 1) - nfds = select_pipe[0] + 1; - FD_SET (select_pipe[0], &readfds); + if (nfds < data->select_pipe[0] + 1) + nfds = data->select_pipe[0] + 1; + FD_SET (data->select_pipe[0], &readfds); rc = pselect (nfds, &readfds, - android_pselect_writefds, - android_pselect_exceptfds, - android_pselect_timeout, + data->select_writefds, + data->select_exceptfds, + data->select_timeout, NULL); /* Subtract 1 from rc if readfds contains the select pipe, and also remove it from that set. */ - if (rc != -1 && FD_ISSET (select_pipe[0], &readfds)) + if (rc != -1 && FD_ISSET (data->select_pipe[0], &readfds)) { rc -= 1; - FD_CLR (select_pipe[0], &readfds); + FD_CLR (data->select_pipe[0], &readfds); /* If no file descriptors aside from the select pipe are ready, then pretend that an error has occurred. */ @@ -427,11 +567,11 @@ android_run_select_thread (void *data) /* Save the read file descriptor set back again. */ - if (android_pselect_readfds) - *android_pselect_readfds = readfds; + if (data->select_readfds) + *data->select_readfds = readfds; - android_pselect_rc = rc; - pthread_mutex_unlock (&event_queue.select_mutex); + data->select_rc = rc; + pthread_mutex_unlock (&data->select_mutex); /* Signal the main thread that there is now data to read. Hold the event queue lock during this process to make sure this @@ -443,44 +583,46 @@ android_run_select_thread (void *data) pthread_mutex_unlock (&event_queue.mutex); /* Read a single byte from the select pipe. */ - read (select_pipe[0], &byte, 1); + read (data->select_pipe[0], &byte, 1); /* Signal the Emacs thread that pselect is done. If read_var was signaled by android_write_event, event_queue.mutex could still be locked, so this must come before. */ - sem_post (&android_pselect_sem); + sem_post (&data->select_sem); } -#else +#else /* __ANDROID_API__ >= 21 */ + sigfillset (&signals); if (pthread_sigmask (SIG_BLOCK, &signals, NULL)) __android_log_print (ANDROID_LOG_FATAL, __func__, "pthread_sigmask: %s", strerror (errno)); - sigfillset (&signals); - sigdelset (&signals, SIGUSR1); + sigdelset (&signals, SELECT_SIGNAL); sigemptyset (&waitset); - sigaddset (&waitset, SIGUSR1); + sigaddset (&waitset, SELECT_SIGNAL); +#ifdef THREADS_ENABLED + pthread_setspecific (poll_thread_internal, thread_data); +#endif /* THREADS_ENABLED */ while (true) { /* Wait for the thread to be released. */ - while (sem_wait (&android_pselect_start_sem) < 0) + while (sem_wait (&data->start_sem) < 0) ;; - - /* Clear the ``pselect interrupted'' flag. This is safe because - right now, SIGUSR1 is blocked. */ - android_pselect_interrupted = 0; + if (data->canceled) + return NULL; /* Get the select lock and call pselect. */ - pthread_mutex_lock (&event_queue.select_mutex); - rc = pselect (android_pselect_nfds, - android_pselect_readfds, - android_pselect_writefds, - android_pselect_exceptfds, - android_pselect_timeout, + data->cancel_signal_received = 0; + pthread_mutex_lock (&data->select_mutex); + rc = pselect (data->select_nfds, + data->select_readfds, + data->select_writefds, + data->select_exceptfds, + data->select_timeout, &signals); - android_pselect_rc = rc; - pthread_mutex_unlock (&event_queue.select_mutex); + data->select_rc = rc; + pthread_mutex_unlock (&data->select_mutex); /* Signal the main thread that there is now data to read. Hold the event queue lock during this process to make sure this @@ -491,39 +633,51 @@ android_run_select_thread (void *data) pthread_cond_broadcast (&event_queue.read_var); pthread_mutex_unlock (&event_queue.mutex); - /* Check `android_pselect_interrupted' instead of rc and errno. + /* Test a separate flag `data->cancel_signal_received' rather than + rc and errno. This is because `pselect' does not return an rc of -1 upon being interrupted in some versions of Android, but does set signal masks correctly. */ - - if (!android_pselect_interrupted) - /* Now, wait for SIGUSR1, unless pselect was interrupted and - the signal was already delivered. The Emacs thread will - always send this signal after read_var is triggered or the - UI thread has sent an event. */ + if (!data->cancel_signal_received) + /* Now, wait for SELECT_SIGNAL, unless pselect was interrupted + and the signal has already been delivered. The Emacs thread + will always send this signal after read_var is triggered or + the UI thread has sent an event. */ sigwait (&waitset, &sig); /* Signal the Emacs thread that pselect is done. If read_var was signaled by android_write_event, event_queue.mutex could still be locked, so this must come before. */ - sem_post (&android_pselect_sem); + sem_post (&data->select_sem); } -#endif +#endif /* __ANDROID_API__ >= 21 */ return NULL; } -#if __ANDROID_API__ >= 16 +#if __ANDROID_API__ >= 21 static void -android_handle_sigusr1 (int sig, siginfo_t *siginfo, void *arg) +android_handle_poll_signal (int sig, siginfo_t *siginfo, void *arg) { - /* Notice that pselect has been interrupted. */ - android_pselect_interrupted = 1; + struct android_thread_event_queue *queue; + + /* Although pthread_getspecific is not AS-safe, its implementation has + been verified to be safe to invoke from a single handler called + within pselect in a controlled manner, and this is the only means + of retrieving thread-specific data from a signal handler, as the + POSIX real-time signal system calls are unavailable to Android + applications. */ +#ifdef THREADS_ENABLED + queue = pthread_getspecific (poll_thread_internal); +#else /* !THREADS_ENABLED */ + queue = &event_queue.thread; +#endif /* !THREADS_ENABLED */ + queue->cancel_signal_received = 1; } -#endif +#endif /* __ANDROID_API__ >= 21 */ /* Semaphore used to indicate completion of a query. This should ideally be defined further down. */ @@ -543,66 +697,57 @@ static pthread_t main_thread_id; static void android_init_events (void) { +#if __ANDROID_API__ >= 21 struct sigaction sa; +#endif /* __ANDROID_API__ >= 21 */ if (pthread_mutex_init (&event_queue.mutex, NULL)) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "pthread_mutex_init: %s", - strerror (errno)); - - if (pthread_mutex_init (&event_queue.select_mutex, NULL)) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "pthread_mutex_init: %s", - strerror (errno)); + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pthread_mutex_init: %s", + strerror (errno)); + emacs_abort (); + } if (pthread_cond_init (&event_queue.read_var, NULL)) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "pthread_cond_init: %s", - strerror (errno)); - - sem_init (&android_pselect_sem, 0, 0); - sem_init (&android_pselect_start_sem, 0, 0); - sem_init (&android_query_sem, 0, 0); + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pthread_cond_init: %s", + strerror (errno)); + emacs_abort (); + } event_queue.events.next = &event_queue.events; event_queue.events.last = &event_queue.events; main_thread_id = pthread_self (); -#if __ANDROID_API__ >= 16 - - /* Before starting the select thread, make sure the disposition for - SIGUSR1 is correct. */ +#if __ANDROID_API__ >= 21 + /* Before any event threads are initialized, guarantee that the + disposition of SELECT_SIGNAL is correct. */ sigfillset (&sa.sa_mask); - sa.sa_sigaction = android_handle_sigusr1; + sa.sa_sigaction = android_handle_poll_signal; sa.sa_flags = SA_SIGINFO; - -#else - - /* Set up the file descriptor used to wake up pselect. */ - if (pipe2 (select_pipe, O_CLOEXEC) < 0) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "pipe2: %s", strerror (errno)); - - /* Make sure the read end will fit in fd_set. */ - if (select_pipe[0] >= FD_SETSIZE) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "read end of select pipe" - " lies outside FD_SETSIZE!"); - -#endif - - if (sigaction (SIGUSR1, &sa, NULL)) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "sigaction: %s", - strerror (errno)); - - /* Start the select thread. */ - if (pthread_create (&event_queue.select_thread, NULL, - android_run_select_thread, NULL)) - __android_log_print (ANDROID_LOG_FATAL, __func__, - "pthread_create: %s", - strerror (errno)); + if (sigaction (SELECT_SIGNAL, &sa, NULL)) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "sigaction: %s", + strerror (errno)); + emacs_abort (); + } +#endif /* __ANDROID_API__ >= 21 */ +#ifndef THREADS_ENABLED + android_init_thread_events (&event_queue.thread); +#else /* THREADS_ENABLED */ + if (pthread_key_create (&poll_thread, android_finalize_thread_events) + || pthread_key_create (&poll_thread_internal, NULL)) + { + __android_log_print (ANDROID_LOG_FATAL, __func__, + "pthread_key_create: %s", + strerror (errno)); + emacs_abort (); + } +#endif /* THREADS_ENABLED */ } int @@ -761,25 +906,17 @@ int android_select (int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timespec *timeout) { - int nfds_return; -#if __ANDROID_API__ < 16 + int nfds_return, nevents; +#if __ANDROID_API__ < 21 static char byte; #endif + struct android_thread_event_queue *data; -#ifdef THREADS_ENABLED - if (!pthread_equal (pthread_self (), main_thread_id)) - return pselect (nfds, readfds, writefds, exceptfds, timeout, - NULL); -#endif /* THREADS_ENABLED */ - - /* Since Emacs is reading keyboard input again, signify that queries - from input methods are no longer ``urgent''. */ - - __atomic_clear (&android_urgent_query, __ATOMIC_RELEASE); - - /* Check for and run anything the UI thread wants to run on the main - thread. */ - android_check_query (); + /* When threads are enabled, the following is executed before the + global lock is released. */ +#ifndef THREADS_ENABLED + android_before_select (); +#endif /* !THREADS_ENABLED */ pthread_mutex_lock (&event_queue.mutex); @@ -804,60 +941,60 @@ android_select (int nfds, fd_set *readfds, fd_set *writefds, nfds_return = 0; - pthread_mutex_lock (&event_queue.select_mutex); - android_pselect_nfds = nfds; - android_pselect_readfds = readfds; - android_pselect_writefds = writefds; - android_pselect_exceptfds = exceptfds; - android_pselect_timeout = timeout; - pthread_mutex_unlock (&event_queue.select_mutex); + data = android_get_poll_thread (); + + pthread_mutex_lock (&data->select_mutex); + data->select_nfds = nfds; + data->select_readfds = readfds; + data->select_writefds = writefds; + data->select_exceptfds = exceptfds; + data->select_timeout = timeout; + pthread_mutex_unlock (&data->select_mutex); /* Release the select thread. */ - sem_post (&android_pselect_start_sem); + sem_post (&data->start_sem); /* Start waiting for the event queue condition to be set. */ pthread_cond_wait (&event_queue.read_var, &event_queue.mutex); -#if __ANDROID_API__ >= 16 +#if __ANDROID_API__ >= 21 /* Interrupt the select thread now, in case it's still in pselect. */ - pthread_kill (event_queue.select_thread, SIGUSR1); -#else + pthread_kill (data->select_thread, SELECT_SIGNAL); +#else /* __ANDROID_API__ < 21 */ /* Interrupt the select thread by writing to the select pipe. */ - if (write (select_pipe[1], &byte, 1) != 1) + if (write (data->select_pipe[1], &byte, 1) != 1) __android_log_print (ANDROID_LOG_FATAL, __func__, "write: %s", strerror (errno)); -#endif +#endif /* __ANDROID_API__ < 21 */ - /* Unlock the event queue mutex. */ + /* Are there any events in the event queue? */ + nevents = event_queue.num_events; pthread_mutex_unlock (&event_queue.mutex); - /* Wait for pselect to return in any case. This must be done with - the event queue mutex unlocked. Otherwise, the pselect thread - can hang if it tries to lock the event queue mutex to signal - read_var after the UI thread has already done so. */ - while (sem_wait (&android_pselect_sem) < 0) + /* Wait for pselect to return in any case. This must be done with the + event queue mutex unlocked. Otherwise, the pselect thread can hang + if it tries to lock the event queue mutex to signal read_var after + the UI thread has already done so. */ + while (sem_wait (&data->select_sem) < 0) ;; /* If there are now events in the queue, return 1. */ - - pthread_mutex_lock (&event_queue.mutex); - if (event_queue.num_events) + if (nevents) nfds_return = 1; - pthread_mutex_unlock (&event_queue.mutex); - /* Add the return value of pselect if it has also found ready file - descriptors. */ + /* Add the return value of pselect if it has also discovered ready + file descriptors. */ - if (android_pselect_rc >= 0) - nfds_return += android_pselect_rc; + if (data->select_rc >= 0) + nfds_return += data->select_rc; else if (!nfds_return) - /* If pselect was interrupted and nfds_return is 0 (meaning that - no events have been read), indicate that an error has taken + /* If pselect was interrupted and nfds_return is 0 (meaning that no + events have been read), indicate that an error has taken place. */ - nfds_return = android_pselect_rc; + nfds_return = data->select_rc; - if ((android_pselect_rc < 0) && nfds_return >= 0) + if ((data->select_rc < 0) && nfds_return >= 0) { /* Clear the file descriptor sets if events will be delivered but no file descriptors have become ready to prevent the @@ -6721,6 +6858,23 @@ static void *android_query_context; itself; however, the input signal handler executes a memory fence to ensure that all query related writes become visible. */ +/* Clear the ``urgent query'' flag and run any function that the UI + thread has asked to run. Must be invoked before `android_select' + from the thread holding the global lock. */ + +void +android_before_select (void) +{ + /* Since Emacs is reading keyboard input again, signify that queries + from input methods are no longer ``urgent''. */ + + __atomic_clear (&android_urgent_query, __ATOMIC_RELEASE); + + /* Check for and run anything the UI thread wants to run on the main + thread. */ + android_check_query (); +} + /* Run any function that the UI thread has asked to run, and then signal its completion. */ @@ -6781,7 +6935,7 @@ android_check_query_urgent (void) if (!proc) return; - proc (closure); + (*proc) (closure); /* Finish the query. Don't clear `android_urgent_query'; instead, do that the next time Emacs enters the keyboard loop. */ @@ -6931,8 +7085,8 @@ android_run_in_emacs_thread (void (*proc) (void *), void *closure) /* Send a dummy event. `android_check_query' will be called inside wait_reading_process_output after the event arrives. - Otherwise, android_select will call android_check_thread the next - time it is entered. */ + Otherwise, android_select will call `android_check_query' when next + it is entered. */ android_write_event (&event); /* Start waiting for the function to be executed. First, wait two diff --git a/src/android.h b/src/android.h index 31436301df8..1a12c95c9a5 100644 --- a/src/android.h +++ b/src/android.h @@ -244,6 +244,7 @@ extern void android_display_toast (const char *); /* Event loop functions. */ +extern void android_before_select (void); extern void android_check_query (void); extern void android_check_query_urgent (void); extern int android_run_in_emacs_thread (void (*) (void *), void *); diff --git a/src/thread.c b/src/thread.c index 5610f8be0dd..8fd713d0c81 100644 --- a/src/thread.c +++ b/src/thread.c @@ -653,6 +653,9 @@ thread_select (select_func *func, int max_fds, fd_set *rfds, sa.efds = efds; sa.timeout = timeout; sa.sigmask = sigmask; +#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY + android_before_select (); +#endif /* HAVE_ANDROID && !defined ANDROID_STUBIFY */ flush_stack_call_func (really_call_select, &sa); return sa.result; } commit 8b9194ae03214dd5169bd84f7d83bbe660dd9f90 Author: Eshel Yaron Date: Fri Feb 28 12:07:31 2025 +0100 Make 'completion-preview-sort-function' a defcustom * lisp/completion-preview.el (completion-preview-sort-function): Define and document it as a user option. * etc/NEWS: Announce. diff --git a/etc/NEWS b/etc/NEWS index a59a1a3017d..ae267c4c5dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -184,6 +184,17 @@ accepts a comma-separated list. The prompt format can include the separator description and the separator string, which are both stored as text properties of the 'crm-separator' regular expression. +--- +*** New user option 'completion-preview-sort-function'. +This option controls how Completion Preview mode sorts completion +candidates. If you use this mode together with an in-buffer completion +popup interface, such as the interfaces that the GNU ELPA packages Corfu +and Company provide, you can set this option to the same sort function +that your popup interface uses for a more integrated experience. + +Note: 'completion-preview-sort-function' was present also in Emacs 30.1, +albeit as a variable, not a user option. + ** Windows +++ diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 4fc9bb0c9f3..6ccf235dbc5 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -226,8 +226,20 @@ affect the background color, for example with `hl-line-mode'." (const :tag "Disable" nil)) :version "31.1") -(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha - "Sort function to use for choosing a completion candidate to preview.") +(defcustom completion-preview-sort-function #'minibuffer--sort-by-length-alpha + "Sort function to use for choosing a completion candidate to preview. + +Completion Preview mode calls the function that this option specifies to +sort completion candidates. The function takes one argument, the list +of candidates, and returns the list sorted. + +The default sort function sorts first by length, then alphabetically. +To disable sorting, set this option to `identity'. + +If the completion table that produces the candidates already specifies a +sort function, it takes precedence over this option." + :type 'function + :version "31.1") (defface completion-preview '((t :inherit shadow)) commit 5447b015a44d411606687999a7a5803d19899f23 Author: Michael Albinus Date: Fri Feb 28 10:38:04 2025 +0100 * lisp/net/tramp.el (tramp-mode): Set to nil on MS-DOS. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a199417b12a..26716ed8b66 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -120,9 +120,9 @@ :version "22.1" :link '(info-link :tag "Tramp manual" "(tramp) Top")) -;; Maybe we need once a real Tramp mode, with key bindings etc. +;; On MS-DOS, there is no process support. ;;;###autoload -(defvar tramp-mode t +(defvar tramp-mode (not (eq system-type 'ms-dos)) "Whether Tramp is enabled. If it is set to nil, all remote file names are used literally. Don't set it manually, use `inhibit-remote-files' or `without-remote-files'