1;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend 2 3;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: John Wiegley <johnw@newartisans.com> 6;; Maintainer: FSF 7;; Keywords: comm 8 9;; This file is part of GNU Emacs. 10 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 2, or (at 14;; your option) any later version. 15 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. 20 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. 25 26;;; Commentary: 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. 30 31;;; Code: 32 33(require 'eudc) 34(require 'executable) 35 36;;{{{ Internal cooking 37 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") 42 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) 47 48(defun eudc-mab-query-internal (query &optional return-attrs) 49 "Query MAB with QUERY. 50QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid 51MAB attribute names. 52RETURN-ATTRS is a list of attributes to return, defaulting to 53`eudc-default-return-attributes'." 54 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))) 58 result) 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)) 63 (erase-buffer) 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)) 68 (while (not (eobp)) 69 (let* ((args (split-string (buffer-substring (point) 70 (line-end-position)) 71 "\\s-*:\\s-*")) 72 (lastname (nth 0 args)) 73 (firstname (nth 1 args)) 74 (phone (nth 2 args)) 75 (mail (nth 3 args)) 76 (matched t)) 77 78 (if (string-match "\\s-+\\'" mail) 79 (setq mail (replace-match "" nil nil mail))) 80 81 (dolist (term query) 82 (cond 83 ((eq (car term) 'name) 84 (unless (string-match (cdr term) 85 (concat firstname " " lastname)) 86 (setq matched nil))) 87 ((eq (car term) 'email) 88 (unless (string= (cdr term) mail) 89 (setq matched nil))) 90 ((eq (car term) 'phone)))) 91 92 (when matched 93 (setq result 94 (cons `((firstname . ,firstname) 95 (lastname . ,lastname) 96 (name . ,(concat firstname " " lastname)) 97 (phone . ,phone) 98 (email . ,mail)) result)))) 99 (forward-line))) 100 (if (null return-attrs) 101 result 102 (let (eudc-result) 103 (dolist (entry result) 104 (let (entry-attrs abort) 105 (dolist (attr entry) 106 (when (memq (car attr) return-attrs) 107 (if (= (length (cdr attr)) 0) 108 (setq abort t) 109 (setq entry-attrs 110 (cons attr entry-attrs))))) 111 (if (and entry-attrs (not abort)) 112 (setq eudc-result 113 (cons entry-attrs eudc-result))))) 114 eudc-result)))) 115 116;;}}} 117 118;;{{{ High-level interfaces (interactive functions) 119 120(defun eudc-mab-set-server (dummy) 121 "Set the EUDC server to MAB." 122 (interactive) 123 (eudc-set-server dummy 'mab) 124 (message "MAB server selected")) 125 126;;}}} 127 128 129(eudc-register-protocol 'mab) 130 131(provide 'eudcb-mab) 132 133;; arch-tag: 4bef8e65-f109-47c7-91b9-8a6ea3ed7bb1 134;;; eudcb-mab.el ends here 135