code.delx.au - gnu-emacs-elpa/blob - gnorb-org.el

   1 ;;; gnorb-org.el --- The Org-centric functions of gnorb
   2
   3 ;; Copyright (C) 2014  Eric Abrahamsen
   4
   5 ;; Author: Eric Abrahamsen  <eric@ericabrahamsen.net>
   6 ;; Keywords:
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;
  24
  25 ;;; Code:
  26
  27 (eval-when-compile
  28   (require 'cl))
  29
  30 (require 'gnorb-utils)
  31
  32 (defgroup gnorb-org nil
  33   "The Org bits of Gnorb."
  34   :tag "Gnorb Org"
  35   :group 'gnorb)
  36
  37 (defcustom gnorb-org-after-message-setup-hook nil
  38   "Hook run in a message buffer after setting up the message from
  39   `gnorb-org-handle-mail' or `gnorb-org-email-subtree'."
  40   :group 'gnorb-org
  41   :type 'hook)
  42
  43 (defcustom gnorb-org-trigger-actions
  44   '(("todo state" . todo)
  45     ("take note" . note)
  46     ("don't associate" . no-associate)
  47     ("only associate" . associate)
  48 ;    ("capture to child" . cap-child)
  49 ;    ("capture to sibling" . cap-sib)
  50 )
  51   "List of potential actions that can be taken on headings.
  52
  53 When triggering an Org heading after receiving or sending a
  54 message, this option lists the possible actions to take. Built-in
  55 actions include:
  56
  57 todo state: Associate the message, and change TODO state.
  58 take note: Associate the message, and take a note.
  59 don't associate: Do nothing at all, don't connect the message and TODO.
  60 only associate: Associate the message with this heading, do nothing else.
  61 capture to child: [not yet implemented] Associate this message with a new child heading.
  62 capture to sibling: [not yet implemented] Associate this message with a new sibling heading.
  63
  64 You can reorder this list or remove items as suits your workflow.
  65 The two \"capture\" options will use the value of
  66 `gnorb-gnus-new-todo-capture-key' to find the appropriate
  67 template.
  68
  69 You can also add custom actions to the list. Actions should be a
  70 cons of a string tag and a symbol indicating a custom function.
  71 This function will be called on the heading in question, and
  72 passed a plist containing information about the message from
  73 which we're triggering."
  74   :group 'gnorb-org
  75   :type 'list)
  76
  77 (defcustom gnorb-org-msg-id-key "GNORB_MSG_ID"
  78   "The name of the org property used to store the Message-IDs
  79   from relevant messages. This is no longer used, and will be
  80   removed soon."
  81   :group 'gnorb-org
  82   :type 'string)
  83
  84 (defcustom gnorb-org-mail-scan-scope 2
  85   "Number of paragraphs to scan for mail-related links.
  86
  87 When handling a TODO heading with `gnorb-org-handle-mail', Gnorb
  88 will typically reply to the most recent message associated with
  89 this heading. If there are no such messages, or message tracking
  90 is disabled entirely, or `gnorb-org-handle-mail' has been called
  91 with a prefix arg, the heading and body text of the subtree under
  92 point will instead be scanned for gnus:, mailto:, and bbdb:
  93 links. This option controls how many paragraphs of body text to
  94 scan. Set to 0 to only look in the heading.")
  95
  96 (make-obsolete-variable
  97  'gnorb-org-mail-scan-strategies
  98  "This variable has been superseded by `gnorb-org-trigger-actions'"
  99  "September 12, 2014" 'set)
 100
 101 (make-obsolete-variable
 102  'gnorb-org-mail-scan-state-changes
 103  "This variable has been superseded by `gnorb-org-trigger-actions'"
 104  "September 12, 2014" 'set)
 105
 106 (make-obsolete-variable
 107  'gnorb-org-mail-scan-function
 108  "This variable has been superseded by `gnorb-org-trigger-actions'"
 109  "September 12, 2014" 'set)
 110
 111 (defcustom gnorb-org-find-candidates-match nil
 112   "When scanning all org files for heading related to an incoming
 113 message, this option will limit which headings will be offered as
 114 target candidates. Specifically it will be used as the second
 115 argument to `org-map-entries', and syntax is the same as that
 116 used in an agenda tags view."
 117   :group 'gnorb-org
 118   :type 'symbol)
 119
 120 ;;;###autoload
 121 (defun gnorb-org-contact-link (rec)
 122   "Prompt for a BBDB record and insert a link to that record at
 123 point.
 124
 125 There's really no reason to use this instead of regular old
 126 `org-insert-link' with BBDB completion. But there might be in the
 127 future!"
 128   ;; this needs to handle an active region.
 129   (interactive (list (gnorb-prompt-for-bbdb-record)))
 130   (let* ((name (bbdb-record-name rec))
 131          (link (concat "bbdb:" (org-link-escape name))))
 132     (org-store-link-props :type "bbdb" :name name
 133                           :link link :description name)
 134     (if (called-interactively-p 'any)
 135         (insert (format "[[%s][%s]]" link name))
 136       link)))
 137
 138 (defun gnorb-org-restore-after-send ()
 139   "After an email is sent, go through all the org ids that might
 140 have been in the outgoing message's headers and call
 141 `gnorb-trigger-todo-action' on each one, then put us back where
 142 we came from."
 143   (delete-other-windows)
 144   (dolist (id gnorb-message-org-ids)
 145     (org-id-goto id)
 146     (gnorb-trigger-todo-action nil id))
 147   ;; this is a little unnecessary, but it may save grief
 148   (setq gnorb-gnus-message-info nil)
 149   (setq gnorb-message-org-ids nil)
 150   (gnorb-restore-layout))
 151
 152 (defun gnorb-org-extract-links (&optional arg region)
 153   "See if there are viable links in the subtree under point."
 154   ;; We're not currently using the arg. What could we do with it?
 155   (let (strings)
 156     ;; If the region was active, only use the region
 157     (if region
 158         (push (buffer-substring (car region) (cdr region))
 159               strings)
 160       ;; Otherwise collect the heading text, and all the paragraph
 161       ;; text.
 162       (save-restriction
 163         (org-narrow-to-subtree)
 164         (let ((head (org-element-at-point))
 165               (tree (org-element-parse-buffer)))
 166           (push (org-element-property
 167                  :raw-value
 168                  head)
 169                 strings)
 170           (org-element-map tree 'paragraph
 171             (lambda (p)
 172               (push (org-element-interpret-data p)
 173                     strings))
 174             nil nil 'drawer))))
 175     (when strings
 176       ;; Limit number of paragraphs based on
 177       ;; `gnorb-org-mail-scan-scope'
 178       (setq strings
 179             (cond ((eq gnorb-org-mail-scan-scope 'all)
 180                    strings)
 181                   ((numberp gnorb-org-mail-scan-scope)
 182                    (delq nil
 183                          (cl-subseq
 184                           strings 0 (1+ gnorb-org-mail-scan-scope))))
 185                   ;; We could provide more options here. 'tree vs
 186                   ;; 'subtree, for instance.
 187                   (t
 188                    strings)))
 189       (with-temp-buffer
 190         (dolist (s strings)
 191           (insert s)
 192           (insert "\n"))
 193         (goto-char (point-min))
 194         (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb)))))
 195
 196 (defun gnorb-org-extract-mail-stuff (&optional arg region)
 197   "Decide how to hande the Org heading under point as an email task.
 198
 199 See the docstring of `gnorb-org-handle-mail' for details."
 200   (if (or (not gnorb-tracking-enabled)
 201           region)
 202       (gnorb-org-extract-links arg region)
 203     ;; Get all the messages associated with the IDS in this subtree.
 204     (let ((assoc-msg-ids
 205            (delete-dups
 206             (cl-mapcan
 207              (lambda (id)
 208                (gnorb-registry-org-id-search id))
 209              (gnorb-collect-ids)))))
 210       (gnorb-org-extract-mail-tracking assoc-msg-ids arg region))))
 211
 212 (defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region)
 213
 214   (let* ((all-links (gnorb-org-extract-links nil region))
 215          ;; The latest (by the creation-time registry key) of all the
 216          ;; tracked messages that were not sent by our user.
 217          (latest-msg-id
 218           (when assoc-msg-ids
 219             (car
 220              (sort
 221               (cl-remove-if
 222                (lambda (m)
 223                  (let ((from (car (gnus-registry-get-id-key m 'sender))))
 224                    (or (null from)
 225                        (string-match-p
 226                         user-mail-address from)
 227                        (string-match-p
 228                         message-alternative-emails from))))
 229                assoc-msg-ids)
 230               (lambda (r l)
 231                 (time-less-p
 232                  (car (gnus-registry-get-id-key l 'creation-time))
 233                  (car (gnus-registry-get-id-key r 'creation-time))))))))
 234          (msg-id-link
 235           (when latest-msg-id
 236             (gnorb-msg-id-to-link latest-msg-id))))
 237     (cond
 238      ;; If there are no tracked messages, or the user has specifically
 239      ;; requested we ignore them with the prefix arg, just return the
 240      ;; found links in the subtree.
 241      ((or arg
 242           (null msg-id-link))
 243       all-links)
 244      ;; Otherwise ignore the other links in the subtree, and return
 245      ;; the latest message.
 246      (msg-id-link
 247       `(:gnus ,(list msg-id-link))))))
 248
 249 (defun gnorb-org-setup-message
 250     (&optional messages mails from cc bcc attachments text ids)
 251   "Common message setup routine for other gnorb-org commands.
 252 MESSAGES is a list of gnus links pointing to messages -- we
 253 currently only use the first of the list. MAILS is a list of
 254 email address strings suitable for inserting in the To header.
 255 ATTACHMENTS is a list of filenames to attach. TEXT is a string or
 256 buffer, which is inserted in the message body. IDS is one or more
 257 Org heading ids, associating the outgoing message with those
 258 headings."
 259   (require 'gnorb-gnus)
 260   (if (not messages)
 261       ;; Either compose new message...
 262       (compose-mail)
 263     ;; ...or follow link and start reply.
 264     (condition-case err
 265         (gnorb-reply-to-gnus-link (car messages))
 266       (error (gnorb-restore-layout)
 267              (signal (car err) (cdr err)))))
 268   ;; Add MAILS to message To header.
 269   (when mails
 270     (message-goto-to)
 271     (when messages
 272       (insert ", "))
 273     (insert (mapconcat 'identity mails ", ")))
 274   ;; Return us after message is sent.
 275   (add-to-list 'message-exit-actions
 276                'gnorb-org-restore-after-send t)
 277   ;; Set headers from MAIL_* properties (from, cc, and bcc).
 278   (cl-flet ((sh (h)
 279                 (when (cdr h)
 280                   (funcall (intern (format "message-goto-%s" (car h))))
 281                   (let ((message-beginning-of-line t)
 282                         (show-trailing-whitespace t))
 283                     (message-beginning-of-line)
 284                     (unless (bolp)
 285                       (kill-line))
 286                     (insert (cdr h))))))
 287     (dolist (h `((from . ,from) (cc . ,cc) (bcc . ,bcc)))
 288       (sh h)))
 289   ;; attach ATTACHMENTS
 290   (map-y-or-n-p
 291    (lambda (a) (format "Attach %s to outgoing message? "
 292                        (file-name-nondirectory a)))
 293    (lambda (a)
 294      (mml-attach-file a (mm-default-file-encoding a)
 295                       nil "attachment"))
 296    attachments
 297    '("file" "files" "attach"))
 298   ;; insert text, if any
 299   (when text
 300     (message-goto-body)
 301     (insert"\n")
 302     (if (bufferp text)
 303         (insert-buffer-substring text)
 304       (insert text)))
 305   ;; insert org ids, if any
 306   (when ids
 307     (unless (listp ids)
 308       (setq ids (list ids)))
 309     (save-excursion
 310       (save-restriction
 311         (message-narrow-to-headers)
 312         (dolist (i ids)
 313           (goto-char (point-at-bol))
 314           (open-line 1)
 315           ;; this function hardly does anything
 316           (message-insert-header
 317            (intern gnorb-mail-header) i)))))
 318   ;; put point somewhere reasonable
 319   (if (or mails messages)
 320       (if (not messages)
 321           (message-goto-subject)
 322         (message-goto-body))
 323     (message-goto-to))
 324   (run-hooks 'gnorb-org-after-message-setup-hook))
 325
 326 (defun gnorb-org-attachment-list (&optional id)
 327   "Get a list of files (absolute filenames) attached to the
 328 current heading, or the heading indicated by optional argument ID."
 329   (when (featurep 'org-attach)
 330     (let* ((attach-dir (save-excursion
 331                          (when id
 332                            (org-id-goto id))
 333                          (org-attach-dir t)))
 334            (files
 335             (mapcar
 336              (lambda (f)
 337                (expand-file-name f attach-dir))
 338              (org-attach-file-list attach-dir))))
 339       files)))
 340
 341 ;;;###autoload
 342 (defun gnorb-org-handle-mail (&optional arg text file)
 343   "Handle current headline as a mail TODO.
 344
 345 How this function behaves depends on whether you're using Gnorb
 346 for email tracking, also on the prefix arg, and on the active
 347 region.
 348
 349 If tracking is enabled and there is no prefix arg, Gnorb will
 350 begin a reply to the newest associated message that wasn't sent
 351 by the user -- ie, the Sender header doesn't match
 352 `user-mail-address' or `message-alternative-emails'.
 353
 354 If tracking is enabled and there is a prefix arg, ignore the
 355 tracked messages and instead scan the subtree for mail-related
 356 links. This means links prefixed with gnus:, mailto:, or bbdb:.
 357 See `gnorb-org-mail-scan-scope' to limit the scope of this scan.
 358 Do something appropriate with the resulting links.
 359
 360 With a double prefix arg, ignore all tracked messages and all
 361 links, and compose a blank new message.
 362
 363 If tracking is enabled and you want to reply to a
 364 specific (earlier) message in the tracking history, use
 365 `gnorb-org-view' to open an nnir *Summary* buffer containing all
 366 the messages, and reply to the one you want. Your reply will be
 367 automatically tracked, as well.
 368
 369 If tracking is not enabled and you want to use a specific link in
 370 the subtree as a basis for the email action, then put the region
 371 around that link before you call this message."
 372   (interactive "P")
 373   (setq gnorb-window-conf (current-window-configuration))
 374   (move-marker gnorb-return-marker (point))
 375   (when (eq major-mode 'org-agenda-mode)
 376     ;; If this is all the different types, we could skip the check.
 377     (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
 378     (org-agenda-check-no-diary)
 379     (let* ((marker (or (org-get-at-bol 'org-hd-marker)
 380                        (org-agenda-error)))
 381            (buffer (marker-buffer marker))
 382            (pos (marker-position marker)))
 383       (switch-to-buffer buffer)
 384       (widen)
 385       (goto-char pos)))
 386   (let ((region
 387          (when (use-region-p)
 388            (cons (region-beginning) (region-end)))))
 389     (deactivate-mark)
 390     (save-excursion
 391       (unless (org-back-to-heading t)
 392         (error "Not in an org item"))
 393       (cl-flet ((mp (p) (org-entry-get (point) p t)))
 394         ;; Double prefix means ignore everything and compose a blank
 395         ;; mail.
 396         (let* ((links (unless (equal arg '(16))
 397                         (gnorb-org-extract-mail-stuff arg region)))
 398                (attachments (gnorb-org-attachment-list))
 399                (from (mp "MAIL_FROM"))
 400                (cc (mp "MAIL_CC"))
 401                (bcc (mp "MAIL_BCC"))
 402                (org-id (org-id-get-create))
 403                (recs (plist-get links :bbdb))
 404                (message-mode-hook (copy-sequence message-mode-hook))
 405                mails)
 406           (when file
 407             (cons file attachments))
 408           (when recs
 409             (setq recs
 410                   (delq nil
 411                         (mapcar
 412                          (lambda (r)
 413                            (car (bbdb-message-search
 414                                  (org-link-unescape r)
 415                                  nil)))
 416                          recs))))
 417           (when recs
 418             (dolist (r recs)
 419               (push (bbdb-mail-address r) mails)))
 420           (when (and recs
 421                      gnorb-bbdb-posting-styles)
 422             (add-hook 'message-mode-hook
 423                       (lambda ()
 424                         (gnorb-bbdb-configure-posting-styles (cdr recs))
 425                         (gnorb-bbdb-configure-posting-styles (list (car recs))))))
 426           (gnorb-org-setup-message
 427            (plist-get links :gnus)
 428            (append mails (plist-get links :mail))
 429            from cc bcc
 430            attachments text org-id))))))
 431
 432 ;;; Email subtree
 433
 434 (defcustom gnorb-org-email-subtree-text-parameters nil
 435   "A plist of export parameters corresponding to the EXT-PLIST
 436   argument to the export functions, for use when exporting to
 437   text."
 438   :group 'gnorb-org
 439   :type 'boolean)
 440
 441 (defcustom gnorb-org-email-subtree-file-parameters nil
 442   "A plist of export parameters corresponding to the EXT-PLIST
 443   argument to the export functions, for use when exporting to a
 444   file."
 445   :group 'gnorb-org
 446   :type 'boolean)
 447
 448 (defcustom gnorb-org-email-subtree-text-options '(nil t nil t)
 449   "A list of ts and nils corresponding to Org's export options,
 450 to be used when exporting to text. The options, in order, are
 451 async, subtreep, visible-only, and body-only."
 452   :group 'gnorb-org
 453   :type 'list)
 454
 455 (defcustom gnorb-org-email-subtree-file-options '(nil t nil nil)
 456   "A list of ts and nils corresponding to Org's export options,
 457 to be used when exporting to a file. The options, in order, are
 458 async, subtreep, visible-only, and body-only."
 459   :group 'gnorb-org
 460   :type 'list)
 461
 462 (defcustom gnorb-org-export-extensions
 463   '((latex ".tex")
 464     (ascii ".txt")
 465     (html ".html")
 466     (org ".org")
 467     (icalendar ".ics")
 468     (man ".man")
 469     (md ".md")
 470     (odt ".odt") ; not really, though
 471     (texinfo ".texi")
 472     (beamer ".tex"))
 473   "Correspondence between export backends and their
 474 respective (usual) file extensions. Ugly way to do it, but what
 475 the hey..."
 476   :group 'gnorb-org)
 477
 478 ;;;###autoload
 479 (defun gnorb-org-email-subtree (&optional arg)
 480   "Call on a subtree to export it either to a text string or a file,
 481 then compose a mail message either with the exported text
 482 inserted into the message body, or the exported file attached to
 483 the message.
 484
 485 Export options default to the following: When exporting to a
 486 buffer: async = nil, subtreep = t, visible-only = nil, body-only
 487 = t. Options are the same for files, except body-only is set to
 488 nil. Customize `gnorb-org-email-subtree-text-options' and
 489 `gnorb-org-email-subtree-file-options', respectively.
 490
 491 Customize `gnorb-org-email-subtree-parameters' to your preferred
 492 default set of parameters."
 493   ;; I sure would have liked to use the built-in dispatch ui, but it's
 494   ;; got too much hard-coded stuff.
 495   (interactive "P")
 496   (org-back-to-heading t)
 497   (let* ((backend-string
 498           (org-completing-read
 499            "Export backend: "
 500            (mapcar (lambda (b)
 501                      (symbol-name (org-export-backend-name b)))
 502                    org-export--registered-backends) nil t))
 503          (backend-symbol (intern backend-string))
 504          (f-or-t (org-completing-read "Export as file or text? "
 505                                       '("file" "text") nil t))
 506          (org-export-show-temporary-export-buffer nil)
 507          (opts (if (equal f-or-t "text")
 508                    gnorb-org-email-subtree-text-options
 509                  gnorb-org-email-subtree-file-options))
 510          (result
 511           (if (equal f-or-t "text")
 512               (apply 'org-export-to-buffer
 513                      `(,backend-symbol
 514                        "*Gnorb Export*"
 515                        ,@opts
 516                        ,gnorb-org-email-subtree-text-parameters))
 517             (apply 'org-export-to-file
 518                    `(,backend-symbol
 519                      ,(org-export-output-file-name
 520                        (second (assoc backend-symbol gnorb-org-export-extensions))
 521                        t gnorb-tmp-dir)
 522                      ,@opts
 523                      ,gnorb-org-email-subtree-file-parameters))))
 524          text file)
 525     (setq gnorb-window-conf (current-window-configuration))
 526     (move-marker gnorb-return-marker (point))
 527     (if (bufferp result)
 528         (setq text result)
 529       (setq file result))
 530     (gnorb-org-handle-mail arg text file)))
 531
 532 (defcustom gnorb-org-capture-collect-link-p t
 533   "Should the capture process store a link to the gnus message or
 534   BBDB record under point, even if it's not part of the template?
 535   You'll probably end up needing it, anyway."
 536   :group 'gnorb-org)
 537
 538 (defun gnorb-org-capture-collect-link ()
 539   (when gnorb-org-capture-collect-link-p
 540     (let ((buf (org-capture-get :original-buffer)))
 541       (when buf
 542         (with-current-buffer buf
 543           (when (memq major-mode '(gnus-summary-mode
 544                                    gnus-article-mode
 545                                    bbdb-mode))
 546             (call-interactively 'org-store-link)))))))
 547
 548 (add-hook 'org-capture-mode-hook 'gnorb-org-capture-collect-link)
 549
 550 ;;; Agenda/BBDB popup stuff
 551
 552 (defcustom gnorb-org-agenda-popup-bbdb nil
 553   "Should Agenda tags search pop up a BBDB buffer with matching
 554   records?
 555
 556 Records are considered matching if they have an `org-tags' field
 557 matching the current Agenda search. The name of that field can be
 558 customized with `gnorb-bbdb-org-tag-field'."
 559   :group 'gnorb-org)
 560
 561 (defcustom gnorb-org-bbdb-popup-layout 'pop-up-multi-line
 562   "Default BBDB buffer layout for automatic Org Agenda display."
 563   :group 'gnorb-org
 564   :type '(choice (const one-line)
 565                  (const multi-line)
 566                  (const full-multi-line)
 567                  (symbol)))
 568
 569 ;;;###autoload
 570 (defun gnorb-org-popup-bbdb (&optional str)
 571   "In an `org-tags-view' Agenda buffer, pop up a BBDB buffer
 572 showing records whose `org-tags' field matches the current tags
 573 search."
 574   ;; I was hoping to use `org-make-tags-matcher' directly, then snag
 575   ;; the tagmatcher from the resulting value, but there doesn't seem
 576   ;; to be a reliable way of only getting the tag-related returns. But
 577   ;; I'd still like to use that function. So an ugly hack to first
 578   ;; remove non-tag contents from the query string, and then make a
 579   ;; new call to `org-make-tags-matcher'.
 580   (interactive)
 581   (require 'gnorb-bbdb)
 582   (let (recs)
 583     (cond ((and
 584             (and (eq major-mode 'org-agenda-mode)
 585                  (eq org-agenda-type 'tags))
 586             (or (called-interactively-p 'any)
 587                 gnorb-org-agenda-popup-bbdb))
 588            (let ((todo-only nil)
 589                  (str (or str org-agenda-query-string))
 590                  (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
 591                  or-terms term rest out-or acc tag-clause)
 592              (setq or-terms (org-split-string str "|"))
 593              (while (setq term (pop or-terms))
 594                (setq acc nil)
 595                (while (string-match re term)
 596                  (setq rest (substring term (match-end 0)))
 597                  (let ((sub-term (match-string 0 term)))
 598                    (unless (save-match-data ; this isn't a tag, don't want it
 599                              (string-match "\\([<>=]\\)" sub-term))
 600                      (push sub-term acc))
 601                    (setq term rest)))
 602                (push (mapconcat 'identity (nreverse acc) "") out-or))
 603              (setq str (mapconcat 'identity (nreverse out-or) "|"))
 604              (setq tag-clause (cdr (org-make-tags-matcher str)))
 605              (unless (equal str "")
 606                (setq recs
 607                      (cl-remove-if-not
 608                       (lambda (r)
 609                         (let ((rec-tags (bbdb-record-xfield
 610                                          r gnorb-bbdb-org-tag-field)))
 611                           (and rec-tags
 612                                (let ((tags-list (org-split-string rec-tags ":"))
 613                                      (case-fold-search t)
 614                                      (org-trust-scanner-tags t))
 615                                  (eval tag-clause)))))
 616                       (bbdb-records))))))
 617           ((eq major-mode 'org-mode)
 618            (save-excursion
 619              (org-back-to-heading)
 620              (let ((bound (org-element-property
 621                            :end (org-element-at-point)))
 622                    desc rec)
 623                (while (re-search-forward
 624                        org-bracket-link-analytic-regexp bound t)
 625                  (when (string-match-p "bbdb" (match-string 2))
 626                    (setq desc (match-string 5)
 627                          rec (bbdb-search (bbdb-records) desc desc desc)
 628                          recs (append recs rec))))))))
 629     (if recs
 630         (bbdb-display-records
 631          recs gnorb-org-bbdb-popup-layout)
 632       (when (get-buffer-window bbdb-buffer-name)
 633         (quit-window nil
 634                      (get-buffer-window bbdb-buffer-name)))
 635       (when (called-interactively-p 'any)
 636         (message "No relevant BBDB records")))))
 637
 638 (if (featurep 'gnorb-bbdb)
 639     (add-hook 'org-agenda-finalize-hook 'gnorb-org-popup-bbdb))
 640
 641 ;;; Groups from the gnorb gnus server backend
 642
 643 ;;;###autoload
 644 (defun gnorb-org-view ()
 645   "Search the subtree at point for links to gnus messages, and
 646 then show them in an ephemeral group, in gnus.
 647
 648 This won't work unless you've added a \"nngnorb\" server to
 649 your gnus select methods."
 650   ;; this should also work on the active region, if there is one.
 651   (interactive)
 652   (require 'gnorb-gnus)
 653   (setq gnorb-window-conf (current-window-configuration))
 654   (move-marker gnorb-return-marker (point))
 655   (when (eq major-mode 'org-agenda-mode)
 656     (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
 657     (org-agenda-check-no-diary)
 658     (let* ((marker (or (org-get-at-bol 'org-hd-marker)
 659                        (org-agenda-error)))
 660            (buffer (marker-buffer marker))
 661            (pos (marker-position marker)))
 662       (switch-to-buffer buffer)
 663       (goto-char pos)
 664       (org-reveal)))
 665   (let (id)
 666     (save-excursion
 667       (org-back-to-heading)
 668       (setq id (concat "id+" (org-id-get-create)))
 669       (gnorb-gnus-search-messages
 670        id
 671        `(when (and (window-configuration-p gnorb-window-conf)
 672                    gnorb-return-marker)
 673           (set-window-configuration gnorb-window-conf)
 674           (goto-char gnorb-return-marker))))))
 675
 676 (provide 'gnorb-org)
 677 ;;; gnorb-org.el ends here