torsten  committed 1e0a659

- added support for non-existing defface
- reorganized history mechanism to be more flexible
- added client identification at the dictionary server
- added selection for default dictionary
- added buttons at the window top for selecting functions

  • Participants
  • Parent commits b2522f1

Comments (0)

Files changed (1)

File dictionary.el

   :group 'dictionary
   :type 'number)
+(defcustom dictionary-identification
+  "dictionary.el emacs lisp dictionary client"
+  "This is the identification string that will be send to the server."
+  :group 'dictionary
+  :type 'number)
+(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)
+(if (fboundp 'defface)
+    (progn
 (defface dictionary-word-entry-face
   '((((type x))
-     (:bold t :italic t))
+     (:italic t))
     (((type tty) (class color))
-      (:foreground "green"))
+     (:foreground "green"))
      (: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)
      (:foreground "blue"))
      (:underline t)))
   "The face that is used for displaying a reference word."
   :group 'dictionary)
+;; else
+(message "Please update your custom.el file: %s"
+	 "")
+(unless (find-face 'dictionary-word-entry-face)
+  (copy-face 'italic 'dictionary-word-entry-face))
+(unless (find-face 'dictionary-button-face)
+  (copy-face 'bold 'dictionary-button-face))
+(unless (find-face 'dictionary-reference-face)
+  (copy-face 'default 'dictionary-reference-face)
+  (set-face-foreground 'dictionary-reference-face "blue")))
 ;; Buffer local variables for storing the current state
   "The window configuration to be restored upon closing the buffer")
-(defvar dictionary-stack
+(defvar dictionary-position-stack
-  "The history buffer for dictionary operations")
+  "The history buffer for point and window position")
-(defvar dictionary-potential-stack-contents
+(defvar dictionary-data-stack
+  nil
+  "The history buffer for functions and arguments")
+(defvar dictionary-positions
+  nil
+  "The current positions")
+(defvar dictionary-current-data
   "The item that will be placed on stack next time")
   (setq major-mode 'dictionary-mode)
   (setq mode-name "Dictionary")
-  (make-local-variable 'dictionary-stack)
-  (setq dictionary-stack nil)
-  (make-local-variable 'dictionary-potential-stack-contents)
-  (setq dictionary-potential-stack-contents nil)
+  (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-hook 'kill-buffer-hook)
   (add-hook 'kill-buffer-hook 'dictionary-close t t))
     (setq dictionary-window-configuration window-configuration)
     (condition-case message
-    (dictionary-check-connection server port)
+    (dictionary-check-connection)
       (error (progn
 	       (error "Unable to open connection to %s:%s - %s"
   (suppress-keymap dictionary-mode-map))
-(defun dictionary-check-connection (server port)
+(defun dictionary-check-connection ()
   "Check if there is already a connection open"
   (if (not (or dictionary-connection
 	       (eq (connection-status dictionary-connection) 'up)))
 	(connection-close dictionary-connection)
 	(setq dictionary-connection
-	      (connection-open server port))
-	(dictionary-check-initial-reply))))
+	      (connection-open dictionary-server dictionary-port))
+	(dictionary-check-initial-reply)
+	(dictionary-send-command (concat "client " dictionary-identification))
+	(let ((reply (dictionary-read-reply-and-split)))
+	  (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-send-command (string)
   "Send the command `string' to the network connection."
+  (dictionary-check-connection)
   (connection-send-crlf dictionary-connection string))
 (defun dictionary-read-reply ()
       (error "Server returned: %s" (dictionary-reply reply)))))
 ;; Store the current state
-(defun dictionary-store-state (word dictionary kind pos window)
-  "Stores the current state of operation for later restore"
+(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)))
-  (if dictionary-potential-stack-contents
-      (push (list (car dictionary-potential-stack-contents)
-		  (cdr dictionary-potential-stack-contents)
-		  kind pos window)
-	    dictionary-stack))
-  (setq dictionary-potential-stack-contents (cons word dictionary)))
+(defun dictionary-store-positions ()
+  "Stores the current positions for later restore."
+  (setq dictionary-positions (cons (point) (window-start))))
 ;; Restore the last state
-(defun dictionary-restore-state ()
+(defun dictionary-restore-state (&rest ignored)
   "Restore the state just before the last operation"
-  (let ((prev (pop dictionary-stack)))
-    (unless prev
+  (let ((position (pop dictionary-position-stack))
+	(data (pop dictionary-data-stack)))
+    (unless position
       (error "Already at begin of history"))
-    (let ((word (nth 0 prev))
-	  (dictionary (nth 1 prev))
-	  (kind (nth 2 prev))
-	  (point (nth 3 prev))
-	  (window-start (nth 4 prev)))
-      (setq dictionary-potential-stack-contents (cons word dictionary))
-      (funcall kind word dictionary)
-      (set-window-start (selected-window) window-start)
-      (goto-char point))))
+    (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"
+  (dictionary-store-positions)
   (let ((word (car args))
-	(dictionary (cadr args))
-	(pos (point))
-	(window (window-start)))
+	(dictionary (cadr args)))
     (if all
-	(setq dictionary "*"))
+	(setq dictionary dictionary-default-dictionary))
     (dictionary-do-search word dictionary)
-    (dictionary-store-state word dictionary 'dictionary-do-search
-			    pos window)))
+    (dictionary-store-state 'dictionary-do-search (list word dictionary))))
 (defun dictionary-do-search (word dictionary)
   "The workhorse for doing the search"
     (if (dictionary-check-reply reply 552)
 	(error "Word \"%s\" in dictionary \"%s\" not found"
 	       word dictionary)
-      (unless (dictionary-check-reply reply 150)
-	(error "%s" reply))
-      (dictionary-display-search-result reply))))
+      (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" reply))
+	(dictionary-display-search-result reply)))))
+(defun dictionary-pre-buffer ()
+  "These commands are executed at the begin of a new buffer"
+  (toggle-read-only 0)
+  (erase-buffer)
+  (link-insert-link "[Back]" 'dictionary-button-face 
+		    'dictionary-restore-state)
+  (insert " ")
+  (link-insert-link "[Search Definition]" 
+		    'dictionary-button-face 
+		    'dictionary-search)
+  (insert " ")
+  (link-insert-link "[Select Default Dictionary]"
+		    'dictionary-button-face
+		    'dictionary-select-dictionary)
+  (insert "\n\n"))
+(defun dictionary-past-buffer ()
+  "These commands are executed at the end of a new buffer"
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (toggle-read-only 1))
 (defun dictionary-display-search-result (reply)
   "This function starts displaying the result starting with the `reply'."
-  (let* ((number (nth 1 (dictionary-reply-list reply))))
-    (toggle-read-only 0)
-    (erase-buffer)
+  (let ((number (nth 1 (dictionary-reply-list reply))))
+    (dictionary-pre-buffer)
     (insert number (if (equal number "1")
 		       " definition"
 		     " definitions")
     (setq reply (dictionary-read-reply-and-split))
     (while (dictionary-check-reply reply 151)
       (let* ((reply-list (dictionary-reply-list reply))
-	     (database (nth 2 reply-list))
+	     (dictionary (nth 2 reply-list))
 	     (description (nth 3 reply-list))
 	     (word (nth 1 reply-list)))
-	(dictionary-display-word-entry word database description)
+	(dictionary-display-word-entry word dictionary description)
 	(setq reply (dictionary-read-answer))
-	(dictionary-display-word-definition reply word database)
+	(dictionary-display-word-definition reply word dictionary)
 	(setq reply (dictionary-read-reply-and-split))))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (toggle-read-only 1)))
+    (dictionary-past-buffer)))
-(defun dictionary-display-word-entry (word database description)
+(defun dictionary-display-word-entry (word dictionary description)
   "Insert an explanation for the current definition."
   (let ((start (point)))
-    (insert "From " description "[" database "]:\n\n")
+    (insert "From " description "[" dictionary "]:\n\n")
     (put-text-property start (point) 'face 'dictionary-word-entry-face)))
-(defun dictionary-display-word-definition (reply word database)
+(defun dictionary-display-word-definition (reply word dictionary)
   "Insert the definition for the current word"
   (let ((start (point)))
     (insert reply)
 		(dictionary-mark-reference match-start match-end
-					   word database)))
+					   word dictionary)))
 	  (goto-char (point-max)))))))
-(defun dictionary-mark-reference (start end call displayed-word database)
+(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 `database' is given as argument."
+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)))
     (unless (equal word displayed-word)
       (link-create-link start end 'dictionary-reference-face
-			call (list word database)))))
+			call (list word 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."
+  (dictionary-send-command "show db")
+  (let ((reply (dictionary-read-reply-and-split)))
+    (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-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 (split-string reply "\n+")))
+    (mapcar 'dictionary-display-dictionary-line list))
+  (dictionary-past-buffer))
+(defun dictionary-display-dictionary-line (string)
+  "Display a single dictionary"
+  (let* ((list (dictionary-split-string string))
+	 (dictionary (car list))
+	 (description (cadr list)))
+    (if dictionary
+	(progn
+	  (link-insert-link description 'dictionary-reference-face
+			    'dictionary-set-dictionary dictionary)
+	  (insert "\n")))))
+(defun dictionary-set-dictionary (dictionary &rest ignored)
+  "Select this dictionary as new default"
+  (setq dictionary-default-dictionary dictionary)
+  (message "Dictionary %s has been selected" dictionary))
 ;; User callable commands
-(defun dictionary-search (word &optional dictionary)
+(defun dictionary-search (&optional word &optional dictionary)
   "Search the `word' in `dictionary' if given or in all if nil"
-  (interactive "sSearch word: ")
+  (interactive)
+  (or word
+      (setq word (read-string "Search word: ")))
   (or dictionary
-      (setq dictionary "*"))
+      (setq dictionary dictionary-default-dictionary))
   (dictionary-new-search (list word dictionary)))
 (defun dictionary-last ()