From: Eshel Yaron <me@eshelyaron.com>
To: Philip Kaludercic <philipk@posteo.net>
Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
Subject: Re: [ELPA] New package: dict
Date: Sat, 20 May 2023 21:27:22 +0300 [thread overview]
Message-ID: <m1bkiezwmt.fsf@esmac.lan> (raw)
In-Reply-To: <871qjb9cd6.fsf@posteo.net> (Philip Kaludercic's message of "Sat, 20 May 2023 16:49:41 +0000")
[-- Attachment #1: Type: text/plain, Size: 6196 bytes --]
Hi Philip,
Thanks for your comments, I'm responding to them inline and attaching a
slightly updated patch based on them below.
Philip Kaludercic <philipk@posteo.net> writes:
>> From 2bbd1767594990357f61d4af467093bf6abb117e Mon Sep 17 00:00:00 2001
>> From: Eshel Yaron <me@eshelyaron.com>
>> Date: Mon, 15 May 2023 21:04:21 +0300
>> Subject: [PATCH v2] 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'.
>
> Shouldn't these Changelog entries be folded together?
>
> * 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.
>
I'm not sure, the way I read the example commit message in CONTRIBUTE is
that opening and closing parentheses should appear on the same line, no?
Anyway I updated the commit message to be a bit more compact.
>> +(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")
>
> What is the reason for having this option fallback to nil? I couldn't
> make that out from the patch. If all the other options offer a
> concrete-default function (that you could also call in your own
> function), then it seems inconsistent to not provide this here as well.
>
The reason is that, unlike the other options, the default path that
`dictionary-search` takes to displaying a definition is highly coupled
with how it obtains the definition, making it difficult to extract into
a standalone function. That's a refactor I prefer to avoid at this
point. So, if you set `dictionary-display-definition-function` to a
custom function, we use the new function `dictionary-define-word` to
cleanly obtain the definition and let your custom function display it.
If you use the default (nil) value, we let `dictionary-search` call the
"old" function `dictionary-new-search` that both obtains and displays
the definition.
>> +(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)))))
>> + (setq dictionary-display-definition-function (nth 0 vals)
>> + dictionary-read-word-function (nth 1 vals)
>> + dictionary-read-dictionary-function (nth 2 vals)))
>
> I think you could also make use of seq-setq here?
>
Done, in the updated patch.
>> +(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))
>
> I think a memq would be nice here.
>
No, `memq` would be appropriate if we wanted to check that the
expression `(read (dictionary-read-reply))` evaluates to either 150 or
to 151, but here we want to check that it evaluates 150 and then
afterwards that it evaluates to 151.
>> +(define-button-type 'help-word
>> + :supertype 'help-xref
>> + 'help-function 'dictionary-search
>> + 'help-echo (purecopy "mouse-2, RET: describe this word"))
>
> Why the purecopy?
>
Thanks, I guess that's something I copied from the button definitions in
help-mode.el. Removed.
>> +(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)
>
> Perhaps you could explain what is going on here. Why is this pattern
> significant?
>
We want to buttonize references to other definitions in the *Help*
buffer, which appear enclosed in curly braces. I've added a comment
explaining this.
Updated patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v3-0001-Add-customization-options-for-dictionary-search.patch --]
[-- Type: text/x-patch, Size: 13821 bytes --]
From 1661dfd141d0ef49367f2312aa28a8b5e68a3caa Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Mon, 15 May 2023 21:04:21 +0300
Subject: [PATCH v3] 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 | 44 +++++++++
lisp/net/dictionary.el | 200 +++++++++++++++++++++++++++++++++++++----
2 files changed, 229 insertions(+), 15 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 04ef976a8d1..cd176685c14 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -333,6 +333,50 @@ instead of:
*** New ':vc' keyword.
This keyword enables the user to install packages using 'package-vc'.
+** 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.
+
+
\f
* New Modes and Packages in Emacs 30.1
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index ba65225692a..f5116dc28da 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,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 +426,8 @@ dictionary-word-history
'()
"History list of searched word.")
+(defvar dictionary--last-match nil)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic function providing startup actions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1139,6 +1201,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 +1225,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 +1461,100 @@ 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 (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)
+ (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 "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
next prev parent reply other threads:[~2023-05-20 18:27 UTC|newest]
Thread overview: 42+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-05-11 13:22 [ELPA] New package: dict Eshel Yaron
2023-05-11 13:59 ` Eli Zaretskii
2023-05-11 14:14 ` Philip Kaludercic
2023-05-11 17:56 ` Eshel Yaron
2023-05-11 18:16 ` Eli Zaretskii
2023-05-11 18:29 ` Philip Kaludercic
2023-05-12 13:17 ` Eshel Yaron
2023-05-12 13:44 ` Eli Zaretskii
2023-05-14 6:41 ` Eshel Yaron
2023-05-14 9:14 ` Eli Zaretskii
2023-05-15 18:50 ` Eshel Yaron
2023-05-18 7:57 ` Eshel Yaron
2023-05-18 8:32 ` Eli Zaretskii
2023-05-18 10:59 ` Eli Zaretskii
2023-05-18 12:21 ` Eshel Yaron
2023-05-18 14:09 ` Eli Zaretskii
2023-05-18 15:51 ` Eshel Yaron
2023-05-18 15:58 ` Eli Zaretskii
2023-05-19 8:34 ` Eshel Yaron
2023-05-20 14:19 ` Eli Zaretskii
2023-05-20 16:49 ` Philip Kaludercic
2023-05-20 18:27 ` Eshel Yaron [this message]
2023-05-20 19:11 ` Philip Kaludercic
2023-05-21 6:52 ` Eshel Yaron
2023-05-25 9:52 ` Eshel Yaron
2023-05-25 19:10 ` Philip Kaludercic
2023-05-26 9:16 ` Eli Zaretskii
2023-05-26 11:36 ` Rudolf Adamkovič
2023-05-26 12:26 ` Eshel Yaron
2023-05-18 12:59 ` Philip Kaludercic
2023-05-18 15:37 ` Eshel Yaron
2023-05-18 15:58 ` Philip Kaludercic
2023-05-14 16:06 ` Stephen Leake
2023-05-15 18:58 ` Eshel Yaron
2023-05-11 14:18 ` Philip Kaludercic
2023-05-11 18:00 ` Eshel Yaron
2023-05-11 18:31 ` Philip Kaludercic
2023-05-12 13:32 ` Eshel Yaron
2023-05-16 19:38 ` Philip Kaludercic
2023-05-17 2:25 ` Eli Zaretskii
2023-05-13 22:30 ` Richard Stallman
2023-05-14 6:48 ` Eshel Yaron
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m1bkiezwmt.fsf@esmac.lan \
--to=me@eshelyaron.com \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=philipk@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.