1 ;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 ;; Author: John Wiegley <johnw@newartisans.com>
9 ;; This file is part of GNU Emacs.
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 3, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
27 ;; This library provides an interface to use the Mac's AddressBook,
28 ;; by way of the "contacts" command-line utility which can be found
29 ;; by searching on the Net.
36 ;;{{{ Internal cooking
38 (defvar eudc-mab-conversion-alist nil
)
39 (defvar eudc-buffer-time nil
)
40 (defvar eudc-contacts-file
41 "~/Library/Application Support/AddressBook/AddressBook.data")
43 (eudc-protocol-set 'eudc-query-function
'eudc-mab-query-internal
'mab
)
44 (eudc-protocol-set 'eudc-list-attributes-function nil
'mab
)
45 (eudc-protocol-set 'eudc-mab-conversion-alist nil
'mab
)
46 (eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil
'mab
)
48 (defun eudc-mab-query-internal (query &optional return-attrs
)
49 "Query MAB with QUERY.
50 QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
52 RETURN-ATTRS is a list of attributes to return, defaulting to
53 `eudc-default-return-attributes'."
55 (let ((fmt-string "%ln:%fn:%p:%e")
56 (mab-buffer (get-buffer-create " *mab contacts*"))
57 (modified (nth 5 (file-attributes eudc-contacts-file
)))
59 (with-current-buffer mab-buffer
60 (make-local-variable 'eudc-buffer-time
)
61 (goto-char (point-min))
62 (when (or (eobp) (time-less-p eudc-buffer-time modified
))
64 (call-process (executable-find "contacts") nil t nil
65 "-H" "-l" "-f" fmt-string
)
66 (setq eudc-buffer-time modified
))
67 (goto-char (point-min))
69 (let* ((args (split-string (buffer-substring (point)
72 (lastname (nth 0 args
))
73 (firstname (nth 1 args
))
78 (if (string-match "\\s-+\\'" mail
)
79 (setq mail
(replace-match "" nil nil mail
)))
83 ((eq (car term
) 'name
)
84 (unless (string-match (cdr term
)
85 (concat firstname
" " lastname
))
87 ((eq (car term
) 'email
)
88 (unless (string= (cdr term
) mail
)
90 ((eq (car term
) 'phone
))))
94 (cons `((firstname .
,firstname
)
95 (lastname .
,lastname
)
96 (name .
,(concat firstname
" " lastname
))
98 (email .
,mail
)) result
))))
100 (if (null return-attrs
)
103 (dolist (entry result
)
104 (let (entry-attrs abort
)
106 (when (memq (car attr
) return-attrs
)
107 (if (= (length (cdr attr
)) 0)
110 (cons attr entry-attrs
)))))
111 (if (and entry-attrs
(not abort
))
113 (cons entry-attrs eudc-result
)))))
118 ;;{{{ High-level interfaces (interactive functions)
120 (defun eudc-mab-set-server (dummy)
121 "Set the EUDC server to MAB."
123 (eudc-set-server dummy
'mab
)
124 (message "MAB server selected"))
129 (eudc-register-protocol 'mab
)
133 ;; arch-tag: 4bef8e65-f109-47c7-91b9-8a6ea3ed7bb1
134 ;;; eudcb-mab.el ends here