From 306927fec8a2ca26cfd98a712c68f99605073489 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 6 May 2023 17:48:17 +0300 Subject: [PATCH 1/1] Initial commit --- dict.el | 258 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 258 insertions(+) create mode 100644 dict.el diff --git a/dict.el b/dict.el new file mode 100644 index 0000000..1582800 --- /dev/null +++ b/dict.el @@ -0,0 +1,258 @@ +;;; dict.el --- Get word definitions from RFC2229 dictionary servers -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Eshel Yaron + +;; Author: Eshel Yaron +;; Keywords: help, comm +;; URL: https://git.eshelyaron.com/gitweb/dict.git +;; Package-Version: 0.1.0 +;; Package-Requires: ((emacs "29.1")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Dict defines a single command that displays the definition of a +;; given word, as obtained from an RFC2229 dictionary server. To use +;; it, invoke \\[dict-describe-word]. + +;;; Code: + +(defgroup dict nil + "Access to RFC2229 dictionary servers." + :group 'help) + +(defcustom dict-process-buffer-name "*dict output*" + "Buffer name for dictionary server output." + :type 'string) + +(defcustom dict-process-name "dict" + "Process name for dictionary server connection." + :type 'string) + +(defcustom dict-server-host "dict.org" + "Host or IP address of dictionary server." + :type 'string) + +(defcustom dict-server-port 2628 + "Port of dictionary server." + :type 'natnum) + +(defcustom dict-dictionary nil + "Name of the dictionary to use for matching and defining words." + :type '(choice (const :tag "Prompt on first use" nil) + (string :tag "Select dictionary"))) + +(defcustom dict-strategy nil + "Name of the dictionary matching strategy to use." + :type '(choice (const :tag "Prompt on first use" nil) + (string :tag "Select strategy"))) + +(defcustom dict-display-definition-function + #'dict-display-definition-in-help-buffer + "Function to use for displaying dictionary definitions." + :type 'function) + +(defvar dict-process nil) + +(defvar dict-read-word-history nil) + +(defvar dict-match-cache nil) + +(defun dict-command (command parse) + "Invoke a dictionary server command. +COMMAND is an RFC2229 command in string format, without a newline. + +Return the result of calling the function PARSE in a the +beginning of a buffer with the server's response." + (let ((buffer (get-buffer-create dict-process-buffer-name))) + (with-current-buffer buffer + (delete-region (point-min) (point-max))) + (let* ((result nil) + (done nil) + (filter + (lambda (process string) + (internal-default-process-filter process string) + (with-current-buffer (process-buffer process) + (save-excursion + (goto-char (point-min)) + (cond + ((search-forward "\r\n5" nil t) ; error code + (setq done t)) + ((search-forward "\r\n.\r\n" nil t) + (goto-char (point-min)) + (setq result (funcall parse) + done t))))))) + (proc (if (process-live-p dict-process) + dict-process + (setq dict-process + (make-network-process + :name dict-process-name + :host dict-server-host + :service dict-server-port + :buffer buffer))))) + (set-process-filter proc filter) + (process-send-string proc (concat command "\n")) + (while (not done) + (accept-process-output proc 1)) + result))) + +(defun dict-match-word (word) + "Return dictionary matches for WORD as a list of strings." + (unless (string-empty-p word) + (if (string= (car dict-match-cache) word) + (cdr dict-match-cache) + (setq dict-match-cache + (cons word + (dict-command + (format "match %s %s \"%s\"" + (dict-dictionary) + (dict-strategy) + word) + (lambda () + (let ((result nil)) + (search-forward "\r\n152" nil t) + (while (not (looking-at (rx "\r\n.\r\n"))) + (search-forward "\r\n" nil t) + (search-forward " " nil t) + (push (read (current-buffer)) result)) + (reverse result))))))))) + +(defun dict-define-word (word) + "Return the dictionary definition of WORD, or nil if not defined." + (dict-command (format "define %s \"%s\"" + (dict-dictionary) + word) + (lambda () + (search-forward "\r\n151" nil t) + (buffer-substring + (search-forward "\r\n") + (- (search-forward "\r\n.\r\n" nil t) 5))))) + +(defun dict-get-strategies () + "Return the dictionary server's supported matching strategies." + (cons + '("." . "Default strategy") + (dict-command "show strat" + (lambda () + (let ((result nil)) + (search-forward "\r\n111" nil t) + (while (not (looking-at (rx "\r\n.\r\n"))) + (push (cons (buffer-substring + (search-forward "\r\n" nil t) + (1- (search-forward " " nil t))) + (read (current-buffer))) + result)) + result))))) + +(defun dict-read-strategy () + "Prompt for a matching strategy supported by the dictionary server." + (let* ((strats (dict-get-strategies)) + (len (apply #'max (mapcar #'length (mapcar #'car strats)))) + (completion-extra-properties + (list :annotation-function + (lambda (key) + (concat (make-string (1+ (- len (length key))) ?\s) + (alist-get key strats nil nil #'string=)))))) + (completing-read "Strategy: " + strats nil t))) + +(defun dict-strategy () + "Return the value of the user option `dict-strategy'. +If its nil, prompt for a supported strategy and set the user +option to it first." + (or dict-strategy + (setq dict-strategy (dict-read-strategy)))) + +(defun dict-get-dictionaries () + "Return the dictionary server's supported dictionaries." + (append + '(("*" . "All dictionaries") + ("!" . "First matching dictionary")) + (dict-command "show db" + (lambda () + (let ((result nil)) + (search-forward "\r\n110" nil t) + (while (not (looking-at (rx "\r\n.\r\n"))) + (push (cons (buffer-substring + (search-forward "\r\n" nil t) + (1- (search-forward " " nil t))) + (read (current-buffer))) + result)) + result))))) + +(defun dict-read-dictionary () + "Prompt for dictionary server's supported by the dictionary server." + (let* ((dicts (dict-get-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 "Dictionary: " + dicts nil t))) + +(defun dict-dictionary () + "Return the value of the user option `dict-dictionary'. +If its nil, prompt for a supported dictionary and set the user +option to it first." + (or dict-dictionary + (setq dict-dictionary (dict-read-dictionary)))) + +(defun dict-read-word () + "Prompt for a word known to the dictionary server." + (let* ((completion-ignore-case t) + (word-at-point (thing-at-point 'word t)) + (default (car (dict-match-word word-at-point)))) + (completing-read (format-prompt "Word" default) + (completion-table-dynamic #'dict-match-word) + nil t nil 'dict-read-word-history default t))) + +(define-button-type 'help-word + :supertype 'help-xref + 'help-function 'dict-describe-word + 'help-echo (purecopy "mouse-2, RET: describe this word")) + +(defun dict-display-definition-in-help-buffer (word definition) + (let ((help-buffer-under-preparation t)) + (help-setup-xref (list #'dict-describe-word word) + (called-interactively-p 'interactive)) + (with-help-window (help-buffer) + (with-current-buffer (help-buffer) + (insert (string-replace "\r\n" "\n" 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))))))) + +;;;###autoload +(defun dict-describe-word (word) + "Display the definition of WORD. + +This command obtains the definition of WORD from the RFC2229 +dictionary server specified by `dict-server-host' and +`dict-server-port'. When successful, it calls the function +specified by `dict-display-definition-function' to display the +definition. (By default, this uses a *Help* buffer.)" + (interactive (list (dict-read-word))) + (let ((definition (dict-define-word word))) + (if definition + (funcall dict-display-definition-function word definition) + (user-error "No definition found for \"%s\"" word)))) + +(provide 'dict) +;;; dict.el ends here -- 2.39.2