X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=f0f54a54d003476cf0e775c0d4e025a418027e64;hb=6335e3308b5e6287e63024fa905c93b41a285575;hp=646da71c009d957f08dca355176365c7efa95a2a;hpb=7daaa2d776d3846b933c51bf1ccf5c5cc22a1437;p=gnus diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 646da71c0..f0f54a54d 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -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, -;; 2001, 2002 Free Software Foundation, Inc. +;; 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -299,7 +299,8 @@ so I simply dropped them." "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" "^Content-ID:") "*List of regexps to match headers included in digested messages. -The headers will be included in the sequence they are matched." +The headers will be included in the sequence they are matched. If nil +include all headers." :group 'gnus-extract :type '(repeat regexp)) @@ -509,11 +510,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Various")))) (goto-char (point-min)) (when (re-search-forward "^Subject: ") - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) (insert subject)) (goto-char (point-min)) (when (re-search-forward "^From:") - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) (insert " " from)) (let ((message-forward-decoded-p t)) (message-forward post t)))) @@ -571,11 +572,12 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-mark-series () "Mark the current series with the process mark." (interactive) - (let ((articles (gnus-uu-find-articles-matching))) + (let* ((articles (gnus-uu-find-articles-matching)) + (l (length articles))) (while articles (gnus-summary-set-process-mark (car articles)) (setq articles (cdr articles))) - (message "")) + (message "Marked %d articles" l)) (gnus-summary-position-point)) (defun gnus-uu-mark-region (beg end &optional unmark) @@ -847,7 +849,7 @@ When called interactively, prompt for REGEXP." (save-restriction (set-buffer buffer) (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) (put-text-property (point-min) (point-max) 'intangible nil)) @@ -868,7 +870,7 @@ When called interactively, prompt for REGEXP." (setq body (buffer-substring (1- (point)) (point-max))) (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-substring (point-min) (point-max))) + (setq sorthead (buffer-string)) (while headers (setq headline (car headers)) (setq headers (cdr headers)) @@ -1088,7 +1090,7 @@ When called interactively, prompt for REGEXP." (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]+" t t)) - (buffer-substring (point-min) (point-max)))) + (buffer-string))) (defun gnus-uu-get-list-of-articles (n) ;; If N is non-nil, the article numbers of the N next articles @@ -1148,7 +1150,7 @@ When called interactively, prompt for REGEXP." ;; Expand numbers, sort, and return the list of article ;; numbers. - (mapcar (lambda (sub) (cdr sub)) + (mapcar 'cdr (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) @@ -1350,23 +1352,23 @@ When called interactively, prompt for REGEXP." (setq process-state (list 'error)) (gnus-message 2 "No begin part at the beginning") (sleep-for 2)) - (setq state 'middle))) - + (setq state 'middle)))) + ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t))))) + (if result-files + (message "") + (cond + ((not has-been-begin) + (gnus-message 2 "Wrong type file")) + ((memq 'error process-state) + (gnus-message 2 "An error occurred during decoding")) + ((not (or (memq 'ok process-state) + (memq 'end process-state))) + (gnus-message 2 "End of articles reached before end of file"))) + ;; Make unsuccessfully decoded articles unread. + (when gnus-uu-unmark-articles-not-decoded + (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) @@ -1401,7 +1403,7 @@ When called interactively, prompt for REGEXP." (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) + (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 ""))) @@ -1436,9 +1438,9 @@ When called interactively, prompt for REGEXP." ;; This is the beginning of a uuencoded article. ;; 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)))) + (gnus-map-function + mm-file-name-rewrite-functions + (file-name-nondirectory (match-string 1)))) (replace-match (concat "begin 644 " gnus-uu-file-name) t t) ;; Remove any non gnus-uu-body-line right after start. @@ -1628,7 +1630,7 @@ Gnus might fail to display all of it.") (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - (if (= 0 (call-process shell-file-name nil + (if (eq 0 (call-process shell-file-name nil (gnus-get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") @@ -1703,8 +1705,7 @@ Gnus might fail to display all of it.") (defun gnus-uu-check-correct-stripped-uucode (start end) (save-excursion (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () + (unless gnus-uu-correct-stripped-uucode (goto-char start) (if (re-search-forward " \\|`" end t) @@ -1717,19 +1718,15 @@ Gnus might fail to display all of it.") (forward-line 1)))) (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () + (unless (looking-at (concat gnus-uu-begin-string "\\|" + gnus-uu-end-string)) (when (not found) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg))) + (setq length (- (point-at-eol) (point-at-bol)))) (setq found t) (beginning-of-line) (setq beg (point)) (end-of-line) - (when (not (= length (- (point) beg))) + (unless (= length (- (point) beg)) (insert (make-string (- length (- (point) beg)) ? )))) (forward-line 1))))))) @@ -1774,7 +1771,7 @@ Gnus might fail to display all of it.") ;; that the filename will be treated as a single argument when the shell ;; executes the command. (defun gnus-uu-command (action file) - (let ((quoted-file (mm-quote-arg file))) + (let ((quoted-file (shell-quote-argument file))) (if (string-match "%s" action) (format action quoted-file) (concat action " " quoted-file)))) @@ -1793,9 +1790,13 @@ Gnus might fail to display all of it.") (if (file-directory-p file) (gnus-uu-delete-work-dir file) (gnus-message 9 "Deleting file %s..." file) - (delete-file file)))) - (delete-directory dir))) - (gnus-message 7 "")) + (condition-case err + (delete-file file) + (error (gnus-message 3 "Deleting file %s failed... %s" file err)))))) + (condition-case err + (delete-directory dir) + (error (gnus-message 3 "Deleting directory %s failed... %s" file err)))) + (gnus-message 7 ""))) ;; Initializing @@ -1906,8 +1907,8 @@ The user will be asked for a file name." ;; Encodes with base64 and adds MIME headers (defun gnus-uu-post-encode-mime (path file-name) - (when (zerop (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s -o %s" "mmencode" path file-name))) + (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch + (format "%s %s -o %s" "mmencode" path file-name))) (gnus-uu-post-make-mime file-name "base64") t)) @@ -1932,8 +1933,8 @@ The user will be asked for a file name." ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) + (eq 0 (call-process shell-file-name nil t nil shell-command-switch + (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () "Posts the composed news article and encoded file. @@ -2025,8 +2026,7 @@ If no file has been included, the user will be asked for a file." (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring (point-min) (point))) + (setq header (buffer-substring (point-min) (point-at-bol))) (goto-char (point-min)) (when gnus-uu-post-separate-description @@ -2102,8 +2102,7 @@ If no file has been included, the user will be asked for a file." (when (not gnus-uu-post-separate-description) (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) + (bury-buffer)))) (provide 'gnus-uu)