Commits

Anonymous committed 62e15a9

- added matching words

Comments (0)

Files changed (1)

   :group 'dictionary
   :type 'string)
 
+(defcustom dictionary-default-strategy
+  "."
+  "The default strategy for listing matching words."
+  :group 'dictionary
+  :type 'string)
+
+(defcustom dictionary-create-buttons
+  t
+  "Create some clickable buttons on top of the window if non-nil"
+  :group 'dictionary
+  :type 'boolean)
+
 (if (fboundp 'defface)
     (progn
 
   (make-local-variable 'dictionary-positions)
 
   (make-local-variable 'dictionary-default-dictionary)
+  (make-local-variable 'dictionary-default-strategy)
 
   (make-local-hook 'kill-buffer-hook)
   (add-hook 'kill-buffer-hook 'dictionary-close t t))
     (setq dictionary-window-configuration window-configuration)
     (dictionary-mode)
     (condition-case message
-    (dictionary-check-connection)
+	(dictionary-check-connection)
       (error (progn
 	       (dictionary-close)
 	       (error "Unable to open connection to %s:%s - %s"
   (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-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 "d" 'dictionary-search-word-at-point)
   (define-key dictionary-mode-map "l" 'dictionary-last)
 
   
 (defun dictionary-check-connection ()
   "Check if there is already a connection open"
-  (if (not (or dictionary-connection
-	       (eq (connection-status dictionary-connection) 'up)))
+  (if (not (and dictionary-connection
+		(eq (connection-status dictionary-connection) 'up)))
       (progn
 	(connection-close dictionary-connection)
 	(setq dictionary-connection
 	  (error "Dictionary \"%s\" is unknown, please select an existing one."
 		 dictionary)
 	(unless (dictionary-check-reply reply 150)
-	  (error "Unknown server answer: %s" reply))
+	  (error "Unknown server answer: %s" (dictionary-reply 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"))
+  (if dictionary-create-buttons
+      (progn
+	(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 "[Matching words]"
+			  'dictionary-button-face
+			  'dictionary-match-words)
+	(insert "\n       ")
+	(link-insert-link "[Select Default Dictionary]"
+			  'dictionary-button-face
+			  'dictionary-select-dictionary)
+	(insert " ")
+	(link-insert-link "[Select Match Strategy]"
+			  'dictionary-button-face
+			  'dictionary-select-strategy)
+	(insert "\n\n"))))
 
-(defun dictionary-past-buffer ()
+(defun dictionary-post-buffer ()
   "These commands are executed at the end of a new buffer"
     (goto-char (point-min))
     (set-buffer-modified-p nil)
 	(setq reply (dictionary-read-answer))
 	(dictionary-display-word-definition reply word dictionary)
 	(setq reply (dictionary-read-reply-and-split))))
-    (dictionary-past-buffer)))
+    (dictionary-post-buffer)))
 
 (defun dictionary-display-word-entry (word dictionary description)
   "Insert an explanation for the current definition."
   (let* ((reply (dictionary-read-answer))
 	 (list (split-string reply "\n+")))
     (mapcar 'dictionary-display-dictionary-line list))
-  (dictionary-past-buffer))
+  (dictionary-post-buffer))
 
 (defun dictionary-display-dictionary-line (string)
   "Display a single dictionary"
     (if dictionary
 	(progn
 	  (link-insert-link description 'dictionary-reference-face
-			    'dictionary-set-dictionary dictionary)
+			    'dictionary-set-dictionary 
+			    (cons dictionary description))
 	  (insert "\n")))))
     
-(defun dictionary-set-dictionary (dictionary &rest ignored)
+(defun dictionary-set-dictionary (param &optional more)
   "Select this dictionary as new default"
-  (setq dictionary-default-dictionary dictionary)
-  (message "Dictionary %s has been selected" dictionary))
+
+  (if more
+      (dictionary-display-more-info param)
+    (let ((dictionary (car param)))
+      (setq dictionary-default-dictionary dictionary)
+      (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)
+      (dictionary-send-command (concat "show info \"" dictionary "\""))
+      (let ((reply (dictionary-read-reply-and-split)))
+	(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))
+	  (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."
+
+  (dictionary-send-command "show strat")
+
+  (let ((reply (dictionary-read-reply-and-split)))
+    (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 strategie:\n\n")
+  (dictionary-display-strategy-line ". \"The servers default\"")
+  (let* ((reply (dictionary-read-answer))
+	 (list (split-string reply "\n+")))
+    (mapcar '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)
+	  (insert "\n")))))
+    
+(defun dictionary-set-strategy (strategy &rest ignored)
+  "Select this strategy as new default"
+  (setq dictionary-default-strategy strategy)
+  (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-store-state 'dictionary-do-matching 
+			  (list word dictionary-default-dictionary
+				dictionary-default-strategy)))
+
+(defun dictionary-do-matching (word dictionary strategy)
+  "Ask the server about matches to `word' and display it."
+  
+  (dictionary-send-command 
+   (concat "match \"" dictionary "\" \""
+	   strategy "\" \"" word "\""))
+  (let ((reply (dictionary-read-reply-and-split)))
+    (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)))
+    (dictionary-display-match-result reply)))
+
+(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 (split-string (dictionary-read-answer) "\n+")))
+    (insert number " matching word" (if (equal number "1") "" "s")
+	    " found\n\n")
+    (let ((result (make-hashtable 5 'equal)))
+      (mapcar (lambda (item)
+		(let* ((list (dictionary-split-string item))
+		       (dictionary (car list))
+		       (word (cadr list))
+		       (hash (gethash dictionary result)))
+		  (if dictionary
+		      (puthash dictionary (if hash
+					      (cons word hash)
+					    (list word))
+			       result))))
+	      list)
+      (dictionary-display-match-lines result)))
+  (dictionary-post-buffer))
+
+(defun dictionary-display-match-lines (hash)
+  "Display the match lines."
+  (maphash (lambda (dictionary word-list)
+	     (insert "Matches from " dictionary ":\n")
+	     (mapcar (lambda (word)
+		       (insert "  ")
+		       (link-insert-link word 'dictionary-reference-face
+					 'dictionary-new-search
+					 (list word dictionary))
+		       (insert "\n")) word-list)
+	     (insert "\n"))
+	   hash))
+
+	   
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; User callable commands
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   "Display a little help"
   (interactive)
   (describe-function 'dictionary-mode))
+
+(defun dictionary-match-words (&optional word &rest ignored)
+  "Search `word' in current default dictionary using default strategy."
+  (interactive)
+  (or word
+      (setq word (read-string "Search word: ")))
+  (dictionary-new-matching word))