Mercurial > emacs

comparison lisp/gnus/nndraft.el @ 31716:9968f55ad26e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Update to emacs-21-branch of the Gnus CVS repository.
author Gerd Moellmann <gerd@gnu.org>
date Tue, 19 Sep 2000 13:37:09 +0000
parents 15fc6acbae7a
children 695cf19ef79e d7ddb3e565de
comparison
equal deleted inserted replaced
31715:7c896543d225 31716:9968f55ad26e
1 ;;; nndraft.el --- draft article access for Gnus 1 ;;; nndraft.el --- draft article access for Gnus
2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
3 ;; Free Software Foundation, Inc.
3 4
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Keywords: news 6 ;; Keywords: news
6 7
7 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
28 (require 'nnheader) 29 (require 'nnheader)
29 (require 'nnmail) 30 (require 'nnmail)
30 (require 'gnus-start) 31 (require 'gnus-start)
31 (require 'nnmh) 32 (require 'nnmh)
32 (require 'nnoo) 33 (require 'nnoo)
34 (require 'mm-util)
33 (eval-when-compile 35 (eval-when-compile
34 (require 'cl) 36 (require 'cl)
35 ;; This is just to shut up the byte-compiler. 37 ;; This is just to shut up the byte-compiler.
36 (fset 'nndraft-request-group 'ignore)) 38 (fset 'nndraft-request-group 'ignore))
37 39
75 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) 77 (deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
76 (nndraft-possibly-change-group group) 78 (nndraft-possibly-change-group group)
77 (save-excursion 79 (save-excursion
78 (set-buffer nntp-server-buffer) 80 (set-buffer nntp-server-buffer)
79 (erase-buffer) 81 (erase-buffer)
80 (let* ((buf (get-buffer-create " *draft headers*")) 82 (let* (article)
81 article)
82 (set-buffer buf)
83 (buffer-disable-undo (current-buffer))
84 (erase-buffer)
85 ;; We don't support fetching by Message-ID. 83 ;; We don't support fetching by Message-ID.
86 (if (stringp (car articles)) 84 (if (stringp (car articles))
87 'headers 85 'headers
88 (while articles 86 (while articles
89 (set-buffer buf) 87 (narrow-to-region (point) (point))
90 (when (nndraft-request-article 88 (when (nndraft-request-article
91 (setq article (pop articles)) group server (current-buffer)) 89 (setq article (pop articles)) group server (current-buffer))
92 (goto-char (point-min)) 90 (goto-char (point-min))
93 (if (search-forward "\n\n" nil t) 91 (if (search-forward "\n\n" nil t)
94 (forward-line -1) 92 (forward-line -1)
95 (goto-char (point-max))) 93 (goto-char (point-max)))
96 (delete-region (point) (point-max)) 94 (delete-region (point) (point-max))
97 (set-buffer nntp-server-buffer) 95 (goto-char (point-min))
96 (insert (format "221 %d Article retrieved.\n" article))
97 (widen)
98 (goto-char (point-max)) 98 (goto-char (point-max))
99 (insert (format "221 %d Article retrieved.\n" article))
100 (insert-buffer-substring buf)
101 (insert ".\n"))) 99 (insert ".\n")))
102 100
103 (nnheader-fold-continuation-lines) 101 (nnheader-fold-continuation-lines)
104 'headers)))) 102 'headers))))
105 103
111 (let* ((file (nndraft-article-filename id)) 109 (let* ((file (nndraft-article-filename id))
112 (auto (nndraft-auto-save-file-name file)) 110 (auto (nndraft-auto-save-file-name file))
113 (newest (if (file-newer-than-file-p file auto) file auto)) 111 (newest (if (file-newer-than-file-p file auto) file auto))
114 (nntp-server-buffer (or buffer nntp-server-buffer))) 112 (nntp-server-buffer (or buffer nntp-server-buffer)))
115 (when (and (file-exists-p newest) 113 (when (and (file-exists-p newest)
116 (nnmail-find-file newest)) 114 (let ((nnmail-file-coding-system
115 (if (file-newer-than-file-p file auto)
116 (if (equal group "drafts")
117 message-draft-coding-system
118 mm-text-coding-system)
119 mm-auto-save-coding-system)))
120 (nnmail-find-file newest)))
117 (save-excursion 121 (save-excursion
118 (set-buffer nntp-server-buffer) 122 (set-buffer nntp-server-buffer)
119 (goto-char (point-min)) 123 (goto-char (point-min))
120 ;; If there's a mail header separator in this file, 124 ;; If there's a mail header separator in this file,
121 ;; we remove it. 125 ;; we remove it.
136 (nndraft-possibly-change-group group) 140 (nndraft-possibly-change-group group)
137 (gnus-info-set-read 141 (gnus-info-set-read
138 info 142 info
139 (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) 143 (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
140 (nndraft-articles) t)) 144 (nndraft-articles) t))
141 (let (marks) 145 (let ((marks (nth 3 info)))
142 (when (setq marks (nth 3 info)) 146 (when marks
147 ;; Nix out all marks except the `unsend'-able article marks.
143 (setcar (nthcdr 3 info) 148 (setcar (nthcdr 3 info)
144 (if (assq 'unsend marks) 149 (if (assq 'unsend marks)
145 (list (assq 'unsend marks)) 150 (list (assq 'unsend marks))
146 nil)))) 151 nil))))
147 t) 152 t)
151 (nndraft-open-server "") 156 (nndraft-open-server "")
152 (nndraft-request-group group) 157 (nndraft-request-group group)
153 (nndraft-possibly-change-group group) 158 (nndraft-possibly-change-group group)
154 (let ((gnus-verbose-backends nil) 159 (let ((gnus-verbose-backends nil)
155 (buf (current-buffer)) 160 (buf (current-buffer))
156 article file) 161 article file)
157 (nnheader-temp-write nil 162 (with-temp-buffer
158 (insert-buffer buf) 163 (insert-buffer-substring buf)
159 (setq article (nndraft-request-accept-article 164 (setq article (nndraft-request-accept-article
160 group (nnoo-current-server 'nndraft) t 'noinsert)) 165 group (nnoo-current-server 'nndraft) t 'noinsert)
161 (setq file (nndraft-article-filename article))) 166 file (nndraft-article-filename article)))
162 (setq buffer-file-name (expand-file-name file)) 167 (setq buffer-file-name (expand-file-name file)
163 (setq buffer-auto-save-file-name (make-auto-save-file-name)) 168 buffer-auto-save-file-name (make-auto-save-file-name))
164 (clear-visited-file-modtime) 169 (clear-visited-file-modtime)
165 article)) 170 article))
166 171
167 (deffoo nndraft-request-expire-articles (articles group &optional server force) 172 (deffoo nndraft-request-expire-articles (articles group &optional server force)
168 (nndraft-possibly-change-group group) 173 (nndraft-possibly-change-group group)
175 (while articles 180 (while articles
176 (unless (memq (setq article (pop articles)) res) 181 (unless (memq (setq article (pop articles)) res)
177 (let ((auto (nndraft-auto-save-file-name 182 (let ((auto (nndraft-auto-save-file-name
178 (nndraft-article-filename article)))) 183 (nndraft-article-filename article))))
179 (when (file-exists-p auto) 184 (when (file-exists-p auto)
180 (funcall nnmail-delete-file-function auto))))) 185 (funcall nnmail-delete-file-function auto)))
186 (dolist (backup
187 (let ((kept-new-versions 1)
188 (kept-old-versions 0))
189 (find-backup-file-name
190 (nndraft-article-filename article))))
191 (when (file-exists-p backup)
192 (funcall nnmail-delete-file-function backup)))))
181 res)) 193 res))
182 194
183 (deffoo nndraft-request-accept-article (group &optional server last noinsert) 195 (deffoo nndraft-request-accept-article (group &optional server last noinsert)
184 (nndraft-possibly-change-group group) 196 (nndraft-possibly-change-group group)
185 (let ((gnus-verbose-backends nil)) 197 (let ((gnus-verbose-backends nil))
186 (nnoo-parent-function 'nndraft 'nnmh-request-accept-article 198 (nnoo-parent-function 'nndraft 'nnmh-request-accept-article
187 (list group server last noinsert)))) 199 (list group server last noinsert))))
200
201 (deffoo nndraft-request-replace-article (article group buffer)
202 (nndraft-possibly-change-group group)
203 (let ((nnmail-file-coding-system
204 (if (equal group "drafts")
205 mm-auto-save-coding-system
206 mm-text-coding-system)))
207 (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
208 (list article group buffer))))
188 209
189 (deffoo nndraft-request-create-group (group &optional server args) 210 (deffoo nndraft-request-create-group (group &optional server args)
190 (nndraft-possibly-change-group group) 211 (nndraft-possibly-change-group group)
191 (if (file-exists-p nndraft-current-directory) 212 (if (file-exists-p nndraft-current-directory)
192 (if (file-directory-p nndraft-current-directory) 213 (if (file-directory-p nndraft-current-directory)
235 (nnoo-import nndraft 256 (nnoo-import nndraft
236 (nnmh 257 (nnmh
237 nnmh-retrieve-headers 258 nnmh-retrieve-headers
238 nnmh-request-group 259 nnmh-request-group
239 nnmh-close-group 260 nnmh-close-group
240 nnmh-request-list 261 nnmh-request-list
241 nnmh-request-newsgroups 262 nnmh-request-newsgroups
242 nnmh-request-move-article 263 nnmh-request-move-article))
243 nnmh-request-replace-article))
244 264
245 (provide 'nndraft) 265 (provide 'nndraft)
246 266
247 ;;; nndraft.el ends here 267 ;;; nndraft.el ends here