emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Michael Strey <mstrey@strey.biz>
To: emacs-orgmode@gnu.org
Subject: Re: phone links...
Date: Sun, 14 Apr 2013 22:49:29 +0200	[thread overview]
Message-ID: <20130414204929.GY659@strey.biz> (raw)
In-Reply-To: <20130409073140.GJ659@strey.biz>

[-- Attachment #1: Type: text/plain, Size: 857 bytes --]

On Tue, Apr 09, 2013 at 09:31:40AM +0200, Michael Strey wrote:

[...]

> The problem is on the side of org-contacts.  Org-contacts does not
> support links in its properties.
[...]

> This shortcoming effects not only the phone links but email links as
> well.

Attached is a patch to allow org links in org-contacts properties.
It allows entries like in the following example without effecting
org-contacts current functions.

#+BEGIN_SRC org
* Surname, Name
:PROPERTIES:
:EMAIL:    mailto:test2@test.de; [[mailto:name@test.de]] foo@bar.biz
:PHONE:    [[tel:+49 351 4129535]], +491766626196 [[+49 (351) 41295-35]]
:END:
#+END_SRC

Phone links of the form [[tel:+49 351 412 95-35][My phone number]] or
[[tel:+49 351 41295-35]] are expected.  `-', `/', `(', `)' and
whitespace characters are allowed in telephone numbers.


-- 
Michael Strey 
www.strey.biz


[-- Attachment #2: 0174-Org-contacts-Allow-org-links-in-properties.patch --]
[-- Type: text/plain, Size: 9954 bytes --]

From 69ae791cd552bacdcbc99af99a82ab699fa16d36 Mon Sep 17 00:00:00 2001
From: Michael Strey <mstrey@strey.biz>
Date: Fri, 12 Apr 2013 12:33:16 +0200
Subject: [PATCH 174/174] Org-contacts: Allow org links in properties

* org-contacts.el (org-contacts-split-property, chomp): Introduce a custom
  version of split-string that keeps org links intact. `chomp' is a
  helper function for `org-contacts-split-property'.
* org-contacts.el (org-contacts-strip-link): Introduce a new function
  that removes brackets, description, link type and colon from an org
  link string returning the pure link key.
* org-contacts.el (org-contacts-complete-group)
	(org-contacts-complete-name, org-contacts-view-send-email)
	(org-contacts-get-icon, org-contacts-vcard-format): Apply the
  new functions to the already existing functions extracting telephone numbers
  and email addresses from the properties.

Allowed separators for email addresses and phone numbers are `,', `;'
and whitespace.  `:' is not allowed anymore as separator to avoid
confusion with implizit links.

Examples of properties that are possible after those changes:

* Surname, Name
:PROPERTIES:
:EMAIL:    mailto:test2@test.de; [[mailto:name@test.de]] foo@bar.biz
:PHONE:    [[tel:+49 351 4129535]], +491766626196 [[+49 (351) 41295-35]]
:END:

Phone links of the form [[tel:+49 351 412 95-35][My phone number]] or
[[tel:+49 351 41295-35]] are expected.  `-', `/', `(', `)' and
whitespace characters are allowed in telephone numbers.
---
 contrib/lisp/org-contacts.el | 83 ++++++++++++++++++++++++++++++++++++--------
 5 files changed, 106 insertions(+), 28 deletions(-)

diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 65eeea8..a502674 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -218,7 +218,7 @@ This overrides `org-email-link-description-format' if set."
     org-contacts-db))
 
 (defun org-contacts-filter (&optional name-match tags-match)
-  "Search for a contact maching NAME-MATCH and TAGS-MATCH.
+  "Search for a contact matching NAME-MATCH and TAGS-MATCH.
 If both match values are nil, return all contacts."
   (if (and (null name-match)
 	   (null tags-match))
@@ -426,7 +426,7 @@ A group FOO is composed of contacts with the tag FOO."
 				    (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
 	(list start end
 	      (if (= (length completion-list) 1)
-		  ;; We've foudn the correct group, returns the address
+		  ;; We've found the correct group, returns the address
 		  (lexical-let ((tag (get-text-property 0 'org-contacts-group
 							(car completion-list))))
 		    (lambda (string pred &optional to-ignore)
@@ -438,11 +438,11 @@ 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 = (car (split-string
+				       for email = (org-contacts-strip-link (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))
 				 ", ")))
@@ -459,14 +459,14 @@ A group FOO is composed of contacts with the tag FOO."
 		;; returned by `org-contacts-filter'.
 		for contact-name = (car contact)
 		;; Build the list of the user email addresses.
-		for email-list = (split-string (or
+		for email-list = (org-contacts-split-property (or
 						(cdr (assoc-string org-contacts-email-property
 								   (caddr contact))) ""))
 		;; If the user has email addresses…
 		if email-list
 		;; … append a list of USER <EMAIL>.
 		nconc (loop for email in email-list
-			    collect (org-contacts-format-email contact-name email))))
+			    collect (org-contacts-format-email contact-name (org-contacts-strip-link email)))))
 	 (completion-list (org-contacts-all-completions-prefix
 			   string
 			   (org-uniquify completion-list))))
@@ -731,11 +731,12 @@ address."
     (org-with-point-at marker
       (let ((emails (org-entry-get (point) org-contacts-email-property)))
         (if emails
-            (let ((email-list (split-string emails)))
+            (let ((email-list (org-contacts-split-property emails)))
               (if (and (= (length email-list) 1) (not ask))
                   (compose-mail (org-contacts-format-email
                                  (org-get-heading t) emails))
                 (let ((email (completing-read "Send mail to which address: " email-list)))
+		  (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)."
@@ -759,8 +760,8 @@ address."
              (email-list (org-entry-get pom org-contacts-email-property))
              (gravatar
               (when email-list
-                (loop for email in (split-string email-list)
-                      for gravatar = (gravatar-retrieve-synchronously email)
+                (loop for email in (org-contacts-split-property email-list)
+                      for gravatar = (gravatar-retrieve-synchronously (org-contacts-strip-link email))
                       if (and gravatar
                               (not (eq gravatar 'error)))
                       return gravatar))))
@@ -842,19 +843,19 @@ to do our best."
 	 (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
     (concat head
 	    (when email (progn
-			  (setq emails-list (split-string email "[,;: ]+"))
+			  (setq emails-list (org-contacts-split-property email "[,; ]+"))
 			  (setq result "")
 			  (while emails-list
-			    (setq result (concat result  "EMAIL:" (car emails-list) "\n"))
+			    (setq result (concat result  "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n"))
 			    (setq emails-list (cdr emails-list)))
 			  result))
 	    (when addr
 	      (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
 	    (when tel (progn
-			(setq phones-list (split-string tel "[,;: ]+"))
+			(setq phones-list (org-contacts-split-property tel "[,; ]+"))
 			(setq result "")
 			(while phones-list
-			  (setq result (concat result  "TEL:" (car phones-list) "\n"))
+			  (setq result (concat result  "TEL:" (org-contacts-strip-link (car phones-list)) "\n"))
 			  (setq phones-list (cdr phones-list)))
 			result))
 	    (when bday
@@ -903,7 +904,61 @@ Requires google-maps-el."
     if addr
     collect (cons (list addr) (list :label (string-to-char (car contact)))))))
 
-(provide 'org-contacts)
+(defun org-contacts-strip-link (link)
+  "Remove brackets, description, link type and colon from an org link string and return the pure link key."
+   (let (startpos colonpos endpos)
+     (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:")) link))
+     (if startpos
+         (progn
+            (setq colonpos (string-match ":" link))
+            (setq endpos (string-match "\\]" link))
+            (if endpos (substring link (1+ colonpos) endpos) link))
+         (progn
+            (setq startpos (string-match "mailto:" link))
+            (setq colonpos (string-match ":" link))
+            (if startpos (substring link (1+ colonpos)) link)))))
+
+(defun org-contacts-split-property (string &optional separators omit-nulls)
+  "Custom version of `split-string'.
+Split a property STRING into sub-strings bounded by matches
+for SEPARATORS but keep Org links intact.
+
+The beginning and end of STRING, and each match for SEPARATORS, are
+splitting points.  The substrings matching SEPARATORS are removed, and
+the substrings between the splitting points are collected as a list,
+which is returned.
+
+If SEPARATORS is non-nil, it should be a regular expression matching text
+which separates, but is not part of, the substrings.  If nil it defaults to
+`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
+OMIT-NULLS is forced to t.
+
+If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
+that for the default value of SEPARATORS leading and trailing whitespace
+are effectively trimmed).  If nil, all zero-length substrings are retained."
+(let* ((keep-nulls (or nil omit-nulls))
+         (rexp (or separators split-string-default-separators))
+         (inputlist (split-string string rexp keep-nulls))
+         (linkstring "")
+         (bufferstring "")
+         (proplist (list "")))
+    (while inputlist
+      (setq bufferstring (pop inputlist))
+      (if (string-match "\\[\\[" bufferstring)
+          (progn
+            (setq linkstring (concat bufferstring " "))
+            (while (not (string-match "\\]\\]" bufferstring))
+              (setq bufferstring (pop inputlist))
+              (setq linkstring (concat  linkstring bufferstring " ")))
+            (setq proplist (cons (chomp linkstring) proplist)))
+        (setq proplist (cons bufferstring proplist))))
+    (cdr (reverse proplist))))
+
+(defun chomp (str)
+  "Chomp leading and tailing whitespace from STR."
+  (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
+    (setq str (replace-match "" t t str)))
+  str)
 
 (provide 'org-contacts)
 
-;; This program is distaributed in the hope that it will be useful,
+;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-- 
1.8.2


  parent reply	other threads:[~2013-04-14 20:49 UTC|newest]

Thread overview: 44+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-03-29 23:23 phone links Robert Goldman
2013-03-30  9:12 ` Karl Voit
2013-04-01 13:30 ` Robert Goldman
2013-04-03 14:52 ` Michael Strey
2013-04-03 15:05   ` Robert Goldman
2013-04-04  8:26     ` Michael Strey
2013-04-04 13:55       ` Michael Strey
2013-04-04 12:15 ` Bastien
2013-04-04 20:38   ` Simon Thum
2013-04-05  3:04     ` Robert P. Goldman
2013-04-05  6:42     ` Bastien
2013-04-06 12:05       ` Simon Thum
2013-04-06 12:10       ` Simon Thum
2013-04-06 20:58         ` Bastien
2013-04-05  2:38   ` Robert P. Goldman
2013-04-08 10:38     ` Michael Strey
2013-04-08 12:47       ` Robert Goldman
2013-04-08 14:07         ` Michael Strey
2013-04-08 14:44           ` Robert Goldman
2013-04-09  7:31             ` Michael Strey
2013-04-09 12:19               ` Robert Goldman
2013-04-09 14:40                 ` Michael Strey
2013-04-13 14:12               ` Feng Shu
2013-04-13 14:43                 ` Feng Shu
2013-04-14  8:38                   ` Bastien
2013-04-14 14:31                     ` Feng Shu
2013-04-15 15:39                       ` Bastien
2013-04-15 23:37                         ` Feng Shu
2013-04-16 21:11                       ` Daimrod
2013-04-17  3:55                         ` Feng Shu
2013-04-17  6:10                           ` Daimrod
2013-04-14 20:49               ` Michael Strey [this message]
2013-04-16 22:22                 ` Daimrod
2013-04-17 10:28                   ` Michael Strey
2013-04-20 15:59                     ` Daimrod
2013-04-26 12:48                       ` [Patch] " Michael Strey
2013-04-30  9:09                         ` Daimrod
2013-05-31  0:04                         ` Daimrod
2013-04-09  9:57       ` Feng Shu
2013-04-10 14:17 ` Michael Strey
2013-04-11 10:27   ` Michael Strey
2013-04-16  7:57     ` Eric S Fraga
2013-04-16 12:25       ` Robert P. Goldman
2013-04-17  8:14         ` Michael Strey

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20130414204929.GY659@strey.biz \
    --to=mstrey@strey.biz \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).