X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=d539cd19977bd73774b744eb94babefd1755595b;hb=92cd97ef5a0abb984188890f0e3f9088956c33f0;hp=fcf4d4ce7152db5f82e501c0a7e9d3aef3463901;hpb=a707b63af25b91cb730c12e65156ca364bf49a44;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el
index fcf4d4c..d539cd1 100644
--- a/lisp/gnus-uu.el
+++ b/lisp/gnus-uu.el
@@ -1,6 +1,6 @@
 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000
-;;        Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
+;;        2001 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Created: 2 Oct 1993
@@ -33,7 +33,6 @@
 (require 'gnus-art)
 (require 'message)
 (require 'gnus-msg)
-(require 'mm-decode)
 
 (defgroup gnus-extract nil
   "Extracting encoded files."
@@ -297,7 +296,7 @@ so I simply dropped them."
   '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
     "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
     "^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
-    "^Content-ID:")
+    "^Content-ID:" "^User-Agent:" "^X-Face:")
   "*List of regexps to match headers included in digested messages.
 The headers will be included in the sequence they are matched."
   :group 'gnus-extract
@@ -529,42 +528,44 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
     (if (and n (not (numberp n)))
 	(setq message-forward-as-mime (not message-forward-as-mime)
 	      n nil))
-    (gnus-setup-message 'forward
-      (setq gnus-uu-digest-from-subject nil)
-      (setq gnus-uu-digest-buffer 
-	    (gnus-get-buffer-create " *gnus-uu-forward*"))
-      (gnus-uu-decode-save n file)
-      (switch-to-buffer gnus-uu-digest-buffer)
-      (let ((fs gnus-uu-digest-from-subject))
-	(when fs
-	  (setq from (caar fs)
-		subject (gnus-simplify-subject-fuzzy (cdar fs))
-		fs (cdr fs))
-	  (while (and fs (or from subject))
-	    (when from
-	      (unless (string= from (caar fs))
-		(setq from nil)))
-	    (when subject
-	      (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
-			       subject)
-		(setq subject nil)))
-	    (setq fs (cdr fs))))
-	(unless subject
-	  (setq subject "Digested Articles"))
-	(unless from
-	  (setq from
-		(if (gnus-news-group-p gnus-newsgroup-name)
-		    gnus-newsgroup-name
-		  "Various"))))
-      (goto-char (point-min))
-      (when (re-search-forward "^Subject: ")
-	(delete-region (point) (gnus-point-at-eol))
-	(insert subject))
-      (goto-char (point-min))
-      (when (re-search-forward "^From:")
-	(delete-region (point) (gnus-point-at-eol))
-	(insert " " from))
-      (message-forward post t))
+    (let ((gnus-article-reply (gnus-summary-work-articles n)))
+      (gnus-setup-message 'forward
+	(setq gnus-uu-digest-from-subject nil)
+	(setq gnus-uu-digest-buffer
+	      (gnus-get-buffer-create " *gnus-uu-forward*"))
+	(gnus-uu-decode-save n file)
+	(switch-to-buffer gnus-uu-digest-buffer)
+	(let ((fs gnus-uu-digest-from-subject))
+	  (when fs
+	    (setq from (caar fs)
+		  subject (gnus-simplify-subject-fuzzy (cdar fs))
+		  fs (cdr fs))
+	    (while (and fs (or from subject))
+	      (when from
+		(unless (string= from (caar fs))
+		  (setq from nil)))
+	      (when subject
+		(unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
+				 subject)
+		  (setq subject nil)))
+	      (setq fs (cdr fs))))
+	  (unless subject
+	    (setq subject "Digested Articles"))
+	  (unless from
+	    (setq from
+		  (if (gnus-news-group-p gnus-newsgroup-name)
+		      gnus-newsgroup-name
+		    "Various"))))
+	(goto-char (point-min))
+	(when (re-search-forward "^Subject: ")
+	  (delete-region (point) (gnus-point-at-eol))
+	  (insert subject))
+	(goto-char (point-min))
+	(when (re-search-forward "^From:")
+	  (delete-region (point) (gnus-point-at-eol))
+	  (insert " " from))
+	(let ((message-forward-decoded-p t))
+	  (message-forward post))))
     (setq gnus-uu-digest-from-subject nil)))
 
 (defun gnus-uu-digest-post-forward (&optional n)
@@ -574,17 +575,40 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 ;; Process marking.
 
+(defun gnus-message-process-mark (unmarkp new-marked)
+  (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
+    (message "%d mark%s %s%s"
+	     (length new-marked)
+	     (if (= (length new-marked) 1) "" "s")
+	     (if unmarkp "removed" "added")
+	     (cond
+	      ((and (zerop old)
+		    (not unmarkp))
+	       "")
+	      (unmarkp
+	       (format ", %d remain marked"
+		       (length gnus-newsgroup-processable)))
+	      (t
+	       (format ", %d already marked" old))))))
+
+(defun gnus-new-processable (unmarkp articles)
+  (if unmarkp
+      (gnus-intersection gnus-newsgroup-processable articles)
+    (gnus-set-difference articles gnus-newsgroup-processable)))
+
 (defun gnus-uu-mark-by-regexp (regexp &optional unmark)
   "Set the process mark on articles whose subjects match REGEXP.
 When called interactively, prompt for REGEXP.
 Optional UNMARK non-nil means unmark instead of mark."
   (interactive "sMark (regexp): \nP")
-  (let ((articles (gnus-uu-find-articles-matching regexp)))
-    (while articles
-      (if unmark
-	  (gnus-summary-remove-process-mark (pop articles))
-	(gnus-summary-set-process-mark (pop articles))))
-    (message ""))
+  (save-excursion
+    (let* ((articles (gnus-uu-find-articles-matching regexp))
+	   (new-marked (gnus-new-processable unmark articles)))
+      (while articles
+	(if unmark
+	    (gnus-summary-remove-process-mark (pop articles))
+	  (gnus-summary-set-process-mark (pop articles))))
+      (gnus-message-process-mark unmark new-marked)))
   (gnus-summary-position-point))
 
 (defun gnus-uu-unmark-by-regexp (regexp)
@@ -823,9 +847,9 @@ When called interactively, prompt for REGEXP."
    (gnus-uu-save-separate-articles
     (save-excursion
       (set-buffer buffer)
-      (let ((coding-system-for-write mm-text-coding-system))
-	(gnus-write-buffer
-	 (concat gnus-uu-saved-article-name gnus-current-article)))
+      (gnus-write-buffer-as-coding-system
+       nnheader-text-coding-system
+       (concat gnus-uu-saved-article-name gnus-current-article))
       (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
 	    ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
 						 'begin 'end))
@@ -860,10 +884,6 @@ When called interactively, prompt for REGEXP."
 	      (insert (format
 		       "Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
 		       (current-time-string) name name))
-	      (when (and message-forward-as-mime gnus-uu-digest-buffer)
-		;; The default part in multipart/digest is message/rfc822.
-		;; Subject is a fake head.
-		(insert "<#part type=text/plain>\nSubject: Topics\n\n"))
 	      (insert "Topics:\n")))
 	(when (not (eq in-state 'end))
 	  (setq state (list 'middle))))
@@ -878,14 +898,9 @@ When called interactively, prompt for REGEXP."
 	      ;; These two are necessary for XEmacs 19.12 fascism.
 	      (put-text-property (point-min) (point-max) 'invisible nil)
 	      (put-text-property (point-min) (point-max) 'intangible nil))
-	    (when (and message-forward-as-mime 
-		       message-forward-show-mml
-		       gnus-uu-digest-buffer)
-	      (mm-enable-multibyte)
-	      (mime-to-mml))
 	    (goto-char (point-min))
 	    (re-search-forward "\n\n")
-	    (unless (and message-forward-as-mime gnus-uu-digest-buffer)
+	    (unless gnus-uu-digest-buffer
 	      ;; Quote all 30-dash lines.
 	      (save-excursion
 		(while (re-search-forward "^-" nil t)
@@ -909,37 +924,20 @@ When called interactively, prompt for REGEXP."
 					  (1- (point)))
 				     (progn (forward-line 1) (point)))))))))
 	    (widen)))
-	(if (and message-forward-as-mime gnus-uu-digest-buffer)
-	  (if message-forward-show-mml
-	      (progn
-		(insert "\n<#mml type=message/rfc822>\n")
-		(insert sorthead) (goto-char (point-max))
-		(insert body) (goto-char (point-max))
-		(insert "\n<#/mml>\n"))
-	    (let ((buf (mml-generate-new-buffer " *mml*")))
-	      (with-current-buffer buf
-		(insert sorthead)
-		(goto-char (point-min))
-		(when (re-search-forward "^Subject: \\(.*\\)$" nil t)
-		  (setq subj (buffer-substring (match-beginning 1) 
-					       (match-end 1))))
-		(goto-char (point-max))
-		(insert body))
-	      (insert "\n<#part type=message/rfc822"
-		      " buffer=\"" (buffer-name buf) "\">\n")))
-	  (insert sorthead) (goto-char (point-max))
-	  (insert body) (goto-char (point-max))
-	  (insert (concat "\n" (make-string 30 ?-) "\n\n")))
+	(insert message-forward-start-separator)
+	(insert sorthead) (goto-char (point-max))
+	(insert body) (goto-char (point-max))
 	(goto-char beg)
-	(when (re-search-forward "^Subject: \\(.*\\)$" nil t)
-	  (setq subj (buffer-substring (match-beginning 1) (match-end 1))))
+	(when (re-search-forward "^Subject:" nil t)
+	  (setq subj (nnheader-decode-subject
+		      (buffer-substring (match-end 0) (std11-field-end)))))
 	(when subj
 	  (save-excursion
 	    (set-buffer "*gnus-uu-pre*")
 	    (insert (format "   %s\n" subj)))))
       (when (or (eq in-state 'last)
 		(eq in-state 'first-and-last))
-	(if (and message-forward-as-mime gnus-uu-digest-buffer)
+	(if gnus-uu-digest-buffer
 	    (with-current-buffer gnus-uu-digest-buffer
 	      (erase-buffer)
 	      (insert-buffer "*gnus-uu-pre*")
@@ -952,8 +950,8 @@ When called interactively, prompt for REGEXP."
 		(with-current-buffer gnus-uu-digest-buffer
 		  (erase-buffer)
 		  (insert-buffer "*gnus-uu-pre*"))
-	      (let ((coding-system-for-write mm-text-coding-system))
-		(gnus-write-buffer gnus-uu-saved-article-name))))
+	      (gnus-write-buffer-as-coding-system
+	       nnheader-text-coding-system gnus-uu-saved-article-name)))
 	  (save-excursion
 	    (set-buffer "*gnus-uu-body*")
 	    (goto-char (point-max))
@@ -965,9 +963,10 @@ When called interactively, prompt for REGEXP."
 		(with-current-buffer gnus-uu-digest-buffer
 		  (goto-char (point-max))
 		  (insert-buffer "*gnus-uu-body*"))
-	      (let ((coding-system-for-write mm-text-coding-system) 
-		    (file-name-coding-system nnmail-pathname-coding-system))
-		(write-region
+	      (let ((file-name-coding-system nnmail-pathname-coding-system)
+		    (pathname-coding-system nnmail-pathname-coding-system))
+		(write-region-as-coding-system
+		 nnheader-text-coding-system
 		 (point-min) (point-max) gnus-uu-saved-article-name t)))))
 	(gnus-kill-buffer "*gnus-uu-pre*")
 	(gnus-kill-buffer "*gnus-uu-body*")
@@ -1015,7 +1014,8 @@ When called interactively, prompt for REGEXP."
 	(beginning-of-line)
 	(forward-line 1)
 	(when (file-exists-p gnus-uu-binhex-article-name)
-	  (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
+	  (write-region-as-binary start-char (point)
+				  gnus-uu-binhex-article-name 'append))))
     (if (memq 'begin state)
 	(cons gnus-uu-binhex-article-name state)
       state)))
@@ -1393,6 +1393,9 @@ When called interactively, prompt for REGEXP."
 	  (while article-series
 	    (gnus-summary-tick-article (pop article-series) t)))))
 
+    ;; The original article buffer is hosed, shoot it down.
+    (gnus-kill-buffer gnus-original-article-buffer)
+    (setq gnus-current-article nil)
     result-files))
 
 (defun gnus-uu-grab-view (file)
@@ -1409,9 +1412,12 @@ When called interactively, prompt for REGEXP."
   (when gnus-uu-default-dir
     (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
 			   (file-name-nondirectory file))))
-      (rename-file file to-file)
-      (unless (file-exists-p file)
-	(make-symbolic-link to-file file)))))
+      (cond ((fboundp 'make-symbolic-link)
+	     (rename-file file to-file)
+	     (unless (file-exists-p file)
+	       (make-symbolic-link to-file file)))
+	    (t
+	     (copy-file file to-file))))))
 
 (defun gnus-uu-part-number (article)
   (let* ((header (gnus-summary-article-header article))
@@ -1461,7 +1467,7 @@ When called interactively, prompt for REGEXP."
 		(let ((nnheader-file-name-translation-alist
 		       '((?/ . ?,) (?  . ?_) (?* . ?_) (?$ . ?_))))
 		  (nnheader-translate-file-chars (match-string 1))))
-          (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
+	  (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
 
 	  ;; Remove any non gnus-uu-body-line right after start.
 	  (forward-line 1)
@@ -1570,7 +1576,7 @@ Gnus might fail to display all of it.")
 	      (unless
 		  (unwind-protect
 		      (with-current-buffer buffer
-			(insert (substitute-command-keys 
+			(insert (substitute-command-keys
 				 gnus-uu-unshar-warning))
 			(goto-char (point-min))
 			(display-buffer buffer)
@@ -1793,11 +1799,23 @@ Gnus might fail to display all of it.")
     (when (setq buf (get-buffer gnus-uu-output-buffer-name))
       (kill-buffer buf))))
 
+(defun gnus-quote-arg-for-sh-or-csh (arg)
+  (let ((pos 0) new-pos accum)
+    ;; *** bug: we don't handle newline characters properly
+    (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
+      (push (substring arg pos new-pos) accum)
+      (push "\\" accum)
+      (push (list (aref arg new-pos)) accum)
+      (setq pos (1+ new-pos)))
+    (if (= pos 0)
+	arg
+      (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
 ;; Inputs an action and a filename and returns a full command, making sure
 ;; that the filename will be treated as a single argument when the shell
 ;; executes the command.
 (defun gnus-uu-command (action file)
-  (let ((quoted-file (mm-quote-arg file)))
+  (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file)))
     (if (string-match "%s" action)
 	(format action quoted-file)
       (concat action " " quoted-file))))
@@ -2130,4 +2148,4 @@ If no file has been included, the user will be asked for a file."
 
 (provide 'gnus-uu)
 
-;; gnus-uu.el ends here
+;;; gnus-uu.el ends here