From: Torsten Hilbrich <torsten.hilbrich@gmx.net>
Date: Mon, 5 Oct 2020 04:50:25 +0000 (+0200)
Subject: Importing dictionary module
X-Git-Tag: emacs-28.0.90~4726^2~30
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b6227446d9;p=emacs.git

Importing dictionary module

* lisp/net: Adding files connection.el, link.el, dictionary.el,
imported from https://github.com/myrkr/dictionary-el.git
---

diff --git a/lisp/net/connection.el b/lisp/net/connection.el
new file mode 100644
index 00000000000..3afcc2cb894
--- /dev/null
+++ b/lisp/net/connection.el
@@ -0,0 +1,159 @@
+;;; connection.el --- TCP-based client connection
+
+;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
+;; Keywords: network
+;; 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:
+
+;; connection allows to handle TCP-based connections in client mode
+;; where text-based information are exchanged. There is special
+;; support for handling CR LF (and the usual CR LF . CR LF
+;; terminater).
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(defmacro connection-p (connection)
+  "Returns non-nil if `connection' is a connection object"
+  (list 'get connection ''connection))
+
+(defmacro connection-read-point (connection)
+  "Return the read point of the connection object."
+  (list 'get connection ''connection-read-point))
+
+(defmacro connection-process (connection)
+  "Return the process of the connection object."
+  (list 'get connection ''connection-process))
+
+(defmacro connection-buffer (connection)
+  "Return the buffer of the connection object."
+  (list 'get connection ''connection-buffer))
+
+(defmacro connection-set-read-point (connection point)
+  "Set the read-point for `connection' to `point'."
+  (list 'put connection ''connection-read-point point))
+
+(defmacro connection-set-process (connection process)
+  "Set the process for `connection' to `process'."
+  (list 'put connection ''connection-process process))
+
+(defmacro connection-set-buffer (connection buffer)
+  "Set the buffer for `connection' to `buffer'."
+  (list 'put connection ''connection-buffer buffer))
+
+(defun connection-create-data (buffer process point)
+  "Create a new connection data based on `buffer', `process', and `point'."
+  (let ((connection (make-symbol "connection")))
+    (put connection 'connection t)
+    (connection-set-read-point connection point)
+    (connection-set-process connection process)
+    (connection-set-buffer connection buffer)
+    connection))
+
+(defun connection-open (server port)
+  "Open a connection to `server' and `port'.
+A data structure identifing the connection is returned"
+
+  (let ((process-buffer (generate-new-buffer (format " connection to %s:%s"
+						     server
+						     port)))
+	(process))
+    (with-current-buffer process-buffer
+      (setq process (open-network-stream "connection" process-buffer
+					 server port))
+      (connection-create-data process-buffer process (point-min)))))
+
+(defun connection-status (connection)
+  "Return the status of the connection.
+Possible return values are the symbols:
+nil: argument is no connection object
+'none: argument has no connection
+'up: connection is open and buffer is existing
+'down: connection is closed
+'alone: connection is not associated with a buffer"
+  (if (connection-p connection)
+      (let ((process (connection-process connection))
+	    (buffer (connection-buffer connection)))
+	(if (not process)
+	    'none
+	  (if (not (buffer-live-p buffer))
+	      'alone
+	    (if (not (eq (process-status process) 'open))
+		'down
+	      'up))))
+    nil))
+
+(defun connection-close (connection)
+  "Force closing of the connection."
+  (if (connection-p connection)
+      (progn
+	(let ((buffer (connection-buffer connection))
+	      (process (connection-process connection)))
+	  (if process
+	      (delete-process process))
+	  (if buffer
+	      (kill-buffer buffer))
+
+	  (connection-set-process connection nil)
+	  (connection-set-buffer connection nil)))))
+
+(defun connection-send (connection data)
+  "Send `data' to the process."
+  (unless (eq (connection-status connection) 'up)
+    (error "Connection is not up"))
+  (with-current-buffer (connection-buffer connection)
+    (goto-char (point-max))
+    (connection-set-read-point connection (point))
+    (process-send-string (connection-process connection) data)))
+
+(defun connection-send-crlf (connection data)
+  "Send `data' together with CRLF to the process."
+  (connection-send connection (concat data "\r\n")))
+
+(defun connection-read (connection delimiter)
+  "Read data until `delimiter' is found inside the buffer."
+  (unless (eq (connection-status connection) 'up)
+    (error "Connection is not up"))
+  (let ((case-fold-search nil)
+	match-end)
+    (with-current-buffer (connection-buffer connection)
+      (goto-char (connection-read-point connection))
+      ;; Wait until there is enough data
+      (while (not (search-forward-regexp delimiter nil t))
+	(accept-process-output (connection-process connection) 3)
+	(goto-char (connection-read-point connection)))
+      (setq match-end (point))
+      ;; Return the result
+      (let ((result (buffer-substring (connection-read-point connection)
+				      match-end)))
+	(connection-set-read-point connection match-end)
+	result))))
+
+(defun connection-read-crlf (connection)
+  "Read until a line is completedx with CRLF"
+  (connection-read connection "\015?\012"))
+
+(defun connection-read-to-point (connection)
+  "Read until a line is consisting of a single point"
+  (connection-read connection "\015?\012[.]\015?\012"))
+
+(provide 'connection)
+;;; connection.el ends here
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
new file mode 100644
index 00000000000..9545926cb25
--- /dev/null
+++ b/lisp/net/dictionary.el
@@ -0,0 +1,1367 @@
+;;; dictionary.el --- Client for rfc2229 dictionary servers
+
+;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net>
+;; Keywords: interface, dictionary
+;; Version: 1.11
+;; Package-Requires: ((connection "1.11") (link "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:
+
+;; dictionary allows you to interact with dictionary servers.
+;; Use M-x customize-group dictionary to modify user settings.
+;;
+;; Main functions for interaction are:
+;; dictionary        - opens a new dictionary buffer
+;; dictionary-search - search for the definition of a word
+;;
+;; You can find more information in the README file of the GitHub
+;; repository https://github.com/myrkr/dictionary-el
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(require 'easymenu)
+(require 'custom)
+(require 'connection)
+(require 'link)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Stuff for customizing.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(eval-when-compile
+  (unless (fboundp 'defface)
+    (message "Please update your custom.el file: %s"
+	     "http://www.dina.kvl.dk/~abraham/custom/"))
+
+  (unless (fboundp 'defgroup)
+    (defmacro defgroup (&rest ignored))
+    (defmacro defcustom (var value doc &rest ignored)
+      (list 'defvar var value doc))))
+
+(defvar dictionary-server)
+(defun dictionary-set-server-var (name value)
+  (if (and (boundp 'dictionary-connection)
+	   dictionary-connection
+	   (eq (connection-status dictionary-connection) 'up)
+	   (y-or-n-p
+	    (concat "Close existing connection to " dictionary-server "? ")))
+      (connection-close dictionary-connection))
+  (set-default name value))
+
+(defgroup dictionary nil
+  "Client for accessing the dictd server based dictionaries"
+  :group 'hypermedia)
+
+(defgroup dictionary-proxy nil
+  "Proxy configuration options for the dictionary client"
+  :group 'dictionary)
+
+(defcustom dictionary-server
+  "dict.org"
+  "This server is contacted for searching the dictionary"
+  :group 'dictionary
+  :set 'dictionary-set-server-var
+  :type 'string)
+
+(defcustom dictionary-port
+  2628
+  "The port of the dictionary server.
+ This port is propably always 2628 so there should be no need to modify it."
+  :group 'dictionary
+  :set 'dictionary-set-server-var
+  :type 'number)
+
+(defcustom dictionary-identification
+  "dictionary.el emacs lisp dictionary client"
+  "This is the identification string that will be sent to the server."
+  :group 'dictionary
+  :type 'string)
+
+(defcustom dictionary-default-dictionary
+  "*"
+  "The dictionary which is used for searching definitions and matching.
+ * and ! have a special meaning, * search all dictionaries, ! search until
+ one dictionary yields matches."
+  :group 'dictionary
+  :type 'string)
+
+(defcustom dictionary-default-strategy
+  "."
+  "The default strategy for listing matching words."
+  :group 'dictionary
+  :type 'string)
+
+(defcustom dictionary-default-popup-strategy
+  "exact"
+  "The default strategy for listing matching words within a popup window.
+
+The following algorithm (defined by the dictd server) are supported
+by the choice value:
+
+- Exact match
+
+  The found word exactly matches the searched word.
+
+- Similiar sounding
+
+  The found word sounds similiar to the searched word.  For this match type
+  the soundex algorithm defined by Donald E. Knuth is used.  It will only
+  works with english words and the algorithm is not very reliable (i.e.,
+  the soundex algorithm is quite simple).
+
+- Levenshtein distance one
+
+  The Levenshtein distance is defined as the number of insertions, deletions,
+  or replacements needed to get the searched word.  This algorithm searches
+  for word where spelling mistakes are allowed.  Levenshtein distance one
+  means there is either a deleted character, an inserted character, or a
+  modified one.
+
+- User choice
+
+  Here you can enter any matching algorithm supported by your
+  dictionary server.
+"
+  :group 'dictionary
+  :type '(choice (const :tag "Exact match" "exact")
+		 (const :tag "Similiar sounding" "soundex")
+		 (const :tag "Levenshtein distance one" "lev")
+		 (string :tag "User choice")))
+
+(defcustom dictionary-create-buttons
+  t
+  "Create some clickable buttons on top of the window if non-nil."
+  :group 'dictionary
+  :type 'boolean)
+
+(defcustom dictionary-mode-hook
+  nil
+  "Hook run in dictionary mode buffers."
+  :group 'dictionary
+  :type 'hook)
+
+(defcustom dictionary-use-http-proxy
+  nil
+  "Connects via a HTTP proxy using the CONNECT command when not nil."
+  :group 'dictionary-proxy
+  :set 'dictionary-set-server-var
+  :type 'boolean)
+
+(defcustom dictionary-proxy-server
+  "proxy"
+  "The name of the HTTP proxy to use when dictionary-use-http-proxy is set."
+  :group 'dictionary-proxy
+  :set 'dictionary-set-server-var
+  :type 'string)
+
+(defcustom dictionary-proxy-port
+  3128
+  "The port of the proxy server, used only when dictionary-use-http-proxy is set."
+  :group 'dictionary-proxy
+  :set 'dictionary-set-server-var
+  :type 'number)
+
+(defcustom dictionary-use-single-buffer
+  nil
+  "Should the dictionary command reuse previous dictionary buffers?"
+  :group 'dictionary
+  :type 'boolean)
+
+(defcustom dictionary-description-open-delimiter
+  ""
+  "The delimiter to display in front of the dictionaries description"
+  :group 'dictionary
+  :type 'string)
+
+(defcustom dictionary-description-close-delimiter
+  ""
+  "The delimiter to display after of the dictionaries description"
+  :group 'dictionary
+  :type 'string)
+
+;; Define only when coding-system-list is available
+(when (fboundp 'coding-system-list)
+  (defcustom dictionary-coding-systems-for-dictionaries
+    '( ("mueller" . koi8-r))
+    "Mapping of dictionaries to coding systems.
+ Each entry in this list defines the coding system to be used for that
+ dictionary.  The default coding system for all other dictionaries
+ is utf-8"
+    :group 'dictionary
+    :type `(repeat (cons :tag "Association"
+			 (string :tag "Dictionary name")
+			 (choice :tag "Coding system"
+				 :value 'utf-8
+				 ,@(mapcar (lambda (x) (list 'const x))
+					   (coding-system-list))
+				 ))))
+
+  )
+
+(if (fboundp 'defface)
+    (progn
+
+      (defface dictionary-word-definition-face
+	'((((supports (:family "DejaVu Serif")))
+	   (:family "DejaVu Serif"))
+	  (((type x))
+	   (:font "Sans Serif"))
+	  (t
+	   (:font "default")))
+	"The face that is used for displaying the definition of the word."
+	:group 'dictionary)
+
+      (defface dictionary-word-entry-face
+	'((((type x))
+	   (:italic t))
+	  (((type tty) (class color))
+	   (:foreground "green"))
+	  (t
+	   (:inverse t)))
+	"The face that is used for displaying the initial word entry line."
+	:group 'dictionary)
+
+      (defface dictionary-button-face
+	'((t
+	   (:bold t)))
+	"The face that is used for displaying buttons."
+	:group 'dictionary)
+
+      (defface dictionary-reference-face
+	'((((type x)
+	    (class color)
+	    (background dark))
+	   (:foreground "yellow"))
+	  (((type tty)
+	    (class color)
+	    (background dark))
+	   (:foreground "cyan"))
+	  (((class color)
+	    (background light))
+	   (:foreground "blue"))
+	  (t
+	   (:underline t)))
+
+	"The face that is used for displaying a reference word."
+	:group 'dictionary)
+
+      )
+
+  ;; else
+  (copy-face 'italic 'dictionary-word-entry-face)
+  (copy-face 'bold 'dictionary-button-face)
+  (copy-face 'default 'dictionary-reference-face)
+  (set-face-foreground 'dictionary-reference-face "blue"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Buffer local variables for storing the current state
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar dictionary-window-configuration
+  nil
+  "The window configuration to be restored upon closing the buffer")
+
+(defvar dictionary-selected-window
+  nil
+  "The currently selected window")
+
+(defvar dictionary-position-stack
+  nil
+  "The history buffer for point and window position")
+
+(defvar dictionary-data-stack
+  nil
+  "The history buffer for functions and arguments")
+
+(defvar dictionary-positions
+  nil
+  "The current positions")
+
+(defvar dictionary-current-data
+  nil
+  "The item that will be placed on stack next time")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Global variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar dictionary-mode-map
+  nil
+  "Keymap for dictionary mode")
+
+(defvar dictionary-connection
+  nil
+  "The current network connection")
+
+(defvar dictionary-instances
+  0
+  "The number of open dictionary buffers")
+
+(defvar dictionary-marker
+  nil
+  "Stores the point position while buffer display.")
+
+(defvar dictionary-color-support
+  (condition-case nil
+      (x-display-color-p)
+    (error nil))
+  "Determines if the Emacs has support to display color")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Basic function providing startup actions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun dictionary-mode ()
+  "This is a mode for searching a dictionary server implementing
+ the protocol defined in RFC 2229.
+
+ This is a quick reference to this mode describing the default key bindings:
+
+ * q close the dictionary buffer
+ * h display this help information
+ * s ask for a new word to search
+ * d search the word at point
+ * n or Tab place point to the next link
+ * p or S-Tab place point to the prev link
+
+ * m ask for a pattern and list all matching words.
+ * D select the default dictionary
+ * 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)
+    (incf dictionary-instances))
+
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (use-local-map dictionary-mode-map)
+  (setq major-mode 'dictionary-mode)
+  (setq mode-name "Dictionary")
+
+  (make-local-variable 'dictionary-data-stack)
+  (setq dictionary-data-stack nil)
+  (make-local-variable 'dictionary-position-stack)
+  (setq dictionary-position-stack nil)
+
+  (make-local-variable 'dictionary-current-data)
+  (make-local-variable 'dictionary-positions)
+
+  (make-local-variable 'dictionary-default-dictionary)
+  (make-local-variable 'dictionary-default-strategy)
+
+  (if (featurep 'xemacs)
+      (make-local-hook 'kill-buffer-hook))
+  (add-hook 'kill-buffer-hook 'dictionary-close t t)
+  (run-hooks 'dictionary-mode-hook))
+
+;;;###autoload
+(defun dictionary ()
+  "Create a new dictonary buffer and install dictionary-mode"
+  (interactive)
+  (let ((buffer (or (and dictionary-use-single-buffer
+                         (get-buffer "*Dictionary*"))
+                    (generate-new-buffer "*Dictionary*")))
+        (window-configuration (current-window-configuration))
+        (selected-window (frame-selected-window)))
+
+    (switch-to-buffer-other-window buffer)
+    (dictionary-mode)
+
+    (make-local-variable 'dictionary-window-configuration)
+    (make-local-variable 'dictionary-selected-window)
+    (setq dictionary-window-configuration window-configuration)
+    (setq dictionary-selected-window selected-window)
+    (dictionary-check-connection)
+    (dictionary-new-buffer)
+    (dictionary-store-positions)
+    (dictionary-store-state 'dictionary-new-buffer nil)))
+
+(defun dictionary-new-buffer (&rest ignore)
+  "Create a new and clean buffer"
+
+  (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)
+
+  (link-initialize-keymap dictionary-mode-map))
+
+(defmacro dictionary-reply-code (reply)
+  "Return the reply code stored in `reply'."
+  (list 'get reply ''reply-code))
+
+(defmacro dictionary-reply (reply)
+  "Return the string reply stored in `reply'."
+  (list 'get reply ''reply))
+
+(defmacro dictionary-reply-list (reply)
+  "Return the reply list stored in `reply'."
+  (list 'get reply ''reply-list))
+
+(defun dictionary-check-connection ()
+  "Check if there is already a connection open"
+  (if (not (and dictionary-connection
+		(eq (connection-status dictionary-connection) 'up)))
+      (let ((wanted 'raw-text)
+	    (coding-system nil))
+	(if (and (fboundp 'coding-system-list)
+		 (member wanted (coding-system-list)))
+	    (setq coding-system wanted))
+	(let ((coding-system-for-read coding-system)
+	      (coding-system-for-write coding-system))
+	  (message "Opening connection to %s:%s" dictionary-server
+		   dictionary-port)
+	  (connection-close dictionary-connection)
+	  (setq dictionary-connection
+		(if dictionary-use-http-proxy
+		    (connection-open dictionary-proxy-server
+				     dictionary-proxy-port)
+		  (connection-open dictionary-server dictionary-port)))
+	  (set-process-query-on-exit-flag
+	   (connection-process dictionary-connection)
+	   nil)
+
+	  (when dictionary-use-http-proxy
+	    (message "Proxy CONNECT to %s:%d"
+		     dictionary-proxy-server
+		     dictionary-proxy-port)
+	    (dictionary-send-command (format "CONNECT %s:%d HTTP/1.1"
+					     dictionary-server
+					     dictionary-port))
+	    ;; just a \r\n combination
+	    (dictionary-send-command "")
+
+	    ;; read first line of reply
+	    (let* ((reply (dictionary-read-reply))
+		   (reply-list (dictionary-split-string reply)))
+	      ;; first item is protocol, second item is code
+	      (unless (= (string-to-number (cadr reply-list)) 200)
+		(error "Bad reply from proxy server %s" reply))
+
+	      ;; skip the following header lines until empty found
+	      (while (not (equal reply ""))
+		(setq reply (dictionary-read-reply)))))
+
+	  (dictionary-check-initial-reply)
+	  (dictionary-send-command (concat "client " dictionary-identification))
+	  (let ((reply (dictionary-read-reply-and-split)))
+	    (message nil)
+	    (unless (dictionary-check-reply reply 250)
+	      (error "Unknown server answer: %s"
+		     (dictionary-reply reply))))))))
+
+(defun dictionary-mode-p ()
+  "Return non-nil if current buffer has dictionary-mode"
+  (eq major-mode 'dictionary-mode))
+
+(defun dictionary-ensure-buffer ()
+  "If current buffer is not a dictionary buffer, create a new one."
+  (unless (dictionary-mode-p)
+    (dictionary)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Dealing with closing the buffer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-close (&rest ignore)
+  "Close the current dictionary buffer and its connection"
+  (interactive)
+  (if (eq major-mode 'dictionary-mode)
+      (progn
+	(setq major-mode nil)
+	(if (<= (decf dictionary-instances) 0)
+	    (connection-close dictionary-connection))
+	(let ((configuration dictionary-window-configuration)
+	      (selected-window dictionary-selected-window))
+	  (kill-buffer (current-buffer))
+	  (set-window-configuration configuration)
+	  (select-window selected-window)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpful functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-send-command (string)
+  "Send the command `string' to the network connection."
+  (dictionary-check-connection)
+  ;;;; #####
+  (connection-send-crlf dictionary-connection string))
+
+(defun dictionary-read-reply ()
+  "Read the reply line from the server"
+  (let ((answer (connection-read-crlf dictionary-connection)))
+    (if (string-match "\r?\n" answer)
+	(substring answer 0 (match-beginning 0))
+      answer)))
+
+(defun dictionary-split-string (string)
+  "Split the `string' constiting of space separated words into elements.
+This function knows about the special meaning of quotes (\")"
+  (let ((list))
+    (while (and string (> (length string) 0))
+      (let ((search "\\(\\s-+\\)")
+	    (start 0))
+	(if (= (aref string 0) ?\")
+	    (setq search "\\(\"\\)\\s-*"
+		  start 1))
+	(if (string-match search string start)
+	    (progn
+	      (setq list (cons (substring string start (- (match-end 1) 1)) list)
+		    string (substring string (match-end 0))))
+	  (setq list (cons string list)
+		string nil))))
+    (nreverse list)))
+
+(defun dictionary-read-reply-and-split ()
+  "Read the reply, split it into words and return it"
+  (let ((answer (make-symbol "reply-data"))
+	(reply (dictionary-read-reply)))
+    (let ((reply-list (dictionary-split-string reply)))
+      (put answer 'reply reply)
+      (put answer 'reply-list reply-list)
+      (put answer 'reply-code (string-to-number (car reply-list)))
+      answer)))
+
+(defun dictionary-read-answer ()
+  "Read an answer delimited by a . on a single line"
+  (let ((answer (connection-read-to-point dictionary-connection))
+	(start 0))
+    (while (string-match "\r\n" answer start)
+      (setq answer (replace-match "\n" t t answer))
+      (setq start (1- (match-end 0))))
+    (setq start 0)
+    (if (string-match "\n\\.\n.*" answer start)
+	(setq answer (replace-match "" t t answer)))
+    answer))
+
+(defun dictionary-check-reply (reply code)
+  "Check if the reply in `reply' has the `code'."
+  (let ((number (dictionary-reply-code reply)))
+    (and (numberp number)
+	 (= number code))))
+
+(defun dictionary-coding-system (dictionary)
+  "Select coding system to use for that dictionary"
+  (when (boundp 'dictionary-coding-systems-for-dictionaries)
+    (let ((coding-system
+           (or (cdr (assoc dictionary
+                           dictionary-coding-systems-for-dictionaries))
+               'utf-8)))
+      (if (member coding-system (coding-system-list))
+          coding-system
+        nil))))
+
+(defun dictionary-decode-charset (text dictionary)
+  "Convert the text from the charset defined by the dictionary given."
+  (let ((coding-system (dictionary-coding-system dictionary)))
+    (if coding-system
+	(decode-coding-string text coding-system)
+      text)))
+
+(defun dictionary-encode-charset (text dictionary)
+  "Convert the text to the charset defined by the dictionary given."
+  (let ((coding-system (dictionary-coding-system dictionary)))
+    (if coding-system
+	(encode-coding-string text coding-system)
+      text)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Communication functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun dictionary-check-initial-reply ()
+  "Read the first reply from server and check it."
+  (let ((reply (dictionary-read-reply-and-split)))
+    (unless (dictionary-check-reply reply 220)
+      (connection-close dictionary-connection)
+      (error "Server returned: %s" (dictionary-reply reply)))))
+
+;; Store the current state
+(defun dictionary-store-state (function data)
+  "Stores the current state of operation for later restore."
+
+  (if dictionary-current-data
+      (progn
+	(push dictionary-current-data dictionary-data-stack)
+	(unless dictionary-positions
+	  (error "dictionary-store-state called before dictionary-store-positions"))
+	(push dictionary-positions dictionary-position-stack)))
+  (setq dictionary-current-data
+	(cons function data)))
+
+(defun dictionary-store-positions ()
+  "Stores the current positions for later restore."
+
+  (setq dictionary-positions (cons (point) (window-start))))
+
+;; Restore the previous state
+(defun dictionary-restore-state (&rest ignored)
+  "Restore the state just before the last operation"
+  (let ((position (pop dictionary-position-stack))
+	(data (pop dictionary-data-stack)))
+    (unless position
+      (error "Already at begin of history"))
+    (apply (car data) (cdr data))
+    (set-window-start (selected-window) (cdr position))
+    (goto-char (car position))
+    (setq dictionary-current-data data)))
+
+;; The normal search
+
+(defun dictionary-new-search (args &optional all)
+  "Save the current state and start a new search"
+  (interactive)
+  (dictionary-store-positions)
+  (let ((word (car args))
+	(dictionary (cdr args)))
+
+    (if all
+	(setq dictionary dictionary-default-dictionary))
+    (dictionary-ensure-buffer)
+    (dictionary-new-search-internal word dictionary 'dictionary-display-search-result)
+    (dictionary-store-state 'dictionary-new-search-internal
+			    (list word dictionary 'dictionary-display-search-result))))
+
+(defun dictionary-new-search-internal (word dictionary function)
+  "Starts a new search after preparing the buffer"
+  (dictionary-pre-buffer)
+  (dictionary-do-search word dictionary function))
+
+(defun dictionary-do-search (word dictionary function &optional nomatching)
+  "The workhorse for doing the search"
+
+  (message "Searching for %s in %s" word dictionary)
+  (dictionary-send-command (concat "define "
+				   (dictionary-encode-charset dictionary "")
+				   " \""
+				   (dictionary-encode-charset word dictionary)
+				   "\""))
+
+  (message nil)
+  (let ((reply (dictionary-read-reply-and-split)))
+    (if (dictionary-check-reply reply 552)
+	(progn
+	  (unless nomatching
+	    (beep)
+	    (insert "Word not found, maybe you are looking "
+		    "for one of these words\n\n")
+	    (dictionary-do-matching word
+				    dictionary
+				    "."
+				    'dictionary-display-only-match-result)
+	    (dictionary-post-buffer)))
+      (if (dictionary-check-reply reply 550)
+	  (error "Dictionary \"%s\" is unknown, please select an existing one."
+		 dictionary)
+	(unless (dictionary-check-reply reply 150)
+	  (error "Unknown server answer: %s" (dictionary-reply reply)))
+	(funcall function reply)))))
+
+(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
+	(link-insert-link "[Back]" 'dictionary-button-face
+			  'dictionary-restore-state nil
+			  "Mouse-2 to go backwards in history")
+	(insert " ")
+	(link-insert-link "[Search Definition]"
+			  'dictionary-button-face
+			  'dictionary-search nil
+			  "Mouse-2 to look up a new word")
+	(insert "         ")
+
+	(link-insert-link "[Matching words]"
+			  'dictionary-button-face
+			  'dictionary-match-words nil
+			  "Mouse-2 to find matches for a pattern")
+	(insert "        ")
+
+	(link-insert-link "[Quit]" 'dictionary-button-face
+			  'dictionary-close nil
+			  "Mouse-2 to close this window")
+
+	(insert "\n       ")
+
+	(link-insert-link "[Select Dictionary]"
+			  'dictionary-button-face
+			  'dictionary-select-dictionary nil
+			  "Mouse-2 to select dictionary for future searches")
+	(insert "         ")
+	(link-insert-link "[Select Match Strategy]"
+			  'dictionary-button-face
+			  'dictionary-select-strategy nil
+			  "Mouse-2 to select matching algorithm")
+	(insert "\n\n")))
+  (setq dictionary-marker (point-marker)))
+
+(defun dictionary-post-buffer ()
+  "These commands are executed at the end of a new buffer"
+  (goto-char dictionary-marker)
+
+  (set-buffer-modified-p nil)
+  (setq buffer-read-only t))
+
+(defun dictionary-display-search-result (reply)
+  "This function starts displaying the result starting with the `reply'."
+
+  (let ((number (nth 1 (dictionary-reply-list reply))))
+    (insert number (if (equal number "1")
+		       " definition"
+		     " definitions")
+	    " found\n\n")
+    (setq reply (dictionary-read-reply-and-split))
+    (while (dictionary-check-reply reply 151)
+      (let* ((reply-list (dictionary-reply-list reply))
+	     (dictionary (nth 2 reply-list))
+	     (description (nth 3 reply-list))
+	     (word (nth 1 reply-list)))
+	(dictionary-display-word-entry word dictionary description)
+	(setq reply (dictionary-read-answer))
+	(dictionary-display-word-definition reply word dictionary)
+	(setq reply (dictionary-read-reply-and-split))))
+    (dictionary-post-buffer)))
+
+(defun dictionary-display-word-entry (word dictionary description)
+  "Insert an explanation for the current definition."
+  (let ((start (point)))
+    (insert "From "
+	    dictionary-description-open-delimiter
+	    (dictionary-decode-charset description dictionary)
+	    dictionary-description-close-delimiter
+	    " [" (dictionary-decode-charset dictionary dictionary) "]:"
+	    "\n\n")
+    (put-text-property start (point) 'face 'dictionary-word-entry-face)))
+
+(defun dictionary-display-word-definition (reply word dictionary)
+  "Insert the definition for the current word"
+  (let ((start (point)))
+    (insert (dictionary-decode-charset reply dictionary))
+    (insert "\n\n")
+    (put-text-property start (point) 'face 'dictionary-word-definition-face)
+    (let ((regexp "\\({+\\)\\([^ '\"][^}]*\\)\\(}+\\)"))
+      (goto-char start)
+      (while (< (point) (point-max))
+	(if (search-forward-regexp regexp nil t)
+	    (let ((match-start (match-beginning 2))
+		  (match-end (match-end 2)))
+	      (if dictionary-color-support
+		  ;; Compensate for the replacement
+		  (let ((brace-match-length (- (match-end 1)
+					       (match-beginning 1))))
+		    (setq match-start (- (match-beginning 2)
+					 brace-match-length))
+		    (setq match-end (- (match-end 2)
+				       brace-match-length))
+		    (replace-match "\\2")))
+	      (dictionary-mark-reference match-start match-end
+					 'dictionary-new-search
+					 word dictionary))
+	  (goto-char (point-max)))))))
+
+(defun dictionary-mark-reference (start end call displayed-word dictionary)
+  "Format the area from `start' to `end' as link calling `call'.
+The word is taken from the buffer, the `dictionary' is given as argument."
+  (let ((word (buffer-substring-no-properties start end)))
+    (while (string-match "\n\\s-*" word)
+      (setq word (replace-match " " t t word)))
+    (while (string-match "[*\"]" word)
+      (setq word (replace-match "" t t word)))
+
+    (unless (equal word displayed-word)
+      (link-create-link start end 'dictionary-reference-face
+			call (cons word dictionary)
+			(concat "Press Mouse-2 to lookup \""
+				word "\" in \"" dictionary "\"")))))
+
+(defun dictionary-select-dictionary (&rest ignored)
+  "Save the current state and start a dictionary selection"
+  (interactive)
+  (dictionary-ensure-buffer)
+  (dictionary-store-positions)
+  (dictionary-do-select-dictionary)
+  (dictionary-store-state 'dictionary-do-select-dictionary nil))
+
+(defun dictionary-do-select-dictionary (&rest ignored)
+  "The workhorse for doing the dictionary selection."
+
+  (message "Looking up databases and descriptions")
+  (dictionary-send-command "show db")
+
+  (let ((reply (dictionary-read-reply-and-split)))
+    (message nil)
+    (if (dictionary-check-reply reply 554)
+	(error "No dictionary present")
+      (unless (dictionary-check-reply reply 110)
+	(error "Unknown server answer: %s"
+	       (dictionary-reply reply)))
+      (dictionary-display-dictionarys reply))))
+
+(defun dictionary-simple-split-string (string &optional pattern)
+  "Return a list of substrings of STRING which are separated by PATTERN.
+If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+  (or pattern
+      (setq pattern "[ \f\t\n\r\v]+"))
+  ;; The FSF version of this function takes care not to cons in case
+  ;; of infloop.  Maybe we should synch?
+  (let (parts (start 0))
+    (while (string-match pattern string start)
+      (setq parts (cons (substring string start (match-beginning 0)) parts)
+	    start (match-end 0)))
+    (nreverse (cons (substring string start) parts))))
+
+(defun dictionary-display-dictionarys (reply)
+  "Handle the display of all dictionaries existing on the server"
+  (dictionary-pre-buffer)
+  (insert "Please select your default dictionary:\n\n")
+  (dictionary-display-dictionary-line "* \"All dictionaries\"")
+  (dictionary-display-dictionary-line "! \"The first matching dictionary\"")
+  (let* ((reply (dictionary-read-answer))
+	 (list (dictionary-simple-split-string reply "\n+")))
+    (mapc 'dictionary-display-dictionary-line list))
+  (dictionary-post-buffer))
+
+(defun dictionary-display-dictionary-line (string)
+  "Display a single dictionary"
+  (let* ((list (dictionary-split-string string))
+	 (dictionary (car list))
+	 (description (cadr list))
+	 (translated (dictionary-decode-charset description dictionary)))
+    (if dictionary
+	(if (equal dictionary "--exit--")
+	    (insert "(end of default search list)\n")
+	  (link-insert-link (concat dictionary ": " translated)
+			    'dictionary-reference-face
+			    'dictionary-set-dictionary
+			    (cons dictionary description)
+			    "Mouse-2 to select this dictionary")
+	  (insert "\n")))))
+
+(defun dictionary-set-dictionary (param &optional more)
+  "Select this dictionary as new default"
+
+  (if more
+      (dictionary-display-more-info param)
+    (let ((dictionary (car param)))
+      (setq dictionary-default-dictionary dictionary)
+      (dictionary-restore-state)
+      (message "Dictionary %s has been selected" dictionary))))
+
+(defun dictionary-display-more-info (param)
+  "Display the available information on the dictionary"
+
+  (let ((dictionary (car param))
+	(description (cdr param)))
+    (unless (or (equal dictionary "*")
+		(equal dictionary "!"))
+      (dictionary-store-positions)
+      (message "Requesting more information on %s" dictionary)
+      (dictionary-send-command
+       (concat "show info " (dictionary-encode-charset dictionary "")))
+      (let ((reply (dictionary-read-reply-and-split)))
+	(message nil)
+	(if (dictionary-check-reply reply 550)
+	    (error "Dictionary \"%s\" not existing" dictionary)
+	  (unless (dictionary-check-reply reply 112)
+	    (error "Unknown server answer: %s" (dictionary-reply reply)))
+	  (dictionary-pre-buffer)
+	  (insert "Information on dictionary: ")
+	  (link-insert-link description 'dictionary-reference-face
+			    'dictionary-set-dictionary
+			    (cons dictionary description)
+			    "Mouse-2 to select this dictionary")
+	  (insert "\n\n")
+	  (setq reply (dictionary-read-answer))
+	  (insert reply)
+	  (dictionary-post-buffer)))
+
+      (dictionary-store-state 'dictionary-display-more-info dictionary))))
+
+(defun dictionary-select-strategy (&rest ignored)
+  "Save the current state and start a strategy selection"
+  (interactive)
+  (dictionary-ensure-buffer)
+  (dictionary-store-positions)
+  (dictionary-do-select-strategy)
+  (dictionary-store-state 'dictionary-do-select-strategy nil))
+
+(defun dictionary-do-select-strategy ()
+  "The workhorse for doing the strategy selection."
+
+  (message "Request existing matching algorithm")
+  (dictionary-send-command "show strat")
+
+  (let ((reply (dictionary-read-reply-and-split)))
+    (message nil)
+    (if (dictionary-check-reply reply 555)
+	(error "No strategies available")
+      (unless (dictionary-check-reply reply 111)
+	(error "Unknown server answer: %s"
+	       (dictionary-reply reply)))
+      (dictionary-display-strategies reply))))
+
+(defun dictionary-display-strategies (reply)
+  "Handle the display of all strategies existing on the server"
+  (dictionary-pre-buffer)
+  (insert "Please select your default search strategy:\n\n")
+  (dictionary-display-strategy-line ". \"The servers default\"")
+  (let* ((reply (dictionary-read-answer))
+	 (list (dictionary-simple-split-string reply "\n+")))
+    (mapc 'dictionary-display-strategy-line list))
+  (dictionary-post-buffer))
+
+(defun dictionary-display-strategy-line (string)
+  "Display a single strategy"
+  (let* ((list (dictionary-split-string string))
+	 (strategy (car list))
+	 (description (cadr list)))
+    (if strategy
+	(progn
+	  (link-insert-link description 'dictionary-reference-face
+			    'dictionary-set-strategy strategy
+			    "Mouse-2 to select this matching algorithm")
+	  (insert "\n")))))
+
+(defun dictionary-set-strategy (strategy &rest ignored)
+  "Select this strategy as new default"
+  (setq dictionary-default-strategy strategy)
+  (dictionary-restore-state)
+  (message "Strategy %s has been selected" strategy))
+
+(defun dictionary-new-matching (word)
+  "Run a new matching search on `word'."
+  (dictionary-ensure-buffer)
+  (dictionary-store-positions)
+  (dictionary-do-matching word dictionary-default-dictionary
+			  dictionary-default-strategy
+			  'dictionary-display-match-result)
+  (dictionary-store-state 'dictionary-do-matching
+			  (list word dictionary-default-dictionary
+				dictionary-default-strategy
+				'dictionary-display-match-result)))
+
+(defun dictionary-do-matching (word dictionary strategy function)
+  "Ask the server about matches to `word' and display it."
+
+  (message "Lookup matching words for %s in %s using %s"
+	   word dictionary strategy)
+  (dictionary-send-command
+   (concat "match " (dictionary-encode-charset dictionary "") " "
+	   (dictionary-encode-charset strategy "") " \""
+	   (dictionary-encode-charset word "") "\""))
+  (let ((reply (dictionary-read-reply-and-split)))
+    (message nil)
+    (if (dictionary-check-reply reply 550)
+	(error "Dictionary \"%s\" is invalid" dictionary))
+    (if (dictionary-check-reply reply 551)
+	(error "Strategy \"%s\" is invalid" strategy))
+    (if (dictionary-check-reply reply 552)
+	(error (concat
+		"No match for \"%s\" with strategy \"%s\" in "
+		"dictionary \"%s\".")
+	       word strategy dictionary))
+    (unless (dictionary-check-reply reply 152)
+      (error "Unknown server answer: %s" (dictionary-reply reply)))
+    (funcall function reply)))
+
+(defun dictionary-display-only-match-result (reply)
+  "Display the results from the current matches without the headers."
+
+  (let ((number (nth 1 (dictionary-reply-list reply)))
+	(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+    (insert number " matching word" (if (equal number "1") "" "s")
+	    " found\n\n")
+    (let ((result nil))
+      (mapc (lambda (item)
+	      (let* ((list (dictionary-split-string item))
+		     (dictionary (car list))
+		     (word (cadr list))
+		     (hash (assoc dictionary result)))
+		(if dictionary
+		    (if hash
+			(setcdr hash (cons word (cdr hash)))
+		      (setq result (cons
+				    (cons dictionary (list word))
+				    result))))))
+	    list)
+      (dictionary-display-match-lines (reverse result)))))
+
+(defun dictionary-display-match-result (reply)
+  "Display the results from the current matches."
+  (dictionary-pre-buffer)
+
+  (let ((number (nth 1 (dictionary-reply-list reply)))
+	(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+    (insert number " matching word" (if (equal number "1") "" "s")
+	    " found\n\n")
+    (let ((result nil))
+      (mapc (lambda (item)
+	      (let* ((list (dictionary-split-string item))
+		     (dictionary (car list))
+		     (word (cadr list))
+		     (hash (assoc dictionary result)))
+		(if dictionary
+		    (if hash
+			(setcdr hash (cons word (cdr hash)))
+		      (setq result (cons
+				    (cons dictionary (list word))
+				    result))))))
+	    list)
+      (dictionary-display-match-lines (reverse result))))
+  (dictionary-post-buffer))
+
+(defun dictionary-display-match-lines (list)
+  "Display the match lines."
+  (mapc (lambda (item)
+	  (let ((dictionary (car item))
+		(word-list (cdr item)))
+	    (insert "Matches from " dictionary ":\n")
+	    (mapc (lambda (word)
+		    (setq word (dictionary-decode-charset word dictionary))
+		    (insert "  ")
+		    (link-insert-link word
+				      'dictionary-reference-face
+				      'dictionary-new-search
+				      (cons word dictionary)
+				      "Mouse-2 to lookup word")
+		    (insert "\n")) (reverse word-list))
+	    (insert "\n")))
+	list))
+
+;; Returns a sensible default for dictionary-search:
+;; - if region is active returns its contents
+;; - otherwise return the word near the point
+(defun dictionary-search-default ()
+  (if (use-region-p)
+      (buffer-substring-no-properties (region-beginning) (region-end))
+    (current-word t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; User callable commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun dictionary-search (word &optional dictionary)
+  "Search the `word' in `dictionary' if given or in all if nil.
+It presents the word at point as default input and allows editing it."
+  (interactive
+   (list (let ((default (dictionary-search-default)))
+           (read-string (if default
+                            (format "Search word (%s): " default)
+                          "Search word: ")
+                        nil nil default))
+	 (if current-prefix-arg
+	     (read-string (if dictionary-default-dictionary
+			      (format "Dictionary (%s): " dictionary-default-dictionary)
+			    "Dictionary: ")
+			  nil nil dictionary-default-dictionary)
+	   dictionary-default-dictionary)))
+
+  ;; if called by pressing the button
+  (unless word
+    (setq word (read-string "Search word: ")))
+  ;; just in case non-interactivly called
+  (unless dictionary
+    (setq dictionary dictionary-default-dictionary))
+  (dictionary-new-search (cons word dictionary)))
+
+;;;###autoload
+(defun dictionary-lookup-definition ()
+  "Unconditionally lookup the word at point."
+  (interactive)
+  (dictionary-new-search (cons (current-word) dictionary-default-dictionary)))
+
+(defun dictionary-previous ()
+  "Go to the previous location in the current buffer"
+  (interactive)
+  (unless (dictionary-mode-p)
+    (error "Current buffer is no dictionary buffer"))
+  (dictionary-restore-state))
+
+(defun dictionary-next-link ()
+  "Place the cursor to the next link."
+  (interactive)
+  (let ((pos (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 (link-prev-link)))
+    (if pos
+	(goto-char pos)
+      (error "There is no previous link"))))
+
+(defun dictionary-help ()
+  "Display a little help"
+  (interactive)
+  (describe-function 'dictionary-mode))
+
+;;;###autoload
+(defun dictionary-match-words (&optional pattern &rest ignored)
+  "Search `pattern' in current default dictionary using default strategy."
+  (interactive)
+  ;; can't use interactive because of mouse events
+  (or pattern
+      (setq pattern (read-string "Search pattern: ")))
+  (dictionary-new-matching pattern))
+
+;;;###autoload
+(defun dictionary-mouse-popup-matching-words (event)
+  "Display entries matching the word at the cursor"
+  (interactive "e")
+  (let ((word (save-window-excursion
+		(save-excursion
+		  (mouse-set-point event)
+		  (current-word)))))
+    (selected-window)
+    (dictionary-popup-matching-words word)))
+
+;;;###autoload
+(defun dictionary-popup-matching-words (&optional word)
+  "Display entries matching the word at the point"
+  (interactive)
+  (unless (functionp 'popup-menu)
+    (error "Sorry, popup menus are not available in this emacs version"))
+  (dictionary-do-matching (or word (current-word))
+			  dictionary-default-dictionary
+			  dictionary-default-popup-strategy
+			  'dictionary-process-popup-replies))
+
+(defun dictionary-process-popup-replies (reply)
+  (let ((number (nth 1 (dictionary-reply-list reply)))
+	(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+
+    (let ((result (mapcar (lambda (item)
+			    (let* ((list (dictionary-split-string item))
+				   (dictionary (car list))
+				   (word (dictionary-decode-charset
+					  (cadr list) dictionary)))
+			      (message word)
+			      (if (equal word "")
+				  [ "-" nil nil]
+				(vector (concat "[" dictionary "] " word)
+					`(dictionary-new-search
+					  '(,word . ,dictionary))
+					t ))))
+
+			  list)))
+      (let ((menu (make-sparse-keymap 'dictionary-popup)))
+
+	(easy-menu-define dictionary-mode-map-menu dictionary-mode-map
+	  "Menu used for displaying dictionary popup"
+	  (cons "Matching words"
+		`(,@result)))
+	(popup-menu dictionary-mode-map-menu)))))
+
+;;; Tooltip support
+
+;; Common to GNU Emacs and XEmacs
+
+;; Add a mode indicater named "Dict"
+(defvar dictionary-tooltip-mode
+  nil
+  "Indicates wheather the dictionary tooltip mode is active")
+(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
+
+(defcustom dictionary-tooltip-dictionary
+  nil
+  "This dictionary to lookup words for tooltips"
+  :group 'dictionary
+  :type '(choice (const :tag "None" nil) string))
+
+(defun dictionary-definition (word &optional dictionary)
+  (interactive)
+  (unwind-protect
+      (let ((dictionary (or dictionary dictionary-default-dictionary)))
+	(dictionary-do-search word dictionary 'dictionary-read-definition t))
+    nil))
+
+(defun dictionary-read-definition (reply)
+  (let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
+    (mapconcat 'identity (cdr list) "\n")))
+
+(defconst dictionary-use-balloon-help
+  (eval-when-compile
+    (condition-case nil
+	(require 'balloon-help)
+      (error nil))))
+
+(make-variable-buffer-local 'dictionary-balloon-help-extent)
+
+(if dictionary-use-balloon-help
+    (progn
+
+;; The following definition are only valid for XEmacs with balloon-help
+
+(defvar dictionary-balloon-help-position nil
+  "Current position to lookup word")
+
+(defun dictionary-balloon-help-store-position (event)
+  (setq dictionary-balloon-help-position (event-point event)))
+
+(defun dictionary-balloon-help-description (&rest extent)
+  "Get the word from the cursor and lookup it"
+  (if dictionary-balloon-help-position
+      (let ((word (save-window-excursion
+		    (save-excursion
+		      (goto-char dictionary-balloon-help-position)
+		      (current-word)))))
+	(let ((definition
+		(dictionary-definition word dictionary-tooltip-dictionary)))
+	  (if definition
+	      (dictionary-decode-charset definition
+					 dictionary-tooltip-dictionary)
+	    nil)))))
+
+(defvar dictionary-balloon-help-extent nil
+  "The extent for activating the balloon help")
+
+;;;###autoload
+(defun dictionary-tooltip-mode (&optional arg)
+   "Display tooltips for the current word"
+   (interactive "P")
+   (let* ((on (if arg
+		  (> (prefix-numeric-value arg) 0)
+		(not dictionary-tooltip-mode))))
+     (make-local-variable 'dictionary-tooltip-mode)
+     (if on
+	 ;; active mode
+	 (progn
+	   ;; remove old extend
+	   (if dictionary-balloon-help-extent
+	       (delete-extent dictionary-balloon-help-extent))
+	   ;; create new one
+	   (setq dictionary-balloon-help-extent (make-extent (point-min)
+							     (point-max)))
+	   (set-extent-property dictionary-balloon-help-extent
+				'balloon-help
+				'dictionary-balloon-help-description)
+	   (set-extent-property dictionary-balloon-help-extent
+				'start-open nil)
+	   (set-extent-property dictionary-balloon-help-extent
+				'end-open nil)
+	   (add-hook 'mouse-motion-hook
+		     'dictionary-balloon-help-store-position))
+
+       ;; deactivate mode
+       (if dictionary-balloon-help-extent
+	   (delete-extent dictionary-balloon-help-extent))
+       (remove-hook 'mouse-motion-hook
+		     'dictionary-balloon-help-store-position))
+     (setq dictionary-tooltip-mode on)
+     (balloon-help-minor-mode on)))
+
+) ;; end of XEmacs part
+
+(defvar global-dictionary-tooltip-mode
+  nil)
+
+;;; Tooltip support for GNU Emacs
+(defun dictionary-display-tooltip (event)
+  "Search the current word in the `dictionary-tooltip-dictionary'."
+  (interactive "e")
+  (if dictionary-tooltip-dictionary
+      (let ((word (save-window-excursion
+		    (save-excursion
+		      (mouse-set-point event)
+		      (current-word)))))
+	(let ((definition
+		(dictionary-definition word dictionary-tooltip-dictionary)))
+	  (if definition
+	      (tooltip-show
+	       (dictionary-decode-charset definition
+					  dictionary-tooltip-dictionary)))
+	  t))
+    nil))
+
+;;;###autoload
+(defun dictionary-tooltip-mode (&optional arg)
+  "Display tooltips for the current word"
+  (interactive "P")
+  (require 'tooltip)
+  (let ((on (if arg
+		(> (prefix-numeric-value arg) 0)
+	      (not dictionary-tooltip-mode))))
+    (make-local-variable 'dictionary-tooltip-mode)
+    (setq dictionary-tooltip-mode on)
+    ;; make sure that tooltip is still (global available) even is on
+    ;; if nil
+    (tooltip-mode 1)
+    (add-hook 'tooltip-hook 'dictionary-display-tooltip)
+    (make-local-variable 'track-mouse)
+    (setq track-mouse on)))
+
+;;;###autoload
+(defun global-dictionary-tooltip-mode (&optional arg)
+  "Enable/disable dictionary-tooltip-mode for all buffers"
+  (interactive "P")
+  (require 'tooltip)
+  (let* ((on (if arg (> (prefix-numeric-value arg) 0)
+	      (not global-dictionary-tooltip-mode)))
+	 (hook-fn (if on 'add-hook 'remove-hook)))
+    (setq global-dictionary-tooltip-mode on)
+    (tooltip-mode 1)
+    (funcall hook-fn 'tooltip-hook 'dictionary-display-tooltip)
+    (setq-default dictionary-tooltip-mode on)
+    (setq-default track-mouse on)))
+
+) ;; end of GNU Emacs part
+
+(provide 'dictionary)
+
+;;; dictionary.el ends here
diff --git a/lisp/net/link.el b/lisp/net/link.el
new file mode 100644
index 00000000000..30eadb10176
--- /dev/null
+++ b/lisp/net/link.el
@@ -0,0 +1,129 @@
+;;; 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.
+;;
+;; link-create-link       - insert a new link for the text in the given range
+;; link-initialize-keymap - install the keybinding for selecting links
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(defun 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 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)
+    (link-create-link start (point) face function data help)))
+
+(defun 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 link-selected-all ()
+  "Called for meta clicking the link"
+  (interactive)
+  (link-selected 'all))
+
+(defun link-mouse-click (event &optional all)
+  "Is called upon clicking the link."
+  (interactive "@e")
+
+  (mouse-set-point event)
+  (link-selected))
+
+(defun link-mouse-click-all (event)
+  "Is called upon meta clicking the link."
+  (interactive "@e")
+
+  (mouse-set-point event)
+  (link-selected-all))
+
+(defun 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 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 link-initialize-keymap (keymap)
+  "Defines the necessary bindings inside keymap"
+
+  (if (and (boundp 'running-xemacs) running-xemacs)
+      (progn
+        (define-key keymap [button2] 'link-mouse-click)
+        (define-key keymap [(meta button2)] 'link-mouse-click-all))
+    (define-key keymap [mouse-2] 'link-mouse-click)
+    (define-key keymap [M-mouse-2] 'link-mouse-click-all))
+    (define-key keymap "\r" 'link-selected)
+    (define-key keymap "\M-\r" 'link-selected-all))
+
+(provide 'link)
+;;; link.el ends here