nndraft.el (nndraft-update-unread-articles): Don't show group having no unread articl...
[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
30b0f250
KY
164(defun nndraft-update-unread-articles ()
165 "Update groups' unread articles in the group buffer."
166 (nndraft-request-list)
167 (with-current-buffer gnus-group-buffer
bb9e218d
KY
168 (let* ((groups (mapcar (lambda (elem)
169 (gnus-group-prefixed-name (car elem)
170 (list 'nndraft "")))
171 (nnmail-get-active)))
172 (gnus-group-marked (copy-sequence groups))
173 (inhibit-read-only t))
174 (gnus-group-get-new-news-this-group nil t)
175 (dolist (group groups)
176 (unless (and gnus-permanently-visible-groups
177 (string-match gnus-permanently-visible-groups
178 group))
179 (gnus-group-goto-group group)
180 (when (zerop (gnus-group-group-unread))
181 (gnus-delete-line)))))))
30b0f250 182
eec82323
LMI
183(deffoo nndraft-request-associate-buffer (group)
184 "Associate the current buffer with some article in the draft group."
6748645f
LMI
185 (nndraft-open-server "")
186 (nndraft-request-group group)
187 (nndraft-possibly-change-group group)
188 (let ((gnus-verbose-backends nil)
189 (buf (current-buffer))
16409b0b
GM
190 article file)
191 (with-temp-buffer
192 (insert-buffer-substring buf)
6748645f 193 (setq article (nndraft-request-accept-article
16409b0b
GM
194 group (nnoo-current-server 'nndraft) t 'noinsert)
195 file (nndraft-article-filename article)))
196 (setq buffer-file-name (expand-file-name file)
197 buffer-auto-save-file-name (make-auto-save-file-name))
eec82323 198 (clear-visited-file-modtime)
4a43ee9b
MB
199 (let ((hook (if (boundp 'write-contents-functions)
200 'write-contents-functions
201 'write-contents-hooks)))
202 (gnus-make-local-hook hook)
203 (add-hook hook 'nndraft-generate-headers nil t))
30b0f250
KY
204 (gnus-make-local-hook 'after-save-hook)
205 (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t)
206 (message-add-action '(nndraft-update-unread-articles)
207 'exit 'postpone 'kill)
eec82323
LMI
208 article))
209
286c4fc2 210(deffoo nndraft-request-group (group &optional server dont-check info)
23f87bed
MB
211 (nndraft-possibly-change-group group)
212 (unless dont-check
213 (let* ((pathname (nnmail-group-pathname group nndraft-directory))
214 (file-name-coding-system nnmail-pathname-coding-system)
215 dir file)
216 (nnheader-re-read-dir pathname)
e9bd5782 217 (setq dir (mapcar (lambda (name) (string-to-number (substring name 1)))
23f87bed
MB
218 (ignore-errors (directory-files
219 pathname nil "^#[0-9]+#$" t))))
220 (dolist (n dir)
221 (unless (file-exists-p
222 (setq file (expand-file-name (int-to-string n) pathname)))
223 (rename-file (nndraft-auto-save-file-name file) file)))))
224 (nnoo-parent-function 'nndraft
225 'nnmh-request-group
226 (list group server dont-check)))
227
c9fc72fa 228(deffoo nndraft-request-move-article (article group server accept-form
01c52d31 229 &optional last move-is-internal)
23f87bed
MB
230 (nndraft-possibly-change-group group)
231 (let ((buf (get-buffer-create " *nndraft move*"))
232 result)
233 (and
234 (nndraft-request-article article group server)
20a673b2 235 (with-current-buffer buf
23f87bed
MB
236 (erase-buffer)
237 (insert-buffer-substring nntp-server-buffer)
238 (setq result (eval accept-form))
239 (kill-buffer (current-buffer))
240 result)
241 (null (nndraft-request-expire-articles (list article) group server 'force))
242 result)))
243
6748645f
LMI
244(deffoo nndraft-request-expire-articles (articles group &optional server force)
245 (nndraft-possibly-change-group group)
246 (let* ((nnmh-allow-delete-final t)
4478e074
G
247 (nnmail-expiry-target
248 (or (gnus-group-find-parameter
229b59da 249 (gnus-group-prefixed-name group (list 'nndraft server))
4478e074
G
250 'expiry-target t)
251 nnmail-expiry-target))
6748645f
LMI
252 (res (nnoo-parent-function 'nndraft
253 'nnmh-request-expire-articles
254 (list articles group server force)))
255 article)
eec82323
LMI
256 ;; Delete all the "state" files of articles that have been expired.
257 (while articles
258 (unless (memq (setq article (pop articles)) res)
6748645f 259 (let ((auto (nndraft-auto-save-file-name
eec82323 260 (nndraft-article-filename article))))
eec82323 261 (when (file-exists-p auto)
16409b0b
GM
262 (funcall nnmail-delete-file-function auto)))
263 (dolist (backup
264 (let ((kept-new-versions 1)
265 (kept-old-versions 0))
266 (find-backup-file-name
267 (nndraft-article-filename article))))
268 (when (file-exists-p backup)
269 (funcall nnmail-delete-file-function backup)))))
eec82323
LMI
270 res))
271
272(deffoo nndraft-request-accept-article (group &optional server last noinsert)
6748645f
LMI
273 (nndraft-possibly-change-group group)
274 (let ((gnus-verbose-backends nil))
275 (nnoo-parent-function 'nndraft 'nnmh-request-accept-article
276 (list group server last noinsert))))
eec82323 277
16409b0b
GM
278(deffoo nndraft-request-replace-article (article group buffer)
279 (nndraft-possibly-change-group group)
280 (let ((nnmail-file-coding-system
23f87bed
MB
281 (if (member group '("drafts" "delayed"))
282 message-draft-coding-system
16409b0b
GM
283 mm-text-coding-system)))
284 (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
285 (list article group buffer))))
286
eec82323 287(deffoo nndraft-request-create-group (group &optional server args)
6748645f
LMI
288 (nndraft-possibly-change-group group)
289 (if (file-exists-p nndraft-current-directory)
290 (if (file-directory-p nndraft-current-directory)
eec82323
LMI
291 t
292 nil)
293 (condition-case ()
294 (progn
6748645f 295 (gnus-make-directory nndraft-current-directory)
eec82323
LMI
296 t)
297 (file-error nil))))
298
299\f
300;;; Low-Level Interface
301
6748645f
LMI
302(defun nndraft-possibly-change-group (group)
303 (when (and group
304 (not (equal group nndraft-current-group)))
305 (nndraft-open-server "")
306 (setq nndraft-current-group group)
307 (setq nndraft-current-directory
308 (nnheader-concat nndraft-directory group))))
eec82323
LMI
309
310(defun nndraft-article-filename (article &rest args)
311 (apply 'concat
6748645f 312 (file-name-as-directory nndraft-current-directory)
eec82323
LMI
313 (int-to-string article)
314 args))
315
316(defun nndraft-auto-save-file-name (file)
317 (save-excursion
318 (prog1
319 (progn
320 (set-buffer (get-buffer-create " *draft tmp*"))
321 (setq buffer-file-name file)
322 (make-auto-save-file-name))
323 (kill-buffer (current-buffer)))))
324
6748645f
LMI
325(defun nndraft-articles ()
326 "Return the list of messages in the group."
327 (gnus-make-directory nndraft-current-directory)
328 (sort
e9bd5782 329 (mapcar 'string-to-number
6748645f
LMI
330 (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
331 '<))
332
333(nnoo-import nndraft
334 (nnmh
335 nnmh-retrieve-headers
336 nnmh-request-group
337 nnmh-close-group
16409b0b 338 nnmh-request-list
23f87bed 339 nnmh-request-newsgroups))
6748645f 340
eec82323
LMI
341(provide 'nndraft)
342
343;;; nndraft.el ends here