;;; 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)
