From 8e935df99f161b7af70f4a679f01c98d09358ffd Mon Sep 17 00:00:00 2001 From: TEC Date: Sun, 26 Jul 2020 21:34:08 +0800 Subject: [PATCH] Add sdcv package (locally) for offline dictionary --- config.org | 27 +++ lisp/sdcv-mode.el | 413 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 440 insertions(+) create mode 100644 lisp/sdcv-mode.el diff --git a/config.org b/config.org index c67b34a..0b03f75 100644 --- a/config.org +++ b/config.org @@ -672,6 +672,26 @@ To make VLF available without delaying startup, we'll just load it in quiet mome (use-package! vlf-setup :defer-incrementally vlf-tune vlf-base vlf-write vlf-search vlf-occur vlf-follow vlf-ediff vlf) #+END_SRC +**** Definitions +Doom already loads =define-word=, and provides it's own definition service using +[[https://github.com/gromnitsky/wordnut][wordnut]]. However, using an offline dictionary possess a few compelling +advantages, namely: + + speed + + integration of multiple dictionaries +[[http://goldendict.org/][GoldenDict]] seems like the best option currently avalible, but lacks a CLI. +Hence, we'll fall back to [[https://dushistov.github.io/sdcv/][sdcv]] (a CLI version of StarDict) for now. +To interface with this, we'll use a local copy of [[https://github.com/gucong/emacs-sdcv][emacs-sdcv]] (to enable easy +modification). +#+BEGIN_SRC emacs-lisp +(package! sdcv-mode :recipe (:local-repo "lisp" :no-byte-compile t)) +#+END_SRC + +Given that a request for a CLI is the most upvoted issue on GitHub for +GoldenDict, it's likely we'll be able to switch from ~sdcv~ to that in the future. + +Since GoldenDict supports StarDict files, I expect this will be a relatively +painless switch. + *** Email It's nice to send out fancy HTML emails. The =org-msg= package allows to write emails in org mode, and send as an HTML multipart email. We can setup some CSS @@ -2339,6 +2359,13 @@ add package src directories to projectile. This isn't desirable in my opinion. "Return t if FILEPATH is within any of `projectile-ignored-projects'" (or (mapcar (lambda (p) (s-starts-with-p p filepath)) projectile-ignored-projects))) #+END_SRC +** StarDict +We start off my loading =sdcv-mode=, then we'll integrate it into pre-existing +definition functionality (like ~+lookup/dictionary-definition~). +#+BEGIN_SRC emacs-lisp +(use-package! sdcv-mode + :commands sdcv-search sdcv-list-dictionary) +#+END_SRC ** Smart Parentheses #+BEGIN_SRC emacs-lisp (sp-local-pair diff --git a/lisp/sdcv-mode.el b/lisp/sdcv-mode.el new file mode 100644 index 0000000..8430078 --- /dev/null +++ b/lisp/sdcv-mode.el @@ -0,0 +1,413 @@ +;;; sdcv-mode.el --- major mode to do dictionary query through sdcv + +;; Copyright 2006~2008 pluskid, +;; 2011 gucong +;; +;; Author: pluskid , +;; gucong +;; +;; 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") + +;;; sdcv-mode.el ends here