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