summaryrefslogtreecommitdiff
path: root/lisp/net/dictionary.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net/dictionary.el')
-rw-r--r--lisp/net/dictionary.el177
1 files changed, 98 insertions, 79 deletions
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index f8733429e94..6f086053b6a 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -1,22 +1,24 @@
;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*-
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
;; Keywords: interface, dictionary
-;; This file is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This file is distributed in the hope that it will be useful,
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,7 +48,7 @@
(defun dictionary-set-server-var (name value)
"Customize helper for setting variable NAME to VALUE.
The helper is used by customize to check for an active connection
-when setting a variable. The user has then the choice to close
+when setting a variable. The user has then the choice to close
the existing connection."
(if (and (boundp 'dictionary-connection)
dictionary-connection
@@ -73,8 +75,7 @@ You can specify here:
- Automatic: First try localhost, then dict.org after confirmation
- localhost: Only use localhost
- dict.org: Only use dict.org
-- User-defined: You can specify your own server here
-"
+- User-defined: You can specify your own server here"
:group 'dictionary
:set 'dictionary-set-server-var
:type '(choice (const :tag "Automatic" nil)
@@ -86,7 +87,7 @@ You can specify here:
(defcustom dictionary-port
2628
"The port of the dictionary server.
- This port is propably always 2628 so there should be no need to modify it."
+This port is propably always 2628 so there should be no need to modify it."
:group 'dictionary
:set 'dictionary-set-server-var
:type 'number
@@ -102,8 +103,8 @@ You can specify here:
(defcustom dictionary-default-dictionary
"*"
"The dictionary which is used for searching definitions and matching.
- * and ! have a special meaning, * search all dictionaries, ! search until
- one dictionary yields matches."
+* and ! have a special meaning, * search all dictionaries, ! search until
+one dictionary yields matches."
:group 'dictionary
:type 'string
:version "28.1")
@@ -144,8 +145,7 @@ by the choice value:
- User choice
Here you can enter any matching algorithm supported by your
- dictionary server.
-"
+ dictionary server."
:group 'dictionary
:type '(choice (const :tag "Exact match" "exact")
(const :tag "Similiar sounding" "soundex")
@@ -160,6 +160,18 @@ by the choice value:
:type 'boolean
:version "28.1")
+(defcustom dictionary-link-dictionary
+ "*"
+ "The dictionary which is used in links.
+* means to create links that search all dictionaries,
+nil means to create links that search only in the same dictionary
+where the current word was found."
+ :group 'dictionary
+ :type '(choice (const :tag "Link to all dictionaries" "*")
+ (const :tag "Link only to the same dictionary" nil)
+ (string :tag "User choice"))
+ :version "28.1")
+
(defcustom dictionary-mode-hook
nil
"Hook run in dictionary mode buffers."
@@ -167,6 +179,13 @@ by the choice value:
:type 'hook
:version "28.1")
+(defcustom dictionary-post-buffer-hook
+ nil
+ "Hook run at the end of every update of the dictionary buffer."
+ :group 'dictionary
+ :type 'hook
+ :version "28.1")
+
(defcustom dictionary-use-http-proxy
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
@@ -177,7 +196,7 @@ by the choice value:
(defcustom dictionary-proxy-server
"proxy"
- "The name of the HTTP proxy to use when dictionary-use-http-proxy is set."
+ "The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:type 'string
@@ -185,7 +204,7 @@ by the choice value:
(defcustom dictionary-proxy-port
3128
- "The port of the proxy server, used only when dictionary-use-http-proxy is set."
+ "The port of the proxy server, used only when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
:set 'dictionary-set-server-var
:type 'number
@@ -200,14 +219,14 @@ by the choice value:
(defcustom dictionary-description-open-delimiter
""
- "The delimiter to display in front of the dictionaries description"
+ "The delimiter to display in front of the dictionaries description."
:group 'dictionary
:type 'string
:version "28.1")
(defcustom dictionary-description-close-delimiter
""
- "The delimiter to display after of the dictionaries description"
+ "The delimiter to display after of the dictionaries description."
:group 'dictionary
:type 'string
:version "28.1")
@@ -283,27 +302,27 @@ is utf-8"
(defvar dictionary-window-configuration
nil
- "The window configuration to be restored upon closing the buffer")
+ "The window configuration to be restored upon closing the buffer.")
(defvar dictionary-selected-window
nil
- "The currently selected window")
+ "The currently selected window.")
(defvar dictionary-position-stack
nil
- "The history buffer for point and window position")
+ "The history buffer for point and window position.")
(defvar dictionary-data-stack
nil
- "The history buffer for functions and arguments")
+ "The history buffer for functions and arguments.")
(defvar dictionary-positions
nil
- "The current positions")
+ "The current positions.")
(defvar dictionary-current-data
nil
- "The item that will be placed on stack next time")
+ "The item that will be placed on stack next time.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Global variables
@@ -323,18 +342,19 @@ is utf-8"
(define-key map "l" 'dictionary-previous)
(define-key map "n" 'forward-button)
(define-key map "p" 'backward-button)
- (define-key map " " 'scroll-up)
- (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
+ (define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
+ (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command)
map)
"Keymap for the dictionary mode.")
(defvar dictionary-connection
nil
- "The current network connection")
+ "The current network connection.")
(defvar dictionary-instances
0
- "The number of open dictionary buffers")
+ "The number of open dictionary buffers.")
(defvar dictionary-marker
nil
@@ -344,11 +364,11 @@ is utf-8"
(condition-case nil
(x-display-color-p)
(error nil))
- "Determines if the Emacs has support to display color")
+ "Determines if the Emacs has support to display color.")
(defvar dictionary-word-history
'()
- "History list of searched word")
+ "History list of searched word.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic function providing startup actions
@@ -356,25 +376,25 @@ is utf-8"
;;;###autoload
(defun dictionary-mode ()
+ ;; FIXME: Use define-derived-mode.
"Mode for searching a dictionary.
This is a mode for searching a dictionary server implementing the
protocol defined in RFC 2229.
This is a quick reference to this mode describing the default key bindings:
+\\<dictionary-mode-map>
+* \\[dictionary-close] close the dictionary buffer
+* \\[dictionary-help] display this help information
+* \\[dictionary-search] ask for a new word to search
+* \\[dictionary-lookup-definition] search the word at point
+* \\[forward-button] or TAB place point to the next link
+* \\[backward-button] or S-TAB place point to the prev link
-* q close the dictionary buffer
-* h display this help information
-* s ask for a new word to search
-* d search the word at point
-* n or Tab place point to the next link
-* p or S-Tab place point to the prev link
-
-* m ask for a pattern and list all matching words.
-* D select the default dictionary
-* M select the default search strategy
+* \\[dictionary-match-words] ask for a pattern and list all matching words.
+* \\[dictionary-select-dictionary] select the default dictionary
+* \\[dictionary-select-strategy] select the default search strategy
-* Return or Button2 visit that link
-"
+* RET or <mouse-2> visit that link"
(unless (eq major-mode 'dictionary-mode)
(cl-incf dictionary-instances))
@@ -399,7 +419,7 @@ This is a quick reference to this mode describing the default key bindings:
;;;###autoload
(defun dictionary ()
- "Create a new dictonary buffer and install dictionary-mode."
+ "Create a new dictonary buffer and install `dictionary-mode'."
(interactive)
(let ((buffer (or (and dictionary-use-single-buffer
(get-buffer "*Dictionary*"))
@@ -498,13 +518,13 @@ The connection takes the proxy setting in customization group
(dictionary-open-server server)
(error
(if (y-or-n-p
- (format "Failed to open server %s, continue with dict.org?"
+ (format "Failed to open server %s, continue with dict.org? "
server))
(dictionary-open-server "dict.org")
(error "Failed automatic server selection, please customize dictionary-server"))))))))
(defun dictionary-mode-p ()
- "Return non-nil if current buffer has dictionary-mode."
+ "Return non-nil if current buffer has `dictionary-mode'."
(eq major-mode 'dictionary-mode))
(defun dictionary-ensure-buffer ()
@@ -535,7 +555,7 @@ The connection takes the proxy setting in customization group
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-send-command (string)
- "Send the command `string' to the network connection."
+ "Send the command STRING to the network connection."
(dictionary-check-connection)
;;;; #####
(dictionary-connection-send-crlf dictionary-connection string))
@@ -566,7 +586,7 @@ This function knows about the special meaning of quotes (\")"
(nreverse list)))
(defun dictionary-read-reply-and-split ()
- "Reads the reply, splits it into words and returns it."
+ "Read the reply, split it into words and return it."
(let ((answer (make-symbol "reply-data"))
(reply (dictionary-read-reply)))
(let ((reply-list (dictionary-split-string reply)))
@@ -589,7 +609,7 @@ The answer is delimited by a decimal point (.) on a line by itself."
answer))
(defun dictionary-check-reply (reply code)
- "Extract the reply code from REPLY and checks against CODE."
+ "Extract the reply code from REPLY and check against CODE."
(let ((number (dictionary-reply-code reply)))
(and (numberp number)
(= number code))))
@@ -623,7 +643,7 @@ The answer is delimited by a decimal point (.) on a line by itself."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dictionary-check-initial-reply ()
- "Reads the first reply from server and checks it."
+ "Read the first reply from server and check it."
(let ((reply (dictionary-read-reply-and-split)))
(unless (dictionary-check-reply reply 220)
(dictionary-connection-close dictionary-connection)
@@ -631,9 +651,9 @@ The answer is delimited by a decimal point (.) on a line by itself."
;; Store the current state
(defun dictionary-store-state (function data)
- "Stores the current state of operation for later restore.
-The current state consist of a tuple of FUNCTION and DATA. This
-is basically an implementation of a history to return to a
+ "Store the current state of operation for later restore.
+The current state consist of a tuple of FUNCTION and DATA.
+This is basically an implementation of a history to return to a
previous state."
(if dictionary-current-data
(progn
@@ -645,7 +665,7 @@ previous state."
(cons function data)))
(defun dictionary-store-positions ()
- "Stores the current positions for later restore."
+ "Store the current positions for later restore."
(setq dictionary-positions (cons (point) (window-start))))
@@ -664,7 +684,7 @@ previous state."
;; The normal search
(defun dictionary-new-search (args &optional all)
- "Saves the current state and starts a new search based on ARGS.
+ "Save the current state and start a new search based on ARGS.
The parameter ARGS is a cons cell where car is the word to search
and cdr is the dictionary where to search the word in."
(interactive)
@@ -680,15 +700,14 @@ and cdr is the dictionary where to search the word in."
(list word dictionary 'dictionary-display-search-result))))
(defun dictionary-new-search-internal (word dictionary function)
- "Starts a new search for WORD in DICTIONARY after preparing the buffer.
-FUNCTION is the callback which is called for each search result.
-"
+ "Start a new search for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result."
(dictionary-pre-buffer)
(dictionary-do-search word dictionary function))
(defun dictionary-do-search (word dictionary function &optional nomatching)
- "Searches WORD in DICTIONARY and calls FUNCTION for each result.
-The parameter NOMATCHING controls whether to suppress the display
+ "Search for WORD in DICTIONARY and call FUNCTION for each result.
+Optional argument NOMATCHING controls whether to suppress the display
of matching words."
(message "Searching for %s in %s" word dictionary)
@@ -712,7 +731,7 @@ of matching words."
'dictionary-display-only-match-result)
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
- (error "Dictionary \"%s\" is unknown, please select an existing one."
+ (error "Dictionary \"%s\" is unknown, please select an existing one"
dictionary)
(unless (dictionary-check-reply reply 150)
(error "Unknown server answer: %s" (dictionary-reply reply)))
@@ -773,10 +792,11 @@ of matching words."
(goto-char dictionary-marker)
(set-buffer-modified-p nil)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (run-hooks 'dictionary-post-buffer-hook))
(defun dictionary-display-search-result (reply)
- "This function starts displaying the result in REPLY."
+ "Start displaying the result in REPLY."
(let ((number (nth 1 (dictionary-reply-list reply))))
(insert number (if (equal number "1")
@@ -810,8 +830,7 @@ The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION."
(defun dictionary-display-word-definition (reply word dictionary)
"Insert the definition in REPLY for the current WORD from DICTIONARY.
It will replace links which are found in the REPLY and replace
-them with buttons to perform a a new search.
-"
+them with buttons to perform a a new search."
(let ((start (point)))
(insert (dictionary-decode-charset reply dictionary))
(insert "\n\n")
@@ -844,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
(setq word (replace-match " " t t word)))
(while (string-match "[*\"]" word)
(setq word (replace-match "" t t word)))
+ (when dictionary-link-dictionary
+ (setq dictionary dictionary-link-dictionary))
(unless (equal word displayed-word)
(make-button start end :type 'dictionary-link
@@ -931,7 +952,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(message "Dictionary %s has been selected" dictionary))))
(defun dictionary-special-dictionary (name)
- "Checks whether the special * or ! dictionary are seen in NAME."
+ "Check whether the special * or ! dictionary are seen in NAME."
(or (equal name "*")
(equal name "!")))
@@ -1011,7 +1032,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(insert "\n")))))
(defun dictionary-set-strategy (strategy &rest ignored)
- "Select this STRATEGY as new default"
+ "Select this STRATEGY as new default."
(setq dictionary-default-strategy strategy)
(dictionary-restore-state)
(message "Strategy %s has been selected" strategy))
@@ -1119,9 +1140,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
;; - if region is active returns its contents
;; - otherwise return the word near the point
(defun dictionary-search-default ()
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning) (region-end))
- (current-word t)))
+ (cond
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ ((car (get-char-property (point) 'data)))
+ (t (current-word t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User callable commands
@@ -1234,7 +1257,7 @@ allows editing it."
(defcustom dictionary-tooltip-dictionary
nil
- "This dictionary to lookup words for tooltips"
+ "This dictionary to lookup words for tooltips."
:group 'dictionary
:type '(choice (const :tag "None" nil) string)
:version "28.1")
@@ -1296,8 +1319,7 @@ It is normally internally called with 1 to enable support for the
tooltip mode. The hook function will check the value of the
variable dictionary-tooltip-mode to decide if some action must be
taken. When disabling the tooltip mode the value of this variable
-will be set to nil.
-"
+will be set to nil."
(interactive)
(tooltip-mode on)
(if on
@@ -1309,10 +1331,8 @@ will be set to nil.
"Display tooltips for the current word.
This function can be used to enable or disable the tooltip mode
-for the current buffer (based on ARG). If global-tooltip-mode is
-active it will overwrite that mode for the current buffer.
-"
-
+for the current buffer (based on ARG). If global-tooltip-mode is
+active it will overwrite that mode for the current buffer."
(interactive "P")
(require 'tooltip)
(let ((on (if arg
@@ -1335,8 +1355,7 @@ Internally it provides a default for the dictionary-tooltip-mode.
It can be overwritten for each buffer using dictionary-tooltip-mode.
Note: (global-dictionary-tooltip-mode 0) will not disable the mode
-any buffer where (dictionary-tooltip-mode 1) has been called.
-"
+any buffer where (dictionary-tooltip-mode 1) has been called."
(interactive "P")
(require 'tooltip)
(let ((on (if arg (> (prefix-numeric-value arg) 0)