From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eshel Yaron Newsgroups: gmane.emacs.devel Subject: Re: [ELPA] New package: dict Date: Thu, 25 May 2023 12:52:55 +0300 Message-ID: References: <834joj55pt.fsf@gnu.org> <87ednnvtt6.fsf@posteo.net> <875y8ywwko.fsf@posteo.net> <83zg69br5f.fsf@gnu.org> <83ednj9sw2.fsf@gnu.org> <837ct5x5v6.fsf@gnu.org> <83sfbtvii4.fsf@gnu.org> <83h6s9vdft.fsf@gnu.org> <871qjb9cd6.fsf@posteo.net> <875y8m95tb.fsf@posteo.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="36672"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Philip Kaludercic , Eli Zaretskii To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu May 25 11:53:51 2023 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1q27fL-0009Mt-3X for ged-emacs-devel@m.gmane-mx.org; Thu, 25 May 2023 11:53:51 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q27ec-0003Ni-2n; Thu, 25 May 2023 05:53:06 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q27eZ-0003NM-N3 for emacs-devel@gnu.org; Thu, 25 May 2023 05:53:03 -0400 Original-Received: from mail.eshelyaron.com ([107.175.124.16] helo=eshelyaron.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q27eX-0000wm-7f; Thu, 25 May 2023 05:53:03 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com; s=mail; t=1685008379; bh=eYaNdJ7QkGj6zZ1JF9xpC+vf0GVVwNMjLQMXk88qMk0=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=Ab5VAX5lqnhf00QaLzKiJkhmju5vC1Fk+u01XEugNX/KVJCkPQ5Y9xm4qU7UdL/Xm cyh0eIqXtq0XZojsKg8NQh7/I1fZverW5bg2SjDzf/JBPyb2buQ8ZsVzfweSjKwMNv 2ekuqsSiTfYj9/rGhz1/EWuHcUkzA5AHA3bdPPWF4xGXzC84l6eBzSet91fPQlsQyF dRI22HfqnPOgsm6DHN4V4SUo6gl5XHgEnnL6YTxSJwshbZN3LUFvzBs19pHGMfs/Eg /2ElHex0xjyPfpIAtpqc3keu3KQgGnU8DkzE+0HfDLGVNsw7KmXcFZ3GlFwGGygyXv fpiUoDejZ0DNw== In-Reply-To: (Eshel Yaron's message of "Sun, 21 May 2023 09:52:51 +0300") Received-SPF: pass client-ip=107.175.124.16; envelope-from=me@eshelyaron.com; helo=eshelyaron.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:306322 Archived-At: --=-=-= Content-Type: text/plain Hi, I'm attaching a slightly updated patch to dictionary.el. The only change wrt to my previous patch is that `dictionary-match-word` now uses the new `external-completion-table` from Emacs 29 instead of `completion-table-dynamic` to allow leveraging arbitrary matching strategies that the dictionary server provides. For example, we can now set `dictionary-default-strategy` to the "soundex" matching strategy that dict.org provides to get completion candidates that sound similar to the minibuffer input (such as "tail", "tale" and "tell"). I've also rebased onto master branch to avoid conflicts in etc/NEWS. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=v4-0001-Add-customization-options-for-dictionary-search.patch >From 749743aa703a98352cb12ad84c04c971b22ea44c Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 15 May 2023 21:04:21 +0300 Subject: [PATCH v4] 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) (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. --- etc/NEWS | 45 +++++++++ lisp/net/dictionary.el | 203 ++++++++++++++++++++++++++++++++++++++--- 2 files changed, 233 insertions(+), 15 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7729dbc79fa..07fc2fab774 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index ba65225692a..8d81b3ec9d8 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -38,6 +38,8 @@ (require 'custom) (require 'dictionary-connection) (require 'button) +(require 'help-mode) +(require 'external-completion) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -247,6 +249,65 @@ 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 #'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 @@ dictionary-word-history '() "History list of searched word.") +(defvar dictionary--last-match nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1139,6 +1202,20 @@ dictionary-search-default ((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 @@ 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 + (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 @@ 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 &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 -- 2.40.1 --=-=-=--