;; -*- 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)