X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=27d229dbbc568a7ada9dc4f6cbc572197e4e6fb2;hb=a9ea2f8e352007f14f77dccac95b32e51de1eaf8;hp=2223fe0cdc6122d2b43dc533c0ac08efbca0d96e;hpb=90d5d722141b45cf27a7cb587785d60b557bc571;p=gnus diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 2223fe0cd..27d229dbb 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -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-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))