From mboxrd@z Thu Jan 1 00:00:00 1970 From: Michael Strey Subject: Re: phone links... Date: Sun, 14 Apr 2013 22:49:29 +0200 Message-ID: <20130414204929.GY659@strey.biz> References: <5156228C.4010400@sift.info> <871uaq7aqy.fsf@bzg.ath.cx> <515E3938.2030202@sift.info> <20130408103832.GE659@strey.biz> <5162BC78.7010509@sift.info> <20130408140731.GF659@strey.biz> <5162D7BC.3020303@sift.info> <20130409073140.GJ659@strey.biz> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="pQhZXvAqiZgbeUkD" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:34381) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1URTri-0003jW-3Y for emacs-orgmode@gnu.org; Sun, 14 Apr 2013 16:49:35 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1URTrg-0001iT-FI for emacs-orgmode@gnu.org; Sun, 14 Apr 2013 16:49:34 -0400 Received: from mx2.supremebox.com ([198.23.53.42]:48622) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1URTrg-0001iK-9v for emacs-orgmode@gnu.org; Sun, 14 Apr 2013 16:49:32 -0400 Received: from [77.179.17.14] (helo=localhost) by mx2.supremebox.com with esmtpa (Exim 4.80) (envelope-from ) id 1URTre-0005cl-Lr for emacs-orgmode@gnu.org; Sun, 14 Apr 2013 20:49:31 +0000 Content-Disposition: inline In-Reply-To: <20130409073140.GJ659@strey.biz> 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 --pQhZXvAqiZgbeUkD Content-Type: text/plain; charset=us-ascii Content-Disposition: inline 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 --pQhZXvAqiZgbeUkD Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename="0174-Org-contacts-Allow-org-links-in-properties.patch" Content-Transfer-Encoding: quoted-printable =46rom 69ae791cd552bacdcbc99af99a82ab699fa16d36 Mon Sep 17 00:00:00 2001 =46rom: Michael Strey 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 numb= ers 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 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)) @@ -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 (=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) @@ -438,11 +438,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)) ", "))) @@ -459,14 +459,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)))) @@ -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 (=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)." @@ -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 =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)))) @@ -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 pho= nes-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)))= )))) =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 key." + (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 (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) =20 (provide 'org-contacts) =20 -;; 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. --=20 1.8.2 --pQhZXvAqiZgbeUkD--