Compare commits

..

No commits in common. "8632b1f94c354b7648f4a10a6dfd630f0166cec2" and "9db2e7d28c07a4dbb2fa34ffea38083aaf16a514" have entirely different histories.

3 changed files with 38 additions and 123 deletions

View file

@ -20,7 +20,7 @@ addresses, export contacts to a vCard file, put birthdays in your Org Agenda, an
* Installation
Package has been submitted to NonGNU or MELPA. You can install it through those package sources.
Package will be submitted to NonGNU or MELPA. Wait me have time to do this work.
* Usage

View file

@ -900,7 +900,6 @@ This adds `org-contacts-gnus-check-mail-address' and
(add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-check-mail-address)
(add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-store-last-mail))
;;;###autoload
(defun org-contacts-setup-completion-at-point ()
"Add `org-contacts-message-complete-function' as a new function
to complete the thing at point."
@ -1273,13 +1272,7 @@ are effectively trimmed). If nil, all zero-length substrings are retained."
"Store the contact in `org-contacts-files' with a link."
(when (and (eq major-mode 'org-mode)
(member (buffer-file-name)
(mapcar #'expand-file-name (org-contacts-files)))
(not (org-before-first-heading-p))
(let ((element (org-element-at-point)))
(funcall (cdr (org-make-tags-matcher org-contacts-matcher))
(org-element-property :todo-keyword element)
(org-get-tags element)
(org-element-property :level element))))
(mapcar #'expand-file-name (org-contacts-files))))
(if (bound-and-true-p org-id-link-to-org-use-id)
(org-id-store-link)
(let ((headline-str (substring-no-properties (org-get-heading t t t t))))
@ -1301,53 +1294,38 @@ Each element has the form (NAME . (FILE . POSITION))."
(with-current-buffer (get-buffer (file-name-nondirectory file))
(org-map-entries
(lambda ()
(let* ((name (substring-no-properties (org-get-heading t t t t)))
(let ((name (substring-no-properties (org-get-heading t t t t)))
(file (buffer-file-name))
(position (point))
;; extract properties Org entry headline at `position' as data API for better contacts searching.
(entry-properties (org-entry-properties position 'standard))
(property-name-chinese (cdr (assoc (upcase "NAME(Chinese)") entry-properties)))
(property-name-english (cdr (assoc (upcase "NAME(English)") entry-properties)))
(property-nick (cdr (assoc "NICK" entry-properties)))
(property-email (cdr (assoc "EMAIL" entry-properties)))
(property-mobile (cdr (assoc "MOBILE" entry-properties)))
(property-wechat (cdr (assoc (upcase "WeChat") entry-properties)))
(property-qq (cdr (assoc "QQ" entry-properties))))
(list :name name :file file :position position
:name-chinese property-name-chinese
:name-english property-name-english
:nick property-nick
:email property-email
:mobile property-email
:wechat property-wechat
:qq property-qq))))))
(position (point)))
`(:name ,name :file ,file :position ,position))))))
(org-contacts-files))))
;;;###autoload
(defun org-contacts-link-open (query)
(defun org-contacts-link-open (path)
"Open contacts: link type with jumping or searching."
(let* ((f (car (org-contacts-files)))
(fname (file-name-nondirectory f))
(buf (progn
(unless (buffer-live-p (get-buffer fname)) (find-file f))
(get-buffer fname))))
(let ((query path))
(cond
;; /query/ format searching
((string-match "/.*/" query)
(let* ((f (car (org-contacts-files)))
(buf (get-buffer (file-name-nondirectory f))))
(unless (buffer-live-p buf) (find-file f))
(with-current-buffer buf
(string-match "/\\(.*\\)/" query)
(occur (match-string 1 query))))
(occur (match-string 1 query)))))
;; jump to exact contact headline directly
(t
(let* ((f (car (org-contacts-files)))
(_ (find-file f))
(buf (get-buffer (file-name-nondirectory f))))
(with-current-buffer buf
(if-let ((position (org-find-exact-headline-in-buffer query)))
(goto-char (marker-position position))
(user-error "[org-contacts] Can't find <%s> in your `org-contacts-files'." query)))
(display-buffer buf '(display-buffer-below-selected))
(goto-char (marker-position (org-find-exact-headline-in-buffer query))))
(display-buffer buf '(display-buffer-below-selected)))
;; FIXME:
;; (let* ((contact-entry (map-filter
;; (let* ((f (car (org-contacts-files)))
;; (_ (find-file f))
;; ;; FIXME:
;; (contact-entry (map-filter
;; (lambda (contact-plist)
;; (if (string-equal (plist-get contact-plist :name) query)
;; contact-plist))
@ -1385,7 +1363,6 @@ Each element has the form (NAME . (FILE . POSITION))."
(defun org-contacts-mailto-link--get-all-emails ()
"Retrieve all org-contacts EMAIL property values."
(setq org-contacts-emails-list
(mapcar
(lambda (contact)
(let* ((org-contacts-buffer (find-file-noselect (car (org-contacts-files))))
@ -1395,20 +1372,11 @@ Each element has the form (NAME . (FILE . POSITION))."
(with-current-buffer org-contacts-buffer
(goto-char position)
;; (symbol-name (org-property-or-variable-value 'EMAIL))
(when-let ((pvalue (org-entry-get (point) "EMAIL")))
;; handle `mailto:' link. e.g. "[[mailto:yantar92@posteo.net]]", "[[mailto:yantar92@posteo.net][yantar92@posteo.net]]"
;; Reference the testing file `test-org-contacts.el'.
(if (string-match
"\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\(,\\ *\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\)"
pvalue)
(match-string 1 pvalue)
pvalue))))))
(org-entry-get (point) "EMAIL")))))
(ignore name)
;; (cons name email)
email))
(org-contacts--all-contacts)))
;; clean nil and empty string "" from result.
(delq "" (delq nil org-contacts-emails-list)))
(defun org-contacts-mailto-link-completion (&optional _arg)
"Org mode link `mailto:' completion with org-contacts emails."

View file

@ -1,53 +0,0 @@
(require 'ert)
(ert-deftest ert-test-org-contacts-property-email-value-extracting-regexp ()
"Testing org-contacts property `EMAIL' value extracting regexp rule."
(let ((regexp-rule
;; "\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]" ; valid
"\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\(,\\ *\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\)" ; valid
))
(let ((pvalue "huangtc@outlook.com")) ; normal email
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
(let ((pvalue "huangtc@outlook.com,")) ; has comma separator
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
(let ((pvalue "huangtc@outlook.com, tristan.j.huang@gmail.com,"))
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
(let ((pvalue "[[mailto:yantar92@posteo.net]]"))
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
(let ((pvalue "[[mailto:yantar92@posteo.net][yantar92@posteo.net]]"))
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
(let ((pvalue "[[mailto:yantar92@posteo.net][yantar92@posteo.net]], [[mailto:yantar92@gmail.com][yantar92@gmail.com]]"))
(if (string-match regexp-rule pvalue)
(should (string-equal (match-string 1 pvalue) "yantar92@posteo.net"))
pvalue))
))
;;; literal testing
;; (let ((regexp-rule "\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]")
;; (pvalue "[[mailto:yantar92@posteo.net][yantar92@posteo.net]]"))
;; (if (string-match regexp-rule pvalue)
;; (match-string 1 pvalue)
;; pvalue))
;; (let ((regexp-rule "\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\(,\\ *\\[\\[mailto:\\(.*\\)\\]\\(\\[.*\\]\\)\\]\\)")
;; (pvalue "[[mailto:yantar92@posteo.net][yantar92@posteo.net]], [[mailto:yantar92@gmail.com][yantar92@gmail.com]]"))
;; (if (string-match regexp-rule pvalue)
;; (match-string 1 pvalue)
;; pvalue))