Imported Upstream version 8.3.1

1 files changed, 129 insertions, 24 deletions

diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 0bc9cd7..edc09fe 100644
--- a/contrib/lisp/org-contacts.el
+++ b/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
@@ -183,6 +188,12 @@ This overrides `org-email-link-description-format' if set."
   :group 'org-contacts
   :type 'boolean)
 
+(defcustom org-contacts-complete-functions
+  '(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)
+
 ;; Decalre external functions and variables
 (declare-function org-reverse-string "org")
 (declare-function diary-ordinal-suffix "ext:diary-lib")
@@ -244,30 +255,56 @@ to dead or no buffer."
   (let* (todo-only
 	 (contacts-matcher
 	  (cdr (org-make-tags-matcher org-contacts-matcher)))
-	 markers result)
+	 result)
     (when (org-contacts-db-need-update-p)
       (let ((progress-reporter
 	     (make-progress-reporter "Updating Org Contacts Database..." 0 (length org-contacts-files)))
 	    (i 0))
 	(dolist (file (org-contacts-files))
-	  (org-check-agenda-file file)
-	  (with-current-buffer (org-get-agenda-file-buffer file)
-	    (unless (eq major-mode 'org-mode)
-	      (error "File %s is no in `org-mode'" file))
-	    (org-scan-tags
-	     '(add-to-list 'markers (set-marker (make-marker) (point)))
-	     contacts-matcher
-	     todo-only))
+	  (if (catch 'nextfile
+                ;; if file doesn't exist and the user agrees to removing it
+                ;; from org-agendas-list, 'nextfile is thrown.  Catch it here
+                ;; and skip processing the file.
+                ;;
+                ;; TODO: suppose that the user has set an org-contacts-files
+                ;; list that contains an element that doesn't exist in the
+                ;; file system: in that case, the org-agenda-files list could
+                ;; be updated (and saved to the customizations of the user) if
+                ;; it contained the same file even though the org-agenda-files
+                ;; list wasn't actually used.  I don't think it is normal that
+                ;; org-contacts updates org-agenda-files in this case, but
+                ;; short of duplicating org-check-agenda-files and
+                ;; org-remove-files, I don't know how to avoid it.
+                ;;
+                ;; A side effect of the TODO is that the faulty
+                ;; org-contacts-files list never gets updated and thus the
+                ;; user is always queried about the missing files when
+                ;; org-contacts-db-need-update-p returns true.
+                (org-check-agenda-file file))
+              (message "Skipped %s removed from org-agenda-files list."
+                       (abbreviate-file-name file))
+	    (with-current-buffer (org-get-agenda-file-buffer file)
+	      (unless (eq major-mode 'org-mode)
+		(error "File %s is not in `org-mode'" file))
+	      (setf result
+		    (append result
+			    (org-scan-tags
+			     'org-contacts-at-point
+			     contacts-matcher
+			     todo-only)))))
 	  (progress-reporter-update progress-reporter (setq i (1+ i))))
-	(dolist (marker markers result)
-	  (org-with-point-at marker
-	    (add-to-list 'result
-			 (list (org-get-heading t) marker (org-entry-properties marker 'all)))))
 	(setf org-contacts-db result
 	      org-contacts-last-update (current-time))
-      (progress-reporter-done progress-reporter)))
+	(progress-reporter-done progress-reporter)))
     org-contacts-db))
 
+(defun org-contacts-at-point (&optional pom)
+  "Return the contacts at point-or-marker POM or current position
+if nil."
+  (setq pom (or pom (point)))
+  (org-with-point-at pom
+    (list (org-get-heading t) (set-marker (make-marker) pom) (org-entry-properties pom 'all))))
+
 (defun org-contacts-filter (&optional name-match tags-match prop-match)
   "Search for a contact matching any of NAME-MATCH, TAGS-MATCH, PROP-MATCH.
 If all match values are nil, return all contacts.
@@ -500,11 +537,12 @@ A group FOO is composed of contacts with the tag FOO."
 				       ;; returned by `org-contacts-filter'.
 				       for contact-name = (car contact)
 				       ;; Grab the first email of the contact
-				       for email = (org-contacts-strip-link (car (org-contacts-split-property
-							 (or
-							  (cdr (assoc-string org-contacts-email-property
-									     (caddr contact)))
-							  ""))))
+				       for email = (org-contacts-strip-link
+						    (or (car (org-contacts-split-property
+							      (or
+							       (cdr (assoc-string org-contacts-email-property
+										  (caddr contact)))
+							       ""))) ""))
 				       ;; If the user has an email address, append USER <EMAIL>.
 				       if email collect (org-contacts-format-email contact-name email))
 				 ", ")))
@@ -512,6 +550,45 @@ 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 string)
+  "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 (or (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) ":")
+				      '())
+		    for marker = (second contact)
+		    if (with-current-buffer (marker-buffer marker)
+			 (save-excursion
+			   (goto-char marker)
+			   (let (todo-only)
+			     (eval (cdr (org-make-tags-matcher (subseq string 1)))))))
+		    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
@@ -570,8 +647,8 @@ A group FOO is composed of contacts with the tag FOO."
 			(goto-char (match-end 0))
 			(point))))
 	   (string (buffer-substring start end)))
-	(or (org-contacts-complete-group start end string)
-	    (org-contacts-complete-name start end string))))))
+	(run-hook-with-args-until-success
+	 'org-contacts-complete-functions start end string)))))
 
 (defun org-contacts-gnus-get-name-email ()
   "Get name and email address from Gnus message."
@@ -826,7 +903,7 @@ address."
 		  (setq email (org-contacts-strip-link email))
                   (org-contacts-check-mail-address email)
                   (compose-mail (org-contacts-format-email (org-get-heading t) email)))))
-          (error (format "This contact has no mail address set (no %s property)."
+          (error (format "This contact has no mail address set (no %s property)"
                          org-contacts-email-property)))))))
 
 (defun org-contacts-get-icon (&optional pom)
@@ -946,7 +1023,7 @@ to do our best."
 			(setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel)))
 			(setq result "")
 			(while phones-list
-			  (setq result (concat result  "TEL:" (org-contacts-strip-link (car phones-list)) "\n"))
+			  (setq result (concat result  "TEL:" (org-link-unescape (org-contacts-strip-link (car phones-list))) "\n"))
 			  (setq phones-list (cdr phones-list)))
 			result))
 	    (when bday
@@ -960,11 +1037,39 @@ to do our best."
 	    "END:VCARD\n\n")))
 
 (defun org-contacts-export-as-vcard (&optional name file to-buffer)
+  "Export org contacts to V-Card 3.0.
+
+By default, all contacts are exported to `org-contacts-vcard-file'.
+
+When NAME is \\[universal-argument], prompts for a contact name.
+
+When NAME is \\[universal-argument] \\[universal-argument],
+prompts for a contact name and a file name where to export.
+
+When NAME is \\[universal-argument] \\[universal-argument]
+\\[universal-argument], prompts for a contact name and a buffer where to export.
+
+If the function is not called interactively, all parameters are
+passed to `org-contacts-export-as-vcard-internal'."
+  (interactive "P")
+  (when (called-interactively-p 'any)
+    (cl-psetf name
+	     (when name
+	       (read-string "Contact name: "
+			    (first (org-contacts-at-point))))
+	     file
+	     (when (equal name '(16))
+	       (read-file-name "File: " nil org-contacts-vcard-file))
+	     to-buffer
+	     (when (equal name '(64))
+	       (read-buffer "Buffer: "))))
+  (org-contacts-export-as-vcard-internal name file to-buffer))
+
+(defun org-contacts-export-as-vcard-internal (&optional name file to-buffer)
   "Export all contacts matching NAME as VCard 3.0.
 If TO-BUFFER is nil, the content is written to FILE or
 `org-contacts-vcard-file'.  If TO-BUFFER is non-nil, the buffer
 is created and the VCard is written into that buffer."
-  (interactive) ; TODO ask for name?
   (let* ((filename (or file org-contacts-vcard-file))
 	 (buffer (if to-buffer
 		     (get-buffer-create to-buffer)