;;; -*- Mode:Emacs-Lisp -*-

;;; This file is the core of the eweouz, an interface to the
;;; evolution-data-server, somewhat similar to BBDB.

;;;  copyright (c) 2008 Tollef Fog Heen <tfheen@err.no>
;;;
;;; eweouz is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License version 2 as
;;; published by the Free Software Foundation.
;;;
;;; eweouz is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA.
;;;

(require 'cl)

(defconst eweouz-version "0.8")
(defconst eweouz-buffer-name "*EWEOUZ*")

(setq eweouz-helper-dirs '("/usr/lib/eweouz" "/usr/local/lib/eweouz"))

(defvar eweouz-dump-path (locate-file "eweouz-dump-addressbook"
				      eweouz-helper-dirs
				      nil
				      'executable))

(defvar eweouz-write-path (locate-file "eweouz-write-addressbook"
				       eweouz-helper-dirs
				       nil
				       'executable))

(defvar eweouz-buffer nil)
(defvar eweouz-pop-up-target-lines 5)

(defun eweouz-search-do (func string &optional max-matches)
  "Search for the simple string STRING in all fields"
  (let ((i 0))
    (with-temp-buffer
      (call-process eweouz-dump-path nil (list (current-buffer) nil) t string)
      (set-text-properties (point-min) (point-max) nil nil)
      (goto-char (point-min))
      (message (format "%s" (point)))
      (while (and (looking-at "\n*BEGIN:VCARD") (or (eq max-matches nil)
						 (< i max-matches)))
	(let ((m-start (point)))
	  (incf i)
	  (message (format "%s" (point)))
	  (search-forward-regexp "^END:VCARD")
	  (funcall func (vcard-parse-string (buffer-substring m-start (point)))))))))

;;;###autoload
(defun eweouz-complete (&optional start-pos)
  (interactive)
  (eweouz-erase-buffer)
  (let* ((end (point))
	 (beg (or start-pos
		  (save-excursion
		    (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
		    (goto-char (match-end 0))
		    (point))))
	 (typed (or (and (eq this-command last-command)
			 (get this-command 'typed))
		    (downcase (buffer-substring beg end))))
	 (index (or (and (eq this-command last-command)
			 (get this-command 'index))
		    0))
	 (match-recs '()))
    (eweouz-search-do '(lambda (x) (add-to-list 'match-recs x)) typed)
    (cond ((= 0 (length match-recs))
	   (message "No matching records"))
	  ((= 1 (length match-recs))
	  ; Just one match; insert it
	   (progn
	     (delete-region beg end)
	     (insert (vcard-format-sample-get-name (car match-recs)))))
	  ((< 1 (length match-recs))
	   ;; For now, just display the records and leave the user to
	   ;; complete
	   (if (eq this-command last-command)
	       ;; Select next in list
	       (progn
		 (delete-region beg end)
		 (insert (vcard-format-sample-get-name (nth index match-recs)))
		 (put this-command 'index (% (+ 1 index)
					     (length match-recs))))
	     (save-excursion
	       (put this-command 'typed typed)
	       (put this-command 'index 0)
	       (set-buffer (get-buffer-create eweouz-buffer-name))
	       (mapcar '(lambda (x) (insert (format "%s\n"
						  (vcard-format-sample-get-name x)))) match-recs)
	       (eweouz-pop-up-eweouz-buffer)))))))

;
; Mostly stolen from bbdb-pop-up-bbdb-buffer

(defun eweouz-pop-up-eweouz-buffer (&optional horiz-predicate)
 (let ((b (current-buffer)))
    (if (get-buffer-window eweouz-buffer-name)
	nil
      (let* ((first-window (selected-window))
	     (tallest-window first-window)
	     (window first-window))
	;; find the tallest window...
	(while (not (eq (setq window (previous-window window)) first-window))
	  (if (> (window-height window) (window-height tallest-window))
	      (setq tallest-window window)))
	;; select it and split it...
	(select-window tallest-window)
	(let ((size (min
		     (- (window-height tallest-window)
			window-min-height 1)
		     (- (window-height tallest-window)
			(max window-min-height
			     (1+ eweouz-pop-up-target-lines))))))
	  (split-window tallest-window
			(if (> size 0) size window-min-height)))
	(if (memq major-mode
		  '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode))
	    (goto-char (point-min)))  ; make gnus happy...
	;; goto the bottom of the two...
	(select-window (next-window))
	;; make it display *EWEOUZ*...
	(let ((pop-up-windows nil))
	  (switch-to-buffer (get-buffer-create eweouz-buffer-name)))
	;; select the original window we were in...
	(select-window first-window)))
    ;; and make sure the current buffer is correct as well.
    (set-buffer b)
    nil))

(defun eweouz-erase-buffer ()
  (save-excursion
    (set-buffer (get-buffer-create eweouz-buffer-name))
    (erase-buffer)))

;;;###autoload
(defun eweouz (string)
  (interactive "MSearch for: ")
  "Search all entries for the simple string STRING in all fields"
  (eweouz-erase-buffer)
  (eweouz-search-do 'eweouz-show string)
  (eweouz-pop-up-eweouz-buffer))

(defun eweouz-show (record)
  "Display an entry in the current buffer"
  (save-excursion
    (set-buffer (get-buffer-create eweouz-buffer-name))
    (insert (vcard-pretty-print record))))

(defun eweouz-add-sender-gnus ()
  "Add sender of current message"
  (interactive)
  (save-excursion
    (set-buffer gnus-article-buffer)
    (let* ((from (mail-header-parse-address (gnus-fetch-field "From")))
	   (email (car from))
	   (name (cdr from))
	   (record (or (eweouz-search-do 'identity email 1)
		       (eweouz-search-do 'identity name 1))))
      (if record
	  (eweouz-do-update record name email)
	(eweouz-do-add from)))))

(defun eweouz-do-update (record name email)
  (interactive)
  (let ((uid (cadr (assoc '("uid") record))))
    (message (format "%s %s %s" uid name email))
    (call-process eweouz-write-path nil nil nil "--id" uid "--full-name" name
		  "--emails" email)))

(defun eweouz-do-add (record)
  (interactive)
  (let* ((email (car record))
	 (name (cdr record)))
    (message (format "%s" record))
    (call-process eweouz-write-path nil nil nil "--id" "new" "--full-name" name
		  "--emails" email)))

(defun eweouz-insinuate-gnus ()
  "Call this function to hook EWEOUZ into Gnus."
  (define-key gnus-summary-mode-map ":" 'eweouz-add-sender-gnus))

(defun eweouz-insinuate-sendmail ()
  "Call this function to hook EWEOUZ into sendmail (M-x mail)."
  (define-key mail-mode-map [C-tab] 'eweouz-complete))

(defun eweouz-insinuate-message ()
  "Call this function to hook EWEOUZ into message-mode."
  (define-key message-mode-map [C-tab] 'eweouz-complete))

(defun eweouz-insinuate-wl ()
  (define-key wl-draft-mode-map [C-tab] 'eweouz-complete)
  (define-key wl-summary-mode-map ":" 'eweouz-add-sender-wl))

(defun eweouz-add-sender-wl ()
  "Add sender of current message"
  (interactive)
  (wl-summary-set-message-buffer-or-redisplay)
  (set-buffer (wl-message-get-original-buffer))
  (let* ((from (std11-extract-address-components (std11-field-body "From")))
	 (name (cadr from))
	 (email (car from))
	 (record (cons name email)))
    (eweouz-do-add record)))

(require 'vcard)
(provide 'eweouz)

