master 7db376e: Make thingatpt respect fields

[Lars Ingebrigtsen]

branch: master
commit 7db376e560448e61485ba054def8c82b21f33d6a
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make thingatpt respect fields
    
    * lisp/thingatpt.el (thing-at-point): Make thingatpt respect
    fields (bug#9454).
---
 etc/NEWS                     |  6 ++++++
 lisp/thingatpt.el            | 38 ++++++++++++++++++++++----------------
 test/lisp/thingatpt-tests.el |  8 ++++++++
 3 files changed, 36 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 2c929e4..04e4823 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2432,6 +2432,12 @@ that makes it a valid button.
 *** New variable 'thing-at-point-provider-alist'.
 This allows mode-specific alterations to how 'thing-at-point' works.
 
+---
+*** thingatpt now respects fields.
+'thing-at-point' (and all functions that use it, like
+'symbol-at-point') will narrow to the current field (if any) before
+trying to identify the thing at point.
+
 ** Enriched mode
 
 ---
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 66bbfb0..ab17748 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -162,24 +162,30 @@ Possibilities include `symbol', `list', `sexp', `defun',
 When the optional argument NO-PROPERTIES is non-nil,
 strip text properties from the return value.
 
+If the current buffer uses fields (see Info node `(elisp)Fields'),
+this function will narrow to the field before identifying the
+thing at point.
+
 See the file `thingatpt.el' for documentation on how to define
 a symbol as a valid THING."
-  (let ((text
-         (cond
-          ((cl-loop for (pthing . function) in thing-at-point-provider-alist
-                    when (eq pthing thing)
-                    for result = (funcall function)
-                    when result
-                    return result))
-          ((get thing 'thing-at-point)
-           (funcall (get thing 'thing-at-point)))
-          (t
-           (let ((bounds (bounds-of-thing-at-point thing)))
-             (when bounds
-               (buffer-substring (car bounds) (cdr bounds))))))))
-    (when (and text no-properties (sequencep text))
-      (set-text-properties 0 (length text) nil text))
-    text))
+  (save-restriction
+    (narrow-to-region (field-beginning) (field-end))
+    (let ((text
+           (cond
+            ((cl-loop for (pthing . function) in thing-at-point-provider-alist
+                      when (eq pthing thing)
+                      for result = (funcall function)
+                      when result
+                      return result))
+            ((get thing 'thing-at-point)
+             (funcall (get thing 'thing-at-point)))
+            (t
+             (let ((bounds (bounds-of-thing-at-point thing)))
+               (when bounds
+                 (buffer-substring (car bounds) (cdr bounds))))))))
+      (when (and text no-properties (sequencep text))
+        (set-text-properties 0 (length text) nil text))
+      text)))
 
 ;; Go to beginning/end
 
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index fba6f21..1849480 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -223,4 +223,12 @@ position to retrieve THING.")
   (should (equal (test--number "0xf00" 2) 3840))
   (should (equal (test--number "0xf00" 3) 3840)))
 
+(ert-deftest test-fields ()
+  (with-temp-buffer
+    (insert (propertize "foo" 'field 1) "bar" (propertize "zot" 'field 2))
+    (goto-char 1)
+    (should (eq (symbol-at-point) 'foo))
+    (goto-char 5)
+    (should (eq (symbol-at-point) 'bar))))
+
 ;;; thingatpt.el ends here