From: Torsten Hilbrich Date: Fri, 9 Oct 2020 03:00:02 +0000 (+0200) Subject: Dictionary now uses button X-Git-Tag: emacs-28.0.90~4726^2~23 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1773b9b687;p=emacs.git Dictionary now uses button * net/lisp/dictionary-link.el: Removed now obsolete file * net/lisp/dictionary.el: Use insert-button and make-button * net/lisp/dictionary.el (dictionary-mode-map): Now defined using defvar I had to add a conversion function as parameter for the button 'action as I need to be able to pass nil data to my function. This is not possible with the regular button 'action function and the 'button-data value. The functionality of searching a link in all dictionaries has been removed for now. It might appear again once I have an idea how to implement it. --- diff --git a/lisp/net/dictionary-link.el b/lisp/net/dictionary-link.el deleted file mode 100644 index 549f199e02a..00000000000 --- a/lisp/net/dictionary-link.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; dictionary-link.el --- Hypertext links in text buffers - -;; Author: Torsten Hilbrich -;; Keywords: interface, hypermedia -;; Version: 1.11 - -;; This file 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 2, or (at your option) -;; any later version. - -;; This file 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file contains functions for using links in buffers. A link is -;; a part of the buffer marked with a special face, beeing -;; hightlighted while the mouse points to it and beeing activated when -;; pressing return or clicking the button2. - -;; Which each link a function and some data are associated. Upon -;; clicking the function is called with the data as only -;; argument. Both the function and the data are stored in text -;; properties. -;; -;; dictionary-link-create-link - insert a new link for the text in the given range -;; dictionary-link-initialize-keymap - install the keybinding for selecting links - -;;; Code: - -(defun dictionary-link-create-link (start end face function &optional data help) - "Create a link in the current buffer starting from `start' going to `end'. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((properties `(face ,face - mouse-face highlight - link t - link-data ,data - help-echo ,help - link-function ,function))) - (remove-text-properties start end properties) - (add-text-properties start end properties))) - -(defun dictionary-link-insert-link (text face function &optional data help) - "Insert the `text' at point to be formatted as link. -The `face' is used for displaying, the `data' are stored together with the -link. Upon clicking the `function' is called with `data' as argument." - (let ((start (point))) - (insert text) - (dictionary-link-create-link start (point) face function data help))) - -(defun dictionary-link-selected (&optional all) - "Is called upon clicking or otherwise visiting the link." - (interactive) - - (let* ((properties (text-properties-at (point))) - (function (plist-get properties 'link-function)) - (data (plist-get properties 'link-data))) - (if function - (funcall function data all)))) - -(defun dictionary-link-selected-all () - "Called for meta clicking the link" - (interactive) - (dictionary-link-selected 'all)) - -(defun dictionary-link-mouse-click (event &optional all) - "Is called upon clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected)) - -(defun dictionary-link-mouse-click-all (event) - "Is called upon meta clicking the link." - (interactive "@e") - - (mouse-set-point event) - (dictionary-link-selected-all)) - -(defun dictionary-link-next-link () - "Return the position of the next link or nil if there is none" - (let* ((pos (point)) - (pos (next-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (min (1+ pos) (point-max)) 'link t) - pos - (next-single-property-change pos 'link)) - nil))) - - -(defun dictionary-link-prev-link () - "Return the position of the previous link or nil if there is none" - (let* ((pos (point)) - (pos (previous-single-property-change pos 'link))) - (if pos - (if (text-property-any pos (1+ pos) 'link t) - pos - (let ((val (previous-single-property-change pos 'link))) - (if val - val - (text-property-any (point-min) (1+ (point-min)) 'link t)))) - nil))) - -(defun dictionary-link-initialize-keymap (keymap) - "Defines the necessary bindings inside keymap" - - (define-key keymap [mouse-2] 'dictionary-link-mouse-click) - (define-key keymap [M-mouse-2] 'dictionary-link-mouse-click-all) - (define-key keymap "\r" 'dictionary-link-selected) - (define-key keymap "\M-\r" 'dictionary-link-selected-all)) - -(provide 'dictionary-link) -;;; dictionary-link.el ends here diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index a0e43b89d96..b25dda5c69c 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -38,7 +38,7 @@ (require 'easymenu) (require 'custom) (require 'dictionary-connection) -(require 'dictionary-link) +(require 'button) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Stuff for customizing. @@ -296,8 +296,24 @@ is utf-8" ;; Global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar dictionary-mode-map - nil - "Keymap for dictionary mode") + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + + (define-key map "q" 'dictionary-close) + (define-key map "h" 'dictionary-help) + (define-key map "s" 'dictionary-search) + (define-key map "d" 'dictionary-lookup-definition) + (define-key map "D" 'dictionary-select-dictionary) + (define-key map "M" 'dictionary-select-strategy) + (define-key map "m" 'dictionary-match-words) + (define-key map "l" 'dictionary-previous) + (define-key map "n" 'forward-button) + (define-key map "p" 'backward-button) + (define-key map " " 'scroll-up) + (define-key map (read-kbd-macro "M-SPC") 'scroll-down) + map) + "Keymap for the dictionary mode.") (defvar dictionary-connection nil @@ -340,7 +356,6 @@ is utf-8" * M select the default search strategy * Return or Button2 visit that link - * M-Return or M-Button2 search the word beneath link in all dictionaries " (unless (eq major-mode 'dictionary-mode) @@ -394,39 +409,6 @@ is utf-8" (dictionary-pre-buffer) (dictionary-post-buffer)) - -(unless dictionary-mode-map - (setq dictionary-mode-map (make-sparse-keymap)) - (suppress-keymap dictionary-mode-map) - - (define-key dictionary-mode-map "q" 'dictionary-close) - (define-key dictionary-mode-map "h" 'dictionary-help) - (define-key dictionary-mode-map "s" 'dictionary-search) - (define-key dictionary-mode-map "d" 'dictionary-lookup-definition) - (define-key dictionary-mode-map "D" 'dictionary-select-dictionary) - (define-key dictionary-mode-map "M" 'dictionary-select-strategy) - (define-key dictionary-mode-map "m" 'dictionary-match-words) - (define-key dictionary-mode-map "l" 'dictionary-previous) - - (if (and (string-match "GNU" (emacs-version)) - (not window-system)) - (define-key dictionary-mode-map [9] 'dictionary-next-link) - (define-key dictionary-mode-map [tab] 'dictionary-next-link)) - - ;; shift-tabs normally is supported on window systems only, but - ;; I do not enforce it - (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link) - (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link) - (define-key dictionary-mode-map [backtab] 'dictionary-prev-link) - - (define-key dictionary-mode-map "n" 'dictionary-next-link) - (define-key dictionary-mode-map "p" 'dictionary-prev-link) - - (define-key dictionary-mode-map " " 'scroll-up) - (define-key dictionary-mode-map [(meta space)] 'scroll-down) - - (dictionary-link-initialize-keymap dictionary-mode-map)) - (defmacro dictionary-reply-code (reply) "Return the reply code stored in `reply'." (list 'get reply ''reply-code)) @@ -696,43 +678,48 @@ This function knows about the special meaning of quotes (\")" (error "Unknown server answer: %s" (dictionary-reply reply))) (funcall function reply))))) +(define-button-type 'dictionary-link + 'face 'dictionary-reference-face + 'action (lambda (button) (funcall (button-get button 'callback) + (button-get button 'data)))) + +(define-button-type 'dictionary-button + :supertype 'dictionary-link + 'face 'dictionary-button-face) + (defun dictionary-pre-buffer () "These commands are executed at the begin of a new buffer" (setq buffer-read-only nil) (erase-buffer) (if dictionary-create-buttons (progn - (dictionary-link-insert-link "[Back]" 'dictionary-button-face - 'dictionary-restore-state nil - "Mouse-2 to go backwards in history") + (insert-button "[Back]" :type 'dictionary-button + 'callback 'dictionary-restore-state + 'help-echo (purecopy "Mouse-2 to go backwards in history")) (insert " ") - (dictionary-link-insert-link "[Search Definition]" - 'dictionary-button-face - 'dictionary-search nil - "Mouse-2 to look up a new word") + (insert-button "[Search Definition]" :type 'dictionary-button + 'callback 'dictionary-search + 'help-echo (purecopy "Mouse-2 to look up a new word")) (insert " ") - (dictionary-link-insert-link "[Matching words]" - 'dictionary-button-face - 'dictionary-match-words nil - "Mouse-2 to find matches for a pattern") + (insert-button "[Matching words]" :type 'dictionary-button + 'callback 'dictionary-match-words + 'help-echo (purecopy "Mouse-2 to find matches for a pattern")) (insert " ") - (dictionary-link-insert-link "[Quit]" 'dictionary-button-face - 'dictionary-close nil - "Mouse-2 to close this window") + (insert-button "[Quit]" :type 'dictionary-button + 'callback 'dictionary-close + 'help-echo (purecopy "Mouse-2 to close this window")) (insert "\n ") - (dictionary-link-insert-link "[Select Dictionary]" - 'dictionary-button-face - 'dictionary-select-dictionary nil - "Mouse-2 to select dictionary for future searches") + (insert-button "[Select Dictionary]" :type 'dictionary-button + 'callback 'dictionary-select-dictionary + 'help-echo (purecopy "Mouse-2 to select dictionary for future searches")) (insert " ") - (dictionary-link-insert-link "[Select Match Strategy]" - 'dictionary-button-face - 'dictionary-select-strategy nil - "Mouse-2 to select matching algorithm") + (insert-button "[Select Match Strategy]" :type 'dictionary-button + 'callback 'dictionary-select-strategy + 'help-echo (purecopy "Mouse-2 to select matching algorithm")) (insert "\n\n"))) (setq dictionary-marker (point-marker))) @@ -810,10 +797,11 @@ The word is taken from the buffer, the `dictionary' is given as argument." (setq word (replace-match "" t t word))) (unless (equal word displayed-word) - (dictionary-link-create-link start end 'dictionary-reference-face - call (cons word dictionary) - (concat "Press Mouse-2 to lookup \"" - word "\" in \"" dictionary "\""))))) + (make-button start end :type 'dictionary-link + 'callback call + 'data (cons word dictionary) + 'help-echo (concat "Press Mouse-2 to lookup \"" + word "\" in \"" dictionary "\""))))) (defun dictionary-select-dictionary (&rest ignored) "Save the current state and start a dictionary selection" @@ -871,11 +859,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (if dictionary (if (equal dictionary "--exit--") (insert "(end of default search list)\n") - (dictionary-link-insert-link (concat dictionary ": " translated) - 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button (concat dictionary ": " translated) :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n"))))) (defun dictionary-set-dictionary (param &optional more) @@ -907,10 +894,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (error "Unknown server answer: %s" (dictionary-reply reply))) (dictionary-pre-buffer) (insert "Information on dictionary: ") - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-dictionary - (cons dictionary description) - "Mouse-2 to select this dictionary") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-dictionary + 'data (cons dictionary description) + 'help-echo (purecopy "Mouse-2 to select this dictionary")) (insert "\n\n") (setq reply (dictionary-read-answer)) (insert reply) @@ -958,9 +945,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (description (cadr list))) (if strategy (progn - (dictionary-link-insert-link description 'dictionary-reference-face - 'dictionary-set-strategy strategy - "Mouse-2 to select this matching algorithm") + (insert-button description :type 'dictionary-link + 'callback 'dictionary-set-strategy + 'data strategy + 'help-echo (purecopy "Mouse-2 to select this matching algorithm")) (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) @@ -1060,11 +1048,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (mapc (lambda (word) (setq word (dictionary-decode-charset word dictionary)) (insert " ") - (dictionary-link-insert-link word - 'dictionary-reference-face - 'dictionary-new-search - (cons word dictionary) - "Mouse-2 to lookup word") + (insert-button word :type 'dictionary-button + 'callback 'dictionary-new-search + 'data (cons word dictionary) + 'help-echo (purecopy "Mouse-2 to lookup word")) (insert "\n")) (reverse word-list)) (insert "\n"))) list)) @@ -1119,22 +1106,6 @@ It presents the word at point as default input and allows editing it." (error "Current buffer is no dictionary buffer")) (dictionary-restore-state)) -(defun dictionary-next-link () - "Place the cursor to the next link." - (interactive) - (let ((pos (dictionary-link-next-link))) - (if pos - (goto-char pos) - (error "There is no next link")))) - -(defun dictionary-prev-link () - "Place the cursor to the previous link." - (interactive) - (let ((pos (dictionary-link-prev-link))) - (if pos - (goto-char pos) - (error "There is no previous link")))) - (defun dictionary-help () "Display a little help" (interactive)