[elpa] externals/gnorb 69c3312 089/449: Refactoring of gnorb-org link scanning

[Stefan Monnier]

branch: externals/gnorb
commit 69c331286c8f1e5f94817d28debedf1cee544cbf
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    Refactoring of gnorb-org link scanning
    
    lisp/gnorb-utils.el: New separate function `gnorb-scan-links',
    previously a part of `gnorb-org-extract-mail-stuff'. New helper subst
    `gnorb-bbdb-link-to-mail'.
    
    lisp/gnorb-org.el: Rejigger `gnorb-org-extract-mail-stuff' to use new
    functions.
---
 lisp/gnorb-org.el   | 43 +++++++++++++++++--------------------------
 lisp/gnorb-utils.el | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 26 deletions(-)

diff --git a/lisp/gnorb-org.el b/lisp/gnorb-org.el
index fce23ff..934642a 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -275,32 +275,23 @@ heading text will be scanned for message and mail links."
                      ((eq gnorb-org-mail-scan-scope 'subtree)
                       (goto-char (point-max))))
                (point)))
-            message mails)
-       (cl-labels
-           ((scan-for-links
-             (bound)
-             (unless (eq (point) bound)
-               (while (re-search-forward org-any-link-re bound t)
-                 (let ((addr (or (match-string-no-properties 2)
-                                 (match-string-no-properties 0))))
-                   (cond
-                    ((string-match "^<?gnus:" addr)
-                     (push (substring addr (match-end 0)) message))
-                    ((string-match "^<?mailto:"; addr)
-                     (push (substring addr (match-end 0)) mails))
-                    ((string-match-p "^<?bbdb:" addr)
-                     (with-current-buffer bbdb-buffer-name
-                       (let ((recs bbdb-records))
-                         (org-open-link-from-string (concat "[[" addr "]]"))
-                         (let ((mail (bbdb-mail-address 
(bbdb-current-record))))
-                           (bbdb-display-records recs)
-                           (push mail mails)))))))))))
-         (org-back-to-heading t)
-         (unless state-info
-           (scan-for-links (line-end-position)))
-         (goto-char start)
-         (scan-for-links end))
-       (list message mails)))))
+            strings links bbdb-mails)
+       (org-back-to-heading t)
+       (unless state-info
+         (push (buffer-substring (point) (line-end-position)) strings))
+       (push (buffer-substring start end) strings)
+       (with-temp-buffer
+         (dolist (s strings)
+           (insert s)
+           (insert "\n"))
+         (goto-char (point-min))
+         (setq links (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb)))
+       (when (plist-get links :bbdb)
+         (dolist (b (plist-get links :bbdb))
+           (push (gnorb-bbdb-link-to-mail b) bbdb-mails)))
+       (list (plist-get links :gnus)
+             (append bbdb-mails
+                     (plist-get links :mail)))))))
 
 (defun gnorb-org-setup-message
     (&optional messages mails from cc bcc attachments text ids)
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index bb63698..1c4a37c 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -144,5 +144,39 @@ the prefix arg."
          (call-interactively note-func)
        (call-interactively todo-func)))))
 
+(defsubst gnorb-bbdb-link-to-mail (link)
+  (with-current-buffer bbdb-buffer-name
+    (let ((recs bbdb-records))
+      (org-open-link-from-string (concat "[[bbdb:" link "]]"))
+      (let ((mail (bbdb-mail-address (bbdb-current-record))))
+       (bbdb-display-records recs)
+       mail))))
+
+(defun gnorb-scan-links (bound &rest types)
+  ;; 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 (eq (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 ,gnus :mail ,mail :bbdb ,bbdb))))
+
 (provide 'gnorb-utils)
 ;;; gnorb-utils.el ends here