;;; oxford.el --- interface for oxford dictionary

;; Copyright (C) 2003  Free Software Foundation, Inc.

;; Author: Jerry <unidevel@hotpop.com>
;; Keywords: languages, i18n

;; This file 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 2, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Configuration:
;; add following code to your ~/.emacs file
;;   (add-to-list 'load-path "<oxford installation directory>")
;;   (require 'oxford)
;; How to use:
;;  M-x oxford    Searching for a word
;;  M-x oxford-mode   Enable oxford minor mode,
;;                    type C-h f oxford-mode see more help

;;; Code:
(defvar oxford-mode-map nil
  "Keymap for oxford mode.")

(defvar oxford-mode nil
	"nil disables oxford, non-nil enables.")

(make-variable-buffer-local 'oxford-mode)

(defvar *OXFORD-BUFFER* "*oxford*" "oxford dictionary buffer")

(defconst oxford-version "1.2.0"
  "oxford version number")

(defun oxford-version ()
  "Report the current version of emacs oxford in the minibuffer."
  (interactive)
  (message "Emacs oxford version %s" oxford-version))

(defun oxford-about ()
	"About emacs oxford"
	(interactive)
  (message "Emacs oxford is written by Jerry, 
Bug report to unidevel@hotpop.com,
Current version is %s." oxford-version))

(defface oxford-source-face
  (` ((((class grayscale) (background light))
       (:background "Gray90" :italic t :underline t))
      (((class grayscale) (background dark))
       (:foreground "Gray80" :italic t :underline t :bold t))
      (((class color) (background light)) 
       (:foreground "blue"))
      (((class color) (background dark)) 
       (:foreground "cyan" :bold t))
      (t (:bold t :underline t))))
  "Font lock face used to highlight sources of dictionary information."
  :group 'oxford-faces)

(defface oxford-query-word-face
  (` ((((class grayscale) (background light))
       (:background "Gray90" :bold t))
      (((class grayscale) (background dark))
       (:foreground "Gray80" :bold t))
      (((class color) (background light)) 
       (:foreground "forest green" :bold t))
      (((class color) (background dark)) 
       (:foreground "green" :bold t))
      (t (:bold t :underline t))))
  "Font lock face used to highlight the query word."
  :group 'oxford-faces)

(defface oxford-pronunciation-face
  (` ((((class grayscale) (background light))
       (:background "Gray90" :bold t))
      (((class grayscale) (background dark))
       (:foreground "Gray80" :bold t))
      (((class color) (background light)) 
       (:foreground "red"))
      (((class color) (background dark)) 
       (:foreground "yellow"))
      (t (:bold t :underline t))))
  "Font lock face used to highlight pronunciation information."
  :group 'oxford-faces)

(defface oxford-speech-part-face
  (` ((((class grayscale) (background light))
       (:background "Gray90" :underline t))
      (((class grayscale) (background dark))
       (:foreground "Gray80" :underline t ))
      (((class color) (background light)) 
       (:foreground "blue"))
      (((class color) (background dark)) 
       (:foreground "cyan"))
      (t (:bold t :underline t))))
  "Font lock face used to highlight part of speech information."
  :group 'oxford-faces)

(defface oxford-string-face
  (` ((((class grayscale) (background light))
       (:background "Gray90" :italic t ))
      (((class grayscale) (background dark))
       (:foreground "Gray80" :italic t ))
      (((class color) (background light)) 
       (:foreground "red" :italic t))
      (((class color) (background dark)) 
       (:foreground "yellow" :italic t))
      (t (:bold t :underline t))))
  "Font Lock mode face used to highlight strings and quotes."
  :group 'oxford-faces)

(defun oxford-get-word-from-point ()
	"get word from point"
	(current-word))

(defun oxford-make-face (word)
  (let (was)
    (goto-char (point-min))
    (let ((case-fold-search t) pos-list pos-re)
      (goto-char (point-min))
      (while (looking-at "\\s-")
        (delete-char 1))
      ;; now face highlighting for dictionary entries
      (setq pos-list
						(mapcar
						 '(lambda (arg)
								(mapconcat '(lambda (arg2) (if (string= arg2 ".") "\\." arg2)) 
													 (mapcar 'char-to-string arg)
													 ""))
						 '("n.?" "noun" "v.? ?\\(t\\|i\\)?.?" "verb" "adj.?" "adv.?" "cf.?" "conj.?" 
							 "pl.?" "fr.?" "syn.?" "c.?" "fem.?" "masc.?" "prep.?" "pron.?"
							 "oe.?" "f.?" "ant.?" "a." "l." "gr." "obs."
							 "See" "fml.?" "law.?" "u.?")))
      (setq pos-re 
						(concat "[^a-z]\\(" 
										(mapconcat '(lambda (arg)
																	(concat "\\(" arg "\\)")) pos-list "\\|") 
										"\\)[^a-z]"))
      (while (re-search-forward pos-re nil t)
        (add-text-properties (match-beginning 1) (match-end 1)
                             '(face oxford-speech-part-face)))
      (goto-char (point-min))
      (while (re-search-forward "``[^']+''" nil t)
        (add-text-properties (match-beginning 0) (match-end 0)
                             '(face  oxford-string-face)))
      (goto-char (point-min))
      (while (re-search-forward (concat "[^a-z]\\(" word "\\)[^a-z]") nil t)
        (add-text-properties (match-beginning 1) (match-end 1)
                             '(face oxford-query-word-face)))
      (goto-char (point-min))
      (while (re-search-forward (concat "^\\(/[^/]+/\\)") nil t)
        (add-text-properties (match-beginning 0) (match-end 0)
                             '(face oxford-speech-part-face)))
      (goto-char (point-min))
      (while (re-search-forward "^From \\(.*\\) :$" nil t)
        (add-text-properties (match-beginning 0) (match-end 0)
                             '(face oxford-source-face dictweb t))
        (end-of-line)
        (delete-char 1)
        (setq was (point))
        (if (re-search-forward "\\\\[^\\s-]+\\\\" nil t)
            (add-text-properties (match-beginning 0) (match-end 0)
                                 '(face oxford-pronunciation-face))
          (goto-char was)))
      (goto-char (point-min)))))

(defun oxford (&optional word)
	"oxford interface"
	(interactive (list (read-string "search for: "
																	(funcall 'oxford-get-word-from-point))))
	(save-excursion
		(let ((is-in-oxford-buffer nil)
					(old-buffer (buffer-name)))
			(if (string-equal *OXFORD-BUFFER* (buffer-name))
				(setq is-in-oxford-buffer t))
			(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
					(kill-buffer *OXFORD-BUFFER*))
			(call-process "oxford" nil *OXFORD-BUFFER* nil word)
			(if (not is-in-oxford-buffer)
					(switch-to-buffer-other-window *OXFORD-BUFFER*)
				(switch-to-buffer *OXFORD-BUFFER*))
			(goto-char (point-min))
			(replace-string "" "")
			(goto-char (point-min))
			(fill-region (point-min) (point-max) 'left t t)
			(font-lock-mode t)
			(oxford-make-face word)
			(use-local-map oxford-mode-map)
			(toggle-read-only t)
			(pop-to-buffer old-buffer)))
	)

(defun oxford-follow (word)
  "Lookup the word under point."
  (interactive (list (oxford-get-word-from-point)))
  (if (or (not word)
	  (string= word ""))
      (error "No word under point")
    (oxford word)))

(defun oxford-scroll-up ()
	"Scroll current oxford buffer up"
	(interactive)
	(save-selected-window
		(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
				(progn 
					(pop-to-buffer *OXFORD-BUFFER*)
					(scroll-up)))
		))

(defun oxford-scroll-down ()
	"Scroll current oxford buffer down"
	(interactive)
	(save-selected-window
		(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
				(progn 
					(pop-to-buffer *OXFORD-BUFFER*)
					(scroll-down)
					))
		))

(defun oxford-goto-beginning ()
	"Goto the beginning of oxford buffer"
	(interactive)
	(save-selected-window
		(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
				(progn 
					(pop-to-buffer *OXFORD-BUFFER*)
					(beginning-of-buffer))
			)
		))

(defun oxford-goto-end ()
	"Goto the end of oxford buffer"
	(interactive)
	(save-selected-window
		(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
				(progn 
					(pop-to-buffer *OXFORD-BUFFER*)
					(end-of-buffer))
			)
		))

(defun oxford-quit ()
	"Quit oxford minor mode"
	(interactive)
	(oxford-mode nil)
	)

(defun oxford-exit ()
	"Quit oxford minor mode and close oxford buffer"
	(interactive)
	(save-selected-window
		(oxford-quit)
		(if (buffer-live-p (get-buffer *OXFORD-BUFFER*))
				(progn
					(pop-to-buffer *OXFORD-BUFFER*)
					(kill-buffer *OXFORD-BUFFER*)
					(delete-window))
			)))

(if oxford-mode-map
    nil
  (setq oxford-mode-map (make-keymap))
  (suppress-keymap oxford-mode-map)
  (define-key oxford-mode-map " "    'oxford-scroll-up)
  (define-key oxford-mode-map "\177" 'oxford-scroll-down)
  (define-key oxford-mode-map ">"    'oxford-goto-end)
  (define-key oxford-mode-map "<"    'oxford-goto-beginning)
  (define-key oxford-mode-map "q"    'oxford-quit)
  (define-key oxford-mode-map "Q"    'oxford-exit)
  (define-key oxford-mode-map "s"    'oxford)
  (define-key oxford-mode-map "\r"   'oxford-follow)
  )


(define-minor-mode oxford-mode 
  "Minor mode for using oxford dictionary, when you want to use
 oxford in a buffer, use oxford-mode to enable oxford minor mode
 To submit a problem report, send mail to unidevel@hotpop.com
 
 ENTER lookup word at point
 C-m   lookup word at point
 s     query word at point
 q     quit oxford minor mode
 SPACE scoll down
 BACKSPACE scoll up
 <     goto the beginning of oxford buffer
 >     goto the end of oxford buffer

 To see what version of oxford you are running, enter
  `\\[oxford-version]'.
"
	t
	" oxford"
	oxford-mode-map
	(if oxford-mode
			(toggle-read-only t)
		(toggle-read-only nil))
	)

(provide 'oxford)
;;; oxford.el ends here
