Mercurial > hg > xemacs-beta

comparison lisp/gnus/nndraft.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; nndraft.el --- draft article access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
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)
29 (require 'nnmh)
30 (require 'nnoo)
31 (eval-and-compile (require 'cl))
32
33 (nnoo-declare nndraft)
34
35 (eval-and-compile
36 (autoload 'mail-send-and-exit "sendmail"))
37
38 (defvoo nndraft-directory nil
39 "Where nndraft will store its directory.")
40
41
42
43 (defconst nndraft-version "nndraft 1.0")
44 (defvoo nndraft-status-string "")
45
46
47
48 ;;; Interface functions.
49
50 (nnoo-define-basics nndraft)
51
52 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
53 (save-excursion
54 (set-buffer nntp-server-buffer)
55 (erase-buffer)
56 (let* ((buf (get-buffer-create " *draft headers*"))
57 article)
58 (set-buffer buf)
59 (buffer-disable-undo (current-buffer))
60 (erase-buffer)
61 ;; We don't support fetching by Message-ID.
62 (if (stringp (car articles))
63 'headers
64 (while articles
65 (set-buffer buf)
66 (when (nndraft-request-article
67 (setq article (pop articles)) group server (current-buffer))
68 (goto-char (point-min))
69 (if (search-forward "\n\n" nil t)
70 (forward-line -1)
71 (goto-char (point-max)))
72 (delete-region (point) (point-max))
73 (set-buffer nntp-server-buffer)
74 (goto-char (point-max))
75 (insert (format "221 %d Article retrieved.\n" article))
76 (insert-buffer-substring buf)
77 (insert ".\n")))
78
79 (nnheader-fold-continuation-lines)
80 'headers))))
81
82 (deffoo nndraft-open-server (server &optional defs)
83 (nnoo-change-server 'nndraft server defs)
84 (unless (assq 'nndraft-directory defs)
85 (setq nndraft-directory server))
86 (cond
87 ((not (file-exists-p nndraft-directory))
88 (nndraft-close-server)
89 (nnheader-report 'nndraft "No such file or directory: %s"
90 nndraft-directory))
91 ((not (file-directory-p (file-truename nndraft-directory)))
92 (nndraft-close-server)
93 (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory))
94 (t
95 (nnheader-report 'nndraft "Opened server %s using directory %s"
96 server nndraft-directory)
97 t)))
98
99 (deffoo nndraft-request-article (id &optional group server buffer)
100 (when (numberp id)
101 ;; We get the newest file of the auto-saved file and the
102 ;; "real" file.
103 (let* ((file (nndraft-article-filename id))
104 (auto (nndraft-auto-save-file-name file))
105 (newest (if (file-newer-than-file-p file auto) file auto))
106 (nntp-server-buffer (or buffer nntp-server-buffer)))
107 (when (and (file-exists-p newest)
108 (nnmail-find-file newest))
109 (save-excursion
110 (set-buffer nntp-server-buffer)
111 (goto-char (point-min))
112 ;; If there's a mail header separator in this file,
113 ;; we remove it.
114 (when (re-search-forward
115 (concat "^" mail-header-separator "$") nil t)
116 (replace-match "" t t)))
117 t))))
118
119 (deffoo nndraft-request-restore-buffer (article &optional group server)
120 "Request a new buffer that is restored to the state of ARTICLE."
121 (let ((file (nndraft-article-filename article ".state"))
122 nndraft-point nndraft-mode nndraft-buffer-name)
123 (when (file-exists-p file)
124 (load file t t t)
125 (when nndraft-buffer-name
126 (set-buffer (get-buffer-create
127 (generate-new-buffer-name nndraft-buffer-name)))
128 (nndraft-request-article article group server (current-buffer))
129 (funcall nndraft-mode)
130 (let ((gnus-verbose-backends nil))
131 (nndraft-request-expire-articles (list article) group server t))
132 (goto-char nndraft-point))
133 nndraft-buffer-name)))
134
135 (deffoo nndraft-request-update-info (group info &optional server)
136 (setcar (cddr info) nil)
137 (when (nth 3 info)
138 (setcar (nthcdr 3 info) nil))
139 t)
140
141 (deffoo nndraft-request-associate-buffer (group)
142 "Associate the current buffer with some article in the draft group."
143 (let* ((gnus-verbose-backends nil)
144 (article (cdr (nndraft-request-accept-article
145 group (nnoo-current-server 'nndraft) t 'noinsert)))
146 (file (nndraft-article-filename article)))
147 (setq buffer-file-name file)
148 (setq buffer-auto-save-file-name (make-auto-save-file-name))
149 (clear-visited-file-modtime)
150 article))
151
152 (deffoo nndraft-request-group (group &optional server dont-check)
153 (prog1
154 (nndraft-execute-nnmh-command
155 `(nnmh-request-group group "" ,dont-check))
156 (nnheader-report 'nndraft nnmh-status-string)))
157
158 (deffoo nndraft-request-list (&optional server dir)
159 (nndraft-execute-nnmh-command
160 `(nnmh-request-list nil ,dir)))
161
162 (deffoo nndraft-request-newgroups (date &optional server)
163 (nndraft-execute-nnmh-command
164 `(nnmh-request-newgroups ,date ,server)))
165
166 (deffoo nndraft-request-expire-articles
167 (articles group &optional server force)
168 (let ((res (nndraft-execute-nnmh-command
169 `(nnmh-request-expire-articles
170 ',articles group ,server ,force)))
171 article)
172 ;; Delete all the "state" files of articles that have been expired.
173 (while articles
174 (unless (memq (setq article (pop articles)) res)
175 (let ((file (nndraft-article-filename article ".state"))
176 (auto (nndraft-auto-save-file-name
177 (nndraft-article-filename article))))
178 (when (file-exists-p file)
179 (funcall nnmail-delete-file-function file))
180 (when (file-exists-p auto)
181 (funcall nnmail-delete-file-function auto)))))
182 res))
183
184 (deffoo nndraft-request-accept-article (group &optional server last noinsert)
185 (let* ((point (point))
186 (mode major-mode)
187 (name (buffer-name))
188 (gnus-verbose-backends nil)
189 (gart (nndraft-execute-nnmh-command
190 `(nnmh-request-accept-article group ,server ,last noinsert)))
191 (state
192 (nndraft-article-filename (cdr gart) ".state")))
193 ;; Write the "state" file.
194 (save-excursion
195 (nnheader-set-temp-buffer " *draft state*")
196 (insert (format "%S\n" `(setq nndraft-mode (quote ,mode)
197 nndraft-point ,point
198 nndraft-buffer-name ,name)))
199 (write-region (point-min) (point-max) state nil 'silent)
200 (kill-buffer (current-buffer)))
201 gart))
202
203 (deffoo nndraft-close-group (group &optional server)
204 t)
205
206 (deffoo nndraft-request-create-group (group &optional server)
207 (if (file-exists-p nndraft-directory)
208 (if (file-directory-p nndraft-directory)
209 t
210 nil)
211 (condition-case ()
212 (progn
213 (make-directory nndraft-directory t)
214 t)
215 (file-error nil))))
216
217
218 ;;; Low-Level Interface
219
220 (defun nndraft-execute-nnmh-command (command)
221 (let ((dir (expand-file-name nndraft-directory)))
222 (and (string-match "/$" dir)
223 (setq dir (substring dir 0 (match-beginning 0))))
224 (string-match "/[^/]+$" dir)
225 (let ((group (substring dir (1+ (match-beginning 0))))
226 (nnmh-directory (substring dir 0 (1+ (match-beginning 0))))
227 (nnmail-keep-last-article nil)
228 (nnmh-get-new-mail nil))
229 (eval command))))
230
231 (defun nndraft-article-filename (article &rest args)
232 (apply 'concat
233 (file-name-as-directory nndraft-directory)
234 (int-to-string article)
235 args))
236
237 (defun nndraft-auto-save-file-name (file)
238 (save-excursion
239 (prog1
240 (progn
241 (set-buffer (get-buffer-create " *draft tmp*"))
242 (setq buffer-file-name file)
243 (make-auto-save-file-name))
244 (kill-buffer (current-buffer)))))
245
246 (provide 'nndraft)
247
248 ;;; nndraft.el ends here