;;; 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-2016 Free Software
+;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Created: 2 Oct 1993
:group 'gnus)
(defgroup gnus-extract-view nil
- "Viewwing extracted files."
+ "Viewing extracted files."
:group 'gnus-extract)
(defgroup gnus-extract-archive nil
For example:
-To make gnus-uu use 'xli' to display JPEG and GIF files, put the
+To make gnus-uu use `xli' to display JPEG and GIF files, put the
following in your .emacs file:
- (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
+ (setq gnus-uu-user-view-rules \\='((\"jpg$\\\\|gif$\" \"xli\")))
Both these variables are lists of lists with two string elements. The
first string is a regular expression. If the file name matches this
(defcustom gnus-uu-user-archive-rules nil
"A list that can be set to override the default archive unpacking commands.
-To use, for instance, 'untar' to unpack tar files and 'zip -x' to
+To use, for instance, `untar' to unpack tar files and `zip -x' to
unpack zip files, say the following:
(setq gnus-uu-user-archive-rules
- '((\"\\\\.tar$\" \"untar\")
+ \\='((\"\\\\.tar$\" \"untar\")
(\"\\\\.zip$\" \"zip -x\")))"
:group 'gnus-extract-archive
:type '(repeat (group regexp (string :tag "Command"))))
(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\\)")
(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))
(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))
"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))
(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))))
+ (gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
(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)
"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)))
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
+ (gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(defun gnus-uu-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series."
(interactive "P")
+ (gnus-uu-initialize)
(let ((gnus-uu-save-in-digest t)
- (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
+ (file (mm-make-temp-file (nnheader-concat gnus-uu-work-dir "forward")))
(message-forward-as-mime message-forward-as-mime)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-set-process-mark
(gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1 nil t))
+ (zerop (forward-line 1))
(> (gnus-summary-thread-level) level)))))
(gnus-summary-position-point))
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-remove-process-mark
(gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1))
+ (zerop (forward-line 1))
(> (gnus-summary-thread-level) level))))
(gnus-summary-position-point))
;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
(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))
(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
(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)))
((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
(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"
(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
+ (with-current-buffer buffer
(save-restriction
- (set-buffer buffer)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(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)
(match-beginning 0)
(or (and (re-search-forward "^[^ \t]" nil t)
(1- (point)))
- (progn (forward-line 1) (point)))))))))
- (widen)))
+ (progn (forward-line 1) (point)))))))))))
(if (and message-forward-as-mime gnus-uu-digest-buffer)
(if message-forward-show-mml
(progn
(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))
(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
(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))
(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))
;; 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)
(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))
;; 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))
;; 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)
;; 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)
(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)))))
(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)
(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))
(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))
gnus-shell-command-separator " sh")))))
state))
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
- (let ((oldpoint (point))
- res)
- (goto-char (point-min))
- (when (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
- (goto-char oldpoint)
- res))
-
;; `gnus-uu-choose-action' chooses what action to perform given the name
;; and `gnus-uu-file-action-list'. Returns either nil if no action is
;; found, or the name of the command to run if such a rule is found.
(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))
;; Initializing
-(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
+(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-clean-up)
+(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-delete-work-dir)
\f
(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)
(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))
(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))
(provide 'gnus-uu)
-;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853
;;; gnus-uu.el ends here