Commit 6f572972 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Add `text-property-search-forward' and `-backward'

* doc/lispref/text.texi (Property Search): Document
`text-property-search-forward' and `text-property-search-backward'.

* lisp/emacs-lisp/text-property-search.el: New file.
parent c969fbd4
......@@ -3180,6 +3180,95 @@ buffer to scan. Positions are relative to @var{object}. The default
for @var{object} is the current buffer.
@end defun
@defun text-property-search-forward prop &optional value predicate not-current
Search for the next region that has text property @var{prop} set to
@var{value} according to @var{predicate}.
This function is modelled after @code{search-forward} and friends in
that it moves point, but it returns a structure that describes the
match instead of returning it in @code{match-beginning} and friends.
If the text property can't be found, the function returns @code{nil}.
If it's found, point is placed at the end of the region that has this
text property match, and a @code{prop-match} structure is returned.
@var{predicate} can either be @code{t} (which is a synonym for
@code{equal}), @code{nil} (which means ``not equal''), or a predicate
that will be called with two parameters: The first is @var{value}, and
the second is the value of the text property we're inspecting.
If @var{not-current}, if point is in a region where we have a match,
then skip past that and find the next instance instead.
The @code{prop-match} structure has the following accessors:
@code{prop-match-beginning} (the start of the match),
@code{prop-match-end} (the end of the match), and
@code{prop-match-value} (the value of @var{property} at the start of
the match).
In the examples below, imagine that you're in a buffer that looks like
this:
@example
This is a bold and here's bolditalic and this is the end.
@end example
That is, the ``bold'' words are the @code{bold} face, and the
``italic'' word is in the @code{italic} face.
With point at the start:
@lisp
(while (setq match (text-property-search-forward 'face 'bold t))
(push (buffer-substring (prop-match-beginning match)
(prop-match-end match))
words))
@end lisp
This will pick out all the words that use the @code{bold} face.
@lisp
(while (setq match (text-property-search-forward 'face nil t))
(push (buffer-substring (prop-match-beginning match)
(prop-match-end match))
words))
@end lisp
This will pick out all the bits that have no face properties, which
will result in the list @samp{("This is a " "and here's " "and this is
the end")} (only reversed, since we used @code{push}).
@lisp
(while (setq match (text-property-search-forward 'face nil nil))
(push (buffer-substring (prop-match-beginning match)
(prop-match-end match))
words))
@end lisp
This will pick out all the regions where @code{face} is set to
something, but this is split up into where the properties change, so
the result here will be @samp{("bold" "bold" "italic")}.
For a more realistic example where you might use this, consider that
you have a buffer where certain sections represent URLs, and these are
tagged with @code{shr-url}.
@lisp
(while (setq match (text-property-search-forward 'shr-url nil nil))
(push (prop-match-value match) urls))
@end lisp
This will give you a list of all those URLs.
@end defun
@defun text-property-search-backward prop &optional value predicate not-current
This is just like @code{text-property-search-backward}, but searches
backward instead. Point is placed at the beginning of the matched
region instead of the end, though.
@end defun
@node Special Properties
@subsection Properties with Special Meanings
......
......@@ -164,6 +164,11 @@ non-text modes.
'write-abbrev-file' now writes special properties like ':case-fixed'
for abbrevs that have them.
+++
** The new functions and commands `text-property-search-forward' and
`text-property-search-backward' have been added. These provide an
interface that's more like functions like @code{search-forward}.
* Changes in Specialized Modes and Packages in Emacs 27.1
......
;;; text-property-search.el --- search for text properties -*- lexical-binding:t -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl-lib))
(cl-defstruct (prop-match)
beginning end value)
(defun text-property-search-forward (property &optional value predicate
not-immediate)
"Search for the next region that has text property PROPERTY set to VALUE.
If not found, the return value is nil. If found, point will be
placed at the end of the region and an object describing the
match is returned.
PREDICATE is called with two values. The first is the VALUE
parameter. The second is the value of PROPERTY. This predicate
should return non-nil if there is a match.
Some convenience values for PREDICATE can also be used. `t'
means the same as `equal'. `nil' means almost the same as \"not
equal\", but will also end the match if the value of PROPERTY
changes. See the manual for extensive examples.
If `not-immediate', if the match is under point, it will not be
returned, but instead the next instance is returned, if any.
The return value (if a match is made) is a `prop-match'
structure. The accessor avaliable are
`prop-match-beginning'/`prop-match-end' (which are the region in
the buffer that's matching, and `prop-match-value', which is the
value of PROPERTY at the start of the region."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
(when (> (length string) 0)
(intern string obarray)))))
;; We're standing in the property we're looking for, so find the
;; end.
(if (and (text-property--match-p value (get-text-property (point) property)
predicate)
(not not-immediate))
(text-property--find-end-forward (point) property value predicate)
(let ((origin (point))
(ended nil)
pos)
;; Fix the next candidate.
(while (not ended)
(setq pos (next-single-property-change (point) property))
(if (not pos)
(progn
(goto-char origin)
(setq ended t))
(goto-char pos)
(if (text-property--match-p value (get-text-property (point) property)
predicate)
(setq ended
(text-property--find-end-forward
(point) property value predicate))
;; Skip past this section of non-matches.
(setq pos (next-single-property-change (point) property))
(unless pos
(goto-char origin)
(setq ended t)))))
(and (not (eq ended t))
ended))))
(defun text-property--find-end-forward (start property value predicate)
(let (end)
(if (and value
(null predicate))
;; This is the normal case: We're looking for areas where the
;; values aren't, so we aren't interested in sub-areas where the
;; property has different values, all non-matching value.
(let ((ended nil))
(while (not ended)
(setq end (next-single-property-change (point) property))
(if (not end)
(progn
(goto-char (point-max))
(setq end (point)
ended t))
(goto-char end)
(unless (text-property--match-p
value (get-text-property (point) property) predicate)
(setq ended t)))))
;; End this at the first place the property changes value.
(setq end (next-single-property-change (point) property nil (point-max)))
(goto-char end))
(make-prop-match :beginning start
:end end
:value (get-text-property start property))))
(defun text-property-search-backward (property &optional value predicate
not-immediate)
"Search for the previous region that has text property PROPERTY set to VALUE.
See `text-property-search-forward' for further documentation."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
(when (> (length string) 0)
(intern string obarray)))))
(cond
;; We're at the start of the buffer; no previous matches.
((bobp)
nil)
;; We're standing in the property we're looking for, so find the
;; end.
((and (text-property--match-p
value (get-text-property (1- (point)) property)
predicate)
(not not-immediate))
(text-property--find-end-backward (1- (point)) property value predicate))
(t
(let ((origin (point))
(ended nil)
pos)
(forward-char -1)
;; Fix the next candidate.
(while (not ended)
(setq pos (previous-single-property-change (point) property))
(if (not pos)
(progn
(goto-char origin)
(setq ended t))
(goto-char (1- pos))
(if (text-property--match-p value (get-text-property (point) property)
predicate)
(setq ended
(text-property--find-end-backward
(point) property value predicate))
;; Skip past this section of non-matches.
(setq pos (previous-single-property-change (point) property))
(unless pos
(goto-char origin)
(setq ended t)))))
(and (not (eq ended t))
ended)))))
(defun text-property--find-end-backward (start property value predicate)
(let (end)
(if (and value
(null predicate))
;; This is the normal case: We're looking for areas where the
;; values aren't, so we aren't interested in sub-areas where the
;; property has different values, all non-matching value.
(let ((ended nil))
(while (not ended)
(setq end (previous-single-property-change (point) property))
(if (not end)
(progn
(goto-char (point-min))
(setq end (point)
ended t))
(goto-char (1- end))
(unless (text-property--match-p
value (get-text-property (point) property) predicate)
(goto-char end)
(setq ended t)))))
;; End this at the first place the property changes value.
(setq end (previous-single-property-change
(point) property nil (point-min)))
(goto-char end))
(make-prop-match :beginning end
:end (1+ start)
:value (get-text-property end property))))
(defun text-property--match-p (value prop-value predicate)
(cond
((eq predicate t)
(setq predicate #'equal))
((eq predicate nil)
(setq predicate (lambda (val p-val)
(not (equal val p-val))))))
(funcall predicate value prop-value))
(provide 'text-property-search)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment