procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add customization options for dictionary-search

Browse source 
Allow users to customize 'dictionary-search' via several new
customization options.

* lisp/net/dictionary.el (dictionary-define-word)
(dictionary-match-word, dictionary-completing-read-word)
(dictionary-dictionaries, dictionary-completing-read-dictionary)
(dictionary-display-definition-in-help-buffer): New functions.
(dictionary-read-word-prompt)
(dictionary-display-definition-function)
(dictionary-read-word-function)
(dictionary-read-dictionary-function)
(dictionary-search-interface): New user options.
(dictionary-search): Use them.
(dictionary-read-dictionary-default)
(dictionary-read-word-default): New functions, extracted from
'dictionary-search'.
* etc/NEWS: Announce.
This commit is contained in:
Eshel Yaron 2023-05-15 21:04:21 +03:00 • committed by Eli Zaretskii
parent 4b3de748b0
commit f35648ba0c
2 changed files with 233 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
etc/NEWS
View file

@ -342,6 +342,51 @@ The new Rmail commands 'rmail-mailing-list-post',
'rmail-mailing-list-archive allow to, respectively, post to,
unsubscribe from, request help about, and browse the archives, of the
mailing list from which the current email message was delivered.
** Dictionary
---
*** New user option 'dictionary-search-interface'.
Controls how the 'dictionary-search' command prompts for and displays
dictionary definitions. Customize this user option to 'help' to have
'dictionary-search' display definitions in a *Help* buffer and provide
dictionary-based minibuffer completion for word selection.
---
*** New user option 'dictionary-read-word-prompt'.
This allows the user to customize the prompt that is used by
'dictionary-search' when asking for a word to search in the
dictionary.
---
*** New user option 'dictionary-display-definition-function'.
This allows the user to customize the way in which 'dictionary-search'
displays word definitions. If non-nil, this user option should be set
to a function that displays a word definition obtained from a
dictionary server. The new function
'dictionary-display-definition-in-help-buffer' can be used to display
the definition in a *Help* buffer, instead of the default *Dictionary*
buffer.
---
*** New user option 'dictionary-read-word-function'.
This allows the user to customize the way in which 'dictionary-search'
prompts for a word to search in the dictionary. This user option
should be set to a function that lets the user select a word and
returns it as a string. The new function
'dictionary-completing-read-word' can be used to prompt with
completion based on dictionary matches.
---
*** New user option 'dictionary-read-dictionary-function'.
This allows the user to customize the way in which 'dictionary-search'
prompts for a dictionary to search in. This user option should be set
to a function that lets the user select a dictionary and returns its
name as a string. The new function
'dictionary-completing-read-dictionary' can be used to prompt with
completion based on dictionaries that the server supports.
* New Modes and Packages in Emacs 30.1

203
lisp/net/dictionary.el
View file

@ -38,6 +38,8 @@
(require 'custom)
(require 'dictionary-connection)
(require 'button)
(require 'help-mode)
(require 'external-completion)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stuff for customizing.
@ -247,6 +249,65 @@ is utf-8"
)))
:version "28.1")
(defcustom dictionary-read-word-prompt "Search word"
"Prompt string to use when prompting for a word."
:type 'string
:version "30.1")
(defcustom dictionary-display-definition-function nil
"Function to use for displaying dictionary definitions.
It is called with three string arguments: the word being defined,
the dictionary name, and the full definition."
:type '(choice (const :tag "Dictionary buffer" nil)
(const :tag "Help buffer"
dictionary-display-definition-in-help-buffer)
(function :tag "Custom function"))
:version "30.1")
(defcustom dictionary-read-word-function #'dictionary-read-word-default
"Function to use for prompting for a word.
It is called with one string argument, the name of the dictionary to use, and
must return a string."
:type '(choice (const :tag "Default" dictionary-read-word-default)
(const :tag "Dictionary-based completion"
dictionary-completing-read-word)
(function :tag "Custom function"))
:version "30.1")
(defcustom dictionary-read-dictionary-function
#'dictionary-read-dictionary-default
"Function to use for prompting for a dictionary.
It is called with no arguments and must return a string."
:type '(choice (const :tag "Default" dictionary-read-dictionary-default)
(const :tag "Choose among server-provided dictionaries"
dictionary-completing-read-dictionary)
(function :tag "Custom function"))
:version "30.1")
(defcustom dictionary-search-interface nil
"Controls how `dictionary-search' prompts for words and displays definitions.
When set to `help', `dictionary-search' displays definitions in a *Help* buffer,
and provides completion for word selection based on dictionary matches.
Otherwise, `dictionary-search' displays definitions in a *Dictionary* buffer."
:type '(choice (const :tag "Dictionary buffer" nil)
(const :tag "Help buffer" help))
:set (lambda (symbol value)
(let ((vals (pcase value
('help '(dictionary-display-definition-in-help-buffer
dictionary-completing-read-word
dictionary-completing-read-dictionary))
(_ '(nil
dictionary-read-word-default
dictionary-read-dictionary-default)))))
(seq-setq (dictionary-display-definition-function
dictionary-read-word-function
dictionary-read-dictionary-function)
vals))
(set-default-toplevel-value symbol value))
:version "30.1")
(defface dictionary-word-definition-face
'((((supports (:family "DejaVu Serif")))
(:family "DejaVu Serif"))
@ -366,6 +427,8 @@ is utf-8"
'()
"History list of searched word.")
(defvar dictionary--last-match nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic function providing startup actions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1139,6 +1202,20 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
((car (get-char-property (point) 'data)))
(t (current-word t))))
(defun dictionary-read-dictionary-default ()
"Prompt for a dictionary name."
(read-string (if dictionary-default-dictionary
(format "Dictionary (%s): "
dictionary-default-dictionary)
"Dictionary: ")
nil nil dictionary-default-dictionary))
(defun dictionary-read-word-default (_dictionary)
"Prompt for a word to search in the dictionary."
(let ((default (dictionary-search-default)))
(read-string (format-prompt dictionary-read-word-prompt default)
nil 'dictionary-word-history default)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User callable commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1149,23 +1226,22 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
It presents the selection or word at point as default input and
allows editing it."
(interactive
(list (let ((default (dictionary-search-default)))
(read-string (format-prompt "Search word" default)
nil 'dictionary-word-history default))
(if current-prefix-arg
(read-string (if dictionary-default-dictionary
(format "Dictionary (%s): " dictionary-default-dictionary)
"Dictionary: ")
nil nil dictionary-default-dictionary)
dictionary-default-dictionary)))
;; if called by pressing the button
(unless word
(setq word (read-string "Search word: " nil 'dictionary-word-history)))
;; just in case non-interactively called
(let ((dict
(if current-prefix-arg
(funcall dictionary-read-dictionary-function)
dictionary-default-dictionary)))
(list (funcall dictionary-read-word-function dict) dict)))
(unless dictionary
(setq dictionary dictionary-default-dictionary))
(dictionary-new-search (cons word dictionary)))
(if dictionary-display-definition-function
(if-let ((definition (dictionary-define-word word dictionary)))
(funcall dictionary-display-definition-function word dictionary definition)
(user-error "No definition found for \"%s\"" word))
;; if called by pressing the button
(unless word
(setq word (read-string "Search word: " nil 'dictionary-word-history)))
;; just in case non-interactively called
(dictionary-new-search (cons word dictionary))))
;;;###autoload
(defun dictionary-lookup-definition ()
@ -1386,5 +1462,102 @@ the word at mouse click."
'dictionary-separator))
menu)
(defun dictionary-define-word (word dictionary)
"Return the definition of WORD in DICTIONARY, or nil if not found."
(dictionary-send-command
(format "define %s \"%s\"" dictionary word))
(when (and (= (read (dictionary-read-reply)) 150)
(= (read (dictionary-read-reply)) 151))
(dictionary-read-answer)))
(defun dictionary-match-word (word &rest _)
"Return dictionary matches for WORD as a list of strings.
Further arguments are currently ignored."
(unless (string-empty-p word)
(if (string= (car dictionary--last-match) word)
(cdr dictionary--last-match)
(dictionary-send-command
(format "match %s %s \"%s\""
dictionary-default-dictionary
dictionary-default-strategy
word))
(when (and (= (read (dictionary-read-reply)) 152))
(with-temp-buffer
(insert (dictionary-read-answer))
(goto-char (point-min))
(let ((result nil))
(while (not (eobp))
(search-forward " " nil t)
(push (read (current-buffer)) result)
(search-forward "\n" nil t))
(setq result (reverse result))
(setq dictionary--last-match (cons word result))
result))))))
(defun dictionary-completing-read-word (dictionary)
"Prompt for a word with completion based on matches in DICTIONARY."
(let* ((completion-ignore-case t)
(dictionary-default-dictionary dictionary)
(word-at-point (thing-at-point 'word t))
(default (dictionary-match-word word-at-point)))
(completing-read (format-prompt dictionary-read-word-prompt default)
(external-completion-table 'dictionary-definition
#'dictionary-match-word)
nil t nil 'dictionary-word-history default t)))
(defun dictionary-dictionaries ()
"Return the list of dictionaries the server supports."
(dictionary-send-command "show db")
(when (and (= (read (dictionary-read-reply)) 110))
(with-temp-buffer
(insert (dictionary-read-answer))
(goto-char (point-min))
(let ((result '(("!" . "First matching dictionary")
("*" . "All dictionaries"))))
(while (not (eobp))
(push (cons (buffer-substring
(search-forward "\n" nil t)
(1- (search-forward " " nil t)))
(read (current-buffer)))
result))
(reverse result)))))
(defun dictionary-completing-read-dictionary ()
"Prompt for a dictionary the server supports."
(let* ((dicts (dictionary-dictionaries))
(len (apply #'max (mapcar #'length (mapcar #'car dicts))))
(completion-extra-properties
(list :annotation-function
(lambda (key)
(concat (make-string (1+ (- len (length key))) ?\s)
(alist-get key dicts nil nil #'string=))))))
(completing-read (format-prompt "Select dictionary"
dictionary-default-dictionary)
dicts nil t nil nil dictionary-default-dictionary)))
(define-button-type 'help-word
:supertype 'help-xref
'help-function 'dictionary-search
'help-echo "mouse-2, RET: describe this word")
(defun dictionary-display-definition-in-help-buffer (word dictionary definition)
"Display DEFINITION, the definition of WORD in DICTIONARY."
(let ((help-buffer-under-preparation t))
(help-setup-xref (list #'dictionary-search word dictionary)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer (help-buffer)
(insert definition)
;; Buttonize references to other definitions. These appear as
;; words enclosed with curly braces.
(goto-char (point-min))
(while (re-search-forward (rx "{"
(group-n 1 (* (not (any ?}))))
"}")
nil t)
(help-xref-button 1 'help-word
(match-string 1)
dictionary))))))
(provide 'dictionary)
;;; dictionary.el ends here