;; -*-Emacs-Lisp-*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or         ;;
;; modify it under the terms of the GNU General Public License as        ;;
;; published by the Free Software Foundation; either version 3, or (at   ;;
;; your option) any later version.                                       ;;
;;                                                                       ;;
;; This program is distributed in the hope that it will be useful, but   ;;
;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
;; General Public License for more details.                              ;;
;;                                                                       ;;
;; You should have received a copy of the GNU General Public License     ;;
;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
;;                                                                       ;;
;; Written by and Copyright (C) Francois Fleuret                         ;;
;; Contact <francois@fleuret.org> for comments & bug reports             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This handy function calls the dict unix command.
;;
;; I put in my ~/.emacs.el
;;
;; (when (load "lookup-dict" t)
;;   (define-key global-map [(control \?)] 'lookup-dict))
;;
;; On Debian, install the package dict, and to use it without
;; connection install dictd, dict-foldoc, dict-gcide, dict-jargon and
;; dict-wn

(defun lookup-dict (&optional force)

  "Gets definitions with the unix 'dict' command. Takes for word
either -- in this order, if possible -- the region, the word at
point, and a word given interactively. An optional universal
argument \\[universal-argument] forces the third."

  (interactive "P")

  (let ((word (or

               ;; Word given as parameter
               (and force "")

               ;; Region (Emacs 23 has region-active-p)
               (if (functionp 'region-active-p)
                   (and (region-active-p)
                        (buffer-substring (region-beginning) (region-end)))
                 (condition-case nil
                     (buffer-substring (region-beginning) (region-end))
                   (error nil)))

               ;; Word at point
               (thing-at-point 'word)

               )))

    (when (string= word "") (setq word (read-input "Word: ")))

    (setq word (replace-regexp-in-string "[^a-zA-Z\- \.]" "" (or word "")))

    (let ((name (concat "*definition of " word "*")))

      (if (get-buffer name) (switch-to-buffer name)

        (switch-to-buffer (generate-new-buffer name))

        (text-mode)

        (let ((map (make-sparse-keymap)))

          (suppress-keymap map)
          (define-key map "q" 'kill-this-buffer)
          (define-key map (kbd "RET") 'lookup-dict)
          (define-key map " " (lambda () (interactive)
                                (when (condition-case nil (scroll-up) (error t))
                                  (beginning-of-buffer))))
          (use-local-map map))

        (insert "\nPress <space> to go one page down, <enter> to lookup a word and `q' to\nkill this buffer\n\n")

        (if (string= word "") (insert "Empty word!\n")

          ;; Insert the response of the 'dict' command

          (condition-case nil
              (save-excursion
                (call-process "dict" nil (current-buffer) nil word))

            (error (insert "Can not find the unix `dict' command, is it installed ?\n\n")))

          ;; Remove the spurious whitespaces, underline the "From ..."
          ;; and highlight the searched word

          (delete-trailing-whitespace)

          (save-excursion
            (goto-char (point-min))
            (while (re-search-forward "^From.*$" nil t)
              (add-text-properties (match-beginning 0)
                                   (match-end 0)
                                   '(face underline)))
            (goto-char (point-min))
            (while (re-search-forward (concat "[^a-zA-Z]\\\(" word "\\\)[^a-zA-Z]") nil t)
              (add-text-properties (match-beginning 1)
                                   (match-end 1)
                                   '(face bold))))
          )

        (setq buffer-read-only t)
        (set-buffer-modified-p nil)
        )

      )))