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