* nnslashdot.el (nnslashdot-sid-strip): New function.
[gnus] / lisp / gnus-uu.el
index 387d178..3a60f7d 100644 (file)
@@ -1,5 +1,6 @@
 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 198,995,86,87,93,94,95,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Created: 2 Oct 1993
@@ -58,8 +59,8 @@
   '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
     ("\\.pas$" "cat %s | sed 's/\r$//'")
     ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
-    ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
-    ("\\.tga$" "tgatoppm %s | xv -")
+    ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display")
+    ("\\.tga$" "tgatoppm %s | ee -")
     ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
      "sox -v .5 %s -t .au -u - > /dev/audio")
     ("\\.au$" "cat %s > /dev/audio")
@@ -373,7 +374,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
   ;;"x" gnus-uu-extract-any
-  ;;"m" gnus-uu-extract-mime
+  "m" gnus-summary-save-parts
   "u" gnus-uu-decode-uu
   "U" gnus-uu-decode-uu-and-save
   "s" gnus-uu-decode-unshar
@@ -386,17 +387,17 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   "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)
   (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.
@@ -526,6 +527,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
                 (gnus-get-buffer-create " *gnus-uu-forward*")))
       (erase-buffer)
       (insert-file file)
+      (delete-file file)
       (let ((fs gnus-uu-digest-from-subject))
        (when fs
          (setq from (caar fs)
@@ -566,8 +568,10 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 ;; Process marking.
 
 (defun gnus-uu-mark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and set the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+  "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
@@ -576,9 +580,10 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
     (message ""))
   (gnus-summary-position-point))
 
-(defun gnus-uu-unmark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and remove the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+(defun gnus-uu-unmark-by-regexp (regexp)
+  "Remove the process mark from articles whose subjects match REGEXP.
+When called interactively, prompt for REGEXP."
+  (interactive "sUnmark (regexp): ")
   (gnus-uu-mark-by-regexp regexp t))
 
 (defun gnus-uu-mark-series ()
@@ -623,8 +628,9 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   (interactive)
   (gnus-save-hidden-threads
     (let ((level (gnus-summary-thread-level)))
-      (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
-                 (zerop (gnus-summary-next-subject 1))
+      (while (and (gnus-summary-set-process-mark
+                  (gnus-summary-article-number))
+                 (zerop (gnus-summary-next-subject 1 nil t))
                  (> (gnus-summary-thread-level) level)))))
   (gnus-summary-position-point))
 
@@ -654,7 +660,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 (defun gnus-uu-mark-over (&optional score)
   "Mark all articles with a score over SCORE (the prefix)."
   (interactive "P")
-  (let ((score (gnus-score-default score))
+  (let ((score (or score gnus-summary-default-score 0))
        (data gnus-newsgroup-data))
     (save-excursion
       (while data
@@ -954,7 +960,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
        (beginning-of-line)
        (forward-line 1)
        (when (file-exists-p gnus-uu-binhex-article-name)
-         (append-to-file start-char (point) gnus-uu-binhex-article-name))))
+         (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
     (if (memq 'begin state)
        (cons gnus-uu-binhex-article-name state)
       state)))
@@ -1207,7 +1213,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
        (gnus-inhibit-treatment t)
        has-been-begin article result-file result-files process-state
        gnus-summary-display-article-function
-       gnus-article-prepare-hook
+       gnus-article-prepare-hook gnus-display-mime-function
        article-series files)
 
     (while (and articles
@@ -1398,7 +1404,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
          ;; We replace certain characters that could make things messy.
          (setq gnus-uu-file-name
                (let ((nnheader-file-name-translation-alist
-                      '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
+                      '((?/ . ?,) (?  . ?_) (?* . ?_) (?$ . ?_))))
                  (nnheader-translate-file-chars (match-string 1))))
           (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
 
@@ -1475,6 +1481,21 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
          (cons (if (= (length files) 1) (car files) files) state)
        state))))
 
+(defvar gnus-uu-unshar-warning
+  "*** WARNING ***
+
+Shell archives are an archaic method of bundling files for distribution
+across computer networks.  During the unpacking process, arbitrary commands
+are executed on your system, and all kinds of nasty things can happen.
+Please examine the archive very carefully before you instruct Emacs to
+unpack it.  You can browse the archive buffer using \\[scroll-other-window].
+
+If you are unsure what to do, please answer \"no\"."
+  "Text of warning message displayed by `gnus-uu-unshar-article'.
+Make sure that this text consists only of few text lines.  Otherwise,
+Gnus might fail to display all of it.")
+
+
 ;; This function is used by `gnus-uu-grab-articles' to treat
 ;; a shared article.
 (defun gnus-uu-unshar-article (process-buffer in-state)
@@ -1485,14 +1506,31 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
       (goto-char (point-min))
       (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
          (setq state (list 'wrong-type))
-       (beginning-of-line)
-       (setq start-char (point))
-       (call-process-region
-        start-char (point-max) shell-file-name nil
-        (gnus-get-buffer-create gnus-uu-output-buffer-name) nil
-        shell-command-switch
-        (concat "cd " gnus-uu-work-dir " "
-                gnus-shell-command-separator  " sh"))))
+       (save-window-excursion
+         (save-excursion
+           (switch-to-buffer (current-buffer))
+           (delete-other-windows)
+           (let ((buffer (get-buffer-create (generate-new-buffer-name
+                                             "*Warning*"))))
+             (unless
+                 (unwind-protect
+                     (with-current-buffer buffer
+                       (insert (substitute-command-keys 
+                                gnus-uu-unshar-warning))
+                       (goto-char (point-min))
+                       (display-buffer buffer)
+                       (yes-or-no-p "This is a shell archive, unshar it? "))
+                   (kill-buffer buffer))
+               (setq state (list 'error))))))
+       (unless (memq 'error state)
+         (beginning-of-line)
+         (setq start-char (point))
+         (call-process-region
+          start-char (point-max) shell-file-name nil
+          (gnus-get-buffer-create gnus-uu-output-buffer-name) nil
+          shell-command-switch
+          (concat "cd " gnus-uu-work-dir " "
+                  gnus-shell-command-separator  " sh")))))
     state))
 
 ;; Returns the name of what the shar file is going to unpack.