lookup-dict.el

   1 ;; -*-Emacs-Lisp-*-
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;; This program is free software; you can redistribute it and/or         ;;
   5 ;; modify it under the terms of the GNU General Public License as        ;;
   6 ;; published by the Free Software Foundation; either version 3, or (at   ;;
   7 ;; your option) any later version.                                       ;;
   8 ;;                                                                       ;;
   9 ;; This program is distributed in the hope that it will be useful, but   ;;
  10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
  12 ;; General Public License for more details.                              ;;
  13 ;;                                                                       ;;
  14 ;; You should have received a copy of the GNU General Public License     ;;
  15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
  16 ;;                                                                       ;;
  17 ;; Written by and Copyright (C) Francois Fleuret                         ;;
  18 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20
  21 ;; This handy function calls the dict unix command.
  22 ;;
  23 ;; I put in my ~/.emacs.el
  24 ;;
  25 ;; (when (load "lookup-dict" t)
  26 ;;   (define-key global-map [(control \?)] 'lookup-dict))
  27 ;;
  28 ;; On Debian, install the package dict, and to use it without
  29 ;; connection install dictd, dict-foldoc, dict-gcide, dict-jargon and
  30 ;; dict-wn
  31
  32 (defun lookup-dict (&optional force)
  33
  34   "Gets definitions with the unix 'dict' command. Takes for word
  35 either -- in this order, if possible -- the region, the word at
  36 point, and a word given interactively. An optional universal
  37 argument \\[universal-argument] forces the third."
  38
  39   (interactive "P")
  40
  41   (let ((word (or
  42
  43                ;; Word given as parameter
  44                (and force "")
  45
  46                ;; Region (Emacs 23 has region-active-p)
  47                (if (functionp 'region-active-p)
  48                    (and (region-active-p)
  49                         (buffer-substring (region-beginning) (region-end)))
  50                  (condition-case nil
  51                      (buffer-substring (region-beginning) (region-end))
  52                    (error nil)))
  53
  54                ;; Word at point
  55                (thing-at-point 'word)
  56
  57                )))
  58
  59     (when (string= word "") (setq word (read-input "Word: ")))
  60
  61     (setq word (replace-regexp-in-string "[^a-zA-Z\- \.]" "" (or word "")))
  62
  63     (let ((name (concat "*definition of " word "*")))
  64
  65       (if (get-buffer name) (switch-to-buffer name)
  66
  67         (switch-to-buffer (generate-new-buffer name))
  68
  69         (text-mode)
  70
  71         (let ((map (make-sparse-keymap)))
  72
  73           (suppress-keymap map)
  74           (define-key map "q" 'kill-this-buffer)
  75           (define-key map (kbd "RET") 'lookup-dict)
  76           (define-key map " " (lambda () (interactive)
  77                                 (when (condition-case nil (scroll-up) (error t))
  78                                   (beginning-of-buffer))))
  79           (use-local-map map))
  80
  81         (insert "\nPress <space> to go one page down, <enter> to lookup a word and `q' to\nkill this buffer\n\n")
  82
  83         (if (string= word "") (insert "Empty word!\n")
  84
  85           ;; Insert the response of the 'dict' command
  86
  87           (condition-case nil
  88               (save-excursion
  89                 (call-process "dict" nil (current-buffer) nil word))
  90
  91             (error (insert "Can not find the unix `dict' command, is it installed ?\n\n")))
  92
  93           ;; Remove the spurious whitespaces, underline the "From ..."
  94           ;; and highlight the searched word
  95
  96           (delete-trailing-whitespace)
  97
  98           (save-excursion
  99             (goto-char (point-min))
 100             (while (re-search-forward "^From.*$" nil t)
 101               (add-text-properties (match-beginning 0)
 102                                    (match-end 0)
 103                                    '(face underline)))
 104             (goto-char (point-min))
 105             (while (re-search-forward (concat "[^a-zA-Z]\\\(" word "\\\)[^a-zA-Z]") nil t)
 106               (add-text-properties (match-beginning 1)
 107                                    (match-end 1)
 108                                    '(face bold))))
 109           )
 110
 111         (setq buffer-read-only t)
 112         (set-buffer-modified-p nil)
 113         )
 114
 115       )))