diff options
author | Ryan Kavanagh <rak@rak.ac> | 2023-02-09 18:07:36 -0500 |
---|---|---|
committer | Ryan Kavanagh <rak@rak.ac> | 2023-02-09 18:07:36 -0500 |
commit | 150c9ccde7a8c6fca80e764c799df64b2d4a3271 (patch) | |
tree | c542bbbf1a817249467982a83d859746e0726826 /dot_emacs.d/local/dictem/dictem.el | |
parent | xidle is configured by xresources instead of in xinitrc (diff) | |
parent | Squashed 'dot_emacs.d/local/dictem/' content from commit 078e608 (diff) |
Merge commit 'bf77e060f17055a5efa6941be7a94cb278d3935c' as 'dot_emacs.d/local/dictem'
Diffstat (limited to '')
-rw-r--r-- | dot_emacs.d/local/dictem/dictem.el | 2028 |
1 files changed, 2028 insertions, 0 deletions
diff --git a/dot_emacs.d/local/dictem/dictem.el b/dot_emacs.d/local/dictem/dictem.el new file mode 100644 index 0000000..8602ca3 --- /dev/null +++ b/dot_emacs.d/local/dictem/dictem.el @@ -0,0 +1,2028 @@ +;;; dictem.el --- DICT protocol client (rfc-2229) for [X]Emacs + +;; This code was initially based on +;; dictionary.el written by Torsten Hilbrich <Torsten.Hilbrich@gmx.net> +;; but now probably doesn't contain original code. +;; Most of the code has been written +;; from scratch by Aleksey Cheusov <vle@gmx.net>, 2004-2008. +;; +;; DictEm 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 of the License, or +;; (at your option) any later version. +;; +;; DictEm 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., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA + +;;; Commentary: + +;; DICT protocol client (rfc-2229) for [X]Emacs + +;; NOTE! Documentation is in README file. +;; +;; Latest information about dictem project and sources +;; are available at +;; +;; http://freshmeat.net/projects/dictem +;; http://sourceforge.net/projects/dictem +;; http://mova.org/~cheusov/pub/dictem + +;;; Code: + +(require 'cl) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Custom Things ;;;;; + +(defgroup dictem nil + "Client for accessing the DICT server." + :tag "DictEm" + :group 'help + :group 'hypermedia) + +(defgroup dictem-faces nil + "Face options for dictem DICT client." + :tag "DictEm faces" + :group 'dictem + :group 'faces) + +(defcustom dictem-server nil + "The DICT server" + :group 'dictem + :type '(restricted-sexp :match-alternatives (stringp 'nil))) + +(defcustom dictem-port 2628 + "The port of the DICT server" + :group 'dictem + :type 'number) + +(defcustom dictem-client-prog "dict" + "The command line DICT client. +dictem accesses DICT server through this executable. +dict-1.9.14 or later (or compatible) is strongly recomented." + :group 'dictem + :type 'string) + +(defcustom dictem-client-prog-args-list nil + "A list of additional arguments (strings) passed to dict client. +For example '(\"--some-option\")." + :group 'dictem + :type 'list) + +(defcustom dictem-option-mime nil + "If `t' the OPTION MIME command (see RFC-2229 for details) +will be sent to the DICT server. i.e. \"dict\" program +will be run with \"-M\" option. +As a result server's response will be prepanded with MIME header +followed by a blank line. +Because of bugs in dict -M (version < 1.10.3) utility, +dict-1.10.3 or later is strongly recommended +" + :group 'dictem + :type 'boolean) + +(defcustom dictem-default-strategy nil + "The default search strategy." + :group 'dictem + :type 'string) + +(defcustom dictem-default-database nil + "The default database name." + :group 'dictem + :type 'string) + +(defcustom dictem-user-databases-alist + nil + "ALIST of user's \"virtual\"databases. +Valid value looks like this: +'((\"en-ru\" . (\"mueller7\" \"korolew_en-ru\")) + ((\"en-en\" . (\"foldoc\" \"gcide\" \"wn\"))) + ((\"gazetteer\" . \"gaz\"))) +" + :group 'dictem + :type '(alist :key-type string)) + +(defcustom dictem-exclude-databases + nil + "ALIST of regexps for databases +that will not appear in autocompletion list. +" + :group 'dictem + :type '(alist :key-type string)) + +(defcustom dictem-use-user-databases-only + nil + "If `t', only user's dictionaries from dictem-user-databases-alist +will be used by dictem-select-database" + :group 'dictem + :type 'boolean) + +(defcustom dictem-mode-hook + nil + "Hook run in dictem mode buffers." + :group 'dictem + :type 'hook) + +(defcustom dictem-use-existing-buffer + nil + "If `t' the `dictem-run' function will not create new *dictem* buffer. +Instead, existing buffer will be erased and used to show results. +" + :group 'dictem + :type 'boolean) + +(defcustom dictem-empty-initial-input + nil + "If `t' the `dictem-read-query' leave initial input empty" + :group 'dictem + :type 'boolean) + +(defcustom dictem-use-content-history t + "If not nil and dictem-use-existing-buffer is also not nil, +buffer content and (point) is saved in dictem-content-history variable +when DEFINE hyperlinks are accessed. +It is restored by dictem-last function. +On slow machines it may better to set this variable to nil" + :group 'dictem) + +;;;;; Faces ;;;;; + +(defface dictem-reference-definition-face + '((((background light)) (:foreground "blue")) + (((background dark)) (:foreground "cyan"))) + + "The face that is used for displaying a reference to +a phrase in a DEFINE search." + :group 'dictem-faces) + +(defface dictem-reference-m1-face + '((((background light)) (:foreground "darkgreen")) + (((background dark)) (:foreground "lightblue"))) + + "The face that is used for displaying a reference to +a phrase in a MATCH search." + :group 'dictem-faces) + +(defface dictem-reference-m2-face + '((((background light)) (:foreground "blue")) + (((background dark)) (:bold true :foreground "gray"))) + + "The face that is used for displaying a reference to +a single word in a MATCH search." + :group 'dictem-faces) + +(defface dictem-reference-dbname-face + '((((background light)) (:foreground "darkgreen")) + (((background dark)) (:bold t :foreground "white"))) + + "The face that is used for displaying a reference to database" + :group 'dictem-faces) + +(defface dictem-database-description-face + '((((background light)) (:bold t :foreground "darkblue")) + (((background dark)) (:bold t :foreground "white"))) + + "The face that is used for displaying a database description" + :group 'dictem-faces) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Variables ;;;;; + +(defconst dictem-version "1.0.4" + "DictEm version information.") + +(defvar dictem-strategy-alist + nil + "ALIST of search strategies") + +(defvar dictem-database-alist + nil + "ALIST of databases") + +(defvar dictem-strategy-history + nil + "List of strategies entered from minibuffer") + +(defvar dictem-database-history + nil + "List of database names entered from minibuffer") + +(defvar dictem-query-history + nil + "List of queries entered from minibuffer") + +(defvar dictem-last-database + "*" + "Last used database name") + +(defvar dictem-last-strategy + "." + "Last used strategy name") + +(defvar dictem-mode-map + nil + "Keymap for dictem mode") + +(defvar dictem-temp-buffer-name + "*dict-temp*" + "Temporary dictem buffer name") + +(defvar dictem-current-dbname + nil + "This variable keeps a database name of the definition +currently processed +by functions run from dictem-postprocess-each-definition-hook.") + +(defvar dictem-error-messages + nil + "A list of error messages collected by dictem-run") + +(defvar dictem-hyperlinks-alist + nil + "ALIST of hyperlinks collected from dictem buffer by +the function dictem-postprocess-collect-hyperlinks +(add this function to the hook dictem-postprocess-definition-hook). +This variable is local to buffer") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-prepand-special-strats (l) + (cons '(".") l)) + +(defun dictem-prepand-special-dbs (l) + (cons '("*") (cons '("!") l))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Functions ;;;;;; + +(defmacro save-dictem (&rest funs) + `(let ((dictem-port 2628) + (dictem-server nil) + (dictem-database-alist nil) + (dictem-strategy-alist nil) + (dictem-use-user-databases-only nil) + (dictem-user-databases-alist nil) + ) + (progn ,@funs) + )) + +(defun dictem-client-text () + "Returns a portion of text sent to the server for identifying a client" + (concat "dictem " dictem-version ", DICT client for emacs")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions related to userdb ;; + +(defun dictem-make-userdb (name short-name match define) + "Make user database object" + (list name 'dictem-userdb + short-name match define)) + +(defun dictem-userdb-p (obj) + "Returns t if obj is the dictem error object" + (and obj (listp obj) (cdr obj) (listp (cdr obj)) + (eq (cadr obj) 'dictem-userdb))) + +(defun dictem-userdb-member (obj name) + "Extract member from userdb object by its name" + (cond ((dictem-userdb-p obj) + (nth (cdr (assoc name + '(("name" . 0) ("short-name" . 2) + ("match" . 3) ("define" . 4)))) + obj)) + (t (error "Invalid type of argument")))) + +(defun dictem-userdb-DEFINE (buffer db query host port) + (let* ((fun (dictem-userdb-member db "define")) + (name (dictem-userdb-member db "name")) + (sname (dictem-userdb-member db "short-name")) + (ret (save-excursion (funcall fun query))) + (buf (dictem-get-buffer buffer))) + (save-excursion + (set-buffer buf) + (cond ((dictem-error-p ret) +; (insert "From " sname " [" name "]:\n\n" +; (dictem-error-message ret) "\n\n") +; (insert (dictem-error-message ret) "\n") + (insert (dictem-error-message ret) "\n") + (dictem-error-status ret)) + ((null ret) + (insert "No matches found" "\n") + 20) + ((listp ret) + (dolist (definition ret) + (insert "From " sname " [" name "]:\n\n" + (dictem-indent-string definition) "\n\n")) + 0) + ((stringp ret) + (insert "From " sname " [" name "]:\n\n" + (dictem-indent-string ret) "\n\n") + 0) + (t + (error "Invalid type of returned value1")))))) + +(defun dictem-userdb-MATCH (buffer db query strat host port) + (let* ((fun (dictem-userdb-member db "match")) + (name (dictem-userdb-member db "name")) + (ret (save-excursion (funcall fun query strat))) + (buf (dictem-get-buffer buffer))) + (save-excursion + (set-buffer buf) + (cond ((dictem-error-p ret) + (insert (dictem-error-message ret) "\n") + (dictem-error-status ret)) + ((listp ret) + (insert (concat name ":\n")) + (dolist (match ret); (insert (car db) ":\n" )) + (progn + (insert " " match "\n")) + ) + 0) + (t + (error "Invalid type of returned value2")))))) + +(defun dictem-userdb-SEARCH (buffer db query strat host port) + (let* ((funm (dictem-userdb-member db "match")) + (name (dictem-userdb-member db "name")) + (sname (dictem-userdb-member db "short-name")) + (sname nil) + (ret (funcall funm query strat)) + (buf (dictem-get-buffer buffer))) + (save-excursion + (set-buffer buf) + (cond ((dictem-error-p ret) + (insert (dictem-error-message ret) "\n") + (dictem-error-status ret)) + ((listp ret) + (dolist (match ret) + (dictem-userdb-DEFINE buffer db + match host port)) + 0) + (t + (error "Something strange happened")) + )))) + +(defun dictem-userdb-SHOW-INFO (buffer db host port) + (let ((sname (dictem-userdb-member db "short-name")) + (buf (dictem-get-buffer buffer))) + (save-excursion + (set-buffer buf) + (cond ((dictem-error-p sname) + (insert (dictem-error-message sname) "\n") + (dictem-error-status sname)) + ((stringp sname) + (insert sname) + 0) + (t + (error "Something strange happened")) + )))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions related to error object ;; + +(defun dictem-make-error (error_status &optional buffer-or-string) + "Creates dictem error object" + (cond + ((stringp buffer-or-string) + (list 'dictem-error error_status buffer-or-string)) + ((bufferp buffer-or-string) + (dictem-make-error + error_status + (save-excursion + (set-buffer buffer-or-string) + (goto-char (point-min)) + (dictem-get-line) + ))) + ((eq nil buffer-or-string) + (list 'dictem-error error_status buffer-or-string)) + (t + (error "Invalid type of argument")) + )) + +(defun dictem-error-p (OBJECT) + "Returns t if OBJECT is the dictem error object" + (and + (not (null OBJECT)) + (listp OBJECT) + (eq (car OBJECT) 'dictem-error) + )) + +(defun dictem-error-message (err) + "Extract error message from dictem error object" + (cond + ((dictem-error-p err) + (nth 2 err)) + (t + (error "Invalid type of argument")) + )) + +(defun dictem-error-status (err) + "Extract error status from dictem error object" + (cond + ((dictem-error-p err) + (nth 1 err)) + (t + (error "Invalid type of argument")) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-collect-matches () + ; nreverse, setcar and nconc are used to reduce a number of cons + (goto-char (point-min)) + (let ((dictem-temp nil)) + (loop + (let ((line (dictem-get-line))) + (if (string-match "^[^ ]+:" line) + (progn + (if (consp dictem-temp) + (setcar (cdar dictem-temp) + (nreverse (cadar dictem-temp)))) + (setq + dictem-temp + (cons + (list + (substring line (match-beginning 0) (- (match-end 0) 1)) + (nreverse + (dictem-tokenize (substring line (match-end 0))))) + dictem-temp))) + (if (consp dictem-temp) + (setcar (cdar dictem-temp) + (nconc (nreverse (dictem-tokenize line)) + (cadar dictem-temp)) + )) + )) + (if (or (> (forward-line 1) 0) + (> (current-column) 0)) + (return (nreverse dictem-temp))) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-get-buffer (buf) + (cond + ((bufferp buf) buf) + (buf (current-buffer)) + (t (get-buffer-create dictem-temp-buffer-name)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; call-process functions + +(defun dictem-local-dict-basic-option (host port option-mime) + (let ((server-host (if host host (dictem-get-server)))) + (append + (list "-P" "-") + (if server-host + (list "-h" server-host "-p" (dictem-get-port port))) + (if option-mime '("-M")) + dictem-client-prog-args-list + ))) + +(defun dictem-call-process (buffer host port args) + (let (coding-system + coding-system-for-read + coding-system-for-write) + (if (and (functionp 'coding-system-list) + (member 'utf-8 (coding-system-list))) + (setq coding-system 'utf-8)) + (setq coding-system-for-read coding-system) + (setq coding-system-for-write coding-system) + (apply 'call-process + `(,dictem-client-prog + nil + ,(dictem-get-buffer buffer) + nil + ,@(dictem-local-dict-basic-option host port nil) + ,@args + )))) + +(defun dictem-call-process-SHOW-SERVER (buffer host port) + (dictem-call-process buffer host port '("-I"))) + +(defun dictem-call-process-SHOW-INFO (buffer db host port) + (dictem-call-process buffer host port (list "-i" db))) + +(defun dictem-call-process-SHOW-STRAT (buffer host port) + (dictem-call-process buffer host port '("-S"))) + +(defun dictem-call-process-SHOW-DB (buffer host port) + (dictem-call-process buffer host port '("-D"))) + +(defun dictem-call-process-MATCH (buffer db query strat host port) + (dictem-call-process + buffer host port + (list "-m" + "-d" (if db db "*") + "-s" (if strat strat ".") + query))) + +(defun dictem-call-process-DEFINE (buffer db query host port) + (dictem-call-process + buffer host port + (list "-d" (if db db "*") query))) + +(defun dictem-call-process-SEARCH (buffer db query strat host port) + (dictem-call-process + buffer host port + (list "-d" (if db db "*") + "-s" (if strat strat ".") + query))) + +;;;;; GET Functions ;;;;; + +(defun dictem-get-matches (query &optional database strategy server port) + "Returns ALIST of matches" + (let ((exit_status + (dictem-call-process-MATCH nil database query strategy server port) + )) + (cond + ((= exit_status 20) ;20 means "no matches found", See dict(1) + (kill-buffer dictem-temp-buffer-name) + nil) + ((= exit_status 0) + (progn + (save-excursion + (set-buffer dictem-temp-buffer-name) + (let ((matches (dictem-collect-matches))) + (kill-buffer dictem-temp-buffer-name) + matches)))) + (t + (let + ((err (dictem-make-error exit_status + (get-buffer dictem-temp-buffer-name)))) + (kill-buffer dictem-temp-buffer-name) + err)) + ))) + +(defun dictem-get-strategies (&optional server port) + "Obtains strategy ALIST from a DICT server +and returns alist containing strategies and their descriptions" + (let ((exit_status + (dictem-call-process-SHOW-STRAT nil server port) + )) + (cond + ((= exit_status 0) + (save-excursion + (set-buffer dictem-temp-buffer-name) + (goto-char (point-min)) + (let ((regexp "^ \\([^ ]+\\) +\\(.*\\)$") + (l nil)) + (while (search-forward-regexp regexp nil t) + (setq l (cons + (list + (buffer-substring-no-properties + (match-beginning 1) (match-end 1)) + (buffer-substring-no-properties + (match-beginning 2) (match-end 2))) + l))) + (kill-buffer dictem-temp-buffer-name) + l))) + (t + (let + ((err (dictem-make-error exit_status + (get-buffer dictem-temp-buffer-name)))) + (kill-buffer dictem-temp-buffer-name) + err)) + ))) + +(defun dictem-get-databases (&optional server port) + "Obtains database ALIST from a DICT server +and returns alist containing database names and descriptions" + (let ((exit_status + (dictem-call-process-SHOW-DB nil server port) + )) + (cond + ((= exit_status 0) + (save-excursion + (set-buffer dictem-temp-buffer-name) + (goto-char (point-min)) + (let ((regexp "^ \\([^ ]+\\) +\\(.*\\)$") + (l nil)) + (while (search-forward-regexp regexp nil t) + (let ((dbname (buffer-substring-no-properties + (match-beginning 1) (match-end 1))) + (dbdescr (buffer-substring-no-properties + (match-beginning 2) (match-end 2)))) + (if (not (string= "--exit--" dbname)) + (setq l (cons (list dbname dbdescr) l))))) + (kill-buffer dictem-temp-buffer-name) + l))) + (t + (let + ((err (dictem-make-error exit_status + (get-buffer dictem-temp-buffer-name)))) + (kill-buffer dictem-temp-buffer-name) + err)) + ))) + +(defun dictem-get-default-strategy (&optional def-strat) + "Gets the default search strategy" + (if def-strat + def-strat + (if dictem-default-strategy + dictem-default-strategy + (if dictem-last-strategy + dictem-last-strategy + ".")))) + +(defun dictem-extract-dbname (database) + (cond + ((consp database) (dictem-extract-dbname (car database))) + ((stringp database) database) + (t (error "The database should be either stringp or consp")) + )) + +(defun dictem-get-default-database (&optional def-db) + "Returns the default database" + + (if def-db + (dictem-extract-dbname def-db) + (if dictem-default-database + (dictem-extract-dbname dictem-default-database) + (if dictem-last-database + (dictem-extract-dbname dictem-last-database) + "*")))) + +;;;;; Low Level Functions ;;;;; + +(defun dictem-db-should-be-excluded (dbname) + "Returns t if a dbname should is not interesting for user. +See dictem-exclude-databases variable" + (let ((ret nil)) + (dolist (re dictem-exclude-databases) + (if (string-match re dbname) + (setq ret t))) + ret)) + +(defun dictem-delete-alist-predicate (l pred) + "makes a copy of l with no items for which (pred item) is true" + (let ((ret nil)) + (dolist (item l) + (if (not (funcall pred (car item))) + (setq ret (cons item ret)))) + ret)) + +(defun dictem-get-line () + "Replacement for (thing-at-point 'line)" + (save-excursion + (buffer-substring-no-properties + (progn (beginning-of-line) (point)) + (progn (end-of-line) (point))))) + +(defun dictem-list2alist (l) + (cond + ((null l) nil) + (t (cons + (list (car l) nil) + (dictem-list2alist (cdr l)))))) + +(defun dictem-indent-string (str) + (let ((start 0)) + (while (string-match "\n" str start) + (progn + (setq start ( + 2 (match-end 0))) + (setq str (replace-match "\n " t t str))))) + (concat " " str)) + +(defun dictem-replace-spaces (str) + (while (string-match "[ \n][ \n]+" str) + (setq str (replace-match " " t t str))) + (if (string-match "^ +" str) + (setq str (replace-match "" t t str))) + (if (string-match " +$" str) + (setq str (replace-match "" t t str))) + str) + +(defun dictem-remove-value-from-alist (l) + (let ((ret nil)) + (dolist (i l) + (setq ret (cons (list (car i)) ret))) + (reverse ret) + )) +;(defun dictem-remove-value-from-alist (l) +; (cond +; ((symbolp l) l) +; (t (cons (list (caar l)) +; (dictem-remove-value-from-alist (cdr l)))))) + +(defun dictem-select (prompt alist default history) + (let* + ((completion-ignore-case t) + (str (completing-read + (concat prompt " [" default "]: ") + alist nil t nil history default)) + (str-cons (assoc str alist))) + (cond + ((and str-cons (consp str-cons) (cdr str-cons)) + str-cons) + ((and str-cons (consp str-cons)) + (car str-cons)) + (t nil)))) + +(defun dictem-tokenize (s) + (if (string-match "\"[^\"]+\"\\|[^ \"]+" s ) +; (substring s (match-beginning 0) (match-end 0)) + (cons (substring s (match-beginning 0) (match-end 0)) + (dictem-tokenize (substring s (match-end 0)))) + nil)) + +;(defun dictem-search-forward-regexp-cs (REGEXP &optional BOUND NOERROR COUNT) +; "Case-sensitive variant for search-forward-regexp" +; (let ((case-replace nil) +; (case-fold-search nil)) +; (search-forward-regexp REGEXP BOUND NOERROR COUNT))) + +;(defun dictem-replace-match-cs (NEWTEXT &optional FIXEDCASE LITERAL STRING SUBEXP) +; "Case-sensitive variant for replace-match" +; (let ((case-replace nil) +; (case-fold-search nil)) +; (replace-match NEWTEXT FIXEDCASE LITERAL STRING SUBEXP))) + +(defun dictem-get-port (&optional port) + (let ((p (if port port dictem-port))) + (cond + ((and (stringp p) (string= "" p)) 2628) + ((null p) 2628) + ((stringp p) p) + ((numberp p) (number-to-string p)) + (t (error "The value of dictem-port variable should be \ +either a string or a number")) + ))) + +(defun dictem-get-server () + (cond + ((and (stringp dictem-server) (string= "" dictem-server)) nil) + ((stringp dictem-server) dictem-server) + ((null dictem-server) nil) + (t (error "The value of dictem-server variable should be \ +either a string or a nil")) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Main Functions ;;;;; + +;;;;;; Functions for Initializing ;;;;;; + +(defun dictem-initialize-strategies-alist (&optional server port) + "Obtain strategy ALIST from a DICT server +and sets dictem-strategy-alist variable." + (interactive) + (setq dictem-strategy-alist (dictem-get-strategies + server + (dictem-get-port port)))) + +(defun dictem-initialize-databases-alist (&optional server port) + "Obtain database ALIST from a DICT server +and sets dictem-database-alist variable." + (interactive) + (setq dictem-database-alist + (dictem-get-databases server (dictem-get-port port))) + (if (dictem-error-p dictem-database-alist) + dictem-database-alist + (setq dictem-database-alist + (dictem-delete-alist-predicate + dictem-database-alist + 'dictem-db-should-be-excluded)))) + +(defun dictem-initialize () + "Initializes dictem, i.e. obtains +a list of available databases and strategiss from DICT server +and makes other tasks." + (interactive) + (let ((dbs (dictem-initialize-databases-alist)) + (strats (dictem-initialize-strategies-alist))) + (if (dictem-error-p dbs) + dbs strats))) + +(defun dictem-reinitialize-err () + "Initializes dictem if it is not initialized yet +and run (error ...) if an initialization fails" + (interactive) + (if (or (dictem-error-p dictem-database-alist) + (null dictem-database-alist)) + (if (dictem-error-p (dictem-initialize)) + (error (dictem-error-message dictem-database-alist))))) + +;;; Functions related to Minibuffer ;;;; + +(defun dictem-select-strategy (&optional default-strat) + "Switches to minibuffer and asks the user +to enter a search strategy." + (dictem-reinitialize-err) + (dictem-select + "strategy" + (dictem-prepand-special-strats + (dictem-remove-value-from-alist dictem-strategy-alist)) + (dictem-get-default-strategy default-strat) + 'dictem-strategy-history)) + +(defun dictem-select-database (spec-dbs user-dbs &optional default-db) + "Switches to minibuffer and asks user +to enter a database name." + (dictem-reinitialize-err) + (let* ((dbs (dictem-remove-value-from-alist dictem-database-alist)) + (dbs2 (if user-dbs + (if dictem-use-user-databases-only + dictem-user-databases-alist + (append dictem-user-databases-alist dbs) + ) + dbs))) + (dictem-select + "db" + (if spec-dbs (dictem-prepand-special-dbs dbs2) dbs2) + (dictem-get-default-database default-db) + 'dictem-database-history))) + +(defun dictem-read-query (&optional default-query) + "Switches to minibuffer and asks user to enter a query." + (if (featurep 'xemacs) + (read-string + (concat "query [" default-query "]: ") + nil 'dictem-query-history default-query) + (read-string + (concat "query [" default-query "]: ") + (if dictem-empty-initial-input nil default-query) + 'dictem-query-history default-query t))) + + +;;;;;;;; Hooks ;;;;;;;; + +(defcustom dictem-postprocess-definition-hook + nil + "Hook run in dictem mode buffers containing DEFINE result." + :group 'dictem + :type 'hook + :options '(dictem-postprocess-definition-separator + dictem-postprocess-definition-hyperlinks + dictem-postprocess-each-definition + dictem-postprocess-definition-remove-header + dictem-postprocess-collect-hyperlinks)) + +(defcustom dictem-postprocess-match-hook + nil + "Hook run in dictem mode buffers containing MATCH result." + :group 'dictem + :type 'hook + :options '(dictem-postprocess-match)) + +(defcustom dictem-postprocess-show-info-hook + nil + "Hook run in dictem mode buffers containing SHOW INFO result." + :group 'dictem + :type 'hook + :options '(dictem-postprocess-definition-hyperlinks + dictem-postprocess-collect-hyperlinks)) + +(defcustom dictem-postprocess-show-server-hook + nil + "Hook run in dictem mode buffers containing SHOW SERVER result." + :group 'dictem + :type 'hook) + +;;;;;;;; Search Functions ;;;;;;; + +(defun dictem-call-dict-internal (fun databases) + (let ((exit-status -1)) + (cond + ((null databases) 0) + ((stringp databases) + (dictem-call-dict-internal fun (list databases))) + ((listp databases) + (dolist (db databases) + (let ((ex_st (funcall fun db))) + (cond + ((= ex_st 0) + (setq exit-status 0)) + (t (if (/= 0 exit-status) + (setq exit-status ex_st))) + ))) + (if (= exit-status -1) 0 exit-status) + ) + (t (error "wrong type of argument")) + ) + )) + +;(defun dictem-call-dict-internal (fun databases) +; (dolist (db databases) +; (funcall fun db))) +; (funcall fun databases)) + +(defun dictem-make-url (host port database cmd_sign query &optional strategy) + "Returns dict:// URL" + (concat + "dict://" host ":" + (dictem-get-port (if port port "2628")) + "/" cmd_sign ":" query ":" database + (if strategy (concat ":" (if strategy strategy "."))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-base-do-selector (cmd hook &optional database &rest args) + (let* ((splitted-url nil) + (databases nil) + (user-db (assoc database dictem-user-databases-alist)) + ) + (goto-char (point-max)) + (cond ((dictem-userdb-p database) + (apply 'dictem-base-do-default-server + (append (list cmd hook database) args))) + + ((and database (listp database)) + (dictem-call-dict-internal + `(lambda (db) + (apply 'dictem-base-do-selector + (append (list ,cmd hook db) args))) + (cdr database)) + (setq dictem-last-database (car database))) + + ((and database (stringp database) + (setq splitted-url (dictem-parse-url database))) + (apply 'dictem-base-do-foreign-server + (append + (list cmd hook + (nth 1 splitted-url) + (dictem-get-port (nth 2 splitted-url)) + (nth 3 splitted-url)) + args))) + + (user-db + (let ((exit_status + (apply 'dictem-base-do-selector + (append + (list cmd hook user-db) args)))) + (progn + (setq dictem-last-database database) + exit_status) + )) + + (t + (apply 'dictem-base-do-default-server + (append (list cmd hook database) args))) + ))) + +(defun dictem-base-do-foreign-server (cmd hook server port database &rest args) + (let ((dictem-last-database nil) + (dictem-last-strategy nil)) + (save-dictem (setq dictem-server server) + (setq dictem-port port) + (setq database database) + (dictem-initialize) + (apply 'dictem-base-do-default-server + (append (list cmd hook database) args)) + ))) + +(defun dictem-base-do-default-server (cmd hook + &optional database query strategy) + (let* ((beg (point)) + (fun (if (dictem-userdb-p database) + (dictem-cmd2userdb cmd) + (dictem-cmd2function cmd))) + + (exit_status + (save-excursion (apply fun (append (list t) + (if database (list database)) + (if query (list query)) + (if strategy (list strategy)) + (list nil) (list nil)))) + )) + + (cond ((= 0 exit_status) + (save-excursion + (narrow-to-region beg (point-max)) + (run-hooks hook) + (widen))) + ((= 21 exit_status) + (save-excursion + (narrow-to-region beg (point-max)) + (run-hooks 'dictem-postprocess-match-hook) + (widen))) + (t + (if (/= beg (point)) + (setq dictem-error-messages + (append + (list + (dictem-make-url (dictem-get-server) + (dictem-get-port) database "?" query) + (buffer-substring-no-properties beg (point))) + dictem-error-messages))) + (kill-region beg (point)))) + + (if database (setq dictem-last-database database)) + (if strategy (setq dictem-last-strategy strategy)) + exit_status + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-base-search (databases query strategy) + "MATCH + DEFINE commands" + + (dictem-base-do-selector + "search" + 'dictem-postprocess-definition-hook + databases query strategy)) + +(defun dictem-base-define (databases query c) + "DEFINE command" + + (dictem-base-do-selector + "define" + 'dictem-postprocess-definition-hook + databases query)) + +(defun dictem-base-match (databases query strategy) + "MATCH command" + + (dictem-base-do-selector + "match" + 'dictem-postprocess-match-hook + databases query strategy)) + +(defun dictem-base-show-databases (a b c) + "SHOW DB command" + + (dictem-base-do-selector + "show-db" + nil)) + +(defun dictem-base-show-strategies (a b c) + "SHOW STRAT command" + + (dictem-base-do-selector + "show-strat" + nil)) + +(defun dictem-base-show-info (databases b c) + "SHOW INFO command" + + (dictem-base-do-selector + "show-info" + 'dictem-postprocess-show-info-hook + databases)) + +(defun dictem-base-show-server (a b c) + "SHOW SERVER command" + + (dictem-base-do-selector + "show-server" + 'dictem-postprocess-show-server-hook)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-get-error-message (exit_status) + (cond + ((= exit_status 0) "All is fine") + ((= exit_status 20) "No matches found") + ((= exit_status 21) "Approximate matches found") + ((= exit_status 22) "No databases available") + ((= exit_status 23) "No strategies available") + + ((= exit_status 30) "Unexpected response code from server") + ((= exit_status 31) "Server is temporarily unavailable") + ((= exit_status 32) "Server is shutting down") + ((= exit_status 33) "Syntax error, command not recognized") + ((= exit_status 34) "Syntax error, illegal parameters") + ((= exit_status 35) "Command not implemented") + ((= exit_status 36) "Command parameter not implemented") + ((= exit_status 37) "Access denied") + ((= exit_status 38) "Authentication failed") + ((= exit_status 39) "Invalid database name") + ((= exit_status 40) "Invalid strategy name") + ((= exit_status 41) "Connection to server failed") + (t (concat "Ooops!" (number-to-string exit_status))) + )) + +(defun dictem-local-internal (err-msgs exit_status) + (if err-msgs + (concat (car err-msgs) "\n" + (cadr err-msgs) + "\n" + (dictem-local-internal + (cddr err-msgs) + nil) + ) + (if exit_status + (dictem-get-error-message exit_status) + nil))) + +(defun dictem-generate-full-error-message (exit_status) + + (concat "Error messages:\n\n" + (dictem-local-internal dictem-error-messages exit_status))) + +(defun dictem-run (search-fun &optional database query strategy) + "Creates new *dictem* buffer and run search-fun" + + (let ((ex_status -1)) + + (defun dictem-local-run-functions (funs database query strategy) + (cond + ((functionp funs) + (let ((ex_st (funcall funs database query strategy))) + (if (/= ex_status 0) + (setq ex_status ex_st)))) + ((and (consp funs) (functionp (car funs))) + (dictem-local-run-functions (car funs) database query strategy) + (dictem-local-run-functions (cdr funs) database query strategy)) + ((null funs) + nil) + (t (error "wrong argument type")) + ) + ex_status) + + (let ((selected-window (frame-selected-window)) + ; here we remember values of variables local to buffer + (server dictem-server) + (port dictem-port) + (dbs dictem-database-alist) + (strats dictem-strategy-alist) + (user-dbs dictem-user-databases-alist) + (user-only dictem-use-user-databases-only) + (use-existing-buf dictem-use-existing-buffer) +; (option-mime dictem-option-mime) + (dict-buf nil) + ) + (cond + ((eq dictem-use-existing-buffer 'always) + (dictem-ensure-buffer)) + ((eq dictem-use-existing-buffer t) + (dictem-ensure-buffer)) + (t + (dictem)) + 0) + (setq dict-buf (buffer-name)) +; (set-buffer-file-coding-system coding-system) + (make-local-variable 'dictem-default-strategy) + (make-local-variable 'dictem-default-database) + (make-local-variable 'case-replace) + (make-local-variable 'case-fold-search) + + ; the following lines are to inherit values local to buffer + (set (make-local-variable 'dictem-server) server) + (set (make-local-variable 'dictem-port) port) + (set (make-local-variable 'dictem-database-alist) dbs) + (set (make-local-variable 'dictem-strategy-alist) strats) + (set (make-local-variable 'dictem-user-databases-alist) user-dbs) + (set (make-local-variable 'dictem-use-user-databases-only) user-only) + (set (make-local-variable 'dictem-use-existing-buffer) use-existing-buf) + +; (set (make-local-variable 'dictem-option-mime) option-mime) + + (set (make-local-variable 'dictem-hyperlinks-alist) nil) + + ;;;;;;;;;;;;;; + (setq case-replace nil) + (setq case-fold-search nil) + (setq dictem-error-messages nil) + (dictem-local-run-functions search-fun database query strategy) + (switch-to-buffer dict-buf) + (if (and (not (equal ex_status 0)) (= (point-min) (point-max))) + (insert (dictem-generate-full-error-message ex_status))) + (goto-char (point-min)) + (setq buffer-read-only t) + ex_status + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun dictem-next-section () + "Move point to the next definition" + (interactive) + (forward-char) + (if (search-forward-regexp "^From " nil t) + (beginning-of-line) + (goto-char (point-max)))) + +(defun dictem-previous-section () + "Move point to the previous definition" + (interactive) + (backward-char) + (if (search-backward-regexp "^From " nil t) + (beginning-of-line) + (goto-char (point-min)))) + +(defun dictem-hyperlinks-menu () + "Hyperlinks menu with autocompletion" + (interactive) + (let ((link (completing-read "Go to:" dictem-hyperlinks-alist))) + (if (and link (setq link (assoc link dictem-hyperlinks-alist))) + (dictem-run-define + (cadr link) + dictem-last-database)) + )) + +(defun dictem-next-link () + "Move point to the next hyperlink" + (interactive) + (let ((pt nil) + (limit (point-max))) + (if (and (setq pt (next-single-property-change + (point) 'link nil limit)) + (/= limit pt)) + (if (get-char-property pt 'link) + (goto-char pt) + (goto-char (next-single-property-change pt 'link nil limit)))) + )) + +(defun dictem-previous-link () + "Move point to the previous hyperlink" + (interactive) + (let ((pt nil) + (limit (point-min))) + (if (and (setq pt (previous-single-property-change + (point) 'link nil limit)) + (/= limit pt)) + (if (get-char-property pt 'link) + (goto-char pt) + (goto-char (previous-single-property-change pt 'link nil limit)))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun dictem-help () + "Display a dictem help" + (interactive) + (describe-function 'dictem-mode)) + +(defun dictem-mode () + "This is a mode for dict client implementing +the protocol defined in RFC 2229. + +The following basic commands are available in the buffer. + + \\[dictem-help] display the help information + + \\[dictem-kill] kill the dictem buffer + \\[dictem-kill-all-buffers] kill all dictem buffers + \\[dictem-quit] bury the dictem buffer + + \\[dictem-last] restore content of the previously visited dictem buffer + + \\[dictem-run-search] make a new SEARCH, i.e. ask for a database, strategy and query + and show definitions + \\[dictem-run-match] make a new MATCH, i.e. ask for database, strategy and query + and show matches + \\[dictem-run-define] make a new DEFINE, i.e. ask for a database and query + and show definitions + \\[dictem-run-show-server] show information about DICT server + \\[dictem-run-show-info] ask for a database and show information about it + \\[dictem-run-show-databases] show databases DICT server provides + \\[dictem-run-show-strategies] show search strategies DICT server provides + + \\[dictem-next-section] move point to the next definition + \\[dictem-previous-section] move point to the previous definition + \\[dictem-next-link] move point to the next hyper link + \\[dictem-previous-link] move point to the previous hyper link + + \\[dictem-hyperlinks-menu] display the menu with hyperlinks + + \\[scroll-up] scroll dictem buffer up + \\[scroll-down] scroll dictem buffer down + \\[dictem-define-on-click] or \\[dictem-define-on-press] visit a link (DEFINE using all dictionaries) + + +Also some advanced commands are available. + + \\[dictem-initialize] Initializes dictem, i.e. obtains +a list of available databases and strategiss from DICT server +and makes other tasks + \\[dictem-initialize-strategies-alist] Obtain strategy ALIST from a DICT server and sets dictem-strategy-alist variable + \\[dictem-initialize-databases-alist] Obtain database ALIST from a DICT server and sets dictem-database-alist variable + + +The following key bindings are currently in effect in the buffer: +\\{dictem-mode-map} +" + + (interactive) + + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map dictem-mode-map) + (setq major-mode 'dictem-mode) + (setq mode-name "dictem") + + (add-hook 'kill-buffer-hook 'dictem-kill t t) + (run-hooks 'dictem-mode-hook) + ) + +(defvar dictem-window-configuration + nil + "The window configuration to be restored upon closing the buffer") + +(defvar dictem-selected-window + nil + "The currently selected window") + +(defvar dictem-content-history + nil + "A list of lists (buffer_content point)") + +(defconst dictem-buffer-name + "*dictem buffer*") + +(defconst dictem-url-regexp + "^\\(dict\\)://\\([^/:]*\\)\\(:\\([0-9]+\\)\\)?/\\(.*\\)$") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst dictem-cmd2function-alist + '(("show-server" dictem-call-process-SHOW-SERVER) + ("show-info" dictem-call-process-SHOW-INFO) + ("show-strat" dictem-call-process-SHOW-STRAT) + ("show-db" dictem-call-process-SHOW-DB) + ("match" dictem-call-process-MATCH) + ("define" dictem-call-process-DEFINE) + ("search" dictem-call-process-SEARCH) + )) + +(defconst dictem-cmd2userdb-alist + '(("match" dictem-userdb-MATCH) + ("define" dictem-userdb-DEFINE) + ("search" dictem-userdb-SEARCH) + ("show-info" dictem-userdb-SHOW-INFO) + )) + +(defun dictem-cmd2xxx (cmd alist) + (let ((fun (assoc cmd alist))) + (if fun + (symbol-function (cadr fun)) + (error "Unknown command \"%s\"" cmd) + ) + )) + +(defun dictem-cmd2function (cmd) + (dictem-cmd2xxx cmd dictem-cmd2function-alist)) +(defun dictem-cmd2userdb (cmd) + (dictem-cmd2xxx cmd dictem-cmd2userdb-alist)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun dictem-parse-url (url) + "Parses string like dict://dict.org:2628/foldoc +and returns a list containing protocol, server, port and path on nil if fails" + (if (string-match dictem-url-regexp url) + (list + (match-string 1 url) ; protocol + (match-string 2 url) ; host + (match-string 4 url) ; port + (match-string 5 url) ; path (database name for dict://) + ) + nil)) + +(defun dictem () + "Create a new dictem buffer and install dictem-mode" + (interactive) + + (let ( + (buffer (generate-new-buffer dictem-buffer-name)) + (window-configuration (current-window-configuration)) + (selected-window (frame-selected-window))) + (switch-to-buffer-other-window buffer) + (dictem-mode) + + (make-local-variable 'dictem-window-configuration) + (make-local-variable 'dictem-selected-window) + (make-local-variable 'dictem-content-history) + (setq dictem-window-configuration window-configuration) + (setq dictem-selected-window selected-window) + )) + +;(unless dictem-mode-map +(setq dictem-mode-map (make-sparse-keymap)) +(suppress-keymap dictem-mode-map) + +; Kill the buffer +(define-key dictem-mode-map "k" 'dictem-kill) + +; Kill all dictem buffers +(define-key dictem-mode-map "x" 'dictem-kill-all-buffers) + +; Bury the buffer +(define-key dictem-mode-map "q" 'dictem-quit) + +; LAST, works like in Info-mode +(define-key dictem-mode-map "l" 'dictem-last) + +; Show help message +(define-key dictem-mode-map "h" 'dictem-help) + +; SEARCH = MATCH + DEFINE +(define-key dictem-mode-map "s" 'dictem-run-search) + +; MATCH +(define-key dictem-mode-map "m" 'dictem-run-match) + +; DEFINE +(define-key dictem-mode-map "d" 'dictem-run-define) + +; SHOW SERVER +(define-key dictem-mode-map "r" 'dictem-run-show-server) + +; SHOW INFO +(define-key dictem-mode-map "i" 'dictem-run-show-info) + +; Move point to the next DEFINITION +(define-key dictem-mode-map "n" 'dictem-next-section) + +; Move point to the previous DEFINITION +(define-key dictem-mode-map "p" 'dictem-previous-section) + +; Move point to the next HYPER LINK +(define-key dictem-mode-map "\M-n" 'dictem-next-link) + +; Move point to the previous HYPER LINK +(define-key dictem-mode-map "\M-p" 'dictem-previous-link) + +; Hyperlinks menu +(define-key dictem-mode-map "e" 'dictem-hyperlinks-menu) + +; Scroll up dictem buffer +(define-key dictem-mode-map " " 'scroll-up) + +; Scroll down dictem buffer +(define-key dictem-mode-map "\177" 'scroll-down) + +; Define on click +(if (featurep 'xemacs) + (define-key dictem-mode-map [button2] + 'dictem-define-on-click) + (define-key dictem-mode-map [mouse-2] + 'dictem-define-on-click)) + +(define-key dictem-mode-map "\C-m" + 'dictem-define-on-press) + +(defun dictem-mode-p () + "Return non-nil if current buffer has dictem-mode" + (eq major-mode 'dictem-mode)) + +(defun dictem-ensure-buffer () + "If current buffer is not a dictem buffer, create a new one." + (if (dictem-mode-p) + (progn + (if dictem-use-content-history + (setq dictem-content-history + (cons (list (buffer-substring + (point-min) (point-max)) + (point)) dictem-content-history))) + (setq buffer-read-only nil) + (erase-buffer)) + (dictem))) + +(defun dictem-quit () + "Bury the current dictem buffer." + (interactive) + (if (featurep 'xemacs) + (bury-buffer) + (quit-window))) + +(defun dictem-kill () + "Kill the current dictem buffer." + (interactive) + + (if (eq major-mode 'dictem-mode) + (progn + (setq major-mode nil) + (let ((configuration dictem-window-configuration) + (selected-window dictem-selected-window)) + (kill-buffer (current-buffer)) + (if (window-live-p selected-window) + (progn + (select-window selected-window) + (set-window-configuration configuration))))))) + +(defun dictem-last () + "Go back to the last buffer visited visited." + (interactive) + (if (eq major-mode 'dictem-mode) + (if dictem-content-history + (progn + (setq buffer-read-only nil) + (delete-region (point-min) (point-max)) + (insert (car (car dictem-content-history))) + (goto-char (cadr (car dictem-content-history))) + (setq dictem-content-history (cdr dictem-content-history)) + ) + ) + )) + +(defun dictem-kill-all-buffers () + "Kill all dictem buffers." + (interactive) + (dolist (buffer (buffer-list)) + (let ((buf-name (buffer-name buffer))) + (if (and (<= (length dictem-buffer-name) (length buf-name)) + (string= dictem-buffer-name + (substring buf-name 0 (length dictem-buffer-name)))) + (kill-buffer buf-name)) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Top-level Functions ;;;;;; + +(defun dictem-run-match (query database strat) + "Asks a user about database name, search strategy and query, +creates new *dictem* buffer and +shows matches in it." + (interactive + (list + (dictem-read-query (thing-at-point 'word)) + (dictem-select-database t t (dictem-get-default-database)) + (dictem-select-strategy (dictem-get-default-strategy)))) + (dictem-run 'dictem-base-match database query strat)) + +(defun dictem-run-define (query database) + "Asks a user about database name and query, +creates new *dictem* buffer and +shows definitions in it." + (interactive + (list + (dictem-read-query (thing-at-point 'word)) + (dictem-select-database t t (dictem-get-default-database)))) + (dictem-run 'dictem-base-define database query nil)) + +(defun dictem-run-search (query database strat) + "Asks a user about database name, search strategy and query, +creates new *dictem* buffer and +shows definitions in it." + (interactive + (list + (dictem-read-query (thing-at-point 'word)) + (dictem-select-database t t (dictem-get-default-database)) + (dictem-select-strategy (dictem-get-default-strategy)))) + (dictem-run 'dictem-base-search database query strat)) + +(defun dictem-run-show-info (database) + "Asks a user about database name +creates new *dictem* buffer and +shows information about it." + (interactive (list + (dictem-select-database + nil nil + (dictem-get-default-database)))) + (dictem-run 'dictem-base-show-info database)) + +(defun dictem-run-show-server () + "Creates new *dictem* buffer and +shows information about DICT server in it." + (interactive) + (dictem-run 'dictem-base-show-server)) + +(defun dictem-run-show-databases () + "Creates new *dictem* buffer and +shows a list of databases provided by DICT." + (interactive) + (dictem-run 'dictem-base-show-databases)) + +(defun dictem-run-show-strategies () + "Creates new *dictem* buffer and +shows a list of search stratgeies provided by DICT." + (interactive) + (dictem-run 'dictem-base-show-strategies)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(easy-menu-define + dictem-menu + dictem-mode-map + "DictEm Menu" + `("DictEm" + ["DictEm..." dictem-help t] + "--" + ["Next Section" dictem-next-section t] + ["Previous Section" dictem-previous-section t] + "--" + ["Match" dictem-run-match t] + ["Definition" dictem-run-define t] + ["Search" dictem-run-search t] + "--" + ["Information about server" dictem-run-show-server t] + ["Information about database" dictem-run-show-info t] + ["A list of available databases" dictem-run-show-databases t] + "--" + ["Bury Dictem Buffer" dictem-quit t] + ["Kill Dictem Buffer" dictem-kill t] + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;; Optional Features ;;;;; +(defun dictem-create-link (start end face function &optional data add-props) + "Create a link in the current buffer starting from `start' going to `end'. +The `face' is used for displaying, the `data' are stored together with the +link. Upon clicking the `function' is called with `data' as argument." + (let ((properties + (append (list 'face face + 'mouse-face 'highlight + 'link-data data + 'link-function function + 'dictem-server dictem-server + 'dictem-port dictem-port) + add-props))) + (remove-text-properties start end properties) + (add-text-properties start end properties))) + +;;;;;;; Postprocessing Functions ;;;;;;; + +(defun dictem-postprocess-definition-separator () + (save-excursion + (goto-char (point-min)) + (let ((regexp "^\\(From\\)\\( [^\n]+\\)\\(\\[[^\n]+\\]\\)")) + + (while (search-forward-regexp regexp nil t) + (let ((beg (match-beginning 1)) + (end (match-end 1)) + (beg-dbdescr (match-beginning 2)) + (end-dbdescr (match-end 2)) + (beg-dbname (match-beginning 3)) + (end-dbname (match-end 3)) + ) + (put-text-property beg end + 'face 'dictem-database-description-face) + (put-text-property beg-dbdescr end-dbdescr + 'face 'dictem-database-description-face) + (setq dictem-current-dbname + (dictem-replace-spaces + (buffer-substring-no-properties + (+ beg-dbname 1) (- end-dbname 1)))) + (dictem-create-link + beg-dbname end-dbname + 'dictem-reference-dbname-face + 'dictem-base-show-info + (list (cons 'dbname dictem-current-dbname)))) + )))) + +(defvar dictem-hyperlink-beginning + "{" + "String that begins hyperlink. +This variable is used by +the function 'dictem-postprocess-definition-hyperlinks'") + +(defvar dictem-hyperlink-end + "}" + "String that ends hyperlink. +This variable is used by +the function 'dictem-postprocess-definition-hyperlinks'") + +(defvar dictem-hyperlink-define-func + 'dictem-base-define + "Function called when user clicks on hyperlinks inside the definition. +This variable is used by +the function 'dictem-postprocess-definition-hyperlinks'") + +(defun dictem-postprocess-collect-hyperlinks () + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat "\\(" dictem-hyperlink-beginning "\\([^{}|]+\\)" + dictem-hyperlink-end + "\\|\\(" dictem-hyperlink-beginning + "\\([^{}|\n]+\\)|\\([^{}|\n]+\\)" dictem-hyperlink-end + "\\)\\)"))) + + (while (search-forward-regexp regexp nil t) + (cond ((match-beginning 2) + (let* ((word (dictem-replace-spaces + (buffer-substring-no-properties + (match-beginning 2) + (match-end 2))))) + (setq dictem-hyperlinks-alist + (cons (list word word) dictem-hyperlinks-alist)) + )) + ((match-beginning 3) + (let* ((word-beg (match-beginning 4)) + (word-end (match-end 4)) + (link-beg (match-beginning 5)) + (link-end (match-end 5)) + (word (dictem-replace-spaces + (buffer-substring-no-properties + word-beg word-end))) + (link (dictem-replace-spaces + (buffer-substring-no-properties + link-beg link-end))) + ) + (setq dictem-hyperlinks-alist + (cons (list word link) dictem-hyperlinks-alist)) + ))))) + )) + +(defun dictem-find-brackets (re-beg re-end) + (let ((beg-beg (make-marker)) + (beg-end (make-marker)) + (end-beg (make-marker)) + (end-end (make-marker))) + (if (search-forward-regexp re-beg nil t) + (progn + (set-marker beg-beg (match-beginning 0)) + (set-marker beg-end (match-end 0)) + (if (search-forward-regexp re-end nil t) + (progn + (set-marker end-beg (match-beginning 0)) + (set-marker end-end (match-end 0)) + (list beg-beg beg-end end-beg end-end)) + nil)) + nil))) + +(defun dictem-postprocess-definition-hyperlinks-cyrlybr1 () + (save-excursion + (goto-char (point-min)) + (let ((regexp) (pos) (beg1) (beg2) (beg3) (end) (word)) + + (while (setq pos (dictem-find-brackets dictem-hyperlink-beginning + dictem-hyperlink-end)) + (delete-region (nth 0 pos) (nth 1 pos)) + (delete-region (nth 2 pos) (nth 3 pos)) + (setq word (buffer-substring-no-properties (nth 1 pos) (nth 2 pos))) + (dictem-create-link + (nth 1 pos) (nth 2 pos) + 'dictem-reference-definition-face + dictem-hyperlink-define-func + (list (cons 'word (dictem-replace-spaces word)) + (cons 'dbname dictem-current-dbname)) + '(link t)))))) + +(defun dictem-postprocess-definition-hyperlinks-curlybr2 () + (save-excursion + (goto-char (point-min)) + (let ((regexp + (concat dictem-hyperlink-beginning "\\([^{}|\n]+\\)|\\([^{}|\n]+\\)" + dictem-hyperlink-end))) + + (while (search-forward-regexp regexp nil t) + (let* ((beg (match-beginning 5)) + (end (match-end 5)) + (match-beg (match-beginning 3)) + (repl-beg (match-beginning 4)) + (repl-end (match-end 4)) + (repl (buffer-substring-no-properties repl-beg repl-end)) + (word (buffer-substring-no-properties beg end))) + (replace-match repl t t) + (dictem-create-link + match-beg (+ match-beg (length repl)) + 'dictem-reference-definition-face + dictem-hyperlink-define-func + (list (cons 'word (dictem-replace-spaces word)) + (cons 'dbname dictem-current-dbname)) + '(link t))))))) + +(defun dictem-postprocess-definition-hyperlinks () + (dictem-postprocess-definition-hyperlinks-cyrlybr1) + (dictem-postprocess-definition-hyperlinks-curlybr2) +; (dictem-postprocess-definition-hyperlinks-curlybr2) + ) + +(defun dictem-postprocess-match () + (save-excursion + (goto-char (point-min)) + (let ((last-database dictem-last-database) + (regexp "\\(\"[^\"\n]+\"\\)\\|\\([^ \"\n]+\\)")) + + (while (search-forward-regexp regexp nil t) + (let* ((beg (match-beginning 0)) + (end (match-end 0)) + (first-char (buffer-substring-no-properties beg beg))) + (cond + ((save-excursion (goto-char beg) (= 0 (current-column))) + (setq last-database + (dictem-replace-spaces + (buffer-substring-no-properties beg (- end 1)))) + (dictem-create-link + beg (- end 1) + 'dictem-reference-dbname-face 'dictem-base-show-info + (list (cons 'dbname last-database)))) + ((match-beginning 1) + (dictem-create-link + beg end + 'dictem-reference-m1-face 'dictem-base-define + (list (cons 'word + (dictem-replace-spaces + (buffer-substring-no-properties + (+ beg 1) (- end 1)))) + (cons 'dbname last-database)))) + (t + (dictem-create-link + beg end + 'dictem-reference-m2-face 'dictem-base-define + (list (cons 'word + (dictem-replace-spaces + (buffer-substring-no-properties + beg end ))) + (cons 'dbname last-database)))) + )))))) + +(defun dictem-postprocess-definition-remove-header () + (save-excursion + (goto-char (point-min)) + (end-of-line) + (let (eol (point)) + (goto-char (point-min)) + (if (search-forward-regexp "[0-9] definitions? found" eol t) + (progn + (goto-char (point-min)) + (let ((kill-whole-line t)) + (kill-line 1)) + ))))) + +(defun dictem-add-text-face-properties (start end face-add-props + &optional object) + (let (face-props) + (while (<= start end) + (progn + (setq face-props (get-text-property start 'face object)) + (if (facep face-props) + (progn + (setq face-props nil) + (add-text-properties + start (+ 1 start) + (list 'face nil) + object))) + (add-text-properties + start (+ 1 start) + (list 'face (append face-props face-add-props)) + object) + (setq start (+ start 1)))))) + +(defun dictem-add-begendre-face-propertires (re-beg re-end face-properties) + (let ((bold-beg-beg (make-marker)) + (bold-beg-end (make-marker)) + (bold-end-beg (make-marker)) + (bold-end-end (make-marker))) + (while (search-forward-regexp re-beg nil t) + (progn + (set-marker bold-beg-beg (match-beginning 0)) + (set-marker bold-beg-end (match-end 0)) + (if (search-forward-regexp re-end nil t) + (progn + (set-marker bold-end-beg (match-beginning 0)) + (set-marker bold-end-end (match-end 0)) + (dictem-add-text-face-properties + bold-beg-end (- bold-end-beg 1) face-properties) + (delete-region bold-beg-beg bold-beg-end) + (delete-region bold-end-beg bold-end-end) + )))))) + +(defun dictem-postprocess-stardict-definition () + (interactive) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<b>" "</b>" '(:weight bold)) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<k>" "</k>" '(:height 1.2 :foreground "white" :weight bold)) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<abr>" "</abr>" '(:weight bold :foreground "green")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<dtrn>" "</dtrn>" '()) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<c c=\"green\">" "</c>" '(:foreground "green")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<c c=\"brown\">" "</c>" '(:foreground "brown")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<c>" "</c>" '(:foreground "green")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<ex>" "</ex>" '(:foreground "BurlyWood")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<i>" "</i>" '(:slant "oblique")) + + (goto-char (point-min)) + (dictem-add-begendre-face-propertires + "<c c=\"blueviolet\">" "</c>" '(:foreground "lightblue")) + + ; replaceing <tr> with [ + (goto-char (point-min)) + (while (search-forward-regexp "<tr>" nil t) + (replace-match "[" t t)) + + ; replaceing </tr> with ] + (goto-char (point-min)) + (while (search-forward-regexp "</tr>" nil t) + (replace-match "]" t t)) + + ; replaceing <co> with ( + (goto-char (point-min)) + (while (search-forward-regexp "<co>" nil t) + (replace-match "" t t)) + + ; replaceing </co> with ( + (goto-char (point-min)) + (while (search-forward-regexp "</co>" nil t) + (replace-match "" t t)) + + (let ((dictem-hyperlink-beginning "<kref>") + (dictem-hyperlink-end "</kref>")) + (dictem-postprocess-definition-hyperlinks-cyrlybr1)) + + ) + +;;;;; On-Click Functions ;;;;; +(defun dictem-define-on-press () + "Is called upon pressing Enter." + (interactive) + + (let* ( + (properties (text-properties-at (point))) + (data (plist-get properties 'link-data)) + (fun (plist-get properties 'link-function)) + (dictem-server (plist-get properties 'dictem-server)) + (dictem-port (plist-get properties 'dictem-port)) + (word (assq 'word data)) + (dbname (assq 'dbname data)) + ) + (if (or word dbname) + (dictem-run fun + (if dbname (cdr dbname) dictem-last-database) + (if word (cdr word) nil) + nil)))) + +(defun dictem-define-on-click (event) + "Is called upon clicking the link." + (interactive "@e") + + (mouse-set-point event) + (dictem-define-on-press)) + +;(defun dictem-define-with-db-on-click (event) +; "Is called upon clicking the link." +; (interactive "@e") +; +; (mouse-set-point event) +; (let* ( +; (properties (text-properties-at (point))) +; (word (plist-get properties 'link-data))) +; (if word +; (dictem-run 'dictem-base-define (dictem-select-database) word nil)))) + +;(define-key dictem-mode-map [C-down-mouse-2] +; 'dictem-define-with-db-on-click) + + +;;; Function for "narrowing" definitions ;;;;; + +(defcustom dictem-postprocess-each-definition-hook + nil + "Hook run in dictem mode buffers containing SHOW SERVER result." + :group 'dictem + :type 'hook + :options '(dictem-postprocess-definition-separator + dictem-postprocess-definition-hyperlinks)) + +(defun dictem-postprocess-each-definition () + (save-excursion + (goto-char (point-min)) + (let ((regexp-from-dbname "^From [^\n]+\\[\\([^\n]+\\)\\]") + (beg nil) + (end (make-marker)) + (dbname nil)) + (if (search-forward-regexp regexp-from-dbname nil t) + (let ((dictem-current-dbname + (buffer-substring-no-properties + (match-beginning 1) (match-end 1)))) + (setq beg (match-beginning 0)) + (while (search-forward-regexp regexp-from-dbname nil t) + (set-marker end (match-beginning 0)) +; (set-marker marker (match-end 0)) + (setq dbname + (buffer-substring-no-properties + (match-beginning 1) (match-end 1))) + + (save-excursion + (narrow-to-region beg (marker-position end)) + (run-hooks 'dictem-postprocess-each-definition-hook) + (widen)) + + (setq dictem-current-dbname dbname) + (goto-char end) + (forward-char) + (setq beg (marker-position end)) + ) + (save-excursion + (narrow-to-region beg (point-max)) + (run-hooks 'dictem-postprocess-each-definition-hook) + (widen)) + ))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'dictem) |