procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Additional query and results attributes in eudcb-macos-contacts.el

Browse source 
* lisp/net/eudcb-macos-contacts.el: wider set of attributes for
queries, and in query results
* lisp/net/eudc-vars.el (eudc-inline-expansion-format): update
docstring to explain how to use the function eudc-translate-query to
translate to generic attribute names in the user supplied formatting
function
* etc/NEWS: announce wider query/result attribute set
* doc/misc/eudc.texi: more details on eudcb-mab.el's limitations
This commit is contained in:
Alexander Adolf 2022-07-13 23:52:46 +02:00 • committed by Thomas Fitzsimmons
parent e4ce9e514f
commit e555446907
4 changed files with 175 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
doc/misc/eudc.texi
View file

@ -423,11 +423,12 @@ all macOS versions since 10.0 (which was released 2001).
configurations.
@file{eudcb-mab.el} reverse engineers the format of the database file
used by the macOS Contacts app, and accesses its contents directly.
While this may promise some performance advantages, it comes at the
cost of using an undocumented interface. Hence, users of
@file{eudcb-mab.el} are recommended to double check the compatibility
of @file{eudcb-mab.el} before upgrading to a new version of macOS.
using the external command-line utility named contacts, which needs to
be installed separately. While this may promise some performance
advantages, it comes at the cost of using an undocumented interface.
Hence, users of @file{eudcb-mab.el} are recommended to double check
the compatibility of @file{eudcb-mab.el} and the required, external
command-line utility before upgrading to a new version of macOS.
@file{eudcb-mab.el} is retained for backwards compatibility with
existing configurations, and may be removed in a future release.

6
etc/NEWS
View file

@ -1507,6 +1507,12 @@ EUDC can now contribute email addresses to 'completion-at-point' by
adding the new function 'eudc-capf-complete' to
'completion-at-point-functions' in 'message-mode'.
+++
*** Additional query and results attributes in eudcb-macos-contacts.el
The EUDC back-end for the macOS Contacts app now provides a wider set
of attributes to use for queries, and delivers more attributes in
query results.
** EWW/SHR
+++

15
lisp/net/eudc-vars.el
View file

@ -214,13 +214,14 @@ used to format the PHRASE, and COMMENT parts, respectively. It
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)"

201
lisp/net/eudcb-macos-contacts.el
View file

@ -25,8 +25,17 @@
;; 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:
@ -35,44 +44,139 @@
;;{{{ 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.
@ -81,24 +185,29 @@ 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)
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)))
;;}}}