;;; -*- Mode: Lisp; Last modified: "2006/06/13 00:05:50"; -*-

;────────────────────────────────────
;;; 以下，kamail/kamail3-ldap.l より拝借し，改変したもの。
;────────────────────────────────────

(defvar *kamail3-disable-ldap-search* nil)

(unless *kamail3-disable-ldap-search*
  (require "ldap-search"))

(provide "kamail3-ldap")

(in-package "kamail3")

(define-key *draft-map* #\l 'kamail3-ldap-draft-edit-address)

(defun kamail3-ldap-draft-edit-address ()
  (interactive)
  (let (field
        alist)
    (multiple-value-bind (from to tag)
        (find-text-attribute-point (point))
      (setq field (if (or (equal tag "to")
                          (equal tag "cc")
                          (equal tag "bcc"))
                      tag
                    (completing-read  "header: "
                                      '("to" "cc" "bcc" "repley-to" "sender")
                                      :must-match t))))
    (message "アドレスを検索します。先頭文字列を指定して Enter！！")
    (let ((str (read-string (format nil "LDAP Search (~A): " (string-capitalize field)))))
      (when str
        (if (fboundp 'ed::ldap-search-complete-address-list)
            (setq alist (butlast (ed::ldap-search-complete-address-list str))))
        (setq alist (append alist (mapcar #'(lambda (x)
                                              (list (address-email x)
                                                    (address-name x)
                                                    (address-group x)
                                                    ))
                                          *address-list*)))
        (if alist
            (kamail3-ldap-address-complete alist str field)
          (message "No addresses."))
        ))))

(defun kamail3-ldap-address-complete (alist str field)
  (let (complist)
    (if (equal str "")
        (setq complist alist)
      (dolist (a (reverse alist))
        (when (string-match (concat "^" str) (kamail3-address-addr a))
          (push a complist)))
      )
    (cond ((or (not complist)
               (= 0 (list-length complist)))
           (message "No match."))
          ((= 1 (list-length complist))
           (let ((name (kamail3-address-name (car complist)))
                 (addr (kamail3-address-addr (car complist)))
                 addrstr)
             (if name
                 (setq addrstr (format nil "~A <~A>" name addr))
               (setq addrstr (format nil "~A" addr)))
             (draft-add-header-addr field addrstr)
             ))
          ((< 1 (list-length complist))
           (progn
             (unless (kamail3-address-popup-menu complist field)
               (insert str))))
          );cond
    ))

;────────────────────────────────────
;;; 以下，kamail/kamail-address.l より拝借したものと，改変したもの。
;────────────────────────────────────

(defmacro kamail3-address-addr (addrlist)
  `(car ,addrlist))

(defmacro kamail3-address-name (addrlist)
  `(cadr ,addrlist))

(defmacro kamail3-address-group (addrlist)
  `(caddr ,addrlist))

(defmacro kamail3-address-group-parent (glist)
  `(cdr ,glist))

(defun kamail3-address-popup-menu (alist field)
  (interactive)
  (track-popup-menu (kamail3-address-popup-menu-create alist field)))

(defun kamail3-address-menu-string (addr name)
  (if name
      (format nil "~A <~A>" name addr)
    (format nil "~A" addr)))

(defun kamail3-address-popup-menu-create (alist field &optional group)
  (let ((menu (create-popup-menu nil)))
    (dolist (a alist)
      (let* ((name (kamail3-address-name a))
             (addr (kamail3-address-addr a))
             (g (kamail3-address-group a))
             (str (kamail3-address-menu-string addr name)))
        (when (equal group g)
          (add-menu-item menu 'addr str
                         #'(lambda () (interactive) (draft-add-header-addr field str))))))
    ;(unless group
      ;(add-menu-separator menu))
    (dolist (g *address-group-list*)
      (when (and g (not group))
        (add-popup-menu menu
                        (kamail3-address-popup-menu-create alist field g)
                        g)))
    menu
    ))

;;; kamail3-ldap.l は，ここまで。