1 ;;; nndraft.el --- draft article access for Gnus
2 ;; Copyright (C) 1995,96 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