receives a single argument, which is an alist of
protocol-specific attributes describing the recipient. To access
the alist elements using generic EUDC attribute names, such as
-for example name, or email, use `eudc-translate-attribute-list'.
-The function should return a list, which should contain two
-elements. If the first element is a string, it will be used as
-the PHRASE part, quoting it if necessary. If the second element
-is a string, it will be used as the COMMENT part, unless it
-contains characters not allowed in the COMMENT part by RFC 5322,
-in which case the COMMENT part will be omitted."
+for example name, or email, use `eudc-translate-query' with
+REVERSE set to t to transform the received attribute alist. The
+function should return a list, which should contain two elements.
+If the first element is a string, it will be used as the PHRASE
+part, quoting it if necessary. If the second element is a string,
+it will be used as the COMMENT part, unless it contains
+characters not allowed in the COMMENT part by RFC 5322, in which
+case the COMMENT part will be omitted."
:type '(choice (const :tag "RFC 5322 formatted \"first last <address>\"" nil)
(function :tag "RFC 5322 phrase/comment formatting function")
(list :tag "Format string (deprecated)"
;; Contacts app on localhost, so no 3rd party tools are needed.
;;; Usage:
-;; (require 'eudcb-macos-contacts)
-;; (eudc-macos-contacts-set-server "localhost")
+;; To load the library, first `require' it:
+;;
+;; (require 'eudcb-macos-contacts)
+;;
+;; In the simplest case then just use:
+;;
+;; (eudc-macos-contacts-set-server "localhost")
+;;
+;; When using `eudc-server-hotlist', instead use:
+;;
+;; (add-to-list 'eudc-server-hotlist '("localhost" . macos-contacts))
;;; Code:
;;{{{ Internal cooking
-(defvar eudc-macos-contacts-conversion-alist nil)
+(defvar eudc-macos-contacts-attributes-translation-alist
+ '((name . last_name)
+ (firstname . first_name)
+ (email . email)
+ (phone . phone)
+ (title . job_title)
+ (o . organization)
+ (ou . department))
+ "See `eudc-protocol-attributes-translation-alist'.")
+
+(defconst eudc-macos-contacts--unsearchable-attributes
+ '(email phone)
+ "See `eudc-macos-contacts-search-helper'.")
;; hook ourselves into the EUDC framework
(eudc-protocol-set 'eudc-query-function
- 'eudc-macos-contacts-query-internal
- 'macos-contacts)
+ '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)
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ 'eudc-macos-contacts-attributes-translation-alist
+ 'macos-contacts)
(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
- nil
- 'macos-contacts)
+ nil
+ 'macos-contacts)
-(defun eudc-macos-contacts-search-helper (str)
+(defun eudc-macos-contacts-search-helper (query)
"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?"))))
+Searches for all persons matching QUERY. QUERY is a list of cons
+cells (ATTR . VALUE) where ATTRs should be valid macOS Contacts
+attribute names with space characters replaced by `_' characters.
+Thus, to for instance search for the \"first name\" attribute in
+the Contacts app, the corresponding ATTR would be the symbol
+`first_name'.
+
+Note that due to the way the Contacts app exposes its data via
+AppleScript, the attributes listed in
+`eudc-macos-contacts--unsearchable-attributes' can not be searched
+efficiently. If and when one of these attributes appears in
+QUERY, it is thus skipped, and the query is composed from the
+other attributes in the QUERY."
+ (let ((crit-idx 0)
+ (query-str (string)))
+ ;; assemble a query string for use in an AppleScript "whose"
+ ;; filter clause; generally, this has the form
+ ;; (ATTR1 contains "VALUE1") and (ATTR2 contains "VALUE2") and ...
+ (dolist (criterion query)
+ (let ((attr (string-replace "_" " " (symbol-name (car criterion))))
+ (term (cdr criterion)))
+ ;; defend against unusable attribute names as they cause
+ ;; AppleScript to emit an error message, which in turn will
+ ;; cause elisp errors during results parsing in
+ ;; `eudc-macos-contacts-query-internal'
+ (if (or (not (rassq (car criterion)
+ eudc-macos-contacts-attributes-translation-alist))
+ (memq (car criterion)
+ eudc-macos-contacts--unsearchable-attributes))
+ (message (concat "[eudc] Warning in macOS Contacts backend: "
+ "can not search in attribute "
+ (format "\"%s\"; skipping it." attr)))
+ (progn
+ (when (> crit-idx 0)
+ (setq query-str (concat query-str " and ")))
+ (setq query-str (concat query-str
+ (format "(%s contains \"%s\")" attr term)))
+ (setq crit-idx (1+ crit-idx))))))
+ ;; if a useful query string could be assembled, insert it into the
+ ;; AppleScript template, and run the resulting script; results are
+ ;; captured in the current buffer
+ (if (not (string= query-str ""))
+ (if (executable-find "osascript")
+ (call-process "osascript" nil t nil
+ "-e"
+ (format "
+on joinLines(theText)
+ if (theText is missing value) or (theText is \"\") then
+ return \"\"
+ else
+ set thePars to paragraphs of theText
+ set result to {}
+ repeat with para in thePars
+ set result to result & {para & space}
+ end repeat
+ return text 1 thru -2 of (result as text)
+ end if
+end joinLines
+
+on run
+ set results to {}
+ tell application \"Address Book\"
+ set pList to every person whose %s
+ repeat with pers in pList
+ set pText to ¬
+ first name of pers & \":\" & ¬
+ last name of pers & \":\"
+ if (job title of pers is not missing value) then ¬
+ set pText to pText ¬
+ & my joinLines(job title of pers)
+ set pText to pText & \":\"
+ if (department of pers is not missing value) then ¬
+ set pText to pText ¬
+ & my joinLines(department of pers)
+ set pText to pText & \":\"
+ if (organization of pers is not missing value) then ¬
+ set pText to pText ¬
+ & my joinLines(organization of pers)
+ set pText to pText & \":\"
+ if (count emails of pers) > 0 then
+ repeat with emailAddr in emails of pers
+ set pText to pText & value ¬
+ of emailAddr & \",\"
+ end repeat
+ set pText to text 1 thru -2 of pText
+ end if
+ set pText to pText & \":\"
+ if (count phones of pers) > 0 then
+ repeat with phoneNmbr in phones of pers
+ set pText to pText & value ¬
+ of phoneNmbr & \",\"
+ end repeat
+ set pText to text 1 thru -2 of pText
+ end if
+ set results to results & {pText & \"\n\"}
+ end repeat
+ get results as text
+ end tell
+end run
+" query-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.
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)
+ result)
(with-current-buffer macos-contacts-buffer
(erase-buffer)
- (dolist (term query)
- (eudc-macos-contacts-search-helper (cdr term)))
+ (eudc-macos-contacts-search-helper query)
(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))
+ (if (not (equal (line-beginning-position) (line-end-position)))
+ (let ((keys '(first_name last_name job_title department
+ organization email phone))
+ record)
+ (dolist (field (split-string (buffer-substring
+ (point) (line-end-position))
+ ":"))
+ (let ((key (pop keys)))
+ (unless (string= "" field)
+ (pcase key
+ ((or 'email 'phone) (dolist (x (split-string field ","))
+ (push (cons key x) record)))
+ (_ (push (cons key field) record))))))
+ (unless (length= record 0)
+ (push (nreverse record) result))))
+ (forward-line))
result)))
;;}}}
projects / emacs.git / commitdiff