123 lines
4 KiB
EmacsLisp
123 lines
4 KiB
EmacsLisp
;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
|
|
|
|
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
|
|
|
|
;; Author: Alexander Adolf
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs 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.
|
|
|
|
;; GNU Emacs 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. 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
|