+\f
+;;;========================================================
+;;; Advanced highlighting
+
+;; When active, *every* visible match for the current search string is
+;; highlighted: the current one using the normal isearch match color
+;; and all the others using the `isearch-secondary' face. The extra
+;; highlighting makes it easier to anticipate where the cursor will
+;; land each time you press C-s or C-r to repeat a pending search.
+;; Only the matches visible at any point are highlighted -- when you
+;; move through the buffer, the highlighting is readjusted.
+
+;; This is based on ideas from Bob Glickstein's `ishl' package. It
+;; has been merged with XEmacs by Darryl Okahata, and then completely
+;; rewritten by Hrvoje Niksic.
+
+;; The code makes the following assumptions about the rest of this
+;; file, so be careful when modifying it.
+
+;; * `isearch-highlight-all-update' should get called when the search
+;; string changes, or when the search advances. This is done from
+;; `isearch-update'.
+;; * `isearch-highlight-all-cleanup' should get called when the search
+;; is done. This is performed in `isearch-done'.
+;; * `isearch-string' is expected to contain the current search string
+;; as entered by the user.
+;; * `isearch-opoint' is expected to contain the location where the
+;; current search began.
+;; * the type of the current search is expected to be given by
+;; `isearch-word' and `isearch-regexp'.
+;; * the variable `isearch-invalid-regexp' is expected to be true iff
+;; `isearch-string' is an invalid regexp.
+
+(defcustom isearch-highlight-all-matches search-highlight
+ "*Non-nil means highlight all visible matches."
+ :type 'boolean
+ :group 'isearch)
+
+;; We can't create this face here, as isearch.el is preloaded.
+;; #### Think up a better name for this!
+;(defface isearch-secondary '((t (:foreground "red3")))
+; "Face to use for highlighting all matches."
+; :group 'isearch)
+
+(defvar isearch-highlight-extents nil)
+(defvar isearch-window-start nil)
+(defvar isearch-window-end nil)
+;; We compare isearch-string and isearch-case-fold-search to saved
+;; values for better efficiency.
+(defvar isearch-highlight-last-string nil)
+(defvar isearch-highlight-last-case-fold-search nil)
+(defvar isearch-highlight-last-regexp nil)
+
+(defun isearch-delete-extents-in-range (start end)
+ ;; Delete all highlighting extents that overlap [START, END).
+ (setq isearch-highlight-extents
+ (delete-if (lambda (extent)
+ (when (extent-in-region-p extent start end)
+ (delete-extent extent)
+ t))
+ isearch-highlight-extents)))
+
+(defun isearch-highlight-all-cleanup ()
+ ;; Stop lazily highlighting and remove extra highlighting from
+ ;; buffer.
+ (mapc #'delete-extent isearch-highlight-extents)
+ (setq isearch-highlight-extents nil)
+ (setq isearch-highlight-all-start nil
+ isearch-window-end nil
+ isearch-highlight-last-string nil))
+
+(defun isearch-highlight-all-update ()
+ ;; Update the highlighting if necessary. This needs to check if the
+ ;; search string has changed, or if the window has changed position
+ ;; in the buffer.
+ (let ((need-start-over nil))
+ ;; NB: we don't check for isearch-success because if the point is
+ ;; after the last match, the search can be unsuccessful, and yet
+ ;; there are things to highlight.
+ (cond ((not isearch-highlight-all-matches))
+ ((or (equal isearch-string "")
+ isearch-invalid-regexp)
+ (isearch-highlight-all-cleanup))
+ ((not (eq isearch-case-fold-search
+ isearch-highlight-last-case-fold-search))
+ ;; This case is usually caused by search string being
+ ;; changed, which would be caught below, but it can also be
+ ;; tripped using isearch-toggle-case-fold.
+ (setq need-start-over t))
+ ((not (eq isearch-regexp isearch-highlight-last-regexp))
+ ;; Ditto for isearch-toggle-regexp.
+ (setq need-start-over t))
+ ((equal isearch-string isearch-highlight-last-string)
+ ;; The search string is the same. We need to do something
+ ;; if our position has changed.
+
+ ;; It would be nice if we didn't have to do this; however,
+ ;; window-start doesn't support a GUARANTEE flag, so we must
+ ;; force redisplay to get the correct value for start and end
+ ;; of window.
+ (sit-for 0)
+
+ ;; Check whether our location has changed.
+ (let ((start (window-start))
+ (end (min (window-end) (point-max))))
+ (cond ((and (= start isearch-window-start)
+ (= end isearch-window-end))
+ ;; Our position is unchanged -- do nothing.
+ )
+ ((and (> start isearch-window-start)
+ (> end isearch-window-end)
+ (<= start isearch-window-end))
+ ;; We've migrated downward, but we overlap the old
+ ;; region. Delete the old non-overlapping extents
+ ;; and fill in the rest.
+ (isearch-delete-extents-in-range isearch-window-start start)
+ (isearch-highlightify-region isearch-window-end end)
+ (setq isearch-window-start start
+ isearch-window-end end))
+ ((and (<= start isearch-window-start)
+ (<= end isearch-window-end)
+ (> end isearch-window-start))
+ ;; We've migrated upward, but we overlap the old
+ ;; region. Delete the old non-overlapping extents
+ ;; and fill in the rest.
+ (isearch-delete-extents-in-range
+ end isearch-window-end)
+ (isearch-highlightify-region start isearch-window-start)
+ (setq isearch-window-start start
+ isearch-window-end end))
+ (t
+ ;; The regions don't overlap, or they overlap in a
+ ;; weird way.
+ (setq need-start-over t)))))
+ (t
+ ;; The search string has changed.
+
+ ;; If more input is pending, don't start over because
+ ;; starting over forces redisplay, and that slows down
+ ;; typing.
+ (unless (input-pending-p)
+ (setq need-start-over t))))
+ (when need-start-over
+ ;; Force redisplay before removing the old extents, in order to
+ ;; avoid flicker.
+ (sit-for 0)
+ (isearch-highlight-all-cleanup)
+ (setq isearch-window-start (window-start)
+ isearch-window-end (min (window-end) (point-max)))
+ (isearch-highlightify-region isearch-window-start isearch-window-end))
+
+ (setq isearch-highlight-last-string isearch-string
+ isearch-highlight-last-case-fold-search isearch-case-fold-search
+ isearch-highlight-last-regexp isearch-regexp)))
+
+(defun isearch-highlight-advance (string forwardp)
+ ;; Search ahead for the next or previous match. This is the same as
+ ;; isearch-search, but without the extra baggage. Maybe it should
+ ;; be in a separate function.
+ (let ((case-fold-search isearch-case-fold-search))
+ (funcall (cond (isearch-word (if forwardp
+ 'word-search-forward
+ 'word-search-backward))
+ (isearch-regexp (if forwardp
+ 're-search-forward
+ 're-search-backward))
+ (t (if forwardp
+ 'search-forward
+ 'search-backward)))
+ string nil t)))
+
+(defun isearch-highlightify-region (start end)
+ ;; Highlight all occurrences of isearch-string between START and
+ ;; END. To do this right, we have to search forward as long as
+ ;; there are matches that overlap [START, END), and then search
+ ;; backward the same way.
+ (save-excursion
+ (goto-char isearch-opoint)
+ (let ((lastpoint (point)))
+ (while (and (isearch-highlight-advance isearch-string t)
+ (/= lastpoint (point))
+ (< (match-beginning 0) end))
+ (let ((extent (make-extent (match-beginning 0)
+ (match-end 0))))
+ (set-extent-priority extent (1+ mouse-highlight-priority))
+ (put extent 'face 'isearch-secondary)
+ (push extent isearch-highlight-extents))
+ (setq lastpoint (point))))
+ (goto-char isearch-opoint)
+ (let ((lastpoint (point)))
+ (while (and (isearch-highlight-advance isearch-string nil)
+ (/= lastpoint (point))
+ (>= (match-end 0) start))
+ (let ((extent (make-extent (match-beginning 0)
+ (match-end 0))))
+ (set-extent-priority extent (1+ mouse-highlight-priority))
+ (put extent 'face 'isearch-secondary)
+ (push extent isearch-highlight-extents))
+ (setq lastpoint (point))))))
+