Re: Adding custom providers for thingatpt.el (was: [PATCH] Add support for 'thing-at-point' to get URL at point)

[Jim Porter <jporterbugs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 322 bytes --]

On 5/25/2024 7:09 AM, Ihor Radchenko wrote:
> Ok. Now, may you also add NEWS entry?

See attached. I made my best guess on what subsection of NEWS to use 
("New functions and changes in function arguments"), but maybe that's 
not quite right. It didn't seem to fit in any of the other sections very 
well either, though...

[-- Attachment #2: 0001-Add-support-for-thing-at-point-to-get-URL-at-point.patch --]
[-- Type: text/plain, Size: 3769 bytes --]

From 17b2bae16a5e07f09599b521563536037daa0f8c 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--link-at-point, org--bounds-of-link-at-point): New functions...
(org-mode): ... add to 'thing-at-point-provider-alist' and friends.

* testing/lisp/test-org.el (test-org/thing-at-point/url): New test.

* etc/ORG-NEWS: Announce this change.
---
 etc/ORG-NEWS             |  5 +++++
 lisp/org.el              | 25 +++++++++++++++++++++++++
 testing/lisp/test-org.el | 13 +++++++++++++
 3 files changed, 43 insertions(+)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index e2bbe3e0e..d5d891ba0 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -1474,6 +1474,11 @@ optional argument =NEW-HEADING-CONTAINER= specifies where in the
 buffer it will be added.  If not specified, new headings are created
 at level 1 at the end of the accessible part of the buffer, as before.
 
+*** Org links now support ~thing-at-point~
+
+You can now retrieve the destination of a link by calling
+~(thing-at-point 'url)~.
+
 ** Miscellaneous
 *** Add completion for links to man pages
 
diff --git a/lisp/org.el b/lisp/org.el
index ed18565bd..656f628ba 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)
@@ -5041,6 +5042,19 @@ 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
+              (cons '(url . org--link-at-point)
+                    thing-at-point-provider-alist))
+  (when (boundp 'forward-thing-provider-alist)
+    (setq-local forward-thing-provider-alist
+                (cons '(url . org-next-link)
+                      forward-thing-provider-alist)))
+  (when (boundp 'bounds-of-thing-at-point-provider-alist)
+    (setq-local bounds-of-thing-at-point-provider-alist
+                (cons '(url . org--bounds-of-link-at-point)
+                      bounds-of-thing-at-point-provider-alist)))
+
   ;; If empty file that did not turn on Org mode automatically, make
   ;; it to.
   (when (and org-insert-mode-line-in-empty-file
@@ -8753,6 +8767,17 @@ there is one, return it."
 	   (setq link (nth (1- nth) links)))))
        (cons link end)))))
 
+(defun org--link-at-point ()
+  "`thing-at-point' provider function."
+  (org-element-property :raw-link (org-element-context)))
+
+(defun org--bounds-of-link-at-point ()
+  "`bounds-of-thing-at-point' provider function."
+  (let ((context (org-element-context)))
+    (when (eq (org-element-type context) 'link)
+      (cons (org-element-begin context)
+            (org-element-end 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 072d405bd..519b96647 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3630,6 +3630,19 @@ 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."
+  (org-test-with-temp-text
+      "[[https://www.gnu.org/software/emacs/][GNU Emacs]]"
+    (should (string= (thing-at-point 'url)
+                     "https://www.gnu.org/software/emacs/"))
+    (when (boundp 'bounds-of-thing-at-point-provider-alist)
+      (should (equal (bounds-of-thing-at-point 'url)
+                     '(1 . 51))))))
+
 \f
 ;;; Node Properties
 
-- 
2.25.1