From mboxrd@z Thu Jan 1 00:00:00 1970 From: Daimrod Subject: Re: bbdb or bbdb3 or org-contacts Date: Fri, 01 Feb 2013 18:59:39 +0100 Message-ID: <871ucz3ofo.fsf@casa.home> References: <87pq0qtsa1.fsf@urmel.duenenhof-wilhelm.de> <8738xi2aaf.fsf@bzg.ath.cx> <87txpyn9ql.fsf@casa.home> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:57046) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U1KsS-0001sp-9j for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 12:58:45 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U1Krw-0003Ng-Gd for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 12:58:16 -0500 Received: from mail-wg0-f50.google.com ([74.125.82.50]:45424) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U1Krw-0003Lk-2p for emacs-orgmode@gnu.org; Fri, 01 Feb 2013 12:57:44 -0500 Received: by mail-wg0-f50.google.com with SMTP id es5so3153995wgb.29 for ; Fri, 01 Feb 2013 09:57:42 -0800 (PST) In-Reply-To: (joakim@verona.se's message of "Fri, 01 Feb 2013 11:06:11 +0100") 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: joakim@verona.se Cc: emacs-orgmode@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain joakim@verona.se writes: > Daimrod writes: > >> Bastien writes: >> >>> Hi Dieter, >>> >>> Dieter Wilhelm writes: >>> >>>> What do you advise, what is already usable and what is the way >>>> ahead, still bbdb or bbdb3 or already org-contacts? >>> >>> BBDB is great. org-contacts.el is too slow when you have many >>> contacts, and it is not really maintained anymore. >> >> I've started to use org-contacts.el. I haven't (yet) problem with its >> speed but I've improved the completion mecanism which prevented me to >> use it. When I'll finish to document/comment it, I'll post it here. > > I would be very interested in having a look. See the attached patch files. I still need to need to take into account what could be after the cursor vvvvvv ATM I only use this From: John [cursor]D ^^^^^^^^^^^^^^ But I would like to use this But it mostly works. > I migrated from bbdb to org-contacts, but it turned out to be too slow, > so now I mostly isearch for the contact I want. > > Recently I've bee thinking of trying a strategy where bbdb could act as > a cache for org-contacts, but I havent tried it yet. It shouldnt be too > hard I think. org-contacts can generate a list of all contacts, that you > then iterate and generate the bbdb database from. It might be a useful > addition in any case. I was thinking to add a cache mecanism directly to `org-contacts.el'. It would load the content of the contacts files the first time into the appropriate structure and then reread the files only when they changed. Moreover, `org-contacts.el' doesn't use the new parser from `org-element.el' ATM, and using it might improve the performance too. PS: Sorry for the double patch files but the `org-reverse-string' part hasn't been merged yet and I use it. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Unify-org-id-reverse-string-and-org-babel-reverse-st.patch Content-Transfer-Encoding: quoted-printable From=20d075570c544d89d27eb7eb53fcc46dbb627aa480 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Gr=3DC3=3DA9goire=3D20Jadi?=3D Date: Sat, 26 Jan 2013 22:27:51 +0100 Subject: [PATCH 1/2] Unify `org-id-reverse-string' and `org-babel-reverse-string' into `org-reverse-string' * lisp/org.el (org-reverse-string): Add `org-reverse-string' to reverse a string. * lisp/org-id.el(org-id-new, org-id-decode): Replace `org-id-reverse-string' by `org-reverse-string'. * lisp/ob-core.el(org-babel-trim): Replace `org-babel-reverse-string' by `org-reverse-string' and declare it. TINYCHANGE =2D-- lisp/ob-core.el | 9 +++------ lisp/org-id.el | 7 ++----- lisp/org.el | 4 ++++ 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index bdf8c54..27f665a 100644 =2D-- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -91,6 +91,7 @@ (declare-function org-escape-code-in-region "org-src" (beg end)) (declare-function org-unescape-code-in-string "org-src" (s)) (declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function org-reverse-string "org" (string)) =20 (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -2512,10 +2513,6 @@ If the table is trivial, then return it as a scalar." (match-string 1 cell)) cell) t)) =20 =2D(defun org-babel-reverse-string (string) =2D "Return the reverse of STRING." =2D (apply 'string (reverse (string-to-list string)))) =2D (defun org-babel-chomp (string &optional regexp) "Strip trailing spaces and carriage returns from STRING. Default regexp used is \"[ \f\t\n\r\v]\" but can be @@ -2530,8 +2527,8 @@ overwritten by specifying a regexp as a second argume= nt." "Strip leading and trailing spaces and carriage returns from STRING. Like `org-babel-chomp' only it runs on both the front and back of the string." =2D (org-babel-chomp (org-babel-reverse-string =2D (org-babel-chomp (org-babel-reverse-string string) r= egexp)) + (org-babel-chomp (org-reverse-string + (org-babel-chomp (org-reverse-string string) regexp)) regexp)) =20 (defvar org-babel-org-babel-call-process-region-original nil) diff --git a/lisp/org-id.el b/lisp/org-id.el index 39ca170..a68adcf 100644 =2D-- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -343,7 +343,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (unless (org-uuidgen-p unique) (setq unique (org-id-uuid)))) ((eq org-id-method 'org) =2D (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) + (let* ((etime (org-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain (progn (require 'message) @@ -376,9 +376,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (substring rnd 18 20) (substring rnd 20 32)))) =20 =2D(defun org-id-reverse-string (s) =2D (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) =2D (defun org-id-int-to-b36-one-digit (i) "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a.= .z." (cond @@ -432,7 +429,7 @@ and time is the usual three-integer representation of t= ime." (if (=3D 2 (length parts)) (setq prefix (car parts) time (nth 1 parts)) (setq prefix nil time (nth 0 parts))) =2D (setq time (org-id-reverse-string time)) + (setq time (org-reverse-string time)) (setq time (list (org-id-b36-to-int (substring time 0 4)) (org-id-b36-to-int (substring time 4 8)) (org-id-b36-to-int (substring time 8 12)))) diff --git a/lisp/org.el b/lisp/org.el index 460ff2e..aeb5b05 100644 =2D-- a/lisp/org.el +++ b/lisp/org.el @@ -21093,6 +21093,10 @@ for the search purpose." (error "Unable to create a link to here")))) (org-occur-in-agenda-files (regexp-quote link)))) =20 +(defun org-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + (defun org-uniquify (list) "Remove duplicate elements from LIST." (let (res) =2D-=20 1.7.10.4 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0002-Improve-completion-at-point-for-org-contacts.el-in-m.patch Content-Transfer-Encoding: quoted-printable From=20ec9f192518ae4663b3a5a3066093d9ecc66218fb Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Gr=3DC3=3DA9goire=3D20Jadi?=3D Date: Mon, 28 Jan 2013 11:24:39 +0100 Subject: [PATCH 2/2] Improve `completion-at-point' for `org-contacts.el' in mail * org-contacts.el: Improve the completion part: =2D When a group is found, it now replaces the name of the group by the addresses of the member of the group rather than appending the addresses. =2D One can now complete on all part of an address and not only on the beginning of the name. =2D-- contrib/lisp/org-contacts.el | 301 +++++++++++++++++++++++++++++++++-----= ---- 1 file changed, 238 insertions(+), 63 deletions(-) diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index 8a8140c..f23d938 100644 =2D-- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -179,75 +179,250 @@ If both match values are nil, return all contacts." (let ((completion-ignore-case (not dont-fold))) (complete-with-action action table string pred))))) =20 =2D(defun org-contacts-complete-name (&optional start) +(defun org-contacts-try-completion-prefix (to-match collection &optional p= redicate) + "Like `try-completion' but: +- works only with list and alist; +- looks at all prefixes rather than just the beginning of the string;" + (loop with regexp =3D (concat "\\b" (regexp-quote to-match)) + with ret =3D nil + with ret-start =3D nil + with ret-end =3D nil + + for el in collection + for string =3D (if (listp el) (car el) el) + + for start =3D (when (or (null predicate) (funcall predicate string)) + (string-match regexp string)) + + if start + do (let ((end (match-end 0)) + (len (length string))) + (if (=3D end len) + (return t) + (destructuring-bind (string start end) + (if (null ret) + (values string start end) + (org-contacts-common-substring + ret ret-start ret-end + string start end)) + (setf ret string + ret-start start + ret-end end)))) + + finally (return + (replace-regexp-in-string "\\`[ \t\n]*" "" ret)))) + +(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &option= al ignore-case) + "Compare the contents of two strings, using `compare-strings'. + +This function works like `compare-strings' excepted that it +returns a cons. +- The CAR is the number of characters that match at the beginning. +- The CDR is T is the two strings are the same and NIL otherwise." + (let ((ret (compare-strings s1 start1 end1 s2 start2 end2 ignore-case))) + (if (eq ret t) + (cons (or end1 (length s1)) t) + (cons (1- (abs ret)) nil)))) + +(defun org-contacts-common-substring (s1 start1 end1 s2 start2 end2) + "Extract the common substring between S1 and S2. + +This function extracts the common substring between S1 and S2 and +adjust the part that remains common. + +START1 and END1 delimit the part in S1 that we know is common +between the two strings. This applies to START2 and END2 for S2. + +This function returns a list whose contains: +- The common substring found. +- The new value of the start of the known inner substring. +- The new value of the end of the known inner substring." + ;; Given two strings: + ;; s1: "foo bar baz" + ;; s2: "fooo bar baz" + ;; and the inner substring is "bar" + ;; then: start1 =3D 4, end1 =3D 6, start2 =3D 5, end2 =3D 7 + ;; + ;; To find the common substring we will compare two substrings: + ;; " oof" and " ooof" to find the beginning of the common substring. + ;; " baz" and " baz" to find the end of the common substring. + (let* ((len1 (length s1)) + (start1 (or start1 0)) + (end1 (or end1 len1)) + + (len2 (length s2)) + (start2 (or start2 0)) + (end2 (or end2 len2)) +=09=20 + (new-start (car (org-contacts-compare-strings + (substring (org-reverse-string s1) (- len1 start1)) nil nil + (substring (org-reverse-string s2) (- len2 start2)) nil nil))) +=09=20 + (new-end (+ end1 (car (org-contacts-compare-strings + (substring s1 end1) nil nil + (substring s2 end2) nil nil))))) + (list (substring s1 (- start1 new-start) new-end) + new-start + (+ new-start (- end1 start1))))) + +(defun org-contacts-all-completions-prefix (to-match collection &optional = predicate) + "Like `all-completions' but: +- works only with list and alist; +- looks at all prefixes rather than just the beginning of the string;" + (loop with regexp =3D (concat "\\b" (regexp-quote to-match)) + for el in collection + for string =3D (if (listp el) (car el) el) + for match? =3D (when (and (or (null predicate) (funcall predicate string)= )) + (string-match regexp string)) + if match? + collect (progn + (let ((end (match-end 0))) + (org-no-properties string) + (when (< end (length string)) + ;; Here we add a text property that will be used + ;; later to highlight the character right after + ;; the common part between each addresses. + ;; See `org-contacts-display-sort-function'. + (put-text-property end (1+ end) 'org-contacts-prefix 't string))) + string))) + +(defun org-contacts-make-collection-prefix (collection) + "Makes a collection function from COLLECTION which will match +on prefixes." + (lexical-let ((collection collection)) + (lambda (string predicate flag) + (cond ((eq flag nil) + (org-contacts-try-completion-prefix string collection predicate)) + ((eq flag t) + ;; `org-contacts-all-completions-prefix' has already been + ;; used to compute `all-completions'. + collection) + ((eq flag 'lambda) + (org-contacts-test-completion-prefix string collection predicate)) + ((and (listp flag) (eq (car flag) 'boundaries)) + (destructuring-bind (to-ignore &rest suffix) + flag + (org-contacts-boundaries-prefix string collection predicate suffix= ))) + ((eq flag 'metadata) + (org-contacts-metadata-prefix string collection predicate)) + (t nil ; operation unsupported + ))))) + +(defun org-contacts-display-sort-function (completions) + (mapcar (lambda (string) + (loop with len =3D (1- (length string)) + for i upfrom 0 to len + if (memq 'org-contacts-prefix + (text-properties-at i string)) + do (set-text-properties + i (1+ i) + (list 'font-lock-face + (if (char-equal (aref string i) + (string-to-char " ")) + ;; Spaces can't be bold. + 'underline + 'bold)) string) + else + do (set-text-properties i (1+ i) nil string) + finally (return string))) + completions)) + +(defun org-contacts-test-completion-prefix (string collection predicate) + (find-if (lambda (el) + (and (or (null predicate) (funcall predicate el)) + (string=3D string el))) + collection)) + +(defun org-contacts-boundaries-prefix (string collection predicate suffix) + (list* 'boundaries (completion-boundaries string collection predicate su= ffix))) + +(defun org-contacts-metadata-prefix (string collection predicate) + '(metadata . + ((display-sort-function . org-contacts-display-sort-function)))) + +(defun org-contacts-complete-group (start end string) + "Complete text at START from a group. + +A group FOO is composed of contacts with the tag FOO." + (let* ((completion-ignore-case org-contacts-completion-ignore-case) + (group-completion-p (org-string-match-p + (concat "^" org-contacts-group-prefix) string))) + (when group-completion-p + (let ((completion-list + (all-completions + string + (mapcar (lambda (group) + (propertize (concat org-contacts-group-prefix group) + 'org-contacts-group group)) + (org-uniquify + (loop for contact in (org-contacts-filter) + nconc (org-split-string + (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 + (lexical-let ((tag (get-text-property 0 'org-contacts-group + (car completion-list)))) + (lambda (string pred &optional to-ignore) + (mapconcat 'identity + (loop for contact in (org-contacts-filter + nil + tag) + ;; The contact name is always the car of the assoc-list + ;; returned by `org-contacts-filter'. + for contact-name =3D (car contact) + ;; Grab the first email of the contact + for email =3D (car (split-string + (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)) + ", "))) + ;; We haven't found the correct group + (completion-table-case-fold completion-list + (not org-contacts-completion-ignore-case)))))))) + +(defun org-contacts-complete-name (start end string) "Complete text at START with a user name and email." =2D (let* ((end (point)) =2D (start (or start =2D (save-excursion =2D (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") =2D (goto-char (match-end 0)) =2D (point)))) =2D (orig (buffer-substring start end)) =2D (completion-ignore-case org-contacts-completion-ignore-case) =2D (group-completion-p (org-string-match-p =2D (concat "^" org-contacts-group-prefix) orig)) + (let* ((completion-ignore-case org-contacts-completion-ignore-case) (completion-list =2D (if group-completion-p =2D (mapcar (lambda (group) (propertize (concat org-contacts-g= roup-prefix group) =2D 'org-contacts-group group)) =2D (org-uniquify =2D (loop for contact in (org-contacts-filter) =2D with group-list =2D nconc (org-split-string =2D (or (cdr (assoc-string "ALLTAGS" (ca= ddr contact))) "") ":")))) =2D (loop for contact in (org-contacts-filter) =2D ;; The contact name is always the car of the assoc-list =2D ;; returned by `org-contacts-filter'. =2D for contact-name =3D (car contact) =2D ;; Build the list of the user email addresses. =2D for email-list =3D (split-string (or =2D (cdr (assoc-string org= -contacts-email-property =2D (caddr contact))) "")) =2D ;; If the user has email addresses=E2=80=A6 =2D if email-list =2D ;; =E2=80=A6 append a list of USER . =2D nconc (loop for email in email-list =2D collect (org-contacts-format-email contact= -name email))))) =2D (completion-list (all-completions orig completion-list))) =2D ;; If we are completing a group, and that's the only group, just ret= urn =2D ;; the real result. =2D (when (and group-completion-p =2D (=3D (length completion-list) 1)) =2D (setq completion-list =2D (list (concat =2D (car completion-list) ";: " =2D (mapconcat 'identity =2D (loop for contact in (org-contacts-filter =2D nil =2D (get-text-property 0 'org-contacts-group =2D (car completion-list))) =2D ;; The contact name is always the car of the assoc-list =2D ;; returned by `org-contacts-filter'. =2D for contact-name =3D (car contact) =2D ;; Grab the first email of the contact =2D for email =3D (car (split-string =2D (or =2D (cdr (assoc-string org-contacts-email-property =2D (caddr contact))) =2D ""))) =2D ;; If the user has an email address, append USER . =2D if email collect (org-contacts-format-email contact-name email)) =2D ", "))))) =2D (list start end =2D (completion-table-case-fold completion-list =2D (not org-contacts-completion-ignore-case))))) =2D =2D(defun org-contacts-message-complete-function () + (loop for contact in (org-contacts-filter) + ;; The contact name is always the car of the assoc-list + ;; 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 + (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))))) + (when completion-list + (list start end + (org-contacts-make-collection-prefix + (org-contacts-all-completions-prefix + string + (remove-duplicates completion-list :test #'equalp))))))) + +(defun org-contacts-message-complete-function (&optional start) "Function used in `completion-at-point-functions' in `message-mode'." (let ((mail-abbrev-mode-regexp "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\= |Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):")) (when (mail-abbrev-in-expansion-header-p) =2D (org-contacts-complete-name)))) + (lexical-let* + ((end (point)) + (start (or start + (save-excursion + (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") + (goto-char (match-end 0)) + (point)))) + (string (buffer-substring start end))) + (or (org-contacts-complete-group start end string) + (org-contacts-complete-name start end string)))))) =20 (defun org-contacts-gnus-get-name-email () "Get name and email address from Gnus message." =2D-=20 1.7.10.4 --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable =2D-=20 Daimrod/Greg --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.12 (GNU/Linux) iQIcBAEBAgAGBQJRDAKMAAoJEBNzVHcrZRiUxEcP/RFyVjyT452D9uIiW5p8zGX+ uyEpZyOylByOFqeYXyvc0T6zrM8O6EL+5KNYb1cfYmE0xap/AZxnX2LwZ8sMQK+3 M6AHpua0xcCRydCayU3cLQGVqXR3+SRS8Baka98Wb94fsRI58Tyf26LP3J0sAVhD 6ZxBnoMe24xNaJXP7Lw4/vMsZkswv0bdAwAJCuaQHBP5d5/CRHHQ4XVMB59EOh9p YF+1cmQwe1QvO5qhNalkt1HjyclNH5eOj9WrthSo7NWgXufnLue9ocHWowTC6IcR 1/3QurIvtgmmL6nngZxTTTXThCHdzC9oemcPNDR3jJX5CKQ/YTv6fiiZx301E9aQ RtOC1vC/O8ilz90RQd3VyYkRhMn6DXn08ucNW+R15jPASlKyMCVdQQkWyXABzXRD TGnSSwWbYE7WmqHOk5rzzP6WYVkn98NFEC/sujIKijPVr0QiVjIuEwMWBebA7aPc FubBSHeG1Dh0pKOVwYNCFVnTt3fQ9VjYo94tJbPejlE8354aEyn0oM0kaG/061Bi sFEEiyIFeL/heVrWGaNPsdWw/++UmS2U4mcmaXmsVq4ej1ZKUitMpq/7nkinDavm xFzT5TzevMHx71FH5UBB/NThwEtMmlKQ/CZTYaTUUY3QiHRU1hdTx+uv+1qeZ9tT JhCq/PkB7uDoc/8/kbGf =nFdG -----END PGP SIGNATURE----- --==-=-=--