Commit | Line | Data |
---|---|---|
eec82323 | 1 | ;;; nndraft.el --- draft article access for Gnus |
6748645f | 2 | ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. |
eec82323 | 3 | |
6748645f | 4 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
5 | ;; Keywords: news |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation; either version 2, or (at your option) | |
12 | ;; any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 | ;; Boston, MA 02111-1307, USA. | |
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) | |
6748645f LMI |
33 | (eval-when-compile |
34 | (require 'cl) | |
35 | ;; This is just to shut up the byte-compiler. | |
36 | (fset 'nndraft-request-group 'ignore)) | |
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 LMI |
44 | |
45 | \f | |
46 | ||
6748645f LMI |
47 | (defvoo nndraft-current-group "" nil nnmh-current-group) |
48 | (defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail) | |
49 | (defvoo nndraft-current-directory nil nil nnmh-current-directory) | |
50 | ||
eec82323 | 51 | (defconst nndraft-version "nndraft 1.0") |
6748645f | 52 | (defvoo nndraft-status-string "" nil nnmh-status-string) |
eec82323 LMI |
53 | |
54 | \f | |
55 | ||
56 | ;;; Interface functions. | |
57 | ||
58 | (nnoo-define-basics nndraft) | |
59 | ||
6748645f LMI |
60 | (deffoo nndraft-open-server (server &optional defs) |
61 | (nnoo-change-server 'nndraft server defs) | |
62 | (cond | |
63 | ((not (file-exists-p nndraft-directory)) | |
64 | (nndraft-close-server) | |
65 | (nnheader-report 'nndraft "No such file or directory: %s" | |
66 | nndraft-directory)) | |
67 | ((not (file-directory-p (file-truename nndraft-directory))) | |
68 | (nndraft-close-server) | |
69 | (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory)) | |
70 | (t | |
71 | (nnheader-report 'nndraft "Opened server %s using directory %s" | |
72 | server nndraft-directory) | |
73 | t))) | |
74 | ||
eec82323 | 75 | (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) |
6748645f | 76 | (nndraft-possibly-change-group group) |
eec82323 LMI |
77 | (save-excursion |
78 | (set-buffer nntp-server-buffer) | |
79 | (erase-buffer) | |
80 | (let* ((buf (get-buffer-create " *draft headers*")) | |
81 | article) | |
82 | (set-buffer buf) | |
83 | (buffer-disable-undo (current-buffer)) | |
84 | (erase-buffer) | |
85 | ;; We don't support fetching by Message-ID. | |
86 | (if (stringp (car articles)) | |
87 | 'headers | |
88 | (while articles | |
89 | (set-buffer buf) | |
90 | (when (nndraft-request-article | |
91 | (setq article (pop articles)) group server (current-buffer)) | |
92 | (goto-char (point-min)) | |
93 | (if (search-forward "\n\n" nil t) | |
94 | (forward-line -1) | |
95 | (goto-char (point-max))) | |
96 | (delete-region (point) (point-max)) | |
97 | (set-buffer nntp-server-buffer) | |
98 | (goto-char (point-max)) | |
99 | (insert (format "221 %d Article retrieved.\n" article)) | |
100 | (insert-buffer-substring buf) | |
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) | |
116 | (nnmail-find-file newest)) | |
117 | (save-excursion | |
118 | (set-buffer nntp-server-buffer) | |
119 | (goto-char (point-min)) | |
120 | ;; If there's a mail header separator in this file, | |
121 | ;; we remove it. | |
122 | (when (re-search-forward | |
123 | (concat "^" mail-header-separator "$") nil t) | |
124 | (replace-match "" t t))) | |
125 | t)))) | |
126 | ||
127 | (deffoo nndraft-request-restore-buffer (article &optional group server) | |
128 | "Request a new buffer that is restored to the state of ARTICLE." | |
6748645f LMI |
129 | (nndraft-possibly-change-group group) |
130 | (when (nndraft-request-article article group server (current-buffer)) | |
131 | (message-remove-header "xref") | |
132 | (message-remove-header "lines") | |
133 | t)) | |
eec82323 LMI |
134 | |
135 | (deffoo nndraft-request-update-info (group info &optional server) | |
6748645f LMI |
136 | (nndraft-possibly-change-group group) |
137 | (gnus-info-set-read | |
138 | info | |
139 | (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) | |
140 | (nndraft-articles) t)) | |
141 | (let (marks) | |
142 | (when (setq marks (nth 3 info)) | |
143 | (setcar (nthcdr 3 info) | |
144 | (if (assq 'unsend marks) | |
145 | (list (assq 'unsend marks)) | |
146 | nil)))) | |
eec82323 LMI |
147 | t) |
148 | ||
149 | (deffoo nndraft-request-associate-buffer (group) | |
150 | "Associate the current buffer with some article in the draft group." | |
6748645f LMI |
151 | (nndraft-open-server "") |
152 | (nndraft-request-group group) | |
153 | (nndraft-possibly-change-group group) | |
154 | (let ((gnus-verbose-backends nil) | |
155 | (buf (current-buffer)) | |
156 | article file) | |
157 | (nnheader-temp-write nil | |
158 | (insert-buffer buf) | |
159 | (setq article (nndraft-request-accept-article | |
160 | group (nnoo-current-server 'nndraft) t 'noinsert)) | |
161 | (setq file (nndraft-article-filename article))) | |
162 | (setq buffer-file-name (expand-file-name file)) | |
eec82323 LMI |
163 | (setq buffer-auto-save-file-name (make-auto-save-file-name)) |
164 | (clear-visited-file-modtime) | |
165 | article)) | |
166 | ||
6748645f LMI |
167 | (deffoo nndraft-request-expire-articles (articles group &optional server force) |
168 | (nndraft-possibly-change-group group) | |
169 | (let* ((nnmh-allow-delete-final t) | |
170 | (res (nnoo-parent-function 'nndraft | |
171 | 'nnmh-request-expire-articles | |
172 | (list articles group server force))) | |
173 | article) | |
eec82323 LMI |
174 | ;; Delete all the "state" files of articles that have been expired. |
175 | (while articles | |
176 | (unless (memq (setq article (pop articles)) res) | |
6748645f | 177 | (let ((auto (nndraft-auto-save-file-name |
eec82323 | 178 | (nndraft-article-filename article)))) |
eec82323 LMI |
179 | (when (file-exists-p auto) |
180 | (funcall nnmail-delete-file-function auto))))) | |
181 | res)) | |
182 | ||
183 | (deffoo nndraft-request-accept-article (group &optional server last noinsert) | |
6748645f LMI |
184 | (nndraft-possibly-change-group group) |
185 | (let ((gnus-verbose-backends nil)) | |
186 | (nnoo-parent-function 'nndraft 'nnmh-request-accept-article | |
187 | (list group server last noinsert)))) | |
eec82323 LMI |
188 | |
189 | (deffoo nndraft-request-create-group (group &optional server args) | |
6748645f LMI |
190 | (nndraft-possibly-change-group group) |
191 | (if (file-exists-p nndraft-current-directory) | |
192 | (if (file-directory-p nndraft-current-directory) | |
eec82323 LMI |
193 | t |
194 | nil) | |
195 | (condition-case () | |
196 | (progn | |
6748645f | 197 | (gnus-make-directory nndraft-current-directory) |
eec82323 LMI |
198 | t) |
199 | (file-error nil)))) | |
200 | ||
201 | \f | |
202 | ;;; Low-Level Interface | |
203 | ||
6748645f LMI |
204 | (defun nndraft-possibly-change-group (group) |
205 | (when (and group | |
206 | (not (equal group nndraft-current-group))) | |
207 | (nndraft-open-server "") | |
208 | (setq nndraft-current-group group) | |
209 | (setq nndraft-current-directory | |
210 | (nnheader-concat nndraft-directory group)))) | |
eec82323 LMI |
211 | |
212 | (defun nndraft-article-filename (article &rest args) | |
213 | (apply 'concat | |
6748645f | 214 | (file-name-as-directory nndraft-current-directory) |
eec82323 LMI |
215 | (int-to-string article) |
216 | args)) | |
217 | ||
218 | (defun nndraft-auto-save-file-name (file) | |
219 | (save-excursion | |
220 | (prog1 | |
221 | (progn | |
222 | (set-buffer (get-buffer-create " *draft tmp*")) | |
223 | (setq buffer-file-name file) | |
224 | (make-auto-save-file-name)) | |
225 | (kill-buffer (current-buffer))))) | |
226 | ||
6748645f LMI |
227 | (defun nndraft-articles () |
228 | "Return the list of messages in the group." | |
229 | (gnus-make-directory nndraft-current-directory) | |
230 | (sort | |
231 | (mapcar 'string-to-int | |
232 | (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t)) | |
233 | '<)) | |
234 | ||
235 | (nnoo-import nndraft | |
236 | (nnmh | |
237 | nnmh-retrieve-headers | |
238 | nnmh-request-group | |
239 | nnmh-close-group | |
240 | nnmh-request-list | |
241 | nnmh-request-newsgroups | |
242 | nnmh-request-move-article | |
243 | nnmh-request-replace-article)) | |
244 | ||
eec82323 LMI |
245 | (provide 'nndraft) |
246 | ||
247 | ;;; nndraft.el ends here |