aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/net/dictionary.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net/dictionary.el')
-rw-r--r--lisp/net/dictionary.el163
1 files changed, 67 insertions, 96 deletions
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 @@
38(require 'easymenu) 38(require 'easymenu)
39(require 'custom) 39(require 'custom)
40(require 'dictionary-connection) 40(require 'dictionary-connection)
41(require 'dictionary-link) 41(require 'button)
42 42
43;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44;; Stuff for customizing. 44;; Stuff for customizing.
@@ -296,8 +296,24 @@ is utf-8"
296;; Global variables 296;; Global variables
297;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 297;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
298(defvar dictionary-mode-map 298(defvar dictionary-mode-map
299 nil 299 (let ((map (make-sparse-keymap)))
300 "Keymap for dictionary mode") 300 (suppress-keymap map)
301 (set-keymap-parent map button-buffer-map)
302
303 (define-key map "q" 'dictionary-close)
304 (define-key map "h" 'dictionary-help)
305 (define-key map "s" 'dictionary-search)
306 (define-key map "d" 'dictionary-lookup-definition)
307 (define-key map "D" 'dictionary-select-dictionary)
308 (define-key map "M" 'dictionary-select-strategy)
309 (define-key map "m" 'dictionary-match-words)
310 (define-key map "l" 'dictionary-previous)
311 (define-key map "n" 'forward-button)
312 (define-key map "p" 'backward-button)
313 (define-key map " " 'scroll-up)
314 (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
315 map)
316 "Keymap for the dictionary mode.")
301 317
302(defvar dictionary-connection 318(defvar dictionary-connection
303 nil 319 nil
@@ -340,7 +356,6 @@ is utf-8"
340 * M select the default search strategy 356 * M select the default search strategy
341 357
342 * Return or Button2 visit that link 358 * Return or Button2 visit that link
343 * M-Return or M-Button2 search the word beneath link in all dictionaries
344 " 359 "
345 360
346 (unless (eq major-mode 'dictionary-mode) 361 (unless (eq major-mode 'dictionary-mode)
@@ -394,39 +409,6 @@ is utf-8"
394 (dictionary-pre-buffer) 409 (dictionary-pre-buffer)
395 (dictionary-post-buffer)) 410 (dictionary-post-buffer))
396 411
397
398(unless dictionary-mode-map
399 (setq dictionary-mode-map (make-sparse-keymap))
400 (suppress-keymap dictionary-mode-map)
401
402 (define-key dictionary-mode-map "q" 'dictionary-close)
403 (define-key dictionary-mode-map "h" 'dictionary-help)
404 (define-key dictionary-mode-map "s" 'dictionary-search)
405 (define-key dictionary-mode-map "d" 'dictionary-lookup-definition)
406 (define-key dictionary-mode-map "D" 'dictionary-select-dictionary)
407 (define-key dictionary-mode-map "M" 'dictionary-select-strategy)
408 (define-key dictionary-mode-map "m" 'dictionary-match-words)
409 (define-key dictionary-mode-map "l" 'dictionary-previous)
410
411 (if (and (string-match "GNU" (emacs-version))
412 (not window-system))
413 (define-key dictionary-mode-map [9] 'dictionary-next-link)
414 (define-key dictionary-mode-map [tab] 'dictionary-next-link))
415
416 ;; shift-tabs normally is supported on window systems only, but
417 ;; I do not enforce it
418 (define-key dictionary-mode-map [(shift tab)] 'dictionary-prev-link)
419 (define-key dictionary-mode-map "\e\t" 'dictionary-prev-link)
420 (define-key dictionary-mode-map [backtab] 'dictionary-prev-link)
421
422 (define-key dictionary-mode-map "n" 'dictionary-next-link)
423 (define-key dictionary-mode-map "p" 'dictionary-prev-link)
424
425 (define-key dictionary-mode-map " " 'scroll-up)
426 (define-key dictionary-mode-map [(meta space)] 'scroll-down)
427
428 (dictionary-link-initialize-keymap dictionary-mode-map))
429
430(defmacro dictionary-reply-code (reply) 412(defmacro dictionary-reply-code (reply)
431 "Return the reply code stored in `reply'." 413 "Return the reply code stored in `reply'."
432 (list 'get reply ''reply-code)) 414 (list 'get reply ''reply-code))
@@ -696,43 +678,48 @@ This function knows about the special meaning of quotes (\")"
696 (error "Unknown server answer: %s" (dictionary-reply reply))) 678 (error "Unknown server answer: %s" (dictionary-reply reply)))
697 (funcall function reply))))) 679 (funcall function reply)))))
698 680
681(define-button-type 'dictionary-link
682 'face 'dictionary-reference-face
683 'action (lambda (button) (funcall (button-get button 'callback)
684 (button-get button 'data))))
685
686(define-button-type 'dictionary-button
687 :supertype 'dictionary-link
688 'face 'dictionary-button-face)
689
699(defun dictionary-pre-buffer () 690(defun dictionary-pre-buffer ()
700 "These commands are executed at the begin of a new buffer" 691 "These commands are executed at the begin of a new buffer"
701 (setq buffer-read-only nil) 692 (setq buffer-read-only nil)
702 (erase-buffer) 693 (erase-buffer)
703 (if dictionary-create-buttons 694 (if dictionary-create-buttons
704 (progn 695 (progn
705 (dictionary-link-insert-link "[Back]" 'dictionary-button-face 696 (insert-button "[Back]" :type 'dictionary-button
706 'dictionary-restore-state nil 697 'callback 'dictionary-restore-state
707 "Mouse-2 to go backwards in history") 698 'help-echo (purecopy "Mouse-2 to go backwards in history"))
708 (insert " ") 699 (insert " ")
709 (dictionary-link-insert-link "[Search Definition]" 700 (insert-button "[Search Definition]" :type 'dictionary-button
710 'dictionary-button-face 701 'callback 'dictionary-search
711 'dictionary-search nil 702 'help-echo (purecopy "Mouse-2 to look up a new word"))
712 "Mouse-2 to look up a new word")
713 (insert " ") 703 (insert " ")
714 704
715 (dictionary-link-insert-link "[Matching words]" 705 (insert-button "[Matching words]" :type 'dictionary-button
716 'dictionary-button-face 706 'callback 'dictionary-match-words
717 'dictionary-match-words nil 707 'help-echo (purecopy "Mouse-2 to find matches for a pattern"))
718 "Mouse-2 to find matches for a pattern")
719 (insert " ") 708 (insert " ")
720 709
721 (dictionary-link-insert-link "[Quit]" 'dictionary-button-face 710 (insert-button "[Quit]" :type 'dictionary-button
722 'dictionary-close nil 711 'callback 'dictionary-close
723 "Mouse-2 to close this window") 712 'help-echo (purecopy "Mouse-2 to close this window"))
724 713
725 (insert "\n ") 714 (insert "\n ")
726 715
727 (dictionary-link-insert-link "[Select Dictionary]" 716 (insert-button "[Select Dictionary]" :type 'dictionary-button
728 'dictionary-button-face 717 'callback 'dictionary-select-dictionary
729 'dictionary-select-dictionary nil 718 'help-echo (purecopy "Mouse-2 to select dictionary for future searches"))
730 "Mouse-2 to select dictionary for future searches")
731 (insert " ") 719 (insert " ")
732 (dictionary-link-insert-link "[Select Match Strategy]" 720 (insert-button "[Select Match Strategy]" :type 'dictionary-button
733 'dictionary-button-face 721 'callback 'dictionary-select-strategy
734 'dictionary-select-strategy nil 722 'help-echo (purecopy "Mouse-2 to select matching algorithm"))
735 "Mouse-2 to select matching algorithm")
736 (insert "\n\n"))) 723 (insert "\n\n")))
737 (setq dictionary-marker (point-marker))) 724 (setq dictionary-marker (point-marker)))
738 725
@@ -810,10 +797,11 @@ The word is taken from the buffer, the `dictionary' is given as argument."
810 (setq word (replace-match "" t t word))) 797 (setq word (replace-match "" t t word)))
811 798
812 (unless (equal word displayed-word) 799 (unless (equal word displayed-word)
813 (dictionary-link-create-link start end 'dictionary-reference-face 800 (make-button start end :type 'dictionary-link
814 call (cons word dictionary) 801 'callback call
815 (concat "Press Mouse-2 to lookup \"" 802 'data (cons word dictionary)
816 word "\" in \"" dictionary "\""))))) 803 'help-echo (concat "Press Mouse-2 to lookup \""
804 word "\" in \"" dictionary "\"")))))
817 805
818(defun dictionary-select-dictionary (&rest ignored) 806(defun dictionary-select-dictionary (&rest ignored)
819 "Save the current state and start a dictionary selection" 807 "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]+\"."
871 (if dictionary 859 (if dictionary
872 (if (equal dictionary "--exit--") 860 (if (equal dictionary "--exit--")
873 (insert "(end of default search list)\n") 861 (insert "(end of default search list)\n")
874 (dictionary-link-insert-link (concat dictionary ": " translated) 862 (insert-button (concat dictionary ": " translated) :type 'dictionary-link
875 'dictionary-reference-face 863 'callback 'dictionary-set-dictionary
876 'dictionary-set-dictionary 864 'data (cons dictionary description)
877 (cons dictionary description) 865 'help-echo (purecopy "Mouse-2 to select this dictionary"))
878 "Mouse-2 to select this dictionary")
879 (insert "\n"))))) 866 (insert "\n")))))
880 867
881(defun dictionary-set-dictionary (param &optional more) 868(defun dictionary-set-dictionary (param &optional more)
@@ -907,10 +894,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
907 (error "Unknown server answer: %s" (dictionary-reply reply))) 894 (error "Unknown server answer: %s" (dictionary-reply reply)))
908 (dictionary-pre-buffer) 895 (dictionary-pre-buffer)
909 (insert "Information on dictionary: ") 896 (insert "Information on dictionary: ")
910 (dictionary-link-insert-link description 'dictionary-reference-face 897 (insert-button description :type 'dictionary-link
911 'dictionary-set-dictionary 898 'callback 'dictionary-set-dictionary
912 (cons dictionary description) 899 'data (cons dictionary description)
913 "Mouse-2 to select this dictionary") 900 'help-echo (purecopy "Mouse-2 to select this dictionary"))
914 (insert "\n\n") 901 (insert "\n\n")
915 (setq reply (dictionary-read-answer)) 902 (setq reply (dictionary-read-answer))
916 (insert reply) 903 (insert reply)
@@ -958,9 +945,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
958 (description (cadr list))) 945 (description (cadr list)))
959 (if strategy 946 (if strategy
960 (progn 947 (progn
961 (dictionary-link-insert-link description 'dictionary-reference-face 948 (insert-button description :type 'dictionary-link
962 'dictionary-set-strategy strategy 949 'callback 'dictionary-set-strategy
963 "Mouse-2 to select this matching algorithm") 950 'data strategy
951 'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
964 (insert "\n"))))) 952 (insert "\n")))))
965 953
966(defun dictionary-set-strategy (strategy &rest ignored) 954(defun dictionary-set-strategy (strategy &rest ignored)
@@ -1060,11 +1048,10 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
1060 (mapc (lambda (word) 1048 (mapc (lambda (word)
1061 (setq word (dictionary-decode-charset word dictionary)) 1049 (setq word (dictionary-decode-charset word dictionary))
1062 (insert " ") 1050 (insert " ")
1063 (dictionary-link-insert-link word 1051 (insert-button word :type 'dictionary-button
1064 'dictionary-reference-face 1052 'callback 'dictionary-new-search
1065 'dictionary-new-search 1053 'data (cons word dictionary)
1066 (cons word dictionary) 1054 'help-echo (purecopy "Mouse-2 to lookup word"))
1067 "Mouse-2 to lookup word")
1068 (insert "\n")) (reverse word-list)) 1055 (insert "\n")) (reverse word-list))
1069 (insert "\n"))) 1056 (insert "\n")))
1070 list)) 1057 list))
@@ -1119,22 +1106,6 @@ It presents the word at point as default input and allows editing it."
1119 (error "Current buffer is no dictionary buffer")) 1106 (error "Current buffer is no dictionary buffer"))
1120 (dictionary-restore-state)) 1107 (dictionary-restore-state))
1121 1108
1122(defun dictionary-next-link ()
1123 "Place the cursor to the next link."
1124 (interactive)
1125 (let ((pos (dictionary-link-next-link)))
1126 (if pos
1127 (goto-char pos)
1128 (error "There is no next link"))))
1129
1130(defun dictionary-prev-link ()
1131 "Place the cursor to the previous link."
1132 (interactive)
1133 (let ((pos (dictionary-link-prev-link)))
1134 (if pos
1135 (goto-char pos)
1136 (error "There is no previous link"))))
1137
1138(defun dictionary-help () 1109(defun dictionary-help ()
1139 "Display a little help" 1110 "Display a little help"
1140 (interactive) 1111 (interactive)