commit d00eb1c90253d2a353d3e9730df37fdd81c2a3d2 (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Tue May 21 09:20:01 2024 +0300 Use read-string instead of completing-read for dired-do-touch * lisp/dired-aux.el (dired-mark-read-string): Use read-string when op-symbol is 'touch' (bug#70725). diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a2ce3083cfe..b5eea4c74f6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -658,10 +658,13 @@ values, passed as the seventh arg to `completing-read'. Optional arg COLLECTION is a collection of possible completions, passed as the second arg to `completing-read'." - (dired-mark-pop-up nil op-symbol files - 'completing-read - (format prompt (dired-mark-prompt arg files)) - collection nil nil initial nil default-value nil)) + (apply #'dired-mark-pop-up + nil op-symbol files + (if (eq op-symbol 'touch) 'read-string 'completing-read) + (format prompt (dired-mark-prompt arg files)) + (if (eq op-symbol 'touch) + `(,initial nil ,default-value nil) + `(,collection nil nil ,initial nil ,default-value nil)))) ;;; Cleaning a directory: flagging some backups for deletion commit 1845eede3077d77a7808fd4c0b9d669a3739f1d8 Author: Juri Linkov Date: Tue May 21 09:16:18 2024 +0300 Fix for 'vc-default-patch-addressee' recently added to .dir-locals.el * lisp/vc/vc.el: Add autoloaded setting of 'safe-local-variable' property for 'vc-default-patch-addressee' exactly like it's already done for 'vc-prepare-patches-separately'. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f26e5cc751d..22d7d2f1e33 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3547,6 +3547,8 @@ prepared sequentially." :safe #'booleanp :version "29.1") +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-default-patch-addressee 'safe-local-variable 'stringp) (defcustom vc-default-patch-addressee nil "Default addressee for `vc-prepare-patch'. If nil, no default will be used. This option may be set locally." commit 70e7620843a22128de86e494cfe09d8e8c63f42f Author: Jared Finder Date: Mon May 20 19:21:29 2024 -0700 Do not message for repeated enable/disable of tab-line-mode tab-line-mode should not inform the user of an unexpected change when enabling the mode if already enabled. For example, when running (tab-line-mode 1) repeatedly (bug#68765). * lisp/tab-line.el (tab-line-mode): Modify case when user is informed. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 316c87fb3ad..fa52ccd81aa 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -1122,19 +1122,14 @@ However, return the correct mouse position list if EVENT is a "Toggle display of tab line in the windows displaying the current buffer." :lighter nil (let ((default-value '(:eval (tab-line-format)))) - (if tab-line-mode - ;; Preserve the existing tab-line set outside of this mode - (if (null tab-line-format) + ;; Preserve the existing tab-line set outside of this mode + (if (or (null tab-line-format) + (equal tab-line-format default-value)) + (if tab-line-mode (setq tab-line-format default-value) - (message - "tab-line-format set outside of tab-line-mode, currently `%S'" - tab-line-format)) - ;; Reset only values set by this mode - (if (equal tab-line-format default-value) - (setq tab-line-format nil) - (message - "tab-line-format set outside of tab-line-mode, currently `%S'" - tab-line-format))))) + (setq tab-line-format nil)) + (message "tab-line-format set outside of tab-line-mode, currently `%S'" + tab-line-format)))) (defcustom tab-line-exclude-modes '(completion-list-mode) commit eedb959441578f9b4e62b78e1a772328bffe9466 Author: Jim Porter Date: Mon May 20 17:38:00 2024 -0700 ; * lisp/eshell/em-unix.el (eshell-grep): Fix "plain grep" behavior. diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 751f13cc715..855efa26033 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -815,8 +815,8 @@ external command." (if (and maybe-use-occur eshell-no-grep-available) (eshell-poor-mans-grep args) (eshell-compile command (cons "-n" args) - (and eshell-plain-grep-behavior - 'interactive) + (when eshell-plain-grep-behavior + 'plain) #'grep-mode))) (defun eshell/grep (&rest args) commit 77ece5709a1d38df8cec33432e77044c308b1d6b Author: Jim Porter Date: Mon May 20 12:45:13 2024 -0700 Support text overlays for thingatpt provider helpers * lisp/thingatpt.el (thing-at-point-for-text-property) (forward-thing-for-text-property) (bounds-of-thing-at-point-for-text-property): Rename to... (thing-at-point-for-char-property) (forward-thing-for-char-property) (bounds-of-thing-at-point-for-char-property): ... and add overlay support. Update callers. * test/lisp/thingatpt-tests.el (thing-at-point-providers) (forward-thing-providers, bounds-of-thing-at-point-providers): Test overlays too. * test/lisp/progmodes/bug-reference-tests.el (test-thing-at-point): Test 'bounds-of-thing-at-point' and 'forward-point'. * etc/NEWS: Update function names in announcement. diff --git a/etc/NEWS b/etc/NEWS index 4e52d4dccb2..d72ef5b5bef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1745,9 +1745,9 @@ 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 +The new helper functions 'thing-at-point-for-char-property', +'bounds-of-thing-at-point-for-char-property', and +'forward-thing-for-char-property' can help to help implement custom thingatpt providers for "things" that are defined by a text property. --- diff --git a/lisp/net/eww.el b/lisp/net/eww.el index be43ac2f9db..32e24f9e2e5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1380,15 +1380,15 @@ within text input fields." (defun eww--url-at-point () "`thing-at-point' provider function." - (thing-at-point-for-text-property 'shr-url)) + (thing-at-point-for-char-property 'shr-url)) (defun eww--forward-url (backward) "`forward-thing' provider function." - (forward-thing-for-text-property 'shr-url backward)) + (forward-thing-for-char-property 'shr-url backward)) (defun eww--bounds-of-url-at-point () "`bounds-of-thing-at-point' provider function." - (bounds-of-thing-at-point-for-text-property 'shr-url)) + (bounds-of-thing-at-point-for-char-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 9b8e5c0b106..46163774e47 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -658,15 +658,15 @@ have been run, the auto-setup is inhibited.") (defun bug-reference--url-at-point () "`thing-at-point' provider function." - (thing-at-point-for-text-property 'bug-reference-url)) + (thing-at-point-for-char-property 'bug-reference-url)) (defun bug-reference--forward-url (backward) "`forward-thing' provider function." - (forward-thing-for-text-property 'bug-reference-url backward)) + (forward-thing-for-char-property 'bug-reference-url backward)) (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)) + (bounds-of-thing-at-point-for-char-property 'bug-reference-url)) (defun bug-reference--init (enable) (if enable diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index ff0ed66d62d..fe9f5003f0b 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -828,40 +828,48 @@ treated as white space." ;; Provider helper functions -(defun thing-at-point-for-text-property (property) +(defun thing-at-point-for-char-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) +Each \"thing\" is a region of text with the specified text PROPERTY (or +overlay) set." + (or (get-char-property (point) property) (and (> (point) (point-min)) - (get-text-property (1- (point)) property)))) + (get-char-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 &optional backward) +(defun forward-thing-for-char-property (property &optional backward) "Move forward to the end of the next \"thing\". If BACKWARD is non-nil, move backward to the beginning of the previous \"thing\" instead. Each \"thing\" is a region of text with the -specified text PROPERTY set." - (let ((search-func (if backward #'text-property-search-backward - #'text-property-search-forward)) - (pos-func (if backward #'prop-match-beginning #'prop-match-end))) - (when-let ((match (funcall search-func property))) - (goto-char (funcall pos-func match))))) - -(defun bounds-of-thing-at-point-for-text-property (property) +specified text PROPERTY (or overlay) set." + (let ((bounds (bounds-of-thing-at-point-for-char-property property))) + (if backward + (if (and bounds (> (point) (car bounds))) + (goto-char (car bounds)) + (goto-char (previous-single-char-property-change (point) property)) + (unless (get-char-property (point) property) + (goto-char (previous-single-char-property-change + (point) property)))) + (if (and bounds (< (point) (cdr bounds))) + (goto-char (cdr bounds)) + (unless (get-char-property (point) property) + (goto-char (next-single-char-property-change (point) property))) + (goto-char (next-single-char-property-change (point) property)))))) + +(defun bounds-of-thing-at-point-for-char-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." +The \"thing\" is a region of text with the specified text PROPERTY (or +overlay) set." (let ((pos (point))) - (when (or (get-text-property pos property) + (when (or (get-char-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)))))) + (get-char-property (setq pos (1- pos)) property))) + (cons (previous-single-char-property-change + (min (1+ pos) (point-max)) property) + (next-single-char-property-change pos property))))) ;;; thingatpt.el ends here diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 8cca354705b..21b9d3c8ff3 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -136,8 +136,11 @@ (goto-char (point-min)) ;; Make sure we get the URL when `bug-reference-mode' is active... (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234")) + (should (equal (bounds-of-thing-at-point 'url) '(1 . 9))) + (should (= (save-excursion (forward-thing 'url) (point)) 9)) (bug-reference-mode -1) ;; ... and get nil when `bug-reference-mode' is inactive. - (should-not (thing-at-point 'url)))) + (should-not (thing-at-point 'url)) + (should-not (bounds-of-thing-at-point 'url)))) ;;; bug-reference-tests.el ends here diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index c3b04f29ce5..cc51e3f5296 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -262,10 +262,10 @@ position to retrieve THING.") (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")) + `((url . ,(lambda () (thing-at-point-for-char-property 'foo-url))) + (url . ,(lambda () (thing-at-point-for-char-property 'bar-url))))) + (insert (propertize "hello" 'foo-url "foo.com") "\ngoodbye") + (overlay-put (make-overlay 7 14) 'bar-url "bar.com") (goto-char (point-min)) ;; Get the URL using the first provider. (should (equal (thing-at-point 'url) "foo.com")) @@ -280,10 +280,10 @@ position to retrieve THING.") (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")) + `((url . ,(lambda (n) (forward-thing-for-char-property 'foo-url n))) + (url . ,(lambda (n) (forward-thing-for-char-property 'bar-url n))))) + (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye") + (overlay-put (make-overlay 12 19) 'bar-url "bar.com") (goto-char (point-min)) (forward-thing 'url) ; Move past the first URL. (should (= (point) 6)) @@ -301,11 +301,11 @@ position to retrieve THING.") (setq-local bounds-of-thing-at-point-provider-alist `((url . ,(lambda () - (bounds-of-thing-at-point-for-text-property 'foo-url))) + (bounds-of-thing-at-point-for-char-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")) + (bounds-of-thing-at-point-for-char-property 'bar-url))))) + (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye") + (overlay-put (make-overlay 12 19) '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))) @@ -325,11 +325,11 @@ position to retrieve THING.") (with-temp-buffer (setq-local thing-at-point-provider-alist - `((url . ,(lambda () (thing-at-point-for-text-property 'url)))) + `((url . ,(lambda () (thing-at-point-for-char-property 'url)))) forward-thing-provider-alist - `((url . ,(lambda (n) (forward-thing-for-text-property 'url n)))) + `((url . ,(lambda (n) (forward-thing-for-char-property 'url n)))) bounds-of-thing-at-point-provider-alist - `((url . ,(lambda () (bounds-of-thing-at-point-for-text-property 'url))))) + `((url . ,(lambda () (bounds-of-thing-at-point-for-char-property 'url))))) (insert (propertize "one" 'url "foo.com") (propertize "two" 'url "bar.com") (propertize "three" 'url "baz.com")) commit f6c60f16a231802104f53f3953b7fdc363944316 Author: Jim Porter Date: Mon May 20 12:37:22 2024 -0700 Improve implementation of 'forward-thing' using custom providers Now, call all the custom providers for each step, using the provider that moves point the smallest non-zero amount. This allows multiple providers for a given "thing" to work nicely together. * lisp/thingatpt.el (forward-thing-provider-alist): Update docstring. (forward-thing): New implementation to call each provider N times. (forward-thing-for-text-property): Take BACKWARD instead of N. Update callers. * test/lisp/thingatpt-tests.el (thing-at-point-providers) (forward-thing-providers): Add more checks. (consecutive-things-at-point): New test. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index ff502914eb5..be43ac2f9db 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1382,9 +1382,9 @@ within text input fields." "`thing-at-point' provider function." (thing-at-point-for-text-property 'shr-url)) -(defun eww--forward-url (n) +(defun eww--forward-url (backward) "`forward-thing' provider function." - (forward-thing-for-text-property 'shr-url n)) + (forward-thing-for-text-property 'shr-url backward)) (defun eww--bounds-of-url-at-point () "`bounds-of-thing-at-point' provider function." diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index be162cf9e11..9b8e5c0b106 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -660,9 +660,9 @@ have been run, the auto-setup is inhibited.") "`thing-at-point' provider function." (thing-at-point-for-text-property 'bug-reference-url)) -(defun bug-reference--forward-url (n) +(defun bug-reference--forward-url (backward) "`forward-thing' provider function." - (forward-thing-for-text-property 'bug-reference-url n)) + (forward-thing-for-text-property 'bug-reference-url backward)) (defun bug-reference--bounds-of-url-at-point () "`bounds-of-thing-at-point' provider function." diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 825f49cfab7..ff0ed66d62d 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -76,12 +76,13 @@ question. `whitespace', `line', `face' and `page'.") (defvar forward-thing-provider-alist nil - "Alist of providers for moving forward to the end of a \"thing\". + "Alist of providers for moving forward to the end of the next \"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. +\"thing\" at point. Each function should take a single argument +BACKWARD, which is non-nil if the function should instead move to the +beginning of the previous thing. The provider for \"thing\" that moves +point by the smallest non-zero distance wins. You can use this variable in much the same way as `thing-at-point-provider-alist' (which see).") @@ -106,15 +107,35 @@ Possibilities include `symbol', `list', `sexp', `defun', `number', `filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'." (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))))) + (if (assq thing forward-thing-provider-alist) + (let* ((backward (< n 0)) + (reducer (if backward #'max #'min)) + (limit (if backward (point-min) (point-max)))) + (catch 'done + (dotimes (_ (abs n)) + ;; Find the provider that moves point the smallest non-zero + ;; amount, and use that to update point. + (let ((new-point (seq-reduce + (lambda (value elt) + (if (eq (car elt) thing) + (save-excursion + (funcall (cdr elt) backward) + (if value + (funcall reducer value (point)) + (point))) + value)) + forward-thing-provider-alist nil))) + (if (and new-point (/= new-point (point))) + (goto-char new-point) + ;; If we didn't move point, move to our limit (min or max + ;; point), and terminate. + (goto-char limit) + (throw 'done t)))))) + (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 @@ -819,21 +840,16 @@ Each \"thing\" is a region of text with the specified text PROPERTY set." (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 forward-thing-for-text-property (property &optional backward) + "Move forward to the end of the next \"thing\". +If BACKWARD is non-nil, move backward to the beginning of the previous +\"thing\" instead. Each \"thing\" is a region of text with the +specified text PROPERTY set." + (let ((search-func (if backward #'text-property-search-backward + #'text-property-search-forward)) + (pos-func (if backward #'prop-match-beginning #'prop-match-end))) + (when-let ((match (funcall search-func property))) + (goto-char (funcall pos-func match))))) (defun bounds-of-thing-at-point-for-text-property (property) "Determine the start and end buffer locations for the \"thing\" at point. diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 88a4bc8a27d..c3b04f29ce5 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -270,6 +270,8 @@ position to retrieve THING.") ;; Get the URL using the first provider. (should (equal (thing-at-point 'url) "foo.com")) (should (equal (thing-at-point 'word) "hello")) + (goto-char 6) ; Go to the end of "hello". + (should (equal (thing-at-point 'url) "foo.com")) (goto-char (point-max)) ;; Get the URL using the second provider. (should (equal (thing-at-point 'url) "bar.com")))) @@ -283,13 +285,15 @@ position to retrieve THING.") (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. + (forward-thing 'url) ; Move past the first URL. + (should (= (point) 6)) + (forward-thing 'url) ; Move past the second URL. + (should (= (point) 19)) + (forward-thing 'url -1) ; Move backwards past the second URL. + (should (= (point) 12)) + (forward-thing 'url -1) ; Move backwards past the first URL. + (should (= (point) 1)) + (forward-thing 'word) ; Move past the first word. (should (= (point) 11)))) (ert-deftest bounds-of-thing-at-point-providers () @@ -317,4 +321,30 @@ position to retrieve THING.") (should (eq (save-excursion (beginning-of-thing 'url)) 12)) (should (eq (save-excursion (end-of-thing 'url)) 19)))) +(ert-deftest consecutive-things-at-point () + (with-temp-buffer + (setq-local + thing-at-point-provider-alist + `((url . ,(lambda () (thing-at-point-for-text-property 'url)))) + forward-thing-provider-alist + `((url . ,(lambda (n) (forward-thing-for-text-property 'url n)))) + bounds-of-thing-at-point-provider-alist + `((url . ,(lambda () (bounds-of-thing-at-point-for-text-property 'url))))) + (insert (propertize "one" 'url "foo.com") + (propertize "two" 'url "bar.com") + (propertize "three" 'url "baz.com")) + (goto-char 4) ; Go to the end of "one". + (should (equal (thing-at-point 'url) "bar.com")) + (should (equal (bounds-of-thing-at-point 'url) '(4 . 7))) + (forward-thing 'url) + (should (= (point) 7)) + (should (equal (thing-at-point 'url) "baz.com")) + (should (equal (bounds-of-thing-at-point 'url) '(7 . 12))) + (forward-thing 'url) + (should (= (point) 12)) + (forward-thing 'url -2) + (should (= (point) 4)) + (should (equal (thing-at-point 'url) "bar.com")) + (should (equal (bounds-of-thing-at-point 'url) '(4 . 7))))) + ;;; thingatpt-tests.el ends here commit 642fd607b83c56847914a8a46d6c297a74529610 Author: Paul Eggert Date: Mon May 20 10:12:56 2024 -0700 Sync m4/byteswap.m4 from Gnulib * m4/byteswap.m4: Copy from Gnulib. This fixes a configure glitch on macOS reported by Mattias EngdegÄrd diff --git a/m4/byteswap.m4 b/m4/byteswap.m4 index 3f5ef45cfe6..e91da97b958 100644 --- a/m4/byteswap.m4 +++ b/m4/byteswap.m4 @@ -1,5 +1,5 @@ # byteswap.m4 -# serial 6 +# serial 7 dnl Copyright (C) 2005, 2007, 2009-2024 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -15,6 +15,10 @@ AC_DEFUN([gl_BYTESWAP], AC_CACHE_CHECK([for working bswap_16, bswap_32, bswap_64], [gl_cv_header_working_byteswap_h], [gl_cv_header_working_byteswap_h=no + dnl Check that floating point arguments work. + dnl This also checks C libraries with implementations like + dnl '#define bswap_16(x) (((x) >> 8 & 0xff) | (((x) & 0xff) << 8))' + dnl that mistakenly evaluate their arguments multiple times. AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( [[#include @@ -29,7 +33,7 @@ AC_DEFUN([gl_BYTESWAP], [gl_cv_header_working_byteswap_h=no]) ]) fi - if test $gl_cv_header_working_byteswap_h = yes; then + if test "$gl_cv_header_working_byteswap_h" = yes; then GL_GENERATE_BYTESWAP_H=false else GL_GENERATE_BYTESWAP_H=true commit 3c238f7c50427942a200d38738bd92dad98a3928 Author: Michael Albinus Date: Mon May 20 16:22:17 2024 +0200 Tramp code cleanup * lisp/net/tramp-sh.el (tramp-find-shell, tramp-find-inline-compress) (tramp-get-remote-path): * lisp/net/tramp-smb.el (tramp-smb-handle-process-file): Use `tramp-warning'. * test/lisp/net/tramp-tests.el (tramp--test-container-p): Add "kubernetes", "run0" and "nspawn". (tramp--test-toolbox-p): New defun. (tramp-test45-asynchronous-requests): Use it. (tramp--test-check-files): Adapt regexp. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b79b55ee2cc..569922a9852 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4468,8 +4468,8 @@ file exists and nonzero exit status otherwise." ;; Maybe it works at least for some other commands. (prog1 default-shell - (tramp-message - vec 2 + (tramp-warning + vec (concat "Couldn't find a remote shell which groks tilde " "expansion, using `%s'") @@ -5003,8 +5003,8 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-set-connection-property p "inline-compress" nil) (tramp-set-connection-property p "inline-decompress" nil) - (tramp-message - vec 2 "Couldn't find an inline transfer compress command"))))) + (tramp-warning + vec "Couldn't find an inline transfer compress command"))))) (defun tramp-ssh-option-exists-p (vec option) "Check, whether local ssh OPTION is applicable." @@ -5714,8 +5714,8 @@ Nonexistent directories are removed from spec." (tramp-shell-quote-argument tramp-end-of-heredoc)) 'noerror (rx (literal tramp-end-of-heredoc))) (progn - (tramp-message - vec 2 "Could not retrieve `tramp-own-remote-path'") + (tramp-warning + vec "Could not retrieve `tramp-own-remote-path'") nil))))) ;; Replace place holder `tramp-default-remote-path'. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a51b2b904ec..c6c3caabdcf 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1231,7 +1231,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ((car destination) (setq outbuf (current-buffer)))) ;; stderr. - (tramp-message v 2 "%s" "STDERR not supported")) + (tramp-warning v "%s" "STDERR not supported")) ;; 't (destination (setq outbuf (current-buffer)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 26bf8dea420..18116229337 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4862,10 +4862,11 @@ should be set conmnection-local.") (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\")"))) + (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) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index fabd1009af0..366082edb75 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -7076,7 +7076,7 @@ This is used in tests which we don't want to tag "Check, whether a container method is used. This does not support some special file names." (string-match-p - (rx bol (| "docker" "podman" "apptainer")) + (rx bol (| "docker" "podman" "kubernetes" "apptainer" "run0" "nspawn")) (file-remote-p ert-remote-temporary-file-directory 'method))) (defun tramp--test-container-oob-p () @@ -7222,6 +7222,12 @@ This does not support special file names." (string-equal "telnet" (file-remote-p ert-remote-temporary-file-directory 'method))) +(defun tramp--test-toolbox-p () + "Check, whether the toolbox method is used. +This does not support `tramp-test45-asynchronous-requests'." + (string-equal + "toolbox" (file-remote-p ert-remote-temporary-file-directory 'method))) + (defun tramp--test-windows-nt-p () "Check, whether the locale host runs MS Windows." (eq system-type 'windows-nt)) @@ -7437,7 +7443,9 @@ This requires restrictions of file name syntax." '(tramp--test-async-shell-command)))) (with-temp-buffer (funcall this-shell-command "cat -- *" (current-buffer)) - (should (string-equal elt (buffer-string))))))) + (should + (string-match-p + (rx (literal elt) eol) (buffer-string))))))) (delete-file file2) (should-not (file-exists-p file2)) @@ -7706,8 +7714,9 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) (skip-unless (not (tramp--test-container-p))) - (skip-unless (not (tramp--test-telnet-p))) (skip-unless (not (tramp--test-sshfs-p))) + (skip-unless (not (tramp--test-telnet-p))) + (skip-unless (not (tramp--test-toolbox-p))) (skip-unless (not (tramp--test-windows-nt-p))) (with-timeout commit 9db24de481b8785b04600ff4b349a2a0d761d53b Author: Po Lu Date: Mon May 20 21:13:44 2024 +0800 Adapt last change to Android * src/sfntfont.c (sfnt_parse_style): Replace unrepresentable characters in DESC->adstyle with ` '. diff --git a/src/sfntfont.c b/src/sfntfont.c index fb3feaeaf79..79bc251abe4 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -454,8 +454,9 @@ static struct sfnt_style_desc sfnt_width_descriptions[] = static void sfnt_parse_style (Lisp_Object style_name, struct sfnt_font_desc *desc) { - char *style, *single, *saveptr; + char *style, *single, *saveptr, c; int i; + ptrdiff_t x; USE_SAFE_ALLOCA; /* Fill in default values. slant seems to not be consistent with @@ -555,7 +556,19 @@ sfnt_parse_style (Lisp_Object style_name, struct sfnt_font_desc *desc) /* The adstyle must be a symbol, so intern it if it is set. */ if (!NILP (desc->adstyle)) - desc->adstyle = Fintern (desc->adstyle, Qnil); + { + /* Characters that can't be represented in an XLFD must be + replaced. */ + + for (x = 0; x < SBYTES (desc->adstyle); ++x) + { + c = SREF (desc->adstyle, x); + if (c == '-' || c == '*' || c == '?' && c == '"') + SSET (desc->adstyle, x, ' '); + } + + desc->adstyle = Fintern (desc->adstyle, Qnil); + } SAFE_FREE (); } commit 5957e570800d495522fff688b6d68f34ce557e14 Author: Po Lu Date: Mon May 20 20:59:32 2024 +0800 Circumvent bug#70989 * src/ftfont.c (get_adstyle_property): Substitute a space for unrepresentable adstyle characters. (bug#70989) diff --git a/src/ftfont.c b/src/ftfont.c index 2e37b62ea35..214d7532d6f 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -149,7 +149,8 @@ static Lisp_Object get_adstyle_property (FcPattern *p) { FcChar8 *fcstr; - char *str, *end; + char *str, *end, *tmp; + size_t i; Lisp_Object adstyle; #ifdef FC_FONTFORMAT @@ -168,7 +169,18 @@ get_adstyle_property (FcPattern *p) || matching_prefix (str, end - str, "Oblique") || matching_prefix (str, end - str, "Italic")) return Qnil; - adstyle = font_intern_prop (str, end - str, 1); + /* The characters `-', `?', `*', and `"' are not representable in XLFDs + and therefore must be replaced by substitutes. (bug#70989) */ + USE_SAFE_ALLOCA; + tmp = SAFE_ALLOCA (end - str); + for (i = 0; i < end - str; ++i) + tmp[i] = ((end[i] != '?' + && end[i] != '*' + && end[i] != '"' + && end[i] != '-') + ? end[i] : ' '); + adstyle = font_intern_prop (tmp, end - str, 1); + SAFE_FREE (); if (font_style_to_value (FONT_WIDTH_INDEX, adstyle, 0) >= 0) return Qnil; return adstyle; commit 45916eadaed1b7f3a02df62a25bc851a838b6309 Author: Eli Zaretskii Date: Mon May 20 15:29:39 2024 +0300 Fix visiting zip archives inside tar archives * lisp/tar-mode.el (tar-archive-from-tar): New local variable. (tar-extract): Set it non-nil for an extracted member that happens to be arc-mode archive. * lisp/arc-mode.el (tar-archive-from-tar): Defvar it. (archive-unique-fname): Make sure FNAME can be created in DIR, even if FNAME is provided as an absolute file name (this happens if the archive is a member of a Tar archive, for example). (archive-extract): Set 'archive-remote' for archives that were extracted from Tar archives. (Bug#70987) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 9a8dd6679e3..bf9def681c3 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -563,6 +563,8 @@ Its value is an `archive--file-desc'.") (defvar-local archive-files nil "Vector of `archive--file-desc' objects.") +(defvar tar-archive-from-tar nil) + ;; ------------------------------------------------------------------------- ;;; Section: Support functions. @@ -754,7 +756,8 @@ archive. ;; on local filesystem. Treat such archives as remote. (or archive-remote (setq archive-remote - (or (string-match archive-remote-regexp (buffer-file-name)) + (or tar-archive-from-tar ; was included in a tar archive + (string-match archive-remote-regexp (buffer-file-name)) (string-match file-name-invalid-regexp (buffer-file-name))))) @@ -920,6 +923,9 @@ If FNAME can be uniquely created in DIR, it is returned unaltered. If FNAME is something our underlying filesystem can't grok, or if another file by that name already exists in DIR, a unique new name is generated using `make-temp-file', and the generated name is returned." + (if (file-name-absolute-p fname) + ;; We need a file name relative to the filesystem root. + (setq fname (substring fname (1+ (string-search "/" fname))))) (let ((fullname (expand-file-name fname dir)) (alien (string-match file-name-invalid-regexp fname)) (tmpfile @@ -1179,6 +1185,9 @@ NEW-NAME." (buffer (get-buffer bufname)) (just-created nil) (file-name-coding archive-file-name-coding-system)) + (or archive-remote + (and (local-variable-p 'tar-archive-from-tar) + (setq archive-remote tar-archive-from-tar))) (if (and buffer (string= (buffer-file-name buffer) arcfilename)) nil diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 375191a8167..7278bee48d4 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -135,6 +135,10 @@ This information is useful, but it takes screen space away from file names." (put 'tar-superior-buffer 'permanent-local t) (put 'tar-superior-descriptor 'permanent-local t) +(defvar tar-archive-from-tar nil + "Non-nil if an arc-mode archive file is a member of a tar archive.") +(put tar-archive-from-tar 'permanent-local t) + ;; The Tar data is made up of bytes and better manipulated as bytes ;; and can be very large, so insert/delete can be costly. The summary we ;; want to display may contain non-ascii chars, of course, so we'd like it @@ -1124,6 +1128,8 @@ return nil. Otherwise point is returned." default-directory)) (set-buffer-modified-p nil) (normal-mode) ; pick a mode. + (when (derived-mode-p 'archive-mode) + (setq-local tar-archive-from-tar t)) (setq-local tar-superior-buffer tar-buffer) (setq-local tar-superior-descriptor descriptor) (setq buffer-read-only read-only-p)