[elpa] externals/gnorb 8519593 060/449: Rework Org BBDB popups

[Stefan Monnier]

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

    Rework Org BBDB popups
    
    gnorb-org.el: Used to be Agenda-only, now works in both Agenda and
    regular org files. Function `gnorb-org-agenda-popup-bbdb' renamed to
    `gnorb-org-popup-bbdb'.
---
 README.org        |  20 +++++++----
 lisp/gnorb-org.el | 100 ++++++++++++++++++++++++++++++------------------------
 2 files changed, 69 insertions(+), 51 deletions(-)

diff --git a/README.org b/README.org
index cb6d16d..b5303c0 100644
--- a/README.org
+++ b/README.org
@@ -100,11 +100,18 @@ Use `gnorb-org-email-subtree' when the primary purpose of 
the heading
 is the text (or tables or lists or...) of its subtree, and you just
 happen to want to email that content to someone.
 
-**** gnorb-org-agenda-popup-bbdb
-Call this function in an Org Agenda buffer currently displaying an
-`org-tags-view' search (ie called with the "m" or "M" keys). It will
-look through your BBDB database and pop up a BBDB buffer displaying
-all records that match the current tags search.
+**** gnorb-org-popup-bbdb
+Pop up a BBDB buffer relevant to the current Org display. This works
+differently depending on whether you're in the Agenda, or in a regular
+Org file.
+
+In an Agenda buffer currently displaying an `org-tags-view' search (ie
+called with the "m" or "M" keys), it will look through your BBDB
+database and pop up a BBDB buffer displaying all records that match
+the current tags search.
+
+In a regular file, it will look at the heading under point for bbdb:
+links, and pop up a BBDB buffer showing those records.
 *** User Options
 **** gnorb-org-capture-collect-link-p
 When this is set to t, the capture process will always store a link to
@@ -125,10 +132,11 @@ values as bbdb-pop-up-layout.
        (org-defkey org-mode-map (kbd "C-c C") 'gnorb-org-contact-link)
        (org-defkey org-mode-map (kbd "C-c H") 'gnorb-org-handle-mail)
        (org-defkey org-mode-map (kbd "C-c E") 'gnorb-org-email-subtree)
+       (org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb)
        (setq gnorb-org-agenda-popup-bbdb t)
        (eval-after-load "org-agenda"
          '(org-defkey org-agenda-mode-map (kbd "H") 'gnorb-org-handle-mail)
-         '(org-defkey org-agenda-mode-map (kbd "V") 
'gnorb-org-agenda-popup-bbdb))))
+         '(org-defkey org-agenda-mode-map (kbd "V") 'gnorb-org-popup-bbdb))))
 #+END_SRC
 ** Gnorb-Gnus
 *** Functions
diff --git a/lisp/gnorb-org.el b/lisp/gnorb-org.el
index 2fe5f45..196dc9e 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -337,7 +337,7 @@ customized with `gnorb-bbdb-org-tag-field'."
                 (const full-multi-line)
                 (symbol)))
 
-(defun gnorb-org-agenda-popup-bbdb (&optional str)
+(defun gnorb-org-popup-bbdb (&optional str)
   "In an `org-tags-view' Agenda buffer, pop up a BBDB buffer
 showing records whose `org-tags' field matches the current tags
 search."
@@ -348,50 +348,60 @@ search."
   ;; remove non-tag contents from the query string, and then make a
   ;; new call to `org-make-tags-matcher'.
   (interactive)
-  (when (and
-        (and (eq major-mode 'org-agenda-mode)
-             (eq org-agenda-type 'tags))
-        (or (called-interactively-p)
-            gnorb-org-agenda-popup-bbdb))
-    (require 'gnorb-bbdb)
-    (let ((recs (bbdb-records))
-         (todo-only nil)
-         (str (or str org-agenda-query-string))
-         (re 
"^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
-         or-terms term rest out-or acc tag-clause)
-      (setq or-terms (org-split-string str "|"))
-      (while (setq term (pop or-terms))
-       (setq acc nil)
-       (while (string-match re term)
-         (setq rest (substring term (match-end 0)))
-         (let ((sub-term (match-string 0 term)))
-           (unless (save-match-data ; this isn't a tag, don't want it
-                     (string-match "\\([<>=]\\)" sub-term))
-             (push sub-term acc))
-           (setq term rest)))
-       (push (mapconcat 'identity (nreverse acc) "") out-or))
-      (setq str (mapconcat 'identity (nreverse out-or) "|"))
-      (setq tag-clause (cdr (org-make-tags-matcher str)))
-      (setq recs
-           (remove-if-not
-            (lambda (r)
-              (let ((rec-tags (bbdb-record-xfield
-                               r gnorb-bbdb-org-tag-field)))
-                (and rec-tags
-                     (let ((tags-list (org-split-string rec-tags ":"))
-                           (case-fold-search t)
-                           (org-trust-scanner-tags t))
-                       (eval tag-clause)))))
-            recs))
-      (if recs (bbdb-display-records
-               recs gnorb-org-bbdb-popup-layout)
-       (when (get-buffer-window bbdb-buffer-name)
-         (quit-window nil
-                      (get-buffer-window bbdb-buffer-name)))
-       (when (called-interactively-p)
-         (message "No relevant BBDB records"))))))
-
-(add-hook 'org-agenda-finalize-hook 'gnorb-org-agenda-popup-bbdb)
+  (require 'gnorb-bbdb)
+  (let (recs)
+    (cond ((and
+           (and (eq major-mode 'org-agenda-mode)
+                (eq org-agenda-type 'tags))
+           (or (called-interactively-p)
+               gnorb-org-agenda-popup-bbdb))
+          (let ((todo-only nil)
+                (str (or str org-agenda-query-string))
+                (re 
"^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
+                or-terms term rest out-or acc tag-clause)
+            (setq or-terms (org-split-string str "|"))
+            (while (setq term (pop or-terms))
+              (setq acc nil)
+              (while (string-match re term)
+                (setq rest (substring term (match-end 0)))
+                (let ((sub-term (match-string 0 term)))
+                  (unless (save-match-data ; this isn't a tag, don't want it
+                            (string-match "\\([<>=]\\)" sub-term))
+                    (push sub-term acc))
+                  (setq term rest)))
+              (push (mapconcat 'identity (nreverse acc) "") out-or))
+            (setq str (mapconcat 'identity (nreverse out-or) "|"))
+            (setq tag-clause (cdr (org-make-tags-matcher str)))
+            (setq recs
+                  (remove-if-not
+                   (lambda (r)
+                     (let ((rec-tags (bbdb-record-xfield
+                                      r gnorb-bbdb-org-tag-field)))
+                       (and rec-tags
+                            (let ((tags-list (org-split-string rec-tags ":"))
+                                  (case-fold-search t)
+                                  (org-trust-scanner-tags t))
+                              (eval tag-clause)))))
+                   (bbdb-records)))))
+         ((eq major-mode 'org-mode)
+          (save-excursion
+            (org-back-to-heading)
+            (while (re-search-forward
+                    org-bracket-link-analytic-regexp (line-end-position) t)
+              (when (string-match-p "bbdb" (match-string 2))
+                (let* ((desc (match-string 5))
+                       (rec (bbdb-search (bbdb-records) desc desc desc)))
+                  (setq recs (append recs rec))))))))
+    (if recs
+       (bbdb-display-records
+        recs gnorb-org-bbdb-popup-layout)
+      (when (get-buffer-window bbdb-buffer-name)
+       (quit-window nil
+                    (get-buffer-window bbdb-buffer-name)))
+      (when (called-interactively-p)
+       (message "No relevant BBDB records")))))
+
+(add-hook 'org-agenda-finalize-hook 'gnorb-org-popup-bbdb)
 
 (provide 'gnorb-org)
 ;;; gnorb-org.el ends here