mac-dict.el

;; mac-dict.el --- Look up a word at point in the Dictionary.app and popup the result of it automatically.

;;; Requirements:

;; `dict.py'  - <http://sakito.jp/mac/dictionary.html#python>
;; `popup.el' - <http://github.com/m2ym/auto-complete>

;;; Setup:

;; 1. Put the `dict.py' to somewhere you like. And add the execute
;;    permission to it.
;; 2. If needed, set the order of reference sources by the Preferences
;;    of Dictionary.app because the script searches a word from the top
;;    of listed sources.
;; 3. Put this file and `popup.el' in your load-path and add the following
;;    to your init file.
;;
;;       (require 'mac-dict)
;;       (setq mac-dict-program (expand-file-name "/path/to/dict.py"))
;;       (global-set-key (kbd "C-c d") 'mac-dict-mode)
;;       (global-set-key (kbd "C-c C-d") 'mac-dict-look-up)

;;; Tested:

;; GNU Emacs 23.2 on Mac OS X 10.6.5

;;; Code:

(require 'cl)
(require 'popup)

(defvar mac-dict-program (expand-file-name "~/.emacs.d/dict.py")
  "*Specify the path of script for Dictionary.app.")
(defvar mac-dict-failed-proc-re "AttributeError: "
  "*Regexp matching to the failed result of async process.")
(defvar mac-dict-popup-delay 0.5
  "*Delay to popup a tooltip.")
(defvar mac-dict-tip-height 40
  "*Maximum height of a tooltip.")

(defvar mac-dict-timer nil)
(defconst mac-dict-cache (make-hash-table :test 'equal))

(defvar mac-dict-tip nil)
(defun* mac-dict-popup-tip (word
                            contents
                            &key
                            width
                            &aux string lines)
  (popup-delete mac-dict-tip)           ; Sometimes tip remains
  (setq string (concat word "\n" contents))
  (let ((it (popup-fill-string string width popup-tip-max-width)))
    (setq width (car it)
          lines (cdr it)))
  (setq mac-dict-tip (popup-create (point) width mac-dict-tip-height
                                   :around t
                                   :margin-left 1
                                   :margin-right 1
                                   :scroll-bar t
                                   :face 'popup-tip-face))
  (unwind-protect
      (when (> (popup-width mac-dict-tip) 0) ; not to be corrupted
        (when (not (eq width (popup-width mac-dict-tip))) ; truncated
          ;; Refill once again to lines be fitted to popup width
          (setq width (popup-width mac-dict-tip))
          (setq lines (cdr (popup-fill-string string width width))))
        (popup-set-list mac-dict-tip lines)
        (popup-draw mac-dict-tip)
        (clear-this-command-keys)
        (push (read-event nil) unread-command-events)
        t)
    (popup-delete mac-dict-tip)))

(defun mac-dict-format-word (word)
  "Return formatted WORD."
  (replace-regexp-in-string
   "[0-9]+" ""
   (downcase (substring-no-properties word))))

(defun mac-dict-format-contents (contents)
  "Return formatted CONTENTS."
  (if (string-match mac-dict-failed-proc-re contents)
      'none
    (replace-regexp-in-string "\n+\\'" "" contents)))

(defun mac-dict-process-live-p (proc)
  "Return non-nil if PROC is still running."
  (and (processp proc)
       (not (eq (process-status proc) 'exit))
       (= (process-exit-status proc) 0)
       t))

(defun mac-dict-suppress-popup-p ()
  "If non-nil, suppress showing tooltip."
  (or mark-active
      (and (fboundp 'ac-menu-live-p) (ac-menu-live-p)) ; auto-complete-mode
      (eq last-command 'self-insert-command)
      (eq this-command 'self-insert-command)))

(defun mac-dict-look-up* (&optional interactively)
  (when (and (or interactively mac-dict-mode)
             (not (mac-dict-suppress-popup-p)))
    (lexical-let* ((interactively interactively)
                   (word (word-at-point))
                   (old-word word)
                   (buf (get-buffer-create " *mac-dict-process*"))
                   (enable (not (mac-dict-process-live-p
                                 (get-buffer-process buf))))
                   (contents nil)
                   (msg nil))
      ;; If called INTERACTIVELY, executed with displaying message.
      (labels ((beg-msg () (and interactively (setq msg (message "Looking up `%s'..." word))))
               (end-msg () (and interactively (message (concat msg "done")))))
        (when (and word enable)
          (setq word (mac-dict-format-word word))
          (beg-msg)
          (if (setq contents (gethash word mac-dict-cache))
              ;; Use cache
              (progn
                (end-msg)
                (unless (equal contents 'none)
                  (mac-dict-popup-tip word contents)))
            ;; Run async process
            (set-process-sentinel
             (start-process "mac-dict-process" buf mac-dict-program word)
             (lambda (&rest ignore)
               (setq contents (mac-dict-format-contents
                               (with-current-buffer buf
                                 (prog1 (buffer-substring-no-properties
                                         (point-min) (point-max))
                                   (erase-buffer)))))
               (puthash word contents mac-dict-cache)
               (end-msg)
               (and (or interactively mac-dict-mode)
                    (not (equal contents 'none))
                    (equal (word-at-point) old-word)
                    (mac-dict-popup-tip word contents))))))))))

(defun mac-dict-kinsoku-workaround ()
  ;; Suppress...
  ;; Warning: defvar ignored because kinsoku-limit is let-bound
  (unless (boundp 'kinsoku-limit)
    (load "kinsoku" nil t)))

(defun mac-dict-look-up ()
  "Look up a word at point in Dictionary.app.
Then show the result of it in tooltip."
  (interactive)
  (mac-dict-kinsoku-workaround)
  (mac-dict-look-up* t))

(defun mac-dict-cancel-timer ()
  (when (timerp mac-dict-timer)
    (cancel-timer mac-dict-timer)
    (setq mac-dict-timer nil)))

(defun mac-dict-set-timer ()
  (mac-dict-cancel-timer)
  (setq mac-dict-timer
        (run-with-idle-timer mac-dict-popup-delay t 'mac-dict-look-up*)))

(define-minor-mode mac-dict-mode
  "Toggle Mac-Dict mode."
  :lighter " Mac-Dict"
  :group 'ns
  (if mac-dict-mode
      (progn
        (mac-dict-kinsoku-workaround)
        (mac-dict-set-timer))
    (mac-dict-cancel-timer))
  (if (some (lambda (b)
              (buffer-local-value 'mac-dict-mode b))
            (buffer-list))
      (mac-dict-set-timer)
    (clrhash mac-dict-cache)))

(provide 'mac-dict)
;;; mac-dict.el ends here