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.
This commit is contained in:
Lars Ingebrigtsen 2021-01-23 20:38:54 +01:00
parent 7c9841b842
commit 259edd435e
3 changed files with 57 additions and 3 deletions

View file

@ -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

View file

@ -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
---

View file

@ -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))