Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-uu.el
index 8838644..8f8c2dc 100644 (file)
@@ -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, 2002 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Created: 2 Oct 1993
@@ -320,7 +320,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 (defvar gnus-uu-saved-article-name nil)
 
-(defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
 (defvar gnus-uu-end-string "^end[ \t]*$")
 
 (defvar gnus-uu-body-line "^M")
@@ -335,7 +335,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 (defvar gnus-uu-shar-file-name nil)
 (defvar gnus-uu-shar-name-marker
-  "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+  "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
 
 (defvar gnus-uu-postscript-begin-string "^%!PS-")
 (defvar gnus-uu-postscript-end-string "^%%EOF$")
@@ -352,56 +352,6 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 (defvar gnus-uu-digest-from-subject nil)
 (defvar gnus-uu-digest-buffer nil)
 
-;; Keymaps
-
-(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
-  "p" gnus-summary-mark-as-processable
-  "u" gnus-summary-unmark-as-processable
-  "U" gnus-summary-unmark-all-processable
-  "v" gnus-uu-mark-over
-  "s" gnus-uu-mark-series
-  "r" gnus-uu-mark-region
-  "g" gnus-uu-unmark-region
-  "R" gnus-uu-mark-by-regexp
-  "G" gnus-uu-unmark-by-regexp
-  "t" gnus-uu-mark-thread
-  "T" gnus-uu-unmark-thread
-  "a" gnus-uu-mark-all
-  "b" gnus-uu-mark-buffer
-  "S" gnus-uu-mark-sparse
-  "k" gnus-summary-kill-process-mark
-  "y" gnus-summary-yank-process-mark
-  "w" gnus-summary-save-process-mark
-  "i" gnus-uu-invert-processable)
-
-(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
-  ;;"x" gnus-uu-extract-any
-  "m" gnus-summary-save-parts
-  "u" gnus-uu-decode-uu
-  "U" gnus-uu-decode-uu-and-save
-  "s" gnus-uu-decode-unshar
-  "S" gnus-uu-decode-unshar-and-save
-  "o" gnus-uu-decode-save
-  "O" gnus-uu-decode-save
-  "b" gnus-uu-decode-binhex
-  "B" gnus-uu-decode-binhex
-  "p" gnus-uu-decode-postscript
-  "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys
-    (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
-  "u" gnus-uu-decode-uu-view
-  "U" gnus-uu-decode-uu-and-save-view
-  "s" gnus-uu-decode-unshar-view
-  "S" gnus-uu-decode-unshar-and-save-view
-  "o" gnus-uu-decode-save-view
-  "O" gnus-uu-decode-save-view
-  "b" gnus-uu-decode-binhex-view
-  "B" gnus-uu-decode-binhex-view
-  "p" gnus-uu-decode-postscript-view
-  "P" gnus-uu-decode-postscript-and-save-view)
-
-
 ;; Commands.
 
 (defun gnus-uu-decode-uu (&optional n)
@@ -456,7 +406,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
                          gnus-uu-default-dir
                          gnus-uu-default-dir))))
   (setq gnus-uu-binhex-article-name
-       (make-temp-name (concat gnus-uu-work-dir "binhex")))
+       (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
   (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
 
 (defun gnus-uu-decode-uu-view (&optional n)
@@ -509,7 +459,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
         (read-file-name "Unbinhex, view and save in dir: "
                         gnus-uu-default-dir gnus-uu-default-dir)))
   (setq gnus-uu-binhex-article-name
-       (make-temp-name (concat gnus-uu-work-dir "binhex")))
+       (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
     (gnus-uu-decode-binhex n file)))
 
@@ -520,48 +470,52 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   "Digests and forwards all articles in this series."
   (interactive "P")
   (let ((gnus-uu-save-in-digest t)
-       (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward")))
+       (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
+       (message-forward-as-mime message-forward-as-mime)
+       (mail-parse-charset gnus-newsgroup-charset)
+       (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
        gnus-uu-digest-buffer subject from)
-    (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)
-      (set-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"))))
-      (mime-edit-enclose-digest-region (point-min) (point-max))
-      (if post
-         (message-news nil (concat "[" from "] " subject))
-       (message-mail nil (concat "[" from "] " subject)))
-      (message-goto-body)
-      ;; Make sure we're at the start of the line.
-      (unless (bolp)
-       (insert "\n"))
-      ;; Insert the forwarded buffer.
-      (insert-buffer gnus-uu-digest-buffer)
-      (kill-buffer gnus-uu-digest-buffer)
-      (set-text-properties (point-min) (point-max) nil)
-      (message-position-point))
+    (if (and n (not (numberp n)))
+       (setq message-forward-as-mime (not message-forward-as-mime)
+             n nil))
+    (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)
@@ -997,7 +951,8 @@ When called interactively, prompt for REGEXP."
        (if (looking-at gnus-uu-binhex-begin-line)
            (progn
              (setq state (list 'begin))
-             (write-region 1 1 gnus-uu-binhex-article-name))
+             (write-region (point-min) (point-min)
+                           gnus-uu-binhex-article-name))
          (setq state (list 'middle)))
        (goto-char (point-max))
        (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
@@ -1110,7 +1065,7 @@ When called interactively, prompt for REGEXP."
     (while (re-search-forward "[ \t]+" nil t)
       (replace-match "[ \t]+" t t))
 
-    (buffer-substring 1 (point-max))))
+    (buffer-substring (point-min) (point-max))))
 
 (defun gnus-uu-get-list-of-articles (n)
   ;; If N is non-nil, the article numbers of the N next articles
@@ -1202,10 +1157,11 @@ When called interactively, prompt for REGEXP."
        ;; Expand numbers.
        (goto-char (point-min))
        (while (re-search-forward "[0-9]+" nil t)
-         (replace-match
-          (format "%06d"
-                  (string-to-int (buffer-substring
-                                  (match-beginning 0) (match-end 0))))))
+         (ignore-errors
+           (replace-match
+            (format "%06d"
+                    (string-to-int (buffer-substring
+                                    (match-beginning 0) (match-end 0)))))))
        (setq string (buffer-substring 1 (point-max)))
        (setcar (car string-list) string)
        (setq string-list (cdr string-list))))
@@ -1264,7 +1220,7 @@ When called interactively, prompt for REGEXP."
        (gnus-inhibit-treatment t)
        has-been-begin article result-file result-files process-state
        gnus-summary-display-article-function
-       gnus-article-display-hook gnus-article-prepare-hook gnus-display-mime-function
+       gnus-article-prepare-hook gnus-display-mime-function
        article-series files)
 
     (while (and articles
@@ -1389,6 +1345,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)
@@ -1460,7 +1419,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)
@@ -1569,7 +1528,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)
@@ -1774,8 +1733,7 @@ Gnus might fail to display all of it.")
                 gnus-uu-tmp-dir)))
 
       (setq gnus-uu-work-dir
-           (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
-      (gnus-make-directory gnus-uu-work-dir)
+           (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
       (set-file-modes gnus-uu-work-dir 448)
       (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
       (push (cons gnus-newsgroup-name gnus-uu-work-dir)
@@ -1801,7 +1759,7 @@ Gnus might fail to display all of it.")
       (push (list (aref arg new-pos)) accum)
       (setq pos (1+ new-pos)))
     (if (= pos 0)
-        arg
+       arg
       (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
 
 ;; Inputs an action and a filename and returns a full command, making sure
@@ -1957,7 +1915,7 @@ The user will be asked for a file name."
     (goto-char (point-min))
     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
     (forward-line -1)
-    (narrow-to-region 1 (point))
+    (narrow-to-region (point-min) (point))
     (unless (mail-fetch-field "mime-version")
       (widen)
       (insert "MIME-Version: 1.0\n"))
@@ -2047,7 +2005,7 @@ If no file has been included, the user will be asked for a file."
       (erase-buffer)
       (insert-buffer-substring post-buf beg-binary end-binary)
       (goto-char (point-min))
-      (setq length (count-lines 1 (point-max)))
+      (setq length (count-lines (point-min) (point-max)))
       (setq parts (/ length gnus-uu-post-length))
       (unless (< (% length gnus-uu-post-length) 4)
        (incf parts)))
@@ -2060,7 +2018,7 @@ If no file has been included, the user will be asked for a file."
     (re-search-forward
      (concat "^" (regexp-quote mail-header-separator) "$") nil t)
     (beginning-of-line)
-    (setq header (buffer-substring 1 (point)))
+    (setq header (buffer-substring (point-min) (point)))
 
     (goto-char (point-min))
     (when gnus-uu-post-separate-description
@@ -2141,4 +2099,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