Mercurial > emacs
annotate lisp/gnus/nneething.el @ 107429:024cba2776d2
(hide-sublevels): Don't hide trailing newline (and fix paren typo).
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 18 Mar 2010 23:32:47 -0400 |
parents | ecbe0edc4f69 |
children | 8d09094063d0 |
rev | line source |
---|---|
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
1 ;;; nneething.el --- arbitrary file access for Gnus |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
2 |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, |
106815 | 4 ;; 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:
19522
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
17493 | 8 ;; Keywords: news, mail |
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 | |
19522
681265352f07
Require cl only at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
29 (eval-when-compile (require 'cl)) |
681265352f07
Require cl only at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
30 |
107427
ecbe0edc4f69
Stop message.el from loading about 40 libraries it doesn't always need.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
31 (require 'mailcap) |
17493 | 32 (require 'nnheader) |
33 (require 'nnmail) | |
34 (require 'nnoo) | |
35 (require 'gnus-util) | |
36 | |
37 (nnoo-declare nneething) | |
38 | |
60696
7503b2a24a3c
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-187
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
39 (defvoo nneething-map-file-directory |
7503b2a24a3c
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-187
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
40 (nnheader-concat gnus-directory ".nneething/") |
17493 | 41 "Where nneething stores the map files.") |
42 | |
43 (defvoo nneething-map-file ".nneething" | |
44 "Name of the map files.") | |
45 | |
46 (defvoo nneething-exclude-files nil | |
47 "Regexp saying what files to exclude from the group. | |
48 If this variable is nil, no files will be excluded.") | |
49 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
50 (defvoo nneething-include-files nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
51 "Regexp saying what files to include in the group. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
52 If this variable is non-nil, only files matching this regexp will be |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
53 included.") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
54 |
17493 | 55 |
56 | |
57 ;;; Internal variables. | |
58 | |
59 (defconst nneething-version "nneething 1.0" | |
60 "nneething version.") | |
61 | |
62 (defvoo nneething-current-directory nil | |
63 "Current news group directory.") | |
64 | |
65 (defvoo nneething-status-string "") | |
66 | |
67 (defvoo nneething-work-buffer " *nneething work*") | |
68 | |
69 (defvoo nneething-group nil) | |
70 (defvoo nneething-map nil) | |
71 (defvoo nneething-read-only nil) | |
72 (defvoo nneething-active nil) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
73 (defvoo nneething-address nil) |
17493 | 74 |
75 | |
76 | |
77 ;;; Interface functions. | |
78 | |
79 (nnoo-define-basics nneething) | |
80 | |
81 (deffoo nneething-retrieve-headers (articles &optional group server fetch-old) | |
82 (nneething-possibly-change-directory group) | |
83 | |
84 (save-excursion | |
85 (set-buffer nntp-server-buffer) | |
86 (erase-buffer) | |
87 (let* ((number (length articles)) | |
88 (count 0) | |
89 (large (and (numberp nnmail-large-newsgroup) | |
90 (> number nnmail-large-newsgroup))) | |
91 article file) | |
92 | |
93 (if (stringp (car articles)) | |
94 'headers | |
95 | |
96 (while (setq article (pop articles)) | |
97 (setq file (nneething-file-name article)) | |
98 | |
99 (when (and (file-exists-p file) | |
100 (or (file-directory-p file) | |
101 (not (zerop (nnheader-file-size file))))) | |
102 (insert (format "221 %d Article retrieved.\n" article)) | |
103 (nneething-insert-head file) | |
104 (insert ".\n")) | |
105 | |
106 (incf count) | |
107 | |
108 (and large | |
109 (zerop (% count 20)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
110 (nnheader-message 5 "nneething: Receiving headers... %d%%" |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
111 (/ (* count 100) number)))) |
17493 | 112 |
113 (when large | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
114 (nnheader-message 5 "nneething: Receiving headers...done")) |
17493 | 115 |
116 (nnheader-fold-continuation-lines) | |
117 'headers)))) | |
118 | |
119 (deffoo nneething-request-article (id &optional group server buffer) | |
120 (nneething-possibly-change-directory group) | |
121 (let ((file (unless (stringp id) | |
122 (nneething-file-name id))) | |
123 (nntp-server-buffer (or buffer nntp-server-buffer))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
124 (and (stringp file) ; We did not request by Message-ID. |
17493 | 125 (file-exists-p file) ; The file exists. |
126 (not (file-directory-p file)) ; It's not a dir. | |
127 (save-excursion | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
128 (let ((nnmail-file-coding-system 'binary)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
129 (nnmail-find-file file)) ; Insert the file in the nntp buf. |
17493 | 130 (unless (nnheader-article-p) ; Either it's a real article... |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
131 (let ((type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
132 (unless (file-directory-p file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
133 (or (cdr (assoc (concat "." (file-name-extension file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
134 mailcap-mime-extensions)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
135 "text/plain"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
136 (charset |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
137 (mm-detect-mime-charset-region (point-min) (point-max))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
138 (encoding)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
139 (unless (string-match "\\`text/" type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
140 (base64-encode-region (point-min) (point-max)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
141 (setq encoding "base64")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
142 (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
|
143 (nneething-make-head file (current-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
144 nil type charset encoding)) |
17493 | 145 (insert "\n")) |
146 t)))) | |
147 | |
148 (deffoo nneething-request-group (group &optional server dont-check) | |
149 (nneething-possibly-change-directory group server) | |
150 (unless dont-check | |
151 (nneething-create-mapping) | |
152 (if (> (car nneething-active) (cdr nneething-active)) | |
153 (nnheader-insert "211 0 1 0 %s\n" group) | |
154 (nnheader-insert | |
155 "211 %d %d %d %s\n" | |
156 (- (1+ (cdr nneething-active)) (car nneething-active)) | |
157 (car nneething-active) (cdr nneething-active) | |
158 group))) | |
159 t) | |
160 | |
161 (deffoo nneething-request-list (&optional server dir) | |
162 (nnheader-report 'nneething "LIST is not implemented.")) | |
163 | |
164 (deffoo nneething-request-newgroups (date &optional server) | |
165 (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) | |
166 | |
167 (deffoo nneething-request-type (group &optional article) | |
168 'unknown) | |
169 | |
170 (deffoo nneething-close-group (group &optional server) | |
171 (setq nneething-current-directory nil) | |
172 t) | |
173 | |
174 (deffoo nneething-open-server (server &optional defs) | |
175 (nnheader-init-server-buffer) | |
176 (if (nneething-server-opened server) | |
177 t | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
178 (unless (assq 'nneething-address defs) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
179 (setq defs (append defs (list (list 'nneething-address server))))) |
17493 | 180 (nnoo-change-server 'nneething server defs))) |
181 | |
182 | |
183 ;;; Internal functions. | |
184 | |
185 (defun nneething-possibly-change-directory (group &optional server) | |
186 (when (and server | |
187 (not (nneething-server-opened server))) | |
188 (nneething-open-server server)) | |
189 (when (and group | |
190 (not (equal nneething-group group))) | |
191 (setq nneething-group group) | |
192 (setq nneething-map nil) | |
193 (setq nneething-active (cons 1 0)) | |
194 (nneething-create-mapping))) | |
195 | |
196 (defun nneething-map-file () | |
197 ;; We make sure that the .nneething directory exists. | |
198 (gnus-make-directory nneething-map-file-directory) | |
199 ;; We store it in a special directory under the user's home dir. | |
200 (concat (file-name-as-directory nneething-map-file-directory) | |
201 nneething-group nneething-map-file)) | |
202 | |
203 (defun nneething-create-mapping () | |
204 ;; Read nneething-active and nneething-map. | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
205 (when (file-exists-p nneething-address) |
17493 | 206 (let ((map-file (nneething-map-file)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19522
diff
changeset
|
207 (files (directory-files nneething-address)) |
17493 | 208 touched map-files) |
209 (when (file-exists-p map-file) | |
210 (ignore-errors | |
211 (load map-file nil t t))) | |
212 (unless nneething-active | |
213 (setq nneething-active (cons 1 0))) | |
214 ;; Old nneething had a different map format. | |
215 (when (and (cdar nneething-map) | |
216 (atom (cdar nneething-map))) | |
217 (setq nneething-map | |
218 (mapcar (lambda (n) | |
219 (list (cdr n) (car n) | |
220 (nth 5 (file-attributes | |
221 (nneething-file-name (car n)))))) | |
222 nneething-map))) | |
223 ;; Remove files matching the exclusion regexp. | |
224 (when nneething-exclude-files | |
225 (let ((f files) | |
226 prev) | |
227 (while f | |
228 (if (string-match nneething-exclude-files (car f)) | |
229 (if prev (setcdr prev (cdr f)) | |
230 (setq files (cdr files))) | |
231 (setq prev f)) | |
232 (setq f (cdr f))))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
233 ;; Remove files not matching the inclusion regexp. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
234 (when nneething-include-files |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
235 (let ((f files) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
236 prev) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
237 (while f |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
238 (if (not (string-match nneething-include-files (car f))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
239 (if prev (setcdr prev (cdr f)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
240 (setq files (cdr files))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
241 (setq prev f)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
242 (setq f (cdr f))))) |
17493 | 243 ;; Remove deleted files from the map. |
244 (let ((map nneething-map) | |
245 prev) | |
246 (while map | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
247 (if (and (member (cadr (car map)) files) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
248 ;; We also remove files that have changed mod times. |
17493 | 249 (equal (nth 5 (file-attributes |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
250 (nneething-file-name (cadr (car map))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
251 (cadr (cdar map)))) |
17493 | 252 (progn |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
253 (push (cadr (car map)) map-files) |
17493 | 254 (setq prev map)) |
255 (setq touched t) | |
256 (if prev | |
257 (setcdr prev (cdr map)) | |
258 (setq nneething-map (cdr nneething-map)))) | |
259 (setq map (cdr map)))) | |
260 ;; Find all new files and enter them into the map. | |
261 (while files | |
262 (unless (member (car files) map-files) | |
263 ;; This file is not in the map, so we enter it. | |
264 (setq touched t) | |
265 (setcdr nneething-active (1+ (cdr nneething-active))) | |
266 (push (list (cdr nneething-active) (car files) | |
267 (nth 5 (file-attributes | |
268 (nneething-file-name (car files))))) | |
269 nneething-map)) | |
270 (setq files (cdr files))) | |
271 (when (and touched | |
272 (not nneething-read-only)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
273 (with-temp-file map-file |
17493 | 274 (insert "(setq nneething-map '") |
275 (gnus-prin1 nneething-map) | |
276 (insert ")\n(setq nneething-active '") | |
277 (gnus-prin1 nneething-active) | |
278 (insert ")\n")))))) | |
279 | |
280 (defun nneething-insert-head (file) | |
281 "Insert the head of FILE." | |
282 (when (nneething-get-head file) | |
283 (insert-buffer-substring nneething-work-buffer) | |
284 (goto-char (point-max)))) | |
285 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
286 (defun nneething-encode-file-name (file &optional coding-system) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
287 "Encode the name of the FILE in CODING-SYSTEM." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
288 (let ((pos 0) buf) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
289 (setq file (mm-encode-coding-string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
290 file (or coding-system nnmail-pathname-coding-system))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
291 (while (string-match "[^-0-9a-zA-Z_:/.]" file pos) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
292 (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
293 (cons (substring file pos (match-beginning 0)) buf)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
294 pos (match-end 0))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
295 (apply (function concat) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
296 (nreverse (cons (substring file pos) buf))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
297 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
298 (defun nneething-decode-file-name (file &optional coding-system) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
299 "Decode the name of the FILE is encoded in CODING-SYSTEM." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
300 (let ((pos 0) buf) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
301 (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
302 (setq buf (cons (string (string-to-number (match-string 1 file) 16)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
303 (cons (substring file pos (match-beginning 0)) buf)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
304 pos (match-end 0))) |
74347 | 305 (mm-decode-coding-string |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
306 (apply (function concat) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
307 (nreverse (cons (substring file pos) buf))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
308 (or coding-system nnmail-pathname-coding-system)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
309 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
310 (defun nneething-get-file-name (id) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
311 "Extract the file name from the message ID string." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
312 (when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
313 (nneething-decode-file-name (match-string 1 id)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
314 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
315 (defun nneething-make-head (file &optional buffer extra-msg |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
316 mime-type mime-charset mime-encoding) |
17493 | 317 "Create a head by looking at the file attributes of FILE." |
318 (let ((atts (file-attributes file))) | |
319 (insert | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
320 "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
321 "Message-ID: <nneething-" (nneething-encode-file-name file) |
17493 | 322 "@" (system-name) ">\n" |
323 (if (equal '(0 0) (nth 5 atts)) "" | |
324 (concat "Date: " (current-time-string (nth 5 atts)) "\n")) | |
325 (or (when buffer | |
326 (save-excursion | |
327 (set-buffer buffer) | |
328 (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) | |
329 (concat "From: " (match-string 0) "\n")))) | |
330 (nneething-from-line (nth 2 atts) file)) | |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
60696
diff
changeset
|
331 (if (> (string-to-number (int-to-string (nth 7 atts))) 0) |
17493 | 332 (concat "Chars: " (int-to-string (nth 7 atts)) "\n") |
333 "") | |
334 (if buffer | |
335 (save-excursion | |
336 (set-buffer buffer) | |
337 (concat "Lines: " (int-to-string | |
338 (count-lines (point-min) (point-max))) | |
339 "\n")) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
340 "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
341 (if mime-type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
342 (concat "Content-Type: " mime-type |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
343 (if mime-charset |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
344 (concat "; charset=" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
345 (if (stringp mime-charset) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
346 mime-charset |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
347 (symbol-name mime-charset))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
348 "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
349 (if mime-encoding |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
350 (concat "\nContent-Transfer-Encoding: " mime-encoding) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
351 "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
352 "\nMIME-Version: 1.0\n") |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
353 "")))) |
17493 | 354 |
355 (defun nneething-from-line (uid &optional file) | |
356 "Return a From header based of UID." | |
357 (let* ((login (condition-case nil | |
358 (user-login-name uid) | |
359 (error | |
360 (cond ((= uid (user-uid)) (user-login-name)) | |
361 ((zerop uid) "root") | |
362 (t (int-to-string uid)))))) | |
363 (name (condition-case nil | |
364 (user-full-name uid) | |
365 (error | |
366 (cond ((= uid (user-uid)) (user-full-name)) | |
367 ((zerop uid) "Ms. Root"))))) | |
368 (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) | |
369 (prog1 | |
370 (substring file | |
371 (match-beginning 1) | |
372 (match-end 1)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
373 (when (string-match |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
374 "/\\(users\\|home\\)/\\([^/]+\\)/" file) |
17493 | 375 (setq login (substring file |
376 (match-beginning 2) | |
377 (match-end 2)) | |
378 name nil))) | |
379 (system-name)))) | |
380 (concat "From: " login "@" host | |
381 (if name (concat " (" name ")") "") "\n"))) | |
382 | |
383 (defun nneething-get-head (file) | |
384 "Either find the head in FILE or make a head for FILE." | |
385 (save-excursion | |
386 (set-buffer (get-buffer-create nneething-work-buffer)) | |
387 (setq case-fold-search nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
388 (buffer-disable-undo) |
17493 | 389 (erase-buffer) |
390 (cond | |
391 ((not (file-exists-p file)) | |
392 ;; The file do not exist. | |
393 nil) | |
394 ((or (file-directory-p file) | |
395 (file-symlink-p file)) | |
396 ;; It's a dir, so we fudge a head. | |
397 (nneething-make-head file) t) | |
398 (t | |
399 ;; We examine the file. | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
400 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
401 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
402 (nnheader-insert-head file) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
403 (if (nnheader-article-p) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
404 (delete-region |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
405 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
406 (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
|
407 (or (and (search-forward "\n\n" nil t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
408 (1- (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
409 (point-max))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
410 (point-max)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
411 (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
|
412 (nneething-make-head file (current-buffer)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
413 (delete-region (point) (point-max)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
414 (file-error |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
415 (nneething-make-head file (current-buffer) " (unreadable)"))) |
17493 | 416 t)))) |
417 | |
418 (defun nneething-file-name (article) | |
419 "Return the file name of ARTICLE." | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
420 (let ((dir (file-name-as-directory nneething-address)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
421 fname) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
422 (if (numberp article) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
423 (if (setq fname (cadr (assq article nneething-map))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
424 (expand-file-name fname dir) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
425 (make-temp-name (expand-file-name "nneething" dir))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
426 (expand-file-name article dir)))) |
17493 | 427 |
428 (provide 'nneething) | |
429 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
430 ;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5 |
17493 | 431 ;;; nneething.el ends here |