Added "of" in the buffer name.
[elisp.git] / 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       )))