Sync up with gnus-5.6.39

[elisp/gnus.git-] / lisp / gnus-uu.el

diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el
index 46c38fb..dee2d04 100644 (file)
--- a/lisp/gnus-uu.el
+++ b/lisp/gnus-uu.el
@@ -1,7 +1,7 @@
 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
 ;; Copyright (C) 1985,86,87,93,94,95,96,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Created: 2 Oct 1993
 ;; Keyword: news
 
@@ -54,8 +54,8 @@
 ;; Default viewing action rules
 
 (defcustom gnus-uu-default-view-rules
-  '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
-    ("\\.pas$" "cat %s | sed s/\r//g")
+  '(("\\.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 -")
@@ -353,7 +353,9 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   "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
@@ -515,8 +517,8 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
     (gnus-setup-message 'forward
       (setq gnus-uu-digest-from-subject nil)
       (gnus-uu-decode-save n file)
-      (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
-      (gnus-add-current-to-buffer-list)
+      (setq buf (switch-to-buffer
+                (gnus-get-buffer-create " *gnus-uu-forward*")))
       (erase-buffer)
       (insert-file file)
       (let ((fs gnus-uu-digest-from-subject))
@@ -646,7 +648,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   (gnus-summary-position-point))
 
 (defun gnus-uu-mark-over (&optional score)
-  "Mark all articles with a score over SCORE (the prefix.)"
+  "Mark all articles with a score over SCORE (the prefix)."
   (interactive "P")
   (let ((score (gnus-score-default score))
        (data gnus-newsgroup-data))
@@ -832,10 +834,10 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
              (eq in-state 'first-and-last))
          (progn
            (setq state (list 'begin))
-           (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
+           (save-excursion (set-buffer (gnus-get-buffer-create "*gnus-uu-body*"))
                            (erase-buffer))
            (save-excursion
-             (set-buffer (get-buffer-create "*gnus-uu-pre*"))
+             (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*"))
              (erase-buffer)
              (insert (format
                       "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
@@ -968,7 +970,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
        (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
            (setq state (list 'wrong-type))
          (setq end-char (point))
-         (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+         (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
          (insert-buffer-substring process-buffer start-char end-char)
          (setq file-name (concat gnus-uu-work-dir
                                  (cdr gnus-article-current) ".ps"))
@@ -1018,43 +1020,35 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 (defun gnus-uu-reginize-string (string)
   ;; Takes a string and puts a \ in front of every special character;
-  ;; ignores any leading "version numbers" thingies that they use in
-  ;; the comp.binaries groups, and either replaces anything that looks
-  ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something
-  ;; like that, replaces the last two numbers with "[0-9]+".  This, in
-  ;; my experience, should get most postings of a series.
-  (let ((count 2)
-       (vernum "v[0-9]+[a-z][0-9]+:")
-       beg)
+  ;; replaces the last thing that looks like "2/3" with "[0-9]+/3"
+  ;; or, if it can't find something like that, tries "2 of 3", then
+  ;; finally just replaces the next to last number with "[0-9]+".
+  (let ((count 2))
     (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+      (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
       (buffer-disable-undo (current-buffer))
       (erase-buffer)
       (insert (regexp-quote string))
-      (setq beg 1)
 
       (setq case-fold-search nil)
-      (goto-char (point-min))
-      (when (looking-at vernum)
-       (replace-match vernum t t)
-       (setq beg (length vernum)))
 
-      (goto-char beg)
-      (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
-         (replace-match " [0-9]+/[0-9]+")
+      (end-of-line)
+      (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t)
+         (replace-match "\\1[0-9]+/\\2")
 
-       (goto-char beg)
-       (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
-           (replace-match "[0-9]+ of [0-9]+")
+       (end-of-line)
+       (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)"
+                               nil t)
+           (replace-match "\\1[0-9]+ of \\2")
 
          (end-of-line)
           (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
                                   nil t)
               (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
 
-      (goto-char beg)
+      (goto-char 1)
       (while (re-search-forward "[ \t]+" nil t)
-       (replace-match "[ \t]*" t t))
+       (replace-match "[ \t]+" t t))
 
       (buffer-substring 1 (point-max)))))
 
@@ -1096,8 +1090,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
                     (gnus-uu-reginize-string (gnus-summary-article-subject))))
        list-of-subjects)
     (save-excursion
-      (if (not subject)
-         ()
+      (when subject
        ;; Collect all subjects matching subject.
        (let ((case-fold-search t)
              (data gnus-newsgroup-data)
@@ -1132,7 +1125,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
   (let ((out-list string-list)
        string)
     (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+      (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
       (buffer-disable-undo (current-buffer))
       (while string-list
        (erase-buffer)
@@ -1297,7 +1290,8 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
           (file-exists-p result-file)
           (not gnus-uu-be-dangerous)
           (or (eq gnus-uu-be-dangerous t)
-              (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file)))
+              (gnus-y-or-n-p
+               (format "Delete incomplete file %s? " result-file)))
           (delete-file result-file))
 
       ;; If this was a file of the wrong sort, then
@@ -1355,11 +1349,18 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
 
 (defun gnus-uu-part-number (article)
   (let* ((header (gnus-summary-article-header article))
-        (subject (and header (mail-header-subject header))))
-    (if (and subject
-            (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject))
-       (match-string 0 subject)
-      "")))
+        (subject (and header (mail-header-subject header)))
+        (part nil))
+    (if subject
+       (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+"
+                            subject)
+         (setq part (match-string 0 subject))
+         (setq subject (substring subject (match-end 0)))))
+    (or part
+       (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject)
+         (setq part (match-string 0 subject))
+         (setq subject (substring subject (match-end 0)))))
+    (or part "")))
 
 (defun gnus-uu-uudecode-sentinel (process event)
   (delete-process (get-process process)))
@@ -1417,7 +1418,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
                  (setq gnus-uu-uudecode-process
                        (start-process
                         "*uudecode*"
-                        (get-buffer-create gnus-uu-output-buffer-name)
+                        (gnus-get-buffer-create gnus-uu-output-buffer-name)
                         shell-file-name shell-command-switch
                         (format "cd %s %s uudecode" gnus-uu-work-dir
                                 gnus-shell-command-separator))))
@@ -1483,7 +1484,7 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
        (setq start-char (point))
        (call-process-region
         start-char (point-max) shell-file-name nil
-        (get-buffer-create gnus-uu-output-buffer-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"))))
@@ -1546,13 +1547,13 @@ didn't work, and overwrite existing files.  Otherwise, ask each time."
     (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
 
     (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+      (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
       (erase-buffer))
 
     (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
 
     (if (= 0 (call-process shell-file-name nil
-                          (get-buffer-create gnus-uu-output-buffer-name)
+                          (gnus-get-buffer-create gnus-uu-output-buffer-name)
                           nil shell-command-switch command))
        (message "")
       (gnus-message 2 "Error during unpacking of archive")
@@ -1899,8 +1900,10 @@ If no file has been included, the user will be asked for a file."
     (goto-char (point-max))
     (insert (format "\n%s\n" gnus-uu-post-binary-separator))
 
+    ;; #### Unix-specific?
     (when (string-match "^~/" file-path)
       (setq file-path (concat "$HOME" (substring file-path 1))))
+    ;; #### Unix-specific?
     (if (string-match "/[^/]*$" file-path)
        (setq file-name (substring file-path (1+ (match-beginning 0))))
       (setq file-name file-path))
@@ -1908,7 +1911,7 @@ If no file has been included, the user will be asked for a file."
     (unwind-protect
        (if (save-excursion
              (set-buffer (setq uubuf
-                               (get-buffer-create uuencode-buffer-name)))
+                               (gnus-get-buffer-create uuencode-buffer-name)))
              (erase-buffer)
              (funcall gnus-uu-post-encode-method file-path file-name))
            (insert-buffer-substring uubuf)
@@ -1941,7 +1944,7 @@ If no file has been included, the user will be asked for a file."
     (setq end-binary (point-max))
 
     (save-excursion
-      (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
+      (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name)))
       (erase-buffer)
       (insert-buffer-substring post-buf beg-binary end-binary)
       (goto-char (point-min))
@@ -1973,7 +1976,7 @@ If no file has been included, the user will be asked for a file."
       (setq i 1)
       (setq beg 1)
       (while (not (> i parts))
-       (set-buffer (get-buffer-create send-buffer-name))
+       (set-buffer (gnus-get-buffer-create send-buffer-name))
        (erase-buffer)
        (insert header)
        (when (and threaded gnus-uu-post-message-id)