;; -*- emacs-lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; $Id: gnus_ldap.el,v 1.5 2006-11-06 21:02:42 rscholz Exp $
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; LDAP-Completion für Gnus
;;
;; Die offizielle Quelle dieser Datei ist
;;   <http://www.zonix.de/projects/emacs/config>
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; LDAP-Adressvervollständigung (ungetestet - ich habe kein LDAP)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Colin Walters in <87y9s1bq6z.church.of.emacs@meta.verbum.org>

(setq ldap-default-host "ldap.home")

;; Utility function
(defun cw/completing-choose (prompt list)
  (if (cdr list)
      (completing-read prompt (mapcar 'list list) nil t)
    (car list)))

(require 'ldap)

(defvar cw/ldap-search-query-format "cn=*%s*")
(defvar cw/ldap-name-field "cn")
(defvar cw/ldap-email-field "mail")

(defun cw/ldap-expand-address ()
  (interactive)
  (let* ((end (point))
	 (beg (prog2
		  (backward-word 1)
		  (point)
		(forward-word 1)))
	 (str (buffer-substring beg end))
	 (query (format cw/ldap-search-query-format str)))
    (let ((results (delq nil
			 (mapcar
			  #'(lambda (result)
			      (let ((name (assoc cw/ldap-name-field
						 result))
				    (mails
				     (delq nil
					   (mapcar 
					    #'(lambda (e)
						(when (string-equal cw/ldap-email-field
								    (car e))
						  (cadr e)))
					    result))))
				(when (and name mails)
				  (cons (cadr name) mails))))
			  (ldap-search query)))))
      (unless results
	(error "No matches for %s" query))
      (let* ((result
	      (if (cdr results)
		  (assoc (completing-read "Person: " results)
			 results)
		(car results)))
	     (name (car result))
	     (mail (cw/completing-choose "Address: " (cdr result))))
	(delete-region beg end)
	(insert (format "%s <%s>" name mail))))))

(define-key message-mode-map "\C-cl" 'cw/ldap-expand-address)