summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2021-08-25 18:04:43 +0200
committerLars Ingebrigtsen <larsi@gnus.org>2021-08-25 18:04:43 +0200
commit7db376e560448e61485ba054def8c82b21f33d6a (patch)
tree37cbf86ce24905178f4c7b459c830b7b170b98f4
parentab799500094fb36b3f26b9c8a4147848b204cf0a (diff)
downloademacs-7db376e560448e61485ba054def8c82b21f33d6a.tar.gz
Make thingatpt respect fields
* lisp/thingatpt.el (thing-at-point): Make thingatpt respect fields (bug#9454).
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/thingatpt.el38
-rw-r--r--test/lisp/thingatpt-tests.el8
3 files changed, 36 insertions, 16 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 2c929e4a629..04e482364aa 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 66bbfb0f9f6..ab17748df5b 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 fba6f21d5dc..1849480347e 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