(eudc-mab-query-internal): Added backend support for OS/X's

AddressBook, by calling out to the open source program "contacts"
(installable through Fink).

2 files changed, 138 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 771eabab74e..ccea8fc6f89 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
 2005-11-01  John Wiegley  <johnw@newartisans.com>
 
+        * iswitchb.el (iswitchb-define-mode-map): Re-enabled the
+        toggle-ignore keybinding (C-a).  The author said it had been
+        disabled much earlier due to a possible incompatibility, but after
+        many months of usage I have encountered no problems (and it is a
+        rather useful option, especially for switching to " *temp*").
+
         * net/eudcb-mab.el (eudc-mab-query-internal): Added backend
         support for OS/X's AddressBook, by calling out to the open source
         program "contacts" (installable through Fink).
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
new file mode 100644
index 00000000000..cd6f32dba0c
--- /dev/null
+++ b/lisp/net/eudcb-mab.el
@@ -0,0 +1,132 @@
+;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
+
+;; Copyright (C) 2003 John Wiegley.
+
+;; Author: John Wiegley <johnw@newartisans.com>
+;; Keywords: comm
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;    This library provides an interface to use the Mac's AddressBook,
+;;    by way of the "contacts" command-line utility which can be found
+;;    by searching on the Net.
+
+;;; Code:
+
+(require 'eudc)
+(require 'executable)
+
+;;{{{      Internal cooking
+
+(defvar eudc-mab-conversion-alist nil)
+(defvar eudc-buffer-time nil)
+(defvar eudc-contacts-file
+  "~/Library/Application Support/AddressBook/AddressBook.data")
+
+(eudc-protocol-set 'eudc-query-function 'eudc-mab-query-internal 'mab)
+(eudc-protocol-set 'eudc-list-attributes-function nil 'mab)
+(eudc-protocol-set 'eudc-mab-conversion-alist nil 'mab)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes nil 'mab)
+
+(defun eudc-mab-query-internal (query &optional return-attrs)
+  "Query MAB  with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
+MAB attribute names.
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+
+  (let ((fmt-string "%ln:%fn:%p:%e")
+        (mab-buffer (get-buffer-create " *mab contacts*"))
+        (modified (nth 5 (file-attributes eudc-contacts-file)))
+        result)
+    (with-current-buffer mab-buffer
+      (make-local-variable 'eudc-buffer-time)
+      (goto-char (point-min))
+      (when (or (eobp) (time-less-p eudc-buffer-time modified))
+        (erase-buffer)
+        (call-process (executable-find "contacts") nil t nil
+                      "-H" "-l" "-f" fmt-string)
+        (setq eudc-buffer-time modified))
+      (goto-char (point-min))
+      (while (not (eobp))
+        (let* ((args (split-string (buffer-substring (point)
+                                                     (line-end-position))
+                                   "\\s-*:\\s-*"))
+               (lastname (nth 0 args))
+               (firstname (nth 1 args))
+               (phone (nth 2 args))
+               (mail (nth 3 args))
+               (matched t))
+
+          (if (string-match "\\s-+\\'" mail)
+              (setq mail (replace-match "" nil nil mail)))
+
+          (dolist (term query)
+            (cond
+             ((eq (car term) 'name)
+              (unless (string-match (cdr term)
+                                    (concat firstname " " lastname))
+                (setq matched nil)))
+             ((eq (car term) 'email)
+              (unless (string= (cdr term) mail)
+                (setq matched nil)))
+             ((eq (car term) 'phone))))
+
+          (when matched
+            (setq result
+                  (cons `((firstname . ,firstname)
+                          (lastname . ,lastname)
+                          (name . ,(concat firstname " " lastname))
+                          (phone . ,phone)
+                          (email . ,mail)) result))))
+        (forward-line)))
+    (if (null return-attrs)
+        result
+      (let (eudc-result)
+        (dolist (entry result)
+          (let (entry-attrs abort)
+            (dolist (attr entry)
+              (when (memq (car attr) return-attrs)
+                (if (= (length (cdr attr)) 0)
+                    (setq abort t)
+                  (setq entry-attrs
+                        (cons attr entry-attrs)))))
+            (if (and entry-attrs (not abort))
+                (setq eudc-result
+                      (cons entry-attrs eudc-result)))))
+        eudc-result))))
+
+;;}}}
+
+;;{{{      High-level interfaces (interactive functions)
+
+(defun eudc-mab-set-server (dummy)
+  "Set the EUDC server to MAB."
+  (interactive)
+  (eudc-set-server dummy 'mab)
+  (message "MAB server selected"))
+
+;;}}}
+
+
+(eudc-register-protocol 'mab)
+
+(provide 'eudcb-mab)
+
+;;; eudcb-mab.el ends here