*** empty log message ***
[gnus] / lisp / gnus-uu.el
index 2223fe0..27d229d 100644 (file)
@@ -73,7 +73,7 @@ There are several user variables to tailor the behaviour of gnus-uu to
 your needs. First we have `gnus-uu-user-view-rules', which is the
 variable gnus-uu first consults when trying to decide how to view a
 file. If this variable contains no matches, gnus-uu examines the
-default rule vaiable provided in this package. If gnus-uu finds no
+default rule variable provided in this package. If gnus-uu finds no
 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
 match.")
 
@@ -185,7 +185,7 @@ Default is nil.")
 
 (defvar gnus-uu-view-and-save nil 
   "*Non-nil means that the user will always be asked to save a file after viewing it.
-If the variable is nil, the suer will only be asked to save if the
+If the variable is nil, the user will only be asked to save if the
 viewing is unsuccessful. Default is nil.")
 
 (defvar gnus-uu-ignore-default-view-rules nil
@@ -211,7 +211,7 @@ it nil.")
 Default is nil.")
 
 (defvar gnus-uu-correct-stripped-uucode nil
-  "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had traling spaces deleted. 
+  "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. 
 Default is nil.")
 
 (defvar gnus-uu-save-in-digest nil
@@ -259,7 +259,7 @@ The headers will be included in the sequence they are matched.")
 (defvar gnus-uu-generated-file-list nil)
 (defvar gnus-uu-work-dir nil)
 
-(defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
+(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
 
 (defconst gnus-uu-highest-article-number 1)
 (defvar gnus-uu-default-dir default-directory)
@@ -323,32 +323,37 @@ The headers will be included in the sequence they are matched.")
   "Decodes and saves the resulting file."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
-                        gnus-uu-default-dir
-                        gnus-uu-default-dir t)))
+        (file-name-as-directory
+         (read-file-name "Uudecode and save in dir: "
+                         gnus-uu-default-dir
+                         gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir))
 
 (defun gnus-uu-decode-unshar (n)
   "Unshars the current article."
   (interactive "P")
-  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n))
+  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan))
 
 (defun gnus-uu-decode-unshar-and-save (n dir)
   "Unshars and saves the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
-                        gnus-uu-default-dir
-                        gnus-uu-default-dir t)))
-  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir))
+        (file-name-as-directory
+         (read-file-name "Unshar and save in dir: "
+                         gnus-uu-default-dir
+                         gnus-uu-default-dir t))))
+  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan))
 
 (defun gnus-uu-decode-save (n file)
   "Saves the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file? "
-                        gnus-uu-default-dir
-                        gnus-uu-default-dir)))
+        (read-file-name 
+         (if gnus-uu-save-separate-articles
+             "Save articles is dir: "
+           "Save articles in file: ")
+         gnus-uu-default-dir
+         gnus-uu-default-dir)))
   (setq gnus-uu-saved-article-name file)
   (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)
   (setq gnus-uu-generated-file-list 
@@ -358,9 +363,10 @@ The headers will be included in the sequence they are matched.")
   "Unbinhexes the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
-                        gnus-uu-default-dir
-                        gnus-uu-default-dir t)))
+        (file-name-as-directory
+         (read-file-name "Unbinhex and save in dir: "
+                         gnus-uu-default-dir
+                         gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
 
 (defun gnus-uu-decode-uu-view (n)
@@ -373,7 +379,7 @@ The headers will be included in the sequence they are matched.")
   "Decodes, views and saves the resulting file."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
+        (read-file-name "Uudecode, view and save in dir: "
                         gnus-uu-default-dir
                         gnus-uu-default-dir t)))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
@@ -389,7 +395,7 @@ The headers will be included in the sequence they are matched.")
   "Unshars and saves the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
+        (read-file-name "Unshar, view and save in dir: "
                         gnus-uu-default-dir
                         gnus-uu-default-dir t)))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
@@ -399,8 +405,10 @@ The headers will be included in the sequence they are matched.")
   "Saves and views the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file? "
-                        gnus-uu-default-dir gnus-uu-default-dir)))
+        (read-file-name  (if gnus-uu-save-separate-articles
+                             "Save articles is dir: "
+                           "Save articles in file: ")
+                         gnus-uu-default-dir gnus-uu-default-dir)))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
     (gnus-uu-decode-save n file)))
 
@@ -408,7 +416,7 @@ The headers will be included in the sequence they are matched.")
   "Unbinhexes and views the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
+        (read-file-name "Unbinhex, view and save in dir: "
                         gnus-uu-default-dir gnus-uu-default-dir)))
   (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
     (gnus-uu-decode-binhex n file)))
@@ -419,10 +427,8 @@ The headers will be included in the sequence they are matched.")
 (defun gnus-uu-digest-mail-forward (n &optional post)
   "Digests and forwards all articles in this series."
   (interactive "P")
-  (gnus-uu-initialize)
   (let ((gnus-uu-save-in-digest t)
-       (file (concat gnus-uu-work-dir (make-temp-name "forward")))
-       (winconf (current-window-configuration))
+       (file (make-temp-name (concat gnus-uu-tmp-dir "forward")))
        buf)
     (gnus-uu-decode-save n file)
     (gnus-uu-add-file file)
@@ -444,6 +450,7 @@ The headers will be included in the sequence they are matched.")
     (if post
        (gnus-forward-using-post)
       (funcall gnus-mail-forward-method))
+    (delete-file file)
     (kill-buffer buf)))
 
 (defun gnus-uu-digest-post-forward (n)
@@ -552,9 +559,10 @@ The headers will be included in the sequence they are matched.")
   "Extracts postscript and saves the current article."
   (interactive
    (list current-prefix-arg
-        (read-file-name "Where do you want to save the file(s)? "
-                        gnus-uu-default-dir
-                        gnus-uu-default-dir t)))
+        (file-name-as-directory
+         (read-file-name "Save in dir: "
+                         gnus-uu-default-dir
+                         gnus-uu-default-dir t))))
   (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir))
 
 
@@ -571,17 +579,34 @@ The headers will be included in the sequence they are matched.")
 
 ;; Internal functions.
 
-(defun gnus-uu-decode-with-method (method n &optional save not-insert)
+(defun gnus-uu-decode-with-method (method n &optional save not-insert scan)
   (gnus-uu-initialize)
   (if save (setq gnus-uu-default-dir save))
   (let ((articles (gnus-uu-get-list-of-articles n))
        files)
     (setq files (gnus-uu-grab-articles articles method t))
+    (let ((gnus-current-article (car articles)))
+      (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
     (and save (gnus-uu-save-files files save))
     (setq files (gnus-uu-unpack-files files))
     (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files))
     (setq files (nreverse (gnus-uu-get-actions files)))
-    (or not-insert (gnus-summary-insert-pseudos files))))
+    (or not-insert (gnus-summary-insert-pseudos files save))))
+
+;; Return a list of files in dir.
+(defun gnus-uu-scan-directory (dir)
+  (let ((files (directory-files dir t))
+       dirs out)
+    (while files
+      (cond ((string-match "/\\.\\.?$" (car files)))
+           ((file-directory-p (car files))
+            (setq dirs (cons (car files) dirs)))
+           (t (setq out (cons (list (cons 'name (car files))
+                                    (cons 'article gnus-current-article))
+                              out))))
+      (setq files (cdr files)))
+    (apply 'nconc out (mapcar (lambda (d) (gnus-uu-scan-directory d))
+                             dirs))))
 
 (defun gnus-uu-save-files (files dir)
   (let ((len (length files))
@@ -594,7 +619,8 @@ The headers will be included in the sequence they are matched.")
                               (concat dir (file-name-nondirectory file))
                             dir))
             (and (or (not (file-exists-p to-file))
-                     (gnus-y-or-n-p (format "%s exists; overwrite? " to-file)))
+                     (gnus-y-or-n-p (format "%s exists; overwrite? "
+                                            to-file)))
                  (copy-file file to-file 1 t))))
       (setq files (cdr files)))
     (message "Saved %d file%s" len (if (> len 1) "s" ""))))
@@ -661,7 +687,8 @@ The headers will be included in the sequence they are matched.")
                         (concat sorthead
                                 (buffer-substring 
                                  (match-beginning 0)
-                                 (or (re-search-forward "^[^ \t]" nil t)
+                                 (or (and (re-search-forward "^[^ \t]" nil t)
+                                          (1- (point)))
                                      (progn (forward-line 1) (point))))))))
             (widen)))
         (insert sorthead)(goto-char (point-max))
@@ -775,7 +802,9 @@ The headers will be included in the sequence they are matched.")
       (setq name (cdr (assq 'name (car files))))
       (and 
        (setq action (gnus-uu-get-action name))
-       (setcar files (nconc (list (cons 'action action)
+       (setcar files (nconc (list (if (string= action "gnus-uu-archive")
+                                     (cons 'action "file")
+                                   (cons 'action action))
                                  (cons 'execute (if (string-match "%" action)
                                                     (format action name)
                                                   (concat action " " name))))
@@ -813,7 +842,7 @@ The headers will be included in the sequence they are matched.")
   ;; my experience, should get most postings of a series.
   (let ((count 2)
        (vernum "v[0-9]+[a-z][0-9]+:")
-       reg beg)
+       beg)
     (save-excursion
       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
       (buffer-disable-undo (current-buffer))
@@ -859,7 +888,7 @@ The headers will be included in the sequence they are matched.")
   ;; returned. 
   ;; Failing that, articles that have subjects that are part of the
   ;; same "series" as the current will be returned.
-  (let (articles process)
+  (let (articles)
   (cond 
    (n
     (let ((backward (< n 0))
@@ -887,7 +916,7 @@ The headers will be included in the sequence they are matched.")
   ;; non-nil, article names are not equalized before sorting.
   (let ((subject (or subject 
                     (gnus-uu-reginize-string (gnus-summary-subject-string))))
-       beg end list-of-subjects)
+       list-of-subjects)
     (save-excursion
       (if (not subject)
          ()
@@ -923,7 +952,7 @@ The headers will be included in the sequence they are matched.")
   ;; sorting to find out what sequence the articles are supposed to be
   ;; decoded in. Returns the list of expanded strings.
   (let ((out-list string-list)
-       string pos num)
+       string)
     (save-excursion
       (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
       (buffer-disable-undo (current-buffer))
@@ -1001,10 +1030,8 @@ The headers will be included in the sequence they are matched.")
 (defun gnus-uu-grab-articles 
   (articles process-function &optional sloppy limit no-errors)
   (let ((state 'first) 
-       (wrong-type t)
-       has-been-begin has-been-end 
-       article result-file result-files process-state article-buffer
-       begin-article)
+       has-been-begin article result-file result-files process-state 
+       article-buffer)
  
     (if (not (gnus-server-opened gnus-current-select-method))
        (progn
@@ -1033,7 +1060,7 @@ The headers will be included in the sequence they are matched.")
       (message "Getting article %d, %s" article (gnus-uu-part-number article))
 
       (if (not (= (or gnus-current-article 0) article))
-         (progn
+         (let ((nntp-async-number nil))
            (gnus-request-article article gnus-newsgroup-name
                                  nntp-server-buffer)
            (setq gnus-last-article gnus-current-article)
@@ -1061,9 +1088,7 @@ The headers will be included in the sequence they are matched.")
                    (delete-file result-file)))
            (if (memq 'begin process-state)
                (setq result-file (car process-state)))
-           (setq begin-article article)
-           (setq has-been-begin t)
-           (setq has-been-end nil)))
+           (setq has-been-begin t)))
 
       (if (memq 'end process-state)
          (progn
@@ -1071,7 +1096,6 @@ The headers will be included in the sequence they are matched.")
            (setq result-files (cons (list (cons 'name result-file)
                                           (cons 'article article))
                                     result-files))
-           (setq has-been-end t)
            (setq has-been-begin nil)
            (and limit (= (length result-files) limit)
                 (setq articles nil))))
@@ -1082,12 +1106,10 @@ The headers will be included in the sequence they are matched.")
                    (delete-file result-file)))
 
       (if (not (memq 'wrong-type process-state))
-         (setq wrong-type nil)
+         ()
        (if gnus-uu-unmark-articles-not-decoded
            (gnus-summary-tick-article article t)))
 
-      (if sloppy (setq wrong-type nil))
-
       (if (and (not has-been-begin)
               (not sloppy)
               (or (memq 'end process-state)
@@ -1164,10 +1186,15 @@ The headers will be included in the sequence they are matched.")
 
          (if (looking-at gnus-uu-begin-string)
              (progn 
-               (setq name-end (match-end 1))
-
+               (setq name-end (match-end 1)
+                     name-beg (match-beginning 1))
+               ;; Remove any non gnus-uu-body-line right after start.
+               (forward-line 1)
+               (or (looking-at gnus-uu-body-line)
+                   (gnus-delete-line))
                ; Replace any slashes and spaces in file names before decoding
-               (goto-char (setq name-beg (match-beginning 1)))
+               (goto-char name-beg)
                (while (re-search-forward "/" name-end t)
                  (replace-match ","))
                (goto-char name-beg)
@@ -1225,7 +1252,7 @@ The headers will be included in the sequence they are matched.")
                            nil t)
                           (forward-line 1)))
 
-                    (condition-case err
+                    (condition-case nil
                         (process-send-region gnus-uu-uudecode-process 
                                              start-char (point))
                       (error 
@@ -1300,7 +1327,7 @@ The headers will be included in the sequence they are matched.")
 (defun gnus-uu-treat-archive (file-path)
   ;; Unpacks an archive. Returns t if unpacking is successful.
   (let ((did-unpack t)
-       action command files file file-name dir)
+       action command dir)
     (setq action (gnus-uu-choose-action 
                  file-path (append gnus-uu-user-archive-rules
                                    (if gnus-uu-ignore-default-archive-rules
@@ -1310,7 +1337,6 @@ The headers will be included in the sequence they are matched.")
     (if (not action) (error "No unpackers for the file %s" file-path))
 
     (string-match "/[^/]*$" file-path)
-    (setq file-name (substring file-path (1+ (match-beginning 0))))
     (setq dir (substring file-path 0 (match-beginning 0)))
 
     (if (member action gnus-uu-destructive-archivers)
@@ -1350,9 +1376,10 @@ The headers will be included in the sequence they are matched.")
   ;; Go through FILES and look for files to unpack. 
   (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
         (ofiles files)
-        file did-unpack)
+        file did-unpack file-entry)
+    (gnus-uu-add-file totfiles) 
     (while files
-      (setq file (cdr (assq 'name (car files))))
+      (setq file (cdr (setq file-entry (assq 'name (car files)))))
       (if (and (not (member file ignore))
               (equal (gnus-uu-get-action (file-name-nondirectory file))
                      "gnus-uu-archive"))
@@ -1362,6 +1389,7 @@ The headers will be included in the sequence they are matched.")
                (message "Error during unpacking of %s" file))
            (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
                   (nfiles newfiles))
+             (gnus-uu-add-file newfiles)
              (while nfiles
                (or (member (car nfiles) totfiles)
                    (setq ofiles (cons (list (cons 'name (car nfiles))
@@ -1399,7 +1427,7 @@ The headers will be included in the sequence they are matched.")
     out))
 
 (defun gnus-uu-check-correct-stripped-uucode (start end)
-  (let (found beg length short)
+  (let (found beg length)
     (if (not gnus-uu-correct-stripped-uucode)
        ()
       (goto-char start)
@@ -1430,23 +1458,35 @@ The headers will be included in the sequence they are matched.")
                (insert (make-string (- length (- (point) beg)) ? ))))
          (forward-line 1))))))
 
+(defvar gnus-uu-tmp-alist nil)
+
 (defun gnus-uu-initialize ()
-  (setq gnus-uu-highest-article-number 1)
-  (gnus-uu-check-for-generated-files)
-  (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir))
-  (if (string-match "[^/]$" gnus-uu-tmp-dir) 
-      (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/")))
-  (if (not (file-directory-p gnus-uu-tmp-dir))
-      (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
-    (if (not (file-writable-p gnus-uu-tmp-dir))
-       (error "Temp directory %s can't be written to" gnus-uu-tmp-dir)))
-  (setq gnus-uu-work-dir 
-       (concat gnus-uu-tmp-dir (make-temp-name "gnus")))
-  (gnus-uu-add-file gnus-uu-work-dir)
-  (if (not (file-directory-p gnus-uu-work-dir)) 
-      (make-directory gnus-uu-work-dir))
-  (set-file-modes gnus-uu-work-dir 448)
-  (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")))
+  (let (entry)
+    (if (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
+           (if (file-exists-p (cdr entry))
+               (setq gnus-uu-work-dir (cdr entry))
+             (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
+             nil))
+       t
+      (setq gnus-uu-highest-article-number 1)
+      (setq gnus-uu-tmp-dir (file-name-as-directory 
+                            (expand-file-name gnus-uu-tmp-dir)))
+      (if (not (file-directory-p gnus-uu-tmp-dir))
+         (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
+       (if (not (file-writable-p gnus-uu-tmp-dir))
+           (error "Temp directory %s can't be written to" 
+                  gnus-uu-tmp-dir)))
+
+      (setq gnus-uu-work-dir 
+           (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
+      (gnus-uu-add-file gnus-uu-work-dir)
+      (if (not (file-directory-p gnus-uu-work-dir)) 
+         (gnus-make-directory gnus-uu-work-dir))
+      (set-file-modes gnus-uu-work-dir 448)
+      (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
+      (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir)
+                                   gnus-uu-tmp-alist)))))
+
 
 ;; Kills the temporary uu buffers, kills any processes, etc.
 (defun gnus-uu-clean-up ()
@@ -1491,10 +1531,10 @@ The headers will be included in the sequence they are matched.")
          (append file gnus-uu-generated-file-list))))
 
 ;; Inputs an action and a file and returns a full command, putting
-;; ticks round the file name and escaping any ticks in the file name.
+;; quotes round the file name and escaping any quotes in the file name.
 (defun gnus-uu-command (action file)
   (let ((ofile ""))
-    (while (string-match "`\\|\"\\|\\$\\|\\\\" file)
+    (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file)
       (progn
        (setq ofile
              (concat ofile (substring file 0 (match-beginning 0)) "\\"
@@ -1535,7 +1575,7 @@ uuencode and adds MIME headers.")
 (defvar gnus-uu-post-include-before-composing nil
   "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
 If this variable is t, you can either include an encoded file with
-\\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
+\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
 
 (defvar gnus-uu-post-length 990
   "Maximum length of an article.
@@ -1571,7 +1611,6 @@ is t.")
 
   (use-local-map (copy-keymap (current-local-map)))
   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
-  (local-set-key "\C-c\C-f\C-a" 'gnus-uu-post-reply-summary)
   (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
   (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
   (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
@@ -1656,7 +1695,7 @@ If no file has been included, the user will be asked for a file."
               (if (memq 'Message-ID gnus-required-headers)
                   gnus-required-headers
                 (cons 'Message-ID gnus-required-headers)))
-             gnus-inews-article-hook elem)
+             gnus-inews-article-hook)
 
          (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
                                            gnus-inews-article-hook
@@ -1682,7 +1721,7 @@ If no file has been included, the user will be asked for a file."
 ;; the current buffer. Returns the file name the user gave.
 (defun gnus-uu-post-insert-binary ()
   (let ((uuencode-buffer-name "*uuencode buffer*")
-       file-path post-buf uubuf file-name)
+       file-path uubuf file-name)
 
     (setq file-path (read-file-name 
                     "What file do you want to encode? "))
@@ -1715,7 +1754,7 @@ If no file has been included, the user will be asked for a file."
        (encoded-buffer-name "*encoded buffer*")
        (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
        (separator (concat mail-header-separator "\n\n"))
-       file uubuf length parts header i end beg
+       uubuf length parts header i end beg
        beg-line minlen buf post-buf whole-len beg-binary end-binary)
 
     (setq post-buf (current-buffer))