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: Mon, 15 May 2023 21:50:57 +0300 Message-ID: References: <834joj55pt.fsf@gnu.org> <87ednnvtt6.fsf@posteo.net> <875y8ywwko.fsf@posteo.net> <83zg69br5f.fsf@gnu.org> <83ednj9sw2.fsf@gnu.org> 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="9400"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: philipk@posteo.net, emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Mon May 15 20:52:10 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 1pydIo-0002G3-Hw for ged-emacs-devel@m.gmane-mx.org; Mon, 15 May 2023 20:52:10 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pydHp-000176-Ar; Mon, 15 May 2023 14:51:09 -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 1pydHn-00016q-Ox for emacs-devel@gnu.org; Mon, 15 May 2023 14:51:07 -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 1pydHk-0007Oq-U3; Mon, 15 May 2023 14:51:07 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com; s=mail; t=1684176662; bh=BzguzArieFH60LUESOu3tL38CIU++gh5DTrtXnpIUWM=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=qceQQnpS7sozz/5zziiU+8R+xLJi3PQBX+8GPOGChoeuD44azzpxyLFu5TAWdjCPN EWyb3ntbmlhHE85s26+rSOTwzKSNvXRcz5PEVXTR8xJ7nWG2vNHmiYcAeyt7QgbKmi RTkp6Q40efqtGtQ9k+Wf1AKXXWDvws2DyPzaBBUKG4cmSwruAHVvBWD4iMh8R4vlG0 nwOFBIicL64I36Rxa1LEMpNAU+YGoBJOTRXmiASz9RQ6ol1F4BeW7KqBvU3q9sIAe/ cTPjKniRuxo74HQFp3Sf9HMrU85LhUTb4B8q6ilxrnrPUJZW06MDBx3q5Fwqs7OHXl bRkWqtD5inApA== In-Reply-To: <83ednj9sw2.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 14 May 2023 12:14:37 +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:306129 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> From: Eshel Yaron >> Cc: philipk@posteo.net, emacs-devel@gnu.org >> Date: Sun, 14 May 2023 09:41:52 +0300 >> >> Eli Zaretskii writes: >> >> > How about adding to dictionary.el a customizable function that >> > dictionary-search would call instead of its default operation? >> >> Thanks, this would be a good way to expose the different behavior that I >> want to add. However, my difficulty lies elsewhere. The issue I >> brought up in my previous message is with implementing this behavior >> without introducing unnecessary code duplication to dictionary.el. >> >> In short, we need two things: a way to obtain a word's definition and a >> way to obtain dictionary matches given some input (for completion). >> dictionary.el does these things already, but in way that's too coupled >> with its user interface to admit reuse for my purposes. So the question >> is whether to add the needed stuff from Dict to dictionary.el and accept >> some code duplication, or try to refactor the parts of dictionary.el >> that communicate with the dictionary server to provide a cleaner API. > > I'd say try the latter if it's reasonably easy; otherwise try the > former. Alright, I'm attaching a patch that extends dictionary.el with new user options that modify the behavior of `dictionary-search`. With this patch, `dictionary-search` behaves like my `dict-describe-word` after applying the following customizations: --8<---------------cut here---------------start------------->8--- (setq dictionary-read-dictionary-function #'dictionary-completing-read-dictionary) (setq dictionary-read-word-function #'dictionary-completing-read-word) (setq dictionary-display-definition-function #'dictionary-display-definition-in-help-buffer) --8<---------------cut here---------------end--------------->8--- --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-customization-options-for-dictionary-search.patch >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 --=-=-=--