commit 18457c64b064e3853511d20a6d1d5d3c0f136733 (HEAD, refs/remotes/origin/master) Author: Philip Kaludercic Date: Tue Feb 13 10:52:24 2024 +0100 ; * .dir-locals.el: Set 'vc-default-patch-addressee' diff --git a/.dir-locals.el b/.dir-locals.el index 2339a0f59ca..c74da88a811 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -14,7 +14,8 @@ ("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/" "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) (etags-regen-ignores . ("test/manual/etags/")) - (vc-prepare-patches-separately . nil))) + (vc-prepare-patches-separately . nil) + (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org"))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK" "ATTRIBUTE_MALLOC" commit 91e02dde5fefbba87dc4736df40cfaeec2c088c1 Author: Juri Linkov Date: Mon May 20 09:22:10 2024 +0300 New tests for nested archives (bug#70987) * test/lisp/tar-mode-tests.el (tar-mode-test-tar-extract-zip-and-gz): * test/lisp/arc-mode-tests.el (arc-mode-test-zip-extract-tar-and-gz): New tests. * test/data/decompress/tzg.tar.gz: * test/data/decompress/ztg.zip: New data files to test decompressing of different combinations of nested tar and zip archives. diff --git a/test/data/decompress/tzg.tar.gz b/test/data/decompress/tzg.tar.gz new file mode 100644 index 00000000000..611f543688e Binary files /dev/null and b/test/data/decompress/tzg.tar.gz differ diff --git a/test/data/decompress/ztg.zip b/test/data/decompress/ztg.zip new file mode 100644 index 00000000000..5f4aea4c8dc Binary files /dev/null and b/test/data/decompress/ztg.zip differ diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index acc416d6f78..5ebc56a84fc 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -46,6 +46,22 @@ (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer)) (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer))))) +(declare-function tar-extract "tar-mode") +(ert-deftest arc-mode-test-zip-extract-tar-and-gz () + (skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract)))) + (skip-unless (executable-find "gzip")) + (require 'tar-mode) + (let* ((zip-file (expand-file-name "ztg.zip" arc-mode-tests-data-directory)) + zip-buffer tar-buffer gz-buffer) + (unwind-protect + (with-current-buffer (setq zip-buffer (find-file-noselect zip-file)) + (with-current-buffer (setq tar-buffer (archive-extract)) + (setq gz-buffer (tar-extract)) + (should (equal (char-after) ?\N{SNOWFLAKE})))) + (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer)) + (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer)) + (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer))))) + (ert-deftest arc-mode-test-zip-ensure-ext () "Regression test for bug#61326." (skip-unless (executable-find "zip")) diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el index b40cd39d112..bafe575fdda 100644 --- a/test/lisp/tar-mode-tests.el +++ b/test/lisp/tar-mode-tests.el @@ -46,6 +46,20 @@ (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer)) (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer))))) +(ert-deftest tar-mode-test-tar-extract-zip-and-gz () + (skip-unless (executable-find "gzip")) + (require 'arc-mode) + (let* ((tar-file (expand-file-name "tzg.tar.gz" tar-mode-tests-data-directory)) + tar-buffer zip-buffer gz-buffer) + (unwind-protect + (with-current-buffer (setq tar-buffer (find-file-noselect tar-file)) + (with-current-buffer (setq zip-buffer (tar-extract)) + (setq gz-buffer (archive-extract)) + (should (equal (char-after) ?\N{SNOWFLAKE})))) + (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer)) + (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer)) + (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer))))) + (provide 'tar-mode-tests) ;;; tar-mode-tests.el ends here commit 44d1687f1f6bc3d261aa2344a714b1f3397b3039 Author: Jim Porter Date: Sat May 11 11:41:11 2024 -0700 Tell direction in prompts for '(previous|next)-matching-history-element' Previously, this always said "Previous" for 'previous-matching-history-element' (likewise "Next"). Now, the prompt accounts for a negative prefix argument changing the search direction (bug#70882). * lisp/simple.el (previous-matching-history-element) (next-matching-history-element): Consult numeric prefix argument to determine the prompt string. diff --git a/lisp/simple.el b/lisp/simple.el index cdbbd876e3b..bcd26da13ed 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2876,11 +2876,13 @@ Normally, history elements are matched case-insensitively if makes the search case-sensitive. See also `minibuffer-history-case-insensitive-variables'." (interactive - (let* ((enable-recursive-minibuffers t) + (let* ((n (prefix-numeric-value current-prefix-arg)) + (enable-recursive-minibuffers t) (regexp (read-from-minibuffer - (format-prompt "Previous element matching regexp" + (format-prompt "%s element matching regexp" (and minibuffer-history-search-history - (car minibuffer-history-search-history))) + (car minibuffer-history-search-history)) + (if (>= n 0) "Previous" "Next")) nil minibuffer-local-map nil 'minibuffer-history-search-history (car minibuffer-history-search-history)))) @@ -2888,9 +2890,9 @@ See also `minibuffer-history-case-insensitive-variables'." (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (user-error "No previous history search regexp")) + (user-error "No history search regexp")) regexp) - (prefix-numeric-value current-prefix-arg)))) + n))) (unless (zerop n) (if (and (zerop minibuffer-history-position) (null minibuffer-text-before-history)) @@ -2948,20 +2950,23 @@ Normally, history elements are matched case-insensitively if `case-fold-search' is non-nil, but an uppercase letter in REGEXP makes the search case-sensitive." (interactive - (let* ((enable-recursive-minibuffers t) - (regexp (read-from-minibuffer "Next element matching (regexp): " - nil - minibuffer-local-map - nil - 'minibuffer-history-search-history - (car minibuffer-history-search-history)))) + (let* ((n (prefix-numeric-value current-prefix-arg)) + (enable-recursive-minibuffers t) + (regexp (read-from-minibuffer + (format-prompt "%s element matching regexp" + (and minibuffer-history-search-history + (car minibuffer-history-search-history)) + (if (>= n 0) "Next" "Previous")) + nil minibuffer-local-map nil + 'minibuffer-history-search-history + (car minibuffer-history-search-history)))) ;; Use the last regexp specified, by default, if input is empty. (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (user-error "No previous history search regexp")) + (user-error "No history search regexp")) regexp) - (prefix-numeric-value current-prefix-arg)))) + n))) (previous-matching-history-element regexp (- n))) (defvar minibuffer-temporary-goal-position nil) commit ae9045a8bd8d3917feb570adfab0b929b120a8e5 Author: Jim Porter Date: Sun Apr 28 21:19:53 2024 -0700 Allow defining custom providers for more "thingatpt" functions This also fixes an issue in EWW and bug-reference-mode where (thing-at-point 'url) at the end of a URL would return nil. See . * lisp/thingatpt.el (forward-thing-provider-alist) (bounds-of-thing-at-point-provider-alist): New variables... (forward-thing, bounds-of-thing-at-point): ... use them. (text-property-search-forward, text-property-search-backward) (prop-match-beginning, prop-match-end): Declare. (thing-at-point-for-text-property, forward-thing-for-text-property) (bounds-of-thing-at-point-for-text-property): New functions. * lisp/net/eww.el (eww--url-at-point): Use 'thing-at-point-for-text-property'. (eww--bounds-of-url-at-point, eww--forward-url): New functions... (eww-mode): ... use them. * lisp/progmodes/bug-reference.el (bug-reference--url-at-point): Use 'thing-at-point-for-text-property'. (bug-reference--bounds-of-url-at-point, bug-reference--forward-url): New functions... (bug-reference--init): ... use them. * test/lisp/thingatpt-tests.el (thing-at-point-providers) (forward-thing-providers, bounds-of-thing-at-point-providers): New tests. * etc/NEWS: Announce this change. diff --git a/etc/NEWS b/etc/NEWS index 241b94d66c3..4e52d4dccb2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1735,19 +1735,34 @@ By default it retains the previous behavior: read the contents of Gemfile and act accordingly. But you can also set it to t or nil to skip the check. -** Miscellaneous +** Thingatpt --- -*** Webjump now assumes URIs are HTTPS instead of HTTP. -For links in 'webjump-sites' without an explicit URI scheme, it was -previously assumed that they should be prefixed with "http://". Such -URIs are now prefixed with "https://" instead. +*** New variables for providing custom thingatpt implementations. +The new variables 'bounds-of-thing-at-point-provider-alist' and +'forward-thing-provider-alist' now allow defining custom implementations +of 'bounds-of-thing-at-point' and 'forward-thing', respectively. + +--- +*** New helper functions for text property-based thingatpt providers. +The new helper functions 'thing-at-point-for-text-property', +'bounds-of-thing-at-point-for-text-property', and +'forward-thing-for-text-property' can help to help implement custom +thingatpt providers for "things" that are defined by a text property. --- *** 'bug-reference-mode' now supports 'thing-at-point'. Now, calling '(thing-at-point 'url)' when point is on a bug reference will return the URL for that bug. +** Miscellaneous + +--- +*** Webjump now assumes URIs are HTTPS instead of HTTP. +For links in 'webjump-sites' without an explicit URI scheme, it was +previously assumed that they should be prefixed with "http://". Such +URIs are now prefixed with "https://" instead. + +++ *** New user option 'rcirc-log-time-format'. This allows for rcirc logs to use a custom timestamp format, than the diff --git a/lisp/net/eww.el b/lisp/net/eww.el index ceafca282c4..ff502914eb5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1336,9 +1336,16 @@ within text input fields." ;; desktop support (setq-local desktop-save-buffer #'eww-desktop-misc-data) (setq truncate-lines t) + ;; thingatpt support (setq-local thing-at-point-provider-alist - (append thing-at-point-provider-alist - '((url . eww--url-at-point)))) + (cons '(url . eww--url-at-point) + thing-at-point-provider-alist)) + (setq-local forward-thing-provider-alist + (cons '(url . eww--forward-url) + forward-thing-provider-alist)) + (setq-local bounds-of-thing-at-point-provider-alist + (cons '(url . eww--bounds-of-url-at-point) + bounds-of-thing-at-point-provider-alist)) (setq-local bookmark-make-record-function #'eww-bookmark-make-record) (buffer-disable-undo) (setq-local shr-url-transformer #'eww--transform-url) @@ -1373,7 +1380,15 @@ within text input fields." (defun eww--url-at-point () "`thing-at-point' provider function." - (get-text-property (point) 'shr-url)) + (thing-at-point-for-text-property 'shr-url)) + +(defun eww--forward-url (n) + "`forward-thing' provider function." + (forward-thing-for-text-property 'shr-url n)) + +(defun eww--bounds-of-url-at-point () + "`bounds-of-thing-at-point' provider function." + (bounds-of-thing-at-point-for-text-property 'shr-url)) ;;;###autoload (defun eww-browse-url (url &optional new-window) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 977a3d72cb7..be162cf9e11 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -658,19 +658,39 @@ have been run, the auto-setup is inhibited.") (defun bug-reference--url-at-point () "`thing-at-point' provider function." - (get-char-property (point) 'bug-reference-url)) + (thing-at-point-for-text-property 'bug-reference-url)) + +(defun bug-reference--forward-url (n) + "`forward-thing' provider function." + (forward-thing-for-text-property 'bug-reference-url n)) + +(defun bug-reference--bounds-of-url-at-point () + "`bounds-of-thing-at-point' provider function." + (bounds-of-thing-at-point-for-text-property 'bug-reference-url)) (defun bug-reference--init (enable) (if enable (progn (jit-lock-register #'bug-reference-fontify) (setq-local thing-at-point-provider-alist - (append thing-at-point-provider-alist - '((url . bug-reference--url-at-point))))) + (cons '(url . bug-reference--url-at-point) + thing-at-point-provider-alist)) + (setq-local forward-thing-provider-alist + (cons '(url . bug-reference--forward-url) + forward-thing-provider-alist)) + (setq-local bounds-of-thing-at-point-provider-alist + (cons '(url . bug-reference--bounds-of-url-at-point) + bounds-of-thing-at-point-provider-alist))) (jit-lock-unregister #'bug-reference-fontify) (setq thing-at-point-provider-alist (delete '((url . bug-reference--url-at-point)) thing-at-point-provider-alist)) + (setq forward-thing-provider-alist + (delete '((url . bug-reference--forward-url)) + forward-thing-provider-alist)) + (setq bounds-of-thing-at-point-provider-alist + (delete '((url . bug-reference--bounds-of-url-at-point)) + bounds-of-thing-at-point-provider-alist)) (save-restriction (widen) (bug-reference-unfontify (point-min) (point-max))))) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 7896ad984df..825f49cfab7 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -75,6 +75,27 @@ question. `existing-filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', `face' and `page'.") +(defvar forward-thing-provider-alist nil + "Alist of providers for moving forward to the end of a \"thing\". +This variable can be set globally, or appended to buffer-locally by +modes, to provide functions that will move forward to the end of a +\"thing\" at point. Each function should take a single argument N, the +number of \"things\" to move forward past. The first provider for the +\"thing\" that returns a non-nil value wins. + +You can use this variable in much the same way as +`thing-at-point-provider-alist' (which see).") + +(defvar bounds-of-thing-at-point-provider-alist nil + "Alist of providers to return the bounds of a \"thing\" at point. +This variable can be set globally, or appended to buffer-locally by +modes, to provide functions that will return the bounds of a \"thing\" +at point. The first provider for the \"thing\" that returns a non-nil +value wins. + +You can use this variable in much the same way as +`thing-at-point-provider-alist' (which see).") + ;; Basic movement ;;;###autoload @@ -84,11 +105,16 @@ THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', `number', `filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'." - (let ((forward-op (or (get thing 'forward-op) - (intern-soft (format "forward-%s" thing))))) - (if (functionp forward-op) - (funcall forward-op (or n 1)) - (error "Can't determine how to move over a %s" thing)))) + (setq n (or n 1)) + (or (seq-some (lambda (elt) + (and (eq (car elt) thing) + (funcall (cdr elt) n))) + forward-thing-provider-alist) + (let ((forward-op (or (get thing 'forward-op) + (intern-soft (format "forward-%s" thing))))) + (if (functionp forward-op) + (funcall forward-op n) + (error "Can't determine how to move over a %s" thing))))) ;; General routines @@ -106,6 +132,10 @@ valid THING. Return a cons cell (START . END) giving the start and end positions of the thing found." (cond + ((seq-some (lambda (elt) + (and (eq (car elt) thing) + (funcall (cdr elt)))) + bounds-of-thing-at-point-provider-alist)) ((get thing 'bounds-of-thing-at-point) (funcall (get thing 'bounds-of-thing-at-point))) ;; If the buffer is totally empty, give up. @@ -775,4 +805,47 @@ treated as white space." (goto-char (or (nth 8 ppss) (point))) (form-at-point 'list 'listp)))) +;; Provider helper functions + +(defun thing-at-point-for-text-property (property) + "Return the \"thing\" at point. +Each \"thing\" is a region of text with the specified text PROPERTY set." + (or (get-text-property (point) property) + (and (> (point) (point-min)) + (get-text-property (1- (point)) property)))) + +(autoload 'text-property-search-forward "text-property-search") +(autoload 'text-property-search-backward "text-property-search") +(autoload 'prop-match-beginning "text-property-search") +(autoload 'prop-match-end "text-property-search") + +(defun forward-thing-for-text-property (property n) + "Move forward to the end of the Nth next \"thing\". +Each \"thing\" is a region of text with the specified text PROPERTY set." + (let ((search-func (if (> n 0) #'text-property-search-forward + #'text-property-search-backward)) + (pos-func (if (> n 0) #'prop-match-end #'prop-match-beginning)) + (limit (if (> n 0) (point-max) (point-min)))) + (catch 'done + (dotimes (_ (abs n)) + (if-let ((match (funcall search-func property))) + (goto-char (funcall pos-func match)) + (goto-char limit) + (throw 'done t)))) + ;; Return non-nil. + t)) + +(defun bounds-of-thing-at-point-for-text-property (property) + "Determine the start and end buffer locations for the \"thing\" at point. +The \"thing\" is a region of text with the specified text PROPERTY set." + (let ((pos (point))) + (when (or (get-text-property pos property) + (and (> pos (point-min)) + (get-text-property (setq pos (1- pos)) property))) + (cons (or (previous-single-property-change + (min (1+ pos) (point-max)) property) + (point-min)) + (or (next-single-property-change pos property) + (point-max)))))) + ;;; thingatpt.el ends here diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index e50738f1122..88a4bc8a27d 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -258,4 +258,63 @@ position to retrieve THING.") (should (equal (test--number "0xf00" 2) 3840)) (should (equal (test--number "0xf00" 3) 3840))) +(ert-deftest thing-at-point-providers () + (with-temp-buffer + (setq-local + thing-at-point-provider-alist + `((url . ,(lambda () (thing-at-point-for-text-property 'foo-url))) + (url . ,(lambda () (thing-at-point-for-text-property 'bar-url))))) + (insert (propertize "hello" 'foo-url "foo.com") "\n" + (propertize "goodbye" 'bar-url "bar.com")) + (goto-char (point-min)) + ;; Get the URL using the first provider. + (should (equal (thing-at-point 'url) "foo.com")) + (should (equal (thing-at-point 'word) "hello")) + (goto-char (point-max)) + ;; Get the URL using the second provider. + (should (equal (thing-at-point 'url) "bar.com")))) + +(ert-deftest forward-thing-providers () + (with-temp-buffer + (setq-local + forward-thing-provider-alist + `((url . ,(lambda (n) (forward-thing-for-text-property 'foo-url n))) + (url . ,(lambda (n) (forward-thing-for-text-property 'bar-url n))))) + (insert (propertize "hello" 'foo-url "foo.com") "there\n" + (propertize "goodbye" 'bar-url "bar.com")) + (goto-char (point-min)) + (save-excursion + (forward-thing 'url) ; Move past the first URL. + (should (= (point) 6)) + (forward-thing 'url) ; Move past the second URL. + (should (= (point) 19))) + (goto-char (point-min)) ; Go back to the beginning... + (forward-thing 'word) ; ... and move past the first word. + (should (= (point) 11)))) + +(ert-deftest bounds-of-thing-at-point-providers () + (with-temp-buffer + (setq-local + bounds-of-thing-at-point-provider-alist + `((url . ,(lambda () + (bounds-of-thing-at-point-for-text-property 'foo-url))) + (url . ,(lambda () + (bounds-of-thing-at-point-for-text-property 'bar-url))))) + (insert (propertize "hello" 'foo-url "foo.com") "there\n" + (propertize "goodbye" 'bar-url "bar.com")) + (goto-char (point-min)) + ;; Look for a URL, using the first provider above. + (should (equal (bounds-of-thing-at-point 'url) '(1 . 6))) + (should (eq (save-excursion (beginning-of-thing 'url)) 1)) + (should (eq (save-excursion (end-of-thing 'url)) 6)) + ;; Look for a word, which should *not* use our provider above. + (should (equal (bounds-of-thing-at-point 'word) '(1 . 11))) + (should (eq (save-excursion (beginning-of-thing 'word)) 1)) + (should (eq (save-excursion (end-of-thing 'word)) 11)) + (goto-char (point-max)) + ;; Look for a URL, using the second provider above. + (should (equal (bounds-of-thing-at-point 'url) '(12 . 19))) + (should (eq (save-excursion (beginning-of-thing 'url)) 12)) + (should (eq (save-excursion (end-of-thing 'url)) 19)))) + ;;; thingatpt-tests.el ends here commit a1b24ebc83e3df67d2e12870b4bea941b21cebda Author: Po Lu Date: Mon May 20 09:10:57 2024 +0800 ; Stylistic adjustments to sfnt.c * src/sfnt.c (sfnt_map_table, sfnt_read_table): Adapt to coding style of another project using this module. diff --git a/src/sfnt.c b/src/sfnt.c index 8b7392b3af2..507f2d40e6f 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -14085,10 +14085,11 @@ sfnt_map_table (int fd, struct sfnt_offset_subtable *subtable, struct sfnt_table_directory *directory; size_t offset, page, map_offset; void *data; + int i; /* Find the table in the directory. */ - for (int i = 0; ; i++) + for (i = 0; ; i++) { if (! (i < subtable->num_tables)) return 1; @@ -14148,10 +14149,11 @@ sfnt_read_table (int fd, struct sfnt_offset_subtable *subtable, { struct sfnt_table_directory *directory; void *data; + int i; /* Find the table in the directory. */ - for (int i = 0; ; i++) + for (i = 0; ; i++) { if (! (i < subtable->num_tables)) return NULL; commit 98b83bdc9f4af7798e3314ad8df6ab78efd60f8a Author: Paul Eggert Date: Sun May 19 08:48:52 2024 -0700 Tweak STORE_NUMBER arg type * src/regex-emacs.c (STORE_NUMBER): Make the arg int, not int16_t. There’s no need for the caller to convert to int16_t, and using int makes the machine code a bit smaller (and presumably a bit faster) on x86-64 with GCC 14. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 0ec0c6eb63f..92dbdbecbf1 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -341,7 +341,7 @@ typedef enum /* Store NUMBER in two contiguous bytes starting at DESTINATION. */ static void -STORE_NUMBER (unsigned char *destination, int16_t number) +STORE_NUMBER (unsigned char *destination, int number) { (destination)[0] = (number) & 0377; (destination)[1] = (number) >> 8; commit 9bcd644408367b1d57e62a7f73b4ef4a3cd366b4 Author: Paul Eggert Date: Sun May 19 08:42:57 2024 -0700 Port knuth_hash to odd platforms * src/lisp.h (hash_hash_t, knuth_hash): Use unsigned int and unsigned long long int rather than uint32_t and uint64_t, as POSIX does not guarantee the presence of uint64_t, and uint32_t and uint64_t both in theory have problems with undefined behavior on integer overflow. This doesn’t affect behavior (or even machine code) on typical platforms. diff --git a/src/lisp.h b/src/lisp.h index d61a4d5c982..4b4ff2a2c60 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2534,7 +2534,7 @@ struct Lisp_Hash_Table; /* The type of a hash value stored in the table. It's unsigned and a subtype of EMACS_UINT. */ -typedef uint32_t hash_hash_t; +typedef unsigned int hash_hash_t; typedef enum { Test_eql, @@ -2818,10 +2818,14 @@ INLINE ptrdiff_t knuth_hash (hash_hash_t hash, unsigned bits) { /* Knuth multiplicative hashing, tailored for 32-bit indices - (avoiding a 64-bit multiply). */ - uint32_t alpha = 2654435769; /* 2**32/phi */ - /* Note the cast to uint64_t, to make it work for bits=0. */ - return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits); + (avoiding a 64-bit multiply on typical platforms). */ + unsigned int h = hash; + unsigned int alpha = 2654435769; /* 2**32/phi */ + /* Multiply with unsigned int, ANDing in case UINT_WIDTH exceeds 32. */ + unsigned int product = (h * alpha) & 0xffffffffu; + /* Convert to a wider type, so that the shift works when BITS == 0. */ + unsigned long long int wide_product = product; + return wide_product >> (32 - bits); } commit c07160b8df4e9f795dd73f08a3399ccef465c898 Author: Paul Eggert Date: Sat May 18 19:12:55 2024 -0700 Update from Gnulib by running admin/merge-gnulib diff --git a/lib/sha512.c b/lib/sha512.c index 9eb036fb327..6750041bc7b 100644 --- a/lib/sha512.c +++ b/lib/sha512.c @@ -35,7 +35,7 @@ #ifdef WORDS_BIGENDIAN # define SWAP(n) (n) #else -# define SWAP(n) bswap_64 (n) +# define SWAP(n) u64bswap (n) #endif #if ! HAVE_OPENSSL_SHA512 diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 1888d3ee314..ef9fde30eb2 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -231,6 +231,14 @@ _GL_CXXALIAS_SYS (abort, void, (void)); _GL_CXXALIASWARN (abort); # endif #endif +#if @GNULIB_ABORT_DEBUG@ && @REPLACE_ABORT@ +_GL_EXTERN_C void _gl_pre_abort (void); +#else +# if !GNULIB_defined_gl_pre_abort +# define _gl_pre_abort() /* nothing */ +# define GNULIB_defined_gl_pre_abort 1 +# endif +#endif #if @GNULIB_FREE_POSIX@ diff --git a/lib/u64.h b/lib/u64.h index 4eca03e985e..cfb55887578 100644 --- a/lib/u64.h +++ b/lib/u64.h @@ -22,8 +22,11 @@ #error "Please include config.h first." #endif +#include #include +#include + _GL_INLINE_HEADER_BEGIN #ifndef _GL_U64_INLINE # define _GL_U64_INLINE _GL_INLINE @@ -34,9 +37,6 @@ extern "C" { #endif -/* Return X rotated left by N bits, where 0 < N < 64. */ -#define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n)) - #ifdef UINT64_MAX /* Native implementations are trivial. See below for comments on what @@ -53,24 +53,30 @@ typedef uint64_t u64; # define u64plus(x, y) ((x) + (y)) # define u64shl(x, n) ((x) << (n)) # define u64shr(x, n) ((x) >> (n)) +# define u64bswap(x) bswap_64 (x) #else -/* u64 is a 64-bit unsigned integer value. +# define _GL_U64_MASK32 0xfffffffful /* 2**32 - 1. */ + +/* u64 represents a 64-bit unsigned integer value equal to (HI << 32) + LO. + Implement it with unsigned int, which the GNU coding standards say + is wide enough to hold 32 bits, and which does not signal an error + when adding (theoretically possible with types like uint_fast32_t). u64init (HI, LO), is like u64hilo (HI, LO), but for use in initializer contexts. */ # ifdef WORDS_BIGENDIAN -typedef struct { uint32_t hi, lo; } u64; +typedef struct { unsigned int hi, lo; } u64; # define u64init(hi, lo) { hi, lo } # else -typedef struct { uint32_t lo, hi; } u64; +typedef struct { unsigned int lo, hi; } u64; # define u64init(hi, lo) { lo, hi } # endif /* Given the high and low-order 32-bit quantities HI and LO, return a u64 value representing (HI << 32) + LO. */ _GL_U64_INLINE u64 -u64hilo (uint32_t hi, uint32_t lo) +u64hilo (unsigned int hi, unsigned int lo) { u64 r; r.hi = hi; @@ -78,9 +84,9 @@ u64hilo (uint32_t hi, uint32_t lo) return r; } -/* Return a u64 value representing LO. */ +/* Return a u64 value representing the 32-bit quantity LO. */ _GL_U64_INLINE u64 -u64lo (uint32_t lo) +u64lo (unsigned int lo) { u64 r; r.hi = 0; @@ -88,18 +94,18 @@ u64lo (uint32_t lo) return r; } -/* Return a u64 value representing SIZE. */ +/* Return a u64 value representing SIZE, where 0 <= SIZE < 2**64. */ _GL_U64_INLINE u64 u64size (size_t size) { u64 r; r.hi = size >> 31 >> 1; - r.lo = size; + r.lo = size & _GL_U64_MASK32; return r; } /* Return X < Y. */ -_GL_U64_INLINE int +_GL_U64_INLINE bool u64lt (u64 x, u64 y) { return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo); @@ -135,29 +141,29 @@ u64xor (u64 x, u64 y) return r; } -/* Return X + Y. */ +/* Return X + Y, wrapping around on overflow. */ _GL_U64_INLINE u64 u64plus (u64 x, u64 y) { u64 r; - r.lo = x.lo + y.lo; - r.hi = x.hi + y.hi + (r.lo < x.lo); + r.lo = (x.lo + y.lo) & _GL_U64_MASK32; + r.hi = (x.hi + y.hi + (r.lo < x.lo)) & _GL_U64_MASK32; return r; } -/* Return X << N. */ +/* Return X << N, where 0 <= N < 64. */ _GL_U64_INLINE u64 u64shl (u64 x, int n) { u64 r; if (n < 32) { - r.hi = (x.hi << n) | (x.lo >> (32 - n)); - r.lo = x.lo << n; + r.hi = (x.hi << n & _GL_U64_MASK32) | x.lo >> (32 - n); + r.lo = x.lo << n & _GL_U64_MASK32; } else { - r.hi = x.lo << (n - 32); + r.hi = x.lo << (n - 32) & _GL_U64_MASK32; r.lo = 0; } return r; @@ -171,7 +177,7 @@ u64shr (u64 x, int n) if (n < 32) { r.hi = x.hi >> n; - r.lo = (x.hi << (32 - n)) | (x.lo >> n); + r.lo = (x.hi << (32 - n) & _GL_U64_MASK32) | x.lo >> n; } else { @@ -181,8 +187,22 @@ u64shr (u64 x, int n) return r; } +/* Return X with bytes in reverse order. */ +_GL_U64_INLINE u64 +u64bswap (u64 x) +{ + return u64hilo (bswap_32 (x.lo), bswap_32 (x.hi)); +} + #endif +/* Return X rotated left by N bits, where 0 < N < 64. */ +_GL_U64_INLINE u64 +u64rol (u64 x, int n) +{ + return u64or (u64shl (x, n), u64shr (x, 64 - n)); +} + #ifdef __cplusplus } commit 370a386633b081107d30a00463dd0fe8d81b7e0f Author: Paul Eggert Date: Sat May 18 13:18:32 2024 -0700 Pacify -Wanalyzer-null-dereference in sfnt.c * src/sfnt.c (sfnt_map_table, sfnt_read_table) (sfnt_read_cvar_table): Pacify GCC -Wanalyzer-null-dereference. The change to sfnt_read_cvar_table fixes what appears to be an actual null-dereference bug. diff --git a/src/sfnt.c b/src/sfnt.c index 1832082e4f9..8b7392b3af2 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -14085,22 +14085,18 @@ sfnt_map_table (int fd, struct sfnt_offset_subtable *subtable, struct sfnt_table_directory *directory; size_t offset, page, map_offset; void *data; - int i; /* Find the table in the directory. */ - for (i = 0; i < subtable->num_tables; ++i) + for (int i = 0; ; i++) { - if (subtable->subtables[i].tag == tag) - { - directory = &subtable->subtables[i]; - break; - } + if (! (i < subtable->num_tables)) + return 1; + directory = &subtable->subtables[i]; + if (directory->tag == tag) + break; } - if (i == subtable->num_tables) - return 1; - /* Now try to map the glyph data. Make sure offset is a multiple of the page size. */ @@ -14152,22 +14148,18 @@ sfnt_read_table (int fd, struct sfnt_offset_subtable *subtable, { struct sfnt_table_directory *directory; void *data; - int i; /* Find the table in the directory. */ - for (i = 0; i < subtable->num_tables; ++i) + for (int i = 0; ; i++) { - if (subtable->subtables[i].tag == tag) - { - directory = &subtable->subtables[i]; - break; - } + if (! (i < subtable->num_tables)) + return NULL; + directory = &subtable->subtables[i]; + if (directory->tag == tag) + break; } - if (i == subtable->num_tables) - return NULL; - /* Seek to the table. */ if (lseek (fd, directory->offset, SEEK_SET) != directory->offset) @@ -15160,7 +15152,7 @@ sfnt_read_cvar_table (int fd, struct sfnt_offset_subtable *subtable, /* Copy in the shared point numbers instead. */ cvar->variation[i].num_points = npoints; - if (npoints != UINT16_MAX) + if (points && npoints != UINT16_MAX) { if (cvar->variation[i].num_points > cvt->num_elements) cvar->variation[i].num_points = cvt->num_elements; commit 1c14ccfee599d13ea78b141fc3aec149a4d45a24 Author: Eli Zaretskii Date: Sun May 19 16:40:42 2024 +0300 ; * lisp/menu-bar.el (kill-this-buffer): Fix typo. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 7db1f3ed3b2..eba25f5cfce 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2241,7 +2241,7 @@ using `abort-recursive-edit'. This command can be reliably invoked only from the menu bar, otherwise it could decide to silently do nothing." (interactive "e") - ;; This clossus of a conditional is necessary to account for the wide + ;; This colossus of a conditional is necessary to account for the wide ;; variety of this command's callers. (if (let* ((window (or (and event (event-start event) (posn-window (event-start event))) commit 627d60910b82d35bb5f19fa139de7878cccf082e Author: Po Lu Date: Sun May 19 12:57:09 2024 +0000 Fix kill-this-buffer's detection of minibuffer frames * lisp/menu-bar.el (kill-this-buffer): Don't test against menu-updating-frame, because this variable is only meaningful during menu bar updates. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 320fabb54cf..7db1f3ed3b2 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2233,26 +2233,29 @@ updating the menu." (not (window-minibuffer-p (frame-selected-window menu-frame)))))) -(defun kill-this-buffer () ; for the menu bar +(defun kill-this-buffer (&optional event) ; for the menu bar "Kill the current buffer. When called in the minibuffer, get out of the minibuffer using `abort-recursive-edit'. This command can be reliably invoked only from the menu bar, otherwise it could decide to silently do nothing." - (interactive) - (cond - ;; Don't do anything when `menu-frame' is not alive or visible - ;; (Bug#8184). - ((not (menu-bar-menu-frame-live-and-visible-p))) - ((menu-bar-non-minibuffer-window-p) - (kill-buffer (current-buffer)) - ;; Also close the current window if `menu-bar-close-window' is - ;; set. - (when menu-bar-close-window - (ignore-errors (delete-window)))) - (t - (abort-recursive-edit)))) + (interactive "e") + ;; This clossus of a conditional is necessary to account for the wide + ;; variety of this command's callers. + (if (let* ((window (or (and event (event-start event) + (posn-window (event-start event))) + last-event-frame + (selected-frame))) + (frame (if (framep window) window + (window-frame window)))) + (not (window-minibuffer-p (frame-selected-window frame)))) + (progn (kill-buffer (current-buffer)) + ;; Also close the current window if `menu-bar-close-window' is + ;; set. + (when menu-bar-close-window + (ignore-errors (delete-window)))) + (abort-recursive-edit))) (defun kill-this-buffer-enabled-p () "Return non-nil if the `kill-this-buffer' menu item should be enabled. commit 931663f1236fafce18022455b4e4e7a0c7f22c2c Author: Andrea Corallo Date: Sun May 19 14:50:39 2024 +0200 Silence 3 warnings for non sqlite builds * lisp/emacs-lisp/multisession.el (sqlite-commit) (sqlite-transaction, sqlite-rollback): Declare. diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index 8299e3dffcc..b7bc5536f78 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -137,6 +137,9 @@ DOC should be a doc string, and ARGS are keywords as applicable to (declare-function sqlite-select "sqlite.c") (declare-function sqlite-open "sqlite.c") (declare-function sqlite-pragma "sqlite.c") +(declare-function sqlite-commit "sqlite.c") +(declare-function sqlite-transaction "sqlite.c") +(declare-function sqlite-rollback "sqlite.c") (defvar multisession--db nil) commit c4cc905d6b01eb049b8d9400da2722d7f818d623 Author: Michael Albinus Date: Sun May 19 14:13:03 2024 +0200 Add connection-local variable `tramp-direct-async-process' * doc/misc/tramp.texi (Predefined connection information): Remove "direct-async-process". (Remote processes): Explain connection-local variable tramp-direct-async-process. * etc/NEWS: Add connection-local variable 'tramp-direct-async-process'. * lisp/net/tramp-compat.el (tramp-compat-connection-local-p): Sync with Emacs source. (tramp-compat-connection-local-value): New defalias. * lisp/net/tramp-message.el (tramp-warning): New defsubst. * lisp/net/tramp.el (tramp-direct-async-process): New defvar. (tramp-direct-async-process-p): Use connection-local variable for check. (Bug#70959) * test/lisp/net/tramp-tests.el (tramp--test-deftest-direct-async-process): Use connection-local-variable `tramp-direct-async-process'. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d1c58d83aeb..ca6703998c4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2320,15 +2320,6 @@ default value is @t{"/data/local/tmp"} for the @option{adb} method, @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise. @ref{Temporary directory}. -@item @t{"direct-async-process"} - -When this property is non-@code{nil}, an alternative, more performant -implementation of @code{make-process} and @code{start-file-process} is -applied. The connection method must also be marked with a -non-@code{nil} @code{tramp-direct-async} parameter in -@code{tramp-methods}. @ref{Improving performance of asynchronous -remote processes} for a discussion of constraints. - @item @t{"posix"} Connections using the @option{smb} method check, whether the remote @@ -4468,15 +4459,24 @@ Sometimes, this is not needed. Instead of starting a remote shell and running the command afterwards, it is sufficient to run the command directly. @value{tramp} supports this by an alternative implementation of @code{make-process} and @code{start-file-process}. -This is triggered by the connection property -@t{"direct-async-process"}, @xref{Predefined connection information}, +This is triggered by the connection-local variable +@code{tramp-direct-async-process}, +@ifinfo +@xref{Connection Variables, , , emacs}, +@end ifinfo which must be set to a non-@code{nil} value. Example: @lisp @group -(add-to-list 'tramp-connection-properties - (list (regexp-quote "@trampfn{ssh,user@@host,}") - "direct-async-process" t)) +(connection-local-set-profile-variables + 'remote-direct-async-process + '((tramp-direct-async-process . t))) +@end group + +@group +(connection-local-set-profiles + '(:application tramp :machine "remotehost") + 'remote-direct-async-process) @end group @end lisp @@ -4521,6 +4521,12 @@ In order to gain even more performance, it is recommended to bind use your own settings in @file{~/.ssh/config}, @pxref{Using ssh connection sharing}. +@c Since Emacs 30. +@strong{Note}: In previous @value{tramp} versions this was triggered +by the connection property @t{"direct-async-process"}. This is still +supported but deprecated, and it will be removed in a future +@value{tramp} version. + @node Cleanup remote connections @section Cleanup remote connections diff --git a/etc/NEWS b/etc/NEWS index ebc07c81b9d..241b94d66c3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1146,6 +1146,14 @@ buffer must either visit a file, or it must run 'dired-mode'. Another method but "sudo" can be configured with user option 'tramp-file-name-with-method'. ++++ +*** Direct asynchronous processes are indicated by a connection-local variable. +If direct asynchronous processes shall be used, set the connection-local +variable 'tramp-direct-async-process' to a non-nil value. This has been +changed, in previous Emacs versions this was indicated by the now +deprecated connection property "direct-async-process". See the Tramp +manual "(tramp) Improving performance of asynchronous remote processes". + --- *** Direct asynchronous processes use 'tramp-remote-path'. When a direct asynchronous process is invoked, it uses 'tramp-remote-path' @@ -1721,9 +1729,11 @@ If non-nil, moving point forward or backward between widgets by typing 'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil. ** Ruby mode -New user option 'ruby-rubocop-use-bundler'. By default it retains the -previous behavior: read the contens of Gemfile and act accordingly. But -you can also set it to t or nil to skip the check. + +*** New user option 'ruby-rubocop-use-bundler'. +By default it retains the previous behavior: read the contents of +Gemfile and act accordingly. But you can also set it to t or nil to +skip the check. ** Miscellaneous @@ -2010,6 +2020,7 @@ unibyte string. * Lisp Changes in Emacs 30.1 + +++ ** New user option 'compilation-safety' to control safety of native code. It's now possible to control how safe is the code generated by native @@ -2658,15 +2669,14 @@ objects is still necessary. ** 'vtable-insert-object' can insert "before" or at an index. The signature of 'vtable-insert-object' has changed and is now: -(vtable-insert-object table object &optional location before) - -'location' corresponds to the old 'after-object' argument; if 'before' -is non-nil, the new object is inserted before the 'location' object, -making it possible to insert a new object at the top of the -table. (Before, this was not possible.) In addition, 'location' can be -an integer, a (zero-based) index into the table at which the new object -is inserted ('before' is ignored in this case). + (vtable-insert-object TABLE OBJECT &optional LOCATION BEFORE) +LOCATION corresponds to the old AFTER-OBJECT argument; if BEFORE is +non-nil, the new object is inserted before the LOCATION object, making +it possible to insert a new object at the top of the table. (Before, +this was not possible.) In addition, LOCATION can be an integer, a +(zero-based) index into the table at which the new object is inserted +(BEFORE is ignored in this case). ** JSON diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 26c2049fbae..bbffdf7f3d9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -317,15 +317,46 @@ Also see `ignore'." ?\N{KHMER SIGN CAMNUC PII KUUH}) "List of characters equivalent to trailing colon in \"password\" prompts.")) -;; Macro `connection-local-p' is new in Emacs 30.1. +;; Macros `connection-local-p' and `connection-local-value' are new in +;; Emacs 30.1. (if (macrop 'connection-local-p) (defalias 'tramp-compat-connection-local-p 'connection-local-p) - (defmacro tramp-compat-connection-local-p (variable) - "Non-nil if VARIABLE has a connection-local binding in `default-directory'." - `(let (connection-local-variables-alist file-local-variables-alist) - (hack-connection-local-variables - (connection-local-criteria-for-default-directory)) - (and (assq ',variable connection-local-variables-alist) t)))) + (defmacro tramp-compat-connection-local-p (variable &optional application) + "Non-nil if VARIABLE has a connection-local binding in `default-directory'. +`default-directory' must be a remote file name. +If APPLICATION is nil, the value of +`connection-local-default-application' is used." + (declare (debug (symbolp &optional form))) + (unless (symbolp variable) + (signal 'wrong-type-argument (list 'symbolp variable))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (when criteria + (hack-connection-local-variables criteria) + (and (assq ',variable connection-local-variables-alist) t))))) + +(if (macrop 'connection-local-value) + (defalias 'tramp-compat-connection-local-value 'connection-local-value) + (defmacro tramp-compat-connection-local-value (variable &optional application) + "Return connection-local VARIABLE for APPLICATION in `default-directory'. +`default-directory' must be a remote file name. +If APPLICATION is nil, the value of +`connection-local-default-application' is used. +If VARIABLE does not have a connection-local binding, the return +value is the default binding of the variable." + (declare (debug (symbolp &optional form))) + (unless (symbolp variable) + (signal 'wrong-type-argument (list 'symbolp variable))) + `(let ((criteria + (connection-local-criteria-for-default-directory ,application)) + connection-local-variables-alist file-local-variables-alist) + (if (not criteria) + ,variable + (hack-connection-local-variables criteria) + (if-let ((result (assq ',variable connection-local-variables-alist))) + (cdr result) + ,variable))))) (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (function-put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 97e94a51e7a..685b14d14db 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -459,6 +459,16 @@ the resulting error message." (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) +(defsubst tramp-warning (vec-or-proc fmt-string &rest arguments) + "Show a warning. +VEC-OR-PROC identifies the connection to use, remaining arguments passed +to `tramp-message'." + (declare (tramp-suppress-trace t)) + (let (signal-hook-function) + (apply 'tramp-message vec-or-proc 2 fmt-string arguments) + (display-warning + 'tramp (apply #'format-message fmt-string arguments) :warning))) + (defun tramp-test-message (fmt-string &rest arguments) "Emit a Tramp message according `default-directory'." (declare (tramp-suppress-trace t)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f024ebecfc5..26bf8dea420 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4847,15 +4847,41 @@ a connection-local variable." (when (process-command proc) (tramp-message vec 6 "%s" (string-join (process-command proc) " ")))) +(defvar tramp-direct-async-process nil + "Whether direct asynchronous processes should be used. +It is not recommended to change this variable globally. Instead, it +should be set conmnection-local.") + (defun tramp-direct-async-process-p (&rest args) "Whether direct async `make-process' can be called." (let ((v (tramp-dissect-file-name default-directory)) (buffer (plist-get args :buffer)) (stderr (plist-get args :stderr))) + ;; Since Tramp 2.7.1. In a future release, we'll ignore this + ;; connection property. + (when (and (not (tramp-compat-connection-local-p + tramp-direct-async-process)) + (tramp-connection-property-p v "direct-async-process")) + (let ((msg (concat "Connection property \"direct-async-process\" is deprecated, " + "use connection-local variable `tramp-direct-async-process'\n" + "See (info \"(tramp) Improving performance of " + "asynchronous remote processes\")"))) + (if (tramp-get-connection-property + tramp-null-hop "direct-async-process-warned") + (tramp-message v 2 msg) + (tramp-set-connection-property + tramp-null-hop "direct-async-process-warned" t) + (tramp-warning v msg)))) + (and ;; The method supports it. (tramp-get-method-parameter v 'tramp-direct-async) - ;; It has been indicated. - (tramp-get-connection-property v "direct-async-process") + ;; It has been indicated. We don't use the global value of + ;; `tramp-direct-async-process'. + (or (and (tramp-compat-connection-local-p tramp-direct-async-process) + (tramp-compat-connection-local-value + tramp-direct-async-process)) + ;; Deprecated setting. + (tramp-get-connection-property v "direct-async-process")) ;; There's no multi-hop. (or (not (tramp-multi-hop-p v)) (null (cdr (tramp-compute-multi-hops v)))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f7c83f3b8eb..fabd1009af0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5372,11 +5372,18 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." :tags (append '(:expensive-test :tramp-asynchronous-processes) (and ,unstable '(:unstable))) (skip-unless (tramp--test-enabled)) - (let ((default-directory ert-remote-temporary-file-directory) - (ert-test (ert-get-test ',test)) - (tramp-connection-properties - (cons '(nil "direct-async-process" t) - tramp-connection-properties))) + (let* ((default-directory ert-remote-temporary-file-directory) + (ert-test (ert-get-test ',test)) + (connection-local-profile-alist + (cons + '(direct-async-process-profile (tramp-direct-async-process . t)) + connection-local-profile-alist)) + (connection-local-criteria-alist + (cons + `((:application tramp + :machine ,(file-remote-p default-directory 'host)) + direct-async-process-profile) + connection-local-criteria-alist))) (skip-unless (tramp-direct-async-process-p)) ;; We do expect an established connection already, ;; `file-truename' does it by side-effect. Suppress commit 92cd24f405ca15e453238cae4f2e1922667220f0 Author: Stefan Kangas Date: Sun May 19 10:43:59 2024 +0200 Add convenience binding for html-paragraph to mhtml-mode * lisp/textmodes/sgml-mode.el (html-mode-map): Bind 'C-c C-c p' to 'html-paragraph'. (Bug#70533) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 0e15f7e6062..1f440ebf7d0 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1820,6 +1820,7 @@ This takes effect when first loading the library.") (define-key map "\C-c\C-c#" #'html-id-anchor) (define-key map "\C-c\C-ci" #'html-image) (when html-quick-keys + (define-key map "\C-cp" #'html-paragraph) (define-key map "\C-c-" #'html-horizontal-rule) (define-key map "\C-cd" #'html-div) (define-key map "\C-co" #'html-ordered-list) commit dbd50ccd8e0f32054944f3016323f8e847ad167b Author: Eli Zaretskii Date: Sun May 19 11:23:19 2024 +0300 ; * lisp/color.el (color-oklab-to-xyz): Doc fix. diff --git a/lisp/color.el b/lisp/color.el index 5ba73f4a879..79dced4e3d7 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -372,7 +372,7 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'." (defun color-oklab-to-xyz (l a b) "Convert the OkLab color represented by L A B to CIE XYZ. Oklab is a perceptual color space created by Björn Ottosson -. It has the property that +. It has the property that changes in the hue and saturation of a color can be made while maintaining the same perceived lightness." (let ((ll (expt (+ (* 1.0 l) (* 0.39633779 a) (* 0.21580376 b)) 3)) commit f917c3b45dc182a20d5e5d5954fae914fc5303be Author: Eli Zaretskii Date: Sun May 19 11:21:22 2024 +0300 ; * etc/NEWS: Announce Oklab support. diff --git a/etc/NEWS b/etc/NEWS index 86ed99505d9..ebc07c81b9d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1766,6 +1766,8 @@ The following new XML schemas are now supported: - Nuget package specification file - Nuget packages config file +** color.el now supports the Oklab color representation. + * New Modes and Packages in Emacs 30.1 commit c5e5940ba40b801270bbe02b92576eac36f73222 Author: Robert Church Date: Mon May 13 17:28:28 2024 -0700 Add Oklab color space utility functions in color.el. * lisp/color.el (color-oklab-to-xyz, color-oklab-to-srgb) (color-srgb-to-oklab): New functions. (Bug#70963) * test/lisp/color-tests.el (color-tests-oklab-to-xyz) (color-tests-xyz-to-oklab, color-tests-srgb-to-oklab) (color-tests-oklab-to-srgb): New tests. diff --git a/lisp/color.el b/lisp/color.el index 078c12fbf47..5ba73f4a879 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -29,7 +29,8 @@ ;; ;; Supported color representations include RGB (red, green, blue), HSV ;; (hue, saturation, value), HSL (hue, saturation, luminance), sRGB, -;; CIE XYZ, and CIE L*a*b* color components. +;; CIE XYZ, CIE L*a*b* color components, and the Oklab perceptual color +;; space. ;;; Code: @@ -368,6 +369,44 @@ returned by `color-srgb-to-lab' or `color-xyz-to-lab'." (expt (/ ΔH′ (* Sh kH)) 2.0) (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))) +(defun color-oklab-to-xyz (l a b) + "Convert the OkLab color represented by L A B to CIE XYZ. +Oklab is a perceptual color space created by Björn Ottosson +. It has the property that +changes in the hue and saturation of a color can be made while maintaining +the same perceived lightness." + (let ((ll (expt (+ (* 1.0 l) (* 0.39633779 a) (* 0.21580376 b)) 3)) + (mm (expt (+ (* 1.00000001 l) (* -0.10556134 a) (* -0.06385417 b)) 3)) + (ss (expt (+ (* 1.00000005 l) (* -0.08948418 a) (* -1.29148554 b)) 3))) + (list (+ (* ll 1.22701385) (* mm -0.55779998) (* ss 0.28125615)) + (+ (* ll -0.04058018) (* mm 1.11225687) (* ss -0.07167668)) + (+ (* ll -0.07638128) (* mm -0.42148198) (* ss 1.58616322))))) + +(defun color-xyz-to-oklab (x y z) + "Convert the CIE XYZ color represented by X Y Z to Oklab." + (let ((ll (+ (* x 0.8189330101) (* y 0.3618667424) (* z -0.1288597137))) + (mm (+ (* x 0.0329845436) (* y 0.9293118715) (* z 0.0361456387))) + (ss (+ (* x 0.0482003018) (* y 0.2643662691) (* z 0.6338517070)))) + (let* + ((cube-root (lambda (f) + (if (< f 0) + (- (expt (- f) (/ 1.0 3.0))) + (expt f (/ 1.0 3.0))))) + (lll (funcall cube-root ll)) + (mmm (funcall cube-root mm)) + (sss (funcall cube-root ss))) + (list (+ (* lll 0.2104542553) (* mmm 0.7936177850) (* sss -0.0040720468)) + (+ (* lll 1.9779984951) (* mmm -2.4285922050) (* sss 0.4505937099)) + (+ (* lll 0.0259040371) (* mmm 0.7827717662) (* sss -0.8086757660)))))) + +(defun color-oklab-to-srgb (l a b) + "Convert the Oklab color represented by L A B to sRGB." + (apply #'color-xyz-to-srgb (color-oklab-to-xyz l a b))) + +(defun color-srgb-to-oklab (r g b) + "Convert the sRGB color R G B to Oklab." + (apply #'color-xyz-to-oklab (color-srgb-to-xyz r g b))) + (defun color-clamp (value) "Make sure VALUE is a number between 0.0 and 1.0 inclusive." (min 1.0 (max 0.0 value))) diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el index 9b6b8c1f8dc..0f53e4332a4 100644 --- a/test/lisp/color-tests.el +++ b/test/lisp/color-tests.el @@ -247,5 +247,38 @@ (should (equal (color-darken-name "red" 0) "#ffff00000000")) (should (equal (color-darken-name "red" 10) "#e66500000000"))) +(ert-deftest color-tests-oklab-to-xyz () + (should (color-tests--approx-equal (color-oklab-to-xyz 0 0 0) '(0.0 0.0 0.0))) + (should (color-tests--approx-equal (color-oklab-to-xyz 1.0 0.0 0.0) + '(0.95047005 1.0 1.0883001))) + (should (color-tests--approx-equal (color-oklab-to-xyz 0.450 1.236 -0.019) '(1.000604 -0.000008 -0.000038))) + (should (color-tests--approx-equal (color-oklab-to-xyz 0.922 -0.671 0.263) '(0.000305 1.000504 0.000898))) + (should (color-tests--approx-equal (color-oklab-to-xyz 0.153 -1.415 -0.449) '(0.000590 0.000057 1.001650)))) + +(ert-deftest color-tests-xyz-to-oklab () + (should (color-tests--approx-equal (color-xyz-to-oklab 0 0 0) '(0.0 0.0 0.0))) + (should (color-tests--approx-equal (color-xyz-to-oklab 0.95 1.0 1.089) + '(0.999969 -0.000258 -0.000115))) + (should (color-tests--approx-equal (color-xyz-to-oklab 1.0 0.0 0.0) + '(0.449932 1.235710 -0.019028))) + (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 1.0 0.0) + '(0.921817 -0.671238 0.263324))) + (should (color-tests--approx-equal (color-xyz-to-oklab 0.0 0.0 1.0) + '(0.152603 -1.414997 -0.448927)))) + +(ert-deftest color-tests-srgb-to-oklab () + (should (equal (color-srgb-to-oklab 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal (color-srgb-to-oklab 0 0 1) '(0.451978 -0.032430 -0.311611))) + (should + (color-tests--approx-equal (color-srgb-to-oklab 0.1 0.2 0.3) '(0.313828 -0.019091 -0.052561)))) + +(ert-deftest color-tests-oklab-to-srgb () + (should (equal (color-oklab-to-srgb 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal (color-oklab-to-srgb 0.451978 -0.032430 -0.311611) '(0.0 0.0 1.0))) + (should + (color-tests--approx-equal (color-oklab-to-srgb 0.313828 -0.019091 -0.052561) '(0.1 0.2 0.3)))) + (provide 'color-tests) ;;; color-tests.el ends here commit 42d444114d8df0ffddf1e80891a386c0edcbd976 Author: Morgan Smith Date: Sun May 12 09:19:30 2024 -0400 * lisp/window.el (fit-window-to-buffer): Fix width calculation When PIXELWISE is nil, we still calculate width in pixels and then convert it to columns. However, part of the calculation was using columns where it should have used pixels. (Bug#70894) diff --git a/lisp/window.el b/lisp/window.el index 8feeba0d83e..e709e978cc9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9906,8 +9906,8 @@ accessible position." ;; the bottom is wider than the window. (* (window-body-height window pixelwise) (if pixelwise 1 char-height)))) - (- total-width - (window-body-width window pixelwise))))) + (- (* total-width (if pixelwise 1 char-width)) + (window-body-width window t))))) (unless pixelwise (setq width (/ (+ width char-width -1) char-width))) (setq width (max min-width (min max-width width))) commit 5216903ae6c3f91ebefb1152af40753f723cbc39 Author: Eli Zaretskii Date: Sun May 19 10:58:52 2024 +0300 Fix MinGW build with GCC 14 and later * configure.ac [mingw]: Add -Wno-error=implicit-function-declaration to GCC_TEST_OPTIONS. (Bug#70889) diff --git a/configure.ac b/configure.ac index cab9eedd6cf..e3213f4ac79 100644 --- a/configure.ac +++ b/configure.ac @@ -1493,7 +1493,11 @@ case "${canonical}" in *-mingw* ) opsys=mingw32 # MinGW overrides and adds some system headers in nt/inc. - GCC_TEST_OPTIONS="-I $srcdir/nt/inc" + # Also, GCC 14 turns on implicit-function-declaration + # error by default, which fails configure tests where our + # emulation of Posix headers defines only the minimal + # stuff we actually need. + GCC_TEST_OPTIONS="-I $srcdir/nt/inc -Wno-error=implicit-function-declaration" ;; *-sysv4.2uw* ) opsys=unixware ;; *-sysv5uw* ) opsys=unixware ;; @@ -1508,7 +1512,7 @@ case "${canonical}" in *-mingw* ) opsys=mingw32 # MinGW overrides and adds some system headers in nt/inc. - GCC_TEST_OPTIONS="-I $srcdir/nt/inc" + GCC_TEST_OPTIONS="-I $srcdir/nt/inc -Wno-error=implicit-function-declaration" ;; ## Otherwise, we'll fall through to the generic opsys code at the bottom. esac