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.
46 (defvar nngnorb-status-string "")
48 (defvar nngnorb-attachment-file-list nil
49 "A place to store Org attachments relevant to the subtree being
52 (make-variable-buffer-local 'nngnorb-attachment-file-list)
54 (gnus-declare-backend "nngnorb" 'none)
56 (add-to-list 'nnir-method-default-engines '(nngnorb . gnorb))
58 (add-to-list 'nnir-engines
59 '(gnorb nnir-run-gnorb))
61 (defun nnir-run-gnorb (query server &optional group)
62 "Run the actual search for messages to display. See nnir.el for
63 some details of how this gets called.
65 As things stand, the query string can be given as one of two
66 different things. First is the ID string of an Org heading,
67 prefixed with \"id+\". This was probably a bad choice as it could
68 conceivably look like an org tags search string. Fix that later.
69 If it's an ID, then the entire subtree text of that heading is
70 scanned for gnus links, and the messages relevant to the subtree
71 are collected from the registry, and all the resulting messages
72 are displayed in an ephemeral group.
74 Otherwise, the query string can be a tags match string, a la the
75 Org agenda tags search. All headings matched by this string will
76 be scanned for gnus messages, and those messages displayed."
77 ;; During the transition period between using message-ids stored in
78 ;; a property, and the new registry-based system, we're going to use
79 ;; both methods to collect relevant messages. This could be a little
80 ;; slower, but for the time being it will be safer.
82 (let ((q (cdr (assq 'query query)))
83 (buf (get-buffer-create nnir-tmp-buffer))
84 msg-ids org-ids links vectors)
85 (with-current-buffer buf
87 (setq nngnorb-attachment-file-list nil))
88 (when (equal "5.13" gnus-version-number)
90 (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q)
91 (with-demoted-errors "Error: %S"
92 (org-id-goto (match-string 1 q))
97 :end (org-element-at-point)))
99 (org-narrow-to-subtree)
105 (with-current-buffer buf
106 ;; The file list var is buffer local, so set it
107 ;; (local to the nnir-tmp-buffer) to a full list
108 ;; of all files in the subtree.
110 (setq nngnorb-attachment-file-list
111 (append (gnorb-org-attachment-list id)
112 nngnorb-attachment-file-list))))))))
114 ;; be a little careful: this could be a list of links, or
115 ;; it could be the full plist
116 (setq links (if (plist-member q :gnus)
121 (push (org-id-get) org-ids)
126 (outline-next-heading)
130 (with-current-buffer buf
131 (goto-char (point-min))
132 (setq links (plist-get (gnorb-scan-links (point-max) 'gnus)
134 (goto-char (point-min))
135 (while (re-search-forward
136 (concat ":" gnorb-org-msg-id-key ": \\([^\n]+\\)")
138 (setq msg-ids (append (split-string (match-string 1)) msg-ids))))
139 ;; Here's where we maybe do some duplicate work using the
140 ;; registry. Take our org ids and find all relevant message ids.
141 (dolist (i (delq nil org-ids))
142 (let ((rel-msg-id (gnorb-registry-org-id-search i)))
144 (setq msg-ids (append rel-msg-id msg-ids)))))
147 (let ((link (gnorb-msg-id-to-link id)))
149 (push link links)))))
150 (setq links (delete-dups links))
151 (unless (gnus-alive-p)
153 (dolist (m links (when vectors
155 (let (server-group msg-id result artno)
156 (setq m (org-link-unescape m))
157 (when (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" m)
158 (setq server-group (match-string 1 m)
159 msg-id (match-string 3 m)
160 result (ignore-errors (gnus-request-head msg-id server-group)))
162 (setq artno (cdr result))
163 (when (and (integerp artno) (> artno 0))
164 (push (vector server-group artno 100) vectors)))))))))
166 (defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
167 "Keymap for use in Gnorb's *Summary* minor mode.")
169 (define-minor-mode gnorb-summary-minor-mode
170 "A minor mode for use in nnir *Summary* buffers created by Gnorb.
172 These *Summary* buffers are usually created by calling
173 `gnorb-org-view', or by initiating an nnir search on a nngnorb server.
175 While active, this mode provides some Gnorb-specific commands,
176 and also advises Gnus' reply-related commands in order to
177 continue to provide tracking of sent messages."
178 nil " Gnorb" gnorb-summary-minor-mode-map
179 (setq nngnorb-attachment-file-list
180 ;; Copy the list of attached files from the nnir-tmp-buffer to
181 ;; this summary buffer.
183 'nngnorb-attachment-file-list
184 (get-buffer nnir-tmp-buffer))))
186 (define-key gnorb-summary-minor-mode-map
187 [remap gnus-summary-exit]
190 (define-key gnorb-summary-minor-mode-map (kbd "C-c d")
191 'gnorb-summary-disassociate-message)
193 ;; All this is pretty horrible, but it's the only way to get sane
194 ;; behavior, there are no appropriate hooks, and I want to avoid
195 ;; advising functions.
197 (define-key gnorb-summary-minor-mode-map
198 [remap gnus-summary-very-wide-reply-with-original]
199 'gnorb-summary-very-wide-reply-with-original)
201 (define-key gnorb-summary-minor-mode-map
202 [remap gnus-summary-wide-reply-with-original]
203 'gnorb-summary-wide-reply-with-original)
205 (define-key gnorb-summary-minor-mode-map
206 [remap gnus-summary-reply]
207 'gnorb-summary-reply)
209 (define-key gnorb-summary-minor-mode-map
210 [remap gnus-summary-very-wide-reply]
211 'gnorb-summary-very-wide-reply)
213 (define-key gnorb-summary-minor-mode-map
214 [remap gnus-summary-reply-with-original]
215 'gnorb-summary-reply-with-original)
217 (define-key gnorb-summary-minor-mode-map
218 [remap gnus-summary-wide-reply]
219 'gnorb-summary-wide-reply)
221 (define-key gnorb-summary-minor-mode-map
222 [remap gnus-summary-mail-forward]
223 'gnorb-summary-mail-forward)
225 (defun gnorb-summary-wide-reply (&optional yank)
227 (list (and current-prefix-arg
228 (gnus-summary-work-articles 1))))
229 (gnorb-summary-reply yank t))
231 (defun gnorb-summary-reply-with-original (n &optional wide)
233 (gnorb-summary-reply (gnus-summary-work-articles n) wide))
235 (defun gnorb-summary-very-wide-reply (&optional yank)
237 (list (and current-prefix-arg
238 (gnus-summary-work-articles 1))))
239 (gnorb-summary-reply yank t (gnus-summary-work-articles yank)))
241 (defun gnorb-summary-reply (&optional yank wide very-wide)
243 (gnus-summary-reply yank wide very-wide)
244 (gnorb-summary-reply-hook))
246 (defun gnorb-summary-wide-reply-with-original (n)
248 (gnorb-summary-reply-with-original n t))
250 (defun gnorb-summary-very-wide-reply-with-original (n)
253 (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
255 (defun gnorb-summary-mail-forward (n)
257 (gnus-summary-mail-forward n t)
258 (gnorb-summary-reply-hook))
260 (defun gnorb-summary-reply-hook (&rest args)
261 "Function that runs after any command that creates a reply."
262 ;; Not actually a "hook"
263 (let* ((msg-id (aref message-reply-headers 4))
264 (org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids)))
265 (compose-marker (make-marker))
266 (attachments (buffer-local-value
267 'nngnorb-attachment-file-list
268 (get-buffer nnir-tmp-buffer))))
270 (move-marker compose-marker (point))
273 (message-narrow-to-headers-or-head)
274 (goto-char (point-at-bol))
276 (message-insert-header
277 (intern gnorb-mail-header)
279 (add-to-list 'message-exit-actions
280 'gnorb-org-restore-after-send t))
281 (goto-char compose-marker))
284 (lambda (a) (format "Attach %s to outgoing message? "
285 (file-name-nondirectory a)))
287 (mml-attach-file a (mm-default-file-encoding a)
290 '("file" "files" "attach")))))
292 (defun gnorb-summary-exit ()
293 "Like `gnus-summary-exit', but restores the gnorb window conf."
295 (call-interactively 'gnus-summary-exit)
296 (gnorb-restore-layout))
298 (defun gnorb-summary-disassociate-message ()
299 "Disassociate a message from its Org TODO.
301 This is used in a Gnorb-created *Summary* buffer to remove the
302 connection between the message and whichever Org TODO resulted in
303 the message being included in this search."
305 (let* ((msg-id (gnus-fetch-original-field "message-id"))
306 (org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
309 (if (= (length org-ids) 1)
310 ;; Only one associated Org TODO.
311 (progn (gnus-registry-set-id-key msg-id 'gnorb-ids)
312 (setq chosen (car org-ids)))
313 ;; Multiple associated TODOs, prompt to choose one.
317 "Choose a TODO to disassociate from: "
320 (cons (gnorb-pretty-outline h) h))
322 (gnus-registry-set-id-key msg-id 'gnorb-ids
323 (remove chosen org-ids)))
324 (message "Message disassociated from %s"
325 (gnorb-pretty-outline chosen)))))
327 (defvar nngnorb-status-string "")
329 (defun nngnorb-retrieve-headers (articles &optional group server fetch-old)
330 (with-current-buffer nntp-server-buffer
334 (defun nngnorb-open-server (server &optional definitions)
337 (defun nngnorb-close-server (&optional server)
340 (defun nngnorb-request-close ()
343 (defun nngnorb-server-opened (&optional server)
346 (defun nngnorb-status-message (&optional server)
347 nngnorb-status-string)
349 (defun nngnorb-request-article (article &optional group server to-buffer)
350 (setq nngnorb-status-string "No such group")
353 (defun nngnorb-request-group (group &optional server fast info)
354 (let (deactivate-mark)
355 (with-current-buffer nntp-server-buffer
357 (insert "411 no such news group\n")))
358 (setq nngnorb-status-string "No such group")
361 (defun nngnorb-close-group (group &optional server)
364 (defun nngnorb-request-list (&optional server)
365 (with-current-buffer nntp-server-buffer
369 (defun nngnorb-request-post (&optional server)
370 (setq nngnorb-status-string "Read-only server")
375 ;;; nnnil.el ends here