;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1985-1987, 1993-1998, 2000-2012
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Created: 2 Oct 1993
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'message)
(require 'gnus-msg)
(require 'mm-decode)
+(require 'yenc)
(defgroup gnus-extract nil
"Extracting encoded files."
:group 'gnus)
(defgroup gnus-extract-view nil
- "Viewwing extracted files."
+ "Viewing extracted files."
:group 'gnus-extract)
(defgroup gnus-extract-archive nil
("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
"gnus-uu-archive"))
"*Default actions to be taken when the user asks to view a file.
-To change the behaviour, you can either edit this variable or set
+To change the behavior, you can either edit this variable or set
`gnus-uu-user-view-rules' to something useful.
For example:
command string, the file name will be appended to the command string
before executing.
-There are several user variables to tailor the behaviour of gnus-uu to
+There are several user variables to tailor the behavior 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
"^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))
(defvar gnus-uu-saved-article-name nil)
-(defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
(defvar gnus-uu-end-string "^end[ \t]*$")
(defvar gnus-uu-body-line "^M")
(defvar gnus-uu-shar-begin-string "^#! */bin/sh")
-(defvar gnus-uu-shar-file-name nil)
(defvar gnus-uu-shar-name-marker
- "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+ "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
(defvar gnus-uu-postscript-begin-string "^%!PS-")
(defvar gnus-uu-postscript-end-string "^%%EOF$")
(defvar gnus-uu-file-name nil)
(defvar gnus-uu-uudecode-process nil)
(defvar gnus-uu-binhex-article-name nil)
+(defvar gnus-uu-yenc-article-name nil)
(defvar gnus-uu-work-dir nil)
(defvar gnus-uu-digest-from-subject nil)
(defvar gnus-uu-digest-buffer nil)
-;; Keymaps
-
-(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "g" gnus-uu-unmark-region
- "R" gnus-uu-mark-by-regexp
- "G" gnus-uu-unmark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark
- "i" gnus-uu-invert-processable)
-
-(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- "m" gnus-summary-save-parts
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
-
-
;; Commands.
(defun gnus-uu-decode-uu (&optional n)
(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 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 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))))
(setq gnus-uu-binhex-article-name
- (make-temp-name (concat gnus-uu-work-dir "binhex")))
+ (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
+(defun gnus-uu-decode-yenc (n dir)
+ "Decode the yEnc-encoded current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (read-directory-name "yEnc decode and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir))))
+ (setq gnus-uu-yenc-article-name nil)
+ (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t))
+
(defun gnus-uu-decode-uu-view (&optional n)
"Uudecodes and views the current article."
(interactive "P")
"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)))
(read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
(setq gnus-uu-binhex-article-name
- (make-temp-name (concat gnus-uu-work-dir "binhex")))
+ (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-binhex n file)))
"Digests and forwards all articles in this series."
(interactive "P")
(let ((gnus-uu-save-in-digest t)
- (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward")))
+ (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
(message-forward-as-mime message-forward-as-mime)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(if (and n (not (numberp n)))
(setq message-forward-as-mime (not message-forward-as-mime)
n nil))
- (gnus-setup-message 'forward
- (setq gnus-uu-digest-from-subject nil)
- (setq gnus-uu-digest-buffer
- (gnus-get-buffer-create " *gnus-uu-forward*"))
- (gnus-uu-decode-save n file)
- (switch-to-buffer gnus-uu-digest-buffer)
- (let ((fs gnus-uu-digest-from-subject))
- (when fs
- (setq from (caar fs)
- subject (gnus-simplify-subject-fuzzy (cdar fs))
- fs (cdr fs))
- (while (and fs (or from subject))
- (when from
- (unless (string= from (caar fs))
- (setq from nil)))
- (when subject
- (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
- subject)
- (setq subject nil)))
- (setq fs (cdr fs))))
- (unless subject
- (setq subject "Digested Articles"))
- (unless from
- (setq from
- (if (gnus-news-group-p gnus-newsgroup-name)
- gnus-newsgroup-name
- "Various"))))
- (goto-char (point-min))
- (when (re-search-forward "^Subject: ")
- (delete-region (point) (gnus-point-at-eol))
- (insert subject))
- (goto-char (point-min))
- (when (re-search-forward "^From:")
- (delete-region (point) (gnus-point-at-eol))
- (insert " " from))
- (message-forward post t))
+ (let ((gnus-article-reply (gnus-summary-work-articles n)))
+ (when (and (not n)
+ (= (length gnus-article-reply) 1))
+ ;; The case where neither a number of articles nor a region is
+ ;; specified.
+ (gnus-summary-top-thread)
+ (setq gnus-article-reply (nreverse (gnus-uu-find-articles-matching))))
+ (gnus-setup-message 'forward
+ (setq gnus-uu-digest-from-subject nil)
+ (setq gnus-uu-digest-buffer
+ (gnus-get-buffer-create " *gnus-uu-forward*"))
+ ;; Specify articles to be forwarded. Note that they should be
+ ;; reversed; see `gnus-uu-get-list-of-articles'.
+ (let ((gnus-newsgroup-processable (reverse gnus-article-reply)))
+ (gnus-uu-decode-save n file)
+ (setq gnus-article-reply gnus-newsgroup-processable))
+ ;; Restore the value of `gnus-newsgroup-processable' to which
+ ;; it should be set when it is not `let'-bound.
+ (setq gnus-newsgroup-processable (reverse gnus-article-reply))
+ (switch-to-buffer gnus-uu-digest-buffer)
+ (let ((fs gnus-uu-digest-from-subject))
+ (when fs
+ (setq from (caar fs)
+ subject (gnus-simplify-subject-fuzzy (cdar fs))
+ fs (cdr fs))
+ (while (and fs (or from subject))
+ (when from
+ (unless (string= from (caar fs))
+ (setq from nil)))
+ (when subject
+ (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
+ subject)
+ (setq subject nil)))
+ (setq fs (cdr fs))))
+ (unless subject
+ (setq subject "Digested Articles"))
+ (unless from
+ (setq from
+ (if (gnus-news-group-p gnus-newsgroup-name)
+ gnus-newsgroup-name
+ "Various"))))
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: ")
+ (delete-region (point) (point-at-eol))
+ (insert subject))
+ (goto-char (point-min))
+ (when (re-search-forward "^From:")
+ (delete-region (point) (point-at-eol))
+ (insert " " from))
+ (let ((message-forward-decoded-p t))
+ (message-forward post t))))
(setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (&optional n)
(defun gnus-message-process-mark (unmarkp new-marked)
(let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
- (message "%d mark%s %s%s"
- (length new-marked)
- (if (= (length new-marked) 1) "" "s")
- (if unmarkp "removed" "added")
- (cond
- ((and (zerop old)
- (not unmarkp))
- "")
- (unmarkp
- (format ", %d remain marked"
- (length gnus-newsgroup-processable)))
- (t
- (format ", %d already marked" old))))))
+ (gnus-message 6 "%d mark%s %s%s"
+ (length new-marked)
+ (if (= (length new-marked) 1) "" "s")
+ (if unmarkp "removed" "added")
+ (cond
+ ((and (zerop old)
+ (not unmarkp))
+ "")
+ (unmarkp
+ (format ", %d remain marked"
+ (length gnus-newsgroup-processable)))
+ (t
+ (format ", %d already marked" old))))))
(defun gnus-new-processable (unmarkp articles)
(if unmarkp
(interactive "sUnmark (regexp): ")
(gnus-uu-mark-by-regexp regexp t))
-(defun gnus-uu-mark-series ()
+(defun gnus-uu-mark-series (&optional silent)
"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 ""))
- (gnus-summary-position-point))
+ (unless silent
+ (gnus-message 6 "Marked %d articles" l))
+ (gnus-summary-position-point)
+ l))
(defun gnus-uu-mark-region (beg end &optional unmark)
"Set the process mark on all articles between point and mark."
(setq gnus-newsgroup-processable nil)
(save-excursion
(let ((data gnus-newsgroup-data)
+ (count 0)
number)
(while data
(when (and (not (memq (setq number (gnus-data-number (car data)))
gnus-newsgroup-processable))
(vectorp (gnus-data-header (car data))))
(gnus-summary-goto-subject number)
- (gnus-uu-mark-series))
- (setq data (cdr data)))))
+ (setq count (+ count (gnus-uu-mark-series t))))
+ (setq data (cdr data)))
+ (gnus-message 6 "Marked %d articles" count)))
(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"
- (current-time-string) name name))
+ (message-make-date) name name))
(when (and message-forward-as-mime gnus-uu-digest-buffer)
- ;; The default part in multipart/digest is message/rfc822.
- ;; Subject is a fake head.
- (insert "<#part type=text/plain>\nSubject: Topics\n\n"))
+ (insert
+ "<#mml type=message/rfc822>\nSubject: Topics\n\n<#/mml>\n")
+ (forward-line -1))
(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
(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))
- (when (and message-forward-as-mime
+ (when (and message-forward-as-mime
message-forward-show-mml
gnus-uu-digest-buffer)
(mm-enable-multibyte)
(mime-to-mml))
(goto-char (point-min))
- (re-search-forward "\n\n")
+ (search-forward "\n\n")
(unless (and message-forward-as-mime gnus-uu-digest-buffer)
;; Quote all 30-dash lines.
(save-excursion
(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))
(insert sorthead)
(goto-char (point-min))
(when (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (setq subj (buffer-substring (match-beginning 1)
+ (setq subj (buffer-substring (match-beginning 1)
(match-end 1))))
(goto-char (point-max))
(insert body))
(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))
(if (and message-forward-as-mime gnus-uu-digest-buffer)
(with-current-buffer gnus-uu-digest-buffer
(erase-buffer)
- (insert-buffer "*gnus-uu-pre*")
+ (insert-buffer-substring "*gnus-uu-pre*")
(goto-char (point-max))
- (insert-buffer "*gnus-uu-body*"))
- (save-excursion
- (set-buffer "*gnus-uu-pre*")
+ (insert-buffer-substring "*gnus-uu-body*"))
+ (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
(erase-buffer)
- (insert-buffer "*gnus-uu-pre*"))
+ (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))
(if gnus-uu-digest-buffer
(with-current-buffer gnus-uu-digest-buffer
(goto-char (point-max))
- (insert-buffer "*gnus-uu-body*"))
- (let ((coding-system-for-write mm-text-coding-system)
+ (insert-buffer-substring "*gnus-uu-body*"))
+ (let ((coding-system-for-write mm-text-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
(write-region
(point-min) (point-max) gnus-uu-saved-article-name t)))))
(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))
(if (looking-at gnus-uu-binhex-begin-line)
(progn
(setq state (list 'begin))
- (write-region 1 1 gnus-uu-binhex-article-name))
+ (write-region (point-min) (point-min)
+ gnus-uu-binhex-article-name))
(setq state (list 'middle)))
(goto-char (point-max))
(re-search-backward (concat gnus-uu-binhex-body-line "\\|"
(cons gnus-uu-binhex-article-name state)
state)))
+;; yEnc
+
+(defun gnus-uu-yenc-article (buffer in-state)
+ (with-current-buffer gnus-original-article-buffer
+ (widen)
+ (let ((file-name (yenc-extract-filename))
+ state start-char)
+ (when (not file-name)
+ (setq state (list 'wrong-type)))
+
+ (if (memq 'wrong-type state)
+ ()
+ (when (yenc-first-part-p)
+ (setq gnus-uu-yenc-article-name
+ (expand-file-name file-name gnus-uu-work-dir))
+ (push 'begin state))
+ (when (yenc-last-part-p)
+ (push 'end state))
+ (unless state
+ (push 'middle state))
+ (mm-with-unibyte-buffer
+ (insert-buffer-substring gnus-original-article-buffer)
+ (yenc-decode-region (point-min) (point-max))
+ (when (and (member 'begin state)
+ (file-exists-p gnus-uu-yenc-article-name))
+ (delete-file gnus-uu-yenc-article-name))
+ (mm-append-to-file (point-min) (point-max)
+ gnus-uu-yenc-article-name)))
+ (if (memq 'begin state)
+ (cons file-name state)
+ state))))
+
;; PostScript
(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))
nil t)
(replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
- (goto-char 1)
+ (goto-char (point-min))
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]+" t t))
- (buffer-substring 1 (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
;; 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))
;; 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)
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
- (replace-match
- (format "%06d"
- (string-to-int (buffer-substring
- (match-beginning 0) (match-end 0))))))
- (setq string (buffer-substring 1 (point-max)))
+ (ignore-errors
+ (replace-match
+ (format "%06d"
+ (string-to-number (buffer-substring
+ (match-beginning 0) (match-end 0)))))))
+ (setq string (buffer-substring (point-min) (point-max)))
(setcar (car string-list) string)
(setq string-list (cdr string-list))))
out-list))
;; 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)))))
(not gnus-uu-be-dangerous)
(or (eq gnus-uu-be-dangerous t)
(gnus-y-or-n-p
- (format "Delete unsuccessfully decoded file %s"
+ (format "Delete unsuccessfully decoded file %s? "
result-file))))
(delete-file result-file)))
(when (memq 'begin process-state)
(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)
+ (setq gnus-current-article nil)
result-files))
(defun gnus-uu-grab-view (file)
(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 "")))
(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))
;; 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))))
- (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
+ (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.
(forward-line 1)
(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))
(unless
(unwind-protect
(with-current-buffer buffer
- (insert (substitute-command-keys
+ (insert (substitute-command-keys
gnus-uu-unshar-warning))
(goto-char (point-min))
(display-buffer buffer)
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))
- (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 "")
(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)
(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)))))))
gnus-uu-tmp-dir)))
(setq gnus-uu-work-dir
- (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
- (gnus-make-directory gnus-uu-work-dir)
- (set-file-modes gnus-uu-work-dir 448)
+ (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
+ (gnus-set-file-modes gnus-uu-work-dir 448)
(setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
(push (cons gnus-newsgroup-name gnus-uu-work-dir)
gnus-uu-tmp-alist))))
;; 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))))
(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
(when (gnus-uu-post-encode-file "uuencode" path file-name)
(goto-char (point-min))
(forward-line 1)
- (while (re-search-forward " " nil t)
+ (while (search-forward " " nil t)
(replace-match "`"))
t))
;; 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))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line -1)
- (narrow-to-region 1 (point))
+ (narrow-to-region (point-min) (point))
(unless (mail-fetch-field "mime-version")
(widen)
(insert "MIME-Version: 1.0\n"))
;; 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.
(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))
- (setq length (count-lines 1 (point-max)))
+ (setq length (count-lines (point-min) (point-max)))
(setq parts (/ length gnus-uu-post-length))
(unless (< (% length gnus-uu-post-length) 4)
(incf parts)))
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (beginning-of-line)
- (setq header (buffer-substring 1 (point)))
+ (setq header (buffer-substring (point-min) (point-at-bol)))
(goto-char (point-min))
(when gnus-uu-post-separate-description
(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))
(when (not gnus-uu-post-separate-description)
(set-buffer-modified-p nil)
- (when (fboundp 'bury-buffer)
- (bury-buffer)))))
+ (bury-buffer))))
(provide 'gnus-uu)
-;; gnus-uu.el ends here
+;;; gnus-uu.el ends here
projects / gnus / blobdiff