From 259edd435e0c02c3c906e8b34e7ece37724ccf11 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 23 Jan 2021 20:38:54 +0100
Subject: [PATCH] Add a mechanism for buffer-local thing-at-points

* doc/lispref/text.texi (Buffer Contents): Document it.

* lisp/thingatpt.el (thing-at-point-provider-alist): New variable.
(thing-at-point): Use it.
---
 doc/lispref/text.texi | 19 +++++++++++++++++++
 etc/NEWS              |  6 ++++++
 lisp/thingatpt.el     | 35 ++++++++++++++++++++++++++++++++---
 3 files changed, 57 insertions(+), 3 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 35bc6f9f161..14854a5aafa 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -334,6 +334,25 @@ but there is no peace.
 (thing-at-point 'whitespace)
      @result{} nil
 @end example
+
+@defvar thing-at-point-provider-alist
+This variable allows users and modes to tweak how
+@code{thing-at-point} works.  It's an association list of @var{thing}s
+and functions (called with zero parameters) to return that thing.
+Entries for @var{thing} will be evaluated in turn until a
+non-@code{nil} result is returned.
+
+For instance, a major mode could say:
+
+@lisp
+(setq-local thing-at-point-provider-alist
+            (append thing-at-point-provider-alist
+                    '((url . my-mode--url-at-point))))
+@end lisp
+
+If no providers have a non-@code{nil} return, the @var{thing} will be
+computed the standard way.
+@end defvar
 @end defun
 
 @node Comparing Text
diff --git a/etc/NEWS b/etc/NEWS
index 357c75b7e96..6a80493e239 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1564,6 +1564,12 @@ that makes it a valid button.
 
 *** New macro `named-let` that provides Scheme's "named let" looping construct
 
+** thingatpt
+
++++
+*** New variable 'thing-at-point-provider-alist'.
+This allows mode-specific alterations to how `thing-at-point' works.
+
 ** Miscellaneous
 
 ---
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 67d4092d407..c52fcfcc051 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -52,8 +52,30 @@
 
 ;;; Code:
 
+(require 'cl-lib)
 (provide 'thingatpt)
 
+(defvar thing-at-point-provider-alist nil
+  "Alist of providers for returning a \"thing\" at point.
+This variable can be set globally, or appended to buffer-locally
+by modes, to provide functions that will return a \"thing\" at
+point.  The first provider for the \"thing\" that returns a
+non-nil value wins.
+
+For instance, a major mode could say:
+
+\(setq-local thing-at-point-provider-alist
+            (append thing-at-point-provider-alist
+                    \\='((url . my-mode--url-at-point))))
+
+to provide a way to get an `url' at point in that mode.  The
+provider functions are called with no parameters at the point in
+question.
+
+\"things\" include `symbol', `list', `sexp', `defun', `filename',
+`url', `email', `uuid', `word', `sentence', `whitespace', `line',
+and `page'.")
+
 ;; Basic movement
 
 ;;;###autoload
@@ -143,11 +165,18 @@ strip text properties from the return value.
 See the file `thingatpt.el' for documentation on how to define
 a symbol as a valid THING."
   (let ((text
-         (if (get thing 'thing-at-point)
-             (funcall (get thing 'thing-at-point))
+         (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)))))))
+               (buffer-substring (car bounds) (cdr bounds))))))))
     (when (and text no-properties (sequencep text))
       (set-text-properties 0 (length text) nil text))
     text))
-- 
2.39.2