1 |
;;; nneething.el --- arbitrary file access for Gnus |
;;; nneething.el --- arbitrary file access for Gnus |
2 |
|
|
3 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
7 |
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
8 |
;; Keywords: news, mail |
;; Keywords: news, mail |
9 |
|
|
10 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
64 |
|
|
65 |
(defvoo nneething-status-string "") |
(defvoo nneething-status-string "") |
66 |
|
|
|
(defvoo nneething-message-id-number 0) |
|
67 |
(defvoo nneething-work-buffer " *nneething work*") |
(defvoo nneething-work-buffer " *nneething work*") |
68 |
|
|
69 |
(defvoo nneething-group nil) |
(defvoo nneething-group nil) |
121 |
(let ((file (unless (stringp id) |
(let ((file (unless (stringp id) |
122 |
(nneething-file-name id))) |
(nneething-file-name id))) |
123 |
(nntp-server-buffer (or buffer nntp-server-buffer))) |
(nntp-server-buffer (or buffer nntp-server-buffer))) |
124 |
(and (stringp file) ; We did not request by Message-ID. |
(and (stringp file) ; We did not request by Message-ID. |
125 |
(file-exists-p file) ; The file exists. |
(file-exists-p file) ; The file exists. |
126 |
(not (file-directory-p file)) ; It's not a dir. |
(not (file-directory-p file)) ; It's not a dir. |
127 |
(save-excursion |
(save-excursion |
128 |
(nnmail-find-file file) ; Insert the file in the nntp buf. |
(let ((nnmail-file-coding-system 'binary)) |
129 |
|
(nnmail-find-file file)) ; Insert the file in the nntp buf. |
130 |
(unless (nnheader-article-p) ; Either it's a real article... |
(unless (nnheader-article-p) ; Either it's a real article... |
131 |
(goto-char (point-min)) |
(let ((type |
132 |
(nneething-make-head |
(unless (file-directory-p file) |
133 |
file (current-buffer)) ; ... or we fake some headers. |
(or (cdr (assoc (concat "." (file-name-extension file)) |
134 |
|
mailcap-mime-extensions)) |
135 |
|
"text/plain"))) |
136 |
|
(charset |
137 |
|
(mm-detect-mime-charset-region (point-min) (point-max))) |
138 |
|
(encoding)) |
139 |
|
(unless (string-match "\\`text/" type) |
140 |
|
(base64-encode-region (point-min) (point-max)) |
141 |
|
(setq encoding "base64")) |
142 |
|
(goto-char (point-min)) |
143 |
|
(nneething-make-head file (current-buffer) |
144 |
|
nil type charset encoding)) |
145 |
(insert "\n")) |
(insert "\n")) |
146 |
t)))) |
t)))) |
147 |
|
|
245 |
prev) |
prev) |
246 |
(while map |
(while map |
247 |
(if (and (member (cadr (car map)) files) |
(if (and (member (cadr (car map)) files) |
248 |
;; We also remove files that have changed mod times. |
;; We also remove files that have changed mod times. |
249 |
(equal (nth 5 (file-attributes |
(equal (nth 5 (file-attributes |
250 |
(nneething-file-name (cadr (car map))))) |
(nneething-file-name (cadr (car map))))) |
251 |
(cadr (cdar map)))) |
(cadr (cdar map)))) |
283 |
(insert-buffer-substring nneething-work-buffer) |
(insert-buffer-substring nneething-work-buffer) |
284 |
(goto-char (point-max)))) |
(goto-char (point-max)))) |
285 |
|
|
286 |
(defun nneething-make-head (file &optional buffer) |
(defun nneething-encode-file-name (file &optional coding-system) |
287 |
|
"Encode the name of the FILE in CODING-SYSTEM." |
288 |
|
(let ((pos 0) buf) |
289 |
|
(setq file (mm-encode-coding-string |
290 |
|
file (or coding-system nnmail-pathname-coding-system))) |
291 |
|
(while (string-match "[^-0-9a-zA-Z_:/.]" file pos) |
292 |
|
(setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) |
293 |
|
(cons (substring file pos (match-beginning 0)) buf)) |
294 |
|
pos (match-end 0))) |
295 |
|
(apply (function concat) |
296 |
|
(nreverse (cons (substring file pos) buf))))) |
297 |
|
|
298 |
|
(defun nneething-decode-file-name (file &optional coding-system) |
299 |
|
"Decode the name of the FILE is encoded in CODING-SYSTEM." |
300 |
|
(let ((pos 0) buf) |
301 |
|
(while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos) |
302 |
|
(setq buf (cons (string (string-to-number (match-string 1 file) 16)) |
303 |
|
(cons (substring file pos (match-beginning 0)) buf)) |
304 |
|
pos (match-end 0))) |
305 |
|
(decode-coding-string |
306 |
|
(apply (function concat) |
307 |
|
(nreverse (cons (substring file pos) buf))) |
308 |
|
(or coding-system nnmail-pathname-coding-system)))) |
309 |
|
|
310 |
|
(defun nneething-get-file-name (id) |
311 |
|
"Extract the file name from the message ID string." |
312 |
|
(when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id) |
313 |
|
(nneething-decode-file-name (match-string 1 id)))) |
314 |
|
|
315 |
|
(defun nneething-make-head (file &optional buffer extra-msg |
316 |
|
mime-type mime-charset mime-encoding) |
317 |
"Create a head by looking at the file attributes of FILE." |
"Create a head by looking at the file attributes of FILE." |
318 |
(let ((atts (file-attributes file))) |
(let ((atts (file-attributes file))) |
319 |
(insert |
(insert |
320 |
"Subject: " (file-name-nondirectory file) "\n" |
"Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" |
321 |
"Message-ID: <nneething-" |
"Message-ID: <nneething-" (nneething-encode-file-name file) |
|
(int-to-string (incf nneething-message-id-number)) |
|
322 |
"@" (system-name) ">\n" |
"@" (system-name) ">\n" |
323 |
(if (equal '(0 0) (nth 5 atts)) "" |
(if (equal '(0 0) (nth 5 atts)) "" |
324 |
(concat "Date: " (current-time-string (nth 5 atts)) "\n")) |
(concat "Date: " (current-time-string (nth 5 atts)) "\n")) |
337 |
(concat "Lines: " (int-to-string |
(concat "Lines: " (int-to-string |
338 |
(count-lines (point-min) (point-max))) |
(count-lines (point-min) (point-max))) |
339 |
"\n")) |
"\n")) |
340 |
|
"") |
341 |
|
(if mime-type |
342 |
|
(concat "Content-Type: " mime-type |
343 |
|
(if mime-charset |
344 |
|
(concat "; charset=" |
345 |
|
(if (stringp mime-charset) |
346 |
|
mime-charset |
347 |
|
(symbol-name mime-charset))) |
348 |
|
"") |
349 |
|
(if mime-encoding |
350 |
|
(concat "\nContent-Transfer-Encoding: " mime-encoding) |
351 |
|
"") |
352 |
|
"\nMIME-Version: 1.0\n") |
353 |
"")))) |
"")))) |
354 |
|
|
355 |
(defun nneething-from-line (uid &optional file) |
(defun nneething-from-line (uid &optional file) |
397 |
(nneething-make-head file) t) |
(nneething-make-head file) t) |
398 |
(t |
(t |
399 |
;; We examine the file. |
;; We examine the file. |
400 |
(nnheader-insert-head file) |
(condition-case () |
401 |
(if (nnheader-article-p) |
(progn |
402 |
(delete-region |
(nnheader-insert-head file) |
403 |
(progn |
(if (nnheader-article-p) |
404 |
(goto-char (point-min)) |
(delete-region |
405 |
(or (and (search-forward "\n\n" nil t) |
(progn |
406 |
(1- (point))) |
(goto-char (point-min)) |
407 |
(point-max))) |
(or (and (search-forward "\n\n" nil t) |
408 |
(point-max)) |
(1- (point))) |
409 |
(goto-char (point-min)) |
(point-max))) |
410 |
(nneething-make-head file (current-buffer)) |
(point-max)) |
411 |
(delete-region (point) (point-max))) |
(goto-char (point-min)) |
412 |
|
(nneething-make-head file (current-buffer)) |
413 |
|
(delete-region (point) (point-max)))) |
414 |
|
(file-error |
415 |
|
(nneething-make-head file (current-buffer) " (unreadable)"))) |
416 |
t)))) |
t)))) |
417 |
|
|
418 |
(defun nneething-file-name (article) |
(defun nneething-file-name (article) |
419 |
"Return the file name of ARTICLE." |
"Return the file name of ARTICLE." |
420 |
(let ((dir (file-name-as-directory nneething-address)) |
(let ((dir (file-name-as-directory nneething-address)) |
421 |
fname) |
fname) |
422 |
(if (numberp article) |
(if (numberp article) |
423 |
(if (setq fname (cadr (assq article nneething-map))) |
(if (setq fname (cadr (assq article nneething-map))) |
424 |
(expand-file-name fname dir) |
(expand-file-name fname dir) |