emacs: lisp/gnus/nneething.el comparison

comparison lisp/gnus/nneething.el @ 89971:cce1c0ee76ee

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-36 Merge from emacs--cvs-trunk--0, emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-524 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-534 Update from CVS * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0 tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS

author	Miles Bader <miles@gnu.org>
date	Thu, 09 Sep 2004 09:36:36 +0000
parents	561b856c5b1f 55fd4f77387a
children	30ad2795fdab

comparison

equal deleted inserted replaced

-:a849e5779b8c
+:cce1c0ee76ee
 ;;; nneething.el --- arbitrary file access for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
 ;;	Free Software Foundation, Inc.
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;;	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news, mail
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 (defvoo nneething-current-directory nil
 "Current news group directory.")
 (defvoo nneething-status-string "")
-(defvoo nneething-message-id-number 0)
 (defvoo nneething-work-buffer " *nneething work*")
 (defvoo nneething-group nil)
 (defvoo nneething-map nil)
 (defvoo nneething-read-only nil)
 (deffoo nneething-request-article (id &optional group server buffer)
 (nneething-possibly-change-directory group)
 (let ((file (unless (stringp id)
 		(nneething-file-name id)))
 	(nntp-server-buffer (or buffer nntp-server-buffer)))
-(and (stringp file)			; We did not request by Message-ID.
+(and (stringp file)		   ; We did not request by Message-ID.
 	 (file-exists-p file)		; The file exists.
 	 (not (file-directory-p file))	; It's not a dir.
 	 (save-excursion
-	   (nnmail-find-file file)	; Insert the file in the nntp buf.
+	   (let ((nnmail-file-coding-system 'binary))
+	     (nnmail-find-file file))	; Insert the file in the nntp buf.
 	   (unless (nnheader-article-p)	; Either it's a real article...
-	     (goto-char (point-min))
+	     (let ((type
-	     (nneething-make-head
+		    (unless (file-directory-p file)
-	      file (current-buffer))	; ... or we fake some headers.
+		      (or (cdr (assoc (concat "." (file-name-extension file))
+				      mailcap-mime-extensions))
+			  "text/plain")))
+		   (charset
+		    (mm-detect-mime-charset-region (point-min) (point-max)))
+		   (encoding))
+	       (unless (string-match "\\`text/" type)
+		 (base64-encode-region (point-min) (point-max))
+		 (setq encoding "base64"))
+	       (goto-char (point-min))
+	       (nneething-make-head file (current-buffer)
+				    nil type charset encoding))
 	     (insert "\n"))
 	   t))))
 (deffoo nneething-request-group (group &optional server dont-check)
 (nneething-possibly-change-directory group server)
 ;; Remove deleted files from the map.
 (let ((map nneething-map)
 	    prev)
 	(while map
 	  (if (and (member (cadr (car map)) files)
-		   ;; We also remove files that have changed mod times.
+		  ;; We also remove files that have changed mod times.
 		   (equal (nth 5 (file-attributes
 				  (nneething-file-name (cadr (car map)))))
 			  (cadr (cdar map))))
 	      (progn
 		(push (cadr (car map)) map-files)
 "Insert the head of FILE."
 (when (nneething-get-head file)
 (insert-buffer-substring nneething-work-buffer)
 (goto-char (point-max))))
-(defun nneething-make-head (file &optional buffer)
+(defun nneething-encode-file-name (file &optional coding-system)
+"Encode the name of the FILE in CODING-SYSTEM."
+(let ((pos 0) buf)
+(setq file (mm-encode-coding-string
+		file (or coding-system nnmail-pathname-coding-system)))
+(while (string-match "[^-0-9a-zA-Z_:/.]" file pos)
+(setq buf (cons (format "%%%02x" (aref file (match-beginning 0)))
+		      (cons (substring file pos (match-beginning 0)) buf))
+	    pos (match-end 0)))
+(apply (function concat)
+	   (nreverse (cons (substring file pos) buf)))))
+(defun nneething-decode-file-name (file &optional coding-system)
+"Decode the name of the FILE is encoded in CODING-SYSTEM."
+(let ((pos 0) buf)
+(while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos)
+(setq buf (cons (string (string-to-number (match-string 1 file) 16))
+		      (cons (substring file pos (match-beginning 0)) buf))
+	    pos (match-end 0)))
+(decode-coding-string
+(apply (function concat)
+	    (nreverse (cons (substring file pos) buf)))
+(or coding-system nnmail-pathname-coding-system))))
+(defun nneething-get-file-name (id)
+"Extract the file name from the message ID string."
+(when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id)
+(nneething-decode-file-name (match-string 1 id))))
+(defun nneething-make-head (file &optional buffer extra-msg
+				 mime-type mime-charset mime-encoding)
 "Create a head by looking at the file attributes of FILE."
 (let ((atts (file-attributes file)))
 (insert
-"Subject: " (file-name-nondirectory file) "\n"
+"Subject: " (file-name-nondirectory file) (or extra-msg "") "\n"
-"Message-ID: <nneething-"
+"Message-ID: <nneething-" (nneething-encode-file-name file)
-(int-to-string (incf nneething-message-id-number))
 "@" (system-name) ">\n"
 (if (equal '(0 0) (nth 5 atts)) ""
 (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
 (or (when buffer
 	   (save-excursion
 	 (save-excursion
 	   (set-buffer buffer)
 	   (concat "Lines: " (int-to-string
 			      (count-lines (point-min) (point-max)))
 		   "\n"))
+"")
+(if mime-type
+	 (concat "Content-Type: " mime-type
+		 (if mime-charset
+		     (concat "; charset="
+			     (if (stringp mime-charset)
+				 mime-charset
+			       (symbol-name mime-charset)))
+		   "")
+		 (if mime-encoding
+		     (concat "\nContent-Transfer-Encoding: " mime-encoding)
+		   "")
+		 "\nMIME-Version: 1.0\n")
 ""))))
 (defun nneething-from-line (uid &optional file)
 "Return a From header based of UID."
 (let* ((login (condition-case nil
 	  (file-symlink-p file))
 ;; It's a dir, so we fudge a head.
 (nneething-make-head file) t)
 (t
 ;; We examine the file.
-(nnheader-insert-head file)
+(condition-case ()
-(if (nnheader-article-p)
+	  (progn
-	  (delete-region
+	    (nnheader-insert-head file)
-	   (progn
+	    (if (nnheader-article-p)
-	     (goto-char (point-min))
+		(delete-region
-	     (or (and (search-forward "\n\n" nil t)
+		 (progn
-		      (1- (point)))
+		   (goto-char (point-min))
-		 (point-max)))
+		   (or (and (search-forward "\n\n" nil t)
-	   (point-max))
+			    (1- (point)))
-	(goto-char (point-min))
+		       (point-max)))
-	(nneething-make-head file (current-buffer))
+		 (point-max))
-	(delete-region (point) (point-max)))
+	      (goto-char (point-min))
+	      (nneething-make-head file (current-buffer))
+	      (delete-region (point) (point-max))))
+	(file-error
+	 (nneething-make-head file (current-buffer) " (unreadable)")))
 t))))
 (defun nneething-file-name (article)
 "Return the file name of ARTICLE."
 (let ((dir (file-name-as-directory nneething-address))
-fname)
+	fname)
 (if (numberp article)
 	(if (setq fname (cadr (assq article nneething-map)))
 	    (expand-file-name fname dir)
 	  (mm-make-temp-file (expand-file-name "nneething" dir)))
 (expand-file-name article dir))))

Mercurial > emacs

comparison lisp/gnus/nneething.el @ 89971:cce1c0ee76ee