mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
Support text overlays for thingatpt provider helpers
* lisp/thingatpt.el (thing-at-point-for-text-property) (forward-thing-for-text-property) (bounds-of-thing-at-point-for-text-property): Rename to... (thing-at-point-for-char-property) (forward-thing-for-char-property) (bounds-of-thing-at-point-for-char-property): ... and add overlay support. Update callers. * test/lisp/thingatpt-tests.el (thing-at-point-providers) (forward-thing-providers, bounds-of-thing-at-point-providers): Test overlays too. * test/lisp/progmodes/bug-reference-tests.el (test-thing-at-point): Test 'bounds-of-thing-at-point' and 'forward-point'. * etc/NEWS: Update function names in announcement.
This commit is contained in:
parent
f6c60f16a2
commit
77ece5709a
6
etc/NEWS
6
etc/NEWS
@ -1745,9 +1745,9 @@ 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
|
||||
The new helper functions 'thing-at-point-for-char-property',
|
||||
'bounds-of-thing-at-point-for-char-property', and
|
||||
'forward-thing-for-char-property' can help to help implement custom
|
||||
thingatpt providers for "things" that are defined by a text property.
|
||||
|
||||
---
|
||||
|
@ -1380,15 +1380,15 @@ within text input fields."
|
||||
|
||||
(defun eww--url-at-point ()
|
||||
"`thing-at-point' provider function."
|
||||
(thing-at-point-for-text-property 'shr-url))
|
||||
(thing-at-point-for-char-property 'shr-url))
|
||||
|
||||
(defun eww--forward-url (backward)
|
||||
"`forward-thing' provider function."
|
||||
(forward-thing-for-text-property 'shr-url backward))
|
||||
(forward-thing-for-char-property 'shr-url backward))
|
||||
|
||||
(defun eww--bounds-of-url-at-point ()
|
||||
"`bounds-of-thing-at-point' provider function."
|
||||
(bounds-of-thing-at-point-for-text-property 'shr-url))
|
||||
(bounds-of-thing-at-point-for-char-property 'shr-url))
|
||||
|
||||
;;;###autoload
|
||||
(defun eww-browse-url (url &optional new-window)
|
||||
|
@ -658,15 +658,15 @@ have been run, the auto-setup is inhibited.")
|
||||
|
||||
(defun bug-reference--url-at-point ()
|
||||
"`thing-at-point' provider function."
|
||||
(thing-at-point-for-text-property 'bug-reference-url))
|
||||
(thing-at-point-for-char-property 'bug-reference-url))
|
||||
|
||||
(defun bug-reference--forward-url (backward)
|
||||
"`forward-thing' provider function."
|
||||
(forward-thing-for-text-property 'bug-reference-url backward))
|
||||
(forward-thing-for-char-property 'bug-reference-url backward))
|
||||
|
||||
(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))
|
||||
(bounds-of-thing-at-point-for-char-property 'bug-reference-url))
|
||||
|
||||
(defun bug-reference--init (enable)
|
||||
(if enable
|
||||
|
@ -828,40 +828,48 @@ treated as white space."
|
||||
|
||||
;; Provider helper functions
|
||||
|
||||
(defun thing-at-point-for-text-property (property)
|
||||
(defun thing-at-point-for-char-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)
|
||||
Each \"thing\" is a region of text with the specified text PROPERTY (or
|
||||
overlay) set."
|
||||
(or (get-char-property (point) property)
|
||||
(and (> (point) (point-min))
|
||||
(get-text-property (1- (point)) property))))
|
||||
(get-char-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 &optional backward)
|
||||
(defun forward-thing-for-char-property (property &optional backward)
|
||||
"Move forward to the end of the next \"thing\".
|
||||
If BACKWARD is non-nil, move backward to the beginning of the previous
|
||||
\"thing\" instead. Each \"thing\" is a region of text with the
|
||||
specified text PROPERTY set."
|
||||
(let ((search-func (if backward #'text-property-search-backward
|
||||
#'text-property-search-forward))
|
||||
(pos-func (if backward #'prop-match-beginning #'prop-match-end)))
|
||||
(when-let ((match (funcall search-func property)))
|
||||
(goto-char (funcall pos-func match)))))
|
||||
specified text PROPERTY (or overlay) set."
|
||||
(let ((bounds (bounds-of-thing-at-point-for-char-property property)))
|
||||
(if backward
|
||||
(if (and bounds (> (point) (car bounds)))
|
||||
(goto-char (car bounds))
|
||||
(goto-char (previous-single-char-property-change (point) property))
|
||||
(unless (get-char-property (point) property)
|
||||
(goto-char (previous-single-char-property-change
|
||||
(point) property))))
|
||||
(if (and bounds (< (point) (cdr bounds)))
|
||||
(goto-char (cdr bounds))
|
||||
(unless (get-char-property (point) property)
|
||||
(goto-char (next-single-char-property-change (point) property)))
|
||||
(goto-char (next-single-char-property-change (point) property))))))
|
||||
|
||||
(defun bounds-of-thing-at-point-for-text-property (property)
|
||||
(defun bounds-of-thing-at-point-for-char-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."
|
||||
The \"thing\" is a region of text with the specified text PROPERTY (or
|
||||
overlay) set."
|
||||
(let ((pos (point)))
|
||||
(when (or (get-text-property pos property)
|
||||
(when (or (get-char-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))))))
|
||||
(get-char-property (setq pos (1- pos)) property)))
|
||||
(cons (previous-single-char-property-change
|
||||
(min (1+ pos) (point-max)) property)
|
||||
(next-single-char-property-change pos property)))))
|
||||
|
||||
;;; thingatpt.el ends here
|
||||
|
@ -136,8 +136,11 @@
|
||||
(goto-char (point-min))
|
||||
;; Make sure we get the URL when `bug-reference-mode' is active...
|
||||
(should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234"))
|
||||
(should (equal (bounds-of-thing-at-point 'url) '(1 . 9)))
|
||||
(should (= (save-excursion (forward-thing 'url) (point)) 9))
|
||||
(bug-reference-mode -1)
|
||||
;; ... and get nil when `bug-reference-mode' is inactive.
|
||||
(should-not (thing-at-point 'url))))
|
||||
(should-not (thing-at-point 'url))
|
||||
(should-not (bounds-of-thing-at-point 'url))))
|
||||
|
||||
;;; bug-reference-tests.el ends here
|
||||
|
@ -262,10 +262,10 @@ position to retrieve THING.")
|
||||
(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"))
|
||||
`((url . ,(lambda () (thing-at-point-for-char-property 'foo-url)))
|
||||
(url . ,(lambda () (thing-at-point-for-char-property 'bar-url)))))
|
||||
(insert (propertize "hello" 'foo-url "foo.com") "\ngoodbye")
|
||||
(overlay-put (make-overlay 7 14) 'bar-url "bar.com")
|
||||
(goto-char (point-min))
|
||||
;; Get the URL using the first provider.
|
||||
(should (equal (thing-at-point 'url) "foo.com"))
|
||||
@ -280,10 +280,10 @@ position to retrieve THING.")
|
||||
(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"))
|
||||
`((url . ,(lambda (n) (forward-thing-for-char-property 'foo-url n)))
|
||||
(url . ,(lambda (n) (forward-thing-for-char-property 'bar-url n)))))
|
||||
(insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
|
||||
(overlay-put (make-overlay 12 19) 'bar-url "bar.com")
|
||||
(goto-char (point-min))
|
||||
(forward-thing 'url) ; Move past the first URL.
|
||||
(should (= (point) 6))
|
||||
@ -301,11 +301,11 @@ position to retrieve THING.")
|
||||
(setq-local
|
||||
bounds-of-thing-at-point-provider-alist
|
||||
`((url . ,(lambda ()
|
||||
(bounds-of-thing-at-point-for-text-property 'foo-url)))
|
||||
(bounds-of-thing-at-point-for-char-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"))
|
||||
(bounds-of-thing-at-point-for-char-property 'bar-url)))))
|
||||
(insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
|
||||
(overlay-put (make-overlay 12 19) '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)))
|
||||
@ -325,11 +325,11 @@ position to retrieve THING.")
|
||||
(with-temp-buffer
|
||||
(setq-local
|
||||
thing-at-point-provider-alist
|
||||
`((url . ,(lambda () (thing-at-point-for-text-property 'url))))
|
||||
`((url . ,(lambda () (thing-at-point-for-char-property 'url))))
|
||||
forward-thing-provider-alist
|
||||
`((url . ,(lambda (n) (forward-thing-for-text-property 'url n))))
|
||||
`((url . ,(lambda (n) (forward-thing-for-char-property 'url n))))
|
||||
bounds-of-thing-at-point-provider-alist
|
||||
`((url . ,(lambda () (bounds-of-thing-at-point-for-text-property 'url)))))
|
||||
`((url . ,(lambda () (bounds-of-thing-at-point-for-char-property 'url)))))
|
||||
(insert (propertize "one" 'url "foo.com")
|
||||
(propertize "two" 'url "bar.com")
|
||||
(propertize "three" 'url "baz.com"))
|
||||
|
Loading…
Reference in New Issue
Block a user