X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=83f817fd8e9904d4d43acafaf117ebec31314eb9;hp=3a60f7db23759091c22c0f4f22f67674bd819c47;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=61daf7a03e900c380e8968a330e947b2f65853d9 diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 3a60f7db2..83f817fd8 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,6 +1,7 @@ ;;; 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-2016 Free Software +;; Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 @@ -8,10 +9,10 @@ ;; 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 @@ -19,9 +20,7 @@ ;; 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 . ;;; Commentary: @@ -34,6 +33,7 @@ (require 'message) (require 'gnus-msg) (require 'mm-decode) +(require 'yenc) (defgroup gnus-extract nil "Extracting encoded files." @@ -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 @@ -74,15 +74,15 @@ ("\\.\\(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: -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 @@ -94,7 +94,7 @@ at that point in the command string. If there's no \"%s\" in the 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 @@ -140,10 +140,10 @@ details." (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")))) @@ -295,9 +295,12 @@ so I simply dropped them." (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:") + "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" + "^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)) @@ -319,7 +322,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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") @@ -332,9 +335,8 @@ 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-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$") @@ -342,6 +344,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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) @@ -349,56 +352,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defvar gnus-uu-default-dir gnus-article-save-directory) (defvar gnus-uu-digest-from-subject 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) - +(defvar gnus-uu-digest-buffer nil) ;; Commands. @@ -412,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)) @@ -427,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)) @@ -436,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 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)) @@ -450,13 +403,25 @@ 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)))) + (gnus-uu-initialize) (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") @@ -493,10 +458,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))) @@ -506,8 +472,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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 - (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))) @@ -517,47 +484,67 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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 (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) - buf subject from) - (gnus-setup-message 'forward - (setq gnus-uu-digest-from-subject nil) - (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer - (gnus-get-buffer-create " *gnus-uu-forward*"))) - (erase-buffer) - (insert-file file) - (delete-file file) - (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)) + (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) + gnus-uu-digest-buffer subject from) + (if (and n (not (numberp n))) + (setq message-forward-as-mime (not message-forward-as-mime) + n nil)) + (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) @@ -567,17 +554,40 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Process marking. +(defun gnus-message-process-mark (unmarkp new-marked) + (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) + (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 + (gnus-intersection gnus-newsgroup-processable articles) + (gnus-set-difference articles gnus-newsgroup-processable))) + (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "Set the process mark on articles whose subjects match REGEXP. When called interactively, prompt for REGEXP. Optional UNMARK non-nil means unmark instead of mark." (interactive "sMark (regexp): \nP") - (let ((articles (gnus-uu-find-articles-matching regexp))) - (while articles - (if unmark - (gnus-summary-remove-process-mark (pop articles)) - (gnus-summary-set-process-mark (pop articles)))) - (message "")) + (save-excursion + (let* ((articles (gnus-uu-find-articles-matching regexp)) + (new-marked (gnus-new-processable unmark articles))) + (while articles + (if unmark + (gnus-summary-remove-process-mark (pop articles)) + (gnus-summary-set-process-mark (pop articles)))) + (gnus-message-process-mark unmark new-marked))) (gnus-summary-position-point)) (defun gnus-uu-unmark-by-regexp (regexp) @@ -586,15 +596,18 @@ When called interactively, prompt for REGEXP." (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." @@ -630,7 +643,7 @@ When called interactively, prompt for REGEXP." (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)) @@ -640,7 +653,7 @@ When called interactively, prompt for REGEXP." (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)) @@ -702,20 +715,22 @@ When called interactively, prompt for REGEXP." (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 . (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)) @@ -726,11 +741,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 @@ -814,18 +829,17 @@ 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) - (gnus-write-buffer - (concat gnus-uu-saved-article-name gnus-current-article)) + (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))) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((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 @@ -843,40 +857,47 @@ 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\nTopics:\n" - (current-time-string) name name)))) + "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" + (message-make-date) name name)) + (when (and message-forward-as-mime gnus-uu-digest-buffer) + (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 + (with-current-buffer buffer (save-restriction - (set-buffer buffer) - (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) + (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) (put-text-property (point-min) (point-max) 'intangible nil)) + (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") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward "^-" nil t) - (beginning-of-line) - (delete-char 1) - (insert "- "))) + (search-forward "\n\n") + (unless (and message-forward-as-mime gnus-uu-digest-buffer) + ;; Quote all 30-dash lines. + (save-excursion + (while (re-search-forward "^-" nil t) + (beginning-of-line) + (delete-char 1) + (insert "- ")))) (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)) @@ -888,32 +909,64 @@ When called interactively, prompt for REGEXP." (match-beginning 0) (or (and (re-search-forward "^[^ \t]" nil t) (1- (point))) - (progn (forward-line 1) (point))))))))) - (widen))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) + (progn (forward-line 1) (point))))))))))) + (if (and message-forward-as-mime gnus-uu-digest-buffer) + (if message-forward-show-mml + (progn + (insert "\n<#mml type=message/rfc822>\n") + (insert sorthead) (goto-char (point-max)) + (insert body) (goto-char (point-max)) + (insert "\n<#/mml>\n")) + (let ((buf (mml-generate-new-buffer " *mml*"))) + (with-current-buffer buf + (insert sorthead) + (goto-char (point-min)) + (when (re-search-forward "^Subject: \\(.*\\)$" nil t) + (setq subj (buffer-substring (match-beginning 1) + (match-end 1)))) + (goto-char (point-max)) + (insert body)) + (insert "\n<#part type=message/rfc822" + " buffer=\"" (buffer-name buf) "\">\n"))) + (insert sorthead) (goto-char (point-max)) + (insert body) (goto-char (point-max)) + (insert (concat "\n" (make-string 30 ?-) "\n\n"))) (goto-char beg) (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion - (set-buffer "*gnus-uu-pre*") + (setq subj (buffer-substring (match-beginning 1) (match-end 1)))) + (when subj + (with-current-buffer "*gnus-uu-pre*" (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) (eq in-state 'first-and-last)) - (save-excursion - (set-buffer "*gnus-uu-pre*") - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (gnus-write-buffer gnus-uu-saved-article-name)) - (save-excursion - (set-buffer "*gnus-uu-body*") - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t)) + (if (and message-forward-as-mime gnus-uu-digest-buffer) + (with-current-buffer gnus-uu-digest-buffer + (erase-buffer) + (insert-buffer-substring "*gnus-uu-pre*") + (goto-char (point-max)) + (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-substring "*gnus-uu-pre*")) + (let ((coding-system-for-write mm-text-coding-system)) + (gnus-write-buffer gnus-uu-saved-article-name)))) + (with-current-buffer "*gnus-uu-body*" + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (if gnus-uu-digest-buffer + (with-current-buffer gnus-uu-digest-buffer + (goto-char (point-max)) + (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))))) (gnus-kill-buffer "*gnus-uu-pre*") (gnus-kill-buffer "*gnus-uu-body*") (push 'end state)) @@ -932,8 +985,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)) @@ -947,7 +999,8 @@ When called interactively, prompt for REGEXP." (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 "\\|" @@ -965,13 +1018,44 @@ When called interactively, prompt for REGEXP." (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)) @@ -1033,8 +1117,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)) @@ -1055,11 +1138,11 @@ When called interactively, prompt for REGEXP." 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 @@ -1119,7 +1202,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)) @@ -1133,8 +1216,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) @@ -1151,11 +1233,12 @@ When called interactively, prompt for REGEXP." ;; 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)) @@ -1208,6 +1291,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) @@ -1236,11 +1320,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))))) @@ -1261,7 +1343,7 @@ When called interactively, prompt for REGEXP." (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) @@ -1320,24 +1402,27 @@ 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) + (setq gnus-current-article nil) result-files)) (defun gnus-uu-grab-view (file) @@ -1368,7 +1453,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 ""))) @@ -1378,8 +1463,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) @@ -1389,7 +1473,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)) @@ -1403,10 +1487,10 @@ 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)))) - (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) @@ -1501,8 +1585,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)) @@ -1515,7 +1598,7 @@ Gnus might fail to display all of it.") (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) @@ -1533,16 +1616,6 @@ Gnus might fail to display all of it.") 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. @@ -1589,13 +1662,12 @@ 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)) - (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 "") @@ -1670,8 +1742,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) @@ -1684,19 +1755,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))))))) @@ -1720,9 +1787,8 @@ Gnus might fail to display all of it.") 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)))) @@ -1742,7 +1808,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)))) @@ -1761,14 +1827,18 @@ 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 -(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) @@ -1841,7 +1911,7 @@ is t." (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-local-map)) (use-local-map map)) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) + ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) (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) @@ -1862,7 +1932,7 @@ The user will be asked for a file name." (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)) @@ -1874,8 +1944,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)) @@ -1891,7 +1961,7 @@ The user will be asked for a file name." (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")) @@ -1900,8 +1970,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. @@ -1942,9 +2012,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) @@ -1976,12 +2045,12 @@ 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)) - (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))) @@ -1993,8 +2062,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 1 (point))) + (setq header (buffer-substring (point-min) (point-at-bol))) (goto-char (point-min)) (when gnus-uu-post-separate-description @@ -2033,8 +2101,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)) @@ -2070,9 +2137,8 @@ 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) -;; gnus-uu.el ends here +;;; gnus-uu.el ends here