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
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

106
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-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)))
(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))))))
(let ((name (substring-no-properties (org-get-heading t t t t)))
(file (buffer-file-name))
(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)
(with-current-buffer buf
(string-match "/\\(.*\\)/" query)
(occur (match-string 1 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)))))
;; jump to exact contact headline directly
(t
(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))
(let* ((f (car (org-contacts-files)))
(_ (find-file f))
(buf (get-buffer (file-name-nondirectory f))))
(with-current-buffer buf
(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,30 +1363,20 @@ 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))))
(name (plist-get contact :name))
(position (plist-get contact :position))
(email (save-excursion
(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))))))
(ignore name)
;; (cons name email)
email))
(org-contacts--all-contacts)))
;; clean nil and empty string "" from result.
(delq "" (delq nil org-contacts-emails-list)))
(mapcar
(lambda (contact)
(let* ((org-contacts-buffer (find-file-noselect (car (org-contacts-files))))
(name (plist-get contact :name))
(position (plist-get contact :position))
(email (save-excursion
(with-current-buffer org-contacts-buffer
(goto-char position)
;; (symbol-name (org-property-or-variable-value 'EMAIL))
(org-entry-get (point) "EMAIL")))))
(ignore name)
;; (cons name email)
email))
(org-contacts--all-contacts)))
(defun org-contacts-mailto-link-completion (&optional _arg)
"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))