[elpa] externals/gnorb 354705a 245/449: Provide completion for Org tags on BBDB records

[Stefan Monnier]

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

    Provide completion for Org tags on BBDB records
    
    * gnorb-bbdb.el (gnorb-bbdb-read-org-tags): New function for reading
      tags with multiple completion.
      (gnorb-bbdb-display-org-tags): Display function for Org tags as a
      list.
    
    Both functions are only put in use in newer versions of BBDB, where
    xfield values can be sexps.
---
 gnorb-bbdb.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)

diff --git a/gnorb-bbdb.el b/gnorb-bbdb.el
index b30298f..85c42c8 100644
--- a/gnorb-bbdb.el
+++ b/gnorb-bbdb.el
@@ -147,6 +147,58 @@ be composed, just as in `gnus-posting-styles'.
 An example value might look like:"
   :group 'gnorb-bbdb)
 
+(when (fboundp 'bbdb-record-xfield-string)
+  (fset (intern (format "bbdb-read-xfield-%s"
+                       gnorb-bbdb-org-tag-field))
+       (lambda (&optional init)
+         (gnorb-bbdb-read-org-tags init)))
+
+  (fset (intern (format "bbdb-display-%s-multi-line"
+                       gnorb-bbdb-org-tag-field))
+       (lambda (record)
+         (gnorb-bbdb-display-org-tags record))))
+
+(defun gnorb-bbdb-read-org-tags (&optional init)
+  "Read Org mode tags, with `completing-read-multiple'."
+  (if (string< "24.3" (substring emacs-version 0 4))
+      (let ((crm-separator
+            (concat "[ \t\n]*"
+                    (cadr (assq gnorb-bbdb-org-tag-field
+                                bbdb-separator-alist))
+                    "[ \t\n]*"))
+           (crm-local-completion-map bbdb-crm-local-completion-map)
+           (table (mapcar #'car
+                          (org-global-tags-completion-table
+                           (org-agenda-files))))
+           (init (if (consp init)
+                     (bbdb-join init
+                                (nth 2 (assq gnorb-bbdb-org-tag-field
+                                             bbdb-separator-alist)))
+                   init)))
+       (completing-read-multiple
+        "Tags: " table
+        nil nil init))
+    (bbdb-split gnorb-bbdb-org-tag-field
+               (bbdb-read-string "Tags: " init))))
+
+(defun gnorb-bbdb-display-org-tags (record)
+  "Display the Org tags associated with the record.
+
+Org tags are stored in the `gnorb-bbdb-org-tags-field'."
+  (let ((full-field (assq gnorb-bbdb-org-tag-field
+                         (bbdb-record-xfields record)))
+       (val (bbdb-record-xfield
+             record
+             gnorb-bbdb-org-tag-field)))
+    (when val
+      (bbdb-display-text (format fmt gnorb-bbdb-org-tag-field)
+                        `(xfields ,full-field field-label)
+                        'bbdb-field-name)
+      (if (consp val)
+         (bbdb-display-list val gnorb-bbdb-org-tag-field "\n")
+       (insert
+        (bbdb-indent-string (concat val "\n") indent))))))
+
 ;;;###autoload
 (defun gnorb-bbdb-mail (records &optional subject n verbose)
   "\\<bbdb-mode-map>Acts just like `bbdb-mail', except runs
@@ -405,6 +457,8 @@ layout type."
                          (eq format 'multi))
                     (bbdb-indent-string (concat val "\n") indent))
                    ((listp val)
+                    ;; Why aren't I using `bbdb-display-list' with a
+                    ;; preformatted list of messages?
                     (concat
                      (bbdb-indent-string
                       (mapconcat