new repository

1 files changed, 414 insertions, 0 deletions

diff --git a/custom/sdcv-mode.el b/custom/sdcv-mode.el
new file mode 100644
index 00000000..bdb89cd6
--- /dev/null
+++ b/custom/sdcv-mode.el
@@ -0,0 +1,414 @@
+;;; sdcv-mode.el --- major mode to do dictionary query through sdcv
+
+;; Copyright 2006~2008 pluskid,
+;;           2011 gucong
+;;
+;; Author: pluskid <pluskid@gmail.com>,
+;;         gucong <gucong43216@gmail.com>
+;;
+;; This program 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 program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; This is a major mode to view output of dictionary search of sdcv.
+
+;; Put this file into your load-path and the following into your
+;; ~/.emacs:
+;;   (require 'sdcv-mode)
+;;   (global-set-key (kbd "C-c d") 'sdcv-search)
+
+;;; Changelog:
+
+;; 2012/01/02
+;;     * New variable: `sdcv-word-processor'
+;;     * Breaking change:
+;;       for `sdcv-dictionary-list' and `sdcv-dictionary-alist',
+;;       non-list (non-nil) value now means full dictionary list
+;;     * Rewrite `sdcv-search' for both interactive and non-interactive use
+;;     * `sdcv-dictionary-list' is left for customization use only
+;;     * Better highlighting.
+;;
+;; 2011/06/30
+;;     * New feature: parse output for failed lookup
+;;     * Keymap modification
+;;
+;; 2008/06/11
+;;     * sdcv-mode v 0.1 init (with background process)
+
+;;; Code:
+
+(require 'outline)
+(provide 'sdcv-mode)
+(eval-when-compile
+  (require 'cl))
+
+;;; ==================================================================
+;;; Frontend, search word and display sdcv buffer
+(defun sdcv-search (word &optional dict-list-name dict-list interactive-p)
+  "Search WORD through the command-line tool sdcv.
+The result will be displayed in buffer named with
+`sdcv-buffer-name' with `sdcv-mode' if called interactively.
+
+When provided with DICT-LIST-NAME, query `sdcv-dictionary-alist'
+to get the new dictionary list before search.
+Alternatively, dictionary list can be specified directly
+by DICT-LIST.  Any non-list value of it means using all dictionaries.
+
+When called interactively, prompt for the word.
+Prefix argument have the following meaning:
+If `sdcv-dictionary-alist' is defined, 
+use prefix argument to select a new DICT-LIST-NAME.
+Otherwise, prefix argument means using all dictionaries.
+
+Word may contain some special characters:
+    *       match zero or more characters
+    ?       match zero or one character
+    /       used at the beginning, for fuzzy search
+    |       used at the beginning, for data search
+    \       escape the character right after"
+  (interactive
+   (let* ((dict-list-name
+           (and current-prefix-arg sdcv-dictionary-alist
+                (completing-read "Select dictionary list: "
+                                 sdcv-dictionary-alist nil t)))
+          (dict-list
+           (and current-prefix-arg (not sdcv-dictionary-alist)))
+          (guess (or (and transient-mark-mode mark-active
+                          (buffer-substring-no-properties
+                           (region-beginning) (region-end)))
+                     (current-word nil t)))
+          (word (read-string (format "Search dict (default: %s): " guess)
+                             nil nil guess)))
+     (list word dict-list-name dict-list t)))
+  ;; init current dictionary list
+  (when (null sdcv-current-dictionary-list)
+    (setq sdcv-current-dictionary-list sdcv-dictionary-list))
+  ;; dict-list-name to dict-list
+  (when (and (not dict-list) dict-list-name)
+    (if (not sdcv-dictionary-alist)
+        (error "`sdcv-dictionary-alist' not defined"))
+    (setq dict-list
+          (cdr (assoc dict-list-name sdcv-dictionary-alist))))
+  ;; prepare new dictionary list
+  (when (and dict-list (not (equal sdcv-current-dictionary-list dict-list)))
+    (setq sdcv-current-dictionary-list dict-list)
+    ;; kill sdcv process
+    (and (get-process sdcv-process-name)
+         (kill-process (get-process sdcv-process-name)))
+    (while (get-process sdcv-process-name)
+      (sleep-for 0.01)))
+  (let ((result
+         (concat ">>>"
+          (mapconcat
+           (lambda (w) (sdcv-do-lookup w))
+           (if sdcv-word-processor
+               (let ((processed (funcall sdcv-word-processor word)))
+                 (if (listp processed) processed (list processed)))
+             (list word))
+           ">>>"))))
+    (if (not interactive-p)
+        result
+      (with-current-buffer (get-buffer-create sdcv-buffer-name)
+        (setq buffer-read-only nil)
+        (erase-buffer)
+        (insert result))
+      (sdcv-goto-sdcv)
+      (sdcv-mode)
+      (sdcv-mode-reinit))))
+
+(defun sdcv-list-dictionary ()
+  "Show available dictionaries."
+  (interactive)
+  (let (resize-mini-windows)
+    (shell-command "sdcv -l" sdcv-buffer-name)))
+
+(defvar sdcv-current-dictionary-list nil)
+
+(defun sdcv-generate-dictionary-argument ()
+  "Generate dictionary argument for sdcv from `sdcv-current-dictionary-list'
+and `sdcv-dictionary-path'."
+  (append
+   (and sdcv-dictionary-path (list "--data-dir" sdcv-dictionary-path))
+   (and (listp sdcv-current-dictionary-list)
+        (mapcan (lambda (dict)
+                  (list "-u" dict))
+                sdcv-current-dictionary-list))))
+
+;;; ==================================================================
+;;; utilities to switch from and to sdcv buffer
+(defvar sdcv-previous-window-conf nil
+  "Window configuration before switching to sdcv buffer.")
+(defun sdcv-goto-sdcv ()
+  "Switch to sdcv buffer in other window."
+  (interactive)
+  (unless (eq (current-buffer)
+	      (sdcv-get-buffer))
+    (setq sdcv-previous-window-conf (current-window-configuration)))
+  (let* ((buffer (sdcv-get-buffer))
+         (window (get-buffer-window buffer)))
+    (if (null window)
+        (switch-to-buffer-other-window buffer)
+      (select-window window))))
+(defun sdcv-return-from-sdcv ()
+  "Bury sdcv buffer and restore the previous window configuration."
+  (interactive)
+  (if (window-configuration-p sdcv-previous-window-conf)
+      (progn
+        (set-window-configuration sdcv-previous-window-conf)
+        (setq sdcv-previous-window-conf nil)
+        (bury-buffer (sdcv-get-buffer)))
+    (bury-buffer)))
+
+(defun sdcv-get-buffer ()
+  "Get the sdcv buffer. Create one if there's none."
+  (let ((buffer (get-buffer-create sdcv-buffer-name)))
+    (with-current-buffer buffer
+      (unless (eq major-mode 'sdcv-mode)
+        (sdcv-mode)))
+    buffer))
+
+;;; ==================================================================
+;;; The very major mode
+(defvar sdcv-mode-font-lock-keywords
+  '(
+    ;; dictionary name
+    ("^-->\\(.*\\)$" . (1 sdcv-hit-face))
+    ("^==>\\(.*\\)$" . (1 sdcv-failed-face))
+    ("^\\(>>>.*\\)$" . (1 sdcv-heading-face))
+    )
+  "Expressions to hilight in `sdcv-mode'")
+
+(defvar sdcv-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "q" 'sdcv-return-from-sdcv)
+    (define-key map (kbd "RET") 'sdcv-search)
+    (define-key map "a" 'show-all)
+    (define-key map "h" 'hide-body)
+    (define-key map "o" 'sdcv-toggle-entry)
+    (define-key map "n" 'sdcv-next-entry)
+    (define-key map "p" 'sdcv-previous-entry)
+    map)
+  "Keymap for `sdcv-mode'.")
+
+(define-derived-mode sdcv-mode nil "sdcv"
+  "Major mode to look up word through sdcv.
+\\{sdcv-mode-map}
+Turning on Text mode runs the normal hook `sdcv-mode-hook'."
+  (setq font-lock-defaults '(sdcv-mode-font-lock-keywords))
+  (setq buffer-read-only t)
+  (set (make-local-variable 'outline-regexp) "-->.*\n-->\\|==>\\|>>>")
+  (set (make-local-variable font-lock-string-face) nil)
+)
+
+(defun sdcv-mode-reinit ()
+  "Re-initialize buffer.
+Hide all entrys but the first one and goto
+the beginning of the buffer."
+  (ignore-errors
+    (setq buffer-read-only nil)
+    (sdcv-parse-failed)
+    (setq buffer-read-only t)
+    (hide-body)
+    (goto-char (point-min))
+    (forward-line 1)
+    (show-entry)))
+
+(defun sdcv-parse-failed ()
+  (goto-char (point-min))
+  (let (save-word)
+    (while (re-search-forward "^[0-9]+).*-->\\(.*\\)$" nil t)
+      (let ((cur-word (match-string-no-properties 1)))
+        (unless (string= save-word cur-word)
+          (setq save-word cur-word)
+          (re-search-backward "^\\(.\\)" nil t)
+          (match-string 1)
+          (insert (format "\n==>%s\n" save-word)))))))
+
+(defun sdcv-next-entry ()
+  (interactive)
+  (outline-next-heading)
+  (show-entry)
+  (recenter-top-bottom 0))
+(defun sdcv-previous-entry ()
+  (interactive)
+  (outline-previous-heading)
+  (show-entry)
+  (recenter-top-bottom 0))
+
+(defun sdcv-toggle-entry ()
+  (interactive)
+  (save-excursion
+    (outline-back-to-heading)
+    (if (not (outline-invisible-p (line-end-position)))
+        (hide-entry)
+      (show-entry))))
+
+;;; ==================================================================
+;;; Support for sdcv process in background
+(defun sdcv-do-lookup (word)
+  "Send the word to the sdcv process and return the result."
+  (let ((process (sdcv-get-process)))
+    (process-send-string process (concat word "\n"))
+    (with-current-buffer (process-buffer process)
+      (let ((i 0) rlt done)
+	(while (and (not done)
+		    (< i sdcv-wait-timeout))
+	  (when (sdcv-match-tail sdcv-word-prompts)
+	    (setq rlt (buffer-substring-no-properties (point-min)
+						      (point-max)))
+	    (setq done t))
+	  (when (sdcv-match-tail sdcv-choice-prompts)
+	    (process-send-string process "-1\n"))
+	  (unless done
+	    (sleep-for sdcv-wait-interval)
+	    (setq i (+ i sdcv-wait-interval))))
+	(unless (< i sdcv-wait-timeout)
+	  ;; timeout
+	  (kill-process process)
+	  (error "ERROR: timeout waiting for sdcv"))
+	(erase-buffer)
+    rlt))))
+
+(defvar sdcv-wait-timeout 2
+  "The max time (in seconds) to wait for the sdcv process to
+produce some output.")
+(defvar sdcv-wait-interval 0.01
+  "The interval (in seconds) to sleep each time to wait for
+sdcv's output.")
+
+(defconst sdcv-process-name "%sdcv-mode-process%")
+(defconst sdcv-process-buffer-name "*sdcv-mode-process*")
+
+(defvar sdcv-word-prompts '("Enter word or phrase: "
+			    "请输入单词或短语："
+			    "請輸入單字或片語：")
+  "A list of prompts that sdcv use to prompt for word.")
+
+(defvar sdcv-choice-prompts '("Your choice[-1 to abort]: "
+			      "您的选择为："
+			      "您的選擇為：")
+  "A list of prompts that sdcv use to prompt for a choice
+of multiple candicates.")
+
+(defvar sdcv-result-patterns '("^Found [0-9]+ items, similar to [*?/|]*\\(.+?\\)[*?]*\\."
+			      "^发现 [0-9]+ 条记录和 [*?/|]*\\(.+?\\)[*?]* 相似。"
+			      )
+  "A list of patterns to extract result word of sdcv. Special
+characters are stripped.")
+
+(defun sdcv-get-process ()
+  "Get or create the sdcv process."
+  (let ((process (get-process sdcv-process-name)))
+    (when (null process)
+      (with-current-buffer (get-buffer-create
+			    sdcv-process-buffer-name)
+	(erase-buffer)
+	(setq process (apply 'start-process
+			     sdcv-process-name
+			     sdcv-process-buffer-name
+			     sdcv-program-path
+			     (sdcv-generate-dictionary-argument)))
+	;; kill the initial prompt
+	(let ((i 0))
+	  (message "starting sdcv...")
+	  (while (and (not (sdcv-match-tail sdcv-word-prompts))
+		      (< i sdcv-wait-timeout))
+	    (sleep-for sdcv-wait-interval)
+	    (setq i (+ i sdcv-wait-interval)))
+	  (unless (< i sdcv-wait-timeout)
+	    ;; timeout
+	    (kill-process process)
+	    (error "ERROR: timeout waiting for sdcv"))
+	  (erase-buffer))))
+    process))
+
+(defun sdcv-buffer-tail (length)
+  "Get a substring of length LENGTH at the end of
+current buffer."
+  (let ((beg (- (point-max) length))
+	(end (point-max)))
+    (if (< beg (point-min))
+	(setq beg (point-min)))
+    (buffer-substring-no-properties beg end)))
+
+(defun sdcv-match-tail (prompts)
+  (let ((done nil)
+	(prompt nil))
+    (while (and (not done)
+		prompts)
+      (setq prompt (car prompts))
+      (setq prompts (cdr prompts))
+      (when (string-equal prompt
+                          (sdcv-buffer-tail (length prompt)))
+        (delete-region (- (point-max) (length prompt))
+                       (point-max))
+        (setq done t)))
+    done))
+
+
+;;;;##################################################################
+;;;;  User Options, Variables
+;;;;##################################################################
+
+(defvar sdcv-buffer-name "*sdcv*"
+  "The name of the buffer of sdcv.")
+(defvar sdcv-dictionary-list t
+  "A list of dictionaries to use.
+Each entry is a string denoting the name of a dictionary, which
+is then passed to sdcv through the '-u' command line option. 
+Any non-list value means using all the dictionaries.")
+(defvar sdcv-dictionary-alist nil
+  "An alist of dictionaries, used to interactively form
+dictionary list. It has the form:
+   ((\"full\" . t)
+    (\"group1\" \"dict1\" \"dict2\" ...)
+    (\"group2\" \"dict2\" \"dict3\"))
+Any cons cell here means using all dictionaries.
+")
+
+(defvar sdcv-program-path "sdcv"
+  "The path of sdcv program.")
+
+(defvar sdcv-dictionary-path nil
+  "The path of dictionaries.")
+
+(defvar sdcv-word-processor nil
+  "This is the function that take a word (stirng) 
+and return a word or a list of words for lookup by `sdcv-search'.
+All lookup result(s) will finally be concatenated together.
+
+`nil' value means do nothing with the original word.
+
+The following is an example.  This function takes the original word and
+compare whether simplified and traditional form of the word are the same.
+If not, look up both of the words.
+
+      (lambda (word)
+        (let ((sim (chinese-conv word \"simplified\"))
+              (tra (chinese-conv word \"traditional\")))
+          (if (not (string= sim tra))
+              (list sim tra)
+            word)))
+")
+
+(defvar sdcv-hit-face 'font-lock-type-face
+  "Face for search hits")
+(defvar sdcv-failed-face 'font-lock-keyword-face
+  "Face for suggestions for a failed lookup.")
+(defvar sdcv-heading-face 'highlight
+  "Face for heading of lookup")
+
+(provide 'sdcv-mode)
+;;; sdcv-mode.el ends here