1 ;;; nngnorb.el --- Gnorb backend for Gnus
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Author: Eric Abrahamsen <eric@ericabrahamsen.net.>
7 ;; This file is part of GNU Emacs.
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.
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.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; This is a backend for supporting Gnorb-related stuff. I'm going to
25 ;; regret this, I know.
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.
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.
47 (defvar nngnorb-status-string "")
49 (defvar nngnorb-attachment-file-list nil
50 "A place to store Org attachments relevant to the subtree being
53 (make-variable-buffer-local 'nngnorb-attachment-file-list)
55 (gnus-declare-backend "nngnorb" 'none)
57 (add-to-list 'nnir-method-default-engines '(nngnorb . gnorb))
59 (add-to-list 'nnir-engines
60 '(gnorb nnir-run-gnorb))
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.
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.
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.
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
88 (setq nngnorb-attachment-file-list nil))
89 (when (equal "5.13" gnus-version-number)
91 (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q)
92 (with-demoted-errors "Error: %S"
93 (org-id-goto (match-string 1 q))
98 :end (org-element-at-point)))
100 (org-narrow-to-subtree)
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.
111 (setq nngnorb-attachment-file-list
112 (append (gnorb-org-attachment-list id)
113 nngnorb-attachment-file-list))))))))
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)
122 (push (org-id-get) org-ids)
127 (outline-next-heading)
131 (with-current-buffer buf
132 (goto-char (point-min))
133 (setq links (plist-get (gnorb-scan-links (point-max) 'gnus)
135 (goto-char (point-min))
136 (while (re-search-forward
137 (concat ":" gnorb-org-msg-id-key ": \\([^\n]+\\)")
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)))
145 (setq msg-ids (append rel-msg-id msg-ids)))))
148 (let ((link (gnorb-msg-id-to-link id)))
150 (push link links)))))
151 (setq links (delete-dups links))
152 (unless (gnus-alive-p)
154 (dolist (m links (when vectors
156 (let (server-group msg-id result artno)
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
162 result (ignore-errors (gnus-request-head msg-id server-group)))
164 (setq artno (cdr result))
165 (when (and (integerp artno) (> artno 0))
166 (push (vector server-group artno 100) vectors)))))))))
168 (defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
169 "Keymap for use in Gnorb's *Summary* minor mode.")
171 (define-minor-mode gnorb-summary-minor-mode
172 "A minor mode for use in nnir *Summary* buffers created by Gnorb.
174 These *Summary* buffers are usually created by calling
175 `gnorb-org-view', or by initiating an nnir search on a nngnorb server.
177 While active, this mode provides some Gnorb-specific commands,
178 and also advises Gnus' reply-related commands in order to
179 continue to provide tracking of sent messages."
180 nil " Gnorb" gnorb-summary-minor-mode-map
181 (setq nngnorb-attachment-file-list
182 ;; Copy the list of attached files from the nnir-tmp-buffer to
183 ;; this summary buffer.
185 'nngnorb-attachment-file-list
186 (get-buffer nnir-tmp-buffer))))
188 (define-key gnorb-summary-minor-mode-map
189 [remap gnus-summary-exit]
192 (define-key gnorb-summary-minor-mode-map (kbd "C-c d")
193 'gnorb-summary-disassociate-message)
195 ;; All this is pretty horrible, but it's the only way to get sane
196 ;; behavior, there are no appropriate hooks, and I want to avoid
197 ;; advising functions.
199 (define-key gnorb-summary-minor-mode-map
200 [remap gnus-summary-very-wide-reply-with-original]
201 'gnorb-summary-very-wide-reply-with-original)
203 (define-key gnorb-summary-minor-mode-map
204 [remap gnus-summary-wide-reply-with-original]
205 'gnorb-summary-wide-reply-with-original)
207 (define-key gnorb-summary-minor-mode-map
208 [remap gnus-summary-reply]
209 'gnorb-summary-reply)
211 (define-key gnorb-summary-minor-mode-map
212 [remap gnus-summary-very-wide-reply]
213 'gnorb-summary-very-wide-reply)
215 (define-key gnorb-summary-minor-mode-map
216 [remap gnus-summary-reply-with-original]
217 'gnorb-summary-reply-with-original)
219 (define-key gnorb-summary-minor-mode-map
220 [remap gnus-summary-wide-reply]
221 'gnorb-summary-wide-reply)
223 (define-key gnorb-summary-minor-mode-map
224 [remap gnus-summary-mail-forward]
225 'gnorb-summary-mail-forward)
227 (defun gnorb-summary-wide-reply (&optional yank)
229 (list (and current-prefix-arg
230 (gnus-summary-work-articles 1))))
231 (gnorb-summary-reply yank t))
233 (defun gnorb-summary-reply-with-original (n &optional wide)
235 (gnorb-summary-reply (gnus-summary-work-articles n) wide))
237 (defun gnorb-summary-very-wide-reply (&optional yank)
239 (list (and current-prefix-arg
240 (gnus-summary-work-articles 1))))
241 (gnorb-summary-reply yank t (gnus-summary-work-articles yank)))
243 (defun gnorb-summary-reply (&optional yank wide very-wide)
245 (gnus-summary-reply yank wide very-wide)
246 (gnorb-summary-reply-hook))
248 (defun gnorb-summary-wide-reply-with-original (n)
250 (gnorb-summary-reply-with-original n t))
252 (defun gnorb-summary-very-wide-reply-with-original (n)
255 (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
257 (defun gnorb-summary-mail-forward (n)
259 (gnus-summary-mail-forward n t)
260 (gnorb-summary-reply-hook))
262 (defun gnorb-summary-reply-hook (&rest args)
263 "Function that runs after any command that creates a reply."
264 ;; Not actually a "hook"
265 (let* ((msg-id (aref message-reply-headers 4))
266 (org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids)))
267 (compose-marker (make-marker))
268 (attachments (buffer-local-value
269 'nngnorb-attachment-file-list
270 (get-buffer nnir-tmp-buffer))))
272 (move-marker compose-marker (point))
275 (message-narrow-to-headers-or-head)
276 (goto-char (point-at-bol))
278 (message-insert-header
279 (intern gnorb-mail-header)
281 (add-to-list 'message-exit-actions
282 'gnorb-org-restore-after-send t))
283 (goto-char compose-marker))
286 (lambda (a) (format "Attach %s to outgoing message? "
287 (file-name-nondirectory a)))
289 (mml-attach-file a (mm-default-file-encoding a)
292 '("file" "files" "attach")))))
294 (defun gnorb-summary-exit ()
295 "Like `gnus-summary-exit', but restores the gnorb window conf."
297 (call-interactively 'gnus-summary-exit)
298 (gnorb-restore-layout))
300 (defun gnorb-summary-disassociate-message ()
301 "Disassociate a message from its Org TODO.
303 This is used in a Gnorb-created *Summary* buffer to remove the
304 connection between the message and whichever Org TODO resulted in
305 the message being included in this search."
307 (unless (get-buffer-window gnus-article-buffer t)
308 (gnus-summary-display-article
309 (gnus-summary-article-number)))
310 (let* ((msg-id (gnus-fetch-original-field "message-id"))
311 (org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
315 (if (= (length org-ids) 1)
316 ;; Only one associated Org TODO.
317 (progn (gnus-registry-set-id-key msg-id 'gnorb-ids nil)
318 (setq chosen (car org-ids)))
319 ;; Multiple associated TODOs, prompt to choose one.
323 "Choose a TODO to disassociate from: "
326 (cons (gnorb-pretty-outline h) h))
328 (gnus-registry-set-id-key msg-id 'gnorb-ids
329 (remove chosen org-ids)))
330 (message "Message disassociated from %s"
331 (gnorb-pretty-outline chosen)))
332 (message "Message has no associations"))))
334 (defvar nngnorb-status-string "")
336 (defun nngnorb-retrieve-headers (articles &optional group server fetch-old)
337 (with-current-buffer nntp-server-buffer
341 (defun nngnorb-open-server (server &optional definitions)
344 (defun nngnorb-close-server (&optional server)
347 (defun nngnorb-request-close ()
350 (defun nngnorb-server-opened (&optional server)
353 (defun nngnorb-status-message (&optional server)
354 nngnorb-status-string)
356 (defun nngnorb-request-article (article &optional group server to-buffer)
357 (setq nngnorb-status-string "No such group")
360 (defun nngnorb-request-group (group &optional server fast info)
361 (let (deactivate-mark)
362 (with-current-buffer nntp-server-buffer
364 (insert "411 no such news group\n")))
365 (setq nngnorb-status-string "No such group")
368 (defun nngnorb-close-group (group &optional server)
371 (defun nngnorb-request-list (&optional server)
372 (with-current-buffer nntp-server-buffer
376 (defun nngnorb-request-post (&optional server)
377 (setq nngnorb-status-string "Read-only server")
382 ;;; nnnil.el ends here