From: Daimrod <daimrod@gmail.com>
To: joakim@verona.se
Cc: emacs-orgmode@gnu.org
Subject: Re: bbdb or bbdb3 or org-contacts
Date: Fri, 01 Feb 2013 18:59:39 +0100 [thread overview]
Message-ID: <871ucz3ofo.fsf@casa.home> (raw)
In-Reply-To: <m31ud09wmk.fsf@chopper.vpn.verona.se> (joakim@verona.se's message of "Fri, 01 Feb 2013 11:06:11 +0100")
[-- Attachment #1.1: Type: text/plain, Size: 1839 bytes --]
joakim@verona.se writes:
> Daimrod <daimrod@gmail.com> writes:
>
>> Bastien <bzg@altern.org> writes:
>>
>>> Hi Dieter,
>>>
>>> Dieter Wilhelm <dieter@duenenhof-wilhelm.de> 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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Unify-org-id-reverse-string-and-org-babel-reverse-st.patch --]
[-- Type: text/x-diff, Size: 4169 bytes --]
From d075570c544d89d27eb7eb53fcc46dbb627aa480 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Jadi?= <gregoire.jadi@gmail.com>
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
---
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
--- 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))
(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))
-(defun org-babel-reverse-string (string)
- "Return the reverse of STRING."
- (apply 'string (reverse (string-to-list string))))
-
(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 argument."
"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."
- (org-babel-chomp (org-babel-reverse-string
- (org-babel-chomp (org-babel-reverse-string string) regexp))
+ (org-babel-chomp (org-reverse-string
+ (org-babel-chomp (org-reverse-string string) regexp))
regexp))
(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
--- 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)
- (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))))
-(defun org-id-reverse-string (s)
- (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
-
(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 time."
(if (= 2 (length parts))
(setq prefix (car parts) time (nth 1 parts))
(setq prefix nil time (nth 0 parts)))
- (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
--- 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))))
+(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)
--
1.7.10.4
[-- Attachment #1.3: 0002-Improve-completion-at-point-for-org-contacts.el-in-m.patch --]
[-- Type: text/x-diff, Size: 13989 bytes --]
From ec9f192518ae4663b3a5a3066093d9ecc66218fb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Jadi?= <gregoire.jadi@gmail.com>
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:
- 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.
- One can now complete on all part of an address and not only on the
beginning of the name.
---
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
--- 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)))))
-(defun org-contacts-complete-name (&optional start)
+(defun org-contacts-try-completion-prefix (to-match collection &optional predicate)
+ "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 = (concat "\\b" (regexp-quote to-match))
+ with ret = nil
+ with ret-start = nil
+ with ret-end = nil
+
+ for el in collection
+ for string = (if (listp el) (car el) el)
+
+ for start = (when (or (null predicate) (funcall predicate string))
+ (string-match regexp string))
+
+ if start
+ do (let ((end (match-end 0))
+ (len (length string)))
+ (if (= 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 &optional 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 = 4, end1 = 6, start2 = 5, end2 = 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))
+
+ (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)))
+
+ (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 = (concat "\\b" (regexp-quote to-match))
+ for el in collection
+ for string = (if (listp el) (car el) el)
+ for match? = (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 = (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= string el)))
+ collection))
+
+(defun org-contacts-boundaries-prefix (string collection predicate suffix)
+ (list* 'boundaries (completion-boundaries string collection predicate suffix)))
+
+(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 (= (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 = (car contact)
+ ;; Grab the first email of the contact
+ for email = (car (split-string
+ (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))
+ ", ")))
+ ;; 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."
- (let* ((end (point))
- (start (or start
- (save-excursion
- (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
- (goto-char (match-end 0))
- (point))))
- (orig (buffer-substring start end))
- (completion-ignore-case org-contacts-completion-ignore-case)
- (group-completion-p (org-string-match-p
- (concat "^" org-contacts-group-prefix) orig))
+ (let* ((completion-ignore-case org-contacts-completion-ignore-case)
(completion-list
- (if group-completion-p
- (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group)
- 'org-contacts-group group))
- (org-uniquify
- (loop for contact in (org-contacts-filter)
- with group-list
- nconc (org-split-string
- (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
- (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 = (car contact)
- ;; Build the list of the user email addresses.
- for email-list = (split-string (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)))))
- (completion-list (all-completions orig completion-list)))
- ;; If we are completing a group, and that's the only group, just return
- ;; the real result.
- (when (and group-completion-p
- (= (length completion-list) 1))
- (setq completion-list
- (list (concat
- (car completion-list) ";: "
- (mapconcat 'identity
- (loop for contact in (org-contacts-filter
- nil
- (get-text-property 0 'org-contacts-group
- (car completion-list)))
- ;; The contact name is always the car of the assoc-list
- ;; returned by `org-contacts-filter'.
- for contact-name = (car contact)
- ;; Grab the first email of the contact
- for email = (car (split-string
- (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))
- ", ")))))
- (list start end
- (completion-table-case-fold completion-list
- (not org-contacts-completion-ignore-case)))))
-
-(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 = (car contact)
+ ;; Build the list of the user email addresses.
+ for email-list = (split-string (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)))))
+ (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)
- (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))))))
(defun org-contacts-gnus-get-name-email ()
"Get name and email address from Gnus message."
--
1.7.10.4
[-- Attachment #1.4: Type: text/plain, Size: 21 bytes --]
--
Daimrod/Greg
[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]
next prev parent reply other threads:[~2013-02-01 17:58 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-01-27 18:06 bbdb or bbdb3 or org-contacts Dieter Wilhelm
2013-01-28 8:22 ` David Rogers
2013-02-21 9:51 ` Sriram Karra
2013-01-30 10:58 ` Bastien
2013-01-30 12:20 ` Daimrod
2013-01-30 16:15 ` Bastien
2013-02-01 10:06 ` joakim
2013-02-01 17:59 ` Daimrod [this message]
2013-02-03 14:04 ` Dieter Wilhelm
2013-02-03 15:50 ` Gour
2013-02-13 17:31 ` Bastien
2013-02-13 18:03 ` joakim
2013-02-13 22:14 ` Daimrod
2013-02-13 22:20 ` Bastien
2013-02-13 22:39 ` Daimrod
2013-02-14 7:39 ` Bastien
2013-02-14 7:56 ` Gour
2013-01-30 17:13 ` Gour
2013-01-30 17:27 ` Bastien
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=871ucz3ofo.fsf@casa.home \
--to=daimrod@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=joakim@verona.se \
/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).