Mercurial > emacs

comparison lisp/gnus/nndraft.el @ 24357:15fc6acbae7a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgrading to Gnus 5.7; see ChangeLog
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Sat, 20 Feb 1999 14:05:57 +0000
parents e6935c08cf0b
children 9968f55ad26e
comparison
equal deleted inserted replaced
24356:a5a611ef40f6 24357:15fc6acbae7a
1 ;;; nndraft.el --- draft article access for Gnus 1 ;;; nndraft.el --- draft article access for Gnus
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
8 8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify 9 ;; GNU Emacs is free software; you can redistribute it and/or modify
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Code: 26 ;;; Code:
27 27
28 (require 'nnheader) 28 (require 'nnheader)
29 (require 'nnmail)
30 (require 'gnus-start)
29 (require 'nnmh) 31 (require 'nnmh)
30 (require 'nnoo) 32 (require 'nnoo)
31 (eval-and-compile (require 'cl)) 33 (eval-when-compile
32 34 (require 'cl)
33 (nnoo-declare nndraft) 35 ;; This is just to shut up the byte-compiler.
34 36 (fset 'nndraft-request-group 'ignore))
35 (eval-and-compile 37
36 (autoload 'mail-send-and-exit "sendmail")) 38 (nnoo-declare nndraft
37 39 nnmh)
38 (defvoo nndraft-directory nil 40
39 "Where nndraft will store its directory.") 41 (defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")
42 "Where nndraft will store its files."
43 nnmh-directory)
40 44
41 45
42 46
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
43 (defconst nndraft-version "nndraft 1.0") 51 (defconst nndraft-version "nndraft 1.0")
44 (defvoo nndraft-status-string "") 52 (defvoo nndraft-status-string "" nil nnmh-status-string)
45 53
46 54
47 55
48 ;;; Interface functions. 56 ;;; Interface functions.
49 57
50 (nnoo-define-basics nndraft) 58 (nnoo-define-basics nndraft)
51 59
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
52 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) 75 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
76 (nndraft-possibly-change-group group)
53 (save-excursion 77 (save-excursion
54 (set-buffer nntp-server-buffer) 78 (set-buffer nntp-server-buffer)
55 (erase-buffer) 79 (erase-buffer)
56 (let* ((buf (get-buffer-create " *draft headers*")) 80 (let* ((buf (get-buffer-create " *draft headers*"))
57 article) 81 article)
77 (insert ".\n"))) 101 (insert ".\n")))
78 102
79 (nnheader-fold-continuation-lines) 103 (nnheader-fold-continuation-lines)
80 'headers)))) 104 'headers))))
81 105
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) 106 (deffoo nndraft-request-article (id &optional group server buffer)
107 (nndraft-possibly-change-group group)
100 (when (numberp id) 108 (when (numberp id)
101 ;; We get the newest file of the auto-saved file and the 109 ;; We get the newest file of the auto-saved file and the
102 ;; "real" file. 110 ;; "real" file.
103 (let* ((file (nndraft-article-filename id)) 111 (let* ((file (nndraft-article-filename id))
104 (auto (nndraft-auto-save-file-name file)) 112 (auto (nndraft-auto-save-file-name file))
116 (replace-match "" t t))) 124 (replace-match "" t t)))
117 t)))) 125 t))))
118 126
119 (deffoo nndraft-request-restore-buffer (article &optional group server) 127 (deffoo nndraft-request-restore-buffer (article &optional group server)
120 "Request a new buffer that is restored to the state of ARTICLE." 128 "Request a new buffer that is restored to the state of ARTICLE."
121 (let ((file (nndraft-article-filename article ".state")) 129 (nndraft-possibly-change-group group)
122 nndraft-point nndraft-mode nndraft-buffer-name) 130 (when (nndraft-request-article article group server (current-buffer))
123 (when (file-exists-p file) 131 (message-remove-header "xref")
124 (load file t t t) 132 (message-remove-header "lines")
125 (when nndraft-buffer-name 133 t))
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 134
135 (deffoo nndraft-request-update-info (group info &optional server) 135 (deffoo nndraft-request-update-info (group info &optional server)
136 (setcar (cddr info) nil) 136 (nndraft-possibly-change-group group)
137 (when (nth 3 info) 137 (gnus-info-set-read
138 (setcar (nthcdr 3 info) nil)) 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))))
139 t) 147 t)
140 148
141 (deffoo nndraft-request-associate-buffer (group) 149 (deffoo nndraft-request-associate-buffer (group)
142 "Associate the current buffer with some article in the draft group." 150 "Associate the current buffer with some article in the draft group."
143 (let* ((gnus-verbose-backends nil) 151 (nndraft-open-server "")
144 (article (cdr (nndraft-request-accept-article 152 (nndraft-request-group group)
145 group (nnoo-current-server 'nndraft) t 'noinsert))) 153 (nndraft-possibly-change-group group)
146 (file (nndraft-article-filename article))) 154 (let ((gnus-verbose-backends nil)
147 (setq buffer-file-name file) 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))
148 (setq buffer-auto-save-file-name (make-auto-save-file-name)) 163 (setq buffer-auto-save-file-name (make-auto-save-file-name))
149 (clear-visited-file-modtime) 164 (clear-visited-file-modtime)
150 article)) 165 article))
151 166
152 (deffoo nndraft-request-group (group &optional server dont-check) 167 (deffoo nndraft-request-expire-articles (articles group &optional server force)
153 (prog1 168 (nndraft-possibly-change-group group)
154 (nndraft-execute-nnmh-command 169 (let* ((nnmh-allow-delete-final t)
155 `(nnmh-request-group group "" ,dont-check)) 170 (res (nnoo-parent-function 'nndraft
156 (nnheader-report 'nndraft nnmh-status-string))) 171 'nnmh-request-expire-articles
157 172 (list articles group server force)))
158 (deffoo nndraft-request-list (&optional server dir) 173 article)
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. 174 ;; Delete all the "state" files of articles that have been expired.
173 (while articles 175 (while articles
174 (unless (memq (setq article (pop articles)) res) 176 (unless (memq (setq article (pop articles)) res)
175 (let ((file (nndraft-article-filename article ".state")) 177 (let ((auto (nndraft-auto-save-file-name
176 (auto (nndraft-auto-save-file-name
177 (nndraft-article-filename article)))) 178 (nndraft-article-filename article))))
178 (when (file-exists-p file)
179 (funcall nnmail-delete-file-function file))
180 (when (file-exists-p auto) 179 (when (file-exists-p auto)
181 (funcall nnmail-delete-file-function auto))))) 180 (funcall nnmail-delete-file-function auto)))))
182 res)) 181 res))
183 182
184 (deffoo nndraft-request-accept-article (group &optional server last noinsert) 183 (deffoo nndraft-request-accept-article (group &optional server last noinsert)
185 (let* ((point (point)) 184 (nndraft-possibly-change-group group)
186 (mode major-mode) 185 (let ((gnus-verbose-backends nil))
187 (name (buffer-name)) 186 (nnoo-parent-function 'nndraft 'nnmh-request-accept-article
188 (gnus-verbose-backends nil) 187 (list group server last noinsert))))
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 188
206 (deffoo nndraft-request-create-group (group &optional server args) 189 (deffoo nndraft-request-create-group (group &optional server args)
207 (if (file-exists-p nndraft-directory) 190 (nndraft-possibly-change-group group)
208 (if (file-directory-p nndraft-directory) 191 (if (file-exists-p nndraft-current-directory)
192 (if (file-directory-p nndraft-current-directory)
209 t 193 t
210 nil) 194 nil)
211 (condition-case () 195 (condition-case ()
212 (progn 196 (progn
213 (gnus-make-directory nndraft-directory) 197 (gnus-make-directory nndraft-current-directory)
214 t) 198 t)
215 (file-error nil)))) 199 (file-error nil))))
216 200
217 201
218 ;;; Low-Level Interface 202 ;;; Low-Level Interface
219 203
220 (defun nndraft-execute-nnmh-command (command) 204 (defun nndraft-possibly-change-group (group)
221 (let ((dir (expand-file-name nndraft-directory))) 205 (when (and group
222 (when (string-match "/$" dir) 206 (not (equal group nndraft-current-group)))
223 (setq dir (substring dir 0 (match-beginning 0)))) 207 (nndraft-open-server "")
224 (string-match "/[^/]+$" dir) 208 (setq nndraft-current-group group)
225 (let ((group (substring dir (1+ (match-beginning 0)))) 209 (setq nndraft-current-directory
226 (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) 210 (nnheader-concat nndraft-directory group))))
227 (nnmail-keep-last-article nil)
228 (nnmh-get-new-mail nil))
229 (eval command))))
230 211
231 (defun nndraft-article-filename (article &rest args) 212 (defun nndraft-article-filename (article &rest args)
232 (apply 'concat 213 (apply 'concat
233 (file-name-as-directory nndraft-directory) 214 (file-name-as-directory nndraft-current-directory)
234 (int-to-string article) 215 (int-to-string article)
235 args)) 216 args))
236 217
237 (defun nndraft-auto-save-file-name (file) 218 (defun nndraft-auto-save-file-name (file)
238 (save-excursion 219 (save-excursion
241 (set-buffer (get-buffer-create " *draft tmp*")) 222 (set-buffer (get-buffer-create " *draft tmp*"))
242 (setq buffer-file-name file) 223 (setq buffer-file-name file)
243 (make-auto-save-file-name)) 224 (make-auto-save-file-name))
244 (kill-buffer (current-buffer))))) 225 (kill-buffer (current-buffer)))))
245 226
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
246 (provide 'nndraft) 245 (provide 'nndraft)
247 246
248 ;;; nndraft.el ends here 247 ;;; nndraft.el ends here