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.
This commit is contained in:
Torsten Hilbrich
parent
99a7e918c8
commit
1773b9b687
2 changed files with 67 additions and 218 deletions
|
|
@ -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
|
|
||||||
|
|
@ -38,7 +38,7 @@
|
||||||
(require 'easymenu)
|
(require 'easymenu)
|
||||||
(require 'custom)
|
(require 'custom)
|
||||||
(require 'dictionary-connection)
|
(require 'dictionary-connection)
|
||||||
(require 'dictionary-link)
|
(require 'button)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Stuff for customizing.
|
;; Stuff for customizing.
|
||||||
|
|
@ -296,8 +296,24 @@ is utf-8"
|
||||||
;; Global variables
|
;; Global variables
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(defvar dictionary-mode-map
|
(defvar dictionary-mode-map
|
||||||
nil
|
(let ((map (make-sparse-keymap)))
|
||||||
"Keymap for dictionary mode")
|
(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
|
(defvar dictionary-connection
|
||||||
nil
|
nil
|
||||||
|
|
@ -340,7 +356,6 @@ is utf-8"
|
||||||
* M select the default search strategy
|
* M select the default search strategy
|
||||||
|
|
||||||
* Return or Button2 visit that link
|
* 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)
|
(unless (eq major-mode 'dictionary-mode)
|
||||||
|
|
@ -394,39 +409,6 @@ is utf-8"
|
||||||
(dictionary-pre-buffer)
|
(dictionary-pre-buffer)
|
||||||
(dictionary-post-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)
|
(defmacro dictionary-reply-code (reply)
|
||||||
"Return the reply code stored in `reply'."
|
"Return the reply code stored in `reply'."
|
||||||
(list 'get reply ''reply-code))
|
(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)))
|
(error "Unknown server answer: %s" (dictionary-reply reply)))
|
||||||
(funcall function 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 ()
|
(defun dictionary-pre-buffer ()
|
||||||
"These commands are executed at the begin of a new buffer"
|
"These commands are executed at the begin of a new buffer"
|
||||||
(setq buffer-read-only nil)
|
(setq buffer-read-only nil)
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(if dictionary-create-buttons
|
(if dictionary-create-buttons
|
||||||
(progn
|
(progn
|
||||||
(dictionary-link-insert-link "[Back]" 'dictionary-button-face
|
(insert-button "[Back]" :type 'dictionary-button
|
||||||
'dictionary-restore-state nil
|
'callback 'dictionary-restore-state
|
||||||
"Mouse-2 to go backwards in history")
|
'help-echo (purecopy "Mouse-2 to go backwards in history"))
|
||||||
(insert " ")
|
(insert " ")
|
||||||
(dictionary-link-insert-link "[Search Definition]"
|
(insert-button "[Search Definition]" :type 'dictionary-button
|
||||||
'dictionary-button-face
|
'callback 'dictionary-search
|
||||||
'dictionary-search nil
|
'help-echo (purecopy "Mouse-2 to look up a new word"))
|
||||||
"Mouse-2 to look up a new word")
|
|
||||||
(insert " ")
|
(insert " ")
|
||||||
|
|
||||||
(dictionary-link-insert-link "[Matching words]"
|
(insert-button "[Matching words]" :type 'dictionary-button
|
||||||
'dictionary-button-face
|
'callback 'dictionary-match-words
|
||||||
'dictionary-match-words nil
|
'help-echo (purecopy "Mouse-2 to find matches for a pattern"))
|
||||||
"Mouse-2 to find matches for a pattern")
|
|
||||||
(insert " ")
|
(insert " ")
|
||||||
|
|
||||||
(dictionary-link-insert-link "[Quit]" 'dictionary-button-face
|
(insert-button "[Quit]" :type 'dictionary-button
|
||||||
'dictionary-close nil
|
'callback 'dictionary-close
|
||||||
"Mouse-2 to close this window")
|
'help-echo (purecopy "Mouse-2 to close this window"))
|
||||||
|
|
||||||
(insert "\n ")
|
(insert "\n ")
|
||||||
|
|
||||||
(dictionary-link-insert-link "[Select Dictionary]"
|
(insert-button "[Select Dictionary]" :type 'dictionary-button
|
||||||
'dictionary-button-face
|
'callback 'dictionary-select-dictionary
|
||||||
'dictionary-select-dictionary nil
|
'help-echo (purecopy "Mouse-2 to select dictionary for future searches"))
|
||||||
"Mouse-2 to select dictionary for future searches")
|
|
||||||
(insert " ")
|
(insert " ")
|
||||||
(dictionary-link-insert-link "[Select Match Strategy]"
|
(insert-button "[Select Match Strategy]" :type 'dictionary-button
|
||||||
'dictionary-button-face
|
'callback 'dictionary-select-strategy
|
||||||
'dictionary-select-strategy nil
|
'help-echo (purecopy "Mouse-2 to select matching algorithm"))
|
||||||
"Mouse-2 to select matching algorithm")
|
|
||||||
(insert "\n\n")))
|
(insert "\n\n")))
|
||||||
(setq dictionary-marker (point-marker)))
|
(setq dictionary-marker (point-marker)))
|
||||||
|
|
||||||
|
|
@ -810,9 +797,10 @@ The word is taken from the buffer, the `dictionary' is given as argument."
|
||||||
(setq word (replace-match "" t t word)))
|
(setq word (replace-match "" t t word)))
|
||||||
|
|
||||||
(unless (equal word displayed-word)
|
(unless (equal word displayed-word)
|
||||||
(dictionary-link-create-link start end 'dictionary-reference-face
|
(make-button start end :type 'dictionary-link
|
||||||
call (cons word dictionary)
|
'callback call
|
||||||
(concat "Press Mouse-2 to lookup \""
|
'data (cons word dictionary)
|
||||||
|
'help-echo (concat "Press Mouse-2 to lookup \""
|
||||||
word "\" in \"" dictionary "\"")))))
|
word "\" in \"" dictionary "\"")))))
|
||||||
|
|
||||||
(defun dictionary-select-dictionary (&rest ignored)
|
(defun dictionary-select-dictionary (&rest ignored)
|
||||||
|
|
@ -871,11 +859,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
|
||||||
(if dictionary
|
(if dictionary
|
||||||
(if (equal dictionary "--exit--")
|
(if (equal dictionary "--exit--")
|
||||||
(insert "(end of default search list)\n")
|
(insert "(end of default search list)\n")
|
||||||
(dictionary-link-insert-link (concat dictionary ": " translated)
|
(insert-button (concat dictionary ": " translated) :type 'dictionary-link
|
||||||
'dictionary-reference-face
|
'callback 'dictionary-set-dictionary
|
||||||
'dictionary-set-dictionary
|
'data (cons dictionary description)
|
||||||
(cons dictionary description)
|
'help-echo (purecopy "Mouse-2 to select this dictionary"))
|
||||||
"Mouse-2 to select this dictionary")
|
|
||||||
(insert "\n")))))
|
(insert "\n")))))
|
||||||
|
|
||||||
(defun dictionary-set-dictionary (param &optional more)
|
(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)))
|
(error "Unknown server answer: %s" (dictionary-reply reply)))
|
||||||
(dictionary-pre-buffer)
|
(dictionary-pre-buffer)
|
||||||
(insert "Information on dictionary: ")
|
(insert "Information on dictionary: ")
|
||||||
(dictionary-link-insert-link description 'dictionary-reference-face
|
(insert-button description :type 'dictionary-link
|
||||||
'dictionary-set-dictionary
|
'callback 'dictionary-set-dictionary
|
||||||
(cons dictionary description)
|
'data (cons dictionary description)
|
||||||
"Mouse-2 to select this dictionary")
|
'help-echo (purecopy "Mouse-2 to select this dictionary"))
|
||||||
(insert "\n\n")
|
(insert "\n\n")
|
||||||
(setq reply (dictionary-read-answer))
|
(setq reply (dictionary-read-answer))
|
||||||
(insert reply)
|
(insert reply)
|
||||||
|
|
@ -958,9 +945,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
|
||||||
(description (cadr list)))
|
(description (cadr list)))
|
||||||
(if strategy
|
(if strategy
|
||||||
(progn
|
(progn
|
||||||
(dictionary-link-insert-link description 'dictionary-reference-face
|
(insert-button description :type 'dictionary-link
|
||||||
'dictionary-set-strategy strategy
|
'callback 'dictionary-set-strategy
|
||||||
"Mouse-2 to select this matching algorithm")
|
'data strategy
|
||||||
|
'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
|
||||||
(insert "\n")))))
|
(insert "\n")))))
|
||||||
|
|
||||||
(defun dictionary-set-strategy (strategy &rest ignored)
|
(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)
|
(mapc (lambda (word)
|
||||||
(setq word (dictionary-decode-charset word dictionary))
|
(setq word (dictionary-decode-charset word dictionary))
|
||||||
(insert " ")
|
(insert " ")
|
||||||
(dictionary-link-insert-link word
|
(insert-button word :type 'dictionary-button
|
||||||
'dictionary-reference-face
|
'callback 'dictionary-new-search
|
||||||
'dictionary-new-search
|
'data (cons word dictionary)
|
||||||
(cons word dictionary)
|
'help-echo (purecopy "Mouse-2 to lookup word"))
|
||||||
"Mouse-2 to lookup word")
|
|
||||||
(insert "\n")) (reverse word-list))
|
(insert "\n")) (reverse word-list))
|
||||||
(insert "\n")))
|
(insert "\n")))
|
||||||
list))
|
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"))
|
(error "Current buffer is no dictionary buffer"))
|
||||||
(dictionary-restore-state))
|
(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 ()
|
(defun dictionary-help ()
|
||||||
"Display a little help"
|
"Display a little help"
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue