>From 1b5eecf46a40888c8c9ba900b17c1701fb3bcd70 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 15 May 2023 21:04:21 +0300 Subject: [PATCH] Add customization options for dictionary-search 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): New user options. (dictionary-search): Use them. * etc/NEWS: Announce. --- etc/NEWS | 36 +++++++++ lisp/net/dictionary.el | 166 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 187 insertions(+), 15 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b4846eb11b0..8a9afa53cdc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -322,6 +322,42 @@ instead of: and another_expression): do_something() +** Dictionary + +--- +*** 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. If non-nil, 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. If non-nil, 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 diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ba65225692a..adf1f409f26 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -38,6 +38,7 @@ (require 'custom) (require 'dictionary-connection) (require 'button) +(require 'help-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -247,6 +248,39 @@ dictionary-coding-systems-for-dictionaries ))) :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 nil + "Function to use for prompting for a word. +It is called with no arguments and must return a string." + :type '(choice (const :tag "Default" nil) + (const :tag "Dictionary-based completion" + dictionary-completing-read-word) + (function :tag "Custom function")) + :version "30.1") + +(defcustom dictionary-read-dictionary-function nil + "Function to use for prompting for a dictionary. +It is called with no arguments and must return a string." + :type '(choice (const :tag "Default" nil) + (const :tag "Choose among server-provided dictionaries" + dictionary-completing-read-dictionary) + (function :tag "Custom function")) + :version "30.1") + (defface dictionary-word-definition-face '((((supports (:family "DejaVu Serif"))) (:family "DejaVu Serif")) @@ -366,6 +400,8 @@ dictionary-word-history '() "History list of searched word.") +(defvar dictionary--last-match nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1149,23 +1185,33 @@ dictionary-search 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 + (if dictionary-read-dictionary-function + (funcall dictionary-read-dictionary-function) + (read-string (if dictionary-default-dictionary + (format "Dictionary (%s): " + dictionary-default-dictionary) + "Dictionary: ") + nil nil dictionary-default-dictionary)) + dictionary-default-dictionary))) + (list (if dictionary-read-word-function + (funcall dictionary-read-word-function) + (let ((default (dictionary-search-default))) + (read-string (format-prompt dictionary-read-word-prompt default) + nil 'dictionary-word-history default))) + 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 +1432,95 @@ dictionary-context-menu '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) + "Return dictionary matches for WORD as a list of strings." + (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 () + "Prompt for a word with completion based on dictionary matches." + (let* ((completion-ignore-case t) + (word-at-point (thing-at-point 'word t)) + (default (dictionary-match-word word-at-point))) + (completing-read (format-prompt dictionary-read-word-prompt default) + (completion-table-dynamic #'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 (purecopy "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) + (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))))))) + (provide 'dictionary) ;;; dictionary.el ends here -- 2.40.1