Mercurial > emacs
annotate lisp/gnus/gnus-uu.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 8d09094063d0 |
children | f567b340d004 |
rev | line source |
---|---|
17493 | 1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
2 |
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, |
106815 | 4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 7 ;; Created: 2 Oct 1993 |
8 ;; Keyword: news | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 13 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
17493 | 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 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;;; Code: | |
28 | |
19634
118761d47324
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
29 (eval-when-compile (require 'cl)) |
118761d47324
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
30 |
17493 | 31 (require 'gnus) |
32 (require 'gnus-art) | |
33 (require 'message) | |
34 (require 'gnus-msg) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
35 (require 'mm-decode) |
87097 | 36 (require 'yenc) |
17493 | 37 |
38 (defgroup gnus-extract nil | |
39 "Extracting encoded files." | |
40 :prefix "gnus-uu-" | |
41 :group 'gnus) | |
42 | |
43 (defgroup gnus-extract-view nil | |
44 "Viewwing extracted files." | |
45 :group 'gnus-extract) | |
46 | |
47 (defgroup gnus-extract-archive nil | |
48 "Extracting encoded archives." | |
49 :group 'gnus-extract) | |
50 | |
51 (defgroup gnus-extract-post nil | |
52 "Extracting encoded archives." | |
53 :prefix "gnus-uu-post" | |
54 :group 'gnus-extract) | |
55 | |
56 ;; Default viewing action rules | |
57 | |
58 (defcustom gnus-uu-default-view-rules | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
59 '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
60 ("\\.pas$" "cat %s | sed 's/\r$//'") |
17493 | 61 ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") |
29734
afc9d8eb0666
(gnus-uu-default-view-rules): Don't use `xv'.
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
62 ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display") |
afc9d8eb0666
(gnus-uu-default-view-rules): Don't use `xv'.
Gerd Moellmann <gerd@gnu.org>
parents:
26039
diff
changeset
|
63 ("\\.tga$" "tgatoppm %s | ee -") |
17493 | 64 ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" |
65 "sox -v .5 %s -t .au -u - > /dev/audio") | |
66 ("\\.au$" "cat %s > /dev/audio") | |
67 ("\\.midi?$" "playmidi -f") | |
68 ("\\.mod$" "str32") | |
69 ("\\.ps$" "ghostview") | |
70 ("\\.dvi$" "xdvi") | |
71 ("\\.html$" "xmosaic") | |
72 ("\\.mpe?g$" "mpeg_play") | |
73 ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") | |
74 ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" | |
75 "gnus-uu-archive")) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
76 "*Default actions to be taken when the user asks to view a file. |
79416
3741d4f6b713
(gnus-uu-default-view-rules): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
78224
diff
changeset
|
77 To change the behavior, you can either edit this variable or set |
17493 | 78 `gnus-uu-user-view-rules' to something useful. |
79 | |
80 For example: | |
81 | |
82 To make gnus-uu use 'xli' to display JPEG and GIF files, put the | |
83 following in your .emacs file: | |
84 | |
85 (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) | |
86 | |
87 Both these variables are lists of lists with two string elements. The | |
88 first string is a regular expression. If the file name matches this | |
89 regular expression, the command in the second string is executed with | |
90 the file as an argument. | |
91 | |
92 If the command string contains \"%s\", the file name will be inserted | |
93 at that point in the command string. If there's no \"%s\" in the | |
94 command string, the file name will be appended to the command string | |
95 before executing. | |
96 | |
79416
3741d4f6b713
(gnus-uu-default-view-rules): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
78224
diff
changeset
|
97 There are several user variables to tailor the behavior of gnus-uu to |
17493 | 98 your needs. First we have `gnus-uu-user-view-rules', which is the |
99 variable gnus-uu first consults when trying to decide how to view a | |
100 file. If this variable contains no matches, gnus-uu examines the | |
101 default rule variable provided in this package. If gnus-uu finds no | |
102 match here, it uses `gnus-uu-user-view-rules-end' to try to make a | |
103 match." | |
104 :group 'gnus-extract-view | |
105 :type '(repeat (group regexp (string :tag "Command")))) | |
106 | |
107 (defcustom gnus-uu-user-view-rules nil | |
108 "What actions are to be taken to view a file. | |
109 See the documentation on the `gnus-uu-default-view-rules' variable for | |
110 details." | |
111 :group 'gnus-extract-view | |
112 :type '(repeat (group regexp (string :tag "Command")))) | |
113 | |
114 (defcustom gnus-uu-user-view-rules-end | |
115 '(("" "file")) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
116 "*What actions are to be taken if no rule matched the file name. |
17493 | 117 See the documentation on the `gnus-uu-default-view-rules' variable for |
118 details." | |
119 :group 'gnus-extract-view | |
120 :type '(repeat (group regexp (string :tag "Command")))) | |
121 | |
122 ;; Default unpacking commands | |
123 | |
124 (defcustom gnus-uu-default-archive-rules | |
125 '(("\\.tar$" "tar xf") | |
126 ("\\.zip$" "unzip -o") | |
127 ("\\.ar$" "ar x") | |
128 ("\\.arj$" "unarj x") | |
129 ("\\.zoo$" "zoo -e") | |
130 ("\\.\\(lzh\\|lha\\)$" "lha x") | |
131 ("\\.Z$" "uncompress") | |
132 ("\\.gz$" "gunzip") | |
133 ("\\.arc$" "arc -x")) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
134 "*See `gnus-uu-user-archive-rules'." |
17493 | 135 :group 'gnus-extract-archive |
136 :type '(repeat (group regexp (string :tag "Command")))) | |
137 | |
138 (defvar gnus-uu-destructive-archivers | |
139 (list "uncompress" "gunzip")) | |
140 | |
141 (defcustom gnus-uu-user-archive-rules nil | |
142 "A list that can be set to override the default archive unpacking commands. | |
143 To use, for instance, 'untar' to unpack tar files and 'zip -x' to | |
144 unpack zip files, say the following: | |
145 (setq gnus-uu-user-archive-rules | |
146 '((\"\\\\.tar$\" \"untar\") | |
147 (\"\\\\.zip$\" \"zip -x\")))" | |
148 :group 'gnus-extract-archive | |
149 :type '(repeat (group regexp (string :tag "Command")))) | |
150 | |
151 (defcustom gnus-uu-ignore-files-by-name nil | |
152 "*A regular expression saying what files should not be viewed based on name. | |
153 If, for instance, you want gnus-uu to ignore all .au and .wav files, | |
154 you could say something like | |
155 | |
156 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") | |
157 | |
158 Note that this variable can be used in conjunction with the | |
159 `gnus-uu-ignore-files-by-type' variable." | |
160 :group 'gnus-extract | |
161 :type '(choice (const :tag "off" nil) | |
162 (regexp :format "%v"))) | |
163 | |
164 (defcustom gnus-uu-ignore-files-by-type nil | |
165 "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. | |
166 If, for instance, you want gnus-uu to ignore all audio files and all mpegs, | |
167 you could say something like | |
168 | |
169 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") | |
170 | |
171 Note that this variable can be used in conjunction with the | |
172 `gnus-uu-ignore-files-by-name' variable." | |
173 :group 'gnus-extract | |
174 :type '(choice (const :tag "off" nil) | |
175 (regexp :format "%v"))) | |
176 | |
177 ;; Pseudo-MIME support | |
178 | |
179 (defconst gnus-uu-ext-to-mime-list | |
180 '(("\\.gif$" "image/gif") | |
181 ("\\.jpe?g$" "image/jpeg") | |
182 ("\\.tiff?$" "image/tiff") | |
183 ("\\.xwd$" "image/xwd") | |
184 ("\\.pbm$" "image/pbm") | |
185 ("\\.pgm$" "image/pgm") | |
186 ("\\.ppm$" "image/ppm") | |
187 ("\\.xbm$" "image/xbm") | |
188 ("\\.pcx$" "image/pcx") | |
189 ("\\.tga$" "image/tga") | |
190 ("\\.ps$" "image/postscript") | |
191 ("\\.fli$" "video/fli") | |
192 ("\\.wav$" "audio/wav") | |
193 ("\\.aiff$" "audio/aiff") | |
194 ("\\.hcom$" "audio/hcom") | |
195 ("\\.voc$" "audio/voc") | |
196 ("\\.smp$" "audio/smp") | |
197 ("\\.mod$" "audio/mod") | |
198 ("\\.dvi$" "image/dvi") | |
199 ("\\.mpe?g$" "video/mpeg") | |
200 ("\\.au$" "audio/basic") | |
201 ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") | |
202 ("\\.\\(c\\|h\\)$" "text/source") | |
203 ("read.*me" "text/plain") | |
204 ("\\.html$" "text/html") | |
205 ("\\.bat$" "text/bat") | |
206 ("\\.[1-6]$" "text/man") | |
207 ("\\.flc$" "video/flc") | |
208 ("\\.rle$" "video/rle") | |
209 ("\\.pfx$" "video/pfx") | |
210 ("\\.avi$" "video/avi") | |
211 ("\\.sme$" "video/sme") | |
212 ("\\.rpza$" "video/prza") | |
213 ("\\.dl$" "video/dl") | |
214 ("\\.qt$" "video/qt") | |
215 ("\\.rsrc$" "video/rsrc") | |
216 ("\\..*$" "unknown/unknown"))) | |
217 | |
218 ;; Various variables users may set | |
219 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
220 (defcustom gnus-uu-tmp-dir |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
221 (cond ((fboundp 'temp-directory) (temp-directory)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
222 ((boundp 'temporary-file-directory) temporary-file-directory) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
223 ("/tmp/")) |
17493 | 224 "*Variable saying where gnus-uu is to do its work. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
225 Default is \"/tmp/\"." |
17493 | 226 :group 'gnus-extract |
227 :type 'directory) | |
228 | |
229 (defcustom gnus-uu-do-not-unpack-archives nil | |
230 "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. | |
231 Default is nil." | |
232 :group 'gnus-extract-archive | |
233 :type 'boolean) | |
234 | |
235 (defcustom gnus-uu-ignore-default-view-rules nil | |
236 "*Non-nil means that gnus-uu will ignore the default viewing rules. | |
237 Only the user viewing rules will be consulted. Default is nil." | |
238 :group 'gnus-extract-view | |
239 :type 'boolean) | |
240 | |
241 (defcustom gnus-uu-grabbed-file-functions nil | |
242 "Functions run on each file after successful decoding. | |
243 They will be called with the name of the file as the argument. | |
244 Likely functions you can use in this list are `gnus-uu-grab-view' | |
245 and `gnus-uu-grab-move'." | |
246 :group 'gnus-extract | |
247 :options '(gnus-uu-grab-view gnus-uu-grab-move) | |
248 :type 'hook) | |
249 | |
250 (defcustom gnus-uu-ignore-default-archive-rules nil | |
251 "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. | |
252 Only the user unpacking commands will be consulted. Default is nil." | |
253 :group 'gnus-extract-archive | |
254 :type 'boolean) | |
255 | |
256 (defcustom gnus-uu-kill-carriage-return t | |
257 "*Non-nil means that gnus-uu will strip all carriage returns from articles. | |
258 Default is t." | |
259 :group 'gnus-extract | |
260 :type 'boolean) | |
261 | |
262 (defcustom gnus-uu-view-with-metamail nil | |
263 "*Non-nil means that files will be viewed with metamail. | |
264 The gnus-uu viewing functions will be ignored and gnus-uu will try | |
265 to guess at a content-type based on file name suffixes. Default | |
266 it nil." | |
267 :group 'gnus-extract | |
268 :type 'boolean) | |
269 | |
270 (defcustom gnus-uu-unmark-articles-not-decoded nil | |
271 "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. | |
272 Default is nil." | |
273 :group 'gnus-extract | |
274 :type 'boolean) | |
275 | |
276 (defcustom gnus-uu-correct-stripped-uucode nil | |
277 "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. | |
278 Default is nil." | |
279 :group 'gnus-extract | |
280 :type 'boolean) | |
281 | |
282 (defcustom gnus-uu-save-in-digest nil | |
283 "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. | |
284 If this variable is nil, gnus-uu will just save everything in a | |
285 file without any embellishments. The digesting almost conforms to RFC1153 - | |
286 no easy way to specify any meaningful volume and issue numbers were found, | |
287 so I simply dropped them." | |
288 :group 'gnus-extract | |
289 :type 'boolean) | |
290 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
291 (defcustom gnus-uu-pre-uudecode-hook nil |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
292 "Hook run before sending a message to uudecode." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
293 :group 'gnus-extract |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
294 :type 'hook) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
295 |
17493 | 296 (defcustom gnus-uu-digest-headers |
297 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
298 "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
299 "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
300 "^Content-ID:") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
301 "*List of regexps to match headers included in digested messages. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
302 The headers will be included in the sequence they are matched. If nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
303 include all headers." |
17493 | 304 :group 'gnus-extract |
305 :type '(repeat regexp)) | |
306 | |
307 (defcustom gnus-uu-save-separate-articles nil | |
308 "*Non-nil means that gnus-uu will save articles in separate files." | |
309 :group 'gnus-extract | |
310 :type 'boolean) | |
311 | |
312 (defcustom gnus-uu-be-dangerous 'ask | |
313 "*Specifies what to do if unusual situations arise during decoding. | |
314 If nil, be as conservative as possible. If t, ignore things that | |
315 didn't work, and overwrite existing files. Otherwise, ask each time." | |
316 :group 'gnus-extract | |
317 :type '(choice (const :tag "conservative" nil) | |
318 (const :tag "ask" ask) | |
319 (const :tag "liberal" t))) | |
320 | |
321 ;; Internal variables | |
322 | |
323 (defvar gnus-uu-saved-article-name nil) | |
324 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
325 (defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
326 (defvar gnus-uu-end-string "^end[ \t]*$") |
17493 | 327 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
328 (defvar gnus-uu-body-line "^M") |
17493 | 329 (let ((i 61)) |
330 (while (> (setq i (1- i)) 0) | |
331 (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) | |
332 (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) | |
333 | |
334 ;"^M.............................................................?$" | |
335 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
336 (defvar gnus-uu-shar-begin-string "^#! */bin/sh") |
17493 | 337 |
338 (defvar gnus-uu-shar-file-name nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
339 (defvar gnus-uu-shar-name-marker |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
340 "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)") |
17493 | 341 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
342 (defvar gnus-uu-postscript-begin-string "^%!PS-") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
343 (defvar gnus-uu-postscript-end-string "^%%EOF$") |
17493 | 344 |
345 (defvar gnus-uu-file-name nil) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
346 (defvar gnus-uu-uudecode-process nil) |
17493 | 347 (defvar gnus-uu-binhex-article-name nil) |
87097 | 348 (defvar gnus-uu-yenc-article-name nil) |
17493 | 349 |
350 (defvar gnus-uu-work-dir nil) | |
351 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
352 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*") |
17493 | 353 |
354 (defvar gnus-uu-default-dir gnus-article-save-directory) | |
355 (defvar gnus-uu-digest-from-subject nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
356 (defvar gnus-uu-digest-buffer nil) |
17493 | 357 |
358 ;; Commands. | |
359 | |
360 (defun gnus-uu-decode-uu (&optional n) | |
361 "Uudecodes the current article." | |
362 (interactive "P") | |
363 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) | |
364 | |
365 (defun gnus-uu-decode-uu-and-save (n dir) | |
366 "Decodes and saves the resulting file." | |
367 (interactive | |
368 (list current-prefix-arg | |
369 (file-name-as-directory | |
370 (read-file-name "Uudecode and save in dir: " | |
371 gnus-uu-default-dir | |
372 gnus-uu-default-dir t)))) | |
373 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) | |
374 | |
375 (defun gnus-uu-decode-unshar (&optional n) | |
376 "Unshars the current article." | |
377 (interactive "P") | |
378 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) | |
379 | |
380 (defun gnus-uu-decode-unshar-and-save (n dir) | |
381 "Unshars and saves the current article." | |
382 (interactive | |
383 (list current-prefix-arg | |
384 (file-name-as-directory | |
385 (read-file-name "Unshar and save in dir: " | |
386 gnus-uu-default-dir | |
387 gnus-uu-default-dir t)))) | |
388 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) | |
389 | |
390 (defun gnus-uu-decode-save (n file) | |
391 "Saves the current article." | |
392 (interactive | |
393 (list current-prefix-arg | |
394 (read-file-name | |
395 (if gnus-uu-save-separate-articles | |
79416
3741d4f6b713
(gnus-uu-default-view-rules): Fix typos in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
78224
diff
changeset
|
396 "Save articles in dir: " |
17493 | 397 "Save articles in file: ") |
398 gnus-uu-default-dir | |
399 gnus-uu-default-dir))) | |
400 (setq gnus-uu-saved-article-name file) | |
401 (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) | |
402 | |
403 (defun gnus-uu-decode-binhex (n dir) | |
404 "Unbinhexes the current article." | |
405 (interactive | |
406 (list current-prefix-arg | |
407 (file-name-as-directory | |
408 (read-file-name "Unbinhex and save in dir: " | |
409 gnus-uu-default-dir | |
410 gnus-uu-default-dir)))) | |
411 (setq gnus-uu-binhex-article-name | |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
412 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) |
17493 | 413 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) |
414 | |
87097 | 415 (defun gnus-uu-decode-yenc (n dir) |
416 "Decode the yEnc-encoded current article." | |
417 (interactive | |
418 (list current-prefix-arg | |
419 (file-name-as-directory | |
420 (read-file-name "yEnc decode and save in dir: " | |
421 gnus-uu-default-dir | |
422 gnus-uu-default-dir)))) | |
423 (setq gnus-uu-yenc-article-name nil) | |
424 (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t)) | |
425 | |
17493 | 426 (defun gnus-uu-decode-uu-view (&optional n) |
427 "Uudecodes and views the current article." | |
428 (interactive "P") | |
429 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
430 (gnus-uu-decode-uu n))) | |
431 | |
432 (defun gnus-uu-decode-uu-and-save-view (n dir) | |
433 "Decodes, views and saves the resulting file." | |
434 (interactive | |
435 (list current-prefix-arg | |
436 (read-file-name "Uudecode, view and save in dir: " | |
437 gnus-uu-default-dir | |
438 gnus-uu-default-dir t))) | |
439 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
440 (gnus-uu-decode-uu-and-save n dir))) | |
441 | |
442 (defun gnus-uu-decode-unshar-view (&optional n) | |
443 "Unshars and views the current article." | |
444 (interactive "P") | |
445 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
446 (gnus-uu-decode-unshar n))) | |
447 | |
448 (defun gnus-uu-decode-unshar-and-save-view (n dir) | |
449 "Unshars and saves the current article." | |
450 (interactive | |
451 (list current-prefix-arg | |
452 (read-file-name "Unshar, view and save in dir: " | |
453 gnus-uu-default-dir | |
454 gnus-uu-default-dir t))) | |
455 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
456 (gnus-uu-decode-unshar-and-save n dir))) | |
457 | |
458 (defun gnus-uu-decode-save-view (n file) | |
459 "Saves and views the current article." | |
460 (interactive | |
461 (list current-prefix-arg | |
462 (read-file-name (if gnus-uu-save-separate-articles | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
463 "Save articles is dir: " |
17493 | 464 "Save articles in file: ") |
465 gnus-uu-default-dir gnus-uu-default-dir))) | |
466 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
467 (gnus-uu-decode-save n file))) | |
468 | |
469 (defun gnus-uu-decode-binhex-view (n file) | |
470 "Unbinhexes and views the current article." | |
471 (interactive | |
472 (list current-prefix-arg | |
473 (read-file-name "Unbinhex, view and save in dir: " | |
474 gnus-uu-default-dir gnus-uu-default-dir))) | |
475 (setq gnus-uu-binhex-article-name | |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
476 (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) |
17493 | 477 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) |
478 (gnus-uu-decode-binhex n file))) | |
479 | |
480 | |
481 ;; Digest and forward articles | |
482 | |
483 (defun gnus-uu-digest-mail-forward (&optional n post) | |
484 "Digests and forwards all articles in this series." | |
485 (interactive "P") | |
486 (let ((gnus-uu-save-in-digest t) | |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
487 (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward"))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
488 (message-forward-as-mime message-forward-as-mime) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
489 (mail-parse-charset gnus-newsgroup-charset) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
490 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
491 gnus-uu-digest-buffer subject from) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
492 (if (and n (not (numberp n))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
493 (setq message-forward-as-mime (not message-forward-as-mime) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
494 n nil)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
495 (let ((gnus-article-reply (gnus-summary-work-articles n))) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
496 (when (and (not n) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
497 (= (length gnus-article-reply) 1)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
498 ;; The case where neither a number of articles nor a region is |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
499 ;; specified. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
500 (gnus-summary-top-thread) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
501 (setq gnus-article-reply (nreverse (gnus-uu-find-articles-matching)))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
502 (gnus-setup-message 'forward |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
503 (setq gnus-uu-digest-from-subject nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
504 (setq gnus-uu-digest-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
505 (gnus-get-buffer-create " *gnus-uu-forward*")) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
506 ;; Specify articles to be forwarded. Note that they should be |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
507 ;; reversed; see `gnus-uu-get-list-of-articles'. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
508 (let ((gnus-newsgroup-processable (reverse gnus-article-reply))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
509 (gnus-uu-decode-save n file) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
510 (setq gnus-article-reply gnus-newsgroup-processable)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
511 ;; Restore the value of `gnus-newsgroup-processable' to which |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
512 ;; it should be set when it is not `let'-bound. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
513 (setq gnus-newsgroup-processable (reverse gnus-article-reply)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
514 (switch-to-buffer gnus-uu-digest-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
515 (let ((fs gnus-uu-digest-from-subject)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
516 (when fs |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
517 (setq from (caar fs) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
518 subject (gnus-simplify-subject-fuzzy (cdar fs)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
519 fs (cdr fs)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
520 (while (and fs (or from subject)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
521 (when from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
522 (unless (string= from (caar fs)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
523 (setq from nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
524 (when subject |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
525 (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
526 subject) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
527 (setq subject nil))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
528 (setq fs (cdr fs)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
529 (unless subject |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
530 (setq subject "Digested Articles")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
531 (unless from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
532 (setq from |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
533 (if (gnus-news-group-p gnus-newsgroup-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
534 gnus-newsgroup-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
535 "Various")))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
536 (goto-char (point-min)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
537 (when (re-search-forward "^Subject: ") |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
538 (delete-region (point) (point-at-eol)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
539 (insert subject)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
540 (goto-char (point-min)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
541 (when (re-search-forward "^From:") |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
542 (delete-region (point) (point-at-eol)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
543 (insert " " from)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
544 (let ((message-forward-decoded-p t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
545 (message-forward post t)))) |
17493 | 546 (setq gnus-uu-digest-from-subject nil))) |
547 | |
548 (defun gnus-uu-digest-post-forward (&optional n) | |
549 "Digest and forward to a newsgroup." | |
550 (interactive "P") | |
551 (gnus-uu-digest-mail-forward n t)) | |
552 | |
553 ;; Process marking. | |
554 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
555 (defun gnus-message-process-mark (unmarkp new-marked) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
556 (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
557 (gnus-message 6 "%d mark%s %s%s" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
558 (length new-marked) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
559 (if (= (length new-marked) 1) "" "s") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
560 (if unmarkp "removed" "added") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
561 (cond |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
562 ((and (zerop old) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
563 (not unmarkp)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
564 "") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
565 (unmarkp |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
566 (format ", %d remain marked" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
567 (length gnus-newsgroup-processable))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
568 (t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
569 (format ", %d already marked" old)))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
570 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
571 (defun gnus-new-processable (unmarkp articles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
572 (if unmarkp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
573 (gnus-intersection gnus-newsgroup-processable articles) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
574 (gnus-set-difference articles gnus-newsgroup-processable))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
575 |
17493 | 576 (defun gnus-uu-mark-by-regexp (regexp &optional unmark) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
577 "Set the process mark on articles whose subjects match REGEXP. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
578 When called interactively, prompt for REGEXP. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
579 Optional UNMARK non-nil means unmark instead of mark." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
580 (interactive "sMark (regexp): \nP") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
581 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
582 (let* ((articles (gnus-uu-find-articles-matching regexp)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
583 (new-marked (gnus-new-processable unmark articles))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
584 (while articles |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
585 (if unmark |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
586 (gnus-summary-remove-process-mark (pop articles)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
587 (gnus-summary-set-process-mark (pop articles)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
588 (gnus-message-process-mark unmark new-marked))) |
17493 | 589 (gnus-summary-position-point)) |
590 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
591 (defun gnus-uu-unmark-by-regexp (regexp) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
592 "Remove the process mark from articles whose subjects match REGEXP. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
593 When called interactively, prompt for REGEXP." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
594 (interactive "sUnmark (regexp): ") |
17493 | 595 (gnus-uu-mark-by-regexp regexp t)) |
596 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
597 (defun gnus-uu-mark-series (&optional silent) |
17493 | 598 "Mark the current series with the process mark." |
599 (interactive) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
600 (let* ((articles (gnus-uu-find-articles-matching)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
601 (l (length articles))) |
17493 | 602 (while articles |
603 (gnus-summary-set-process-mark (car articles)) | |
604 (setq articles (cdr articles))) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
605 (unless silent |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
606 (gnus-message 6 "Marked %d articles" l)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
607 (gnus-summary-position-point) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
608 l)) |
17493 | 609 |
610 (defun gnus-uu-mark-region (beg end &optional unmark) | |
611 "Set the process mark on all articles between point and mark." | |
612 (interactive "r") | |
613 (save-excursion | |
614 (goto-char beg) | |
615 (while (< (point) end) | |
616 (if unmark | |
617 (gnus-summary-remove-process-mark (gnus-summary-article-number)) | |
618 (gnus-summary-set-process-mark (gnus-summary-article-number))) | |
619 (forward-line 1))) | |
620 (gnus-summary-position-point)) | |
621 | |
622 (defun gnus-uu-unmark-region (beg end) | |
623 "Remove the process mark from all articles between point and mark." | |
624 (interactive "r") | |
625 (gnus-uu-mark-region beg end t)) | |
626 | |
627 (defun gnus-uu-mark-buffer () | |
628 "Set the process mark on all articles in the buffer." | |
629 (interactive) | |
630 (gnus-uu-mark-region (point-min) (point-max))) | |
631 | |
632 (defun gnus-uu-unmark-buffer () | |
633 "Remove the process mark on all articles in the buffer." | |
634 (interactive) | |
635 (gnus-uu-mark-region (point-min) (point-max) t)) | |
636 | |
637 (defun gnus-uu-mark-thread () | |
638 "Marks all articles downwards in this thread." | |
639 (interactive) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
640 (gnus-save-hidden-threads |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
641 (let ((level (gnus-summary-thread-level))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
642 (while (and (gnus-summary-set-process-mark |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
643 (gnus-summary-article-number)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
644 (zerop (gnus-summary-next-subject 1 nil t)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
645 (> (gnus-summary-thread-level) level))))) |
17493 | 646 (gnus-summary-position-point)) |
647 | |
648 (defun gnus-uu-unmark-thread () | |
649 "Unmarks all articles downwards in this thread." | |
650 (interactive) | |
651 (let ((level (gnus-summary-thread-level))) | |
652 (while (and (gnus-summary-remove-process-mark | |
653 (gnus-summary-article-number)) | |
654 (zerop (gnus-summary-next-subject 1)) | |
655 (> (gnus-summary-thread-level) level)))) | |
656 (gnus-summary-position-point)) | |
657 | |
658 (defun gnus-uu-invert-processable () | |
659 "Invert the list of process-marked articles." | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
660 (interactive) |
17493 | 661 (let ((data gnus-newsgroup-data) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
662 number) |
17493 | 663 (save-excursion |
664 (while data | |
665 (if (memq (setq number (gnus-data-number (pop data))) | |
666 gnus-newsgroup-processable) | |
667 (gnus-summary-remove-process-mark number) | |
668 (gnus-summary-set-process-mark number))))) | |
669 (gnus-summary-position-point)) | |
670 | |
671 (defun gnus-uu-mark-over (&optional score) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
672 "Mark all articles with a score over SCORE (the prefix)." |
17493 | 673 (interactive "P") |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
674 (let ((score (or score gnus-summary-default-score 0)) |
17493 | 675 (data gnus-newsgroup-data)) |
676 (save-excursion | |
677 (while data | |
678 (when (> (or (cdr (assq (gnus-data-number (car data)) | |
679 gnus-newsgroup-scored)) | |
680 gnus-summary-default-score 0) | |
681 score) | |
682 (gnus-summary-set-process-mark (caar data))) | |
683 (setq data (cdr data)))) | |
684 (gnus-summary-position-point))) | |
685 | |
686 (defun gnus-uu-mark-sparse () | |
687 "Mark all series that have some articles marked." | |
688 (interactive) | |
689 (let ((marked (nreverse gnus-newsgroup-processable)) | |
690 subject articles total headers) | |
691 (unless marked | |
692 (error "No articles marked with the process mark")) | |
693 (setq gnus-newsgroup-processable nil) | |
694 (save-excursion | |
695 (while marked | |
696 (and (vectorp (setq headers | |
697 (gnus-summary-article-header (car marked)))) | |
698 (setq subject (mail-header-subject headers) | |
699 articles (gnus-uu-find-articles-matching | |
700 (gnus-uu-reginize-string subject)) | |
701 total (nconc total articles))) | |
702 (while articles | |
703 (gnus-summary-set-process-mark (car articles)) | |
704 (setcdr marked (delq (car articles) (cdr marked))) | |
705 (setq articles (cdr articles))) | |
706 (setq marked (cdr marked))) | |
707 (setq gnus-newsgroup-processable (nreverse total))) | |
708 (gnus-summary-position-point))) | |
709 | |
710 (defun gnus-uu-mark-all () | |
711 "Mark all articles in \"series\" order." | |
712 (interactive) | |
713 (setq gnus-newsgroup-processable nil) | |
714 (save-excursion | |
715 (let ((data gnus-newsgroup-data) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
716 (count 0) |
17493 | 717 number) |
718 (while data | |
719 (when (and (not (memq (setq number (gnus-data-number (car data))) | |
720 gnus-newsgroup-processable)) | |
721 (vectorp (gnus-data-header (car data)))) | |
722 (gnus-summary-goto-subject number) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
723 (setq count (+ count (gnus-uu-mark-series t)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
724 (setq data (cdr data))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
725 (gnus-message 6 "Marked %d articles" count))) |
17493 | 726 (gnus-summary-position-point)) |
727 | |
728 ;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. | |
729 | |
730 (defun gnus-uu-decode-postscript (&optional n) | |
731 "Gets postscript of the current article." | |
732 (interactive "P") | |
733 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) | |
734 | |
735 (defun gnus-uu-decode-postscript-view (&optional n) | |
736 "Gets and views the current article." | |
737 (interactive "P") | |
738 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
739 (gnus-uu-decode-postscript n))) | |
740 | |
741 (defun gnus-uu-decode-postscript-and-save (n dir) | |
742 "Extracts postscript and saves the current article." | |
743 (interactive | |
744 (list current-prefix-arg | |
745 (file-name-as-directory | |
746 (read-file-name "Save in dir: " | |
747 gnus-uu-default-dir | |
748 gnus-uu-default-dir t)))) | |
749 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article | |
750 n dir nil nil t)) | |
751 | |
752 (defun gnus-uu-decode-postscript-and-save-view (n dir) | |
753 "Decodes, views and saves the resulting file." | |
754 (interactive | |
755 (list current-prefix-arg | |
756 (read-file-name "Where do you want to save the file(s)? " | |
757 gnus-uu-default-dir | |
758 gnus-uu-default-dir t))) | |
759 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | |
760 (gnus-uu-decode-postscript-and-save n dir))) | |
761 | |
762 | |
763 ;; Internal functions. | |
764 | |
765 (defun gnus-uu-decode-with-method (method n &optional save not-insert | |
766 scan cdir) | |
767 (gnus-uu-initialize scan) | |
768 (when save | |
769 (setq gnus-uu-default-dir save)) | |
770 ;; Create the directory we save to. | |
771 (when (and scan cdir save | |
772 (not (file-exists-p save))) | |
773 (make-directory save t)) | |
774 (let ((articles (gnus-uu-get-list-of-articles n)) | |
775 files) | |
776 (setq files (gnus-uu-grab-articles articles method t)) | |
777 (let ((gnus-current-article (car articles))) | |
778 (when scan | |
779 (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) | |
780 (when save | |
781 (gnus-uu-save-files files save)) | |
782 (when (eq gnus-uu-do-not-unpack-archives nil) | |
783 (setq files (gnus-uu-unpack-files files))) | |
784 (setq files (nreverse (gnus-uu-get-actions files))) | |
785 (or not-insert (not gnus-insert-pseudo-articles) | |
786 (gnus-summary-insert-pseudos files save)))) | |
787 | |
788 (defun gnus-uu-scan-directory (dir &optional rec) | |
789 "Return a list of all files under DIR." | |
790 (let ((files (directory-files dir t)) | |
791 out file) | |
792 (while (setq file (pop files)) | |
793 (unless (member (file-name-nondirectory file) '("." "..")) | |
794 (push (list (cons 'name file) | |
795 (cons 'article gnus-current-article)) | |
796 out) | |
797 (when (file-directory-p file) | |
798 (setq out (nconc (gnus-uu-scan-directory file t) out))))) | |
799 (if rec | |
800 out | |
801 (nreverse out)))) | |
802 | |
803 (defun gnus-uu-save-files (files dir) | |
804 "Save FILES in DIR." | |
805 (let ((len (length files)) | |
806 (reg (concat "^" (regexp-quote gnus-uu-work-dir))) | |
807 to-file file fromdir) | |
808 (while (setq file (cdr (assq 'name (pop files)))) | |
809 (when (file-exists-p file) | |
810 (string-match reg file) | |
811 (setq fromdir (substring file (match-end 0))) | |
812 (if (file-directory-p file) | |
813 (gnus-make-directory (concat dir fromdir)) | |
814 (setq to-file (concat dir fromdir)) | |
815 (when (or (not (file-exists-p to-file)) | |
816 (eq gnus-uu-be-dangerous t) | |
817 (and gnus-uu-be-dangerous | |
818 (gnus-y-or-n-p (format "%s exists; overwrite? " | |
819 to-file)))) | |
820 (copy-file file to-file t t))))) | |
821 (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) | |
822 | |
823 ;; Functions for saving and possibly digesting articles without | |
824 ;; any decoding. | |
825 | |
826 ;; Function called by gnus-uu-grab-articles to treat each article. | |
827 (defun gnus-uu-save-article (buffer in-state) | |
828 (cond | |
829 (gnus-uu-save-separate-articles | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
830 (with-current-buffer buffer |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
831 (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:
29734
diff
changeset
|
832 (gnus-write-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
833 (concat gnus-uu-saved-article-name gnus-current-article))) |
17493 | 834 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) |
835 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name | |
836 'begin 'end)) | |
837 ((eq in-state 'last) (list 'end)) | |
838 (t (list 'middle))))) | |
839 ((not gnus-uu-save-in-digest) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
840 (with-current-buffer buffer |
17493 | 841 (write-region (point-min) (point-max) gnus-uu-saved-article-name t) |
842 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) | |
843 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name | |
844 'begin 'end)) | |
845 ((eq in-state 'last) (list 'end)) | |
846 (t (list 'middle))))) | |
847 (t | |
848 (let ((header (gnus-summary-article-header))) | |
849 (push (cons (mail-header-from header) | |
850 (mail-header-subject header)) | |
851 gnus-uu-digest-from-subject)) | |
852 (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) | |
853 beg subj headers headline sorthead body end-string state) | |
854 (if (or (eq in-state 'first) | |
855 (eq in-state 'first-and-last)) | |
856 (progn | |
857 (setq state (list 'begin)) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
858 (with-current-buffer (gnus-get-buffer-create "*gnus-uu-body*") |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
859 (erase-buffer)) |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
860 (with-current-buffer (gnus-get-buffer-create "*gnus-uu-pre*") |
17493 | 861 (erase-buffer) |
862 (insert (format | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
863 "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" |
64780
4def766e2c3f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-515
Miles Bader <miles@gnu.org>
parents:
64754
diff
changeset
|
864 (message-make-date) name name)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
865 (when (and message-forward-as-mime gnus-uu-digest-buffer) |
69949
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
866 (insert |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
867 "<#mml type=message/rfc822>\nSubject: Topics\n\n<#/mml>\n") |
d0312c3f2374
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-214
Miles Bader <miles@gnu.org>
parents:
68633
diff
changeset
|
868 (forward-line -1)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
869 (insert "Topics:\n"))) |
17493 | 870 (when (not (eq in-state 'end)) |
871 (setq state (list 'middle)))) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
872 (with-current-buffer "*gnus-uu-body*" |
17493 | 873 (goto-char (setq beg (point-max))) |
874 (save-excursion | |
875 (save-restriction | |
876 (set-buffer buffer) | |
877 (let (buffer-read-only) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
878 (set-text-properties (point-min) (point-max) nil) |
17493 | 879 ;; These two are necessary for XEmacs 19.12 fascism. |
880 (put-text-property (point-min) (point-max) 'invisible nil) | |
881 (put-text-property (point-min) (point-max) 'intangible nil)) | |
35957
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
882 (when (and message-forward-as-mime |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
883 message-forward-show-mml |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
884 gnus-uu-digest-buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
885 (mm-enable-multibyte) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
886 (mime-to-mml)) |
17493 | 887 (goto-char (point-min)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
888 (search-forward "\n\n") |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
889 (unless (and message-forward-as-mime gnus-uu-digest-buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
890 ;; Quote all 30-dash lines. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
891 (save-excursion |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
892 (while (re-search-forward "^-" nil t) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
893 (beginning-of-line) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
894 (delete-char 1) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
895 (insert "- ")))) |
17493 | 896 (setq body (buffer-substring (1- (point)) (point-max))) |
897 (narrow-to-region (point-min) (point)) | |
898 (if (not (setq headers gnus-uu-digest-headers)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
899 (setq sorthead (buffer-string)) |
17493 | 900 (while headers |
901 (setq headline (car headers)) | |
902 (setq headers (cdr headers)) | |
903 (goto-char (point-min)) | |
904 (while (re-search-forward headline nil t) | |
905 (setq sorthead | |
906 (concat sorthead | |
907 (buffer-substring | |
908 (match-beginning 0) | |
909 (or (and (re-search-forward "^[^ \t]" nil t) | |
910 (1- (point))) | |
911 (progn (forward-line 1) (point))))))))) | |
912 (widen))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
913 (if (and message-forward-as-mime gnus-uu-digest-buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
914 (if message-forward-show-mml |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
915 (progn |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
916 (insert "\n<#mml type=message/rfc822>\n") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
917 (insert sorthead) (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
918 (insert body) (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
919 (insert "\n<#/mml>\n")) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
920 (let ((buf (mml-generate-new-buffer " *mml*"))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
921 (with-current-buffer buf |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
922 (insert sorthead) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
923 (goto-char (point-min)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
924 (when (re-search-forward "^Subject: \\(.*\\)$" nil t) |
35957
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
925 (setq subj (buffer-substring (match-beginning 1) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
926 (match-end 1)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
927 (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
928 (insert body)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
929 (insert "\n<#part type=message/rfc822" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
930 " buffer=\"" (buffer-name buf) "\">\n"))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
931 (insert sorthead) (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
932 (insert body) (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
933 (insert (concat "\n" (make-string 30 ?-) "\n\n"))) |
17493 | 934 (goto-char beg) |
935 (when (re-search-forward "^Subject: \\(.*\\)$" nil t) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
936 (setq subj (buffer-substring (match-beginning 1) (match-end 1)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
937 (when subj |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
938 (with-current-buffer "*gnus-uu-pre*" |
17493 | 939 (insert (format " %s\n" subj))))) |
940 (when (or (eq in-state 'last) | |
941 (eq in-state 'first-and-last)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
942 (if (and message-forward-as-mime gnus-uu-digest-buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
943 (with-current-buffer gnus-uu-digest-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
944 (erase-buffer) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
945 (insert-buffer-substring "*gnus-uu-pre*") |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
946 (goto-char (point-max)) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
947 (insert-buffer-substring "*gnus-uu-body*")) |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
948 (with-current-buffer "*gnus-uu-pre*" |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
949 (insert (format "\n\n%s\n\n" (make-string 70 ?-))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
950 (if gnus-uu-digest-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
951 (with-current-buffer gnus-uu-digest-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
952 (erase-buffer) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
953 (insert-buffer-substring "*gnus-uu-pre*")) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
954 (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:
29734
diff
changeset
|
955 (gnus-write-buffer gnus-uu-saved-article-name)))) |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
956 (with-current-buffer "*gnus-uu-body*" |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
957 (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
958 (insert |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
959 (concat (setq end-string (format "End of %s Digest" name)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
960 "\n")) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
961 (insert (concat (make-string (length end-string) ?*) "\n")) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
962 (if gnus-uu-digest-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
963 (with-current-buffer gnus-uu-digest-buffer |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
964 (goto-char (point-max)) |
64712
4db92b217e85
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-507
Miles Bader <miles@gnu.org>
parents:
64085
diff
changeset
|
965 (insert-buffer-substring "*gnus-uu-body*")) |
35957
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
966 (let ((coding-system-for-write mm-text-coding-system) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
967 (file-name-coding-system nnmail-pathname-coding-system)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
968 (write-region |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
969 (point-min) (point-max) gnus-uu-saved-article-name t))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
970 (gnus-kill-buffer "*gnus-uu-pre*") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
971 (gnus-kill-buffer "*gnus-uu-body*") |
17493 | 972 (push 'end state)) |
973 (if (memq 'begin state) | |
974 (cons gnus-uu-saved-article-name state) | |
975 state))))) | |
976 | |
977 ;; Binhex treatment - not very advanced. | |
978 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
979 (defvar gnus-uu-binhex-body-line |
17493 | 980 "^[^:]...............................................................$") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
981 (defvar gnus-uu-binhex-begin-line |
17493 | 982 "^:...............................................................$") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
983 (defvar gnus-uu-binhex-end-line |
17493 | 984 ":$") |
985 | |
986 (defun gnus-uu-binhex-article (buffer in-state) | |
987 (let (state start-char) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
988 (with-current-buffer buffer |
17493 | 989 (widen) |
990 (goto-char (point-min)) | |
991 (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) | |
992 (when (not (re-search-forward gnus-uu-binhex-body-line nil t)) | |
993 (setq state (list 'wrong-type)))) | |
994 | |
995 (if (memq 'wrong-type state) | |
996 () | |
997 (beginning-of-line) | |
998 (setq start-char (point)) | |
999 (if (looking-at gnus-uu-binhex-begin-line) | |
1000 (progn | |
1001 (setq state (list 'begin)) | |
44514
8bfbcb957964
(gnus-uu-binhex-article, gnus-uu-reginize-string, gnus-uu-expand-numbers)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44075
diff
changeset
|
1002 (write-region (point-min) (point-min) |
8bfbcb957964
(gnus-uu-binhex-article, gnus-uu-reginize-string, gnus-uu-expand-numbers)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44075
diff
changeset
|
1003 gnus-uu-binhex-article-name)) |
17493 | 1004 (setq state (list 'middle))) |
1005 (goto-char (point-max)) | |
1006 (re-search-backward (concat gnus-uu-binhex-body-line "\\|" | |
1007 gnus-uu-binhex-end-line) | |
1008 nil t) | |
1009 (when (looking-at gnus-uu-binhex-end-line) | |
1010 (setq state (if (memq 'begin state) | |
1011 (cons 'end state) | |
1012 (list 'end)))) | |
1013 (beginning-of-line) | |
1014 (forward-line 1) | |
1015 (when (file-exists-p gnus-uu-binhex-article-name) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1016 (mm-append-to-file start-char (point) gnus-uu-binhex-article-name)))) |
17493 | 1017 (if (memq 'begin state) |
1018 (cons gnus-uu-binhex-article-name state) | |
1019 state))) | |
1020 | |
87097 | 1021 ;; yEnc |
1022 | |
1023 (defun gnus-uu-yenc-article (buffer in-state) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1024 (with-current-buffer gnus-original-article-buffer |
87097 | 1025 (widen) |
1026 (let ((file-name (yenc-extract-filename)) | |
1027 state start-char) | |
1028 (when (not file-name) | |
1029 (setq state (list 'wrong-type))) | |
1030 | |
1031 (if (memq 'wrong-type state) | |
1032 () | |
1033 (when (yenc-first-part-p) | |
1034 (setq gnus-uu-yenc-article-name | |
1035 (expand-file-name file-name gnus-uu-work-dir)) | |
1036 (push 'begin state)) | |
1037 (when (yenc-last-part-p) | |
1038 (push 'end state)) | |
1039 (unless state | |
1040 (push 'middle state)) | |
1041 (mm-with-unibyte-buffer | |
87193
b40a0f01cf1e
(gnus-uu-yenc-article): Use insert-buffer-substring.
Glenn Morris <rgm@gnu.org>
parents:
87097
diff
changeset
|
1042 (insert-buffer-substring gnus-original-article-buffer) |
87097 | 1043 (yenc-decode-region (point-min) (point-max)) |
1044 (when (and (member 'begin state) | |
1045 (file-exists-p gnus-uu-yenc-article-name)) | |
1046 (delete-file gnus-uu-yenc-article-name)) | |
1047 (mm-append-to-file (point-min) (point-max) | |
1048 gnus-uu-yenc-article-name))) | |
1049 (if (memq 'begin state) | |
1050 (cons file-name state) | |
1051 state)))) | |
1052 | |
17493 | 1053 ;; PostScript |
1054 | |
1055 (defun gnus-uu-decode-postscript-article (process-buffer in-state) | |
1056 (let ((state (list 'ok)) | |
1057 start-char end-char file-name) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1058 (with-current-buffer process-buffer |
17493 | 1059 (goto-char (point-min)) |
1060 (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) | |
1061 (setq state (list 'wrong-type)) | |
1062 (beginning-of-line) | |
1063 (setq start-char (point)) | |
1064 (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) | |
1065 (setq state (list 'wrong-type)) | |
1066 (setq end-char (point)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1067 (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) |
17493 | 1068 (insert-buffer-substring process-buffer start-char end-char) |
1069 (setq file-name (concat gnus-uu-work-dir | |
1070 (cdr gnus-article-current) ".ps")) | |
1071 (write-region (point-min) (point-max) file-name) | |
1072 (setq state (list file-name 'begin 'end))))) | |
1073 state)) | |
1074 | |
1075 | |
1076 ;; Find actions. | |
1077 | |
1078 (defun gnus-uu-get-actions (files) | |
1079 (let ((ofiles files) | |
1080 action name) | |
1081 (while files | |
1082 (setq name (cdr (assq 'name (car files)))) | |
1083 (and | |
1084 (setq action (gnus-uu-get-action name)) | |
1085 (setcar files (nconc (list (if (string= action "gnus-uu-archive") | |
1086 (cons 'action "file") | |
1087 (cons 'action action)) | |
1088 (cons 'execute (gnus-uu-command | |
1089 action name))) | |
1090 (car files)))) | |
1091 (setq files (cdr files))) | |
1092 ofiles)) | |
1093 | |
1094 (defun gnus-uu-get-action (file-name) | |
1095 (let (action) | |
1096 (setq action | |
1097 (gnus-uu-choose-action | |
1098 file-name | |
1099 (append | |
1100 gnus-uu-user-view-rules | |
1101 (if gnus-uu-ignore-default-view-rules | |
1102 nil | |
1103 gnus-uu-default-view-rules) | |
1104 gnus-uu-user-view-rules-end))) | |
1105 (when (and (not (string= (or action "") "gnus-uu-archive")) | |
1106 gnus-uu-view-with-metamail) | |
1107 (when (setq action | |
1108 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) | |
1109 (setq action (format "metamail -d -b -c \"%s\"" action)))) | |
1110 action)) | |
1111 | |
1112 | |
1113 ;; Functions for treating subjects and collecting series. | |
1114 | |
1115 (defun gnus-uu-reginize-string (string) | |
1116 ;; Takes a string and puts a \ in front of every special character; | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1117 ;; replaces the last thing that looks like "2/3" with "[0-9]+/3" |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1118 ;; or, if it can't find something like that, tries "2 of 3", then |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1119 ;; finally just replaces the next to last number with "[0-9]+". |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1120 (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1121 (buffer-disable-undo) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1122 (erase-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1123 (insert (regexp-quote string)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1124 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1125 (setq case-fold-search nil) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1126 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1127 (end-of-line) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1128 (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1129 (replace-match "\\1[0-9]+/\\2") |
17493 | 1130 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1131 (end-of-line) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1132 (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)" |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1133 nil t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1134 (replace-match "\\1[0-9]+ of \\2") |
17493 | 1135 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1136 (end-of-line) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1137 (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1138 nil t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1139 (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) |
17493 | 1140 |
85008
ff46392e7e97
(gnus-uu-reginize-string, gnus-uu-expand-numbers): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78224
diff
changeset
|
1141 (goto-char (point-min)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1142 (while (re-search-forward "[ \t]+" nil t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1143 (replace-match "[ \t]+" t t)) |
17493 | 1144 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1145 (buffer-string))) |
17493 | 1146 |
1147 (defun gnus-uu-get-list-of-articles (n) | |
1148 ;; If N is non-nil, the article numbers of the N next articles | |
1149 ;; will be returned. | |
1150 ;; If any articles have been marked as processable, they will be | |
1151 ;; returned. | |
1152 ;; Failing that, articles that have subjects that are part of the | |
1153 ;; same "series" as the current will be returned. | |
1154 (let (articles) | |
1155 (cond | |
1156 (n | |
1157 (setq n (prefix-numeric-value n)) | |
1158 (let ((backward (< n 0)) | |
1159 (n (abs n))) | |
1160 (save-excursion | |
1161 (while (and (> n 0) | |
1162 (push (gnus-summary-article-number) | |
1163 articles) | |
1164 (gnus-summary-search-forward nil nil backward)) | |
1165 (setq n (1- n)))) | |
1166 (nreverse articles))) | |
1167 (gnus-newsgroup-processable | |
1168 (reverse gnus-newsgroup-processable)) | |
1169 (t | |
1170 (gnus-uu-find-articles-matching))))) | |
1171 | |
1172 (defun gnus-uu-string< (l1 l2) | |
1173 (string< (car l1) (car l2))) | |
1174 | |
1175 (defun gnus-uu-find-articles-matching | |
1176 (&optional subject only-unread do-not-translate) | |
1177 ;; Finds all articles that matches the regexp SUBJECT. If it is | |
1178 ;; nil, the current article name will be used. If ONLY-UNREAD is | |
1179 ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is | |
1180 ;; non-nil, article names are not equalized before sorting. | |
1181 (let ((subject (or subject | |
1182 (gnus-uu-reginize-string (gnus-summary-article-subject)))) | |
1183 list-of-subjects) | |
1184 (save-excursion | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1185 (when subject |
17493 | 1186 ;; Collect all subjects matching subject. |
1187 (let ((case-fold-search t) | |
1188 (data gnus-newsgroup-data) | |
1189 subj mark d) | |
1190 (while data | |
1191 (setq d (pop data)) | |
1192 (and (not (gnus-data-pseudo-p d)) | |
1193 (or (not only-unread) | |
1194 (= (setq mark (gnus-data-mark d)) | |
1195 gnus-unread-mark) | |
1196 (= mark gnus-ticked-mark) | |
1197 (= mark gnus-dormant-mark)) | |
1198 (setq subj (mail-header-subject (gnus-data-header d))) | |
1199 (string-match subject subj) | |
1200 (push (cons subj (gnus-data-number d)) | |
1201 list-of-subjects)))) | |
1202 | |
1203 ;; Expand numbers, sort, and return the list of article | |
1204 ;; numbers. | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1205 (mapcar 'cdr |
17493 | 1206 (sort (gnus-uu-expand-numbers |
1207 list-of-subjects | |
1208 (not do-not-translate)) | |
1209 'gnus-uu-string<)))))) | |
1210 | |
1211 (defun gnus-uu-expand-numbers (string-list &optional translate) | |
1212 ;; Takes a list of strings and "expands" all numbers in all the | |
1213 ;; strings. That is, this function makes all numbers equal length by | |
1214 ;; prepending lots of zeroes before each number. This is to ease later | |
1215 ;; sorting to find out what sequence the articles are supposed to be | |
1216 ;; decoded in. Returns the list of expanded strings. | |
1217 (let ((out-list string-list) | |
1218 string) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1219 (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1220 (buffer-disable-undo) |
17493 | 1221 (while string-list |
1222 (erase-buffer) | |
1223 (insert (caar string-list)) | |
1224 ;; Translate multiple spaces to one space. | |
1225 (goto-char (point-min)) | |
1226 (while (re-search-forward "[ \t]+" nil t) | |
1227 (replace-match " ")) | |
1228 ;; Translate all characters to "a". | |
1229 (goto-char (point-min)) | |
1230 (when translate | |
1231 (while (re-search-forward "[A-Za-z]" nil t) | |
1232 (replace-match "a" t t))) | |
1233 ;; Expand numbers. | |
1234 (goto-char (point-min)) | |
1235 (while (re-search-forward "[0-9]+" nil t) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1236 (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1237 (replace-match |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1238 (format "%06d" |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
1239 (string-to-number (buffer-substring |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1240 (match-beginning 0) (match-end 0))))))) |
85008
ff46392e7e97
(gnus-uu-reginize-string, gnus-uu-expand-numbers): Don't hardcode point-min==1.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78224
diff
changeset
|
1241 (setq string (buffer-substring (point-min) (point-max))) |
17493 | 1242 (setcar (car string-list) string) |
1243 (setq string-list (cdr string-list)))) | |
1244 out-list)) | |
1245 | |
1246 | |
1247 ;; `gnus-uu-grab-articles' is the general multi-article treatment | |
1248 ;; function. It takes a list of articles to be grabbed and a function | |
1249 ;; to apply to each article. | |
1250 ;; | |
1251 ;; The function to be called should take two parameters. The first | |
1252 ;; parameter is the article buffer. The function should leave the | |
1253 ;; result, if any, in this buffer. Most treatment functions will just | |
1254 ;; generate files... | |
1255 ;; | |
1256 ;; The second parameter is the state of the list of articles, and can | |
1257 ;; have four values: `first', `middle', `last' and `first-and-last'. | |
1258 ;; | |
1259 ;; The function should return a list. The list may contain the | |
1260 ;; following symbols: | |
1261 ;; `error' if an error occurred | |
1262 ;; `begin' if the beginning of an encoded file has been received | |
1263 ;; If the list returned contains a `begin', the first element of | |
1264 ;; the list *must* be a string with the file name of the decoded | |
1265 ;; file. | |
1266 ;; `end' if the end of an encoded file has been received | |
1267 ;; `middle' if the article was a body part of an encoded file | |
1268 ;; `wrong-type' if the article was not a part of an encoded file | |
1269 ;; `ok', which can be used everything is ok | |
1270 | |
1271 (defvar gnus-uu-has-been-grabbed nil) | |
1272 | |
1273 (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) | |
1274 (let (art) | |
1275 (if (not (and gnus-uu-has-been-grabbed | |
1276 gnus-uu-unmark-articles-not-decoded)) | |
1277 () | |
1278 (when dont-unmark-last-article | |
1279 (setq art (car gnus-uu-has-been-grabbed)) | |
1280 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) | |
1281 (while gnus-uu-has-been-grabbed | |
1282 (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) | |
1283 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) | |
1284 (when dont-unmark-last-article | |
1285 (setq gnus-uu-has-been-grabbed (list art)))))) | |
1286 | |
1287 ;; This function takes a list of articles and a function to apply to | |
1288 ;; each article grabbed. | |
1289 ;; | |
1290 ;; This function returns a list of files decoded if the grabbing and | |
1291 ;; the process-function has been successful and nil otherwise. | |
1292 (defun gnus-uu-grab-articles (articles process-function | |
1293 &optional sloppy limit no-errors) | |
1294 (let ((state 'first) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1295 (gnus-asynchronous nil) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1296 (gnus-inhibit-treatment t) |
17493 | 1297 has-been-begin article result-file result-files process-state |
1298 gnus-summary-display-article-function | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1299 gnus-article-prepare-hook gnus-display-mime-function |
17493 | 1300 article-series files) |
1301 | |
1302 (while (and articles | |
1303 (not (memq 'error process-state)) | |
1304 (or sloppy | |
1305 (not (memq 'end process-state)))) | |
1306 | |
1307 (setq article (pop articles)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1308 (when (vectorp (gnus-summary-article-header article)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1309 (push article article-series) |
17493 | 1310 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1311 (unless articles |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1312 (if (eq state 'first) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1313 (setq state 'first-and-last) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1314 (setq state 'last))) |
17493 | 1315 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1316 (let ((part (gnus-uu-part-number article))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1317 (gnus-message 6 "Getting article %d%s..." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1318 article (if (string= part "") "" (concat ", " part)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1319 (gnus-summary-display-article article) |
17493 | 1320 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1321 ;; Push the article to the processing function. |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1322 (with-current-buffer gnus-original-article-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1323 (let ((buffer-read-only nil)) |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1324 (with-current-buffer gnus-summary-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1325 (setq process-state |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1326 (funcall process-function |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1327 gnus-original-article-buffer state))))) |
17493 | 1328 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1329 (gnus-summary-remove-process-mark article) |
17493 | 1330 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1331 ;; If this is the beginning of a decoded file, we push it |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1332 ;; on to a list. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1333 (when (or (memq 'begin process-state) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1334 (and (or (eq state 'first) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1335 (eq state 'first-and-last)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1336 (memq 'ok process-state))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1337 (when has-been-begin |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1338 ;; If there is a `result-file' here, that means that the |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1339 ;; file was unsuccessfully decoded, so we delete it. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1340 (when (and result-file |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1341 (file-exists-p result-file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1342 (not gnus-uu-be-dangerous) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1343 (or (eq gnus-uu-be-dangerous t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1344 (gnus-y-or-n-p |
65688
41260182da5b
2005-09-25 Romain Francoise <romain@orebokech.com>
Romain Francoise <romain@orebokech.com>
parents:
64780
diff
changeset
|
1345 (format "Delete unsuccessfully decoded file %s? " |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1346 result-file)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1347 (delete-file result-file))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1348 (when (memq 'begin process-state) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1349 (setq result-file (car process-state))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1350 (setq has-been-begin t)) |
17493 | 1351 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1352 ;; Check whether we have decoded one complete file. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1353 (when (memq 'end process-state) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1354 (setq article-series nil) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1355 (setq has-been-begin nil) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1356 (if (stringp result-file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1357 (setq files (list result-file)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1358 (setq files result-file)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1359 (setq result-file (car files)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1360 (while files |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1361 (push (list (cons 'name (pop files)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1362 (cons 'article article)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1363 result-files)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1364 ;; Allow user-defined functions to be run on this file. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1365 (when gnus-uu-grabbed-file-functions |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1366 (let ((funcs gnus-uu-grabbed-file-functions)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1367 (unless (listp funcs) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1368 (setq funcs (list funcs))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1369 (while funcs |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1370 (funcall (pop funcs) result-file)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1371 (setq result-file nil) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1372 ;; Check whether we have decoded enough articles. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1373 (and limit (= (length result-files) limit) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1374 (setq articles nil))) |
17493 | 1375 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1376 ;; If this is the last article to be decoded, and |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1377 ;; we still haven't reached the end, then we delete |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1378 ;; the partially decoded file. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1379 (and (or (eq state 'last) (eq state 'first-and-last)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1380 (not (memq 'end process-state)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1381 result-file |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1382 (file-exists-p result-file) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1383 (not gnus-uu-be-dangerous) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1384 (or (eq gnus-uu-be-dangerous t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1385 (gnus-y-or-n-p |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1386 (format "Delete incomplete file %s? " result-file))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1387 (delete-file result-file)) |
17493 | 1388 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1389 ;; If this was a file of the wrong sort, then |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1390 (when (and (or (memq 'wrong-type process-state) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1391 (memq 'error process-state)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1392 gnus-uu-unmark-articles-not-decoded) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1393 (gnus-summary-tick-article article t)) |
17493 | 1394 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1395 ;; Set the new series state. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1396 (if (and (not has-been-begin) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1397 (not sloppy) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1398 (or (memq 'end process-state) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1399 (memq 'middle process-state))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1400 (progn |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1401 (setq process-state (list 'error)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1402 (gnus-message 2 "No begin part at the beginning") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1403 (sleep-for 2)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1404 (setq state 'middle)))) |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
1405 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1406 ;; When there are no result-files, then something must be wrong. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1407 (if result-files |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1408 (message "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1409 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1410 ((not has-been-begin) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1411 (gnus-message 2 "Wrong type file")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1412 ((memq 'error process-state) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1413 (gnus-message 2 "An error occurred during decoding")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1414 ((not (or (memq 'ok process-state) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1415 (memq 'end process-state))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1416 (gnus-message 2 "End of articles reached before end of file"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1417 ;; Make unsuccessfully decoded articles unread. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1418 (when gnus-uu-unmark-articles-not-decoded |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1419 (while article-series |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1420 (gnus-summary-tick-article (pop article-series) t)))) |
17493 | 1421 |
35957
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
1422 ;; The original article buffer is hosed, shoot it down. |
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
1423 (gnus-kill-buffer gnus-original-article-buffer) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1424 (setq gnus-current-article nil) |
17493 | 1425 result-files)) |
1426 | |
1427 (defun gnus-uu-grab-view (file) | |
1428 "View FILE using the gnus-uu methods." | |
1429 (let ((action (gnus-uu-get-action file))) | |
1430 (gnus-execute-command | |
1431 (if (string-match "%" action) | |
1432 (format action file) | |
1433 (concat action " " file)) | |
1434 (eq gnus-view-pseudos 'not-confirm)))) | |
1435 | |
1436 (defun gnus-uu-grab-move (file) | |
1437 "Move FILE to somewhere." | |
1438 (when gnus-uu-default-dir | |
1439 (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) | |
1440 (file-name-nondirectory file)))) | |
1441 (rename-file file to-file) | |
1442 (unless (file-exists-p file) | |
1443 (make-symbolic-link to-file file))))) | |
1444 | |
1445 (defun gnus-uu-part-number (article) | |
1446 (let* ((header (gnus-summary-article-header article)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1447 (subject (and header (mail-header-subject header))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1448 (part nil)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1449 (if subject |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1450 (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+" |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1451 subject) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1452 (setq part (match-string 0 subject)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1453 (setq subject (substring subject (match-end 0))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1454 (or part |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1455 (while (string-match "[0-9]+[^0-9]+[0-9]+" subject) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1456 (setq part (match-string 0 subject)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1457 (setq subject (substring subject (match-end 0))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1458 (or part ""))) |
17493 | 1459 |
1460 (defun gnus-uu-uudecode-sentinel (process event) | |
1461 (delete-process (get-process process))) | |
1462 | |
1463 (defun gnus-uu-uustrip-article (process-buffer in-state) | |
1464 ;; Uudecodes a file asynchronously. | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1465 (with-current-buffer process-buffer |
17493 | 1466 (let ((state (list 'wrong-type)) |
1467 process-connection-type case-fold-search buffer-read-only | |
1468 files start-char) | |
1469 (goto-char (point-min)) | |
1470 | |
1471 ;; Deal with ^M at the end of the lines. | |
1472 (when gnus-uu-kill-carriage-return | |
1473 (save-excursion | |
1474 (while (search-forward "\r" nil t) | |
108765
d835100c3e8b
Replace Lisp calls to delete-backward-char by delete-char.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
1475 (delete-char -1)))) |
17493 | 1476 |
1477 (while (or (re-search-forward gnus-uu-begin-string nil t) | |
1478 (re-search-forward gnus-uu-body-line nil t)) | |
1479 (setq state (list 'ok)) | |
1480 ;; Ok, we are at the first uucoded line. | |
1481 (beginning-of-line) | |
1482 (setq start-char (point)) | |
1483 | |
1484 (if (not (looking-at gnus-uu-begin-string)) | |
1485 (setq state (list 'middle)) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
1486 ;; This is the beginning of a uuencoded article. |
17493 | 1487 ;; We replace certain characters that could make things messy. |
1488 (setq gnus-uu-file-name | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1489 (gnus-map-function |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64712
diff
changeset
|
1490 mm-file-name-rewrite-functions |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1491 (file-name-nondirectory (match-string 1)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1492 (replace-match (concat "begin 644 " gnus-uu-file-name) t t) |
17493 | 1493 |
1494 ;; Remove any non gnus-uu-body-line right after start. | |
1495 (forward-line 1) | |
1496 (while (and (not (eobp)) | |
1497 (not (looking-at gnus-uu-body-line))) | |
1498 (gnus-delete-line)) | |
1499 | |
1500 ;; If a process is running, we kill it. | |
1501 (when (and gnus-uu-uudecode-process | |
1502 (memq (process-status gnus-uu-uudecode-process) | |
1503 '(run stop))) | |
1504 (delete-process gnus-uu-uudecode-process) | |
1505 (gnus-uu-unmark-list-of-grabbed t)) | |
1506 | |
1507 ;; Start a new uudecoding process. | |
1508 (let ((cdir default-directory)) | |
1509 (unwind-protect | |
1510 (progn | |
1511 (cd gnus-uu-work-dir) | |
1512 (setq gnus-uu-uudecode-process | |
1513 (start-process | |
1514 "*uudecode*" | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1515 (gnus-get-buffer-create gnus-uu-output-buffer-name) |
17493 | 1516 shell-file-name shell-command-switch |
1517 (format "cd %s %s uudecode" gnus-uu-work-dir | |
1518 gnus-shell-command-separator)))) | |
1519 (cd cdir))) | |
1520 (set-process-sentinel | |
1521 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) | |
1522 (setq state (list 'begin)) | |
1523 (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) | |
1524 | |
1525 ;; We look for the end of the thing to be decoded. | |
1526 (if (re-search-forward gnus-uu-end-string nil t) | |
1527 (push 'end state) | |
1528 (goto-char (point-max)) | |
1529 (re-search-backward gnus-uu-body-line nil t)) | |
1530 | |
1531 (forward-line 1) | |
1532 | |
1533 (when gnus-uu-uudecode-process | |
1534 (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) | |
1535 ;; Try to correct mishandled uucode. | |
1536 (when gnus-uu-correct-stripped-uucode | |
1537 (gnus-uu-check-correct-stripped-uucode start-char (point))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1538 (gnus-run-hooks 'gnus-uu-pre-uudecode-hook) |
17493 | 1539 |
1540 ;; Send the text to the process. | |
1541 (condition-case nil | |
1542 (process-send-region | |
1543 gnus-uu-uudecode-process start-char (point)) | |
1544 (error | |
1545 (progn | |
1546 (delete-process gnus-uu-uudecode-process) | |
1547 (gnus-message 2 "gnus-uu: Couldn't uudecode") | |
1548 (setq state (list 'wrong-type))))) | |
1549 | |
1550 (if (memq 'end state) | |
1551 (progn | |
1552 ;; Send an EOF, just in case. | |
1553 (ignore-errors | |
1554 (process-send-eof gnus-uu-uudecode-process)) | |
1555 (while (memq (process-status gnus-uu-uudecode-process) | |
1556 '(open run)) | |
1557 (accept-process-output gnus-uu-uudecode-process 1))) | |
1558 (when (or (not gnus-uu-uudecode-process) | |
1559 (not (memq (process-status gnus-uu-uudecode-process) | |
1560 '(run stop)))) | |
1561 (setq state (list 'wrong-type))))))) | |
1562 | |
1563 (if (memq 'begin state) | |
1564 (cons (if (= (length files) 1) (car files) files) state) | |
1565 state)))) | |
1566 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1567 (defvar gnus-uu-unshar-warning |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1568 "*** WARNING *** |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1569 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1570 Shell archives are an archaic method of bundling files for distribution |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1571 across computer networks. During the unpacking process, arbitrary commands |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1572 are executed on your system, and all kinds of nasty things can happen. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1573 Please examine the archive very carefully before you instruct Emacs to |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1574 unpack it. You can browse the archive buffer using \\[scroll-other-window]. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1575 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1576 If you are unsure what to do, please answer \"no\"." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1577 "Text of warning message displayed by `gnus-uu-unshar-article'. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1578 Make sure that this text consists only of few text lines. Otherwise, |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1579 Gnus might fail to display all of it.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1580 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1581 |
17493 | 1582 ;; This function is used by `gnus-uu-grab-articles' to treat |
1583 ;; a shared article. | |
1584 (defun gnus-uu-unshar-article (process-buffer in-state) | |
1585 (let ((state (list 'ok)) | |
1586 start-char) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1587 (with-current-buffer process-buffer |
17493 | 1588 (goto-char (point-min)) |
1589 (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) | |
1590 (setq state (list 'wrong-type)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1591 (save-window-excursion |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1592 (save-excursion |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1593 (switch-to-buffer (current-buffer)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1594 (delete-other-windows) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1595 (let ((buffer (get-buffer-create (generate-new-buffer-name |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1596 "*Warning*")))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1597 (unless |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1598 (unwind-protect |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1599 (with-current-buffer buffer |
35957
a35d9c07d074
2001-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33765
diff
changeset
|
1600 (insert (substitute-command-keys |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1601 gnus-uu-unshar-warning)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1602 (goto-char (point-min)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1603 (display-buffer buffer) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1604 (yes-or-no-p "This is a shell archive, unshar it? ")) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1605 (kill-buffer buffer)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1606 (setq state (list 'error)))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1607 (unless (memq 'error state) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1608 (beginning-of-line) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1609 (setq start-char (point)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1610 (call-process-region |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1611 start-char (point-max) shell-file-name nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1612 (gnus-get-buffer-create gnus-uu-output-buffer-name) nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1613 shell-command-switch |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1614 (concat "cd " gnus-uu-work-dir " " |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1615 gnus-shell-command-separator " sh"))))) |
17493 | 1616 state)) |
1617 | |
1618 ;; Returns the name of what the shar file is going to unpack. | |
1619 (defun gnus-uu-find-name-in-shar () | |
1620 (let ((oldpoint (point)) | |
1621 res) | |
1622 (goto-char (point-min)) | |
1623 (when (re-search-forward gnus-uu-shar-name-marker nil t) | |
1624 (setq res (buffer-substring (match-beginning 1) (match-end 1)))) | |
1625 (goto-char oldpoint) | |
1626 res)) | |
1627 | |
1628 ;; `gnus-uu-choose-action' chooses what action to perform given the name | |
1629 ;; and `gnus-uu-file-action-list'. Returns either nil if no action is | |
1630 ;; found, or the name of the command to run if such a rule is found. | |
1631 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) | |
1632 (let ((action-list (copy-sequence file-action-list)) | |
1633 (case-fold-search t) | |
1634 rule action) | |
1635 (and | |
1636 (unless no-ignore | |
1637 (and (not | |
1638 (and gnus-uu-ignore-files-by-name | |
1639 (string-match gnus-uu-ignore-files-by-name file-name))) | |
1640 (not | |
1641 (and gnus-uu-ignore-files-by-type | |
1642 (string-match gnus-uu-ignore-files-by-type | |
1643 (or (gnus-uu-choose-action | |
1644 file-name gnus-uu-ext-to-mime-list t) | |
1645 "")))))) | |
1646 (while (not (or (eq action-list ()) action)) | |
1647 (setq rule (car action-list)) | |
1648 (setq action-list (cdr action-list)) | |
1649 (when (string-match (car rule) file-name) | |
1650 (setq action (cadr rule))))) | |
1651 action)) | |
1652 | |
1653 (defun gnus-uu-treat-archive (file-path) | |
1654 ;; Unpacks an archive. Returns t if unpacking is successful. | |
1655 (let ((did-unpack t) | |
1656 action command dir) | |
1657 (setq action (gnus-uu-choose-action | |
1658 file-path (append gnus-uu-user-archive-rules | |
1659 (if gnus-uu-ignore-default-archive-rules | |
1660 nil | |
1661 gnus-uu-default-archive-rules)))) | |
1662 | |
1663 (when (not action) | |
1664 (error "No unpackers for the file %s" file-path)) | |
1665 | |
1666 (string-match "/[^/]*$" file-path) | |
1667 (setq dir (substring file-path 0 (match-beginning 0))) | |
1668 | |
1669 (when (member action gnus-uu-destructive-archivers) | |
1670 (copy-file file-path (concat file-path "~") t)) | |
1671 | |
1672 (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) | |
1673 | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
1674 (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) |
17493 | 1675 (erase-buffer)) |
1676 | |
1677 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) | |
1678 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1679 (if (eq 0 (call-process shell-file-name nil |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
1680 (gnus-get-buffer-create gnus-uu-output-buffer-name) |
17493 | 1681 nil shell-command-switch command)) |
1682 (message "") | |
1683 (gnus-message 2 "Error during unpacking of archive") | |
1684 (setq did-unpack nil)) | |
1685 | |
1686 (when (member action gnus-uu-destructive-archivers) | |
1687 (rename-file (concat file-path "~") file-path t)) | |
1688 | |
1689 did-unpack)) | |
1690 | |
1691 (defun gnus-uu-dir-files (dir) | |
1692 (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) | |
1693 files file) | |
1694 (while dirs | |
1695 (if (file-directory-p (setq file (car dirs))) | |
1696 (setq files (append files (gnus-uu-dir-files file))) | |
1697 (push file files)) | |
1698 (setq dirs (cdr dirs))) | |
1699 files)) | |
1700 | |
1701 (defun gnus-uu-unpack-files (files &optional ignore) | |
1702 ;; Go through FILES and look for files to unpack. | |
1703 (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) | |
1704 (ofiles files) | |
1705 file did-unpack) | |
1706 (while files | |
1707 (setq file (cdr (assq 'name (car files)))) | |
1708 (when (and (not (member file ignore)) | |
1709 (equal (gnus-uu-get-action (file-name-nondirectory file)) | |
1710 "gnus-uu-archive")) | |
1711 (push file did-unpack) | |
1712 (unless (gnus-uu-treat-archive file) | |
1713 (gnus-message 2 "Error during unpacking of %s" file)) | |
1714 (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) | |
1715 (nfiles newfiles)) | |
1716 (while nfiles | |
1717 (unless (member (car nfiles) totfiles) | |
1718 (push (list (cons 'name (car nfiles)) | |
1719 (cons 'original file)) | |
1720 ofiles)) | |
1721 (setq nfiles (cdr nfiles))) | |
1722 (setq totfiles newfiles))) | |
1723 (setq files (cdr files))) | |
1724 (if did-unpack | |
1725 (gnus-uu-unpack-files ofiles (append did-unpack ignore)) | |
1726 ofiles))) | |
1727 | |
1728 (defun gnus-uu-ls-r (dir) | |
1729 (let* ((files (gnus-uu-directory-files dir t)) | |
1730 (ofiles files)) | |
1731 (while files | |
1732 (when (file-directory-p (car files)) | |
1733 (setq ofiles (delete (car files) ofiles)) | |
1734 (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) | |
1735 (setq files (cdr files))) | |
1736 ofiles)) | |
1737 | |
1738 ;; Various stuff | |
1739 | |
1740 (defun gnus-uu-directory-files (dir &optional full) | |
1741 (let (files out file) | |
1742 (setq files (directory-files dir full)) | |
1743 (while files | |
1744 (setq file (car files)) | |
1745 (setq files (cdr files)) | |
1746 (unless (member (file-name-nondirectory file) '("." "..")) | |
1747 (push file out))) | |
1748 (setq out (nreverse out)) | |
1749 out)) | |
1750 | |
1751 (defun gnus-uu-check-correct-stripped-uucode (start end) | |
1752 (save-excursion | |
1753 (let (found beg length) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1754 (unless gnus-uu-correct-stripped-uucode |
17493 | 1755 (goto-char start) |
1756 | |
1757 (if (re-search-forward " \\|`" end t) | |
1758 (progn | |
1759 (goto-char start) | |
1760 (while (not (eobp)) | |
1761 (progn | |
1762 (when (looking-at "\n") | |
1763 (replace-match "")) | |
1764 (forward-line 1)))) | |
1765 | |
1766 (while (not (eobp)) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1767 (unless (looking-at (concat gnus-uu-begin-string "\\|" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1768 gnus-uu-end-string)) |
17493 | 1769 (when (not found) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1770 (setq length (- (point-at-eol) (point-at-bol)))) |
17493 | 1771 (setq found t) |
1772 (beginning-of-line) | |
1773 (setq beg (point)) | |
1774 (end-of-line) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1775 (unless (= length (- (point) beg)) |
17493 | 1776 (insert (make-string (- length (- (point) beg)) ? )))) |
1777 (forward-line 1))))))) | |
1778 | |
1779 (defvar gnus-uu-tmp-alist nil) | |
1780 | |
1781 (defun gnus-uu-initialize (&optional scan) | |
1782 (let (entry) | |
1783 (if (and (not scan) | |
1784 (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) | |
1785 (if (file-exists-p (cdr entry)) | |
1786 (setq gnus-uu-work-dir (cdr entry)) | |
1787 (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) | |
1788 nil))) | |
1789 t | |
1790 (setq gnus-uu-tmp-dir (file-name-as-directory | |
1791 (expand-file-name gnus-uu-tmp-dir))) | |
1792 (if (not (file-directory-p gnus-uu-tmp-dir)) | |
1793 (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) | |
1794 (when (not (file-writable-p gnus-uu-tmp-dir)) | |
1795 (error "Temp directory %s can't be written to" | |
1796 gnus-uu-tmp-dir))) | |
1797 | |
1798 (setq gnus-uu-work-dir | |
44075
7782e54757bb
* mail-source.el (make-source-make-complex-temp-name): Use
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38413
diff
changeset
|
1799 (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1800 (gnus-set-file-modes gnus-uu-work-dir 448) |
17493 | 1801 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) |
1802 (push (cons gnus-newsgroup-name gnus-uu-work-dir) | |
1803 gnus-uu-tmp-alist)))) | |
1804 | |
1805 | |
1806 ;; Kills the temporary uu buffers, kills any processes, etc. | |
1807 (defun gnus-uu-clean-up () | |
1808 (let (buf) | |
1809 (and gnus-uu-uudecode-process | |
1810 (memq (process-status (or gnus-uu-uudecode-process "nevair")) | |
1811 '(stop run)) | |
1812 (delete-process gnus-uu-uudecode-process)) | |
1813 (when (setq buf (get-buffer gnus-uu-output-buffer-name)) | |
1814 (kill-buffer buf)))) | |
1815 | |
1816 ;; Inputs an action and a filename and returns a full command, making sure | |
1817 ;; that the filename will be treated as a single argument when the shell | |
1818 ;; executes the command. | |
1819 (defun gnus-uu-command (action file) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1820 (let ((quoted-file (shell-quote-argument file))) |
17493 | 1821 (if (string-match "%s" action) |
1822 (format action quoted-file) | |
1823 (concat action " " quoted-file)))) | |
1824 | |
1825 (defun gnus-uu-delete-work-dir (&optional dir) | |
1826 "Delete recursively all files and directories under `gnus-uu-work-dir'." | |
1827 (if dir | |
1828 (gnus-message 7 "Deleting directory %s..." dir) | |
1829 (setq dir gnus-uu-work-dir)) | |
1830 (when (and dir | |
1831 (file-exists-p dir)) | |
1832 (let ((files (directory-files dir t nil t)) | |
1833 file) | |
1834 (while (setq file (pop files)) | |
1835 (unless (member (file-name-nondirectory file) '("." "..")) | |
1836 (if (file-directory-p file) | |
1837 (gnus-uu-delete-work-dir file) | |
1838 (gnus-message 9 "Deleting file %s..." file) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1839 (condition-case err |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1840 (delete-file file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1841 (error (gnus-message 3 "Deleting file %s failed... %s" file err)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1842 (condition-case err |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1843 (delete-directory dir) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1844 (error (gnus-message 3 "Deleting directory %s failed... %s" file err)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1845 (gnus-message 7 ""))) |
17493 | 1846 |
1847 ;; Initializing | |
1848 | |
1849 (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) | |
1850 (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) | |
1851 | |
1852 | |
1853 | |
1854 ;;; | |
1855 ;;; uuencoded posting | |
1856 ;;; | |
1857 | |
1858 ;; Any function that is to be used as and encoding method will take two | |
1859 ;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" | |
1860 ;; and "spiral.jpg", respectively.) The function should return nil if | |
1861 ;; the encoding wasn't successful. | |
1862 (defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode | |
1863 "Function used for encoding binary files. | |
1864 There are three functions supplied with gnus-uu for encoding files: | |
1865 `gnus-uu-post-encode-uuencode', which does straight uuencoding; | |
1866 `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME | |
1867 headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with | |
1868 uuencode and adds MIME headers." | |
1869 :group 'gnus-extract-post | |
1870 :type '(radio (function-item gnus-uu-post-encode-uuencode) | |
1871 (function-item gnus-uu-post-encode-mime) | |
1872 (function-item gnus-uu-post-encode-mime-uuencode) | |
1873 (function :tag "Other"))) | |
1874 | |
1875 (defcustom gnus-uu-post-include-before-composing nil | |
1876 "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. | |
1877 If this variable is t, you can either include an encoded file with | |
1878 \\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." | |
1879 :group 'gnus-extract-post | |
1880 :type 'boolean) | |
1881 | |
1882 (defcustom gnus-uu-post-length 990 | |
1883 "Maximum length of an article. | |
1884 The encoded file will be split into how many articles it takes to | |
1885 post the entire file." | |
1886 :group 'gnus-extract-post | |
1887 :type 'integer) | |
1888 | |
1889 (defcustom gnus-uu-post-threaded nil | |
1890 "Non-nil means that gnus-uu will post the encoded file in a thread. | |
1891 This may not be smart, as no other decoder I have seen are able to | |
1892 follow threads when collecting uuencoded articles. (Well, I have seen | |
1893 one package that does that - gnus-uu, but somehow, I don't think that | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
1894 counts...) The default is nil." |
17493 | 1895 :group 'gnus-extract-post |
1896 :type 'boolean) | |
1897 | |
1898 (defcustom gnus-uu-post-separate-description t | |
1899 "Non-nil means that the description will be posted in a separate article. | |
1900 The first article will typically be numbered (0/x). If this variable | |
1901 is nil, the description the user enters will be included at the | |
1902 beginning of the first article, which will be numbered (1/x). Default | |
1903 is t." | |
1904 :group 'gnus-extract-post | |
1905 :type 'boolean) | |
1906 | |
1907 (defvar gnus-uu-post-binary-separator "--binary follows this line--") | |
1908 (defvar gnus-uu-post-message-id nil) | |
1909 (defvar gnus-uu-post-inserted-file-name nil) | |
1910 (defvar gnus-uu-winconf-post-news nil) | |
1911 | |
1912 (defun gnus-uu-post-news () | |
1913 "Compose an article and post an encoded file." | |
1914 (interactive) | |
1915 (setq gnus-uu-post-inserted-file-name nil) | |
1916 (setq gnus-uu-winconf-post-news (current-window-configuration)) | |
1917 | |
1918 (gnus-summary-post-news) | |
1919 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1920 (let ((map (make-sparse-keymap))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1921 (set-keymap-parent map (current-local-map)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
29734
diff
changeset
|
1922 (use-local-map map)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1923 ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) |
17493 | 1924 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) |
1925 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) | |
1926 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) | |
1927 | |
1928 (when gnus-uu-post-include-before-composing | |
1929 (save-excursion (setq gnus-uu-post-inserted-file-name | |
1930 (gnus-uu-post-insert-binary))))) | |
1931 | |
1932 (defun gnus-uu-post-insert-binary-in-article () | |
1933 "Inserts an encoded file in the buffer. | |
1934 The user will be asked for a file name." | |
1935 (interactive) | |
1936 (save-excursion | |
1937 (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) | |
1938 | |
1939 ;; Encodes with uuencode and substitutes all spaces with backticks. | |
1940 (defun gnus-uu-post-encode-uuencode (path file-name) | |
1941 (when (gnus-uu-post-encode-file "uuencode" path file-name) | |
1942 (goto-char (point-min)) | |
1943 (forward-line 1) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
1944 (while (search-forward " " nil t) |
17493 | 1945 (replace-match "`")) |
1946 t)) | |
1947 | |
1948 ;; Encodes with uuencode and adds MIME headers. | |
1949 (defun gnus-uu-post-encode-mime-uuencode (path file-name) | |
1950 (when (gnus-uu-post-encode-uuencode path file-name) | |
1951 (gnus-uu-post-make-mime file-name "x-uue") | |
1952 t)) | |
1953 | |
1954 ;; Encodes with base64 and adds MIME headers | |
1955 (defun gnus-uu-post-encode-mime (path file-name) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1956 (when (eq 0 (call-process shell-file-name nil t 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
|
1957 (format "%s %s -o %s" "mmencode" path file-name))) |
17493 | 1958 (gnus-uu-post-make-mime file-name "base64") |
1959 t)) | |
1960 | |
1961 ;; Adds MIME headers. | |
1962 (defun gnus-uu-post-make-mime (file-name encoding) | |
1963 (goto-char (point-min)) | |
1964 (insert (format "Content-Type: %s; name=\"%s\"\n" | |
1965 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) | |
1966 file-name)) | |
1967 (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) | |
1968 (save-restriction | |
1969 (set-buffer gnus-message-buffer) | |
1970 (goto-char (point-min)) | |
1971 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) | |
1972 (forward-line -1) | |
44514
8bfbcb957964
(gnus-uu-binhex-article, gnus-uu-reginize-string, gnus-uu-expand-numbers)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44075
diff
changeset
|
1973 (narrow-to-region (point-min) (point)) |
17493 | 1974 (unless (mail-fetch-field "mime-version") |
1975 (widen) | |
1976 (insert "MIME-Version: 1.0\n")) | |
1977 (widen))) | |
1978 | |
1979 ;; Encodes a file PATH with COMMAND, leaving the result in the | |
1980 ;; current buffer. | |
1981 (defun gnus-uu-post-encode-file (command path file-name) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1982 (eq 0 (call-process shell-file-name nil t 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
|
1983 (format "%s %s %s" command path file-name)))) |
17493 | 1984 |
1985 (defun gnus-uu-post-news-inews () | |
1986 "Posts the composed news article and encoded file. | |
1987 If no file has been included, the user will be asked for a file." | |
1988 (interactive) | |
1989 | |
1990 (let (file-name) | |
1991 | |
1992 (if gnus-uu-post-inserted-file-name | |
1993 (setq file-name gnus-uu-post-inserted-file-name) | |
1994 (setq file-name (gnus-uu-post-insert-binary))) | |
1995 | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
1996 (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) |
17493 | 1997 (setq gnus-uu-post-inserted-file-name nil) |
1998 (when gnus-uu-winconf-post-news | |
1999 (set-window-configuration gnus-uu-winconf-post-news))) | |
2000 | |
2001 ;; Asks for a file to encode, encodes it and inserts the result in | |
2002 ;; the current buffer. Returns the file name the user gave. | |
2003 (defun gnus-uu-post-insert-binary () | |
2004 (let ((uuencode-buffer-name "*uuencode buffer*") | |
2005 file-path uubuf file-name) | |
2006 | |
2007 (setq file-path (read-file-name | |
2008 "What file do you want to encode? ")) | |
2009 (when (not (file-exists-p file-path)) | |
2010 (error "%s: No such file" file-path)) | |
2011 | |
2012 (goto-char (point-max)) | |
2013 (insert (format "\n%s\n" gnus-uu-post-binary-separator)) | |
2014 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
2015 ;; #### Unix-specific? |
17493 | 2016 (when (string-match "^~/" file-path) |
2017 (setq file-path (concat "$HOME" (substring file-path 1)))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
2018 ;; #### Unix-specific? |
17493 | 2019 (if (string-match "/[^/]*$" file-path) |
2020 (setq file-name (substring file-path (1+ (match-beginning 0)))) | |
2021 (setq file-name file-path)) | |
2022 | |
2023 (unwind-protect | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
2024 (if (with-current-buffer |
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
2025 (setq uubuf (gnus-get-buffer-create uuencode-buffer-name)) |
17493 | 2026 (erase-buffer) |
2027 (funcall gnus-uu-post-encode-method file-path file-name)) | |
2028 (insert-buffer-substring uubuf) | |
2029 (error "Encoding unsuccessful")) | |
2030 (kill-buffer uubuf)) | |
2031 file-name)) | |
2032 | |
2033 ;; Posts the article and all of the encoded file. | |
2034 (defun gnus-uu-post-encoded (file-name &optional threaded) | |
2035 (let ((send-buffer-name "*uuencode send buffer*") | |
2036 (encoded-buffer-name "*encoded buffer*") | |
2037 (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") | |
2038 (separator (concat mail-header-separator "\n\n")) | |
2039 uubuf length parts header i end beg | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
2040 beg-line minlen post-buf whole-len beg-binary end-binary) |
17493 | 2041 |
2042 (setq post-buf (current-buffer)) | |
2043 | |
2044 (goto-char (point-min)) | |
2045 (when (not (re-search-forward | |
2046 (if gnus-uu-post-separate-description | |
2047 (concat "^" (regexp-quote gnus-uu-post-binary-separator) | |
2048 "$") | |
2049 (concat "^" (regexp-quote mail-header-separator) "$")) | |
2050 nil t)) | |
2051 (error "Internal error: No binary/header separator")) | |
2052 (beginning-of-line) | |
2053 (forward-line 1) | |
2054 (setq beg-binary (point)) | |
2055 (setq end-binary (point-max)) | |
2056 | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
2057 (with-current-buffer |
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
2058 (setq uubuf (gnus-get-buffer-create encoded-buffer-name)) |
17493 | 2059 (erase-buffer) |
2060 (insert-buffer-substring post-buf beg-binary end-binary) | |
2061 (goto-char (point-min)) | |
44514
8bfbcb957964
(gnus-uu-binhex-article, gnus-uu-reginize-string, gnus-uu-expand-numbers)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44075
diff
changeset
|
2062 (setq length (count-lines (point-min) (point-max))) |
17493 | 2063 (setq parts (/ length gnus-uu-post-length)) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2064 (unless (< (% length gnus-uu-post-length) 4) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2065 (incf parts))) |
17493 | 2066 |
2067 (when gnus-uu-post-separate-description | |
2068 (forward-line -1)) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2069 (delete-region (point) (point-max)) |
17493 | 2070 |
2071 (goto-char (point-min)) | |
2072 (re-search-forward | |
2073 (concat "^" (regexp-quote mail-header-separator) "$") nil t) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
2074 (setq header (buffer-substring (point-min) (point-at-bol))) |
17493 | 2075 |
2076 (goto-char (point-min)) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2077 (when gnus-uu-post-separate-description |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2078 (when (re-search-forward "^Subject: " nil t) |
17493 | 2079 (end-of-line) |
2080 (insert (format " (0/%d)" parts))) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2081 (save-excursion |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2082 (message-send)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2083 (setq gnus-uu-post-message-id (message-fetch-field "message-id"))) |
17493 | 2084 |
2085 (save-excursion | |
2086 (setq i 1) | |
2087 (setq beg 1) | |
2088 (while (not (> i parts)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
2089 (set-buffer (gnus-get-buffer-create send-buffer-name)) |
17493 | 2090 (erase-buffer) |
2091 (insert header) | |
2092 (when (and threaded gnus-uu-post-message-id) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2093 (insert "References: " gnus-uu-post-message-id "\n")) |
17493 | 2094 (insert separator) |
2095 (setq whole-len | |
2096 (- 62 (length (format top-string "" file-name i parts "")))) | |
2097 (when (> 1 (setq minlen (/ whole-len 2))) | |
2098 (setq minlen 1)) | |
2099 (setq | |
2100 beg-line | |
2101 (format top-string | |
2102 (make-string minlen ?-) | |
2103 file-name i parts | |
2104 (make-string | |
2105 (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) | |
2106 | |
2107 (goto-char (point-min)) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2108 (when (re-search-forward "^Subject: " nil t) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2109 (end-of-line) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2110 (insert (format " (%d/%d)" i parts))) |
17493 | 2111 |
2112 (goto-char (point-max)) | |
110410
f2e111723c3a
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
2113 (with-current-buffer uubuf |
17493 | 2114 (goto-char beg) |
2115 (if (= i parts) | |
2116 (goto-char (point-max)) | |
2117 (forward-line gnus-uu-post-length)) | |
2118 (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) | |
2119 (forward-line -4)) | |
2120 (setq end (point))) | |
2121 (insert-buffer-substring uubuf beg end) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2122 (insert beg-line "\n") |
17493 | 2123 (setq beg end) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2124 (incf i) |
17493 | 2125 (goto-char (point-min)) |
2126 (re-search-forward | |
2127 (concat "^" (regexp-quote mail-header-separator) "$") nil t) | |
2128 (beginning-of-line) | |
2129 (forward-line 2) | |
2130 (when (re-search-forward | |
2131 (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") | |
2132 nil t) | |
2133 (replace-match "") | |
2134 (forward-line 1)) | |
2135 (insert beg-line) | |
2136 (insert "\n") | |
2137 (let (message-sent-message-via) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2138 (save-excursion |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2139 (message-send)) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2140 (setq gnus-uu-post-message-id |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2141 (concat (message-fetch-field "references") " " |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2142 (message-fetch-field "message-id")))))) |
17493 | 2143 |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2144 (gnus-kill-buffer send-buffer-name) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19634
diff
changeset
|
2145 (gnus-kill-buffer encoded-buffer-name) |
17493 | 2146 |
2147 (when (not gnus-uu-post-separate-description) | |
2148 (set-buffer-modified-p nil) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
85008
diff
changeset
|
2149 (bury-buffer)))) |
17493 | 2150 |
2151 (provide 'gnus-uu) | |
2152 | |
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
36856
diff
changeset
|
2153 ;;; gnus-uu.el ends here |