* [PATCH] Add support for 'thing-at-point' to get URL at point
@ 2023-11-06 19:45 Jim Porter
2023-11-06 19:56 ` Jim Porter
2023-11-06 20:11 ` Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point) Ihor Radchenko
0 siblings, 2 replies; 18+ messages in thread
From: Jim Porter @ 2023-11-06 19:45 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 428 bytes --]
This is similar to Emacs bug#66752[1]. It would be nice if
"(thing-at-point 'url)" would return the URL when point is over an Org
link. With this, it's easier to write a function that copies (or browses
to) the URL at point without coding so many special cases.
Attached is a patch with a regression test for it. Should this also get
a NEWS entry?
[1] https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-10/msg01628.html
[-- Attachment #2: 0001-Add-support-for-thing-at-point-to-get-URL-at-point.patch --]
[-- Type: text/plain, Size: 2229 bytes --]
From 6bce84bd28253236eff8ef972ede7daf82f95a71 Mon Sep 17 00:00:00 2001
From: Jim Porter <itsjimporter@gmail.com>
Date: Mon, 6 Nov 2023 11:39:09 -0800
Subject: [PATCH] Add support for 'thing-at-point' to get URL at point
* lisp/org.el (thingatpt): Require.
(org--url-at-point): New function...
(org-mode): ... and add it to 'thing-at-point-provider-alist'.
* testing/lisp/test-org.el (test-org/thing-at-point/url): New test.
---
lisp/org.el | 10 ++++++++++
testing/lisp/test-org.el | 10 ++++++++++
2 files changed, 20 insertions(+)
diff --git a/lisp/org.el b/lisp/org.el
index 4eb6ad0ee..c7ecfc13a 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -81,6 +81,7 @@
(require 'calendar)
(require 'find-func)
(require 'format-spec)
+(require 'thingatpt)
(condition-case nil
(load (concat (file-name-directory load-file-name)
@@ -4948,6 +4949,11 @@ The following commands are available:
#'pcomplete-completions-at-point nil t)
(setq-local buffer-face-mode-face 'org-default)
+ ;; `thing-at-point' support
+ (setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . org--url-at-point))))
+
;; If empty file that did not turn on Org mode automatically, make
;; it to.
(when (and org-insert-mode-line-in-empty-file
@@ -8611,6 +8617,10 @@ there is one, return it."
(setq link (nth (1- nth) links)))))
(cons link end)))))
+(defun org--url-at-point ()
+ "`thing-at-point' provider function."
+ (org-element-property :raw-link (org-element-context)))
+
;;; File search
(defun org-do-occur (regexp &optional cleanup)
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 21b850c03..2fe4477a3 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3583,6 +3583,16 @@ Foo Bar
(org-open-at-point))
nil)))))
+\f
+;;; Thing at point
+
+(ert-deftest test-org/thing-at-point/url ()
+ "Test that `thing-at-point' returns the URL at point."
+ (should
+ (org-test-with-temp-text
+ "[[https://www.gnu.org/software/emacs/][GNU Emacs]]"
+ (string= (thing-at-point 'url) "https://www.gnu.org/software/emacs/"))))
+
\f
;;; Node Properties
--
2.25.1
^ permalink raw reply related [flat|nested] 18+ messages in thread
* Re: [PATCH] Add support for 'thing-at-point' to get URL at point
2023-11-06 19:45 [PATCH] Add support for 'thing-at-point' to get URL at point Jim Porter
@ 2023-11-06 19:56 ` Jim Porter
2023-11-06 20:11 ` Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point) Ihor Radchenko
1 sibling, 0 replies; 18+ messages in thread
From: Jim Porter @ 2023-11-06 19:56 UTC (permalink / raw)
To: emacs-orgmode
On 11/6/2023 11:45 AM, Jim Porter wrote:
> This is similar to Emacs bug#66752[1]. It would be nice if
> "(thing-at-point 'url)" would return the URL when point is over an Org
> link. With this, it's easier to write a function that copies (or browses
> to) the URL at point without coding so many special cases.
Actually, this code should probably be a bit more selective: is there a
good way to tell when an Org link is an absolute URL, as opposed to some
relative path or internal target?
Maybe we should check 'thing-at-point-uri-schemes'?
^ permalink raw reply [flat|nested] 18+ messages in thread
* Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2023-11-06 19:45 [PATCH] Add support for 'thing-at-point' to get URL at point Jim Porter
2023-11-06 19:56 ` Jim Porter
@ 2023-11-06 20:11 ` Ihor Radchenko
2023-11-06 20:53 ` Jim Porter
1 sibling, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2023-11-06 20:11 UTC (permalink / raw)
To: Jim Porter, emacs-devel; +Cc: emacs-orgmode
[ Branching to emacs-devel for further input from Emacs devs ]
Jim Porter <jporterbugs@gmail.com> writes:
> This is similar to Emacs bug#66752[1]. It would be nice if
> "(thing-at-point 'url)" would return the URL when point is over an Org
> link. With this, it's easier to write a function that copies (or browses
> to) the URL at point without coding so many special cases.
> ...
> +(defun org--url-at-point ()
> + "`thing-at-point' provider function."
> + (org-element-property :raw-link (org-element-context)))
Supporting thingatpt.el is certainly welcome. However, I have some
doubts about how mature thingatpt.el is.
In particular, I am concerned whether `thing-at-point-provider-alist' is
reliable enough in non-trivial scenarios like when given URL string is
not matching some generic URL regexp.
Looking into the source code of `bounds-of-thing-at-point', I see that
for standard "things" (like url),
`thing-at-point-bounds-of-url-at-point' is used unconditionally. In the
case of Org links, we may have something like [<point>[https://orgmode.org]]
that will not match default URL regexp as is. AFAIU, there is no
documented way to customize the behaviour of `bounds-of-thing-at-point'
and `forward-thing'.
I also have concerns about Org-specific part of the patch, but the above
is far more important, and we need to discuss it before starting to
consider anything for Org mode.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2023-11-06 20:11 ` Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point) Ihor Radchenko
@ 2023-11-06 20:53 ` Jim Porter
2024-02-05 15:07 ` Ihor Radchenko
0 siblings, 1 reply; 18+ messages in thread
From: Jim Porter @ 2023-11-06 20:53 UTC (permalink / raw)
To: Ihor Radchenko, emacs-devel; +Cc: emacs-orgmode
On 11/6/2023 12:11 PM, Ihor Radchenko wrote:
> [ Branching to emacs-devel for further input from Emacs devs ]
>
> Jim Porter <jporterbugs@gmail.com> writes:
>
>> This is similar to Emacs bug#66752[1]. It would be nice if
>> "(thing-at-point 'url)" would return the URL when point is over an Org
>> link. With this, it's easier to write a function that copies (or browses
>> to) the URL at point without coding so many special cases.
>> ...
>> +(defun org--url-at-point ()
>> + "`thing-at-point' provider function."
>> + (org-element-property :raw-link (org-element-context)))
>
> Supporting thingatpt.el is certainly welcome. However, I have some
> doubts about how mature thingatpt.el is.
>
> In particular, I am concerned whether `thing-at-point-provider-alist' is
> reliable enough in non-trivial scenarios like when given URL string is
> not matching some generic URL regexp.
The nice thing about 'thing-at-point-provider-alist' is that your
provider has absolute control over what to return, so Org's URL provider
could do whatever it wants. As far as I can tell, this code path
completely avoids calling 'bounds-of-thing-at-point' ('botap'). However,
it *would* call 'botap' if point wasn't on an Org link, since it would
fall back to the last condition in 'thing-at-point'. Still, this is what
happens today with no provider, so it's not really any worse than before...
Maybe it would make sense for 'thing-at-point' to have a "(catch
'not-found ...)" form around the loop over
'thing-at-point-provider-alist'. Then Org could definitively say,
"There's no URL at point, no matter what anyone else says".
> Looking into the source code of `bounds-of-thing-at-point', I see that
> for standard "things" (like url),
> `thing-at-point-bounds-of-url-at-point' is used unconditionally. In the
> case of Org links, we may have something like [<point>[https://orgmode.org]]
> that will not match default URL regexp as is. AFAIU, there is no
> documented way to customize the behaviour of `bounds-of-thing-at-point'
> and `forward-thing'.
I think it would make sense to add some sort of
'bounds-of-thing-at-point-provider-alist' (that's a mouthful!) that
would let modes override the behavior of 'botap', but I don't think
that's necessary for the narrower purpose of asking, "I want the value
of THING at point, if any."
> I also have concerns about Org-specific part of the patch, but the above
> is far more important, and we need to discuss it before starting to
> consider anything for Org mode.
For better or worse, I mostly modeled this patch on how EWW integrates
with thing-at-point, since that's the only place I saw in the Emacs tree
that did this already.
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2023-11-06 20:53 ` Jim Porter
@ 2024-02-05 15:07 ` Ihor Radchenko
2024-02-05 22:44 ` Jim Porter
0 siblings, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-02-05 15:07 UTC (permalink / raw)
To: Jim Porter; +Cc: emacs-devel, emacs-orgmode
Jim Porter <jporterbugs@gmail.com> writes:
>> Looking into the source code of `bounds-of-thing-at-point', I see that
>> for standard "things" (like url),
>> `thing-at-point-bounds-of-url-at-point' is used unconditionally. In the
>> case of Org links, we may have something like [<point>[https://orgmode.org]]
>> that will not match default URL regexp as is. AFAIU, there is no
>> documented way to customize the behaviour of `bounds-of-thing-at-point'
>> and `forward-thing'.
>
> I think it would make sense to add some sort of
> 'bounds-of-thing-at-point-provider-alist' (that's a mouthful!) that
> would let modes override the behavior of 'botap', but I don't think
> that's necessary for the narrower purpose of asking, "I want the value
> of THING at point, if any."
It would make sense to add a number of alists:
- bounds-of-thing-at-point-provider-alist
- same for 'forward-op, 'beginning-op, 'end-op.
After Emacs have those, we can add Org mode support.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-05 15:07 ` Ihor Radchenko
@ 2024-02-05 22:44 ` Jim Porter
2024-02-05 22:56 ` Ihor Radchenko
2024-04-12 12:41 ` Ihor Radchenko
0 siblings, 2 replies; 18+ messages in thread
From: Jim Porter @ 2024-02-05 22:44 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-devel, emacs-orgmode
On 2/5/2024 7:07 AM, Ihor Radchenko wrote:
> It would make sense to add a number of alists:
> - bounds-of-thing-at-point-provider-alist
> - same for 'forward-op, 'beginning-op, 'end-op.
>
> After Emacs have those, we can add Org mode support.
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).
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-05 22:44 ` Jim Porter
@ 2024-02-05 22:56 ` Ihor Radchenko
2024-02-06 12:26 ` Eli Zaretskii
2024-04-12 12:41 ` Ihor Radchenko
1 sibling, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-02-05 22:56 UTC (permalink / raw)
To: Jim Porter, stefankangas, Eli Zaretskii; +Cc: emacs-devel, emacs-orgmode
Jim Porter <jporterbugs@gmail.com> writes:
> On 2/5/2024 7:07 AM, Ihor Radchenko wrote:
>> It would make sense to add a number of alists:
>> - bounds-of-thing-at-point-provider-alist
>> - same for 'forward-op, 'beginning-op, 'end-op.
>>
>> After Emacs have those, we can add Org mode support.
>
> 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).
CCing Stefan and Eli.
Please, let us know if the above is something not wanted upstream.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-05 22:56 ` Ihor Radchenko
@ 2024-02-06 12:26 ` Eli Zaretskii
2024-02-06 12:38 ` Ihor Radchenko
0 siblings, 1 reply; 18+ messages in thread
From: Eli Zaretskii @ 2024-02-06 12:26 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: jporterbugs, stefankangas, emacs-devel, emacs-orgmode
> From: Ihor Radchenko <yantar92@posteo.net>
> Cc: emacs-devel@gnu.org, emacs-orgmode@gnu.org
> Date: Mon, 05 Feb 2024 22:56:05 +0000
>
> Jim Porter <jporterbugs@gmail.com> writes:
>
> > On 2/5/2024 7:07 AM, Ihor Radchenko wrote:
> >> It would make sense to add a number of alists:
> >> - bounds-of-thing-at-point-provider-alist
> >> - same for 'forward-op, 'beginning-op, 'end-op.
> >>
> >> After Emacs have those, we can add Org mode support.
> >
> > 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).
>
> CCing Stefan and Eli.
> Please, let us know if the above is something not wanted upstream.
I think we do want to allow extending of this, but doesn't
thingatpt.el already provide such capabilities? For example, I see
this in bounds-of-thing-at-point:
(defun bounds-of-thing-at-point (thing)
"Determine the start and end buffer locations for the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun', `number',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'.
See the file `thingatpt.el' for documentation on how to define a
valid THING.
Return a cons cell (START . END) giving the start and end
positions of the thing found."
(cond
((get thing 'bounds-of-thing-at-point) <<<<<<<<<<<<<<<<<<<<<<<<
(funcall (get thing 'bounds-of-thing-at-point)))
Doesn't this provide the extension capabilities you are looking for?
If not, why not?
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-06 12:26 ` Eli Zaretskii
@ 2024-02-06 12:38 ` Ihor Radchenko
2024-02-06 12:47 ` Eli Zaretskii
0 siblings, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-02-06 12:38 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jporterbugs, stefankangas, emacs-devel, emacs-orgmode
Eli Zaretskii <eliz@gnu.org> writes:
> I think we do want to allow extending of this, but doesn't
> thingatpt.el already provide such capabilities? For example, I see
> this in bounds-of-thing-at-point:
> ...
> (cond
> ((get thing 'bounds-of-thing-at-point) <<<<<<<<<<<<<<<<<<<<<<<<
> (funcall (get thing 'bounds-of-thing-at-point)))
>
> Doesn't this provide the extension capabilities you are looking for?
> If not, why not?
Unlike `thing-at-point-provider-alist', which can be buffer-local,
symbol property is always global and setting it would override other
thing providers.
Note how `thing-at-point' uses
(cond
((let ((alist thing-at-point-provider-alist)
elt result)
(while (and alist (null result))
(setq elt (car alist)
alist (cdr alist))
(and (eq (car elt) thing)
(setq result (funcall (cdr elt)))))
result))
((get thing 'thing-at-point)
(funcall (get thing 'thing-at-point)))
checking `thing-at-point-provider-alist' and only then falling back to
`get'. What I am proposing is to add the equivalent alists for other
operators used by thingatpt.el.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-06 12:38 ` Ihor Radchenko
@ 2024-02-06 12:47 ` Eli Zaretskii
0 siblings, 0 replies; 18+ messages in thread
From: Eli Zaretskii @ 2024-02-06 12:47 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: jporterbugs, stefankangas, emacs-devel, emacs-orgmode
> From: Ihor Radchenko <yantar92@posteo.net>
> Cc: jporterbugs@gmail.com, stefankangas@gmail.com, emacs-devel@gnu.org,
> emacs-orgmode@gnu.org
> Date: Tue, 06 Feb 2024 12:38:19 +0000
>
> Eli Zaretskii <eliz@gnu.org> writes:
>
> > I think we do want to allow extending of this, but doesn't
> > thingatpt.el already provide such capabilities? For example, I see
> > this in bounds-of-thing-at-point:
> > ...
> > (cond
> > ((get thing 'bounds-of-thing-at-point) <<<<<<<<<<<<<<<<<<<<<<<<
> > (funcall (get thing 'bounds-of-thing-at-point)))
> >
> > Doesn't this provide the extension capabilities you are looking for?
> > If not, why not?
>
> Unlike `thing-at-point-provider-alist', which can be buffer-local,
> symbol property is always global and setting it would override other
> thing providers.
>
> Note how `thing-at-point' uses
>
> (cond
> ((let ((alist thing-at-point-provider-alist)
> elt result)
> (while (and alist (null result))
> (setq elt (car alist)
> alist (cdr alist))
> (and (eq (car elt) thing)
> (setq result (funcall (cdr elt)))))
> result))
> ((get thing 'thing-at-point)
> (funcall (get thing 'thing-at-point)))
>
> checking `thing-at-point-provider-alist' and only then falling back to
> `get'. What I am proposing is to add the equivalent alists for other
> operators used by thingatpt.el.
I guess it's fine, then.
But we probably should have such alists in all the other thingatpt
methods as well.
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-02-05 22:44 ` Jim Porter
2024-02-05 22:56 ` Ihor Radchenko
@ 2024-04-12 12:41 ` Ihor Radchenko
2024-04-12 22:30 ` Jim Porter
1 sibling, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-04-12 12:41 UTC (permalink / raw)
To: Jim Porter; +Cc: emacs-devel, emacs-orgmode
Jim Porter <jporterbugs@gmail.com> writes:
> On 2/5/2024 7:07 AM, Ihor Radchenko wrote:
>> It would make sense to add a number of alists:
>> - bounds-of-thing-at-point-provider-alist
>> - same for 'forward-op, 'beginning-op, 'end-op.
>>
>> After Emacs have those, we can add Org mode support.
>
> 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?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-12 12:41 ` Ihor Radchenko
@ 2024-04-12 22:30 ` Jim Porter
2024-04-29 4:26 ` Jim Porter
0 siblings, 1 reply; 18+ messages in thread
From: Jim Porter @ 2024-04-12 22:30 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-devel, emacs-orgmode
On 4/12/2024 5:41 AM, Ihor Radchenko wrote:
> Jim Porter <jporterbugs@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.
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-12 22:30 ` Jim Porter
@ 2024-04-29 4:26 ` Jim Porter
2024-04-29 18:14 ` Ihor Radchenko
0 siblings, 1 reply; 18+ messages in thread
From: Jim Porter @ 2024-04-29 4:26 UTC (permalink / raw)
To: Ihor Radchenko, eliz; +Cc: emacs-devel, emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1231 bytes --]
On 4/12/2024 3:30 PM, Jim Porter wrote:
> On 4/12/2024 5:41 AM, Ihor Radchenko wrote:
>> Jim Porter <jporterbugs@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).
[-- Attachment #2: 0001-Allow-defining-custom-providers-for-more-thingatpt-f.patch --]
[-- Type: text/plain, Size: 6486 bytes --]
From a0ed62aa42fa47043511ba814cf5ce8419e9d03f Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@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
^ permalink raw reply related [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-29 4:26 ` Jim Porter
@ 2024-04-29 18:14 ` Ihor Radchenko
2024-04-30 4:42 ` Jim Porter
0 siblings, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-04-29 18:14 UTC (permalink / raw)
To: Jim Porter; +Cc: eliz, emacs-devel, emacs-orgmode
Jim Porter <jporterbugs@gmail.com> writes:
> 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).
Thanks!
I have a small comment on the docstring of
`forward-thing-provider-alist' - it refers to
`thing-at-point-provider-alist', but the provides here are called with
an argument N, unlike the providers in `thing-at-point-provider-alist'.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-29 18:14 ` Ihor Radchenko
@ 2024-04-30 4:42 ` Jim Porter
2024-04-30 11:39 ` Ihor Radchenko
0 siblings, 1 reply; 18+ messages in thread
From: Jim Porter @ 2024-04-30 4:42 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: eliz, emacs-devel, emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 633 bytes --]
On 4/29/2024 11:14 AM, Ihor Radchenko wrote:
> Thanks!
> I have a small comment on the docstring of
> `forward-thing-provider-alist' - it refers to
> `thing-at-point-provider-alist', but the provides here are called with
> an argument N, unlike the providers in `thing-at-point-provider-alist'.
Fixed.
I've also added some helper functions for 'forward-thing' and
'bounds-of-thing-at-point' when the "thing" is defined by a text
property, and then used those helper functions for EWW and
bug-reference-mode.
I've lightly tested this (and added a few automated regression tests),
but there could be some bugs lurking in here...
[-- Attachment #2: 0001-Allow-defining-custom-providers-for-more-thingatpt-f.patch --]
[-- Type: text/plain, Size: 12593 bytes --]
From ad8db930907cd760142fd6f035d97ce93ce8d850 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 28 Apr 2024 21:19:53 -0700
Subject: [PATCH] Allow defining custom providers for more "thingatpt"
functions
* lisp/thingatpt.el (forward-thing-provider-alist)
(bounds-of-thing-at-point-provider-alist): New variables...
(forward-thing, bounds-of-thing-at-point): ... use them.
(text-property-search-forward, text-property-search-backward)
(prop-match-beginning, prop-match-end): Declare.
(forward-thing-for-text-property)
(bounds-of-thing-at-point-for-text-property): New functions.
* lisp/net/eww.el (eww--bounds-of-url-at-point, eww--forward-url): New
functions...
(eww-mode): ... use them.
* lisp/progmodes/bug-reference.el
(bug-reference--bounds-of-url-at-point, bug-reference--forward-url): New
functions...
(bug-reference--init): ... 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 | 21 +++++++---
lisp/net/eww.el | 14 +++++++
lisp/progmodes/bug-reference.el | 22 +++++++++-
lisp/thingatpt.el | 71 ++++++++++++++++++++++++++++++---
test/lisp/thingatpt-tests.el | 36 +++++++++++++++++
5 files changed, 153 insertions(+), 11 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7efb4110bcd..394f75884c1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1591,19 +1591,30 @@ 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 and functions 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. In
+addition, "things" defined by a text property can use the new functions
+'bounds-of-thing-at-point-for-text-property' and
+'forward-thing-for-text-property' to help implement these providers.
---
*** '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/net/eww.el b/lisp/net/eww.el
index 39ea964d47a..adabd8d8d8b 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1321,6 +1321,12 @@ eww-mode
(setq-local thing-at-point-provider-alist
(append thing-at-point-provider-alist
'((url . eww--url-at-point))))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (append bounds-of-thing-at-point-provider-alist
+ '((url . eww--bounds-of-url-at-point))))
+ (setq-local forward-thing-provider-alist
+ (append forward-thing-provider-alist
+ '((url . eww--forward-url))))
(setq-local bookmark-make-record-function #'eww-bookmark-make-record)
(buffer-disable-undo)
(setq-local shr-url-transformer #'eww--transform-url)
@@ -1351,6 +1357,14 @@ eww--url-at-point
"`thing-at-point' provider function."
(get-text-property (point) 'shr-url))
+(defun eww--bounds-of-url-at-point ()
+ "`bounds-of-thing-at-point' provider function."
+ (bounds-of-thing-at-point-for-text-property 'shr-url))
+
+(defun eww--forward-url (n)
+ "`forward-thing' provider function."
+ (forward-thing-for-text-property 'shr-url n))
+
;;;###autoload
(defun eww-browse-url (url &optional new-window)
"Ask the EWW browser to load URL.
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 977a3d72cb7..bfc22fb10d2 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -660,17 +660,37 @@ bug-reference--url-at-point
"`thing-at-point' provider function."
(get-char-property (point) 'bug-reference-url))
+(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))
+
+(defun bug-reference--forward-url (n)
+ "`forward-thing' provider function."
+ (forward-thing-for-text-property 'bug-reference-url n))
+
(defun bug-reference--init (enable)
(if enable
(progn
(jit-lock-register #'bug-reference-fontify)
(setq-local thing-at-point-provider-alist
(append thing-at-point-provider-alist
- '((url . bug-reference--url-at-point)))))
+ '((url . bug-reference--url-at-point))))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (append bounds-of-thing-at-point-provider-alist
+ '((url . bug-reference--bounds-of-url-at-point))))
+ (setq-local forward-thing-provider-alist
+ (append forward-thing-provider-alist
+ '((url . bug-reference--forward-url)))))
(jit-lock-unregister #'bug-reference-fontify)
(setq thing-at-point-provider-alist
(delete '((url . bug-reference--url-at-point))
thing-at-point-provider-alist))
+ (setq bounds-of-thing-at-point-provider-alist
+ (delete '((url . bug-reference--bounds-of-url-at-point))
+ bounds-of-thing-at-point-provider-alist))
+ (setq forward-thing-provider-alist
+ (delete '((url . bug-reference--forward-url))
+ forward-thing-provider-alist))
(save-restriction
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 7896ad984df..dad71a4ca94 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -75,6 +75,27 @@ thing-at-point-provider-alist
`existing-filename', `url', `email', `uuid', `word', `sentence',
`whitespace', `line', `face' and `page'.")
+(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. 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.
+
+You can use this variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
+(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 variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
;; Basic movement
;;;###autoload
@@ -84,11 +105,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 +132,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.
@@ -775,4 +805,35 @@ list-at-point
(goto-char (or (nth 8 ppss) (point)))
(form-at-point 'list 'listp))))
+(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 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 bounds-of-thing-at-point-for-text-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."
+ (when (get-text-property (point) property)
+ (cons (or (previous-single-property-change
+ (min (1+ (point)) (point-max)) property)
+ (point-min))
+ (or (next-single-property-change (point) property)
+ (point-max)))))
+
;;; thingatpt.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index e50738f1122..26e20f58be7 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -258,4 +258,40 @@ 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 () (get-text-property (point) 'my-url)))))
+ (insert (propertize "hello" 'my-url "test"))
+ (goto-char (point-min))
+ (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)
+ (forward-thing-for-text-property 'my-url n)))))
+ (insert (propertize "foo" 'my-url "test") "bar")
+ (goto-char (point-min))
+ (should (eq (save-excursion (forward-thing 'url) (point)) 4))
+ (should (eq (save-excursion (forward-thing 'word) (point)) 7))))
+
+(ert-deftest bounds-of-thing-at-point-providers ()
+ (with-temp-buffer
+ (setq-local bounds-of-thing-at-point-provider-alist
+ `((url . ,(lambda ()
+ (bounds-of-thing-at-point-for-text-property
+ 'my-url)))))
+ (insert (propertize "foo" 'my-url "test") "bar")
+ (goto-char (point-min))
+ ;; Look for a "URL", using our provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(1 . 4)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 1))
+ (should (eq (save-excursion (end-of-thing 'url)) 4))
+ ;; Look for a word, which should *not* use our provider above.
+ (should (equal (bounds-of-thing-at-point 'word) '(1 . 7)))
+ (should (eq (save-excursion (beginning-of-thing 'word)) 1))
+ (should (eq (save-excursion (end-of-thing 'word)) 7))))
+
;;; thingatpt-tests.el ends here
--
2.25.1
^ permalink raw reply related [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-30 4:42 ` Jim Porter
@ 2024-04-30 11:39 ` Ihor Radchenko
2024-04-30 18:27 ` Jim Porter
0 siblings, 1 reply; 18+ messages in thread
From: Ihor Radchenko @ 2024-04-30 11:39 UTC (permalink / raw)
To: Jim Porter; +Cc: eliz, emacs-devel, emacs-orgmode
Jim Porter <jporterbugs@gmail.com> writes:
> + (setq-local bounds-of-thing-at-point-provider-alist
> + (append bounds-of-thing-at-point-provider-alist
> + '((url . eww--bounds-of-url-at-point))))
> + (setq-local forward-thing-provider-alist
> + (append forward-thing-provider-alist
> + '((url . eww--forward-url))))
> ...
What happens if you have multiple providers for an URL?
You add the provider to the end, so it will have the lower priority in
this scenario. I guess that you want the opposite - EWW provider to take
precedence. Same for other changes.
> +(ert-deftest thing-at-point-providers ()
> ...
> +(ert-deftest forward-thing-providers ()
> ...
> +(ert-deftest bounds-of-thing-at-point-providers ()
> + (with-temp-buffer
> + (setq-local bounds-of-thing-at-point-provider-alist
> + `((url . ,(lambda ()
> + (bounds-of-thing-at-point-for-text-property
> + 'my-url)))))
It would make sense to add tests for "first wins" behaviour.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 18+ messages in thread
* Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-30 11:39 ` Ihor Radchenko
@ 2024-04-30 18:27 ` Jim Porter
2024-04-30 21:10 ` [External] : " Drew Adams
0 siblings, 1 reply; 18+ messages in thread
From: Jim Porter @ 2024-04-30 18:27 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: eliz, emacs-devel, emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 847 bytes --]
On 4/30/2024 4:39 AM, Ihor Radchenko wrote:
> What happens if you have multiple providers for an URL?
> You add the provider to the end, so it will have the lower priority in
> this scenario. I guess that you want the opposite - EWW provider to take
> precedence. Same for other changes.
That's probably reasonable. I was just keeping things the way they were
historically here, but we might as well fix this now.
> It would make sense to add tests for "first wins" behaviour.
Done.
I've also fixed a bug in EWW and bug-reference-mode where it would
return nil for (thing-at-point 'url) if point was at the *end* of a URL.
It's now consistent with how 'thing-at-point' works by default. (If you
have two consecutive URLs and point is between them - only possible with
the custom provider function, I think - it'll prefer the second one.)
[-- Attachment #2: 0001-Allow-defining-custom-providers-for-more-thingatpt-f.patch --]
[-- Type: text/plain, Size: 14978 bytes --]
From da26f0160c955f15e123e5b28cf8a9f514395e21 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 28 Apr 2024 21:19:53 -0700
Subject: [PATCH] Allow defining custom providers for more "thingatpt"
functions
This also fixes an issue in EWW and bug-reference-mode where
(thing-at-point 'url) at the end of a URL would return nil.
* lisp/thingatpt.el (forward-thing-provider-alist)
(bounds-of-thing-at-point-provider-alist): New variables...
(forward-thing, bounds-of-thing-at-point): ... use them.
(text-property-search-forward, text-property-search-backward)
(prop-match-beginning, prop-match-end): Declare.
(thing-at-point-for-text-property, forward-thing-for-text-property)
(bounds-of-thing-at-point-for-text-property): New functions.
* lisp/net/eww.el (eww--url-at-point): Use
'thing-at-point-for-text-property'.
(eww--bounds-of-url-at-point, eww--forward-url): New functions...
(eww-mode): ... use them.
* lisp/progmodes/bug-reference.el (bug-reference--url-at-point): Use
'thing-at-point-for-text-property'.
(bug-reference--bounds-of-url-at-point, bug-reference--forward-url): New
functions...
(bug-reference--init): ... 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 | 25 ++++++++--
lisp/net/eww.el | 21 +++++++--
lisp/progmodes/bug-reference.el | 26 +++++++++--
lisp/thingatpt.el | 83 +++++++++++++++++++++++++++++++--
test/lisp/thingatpt-tests.el | 59 +++++++++++++++++++++++
5 files changed, 198 insertions(+), 16 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 7efb4110bcd..061161bb2fd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1591,19 +1591,34 @@ of the currently existing keyboards macros using the new mode
duplicating them, deleting them, and editing their counters, formats,
and keys.
-** Miscellaneous
+** Thingatpt
---
-*** 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.
+
+---
+*** 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
+thingatpt providers for "things" that are defined by a text property.
---
*** '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/net/eww.el b/lisp/net/eww.el
index 39ea964d47a..b3997786d9e 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1318,9 +1318,16 @@ eww-mode
;; desktop support
(setq-local desktop-save-buffer #'eww-desktop-misc-data)
(setq truncate-lines t)
+ ;; thingatpt support
(setq-local thing-at-point-provider-alist
- (append thing-at-point-provider-alist
- '((url . eww--url-at-point))))
+ (cons '(url . eww--url-at-point)
+ thing-at-point-provider-alist))
+ (setq-local forward-thing-provider-alist
+ (cons '(url . eww--forward-url)
+ forward-thing-provider-alist))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (cons '(url . eww--bounds-of-url-at-point)
+ bounds-of-thing-at-point-provider-alist))
(setq-local bookmark-make-record-function #'eww-bookmark-make-record)
(buffer-disable-undo)
(setq-local shr-url-transformer #'eww--transform-url)
@@ -1349,7 +1356,15 @@ eww--rescale-images
(defun eww--url-at-point ()
"`thing-at-point' provider function."
- (get-text-property (point) 'shr-url))
+ (thing-at-point-for-text-property 'shr-url))
+
+(defun eww--forward-url (n)
+ "`forward-thing' provider function."
+ (forward-thing-for-text-property 'shr-url n))
+
+(defun eww--bounds-of-url-at-point ()
+ "`bounds-of-thing-at-point' provider function."
+ (bounds-of-thing-at-point-for-text-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 977a3d72cb7..be162cf9e11 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -658,19 +658,39 @@ bug-reference--run-auto-setup
(defun bug-reference--url-at-point ()
"`thing-at-point' provider function."
- (get-char-property (point) 'bug-reference-url))
+ (thing-at-point-for-text-property 'bug-reference-url))
+
+(defun bug-reference--forward-url (n)
+ "`forward-thing' provider function."
+ (forward-thing-for-text-property 'bug-reference-url n))
+
+(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))
(defun bug-reference--init (enable)
(if enable
(progn
(jit-lock-register #'bug-reference-fontify)
(setq-local thing-at-point-provider-alist
- (append thing-at-point-provider-alist
- '((url . bug-reference--url-at-point)))))
+ (cons '(url . bug-reference--url-at-point)
+ thing-at-point-provider-alist))
+ (setq-local forward-thing-provider-alist
+ (cons '(url . bug-reference--forward-url)
+ forward-thing-provider-alist))
+ (setq-local bounds-of-thing-at-point-provider-alist
+ (cons '(url . bug-reference--bounds-of-url-at-point)
+ bounds-of-thing-at-point-provider-alist)))
(jit-lock-unregister #'bug-reference-fontify)
(setq thing-at-point-provider-alist
(delete '((url . bug-reference--url-at-point))
thing-at-point-provider-alist))
+ (setq forward-thing-provider-alist
+ (delete '((url . bug-reference--forward-url))
+ forward-thing-provider-alist))
+ (setq bounds-of-thing-at-point-provider-alist
+ (delete '((url . bug-reference--bounds-of-url-at-point))
+ bounds-of-thing-at-point-provider-alist))
(save-restriction
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 7896ad984df..825f49cfab7 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -75,6 +75,27 @@ thing-at-point-provider-alist
`existing-filename', `url', `email', `uuid', `word', `sentence',
`whitespace', `line', `face' and `page'.")
+(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. 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.
+
+You can use this variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
+(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 variable in much the same way as
+`thing-at-point-provider-alist' (which see).")
+
;; Basic movement
;;;###autoload
@@ -84,11 +105,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 +132,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.
@@ -775,4 +805,47 @@ list-at-point
(goto-char (or (nth 8 ppss) (point)))
(form-at-point 'list 'listp))))
+;; Provider helper functions
+
+(defun thing-at-point-for-text-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)
+ (and (> (point) (point-min))
+ (get-text-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 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 bounds-of-thing-at-point-for-text-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."
+ (let ((pos (point)))
+ (when (or (get-text-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))))))
+
;;; thingatpt.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index e50738f1122..88a4bc8a27d 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -258,4 +258,63 @@ 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 () (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"))
+ (goto-char (point-min))
+ ;; Get the URL using the first provider.
+ (should (equal (thing-at-point 'url) "foo.com"))
+ (should (equal (thing-at-point 'word) "hello"))
+ (goto-char (point-max))
+ ;; Get the URL using the second provider.
+ (should (equal (thing-at-point 'url) "bar.com"))))
+
+(ert-deftest forward-thing-providers ()
+ (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"))
+ (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.
+ (should (= (point) 11))))
+
+(ert-deftest bounds-of-thing-at-point-providers ()
+ (with-temp-buffer
+ (setq-local
+ bounds-of-thing-at-point-provider-alist
+ `((url . ,(lambda ()
+ (bounds-of-thing-at-point-for-text-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"))
+ (goto-char (point-min))
+ ;; Look for a URL, using the first provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(1 . 6)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 1))
+ (should (eq (save-excursion (end-of-thing 'url)) 6))
+ ;; Look for a word, which should *not* use our provider above.
+ (should (equal (bounds-of-thing-at-point 'word) '(1 . 11)))
+ (should (eq (save-excursion (beginning-of-thing 'word)) 1))
+ (should (eq (save-excursion (end-of-thing 'word)) 11))
+ (goto-char (point-max))
+ ;; Look for a URL, using the second provider above.
+ (should (equal (bounds-of-thing-at-point 'url) '(12 . 19)))
+ (should (eq (save-excursion (beginning-of-thing 'url)) 12))
+ (should (eq (save-excursion (end-of-thing 'url)) 19))))
+
;;; thingatpt-tests.el ends here
--
2.25.1
^ permalink raw reply related [flat|nested] 18+ messages in thread
* RE: [External] : Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)
2024-04-30 18:27 ` Jim Porter
@ 2024-04-30 21:10 ` Drew Adams
0 siblings, 0 replies; 18+ messages in thread
From: Drew Adams @ 2024-04-30 21:10 UTC (permalink / raw)
To: Jim Porter, Ihor Radchenko
Cc: eliz@gnu.org, emacs-devel@gnu.org, emacs-orgmode@gnu.org
> I've also fixed a bug in EWW and bug-reference-mode
> where it would return nil for (thing-at-point 'url)
> if point was at the *end* of a URL.
By "at the end" I assume you really mean just
_after_ a URL, i.e., no longer on/at the URL.
FWIW, that's actually _superior_ behavior.
Unfortunately however, Emacs has chosen the
behavior you describe here:
> It's now consistent with how 'thing-at-point'
> works by default.
> (If you have two consecutive URLs and point
> is between them...it'll prefer the second one.)
Which is better! It's what "at point" means.
(Yes, technically point is between the chars.)
And with a block cursor the cursor is on the
second thing, not the first.
And `C-x =' describes the current "cursor
position" (aka point), and it describes - wait
for it - not the char before point but the char
after point, IOW, colloquially the char at point.
And `forward-sexp', `forward-word', `forward-thing',
etc. advance just _past_ the thing. The cursor
is then _not_ on the thing, and unless the thing
is immediately followed by another thing, there's
_no_ thing at point.
Unfortunately, Emacs maintainers decided that
thingatpt.el isn't useful for anything except
obtaining something to use as a default value for
user input. The opinion was that no one ever
wants/needs to get nil, telling them that there's
no thing at point. Better, they think, to always
try to get a thing at point OR at (1- point).
This awful Emacs behavior defeats the successive
use of functions that do something with the next
thing at point, in precisely the case you cited:
when the next thing butts up against the previous
thing.
In particular, these important use cases are
defeated by the behavior chosen for Emacs:
1. To find out _whether there is_, in fact,
a THING at point. AT POINT - not point OR
(point - 1).
2. IF there really is a THING at point, to
return it (or its bounds).
See bug #9300, " `bounds-of-thing-at-point'
does not return nil when just after THING".
___
Library thingatpt+.el fixes this, providing
more useful behavior for thing-at-point, and
making more use cases possible.
It also provides functions for picking up a
thing that's _near_ point (where "near" can
be specified).
That's what Emacs _should_ do for the only
use case it even cares about, which is trying
to get a thing for use as a default value for
input. Getting a thing near point is quite
different from getting a thing _at point_.
___
https://www.emacswiki.org/emacs/download/thingatpt%2b.el
^ permalink raw reply [flat|nested] 18+ messages in thread
end of thread, other threads:[~2024-04-30 21:11 UTC | newest]
Thread overview: 18+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-06 19:45 [PATCH] Add support for 'thing-at-point' to get URL at point Jim Porter
2023-11-06 19:56 ` Jim Porter
2023-11-06 20:11 ` Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point) Ihor Radchenko
2023-11-06 20:53 ` Jim Porter
2024-02-05 15:07 ` Ihor Radchenko
2024-02-05 22:44 ` Jim Porter
2024-02-05 22:56 ` Ihor Radchenko
2024-02-06 12:26 ` Eli Zaretskii
2024-02-06 12:38 ` Ihor Radchenko
2024-02-06 12:47 ` Eli Zaretskii
2024-04-12 12:41 ` Ihor Radchenko
2024-04-12 22:30 ` Jim Porter
2024-04-29 4:26 ` Jim Porter
2024-04-29 18:14 ` Ihor Radchenko
2024-04-30 4:42 ` Jim Porter
2024-04-30 11:39 ` Ihor Radchenko
2024-04-30 18:27 ` Jim Porter
2024-04-30 21:10 ` [External] : " Drew Adams
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).