[patch] Lazy highlighting improvement

Here is an attempt to make the "lazy highlighting" feature a bit more responsive and logical. Currently lazy highlighting always works on the entire buffer, and to make the process interruptible it introduces various timeouts. The highlighting process has nothing to do with the movement of the cursor (as with repeated and fast pressing of C-s) so it's even possible to "overtake" the updating process. Because of timeouts, the current lazy highlighting implementation also visibly animates. While it was cool enough at first, I found it quite distracting later. The following patch implements an IMHO more logical variant of the same feature: now it only updates the visible portion of the window, and it does it without any delays. When you change the search string, or when you move forward in isearch, only the visible portion of the buffer gets recalculated. Although the code to get all cases right is tricky in places, the rather complex code that dealt with timeouts is now done away with, so this patch does not add too much complexity. The only feature that gets lost is the ability to retain the highlighting after the isearch exits. This feature was not implemented correctly in the first place because the highlights were in fact retained only for the part of the buffer that the lazy highlighting has had time to reach, instead of the whole buffer. A fully correct implementation of that feature is very hard. If there are no objections, I'll mail this patch to <xemacs-patches>. To test the patch, apply it to isearch-mode.el, load it with `M-x load-file', and try using incremental search. Index: lisp/isearch-mode.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs/lisp/isearch-mode.el,v retrieving revision 1.4.2.6 diff -u -r1.4.2.6 isearch-mode.el --- isearch-mode.el 1999/07/30 13:57:25 1.4.2.6 +++ isearch-mode.el 1999/08/29 04:18:13 ＠＠ -74,18 +74,17 ＠＠ ;; <bobg(a)zanshin.com&gt; GNU Emacs isearch enhancements. From his release ;; message: ;; -;; ** New feature in incremental search: "lazy highlighting," controlled -;; by the variable `isearch-lazy-highlight'. When active, *every* -;; match for the current search string is highlighted: the current one -;; using the normal isearch match color and all the others using the -;; unobtrusive `secondary-selection' color. 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. Highlighting of -;; these additional matches happens in a deferred fashion using "idle -;; timers," so the cycles needed do not rob isearch of its usual -;; snappy response. New default keybinding: M-C for clearing the -;; extra highlighting (which normally happens automatically unless you -;; turn off `isearch-lazy-highlight-cleanup'). +;; ** New feature in incremental search: "lazy highlighting," +;; controlled by the variable `isearch-highlight-all-matches'. +;; When active, *every* match for the current search string is +;; highlighted: the current one using the normal isearch match +;; color and all the others using the unobtrusive +;; `secondary-selection' color. 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. Highlighting of +;; these additional matches happens in a deferred fashion using +;; "idle timers," so the cycles needed do not rob isearch of its +;; usual snappy response. ;; ;; Bob's code was modified to use extents instead of overlays. ＠＠ -545,7 +544,7 ＠＠ (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil isearch-yank-flag nil) - (isearch-lazy-highlight-new-loop) + (isearch-highlight-all-update) ) ＠＠ -571,7 +570,7 ＠＠ (setq isearch-mode nil) (set-buffer-modified-p (buffer-modified-p));; update modeline (isearch-dehighlight t) - (isearch-lazy-highlight-cleanup) + (isearch-highlight-all-cleanup) )) ;; it's not critical that this be inside inhibit-quit, but leaving ＠＠ -1647,7 +1646,7 ＠＠ (put 'with-caps-disable-folding 'edebug-form-spec '(form body))  -;;; isearch-lazy-highlight feature +;;; isearch-highlight-all feature ;;; (formerly "ishl") ;;; by Bob Glickstein <http://www.zanshin.com/~bobg/> ＠＠ -1662,169 +1661,161 ＠＠ ;;; IMPLEMENTATION NOTE: This depends on some isearch internals. ;;; Specifically: -;;; - `isearch-update' is expected to be called (at least) every time -;;; the search string changes; +;;; - `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-extent' is expected to contain the extent used for -;;; primary isearch match-highlighting; ;;; - `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 direction of the current search is expected to be given by -;;; `isearch-forward'; ;;; - the variable `isearch-invalid-regexp' is expected to be true ;;; iff `isearch-string' is an invalid regexp. -(defgroup isearch-lazy-highlight nil - "Lazy highlighting feature for incremental search." - :prefix "isearch-lazy-highlight-" +(defcustom isearch-highlight-all-matches t + "*Document me please." + :type 'sexp :group 'isearch) -(defcustom isearch-lazy-highlight t - "*Controls the lazy-highlight behavior of incremental search. -When non-nil, all text in the buffer matching the current search -string is highlighted lazily (see -`isearch-lazy-highlight-initial-delay' and -`isearch-lazy-highlight-interval')." - :type 'boolean - :group 'isearch-lazy-highlight) - -(defcustom isearch-lazy-highlight-cleanup t - "*Controls whether to remove extra highlighting after a search. -If this is nil, extra highlighting can be \"manually\" removed with -\\[isearch-lazy-highlight-cleanup]." - :type 'boolean - :group 'isearch-lazy-highlight) - -(defcustom isearch-lazy-highlight-initial-delay 0.25 - "*Seconds to wait before beginning to lazily highlight all matches." - :type 'number - :group 'isearch-lazy-highlight) - -(defcustom isearch-lazy-highlight-interval 0.0625 - "*Seconds between lazily highlighting successive matches." - :type 'number - :group 'isearch-lazy-highlight) - -(defcustom isearch-lazy-highlight-face 'secondary-selection - "*Face to use for lazily highlighting all matches." +(defcustom isearch-highlight-all-face 'secondary-selection + "*Face to use for highlighting all matches." :type 'face - :group 'isearch-lazy-highlight) + :group 'isearch) -(defvar isearch-lazy-highlight-extents nil) -(defvar isearch-lazy-highlight-wrapped nil) -(defvar isearch-lazy-highlight-start nil) -(defvar isearch-lazy-highlight-end nil) -(defvar isearch-lazy-highlight-timer nil) -(defvar isearch-lazy-highlight-last-string nil) +(defvar isearch-highlight-all-extents nil) +(defvar isearch-highlight-all-start nil) +(defvar isearch-highlight-all-end nil) +(defvar isearch-highlight-all-last-string nil) + +(defun isearch-highlight-all-delete-extents-in-range (start end) + ;; Delete all highlighting extents that overlap [start, end). + (dolist (extent isearch-highlight-all-extents) + (when (extent-in-region-p extent start end) + (delete-extent extent))) + ;; Prune the dead extents from the list. + (setq isearch-highlight-all-extents + (delete-if-not #'extent-live-p isearch-highlight-all-extents))) -(defun isearch-lazy-highlight-cleanup (&optional force) +(defun isearch-highlight-all-cleanup () "Stop lazily highlighting and remove extra highlighting from buffer. -This happens automatically when exiting an incremental search if -`isearch-lazy-highlight-cleanup' is non-nil." - (interactive '(t)) - (if (or force isearch-lazy-highlight-cleanup) - (isearch-lazy-highlight-remove-extents)) - (if isearch-lazy-highlight-timer - (progn - (delete-itimer isearch-lazy-highlight-timer) - (setq isearch-lazy-highlight-timer nil)))) +This happens automatically when exiting an incremental search." + (mapcar #'delete-extent isearch-highlight-all-extents) + (setq isearch-highlight-all-extents nil) + (setq isearch-highlight-all-start nil + isearch-highlight-all-end nil + isearch-highlight-all-last-string nil)) -(defun isearch-lazy-highlight-remove-extents () - "Remove lazy highlight extents from the buffer." - (while isearch-lazy-highlight-extents - (delete-extent (car isearch-lazy-highlight-extents)) - (setq isearch-lazy-highlight-extents - (cdr isearch-lazy-highlight-extents)))) - -(defun isearch-lazy-highlight-new-loop () - "Cleanup any previous isearch-lazy-highlight loop and begin a new one. +(defun isearch-highlight-all-update () + "Cleanup any previous isearch-highlight-all loop and begin a new one. This happens when `isearch-update' is invoked (which can cause the search string to change." - (if (and isearch-lazy-highlight - (not (equal isearch-string isearch-lazy-highlight-last-string))) - ;; the search string did indeed change - (progn - (isearch-lazy-highlight-cleanup t) ;kill old loop & remove extents - (if (and isearch-extent - (not (extent-property isearch-extent 'priority))) - ;; make sure the isearch-extent takes priority - (set-extent-priority isearch-extent '(priority 1))) - (setq isearch-lazy-highlight-start isearch-opoint - isearch-lazy-highlight-end isearch-opoint - isearch-lazy-highlight-last-string isearch-string - isearch-lazy-highlight-wrapped nil) - (setq isearch-lazy-highlight-timer - (start-itimer "Lazy highlight" - 'isearch-lazy-highlight-update - isearch-lazy-highlight-initial-delay - nil t))))) + (let ((needs-update-all nil)) + (cond ((not isearch-highlight-all-matches)) + ((or (equal isearch-string "") + isearch-invalid-regexp) + (isearch-highlight-all-cleanup)) + ((equal isearch-string isearch-highlight-all-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 valye for start and end + ;; of window. + (sit-for 0) + ;; Check whether our location has changed. + (let ((start (window-start)) + (end (window-end nil t))) + (cond ((and (= start isearch-highlight-all-start) + (= end isearch-highlight-all-end)) + ;; Our position is unchanged -- do nothing. + ) + ((and (> start isearch-highlight-all-start) + (> end isearch-highlight-all-end) + (<= start isearch-highlight-all-end)) + ;; We've migrated downward, but we overlap the old + ;; region. Delete the old non-overlapping extents + ;; and fill in the rest. + (isearch-highlight-all-delete-extents-in-range + isearch-highlight-all-start start) + (isearch-highlight-all-iterate + isearch-highlight-all-end end) + (setq isearch-highlight-all-start start + isearch-highlight-all-end end)) + ((and (<= start isearch-highlight-all-start) + (<= end isearch-highlight-all-end) + (> end isearch-highlight-all-start)) + ;; We've migrated upward, but we overlap the old + ;; region. Delete the old non-overlapping extents + ;; and fill in the rest. + (isearch-highlight-all-delete-extents-in-range + end isearch-highlight-all-end) + (isearch-highlight-all-iterate + start isearch-highlight-all-start) + (setq isearch-highlight-all-start start + isearch-highlight-all-end end)) + (t + ;; The regions don't overlap, or they overlap in a + ;; weird way. + (setq needs-update-all t))))) + (t + ;; The search string has changed. + (setq needs-update-all t))) + (when needs-update-all + ;; Force redisplay before removing the old extents, in order to + ;; avoid flicker. + (sit-for 0) + (isearch-highlight-all-cleanup) + (setq isearch-highlight-all-start (window-start) + isearch-highlight-all-end (window-end nil t) + isearch-highlight-all-last-string isearch-string) + (isearch-highlight-all-iterate + isearch-highlight-all-start + isearch-highlight-all-end)))) -(defun isearch-lazy-highlight-search () +(defun isearch-highlight-all-search (string forwardp) "Search ahead for the next or previous match, for lazy highlighting. -Attempt to do the search exactly the way the pending isearch would." +Attempt to do the search the way isearch would." (let ((case-fold-search isearch-case-fold-search)) - (funcall (cond (isearch-word (if isearch-forward + (funcall (cond (isearch-word (if forwardp 'word-search-forward 'word-search-backward)) - (isearch-regexp (if isearch-forward + (isearch-regexp (if forwardp 're-search-forward 're-search-backward)) - (t (if isearch-forward + (t (if forwardp 'search-forward 'search-backward))) - isearch-string - (if isearch-forward - (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-start - nil) - (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-end - nil)) - t))) - -(defun isearch-lazy-highlight-update () - "Find and highlight the next match in the lazy highlighting loop." - (when (not isearch-invalid-regexp) - (save-excursion - (save-match-data - (goto-char (if isearch-forward - isearch-lazy-highlight-end - isearch-lazy-highlight-start)) - (let ((found (isearch-lazy-highlight-search))) ;do search - (if found - ;; found the next match - (let ((ext (make-extent (match-beginning 0) - (match-end 0)))) - (set-extent-properties ext - (list - 'face isearch-lazy-highlight-face - 'priority 0)) - (setq isearch-lazy-highlight-extents - (cons ext isearch-lazy-highlight-extents)) - (setq isearch-lazy-highlight-timer - (start-itimer "Lazy highlight" - 'isearch-lazy-highlight-update - isearch-lazy-highlight-interval - nil t)) - (if isearch-forward - (setq isearch-lazy-highlight-end (point)) - (setq isearch-lazy-highlight-start (point)))) - ;; found no next match - (when (not isearch-lazy-highlight-wrapped) - ;; let's try wrapping around the end of the buffer - (setq isearch-lazy-highlight-wrapped t) - (setq isearch-lazy-highlight-timer - (start-itimer "Lazy highlight" - 'isearch-lazy-highlight-update - isearch-lazy-highlight-interval - nil t)) - (if isearch-forward - (setq isearch-lazy-highlight-end (point-min)) - (setq isearch-lazy-highlight-start (point-max)))))))))) + string nil t))) -(define-key esc-map "C" 'isearch-lazy-highlight-cleanup) +(defun isearch-highlight-all-iterate (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 start) + (let ((lastpoint (point))) + (while (and (isearch-highlight-all-search isearch-string t) + (/= lastpoint (point)) + (< (match-beginning 0) end)) + (let ((extent (make-extent (match-beginning 0) + (match-end 0)))) + (put extent 'face isearch-highlight-all-face) + (put extent 'foo 'bar) + (push extent isearch-highlight-all-extents)))) + (goto-char start) + (let ((lastpoint (point))) + (while (and (isearch-highlight-all-search isearch-string nil) + (/= lastpoint (point)) + (>= (match-end 0) start)) + (let ((extent (make-extent (match-beginning 0) + (match-end 0)))) + (put extent 'face isearch-highlight-all-face) + (put extent 'foo 'bar) + (push extent isearch-highlight-all-extents)))))) ;;; isearch-mode.el ends here