From: Lars Ingebrigtsen Date: Tue, 17 Apr 2018 16:51:41 +0000 (+0200) Subject: Add `text-property-search-forward' and `-backward' X-Git-Tag: emacs-27.0.90~5161 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6f572972d19397d8295727a99b687fc521bd469e;p=emacs.git 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. --- diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index e89bd0b7ef7..8cb6cf6242a 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index 5aa92e29915..d4024016199 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el new file mode 100644 index 00000000000..cd4471a045c --- /dev/null +++ b/lisp/emacs-lisp/text-property-search.el @@ -0,0 +1,201 @@ +;;; text-property-search.el --- search for text properties -*- lexical-binding:t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 . + +;;; 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)