]> git.eshelyaron.com Git - emacs.git/commitdiff
(eudc-mab-query-internal): Added backend support for OS/X's
authorJohn Wiegley <johnw@newartisans.com>
Tue, 1 Nov 2005 07:10:36 +0000 (07:10 +0000)
committerJohn Wiegley <johnw@newartisans.com>
Tue, 1 Nov 2005 07:10:36 +0000 (07:10 +0000)
AddressBook, by calling out to the open source program "contacts"
(installable through Fink).

lisp/ChangeLog
lisp/net/eudcb-mab.el [new file with mode: 0644]

index 771eabab74e153ef251764c33779b7b819e36363..ccea8fc6f893ed56fcd694a965066a85cd28fc57 100644 (file)
@@ -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 (file)
index 0000000..cd6f32d
--- /dev/null
@@ -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