Commits

Anonymous committed 37ce101

- made some changes to allow using in emacs19

Comments (0)

Files changed (2)

 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-(require 'cl)
+(eval-when-compile
+  (require 'cl))
+
 (require 'custom)
 (require 'connection)
 (require 'link)
 ;; Stuff for customizing.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(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)))
+
+(unless (fboundp 'find-face)
+  (defmacro find-face (face) nil))
+
 (defgroup dictionary nil
   "Client for accessing the dictd server based dictionaries"
   :group 'help
   :group 'hypermedia)
- 
+
 (defcustom dictionary-server
   "dict.org"
   "This server is contacted for searching the dictionary"
 )
 
 ;; else
-(message "Please update your custom.el file: %s"
-	 "http://www.dina.kvl.dk/~abraham/custom/")
 (unless (find-face 'dictionary-word-entry-face)
   (copy-face 'italic 'dictionary-word-entry-face))
 (unless (find-face 'dictionary-button-face)
 * 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
 "
     (make-local-variable 'dictionary-window-configuration)
     (setq dictionary-window-configuration window-configuration)
     (dictionary-mode)
-    (condition-case message
-	(dictionary-check-connection)
-      (error (progn
-	       (dictionary-close)
-	       (error "Unable to open connection to %s:%s - %s"
-		      server port (nth 1 message)))))))
+    (dictionary-check-connection)))
 
 (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 "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)
+  (define-key dictionary-mode-map "l" 'dictionary-previous)
 
   (define-key dictionary-mode-map [tab] 'dictionary-next-link)
   (define-key dictionary-mode-map "n" 'dictionary-next-link)
   (define-key dictionary-mode-map " " 'scroll-up)
   (define-key dictionary-mode-map [(meta space)] 'scroll-down)
 
-  (suppress-keymap dictionary-mode-map))
+  (link-initialize-keymap dictionary-mode-map))
   
 (defun dictionary-check-connection ()
   "Check if there is already a connection open"
   
   (setq dictionary-positions (cons (point) (window-start))))
   
-;; Restore the last state
+;; Restore the previous state
 (defun dictionary-restore-state (&rest ignored)
   "Restore the state just before the last operation"
   (let ((position (pop dictionary-position-stack))
 	(link-insert-link "[Select Match Strategy]"
 			  'dictionary-button-face
 			  'dictionary-select-strategy)
-	(insert "\n\n"))))
+	(insert "\n\n")))
+  (set-mark (point)))
 
 (defun dictionary-post-buffer ()
   "These commands are executed at the end of a new buffer"
-    (goto-char (point-min))
+    (exchange-point-and-mark)
     (set-buffer-modified-p nil)
     (toggle-read-only 1))
 
 	       (dictionary-reply reply)))
       (dictionary-display-dictionarys reply))))
 
+(unless (fboundp 'split-string)
+  (defun 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)
 (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")
+  (insert "Please select your default search strategy:\n\n")
   (dictionary-display-strategy-line ". \"The servers default\"")
   (let* ((reply (dictionary-read-answer))
 	 (list (split-string reply "\n+")))
 	(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)))
+    (let ((result nil))
       (mapcar (lambda (item)
 		(let* ((list (dictionary-split-string item))
 		       (dictionary (car list))
 		       (word (cadr list))
-		       (hash (gethash dictionary result)))
+		       (hash (assoc dictionary result)))
 		  (if dictionary
-		      (puthash dictionary (if hash
-					      (cons word hash)
-					    (list word))
-			       result))))
+		      (if hash
+			  (setcdr hash (cons word (cdr hash)))
+		    (setq result (cons 
+				  (cons dictionary (list word)) 
+				  result))))))
 	      list)
-      (dictionary-display-match-lines result)))
+      (dictionary-display-match-lines (reverse result))))
   (dictionary-post-buffer))
 
-(defun dictionary-display-match-lines (hash)
+(defun dictionary-display-match-lines (list)
   "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))
-
+  (mapcar (lambda (item)
+	    (let ((dictionary (car item))
+		  (word-list (cdr item)))
+	      (insert "Matches from " dictionary ":\n")
+	      (mapcar (lambda (word)
+			(insert "  ")
+			(link-insert-link word 'dictionary-reference-face
+					  'dictionary-new-search
+					  (list word dictionary))
+			(insert "\n")) (reverse word-list))
+	      (insert "\n")))
+	    list))
 	   
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; User callable commands
       (setq dictionary dictionary-default-dictionary))
   (dictionary-new-search (list word dictionary)))
 
-(defun dictionary-last ()
+(defun dictionary-previous ()
   "Go to the previous location in the current buffer"
   (interactive)
   
 ;; Which each link a function and some data are associated.  Upon
 ;; clicking the function is called with the data as only argument.
 
-(require 'cl)
-
-(defvar link-keymap
-  nil
-  "Keymap used when point is over the link")
+(eval-when-compile
+  (require 'cl))
 
 (defun link-create-link (start end face function &optional data)
   "Create a link in the current buffer starting from `start' going to `end'.
 link.  Upon clicking the `function' is called with `data' as argument."
   (let ((properties `(face ,face
 	              mouse-face highlight
+		      link t
 		      link-data ,data
-		      link-function ,function
-		      keymap ,link-keymap)))
-    (set-extent-properties (make-extent start end) properties)))
+		      link-function ,function)))
+    (set-text-properties start end properties)))
 
 (defun link-insert-link (text face function &optional data)
   "Insert the `text' at point to be formatted as link.
   "Is called upon clicking or otherwise visiting the link."
   (interactive)
 
-  (let* ((extent (extent-at (point)))
-	 (function (extent-property extent 'link-function))
-	 (data (extent-property extent 'link-data)))
+  (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-next-link ()
   "Return the position of the next link or nil if there is none"
-  (let ((oldpos 0)
-	(found))
-    (save-excursion
-      (while (not (or found
-		      (= oldpos (point))))
-	(setq oldpos (point))
-	(goto-char (next-extent-change (point)))
-	(if (extent-at (point) (current-buffer)
-		       'link-function)
-	    (setq found (point)))))
-    found))
+  (let* ((pos (point))
+	 (pos (next-single-property-change pos 'link)))
+    (if (text-property-any pos (min (1+ pos) (point-max)) 'link t)
+	pos
+      (next-single-property-change pos 'link))))
+      
 
 (defun link-prev-link ()
   "Return the position of the previous link or nil if there is none"
-  (let ((oldpos 0)
-	(found))
-    (save-excursion
-      (while (not (or found
-		      (= oldpos (point))))
-	(setq oldpos (point))
-	(goto-char (previous-extent-change (point)))
-	(if (extent-at (point) (current-buffer)
-		       'link-function)
-	    (setq found (point)))))
-    found))
+  (let* ((pos (point))
+	 (pos (previous-single-property-change pos 'link)))
+    (if (text-property-any pos (1+ pos) 'link t)
+	pos
+      ;; Handle special case of link starting at buffer start
+      (let ((val (previous-single-property-change pos 'link)))
+	(if val
+	    val
+	  (text-property-any (point-min) (1+ (point-min)) 'link t))))))
 
-(defun link-remove-link ()
-  "Remove the link at the current position"
-  (let ((extent (extent-at (point) (current-buffer))))
-    (if extent
-	(delete-extent extent))))
+(defun link-initialize-keymap (keymap)
+  "Defines the necessary bindings inside keymap"
 
-(unless link-keymap
-  (setq link-keymap (make-sparse-keymap))
-
-  (define-key link-keymap [button2] 'link-mouse-click)
-  (define-key link-keymap [(meta button2)] 'link-mouse-click-all)
-  (define-key link-keymap [return] 'link-selected)
-  (define-key link-keymap [(meta return)] 'link-selected-all))
+  (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 [return] 'link-selected)
+  (define-key keymap [(meta return)] 'link-selected-all))
 
 (provide 'link)