Commit | Line | Data |
---|---|---|
eec82323 | 1 | ;;; nndraft.el --- draft article access for Gnus |
23f87bed | 2 | |
ba318903 | 3 | ;; Copyright (C) 1995-2014 Free Software Foundation, Inc. |
eec82323 | 4 | |
6748645f | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
6 | ;; Keywords: news |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
eec82323 | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
eec82323 LMI |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eec82323 LMI |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
8db5f662 KY |
27 | ;; For Emacs <22.2 and XEmacs. |
28 | (eval-and-compile | |
29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | |
30 | ||
eec82323 | 31 | (require 'nnheader) |
6748645f LMI |
32 | (require 'nnmail) |
33 | (require 'gnus-start) | |
8db5f662 | 34 | (require 'gnus-group) |
eec82323 LMI |
35 | (require 'nnmh) |
36 | (require 'nnoo) | |
16409b0b | 37 | (require 'mm-util) |
23f87bed | 38 | (eval-when-compile (require 'cl)) |
eec82323 | 39 | |
5261b92e GM |
40 | ;; The nnoo-import at the end, I think. |
41 | (declare-function nndraft-request-list "nndraft" (&rest args) t) | |
8db5f662 | 42 | |
6748645f LMI |
43 | (nnoo-declare nndraft |
44 | nnmh) | |
eec82323 | 45 | |
6748645f LMI |
46 | (defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/") |
47 | "Where nndraft will store its files." | |
48 | nnmh-directory) | |
eec82323 | 49 | |
01c52d31 MB |
50 | (defvar nndraft-required-headers '(Date) |
51 | "*Headers to be generated when saving a draft message. | |
52 | The headers in this variable and the ones in `message-required-headers' | |
53 | are generated if and only if they are also in `message-draft-headers'.") | |
54 | ||
eec82323 LMI |
55 | \f |
56 | ||
6748645f LMI |
57 | (defvoo nndraft-current-group "" nil nnmh-current-group) |
58 | (defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail) | |
59 | (defvoo nndraft-current-directory nil nil nnmh-current-directory) | |
60 | ||
eec82323 | 61 | (defconst nndraft-version "nndraft 1.0") |
6748645f | 62 | (defvoo nndraft-status-string "" nil nnmh-status-string) |
eec82323 LMI |
63 | |
64 | \f | |
65 | ||
66 | ;;; Interface functions. | |
67 | ||
68 | (nnoo-define-basics nndraft) | |
69 | ||
6748645f LMI |
70 | (deffoo nndraft-open-server (server &optional defs) |
71 | (nnoo-change-server 'nndraft server defs) | |
72 | (cond | |
73 | ((not (file-exists-p nndraft-directory)) | |
74 | (nndraft-close-server) | |
75 | (nnheader-report 'nndraft "No such file or directory: %s" | |
76 | nndraft-directory)) | |
77 | ((not (file-directory-p (file-truename nndraft-directory))) | |
78 | (nndraft-close-server) | |
79 | (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory)) | |
80 | (t | |
81 | (nnheader-report 'nndraft "Opened server %s using directory %s" | |
82 | server nndraft-directory) | |
83 | t))) | |
84 | ||
eec82323 | 85 | (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) |
6748645f | 86 | (nndraft-possibly-change-group group) |
20a673b2 | 87 | (with-current-buffer nntp-server-buffer |
eec82323 | 88 | (erase-buffer) |
758845a0 | 89 | (let (article lines chars) |
eec82323 LMI |
90 | ;; We don't support fetching by Message-ID. |
91 | (if (stringp (car articles)) | |
92 | 'headers | |
93 | (while articles | |
16409b0b | 94 | (narrow-to-region (point) (point)) |
eec82323 LMI |
95 | (when (nndraft-request-article |
96 | (setq article (pop articles)) group server (current-buffer)) | |
97 | (goto-char (point-min)) | |
98 | (if (search-forward "\n\n" nil t) | |
99 | (forward-line -1) | |
100 | (goto-char (point-max))) | |
758845a0 LMI |
101 | (setq lines (count-lines (point) (point-max)) |
102 | chars (- (point-max) (point))) | |
eec82323 | 103 | (delete-region (point) (point-max)) |
16409b0b | 104 | (goto-char (point-min)) |
eec82323 | 105 | (insert (format "221 %d Article retrieved.\n" article)) |
758845a0 | 106 | (insert (format "Lines: %d\nChars: %d\n" lines chars)) |
16409b0b GM |
107 | (widen) |
108 | (goto-char (point-max)) | |
eec82323 LMI |
109 | (insert ".\n"))) |
110 | ||
111 | (nnheader-fold-continuation-lines) | |
112 | 'headers)))) | |
113 | ||
eec82323 | 114 | (deffoo nndraft-request-article (id &optional group server buffer) |
6748645f | 115 | (nndraft-possibly-change-group group) |
eec82323 LMI |
116 | (when (numberp id) |
117 | ;; We get the newest file of the auto-saved file and the | |
118 | ;; "real" file. | |
119 | (let* ((file (nndraft-article-filename id)) | |
120 | (auto (nndraft-auto-save-file-name file)) | |
121 | (newest (if (file-newer-than-file-p file auto) file auto)) | |
122 | (nntp-server-buffer (or buffer nntp-server-buffer))) | |
123 | (when (and (file-exists-p newest) | |
16409b0b GM |
124 | (let ((nnmail-file-coding-system |
125 | (if (file-newer-than-file-p file auto) | |
23f87bed | 126 | (if (member group '("drafts" "delayed")) |
16409b0b GM |
127 | message-draft-coding-system |
128 | mm-text-coding-system) | |
129 | mm-auto-save-coding-system))) | |
130 | (nnmail-find-file newest))) | |
20a673b2 | 131 | (with-current-buffer nntp-server-buffer |
eec82323 LMI |
132 | (goto-char (point-min)) |
133 | ;; If there's a mail header separator in this file, | |
134 | ;; we remove it. | |
135 | (when (re-search-forward | |
23f87bed | 136 | (concat "^" (regexp-quote mail-header-separator) "$") nil t) |
eec82323 LMI |
137 | (replace-match "" t t))) |
138 | t)))) | |
139 | ||
140 | (deffoo nndraft-request-restore-buffer (article &optional group server) | |
141 | "Request a new buffer that is restored to the state of ARTICLE." | |
6748645f LMI |
142 | (nndraft-possibly-change-group group) |
143 | (when (nndraft-request-article article group server (current-buffer)) | |
144 | (message-remove-header "xref") | |
145 | (message-remove-header "lines") | |
23f87bed MB |
146 | ;; Articles in nndraft:queue are considered as sent messages. The |
147 | ;; Date field should be the time when they are sent. | |
148 | ;;(message-remove-header "date") | |
6748645f | 149 | t)) |
eec82323 LMI |
150 | |
151 | (deffoo nndraft-request-update-info (group info &optional server) | |
6748645f LMI |
152 | (nndraft-possibly-change-group group) |
153 | (gnus-info-set-read | |
154 | info | |
155 | (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) | |
156 | (nndraft-articles) t)) | |
16409b0b GM |
157 | (let ((marks (nth 3 info))) |
158 | (when marks | |
159 | ;; Nix out all marks except the `unsend'-able article marks. | |
6748645f LMI |
160 | (setcar (nthcdr 3 info) |
161 | (if (assq 'unsend marks) | |
162 | (list (assq 'unsend marks)) | |
163 | nil)))) | |
eec82323 LMI |
164 | t) |
165 | ||
23f87bed MB |
166 | (defun nndraft-generate-headers () |
167 | (save-excursion | |
168 | (message-generate-headers | |
169 | (message-headers-to-generate | |
01c52d31 | 170 | nndraft-required-headers message-draft-headers nil)))) |
23f87bed | 171 | |
30b0f250 KY |
172 | (defun nndraft-update-unread-articles () |
173 | "Update groups' unread articles in the group buffer." | |
174 | (nndraft-request-list) | |
175 | (with-current-buffer gnus-group-buffer | |
bb9e218d KY |
176 | (let* ((groups (mapcar (lambda (elem) |
177 | (gnus-group-prefixed-name (car elem) | |
178 | (list 'nndraft ""))) | |
179 | (nnmail-get-active))) | |
180 | (gnus-group-marked (copy-sequence groups)) | |
39397fad KY |
181 | ;; Don't send delayed articles. |
182 | (gnus-get-new-news-hook nil) | |
bb9e218d KY |
183 | (inhibit-read-only t)) |
184 | (gnus-group-get-new-news-this-group nil t) | |
9937bef4 G |
185 | (save-excursion |
186 | (dolist (group groups) | |
187 | (unless (and gnus-permanently-visible-groups | |
188 | (string-match gnus-permanently-visible-groups | |
189 | group)) | |
190 | (gnus-group-goto-group group) | |
191 | (when (zerop (gnus-group-group-unread)) | |
192 | (gnus-delete-line)))))))) | |
30b0f250 | 193 | |
eec82323 LMI |
194 | (deffoo nndraft-request-associate-buffer (group) |
195 | "Associate the current buffer with some article in the draft group." | |
6748645f LMI |
196 | (nndraft-open-server "") |
197 | (nndraft-request-group group) | |
198 | (nndraft-possibly-change-group group) | |
199 | (let ((gnus-verbose-backends nil) | |
200 | (buf (current-buffer)) | |
16409b0b GM |
201 | article file) |
202 | (with-temp-buffer | |
203 | (insert-buffer-substring buf) | |
6748645f | 204 | (setq article (nndraft-request-accept-article |
16409b0b GM |
205 | group (nnoo-current-server 'nndraft) t 'noinsert) |
206 | file (nndraft-article-filename article))) | |
207 | (setq buffer-file-name (expand-file-name file) | |
208 | buffer-auto-save-file-name (make-auto-save-file-name)) | |
eec82323 | 209 | (clear-visited-file-modtime) |
4a43ee9b MB |
210 | (let ((hook (if (boundp 'write-contents-functions) |
211 | 'write-contents-functions | |
212 | 'write-contents-hooks))) | |
213 | (gnus-make-local-hook hook) | |
214 | (add-hook hook 'nndraft-generate-headers nil t)) | |
30b0f250 KY |
215 | (gnus-make-local-hook 'after-save-hook) |
216 | (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t) | |
217 | (message-add-action '(nndraft-update-unread-articles) | |
218 | 'exit 'postpone 'kill) | |
eec82323 LMI |
219 | article)) |
220 | ||
286c4fc2 | 221 | (deffoo nndraft-request-group (group &optional server dont-check info) |
23f87bed MB |
222 | (nndraft-possibly-change-group group) |
223 | (unless dont-check | |
224 | (let* ((pathname (nnmail-group-pathname group nndraft-directory)) | |
225 | (file-name-coding-system nnmail-pathname-coding-system) | |
226 | dir file) | |
227 | (nnheader-re-read-dir pathname) | |
e9bd5782 | 228 | (setq dir (mapcar (lambda (name) (string-to-number (substring name 1))) |
23f87bed MB |
229 | (ignore-errors (directory-files |
230 | pathname nil "^#[0-9]+#$" t)))) | |
231 | (dolist (n dir) | |
232 | (unless (file-exists-p | |
233 | (setq file (expand-file-name (int-to-string n) pathname))) | |
234 | (rename-file (nndraft-auto-save-file-name file) file))))) | |
235 | (nnoo-parent-function 'nndraft | |
236 | 'nnmh-request-group | |
237 | (list group server dont-check))) | |
238 | ||
c9fc72fa | 239 | (deffoo nndraft-request-move-article (article group server accept-form |
01c52d31 | 240 | &optional last move-is-internal) |
23f87bed MB |
241 | (nndraft-possibly-change-group group) |
242 | (let ((buf (get-buffer-create " *nndraft move*")) | |
243 | result) | |
244 | (and | |
245 | (nndraft-request-article article group server) | |
20a673b2 | 246 | (with-current-buffer buf |
23f87bed MB |
247 | (erase-buffer) |
248 | (insert-buffer-substring nntp-server-buffer) | |
249 | (setq result (eval accept-form)) | |
250 | (kill-buffer (current-buffer)) | |
251 | result) | |
252 | (null (nndraft-request-expire-articles (list article) group server 'force)) | |
253 | result))) | |
254 | ||
6748645f LMI |
255 | (deffoo nndraft-request-expire-articles (articles group &optional server force) |
256 | (nndraft-possibly-change-group group) | |
257 | (let* ((nnmh-allow-delete-final t) | |
115694a3 KY |
258 | (nnmail-expiry-target 'delete) |
259 | ;; FIXME: If we want to move a draft message to an expiry group, | |
260 | ;; there are things to have to improve: | |
261 | ;; - Remove a header separator. | |
262 | ;; - Encode it, including attachments, into a MIME message. | |
263 | ;;(nnmail-expiry-target | |
264 | ;; (or (gnus-group-find-parameter | |
265 | ;; (gnus-group-prefixed-name group (list 'nndraft server)) | |
266 | ;; 'expiry-target t) | |
267 | ;; nnmail-expiry-target)) | |
6748645f LMI |
268 | (res (nnoo-parent-function 'nndraft |
269 | 'nnmh-request-expire-articles | |
270 | (list articles group server force))) | |
271 | article) | |
eec82323 LMI |
272 | ;; Delete all the "state" files of articles that have been expired. |
273 | (while articles | |
274 | (unless (memq (setq article (pop articles)) res) | |
6748645f | 275 | (let ((auto (nndraft-auto-save-file-name |
eec82323 | 276 | (nndraft-article-filename article)))) |
eec82323 | 277 | (when (file-exists-p auto) |
16409b0b GM |
278 | (funcall nnmail-delete-file-function auto))) |
279 | (dolist (backup | |
280 | (let ((kept-new-versions 1) | |
281 | (kept-old-versions 0)) | |
282 | (find-backup-file-name | |
283 | (nndraft-article-filename article)))) | |
284 | (when (file-exists-p backup) | |
285 | (funcall nnmail-delete-file-function backup))))) | |
eec82323 LMI |
286 | res)) |
287 | ||
288 | (deffoo nndraft-request-accept-article (group &optional server last noinsert) | |
6748645f LMI |
289 | (nndraft-possibly-change-group group) |
290 | (let ((gnus-verbose-backends nil)) | |
291 | (nnoo-parent-function 'nndraft 'nnmh-request-accept-article | |
292 | (list group server last noinsert)))) | |
eec82323 | 293 | |
16409b0b GM |
294 | (deffoo nndraft-request-replace-article (article group buffer) |
295 | (nndraft-possibly-change-group group) | |
296 | (let ((nnmail-file-coding-system | |
23f87bed MB |
297 | (if (member group '("drafts" "delayed")) |
298 | message-draft-coding-system | |
16409b0b GM |
299 | mm-text-coding-system))) |
300 | (nnoo-parent-function 'nndraft 'nnmh-request-replace-article | |
301 | (list article group buffer)))) | |
302 | ||
eec82323 | 303 | (deffoo nndraft-request-create-group (group &optional server args) |
6748645f LMI |
304 | (nndraft-possibly-change-group group) |
305 | (if (file-exists-p nndraft-current-directory) | |
306 | (if (file-directory-p nndraft-current-directory) | |
eec82323 LMI |
307 | t |
308 | nil) | |
309 | (condition-case () | |
310 | (progn | |
6748645f | 311 | (gnus-make-directory nndraft-current-directory) |
eec82323 LMI |
312 | t) |
313 | (file-error nil)))) | |
314 | ||
315 | \f | |
316 | ;;; Low-Level Interface | |
317 | ||
6748645f LMI |
318 | (defun nndraft-possibly-change-group (group) |
319 | (when (and group | |
320 | (not (equal group nndraft-current-group))) | |
321 | (nndraft-open-server "") | |
322 | (setq nndraft-current-group group) | |
323 | (setq nndraft-current-directory | |
324 | (nnheader-concat nndraft-directory group)))) | |
eec82323 LMI |
325 | |
326 | (defun nndraft-article-filename (article &rest args) | |
327 | (apply 'concat | |
6748645f | 328 | (file-name-as-directory nndraft-current-directory) |
eec82323 LMI |
329 | (int-to-string article) |
330 | args)) | |
331 | ||
332 | (defun nndraft-auto-save-file-name (file) | |
333 | (save-excursion | |
334 | (prog1 | |
335 | (progn | |
336 | (set-buffer (get-buffer-create " *draft tmp*")) | |
337 | (setq buffer-file-name file) | |
338 | (make-auto-save-file-name)) | |
339 | (kill-buffer (current-buffer))))) | |
340 | ||
6748645f LMI |
341 | (defun nndraft-articles () |
342 | "Return the list of messages in the group." | |
343 | (gnus-make-directory nndraft-current-directory) | |
344 | (sort | |
e9bd5782 | 345 | (mapcar 'string-to-number |
6748645f LMI |
346 | (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t)) |
347 | '<)) | |
348 | ||
349 | (nnoo-import nndraft | |
350 | (nnmh | |
351 | nnmh-retrieve-headers | |
352 | nnmh-request-group | |
353 | nnmh-close-group | |
394679ff | 354 | nnmh-request-list)) |
6748645f | 355 | |
eec82323 LMI |
356 | (provide 'nndraft) |
357 | ||
358 | ;;; nndraft.el ends here |