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.

(cherry picked from commit f6c60f16a231802104f53f3953b7fdc363944316)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index ff502914eb53672bc808e23a843eaa880218b3fd..be43ac2f9db53ddad223288a1ad7ed6612f3eeb7 100644 (file)
--- 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 be162cf9e117e935954f6f49027617ded69c2ab9..9b8e5c0b1068f0614489544849024796480e7419 100644 (file)
--- 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 825f49cfab76b28d28cc54bfc0f0997f0aa4de1e..ff0ed66d62d38c39017ed976380754528bf4b945 100644 (file)
--- 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 88a4bc8a27da805274fc615b683382ad0fe15d70..c3b04f29ce5b232667c749c5da5c7df55c264f9c 100644 (file)
--- 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