;;; dict.el ;;; ;;; Copyright (C) 1999, 2002, 2003, 2004, 2006, 2007, 2008 Thien-Thi Nguyen ;;; ;;; This file is part of ttn's personal elisp library, released 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. There is NO WARRANTY. See file COPYING for details. ;;; Description: Consult Merriam-Webster online dictionary or thesaurus. (require 'thingatpt) (defvar dict-method '("w3m" "-dump") "*Command and args used to read a web page and write it to stdout.") (defun m-w-lookup (book word cutoff) (switch-to-buffer (generate-new-buffer (format "*Merriam-Webster %s: %s*" book word))) (apply 'call-process (car dict-method) nil t nil (append (cdr dict-method) (list (concat "http://www.m-w.com/cgi-bin/" book "?book=" (capitalize book) "&va=" word)))) (if window-system (goto-char (point-min)) (goto-char (point-max)) ;; Do manually since `subst-char-in-region' has multi-byte problems. ;; (At least, it did in 1999 -- we'll switch over one of these days.) (while (/= (point) (point-min)) (when (= 2231 (following-char)) ; the floating dot is ugly on rxvt (delete-char 1) (insert " ")) (forward-char -1))) ;; The cutoff start may actually be offset from the side, so this is ;; a good time to kill both the side and the top noise. (let ((cutoff-regexp (concat "\\(" cutoff "\\):"))) (when (re-search-forward (concat "^.*" cutoff-regexp) (point-max) t) (goto-char (match-beginning 1)) (let ((col (current-column))) (goto-char (point-max)) (insert "\n") (goto-char (point-min)) (move-to-column col) (delete-rectangle (point) (point-max))) (re-search-forward (concat "^\\s-*" cutoff-regexp)) (delete-region (point-min) (match-beginning 0)))) ;; Sigh, quantiy and quality -- ever the confusion flows. (when (re-search-forward "10 \\(Most Popular Sites\\|Search Results\\)" (point-max) t) (beginning-of-line) (delete-region (point) (point-max))) (goto-char (point-min)) ;; Zonk right side crap, too. (when (and (search-forward "|" (point-max) t) (> (current-column) 40)) (let ((col (1- (current-column)))) (goto-char (point-min)) (move-to-column col) (while (< (point) (point-max)) (delete-region (point) (progn (end-of-line) (point))) (forward-line 1) (move-to-column col))) (goto-char (point-min))) (dolist (rx (list "\\[[^]]+.gif\\]" "\\[[0-9]+\\]")) (goto-char (point-min)) (while (re-search-forward rx nil t) (replace-match "" nil t))) (setq truncate-lines t) (goto-char (point-min))) ;;;###autoload (defun dict (w) (interactive (list (read-string "Dictionary Lookup: " (word-at-point)))) (m-w-lookup "dictionary" w "Main Entry")) ;;;###autoload (defun thesaurus (w) (interactive (list (read-string "Thesaurus Lookup: " (word-at-point)))) (m-w-lookup "thesaurus" w "Entry Word")) (provide 'dict) ;;; Below is another implementation from Stefan Monnier. ;;; Some of the suggested changes may be incoporated later. ; From: "Stefan Monnier" ; Sender: monnier@tequila.cs.yale.edu ; To: ttn@mingle.glug.org (thi) ; Subject: Re: dict.el 1.4 ; Date: Tue, 13 Jul 1999 19:55:21 -0400 ; ; > dict 1.4 is a result of some feedback by email and in gnu.emacs.help. ; > thanks go to those people (you know who you are). ; ; I have a few more changes: ; - I use the prefix arg to choose between `dict' and `thesaurus' ; - don't use "183" but ? instead (XEmacs does not accept an integer ; in lieu of a character) ; - use `subst-char-in-region' if you want to substitute a character, ; although I personally prefer to keep those ? characters (do they ; display badly on your screen ?) ; - don't use `switch-to-buffer' since it can badly fail on dedicated frames. ; - only display the buffer if something is found ; - use `narrow' instead of `delete' so that I can see the whole answer ; if I really want to. ; - in case the answer is short, shrink the resulting window (useful if you ; have pop-up-windows set) ; - always use the same buffer. I can use `rename-uniquely' if I really ; need to keep several definitions on screen. ; - use view-mode ; - generalized so you can configure it with several ; URLs for alternative dictionaries and the select among them with a ; prefix. A C-u prefix will allow to interactively choose ; among the dictionaries while a numerical prefix simply chooses the ; corresponding entry. With no prefix, it takes the first entry, ; An exception is made for the case where C-u is used and there are no more ; than 2 different dicts: the second one is taken. ; ; [ this code might rely on CL, I can't remember ] ; ; (defvar dict-dictionaries ; '(("dictionary-webster" ; "http://www.m-w.com/cgi-bin/dictionary?book=Dictionary&va=%s" ; "^Main Entry:\\s-+" "^\\s-+____+") ; ("thesaurus-webster" ; "http://www.m-w.com/cgi-bin/thesaurus?book=Thesaurus&va=%s" ; "^Entry Word:\\s-+" "^\\s-+____+"))) ; ; (defun dict2 (word &optional dict) ; (interactive ; (list (read-string "Lookup: " (word-at-point)) ; (if (consp current-prefix-arg) ; (if (< (length dict-dictionaries) 3) ; (first (first (last dict-dictionaries))) ; (or (completing-read "In dict: " dict-dictionaries nil t) ; (first (first dict-dictionaries)))) ; (car (nth (prefix-numeric-value (or current-prefix-arg 0)) ; dict-dictionaries))))) ; (let* ((case-fold-search t) ; (data (cdr (assoc dict dict-dictionaries)))) ; (with-current-buffer (get-buffer-create (format "*%s*" dict)) ; (setq buffer-read-only nil) ; (widen) ; (erase-buffer) ; (call-process "lynx" nil t nil "-dump" (format (first data) word)) ; ;;(subst-char-in-region (point-min) (point-max) ? ? t) ; (goto-char (point-min)) ; (let* ((start (re-search-forward (second data) nil t)) ; (end (and start (re-search-forward (third data) nil t)))) ; (if (and (not start) ; (re-search-forward "no entries found" nil t)) ; (message "Nothing found") ; (if start (narrow-to-region start (or end (point-max)))) ; (goto-char (point-min)) ; (view-mode 1) ; (pop-to-buffer (current-buffer)) ; (shrink-window-if-larger-than-buffer)))))) ; ; -- Stefan ;;; dict.el ends here