1 ;;; -*- Mode:Emacs-Lisp -*-
3 ;;; This file is the core of the eweouz, an interface to the
4 ;;; evolution-data-server, somewhat similar to BBDB.
6 ;;; copyright (c) 2008 Tollef Fog Heen <tfheen@err.no>
8 ;;; eweouz is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License version 2 as
10 ;;; published by the Free Software Foundation.
12 ;;; eweouz is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;;; General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with this program; if not, write to the Free Software
19 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25 (defconst eweouz-version "0.3")
26 (defconst eweouz-buffer-name "*EWEOUZ*")
28 (setq eweouz-helper-dirs '("/usr/lib/eweouz" "/usr/local/lib/eweouz"))
30 (defvar eweouz-dump-path (locate-file "eweouz-dump-addressbook"
35 (defvar eweouz-write-path (locate-file "eweouz-write-addressbook"
40 (defvar eweouz-buffer nil)
41 (defvar eweouz-pop-up-target-lines 5)
43 (defun eweouz-search-do (func string &optional max-matches)
44 "Search for the simple string STRING in all fields"
47 (call-process eweouz-dump-path nil (list (current-buffer) nil) t string)
48 (set-text-properties (point-min) (point-max) nil nil)
49 (goto-char (point-min))
50 (message (format "%s" (point)))
51 (while (and (looking-at "\n*BEGIN:VCARD") (or (eq max-matches nil)
53 (let ((m-start (point)))
55 (message (format "%s" (point)))
56 (search-forward-regexp "^END:VCARD")
57 (funcall func (vcard-parse-string (buffer-substring m-start (point)))))))))
60 (defun eweouz-complete (&optional start-pos)
66 (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
67 (goto-char (match-end 0))
69 (typed (or (and (eq this-command last-command)
70 (get this-command 'typed))
71 (downcase (buffer-substring beg end))))
72 (index (or (and (eq this-command last-command)
73 (get this-command 'index))
76 (eweouz-search-do '(lambda (x) (add-to-list 'match-recs x)) typed)
77 (cond ((= 0 (length match-recs))
78 (message "No matching records"))
79 ((= 1 (length match-recs))
80 ; Just one match; insert it
82 (delete-region beg end)
83 (insert (vcard-format-sample-get-name (car match-recs)))))
84 ((< 1 (length match-recs))
85 ;; For now, just display the records and leave the user to
87 (if (eq this-command last-command)
88 ;; Select next in list
90 (delete-region beg end)
91 (insert (vcard-format-sample-get-name (nth index match-recs)))
92 (put this-command 'index (% (+ 1 index)
93 (length match-recs))))
95 (put this-command 'typed typed)
96 (put this-command 'index 0)
97 (set-buffer (get-buffer-create eweouz-buffer-name))
98 (mapcar '(lambda (x) (insert (format "%s\n"
99 (vcard-format-sample-get-name x)))) match-recs)
100 (eweouz-pop-up-eweouz-buffer)))))))
103 ; Mostly stolen from bbdb-pop-up-bbdb-buffer
105 (defun eweouz-pop-up-eweouz-buffer (&optional horiz-predicate)
106 (let ((b (current-buffer)))
107 (if (get-buffer-window eweouz-buffer-name)
109 (let* ((first-window (selected-window))
110 (tallest-window first-window)
111 (window first-window))
112 ;; find the tallest window...
113 (while (not (eq (setq window (previous-window window)) first-window))
114 (if (> (window-height window) (window-height tallest-window))
115 (setq tallest-window window)))
116 ;; select it and split it...
117 (select-window tallest-window)
119 (- (window-height tallest-window)
121 (- (window-height tallest-window)
122 (max window-min-height
123 (1+ eweouz-pop-up-target-lines))))))
124 (split-window tallest-window
125 (if (> size 0) size window-min-height)))
127 '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode))
128 (goto-char (point-min))) ; make gnus happy...
129 ;; goto the bottom of the two...
130 (select-window (next-window))
131 ;; make it display *EWEOUZ*...
132 (let ((pop-up-windows nil))
133 (switch-to-buffer (get-buffer-create eweouz-buffer-name)))
134 ;; select the original window we were in...
135 (select-window first-window)))
136 ;; and make sure the current buffer is correct as well.
140 (defun eweouz-erase-buffer ()
142 (set-buffer (get-buffer-create eweouz-buffer-name))
146 (defun eweouz (string)
147 (interactive "MSearch for: ")
148 "Search all entries for the simple string STRING in all fields"
149 (eweouz-erase-buffer)
150 (eweouz-search-do 'eweouz-show string)
151 (eweouz-pop-up-eweouz-buffer))
153 (defun eweouz-show (record)
154 "Display an entry in the current buffer"
156 (set-buffer (get-buffer-create eweouz-buffer-name))
157 (insert (vcard-pretty-print record))))
159 (defun eweouz-add-sender-gnus ()
160 "Add sender of current message"
163 (set-buffer gnus-article-buffer)
164 (let* ((from (mail-header-parse-address (gnus-fetch-field "From")))
167 (record (or (eweouz-search-do 'identity email 1)
168 (eweouz-search-do 'identity name 1))))
170 (eweouz-do-update record name email)
171 (eweouz-do-add from)))))
173 (defun eweouz-do-update (record name email)
175 (let ((uid (cadr (assoc '("uid") record))))
176 (message (format "%s %s %s" uid name email))
177 (call-process eweouz-write-path nil nil nil "--id" uid "--full-name" name
180 (defun eweouz-do-add (record)
182 (let* ((email (car record))
184 (message (format "%s" record))
185 (call-process eweouz-write-path nil nil nil "--id" "new" "--full-name" name
188 (defun eweouz-insinuate-gnus ()
189 "Call this function to hook EWEOUZ into Gnus."
190 (define-key gnus-summary-mode-map ":" 'eweouz-add-sender-gnus))
192 (defun eweouz-insinuate-sendmail ()
193 "Call this function to hook EWEOUZ into sendmail (M-x mail)."
194 (define-key mail-mode-map [C-tab] 'eweouz-complete))
196 (defun eweouz-insinuate-message ()
197 "Call this function to hook EWEOUZ into message-mode."
198 (define-key message-mode-map [C-tab] 'eweouz-complete))
200 (defun eweouz-insinuate-wl ()
201 (define-key wl-draft-mode-map [C-tab] 'eweouz-complete)
202 (define-key wl-summary-mode-map ":" 'eweouz-add-sender-wl))
204 (defun eweouz-add-sender-wl ()
205 "Add sender of current message"
207 (wl-summary-set-message-buffer-or-redisplay)
208 (set-buffer (wl-message-get-original-buffer))
209 (let* ((from (std11-extract-address-components (std11-field-body "From")))
212 (record (cons name email)))
213 (eweouz-do-add record)))