aliens/org-contacts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Compare commits

base: aliens:8632b1f94c354b7648f4a10a6dfd630f0166cec2
Branches Tags
aliens:check-at-contact
aliens:main
..
compare: aliens:9db2e7d28c07a4dbb2fa34ffea38083aaf16a514
Branches Tags
aliens:check-at-contact
aliens:main

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

3 changed files with 38 additions and 123 deletions
Show stats Expand all files Collapse all files

2
README.org
View file

@ -20,7 +20,7 @@ addresses, export contacts to a vCard file, put birthdays in your Org Agenda, an
* Installation * 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 * Usage

72
org-contacts.el
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-check-mail-address)
(add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-store-last-mail)) (add-hook 'gnus-article-prepare-hook #'org-contacts-gnus-store-last-mail))
;;;###autoload
(defun org-contacts-setup-completion-at-point () (defun org-contacts-setup-completion-at-point ()
"Add `org-contacts-message-complete-function' as a new function "Add `org-contacts-message-complete-function' as a new function
to complete the thing at point." 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." "Store the contact in `org-contacts-files' with a link."
(when (and (eq major-mode 'org-mode) (when (and (eq major-mode 'org-mode)
(member (buffer-file-name) (member (buffer-file-name)
(mapcar #'expand-file-name (org-contacts-files))) (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))))
(if (bound-and-true-p org-id-link-to-org-use-id) (if (bound-and-true-p org-id-link-to-org-use-id)
(org-id-store-link) (org-id-store-link)
(let ((headline-str (substring-no-properties (org-get-heading t t t t)))) (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)) (with-current-buffer (get-buffer (file-name-nondirectory file))
(org-map-entries (org-map-entries
(lambda () (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)) (file (buffer-file-name))
(position (point)) (position (point)))
;; extract properties Org entry headline at `position' as data API for better contacts searching. `(:name ,name :file ,file :position ,position))))))
(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))))))
(org-contacts-files)))) (org-contacts-files))))
;;;###autoload ;;;###autoload
(defun org-contacts-link-open (query) (defun org-contacts-link-open (path)
"Open contacts: link type with jumping or searching." "Open contacts: link type with jumping or searching."
(let* ((f (car (org-contacts-files))) (let ((query path))
(fname (file-name-nondirectory f))
(buf (progn
(unless (buffer-live-p (get-buffer fname)) (find-file f))
(get-buffer fname))))
(cond (cond
;; /query/ format searching ;; /query/ format searching
((string-match "/.*/" query) ((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 (with-current-buffer buf
(string-match "/\\(.*\\)/" query) (string-match "/\\(.*\\)/" query)
(occur (match-string 1 query)))) (occur (match-string 1 query)))))
;; jump to exact contact headline directly ;; jump to exact contact headline directly
(t (t
(let* ((f (car (org-contacts-files)))
(_ (find-file f))
(buf (get-buffer (file-name-nondirectory f))))
(with-current-buffer buf (with-current-buffer buf
(if-let ((position (org-find-exact-headline-in-buffer query))) (goto-char (marker-position (org-find-exact-headline-in-buffer query))))
(goto-char (marker-position position)) (display-buffer buf '(display-buffer-below-selected)))
(user-error "[org-contacts] Can't find <%s> in your `org-contacts-files'." query)))
(display-buffer buf '(display-buffer-below-selected))
;; FIXME: ;; (let* ((f (car (org-contacts-files)))
;; (let* ((contact-entry (map-filter ;; (_ (find-file f))
;; ;; FIXME:
;; (contact-entry (map-filter
;; (lambda (contact-plist) ;; (lambda (contact-plist)
;; (if (string-equal (plist-get contact-plist :name) query) ;; (if (string-equal (plist-get contact-plist :name) query)
;; contact-plist)) ;; contact-plist))
@ -1385,7 +1363,6 @@ Each element has the form (NAME . (FILE . POSITION))."
(defun org-contacts-mailto-link--get-all-emails () (defun org-contacts-mailto-link--get-all-emails ()
"Retrieve all org-contacts EMAIL property values." "Retrieve all org-contacts EMAIL property values."
(setq org-contacts-emails-list
(mapcar (mapcar
(lambda (contact) (lambda (contact)
(let* ((org-contacts-buffer (find-file-noselect (car (org-contacts-files)))) (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 (with-current-buffer org-contacts-buffer
(goto-char position) (goto-char position)
;; (symbol-name (org-property-or-variable-value 'EMAIL)) ;; (symbol-name (org-property-or-variable-value 'EMAIL))
(when-let ((pvalue (org-entry-get (point) "EMAIL"))) (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))))))
(ignore name) (ignore name)
;; (cons name email) ;; (cons name email)
email)) email))
(org-contacts--all-contacts))) (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) (defun org-contacts-mailto-link-completion (&optional _arg)
"Org mode link `mailto:' completion with org-contacts emails." "Org mode link `mailto:' completion with org-contacts emails."

53
test-org-contacts.el
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))