SiteMap Search ElispArea HowTo Glossary RecentChanges News Problems Suggestions

google-define.el

Download

;;; google-define.el --- Pull definitions from google and displays them in a buffer.

;;;; Copyright (c) 2007,2008,2009,2010,2011 Jeremy English <jhe@jeremyenglish.org>
;;;;
;;;; Permission to use, copy, modify, distribute, and sell this
;;;; software and its documentation for any purpose is hereby granted
;;;; without fee, provided that the above copyright notice appear in
;;;; all copies and that both that copyright notice and this
;;;; permission notice appear in supporting documentation.  No
;;;; representations are made about the suitability of this software
;;;; for any purpose.  It is provided "as is" without express or
;;;; implied warranty.
;;;;
;;;; Created: 08-February-2007
;;;;
;;;;
;;;; Pulls definitions from google and displays them in a buffer.
;;;;
;;;; google-define is the command to call to get a new definition.
;;;;
;;;; 2007-07-05 You can now search for definitions of terms such as
;;;; pig latin
;;;;
;;;; 2007-11-09 Kevin Brubeck Unhammer changed
;;;; google-define-parse-buffer so that it would use a temporary
;;;; buffer. Now google-define is a more helpful citizen, 'q' will
;;;; close the buffer and it doesn't steal focus.
;;;;
;;;; Since the major mode was just used to change the font colors it
;;;; was dropped and a call to font-lock-fontify-buffer sets the
;;;; colors now.
;;;;
;;;; 2008-01-09 Unicode support was added.
;;;;
;;;; 2008-01-25 I Replaced google-define-plus-space with
;;;; replace-regexp-in-string. Also, trimmed down
;;;; google-define-parse-buffer a bit.
;;;;
;;;; 2009-01-07 Bjørn Arild Mæland made a change that includes the
;;;; searched word in the buffer name, so that recurring definitions
;;;; will not make previous searches disappear.
;;;;
;;;; 2009-05-24 Added support for Aquamacs
;;;;
;;;; 2009-08-12 Bartuer sent in a patch for multiple language output.
;;;;
;;;; 2010-02-19 Kevin Brubeck Unhammer added code to clear read-only
;;;; properties on things at point.
;;;;
;;;; 2011-05-27 Updated to work with googles change to the define 
;;;; feature.

(require 'font-lock)

(defconst *google-define-html-entry-table*
  (list
   '(""" """ "\"")   '("&" "&" "&")     '("'" "&yow;" "'")
   '(">" ">" ">")      '(" " " " " ")   '("¡" "¡" "¡")
   '("¢" "¢" "¢")   '("£" "£" "£")  '("¤" "¤" "¤")
   '("¥" "¥" "¥")    '("¦" "¦" "¦") '("§" "§" "§")
   '("¨" "¨" "¨")    '("©" "©" "©")   '("ª" "ª" "ª")
   '("«" "«" "«")  '("¬" "¬" "¬")    '("­" "­" "­")
   '("®" "®" "®")    '("¯" "¯" "¯")   '("°" "°" "°")
   '("±" "±" "±") '("²" "²" "²")   '("³" "³" "³")
   '("´" "´" "´")  '("µ" "µ" "µ")  '("" "" "")
   '("·" "·" "·") '("¸" "¸" "¸")  '("¹" "¹" "¹")
   '("º" "º" "º")   '("»" "»" "»")  '("¼" "¼" "¼")
   '("½" "½" "½") '("¾" "¾" "¾") '("¿" "¿" "¿")
   '("À" "À" "À") '("Á" "Á" "Á") '("Â" "Â" "Â")
   '("Ã" "Ã" "Ã") '("Ä" "Ä" "Ä")   '("Å" "Å" "Å")
   '("Æ" "Æ" "Æ")  '("Ç" "Ç" "Ç") '("È" "È" "È")
   '("É" "É" "É") '("Ê" "Ê" "Ê")  '("Ë" "Ë" "Ë")
   '("Ì" "Ì" "Ì") '("Í" "Í" "Í") '("Î" "Î" "Î")
   '("Ï" "Ï" "Ï")   '("Ð" "Ð" "Ð")    '("Ñ" "Ñ" "Ñ")
   '("Ò" "Ò" "Ò") '("Ó" "Ó" "Ó") '("Ô" "Ô" "Ô")
   '("Õ" "Õ" "Õ") '("Ö" "Ö" "Ö")   '("×" "×" "×")
   '("Ø" "Ø" "Ø") '("Ù" "Ù" "Ù") '("Ú" "Ú" "Ú")
   '("Û" "Û" "Û")  '("Ü" "Ü" "Ü")   '("Ý" "Ý" "Ý")
   '("Þ" "Þ" "Þ")  '("ß" "ß" "ß")  '("à" "à" "à")
   '("á" "á" "á") '("â" "â" "â")  '("ã" "ã" "ã")
   '("ä" "ä" "ä")   '("å" "å" "å")  '("æ" "æ" "æ")
   '("ç" "ç" "ç") '("è" "è" "è") '("é" "é" "é")
   '("ê" "ê" "ê")  '("ë" "ë" "ë")   '("ì" "ì" "ì")
   '("í" "í" "í") '("î" "î" "î")  '("ï" "ï" "ï")
   '("ð" "ð" "ð")    '("ñ" "ñ" "ñ") '("ò" "ò" "ò")
   '("ó" "ó" "ó") '("ô" "ô" "ô")  '("õ" "õ" "õ")
   '("ö" "ö" "ö")   '("÷" "÷" "÷") '("ø" "ø" "ø")
   '("ù" "ù" "ù") '("ú" "ú" "ú") '("û" "û" "û")
   '("ü" "ü" "ü")   '("ý" "ý" "ý") '("þ" "þ" "þ")
   '("ÿ" "ÿ" "ÿ")   '("<" "<" "<")))

(defun google-define-number-entry (entry)
  (car entry))

(defun google-define-name-entry (entry)
  (cadr entry))

(defun google-define-ascii-entry (entry)
  (cadr (cdr entry)))

(defun google-define-replace-string (from-string to-string)
  (goto-char (point-min))
  (while (search-forward from-string nil t)
    (replace-match to-string nil t)))

(defun google-define-replace-html ()
  (dolist (x *google-define-html-entry-table*)
    (let ((ascii (google-define-ascii-entry x)))
      (google-define-replace-string
       (google-define-number-entry x) ascii)
      (google-define-replace-string
       (google-define-name-entry x) ascii))))

(defun google-define-replace-unicode ()
  (goto-char (point-min))
  (while (search-forward-regexp "&#\\([0-9]+\\);" nil t)
    (let* ((ucs (string-to-number (match-string 1)))
          (rep (char-to-string (or (decode-char 'ucs ucs) ?~))))
    (replace-match rep nil t))))

(defun google-define-get-command (host path)
  (let* ((timeout 180)
         (port 80) ;http
         (post-cmd
          (concat "GET " path " HTTP/1.0\r\n"
                  "Host: " host "\r\n"
                  "User-Agent: Emacs\r\n"
                  "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5\r\n"
                  "Accept-Language: en-us,en;q=0.5\r\n"
                  "Accept-Encoding: gzip,deflate\r\n"
                  "Accept-Charset: ISO-8859-1;q=0.7,*;q=0.7\r\n"
                  "\r\n"))
         proc buf)

    (unwind-protect
        (progn
          (setq proc (open-network-stream "url-get-command"
                                          "*url-get-buffer*"
                                          host
                                          port)
                buf (process-buffer proc))
          (process-send-string proc post-cmd)
          (message "Getting information from %s: waiting for response..." host)

          (while (equal (process-status proc) 'open)
            (unless (accept-process-output proc timeout)
              (delete-process proc)
              (error "Server error: timed out while waiting!")))

          (message "Response received: processing...")))

    ;; unwind-protect
    buf))

(defun google-define-parse-buffer (search-word data-buffer)
 "Pull all of the definitions out of the data returned from
google, and print in a temp-buffer"
 (let ((count 0)
       (header (concat "Definitions for " search-word))
       (temp-buffer-show-hook #'google-define-font-lock)
       (continue t))
   (with-output-to-temp-buffer 
       (concat "*Definitions: " search-word "*")
     (princ (concat header "\n\n"))
     (set-buffer data-buffer)
     (goto-char (point-min))
     (search-forward-regexp "<div class=std>" nil t) ;;Move to the div containing the definitions
     (while (and (search-forward-regexp "\\(<[^>]+>\\)\\([^<]+\\)" nil t) continue)
       (let ((tag (match-string 1))
             (definition 
               (replace-regexp-in-string "\\(\n\\|\r\\|\t\\)" "" 
                                         (match-string 2))))
         (princ
          (with-temp-buffer
            (setf fill-prefix "     ")
            (save-excursion
              ;;(insert (format "%s\n" tag))
              (cond
               ((string-equal tag "<li style=\"list-style:none\">")
                (setq count (+ 1 count))
                (insert (format "%3d. %s\n\n" count definition)))))
            (fill-paragraph nil)
            (google-define-replace-html)
            (google-define-replace-unicode)
            (buffer-string))))))
   (message header)))

(defun google-define-word-at-point ()
 (let ((word-at-point (thing-at-point 'word)))
   (set-text-properties 0 (length word-at-point) nil word-at-point)
   word-at-point))


(defun google-define ()
  "Ask google for the definition of a word.

If we have a current region use it's value as the default."
  (interactive)
  (let* ((search-word
          (read-from-minibuffer "Define: "
                                (google-define-word-at-point)))
        (data-buffer
         (google-define-get-command "www.google.com"
                          (concat
                           "/search?num=100&hl=en&defl=all&q=%22"
                           (replace-regexp-in-string " +" "\+" search-word)
                 "%22&ie=utf-8&oe=utf-8&aq=t&tbs=dfn:1"))))
    (google-define-parse-buffer search-word data-buffer)
    (kill-buffer data-buffer)))

(defconst google-define-font-lock-keywords
  (list
   (list "^Definitions.for.+$" '(0 font-lock-function-name-face))
   (list "^[A-Z].+$" '(0 font-lock-variable-name-face))
   (list "^\\s-+.+$" '(0 font-lock-string-face))))

(defun google-define-font-lock ()
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults
        '(google-define-font-lock-keywords t))
  (font-lock-fontify-buffer))

(provide 'google-define)