Browse Source

contrib/lisp/org-contacts.el: Complete contacts using tags and properties

* contrib/lisp/org-contacts.el (org-contacts-complete-tags-props): New
function that allows the user to retrieve contacts based on tags and
properties.

(org-contacts-complete-functions): Add
org-contacts-complete-tags-props to the completion functions.

(org-contacts-tags-props-prefix): Prefix used to detect the
completion method wished.

Based on the idea and implementation of John Kitchin
Grégoire Jadi 10 years ago
parent
commit
a11ce0b456
1 changed files with 43 additions and 1 deletions
  1. 43 1
      contrib/lisp/org-contacts.el

+ 43 - 1
contrib/lisp/org-contacts.el

@@ -155,6 +155,11 @@ The following replacements are available:
   :type 'string
   :group 'org-contacts)
 
+(defcustom org-contacts-tags-props-prefix "#"
+  "Tags and properties prefix."
+  :type 'string
+  :group 'org-contacts)
+
 (defcustom org-contacts-matcher
   (mapconcat 'identity (list org-contacts-email-property
 			     org-contacts-alias-property
@@ -184,7 +189,7 @@ This overrides `org-email-link-description-format' if set."
   :type 'boolean)
 
 (defcustom org-contacts-complete-functions
-  '(org-contacts-complete-group org-contacts-complete-name)
+  '(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name)
   "List of functions used to complete contacts in `message-mode'."
   :group 'org-contacts
   :type 'hook)
@@ -523,6 +528,43 @@ A group FOO is composed of contacts with the tag FOO."
 		(completion-table-case-fold completion-list
 					    (not org-contacts-completion-ignore-case))))))))
 
+(defun org-contacts-complete-tags-props (start end matcher)
+  "Insert emails that match the tags expression.
+
+For example: FOO-BAR will match entries tagged with FOO but not
+with BAR.
+
+See (org) Matching tags and properties for a complete
+description."
+  (let* ((completion-ignore-case org-contacts-completion-ignore-case)
+	 (completion-p (org-string-match-p
+			      (concat "^" org-contacts-tags-props-prefix) string)))
+    (when completion-p
+      (let ((result
+	     (mapconcat
+	      'identity
+	      (loop for contact in (org-contacts-db)
+		    for contact-name = (car contact)
+		    for email = (org-contacts-strip-link (car (org-contacts-split-property
+							       (or
+								(cdr (assoc-string org-contacts-email-property
+										   (caddr contact)))
+								""))))
+		    for tags = (cdr (assoc "TAGS" (nth 2 contact)))
+		    for tags-list = (if tags
+					(split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":")
+				      '())
+		    if (let ((todo-only nil))
+			 (eval (cdr (org-make-tags-matcher matcher))))
+		    
+		    collect (org-contacts-format-email contact-name email))
+	      ",")))
+	(when (not (string= "" result))
+	  ;; return (start end function)
+	  (lexical-let* ((to-return result))
+	    (list start end
+		  (lambda (string pred &optional to-ignore) to-return))))))))
+
 (defun org-contacts-remove-ignored-property-values (ignore-list list)
   "Remove all ignore-list's elements from list and you can use
    regular expressions in the ignore list."