On 4/12/2024 3:30 PM, Jim Porter wrote:
On 4/12/2024 5:41 AM, Ihor Radchenko wrote:
Jim Porter <jporterb...@gmail.com> writes:
That sounds reasonable enough to me; does anyone else have opinions on
this? Otherwise, I'll get to work on a patch (though probably not for a
couple weeks).
It has been a while since the last message in this thread.
Jim, may I know if you had a chance to work on the patch?
Sorry about that. I'm currently extremely swamped with real life, but
most of that should be wrapped up by the end of the month, at which
point I'll be able to devote some time to Emacs again.
Ihor, Eli: What do you think of the attached patch? I added variables to
let modes define custom providers for 'bounds-of-thing-at-point' and
'forward-thing'. (Notably, I avoided adding vars for the
'beginning-of-thing' and 'end-of-thing' functions, since those just call
'bounds-of-thing-at-point' anyway.)
If this looks like a reasonable way to go, I'll continue work on this
patch by adding entries to 'bounds-of-thing-at-point-provider-alist' and
'forward-thing-provider-alist' in the appropriate places (i.e. wherever
we already add to 'thing-at-point-provider-alist', like in EWW).From a0ed62aa42fa47043511ba814cf5ce8419e9d03f Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterb...@gmail.com>
Date: Sun, 28 Apr 2024 21:19:53 -0700
Subject: [PATCH] Allow defining custom providers for more "thingatpt"
functions
* lisp/thingatpt.el (bounds-of-thing-at-point-provider-alist)
(forward-thing-provider-alist): New variables...
(forward-thing, bounds-of-thing-at-point): ... 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.
---
etc/NEWS | 18 +++++++++++++-----
lisp/thingatpt.el | 35 ++++++++++++++++++++++++++++++-----
test/lisp/thingatpt-tests.el | 31 +++++++++++++++++++++++++++++++
3 files changed, 74 insertions(+), 10 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7efb4110bcd..2480f0d096d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1591,19 +1591,27 @@ of the currently existing keyboards macros using the
new mode
duplicating them, deleting them, and editing their counters, formats,
and keys.
-** Miscellaneous
+** thingatpt.el
---
-*** 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.
---
*** '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/thingatpt.el b/lisp/thingatpt.el
index 7896ad984df..d5f71e3c6a8 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -75,6 +75,22 @@ thing-at-point-provider-alist
`existing-filename', `url', `email', `uuid', `word', `sentence',
`whitespace', `line', `face' and `page'.")
+(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 in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
+(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. The first provider for the \"thing\" that returns a
+non-nil value wins. You can use this in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
;; Basic movement
;;;###autoload
@@ -84,11 +100,16 @@ forward-thing
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 +127,10 @@ bounds-of-thing-at-point
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.
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index e50738f1122..4aacd776176 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -258,4 +258,35 @@ test-numbers-hex-c
(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 () "test"))))
+ (insert "hello")
+ (should (equal (thing-at-point 'url) "test"))
+ (should (equal (thing-at-point 'word) "hello"))))
+
+(ert-deftest forward-thing-providers ()
+ (with-temp-buffer
+ (setq-local forward-thing-provider-alist
+ `((url . ,(lambda (n) (goto-char 4)))))
+ (insert "hello there")
+ (goto-char (point-min))
+ (should (eq (save-excursion (forward-thing 'url) (point)) 4))
+ (should (eq (save-excursion (forward-thing 'word) (point)) 6))))
+
+(ert-deftest bounds-of-thing-at-point-providers ()
+ (with-temp-buffer
+ (setq-local bounds-of-thing-at-point-provider-alist
+ `((url . ,(lambda () '(2 . 3)))))
+ (insert "hello")
+ ;; Look for a "URL", using our provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(2 . 3)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 2))
+ (should (eq (save-excursion (end-of-thing 'url)) 3))
+ ;; Look for a word, which should *not* use our provider above.
+ (should (equal (bounds-of-thing-at-point 'word) '(1 . 6)))
+ (should (eq (save-excursion (beginning-of-thing 'word)) 1))
+ (should (eq (save-excursion (end-of-thing 'word)) 6))))
+
;;; thingatpt-tests.el ends here
--
2.25.1
