Skip to content
2010/10/25 / highmt

anythingでマッチ部分のハイライトをmigemoに対応させる

anything-version 1.287
anything-match-plugin.el,v 1.27
anything-migemo.el,v 1.18

ただでさえ遅いanythingをさらに追い詰めるようなものですが、
かっこいいから。
あと、ハイライトは候補が絞られた後に対して行われるので、
candidates-in-buffer化してソースを高速化してあれば
実際はそんなに遅くならなかったり。

(defvar my-anything-highlight-use-migemo nil)
(defadvice anything-mp-highlight-match-internal
  (around my-anything-mp-highlight-match-internal-ad-migemo activate)
  (if (not my-anything-highlight-use-migemo)
      ad-do-it
    (flet
        ((anything-mp-3-get-patterns
          (pattern)
          (loop for (pred . re) in
                (anything-mp-3-get-patterns-internal pattern) ; avoid being cached
                collect (cons pred (migemo-get-pattern re)))))
      ad-do-it)))

my-anything-highlight-use-migemo を t にすれば
migemoでハイライトされます。

ですが、自分の環境ではタイミングによって問題がおきることがあったので、
(anything-mp-highlight-region の regexp 引数になぜか
anything-bufferの内容全体が渡されてきたりとか)
以下の関数を書き換え。
とりえあず自分の環境では問題が起きなくなったのですが、
効果があったかどうかはよくわかりません。

anything-mp-highlight-match-internal で (set-buffer anything-buffer) と
していたのを with-current-buffer を使うように変更。

(defun* anything-mp-highlight-match-internal (end)
  (when (anything-window)
    (with-current-buffer anything-buffer
      (let ((requote (regexp-quote anything-pattern)))
        (when (>= (length requote) anything-mp-highlight-threshold)
          (anything-mp-highlight-region (point-min) end
                                        requote 'anything-match)))
      (loop for (pred . re) in (anything-mp-3-get-patterns anything-pattern)
            when (and (eq pred 'identity)
                      (>= (length re) anything-mp-highlight-threshold))
            do
            (anything-mp-highlight-region (point-min) end re 'anything-match)))))

anything-mp-highlight-regionで明示的にwith-current-bufferしてみたり。

(defun anything-mp-highlight-region (start end regexp face)
  (with-current-buffer anything-buffer
    (save-excursion
      (goto-char start)
      (let (me mb)
        (while (and (< 0 start)
                    (< 0 end)
                    (setq me (re-search-forward regexp end t))
                    (setq mb (match-beginning 0))
                    (< mb me))
          (put-text-property mb me 'face face))))))
広告
%d人のブロガーが「いいね」をつけました。