Commit | Line | Data |
---|---|---|
bff4d65f JW |
1 | ;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend |
2 | ||
ceb4c4d3 | 3 | ;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. |
bff4d65f JW |
4 | |
5 | ;; Author: John Wiegley <johnw@newartisans.com> | |
6 | ;; Keywords: comm | |
7 | ||
ebce92c7 | 8 | ;; This file is part of GNU Emacs. |
bff4d65f JW |
9 | |
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. | |
14 | ||
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. | |
19 | ||
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 | |
ebce92c7 RF |
22 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 | ;; Boston, MA 02110-1301, USA. | |
bff4d65f JW |
24 | |
25 | ;;; Commentary: | |
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. | |
29 | ||
30 | ;;; Code: | |
31 | ||
32 | (require 'eudc) | |
33 | (require 'executable) | |
34 | ||
35 | ;;{{{ Internal cooking | |
36 | ||
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") | |
41 | ||
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) | |
46 | ||
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 | |
50 | MAB attribute names. | |
51 | RETURN-ATTRS is a list of attributes to return, defaulting to | |
52 | `eudc-default-return-attributes'." | |
53 | ||
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))) | |
57 | result) | |
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)) | |
62 | (erase-buffer) | |
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)) | |
67 | (while (not (eobp)) | |
68 | (let* ((args (split-string (buffer-substring (point) | |
69 | (line-end-position)) | |
70 | "\\s-*:\\s-*")) | |
71 | (lastname (nth 0 args)) | |
72 | (firstname (nth 1 args)) | |
73 | (phone (nth 2 args)) | |
74 | (mail (nth 3 args)) | |
75 | (matched t)) | |
76 | ||
77 | (if (string-match "\\s-+\\'" mail) | |
78 | (setq mail (replace-match "" nil nil mail))) | |
79 | ||
80 | (dolist (term query) | |
81 | (cond | |
82 | ((eq (car term) 'name) | |
83 | (unless (string-match (cdr term) | |
84 | (concat firstname " " lastname)) | |
85 | (setq matched nil))) | |
86 | ((eq (car term) 'email) | |
87 | (unless (string= (cdr term) mail) | |
88 | (setq matched nil))) | |
89 | ((eq (car term) 'phone)))) | |
90 | ||
91 | (when matched | |
92 | (setq result | |
93 | (cons `((firstname . ,firstname) | |
94 | (lastname . ,lastname) | |
95 | (name . ,(concat firstname " " lastname)) | |
96 | (phone . ,phone) | |
97 | (email . ,mail)) result)))) | |
98 | (forward-line))) | |
99 | (if (null return-attrs) | |
100 | result | |
101 | (let (eudc-result) | |
102 | (dolist (entry result) | |
103 | (let (entry-attrs abort) | |
104 | (dolist (attr entry) | |
105 | (when (memq (car attr) return-attrs) | |
106 | (if (= (length (cdr attr)) 0) | |
107 | (setq abort t) | |
108 | (setq entry-attrs | |
109 | (cons attr entry-attrs))))) | |
110 | (if (and entry-attrs (not abort)) | |
111 | (setq eudc-result | |
112 | (cons entry-attrs eudc-result))))) | |
113 | eudc-result)))) | |
114 | ||
115 | ;;}}} | |
116 | ||
117 | ;;{{{ High-level interfaces (interactive functions) | |
118 | ||
119 | (defun eudc-mab-set-server (dummy) | |
120 | "Set the EUDC server to MAB." | |
121 | (interactive) | |
122 | (eudc-set-server dummy 'mab) | |
123 | (message "MAB server selected")) | |
124 | ||
125 | ;;}}} | |
126 | ||
127 | ||
128 | (eudc-register-protocol 'mab) | |
129 | ||
130 | (provide 'eudcb-mab) | |
131 | ||
4515ae7c | 132 | ;; arch-tag: 4bef8e65-f109-47c7-91b9-8a6ea3ed7bb1 |
bff4d65f | 133 | ;;; eudcb-mab.el ends here |