Convert consecutive FSF copyright years to ranges.
[bpt/emacs.git] / lisp / gnus / nndraft.el
CommitLineData
eec82323 1;;; nndraft.el --- draft article access for Gnus
23f87bed 2
73b0cd50 3;; Copyright (C) 1995-2011 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
27(require 'nnheader)
6748645f
LMI
28(require 'nnmail)
29(require 'gnus-start)
eec82323
LMI
30(require 'nnmh)
31(require 'nnoo)
16409b0b 32(require 'mm-util)
23f87bed 33(eval-when-compile (require 'cl))
eec82323 34
6748645f
LMI
35(nnoo-declare nndraft
36 nnmh)
eec82323 37
6748645f
LMI
38(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")
39 "Where nndraft will store its files."
40 nnmh-directory)
eec82323 41
01c52d31
MB
42(defvar nndraft-required-headers '(Date)
43 "*Headers to be generated when saving a draft message.
44The headers in this variable and the ones in `message-required-headers'
45are generated if and only if they are also in `message-draft-headers'.")
46
eec82323
LMI
47\f
48
6748645f
LMI
49(defvoo nndraft-current-group "" nil nnmh-current-group)
50(defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail)
51(defvoo nndraft-current-directory nil nil nnmh-current-directory)
52
eec82323 53(defconst nndraft-version "nndraft 1.0")
6748645f 54(defvoo nndraft-status-string "" nil nnmh-status-string)
eec82323
LMI
55
56\f
57
58;;; Interface functions.
59
60(nnoo-define-basics nndraft)
61
6748645f
LMI
62(deffoo nndraft-open-server (server &optional defs)
63 (nnoo-change-server 'nndraft server defs)
64 (cond
65 ((not (file-exists-p nndraft-directory))
66 (nndraft-close-server)
67 (nnheader-report 'nndraft "No such file or directory: %s"
68 nndraft-directory))
69 ((not (file-directory-p (file-truename nndraft-directory)))
70 (nndraft-close-server)
71 (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory))
72 (t
73 (nnheader-report 'nndraft "Opened server %s using directory %s"
74 server nndraft-directory)
75 t)))
76
eec82323 77(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
6748645f 78 (nndraft-possibly-change-group group)
20a673b2 79 (with-current-buffer nntp-server-buffer
eec82323 80 (erase-buffer)
758845a0 81 (let (article lines chars)
eec82323
LMI
82 ;; We don't support fetching by Message-ID.
83 (if (stringp (car articles))
84 'headers
85 (while articles
16409b0b 86 (narrow-to-region (point) (point))
eec82323
LMI
87 (when (nndraft-request-article
88 (setq article (pop articles)) group server (current-buffer))
89 (goto-char (point-min))
90 (if (search-forward "\n\n" nil t)
91 (forward-line -1)
92 (goto-char (point-max)))
758845a0
LMI
93 (setq lines (count-lines (point) (point-max))
94 chars (- (point-max) (point)))
eec82323 95 (delete-region (point) (point-max))
16409b0b 96 (goto-char (point-min))
eec82323 97 (insert (format "221 %d Article retrieved.\n" article))
758845a0 98 (insert (format "Lines: %d\nChars: %d\n" lines chars))
16409b0b
GM
99 (widen)
100 (goto-char (point-max))
eec82323
LMI
101 (insert ".\n")))
102
103 (nnheader-fold-continuation-lines)
104 'headers))))
105
eec82323 106(deffoo nndraft-request-article (id &optional group server buffer)
6748645f 107 (nndraft-possibly-change-group group)
eec82323
LMI
108 (when (numberp id)
109 ;; We get the newest file of the auto-saved file and the
110 ;; "real" file.
111 (let* ((file (nndraft-article-filename id))
112 (auto (nndraft-auto-save-file-name file))
113 (newest (if (file-newer-than-file-p file auto) file auto))
114 (nntp-server-buffer (or buffer nntp-server-buffer)))
115 (when (and (file-exists-p newest)
16409b0b
GM
116 (let ((nnmail-file-coding-system
117 (if (file-newer-than-file-p file auto)
23f87bed 118 (if (member group '("drafts" "delayed"))
16409b0b
GM
119 message-draft-coding-system
120 mm-text-coding-system)
121 mm-auto-save-coding-system)))
122 (nnmail-find-file newest)))
20a673b2 123 (with-current-buffer nntp-server-buffer
eec82323
LMI
124 (goto-char (point-min))
125 ;; If there's a mail header separator in this file,
126 ;; we remove it.
127 (when (re-search-forward
23f87bed 128 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
eec82323
LMI
129 (replace-match "" t t)))
130 t))))
131
132(deffoo nndraft-request-restore-buffer (article &optional group server)
133 "Request a new buffer that is restored to the state of ARTICLE."
6748645f
LMI
134 (nndraft-possibly-change-group group)
135 (when (nndraft-request-article article group server (current-buffer))
136 (message-remove-header "xref")
137 (message-remove-header "lines")
23f87bed
MB
138 ;; Articles in nndraft:queue are considered as sent messages. The
139 ;; Date field should be the time when they are sent.
140 ;;(message-remove-header "date")
6748645f 141 t))
eec82323
LMI
142
143(deffoo nndraft-request-update-info (group info &optional server)
6748645f
LMI
144 (nndraft-possibly-change-group group)
145 (gnus-info-set-read
146 info
147 (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
148 (nndraft-articles) t))
16409b0b
GM
149 (let ((marks (nth 3 info)))
150 (when marks
151 ;; Nix out all marks except the `unsend'-able article marks.
6748645f
LMI
152 (setcar (nthcdr 3 info)
153 (if (assq 'unsend marks)
154 (list (assq 'unsend marks))
155 nil))))
eec82323
LMI
156 t)
157
23f87bed
MB
158(defun nndraft-generate-headers ()
159 (save-excursion
160 (message-generate-headers
161 (message-headers-to-generate
01c52d31 162 nndraft-required-headers message-draft-headers nil))))
23f87bed 163
eec82323
LMI
164(deffoo nndraft-request-associate-buffer (group)
165 "Associate the current buffer with some article in the draft group."
6748645f
LMI
166 (nndraft-open-server "")
167 (nndraft-request-group group)
168 (nndraft-possibly-change-group group)
169 (let ((gnus-verbose-backends nil)
170 (buf (current-buffer))
16409b0b
GM
171 article file)
172 (with-temp-buffer
173 (insert-buffer-substring buf)
6748645f 174 (setq article (nndraft-request-accept-article
16409b0b
GM
175 group (nnoo-current-server 'nndraft) t 'noinsert)
176 file (nndraft-article-filename article)))
177 (setq buffer-file-name (expand-file-name file)
178 buffer-auto-save-file-name (make-auto-save-file-name))
eec82323 179 (clear-visited-file-modtime)
4a43ee9b
MB
180 (let ((hook (if (boundp 'write-contents-functions)
181 'write-contents-functions
182 'write-contents-hooks)))
183 (gnus-make-local-hook hook)
184 (add-hook hook 'nndraft-generate-headers nil t))
eec82323
LMI
185 article))
186
286c4fc2 187(deffoo nndraft-request-group (group &optional server dont-check info)
23f87bed
MB
188 (nndraft-possibly-change-group group)
189 (unless dont-check
190 (let* ((pathname (nnmail-group-pathname group nndraft-directory))
191 (file-name-coding-system nnmail-pathname-coding-system)
192 dir file)
193 (nnheader-re-read-dir pathname)
e9bd5782 194 (setq dir (mapcar (lambda (name) (string-to-number (substring name 1)))
23f87bed
MB
195 (ignore-errors (directory-files
196 pathname nil "^#[0-9]+#$" t))))
197 (dolist (n dir)
198 (unless (file-exists-p
199 (setq file (expand-file-name (int-to-string n) pathname)))
200 (rename-file (nndraft-auto-save-file-name file) file)))))
201 (nnoo-parent-function 'nndraft
202 'nnmh-request-group
203 (list group server dont-check)))
204
c9fc72fa 205(deffoo nndraft-request-move-article (article group server accept-form
01c52d31 206 &optional last move-is-internal)
23f87bed
MB
207 (nndraft-possibly-change-group group)
208 (let ((buf (get-buffer-create " *nndraft move*"))
209 result)
210 (and
211 (nndraft-request-article article group server)
20a673b2 212 (with-current-buffer buf
23f87bed
MB
213 (erase-buffer)
214 (insert-buffer-substring nntp-server-buffer)
215 (setq result (eval accept-form))
216 (kill-buffer (current-buffer))
217 result)
218 (null (nndraft-request-expire-articles (list article) group server 'force))
219 result)))
220
6748645f
LMI
221(deffoo nndraft-request-expire-articles (articles group &optional server force)
222 (nndraft-possibly-change-group group)
223 (let* ((nnmh-allow-delete-final t)
4478e074
G
224 (nnmail-expiry-target
225 (or (gnus-group-find-parameter
229b59da 226 (gnus-group-prefixed-name group (list 'nndraft server))
4478e074
G
227 'expiry-target t)
228 nnmail-expiry-target))
6748645f
LMI
229 (res (nnoo-parent-function 'nndraft
230 'nnmh-request-expire-articles
231 (list articles group server force)))
232 article)
eec82323
LMI
233 ;; Delete all the "state" files of articles that have been expired.
234 (while articles
235 (unless (memq (setq article (pop articles)) res)
6748645f 236 (let ((auto (nndraft-auto-save-file-name
eec82323 237 (nndraft-article-filename article))))
eec82323 238 (when (file-exists-p auto)
16409b0b
GM
239 (funcall nnmail-delete-file-function auto)))
240 (dolist (backup
241 (let ((kept-new-versions 1)
242 (kept-old-versions 0))
243 (find-backup-file-name
244 (nndraft-article-filename article))))
245 (when (file-exists-p backup)
246 (funcall nnmail-delete-file-function backup)))))
eec82323
LMI
247 res))
248
249(deffoo nndraft-request-accept-article (group &optional server last noinsert)
6748645f
LMI
250 (nndraft-possibly-change-group group)
251 (let ((gnus-verbose-backends nil))
252 (nnoo-parent-function 'nndraft 'nnmh-request-accept-article
253 (list group server last noinsert))))
eec82323 254
16409b0b
GM
255(deffoo nndraft-request-replace-article (article group buffer)
256 (nndraft-possibly-change-group group)
257 (let ((nnmail-file-coding-system
23f87bed
MB
258 (if (member group '("drafts" "delayed"))
259 message-draft-coding-system
16409b0b
GM
260 mm-text-coding-system)))
261 (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
262 (list article group buffer))))
263
eec82323 264(deffoo nndraft-request-create-group (group &optional server args)
6748645f
LMI
265 (nndraft-possibly-change-group group)
266 (if (file-exists-p nndraft-current-directory)
267 (if (file-directory-p nndraft-current-directory)
eec82323
LMI
268 t
269 nil)
270 (condition-case ()
271 (progn
6748645f 272 (gnus-make-directory nndraft-current-directory)
eec82323
LMI
273 t)
274 (file-error nil))))
275
276\f
277;;; Low-Level Interface
278
6748645f
LMI
279(defun nndraft-possibly-change-group (group)
280 (when (and group
281 (not (equal group nndraft-current-group)))
282 (nndraft-open-server "")
283 (setq nndraft-current-group group)
284 (setq nndraft-current-directory
285 (nnheader-concat nndraft-directory group))))
eec82323
LMI
286
287(defun nndraft-article-filename (article &rest args)
288 (apply 'concat
6748645f 289 (file-name-as-directory nndraft-current-directory)
eec82323
LMI
290 (int-to-string article)
291 args))
292
293(defun nndraft-auto-save-file-name (file)
294 (save-excursion
295 (prog1
296 (progn
297 (set-buffer (get-buffer-create " *draft tmp*"))
298 (setq buffer-file-name file)
299 (make-auto-save-file-name))
300 (kill-buffer (current-buffer)))))
301
6748645f
LMI
302(defun nndraft-articles ()
303 "Return the list of messages in the group."
304 (gnus-make-directory nndraft-current-directory)
305 (sort
e9bd5782 306 (mapcar 'string-to-number
6748645f
LMI
307 (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
308 '<))
309
310(nnoo-import nndraft
311 (nnmh
312 nnmh-retrieve-headers
313 nnmh-request-group
314 nnmh-close-group
16409b0b 315 nnmh-request-list
23f87bed 316 nnmh-request-newsgroups))
6748645f 317
eec82323
LMI
318(provide 'nndraft)
319
320;;; nndraft.el ends here