Mac の Emacs でツールチップ辞書 パート2。

前回の記事から、ちょっとパワーアップと整理をしたので、とりあえず現状を公開します。
前回との違いは、

  • リードオンリーでも使えるようにした。
  • jaspace-mode も一時的にオフになるようにした。
  • transient-mark-mode を使っている場合は、マークの文字列を優先するようにした。
  • その上で、マーク中はタイマーで辞書を表示させるようにした。

という感じです。
id:kiririmode さんの記事で紹介されているのを見てやる気を出しました。
リードオンリーのバッファについては、view-mode と buffer-read-only を混同していたので、*info* バッファー等で利用できなかったのに対応しました。
また、例えば substring の string だけを辞書引きしたい場合などのために、transient-mark-mode を使っている場合は、ワードを厳選できるようにしました。
jaspace-mode を利用していない場合は、(temp-cancel-read-only '(popup-tip dict :margin t :scroll-bar t) t) を (temp-cancel-read-only '(popup-tip dict :margin t :scroll-bar t)) にしておいてください。
なんか、コードが when ばっかりで、もっといい書き方ないのかなぁと思いますが。

(defvar dict-bin "/Users/tomoya/projects/commandline-dictionary-app/src/dict"
  "dict 実行ファイルのパス")

(defun temp-cancel-read-only (function &optional jaspace-off)
  "eval temporarily cancel buffer-read-only
&optional t is turn of jaspace-mode"
  (let ((read-only-p nil)
	(jaspace-mode-p nil))
    (when jaspace-off
      (when jaspace-mode
	(jaspace-mode)
	(setq jaspace-mode-p t)))
    (when buffer-read-only
      (toggle-read-only)
      (setq read-only-p t))
    (eval function)
    (when read-only-p
      (toggle-read-only))
    (when jaspace-mode-p
      (jaspace-mode))))

(defun ns-popup-dictionary ()
   "マウスカーソルの単語を Mac の辞書でひく"
   (interactive)
   (let ((word (substring-no-properties (thing-at-point 'word)))
	 (old-buf (current-buffer))
	 (dict-buf (get-buffer-create "*dictionary.app*"))
	 (dict))
     (when (and mark-active transient-mark-mode)
       (setq word (buffer-substring-no-properties (region-beginning) (region-end))))
     (set-buffer dict-buf)
     (erase-buffer)
     (call-process dict-bin
		   nil "*dictionary.app*" t word
		   "Japanese-English" "Japanese" "Japanese Synonyms")
     (setq dict (buffer-string))
     (set-buffer old-buf)
     (when (not (eq (length dict) 0))
       (temp-cancel-read-only '(popup-tip dict :margin t :scroll-bar t) t))))

(defvar dict-timer nil)
(defvar dict-delay 1.0)
(defun dict-timer ()
  (when (and (not (minibufferp))
	     (and mark-active transient-mark-mode))
    (ns-popup-dictionary)))
(setq dict-timer (run-with-idle-timer dict-delay dict-delay 'dict-timer))