diff options
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/net/eudcb-mab.el | 132 |
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 |