Mercurial > emacs
annotate lisp/gnus/gnus-soup.el @ 82603:d0c9cce4628c
* net/tramp.el (top): Require cl.el, when `copy-tree' is not available
otherwise.
(tramp-get-remote-path): New defun. Replace occurences of
`tramp-default-remote-path' by this function.
(tramp-set-remote-path): Move most of the code to
`tramp-get-remote-path'.
(tramp-get-ls-command, tramp-get-remote-id): Don't check for not
existing directories, this is done already in
`tramp-get-remote-path'.
author | Michael Albinus <michael.albinus@gmx.de> |
---|---|
date | Wed, 22 Aug 2007 05:47:42 +0000 |
parents | 24202b793a08 |
children | 1cb31606209f a3c27999decb f55f9811f5d7 |
rev | line source |
---|---|
17493 | 1 ;;; gnus-soup.el --- SOUP packet writing support for Gnus |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
2 |
74547 | 3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
75347 | 4 ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
17493 | 5 |
6 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk> | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 8 ;; Keywords: news, mail |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
78224
24202b793a08
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
75347
diff
changeset
|
14 ;; the Free Software Foundation; either version 3, or (at your option) |
17493 | 15 ;; any later version. |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
17493 | 26 |
27 ;;; Commentary: | |
28 | |
29 ;;; Code: | |
30 | |
19634
118761d47324
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
31 (eval-when-compile (require 'cl)) |
118761d47324
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
32 |
17493 | 33 (require 'gnus) |
34 (require 'gnus-art) | |
35 (require 'message) | |
36 (require 'gnus-start) | |
37 (require 'gnus-range) | |
38 | |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
39 (defgroup gnus-soup nil |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
40 "SOUP packet writing support for Gnus." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
41 :group 'gnus) |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
42 |
17493 | 43 ;;; User Variables: |
44 | |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
45 (defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/") |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
46 "Directory containing an unpacked SOUP packet." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
47 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
48 :type 'directory |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
49 :group 'gnus-soup) |
17493 | 50 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
51 (defcustom gnus-soup-replies-directory |
17493 | 52 (nnheader-concat gnus-soup-directory "SoupReplies/") |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
53 "Directory where Gnus will do processing of replies." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
54 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
55 :type 'directory |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
56 :group 'gnus-soup) |
17493 | 57 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
58 (defcustom gnus-soup-prefix-file "gnus-prefix" |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
59 "Name of the file where Gnus stores the last used prefix." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
60 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
61 :type 'file |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
62 :group 'gnus-soup) |
17493 | 63 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
64 (defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" |
17493 | 65 "Format string command for packing a SOUP packet. |
66 The SOUP files will be inserted where the %s is in the string. | |
67 This string MUST contain both %s and %d. The file number will be | |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
68 inserted where %d appears." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
69 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
70 :type 'string |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
71 :group 'gnus-soup) |
17493 | 72 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
73 (defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -" |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
74 "Format string command for unpacking a SOUP packet. |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
75 The SOUP packet file name will be inserted at the %s." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
76 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
77 :type 'string |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
78 :group 'gnus-soup) |
17493 | 79 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
80 (defcustom gnus-soup-packet-directory gnus-home-directory |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
81 "Where gnus-soup will look for REPLIES packets." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
82 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
83 :type 'directory |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
84 :group 'gnus-soup) |
17493 | 85 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
86 (defcustom gnus-soup-packet-regexp "Soupin" |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
87 "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
88 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
89 :type 'regexp |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
90 :group 'gnus-soup) |
17493 | 91 |
75103
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
92 (defcustom gnus-soup-ignored-headers "^Xref:" |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
93 "Regexp to match headers to be removed when brewing SOUP packets." |
9a023b421e07
(gnus-soup): New custom group. Make user variables customizable.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
74547
diff
changeset
|
94 :version "22.1" ;; Gnus 5.10.9 |
75121
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
95 :type 'regexp |
4da7c9c27b38
Add missing :group in previous change.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
75103
diff
changeset
|
96 :group 'gnus-soup) |
17493 | 97 |
98 ;;; Internal Variables: | |
99 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
100 (defvar gnus-soup-encoding-type ?u |
17493 | 101 "*Soup encoding type. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
102 `u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox |
17493 | 103 format.") |
104 | |
105 (defvar gnus-soup-index-type ?c | |
106 "*Soup index type. | |
107 `n' means no index file and `c' means standard Cnews overview | |
108 format.") | |
109 | |
110 (defvar gnus-soup-areas nil) | |
111 (defvar gnus-soup-last-prefix nil) | |
112 (defvar gnus-soup-prev-prefix nil) | |
113 (defvar gnus-soup-buffers nil) | |
114 | |
115 ;;; Access macros: | |
116 | |
117 (defmacro gnus-soup-area-prefix (area) | |
118 `(aref ,area 0)) | |
119 (defmacro gnus-soup-set-area-prefix (area prefix) | |
120 `(aset ,area 0 ,prefix)) | |
121 (defmacro gnus-soup-area-name (area) | |
122 `(aref ,area 1)) | |
123 (defmacro gnus-soup-area-encoding (area) | |
124 `(aref ,area 2)) | |
125 (defmacro gnus-soup-area-description (area) | |
126 `(aref ,area 3)) | |
127 (defmacro gnus-soup-area-number (area) | |
128 `(aref ,area 4)) | |
129 (defmacro gnus-soup-area-set-number (area value) | |
130 `(aset ,area 4 ,value)) | |
131 | |
132 (defmacro gnus-soup-encoding-format (encoding) | |
133 `(aref ,encoding 0)) | |
134 (defmacro gnus-soup-encoding-index (encoding) | |
135 `(aref ,encoding 1)) | |
136 (defmacro gnus-soup-encoding-kind (encoding) | |
137 `(aref ,encoding 2)) | |
138 | |
139 (defmacro gnus-soup-reply-prefix (reply) | |
140 `(aref ,reply 0)) | |
141 (defmacro gnus-soup-reply-kind (reply) | |
142 `(aref ,reply 1)) | |
143 (defmacro gnus-soup-reply-encoding (reply) | |
144 `(aref ,reply 2)) | |
145 | |
146 ;;; Commands: | |
147 | |
148 (defun gnus-soup-send-replies () | |
149 "Unpack and send all replies in the reply packet." | |
150 (interactive) | |
151 (let ((packets (directory-files | |
152 gnus-soup-packet-directory t gnus-soup-packet-regexp))) | |
153 (while packets | |
154 (when (gnus-soup-send-packet (car packets)) | |
155 (delete-file (car packets))) | |
156 (setq packets (cdr packets))))) | |
157 | |
158 (defun gnus-soup-add-article (n) | |
159 "Add the current article to SOUP packet. | |
160 If N is a positive number, add the N next articles. | |
161 If N is a negative number, add the N previous articles. | |
162 If N is nil and any articles have been marked with the process mark, | |
163 move those articles instead." | |
164 (interactive "P") | |
165 (let* ((articles (gnus-summary-work-articles n)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
166 (tmp-buf (gnus-get-buffer-create "*soup work*")) |
17493 | 167 (area (gnus-soup-area gnus-newsgroup-name)) |
168 (prefix (gnus-soup-area-prefix area)) | |
169 headers) | |
170 (buffer-disable-undo tmp-buf) | |
171 (save-excursion | |
172 (while articles | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
173 ;; Put the article in a buffer. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
174 (set-buffer tmp-buf) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
175 (when (gnus-request-article-this-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
176 (car articles) gnus-newsgroup-name) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
177 (setq headers (nnheader-parse-head t)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
178 (save-restriction |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
179 (message-narrow-to-head) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
180 (message-remove-header gnus-soup-ignored-headers t)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
181 (gnus-soup-store gnus-soup-directory prefix headers |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
182 gnus-soup-encoding-type |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
183 gnus-soup-index-type) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
184 (gnus-soup-area-set-number |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
185 area (1+ (or (gnus-soup-area-number area) 0))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
186 ;; Mark article as read. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
187 (set-buffer gnus-summary-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
188 (gnus-summary-mark-as-read (car articles) gnus-souped-mark)) |
17493 | 189 (gnus-summary-remove-process-mark (car articles)) |
190 (setq articles (cdr articles))) | |
191 (kill-buffer tmp-buf)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
192 (gnus-soup-save-areas) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
193 (gnus-set-mode-line 'summary))) |
17493 | 194 |
195 (defun gnus-soup-pack-packet () | |
196 "Make a SOUP packet from the SOUP areas." | |
197 (interactive) | |
198 (gnus-soup-read-areas) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
199 (if (file-exists-p gnus-soup-directory) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
200 (if (directory-files gnus-soup-directory nil "\\.MSG$") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
201 (gnus-soup-pack gnus-soup-directory gnus-soup-packer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
202 (message "No files to pack.")) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
203 (message "No such directory: %s" gnus-soup-directory))) |
17493 | 204 |
205 (defun gnus-group-brew-soup (n) | |
206 "Make a soup packet from the current group. | |
207 Uses the process/prefix convention." | |
208 (interactive "P") | |
209 (let ((groups (gnus-group-process-prefix n))) | |
210 (while groups | |
211 (gnus-group-remove-mark (car groups)) | |
212 (gnus-soup-group-brew (car groups) t) | |
213 (setq groups (cdr groups))) | |
214 (gnus-soup-save-areas))) | |
215 | |
216 (defun gnus-brew-soup (&optional level) | |
217 "Go through all groups on LEVEL or less and make a soup packet." | |
218 (interactive "P") | |
219 (let ((level (or level gnus-level-subscribed)) | |
220 (newsrc (cdr gnus-newsrc-alist))) | |
221 (while newsrc | |
222 (when (<= (nth 1 (car newsrc)) level) | |
223 (gnus-soup-group-brew (caar newsrc) t)) | |
224 (setq newsrc (cdr newsrc))) | |
225 (gnus-soup-save-areas))) | |
226 | |
227 ;;;###autoload | |
228 (defun gnus-batch-brew-soup () | |
229 "Brew a SOUP packet from groups mention on the command line. | |
230 Will use the remaining command line arguments as regular expressions | |
231 for matching on group names. | |
232 | |
233 For instance, if you want to brew on all the nnml groups, as well as | |
234 groups with \"emacs\" in the name, you could say something like: | |
235 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
236 $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\" |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
237 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
238 Note -- this function hasn't been implemented yet." |
17493 | 239 (interactive) |
240 nil) | |
241 | |
242 ;;; Internal Functions: | |
243 | |
244 ;; Store the current buffer. | |
245 (defun gnus-soup-store (directory prefix headers format index) | |
246 ;; Create the directory, if needed. | |
247 (gnus-make-directory directory) | |
248 (let* ((msg-buf (nnheader-find-file-noselect | |
249 (concat directory prefix ".MSG"))) | |
250 (idx-buf (if (= index ?n) | |
251 nil | |
252 (nnheader-find-file-noselect | |
253 (concat directory prefix ".IDX")))) | |
254 (article-buf (current-buffer)) | |
255 from head-line beg type) | |
256 (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) | |
257 (buffer-disable-undo msg-buf) | |
258 (when idx-buf | |
259 (push idx-buf gnus-soup-buffers) | |
260 (buffer-disable-undo idx-buf)) | |
261 (save-excursion | |
262 ;; Make sure the last char in the buffer is a newline. | |
263 (goto-char (point-max)) | |
264 (unless (= (current-column) 0) | |
265 (insert "\n")) | |
266 ;; Find the "from". | |
267 (goto-char (point-min)) | |
268 (setq from | |
269 (gnus-mail-strip-quoted-names | |
270 (or (mail-fetch-field "from") | |
271 (mail-fetch-field "really-from") | |
272 (mail-fetch-field "sender")))) | |
273 (goto-char (point-min)) | |
274 ;; Depending on what encoding is supposed to be used, we make | |
275 ;; a soup header. | |
276 (setq head-line | |
277 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
278 ((or (= gnus-soup-encoding-type ?u) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
279 (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. |
17493 | 280 (format "#! rnews %d\n" (buffer-size))) |
281 ((= gnus-soup-encoding-type ?m) | |
282 (while (search-forward "\nFrom " nil t) | |
283 (replace-match "\n>From " t t)) | |
284 (concat "From " (or from "unknown") | |
285 " " (current-time-string) "\n")) | |
286 ((= gnus-soup-encoding-type ?M) | |
287 "\^a\^a\^a\^a\n") | |
288 (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) | |
289 ;; Insert the soup header and the article in the MSG buf. | |
290 (set-buffer msg-buf) | |
291 (goto-char (point-max)) | |
292 (insert head-line) | |
293 (setq beg (point)) | |
294 (insert-buffer-substring article-buf) | |
295 ;; Insert the index in the IDX buf. | |
296 (cond ((= index ?c) | |
297 (set-buffer idx-buf) | |
298 (gnus-soup-insert-idx beg headers)) | |
299 ((/= index ?n) | |
300 (error "Unknown index type: %c" type))) | |
301 ;; Return the MSG buf. | |
302 msg-buf))) | |
303 | |
304 (defun gnus-soup-group-brew (group &optional not-all) | |
305 "Enter GROUP and add all articles to a SOUP package. | |
306 If NOT-ALL, don't pack ticked articles." | |
307 (let ((gnus-expert-user t) | |
308 (gnus-large-newsgroup nil) | |
309 (entry (gnus-gethash group gnus-newsrc-hashtb))) | |
310 (when (or (null entry) | |
311 (eq (car entry) t) | |
312 (and (car entry) | |
313 (> (car entry) 0)) | |
314 (and (not not-all) | |
315 (gnus-range-length (cdr (assq 'tick (gnus-info-marks | |
316 (nth 2 entry))))))) | |
317 (when (gnus-summary-read-group group nil t) | |
318 (setq gnus-newsgroup-processable | |
319 (reverse | |
320 (if (not not-all) | |
321 (append gnus-newsgroup-marked gnus-newsgroup-unreads) | |
322 gnus-newsgroup-unreads))) | |
323 (gnus-soup-add-article nil) | |
324 (gnus-summary-exit))))) | |
325 | |
326 (defun gnus-soup-insert-idx (offset header) | |
327 ;; [number subject from date id references chars lines xref] | |
328 (goto-char (point-max)) | |
329 (insert | |
330 (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" | |
331 offset | |
332 (or (mail-header-subject header) "(none)") | |
333 (or (mail-header-from header) "(nobody)") | |
334 (or (mail-header-date header) "") | |
335 (or (mail-header-id header) | |
336 (concat "soup-dummy-id-" | |
337 (mapconcat | |
338 (lambda (time) (int-to-string time)) | |
339 (current-time) "-"))) | |
340 (or (mail-header-references header) "") | |
341 (or (mail-header-chars header) 0) | |
342 (or (mail-header-lines header) "0")))) | |
343 | |
344 (defun gnus-soup-save-areas () | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
345 "Write all SOUP buffers." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
346 (interactive) |
17493 | 347 (gnus-soup-write-areas) |
348 (save-excursion | |
349 (let (buf) | |
350 (while gnus-soup-buffers | |
351 (setq buf (car gnus-soup-buffers) | |
352 gnus-soup-buffers (cdr gnus-soup-buffers)) | |
353 (if (not (buffer-name buf)) | |
354 () | |
355 (set-buffer buf) | |
356 (when (buffer-modified-p) | |
357 (save-buffer)) | |
358 (kill-buffer (current-buffer))))) | |
359 (gnus-soup-write-prefixes))) | |
360 | |
361 (defun gnus-soup-write-prefixes () | |
362 (let ((prefixes gnus-soup-last-prefix) | |
363 prefix) | |
364 (save-excursion | |
365 (gnus-set-work-buffer) | |
366 (while (setq prefix (pop prefixes)) | |
367 (erase-buffer) | |
368 (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
369 (let ((coding-system-for-write mm-text-coding-system)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
370 (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))) |
17493 | 371 |
372 (defun gnus-soup-pack (dir packer) | |
373 (let* ((files (mapconcat 'identity | |
374 '("AREAS" "*.MSG" "*.IDX" "INFO" | |
375 "LIST" "REPLIES" "COMMANDS" "ERRORS") | |
376 " ")) | |
377 (packer (if (< (string-match "%s" packer) | |
378 (string-match "%d" packer)) | |
379 (format packer files | |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
380 (string-to-number (gnus-soup-unique-prefix dir))) |
17493 | 381 (format packer |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
382 (string-to-number (gnus-soup-unique-prefix dir)) |
17493 | 383 files))) |
384 (dir (expand-file-name dir))) | |
385 (gnus-make-directory dir) | |
386 (setq gnus-soup-areas nil) | |
387 (gnus-message 4 "Packing %s..." packer) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
388 (if (eq 0 (call-process shell-file-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
389 nil nil nil shell-command-switch |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
390 (concat "cd " dir " ; " packer))) |
17493 | 391 (progn |
392 (call-process shell-file-name nil nil nil shell-command-switch | |
393 (concat "cd " dir " ; rm " files)) | |
394 (gnus-message 4 "Packing...done" packer)) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
395 (error "Couldn't pack packet")))) |
17493 | 396 |
397 (defun gnus-soup-parse-areas (file) | |
398 "Parse soup area file FILE. | |
399 The result is a of vectors, each containing one entry from the AREA file. | |
400 The vector contain five strings, | |
401 [prefix name encoding description number] | |
402 though the two last may be nil if they are missing." | |
403 (let (areas) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
404 (when (file-exists-p file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
405 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
406 (set-buffer (nnheader-find-file-noselect file 'force)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
407 (buffer-disable-undo) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
408 (goto-char (point-min)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
409 (while (not (eobp)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
410 (push (vector (gnus-soup-field) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
411 (gnus-soup-field) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
412 (gnus-soup-field) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
413 (and (eq (preceding-char) ?\t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
414 (gnus-soup-field)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
415 (and (eq (preceding-char) ?\t) |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
416 (string-to-number (gnus-soup-field)))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
417 areas) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
418 (when (eq (preceding-char) ?\t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
419 (beginning-of-line 2))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
420 (kill-buffer (current-buffer)))) |
17493 | 421 areas)) |
422 | |
423 (defun gnus-soup-parse-replies (file) | |
424 "Parse soup REPLIES file FILE. | |
425 The result is a of vectors, each containing one entry from the REPLIES | |
426 file. The vector contain three strings, [prefix name encoding]." | |
427 (let (replies) | |
428 (save-excursion | |
429 (set-buffer (nnheader-find-file-noselect file)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
430 (buffer-disable-undo) |
17493 | 431 (goto-char (point-min)) |
432 (while (not (eobp)) | |
433 (push (vector (gnus-soup-field) (gnus-soup-field) | |
434 (gnus-soup-field)) | |
435 replies) | |
436 (when (eq (preceding-char) ?\t) | |
437 (beginning-of-line 2))) | |
438 (kill-buffer (current-buffer))) | |
439 replies)) | |
440 | |
441 (defun gnus-soup-field () | |
442 (prog1 | |
443 (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) | |
444 (forward-char 1))) | |
445 | |
446 (defun gnus-soup-read-areas () | |
447 (or gnus-soup-areas | |
448 (setq gnus-soup-areas | |
449 (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) | |
450 | |
451 (defun gnus-soup-write-areas () | |
452 "Write the AREAS file." | |
453 (interactive) | |
454 (when gnus-soup-areas | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
455 (with-temp-file (concat gnus-soup-directory "AREAS") |
17493 | 456 (let ((areas gnus-soup-areas) |
457 area) | |
458 (while (setq area (pop areas)) | |
459 (insert | |
460 (format | |
461 "%s\t%s\t%s%s\n" | |
462 (gnus-soup-area-prefix area) | |
463 (gnus-soup-area-name area) | |
464 (gnus-soup-area-encoding area) | |
465 (if (or (gnus-soup-area-description area) | |
466 (gnus-soup-area-number area)) | |
467 (concat "\t" (or (gnus-soup-area-description | |
468 area) "") | |
469 (if (gnus-soup-area-number area) | |
470 (concat "\t" (int-to-string | |
471 (gnus-soup-area-number area))) | |
472 "")) "")))))))) | |
473 | |
474 (defun gnus-soup-write-replies (dir areas) | |
475 "Write a REPLIES file in DIR containing AREAS." | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
476 (with-temp-file (concat dir "REPLIES") |
17493 | 477 (let (area) |
478 (while (setq area (pop areas)) | |
479 (insert (format "%s\t%s\t%s\n" | |
480 (gnus-soup-reply-prefix area) | |
481 (gnus-soup-reply-kind area) | |
482 (gnus-soup-reply-encoding area))))))) | |
483 | |
484 (defun gnus-soup-area (group) | |
485 (gnus-soup-read-areas) | |
486 (let ((areas gnus-soup-areas) | |
487 (real-group (gnus-group-real-name group)) | |
488 area result) | |
489 (while areas | |
490 (setq area (car areas) | |
491 areas (cdr areas)) | |
492 (when (equal (gnus-soup-area-name area) real-group) | |
493 (setq result area))) | |
494 (unless result | |
495 (setq result | |
496 (vector (gnus-soup-unique-prefix) | |
497 real-group | |
498 (format "%c%c%c" | |
499 gnus-soup-encoding-type | |
500 gnus-soup-index-type | |
501 (if (gnus-member-of-valid 'mail group) ?m ?n)) | |
502 nil nil) | |
503 gnus-soup-areas (cons result gnus-soup-areas))) | |
504 result)) | |
505 | |
506 (defun gnus-soup-unique-prefix (&optional dir) | |
507 (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) | |
508 (entry (assoc dir gnus-soup-last-prefix)) | |
509 gnus-soup-prev-prefix) | |
510 (if entry | |
511 () | |
512 (when (file-exists-p (concat dir gnus-soup-prefix-file)) | |
513 (ignore-errors | |
514 (load (concat dir gnus-soup-prefix-file) nil t t))) | |
515 (push (setq entry (cons dir (or gnus-soup-prev-prefix 0))) | |
516 gnus-soup-last-prefix)) | |
517 (setcdr entry (1+ (cdr entry))) | |
518 (gnus-soup-write-prefixes) | |
519 (int-to-string (cdr entry)))) | |
520 | |
521 (defun gnus-soup-unpack-packet (dir unpacker packet) | |
522 "Unpack PACKET into DIR using UNPACKER. | |
523 Return whether the unpacking was successful." | |
524 (gnus-make-directory dir) | |
525 (gnus-message 4 "Unpacking: %s" (format unpacker packet)) | |
526 (prog1 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
527 (eq 0 (call-process |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
528 shell-file-name nil nil nil shell-command-switch |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
529 (format "cd %s ; %s" (expand-file-name dir) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
530 (format unpacker packet)))) |
17493 | 531 (gnus-message 4 "Unpacking...done"))) |
532 | |
533 (defun gnus-soup-send-packet (packet) | |
534 (gnus-soup-unpack-packet | |
535 gnus-soup-replies-directory gnus-soup-unpacker packet) | |
536 (let ((replies (gnus-soup-parse-replies | |
537 (concat gnus-soup-replies-directory "REPLIES")))) | |
538 (save-excursion | |
539 (while replies | |
540 (let* ((msg-file (concat gnus-soup-replies-directory | |
541 (gnus-soup-reply-prefix (car replies)) | |
542 ".MSG")) | |
543 (msg-buf (and (file-exists-p msg-file) | |
544 (nnheader-find-file-noselect msg-file))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
545 (tmp-buf (gnus-get-buffer-create " *soup send*")) |
17493 | 546 beg end) |
547 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
548 ((and (/= (gnus-soup-encoding-format |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
549 (gnus-soup-reply-encoding (car replies))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
550 ?u) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
551 (/= (gnus-soup-encoding-format |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
552 (gnus-soup-reply-encoding (car replies))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
553 ?n)) ;; Gnus back compatibility. |
17493 | 554 (error "Unsupported encoding")) |
555 ((null msg-buf) | |
556 t) | |
557 (t | |
558 (buffer-disable-undo msg-buf) | |
559 (set-buffer msg-buf) | |
560 (goto-char (point-min)) | |
561 (while (not (eobp)) | |
562 (unless (looking-at "#! *rnews +\\([0-9]+\\)") | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
563 (error "Bad header")) |
17493 | 564 (forward-line 1) |
565 (setq beg (point) | |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
566 end (+ (point) (string-to-number |
17493 | 567 (buffer-substring |
568 (match-beginning 1) (match-end 1))))) | |
569 (switch-to-buffer tmp-buf) | |
570 (erase-buffer) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
571 (mm-disable-multibyte) |
17493 | 572 (insert-buffer-substring msg-buf beg end) |
573 (cond | |
574 ((string= (gnus-soup-reply-kind (car replies)) "news") | |
575 (gnus-message 5 "Sending news message to %s..." | |
576 (mail-fetch-field "newsgroups")) | |
577 (sit-for 1) | |
578 (let ((message-syntax-checks | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
579 'dont-check-for-anything-just-trust-me) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
580 (method (if (functionp message-post-method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
581 (funcall message-post-method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
582 message-post-method)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
583 result) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
584 (run-hooks 'message-send-news-hook) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
585 (gnus-open-server method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
586 (message "Sending news via %s..." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
587 (gnus-server-string method)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
588 (unless (let ((mail-header-separator "")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
589 (gnus-request-post method)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
590 (message "Couldn't send message via news: %s" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
591 (nnheader-get-report (car method)))))) |
17493 | 592 ((string= (gnus-soup-reply-kind (car replies)) "mail") |
593 (gnus-message 5 "Sending mail to %s..." | |
594 (mail-fetch-field "to")) | |
595 (sit-for 1) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
596 (let ((mail-header-separator "")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
597 (mm-with-unibyte-current-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
598 (funcall (or message-send-mail-real-function |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
599 message-send-mail-function))))) |
17493 | 600 (t |
601 (error "Unknown reply kind"))) | |
602 (set-buffer msg-buf) | |
603 (goto-char end)) | |
604 (delete-file (buffer-file-name)) | |
605 (kill-buffer msg-buf) | |
606 (kill-buffer tmp-buf) | |
607 (gnus-message 4 "Sent packet")))) | |
608 (setq replies (cdr replies))) | |
609 t))) | |
610 | |
611 (provide 'gnus-soup) | |
612 | |
52401 | 613 ;;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c |
17493 | 614 ;;; gnus-soup.el ends here |