Commits

Anonymous committed 07f6ac9

(toplevel): Define menu in keymap `eudc-hotlist-keymap' for FSF Emacs
(eudc-mode): Define menu in keymap for FSF Emacs
(eudc-register-protocol): Update custom definition of
`eudc-protocol'
(eudc-expand-inline): Fix for multi-line address lists
(plist-member): Defined for FSF Emacs
(lax-plist-get): Ditto
(eudc-plist-get): New function for compatibility with FSF Emacs
which accepts two args only in `plist-get'
(eudc-install-menu): Use `easy-menu-add-item' in recent FSF Emacsen

  • Participants
  • Parent commits e1b9047
  • Tags r1-26

Comments (0)

Files changed (1)

 ;;    message buffers).  It also interfaces with the BBDB package to let you
 ;;    register query results into your own BBDB database.
 
-;;; Installation:
-
-;;    This library is compatible with XEmacs 20 and under Emacs 19.34 and above
-
 ;;; Usage:
+;;    See the corresponding info file
 
 ;;; Code:
 
 (defvar eudc-hotlist-mode-map nil)
 (defvar eudc-hotlist-list-beginning nil)
 
-;; Known protocols (used in completion)
-;; Not to be mistaken with eudc-supported-protocols
-(defconst eudc-known-protocols '(bbdb ph ldap))
-
 ;; Used by the selection insertion mechanism
 (defvar eudc-pre-select-window-configuration nil)
 (defvar eudc-insertion-marker nil)
 (defun eudc-cdaar (obj)
   (cdr (car (car obj))))
 
+(if (not (fboundp 'plist-member))
+    (progn
+      (defun plist-member (plist prop)
+	(if (not (= 0 (% (length plist) 2)))
+	    (error "Malformed plist"))
+	(catch 'found
+	  (while plist
+	    (if (eq prop (car plist))
+		(throw 'found t))
+	    (setq plist (cdr (cdr plist))))
+	  nil))))
+
+(if (not (fboundp 'lax-plist-get))
+    (defun lax-plist-get (plist prop &optional default)
+      (if (not (= 0 (% (length plist) 2)))
+	  (error "Malformed plist"))
+      (catch 'found
+	(while plist
+	  (if (equal prop (car plist))
+	      (throw 'found (car (cdr plist))))
+	  (setq plist (cdr (cdr plist))))
+	default)))
+
+(if eudc-xemacs-p
+    (defalias 'eudc-plist-get 'plist-get)
+  (defun eudc-plist-get (plist prop &optional default)
+    (if (plist-member plist prop)
+	(plist-get plist prop)
+      default)))
+
 ;;}}} 
 
 ;;{{{ Server and Protocol Variable Routines
   (if (eq 'unbound (eudc-variable-default-value var))
       (eudc-default-set var (symbol-value var)))
   (let* ((eudc-locals (get var 'eudc-locals))
-	 (protocol-locals (plist-get eudc-locals 'protocol)))
+	 (protocol-locals (eudc-plist-get eudc-locals 'protocol)))
     (setq protocol-locals (plist-put protocol-locals (or protocol
 							 eudc-protocol) val))
     (setq eudc-locals 
 (defun eudc-server-set (var val &optional server)
   "Set the SERVER-local binding of VAR to VAL.
 If omitted SERVER defaults to the current value of `eudc-server'.
-The current binding of VAR is changed only if SERVER is omitted.."
+The current binding of VAR is changed only if SERVER is omitted."
   (if (eq 'unbound (eudc-variable-default-value var))
       (eudc-default-set var (symbol-value var)))
   (let* ((eudc-locals (get var 'eudc-locals))
-	 (server-locals (plist-get eudc-locals 'server)))
+	 (server-locals (eudc-plist-get eudc-locals 'server)))
     (setq server-locals (plist-put server-locals (or server
 						     eudc-server) val))
     (setq eudc-locals 
   (let ((eudc-locals (get var 'eudc-locals)))
     (if (and (boundp var)
 	     eudc-locals)
-	(plist-get eudc-locals 'default 'unbound)
+	(eudc-plist-get eudc-locals 'default 'unbound)
       'unbound)))
 
 (defun eudc-variable-protocol-value (var &optional protocol)
 		   eudc-locals
 		   (plist-member eudc-locals 'protocol)))
 	'unbound
-      (setq protocol-locals (plist-get eudc-locals 'protocol))
+      (setq protocol-locals (eudc-plist-get eudc-locals 'protocol))
       (lax-plist-get protocol-locals 
 		     (or protocol
 			 eudc-protocol) 'unbound))))
 		  eudc-locals
 		  (plist-member eudc-locals 'server)))
 	'unbound
-      (setq server-locals (plist-get eudc-locals 'server))
+      (setq server-locals (eudc-plist-get eudc-locals 'server))
       (lax-plist-get server-locals 
 		     (or server
 			 eudc-server) 'unbound))))
 (defun eudc-register-protocol (protocol)
   (unless (memq protocol eudc-supported-protocols)
     (setq eudc-supported-protocols 
-	  (cons protocol eudc-supported-protocols))))
+	  (cons protocol eudc-supported-protocols))
+    (put 'eudc-protocol 'custom-type 
+	 `(choice :menu-tag "Protocol"
+		  ,@(mapcar (lambda (s) 
+			      (list 'string ':tag (symbol-name s)))
+			    eudc-supported-protocols))))
+  (or (memq protocol eudc-known-protocols)
+      (setq eudc-known-protocols
+	    (cons protocol eudc-known-protocols))))
+
 
 (defun eudc-translate-query (query)
   "Translate attribute names of QUERY according to `eudc-protocol-attributes-translation-alist'."
   (setq major-mode 'eudc-mode)
   (setq mode-name "EUDC")
   (use-local-map eudc-mode-map)
-  (setq mode-popup-menu (eudc-menu))
+  (if eudc-emacs-p
+      (easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))
+    (setq mode-popup-menu (eudc-menu)))
   (run-hooks 'eudc-mode-hook)
   )
 
 	(error "No server in the hotlist")))
   (let* ((end (point))
 	 (beg (save-excursion
-		(if (re-search-backward "[:,][ \t]*" 
+		(if (re-search-backward "\\([:,]\\|^\\)[ \t]*" 
 					(save-excursion
 					  (beginning-of-line)
 					  (point))
 	(define-key map "q" 'eudc-hotlist-quit-edit)
 	(define-key map "x" 'kill-this-buffer)
 	map))
-	
+
 (defconst eudc-custom-generated-menu (cdr (custom-menu-create 'eudc)))
 
 (defconst eudc-tail-menu 
     ["Save and Quit" eudc-hotlist-quit-edit t]
     ["Exit without Saving" kill-this-buffer t]))
 
+(if eudc-emacs-p
+    (easy-menu-define eudc-hotlist-emacs-menu 
+		      eudc-hotlist-mode-map
+		      ""
+		      eudc-hotlist-menu))
+
 (defun eudc-menu ()
   (let (command)
     (append '("Directory Search")
    ((and eudc-xemacs-p (featurep 'menubar))
     (add-submenu '("Tools") (eudc-menu)))
    (eudc-emacs-p
-    (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu))
-    (define-key 
-      global-map
-      [menu-bar tools eudc] 
-      (cons "Directory"
-	    (easy-menu-create-keymaps "Directory" (cdr (eudc-menu))))))
+    (cond 
+     ((fboundp 'easy-menu-add-item)
+      (let ((menu (eudc-menu)))
+	(easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu)
+								  (cdr menu)))))
+     ((fboundp 'easy-menu-create-keymaps)
+      (easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu))
+      (define-key 
+	global-map
+	[menu-bar tools eudc] 
+	(cons "Directory"
+	      (easy-menu-create-keymaps "Directory" (cdr (eudc-menu))))))
+     (t
+      (error "Unknown version of easymenu"))))
    ))