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.

2 files changed, 67 insertions, 218 deletions

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 <torsten.hilbrich@gmx.net>
-;; 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)