aboutsummaryrefslogtreecommitdiff
path: root/dot_emacs.d/local/dictem/dictem.el
diff options
context:
space:
mode:
authorRyan Kavanagh <rak@rak.ac>2023-02-09 19:46:44 -0500
committerRyan Kavanagh <rak@rak.ac>2023-02-09 19:46:44 -0500
commit600353e45e0b3a3b2fa0d4645354c8fff5735790 (patch)
tree40027ba89b76457eb9602993ca7ee19f049ae062 /dot_emacs.d/local/dictem/dictem.el
parentMerge remote-tracking branch 'refs/remotes/origin/master' (diff)
~/.emacs.d/local -> ~/.emacs.d/lisp
Diffstat (limited to 'dot_emacs.d/local/dictem/dictem.el')
-rw-r--r--dot_emacs.d/local/dictem/dictem.el2026
1 files changed, 0 insertions, 2026 deletions
diff --git a/dot_emacs.d/local/dictem/dictem.el b/dot_emacs.d/local/dictem/dictem.el
deleted file mode 100644
index 9581a85..0000000
--- a/dot_emacs.d/local/dictem/dictem.el
+++ /dev/null
@@ -1,2026 +0,0 @@
-;;; 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:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; 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)