viper で検索語をハイライトする

普通の isearch だとバッファに存在する全ての検索語がハイライトしてくれるが、viper のそれだとポイント直下のものしかハイライトされずにちょっと淋しい。

以前からなんとかしたかったのだが、今日はちょっと気が向いたので viper-search でもハイライトするようにしてみた。

(defvar viper-search-highlight-overlay-priority 300)
(defvar viper-search-highlight-overlays nil)
(make-variable-buffer-local 'viper-search-highlight-overlays)
(defvar viper-search-highlight-pattern nil)
(make-variable-buffer-local 'viper-search-highlight-pattern)
(defvar viper-search-highlight-limit 500)

(defface viper-search-highlight-overlay
  '((((class color)) (:background "lavender"))
    (t (:weight bold)))
  "*Face used to highlight the search pattern."
  :group 'viper-highlighting)
(defvar viper-search-highlight-overlay-face 'viper-search-highlight-overlay)

(defun viper-highlight-cleanup ()
  (while viper-search-highlight-overlays
    (delete-overlay (car viper-search-highlight-overlays))
    (setq viper-search-highlight-overlays
	  (cdr viper-search-highlight-overlays))))

(defun viper-highlight-search-pattern ()
  (viper-highlight-cleanup)
  (let (ranges beg end ov)
    (setq ranges
	  (cons (cons (window-start) (window-end))
		(if viper-s-forward
		    (list (cons (window-end) (point-max))
			  (cons (point-min) (window-start)))
		  (list (cons (point-min) (window-start))
			(cons (window-end) (point-max))))))
    (dolist (range ranges)
      (setq beg (car range)
	    end (cdr range))
      (save-excursion
	(goto-char beg)
	(save-match-data
	  (while (and (re-search-forward viper-s-string end t)
		      (< (length viper-search-highlight-overlays)
			 viper-search-highlight-limit))
	    (setq ov (viper-make-overlay (match-beginning 0) (match-end 0)))
	    (push ov viper-search-highlight-overlays)
	    (viper-overlay-put ov 'priority
			       viper-search-highlight-overlay-priority)
	    (viper-overlay-put ov 'face viper-search-highlight-overlay-face)
	    (viper-overlay-put ov 'window (selected-window))))))))

(defadvice viper-flash-search-pattern
  (before highlight-search-pattern activate compile)
  (when (and (viper-has-face-support-p)
	     (or (null viper-search-highlight-overlays)
		 (not (string= viper-s-string viper-search-highlight-pattern))))
    (viper-highlight-search-pattern)
    (setq viper-search-highlight-pattern viper-s-string)))

こんなかな。

[追記:2006-12-02] なんか全然イケてなかったので全面的に書き替えてみた。