summaryrefslogtreecommitdiff
path: root/lisp/net/eudcb-macos-contacts.el
diff options
context:
space:
mode:
authorAlexander Adolf <alexander.adolf@condition-alpha.com>2020-05-02 11:13:20 -0400
committerThomas Fitzsimmons <fitzsim@fitzsim.org>2020-07-09 15:32:14 -0400
commit814e3b0b17bce65afb1d487167c1ce7291ddcf4d (patch)
tree0d5a725adbfe668d68392f1fb783c9b20fff598c /lisp/net/eudcb-macos-contacts.el
parent2d7c3e49b0a237dd05fd35d765676ec1d4dd0730 (diff)
downloademacs-814e3b0b17bce65afb1d487167c1ce7291ddcf4d.tar.gz
EUDC: Add macOS Contacts backend
* lisp/net/eudcb-macos-contacts.el: New file. * doc/misc/eudc.texi (macOS Contacts): New section. (macOS Contacts Configuration): Likewise. * etc/NEWS: Mention new macOS Contacts backend.
Diffstat (limited to 'lisp/net/eudcb-macos-contacts.el')
-rw-r--r--lisp/net/eudcb-macos-contacts.el118
1 files changed, 118 insertions, 0 deletions
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
new file mode 100644
index 00000000000..f258d5cb9fb
--- /dev/null
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -0,0 +1,118 @@
+;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
+
+;; Copyright (C) 2020 condition-alpha.com
+
+;; 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 3 of the License, 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the macOS Contacts app as
+;; an EUDC data source. It uses AppleScript to interface with the
+;; Contacts app on localhost, so no 3rd party tools are needed.
+
+;;; Usage:
+;; (require 'eudcb-macos-contacts)
+;; (eudc-macos-contacts-set-server "localhost")
+
+;;; Code:
+
+(require 'eudc)
+(require 'executable)
+
+;;{{{ Internal cooking
+
+(defvar eudc-macos-contacts-conversion-alist nil)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-macos-contacts-query-internal
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-macos-contacts-conversion-alist
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'macos-contacts)
+
+(defun eudc-macos-contacts-search-helper (str)
+ "Helper function to query the Contacts app via AppleScript.
+Searches for all persons with a case-insensitive substring match
+of STR in any of their name fields (first, middle, or last)."
+ (if (executable-find "osascript")
+ (call-process "osascript" nil t nil
+ "-e"
+ (format "
+set results to {}
+tell application \"Address Book\"
+ set pList to every person whose (name contains \"%s\")
+ repeat with pers in pList
+ repeat with emailAddr in emails of pers
+ set results to results & {name of pers & \":\" & value ¬
+ of emailAddr & \"\n\"}
+ end repeat
+ end repeat
+ get results as text
+end tell" str))
+ (message (concat "[eudc] Error in macOS Contacts backend: "
+ "`osascript' executable not found. "
+ "Is this is a macOS 10.0 or later system?"))))
+
+(defun eudc-macos-contacts-query-internal (query &optional return-attrs)
+ "Query macOS Contacts with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
+macOS Contacts attribute names.
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (let ((macos-contacts-buffer (get-buffer-create " *macOS Contacts*"))
+ result)
+ (with-current-buffer macos-contacts-buffer
+ (erase-buffer)
+ (dolist (term query)
+ (eudc-macos-contacts-search-helper (cdr term)))
+ (delete-duplicate-lines (point-min) (point-max))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (equal (line-beginning-position) (line-end-position)))
+ (let* ((args (split-string (buffer-substring
+ (point) (line-end-position))
+ ":"))
+ (name (nth 0 args))
+ (email (nth 1 args)))
+ (setq result (cons `((name . ,name)
+ (email . ,email)) result))))
+ (forward-line))
+ result)))
+
+;;}}}
+
+;;{{{ High-level interfaces (interactive functions)
+
+(defun eudc-macos-contacts-set-server (dummy)
+ "Set the EUDC server to macOS Contacts app.
+The server in DUMMY is not actually used, since this backend
+always and implicitly connetcs to an instance of the Contacts app
+running on the local host."
+ (interactive)
+ (eudc-set-server dummy 'macos-contacts)
+ (message "[eudc] macOS Contacts app server selected"))
+
+;;}}}
+
+(eudc-register-protocol 'macos-contacts)
+
+(provide 'eudcb-macos-contacts)
+
+;;; eudcb-macos-contacts.el ends here