1 ;;; nndraft.el --- draft article access for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
7 ;; This file is part of GNU Emacs.
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)
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.
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.
31 (eval-and-compile (require 'cl
))
33 (nnoo-declare nndraft
)
36 (autoload 'mail-send-and-exit
"sendmail"))
38 (defvoo nndraft-directory nil
39 "Where nndraft will store its directory.")
43 (defconst nndraft-version
"nndraft 1.0")
44 (defvoo nndraft-status-string
"")
48 ;;; Interface functions.
50 (nnoo-define-basics nndraft
)
52 (deffoo nndraft-retrieve-headers
(articles &optional group server fetch-old
)
54 (set-buffer nntp-server-buffer
)
56 (let* ((buf (get-buffer-create " *draft headers*"))
59 (buffer-disable-undo (current-buffer))
61 ;; We don't support fetching by Message-ID.
62 (if (stringp (car articles
))
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
)
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
)
79 (nnheader-fold-continuation-lines)
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
))
87 ((not (file-exists-p nndraft-directory
))
88 (nndraft-close-server)
89 (nnheader-report 'nndraft
"No such file or directory: %s"
91 ((not (file-directory-p (file-truename nndraft-directory
)))
92 (nndraft-close-server)
93 (nnheader-report 'nndraft
"Not a directory: %s" nndraft-directory
))
95 (nnheader-report 'nndraft
"Opened server %s using directory %s"
96 server nndraft-directory
)
99 (deffoo nndraft-request-article
(id &optional group server buffer
)
101 ;; We get the newest file of the auto-saved file and the
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
))
110 (set-buffer nntp-server-buffer
)
111 (goto-char (point-min))
112 ;; If there's a mail header separator in this file,
114 (when (re-search-forward
115 (concat "^" mail-header-separator
"$") nil t
)
116 (replace-match "" t t
)))
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
)
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
)))
135 (deffoo nndraft-request-update-info
(group info
&optional server
)
136 (setcar (cddr info
) nil
)
138 (setcar (nthcdr 3 info
) nil
))
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)
152 (deffoo nndraft-request-group
(group &optional server dont-check
)
154 (nndraft-execute-nnmh-command
155 `(nnmh-request-group group
"" ,dont-check
))
156 (nnheader-report 'nndraft nnmh-status-string
)))
158 (deffoo nndraft-request-list
(&optional server dir
)
159 (nndraft-execute-nnmh-command
160 `(nnmh-request-list nil
,dir
)))
162 (deffoo nndraft-request-newgroups
(date &optional server
)
163 (nndraft-execute-nnmh-command
164 `(nnmh-request-newgroups ,date
,server
)))
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
)))
172 ;; Delete all the "state" files of articles that have been expired.
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
)))))
184 (deffoo nndraft-request-accept-article
(group &optional server last noinsert
)
185 (let* ((point (point))
188 (gnus-verbose-backends nil
)
189 (gart (nndraft-execute-nnmh-command
190 `(nnmh-request-accept-article group
,server
,last noinsert
)))
192 (nndraft-article-filename (cdr gart
) ".state")))
193 ;; Write the "state" file.
195 (nnheader-set-temp-buffer " *draft state*")
196 (insert (format "%S\n" `(setq nndraft-mode
(quote ,mode
)
198 nndraft-buffer-name
,name
)))
199 (write-region (point-min) (point-max) state nil
'silent
)
200 (kill-buffer (current-buffer)))
203 (deffoo nndraft-close-group
(group &optional server
)
206 (deffoo nndraft-request-create-group
(group &optional server args
)
207 (if (file-exists-p nndraft-directory
)
208 (if (file-directory-p nndraft-directory
)
213 (gnus-make-directory nndraft-directory
)
218 ;;; Low-Level Interface
220 (defun nndraft-execute-nnmh-command (command)
221 (let ((dir (expand-file-name nndraft-directory
)))
222 (when (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
))
231 (defun nndraft-article-filename (article &rest args
)
233 (file-name-as-directory nndraft-directory
)
234 (int-to-string article
)
237 (defun nndraft-auto-save-file-name (file)
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)))))
248 ;;; nndraft.el ends here