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