├── .elpaignore ├── .gitignore ├── NEWS ├── README.org ├── dir ├── gnorb-bbdb.el ├── gnorb-gnus.el ├── gnorb-org.el ├── gnorb-registry.el ├── gnorb-utils.el ├── gnorb.el ├── gnorb.info ├── gnorb.org ├── gnorb.texi └── nngnorb.el /.elpaignore: -------------------------------------------------------------------------------- 1 | gnorb.org -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | notes.org 3 | gnorb-pkg.el 4 | gnorb-autoloads.el 5 | TAGS 6 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*- 2 | 3 | * Version 1.1.3 [2017-03-12 Sun] 4 | ** Provide a better interface for trigger action selection 5 | New function `gnorb-select-from-list' providing a nicer interface for 6 | choosing items from a list. 7 | ** Change to format of gnorb-org-trigger-actions 8 | Due to previous item, this custom option has changed format, see 9 | docstring for details. 10 | ** Compatibility with newest BBDB 11 | Updates to match newest version of BBDB in package repos (mostly with 12 | regard to displaying multi-line field values, BBDB is now 13 | lexically bound). 14 | ** Many compiler fixes, and lexical binding 15 | Move to lexical binding. 16 | * Version 1.1.0 [2015-04-23 Thu] 17 | ** New trigger actions 18 | Two new trigger actions allow you to capture a new sibling or child 19 | heading relative to the heading you're triggering. 20 | ** Persistent Gnorb groups 21 | Give a prefix argument to `gnorb-org-view' to create a named, 22 | persistent group containing tracked headings. 23 | ** Gnorb registry usage reports 24 | Call `gnorb-report-tracking-usage' to see how much of the Gnus 25 | registry Gnorb is occupying, and run cleaning routines. 26 | * Version 1.0.1 [2014-10-22 Wed] 27 | ** Deleting associations 28 | It's now possible to delete associations between messages and 29 | headings; the user is also prompted to do this at a few points. 30 | ** Link following 31 | Following links to messages is a little more clever, and will re-use 32 | existing windows/frames when possible. 33 | ** Cleanups/Bugfixes 34 | Proper autoloads, addressing compiler warnings, better chain of 35 | requires, bugfixes. 36 | * Version 1 [2014-10-07 Tue] 37 | ** First Elpa Version 38 | ** Email Tracking 39 | The mechanism for email tracking has changed since Gnorb was made 40 | available on Elpa. See the manual for set-up instructions. 41 | ** Directory Structure 42 | The directory structure has changed since Gnorb was made available on 43 | Elpa. There is no longer a lisp/ directory -- all *.el files are now 44 | at the top level. 45 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * Gnorb 2 | 3 | Glue code between the Gnus, Org, and BBDB packages for Emacs. 4 | 5 | This package connects Emacs-based email, project management, and 6 | contact management a little more closely together. The goal is to 7 | reduce friction when manipulating TODOs, contacts, messages, and 8 | files. 9 | 10 | Probably the most interesting thing Gnorb does is tracking 11 | correspondences between Gnus email messages and Org headings. Rather 12 | than "turning your inbox into a TODO list", as some software puts it, 13 | Gnorb (kind of) does the opposite: turning your TODO headings into 14 | mini mailboxes. 15 | 16 | *NOTE*: Development of this package has moved to the [[http://elpa.gnu.org/packages/gnorb.html][Elpa repository]] 17 | as of March 2017, and the code here will no longer be updated. You're 18 | still welcome to open issues here, though pull requests won't work, 19 | obviously. You can also call `report-emacs-bug' from within emacs. If 20 | it prompts for a package, enter "gnorb". If it doesn't, please cc the 21 | report to eric@ericabrahamsen.net. 22 | -------------------------------------------------------------------------------- /dir: -------------------------------------------------------------------------------- 1 | This is the file .../info/dir, which contains the 2 | topmost node of the Info hierarchy, called (dir)Top. 3 | The first time you invoke Info you start off looking at this node. 4 |  5 | File: dir, Node: Top This is the top of the INFO tree 6 | 7 | This (the Directory node) gives a menu of major topics. 8 | Typing "q" exits, "?" lists all Info commands, "d" returns here, 9 | "h" gives a primer for first-timers, 10 | "mEmacs" visits the Emacs manual, etc. 11 | 12 | In Emacs, you can click mouse button 2 on a menu item or cross reference 13 | to select it. 14 | 15 | * Menu: 16 | 17 | Emacs 18 | * Gnorb: (gnorb). Glue code for Gnus, Org, and BBDB. 19 | -------------------------------------------------------------------------------- /gnorb-bbdb.el: -------------------------------------------------------------------------------- 1 | ;;; gnorb-bbdb.el --- The BBDB-centric functions of gnorb -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 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 . 20 | 21 | ;;; Commentary: 22 | 23 | ;; The Gnorb package has no hard dependency on BBDB, so you'll have to 24 | ;; install it manually. Gnorb is compatible with whichever version of 25 | ;; BBDB is current in the Emacs package manager. I believe it comes 26 | ;; from Melpa. 27 | 28 | ;;; Code: 29 | 30 | (require 'bbdb) 31 | (require 'bbdb-com) 32 | (require 'bbdb-mua) 33 | (require 'gnorb-utils) 34 | (require 'cl-lib) 35 | 36 | (defgroup gnorb-bbdb nil 37 | "The BBDB bits of gnorb." 38 | :tag "Gnorb BBDB" 39 | :group 'gnorb) 40 | 41 | (defcustom gnorb-bbdb-org-tag-field 'org-tags 42 | "The name (as a symbol) of the field to use for org tags." 43 | :group 'gnorb-bbdb 44 | :type 'symbol) 45 | 46 | (when (boundp 'bbdb-separator-alist) ;Allow compilation if BBDB is absent! 47 | (unless (assoc gnorb-bbdb-org-tag-field bbdb-separator-alist) 48 | (push `(,gnorb-bbdb-org-tag-field ":" ":") bbdb-separator-alist))) 49 | 50 | (defcustom gnorb-bbdb-messages-field 'messages 51 | "The name (as a symbol) of the field where links to recent gnus 52 | messages from this record are stored. 53 | 54 | \\Records that do not have this field defined 55 | will not collect links to messages: you have to call 56 | \"\\[gnorb-bbdb-open-link]\" on the record once -- after that, 57 | message links will be collected and updated automatically." 58 | :group 'gnorb-bbdb 59 | :type 'symbol) 60 | 61 | (defcustom gnorb-bbdb-collect-N-messages 5 62 | "For records with a `gnorb-bbdb-messages-field' defined, 63 | collect links to a maximum of this many messages." 64 | :group 'gnorb-bbdb 65 | :type 'integer) 66 | 67 | (defcustom gnorb-bbdb-define-recent 'seen 68 | "For records with a `gnorb-bbdb-message-tag-field' defined, 69 | this variable controls how gnorb defines a \"recent\" message. 70 | Setting it to the symbol seen will collect the messages most 71 | recently opened and viewed. The symbol received means gnorb will 72 | collect the most recent messages by Date header. 73 | 74 | In other words, if this variable is set to 'received, and a 75 | record's messages field is already full of recently-received 76 | messages, opening a five-year-old message (for instance) from 77 | this record will not push a link to the message into the field." 78 | :group 'gnorb-bbdb 79 | :type '(choice (const :tag "Most recently seen" 'seen) 80 | (const :tag "Most recently received" 'received))) 81 | 82 | (defcustom gnorb-bbdb-message-link-format-multi "%:count. %D: %:subject" 83 | "How a single message is formatted in the list of recent messages. 84 | This format string is used in multi-line record display. 85 | 86 | Available information for each message includes the subject, the 87 | date, and the message's count in the list, as an integer. You can 88 | access subject and count using the %:subject and %:count escapes. 89 | The message date can be formatted using any of the escapes 90 | mentioned in the docstring of `format-time-string', which see." 91 | :group 'gnorb-bbdb 92 | :type 'string) 93 | 94 | (defcustom gnorb-bbdb-message-link-format-one "%:count" 95 | "How a single message is formatted in the list of recent messages. 96 | This format string is used in single-line display -- note that by 97 | default, no user-created xfields are displayed in the 'one-line 98 | layout found in `bbdb-layout-alist'. If you want this field to 99 | appear there, put its name in the \"order\" list of the 'one-line 100 | layout. 101 | 102 | Available information for each message includes the subject, the 103 | date, and the message's count in the list, as an integer. You can 104 | access subject and count using the %:subject and %:count escapes. 105 | The message date can be formatted using any of the escapes 106 | mentioned in the docstring of `format-time-string', which see." 107 | :group 'gnorb-bbdb 108 | :type 'string) 109 | 110 | (defface gnorb-bbdb-link '((t :inherit org-link)) 111 | "Custom face for displaying message links in the *BBDB* buffer. 112 | Defaults to org-link." 113 | :group 'gnorb-bbdb) 114 | 115 | (cl-defstruct gnorb-bbdb-link 116 | subject date group id) 117 | 118 | (defcustom gnorb-bbdb-posting-styles nil 119 | "An alist of styles to use when composing messages to the BBDB 120 | record(s) under point. This is entirely analogous to 121 | `gnus-posting-styles', it simply works by examining record fields 122 | rather than group names. 123 | 124 | When composing a message to multiple contacts (using the \"*\" 125 | prefix), the records will be scanned in order, with the record 126 | initially under point (if any) set aside for last. That means 127 | that, in the case of conflicting styles, the record under point 128 | will override the others. 129 | 130 | In order not to be too intrusive, this option has no effect on 131 | the usual `bbdb-mail' command. Instead, the wrapper command 132 | `gnorb-bbdb-mail' is provided, which consults this option and 133 | then hands off to `bbdb-compose-mail'. If you'd always like to 134 | use `gnorb-bbdb-mail', you can simply bind it to \"m\" in the 135 | `bbdb-mode-map'. 136 | 137 | The value of the option should be a list of sexps, each one 138 | matching a single field. The first element should match a field 139 | name: one of the built-in fields like lastname, or an xfield. 140 | Field names should be given as symbols. 141 | 142 | The second element is a regexp used to match against the value of 143 | the field (non-string field values will be cast to strings, if 144 | possible). It can also be a cons of two strings, the first of 145 | which matches the field label, the second the field value. 146 | 147 | Alternately, the first element can be the name of a custom 148 | function that is called with the record as its only argument, and 149 | returns either t or nil. In this case, the second element of the 150 | list is disregarded. 151 | 152 | All following elements should be field setters for the message to 153 | be composed, just as in `gnus-posting-styles'." 154 | 155 | :group 'gnorb-bbdb 156 | :type 'list) 157 | 158 | (when (fboundp 'bbdb-record-xfield-string) 159 | (fset (intern (format "bbdb-read-xfield-%s" 160 | gnorb-bbdb-org-tag-field)) 161 | (lambda (&optional init) 162 | (gnorb-bbdb-read-org-tags init))) 163 | 164 | (fset (intern (format "bbdb-display-%s-multi-line" 165 | gnorb-bbdb-org-tag-field)) 166 | (lambda (record indent) 167 | (gnorb-bbdb-display-org-tags record indent)))) 168 | 169 | (defun gnorb-bbdb-read-org-tags (&optional init) 170 | "Read Org mode tags, with `completing-read-multiple'." 171 | (if (string< "24.3" (substring emacs-version 0 4)) 172 | (let ((crm-separator 173 | (concat "[ \t\n]*" 174 | (cadr (assq gnorb-bbdb-org-tag-field 175 | bbdb-separator-alist)) 176 | "[ \t\n]*")) 177 | (crm-local-completion-map bbdb-crm-local-completion-map) 178 | (table (cl-mapcar #'car 179 | (org-global-tags-completion-table 180 | (org-agenda-files)))) 181 | (init (if (consp init) 182 | (apply #'bbdb-concat (nth 2 (assq gnorb-bbdb-org-tag-field 183 | bbdb-separator-alist)) 184 | init) 185 | init))) 186 | (completing-read-multiple 187 | "Tags: " table 188 | nil nil init)) 189 | (bbdb-split gnorb-bbdb-org-tag-field 190 | (bbdb-read-string "Tags: " init)))) 191 | 192 | (defun gnorb-bbdb-display-org-tags (record indent) 193 | "Display the Org tags associated with the record. 194 | 195 | Org tags are stored in the `gnorb-bbdb-org-tags-field'." 196 | (let ((full-field (assq gnorb-bbdb-org-tag-field 197 | (bbdb-record-xfields record))) 198 | (val (bbdb-record-xfield 199 | record 200 | gnorb-bbdb-org-tag-field))) 201 | (when val 202 | (bbdb-display-text (format (format " %%%ds: " (- indent 3)) 203 | gnorb-bbdb-org-tag-field) 204 | `(xfields ,full-field field-label) 205 | 'bbdb-field-name) 206 | (if (consp val) 207 | (bbdb-display-list val gnorb-bbdb-org-tag-field "\n") 208 | (insert 209 | (bbdb-indent-string (concat val "\n") indent)))))) 210 | 211 | (defvar message-mode-hook) 212 | 213 | ;;;###autoload 214 | (defun gnorb-bbdb-mail (records &optional subject n verbose) 215 | "\\Acts just like `bbdb-mail', except runs 216 | RECORDS through `gnorb-bbdb-posting-styles', allowing 217 | customization of message styles for certain records. From the 218 | `bbdb-mail' docstring: 219 | 220 | Compose a mail message to RECORDS (optional: using SUBJECT). 221 | Interactively, use BBDB prefix \\[bbdb-do-all-records], see 222 | `bbdb-do-all-records'. By default, the first mail addresses of 223 | RECORDS are used. If prefix N is a number, use Nth mail address 224 | of RECORDS (starting from 1). If prefix N is C-u (t 225 | noninteractively) use all mail addresses of RECORDS. If VERBOSE 226 | is non-nil (as in interactive calls) be verbose." 227 | ;; see the function `gnus-configure-posting-styles' for tips on how 228 | ;; to actually do this. 229 | (interactive (list (bbdb-do-records) nil 230 | (or (consp current-prefix-arg) 231 | current-prefix-arg) 232 | t)) 233 | (setq records (bbdb-record-list records)) 234 | (if (not records) 235 | (user-error "No records displayed") 236 | (let ((head (bbdb-current-record)) 237 | (to (bbdb-mail-address records n nil verbose)) 238 | (message-mode-hook (copy-sequence message-mode-hook))) 239 | (setq records (remove head records)) 240 | (when gnorb-bbdb-posting-styles 241 | (add-hook 'message-mode-hook 242 | `(lambda () 243 | (gnorb-bbdb-configure-posting-styles (quote ,records)) 244 | (gnorb-bbdb-configure-posting-styles (list ,head))))) 245 | (bbdb-compose-mail to subject)))) 246 | 247 | (defun gnorb-bbdb-configure-posting-styles (recs) 248 | ;; My most magnificent work of copy pasta! 249 | (dolist (r recs) 250 | (let (field val label rec-val filep 251 | element v value results name address) 252 | (dolist (style gnorb-bbdb-posting-styles) 253 | (setq field (pop style) 254 | val (pop style)) 255 | (when (consp val) ;; (label value) 256 | (setq label (pop val) 257 | val (pop val))) 258 | (unless (fboundp field) 259 | ;; what's the record's existing value for this field? 260 | (setq rec-val (bbdb-record-field r field))) 261 | (when (catch 'match 262 | (cond 263 | ((eq field 'address) 264 | (dolist (a rec-val) 265 | (unless (and label 266 | (not (string-match label (car a)))) 267 | (when 268 | (string-match-p 269 | val 270 | (bbdb-format-address-default a)) 271 | (throw 'match t))))) 272 | ((eq field 'phone) 273 | (dolist (p rec-val) 274 | (unless (and label 275 | (not (string-match label (car p)))) 276 | (when 277 | (string-match-p val (bbdb-phone-string p)) 278 | (throw 'match t))))) 279 | ((consp rec-val) 280 | (dolist (f rec-val) 281 | (when (string-match-p val f) 282 | (throw 'match t)))) 283 | ((fboundp field) 284 | (when (string-match-p (funcall field r)) 285 | (throw 'match t))) 286 | ((stringp rec-val) 287 | (when (string-match-p val rec-val) 288 | (throw 'match t))))) 289 | ;; there are matches, run through the field setters in last 290 | ;; element of the sexp 291 | (dolist (attribute style) 292 | (setq element (pop attribute) 293 | filep nil) 294 | (setq value 295 | (cond 296 | ((eq (car attribute) :file) 297 | (setq filep t) 298 | (cadr attribute)) 299 | ((eq (car attribute) :value) 300 | (cadr attribute)) 301 | (t 302 | (car attribute)))) 303 | ;; We get the value. 304 | (setq v 305 | (cond 306 | ((stringp value) 307 | value) 308 | ((or (symbolp value) 309 | (functionp value)) 310 | (cond ((functionp value) 311 | (funcall value)) 312 | ((boundp value) 313 | (symbol-value value)))) 314 | ((listp value) 315 | (eval value)))) 316 | ;; Post-processing for the signature posting-style: 317 | (and (eq element 'signature) filep 318 | message-signature-directory 319 | ;; don't actually use the signature directory 320 | ;; if message-signature-file contains a path. 321 | (not (file-name-directory v)) 322 | (setq v (nnheader-concat message-signature-directory v))) 323 | ;; Get the contents of file elems. 324 | (when (and filep v) 325 | (setq v (with-temp-buffer 326 | (insert-file-contents v) 327 | (buffer-substring 328 | (point-min) 329 | (progn 330 | (goto-char (point-max)) 331 | (if (zerop (skip-chars-backward "\n")) 332 | (point) 333 | (1+ (point)))))))) 334 | (setq results (delq (assoc element results) results)) 335 | (push (cons element v) results)))) 336 | (setq name (assq 'name results) 337 | address (assq 'address results)) 338 | (setq results (delq name (delq address results))) 339 | (setq results (sort results (lambda (x y) 340 | (string-lessp (car x) (car y))))) 341 | (dolist (result results) 342 | (add-hook 'message-setup-hook 343 | (cond 344 | ((eq 'eval (car result)) 345 | 'ignore) 346 | ((eq 'body (car result)) 347 | `(lambda () 348 | (save-excursion 349 | (message-goto-body) 350 | (insert ,(cdr result))))) 351 | ((eq 'signature (car result)) 352 | (set (make-local-variable 'message-signature) nil) 353 | (set (make-local-variable 'message-signature-file) nil) 354 | (if (not (cdr result)) 355 | 'ignore 356 | `(lambda () 357 | (save-excursion 358 | (let ((message-signature ,(cdr result))) 359 | (when message-signature 360 | (message-insert-signature))))))) 361 | (t 362 | (let ((header 363 | (if (symbolp (car result)) 364 | (capitalize (symbol-name (car result))) 365 | (car result)))) 366 | `(lambda () 367 | (save-excursion 368 | (message-remove-header ,header) 369 | (let ((value ,(cdr result))) 370 | (when value 371 | (message-goto-eoh) 372 | (insert ,header ": " value) 373 | (unless (bolp) 374 | (insert "\n"))))))))) 375 | t 'local)) 376 | (when (or name address) 377 | (add-hook 'message-setup-hook 378 | `(lambda () 379 | (set (make-local-variable 'user-mail-address) 380 | ,(or (cdr address) user-mail-address)) 381 | (let ((user-full-name ,(or (cdr name) (user-full-name))) 382 | (user-mail-address 383 | ,(or (cdr address) user-mail-address))) 384 | (save-excursion 385 | (message-remove-header "From") 386 | (message-goto-eoh) 387 | (insert "From: " (message-make-from) "\n")))) 388 | t 'local))))) 389 | 390 | ;;;###autoload 391 | (defun gnorb-bbdb-tag-agenda (records) 392 | "Open an Org agenda tags view from the BBDB buffer, using the 393 | value of the record's org-tags field. This shows only TODOs by 394 | default; a prefix argument shows all tagged headings; a \"*\" 395 | prefix operates on all currently visible records. If you want 396 | both, use \"C-u\" before the \"*\"." 397 | (interactive (list (bbdb-do-records))) 398 | (require 'org-agenda) 399 | (unless (and (eq major-mode 'bbdb-mode) 400 | (equal (buffer-name) bbdb-buffer-name)) 401 | (error "Only works in the BBDB buffer")) 402 | (setq records (bbdb-record-list records)) 403 | (let ((tag-string 404 | (mapconcat 405 | 'identity 406 | (delete-dups 407 | (cl-mapcan 408 | (lambda (r) 409 | (bbdb-record-xfield-split r gnorb-bbdb-org-tag-field)) 410 | records)) 411 | "|"))) 412 | (if tag-string 413 | ;; C-u = all headings, not just todos 414 | (if (equal current-prefix-arg '(4)) 415 | (org-tags-view nil tag-string) 416 | (org-tags-view t tag-string)) 417 | (error "No org-tags field present")))) 418 | 419 | ;;;###autoload 420 | (defun gnorb-bbdb-mail-search (records) 421 | "Initiate a mail search from the BBDB buffer. 422 | 423 | Use the prefix arg to edit the search string first, and the \"*\" 424 | prefix to search mails from all visible contacts. When using both 425 | a prefix arg and \"*\", the prefix arg must come first." 426 | (interactive (list (bbdb-do-records))) 427 | (unless (and (eq major-mode 'bbdb-mode) 428 | (equal (buffer-name) bbdb-buffer-name)) 429 | (error "Only works in the BBDB buffer")) 430 | (setq records (bbdb-record-list records)) 431 | (require 'gnorb-gnus) 432 | (let* ((backend (or (assoc gnorb-gnus-mail-search-backend 433 | gnorb-gnus-mail-search-backends) 434 | (error "No search backend specified"))) 435 | (search-string 436 | (funcall (cl-second backend) 437 | (cl-mapcan 'bbdb-record-mail records)))) 438 | (when (equal current-prefix-arg '(4)) 439 | (setq search-string 440 | (read-from-minibuffer 441 | (format "%s search string: " (first backend)) search-string))) 442 | (funcall (cl-third backend) search-string) 443 | (delete-other-windows))) 444 | 445 | ;;;###autoload 446 | (defun gnorb-bbdb-cite-contact (rec) 447 | (interactive (list (bbdb-completing-read-record "Record: "))) 448 | (let ((mail-string (bbdb-dwim-mail rec))) 449 | (if (called-interactively-p 'any) 450 | (insert mail-string) 451 | mail-string))) 452 | 453 | ;;; Field containing links to recent messages 454 | (when (boundp 'bbdb-xfield-label-list) 455 | (add-to-list 'bbdb-xfield-label-list gnorb-bbdb-messages-field nil 'eq)) 456 | 457 | (defun gnorb-bbdb-display-messages (record format &optional indent) 458 | "Show links to the messages collected in the 459 | `gnorb-bbdb-messages-field' field of a BBDB record. Each link 460 | will be formatted using the format string in 461 | `gnorb-bbdb-message-link-format-multi' or 462 | `gnorb-bbdb-message-link-format-one', depending on the current 463 | layout type." 464 | (let ((full-field (assq gnorb-bbdb-messages-field 465 | (bbdb-record-xfields record))) 466 | (val (bbdb-record-xfield record gnorb-bbdb-messages-field)) 467 | (map (make-sparse-keymap)) 468 | (count 1)) ; one-indexed to fit with prefix arg to `gnorb-bbdb-open-link' 469 | (define-key map [mouse-1] 'gnorb-bbdb-mouse-open-link) 470 | (define-key map (kbd "") 'gnorb-bbdb-RET-open-link) 471 | (when val 472 | (when (eq format 'multi) 473 | (bbdb-display-text (format (format " %%%ds: " (- indent 3)) 474 | gnorb-bbdb-messages-field) 475 | `(xfields ,full-field field-label) 476 | 'bbdb-field-name)) 477 | (insert (cond ((and (stringp val) 478 | (eq format 'multi)) 479 | (bbdb-indent-string (concat val "\n") indent)) 480 | ((listp val) 481 | ;; Why aren't I using `bbdb-display-list' with a 482 | ;; preformatted list of messages? 483 | (concat 484 | (with-no-warnings ; For `indent' again 485 | (bbdb-indent-string 486 | (mapconcat 487 | (lambda (m) 488 | (prog1 489 | (org-propertize 490 | (concat 491 | (format-time-string 492 | (replace-regexp-in-string 493 | "%:subject" (gnorb-bbdb-link-subject m) 494 | (replace-regexp-in-string 495 | "%:count" (number-to-string count) 496 | (if (eq format 'multi) 497 | gnorb-bbdb-message-link-format-multi 498 | gnorb-bbdb-message-link-format-one))) 499 | (gnorb-bbdb-link-date m))) 500 | 'face 'gnorb-bbdb-link 501 | 'mouse-face 'highlight 502 | 'gnorb-bbdb-link-count count 503 | 'keymap map) 504 | (incf count))) 505 | val (if (eq format 'multi) 506 | "\n" ", ")) 507 | indent)) 508 | (if (eq format 'multi) "\n" ""))) 509 | (t 510 | "")))))) 511 | 512 | (fset (intern (format "bbdb-display-%s-multi-line" 513 | gnorb-bbdb-messages-field)) 514 | (lambda (record indent) 515 | (gnorb-bbdb-display-messages record 'multi indent))) 516 | 517 | (fset (intern (format "bbdb-display-%s-one-line" 518 | gnorb-bbdb-messages-field)) 519 | (lambda (record) 520 | (gnorb-bbdb-display-messages record 'one))) 521 | 522 | ;; Don't allow direct editing of this field 523 | 524 | (fset (intern (format "bbdb-read-xfield-%s" 525 | gnorb-bbdb-messages-field)) 526 | (lambda (&optional _init) 527 | (user-error "This field shouldn't be edited manually"))) 528 | 529 | ;; Open links from the *BBDB* buffer. 530 | 531 | ;;;###autoload 532 | (defun gnorb-bbdb-open-link (record arg) 533 | "\\Call this on a BBDB record to open one of the 534 | links in the message field. By default, the first link will be 535 | opened. Use a prefix arg to open different links. For instance, 536 | M-3 \\[gnorb-bbdb-open-link] will open the third link in the 537 | list. If the %:count escape is present in the message formatting 538 | string (see `gnorb-bbdb-message-link-format-multi' and 539 | `gnorb-bbdb-message-link-format-one'), that's the number to use. 540 | 541 | This function also needs to be called on a contact once before 542 | that contact will start collecting links to messages." 543 | (interactive (list 544 | (or (bbdb-current-record) 545 | (user-error "No record under point")) 546 | current-prefix-arg)) 547 | (unless (fboundp 'bbdb-record-xfield-string) 548 | (user-error "This function only works with the git version of BBDB")) 549 | (let (msg-list target-msg) 550 | (if (not (memq gnorb-bbdb-messages-field 551 | (mapcar 'car (bbdb-record-xfields record)))) 552 | (when (y-or-n-p 553 | (format "Start collecting message links for %s?" 554 | (bbdb-record-name record))) 555 | (bbdb-record-set-xfield record gnorb-bbdb-messages-field "no links yet") 556 | (message "Opening messages from %s will add links to the %s field" 557 | (bbdb-record-name record) 558 | gnorb-bbdb-messages-field) 559 | (bbdb-change-record record)) 560 | (setq msg-list 561 | (bbdb-record-xfield record gnorb-bbdb-messages-field)) 562 | (setq target-msg 563 | (or (and arg 564 | (nth (1- arg) msg-list)) 565 | (car msg-list))) 566 | (when target-msg 567 | (org-gnus-follow-link (gnorb-bbdb-link-group target-msg) 568 | (gnorb-bbdb-link-id target-msg)))))) 569 | 570 | (defun gnorb-bbdb-mouse-open-link (event) 571 | (interactive "e") 572 | (mouse-set-point event) 573 | (let ((rec (bbdb-current-record)) 574 | (num (get-text-property (point) 'gnorb-bbdb-link-count))) 575 | (if (not num) 576 | (user-error "No link under point") 577 | (gnorb-bbdb-open-link rec num)))) 578 | 579 | (defun gnorb-bbdb-RET-open-link () 580 | (interactive) 581 | (let ((rec (bbdb-current-record)) 582 | (num (get-text-property (point) 'gnorb-bbdb-link-count))) 583 | (if (not num) 584 | (user-error "No link under point") 585 | (gnorb-bbdb-open-link rec num)))) 586 | 587 | (defun gnorb-bbdb-store-message-link (record) 588 | "Used in the `bbdb-notice-record-hook' to possibly save a link 589 | to a message into the record's `gnorb-bbdb-messages-field'." 590 | 591 | (when (not (fboundp 'bbdb-record-xfield-string)) 592 | (user-error "This function only works with the git version of BBDB")) 593 | (unless (or (not (and (memq gnorb-bbdb-messages-field 594 | (mapcar 'car (bbdb-record-xfields record))) 595 | (memq major-mode '(gnus-summary-mode gnus-article-mode)))) 596 | (with-current-buffer gnus-article-buffer 597 | (not ; only store messages if the record is the sender 598 | (member (nth 1 (car (bbdb-get-address-components 'sender))) 599 | (bbdb-record-mail record))))) 600 | (with-current-buffer gnus-summary-buffer 601 | (let* ((val (bbdb-record-xfield record gnorb-bbdb-messages-field)) 602 | (art-no (gnus-summary-article-number)) 603 | (heads (gnus-summary-article-header art-no)) 604 | (date (apply 'encode-time 605 | (parse-time-string (mail-header-date heads)))) 606 | (subject (mail-header-subject heads)) 607 | (id (mail-header-id heads)) 608 | (group (gnorb-get-real-group-name 609 | gnus-newsgroup-name 610 | art-no)) 611 | link) 612 | (if (not (and date subject id group)) 613 | (message "Could not save a link to this message") 614 | (setq link (make-gnorb-bbdb-link :subject subject :date date 615 | :group group :id id)) 616 | (when (stringp val) 617 | (setq val nil)) 618 | (setq val (cons link (delete link val))) 619 | (when (eq gnorb-bbdb-define-recent 'received) 620 | (setq val (sort val 621 | (lambda (a b) 622 | (time-less-p 623 | (gnorb-bbdb-link-date b) 624 | (gnorb-bbdb-link-date a)))))) 625 | (setq val (cl-subseq val 0 (min (length val) gnorb-bbdb-collect-N-messages))) 626 | (bbdb-record-set-xfield record 627 | gnorb-bbdb-messages-field 628 | (delq nil val)) 629 | (bbdb-change-record record)))))) 630 | 631 | (add-hook 'bbdb-notice-record-hook 'gnorb-bbdb-store-message-link) 632 | 633 | (provide 'gnorb-bbdb) 634 | ;;; gnorb-bbdb.el ends here 635 | -------------------------------------------------------------------------------- /gnorb-gnus.el: -------------------------------------------------------------------------------- 1 | ;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 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 . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'gnus) 28 | (require 'gnus-sum) 29 | (require 'gnus-art) 30 | (require 'message) 31 | (require 'org) 32 | (require 'org-attach) 33 | (require 'org-capture) 34 | (require 'gnorb-utils) 35 | (require 'mm-decode) 36 | 37 | (declare-function org-gnus-article-link "org-gnus" 38 | (group newsgroups message-id x-no-archive)) 39 | (declare-function org-gnus-follow-link "org-gnus" 40 | (group article)) 41 | 42 | (defvar org-refile-targets) 43 | 44 | (defgroup gnorb-gnus nil 45 | "The Gnus bits of Gnorb." 46 | :tag "Gnorb Gnus" 47 | :group 'gnorb) 48 | 49 | 50 | (defcustom gnorb-gnus-mail-search-backends 51 | '((notmuch (lambda (terms) 52 | (mapconcat 53 | (lambda (m) 54 | (replace-regexp-in-string "\\." "\\\\." m)) 55 | terms " OR ")) 56 | notmuch-search) 57 | (mairix (lambda (terms) 58 | (mapconcat 'identity 59 | terms ",")) 60 | mairix-search) 61 | (namazu (lambda (terms) 62 | (mapconcat 'identity 63 | terms " or ")) 64 | namazu-search)) 65 | "Various backends for mail search. 66 | 67 | An alist of backends, where each element consists of three parts: 68 | the symbol name of the backend, a lambda form which receives a 69 | list of email addresses and returns a properly-formatted search 70 | string, and the symbol name of the function used to initiate the 71 | search." 72 | :group 'gnorb-gnus 73 | :type 'list) 74 | 75 | (defcustom gnorb-gnus-mail-search-backend nil 76 | "Mail search backend currently in use. One of the three symbols 77 | notmuch, namazu, or mairix." 78 | :group 'gnorb-gnus 79 | :type 'symbol) 80 | 81 | (defcustom gnorb-gnus-capture-always-attach nil 82 | "Always prompt about attaching attachments when capturing from 83 | a Gnus message, even if the template being used hasn't 84 | specified the :gnus-attachments key. 85 | 86 | Basically behave as if all attachments have \":gnus-attachments t\"." 87 | :group 'gnorb-gnus 88 | :type 'boolean) 89 | 90 | (defcustom gnorb-gnus-new-todo-capture-key nil 91 | "Key for the capture template to use when creating a new TODO 92 | from an outgoing message." 93 | :group 'gnorb-gnus 94 | :type 'string) 95 | 96 | (defcustom gnorb-gnus-hint-relevant-article t 97 | "When opening a gnus message, should gnorb let you know if the 98 | message is relevant to an existing TODO?" 99 | :group 'gnorb-gnus 100 | :type 'boolean) 101 | 102 | (defcustom gnorb-gnus-summary-mark-format-letter "g" 103 | "Format letter to be used as part of your 104 | `gnus-summary-line-format', to indicate in the *Summary* buffer 105 | which articles might be relevant to TODOs. Since this is a user 106 | format code, it should be prefixed with %u, eg %ug. It will 107 | result in the insertion of the value of 108 | `gnorb-gnus-summary-mark', for relevant messages, or 109 | else a space." 110 | :group 'gnorb-gnus 111 | :type 'string) 112 | 113 | (defcustom gnorb-gnus-summary-mark "¡" 114 | "Default mark to insert in the summary format line of articles 115 | that are likely relevant to existing TODO headings." 116 | :group 'gnorb-gnus 117 | :type 'string) 118 | 119 | (defcustom gnorb-gnus-summary-tracked-mark "&" 120 | "Default mark to insert in the summary format line of articles 121 | that are already tracked by TODO headings." 122 | :group 'gnorb-gnus 123 | :type 'string) 124 | 125 | (defcustom gnorb-gnus-trigger-refile-targets 126 | '((org-agenda-files :maxlevel . 4)) 127 | "A value to use as an equivalent of `org-refile-targets' (which 128 | see) when offering trigger targets for 129 | `gnorb-gnus-incoming-do-todo'." 130 | :group 'gnorb-gnus 131 | :type 'list) 132 | 133 | (defcustom gnorb-gnus-sent-groups nil 134 | "A list of strings indicating sent mail groups. 135 | 136 | In some cases, Gnorb can't detect where your sent messages are 137 | stored (ie if you're using IMAP sent mail folders instead of 138 | local archiving. If you want Gnorb to be able to find sent 139 | messages, this option can help it do that. It should be set to a 140 | list of strings, which are assumed to be fully qualified 141 | server+group combinations, ie \"nnimap+Server:[Gmail]/Sent 142 | Mail\", or something similar. This only has to be done once for 143 | each message." 144 | :group 'gnorb-gnus 145 | :type 'list) 146 | 147 | (defvar gnorb-gnus-capture-attachments nil 148 | "Holding place for attachment names during the capture 149 | process.") 150 | 151 | ;;; What follows is a very careful copy-pasta of bits and pieces from 152 | ;;; mm-decode.el and gnus-art.el. Voodoo was involved. 153 | 154 | ;;;###autoload 155 | (defun gnorb-gnus-article-org-attach (n) 156 | "Save MIME part N, which is the numerical prefix, of the 157 | article under point as an attachment to the specified org 158 | heading." 159 | (interactive "P") 160 | (gnus-article-part-wrapper n 'gnorb-gnus-attach-part)) 161 | 162 | ;;;###autoload 163 | (defun gnorb-gnus-mime-org-attach () 164 | "Save the MIME part under point as an attachment to the 165 | specified org heading." 166 | (interactive) 167 | (gnus-article-check-buffer) 168 | (let ((data (get-text-property (point) 'gnus-data))) 169 | (when data 170 | (gnorb-gnus-attach-part data)))) 171 | 172 | (defun gnorb-gnus-attach-part (handle) 173 | "Attach HANDLE to an existing org heading." 174 | (let* ((filename (gnorb-gnus-save-part handle)) 175 | (org-refile-targets gnorb-gnus-trigger-refile-targets) 176 | (headers (gnus-data-header 177 | (gnus-data-find 178 | (gnus-summary-article-number)))) 179 | (tracked-headings (gnorb-find-tracked-headings headers)) 180 | (target-heading 181 | (gnorb-choose-trigger-heading tracked-headings))) 182 | (require 'org-attach) 183 | (save-window-excursion 184 | (org-id-goto target-heading) 185 | (org-attach-attach filename nil 'mv)))) 186 | 187 | (defun gnorb-gnus-save-part (handle) 188 | (let ((filename (or (mail-content-type-get 189 | (mm-handle-disposition handle) 'filename) 190 | (mail-content-type-get 191 | (mm-handle-type handle) 'name)))) 192 | (setq filename 193 | (gnus-map-function mm-file-name-rewrite-functions 194 | (file-name-nondirectory filename))) 195 | (setq filename (expand-file-name filename gnorb-tmp-dir)) 196 | (mm-save-part-to-file handle filename) 197 | filename)) 198 | 199 | (defun gnorb-gnus-collect-all-attachments (&optional capture-p store) 200 | "Collect all the attachments from the message under point, and 201 | save them into `gnorb-tmp-dir'." 202 | (save-window-excursion 203 | (when capture-p 204 | (set-buffer (org-capture-get :original-buffer))) 205 | (unless (memq major-mode '(gnus-summary-mode gnus-article-mode)) 206 | (error "Only works in Gnus summary or article buffers")) 207 | (let ((article (gnus-summary-article-number)) 208 | mime-handles) 209 | (when (or (null gnus-current-article) 210 | (null gnus-article-current) 211 | (/= article (cdr gnus-article-current)) 212 | (not (equal (car gnus-article-current) gnus-newsgroup-name))) 213 | (gnus-summary-display-article article)) 214 | (gnus-eval-in-buffer-window gnus-article-buffer 215 | (setq mime-handles (cl-remove-if-not 216 | (lambda (h) 217 | (let ((disp (mm-handle-disposition (cdr h)))) 218 | (and (member (car disp) 219 | '("inline" "attachment")) 220 | (mail-content-type-get disp 'filename)))) 221 | gnus-article-mime-handle-alist))) 222 | (when mime-handles 223 | (dolist (h mime-handles) 224 | (let ((filename 225 | (gnorb-gnus-save-part (cdr h)))) 226 | (when (or capture-p store) 227 | (push filename gnorb-gnus-capture-attachments)))))))) 228 | 229 | ;;; Make the above work in the capture process 230 | 231 | (defun gnorb-gnus-capture-attach () 232 | (when (and (or gnorb-gnus-capture-always-attach 233 | (org-capture-get :gnus-attachments)) 234 | (with-current-buffer 235 | (org-capture-get :original-buffer) 236 | (memq major-mode '(gnus-summary-mode gnus-article-mode)))) 237 | (require 'org-attach) 238 | (setq gnorb-gnus-capture-attachments nil) 239 | (gnorb-gnus-collect-all-attachments t) 240 | (map-y-or-n-p 241 | (lambda (a) 242 | (format "Attach %s to capture heading? " 243 | (file-name-nondirectory a))) 244 | (lambda (a) (org-attach-attach a nil 'mv)) 245 | gnorb-gnus-capture-attachments 246 | '("file" "files" "attach")) 247 | (setq gnorb-gnus-capture-attachments nil))) 248 | 249 | (add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach) 250 | 251 | (defvar org-note-abort) 252 | 253 | (defun gnorb-gnus-capture-abort-cleanup () 254 | (with-no-warnings ; For `org-note-abort' 255 | (when (and org-note-abort 256 | (or gnorb-gnus-capture-always-attach 257 | (org-capture-get :gnus-attachments))) 258 | (condition-case nil 259 | (progn (org-attach-delete-all) 260 | (setq abort-note 'clean) 261 | ;; remove any gnorb-mail-header values here 262 | ) 263 | (error 264 | (setq abort-note 'dirty)))))) 265 | 266 | (add-hook 'org-capture-prepare-finalize-hook 267 | 'gnorb-gnus-capture-abort-cleanup) 268 | 269 | ;;; Storing, removing, and acting on Org headers in messages. 270 | 271 | (defvar gnorb-gnus-message-info nil 272 | "Place to store the To, Subject, Date, and Message-ID headers 273 | of the currently-sending or last-sent message.") 274 | 275 | (defun gnorb-gnus-check-outgoing-headers () 276 | "Save the value of the `gnorb-mail-header' for the current 277 | message; multiple header values returned as a string. Also save 278 | information about the outgoing message into 279 | `gnorb-gnus-message-info'." 280 | (save-restriction 281 | (message-narrow-to-headers) 282 | (setq gnorb-gnus-message-info nil) 283 | (let* ((org-ids (mail-fetch-field gnorb-mail-header nil nil t)) 284 | (msg-id (mail-fetch-field "Message-ID")) 285 | (refs (mail-fetch-field "References")) 286 | (in-reply-to (mail-fetch-field "In-Reply-To")) 287 | (to (if (message-news-p) 288 | (mail-fetch-field "Newsgroups") 289 | (mail-fetch-field "To"))) 290 | (from (mail-fetch-field "From")) 291 | (subject (mail-fetch-field "Subject")) 292 | (date (mail-fetch-field "Date")) 293 | ;; If we can get a link, that's awesome. 294 | (gcc (mail-fetch-field "Gcc")) 295 | (link (or (and gcc 296 | (org-store-link nil)) 297 | nil)) 298 | (group (ignore-errors (car (split-string link "#"))))) 299 | ;; If we can't make a real link, then save some information so 300 | ;; we can fake it. 301 | (when in-reply-to 302 | (setq refs (concat refs " " in-reply-to))) 303 | (when refs 304 | (setq refs (gnus-extract-references refs))) 305 | (setq gnorb-gnus-message-info 306 | `(:subject ,subject :msg-id ,msg-id 307 | :to ,to :from ,from 308 | :link ,link :date ,date :refs ,refs 309 | :group ,group)) 310 | (if org-ids 311 | (progn 312 | (require 'gnorb-org) 313 | (setq gnorb-message-org-ids org-ids) 314 | ;; `gnorb-org-setup-message' may have put this here, but 315 | ;; if we're working from a draft, or triggering this from 316 | ;; a reply, it might not be there yet. 317 | (add-to-list 'message-send-actions 318 | 'gnorb-org-restore-after-send t)) 319 | (setq gnorb-message-org-ids nil))))) 320 | 321 | (add-hook 'message-sent-hook 'gnorb-gnus-check-outgoing-headers t) 322 | 323 | ;;;###autoload 324 | (defun gnorb-gnus-outgoing-do-todo (&optional arg) 325 | "Use this command to use the message currently being composed 326 | as an email todo action. 327 | 328 | If it's a new message, or a reply to a message that isn't 329 | referenced by any TODOs, a new TODO will be created. 330 | 331 | If it references an existing TODO, you'll be prompted to trigger 332 | a state-change or a note on that TODO after the message is sent. 333 | 334 | You can call it with a prefix arg to force choosing an Org 335 | subtree to associate with. 336 | 337 | If you've already called this command, but realize you made a 338 | mistake, you can call this command with a double prefix to reset 339 | the association. 340 | 341 | If a new todo is made, it needs a capture template: set 342 | `gnorb-gnus-new-todo-capture-key' to the string key for the 343 | appropriate capture template. If you're using a gnus-based 344 | archive method (ie you have `gnus-message-archive-group' set to 345 | something, and your outgoing messages have a \"Fcc\" header), 346 | then a real link will be made to the outgoing message, and all 347 | the gnus-type escapes will be available (see the Info 348 | manual (org) Template expansion section). If you don't, then the 349 | %:subject, %:to, %:toname, %:toaddress, and %:date escapes for 350 | the outgoing message will still be available -- nothing else will 351 | work." 352 | (interactive "P") 353 | (let ((org-refile-targets gnorb-gnus-trigger-refile-targets) 354 | (compose-marker (make-marker)) 355 | header-ids ref-ids rel-headings 356 | gnorb-window-conf in-reply-to) 357 | (when (equal arg '(4)) 358 | (setq rel-headings 359 | (org-refile-get-location "Trigger action on" nil t)) 360 | (setq rel-headings 361 | (list (list (save-window-excursion 362 | (find-file (nth 1 rel-headings)) 363 | (goto-char (nth 3 rel-headings)) 364 | (org-id-get-create)))))) 365 | (if (not (eq major-mode 'message-mode)) 366 | ;; The message is already sent, so we're relying on whatever was 367 | ;; stored into `gnorb-gnus-message-info'. 368 | (if (equal arg '(16)) 369 | (user-error "A double prefix is only useful with an 370 | unsent message.") 371 | (if arg 372 | (progn 373 | (push (car rel-headings) gnorb-message-org-ids) 374 | (gnorb-org-restore-after-send)) 375 | (setq ref-ids (plist-get gnorb-gnus-message-info :refs)) 376 | (if ref-ids 377 | ;; the message might be relevant to some TODO 378 | ;; heading(s). But if there had been org-id 379 | ;; headers, they would already have been 380 | ;; handled when the message was sent. 381 | (progn 382 | (setq rel-headings (gnorb-find-visit-candidates ref-ids)) 383 | (if (not rel-headings) 384 | (gnorb-gnus-outgoing-make-todo-1) 385 | (dolist (h rel-headings) 386 | (push h gnorb-message-org-ids)) 387 | (gnorb-org-restore-after-send))) 388 | ;; not relevant, just make a new TODO 389 | (gnorb-gnus-outgoing-make-todo-1)))) 390 | ;; We are still in the message composition buffer, so let's see 391 | ;; what we've got. 392 | 393 | (if (equal arg '(16)) 394 | ;; Double prefix arg means delete the association we already 395 | ;; made. 396 | (save-excursion 397 | (save-restriction 398 | (widen) 399 | (setq message-send-actions 400 | (remove 'gnorb-gnus-outgoing-make-todo-1 401 | message-send-actions)) 402 | (message-narrow-to-headers-or-head) 403 | (message-remove-header 404 | gnorb-mail-header) 405 | (message "Message associations have been reset"))) 406 | ;; Save-excursion won't work, because point will move if we 407 | ;; insert headings. 408 | (move-marker compose-marker (point)) 409 | (save-restriction 410 | (widen) 411 | (message-narrow-to-headers-or-head) 412 | (setq header-ids (mail-fetch-field gnorb-mail-header nil nil t)) 413 | ;; With a prefix arg we do not check references, because the 414 | ;; whole point is to add new references. We still want to know 415 | ;; what org id headers are present, though, so we don't add 416 | ;; duplicates. 417 | (setq ref-ids (unless arg (mail-fetch-field "References" t))) 418 | (setq in-reply-to (unless arg (mail-fetch-field "In-Reply-to" t))) 419 | (when in-reply-to 420 | (setq ref-ids (concat ref-ids " " in-reply-to))) 421 | (when ref-ids 422 | ;; if the References header points to any message ids that are 423 | ;; tracked by TODO headings... 424 | (setq rel-headings (gnorb-find-visit-candidates ref-ids))) 425 | (when rel-headings 426 | (goto-char (point-min)) 427 | (dolist (h (delete-dups rel-headings)) 428 | ;; then get the org-ids of those headings, and insert 429 | ;; them into this message as headers. If the id was 430 | ;; already present in a header, don't add it again. 431 | (unless (member h header-ids) 432 | (goto-char (point-at-bol)) 433 | (open-line 1) 434 | (message-insert-header 435 | (intern gnorb-mail-header) 436 | h) 437 | ;; tell the rest of the function that this is a relevant 438 | ;; message 439 | (push h header-ids))))) 440 | (goto-char compose-marker) 441 | (unless header-ids 442 | (add-to-list 'message-send-actions 443 | 'gnorb-gnus-outgoing-make-todo-1 t)) 444 | (message 445 | (if header-ids 446 | "Message will trigger TODO state-changes after sending" 447 | "A TODO will be made from this message after it's sent")))))) 448 | 449 | (defvar org-capture-link-is-already-stored) 450 | 451 | (defun gnorb-gnus-outgoing-make-todo-1 () 452 | (unless gnorb-gnus-new-todo-capture-key 453 | (error "No capture template key set, customize gnorb-gnus-new-todo-capture-key")) 454 | (let* ((link (plist-get gnorb-gnus-message-info :link)) 455 | (group (plist-get gnorb-gnus-message-info :group)) 456 | (date (plist-get gnorb-gnus-message-info :date)) 457 | (date-ts (and date 458 | (ignore-errors 459 | (format-time-string 460 | (org-time-stamp-format t) 461 | (date-to-time date))))) 462 | (date-ts-ia (and date 463 | (ignore-errors 464 | (format-time-string 465 | (org-time-stamp-format t t) 466 | (date-to-time date))))) 467 | (msg-id (plist-get gnorb-gnus-message-info :msg-id)) 468 | (sender (plist-get gnorb-gnus-message-info :from)) 469 | (subject (plist-get gnorb-gnus-message-info :subject)) 470 | ;; Convince Org we already have a link stored, even if we 471 | ;; don't. 472 | (org-capture-link-is-already-stored t)) 473 | (if link 474 | ;; Even if you make a link to not-yet-sent messages, even if 475 | ;; you've saved the draft and it has a Date header, that 476 | ;; header isn't saved into the link plist. So fake that, too. 477 | (org-add-link-props 478 | :date date 479 | :date-timestamp date-ts 480 | :date-timestamp-inactive date-ts-ia 481 | :annotation link) 482 | (org-store-link-props 483 | :subject (plist-get gnorb-gnus-message-info :subject) 484 | :to (plist-get gnorb-gnus-message-info :to) 485 | :date date 486 | :date-timestamp date-ts 487 | :date-timestamp-inactive date-ts-ia 488 | :message-id msg-id 489 | :annotation link)) 490 | (org-capture nil gnorb-gnus-new-todo-capture-key) 491 | (when msg-id 492 | (org-entry-put (point) gnorb-org-msg-id-key msg-id) 493 | (gnorb-registry-make-entry msg-id sender subject (org-id-get-create) group)))) 494 | 495 | ;;; If an incoming message should trigger state-change for a Org todo, 496 | ;;; call this function on it. 497 | 498 | ;;;###autoload 499 | (defun gnorb-gnus-incoming-do-todo (arg &optional id) 500 | "Call this function from a received gnus message to store a 501 | link to the message, prompt for a related Org heading, visit the 502 | heading, and trigger an action on it \(see 503 | `gnorb-org-trigger-actions'\). 504 | 505 | If you've set up message tracking \(with 506 | `gnorb-tracking-initialize'\), Gnorb can guess which Org heading 507 | you probably want to trigger, which can save some time. It does 508 | this by looking in the References header, and seeing if any of 509 | the messages referenced there are already being tracked by any 510 | headings. 511 | 512 | If you mark several messages before calling this function, or 513 | call it with a numerical prefix arg, those messages will be 514 | \"bulk associated\" with the chosen Org heading: associations 515 | will be made, but you won't be prompted to trigger an action, and 516 | you'll stay in the Gnus summary buffer." 517 | (interactive "P") 518 | (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode))) 519 | (user-error "Only works in gnus summary or article mode")) 520 | ;; We should only store a link if it's not already at the head of 521 | ;; `org-stored-links'. There's some duplicate storage, at 522 | ;; present. Take a look at calling it non-interactively. 523 | (setq gnorb-window-conf (current-window-configuration)) 524 | (move-marker gnorb-return-marker (point)) 525 | (setq gnorb-gnus-message-info nil) 526 | (let* ((articles (gnus-summary-work-articles arg)) 527 | (art-no (gnus-summary-article-number)) 528 | (headers (gnus-data-header 529 | (gnus-data-find art-no))) 530 | (msg-id (mail-header-id headers)) 531 | (from (mail-header-from headers)) 532 | (subject (mail-header-subject headers)) 533 | (date (mail-header-date headers)) 534 | (to (cdr (assoc 'To (mail-header-extra headers)))) 535 | (group (gnorb-get-real-group-name 536 | gnus-newsgroup-name 537 | art-no)) 538 | (link (call-interactively 'org-store-link)) 539 | (org-refile-targets gnorb-gnus-trigger-refile-targets) 540 | (ref-msg-ids (concat (mail-header-references headers) " " 541 | msg-id)) 542 | (related-headings 543 | (when (and (null id) ref-msg-ids) 544 | ;; Specifically ask for zombies, so the user has chance to 545 | ;; flush them out. 546 | (gnorb-find-tracked-headings headers t))) 547 | targ) 548 | (setq gnorb-gnus-message-info 549 | `(:subject ,subject :msg-id ,msg-id 550 | :to ,to :from ,from 551 | :link ,link :date ,date :refs ,ref-msg-ids 552 | :group ,group)) 553 | (gnorb-gnus-collect-all-attachments nil t) 554 | (condition-case err 555 | (if id 556 | (progn 557 | (delete-other-windows) 558 | (gnorb-trigger-todo-action nil id)) 559 | ;; Flush out zombies (dead associations). 560 | (setq related-headings 561 | (cl-remove-if 562 | (lambda (h) 563 | (when (null (org-id-find-id-file h)) 564 | (when (y-or-n-p 565 | (format 566 | "ID %s no longer exists, disassociate message?" 567 | h)) 568 | (gnorb-delete-association msg-id h)))) 569 | related-headings)) 570 | ;; See if one of the related headings is chosen. 571 | (unless (catch 'target 572 | (dolist (h related-headings nil) 573 | (when (yes-or-no-p 574 | (format "Trigger action on %s" 575 | (gnorb-pretty-outline h))) 576 | (throw 'target (setq targ h))))) 577 | ;; If not, use the refile interface to choose one. 578 | (setq targ (org-refile-get-location 579 | "Trigger heading" nil t)) 580 | (setq targ 581 | (save-window-excursion 582 | (find-file (nth 1 targ)) 583 | (goto-char (nth 3 targ)) 584 | (org-id-get-create)))) 585 | ;; Either bulk associate multiple messages... 586 | (if (> (length articles) 1) 587 | (progn 588 | (dolist (a articles) 589 | (gnorb-registry-make-entry 590 | (mail-header-id 591 | (gnus-data-header 592 | (gnus-data-find a))) 593 | from subject targ group) 594 | (gnus-summary-remove-process-mark a)) 595 | (message "Associated %d messages with %s" 596 | (length articles) (gnorb-pretty-outline targ))) 597 | ;; ...or just trigger the one. 598 | (delete-other-windows) 599 | (gnorb-trigger-todo-action nil targ))) 600 | (error 601 | ;; If these are left populated after an error, it plays hell 602 | ;; with future trigger processes. 603 | (setq gnorb-gnus-message-info nil) 604 | (setq gnorb-gnus-capture-attachments nil) 605 | (signal (car err) (cdr err)))))) 606 | 607 | ;;;###autoload 608 | (defun gnorb-gnus-quick-reply () 609 | "Compose a reply to the message under point, and associate both 610 | the original message and the reply with the selected heading. 611 | Take no other action. 612 | 613 | Use this when you want to compose a reply to a message on the 614 | spot, and track both messages, without having to go through the 615 | hassle of triggering an action on a heading, and then starting a 616 | reply." 617 | (interactive) 618 | (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode))) 619 | (user-error "Only works in gnus summary or article mode")) 620 | (let* ((art-no (gnus-summary-article-number)) 621 | (headers (gnus-data-header 622 | (gnus-data-find art-no))) 623 | (msg-id (mail-header-id headers)) 624 | (from (mail-header-from headers)) 625 | (subject (mail-header-subject headers)) 626 | (group (gnorb-get-real-group-name 627 | gnus-newsgroup-name 628 | art-no)) 629 | (ref-msg-ids (concat (mail-header-references headers) " " 630 | msg-id)) 631 | (related-headings 632 | (when ref-msg-ids 633 | (gnorb-find-tracked-headings headers t))) 634 | (targ (car-safe related-headings))) 635 | (if targ 636 | (let ((ret (make-marker))) 637 | (setq gnorb-window-conf (current-window-configuration)) 638 | (move-marker gnorb-return-marker (point)) 639 | ;; Assume the first heading is the one we want. 640 | (gnorb-registry-make-entry 641 | msg-id from subject targ group) 642 | (gnus-summary-wide-reply-with-original 1) 643 | (move-marker ret (point)) 644 | (save-restriction 645 | (widen) 646 | (message-narrow-to-headers-or-head) 647 | (goto-char (point-min)) 648 | (open-line 1) 649 | (message-insert-header 650 | (intern gnorb-mail-header) targ)) 651 | (goto-char ret) 652 | (message 653 | (format "Original message and reply will be associated with %s" 654 | (gnorb-pretty-outline targ)))) 655 | (message "No associated headings found")))) 656 | 657 | ;;;###autoload 658 | (defun gnorb-gnus-search-messages (str persist &optional head-text ret) 659 | "Initiate a search for gnus message links in an org subtree. 660 | The arg STR can be one of two things: an Org heading id value 661 | \(IDs should be prefixed with \"id+\"\), in which case links will 662 | be collected from that heading, or a string corresponding to an 663 | Org tags search, in which case links will be collected from all 664 | matching headings. 665 | 666 | In either case, once a collection of links have been made, they 667 | will all be displayed in an ephemeral group on the \"nngnorb\" 668 | server. There must be an active \"nngnorb\" server for this to 669 | work." 670 | (interactive) 671 | (require 'nnir) 672 | (let ((nnir-address 673 | (or (gnus-method-to-server '(nngnorb)) 674 | (user-error 675 | "Please add a \"nngnorb\" backend to your gnus installation."))) 676 | name method spec) 677 | (when (version= "5.13" gnus-version-number) 678 | (with-no-warnings ; All these variables are available. 679 | (setq nnir-current-query nil 680 | nnir-current-server nil 681 | nnir-current-group-marked nil 682 | nnir-artlist nil))) 683 | ;; In 24.4, the group name is mostly decorative, but in 24.3, the 684 | ;; actual query is held there. 685 | (setq name (if (version= "5.13" gnus-version-number) 686 | (concat "nnir:" (prin1-to-string `((query ,str)))) 687 | (if persist 688 | (read-string 689 | (format "Name for group (default %s): " head-text) 690 | nil head-text t) 691 | (concat "gnorb-" str)))) 692 | (setq method (if (version= "5.13" gnus-version-number) 693 | (list 'nnir nnir-address) 694 | (list 'nnir "Gnorb"))) 695 | (setq spec 696 | (list 697 | (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str))) 698 | (cons 'nnir-group-spec `((,nnir-address nil))))) 699 | (cons 'nnir-artlist nil))) 700 | (if persist 701 | (progn 702 | (switch-to-buffer gnus-group-buffer) 703 | (gnus-group-make-group name method nil spec) 704 | (gnus-group-select-group)) 705 | (gnus-group-read-ephemeral-group name method nil ret nil nil spec)))) 706 | 707 | (defun gnorb-gnus-summary-mode-hook () 708 | "Check if we've entered a Gnorb-generated group, and activate 709 | `gnorb-summary-minor-mode', if so." 710 | (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) 711 | (when (string-match-p "Gnorb" (cadr method)) 712 | (gnorb-summary-minor-mode)))) 713 | 714 | (add-hook 'gnus-summary-mode-hook #'gnorb-gnus-summary-mode-hook) 715 | 716 | ;;; Automatic noticing of relevant messages 717 | 718 | ;; likely hooks for the summary buffer include: 719 | ;; `gnus-parse-headers-hook' 720 | 721 | ;; BBDB puts its notice stuff in the `gnus-article-prepare-hook', 722 | ;; which seems as good a spot as any. 723 | 724 | (defun gnorb-gnus-hint-relevant-message () 725 | "When opening an article buffer, check the message to see if it 726 | is relevant to any existing TODO headings. If so, flash a message 727 | to that effect. This function is added to the 728 | `gnus-article-prepare-hook'. It will only do anything if the 729 | option `gnorb-gnus-hint-relevant-article' is non-nil." 730 | (when (and gnorb-gnus-hint-relevant-article 731 | (not (memq (car (gnus-find-method-for-group 732 | gnus-newsgroup-name)) 733 | '(nnvirtual nnir)))) 734 | (let* ((headers 735 | (gnus-data-header 736 | (gnus-data-find 737 | (gnus-summary-article-number)))) 738 | (assoc-heading 739 | (gnus-registry-get-id-key 740 | (gnus-fetch-original-field "message-id") 'gnorb-ids)) 741 | (tracked-headings (gnorb-find-tracked-headings headers)) 742 | (key 743 | (where-is-internal 'gnorb-gnus-incoming-do-todo 744 | nil t))) 745 | (cond (assoc-heading 746 | (message "Message is associated with %s" 747 | (gnorb-pretty-outline (car assoc-heading) t))) 748 | (tracked-headings 749 | (message "Possible relevant todo %s, trigger with %s" 750 | (gnorb-pretty-outline (car tracked-headings) t) 751 | (if key 752 | (key-description key) 753 | "M-x gnorb-gnus-incoming-do-todo"))) 754 | (t nil))))) 755 | 756 | (add-hook 'gnus-select-article-hook 'gnorb-gnus-hint-relevant-message) 757 | 758 | (defun gnorb-gnus-insert-format-letter-maybe (header) 759 | (if (not (memq (car (gnus-find-method-for-group 760 | gnus-newsgroup-name)) 761 | '(nnvirtual nnir))) 762 | (cond ((gnus-registry-get-id-key 763 | (mail-header-message-id header) 'gnorb-ids) 764 | gnorb-gnus-summary-tracked-mark) 765 | ((gnorb-find-tracked-headings header) 766 | gnorb-gnus-summary-mark) 767 | (t " ")) 768 | " ")) 769 | 770 | (fset (intern (concat "gnus-user-format-function-" 771 | gnorb-gnus-summary-mark-format-letter)) 772 | (lambda (header) 773 | (gnorb-gnus-insert-format-letter-maybe header))) 774 | 775 | ;;;###autoload 776 | (defun gnorb-gnus-view () 777 | "Display the first relevant TODO heading for the message under point" 778 | (interactive) 779 | (let* ((headers (gnus-data-header 780 | (gnus-data-find 781 | (gnus-summary-article-number)))) 782 | (tracked-headings 783 | (gnorb-find-tracked-headings headers))) 784 | (when tracked-headings 785 | (setq gnorb-window-conf (current-window-configuration)) 786 | (move-marker gnorb-return-marker (point)) 787 | (delete-other-windows) 788 | (org-id-goto (car tracked-headings))))) 789 | 790 | (provide 'gnorb-gnus) 791 | ;;; gnorb-gnus.el ends here 792 | -------------------------------------------------------------------------------- /gnorb-org.el: -------------------------------------------------------------------------------- 1 | ;;; gnorb-org.el --- The Org-centric functions of gnorb -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 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 . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (require 'gnorb-utils) 28 | (eval-when-compile (require 'cl-lib)) 29 | 30 | (defvar gnorb-bbdb-posting-styles) 31 | (defvar gnorb-bbdb-org-tag-field) 32 | (defvar bbdb-buffer-name) 33 | (defvar message-alternative-emails) 34 | 35 | ;; This many autoloads means either we should require bbdb outright, 36 | ;; or something needs refactoring. 37 | (autoload 'gnorb-bbdb-configure-posting-styles "gnorb-bbdb") 38 | (autoload 'gnorb-registry-org-id-search "gnorb-registry") 39 | (autoload 'bbdb-completing-read-record "bbdb") 40 | (autoload 'bbdb-record-name "bbdb") 41 | (autoload 'bbdb-message-search "bbdb") 42 | (autoload 'bbdb-mail-address "bbdb") 43 | (autoload 'bbdb-record-xfield "bbdb") 44 | (autoload 'bbdb-records "bbdb") 45 | (autoload 'bbdb-search "bbdb") 46 | (autoload 'bbdb-display-records "bbdb") 47 | 48 | (defgroup gnorb-org nil 49 | "The Org bits of Gnorb." 50 | :tag "Gnorb Org" 51 | :group 'gnorb) 52 | 53 | (defcustom gnorb-org-after-message-setup-hook nil 54 | "Hook run in a message buffer after setting up the message from 55 | `gnorb-org-handle-mail' or `gnorb-org-email-subtree'." 56 | :group 'gnorb-org 57 | :type 'hook) 58 | 59 | (defcustom gnorb-org-trigger-actions 60 | '((?t "todo state" todo) 61 | (?n "take note" note) 62 | (?d "don't associate" no-associate) 63 | (?o "only associate" associate) 64 | (?c "capture to child" cap-child) 65 | (?s "capture to sibling" cap-sib)) 66 | "List of potential actions that can be taken on headings. 67 | 68 | When triggering an Org heading after receiving or sending a 69 | message, this option lists the possible actions to take. Built-in 70 | actions include: 71 | 72 | todo state: Associate the message, and change TODO state. 73 | take note: Associate the message, and take a note. 74 | don't associate: Do nothing at all, don't connect the message and TODO. 75 | only associate: Associate the message with this heading, do nothing else. 76 | capture to child: Associate this message with a new child heading. 77 | capture to sibling: Associate this message with a new sibling heading. 78 | 79 | You can reorder this list or remove items as suits your workflow. 80 | The two \"capture\" options will use the value of 81 | `gnorb-gnus-new-todo-capture-key' to find the appropriate 82 | template. 83 | 84 | You can also add custom actions to the list. Actions should be a 85 | list of three elements: a character key, a string tag and a 86 | symbol indicating a custom function. The custom function will be 87 | called on the heading in question, and passed a plist containing 88 | information about the message from which we're triggering." 89 | 90 | :group 'gnorb-org 91 | :type 'list 92 | :package-version '(gnorb . "1.1.3")) 93 | 94 | (defcustom gnorb-org-msg-id-key "GNORB_MSG_ID" 95 | "The name of the org property used to store the Message-IDs 96 | from relevant messages. This is no longer used, and will be 97 | removed soon." 98 | :group 'gnorb-org 99 | :type 'string) 100 | 101 | (defcustom gnorb-org-mail-scan-scope 2 102 | "Number of paragraphs to scan for mail-related links. 103 | 104 | Or set to 'all to scan the whole subtree. 105 | 106 | When handling a TODO heading with `gnorb-org-handle-mail', Gnorb 107 | will typically reply to the most recent message associated with 108 | this heading. If there are no such messages, or message tracking 109 | is disabled entirely, or `gnorb-org-handle-mail' has been called 110 | with a prefix arg, the heading and body text of the subtree under 111 | point will instead be scanned for gnus:, mailto:, and bbdb: 112 | links. This option controls how many paragraphs of body text to 113 | scan. Set to 0 to only look in the heading." 114 | :group 'gnorb-org 115 | :type '(choice (const :tag "Whole subtree" all) 116 | (integer :tag "Number of paragraphs"))) 117 | 118 | (make-obsolete-variable 119 | 'gnorb-org-mail-scan-strategies 120 | "This variable has been superseded by `gnorb-org-trigger-actions'" 121 | "September 12, 2014" 'set) 122 | 123 | (make-obsolete-variable 124 | 'gnorb-org-mail-scan-state-changes 125 | "This variable has been superseded by `gnorb-org-trigger-actions'" 126 | "September 12, 2014" 'set) 127 | 128 | (make-obsolete-variable 129 | 'gnorb-org-mail-scan-function 130 | "This variable has been superseded by `gnorb-org-trigger-actions'" 131 | "September 12, 2014" 'set) 132 | 133 | (defcustom gnorb-org-find-candidates-match nil 134 | "When scanning all org files for heading related to an incoming 135 | message, this option will limit which headings will be offered as 136 | target candidates. Specifically it will be used as the second 137 | argument to `org-map-entries', and syntax is the same as that 138 | used in an agenda tags view." 139 | :group 'gnorb-org 140 | :type 'symbol) 141 | 142 | ;;;###autoload 143 | (defun gnorb-org-contact-link (rec) 144 | "Prompt for a BBDB record and insert a link to that record at 145 | point. 146 | 147 | There's really no reason to use this instead of regular old 148 | `org-insert-link' with BBDB completion. But there might be in the 149 | future!" 150 | ;; this needs to handle an active region. 151 | (interactive (list (bbdb-completing-read-record "Record: "))) 152 | (let* ((name (bbdb-record-name rec)) 153 | (link (concat "bbdb:" (org-link-escape name)))) 154 | (org-store-link-props :type "bbdb" :name name 155 | :link link :description name) 156 | (if (called-interactively-p 'any) 157 | (insert (format "[[%s][%s]]" link name)) 158 | link))) 159 | 160 | (defun gnorb-org-restore-after-send () 161 | "After an email is sent, go through all the org ids that might 162 | have been in the outgoing message's headers and call 163 | `gnorb-trigger-todo-action' on each one, then put us back where 164 | we came from." 165 | (delete-other-windows) 166 | (dolist (id gnorb-message-org-ids) 167 | (org-id-goto id) 168 | (gnorb-trigger-todo-action nil id)) 169 | ;; this is a little unnecessary, but it may save grief 170 | (setq gnorb-gnus-message-info nil) 171 | (setq gnorb-message-org-ids nil) 172 | (gnorb-restore-layout)) 173 | 174 | (defun gnorb-org-extract-links (&optional _arg region) 175 | "See if there are viable links in the subtree under point." 176 | ;; We're not currently using the arg. What could we do with it? 177 | (let (strings) 178 | ;; If the region was active, only use the region 179 | (if region 180 | (push (buffer-substring (car region) (cdr region)) 181 | strings) 182 | ;; Otherwise collect the heading text, and all the paragraph 183 | ;; text. 184 | (save-restriction 185 | (org-narrow-to-subtree) 186 | (let ((head (org-element-at-point)) 187 | (tree (org-element-parse-buffer))) 188 | (push (org-element-property 189 | :raw-value 190 | head) 191 | strings) 192 | (org-element-map tree '(paragraph drawer) 193 | (lambda (p) 194 | (push (org-element-interpret-data p) 195 | strings)) 196 | nil nil 'drawer)))) 197 | (when strings 198 | ;; Limit number of paragraphs based on 199 | ;; `gnorb-org-mail-scan-scope' 200 | (setq strings 201 | (cond ((eq gnorb-org-mail-scan-scope 'all) 202 | strings) 203 | ((numberp gnorb-org-mail-scan-scope) 204 | (cl-subseq 205 | (reverse strings) 206 | 0 (min 207 | (length strings) 208 | (1+ gnorb-org-mail-scan-scope)))) 209 | ;; We could provide more options here. 'tree vs 210 | ;; 'subtree, for instance. 211 | (t 212 | strings))) 213 | (with-temp-buffer 214 | (dolist (s strings) 215 | (insert s) 216 | (insert "\n")) 217 | (goto-char (point-min)) 218 | (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb))))) 219 | 220 | (defun gnorb-org-extract-mail-stuff (&optional arg region) 221 | "Decide how to hande the Org heading under point as an email task. 222 | 223 | See the docstring of `gnorb-org-handle-mail' for details." 224 | (if (or (not gnorb-tracking-enabled) 225 | region) 226 | (gnorb-org-extract-links arg region) 227 | ;; Get all the messages associated with the IDS in this subtree. 228 | (let ((assoc-msg-ids 229 | (delete-dups 230 | (cl-mapcan 231 | (lambda (id) 232 | (gnorb-registry-org-id-search id)) 233 | (gnorb-collect-ids))))) 234 | (gnorb-org-extract-mail-tracking assoc-msg-ids arg region)))) 235 | 236 | (defun gnorb-user-address-match-p (addr) 237 | "Return t if ADDR seems to match the user's email address." 238 | (cond 239 | ((stringp message-alternative-emails) 240 | (string-match-p message-alternative-emails 241 | addr)) 242 | ((functionp message-alternative-emails) 243 | (funcall message-alternative-emails addr)) 244 | (user-mail-address 245 | (string-match-p user-mail-address addr)))) 246 | 247 | (defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region) 248 | 249 | (let* ((all-links (gnorb-org-extract-links nil region)) 250 | ;; The latest (by the creation-time registry key) of all the 251 | ;; tracked messages that were not sent by our user. 252 | (latest-msg-id 253 | (when assoc-msg-ids 254 | (car 255 | (sort 256 | (cl-remove-if 257 | (lambda (m) 258 | (let ((from (car (gnus-registry-get-id-key m 'sender)))) 259 | (and from 260 | (null (gnorb-user-address-match-p from))))) 261 | assoc-msg-ids) 262 | (lambda (r l) 263 | (time-less-p 264 | (car (gnus-registry-get-id-key l 'creation-time)) 265 | (car (gnus-registry-get-id-key r 'creation-time)))))))) 266 | (msg-id-link 267 | (when latest-msg-id 268 | (gnorb-msg-id-to-link latest-msg-id)))) 269 | (cond 270 | ;; If there are no tracked messages, or the user has specifically 271 | ;; requested we ignore them with the prefix arg, just return the 272 | ;; found links in the subtree. 273 | ((or arg 274 | (null msg-id-link)) 275 | all-links) 276 | ;; Otherwise ignore the other links in the subtree, and return 277 | ;; the latest message. 278 | (msg-id-link 279 | `(:gnus ,(list msg-id-link)))))) 280 | 281 | (defvar message-beginning-of-line) 282 | 283 | (defun gnorb-org-setup-message 284 | (&optional messages mails from cc bcc attachments text ids) 285 | "Common message setup routine for other gnorb-org commands. 286 | MESSAGES is a list of gnus links pointing to messages -- we 287 | currently only use the first of the list. MAILS is a list of 288 | email address strings suitable for inserting in the To header. 289 | ATTACHMENTS is a list of filenames to attach. TEXT is a string or 290 | buffer, which is inserted in the message body. IDS is one or more 291 | Org heading ids, associating the outgoing message with those 292 | headings." 293 | (require 'gnorb-gnus) 294 | (if (not messages) 295 | ;; Either compose new message... 296 | (compose-mail) 297 | ;; ...or follow link and start reply. 298 | (condition-case err 299 | (gnorb-reply-to-gnus-link (car messages)) 300 | (error (gnorb-restore-layout) 301 | (signal (car err) (cdr err))))) 302 | ;; Add MAILS to message To header. 303 | (when mails 304 | (message-goto-to) 305 | (when messages 306 | (insert ", ")) 307 | (insert (mapconcat 'identity mails ", "))) 308 | ;; Commenting this out because 309 | ;; `gnorb-gnus-check-outgoing-headers' is set unconditionally in the 310 | ;; `message-send-hook, so this should be redundant. Also, we've 311 | ;; switched to using message-send-actions. 312 | 313 | ;; (add-to-list 314 | ;; 'message-exit-actions 'gnorb-org-restore-after-send t) Set 315 | ;; headers from MAIL_* properties (from, cc, and bcc). 316 | (cl-flet ((sh (h) 317 | (when (cdr h) 318 | (funcall (intern (format "message-goto-%s" (car h)))) 319 | (let ((message-beginning-of-line t) 320 | (show-trailing-whitespace t)) 321 | (message-beginning-of-line) 322 | (unless (bolp) 323 | (kill-line)) 324 | (insert (cdr h)))))) 325 | (dolist (h `((from . ,from) (cc . ,cc) (bcc . ,bcc))) 326 | (sh h))) 327 | ;; attach ATTACHMENTS 328 | (map-y-or-n-p 329 | (lambda (a) (format "Attach %s to outgoing message? " 330 | (file-name-nondirectory a))) 331 | (lambda (a) 332 | (mml-attach-file a (mm-default-file-encoding a) 333 | nil "attachment")) 334 | attachments 335 | '("file" "files" "attach")) 336 | ;; insert text, if any 337 | (when text 338 | (message-goto-body) 339 | (insert "\n") 340 | (if (bufferp text) 341 | (insert-buffer-substring text) 342 | (insert text))) 343 | ;; insert org ids, if any 344 | (when ids 345 | (unless (listp ids) 346 | (setq ids (list ids))) 347 | (save-excursion 348 | (save-restriction 349 | (message-narrow-to-headers) 350 | (dolist (i ids) 351 | (goto-char (point-at-bol)) 352 | (open-line 1) 353 | ;; this function hardly does anything 354 | (message-insert-header 355 | (intern gnorb-mail-header) i))))) 356 | ;; put point somewhere reasonable 357 | (if (or mails messages) 358 | (if (not messages) 359 | (message-goto-subject) 360 | (message-goto-body)) 361 | (message-goto-to)) 362 | (run-hooks 'gnorb-org-after-message-setup-hook)) 363 | 364 | (defun gnorb-org-attachment-list (&optional id) 365 | "Get a list of files (absolute filenames) attached to the 366 | current heading, or the heading indicated by optional argument ID." 367 | (when (featurep 'org-attach) 368 | (let* ((attach-dir (save-excursion 369 | (when id 370 | (org-id-goto id)) 371 | (org-attach-dir t))) 372 | (files 373 | (mapcar 374 | (lambda (f) 375 | (expand-file-name f attach-dir)) 376 | (org-attach-file-list attach-dir)))) 377 | files))) 378 | 379 | (defvar message-mode-hook) 380 | 381 | ;;;###autoload 382 | (defun gnorb-org-handle-mail (&optional arg text file) 383 | "Handle current headline as a mail TODO. 384 | 385 | How this function behaves depends on whether you're using Gnorb 386 | for email tracking, also on the prefix arg, and on the active 387 | region. 388 | 389 | If tracking is enabled and there is no prefix arg, Gnorb will 390 | begin a reply to the newest associated message that wasn't sent 391 | by the user -- ie, the Sender header doesn't match 392 | `user-mail-address' or `message-alternative-emails'. 393 | 394 | If tracking is enabled and there is a prefix arg, ignore the 395 | tracked messages and instead scan the subtree for mail-related 396 | links. This means links prefixed with gnus:, mailto:, or bbdb:. 397 | See `gnorb-org-mail-scan-scope' to limit the scope of this scan. 398 | Do something appropriate with the resulting links. 399 | 400 | With a double prefix arg, ignore all tracked messages and all 401 | links, and compose a blank new message. 402 | 403 | If tracking is enabled and you want to reply to a 404 | specific (earlier) message in the tracking history, use 405 | `gnorb-org-view' to open an nnir *Summary* buffer containing all 406 | the messages, and reply to the one you want. Your reply will be 407 | automatically tracked, as well. 408 | 409 | If tracking is not enabled and you want to use a specific link in 410 | the subtree as a basis for the email action, then put the region 411 | around that link before you call this message." 412 | (interactive "P") 413 | (setq gnorb-window-conf (current-window-configuration)) 414 | (move-marker gnorb-return-marker (point)) 415 | (when (eq major-mode 'org-agenda-mode) 416 | ;; If this is all the different types, we could skip the check. 417 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) 418 | (org-agenda-check-no-diary) 419 | (let* ((marker (or (org-get-at-bol 'org-hd-marker) 420 | (org-agenda-error))) 421 | (buffer (marker-buffer marker)) 422 | (pos (marker-position marker))) 423 | (switch-to-buffer buffer) 424 | (widen) 425 | (goto-char pos))) 426 | (let ((region 427 | (when (use-region-p) 428 | (cons (region-beginning) (region-end))))) 429 | (deactivate-mark) 430 | (save-excursion 431 | (unless (org-back-to-heading t) 432 | (error "Not in an org item")) 433 | (cl-flet ((mp (p) (org-entry-get (point) p t))) 434 | ;; Double prefix means ignore everything and compose a blank 435 | ;; mail. 436 | (let* ((links (unless (equal arg '(16)) 437 | (gnorb-org-extract-mail-stuff arg region))) 438 | (attachments (gnorb-org-attachment-list)) 439 | (from (mp "MAIL_FROM")) 440 | (cc (mp "MAIL_CC")) 441 | (bcc (mp "MAIL_BCC")) 442 | (org-id (org-id-get-create)) 443 | (recs (plist-get links :bbdb)) 444 | (message-mode-hook (copy-sequence message-mode-hook)) 445 | mails) 446 | (when file 447 | (setq attachments (cons file attachments))) 448 | (when recs 449 | (setq recs 450 | (delq nil 451 | (mapcar 452 | (lambda (r) 453 | (car (bbdb-message-search 454 | (org-link-unescape r) 455 | nil))) 456 | recs)))) 457 | (when recs 458 | (dolist (r recs) 459 | (push (bbdb-mail-address r) mails))) 460 | (when (and recs 461 | gnorb-bbdb-posting-styles) 462 | (add-hook 'message-mode-hook 463 | (lambda () 464 | (gnorb-bbdb-configure-posting-styles (cdr recs)) 465 | (gnorb-bbdb-configure-posting-styles (list (car recs)))))) 466 | (gnorb-org-setup-message 467 | (plist-get links :gnus) 468 | (append mails (plist-get links :mail)) 469 | from cc bcc 470 | attachments text org-id)))))) 471 | 472 | ;;; Email subtree 473 | 474 | (defcustom gnorb-org-email-subtree-text-parameters nil 475 | "A plist of export parameters corresponding to the EXT-PLIST 476 | argument to the export functions, for use when exporting to 477 | text." 478 | :group 'gnorb-org 479 | :type 'boolean) 480 | 481 | (defcustom gnorb-org-email-subtree-file-parameters nil 482 | "A plist of export parameters corresponding to the EXT-PLIST 483 | argument to the export functions, for use when exporting to a 484 | file." 485 | :group 'gnorb-org 486 | :type 'boolean) 487 | 488 | (defcustom gnorb-org-email-subtree-text-options '(nil t nil t) 489 | "A list of ts and nils corresponding to Org's export options, 490 | to be used when exporting to text. The options, in order, are 491 | async, subtreep, visible-only, and body-only." 492 | :group 'gnorb-org 493 | :type 'list) 494 | 495 | (defcustom gnorb-org-email-subtree-file-options '(nil t nil nil) 496 | "A list of ts and nils corresponding to Org's export options, 497 | to be used when exporting to a file. The options, in order, are 498 | async, subtreep, visible-only, and body-only." 499 | :group 'gnorb-org 500 | :type 'list) 501 | 502 | (defcustom gnorb-org-export-extensions 503 | '((latex ".tex") 504 | (ascii ".txt") 505 | (html ".html") 506 | (org ".org") 507 | (icalendar ".ics") 508 | (man ".man") 509 | (md ".md") 510 | (odt ".odt") ; not really, though 511 | (texinfo ".texi") 512 | (beamer ".tex")) 513 | "Correspondence between export backends and their 514 | respective (usual) file extensions. Ugly way to do it, but what 515 | the hey..." 516 | :group 'gnorb-org 517 | :type '(repeat 518 | (list symbol string))) 519 | 520 | (defvar org-export-show-temporary-export-buffer) 521 | 522 | ;;;###autoload 523 | (defun gnorb-org-email-subtree (&optional arg) 524 | "Call on a subtree to export it either to a text string or a file, 525 | then compose a mail message either with the exported text 526 | inserted into the message body, or the exported file attached to 527 | the message. 528 | 529 | Export options default to the following: When exporting to a 530 | buffer: async = nil, subtreep = t, visible-only = nil, body-only 531 | = t. Options are the same for files, except body-only is set to 532 | nil. Customize `gnorb-org-email-subtree-text-options' and 533 | `gnorb-org-email-subtree-file-options', respectively. 534 | 535 | Customize `gnorb-org-email-subtree-parameters' to your preferred 536 | default set of parameters." 537 | ;; I sure would have liked to use the built-in dispatch ui, but it's 538 | ;; got too much hard-coded stuff. 539 | (interactive "P") 540 | (org-back-to-heading t) 541 | (let* ((bkend-var 542 | (if (boundp 'org-export--registered-backends) 543 | org-export--registered-backends 544 | org-export-registered-backends)) 545 | (backend-string 546 | (org-completing-read 547 | "Export backend: " 548 | (mapcar (lambda (b) 549 | (symbol-name (org-export-backend-name b))) 550 | bkend-var) 551 | nil t)) 552 | (backend-symbol (intern backend-string)) 553 | (f-or-t (org-completing-read "Export as file or text? " 554 | '("file" "text") nil t)) 555 | (org-export-show-temporary-export-buffer nil) 556 | (opts (if (equal f-or-t "text") 557 | gnorb-org-email-subtree-text-options 558 | gnorb-org-email-subtree-file-options)) 559 | (result 560 | (if (equal f-or-t "text") 561 | (apply 'org-export-to-buffer 562 | `(,backend-symbol 563 | "*Gnorb Export*" 564 | ,@opts 565 | ,gnorb-org-email-subtree-text-parameters)) 566 | (if (eq backend-symbol 'odt) 567 | ;; Need to special-case odt output, as it does too 568 | ;; many clever things. The only downside to this is 569 | ;; it's impossible to put the exported file in the 570 | ;; /tmp/ directory -- it will go wherever it would 571 | ;; have gone with manual export. 572 | (apply #'org-odt-export-to-odt 573 | (append (cl-subseq gnorb-org-email-subtree-file-options 0 3) 574 | (list gnorb-org-email-subtree-file-parameters))) 575 | (apply 'org-export-to-file 576 | `(,backend-symbol 577 | ,(org-export-output-file-name 578 | (cl-second (assoc backend-symbol gnorb-org-export-extensions)) 579 | t gnorb-tmp-dir) 580 | ,@opts 581 | ,gnorb-org-email-subtree-file-parameters))))) 582 | text file) 583 | (if (bufferp result) 584 | (setq text result) 585 | (setq file result)) 586 | (gnorb-org-handle-mail arg text file))) 587 | 588 | (defcustom gnorb-org-capture-collect-link-p t 589 | "Should the capture process store a link to the gnus message or 590 | BBDB record under point, even if it's not part of the template? 591 | You'll probably end up needing it, anyway." 592 | :group 'gnorb-org 593 | :type 'boolean) 594 | 595 | (defun gnorb-org-capture-collect-link () 596 | (when gnorb-org-capture-collect-link-p 597 | (let ((buf (org-capture-get :original-buffer))) 598 | (when buf 599 | (with-current-buffer buf 600 | (when (memq major-mode '(gnus-summary-mode 601 | gnus-article-mode 602 | bbdb-mode)) 603 | (call-interactively 'org-store-link))))))) 604 | 605 | (add-hook 'org-capture-mode-hook 'gnorb-org-capture-collect-link) 606 | 607 | ;;; Agenda/BBDB popup stuff 608 | 609 | (defcustom gnorb-org-agenda-popup-bbdb nil 610 | "Should Agenda tags search pop up a BBDB buffer with matching 611 | records? 612 | 613 | Records are considered matching if they have an `org-tags' field 614 | matching the current Agenda search. The name of that field can be 615 | customized with `gnorb-bbdb-org-tag-field'." 616 | :group 'gnorb-org 617 | :type 'boolean) 618 | 619 | (defcustom gnorb-org-bbdb-popup-layout 'pop-up-multi-line 620 | "Default BBDB buffer layout for automatic Org Agenda display." 621 | :group 'gnorb-org 622 | :type '(choice (const one-line) 623 | (const multi-line) 624 | (const full-multi-line) 625 | (symbol))) 626 | 627 | ;;;###autoload 628 | (defun gnorb-org-popup-bbdb (&optional str) 629 | "In an `org-tags-view' Agenda buffer, pop up a BBDB buffer 630 | showing records whose `org-tags' field matches the current tags 631 | search." 632 | ;; I was hoping to use `org-make-tags-matcher' directly, then snag 633 | ;; the tagmatcher from the resulting value, but there doesn't seem 634 | ;; to be a reliable way of only getting the tag-related returns. But 635 | ;; I'd still like to use that function. So an ugly hack to first 636 | ;; remove non-tag contents from the query string, and then make a 637 | ;; new call to `org-make-tags-matcher'. 638 | (interactive) 639 | (require 'gnorb-bbdb) 640 | (let (recs) 641 | (cond ((and 642 | (and (eq major-mode 'org-agenda-mode) 643 | (eq org-agenda-type 'tags)) 644 | (or (called-interactively-p 'any) 645 | gnorb-org-agenda-popup-bbdb)) 646 | (let ((org--matcher-tags-todo-only nil) 647 | (str (or str org-agenda-query-string)) 648 | (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)") 649 | or-terms term rest out-or acc tag-clause) 650 | (setq or-terms (org-split-string str "|")) 651 | (while (setq term (pop or-terms)) 652 | (setq acc nil) 653 | (while (string-match re term) 654 | (setq rest (substring term (match-end 0))) 655 | (let ((sub-term (match-string 0 term))) 656 | (unless (save-match-data ; this isn't a tag, don't want it 657 | (string-match "\\([<>=]\\)" sub-term)) 658 | (push sub-term acc)) 659 | (setq term rest))) 660 | (push (mapconcat 'identity (nreverse acc) "") out-or)) 661 | (setq str (mapconcat 'identity (nreverse out-or) "|")) 662 | (setq tag-clause (cdr (org-make-tags-matcher str))) 663 | (unless (equal str "") 664 | (setq recs 665 | (cl-remove-if-not 666 | (lambda (r) 667 | (let ((rec-tags (bbdb-record-xfield 668 | r gnorb-bbdb-org-tag-field))) 669 | (and rec-tags 670 | (let ((tags-list (if (stringp rec-tags) 671 | (org-split-string rec-tags ":") 672 | rec-tags)) 673 | (case-fold-search t) 674 | (org-trust-scanner-tags t)) 675 | ;; This is bad, we're lexically bound, now. 676 | (eval tag-clause))))) 677 | (bbdb-records)))))) 678 | ((eq major-mode 'org-mode) 679 | (save-excursion 680 | (org-back-to-heading) 681 | (let ((bound (org-element-property 682 | :end (org-element-at-point))) 683 | desc rec) 684 | (while (re-search-forward 685 | org-bracket-link-analytic-regexp bound t) 686 | (when (string-match-p "bbdb" (match-string 2)) 687 | (setq desc (match-string 5) 688 | rec (bbdb-search (bbdb-records) desc desc desc) 689 | recs (append recs rec)))))))) 690 | (if recs 691 | (bbdb-display-records 692 | recs gnorb-org-bbdb-popup-layout) 693 | (when (get-buffer-window bbdb-buffer-name) 694 | (quit-window nil 695 | (get-buffer-window bbdb-buffer-name))) 696 | (when (called-interactively-p 'any) 697 | (message "No relevant BBDB records"))))) 698 | 699 | (if (featurep 'gnorb-bbdb) 700 | (add-hook 'org-agenda-finalize-hook 'gnorb-org-popup-bbdb)) 701 | 702 | ;;; Groups from the gnorb gnus server backend 703 | 704 | ;;;###autoload 705 | (defun gnorb-org-view (arg) 706 | "Search the subtree at point for links to gnus messages, and 707 | then show them in an ephemeral group, in Gnus. 708 | 709 | With a prefix arg, create a search group that will persist across 710 | Gnus sessions, and can be refreshed. 711 | 712 | This won't work unless you've added a \"nngnorb\" server to 713 | your gnus select methods." 714 | ;; this should also work on the active region, if there is one. 715 | (interactive "P") 716 | (require 'gnorb-gnus) 717 | (setq gnorb-window-conf (current-window-configuration)) 718 | (move-marker gnorb-return-marker (point)) 719 | (when (eq major-mode 'org-agenda-mode) 720 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) 721 | (org-agenda-check-no-diary) 722 | (let* ((marker (or (org-get-at-bol 'org-hd-marker) 723 | (org-agenda-error))) 724 | (buffer (marker-buffer marker)) 725 | (pos (marker-position marker))) 726 | (switch-to-buffer buffer) 727 | (goto-char pos) 728 | (org-reveal))) 729 | (let (id) 730 | (save-excursion 731 | (org-back-to-heading) 732 | (setq id (concat "id+" (org-id-get-create))) 733 | (gnorb-gnus-search-messages 734 | id arg 735 | (replace-regexp-in-string 736 | org-bracket-link-regexp "\\3" 737 | (nth 4 (org-heading-components))) 738 | `(when (and (window-configuration-p gnorb-window-conf) 739 | gnorb-return-marker) 740 | (set-window-configuration gnorb-window-conf) 741 | (goto-char gnorb-return-marker)))))) 742 | 743 | (provide 'gnorb-org) 744 | ;;; gnorb-org.el ends here 745 | -------------------------------------------------------------------------------- /gnorb-registry.el: -------------------------------------------------------------------------------- 1 | ;;; gnorb-registry.el --- Registry implementation for Gnorb -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 6 | 7 | ;; This file is part of GNU Emacs. 8 | 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; Early on, Gnorb's message/todo tracking was done by relying on the 25 | ;; user to insert links to received messages into an Org heading, and 26 | ;; by automatically storing the Message-Ids of sent messages in a 27 | ;; property (`gnorb-org-msg-id-key', defaulting to GNORB_MSG_ID) on 28 | ;; the same heading. The heading could find all relevant messages by 29 | ;; combining the links (incoming) and the IDs of the Gnorb-specific 30 | ;; property (outgoing). 31 | ;; 32 | ;; In the end, this proved to be fragile and messy. Enter the 33 | ;; registry. The Gnus registry is a specialization of a general 34 | ;; "registry" library -- it's possible to roll your own. If you want 35 | ;; to track connections between messages and Org headings, it's an 36 | ;; obvious choice: Each relevant message is stored in the registry, 37 | ;; keyed on its Message-ID, and the org-ids of all relevant headings 38 | ;; are stored in a custom property, in our case gnorb-ids. This allows 39 | ;; us to keep all Gnorb-specific data in one place, without polluting 40 | ;; Org files or Gnus messages, persistent on disk, and with the added 41 | ;; bonus of providing a place to keep arbitrary additional metadata. 42 | ;; 43 | ;; The drawback is that the connections are no longer readily visible 44 | ;; to the user (they need to query the registry to see them), and it 45 | ;; becomes perhaps a bit more difficult (but only a bit) to keep 46 | ;; registry data in sync with the current state of the user's Gnus and 47 | ;; Org files. But a clear win, in the end. 48 | 49 | ;;; Code: 50 | 51 | (require 'gnus-registry) 52 | (require 'gnorb-utils) 53 | (require 'cl-lib) 54 | 55 | (defgroup gnorb-registry nil 56 | "Gnorb's use of the Gnus registry." 57 | :tag "Gnorb Registry" 58 | :group 'gnorb) 59 | 60 | (defun gnorb-registry-make-entry (msg-id sender subject org-id group) 61 | "Create a Gnus registry entry for a message, either received or 62 | sent. Save the relevant Org ids in the 'gnorb-ids key." 63 | ;; This set-id-key stuff is actually horribly 64 | ;; inefficient. 65 | (when gnorb-tracking-enabled 66 | (gnus-registry-get-or-make-entry msg-id) 67 | (when sender 68 | (gnus-registry-set-id-key msg-id 'sender (list sender))) 69 | (when subject 70 | (gnus-registry-set-id-key msg-id 'subject (list subject))) 71 | (when org-id 72 | (let ((ids (gnus-registry-get-id-key msg-id 'gnorb-ids))) 73 | (unless (member org-id ids) 74 | (gnus-registry-set-id-key msg-id 'gnorb-ids (if (stringp org-id) 75 | (cons org-id ids) 76 | (append org-id ids)))))) 77 | (when group 78 | (gnus-registry-set-id-key msg-id 'group (list group))) 79 | (gnus-registry-get-or-make-entry msg-id))) 80 | 81 | (defun gnorb-registry-capture () 82 | "When capturing from a Gnus message, add our new Org heading id 83 | to the message's registry entry, under the 'gnorb-ids key." 84 | (when (and (with-current-buffer 85 | (org-capture-get :original-buffer) 86 | (memq major-mode '(gnus-summary-mode gnus-article-mode))) 87 | (not org-note-abort)) 88 | (let* ((msg-id 89 | (gnorb-bracket-message-id 90 | (plist-get org-store-link-plist :message-id))) 91 | (org-id (org-id-get-create))) 92 | (plist-put org-capture-plist :gnorb-id org-id) 93 | (gnorb-registry-make-entry msg-id nil nil org-id nil)))) 94 | 95 | 96 | (defun gnorb-registry-capture-abort-cleanup () 97 | (when (and (org-capture-get :gnorb-id) 98 | org-note-abort) 99 | (with-no-warnings ; For `abort-note' 100 | (condition-case nil 101 | (let* ((msg-id (format "<%s>" (plist-get org-store-link-plist :message-id))) 102 | (existing-org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids)) 103 | (org-id (org-capture-get :gnorb-id))) 104 | (when (member org-id existing-org-ids) 105 | (gnus-registry-set-id-key msg-id 'gnorb-ids 106 | (remove org-id existing-org-ids))) 107 | (setq abort-note 'clean)) 108 | (error 109 | (setq abort-note 'dirty)))))) 110 | 111 | (defun gnorb-find-visit-candidates (ids &optional include-zombies) 112 | "For all message-ids in IDS (which should be a list of 113 | Message-ID strings, with angle brackets, or a single string of 114 | Message-IDs), produce a list of Org ids for headings that are 115 | relevant to that message. 116 | 117 | If optional argument INCLUDE_ZOMBIES is non-nil, return ID values 118 | even for headings that appear to no longer exist." 119 | (let (ret-val sub-val) 120 | (when (stringp ids) 121 | (setq ids (gnus-extract-references ids))) 122 | (when gnorb-tracking-enabled 123 | (setq ids (delete-dups ids)) 124 | (progn 125 | (dolist (id ids) 126 | (when 127 | (setq sub-val 128 | (gnus-registry-get-id-key id 'gnorb-ids)) 129 | (setq ret-val (append sub-val ret-val)))))) 130 | ;; This lets us be reasonably confident that the 131 | ;; headings still exist. 132 | (unless include-zombies 133 | (cl-remove-if-not 134 | (lambda (org-id) 135 | (org-id-find-id-file org-id)) 136 | ret-val)) 137 | (delete-dups ret-val))) 138 | 139 | (defun gnorb-delete-association (msg-id org-id) 140 | "Disassociate a message and a headline. 141 | 142 | This removes an Org heading's ORG-ID from the 'gnorb-ids key of 143 | the MSG-ID." 144 | (let ((org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))) 145 | (when (member org-id org-ids) 146 | (gnus-registry-set-id-key msg-id 'gnorb-ids 147 | (remove org-id org-ids))))) 148 | 149 | (defun gnorb-delete-all-associations (org-id) 150 | "Delete all message associations for an Org heading. 151 | 152 | The heading is identified by ORG-ID. This is suitable for use 153 | after an Org heading is deleted, for instance." 154 | (let ((assoc-msgs (gnorb-registry-org-id-search org-id)) 155 | (gnorb-id-tracker 156 | (registry-lookup-secondary gnus-registry-db 'gnorb-ids))) 157 | (mapc 158 | (lambda (msg-id) 159 | (let ((org-ids 160 | (gnus-registry-get-id-key msg-id 'gnorb-ids))) 161 | (gnus-registry-set-id-key 162 | msg-id 'gnorb-ids (remove org-id org-ids)))) 163 | assoc-msgs) 164 | (remhash org-id gnorb-id-tracker))) 165 | 166 | (defun gnorb-flush-dead-associations (&optional clean-archived) 167 | "Clean the registry of associations with nonexistent headings. 168 | 169 | Gnus will not prune registry entries that appear to be associated 170 | with an Org heading. If your registry is limited to a very small 171 | size, you may end up with a full registry. Use this function to 172 | remove dead associations, and free up more entries for possible 173 | pruning. 174 | 175 | By default, associations are considered \"live\" if the Org 176 | heading exists in an Org file or in an Org archive file. When 177 | optional CLEAN_ARCHIVED is non-nil, delete associations from 178 | archived headings as well." 179 | (interactive "P") 180 | (let ((gnorb-id-tracker 181 | (registry-lookup-secondary gnus-registry-db 'gnorb-ids)) 182 | (deleted-count 0)) 183 | (require 'org-id) 184 | (maphash 185 | (lambda (k _) 186 | (let ((file (org-id-find-id-file k))) 187 | (when (or (not file) 188 | (and clean-archived 189 | (string-match-p "org_archive$" file))) 190 | (gnorb-delete-all-associations k) 191 | (incf deleted-count)))) 192 | gnorb-id-tracker) 193 | (message "Deleted %d invalid associations" 194 | deleted-count))) 195 | 196 | (defun gnorb-registry-org-id-search (id) 197 | "Find all messages that have the org ID in their 'gnorb-ids 198 | key." 199 | (registry-search gnus-registry-db :member `((gnorb-ids ,id)))) 200 | 201 | (defun gnorb-registry-tracked-messages () 202 | "Return all message-ids that have non-empty 'gnorb-ids keys." 203 | (registry-search gnus-registry-db :regex `((gnorb-ids ".+")))) 204 | 205 | (defun gnorb-registry-tracked-headings () 206 | "Return all Org heading ids that are associated with messages." 207 | (hash-table-keys 208 | (registry-lookup-secondary gnus-registry-db 'gnorb-ids))) 209 | 210 | (defun gnorb-report-tracking-usage () 211 | "Pop up a temporary window reporting on Gnorb usage of the Gnus 212 | registry to track message/heading associations. Reports the 213 | number of tracked messages, the number of tracked headings, and how much of the registry is occupied." 214 | (interactive) 215 | (progn 216 | (pop-to-buffer 217 | (get-buffer-create "*Gnorb Usage*") 218 | '(nil . ((window-height . 10)))) 219 | (gnorb-refresh-usage-status) 220 | (special-mode) 221 | (setq revert-buffer-function #'gnorb-refresh-usage-status) 222 | (local-set-key (kbd "d") (lambda () 223 | (interactive) 224 | (progn 225 | (gnorb-flush-dead-associations) 226 | (gnorb-refresh-usage-status)))) 227 | (local-set-key (kbd "D") (lambda () 228 | (interactive) 229 | (progn 230 | (gnorb-flush-dead-associations t) 231 | (gnorb-refresh-usage-status)))))) 232 | 233 | (defun gnorb-refresh-usage-status () 234 | "Clear and re-format the *Gnorb Usage* buffer." 235 | (let ((messages (length (gnorb-registry-tracked-messages))) 236 | (headings (length (gnorb-registry-tracked-headings))) 237 | (reg-size (registry-size gnus-registry-db)) 238 | (reg-max-size (if (slot-exists-p gnus-registry-db 'max-size) 239 | (oref gnus-registry-db max-size) 240 | (oref gnus-registry-db max-hard)))) 241 | (with-current-buffer "*Gnorb Usage*" 242 | (let ((inhibit-read-only t)) 243 | (erase-buffer) 244 | (insert 245 | (format 246 | "Tracking %d Gnus messages associated with %d Org headings." 247 | messages headings)) 248 | (insert "\n\n") 249 | (insert 250 | (format 251 | "Occupying %.2f%% (%d/%d) of the registry (max %d)." 252 | (* 100 (/ (float messages) reg-size)) 253 | messages reg-size reg-max-size)) 254 | (insert "\n\n") 255 | (insert "Press 'd' to delete associations for non-existent Org headings.\n") 256 | (insert "Press 'D' to delete associations for both non-existent and archived Org headings."))))) 257 | 258 | (defun gnorb-registry-transition-from-props (arg) 259 | "Helper function for transitioning the old tracking system to the new. 260 | 261 | The old system relied on storing sent message ids on relevant Org 262 | headings, in the `gnorb-org-msg-id-key' property. The new system 263 | uses the gnus registry to track relations between messages and 264 | Org headings. This function will go through your agenda files, 265 | find headings that have the `gnorb-org-msg-id-key' property set, 266 | and create new registry entries that reflect that connection. 267 | 268 | Call with a prefix arg to additionally delete the 269 | `gnorb-org-msg-id-key' altogether from your Org headings. As this 270 | function will not create duplicate registry entries, it's safe to 271 | run it once with no prefix arg, to keep the properties in place, 272 | and then once you're sure everything's working okay, run it again 273 | with a prefix arg, to clean the Gnorb-specific properties from 274 | your Org files." 275 | (interactive "P") 276 | (let ((count 0)) 277 | (message "Collecting all relevant Org headings, this could take a while...") 278 | (org-map-entries 279 | (lambda () 280 | (let ((id (org-id-get)) 281 | (props (org-entry-get-multivalued-property 282 | (point) gnorb-org-msg-id-key)) 283 | links) 284 | (when props 285 | ;; If the property is set, we should probably assume that any 286 | ;; Gnus links in the subtree are relevant, and should also be 287 | ;; collected and associated. 288 | (setq links (gnorb-scan-links 289 | (org-element-property :end (org-element-at-point)) 290 | 'gnus)) 291 | (dolist (l (plist-get links :gnus)) 292 | (gnorb-registry-make-entry 293 | (cl-second (split-string l "#")) nil nil 294 | id (cl-first (split-string l "#")))) 295 | (dolist (p props) 296 | (gnorb-registry-make-entry p nil nil id nil) 297 | ;; This function will try to find the group for the message 298 | ;; and set that value on the registry entry if it can find 299 | ;; it. 300 | (unless (gnus-registry-get-id-key p 'group) 301 | (gnorb-msg-id-to-group p)) 302 | (cl-incf count))))) 303 | gnorb-org-find-candidates-match 304 | 'agenda 'archive 'comment) 305 | (message "Collecting all relevant Org headings, this could take a while... done") 306 | ;; Delete the properties if the user has asked us to do so. 307 | (if (equal arg '(4)) 308 | (progn 309 | (dolist (f (org-agenda-files)) 310 | (with-current-buffer (get-file-buffer f) 311 | (org-delete-property-globally gnorb-org-msg-id-key))) 312 | (message "%d entries created; all Gnorb-specific properties deleted." 313 | count)) 314 | (message "%d entries created." count)))) 315 | 316 | (provide 'gnorb-registry) 317 | -------------------------------------------------------------------------------- /gnorb-utils.el: -------------------------------------------------------------------------------- 1 | ;;; gnorb-utils.el --- Common utilities for all gnorb stuff -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 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 . 20 | 21 | ;;; Commentary: 22 | 23 | ;; 24 | 25 | ;;; Code: 26 | 27 | (eval-when-compile (require 'cl-lib)) 28 | (require 'pcase) 29 | (require 'org) 30 | (require 'org-agenda) 31 | (require 'org-element) 32 | 33 | (require 'mailcap) 34 | (mailcap-parse-mimetypes) 35 | 36 | (defgroup gnorb nil 37 | "Glue code between Gnus, Org, and BBDB." 38 | :tag "Gnorb" 39 | :group 'mail) 40 | 41 | (make-obsolete-variable 42 | 'gnorb-trigger-todo-default 43 | "This variable has been superseded by 44 | `gnorb-org-trigger-actions'" 45 | "September 8, 2014" 'set) 46 | 47 | (defvar gnorb-tmp-dir (make-temp-file "emacs-gnorb" t) 48 | "Temporary directory where attachments etc are saved.") 49 | 50 | (defvar gnorb-message-org-ids nil 51 | "List of Org heading IDs from the outgoing Gnus message, used 52 | to mark mail TODOs as done once the message is sent." 53 | ;; The send hook either populates this, or sets it to nil, depending 54 | ;; on whether the message in question has an Org id header. Then 55 | ;; `gnorb-org-restore-after-send' checks for it and acts 56 | ;; appropriately, then sets it to nil. 57 | ) 58 | 59 | (defvar gnorb-window-conf nil 60 | "Save window configurations here, for restoration after mails 61 | are sent, or Org headings triggered.") 62 | 63 | (defvar gnorb-return-marker (make-marker) 64 | "Return point here after various actions, to be used together 65 | with `gnorb-window-conf'.") 66 | 67 | (defvar gnorb-trigger-capture-location nil 68 | "Marker pointing at the location where we want to place capture 69 | templates, for the capture-to-child and capture-to-sibling 70 | trigger actions.") 71 | 72 | (defcustom gnorb-mail-header "X-Org-ID" 73 | "Name of the mail header used to store the ID of a related Org 74 | heading. Only used locally: always stripped when the mail is 75 | sent." 76 | :group 'gnorb 77 | :type 'string) 78 | 79 | ;;; this is just ghastly, but the value of this var is single regexp 80 | ;;; group containing various header names, and we want our value 81 | ;;; inside that group. 82 | (eval-after-load 'message 83 | `(let ((ign-headers-list 84 | (split-string message-ignored-mail-headers 85 | "|")) 86 | (our-val (concat gnorb-mail-header "\\"))) 87 | (unless (member our-val ign-headers-list) 88 | (setq ign-headers-list 89 | `(,@(butlast ign-headers-list 1) ,our-val 90 | ,@(last ign-headers-list 1))) 91 | (setq message-ignored-mail-headers 92 | (mapconcat 93 | 'identity ign-headers-list "|"))))) 94 | 95 | ;;;###autoload 96 | (defun gnorb-restore-layout () 97 | "Restore window layout and value of point after a Gnorb command. 98 | 99 | Some Gnorb commands change the window layout (ie `gnorb-org-view' 100 | or incoming email triggering). This command restores the layout 101 | to what it was. Bind it to a global key, or to local keys in Org 102 | and Gnus and BBDB maps." 103 | (interactive) 104 | (when (window-configuration-p gnorb-window-conf) 105 | (select-frame-set-input-focus 106 | (window-configuration-frame gnorb-window-conf)) 107 | (set-window-configuration gnorb-window-conf) 108 | (when (buffer-live-p (marker-buffer gnorb-return-marker)) 109 | (goto-char gnorb-return-marker)))) 110 | 111 | (defun gnorb-bracket-message-id (id) 112 | "Ensure message-id ID is bound by angle brackets." 113 | ;; Always use a message-id with angle brackets around it. 114 | ;; `gnus-summary-goto-article' can handle either, but 115 | ;; `gnus-request-head' will fail without brackets IF you're 116 | ;; requesting from an nntp group. Mysterious. 117 | (unless (string-match "\\`<" id) 118 | (setq id (concat "<" id))) 119 | (unless (string-match ">\\'" id) 120 | (setq id (concat id ">"))) 121 | id) 122 | 123 | (defun gnorb-unbracket-message-id (id) 124 | "Ensure message-id ID is NOT bound by angle brackets." 125 | ;; This shit is annoying, but Org wants an id with no brackets, and 126 | ;; Gnus is safest with an id that has brackets. So here we are. 127 | (replace-regexp-in-string "\\(\\`<\\|>\\'\\)" "" id)) 128 | 129 | (defun gnorb-reply-to-gnus-link (link) 130 | "Start a reply to the linked message." 131 | (let* ((link (org-link-unescape link)) 132 | (group (car (org-split-string link "#"))) 133 | (id (gnorb-bracket-message-id 134 | (second (org-split-string link "#")))) 135 | (backend 136 | (car (gnus-find-method-for-group group)))) 137 | (gnorb-follow-gnus-link group id) 138 | (call-interactively 139 | (if (eq backend 'nntp) 140 | 'gnus-summary-followup-with-original 141 | 'gnus-summary-wide-reply-with-original)))) 142 | 143 | (defun gnorb-follow-gnus-link (group id) 144 | "Be a little clever about following gnus links. 145 | 146 | The goal here is reuse frames and windows as much as possible, so 147 | we're not opening multiple windows on the *Group* buffer, for 148 | instance, and messing up people's layouts. There also seems to be 149 | an issue when opening a link to a message whose *Summary* buffer 150 | is already visible: somehow, after following the link, point ends 151 | up on the message _after_ the one we want, and things go haywire. 152 | 153 | So we try to be a little clever. The logical progression here is 154 | this: 155 | 156 | 1. If the link's target group is already open in a *Summary* 157 | buffer, just switch to that buffer (if it's visible in any frame 158 | then raise it and switch focus, otherwise pull it into the 159 | current window) and go to the message with 160 | `gnus-summary-goto-article'. 161 | 162 | 2. If the Gnus *Group* buffer is visible in any window or frame, 163 | raise that frame/window and give it focus before following the 164 | link. 165 | 166 | 3. Otherwise just follow the link as usual, in the current 167 | window." 168 | (unless (gnus-alive-p) 169 | (gnus)) 170 | (let* ((sum-buffer (gnus-summary-buffer-name group)) 171 | (target-buffer 172 | (cond 173 | ((gnus-buffer-exists-p sum-buffer) 174 | sum-buffer) 175 | ((gnus-buffer-exists-p gnus-group-buffer) 176 | gnus-group-buffer) 177 | (t nil))) 178 | (target-window (when target-buffer 179 | (get-buffer-window target-buffer t)))) 180 | (if target-window 181 | ;; Our target buffer is displayed somewhere: just go there. 182 | (progn 183 | (select-frame-set-input-focus 184 | (window-frame target-window)) 185 | (switch-to-buffer target-buffer)) 186 | ;; Our target buffer exists, but isn't displayed: pull it up. 187 | (if target-buffer 188 | (switch-to-buffer target-buffer))) 189 | (message "Following link...") 190 | (if (gnus-buffer-exists-p sum-buffer) 191 | (gnus-summary-goto-article id nil t) 192 | (gnorb-open-gnus-link group id)))) 193 | 194 | (defun gnorb-open-gnus-link (group id) 195 | "Gnorb version of `org-gnus-follow-link'." 196 | ;; We've probably already bracketed the id, but just in case this is 197 | ;; called from elsewhere... 198 | (let* ((id (gnorb-bracket-message-id id)) 199 | (arts (gnus-group-unread group)) 200 | artno success) 201 | (or (setq artno (car (gnus-registry-get-id-key id 'artno))) 202 | (progn 203 | (setq artno (cdr (gnus-request-head id group))) 204 | (gnus-registry-set-id-key id 'artno (list artno)))) 205 | (gnus-activate-group group) 206 | (setq success (gnus-group-read-group arts t group)) 207 | (if success 208 | (gnus-summary-goto-article artno nil t) 209 | (signal 'error "Group could not be opened.")))) 210 | 211 | ;; I'd like to suggest this as a general addition to Emacs. *Very* 212 | ;; tired of abusing `completing-read' for this purpose. 213 | (defconst gnorb-select-valid-chars 214 | (append (number-sequence 97 122) 215 | (number-sequence 65 90)) 216 | "A list of characters that are suitable for using as selection 217 | keys.") 218 | 219 | (defvar gnorb-select-choice-buffer "*Selections*" 220 | "The name of the buffer used to pop up selections.") 221 | 222 | (defun gnorb-select-from-list (prompt collection &optional key-func) 223 | "Prompt the user to select something from COLLECTION. 224 | 225 | Selection can happen in a few different ways, depending on the 226 | nature of COLLECTION. Its elements can be: 227 | 228 | 1. A plain string. Simply default to `completing-read'. 229 | 230 | 2. (string object). The function uses `completing-read' on the 231 | strings, returning the selected object. 232 | 233 | 3. (number object). As above, but the user enters a number. 234 | 235 | 4. (character string object). As #3, but \"string\" is displayed 236 | as a string label for object. 237 | 238 | 5. (number string object). As above, with numbers. 239 | 240 | COLLECTION can be passed in ready-made. Alternately, KEY-FUNC 241 | can be provided. The collection will be constructed by mapping 242 | this function over the list of objects, and then appending each 243 | object to the corresponding result. In other words, KEY-FUNC 244 | should return one of the types above, minus the final \"object\" 245 | element. 246 | 247 | Alternately, KEY-FUNC can be the symbol 'char, in which case the 248 | elements of COLLECTION will automatically be keyed to ascending 249 | characters (52 or fewer), or 'number, which does the same with 250 | numbers (no upper bound)." 251 | (interactive) 252 | (let ((len (length collection))) 253 | (cl-labels ((pop-up-selections 254 | (collection &optional charp) 255 | (pop-to-buffer gnorb-select-choice-buffer 256 | '(display-buffer-in-side-window ((side . bottom))) t) 257 | (dolist (c collection) 258 | (insert (format "%s: %s\n" 259 | (if charp 260 | (char-to-string (car c)) 261 | (car c)) 262 | (nth 1 c)))))) 263 | (setq collection 264 | (pcase key-func 265 | ((pred null) 266 | collection) 267 | ('char 268 | (if (> len 52) 269 | (error "Use the char option with fewer than 52 items") 270 | ;; These distinctions between char/string 271 | ;; and number/char are totally manufactured. 272 | (seq-mapn #'list gnorb-select-valid-chars collection))) 273 | ('number 274 | (seq-mapn #'list (number-sequence 1 len) collection)) 275 | ((and func (pred functionp)) 276 | (seq-map (lambda (el) 277 | (let ((res (funcall func el))) 278 | (if (atom res) 279 | (list res el) 280 | (append res 281 | (list el))))) 282 | collection)) 283 | (_ (error "Invalid key-func: %s" key-func)))) 284 | ;; We only test the car of collection to see what type it is. If 285 | ;; elements are mismatched, it's not our problem. 286 | (unwind-protect 287 | (pcase (car collection) 288 | ((pred stringp) 289 | (completing-read prompt collection nil t)) 290 | ((pred symbolp) 291 | (intern-soft (completing-read prompt collection nil t))) 292 | (`(,(pred stringp) ,_) 293 | (nth 1 (assoc (completing-read prompt collection nil t) 294 | collection))) 295 | ;; Looks like pcase might be the wrong tool for this job. 296 | ((or `(,(and c (pred numberp) (guard (memq c gnorb-select-valid-chars))) ,_) 297 | `(,(and c (pred numberp) (guard (memq c gnorb-select-valid-chars))) ,_ ,_)) 298 | (pop-up-selections collection t) 299 | (car (last (assq (read-char 300 | (propertize prompt 'face 'minibuffer-prompt)) 301 | collection)))) 302 | ((or `(,(pred numberp) ,_) 303 | `(,(pred numberp) ,_ ,_)) 304 | (pop-up-selections collection) 305 | (car (last (assq (read-number prompt) 306 | collection))))) 307 | (when-let ((win (get-buffer-window gnorb-select-choice-buffer))) 308 | (quit-window win)))))) 309 | 310 | (defun gnorb-trigger-todo-action (_arg &optional id) 311 | "Do the actual restore action. Two main things here. First: if 312 | we were in the agenda when this was called, then keep us in the 313 | agenda. Then let the user choose an action from the value of 314 | `gnorb-org-trigger-actions'." 315 | (let* ((agenda-p (eq major-mode 'org-agenda-mode)) 316 | (root-marker 317 | (cond (agenda-p 318 | (copy-marker 319 | (org-get-at-bol 'org-hd-marker))) 320 | ((derived-mode-p 'org-mode) 321 | (save-excursion 322 | (org-back-to-heading) 323 | (point-marker))) 324 | (id 325 | (save-excursion 326 | (org-id-goto id) 327 | (org-back-to-heading) 328 | (point-marker))))) 329 | (id (or id 330 | (org-with-point-at root-marker 331 | (org-id-get-create)))) 332 | (action (gnorb-select-from-list 333 | (format 334 | "Trigger action on %s: " 335 | (gnorb-pretty-outline id)) 336 | gnorb-org-trigger-actions))) 337 | (unless agenda-p 338 | (org-reveal)) 339 | (cl-labels 340 | ((make-entry 341 | (id) 342 | (gnorb-registry-make-entry 343 | (plist-get gnorb-gnus-message-info :msg-id) 344 | (plist-get gnorb-gnus-message-info :from) 345 | (plist-get gnorb-gnus-message-info :subject) 346 | id 347 | (plist-get gnorb-gnus-message-info :group)))) 348 | ;; Handle our action. 349 | (if (fboundp action) 350 | (org-with-point-at root-marker 351 | (make-entry (org-id-get-create)) 352 | (funcall action gnorb-gnus-message-info)) 353 | (cl-case action 354 | (note 355 | (org-with-point-at root-marker 356 | (make-entry (org-id-get-create)) 357 | (call-interactively 'org-add-note))) 358 | (todo 359 | (if agenda-p 360 | (progn 361 | (org-with-point-at root-marker 362 | (make-entry (org-id-get-create))) 363 | (call-interactively 'org-agenda-todo)) 364 | (org-with-point-at root-marker 365 | (make-entry (org-id-get-create)) 366 | (call-interactively 'org-todo)))) 367 | (no-associate 368 | nil) 369 | (associate 370 | (org-with-point-at root-marker 371 | (make-entry (org-id-get-create)))) 372 | ;; We're going to capture a new heading 373 | ((cap-child cap-sib) 374 | (org-with-point-at root-marker 375 | (setq gnorb-trigger-capture-location (point-marker))) 376 | (let ((entry 377 | ;; Pick a template. 378 | (copy-sequence (org-capture-select-template)))) 379 | ;; Do surgery on that template so that it finds its 380 | ;; location using our function. 381 | (setf (nth 3 entry) 382 | `(function 383 | ,(if (eq action 'cap-child) 384 | #'gnorb-trigger-capture-child 385 | #'gnorb-trigger-capture-sibling))) 386 | ;; This will likely fail horribly for capture templates 387 | ;; that aren't entries or list items. 388 | (let ((org-capture-entry entry)) 389 | ;; When org-capture-entry is let-bound, the capture 390 | ;; process will use that template instead of 391 | ;; prompting the user. Also, `gnorb-registry-capture' 392 | ;; will take care of making the registry entry for us. 393 | (call-interactively 'org-capture))))))) 394 | ;; Lastly, query about attaching email attachments. No matter what 395 | ;; happens, clear `gnorb-gnus-capture-attachments'. 396 | (unwind-protect 397 | (org-with-point-at 398 | (if (memq action '(cap-child cap-sib)) 399 | (point) 400 | root-marker) 401 | (map-y-or-n-p 402 | (lambda (a) 403 | (format "Attach %s to heading? " 404 | (file-name-nondirectory a))) 405 | (lambda (a) 406 | (with-demoted-errors 407 | (org-attach-attach a nil 'mv))) 408 | gnorb-gnus-capture-attachments 409 | '("file" "files" "attach"))) 410 | (setq gnorb-gnus-capture-attachments nil)))) 411 | 412 | (defun gnorb-trigger-capture-child () 413 | ;; The capture process creates a child by default 414 | (org-goto-marker-or-bmk gnorb-trigger-capture-location) 415 | (org-back-to-heading)) 416 | 417 | (defun gnorb-trigger-capture-sibling () 418 | ;; This only works if we're not trying to create a sibling for a 419 | ;; top-level heading, there appears to be no way to do that. But in 420 | ;; that case this trigger action isn't really necessary, just 421 | ;; handle it with a regular capture. 422 | (org-goto-marker-or-bmk gnorb-trigger-capture-location) 423 | (org-up-heading-safe)) 424 | 425 | (defun gnorb-pretty-outline (id &optional kw) 426 | "Return pretty outline path of the Org heading indicated by ID. 427 | 428 | If the KW argument is true, add the TODO keyword into the path." 429 | (let ((pt (org-id-find id t))) 430 | (if pt 431 | (org-with-point-at pt 432 | (let ((el (org-element-at-point))) 433 | (concat 434 | (if kw 435 | (format "(%s): " 436 | (org-element-property :todo-keyword el)) 437 | "") 438 | (org-format-outline-path 439 | (append 440 | (list 441 | (file-name-nondirectory 442 | (buffer-file-name 443 | (org-base-buffer (current-buffer))))) 444 | (org-get-outline-path) 445 | (list 446 | (replace-regexp-in-string 447 | org-bracket-link-regexp 448 | "\\3" (org-element-property :raw-value el)))))))) 449 | "[none]"))) 450 | 451 | (defun gnorb-scan-links (bound &rest types) 452 | "Scan from point to BOUND looking for links of type in TYPES. 453 | 454 | TYPES is a list of symbols, possible values include 'bbdb, 'mail, 455 | and 'gnus." 456 | ;; this function could be refactored somewhat -- lots of code 457 | ;; repetition. It also should be a little faster for when we're 458 | ;; scanning for gnus links only, that's a little slow. We should 459 | ;; probably use a different regexp based on the value of TYPES. 460 | ;; 461 | ;; This function should also *not* be responsible for unescaping 462 | ;; links -- we don't know what they're going to be used for, and 463 | ;; unescaped is safer. 464 | (unless (= (point) bound) 465 | (let (addr gnus mail bbdb) 466 | (while (re-search-forward org-any-link-re bound t) 467 | (setq addr (or (match-string-no-properties 2) 468 | (match-string-no-properties 0))) 469 | (cond 470 | ((and (memq 'gnus types) 471 | (string-match "^ 9 | 10 | ;; Author: Eric Abrahamsen 11 | ;; Keywords: mail org gnus bbdb todo task 12 | 13 | ;; URL: https://github.com/girzel/gnorb 14 | 15 | ;; This program is free software; you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation, either version 3 of the License, or 18 | ;; (at your option) any later version. 19 | 20 | ;; This program is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with this program. If not, see . 27 | 28 | ;;; Commentary: 29 | 30 | ;; Load this file to load everything. 31 | 32 | ;;; Code: 33 | 34 | (with-eval-after-load 'gnus 35 | (require 'nngnorb) 36 | (require 'gnorb-gnus) 37 | (require 'gnorb-registry)) 38 | (with-eval-after-load 'bbdb 39 | (require 'gnorb-bbdb)) 40 | (with-eval-after-load 'org 41 | (require 'gnorb-org)) 42 | 43 | 44 | (provide 'gnorb) 45 | ;;; gnorb.el ends here 46 | -------------------------------------------------------------------------------- /gnorb.org: -------------------------------------------------------------------------------- 1 | #+TEXINFO_CLASS: info 2 | #+TEXINFO_HEADER: @syncodeindex pg cp 3 | #+TITLE: Gnorb Manual 4 | #+SUBTITLE: for version 1, updated 3 October, 2014 5 | #+TEXINFO_DIR_CATEGORY: Emacs 6 | #+TEXINFO_DIR_TITLE: Gnorb: (gnorb) 7 | #+TEXINFO_DIR_DESC: Glue code for Gnus, Org, and BBDB 8 | #+OPTIONS: *:nil num:t toc:nil 9 | * Introduction 10 | 11 | Gnorb provides glue code between the Gnus, Org, and BBDB packages. 12 | It's aimed at supporting email-based project management, and generally 13 | making it easier to keep track of email communication. 14 | 15 | Much of the code consists of single-use convenience functions, but 16 | tracking email conversations with Org requires is more complicated, 17 | and requires a bit of setup. 18 | 19 | Gnorb can be used in a modular fashion, by selectively loading the 20 | files "gnorb-org", "gnorb-gnus" or "gnorb-bbdb" instead of plain old 21 | "gnorb". The package as a whole is rather Org-centric, though, and it 22 | won't do much of interest without "gnorb-org". 23 | 24 | This means that Gnorb doesn't have hard requirements to any of the 25 | three base libraries. For the libraries you are using, however, you'll 26 | get best results from using the most recent stable version (yes, that 27 | means BBDB 3). Some of the features in Gnorb only work with 28 | development versions of these libraries (those cases are noted below). 29 | * Installation 30 | Gnorb is best installed via the Elpa package manager -- look for it in 31 | `list-packages'. 32 | 33 | You can also clone the source code from 34 | https://github.com/girzel/gnorb, and put the "gnorb" directory on your 35 | load-path. The Github site is also a good place to report bugs and 36 | other issues. 37 | * Setup 38 | :PROPERTIES: 39 | :ID: 9da59609-bb3c-4970-88f6-bddca18d2ad4 40 | :END: 41 | Loading "gnorb" will make the basic functions available. Using Gnorb 42 | for email tracking takes a bit more setup, however: 43 | 44 | 1. Email tracking is done via the Gnus registry, so that must be 45 | activated with 'gnus-registry-initialize'. 46 | 2. It also requires the org-id package to be loaded, and 47 | `org-id-track-globally' set to t (that's the default value, so 48 | simply loading the package should be enough). 49 | 3. Add a nngnorb entry to your `gnus-secondary-select-methods' 50 | variable. It will look like (nngnorb "Server name"). This does 51 | nothing but provide a place to hang nnir searches. 52 | 4. Then put a call to `gnorb-tracking-initialize' in your init files, 53 | at some point after the Gnus registry is initialized. 54 | 5. If you're not using a local archive method for saving your sent 55 | messages (ie you're using IMAP), you'll also need to tell Gnorb 56 | where to find your sent messages. Set the variable 57 | `gnorb-gnus-sent-groups' to a list of strings; each string should 58 | indicate a fully-qualified group name, eg "nnimap+SERVER:GROUP". 59 | 60 | Lastly, Gnorb doesn't bind any keys by default; see the [[id:de1b2579-86c2-4bb1-b77e-3467a3d2b3c7][Suggested 61 | Keybindings]] section below for possibilities. 62 | * Email Tracking 63 | The most interesting thing Gnorb does is using Org headings to track 64 | email conversations. This can mean anything from reminding yourself to 65 | write to your mother, to conducting delicate business negotiations 66 | over email, to running an email-based bug tracker. 67 | 68 | Gnorb assists in this process by using the Gnus registry to track 69 | correspondences between emails and Org headings -- specifically, 70 | message IDs are associated with Org heading ids. As a conversation 71 | develops, messages are collected on a heading (and/or its children). 72 | You can compose new messages directly from the Org heading, and Gnorb 73 | will automatically associate your sent message with the conversation. 74 | You can open Gnus *Summary* buffers holding all the messages 75 | associated with an Org subtree, and reply from there -- these groups 76 | can be made persistent, if you like. When you receive new messages 77 | relevant to a conversation, Gnorb will notice them and prompt you to 78 | associate them with the appropriate Org heading. Attachments on 79 | incoming messages can be automatically saved as attachments on Org 80 | headings, using org-attach. 81 | 82 | In general, the goal is to keep track of whole conversations, reduce 83 | friction when moving between Gnus and Org, and keep you in the Org 84 | agenda rather than in Gnus. 85 | ** Basic Usage 86 | The following sections might be a bit confusing to read if you haven't 87 | actually tried using Gnorb. If you don't want to dive in all the way 88 | just yet, you can just dabble your toes. First set up email tracking 89 | as specified in [[id:9da59609-bb3c-4970-88f6-bddca18d2ad4][Setup]], then do the following: 90 | 91 | 1. Add "%ug" somewhere appropriate in your `gnus-summary-line-format' 92 | variable. 93 | 2. If you don't use a local archive method, add your sent message 94 | groups to `gnorb-gnus-sent-groups' (see the docstring). 95 | 3. Use Org capture from Gnus summary buffers to create reminders for 96 | emails you need to reply to. 97 | 4. Reply to those emails by pressing "C-c t" on the TODO heading in 98 | either the Agenda, or in regular Org files. 99 | 5. If you ever get confused about what's associated with an Org 100 | heading, press "C-c v" on the heading (works in either the Agenda, 101 | or regular Org files). 102 | 103 | That should be enough to get started. 104 | ** Email-Related Commands 105 | Email tracking starts in one of three ways: 106 | 107 | 1. With an Org heading that represents an email TODO. Call 108 | `gnorb-org-handle-mail' (see below) on the heading to compose a new 109 | message, and start the tracking process. 110 | 2. By calling org-capture on a received message. Any heading captured 111 | from a message will automatically be associated with that message. 112 | 3. By calling `gnorb-gnus-outgoing-do-todo' in a message composition 113 | buffer -- see below. 114 | 115 | There are three main email-related commands: 116 | 117 | 1. `gnorb-org-handle-mail' is called on an Org heading to compose a 118 | new message. By default, this will begin a reply to the most recent 119 | message in the conversation. If there are no associated messages to 120 | reply to (or you call the function with a single prefix arg), Gnorb 121 | will look for mailto: or bbdb: links in the heading, and compose a 122 | new message to them. 123 | 124 | Calling the function with a double prefix arg will ignore all 125 | associated messages and links, and compose a blank message. 126 | 127 | Once sent, the message will be associated with the Org heading, and 128 | you'll be brought back to the heading and asked to trigger an 129 | action on it. 130 | 131 | `gnorb-email-subtree' is an alternative entry-point to 132 | `gnorb-org-handle-mail'. It does the same thing as the latter, but 133 | first exports the body of the subtree as either text or a file, 134 | then inserts the text into the message body, or attaches the file 135 | to the message, respectively. 136 | 2. `gnorb-gnus-incoming-do-todo' is called on a message in a Gnus 137 | *Summary* buffer. You'll be prompted for an Org heading, taken to 138 | that heading, and asked to trigger an action on it. 139 | 3. `gnorb-gnus-outgoing-do-todo' is called in message mode, while 140 | composing a new message. 141 | 142 | If called without a prefix arg, a new Org heading will be created 143 | after the message is sent, and the sent message associated with it. 144 | The new heading will be created as a capture heading, using the 145 | template specified by the `gnorb-gnus-new-todo-capture-key' option. 146 | 147 | If you call this function with a single prefix arg, you'll be 148 | prompted to choose an existing Org heading instead. After the the 149 | message is sent, you'll be taken to that heading and prompted to 150 | trigger an action on it. 151 | 152 | If you've called this function, and then realize you've associated 153 | the message with the wrong TODO, call it again with a double prefix 154 | to clear all associations. 155 | 156 | It's also possible to call this function *after* a message is sent, 157 | in case you forgot. Gnorb saves information about the most recently 158 | sent message for this purpose. 159 | 160 | Because these three commands all express a similar intent, but are 161 | called in different modes, it can make sense to give each of them the 162 | same keybinding in the keymaps for Org mode, Gnus summary mode, and 163 | Message mode. 164 | 165 | An additional convenience command is available for use in Gnus summary 166 | buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the 167 | whole round trip of triggering an action and then starting a new 168 | reply, call this command on an incoming message to associate it with a 169 | heading, start a reply, and associate your reply with the same 170 | heading. 171 | ** Trigger Actions 172 | After calling `gnorb-gnus-incoming-do-todo' on a message, or after 173 | sending a message associated with an Org heading, you'll be taken to 174 | the heading and asked to "trigger an action" on it. At the moment 175 | there are six different possibilities: triggering a TODO state-change 176 | on the heading, taking a note on the heading (both these options will 177 | associate the message with the heading), associating the message but 178 | doing nothing else, capturing a new Org heading as a sibling to the 179 | tracked heading, capturing a new Org heading as a child, and lastly, 180 | doing nothing at all. 181 | 182 | More actions may be added in the future; it's also possible to 183 | rearrange or delete existing actions, and add your own: see the 184 | docstring of `gnorb-org-trigger-actions'. 185 | ** Viewing Tracked Messages in *Summary* Buffers 186 | :PROPERTIES: 187 | :END: 188 | Call `gnorb-org-view' on an Org heading to open an nnir summary buffer 189 | showing all the messages associated with that heading and child 190 | headings (this requires you to have added an nngnorb server to your 191 | Gnus backends). A minor mode is in effect, ensuring that any replies 192 | you send to messages in this buffer will automatically be associated 193 | with the original Org heading. You can also invoke 194 | `gnorb-summary-disassociate-message' ("C-c d") to disassociate the 195 | message with the Org heading. 196 | 197 | If you call `gnorb-org-view' with a prefix argument, the search group 198 | will be made persistent across Gnus sessions. You can re-run the 199 | search and update the group contents by hitting "M-g" on the group in 200 | the Gnus *Group* buffer. 201 | 202 | As a bonus, it's possible to go into Gnus' *Server* buffer, find the 203 | line specifying your nngnorb server, and hit "G" (aka 204 | `gnus-group-make-nnir-group'). At the query prompt, enter an Org-style 205 | tags-todo Agenda query string (eg "+work-computer", or what have you). 206 | Gnorb will find all headings matching this query, scan their subtrees 207 | for gnus links, and then give you a Summary buffer containing all the 208 | linked messages. This is dog-slow at the moment; it will get faster. 209 | 210 | ** Hinting in Gnus 211 | :PROPERTIES: 212 | :END: 213 | When you receive new mails that might be relevant to existing Org 214 | TODOs, Gnorb can alert you to that fact. When 215 | `gnorb-gnus-hint-relevant-article' is t (the default), Gnorb will 216 | display a message in the minibuffer when opening potentially relevant 217 | messages. You can then use `gnorb-gnus-incoming-to-todo' to trigger an 218 | action on the relevant TODO. 219 | 220 | This hinting can happen in the Gnus summary buffer as well. If you use 221 | the escape indicated by `gnorb-gnus-summary-mark-format-letter" as 222 | part of your `gnus-summary-line-format', articles that may be relevant 223 | to TODOs will be marked with a special character in the Summary 224 | buffer, as determined by `gnorb-gnus-summary-mark'. By default, the 225 | format letter is "g" (meaning it is used as "%ug" in the format line), 226 | and the mark is "&" for messages that are already tracked, and "¡" for 227 | messages that may be relevant. 228 | ** Message Attachments 229 | :PROPERTIES: 230 | :END: 231 | Gnorb simplifies the handling of attachments that you receive in 232 | emails. When you call `gnorb-gnus-incoming-do-todo' on a message, 233 | you'll be prompted to re-attach the email's attachments onto the Org 234 | heading, using the org-attach library. 235 | 236 | You can also do this as part of the capture process. Set the 237 | new :gnus-attachments key to "t" in a capture template that you use on 238 | mail messages, and you'll be queried to re-attach the message's 239 | attachments onto the newly-captured heading. Or set 240 | `gnorb-gnus-capture-always-attach' to "t" to have Gnorb do this for 241 | all capture templates. 242 | 243 | You can also do this using the regular system of MIME commands, 244 | without invoking the email tracking process. See [[id:de1b2579-86c2-4bb1-b77e-3467a3d2b3c7][Suggested 245 | Keybindings]], below. 246 | 247 | The same process works in reverse: when you send a message from an Org 248 | heading using `gnorb-org-handle-mail', Gnorb will ask if you want to 249 | attach the files in the heading's org-attach directory to the outgoing 250 | message. 251 | ** Registry Usage 252 | You can see how many associations you've got stored in the registry by 253 | calling `gnorb-report-tracking-usage'. This will pop up a buffer 254 | showing how much of the registry you're using, and offering 255 | keybindings for `gnorb-flush-dead-associations', to help Gnorb clean 256 | up after itself. 257 | ** Likely Workflow 258 | You receive an email from Jimmy, who wants to rent a room in your 259 | house. "I'll respond to this later," you think. 260 | 261 | You capture an Org TODO from the email, call it "Jimmy renting a 262 | room", and give it a REPLY keyword. Gnorb quietly records the 263 | correspondence between the email and the TODO, using the Gnus 264 | registry. 265 | 266 | The next day, looking at your Agenda, you see the TODO and decide to 267 | respond to the email. You call `gnorb-org-handle-mail' on the heading, 268 | and Gnorb opens Jimmy's email and starts a reply to it. 269 | 270 | You tell Jimmy the room's available in March, and send the message. 271 | Gnorb takes you back to the heading, and asks you to trigger an action 272 | on it. You choose "todo state", and change the heading keyword to 273 | WAIT. 274 | 275 | Two days later, Jimmy replies to your message, saying that March is 276 | perfect. When you open his response, Gnorb politely reminds you that 277 | the message is relevant to an existing TODO. You call 278 | `gnorb-gnus-incoming-do-todo' on the message, and are again taken to 279 | the TODO and asked to trigger an action. Again you choose "todo 280 | state", and change the heading keyword back to REPLY. 281 | 282 | You get another email, from Samantha, warning you not to rent the room 283 | to Jimmy. She even attaches a picture of a room in her house, as it 284 | looked after Jimmy had stayed there for six months. It's bad. You call 285 | `gnorb-gnus-incoming-do-todo' on her message, and pick the "Jimmy 286 | renting a room" heading. This time, you choose "take note" as the 287 | trigger action, and make a brief note about how bad that room looked. 288 | Gnorb asks if you'd like to attach the picture to the Org heading. You 289 | decide you will. 290 | 291 | Now it's time to write to Jimmy and say something noncommittal. 292 | Calling `gnorb-org-handle-mail' on the heading would respond to 293 | Samantha's email, the most recent of the associated messages, which 294 | isn't what you want. Instead you call `gnorb-org-view' on the heading, 295 | which opens up a Gnus *Summary* buffer containing all four messages: 296 | Jimmy's first, your response, his response to that, and Samantha's 297 | message. You pick Jimmy's second email, and reply to it normally. 298 | Gnorb asks if you'd like to send the picture of the room as an 299 | attachment. You would not. When you send the reply Gnorb tracks that 300 | as well, and does the "trigger an action" trick again. 301 | 302 | In this way Gnorb helps you manage an entire conversation, possibly 303 | with multiple threads and multiple participants. Mostly all you need 304 | to do is call `gnorb-gnus-incoming-do-todo' on newly-received 305 | messages, and `gnorb-org-handle-mail' on the heading when it's time to 306 | compose a new reply. 307 | * Restoring Window Layout 308 | Many Gnorb functions alter the window layout and value of point. In 309 | most of these cases, you can restore the previous layout using the 310 | interactive function `gnorb-restore-layout'. 311 | 312 | * Recent Mails From BBDB Contacts 313 | :PROPERTIES: 314 | :END: 315 | If you're using a recent git version of BBDB (circa mid-May 2014 or 316 | later), you can give your BBDB contacts a special field which will 317 | collect links to recent emails from that contact. The default name of 318 | the field is "messages", but you can customize that name using the 319 | `gnorb-bbdb-messages-field' option. 320 | 321 | Gnorb will not collect links by default: you need to call 322 | `gnorb-bbdb-open-link' on a contact once to start the process. 323 | Thereafter, opening mails from that contact will store a link to the 324 | message. 325 | 326 | Once some links are stored, `gnorb-bbdb-open-link' will open them: Use 327 | a prefix arg to the function call to select particular messages to 328 | open. There are several options controlling how all this works; see 329 | the gnorb-bbdb user options section below for details. 330 | * BBDB posting styles 331 | :PROPERTIES: 332 | :END: 333 | Gnorb comes with a BBDB posting-style system, inspired by (copied 334 | from) gnus-posting-styles. You can specify how messages are composed 335 | to specific contacts, by matching on contact field values (the same 336 | way gnus-posting-styles matches on group names). See the docstring of 337 | `gnorb-bbdb-posting-styles' for details. 338 | 339 | In order not to be too intrusive, Gnorb doesn't alter the behavior of 340 | `bbdb-mail', the usual mail-composition function. Instead it provides 341 | an alternate `gnorb-bbdb-mail', which does exactly the same thing, but 342 | first processes the new mail according to `gnorb-bbdb-posting-styles'. 343 | If you want to use this feature regularly, you can remap `bbdb-mail' 344 | to `gnorb-bbdb-mail' in the `bbdb-mode-map'. 345 | * BBDB Org tagging 346 | BBDB contacts can be tagged with the same tags you use in your Org 347 | files. This allows you to pop up a *BBDB* buffer alongside your Org 348 | Agenda when searching for certain tags. This can happen automatically 349 | for all Org tags-todo searches, if you set the option 350 | `gnorb-org-agenda-popup-bbdb' to t. Or you can do it manually, by 351 | calling the command of the same name. This command only shows TODOs by 352 | default: use a prefix argument to show all tagged headings. 353 | 354 | Tags are stored in an xfield named org-tags, by default. You can 355 | customize the name of this field using `gnorb-bbdb-org-tag-field'. 356 | * Misc BBDB 357 | ** Searching for messages from BBDB contacts 358 | :PROPERTIES: 359 | :END: 360 | Call `gnorb-bbdb-mail-search' to search for all mail messages from the 361 | record(s) displayed. Currently supports the notmuch, mairix, and 362 | namazu search backends; set `gnorb-gnus-mail-search-backend' to one of 363 | those symbol values. 364 | ** Citing BBDB contacts 365 | :PROPERTIES: 366 | :END: 367 | Calling `gnorb-bbdb-cite-contact' will prompt for a BBDB record and 368 | insert a string of the type "Bob Smith ". 369 | ** User Options 370 | - `gnorb-bbdb-org-tag-field :: The name of the BBDB xfield, as a 371 | symbol, that holds Org-related tags. Specified as a string with 372 | the ":" separator between tags, same as for Org headings. 373 | Defaults to org-tag. 374 | - `gnorb-bbdb-messages-field' :: The name of the BBDB xfield that 375 | holds links to recently-received messages from this contact. 376 | Defaults to 'messages. 377 | - `gnorb-bbdb-collect-N-messages' :: Collect at most this many links 378 | to messages from this contact. Defaults to 5. 379 | - `gnorb-bbdb-define-recent' :: What does "recently-received" mean? 380 | Possible values are the symbols seen and received. When set to 381 | seen, the most recently-opened messages are collected. When set 382 | to received, the most recently-received (by Date header) messages 383 | are collected. Defaults to seen. 384 | - `gnorb-bbdb-message-link-format-multi' :: How is a single message's 385 | link formatted in the multi-line BBDB layout format? Defaults to 386 | "%:count. %D: %:subject" (see the docstring for details). 387 | - ` gnorb-bbdb-message-link-format-one' :: How is a single message's 388 | link formatted in the one-line BBDB layout format? Defaults to 389 | nil (see the docstring for details). 390 | - `gnorb-bbdb-posting-styles' :: Styles to use for influencing the 391 | format of mails composed to the BBDB record(s) under point (see 392 | the docstring for details). 393 | * Misc Org 394 | ** Inserting BBDB links 395 | :PROPERTIES: 396 | :END: 397 | Calling `gnorb-org-contact-link' will prompt for a BBDB record and 398 | insert an Org link to that record at point. 399 | ** User Options 400 | - `gnorb-org-after-message-setup-hook' :: Hook run in a message buffer 401 | after setting up the message, from `gnorb-org-handle-mail' or 402 | `gnorb-org-email-subtree'. 403 | - `gnorb-org-trigger-actions' :: List of potential actions that can be 404 | taken on headings after a message is sent. See docstring for 405 | details. 406 | - `gnorb-org-mail-scan-scope' :: The number of paragraphs to scan for 407 | mail-related links. This comes into play when calling 408 | `gnorb-org-handle-mail' on a heading with no associated messages, 409 | or when `gnorb-org-handle-mail' is called with a prefix arg. 410 | - `gnorb-org-find-candidates-match' :: When searching all Org files 411 | for headings to collect messages from, this option can limit 412 | which headings are searched. It is used as the second argument to 413 | a call to `org-map-entries', and has the same syntax as that used 414 | in an agenda tags view. 415 | - `gnorb-org-email-subtree-text-parameters' :: A plist of export 416 | parameters corresponding to the EXT-PLIST argument to the export 417 | functions, for use when exporting to text. 418 | - `gnorb-org-email-subtree-file-parameters' :: A plist of export 419 | parameters corresponding to the EXT-PLIST argument to the export 420 | functions, for use when exporting to a file. 421 | - `gnorb-org-email-subtree-text-options' :: A list of ts and nils 422 | corresponding to Org's export options, to be used when exporting 423 | to text. The options, in order, are async, subtreep, 424 | visible-only, and body-only. 425 | - `gnorb-org-email-subtree-file-options' :: A list of ts and nils 426 | corresponding to Org's export options, to be used when exporting 427 | to a file. The options, in order, are async, subtreep, 428 | visible-only, and body-only. 429 | - `gnorb-org-export-extensions' :: Correspondence between export 430 | backends and their respective (usual) file extensions. 431 | - `gnorb-org-capture-collect-link-p' :: When this is set to t, the 432 | capture process will always store a link to the Gnus message or 433 | BBDB record under point, even when the link isn't part of the 434 | capture template. It can then be added to the captured heading 435 | with org-insert-link, as usual. 436 | - `gnorb-org-agenda-popup-bbdb' :: Set to "t" to automatically pop up 437 | the BBDB buffer displaying records corresponding to the Org 438 | Agenda tags search underway. If this is nil you can always do it 439 | manually with the command of the same name. 440 | - `gnorb-org-bbdb-popup-layout' :: Controls the layout of the 441 | Agenda-related BBDB popup, takes the same values as 442 | bbdb-pop-up-layout. 443 | * Misc Gnus 444 | ** Viewing Org headlines relevant to a message 445 | :PROPERTIES: 446 | :END: 447 | Call `gnorb-gnus-view' on a message that is associated with an Org 448 | heading to jump to that heading. 449 | ** User Options 450 | - `gnorb-gnus-mail-search-backend' :: Specifies the search backend 451 | that you use for searching mails. Currently supports notmuch, 452 | mairix, and namazu: set this option to one of those symbols. 453 | - `gnorb-gnus-capture-always-attach' :: Treat all capture templates as 454 | if they had the :gnus-attachments key set to "t". This only has 455 | any effect if you're capturing from a Gnus summary or article 456 | buffer. 457 | - `gnorb-trigger-todo-default' :: Set to either 'note or 'todo to tell 458 | `gnorb-gnus-incoming-do-todo' what to do by default. You can 459 | reach the non-default behavior by calling that function with a 460 | prefix argument. Alternately, set to 'prompt to always prompt for 461 | the appropriate action. 462 | - `gnorb-gnus-trigger-refile-targets' :: If you use 463 | `gnorb-gnus-incoming-do-todo' on an incoming message, Gnorb will 464 | try to locate a TODO heading that's relevant to that message. If 465 | it can't, it will prompt you for one, using the refile interface. 466 | This option will be used as the value of `org-refile-targets' 467 | during that process: see the docstring of `org-refile-targets' 468 | for the appropriate syntax. 469 | - `gnorb-gnus-new-todo-capture-key' :: Set this to a single-character 470 | string pointing at an Org capture template to use when creating 471 | TODOs from outgoing messages. The template is a regular capture 472 | template, with a few exceptions. If Gnus helps you archive 473 | outgoing messages (ie you have `gnus-message-archive-group' set 474 | to something, and your outgoing messages have a "Fcc" header), a 475 | link to that message will be made, and you'll be able to use all 476 | the escapes related to gnus messages. If you don't archive 477 | outgoing messages, you'll still be able to use the %:subject, 478 | %:to, %:toname, %:toaddress, and %:date escapes in the capture 479 | template. 480 | - `gnorb-gnus-hint-relevant-article' :: Set to "t" (the default) to 481 | have Gnorb give you a hint in the minibuffer when opening 482 | messages that might be relevant to existing Org TODOs. 483 | - `gnorb-gnus-summary-mark-format-letter' :: The formatting letter to 484 | use as part of your `gnus-summary-line-format', to indicate 485 | messages which might be relevant to Org TODOs. Defaults to "g", 486 | meaning it should be used as "%ug" in the format line. 487 | - `gnorb-gnus-summary-mark' :: The mark used to indicate potentially 488 | relevant messages in the Summary buffer, when 489 | `gnorb-gnus-summary-mark-format-letter' is present in the format 490 | line. Defaults to "¡". 491 | - `gnorb-gnus-summary-tracked-mark' :: The mark used to indicate 492 | already-tracked messages in the Summary buffer, when 493 | `gnorb-gnus-summary-mark-format-letter' is present in the format 494 | line. Defaults to "&". 495 | * Suggested Keybindings 496 | :PROPERTIES: 497 | :ID: de1b2579-86c2-4bb1-b77e-3467a3d2b3c7 498 | :END: 499 | #+BEGIN_SRC emacs-lisp 500 | (eval-after-load "gnorb-bbdb" 501 | '(progn 502 | (define-key bbdb-mode-map (kbd "O") 'gnorb-bbdb-tag-agenda) 503 | (define-key bbdb-mode-map (kbd "S") 'gnorb-bbdb-mail-search) 504 | (define-key bbdb-mode-map [remap bbdb-mail] 'gnorb-bbdb-mail) 505 | (define-key bbdb-mode-map (kbd "l") 'gnorb-bbdb-open-link) 506 | (global-set-key (kbd "C-c C") 'gnorb-bbdb-cite-contact))) 507 | 508 | (eval-after-load "gnorb-org" 509 | '(progn 510 | (org-defkey org-mode-map (kbd "C-c C") 'gnorb-org-contact-link) 511 | (org-defkey org-mode-map (kbd "C-c t") 'gnorb-org-handle-mail) 512 | (org-defkey org-mode-map (kbd "C-c e") 'gnorb-org-view) 513 | (org-defkey org-mode-map (kbd "C-c E") 'gnorb-org-email-subtree) 514 | (org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb) 515 | (setq gnorb-org-agenda-popup-bbdb t) 516 | (eval-after-load "org-agenda" 517 | '(progn (org-defkey org-agenda-mode-map (kbd "C-c t") 'gnorb-org-handle-mail) 518 | (org-defkey org-agenda-mode-map (kbd "C-c v") 'gnorb-org-popup-bbdb) 519 | (org-defkey org-agenda-mode-map (kbd "V") 'gnorb-org-view))))) 520 | 521 | (eval-after-load "gnorb-gnus" 522 | '(progn 523 | (define-key gnus-summary-mime-map "a" 'gnorb-gnus-article-org-attach) 524 | (define-key gnus-summary-mode-map (kbd "C-c t") 'gnorb-gnus-incoming-do-todo) 525 | (push '("attach to org heading" . gnorb-gnus-mime-org-attach) 526 | gnus-mime-action-alist) 527 | ;; The only way to add mime button command keys is by redefining 528 | ;; gnus-mime-button-map, possibly not ideal. Ideal would be a 529 | ;; setter function in gnus itself. 530 | (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading") 531 | gnus-mime-button-commands) 532 | (setq gnus-mime-button-map 533 | (let ((map (make-sparse-keymap))) 534 | (define-key map gnus-mouse-2 'gnus-article-push-button) 535 | (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) 536 | (dolist (c gnus-mime-button-commands) 537 | (define-key map (cadr c) (car c))) 538 | map)))) 539 | 540 | (eval-after-load "message" 541 | '(progn 542 | (define-key message-mode-map (kbd "C-c t") 'gnorb-gnus-outgoing-do-todo))) 543 | #+END_SRC 544 | -------------------------------------------------------------------------------- /gnorb.texi: -------------------------------------------------------------------------------- 1 | \input texinfo @c -*- texinfo -*- 2 | @c %**start of header 3 | @setfilename ./gnorb.info 4 | @settitle Gnorb Manual 5 | @documentencoding UTF-8 6 | @documentlanguage en 7 | @syncodeindex pg cp 8 | @c %**end of header 9 | 10 | @dircategory Emacs 11 | @direntry 12 | * Gnorb: (gnorb). Glue code for Gnus, Org, and BBDB. 13 | @end direntry 14 | 15 | @finalout 16 | @titlepage 17 | @title Gnorb Manual 18 | @subtitle for version 1, updated 3 October, 2014 19 | @end titlepage 20 | 21 | @ifnottex 22 | @node Top 23 | @top Gnorb Manual 24 | @end ifnottex 25 | 26 | @menu 27 | * Introduction:: 28 | * Installation:: 29 | * Setup:: 30 | * Email Tracking:: 31 | * Restoring Window Layout:: 32 | * Recent Mails From BBDB Contacts:: 33 | * BBDB posting styles:: 34 | * BBDB Org tagging:: 35 | * Misc BBDB:: 36 | * Misc Org:: 37 | * Misc Gnus:: 38 | * Suggested Keybindings:: 39 | 40 | @detailmenu 41 | --- The Detailed Node Listing --- 42 | 43 | Email Tracking 44 | 45 | * Basic Usage:: 46 | * Email-Related Commands:: 47 | * Trigger Actions:: 48 | * Viewing Tracked Messages in *Summary* Buffers:: 49 | * Hinting in Gnus:: 50 | * Message Attachments:: 51 | * Registry Usage:: 52 | * Likely Workflow:: 53 | 54 | Misc BBDB 55 | 56 | * Searching for messages from BBDB contacts:: 57 | * Citing BBDB contacts:: 58 | * User Options:: 59 | 60 | Misc Org 61 | 62 | * Inserting BBDB links:: 63 | * User Options: User Optionsx. 64 | 65 | Misc Gnus 66 | 67 | * Viewing Org headlines relevant to a message:: 68 | * User Options: User Optionsxx. 69 | @end detailmenu 70 | @end menu 71 | 72 | @node Introduction 73 | @chapter Introduction 74 | 75 | Gnorb provides glue code between the Gnus, Org, and BBDB packages. 76 | It's aimed at supporting email-based project management, and generally 77 | making it easier to keep track of email communication. 78 | 79 | Much of the code consists of single-use convenience functions, but 80 | tracking email conversations with Org requires is more complicated, 81 | and requires a bit of setup. 82 | 83 | Gnorb can be used in a modular fashion, by selectively loading the 84 | files ``gnorb-org'', ``gnorb-gnus'' or ``gnorb-bbdb'' instead of plain old 85 | ``gnorb''. The package as a whole is rather Org-centric, though, and it 86 | won't do much of interest without ``gnorb-org''. 87 | 88 | This means that Gnorb doesn't have hard requirements to any of the 89 | three base libraries. For the libraries you are using, however, you'll 90 | get best results from using the most recent stable version (yes, that 91 | means BBDB 3). Some of the features in Gnorb only work with 92 | development versions of these libraries (those cases are noted below). 93 | 94 | @node Installation 95 | @chapter Installation 96 | 97 | Gnorb is best installed via the Elpa package manager -- look for it in 98 | `list-packages'. 99 | 100 | You can also clone the source code from 101 | @uref{https://github.com/girzel/gnorb}, and put the ``gnorb'' directory on your 102 | load-path. The Github site is also a good place to report bugs and 103 | other issues. 104 | 105 | @node Setup 106 | @chapter Setup 107 | 108 | Loading ``gnorb'' will make the basic functions available. Using Gnorb 109 | for email tracking takes a bit more setup, however: 110 | 111 | @enumerate 112 | @item 113 | Email tracking is done via the Gnus registry, so that must be 114 | activated with `gnus-registry-initialize'. 115 | @item 116 | It also requires the org-id package to be loaded, and 117 | `org-id-track-globally' set to t (that's the default value, so 118 | simply loading the package should be enough). 119 | @item 120 | Add a nngnorb entry to your `gnus-secondary-select-methods' 121 | variable. It will look like (nngnorb ``Server name''). This does 122 | nothing but provide a place to hang nnir searches. 123 | @item 124 | Then put a call to `gnorb-tracking-initialize' in your init files, 125 | at some point after the Gnus registry is initialized. 126 | @item 127 | If you're not using a local archive method for saving your sent 128 | messages (ie you're using IMAP), you'll also need to tell Gnorb 129 | where to find your sent messages. Set the variable 130 | `gnorb-gnus-sent-groups' to a list of strings; each string should 131 | indicate a fully-qualified group name, eg ``nnimap+SERVER:GROUP''. 132 | @end enumerate 133 | 134 | Lastly, Gnorb doesn't bind any keys by default; see the @ref{Suggested Keybindings,Suggested 135 | Keybindings} section below for possibilities. 136 | 137 | @node Email Tracking 138 | @chapter Email Tracking 139 | 140 | The most interesting thing Gnorb does is using Org headings to track 141 | email conversations. This can mean anything from reminding yourself to 142 | write to your mother, to conducting delicate business negotiations 143 | over email, to running an email-based bug tracker. 144 | 145 | Gnorb assists in this process by using the Gnus registry to track 146 | correspondences between emails and Org headings -- specifically, 147 | message IDs are associated with Org heading ids. As a conversation 148 | develops, messages are collected on a heading (and/or its children). 149 | You can compose new messages directly from the Org heading, and Gnorb 150 | will automatically associate your sent message with the conversation. 151 | You can open Gnus *Summary* buffers holding all the messages 152 | associated with an Org subtree, and reply from there -- these groups 153 | can be made persistent, if you like. When you receive new messages 154 | relevant to a conversation, Gnorb will notice them and prompt you to 155 | associate them with the appropriate Org heading. Attachments on 156 | incoming messages can be automatically saved as attachments on Org 157 | headings, using org-attach. 158 | 159 | In general, the goal is to keep track of whole conversations, reduce 160 | friction when moving between Gnus and Org, and keep you in the Org 161 | agenda rather than in Gnus. 162 | @menu 163 | * Basic Usage:: 164 | * Email-Related Commands:: 165 | * Trigger Actions:: 166 | * Viewing Tracked Messages in *Summary* Buffers:: 167 | * Hinting in Gnus:: 168 | * Message Attachments:: 169 | * Registry Usage:: 170 | * Likely Workflow:: 171 | @end menu 172 | 173 | @node Basic Usage 174 | @section Basic Usage 175 | 176 | The following sections might be a bit confusing to read if you haven't 177 | actually tried using Gnorb. If you don't want to dive in all the way 178 | just yet, you can just dabble your toes. First set up email tracking 179 | as specified in @ref{Setup,Setup}, then do the following: 180 | 181 | @enumerate 182 | @item 183 | Add ``%ug'' somewhere appropriate in your `gnus-summary-line-format' 184 | variable. 185 | @item 186 | If you don't use a local archive method, add your sent message 187 | groups to `gnorb-gnus-sent-groups' (see the docstring). 188 | @item 189 | Use Org capture from Gnus summary buffers to create reminders for 190 | emails you need to reply to. 191 | @item 192 | Reply to those emails by pressing ``C-c t'' on the TODO heading in 193 | either the Agenda, or in regular Org files. 194 | @item 195 | If you ever get confused about what's associated with an Org 196 | heading, press ``C-c v'' on the heading (works in either the Agenda, 197 | or regular Org files). 198 | @end enumerate 199 | 200 | That should be enough to get started. 201 | 202 | @node Email-Related Commands 203 | @section Email-Related Commands 204 | 205 | Email tracking starts in one of three ways: 206 | 207 | @enumerate 208 | @item 209 | With an Org heading that represents an email TODO. Call 210 | `gnorb-org-handle-mail' (see below) on the heading to compose a new 211 | message, and start the tracking process. 212 | @item 213 | By calling org-capture on a received message. Any heading captured 214 | from a message will automatically be associated with that message. 215 | @item 216 | By calling `gnorb-gnus-outgoing-do-todo' in a message composition 217 | buffer -- see below. 218 | @end enumerate 219 | 220 | There are three main email-related commands: 221 | 222 | @enumerate 223 | @item 224 | `gnorb-org-handle-mail' is called on an Org heading to compose a 225 | new message. By default, this will begin a reply to the most recent 226 | message in the conversation. If there are no associated messages to 227 | reply to (or you call the function with a single prefix arg), Gnorb 228 | will look for mailto: or bbdb: links in the heading, and compose a 229 | new message to them. 230 | 231 | Calling the function with a double prefix arg will ignore all 232 | associated messages and links, and compose a blank message. 233 | 234 | Once sent, the message will be associated with the Org heading, and 235 | you'll be brought back to the heading and asked to trigger an 236 | action on it. 237 | 238 | `gnorb-email-subtree' is an alternative entry-point to 239 | `gnorb-org-handle-mail'. It does the same thing as the latter, but 240 | first exports the body of the subtree as either text or a file, 241 | then inserts the text into the message body, or attaches the file 242 | to the message, respectively. 243 | @item 244 | `gnorb-gnus-incoming-do-todo' is called on a message in a Gnus 245 | *Summary* buffer. You'll be prompted for an Org heading, taken to 246 | that heading, and asked to trigger an action on it. 247 | @item 248 | `gnorb-gnus-outgoing-do-todo' is called in message mode, while 249 | composing a new message. 250 | 251 | If called without a prefix arg, a new Org heading will be created 252 | after the message is sent, and the sent message associated with it. 253 | The new heading will be created as a capture heading, using the 254 | template specified by the `gnorb-gnus-new-todo-capture-key' option. 255 | 256 | If you call this function with a single prefix arg, you'll be 257 | prompted to choose an existing Org heading instead. After the the 258 | message is sent, you'll be taken to that heading and prompted to 259 | trigger an action on it. 260 | 261 | If you've called this function, and then realize you've associated 262 | the message with the wrong TODO, call it again with a double prefix 263 | to clear all associations. 264 | 265 | It's also possible to call this function *after* a message is sent, 266 | in case you forgot. Gnorb saves information about the most recently 267 | sent message for this purpose. 268 | @end enumerate 269 | 270 | Because these three commands all express a similar intent, but are 271 | called in different modes, it can make sense to give each of them the 272 | same keybinding in the keymaps for Org mode, Gnus summary mode, and 273 | Message mode. 274 | 275 | An additional convenience command is available for use in Gnus summary 276 | buffers: `gnorb-gnus-quick-reply'. If you don't want to go through the 277 | whole round trip of triggering an action and then starting a new 278 | reply, call this command on an incoming message to associate it with a 279 | heading, start a reply, and associate your reply with the same 280 | heading. 281 | 282 | @node Trigger Actions 283 | @section Trigger Actions 284 | 285 | After calling `gnorb-gnus-incoming-do-todo' on a message, or after 286 | sending a message associated with an Org heading, you'll be taken to 287 | the heading and asked to ``trigger an action'' on it. At the moment 288 | there are six different possibilities: triggering a TODO state-change 289 | on the heading, taking a note on the heading (both these options will 290 | associate the message with the heading), associating the message but 291 | doing nothing else, capturing a new Org heading as a sibling to the 292 | tracked heading, capturing a new Org heading as a child, and lastly, 293 | doing nothing at all. 294 | 295 | More actions may be added in the future; it's also possible to 296 | rearrange or delete existing actions, and add your own: see the 297 | docstring of `gnorb-org-trigger-actions'. 298 | 299 | @node Viewing Tracked Messages in *Summary* Buffers 300 | @section Viewing Tracked Messages in *Summary* Buffers 301 | 302 | Call `gnorb-org-view' on an Org heading to open an nnir summary buffer 303 | showing all the messages associated with that heading and child 304 | headings (this requires you to have added an nngnorb server to your 305 | Gnus backends). A minor mode is in effect, ensuring that any replies 306 | you send to messages in this buffer will automatically be associated 307 | with the original Org heading. You can also invoke 308 | `gnorb-summary-disassociate-message' (``C-c d'') to disassociate the 309 | message with the Org heading. 310 | 311 | If you call `gnorb-org-view' with a prefix argument, the search group 312 | will be made persistent across Gnus sessions. You can re-run the 313 | search and update the group contents by hitting ``M-g'' on the group in 314 | the Gnus *Group* buffer. 315 | 316 | As a bonus, it's possible to go into Gnus' *Server* buffer, find the 317 | line specifying your nngnorb server, and hit ``G'' (aka 318 | `gnus-group-make-nnir-group'). At the query prompt, enter an Org-style 319 | tags-todo Agenda query string (eg ``+work-computer'', or what have you). 320 | Gnorb will find all headings matching this query, scan their subtrees 321 | for gnus links, and then give you a Summary buffer containing all the 322 | linked messages. This is dog-slow at the moment; it will get faster. 323 | 324 | @node Hinting in Gnus 325 | @section Hinting in Gnus 326 | 327 | When you receive new mails that might be relevant to existing Org 328 | TODOs, Gnorb can alert you to that fact. When 329 | `gnorb-gnus-hint-relevant-article' is t (the default), Gnorb will 330 | display a message in the minibuffer when opening potentially relevant 331 | messages. You can then use `gnorb-gnus-incoming-to-todo' to trigger an 332 | action on the relevant TODO. 333 | 334 | This hinting can happen in the Gnus summary buffer as well. If you use 335 | the escape indicated by `gnorb-gnus-summary-mark-format-letter`` as 336 | part of your `gnus-summary-line-format', articles that may be relevant 337 | to TODOs will be marked with a special character in the Summary 338 | buffer, as determined by `gnorb-gnus-summary-mark'. By default, the 339 | format letter is ``g'' (meaning it is used as ``%ug'' in the format line), 340 | and the mark is ``&'' for messages that are already tracked, and ``¡'' for 341 | messages that may be relevant. 342 | 343 | @node Message Attachments 344 | @section Message Attachments 345 | 346 | Gnorb simplifies the handling of attachments that you receive in 347 | emails. When you call `gnorb-gnus-incoming-do-todo' on a message, 348 | you'll be prompted to re-attach the email's attachments onto the Org 349 | heading, using the org-attach library. 350 | 351 | You can also do this as part of the capture process. Set the 352 | new :gnus-attachments key to ``t'' in a capture template that you use on 353 | mail messages, and you'll be queried to re-attach the message's 354 | attachments onto the newly-captured heading. Or set 355 | `gnorb-gnus-capture-always-attach' to ``t'' to have Gnorb do this for 356 | all capture templates. 357 | 358 | You can also do this using the regular system of MIME commands, 359 | without invoking the email tracking process. See @ref{Suggested Keybindings,Suggested 360 | Keybindings}, below. 361 | 362 | The same process works in reverse: when you send a message from an Org 363 | heading using `gnorb-org-handle-mail', Gnorb will ask if you want to 364 | attach the files in the heading's org-attach directory to the outgoing 365 | message. 366 | 367 | @node Registry Usage 368 | @section Registry Usage 369 | 370 | You can see how many associations you've got stored in the registry by 371 | calling `gnorb-report-tracking-usage'. This will pop up a buffer 372 | showing how much of the registry you're using, and offering 373 | keybindings for `gnorb-flush-dead-associations', to help Gnorb clean 374 | up after itself. 375 | 376 | @node Likely Workflow 377 | @section Likely Workflow 378 | 379 | You receive an email from Jimmy, who wants to rent a room in your 380 | house. ``I'll respond to this later,'' you think. 381 | 382 | You capture an Org TODO from the email, call it ``Jimmy renting a 383 | room'', and give it a REPLY keyword. Gnorb quietly records the 384 | correspondence between the email and the TODO, using the Gnus 385 | registry. 386 | 387 | The next day, looking at your Agenda, you see the TODO and decide to 388 | respond to the email. You call `gnorb-org-handle-mail' on the heading, 389 | and Gnorb opens Jimmy's email and starts a reply to it. 390 | 391 | You tell Jimmy the room's available in March, and send the message. 392 | Gnorb takes you back to the heading, and asks you to trigger an action 393 | on it. You choose ``todo state'', and change the heading keyword to 394 | WAIT. 395 | 396 | Two days later, Jimmy replies to your message, saying that March is 397 | perfect. When you open his response, Gnorb politely reminds you that 398 | the message is relevant to an existing TODO. You call 399 | `gnorb-gnus-incoming-do-todo' on the message, and are again taken to 400 | the TODO and asked to trigger an action. Again you choose ``todo 401 | state'', and change the heading keyword back to REPLY. 402 | 403 | You get another email, from Samantha, warning you not to rent the room 404 | to Jimmy. She even attaches a picture of a room in her house, as it 405 | looked after Jimmy had stayed there for six months. It's bad. You call 406 | `gnorb-gnus-incoming-do-todo' on her message, and pick the ``Jimmy 407 | renting a room'' heading. This time, you choose ``take note'' as the 408 | trigger action, and make a brief note about how bad that room looked. 409 | Gnorb asks if you'd like to attach the picture to the Org heading. You 410 | decide you will. 411 | 412 | Now it's time to write to Jimmy and say something noncommittal. 413 | Calling `gnorb-org-handle-mail' on the heading would respond to 414 | Samantha's email, the most recent of the associated messages, which 415 | isn't what you want. Instead you call `gnorb-org-view' on the heading, 416 | which opens up a Gnus *Summary* buffer containing all four messages: 417 | Jimmy's first, your response, his response to that, and Samantha's 418 | message. You pick Jimmy's second email, and reply to it normally. 419 | Gnorb asks if you'd like to send the picture of the room as an 420 | attachment. You would not. When you send the reply Gnorb tracks that 421 | as well, and does the ``trigger an action'' trick again. 422 | 423 | In this way Gnorb helps you manage an entire conversation, possibly 424 | with multiple threads and multiple participants. Mostly all you need 425 | to do is call `gnorb-gnus-incoming-do-todo' on newly-received 426 | messages, and `gnorb-org-handle-mail' on the heading when it's time to 427 | compose a new reply. 428 | 429 | @node Restoring Window Layout 430 | @chapter Restoring Window Layout 431 | 432 | Many Gnorb functions alter the window layout and value of point. In 433 | most of these cases, you can restore the previous layout using the 434 | interactive function `gnorb-restore-layout'. 435 | 436 | @node Recent Mails From BBDB Contacts 437 | @chapter Recent Mails From BBDB Contacts 438 | 439 | If you're using a recent git version of BBDB (circa mid-May 2014 or 440 | later), you can give your BBDB contacts a special field which will 441 | collect links to recent emails from that contact. The default name of 442 | the field is ``messages'', but you can customize that name using the 443 | `gnorb-bbdb-messages-field' option. 444 | 445 | Gnorb will not collect links by default: you need to call 446 | `gnorb-bbdb-open-link' on a contact once to start the process. 447 | Thereafter, opening mails from that contact will store a link to the 448 | message. 449 | 450 | Once some links are stored, `gnorb-bbdb-open-link' will open them: Use 451 | a prefix arg to the function call to select particular messages to 452 | open. There are several options controlling how all this works; see 453 | the gnorb-bbdb user options section below for details. 454 | 455 | @node BBDB posting styles 456 | @chapter BBDB posting styles 457 | 458 | Gnorb comes with a BBDB posting-style system, inspired by (copied 459 | from) gnus-posting-styles. You can specify how messages are composed 460 | to specific contacts, by matching on contact field values (the same 461 | way gnus-posting-styles matches on group names). See the docstring of 462 | `gnorb-bbdb-posting-styles' for details. 463 | 464 | In order not to be too intrusive, Gnorb doesn't alter the behavior of 465 | `bbdb-mail', the usual mail-composition function. Instead it provides 466 | an alternate `gnorb-bbdb-mail', which does exactly the same thing, but 467 | first processes the new mail according to `gnorb-bbdb-posting-styles'. 468 | If you want to use this feature regularly, you can remap `bbdb-mail' 469 | to `gnorb-bbdb-mail' in the `bbdb-mode-map'. 470 | 471 | @node BBDB Org tagging 472 | @chapter BBDB Org tagging 473 | 474 | BBDB contacts can be tagged with the same tags you use in your Org 475 | files. This allows you to pop up a *BBDB* buffer alongside your Org 476 | Agenda when searching for certain tags. This can happen automatically 477 | for all Org tags-todo searches, if you set the option 478 | `gnorb-org-agenda-popup-bbdb' to t. Or you can do it manually, by 479 | calling the command of the same name. This command only shows TODOs by 480 | default: use a prefix argument to show all tagged headings. 481 | 482 | Tags are stored in an xfield named org-tags, by default. You can 483 | customize the name of this field using `gnorb-bbdb-org-tag-field'. 484 | 485 | @node Misc BBDB 486 | @chapter Misc BBDB 487 | 488 | @menu 489 | * Searching for messages from BBDB contacts:: 490 | * Citing BBDB contacts:: 491 | * User Options:: 492 | @end menu 493 | 494 | @node Searching for messages from BBDB contacts 495 | @section Searching for messages from BBDB contacts 496 | 497 | Call `gnorb-bbdb-mail-search' to search for all mail messages from the 498 | record(s) displayed. Currently supports the notmuch, mairix, and 499 | namazu search backends; set `gnorb-gnus-mail-search-backend' to one of 500 | those symbol values. 501 | 502 | @node Citing BBDB contacts 503 | @section Citing BBDB contacts 504 | 505 | Calling `gnorb-bbdb-cite-contact' will prompt for a BBDB record and 506 | insert a string of the type ``Bob Smith ''. 507 | 508 | @node User Options 509 | @section User Options 510 | 511 | @table @samp 512 | @item `gnorb-bbdb-org-tag-field 513 | The name of the BBDB xfield, as a 514 | symbol, that holds Org-related tags. Specified as a string with 515 | the ``:'' separator between tags, same as for Org headings. 516 | Defaults to org-tag. 517 | @item `gnorb-bbdb-messages-field' 518 | The name of the BBDB xfield that 519 | holds links to recently-received messages from this contact. 520 | Defaults to `messages. 521 | @item `gnorb-bbdb-collect-N-messages' 522 | Collect at most this many links 523 | to messages from this contact. Defaults to 5. 524 | @item `gnorb-bbdb-define-recent' 525 | What does ``recently-received'' mean? 526 | Possible values are the symbols seen and received. When set to 527 | seen, the most recently-opened messages are collected. When set 528 | to received, the most recently-received (by Date header) messages 529 | are collected. Defaults to seen. 530 | @item `gnorb-bbdb-message-link-format-multi' 531 | How is a single message's 532 | link formatted in the multi-line BBDB layout format? Defaults to 533 | ``%:count. %D: %:subject'' (see the docstring for details). 534 | @item ` gnorb-bbdb-message-link-format-one' 535 | How is a single message's 536 | link formatted in the one-line BBDB layout format? Defaults to 537 | nil (see the docstring for details). 538 | @item `gnorb-bbdb-posting-styles' 539 | Styles to use for influencing the 540 | format of mails composed to the BBDB record(s) under point (see 541 | the docstring for details). 542 | @end table 543 | 544 | @node Misc Org 545 | @chapter Misc Org 546 | 547 | @menu 548 | * Inserting BBDB links:: 549 | * User Options: User Optionsx. 550 | @end menu 551 | 552 | @node Inserting BBDB links 553 | @section Inserting BBDB links 554 | 555 | Calling `gnorb-org-contact-link' will prompt for a BBDB record and 556 | insert an Org link to that record at point. 557 | 558 | @node User Optionsx 559 | @section User Options 560 | 561 | @table @samp 562 | @item `gnorb-org-after-message-setup-hook' 563 | Hook run in a message buffer 564 | after setting up the message, from `gnorb-org-handle-mail' or 565 | `gnorb-org-email-subtree'. 566 | @item `gnorb-org-trigger-actions' 567 | List of potential actions that can be 568 | taken on headings after a message is sent. See docstring for 569 | details. 570 | @item `gnorb-org-mail-scan-scope' 571 | The number of paragraphs to scan for 572 | mail-related links. This comes into play when calling 573 | `gnorb-org-handle-mail' on a heading with no associated messages, 574 | or when `gnorb-org-handle-mail' is called with a prefix arg. 575 | @item `gnorb-org-find-candidates-match' 576 | When searching all Org files 577 | for headings to collect messages from, this option can limit 578 | which headings are searched. It is used as the second argument to 579 | a call to `org-map-entries', and has the same syntax as that used 580 | in an agenda tags view. 581 | @item `gnorb-org-email-subtree-text-parameters' 582 | A plist of export 583 | parameters corresponding to the EXT-PLIST argument to the export 584 | functions, for use when exporting to text. 585 | @item `gnorb-org-email-subtree-file-parameters' 586 | A plist of export 587 | parameters corresponding to the EXT-PLIST argument to the export 588 | functions, for use when exporting to a file. 589 | @item `gnorb-org-email-subtree-text-options' 590 | A list of ts and nils 591 | corresponding to Org's export options, to be used when exporting 592 | to text. The options, in order, are async, subtreep, 593 | visible-only, and body-only. 594 | @item `gnorb-org-email-subtree-file-options' 595 | A list of ts and nils 596 | corresponding to Org's export options, to be used when exporting 597 | to a file. The options, in order, are async, subtreep, 598 | visible-only, and body-only. 599 | @item `gnorb-org-export-extensions' 600 | Correspondence between export 601 | backends and their respective (usual) file extensions. 602 | @item `gnorb-org-capture-collect-link-p' 603 | When this is set to t, the 604 | capture process will always store a link to the Gnus message or 605 | BBDB record under point, even when the link isn't part of the 606 | capture template. It can then be added to the captured heading 607 | with org-insert-link, as usual. 608 | @item `gnorb-org-agenda-popup-bbdb' 609 | Set to ``t'' to automatically pop up 610 | the BBDB buffer displaying records corresponding to the Org 611 | Agenda tags search underway. If this is nil you can always do it 612 | manually with the command of the same name. 613 | @item `gnorb-org-bbdb-popup-layout' 614 | Controls the layout of the 615 | Agenda-related BBDB popup, takes the same values as 616 | bbdb-pop-up-layout. 617 | @end table 618 | 619 | @node Misc Gnus 620 | @chapter Misc Gnus 621 | 622 | @menu 623 | * Viewing Org headlines relevant to a message:: 624 | * User Options: User Optionsxx. 625 | @end menu 626 | 627 | @node Viewing Org headlines relevant to a message 628 | @section Viewing Org headlines relevant to a message 629 | 630 | Call `gnorb-gnus-view' on a message that is associated with an Org 631 | heading to jump to that heading. 632 | 633 | @node User Optionsxx 634 | @section User Options 635 | 636 | @table @samp 637 | @item `gnorb-gnus-mail-search-backend' 638 | Specifies the search backend 639 | that you use for searching mails. Currently supports notmuch, 640 | mairix, and namazu: set this option to one of those symbols. 641 | @item `gnorb-gnus-capture-always-attach' 642 | Treat all capture templates as 643 | if they had the :gnus-attachments key set to ``t''. This only has 644 | any effect if you're capturing from a Gnus summary or article 645 | buffer. 646 | @item `gnorb-trigger-todo-default' 647 | Set to either `note or `todo to tell 648 | `gnorb-gnus-incoming-do-todo' what to do by default. You can 649 | reach the non-default behavior by calling that function with a 650 | prefix argument. Alternately, set to `prompt to always prompt for 651 | the appropriate action. 652 | @item `gnorb-gnus-trigger-refile-targets' 653 | If you use 654 | `gnorb-gnus-incoming-do-todo' on an incoming message, Gnorb will 655 | try to locate a TODO heading that's relevant to that message. If 656 | it can't, it will prompt you for one, using the refile interface. 657 | This option will be used as the value of `org-refile-targets' 658 | during that process: see the docstring of `org-refile-targets' 659 | for the appropriate syntax. 660 | @item `gnorb-gnus-new-todo-capture-key' 661 | Set this to a single-character 662 | string pointing at an Org capture template to use when creating 663 | TODOs from outgoing messages. The template is a regular capture 664 | template, with a few exceptions. If Gnus helps you archive 665 | outgoing messages (ie you have `gnus-message-archive-group' set 666 | to something, and your outgoing messages have a ``Fcc'' header), a 667 | link to that message will be made, and you'll be able to use all 668 | the escapes related to gnus messages. If you don't archive 669 | outgoing messages, you'll still be able to use the %:subject, 670 | %:to, %:toname, %:toaddress, and %:date escapes in the capture 671 | template. 672 | @item `gnorb-gnus-hint-relevant-article' 673 | Set to ``t'' (the default) to 674 | have Gnorb give you a hint in the minibuffer when opening 675 | messages that might be relevant to existing Org TODOs. 676 | @item `gnorb-gnus-summary-mark-format-letter' 677 | The formatting letter to 678 | use as part of your `gnus-summary-line-format', to indicate 679 | messages which might be relevant to Org TODOs. Defaults to ``g'', 680 | meaning it should be used as ``%ug'' in the format line. 681 | @item `gnorb-gnus-summary-mark' 682 | The mark used to indicate potentially 683 | relevant messages in the Summary buffer, when 684 | `gnorb-gnus-summary-mark-format-letter' is present in the format 685 | line. Defaults to ``¡''. 686 | @item `gnorb-gnus-summary-tracked-mark' 687 | The mark used to indicate 688 | already-tracked messages in the Summary buffer, when 689 | `gnorb-gnus-summary-mark-format-letter' is present in the format 690 | line. Defaults to ``&''. 691 | @end table 692 | 693 | @node Suggested Keybindings 694 | @chapter Suggested Keybindings 695 | 696 | @lisp 697 | (eval-after-load "gnorb-bbdb" 698 | '(progn 699 | (define-key bbdb-mode-map (kbd "O") 'gnorb-bbdb-tag-agenda) 700 | (define-key bbdb-mode-map (kbd "S") 'gnorb-bbdb-mail-search) 701 | (define-key bbdb-mode-map [remap bbdb-mail] 'gnorb-bbdb-mail) 702 | (define-key bbdb-mode-map (kbd "l") 'gnorb-bbdb-open-link) 703 | (global-set-key (kbd "C-c C") 'gnorb-bbdb-cite-contact))) 704 | 705 | (eval-after-load "gnorb-org" 706 | '(progn 707 | (org-defkey org-mode-map (kbd "C-c C") 'gnorb-org-contact-link) 708 | (org-defkey org-mode-map (kbd "C-c t") 'gnorb-org-handle-mail) 709 | (org-defkey org-mode-map (kbd "C-c e") 'gnorb-org-view) 710 | (org-defkey org-mode-map (kbd "C-c E") 'gnorb-org-email-subtree) 711 | (org-defkey org-mode-map (kbd "C-c V") 'gnorb-org-popup-bbdb) 712 | (setq gnorb-org-agenda-popup-bbdb t) 713 | (eval-after-load "org-agenda" 714 | '(progn (org-defkey org-agenda-mode-map (kbd "C-c t") 'gnorb-org-handle-mail) 715 | (org-defkey org-agenda-mode-map (kbd "C-c v") 'gnorb-org-popup-bbdb) 716 | (org-defkey org-agenda-mode-map (kbd "V") 'gnorb-org-view))))) 717 | 718 | (eval-after-load "gnorb-gnus" 719 | '(progn 720 | (define-key gnus-summary-mime-map "a" 'gnorb-gnus-article-org-attach) 721 | (define-key gnus-summary-mode-map (kbd "C-c t") 'gnorb-gnus-incoming-do-todo) 722 | (push '("attach to org heading" . gnorb-gnus-mime-org-attach) 723 | gnus-mime-action-alist) 724 | ;; The only way to add mime button command keys is by redefining 725 | ;; gnus-mime-button-map, possibly not ideal. Ideal would be a 726 | ;; setter function in gnus itself. 727 | (push '(gnorb-gnus-mime-org-attach "a" "Attach to Org heading") 728 | gnus-mime-button-commands) 729 | (setq gnus-mime-button-map 730 | (let ((map (make-sparse-keymap))) 731 | (define-key map gnus-mouse-2 'gnus-article-push-button) 732 | (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) 733 | (dolist (c gnus-mime-button-commands) 734 | (define-key map (cadr c) (car c))) 735 | map)))) 736 | 737 | (eval-after-load "message" 738 | '(progn 739 | (define-key message-mode-map (kbd "C-c t") 'gnorb-gnus-outgoing-do-todo))) 740 | @end lisp 741 | 742 | @bye 743 | @c Local Variables: 744 | @c mode: texinfo 745 | @c TeX-master: t 746 | @c End: 747 | -------------------------------------------------------------------------------- /nngnorb.el: -------------------------------------------------------------------------------- 1 | ;;; nngnorb.el --- Gnorb backend for Gnus -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Eric Abrahamsen 6 | 7 | ;; This file is part of GNU Emacs. 8 | 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; This is a backend for supporting Gnorb-related stuff. I'm going to 25 | ;; regret this, I know. 26 | 27 | ;; It started off just with wanting to collect all the gnus links in a 28 | ;; subtree, and display all the messages in an ephemeral group. But it 29 | ;; doesn't seem possible to create ephemeral groups without 30 | ;; associating them with a server, and which server would that be? 31 | ;; Nnir also provides a nice interface to creating ephemeral groups, 32 | ;; but again, it relies on a server parameter to know which nnir 33 | ;; engine to use, and if you try to fake it it still craps out. 34 | 35 | ;; So this file is a copy-pasta from nnnil.el -- I'm trying to keep 36 | ;; this as simple as possible. Right now it does nothing but serving 37 | ;; as a place to hang ephemeral groups made with nnir searches of 38 | ;; message from the rest of your gnus installation. Enjoy. 39 | 40 | ;;; Code: 41 | 42 | (require 'gnus) 43 | (eval-and-compile 44 | (require 'nnheader) 45 | (require 'nnir)) 46 | 47 | (defvar nngnorb-status-string "") 48 | 49 | (defvar nngnorb-attachment-file-list nil 50 | "A place to store Org attachments relevant to the subtree being 51 | viewed.") 52 | 53 | (make-variable-buffer-local 'nngnorb-attachment-file-list) 54 | 55 | (gnus-declare-backend "nngnorb" 'post-mail 'virtual) 56 | 57 | (add-to-list 'nnir-method-default-engines '(nngnorb . gnorb)) 58 | 59 | (add-to-list 'nnir-engines 60 | '(gnorb nnir-run-gnorb)) 61 | 62 | (defun nnir-run-gnorb (query _server &optional _group) 63 | "Run the actual search for messages to display. See nnir.el for 64 | some details of how this gets called. 65 | 66 | As things stand, the query string can be given as one of two 67 | different things. First is the ID string of an Org heading, 68 | prefixed with \"id+\". This was probably a bad choice as it could 69 | conceivably look like an org tags search string. Fix that later. 70 | If it's an ID, then the entire subtree text of that heading is 71 | scanned for gnus links, and the messages relevant to the subtree 72 | are collected from the registry, and all the resulting messages 73 | are displayed in an ephemeral group. 74 | 75 | Otherwise, the query string can be a tags match string, a la the 76 | Org agenda tags search. All headings matched by this string will 77 | be scanned for gnus messages, and those messages displayed." 78 | ;; During the transition period between using message-ids stored in 79 | ;; a property, and the new registry-based system, we're going to use 80 | ;; both methods to collect relevant messages. This could be a little 81 | ;; slower, but for the time being it will be safer. 82 | (save-window-excursion 83 | (let ((q (cdr (assq 'query query))) 84 | (buf (get-buffer-create nnir-tmp-buffer)) 85 | msg-ids org-ids links vectors) 86 | (with-current-buffer buf 87 | (erase-buffer) 88 | (setq nngnorb-attachment-file-list nil)) 89 | (when (and (equal "5.13" gnus-version-number) (version< emacs-version "24.4")) 90 | (setq q (car q))) 91 | (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q) 92 | (with-demoted-errors "Error: %S" 93 | (org-id-goto (match-string 1 q)) 94 | (append-to-buffer 95 | buf 96 | (point) 97 | (org-element-property 98 | :end (org-element-at-point))) 99 | (save-restriction 100 | (org-narrow-to-subtree) 101 | (setq org-ids 102 | (append 103 | (gnorb-collect-ids) 104 | org-ids)) 105 | (when org-ids 106 | (with-current-buffer buf 107 | ;; The file list var is buffer local, so set it 108 | ;; (local to the nnir-tmp-buffer) to a full list 109 | ;; of all files in the subtree. 110 | (dolist (id org-ids) 111 | (setq nngnorb-attachment-file-list 112 | (append (gnorb-org-attachment-list id) 113 | nngnorb-attachment-file-list)))))))) 114 | ((listp q) 115 | ;; be a little careful: this could be a list of links, or 116 | ;; it could be the full plist 117 | (setq links (if (plist-member q :gnus) 118 | (plist-get q :gnus) 119 | q))) 120 | (t (org-map-entries 121 | (lambda () 122 | (push (org-id-get) org-ids) 123 | (append-to-buffer 124 | buf 125 | (point) 126 | (save-excursion 127 | (outline-next-heading) 128 | (point)))) 129 | q 130 | 'agenda))) 131 | (with-current-buffer buf 132 | (goto-char (point-min)) 133 | (setq links (plist-get (gnorb-scan-links (point-max) 'gnus) 134 | :gnus)) 135 | (goto-char (point-min)) 136 | (while (re-search-forward 137 | (concat ":" gnorb-org-msg-id-key ": \\([^\n]+\\)") 138 | (point-max) t) 139 | (setq msg-ids (append (split-string (match-string 1)) msg-ids)))) 140 | ;; Here's where we maybe do some duplicate work using the 141 | ;; registry. Take our org ids and find all relevant message ids. 142 | (dolist (i (delq nil org-ids)) 143 | (let ((rel-msg-id (gnorb-registry-org-id-search i))) 144 | (when rel-msg-id 145 | (setq msg-ids (append (delq nil rel-msg-id) msg-ids))))) 146 | (when msg-ids 147 | (dolist (id msg-ids) 148 | (let ((link (gnorb-msg-id-to-link id))) 149 | (when link 150 | (push link links))))) 151 | (setq links (sort (delete-dups links) 'string<)) 152 | (unless (gnus-alive-p) 153 | (gnus)) 154 | (dolist (m links (when vectors 155 | (reverse vectors))) 156 | (let (server-group msg-id artno check) 157 | (setq m (org-link-unescape m)) 158 | (when (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" m) 159 | (setq server-group (match-string 1 m) 160 | msg-id (gnorb-bracket-message-id 161 | (match-string 3 m)) 162 | artno (or (car (gnus-registry-get-id-key msg-id 'artno)) 163 | (when (setq check 164 | (cdr (ignore-errors 165 | (gnus-request-head 166 | msg-id server-group)))) 167 | (gnus-registry-set-id-key 168 | msg-id 'artno 169 | (list check)) 170 | check))) 171 | (when artno 172 | (when (and (integerp artno) (> artno 0)) 173 | (push (vector server-group artno 100) vectors))))))))) 174 | 175 | (defvar gnorb-summary-minor-mode-map (make-sparse-keymap) 176 | "Keymap for use in Gnorb's *Summary* minor mode.") 177 | 178 | (define-minor-mode gnorb-summary-minor-mode 179 | "A minor mode for use in nnir *Summary* buffers created by Gnorb. 180 | 181 | These *Summary* buffers are usually created by calling 182 | `gnorb-org-view', or by initiating an nnir search on a nngnorb server. 183 | 184 | While active, this mode provides some Gnorb-specific commands, 185 | and also advises Gnus' reply-related commands in order to 186 | continue to provide tracking of sent messages." 187 | nil " Gnorb" gnorb-summary-minor-mode-map 188 | (setq nngnorb-attachment-file-list 189 | ;; Copy the list of attached files from the nnir-tmp-buffer to 190 | ;; this summary buffer. 191 | (buffer-local-value 192 | 'nngnorb-attachment-file-list 193 | (get-buffer-create nnir-tmp-buffer)))) 194 | 195 | (define-key gnorb-summary-minor-mode-map 196 | [remap gnus-summary-exit] 197 | 'gnorb-summary-exit) 198 | 199 | (define-key gnorb-summary-minor-mode-map (kbd "C-c d") 200 | 'gnorb-summary-disassociate-message) 201 | 202 | ;; All this is pretty horrible, but it's the only way to get sane 203 | ;; behavior, there are no appropriate hooks, and I want to avoid 204 | ;; advising functions. 205 | 206 | (define-key gnorb-summary-minor-mode-map 207 | [remap gnus-summary-very-wide-reply-with-original] 208 | 'gnorb-summary-very-wide-reply-with-original) 209 | 210 | (define-key gnorb-summary-minor-mode-map 211 | [remap gnus-summary-wide-reply-with-original] 212 | 'gnorb-summary-wide-reply-with-original) 213 | 214 | (define-key gnorb-summary-minor-mode-map 215 | [remap gnus-summary-reply] 216 | 'gnorb-summary-reply) 217 | 218 | (define-key gnorb-summary-minor-mode-map 219 | [remap gnus-summary-very-wide-reply] 220 | 'gnorb-summary-very-wide-reply) 221 | 222 | (define-key gnorb-summary-minor-mode-map 223 | [remap gnus-summary-reply-with-original] 224 | 'gnorb-summary-reply-with-original) 225 | 226 | (define-key gnorb-summary-minor-mode-map 227 | [remap gnus-summary-wide-reply] 228 | 'gnorb-summary-wide-reply) 229 | 230 | (define-key gnorb-summary-minor-mode-map 231 | [remap gnus-summary-mail-forward] 232 | 'gnorb-summary-mail-forward) 233 | 234 | (defun gnorb-summary-wide-reply (&optional yank) 235 | (interactive 236 | (list (and current-prefix-arg 237 | (gnus-summary-work-articles 1)))) 238 | (gnorb-summary-reply yank t)) 239 | 240 | (defun gnorb-summary-reply-with-original (n &optional wide) 241 | (interactive "P") 242 | (gnorb-summary-reply (gnus-summary-work-articles n) wide)) 243 | 244 | (defun gnorb-summary-very-wide-reply (&optional yank) 245 | (interactive 246 | (list (and current-prefix-arg 247 | (gnus-summary-work-articles 1)))) 248 | (gnorb-summary-reply yank t (gnus-summary-work-articles yank))) 249 | 250 | (defun gnorb-summary-reply (&optional yank wide very-wide) 251 | (interactive) 252 | (gnus-summary-reply yank wide very-wide) 253 | (gnorb-summary-reply-hook)) 254 | 255 | (defun gnorb-summary-wide-reply-with-original (n) 256 | (interactive "P") 257 | (gnorb-summary-reply-with-original n t)) 258 | 259 | (defun gnorb-summary-very-wide-reply-with-original (n) 260 | (interactive "P") 261 | (gnorb-summary-reply 262 | (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) 263 | 264 | (defun gnorb-summary-mail-forward (n) 265 | (interactive "P") 266 | (gnus-summary-mail-forward n t) 267 | (gnorb-summary-reply-hook)) 268 | 269 | (defun gnorb-summary-reply-hook (&rest _args) 270 | "Function that runs after any command that creates a reply." 271 | ;; Not actually a "hook" 272 | (let* ((msg-id (if message-reply-headers 273 | (aref message-reply-headers 4) 274 | ;; When forwarding messages, 275 | ;; `message-reply-headers' is nil. 276 | (save-excursion 277 | (let ((case-fold-search t)) 278 | (when (re-search-forward "message-id: +\\(.*\\)$" (point-max) t) 279 | (match-string 1)))))) 280 | (org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids))) 281 | (compose-marker (make-marker)) 282 | (attachments (buffer-local-value 283 | 'nngnorb-attachment-file-list 284 | (get-buffer nnir-tmp-buffer)))) 285 | (when org-id 286 | (move-marker compose-marker (point)) 287 | (save-restriction 288 | (widen) 289 | (message-narrow-to-headers-or-head) 290 | (goto-char (point-at-bol)) 291 | (open-line 1) 292 | (message-insert-header 293 | (intern gnorb-mail-header) 294 | org-id) 295 | ;; As with elsewhere, this should be redundant with 296 | ;; `gnorb-gnus-check-outgoing-headers.' Even if not, it 297 | ;; should be switched to use `message-send-actions' 298 | ;; (add-to-list 'message-exit-actions 299 | ;; 'gnorb-org-restore-after-send t) 300 | ) 301 | (goto-char compose-marker)) 302 | (when attachments 303 | (map-y-or-n-p 304 | (lambda (a) (format "Attach %s to outgoing message? " 305 | (file-name-nondirectory a))) 306 | (lambda (a) 307 | (mml-attach-file a (mm-default-file-encoding a) 308 | nil "attachment")) 309 | attachments 310 | '("file" "files" "attach"))))) 311 | 312 | (defun gnorb-summary-exit () 313 | "Like `gnus-summary-exit', but restores the gnorb window conf." 314 | (interactive) 315 | (call-interactively 'gnus-summary-exit) 316 | (gnorb-restore-layout)) 317 | 318 | (defun gnorb-summary-disassociate-message () 319 | "Disassociate a message from its Org TODO. 320 | 321 | This is used in a Gnorb-created *Summary* buffer to remove the 322 | connection between the message and whichever Org TODO resulted in 323 | the message being included in this search." 324 | (interactive) 325 | (unless (get-buffer-window gnus-article-buffer t) 326 | (gnus-summary-display-article 327 | (gnus-summary-article-number))) 328 | (let* ((msg-id (gnus-fetch-original-field "message-id")) 329 | (org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids)) 330 | chosen multiple-alist) 331 | (if org-ids 332 | (progn 333 | (if (= (length org-ids) 1) 334 | ;; Only one associated Org TODO. 335 | (progn (gnus-registry-set-id-key msg-id 'gnorb-ids nil) 336 | (setq chosen (car org-ids))) 337 | ;; Multiple associated TODOs, prompt to choose one. 338 | (setq multiple-alist 339 | (mapcar 340 | (lambda (h) 341 | (cons (gnorb-pretty-outline h) h)) 342 | org-ids)) 343 | (setq chosen 344 | (cdr 345 | (assoc 346 | (org-completing-read 347 | "Choose a TODO to disassociate from: " 348 | multiple-alist) 349 | multiple-alist))) 350 | (gnus-registry-set-id-key msg-id 'gnorb-ids 351 | (remove chosen org-ids))) 352 | (message "Message disassociated from %s" 353 | (gnorb-pretty-outline chosen))) 354 | (message "Message has no associations")))) 355 | 356 | (defvar nngnorb-status-string "") 357 | 358 | (defun nngnorb-retrieve-headers (_articles &optional _group _server _fetch-old) 359 | (with-current-buffer nntp-server-buffer 360 | (erase-buffer)) 361 | 'nov) 362 | 363 | (defun nngnorb-open-server (_server &optional _definitions) 364 | t) 365 | 366 | (defun nngnorb-close-server (&optional _server) 367 | t) 368 | 369 | (defun nngnorb-request-close () 370 | t) 371 | 372 | (defun nngnorb-server-opened (&optional _server) 373 | t) 374 | 375 | (defun nngnorb-status-message (&optional _server) 376 | nngnorb-status-string) 377 | 378 | (defun nngnorb-request-article (_article &optional _group _server _to-buffer) 379 | (setq nngnorb-status-string "No such group") 380 | nil) 381 | 382 | (defun nngnorb-request-group (_group &optional _server _fast _info) 383 | (let (deactivate-mark) 384 | (with-current-buffer nntp-server-buffer 385 | (erase-buffer) 386 | (insert "411 no such news group\n"))) 387 | (setq nngnorb-status-string "No such group") 388 | nil) 389 | 390 | (defun nngnorb-close-group (_group &optional _server) 391 | t) 392 | 393 | (defun nngnorb-request-list (&optional _server) 394 | (with-current-buffer nntp-server-buffer 395 | (erase-buffer)) 396 | t) 397 | 398 | (defun nngnorb-request-post (&optional _server) 399 | (setq nngnorb-status-string "Read-only server") 400 | nil) 401 | 402 | (provide 'nngnorb) 403 | 404 | ;;; nnnil.el ends here 405 | --------------------------------------------------------------------------------