From mboxrd@z Thu Jan 1 00:00:00 1970 From: Michael Strey Subject: Re: [Patch] phone links... Date: Fri, 26 Apr 2013 14:48:52 +0200 Message-ID: <20130426124852.GS659@strey.biz> References: <515E3938.2030202@sift.info> <20130408103832.GE659@strey.biz> <5162BC78.7010509@sift.info> <20130408140731.GF659@strey.biz> <5162D7BC.3020303@sift.info> <20130409073140.GJ659@strey.biz> <20130414204929.GY659@strey.biz> <87r4iam7zd.fsf@tanger.home> <20130417102847.GC659@strey.biz> <87li8ddx5b.fsf@tanger.home> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="oxV4ZoPwBLqAyY+a" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:42520) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UVi5C-0000Ub-5S for emacs-orgmode@gnu.org; Fri, 26 Apr 2013 08:49:00 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UVi59-0005s9-PF for emacs-orgmode@gnu.org; Fri, 26 Apr 2013 08:48:58 -0400 Received: from mx1.supremebox.com ([198.23.53.39]:35919) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UVi59-0005rz-Jo for emacs-orgmode@gnu.org; Fri, 26 Apr 2013 08:48:55 -0400 Received: from [77.189.162.161] (helo=localhost) by mx1.supremebox.com with esmtpa (Exim 4.80) (envelope-from ) id 1UVi57-0002Jd-St for emacs-orgmode@gnu.org; Fri, 26 Apr 2013 12:48:54 +0000 Content-Disposition: inline In-Reply-To: <87li8ddx5b.fsf@tanger.home> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org --oxV4ZoPwBLqAyY+a Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Greg, Here are the reworked patches. 0390: fixes two typos 0391: contains all the changes from my last patch and your corrections 0392: introduces a constant for the default value of separators Best regards Michael Strey On Sat, Apr 20, 2013 at 05:59:39PM +0200, Daimrod wrote: > Michael Strey writes: > > Oh =:-|, another struggle with Git. I'm still learning and will do my best. > > If you're not already using magit[1] I highly recommend it to you. You > can use it to commit only a portion of the changes (you can also do it > with "git commit --interactive" but I find it easier with magit). Thanks for the hint. It helped a lot. -- Michael Strey www.strey.biz --oxV4ZoPwBLqAyY+a Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="0390-org-contacts-Fix-two-typos-in-comments.patch" Content-Transfer-Encoding: quoted-printable =46rom 2b59a2800de7066dde72121bc72ba75ea88f3c5a Mon Sep 17 00:00:00 2001 =46rom: Michael Strey Date: Fri, 26 Apr 2013 12:06:34 +0200 Subject: [PATCH 390/392] org-contacts: Fix two typos in comments * contrib/lisp/org-contacts.el (org-contacts-db): fix typo in the word `matching'. * contrib/lisp/org-contacts.el (org-contacts-complete-group): fix typo in the word `found'. TINYCHANGE --- contrib/lisp/org-contacts.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index a3c4aed..626ad7a 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -225,7 +225,7 @@ This overrides `org-email-link-description-format' if s= et." org-contacts-db)) =20 (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)) @@ -433,7 +433,7 @@ A group FOO is composed of contacts with the tag FOO." (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))))) (list start end (if (=3D (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) --=20 1.8.2 --oxV4ZoPwBLqAyY+a Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename="0391-Org-contacts-Allow-org-links-in-properties.patch" Content-Transfer-Encoding: quoted-printable =46rom 68145d055b7a48821d9aec308cd44764a5b889ec Mon Sep 17 00:00:00 2001 =46rom: Michael Strey Date: Fri, 26 Apr 2013 12:29:55 +0200 Subject: [PATCH 391/392] Org-contacts: Allow org links in properties * contrib/lisp/org-contacts.el (org-contacts-split-property): Introduce a custom version of split-string that keeps org links intact. * contrib/lisp/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 target. * contrib/lisp/org-contacts.el (provide 'org-contacts): Remove a redundant line. * contrib/lisp/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 | 73 ++++++++++++++++++++++++++++++++++++----= ---- 1 file changed, 61 insertions(+), 12 deletions(-) diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index 626ad7a..eb3fc09 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -445,11 +445,11 @@ A group FOO is composed of contacts with the tag FOO." ;; returned by `org-contacts-filter'. for contact-name =3D (car contact) ;; Grab the first email of the contact - for email =3D (car (split-string + for email =3D (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 . if email collect (org-contacts-format-email contact-name email)) ", "))) @@ -466,14 +466,14 @@ A group FOO is composed of contacts with the tag FOO." ;; returned by `org-contacts-filter'. for contact-name =3D (car contact) ;; Build the list of the user email addresses. - for email-list =3D (split-string (or + for email-list =3D (org-contacts-split-property (or (cdr (assoc-string org-contacts-email-property (caddr contact))) "")) ;; If the user has email addresses=E2=80=A6 if email-list ;; =E2=80=A6 append a list of USER . 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)))) @@ -738,11 +738,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 (=3D (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-headin= g t) email))))) (error (format "This contact has no mail address set (no %s prop= erty)." @@ -766,8 +767,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 =3D (gravatar-retrieve-synchronously em= ail) + (loop for email in (org-contacts-split-property email-list) + for gravatar =3D (gravatar-retrieve-synchronously (o= rg-contacts-strip-link email)) if (and gravatar (not (eq gravatar 'error))) return gravatar)))) @@ -849,19 +850,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 pho= nes-list)) "\n")) (setq phones-list (cdr phones-list))) result)) (when bday @@ -910,7 +911,55 @@ Requires google-maps-el." if addr collect (cons (list addr) (list :label (string-to-char (car contact)))= )))) =20 -(provide 'org-contacts) +(defun org-contacts-strip-link (link) + "Remove brackets, description, link type and colon from an org link stri= ng and return the pure link target." + (let (startpos colonpos endpos) + (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:")) lin= k)) + (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= =2E" +(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 (org-trim linkstring) proplist))) + (setq proplist (cons bufferstring proplist)))) + (cdr (reverse proplist)))) =20 (provide 'org-contacts) =20 --=20 1.8.2 --oxV4ZoPwBLqAyY+a Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="0392-Org-contacts-Introduce-the-constant-org-contacts-pro.patch" Content-Transfer-Encoding: quoted-printable =46rom a4018be0b34c3c40ad6b43f2380e0fd52a171591 Mon Sep 17 00:00:00 2001 =46rom: Michael Strey Date: Fri, 26 Apr 2013 13:57:46 +0200 Subject: [PATCH 392/392] Org-contacts: Introduce the constant `org-contacts-property-values-separators' * contrib/lisp/org-contacts.el (org-contacts-property-values-separators): Definition of a new constant that will be used as default value of separators for `org-contacts-split-property'. * contrib/lisp/org-contacts.el (org-contacts-vcard-format): We are now using the default separator in general. * contrib/lisp/org-contacts.el (org-contacts-show-map): Line break corrected. * contrib/lisp/org-contacts.el (org-contacts-split-property): Correct the comment describing the function. Application of the newly defined constant `org-contacts-property-values-separators'. --- contrib/lisp/org-contacts.el | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index eb3fc09..84ebc9d 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -174,6 +174,11 @@ This overrides `org-email-link-description-format' if = set." (declare-function std11-narrow-to-header "ext:std11") (declare-function std11-fetch-field "ext:std11") =20 +(defconst org-contacts-property-values-separators "[,; \f\t\n\r\v]+" + "The default value of separators for `org-contacts-split-property'. + +A regexp matching strings of whitespace, `,' and `;'.") + (defvar org-contacts-keymap (let ((map (make-sparse-keymap))) (define-key map "M" 'org-contacts-view-send-email) @@ -850,7 +855,7 @@ 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 (org-contacts-split-property email "[,; ]+")) + (setq emails-list (org-contacts-split-property email)) (setq result "") (while emails-list (setq result (concat result "EMAIL:" (org-contacts-strip-link (car= emails-list)) "\n")) @@ -859,7 +864,7 @@ to do our best." (when addr (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) (when tel (progn - (setq phones-list (org-contacts-split-property tel "[,; ]+")) + (setq phones-list (org-contacts-split-property tel)) (setq result "") (while phones-list (setq result (concat result "TEL:" (org-contacts-strip-link (car pho= nes-list)) "\n")) @@ -912,7 +917,8 @@ Requires google-maps-el." collect (cons (list addr) (list :label (string-to-char (car contact)))= )))) =20 (defun org-contacts-strip-link (link) - "Remove brackets, description, link type and colon from an org link stri= ng and return the pure link target." + "Remove brackets, description, link type and colon from an org +link string and return the pure link target." (let (startpos colonpos endpos) (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:")) lin= k)) (if startpos @@ -935,16 +941,16 @@ splitting points. The substrings matching SEPARATORS= are removed, and the substrings between the splitting points are collected as a list, which is returned. =20 -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 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 `org-contacts-property-values-separator= s', +normally \"[,; \f\t\n\r\v]+\", and OMIT-NULLS is forced to t. =20 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= =2E" (let* ((keep-nulls (or nil omit-nulls)) - (rexp (or separators split-string-default-separators)) + (rexp (or separators org-contacts-property-values-separators)) (inputlist (split-string string rexp keep-nulls)) (linkstring "") (bufferstring "") --=20 1.8.2 --oxV4ZoPwBLqAyY+a--