[elpa] master 0168aa0: Sneakily add basic EBDB support to Gnorb, bump to 1.3.0

[Eric Abrahamsen]

branch: master
commit 0168aa0ad91fba81400be47e72085040832b2256
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Sneakily add basic EBDB support to Gnorb, bump to 1.3.0
    
    * packages/gnorb/gnorb-utils.el (gnorb-scan-links): Generalize this
      function so it can find links of any type. Use an alist instead of a
      plist, as alist-get is setf-able.
    * packages/gnorb/gnorb-org.el (gnorb-org-handle-mail): Search for ebdb
      links as well as bbdb links, and handle them.
    * packages/gnorb/gnorb-registry.el (gnorb-registry-transition-from-props):
      Adjust.
    * packages/gnorb/nngnorb.el (nnir-run-gnorb): Adjust.
    * packages/gnorb/gnorb.el: Bump version.
---
 packages/gnorb/gnorb-org.el      | 59 +++++++++++++++++++++-------------------
 packages/gnorb/gnorb-registry.el |  2 +-
 packages/gnorb/gnorb-utils.el    | 40 +++++++++++----------------
 packages/gnorb/gnorb.el          |  2 +-
 packages/gnorb/nngnorb.el        |  6 ++--
 5 files changed, 52 insertions(+), 57 deletions(-)

diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el
index 7e42cb8..ee6665a 100644
--- a/packages/gnorb/gnorb-org.el
+++ b/packages/gnorb/gnorb-org.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2014  Free Software Foundation, Inc.
 
 ;; Author: Eric Abrahamsen  <address@hidden>
-;; Keywords: 
+;; Keywords:
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -20,7 +20,7 @@
 
 ;;; Commentary:
 
-;; 
+;;
 
 ;;; Code:
 
@@ -213,7 +213,7 @@ we came from."
          (insert s)
          (insert "\n"))
        (goto-char (point-min))
-       (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb)))))
+       (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb 'ebdb)))))
 
 (defun gnorb-org-extract-mail-stuff (&optional arg region)
   "Decide how to hande the Org heading under point as an email task.
@@ -274,7 +274,7 @@ See the docstring of `gnorb-org-handle-mail' for details."
      ;; Otherwise ignore the other links in the subtree, and return
      ;; the latest message.
      (msg-id-link
-      `(:gnus ,(list msg-id-link))))))
+      `(gnus ,msg-id-link)))))
 
 (defvar message-beginning-of-line)
 
@@ -307,7 +307,7 @@ headings."
   ;; `gnorb-gnus-check-outgoing-headers' is set unconditionally in the
   ;; `message-send-hook, so this should be redundant.  Also, we've
   ;; switched to using message-send-actions.
-  
+
   ;; (add-to-list
   ;; 'message-exit-actions 'gnorb-org-restore-after-send t) Set
   ;; headers from MAIL_* properties (from, cc, and bcc).
@@ -377,11 +377,10 @@ current heading, or the heading indicated by optional 
argument ID."
 (defvar message-mode-hook)
 
 ;;;###autoload
-(defun gnorb-org-handle-mail (&optional arg text file)
+(defun gnorb-org-handle-mail (arg &optional text file)
   "Handle current headline as a mail TODO.
-
 How this function behaves depends on whether you're using Gnorb
-for email tracking, also on the prefix arg, and on the active
+for email tracking, also on the prefix ARG, and on the active
 region.
 
 If tracking is enabled and there is no prefix arg, Gnorb will
@@ -406,7 +405,10 @@ automatically tracked, as well.
 
 If tracking is not enabled and you want to use a specific link in
 the subtree as a basis for the email action, then put the region
-around that link before you call this message."
+around that link before you call this message.
+
+TEXT is text to insert into the body of the message being
+composed.  FILE is a file to attach to the message."
   (interactive "P")
   (setq gnorb-window-conf (current-window-configuration))
   (move-marker gnorb-return-marker (point))
@@ -423,7 +425,7 @@ around that link before you call this message."
       (goto-char pos)))
   (let ((region
         (when (use-region-p)
-          (cons (region-beginning) (region-end)))))
+          (region-bounds))))
     (deactivate-mark)
     (save-excursion
       (unless (org-back-to-heading t)
@@ -438,32 +440,33 @@ around that link before you call this message."
               (cc (mp "MAIL_CC"))
               (bcc (mp "MAIL_BCC"))
               (org-id (org-id-get-create))
-              (recs (plist-get links :bbdb))
+              (b-recs (alist-get 'bbdb links))
+              (e-recs (alist-get 'ebdb links))
               (message-mode-hook (copy-sequence message-mode-hook))
               mails)
          (when file
            (setq attachments (cons file attachments)))
-         (when recs
-           (setq recs
-                 (delq nil
-                       (mapcar
-                        (lambda (r)
-                          (car (bbdb-message-search
-                                (org-link-unescape r)
-                                nil)))
-                        recs))))
-         (when recs
-           (dolist (r recs)
-             (push (bbdb-mail-address r) mails)))
-         (when (and recs
+         (when (fboundp 'ebdb-org-retrieve)
+           (dolist (e (alist-get 'ebdb links))
+             (dolist (r (ebdb-org-retrieve e))
+               (let ((m (ebdb-dwim-mail r)))
+                 (when m
+                   (push m mails))))))
+         (dolist (b (alist-get 'bbdb links))
+           (let ((m (ebdb-mail-address
+                     (car (bbdb-message-search
+                           (org-link-unescape r))))))
+             (when m
+               (push m mails))))
+         (when (and b-recs
                     gnorb-bbdb-posting-styles)
            (add-hook 'message-mode-hook
                      (lambda ()
-                       (gnorb-bbdb-configure-posting-styles (cdr recs))
-                       (gnorb-bbdb-configure-posting-styles (list (car 
recs))))))
+                       (gnorb-bbdb-configure-posting-styles (cdr b-recs))
+                       (gnorb-bbdb-configure-posting-styles (list (car 
b-recs))))))
          (gnorb-org-setup-message
-          (plist-get links :gnus)
-          (append mails (plist-get links :mail))
+          (alist-get 'gnus links)
+          (append mails (alist-get 'mail links))
           from cc bcc
           attachments text org-id))))))
 
diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el
index 5acb793..51bce39 100644
--- a/packages/gnorb/gnorb-registry.el
+++ b/packages/gnorb/gnorb-registry.el
@@ -287,7 +287,7 @@ your Org files."
          (setq links (gnorb-scan-links
                       (org-element-property :end (org-element-at-point))
                       'gnus))
-         (dolist (l (plist-get links :gnus))
+         (dolist (l (alist-get 'gnus links))
            (gnorb-registry-make-entry
             (cl-second (split-string l "#")) nil nil
             id (cl-first (split-string l "#"))))
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
index 6548064..4a734cb 100644
--- a/packages/gnorb/gnorb-utils.el
+++ b/packages/gnorb/gnorb-utils.el
@@ -459,37 +459,29 @@ If the KW argument is true, add the TODO keyword into the 
path."
 
 (defun gnorb-scan-links (bound &rest types)
   "Scan from point to BOUND looking for links of type in TYPES.
+TYPES is a list of symbols; we search for all links corresponding
+to those symbols."
+  ;; It may be excessive to examine *all* links, rather than just
+  ;; creating a specialized regexp for the links we want, but it's
+  ;; nice to be lazy and use `org-bracket-link-analytic-regexp', that
+  ;; seems safer.
 
-TYPES is a list of symbols, possible values include `bbdb', `mail',
-and `gnus'."
-  ;; this function could be refactored somewhat -- lots of code
-  ;; repetition. It also should be a little faster for when we're
-  ;; scanning for gnus links only, that's a little slow. We should
-  ;; probably use a different regexp based on the value of TYPES.
-  ;;
   ;; This function should also *not* be responsible for unescaping
   ;; links -- we don't know what they're going to be used for, and
   ;; unescaped is safer.
   (unless (= (point) bound)
-    (let (addr gnus mail bbdb)
-      (while (re-search-forward org-any-link-re bound t)
-       (setq addr (or (match-string-no-properties 2)
-                      (match-string-no-properties 0)))
-       (cond
-        ((and (memq 'gnus types)
-              (string-match "^<?gnus:" addr))
-         (push (substring addr (match-end 0)) gnus))
-        ((and (memq 'mail types)
-              (string-match "^<?mailto:"; addr))
-         (push (substring addr (match-end 0)) mail))
-        ((and (memq 'bbdb types)
-              (string-match "^<?bbdb:" addr))
-         (push (substring addr (match-end 0)) bbdb))))
-      `(:gnus ,(reverse gnus) :mail ,(reverse mail) :bbdb ,(reverse bbdb)))))
+    (let ((alist (mapcar #'list (copy-sequence types))))
+      (while (re-search-forward org-bracket-link-analytic-regexp bound t)
+       (let* ((type (match-string-no-properties 2))
+              (link (match-string-no-properties 3))
+              (sym (intern-soft type)))
+         (when (memq sym types)
+           (push link (alist-get sym alist)))))
+      alist)))
 
 (defun gnorb-msg-id-to-link (msg-id)
-  "Given a message id, try to create a full org link to the
-message."
+  "Create a full Org link to the message MSG-ID.
+The main work is figuring out which group the message is in."
   (let ((server-group (car (gnorb-msg-id-request-head msg-id))))
     (when server-group
       (org-link-escape
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index c976e95..75323fc 100644
--- a/packages/gnorb/gnorb.el
+++ b/packages/gnorb/gnorb.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2014  Free Software Foundation, Inc.
 
-;; Version: 1.2.4
+;; Version: 1.3.0
 ;; Package-Requires: ((cl-lib "0.5"))
 
 ;; Maintainer: Eric Abrahamsen <address@hidden>
diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el
index 8b84afe..f706883 100644
--- a/packages/gnorb/nngnorb.el
+++ b/packages/gnorb/nngnorb.el
@@ -126,9 +126,9 @@ be scanned for gnus messages, and those messages displayed."
                'agenda)))
       (with-current-buffer buf
        (goto-char (point-min))
-       (setq links (append (plist-get (gnorb-scan-links (point-max) 'gnus)
-                                      :gnus)
-                           links))
+       (setq links (append
+                    (alist-get 'gnus (gnorb-scan-links (point-max) 'gnus))
+                    links))
 
        (goto-char (point-min)))
       ;; First add all links to messages (elements of messages should