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

Compare commits

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

10 commits
9db2e7d28c ... 8632b1f94c

Author SHA1 Message Date
Tom Willemse
8632b1f94c Check to see if a contact is being stored 
Before storing a link to a contact, actually check that the element at point is
a contact.

This calls the same matcher that is used by ‘org-contacts-db’ to see if the
current element is indeed a contact.
 2024-02-16 16:35:13 -08:00
stardiviner
7f03eafaad extract properties Org entry headline at `position' as data API for better contacts searching. 2023-07-21 09:51:15 +08:00
Joseph Turner
c386c16802 (org-contacts) Don't try to store link above first heading 
Hi,

Here's a small patch for org-contacts.el.

Be well,

Joseph

From 80365905c9fd342e25ac529dcf0849e4cf90af8c Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Sun, 16 Jul 2023 16:13:14 -0700
Subject: [PATCH] Fix: Don't try to store link above first heading

Previously, org-contacts-link-store attempted to store a link when
point was above the first heading, but signalled an error after

(org-get-heading t t t t)

returned nil. Now, org-contacts-link-store does not attempt to handle
storing links above the first heading.
 2023-07-21 08:47:36 +08:00
stardiviner
2b3a3866aa [test] add ert testing for property "EMAIL" value format regexp matching 2023-07-10 19:48:11 +08:00
stardiviner
7231f8b2b8 Clean nil and empty string "" from result 2023-07-10 19:47:58 +08:00
stardiviner
3f62975e74 Handle property "EMAIL" value in some cases: 
- `mailto:` link
- multiple emails, multiple `mailto:` links

e.g. "[[mailto:yantar92@posteo.net]]", "[[mailto:yantar92@posteo.net][yantar92@posteo.net]]"
 2023-07-10 19:39:06 +08:00
stardiviner
ae45b9413e Add autoload cookie for `org-contacts-setup-completion-at-point' 2023-02-27 22:17:30 +08:00
stardiviner
bb4032eb12 Add `if' condition on (org-find-exact-headline-in-buffer query) return nil. 2022-12-21 12:31:08 +08:00
stardiviner
b7d176dcfb Refactor duplicated open org-contacts file and create buffer 2022-12-21 12:27:53 +08:00
stardiviner
bd5093e46b org-contacts is now on MELPA and NonGNU. 2022-10-10 10:50:37 +08:00
3 changed files with 123 additions and 38 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 will be submitted to NonGNU or MELPA. Wait me have time to do this work.
Package has been submitted to NonGNU or MELPA. You can install it through those package sources.
* Usage

72
org-contacts.el
View file

@ -900,6 +900,7 @@ 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."
@ -1272,7 +1273,13 @@ 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))))
(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)
(org-id-store-link)
(let ((headline-str (substring-no-properties (org-get-heading t t t t))))
@ -1294,38 +1301,53 @@ 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)))
`(:name ,name :file ,file :position ,position))))))
(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))))))
(org-contacts-files))))
;;;###autoload
(defun org-contacts-link-open (path)
(defun org-contacts-link-open (query)
"Open contacts: link type with jumping or searching."
(let ((query path))
(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))))
(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
(goto-char (marker-position (org-find-exact-headline-in-buffer query))))
(display-buffer buf '(display-buffer-below-selected)))
(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))
;; ;; FIXME:
;; (contact-entry (map-filter
;; FIXME:
;; (let* ((contact-entry (map-filter
;; (lambda (contact-plist)
;; (if (string-equal (plist-get contact-plist :name) query)
;; contact-plist))
@ -1363,6 +1385,7 @@ 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))))
@ -1372,11 +1395,20 @@ 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))
(org-entry-get (point) "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)))
(defun org-contacts-mailto-link-completion (&optional _arg)
"Org mode link `mailto:' completion with org-contacts emails."

53
test-org-contacts.el Normal file
View file

@ -0,0 +1,53 @@
(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))