X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=717b6162a1b4129622429049d57895216668ee1a;hb=f440c42e7560dd0044172200683f109567296be4;hp=3cce1e6973a8c594b88f26000e9474022c42c43a;hpb=9a8731d6dea8021a10dec1b42f382609336a9aa9;p=gnus diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 3cce1e697..717b6162a 100644 --- 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, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1993-1998, 2000-2012 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -41,7 +41,7 @@ :group 'gnus) (defgroup gnus-extract-view nil - "Viewwing extracted files." + "Viewing extracted files." :group 'gnus-extract) (defgroup gnus-extract-archive nil @@ -335,7 +335,6 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-shar-begin-string "^#! */bin/sh") -(defvar gnus-uu-shar-file-name nil) (defvar gnus-uu-shar-name-marker "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)") @@ -367,7 +366,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (file-name-as-directory - (read-file-name "Uudecode and save in dir: " + (read-directory-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 nil nil t)) @@ -382,7 +381,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (file-name-as-directory - (read-file-name "Unshar and save in dir: " + (read-directory-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 t)) @@ -391,12 +390,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Saves the current article." (interactive (list current-prefix-arg - (read-file-name - (if gnus-uu-save-separate-articles - "Save articles in dir: " - "Save articles in file: ") - gnus-uu-default-dir - gnus-uu-default-dir))) + (if gnus-uu-save-separate-articles + (read-directory-name + "Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir) + (read-file-name + "Save article 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)) @@ -405,7 +403,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (file-name-as-directory - (read-file-name "Unbinhex and save in dir: " + (read-directory-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-binhex-article-name @@ -417,7 +415,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (interactive (list current-prefix-arg (file-name-as-directory - (read-file-name "yEnc decode and save in dir: " + (read-directory-name "yEnc decode and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-yenc-article-name nil) @@ -459,10 +457,11 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "Saves and views the current article." (interactive (list current-prefix-arg - (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))) + (if gnus-uu-save-separate-articles + (read-directory-name "Save articles in dir: " + gnus-uu-default-dir gnus-uu-default-dir) + (read-file-name "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))) @@ -728,7 +727,7 @@ When called interactively, prompt for REGEXP." ;; All PostScript functions written by Erik Selberg . (defun gnus-uu-decode-postscript (&optional n) - "Gets postscript of the current article." + "Gets PostScript of the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) @@ -739,11 +738,11 @@ When called interactively, prompt for REGEXP." (gnus-uu-decode-postscript n))) (defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts postscript and saves the current article." + "Extracts PostScript and saves the current article." (interactive (list current-prefix-arg (file-name-as-directory - (read-file-name "Save in dir: " + (read-directory-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article @@ -827,8 +826,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-save-article (buffer in-state) (cond (gnus-uu-save-separate-articles - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (let ((coding-system-for-write mm-text-coding-system)) (gnus-write-buffer (concat gnus-uu-saved-article-name gnus-current-article))) @@ -838,8 +836,7 @@ When called interactively, prompt for REGEXP." ((eq in-state 'last) (list 'end)) (t (list 'middle))))) ((not gnus-uu-save-in-digest) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (write-region (point-min) (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name @@ -857,11 +854,9 @@ When called interactively, prompt for REGEXP." (eq in-state 'first-and-last)) (progn (setq state (list 'begin)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*gnus-uu-body*")) + (with-current-buffer (gnus-get-buffer-create "*gnus-uu-body*") (erase-buffer)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) + (with-current-buffer (gnus-get-buffer-create "*gnus-uu-pre*") (erase-buffer) (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" @@ -873,8 +868,7 @@ When called interactively, prompt for REGEXP." (insert "Topics:\n"))) (when (not (eq in-state 'end)) (setq state (list 'middle)))) - (save-excursion - (set-buffer "*gnus-uu-body*") + (with-current-buffer "*gnus-uu-body*" (goto-char (setq beg (point-max))) (save-excursion (save-restriction @@ -940,8 +934,7 @@ When called interactively, prompt for REGEXP." (when (re-search-forward "^Subject: \\(.*\\)$" nil t) (setq subj (buffer-substring (match-beginning 1) (match-end 1)))) (when subj - (save-excursion - (set-buffer "*gnus-uu-pre*") + (with-current-buffer "*gnus-uu-pre*" (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) (eq in-state 'first-and-last)) @@ -951,8 +944,7 @@ When called interactively, prompt for REGEXP." (insert-buffer-substring "*gnus-uu-pre*") (goto-char (point-max)) (insert-buffer-substring "*gnus-uu-body*")) - (save-excursion - (set-buffer "*gnus-uu-pre*") + (with-current-buffer "*gnus-uu-pre*" (insert (format "\n\n%s\n\n" (make-string 70 ?-))) (if gnus-uu-digest-buffer (with-current-buffer gnus-uu-digest-buffer @@ -960,8 +952,7 @@ When called interactively, prompt for REGEXP." (insert-buffer-substring "*gnus-uu-pre*")) (let ((coding-system-for-write mm-text-coding-system)) (gnus-write-buffer gnus-uu-saved-article-name)))) - (save-excursion - (set-buffer "*gnus-uu-body*") + (with-current-buffer "*gnus-uu-body*" (goto-char (point-max)) (insert (concat (setq end-string (format "End of %s Digest" name)) @@ -993,8 +984,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-binhex-article (buffer in-state) (let (state start-char) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (widen) (goto-char (point-min)) (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) @@ -1030,8 +1020,7 @@ When called interactively, prompt for REGEXP." ;; yEnc (defun gnus-uu-yenc-article (buffer in-state) - (save-excursion - (set-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer (widen) (let ((file-name (yenc-extract-filename)) state start-char) @@ -1065,8 +1054,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-decode-postscript-article (process-buffer in-state) (let ((state (list 'ok)) start-char end-char file-name) - (save-excursion - (set-buffer process-buffer) + (with-current-buffer process-buffer (goto-char (point-min)) (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) (setq state (list 'wrong-type)) @@ -1128,8 +1116,7 @@ When called interactively, prompt for REGEXP." ;; 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]+". - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) + (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) (buffer-disable-undo) (erase-buffer) (insert (regexp-quote string)) @@ -1228,8 +1215,7 @@ When called interactively, prompt for REGEXP." ;; decoded in. Returns the list of expanded strings. (let ((out-list string-list) string) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) + (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) (buffer-disable-undo) (while string-list (erase-buffer) @@ -1304,6 +1290,7 @@ When called interactively, prompt for REGEXP." ;; the process-function has been successful and nil otherwise. (defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) + (require 'gnus-async) (let ((state 'first) (gnus-asynchronous nil) (gnus-inhibit-treatment t) @@ -1332,11 +1319,9 @@ When called interactively, prompt for REGEXP." (gnus-summary-display-article article) ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (setq process-state (funcall process-function gnus-original-article-buffer state))))) @@ -1477,8 +1462,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-uustrip-article (process-buffer in-state) ;; Uudecodes a file asynchronously. - (save-excursion - (set-buffer process-buffer) + (with-current-buffer process-buffer (let ((state (list 'wrong-type)) process-connection-type case-fold-search buffer-read-only files start-char) @@ -1488,7 +1472,7 @@ When called interactively, prompt for REGEXP." (when gnus-uu-kill-carriage-return (save-excursion (while (search-forward "\r" nil t) - (delete-backward-char 1)))) + (delete-char -1)))) (while (or (re-search-forward gnus-uu-begin-string nil t) (re-search-forward gnus-uu-body-line nil t)) @@ -1600,8 +1584,7 @@ Gnus might fail to display all of it.") (defun gnus-uu-unshar-article (process-buffer in-state) (let ((state (list 'ok)) start-char) - (save-excursion - (set-buffer process-buffer) + (with-current-buffer process-buffer (goto-char (point-min)) (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) (setq state (list 'wrong-type)) @@ -1688,8 +1671,7 @@ Gnus might fail to display all of it.") (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) + (with-current-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name) (erase-buffer)) (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) @@ -2039,9 +2021,8 @@ If no file has been included, the user will be asked for a file." (setq file-name file-path)) (unwind-protect - (if (save-excursion - (set-buffer (setq uubuf - (gnus-get-buffer-create uuencode-buffer-name))) + (if (with-current-buffer + (setq uubuf (gnus-get-buffer-create uuencode-buffer-name)) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) (insert-buffer-substring uubuf) @@ -2073,8 +2054,8 @@ If no file has been included, the user will be asked for a file." (setq beg-binary (point)) (setq end-binary (point-max)) - (save-excursion - (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name))) + (with-current-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)) @@ -2129,8 +2110,7 @@ If no file has been included, the user will be asked for a file." (insert (format " (%d/%d)" i parts))) (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) + (with-current-buffer uubuf (goto-char beg) (if (= i parts) (goto-char (point-max)) @@ -2170,5 +2150,4 @@ If no file has been included, the user will be asked for a file." (provide 'gnus-uu) -;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853 ;;; gnus-uu.el ends here