;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
+;; 2001, 2002 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Created: 2 Oct 1993
;; Keyword: news
;;; Commentary:
-;;; Code:
+;;; Code:
-(require 'gnus-load)
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
(require 'gnus-art)
(require 'message)
(require 'gnus-msg)
+(require 'mm-decode)
+
+(defgroup gnus-extract nil
+ "Extracting encoded files."
+ :prefix "gnus-uu-"
+ :group 'gnus)
+
+(defgroup gnus-extract-view nil
+ "Viewwing extracted files."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-archive nil
+ "Extracting encoded archives."
+ :group 'gnus-extract)
+
+(defgroup gnus-extract-post nil
+ "Extracting encoded archives."
+ :prefix "gnus-uu-post"
+ :group 'gnus-extract)
;; Default viewing action rules
-(defvar gnus-uu-default-view-rules
- '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
- ("\\.pas$" "cat %s | sed s/\r//g")
+(defcustom gnus-uu-default-view-rules
+ '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
+ ("\\.pas$" "cat %s | sed 's/\r$//'")
("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
- ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
- ("\\.tga$" "tgatoppm %s | xv -")
- ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
+ ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display")
+ ("\\.tga$" "tgatoppm %s | ee -")
+ ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
"sox -v .5 %s -t .au -u - > /dev/audio")
("\\.au$" "cat %s > /dev/audio")
("\\.midi?$" "playmidi -f")
("\\.html$" "xmosaic")
("\\.mpe?g$" "mpeg_play")
("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
- ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
+ ("\\.\\(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.
+ "*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
`gnus-uu-user-view-rules' to something useful.
(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
+Both these variables are lists of lists with two string elements. The
+first string is a regular expression. If the file name matches this
regular expression, the command in the second string is executed with
the file as an argument.
If the command string contains \"%s\", the file name will be inserted
-at that point in the command string. If there's no \"%s\" in the
+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
-your needs. First we have `gnus-uu-user-view-rules', which is the
+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
-default rule variable provided in this package. If gnus-uu finds no
+file. If this variable contains no matches, gnus-uu examines the
+default rule variable provided in this package. If gnus-uu finds no
match here, it uses `gnus-uu-user-view-rules-end' to try to make a
-match.")
-
-(defvar gnus-uu-user-view-rules nil
- "*Variable detailing what actions are to be taken to view a file.
-See the documentation on the `gnus-uu-default-view-rules' variable for
-details.")
-
-(defvar gnus-uu-user-view-rules-end
+match."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules nil
+ "What actions are to be taken to view a file.
+See the documentation on the `gnus-uu-default-view-rules' variable for
+details."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
+
+(defcustom gnus-uu-user-view-rules-end
'(("" "file"))
- "*Variable saying what actions are to be taken if no rule matched the file name.
-See the documentation on the `gnus-uu-default-view-rules' variable for
-details.")
+ "*What actions are to be taken if no rule matched the file name.
+See the documentation on the `gnus-uu-default-view-rules' variable for
+details."
+ :group 'gnus-extract-view
+ :type '(repeat (group regexp (string :tag "Command"))))
;; Default unpacking commands
-(defvar gnus-uu-default-archive-rules
+(defcustom gnus-uu-default-archive-rules
'(("\\.tar$" "tar xf")
("\\.zip$" "unzip -o")
("\\.ar$" "ar x")
("\\.\\(lzh\\|lha\\)$" "lha x")
("\\.Z$" "uncompress")
("\\.gz$" "gunzip")
- ("\\.arc$" "arc -x")))
+ ("\\.arc$" "arc -x"))
+ "*See `gnus-uu-user-archive-rules'."
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
-(defvar gnus-uu-destructive-archivers
+(defvar gnus-uu-destructive-archivers
(list "uncompress" "gunzip"))
-(defvar gnus-uu-user-archive-rules nil
- "*A list that can be set to override the default archive unpacking commands.
+(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
unpack zip files, say the following:
- (setq gnus-uu-user-archive-rules
+ (setq gnus-uu-user-archive-rules
'((\"\\\\.tar$\" \"untar\")
- (\"\\\\.zip$\" \"zip -x\")))")
+ (\"\\\\.zip$\" \"zip -x\")))"
+ :group 'gnus-extract-archive
+ :type '(repeat (group regexp (string :tag "Command"))))
-(defvar gnus-uu-ignore-files-by-name nil
+(defcustom gnus-uu-ignore-files-by-name nil
"*A regular expression saying what files should not be viewed based on name.
-If, for instance, you want gnus-uu to ignore all .au and .wav files,
+If, for instance, you want gnus-uu to ignore all .au and .wav files,
you could say something like
(setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-type' variable.")
+`gnus-uu-ignore-files-by-type' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
-(defvar gnus-uu-ignore-files-by-type nil
+(defcustom gnus-uu-ignore-files-by-type nil
"*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
-If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
+If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
you could say something like
(setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-name' variable.")
+`gnus-uu-ignore-files-by-name' variable."
+ :group 'gnus-extract
+ :type '(choice (const :tag "off" nil)
+ (regexp :format "%v")))
;; Pseudo-MIME support
("\\.rsrc$" "video/rsrc")
("\\..*$" "unknown/unknown")))
-;; Various variables users may set
+;; Various variables users may set
-(defvar gnus-uu-tmp-dir "/tmp/"
+(defcustom gnus-uu-tmp-dir
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"*Variable saying where gnus-uu is to do its work.
-Default is \"/tmp/\".")
+Default is \"/tmp/\"."
+ :group 'gnus-extract
+ :type 'directory)
-(defvar gnus-uu-do-not-unpack-archives nil
- "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
-Default is nil.")
+(defcustom gnus-uu-do-not-unpack-archives nil
+ "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
+Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
-(defvar gnus-uu-ignore-default-view-rules nil
+(defcustom gnus-uu-ignore-default-view-rules nil
"*Non-nil means that gnus-uu will ignore the default viewing rules.
-Only the user viewing rules will be consulted. Default is nil.")
+Only the user viewing rules will be consulted. Default is nil."
+ :group 'gnus-extract-view
+ :type 'boolean)
-(defvar gnus-uu-grabbed-file-functions nil
- "*Functions run on each file after successful decoding.
+(defcustom gnus-uu-grabbed-file-functions nil
+ "Functions run on each file after successful decoding.
They will be called with the name of the file as the argument.
-Likely functions you can use in this list are `gnus-uu-grab-view'
-and `gnus-uu-grab-move'.")
-
-(defvar gnus-uu-ignore-default-archive-rules nil
- "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
-Only the user unpacking commands will be consulted. Default is nil.")
-
-(defvar gnus-uu-kill-carriage-return t
+Likely functions you can use in this list are `gnus-uu-grab-view'
+and `gnus-uu-grab-move'."
+ :group 'gnus-extract
+ :options '(gnus-uu-grab-view gnus-uu-grab-move)
+ :type 'hook)
+
+(defcustom gnus-uu-ignore-default-archive-rules nil
+ "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
+Only the user unpacking commands will be consulted. Default is nil."
+ :group 'gnus-extract-archive
+ :type 'boolean)
+
+(defcustom gnus-uu-kill-carriage-return t
"*Non-nil means that gnus-uu will strip all carriage returns from articles.
-Default is t.")
+Default is t."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-view-with-metamail nil
+(defcustom gnus-uu-view-with-metamail nil
"*Non-nil means that files will be viewed with metamail.
The gnus-uu viewing functions will be ignored and gnus-uu will try
-to guess at a content-type based on file name suffixes. Default
-it nil.")
-
-(defvar gnus-uu-unmark-articles-not-decoded nil
- "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
-Default is nil.")
-
-(defvar gnus-uu-correct-stripped-uucode nil
- "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
-Default is nil.")
-
-(defvar gnus-uu-save-in-digest nil
+to guess at a content-type based on file name suffixes. Default
+it nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-unmark-articles-not-decoded nil
+ "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-correct-stripped-uucode nil
+ "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-save-in-digest nil
"*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
-If this variable is nil, gnus-uu will just save everything in a
-file without any embellishments. The digesting almost conforms to RFC1153 -
-no easy way to specify any meaningful volume and issue numbers were found,
-so I simply dropped them.")
-
-(defvar gnus-uu-digest-headers
+If this variable is nil, gnus-uu will just save everything in a
+file without any embellishments. The digesting almost conforms to RFC1153 -
+no easy way to specify any meaningful volume and issue numbers were found,
+so I simply dropped them."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-pre-uudecode-hook nil
+ "Hook run before sending a message to uudecode."
+ :group 'gnus-extract
+ :type 'hook)
+
+(defcustom gnus-uu-digest-headers
'("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
- "^Summary:" "^References:")
+ "^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.")
-
-(defvar gnus-uu-save-separate-articles nil
- "*Non-nil means that gnus-uu will save articles in separate files.")
+The headers will be included in the sequence they are matched. If nil
+include all headers."
+ :group 'gnus-extract
+ :type '(repeat regexp))
+
+(defcustom gnus-uu-save-separate-articles nil
+ "*Non-nil means that gnus-uu will save articles in separate files."
+ :group 'gnus-extract
+ :type 'boolean)
+
+(defcustom gnus-uu-be-dangerous 'ask
+ "*Specifies what to do if unusual situations arise during decoding.
+If nil, be as conservative as possible. If t, ignore things that
+didn't work, and overwrite existing files. Otherwise, ask each time."
+ :group 'gnus-extract
+ :type '(choice (const :tag "conservative" nil)
+ (const :tag "ask" ask)
+ (const :tag "liberal" t)))
;; Internal variables
(defvar gnus-uu-saved-article-name nil)
-(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst gnus-uu-end-string "^end[ \t]*$")
+(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defvar gnus-uu-end-string "^end[ \t]*$")
-(defconst gnus-uu-body-line "^M")
+(defvar gnus-uu-body-line "^M")
(let ((i 61))
(while (> (setq i (1- i)) 0)
(setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
;"^M.............................................................?$"
-(defconst gnus-uu-shar-begin-string "^#! */bin/sh")
+(defvar gnus-uu-shar-begin-string "^#! */bin/sh")
(defvar gnus-uu-shar-file-name nil)
-(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
+(defvar gnus-uu-shar-name-marker
+ "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
-(defconst gnus-uu-postscript-begin-string "^%!PS-")
-(defconst gnus-uu-postscript-end-string "^%%EOF$")
+(defvar gnus-uu-postscript-begin-string "^%!PS-")
+(defvar gnus-uu-postscript-end-string "^%%EOF$")
(defvar gnus-uu-file-name nil)
-(defconst gnus-uu-uudecode-process nil)
+(defvar gnus-uu-uudecode-process nil)
(defvar gnus-uu-binhex-article-name nil)
(defvar gnus-uu-work-dir nil)
-(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
+(defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
(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
- "R" gnus-uu-mark-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)
-
-(gnus-define-keys
- (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- ;;"m" gnus-uu-extract-mime
- "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.
(defun gnus-uu-decode-uu (&optional n)
"Uudecodes the current article."
- (interactive "P")
+ (interactive "P")
(gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
(defun gnus-uu-decode-uu-and-save (n dir)
"Saves the current article."
(interactive
(list current-prefix-arg
- (read-file-name
+ (read-file-name
(if gnus-uu-save-separate-articles
"Save articles is dir: "
"Save articles in file: ")
(read-file-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")))
+ (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))
(defun gnus-uu-decode-uu-view (&optional n)
- "Uudecodes and views the current article."
+ "Uudecodes and views the current article."
(interactive "P")
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu n)))
(list current-prefix-arg
(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")))
+ (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)))
(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 (concat gnus-uu-tmp-dir "forward")))
- buf subject from)
- (setq gnus-uu-digest-from-subject nil)
- (gnus-uu-decode-save n file)
- (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
- (gnus-add-current-to-buffer-list)
- (erase-buffer)
- (delete-other-windows)
- (insert-file file)
- (let ((fs gnus-uu-digest-from-subject))
- (if (not fs)
- ()
- (setq from (caar fs)
- subject (gnus-simplify-subject-fuzzy (cdar fs))
- fs (cdr fs))
- (while (and fs (or from subject))
- (and from
- (or (string= from (caar fs))
- (setq from nil)))
- (and subject
- (or (string= (gnus-simplify-subject-fuzzy (cdar fs))
- subject)
- (setq subject nil)))
- (setq fs (cdr fs))))
- (or subject (setq subject "Digested Articles"))
- (or from (setq from "Various")))
- (goto-char (point-min))
- (and (re-search-forward "^Subject: ")
- (progn
- (delete-region (point) (gnus-point-at-eol))
- (insert subject)))
- (goto-char (point-min))
- (and (re-search-forward "^From: ")
- (progn
- (delete-region (point) (gnus-point-at-eol))
- (insert from)))
- (message-forward post)
- (delete-file file)
- (kill-buffer buf)
+ (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)
+ 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)))
+ (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))
+ (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)
;; Process marking.
+(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))))))
+
+(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)
- "Ask for a regular expression and set the process mark on all articles that match."
- (interactive (list (read-from-minibuffer "Mark (regexp): ")))
- (gnus-set-global-variables)
- (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 ""))
+ "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")
+ (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 &optional unmark)
- "Ask for a regular expression and remove the process mark on all articles that match."
- (interactive (list (read-from-minibuffer "Mark (regexp): ")))
+(defun gnus-uu-unmark-by-regexp (regexp)
+ "Remove the process mark from articles whose subjects match REGEXP.
+When called interactively, prompt for REGEXP."
+ (interactive "sUnmark (regexp): ")
(gnus-uu-mark-by-regexp regexp t))
(defun gnus-uu-mark-series ()
"Mark the current series with the process mark."
(interactive)
- (gnus-set-global-variables)
(let ((articles (gnus-uu-find-articles-matching)))
(while articles
(gnus-summary-set-process-mark (car articles))
(defun gnus-uu-mark-region (beg end &optional unmark)
"Set the process mark on all articles between point and mark."
(interactive "r")
- (gnus-set-global-variables)
(save-excursion
(goto-char beg)
(while (< (point) end)
"Set the process mark on all articles in the buffer."
(interactive)
(gnus-uu-mark-region (point-min) (point-max)))
-
+
(defun gnus-uu-unmark-buffer ()
"Remove the process mark on all articles in the buffer."
(interactive)
(gnus-uu-mark-region (point-min) (point-max) t))
-
+
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
(interactive)
- (gnus-set-global-variables)
- (let ((level (gnus-summary-thread-level)))
- (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1))
- (> (gnus-summary-thread-level) level))))
+ (gnus-save-hidden-threads
+ (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))
+ (> (gnus-summary-thread-level) level)))))
(gnus-summary-position-point))
(defun gnus-uu-unmark-thread ()
"Unmarks all articles downwards in this thread."
(interactive)
- (gnus-set-global-variables)
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-remove-process-mark
(gnus-summary-article-number))
(> (gnus-summary-thread-level) level))))
(gnus-summary-position-point))
+(defun gnus-uu-invert-processable ()
+ "Invert the list of process-marked articles."
+ (interactive)
+ (let ((data gnus-newsgroup-data)
+ number)
+ (save-excursion
+ (while data
+ (if (memq (setq number (gnus-data-number (pop data)))
+ gnus-newsgroup-processable)
+ (gnus-summary-remove-process-mark number)
+ (gnus-summary-set-process-mark number)))))
+ (gnus-summary-position-point))
+
(defun gnus-uu-mark-over (&optional score)
- "Mark all articles with a score over SCORE (the prefix.)"
+ "Mark all articles with a score over SCORE (the prefix)."
(interactive "P")
- (let ((score (gnus-score-default score))
+ (let ((score (or score gnus-summary-default-score 0))
(data gnus-newsgroup-data))
(save-excursion
(while data
(defun gnus-uu-mark-sparse ()
"Mark all series that have some articles marked."
(interactive)
- (gnus-set-global-variables)
(let ((marked (nreverse gnus-newsgroup-processable))
subject articles total headers)
- (or marked (error "No articles marked with the process mark"))
+ (unless marked
+ (error "No articles marked with the process mark"))
(setq gnus-newsgroup-processable nil)
(save-excursion
(while marked
- (and (vectorp (setq headers
+ (and (vectorp (setq headers
(gnus-summary-article-header (car marked))))
(setq subject (mail-header-subject headers)
- articles (gnus-uu-find-articles-matching
+ articles (gnus-uu-find-articles-matching
(gnus-uu-reginize-string subject))
total (nconc total articles)))
(while articles
(defun gnus-uu-mark-all ()
"Mark all articles in \"series\" order."
(interactive)
- (gnus-set-global-variables)
(setq gnus-newsgroup-processable nil)
(save-excursion
(let ((data gnus-newsgroup-data)
(setq data (cdr data)))))
(gnus-summary-position-point))
-;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
+;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
(defun gnus-uu-decode-postscript (&optional n)
"Gets postscript of the current article."
(read-file-name "Save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
+ (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
n dir nil nil t))
(defun gnus-uu-decode-postscript-and-save-view (n dir)
;; Internal functions.
-(defun gnus-uu-decode-with-method (method n &optional save not-insert
+(defun gnus-uu-decode-with-method (method n &optional save not-insert
scan cdir)
(gnus-uu-initialize scan)
- (if save (setq gnus-uu-default-dir save))
+ (when save
+ (setq gnus-uu-default-dir save))
;; Create the directory we save to.
(when (and scan cdir save
(not (file-exists-p save)))
files)
(setq files (gnus-uu-grab-articles articles method t))
(let ((gnus-current-article (car articles)))
- (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
- (and save (gnus-uu-save-files files save))
- (if (eq gnus-uu-do-not-unpack-archives nil)
+ (when scan
+ (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
+ (when save
+ (gnus-uu-save-files files save))
+ (when (eq gnus-uu-do-not-unpack-archives nil)
(setq files (gnus-uu-unpack-files files)))
(setq files (nreverse (gnus-uu-get-actions files)))
(or not-insert (not gnus-insert-pseudo-articles)
out)
(when (file-directory-p file)
(setq out (nconc (gnus-uu-scan-directory file t) out)))))
- (if rec
+ (if rec
out
(nreverse out))))
(gnus-make-directory (concat dir fromdir))
(setq to-file (concat dir fromdir))
(when (or (not (file-exists-p to-file))
- (gnus-y-or-n-p (format "%s exists; overwrite? " to-file)))
+ (eq gnus-uu-be-dangerous t)
+ (and gnus-uu-be-dangerous
+ (gnus-y-or-n-p (format "%s exists; overwrite? "
+ to-file))))
(copy-file file to-file t t)))))
(gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
;; Function called by gnus-uu-grab-articles to treat each article.
(defun gnus-uu-save-article (buffer in-state)
- (cond
+ (cond
(gnus-uu-save-separate-articles
(save-excursion
(set-buffer buffer)
- (write-region 1 (point-max) (concat gnus-uu-saved-article-name
- gnus-current-article))
+ (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
+ ((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)
- (write-region 1 (point-max) gnus-uu-saved-article-name t)
+ (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) (list gnus-uu-saved-article-name
'begin 'end))
((eq in-state 'last) (list 'end))
(t (list 'middle)))))
(t
(let ((header (gnus-summary-article-header)))
- (setq gnus-uu-digest-from-subject
- (cons (cons (mail-header-from header)
- (mail-header-subject header))
- gnus-uu-digest-from-subject)))
+ (push (cons (mail-header-from header)
+ (mail-header-subject header))
+ gnus-uu-digest-from-subject))
(let ((name (file-name-nondirectory gnus-uu-saved-article-name))
- (delim (concat "^" (make-string 30 ?-) "$"))
beg subj headers headline sorthead body end-string state)
- (if (or (eq in-state 'first)
+ (if (or (eq in-state 'first)
(eq in-state 'first-and-last))
- (progn
+ (progn
(setq state (list 'begin))
- (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
- (erase-buffer))
- (save-excursion
- (set-buffer (get-buffer-create "*gnus-uu-pre*"))
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create "*gnus-uu-body*"))
+ (erase-buffer))
+ (save-excursion
+ (set-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))))
- (if (not (eq in-state 'end))
- (setq state (list 'middle))))
+ (insert (format
+ "Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
+ (current-time-string) name name))
+ (when (and message-forward-as-mime gnus-uu-digest-buffer)
+ (insert "<#part type=message/rfc822>\nSubject: Topics\n\n"))
+ (insert "Topics:\n")))
+ (when (not (eq in-state 'end))
+ (setq state (list 'middle))))
(save-excursion
- (set-buffer (get-buffer "*gnus-uu-body*"))
+ (set-buffer "*gnus-uu-body*")
(goto-char (setq beg (point-max)))
(save-excursion
(save-restriction
;; 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 delim nil t)
- (beginning-of-line)
- (delete-char 1)
- (insert " ")))
+ (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))
(goto-char (point-min))
(while (re-search-forward headline nil t)
- (setq sorthead
+ (setq sorthead
(concat sorthead
- (buffer-substring
+ (buffer-substring
(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"))
+ (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)
- (if (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (progn
- (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
- (save-excursion
- (set-buffer (get-buffer "*gnus-uu-pre*"))
- (insert (format " %s\n" subj))))))
- (if (or (eq in-state 'last)
- (eq in-state 'first-and-last))
- (progn
- (save-excursion
- (set-buffer (get-buffer "*gnus-uu-pre*"))
- (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
- (write-region 1 (point-max) gnus-uu-saved-article-name))
- (save-excursion
- (set-buffer (get-buffer "*gnus-uu-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*")
+ (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*")
(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 1 (point-max) gnus-uu-saved-article-name t))
- (kill-buffer (get-buffer "*gnus-uu-pre*"))
- (kill-buffer (get-buffer "*gnus-uu-body*"))
- (setq state (cons 'end state))))
+ (insert-buffer "*gnus-uu-body*"))
+ (save-excursion
+ (set-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*"))
+ (let ((coding-system-for-write mm-text-coding-system))
+ (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"))
+ (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)
+ (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))
(if (memq 'begin state)
(cons gnus-uu-saved-article-name state)
state)))))
-;; Binhex treatment - not very advanced.
+;; Binhex treatment - not very advanced.
-(defconst gnus-uu-binhex-body-line
+(defvar gnus-uu-binhex-body-line
"^[^:]...............................................................$")
-(defconst gnus-uu-binhex-begin-line
+(defvar gnus-uu-binhex-begin-line
"^:...............................................................$")
-(defconst gnus-uu-binhex-end-line
+(defvar gnus-uu-binhex-end-line
":$")
(defun gnus-uu-binhex-article (buffer in-state)
(set-buffer buffer)
(widen)
(goto-char (point-min))
- (if (not (re-search-forward gnus-uu-binhex-begin-line nil t))
- (if (not (re-search-forward gnus-uu-binhex-body-line nil t))
- (setq state (list 'wrong-type))))
+ (when (not (re-search-forward gnus-uu-binhex-begin-line nil t))
+ (when (not (re-search-forward gnus-uu-binhex-body-line nil t))
+ (setq state (list 'wrong-type))))
(if (memq 'wrong-type state)
()
(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 "\\|"
- gnus-uu-binhex-end-line) nil t)
- (if (looking-at gnus-uu-binhex-end-line)
- (setq state (if (memq 'begin state)
- (cons 'end state)
- (list 'end))))
+ (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
+ gnus-uu-binhex-end-line)
+ nil t)
+ (when (looking-at gnus-uu-binhex-end-line)
+ (setq state (if (memq 'begin state)
+ (cons 'end state)
+ (list 'end))))
(beginning-of-line)
(forward-line 1)
- (if (file-exists-p gnus-uu-binhex-article-name)
- (append-to-file start-char (point) gnus-uu-binhex-article-name))))
+ (when (file-exists-p gnus-uu-binhex-article-name)
+ (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
(if (memq 'begin state)
(cons gnus-uu-binhex-article-name state)
state)))
(if (not (re-search-forward gnus-uu-postscript-end-string nil t))
(setq state (list 'wrong-type))
(setq end-char (point))
- (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
(insert-buffer-substring process-buffer start-char end-char)
(setq file-name (concat gnus-uu-work-dir
(cdr gnus-article-current) ".ps"))
(write-region (point-min) (point-max) file-name)
(setq state (list file-name 'begin 'end)))))
state))
-
+
;; Find actions.
action name)
(while files
(setq name (cdr (assq 'name (car files))))
- (and
+ (and
(setq action (gnus-uu-get-action name))
(setcar files (nconc (list (if (string= action "gnus-uu-archive")
(cons 'action "file")
(defun gnus-uu-get-action (file-name)
(let (action)
- (setq action
- (gnus-uu-choose-action
+ (setq action
+ (gnus-uu-choose-action
file-name
- (append
+ (append
gnus-uu-user-view-rules
- (if gnus-uu-ignore-default-view-rules
- nil
+ (if gnus-uu-ignore-default-view-rules
+ nil
gnus-uu-default-view-rules)
gnus-uu-user-view-rules-end)))
- (if (and (not (string= (or action "") "gnus-uu-archive"))
- gnus-uu-view-with-metamail)
- (if (setq action
+ (when (and (not (string= (or action "") "gnus-uu-archive"))
+ gnus-uu-view-with-metamail)
+ (when (setq action
(gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
- (setq action (format "metamail -d -b -c \"%s\"" action))))
+ (setq action (format "metamail -d -b -c \"%s\"" action))))
action))
(defun gnus-uu-reginize-string (string)
;; Takes a string and puts a \ in front of every special character;
- ;; ignores any leading "version numbers" thingies that they use in
- ;; the comp.binaries groups, and either replaces anything that looks
- ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something
- ;; like that, replaces the last two numbers with "[0-9]+". This, in
- ;; my experience, should get most postings of a series.
- (let ((count 2)
- (vernum "v[0-9]+[a-z][0-9]+:")
- beg)
- (save-excursion
- (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert (regexp-quote string))
- (setq beg 1)
+ ;; 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))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert (regexp-quote string))
- (setq case-fold-search nil)
- (goto-char (point-min))
- (if (looking-at vernum)
- (progn
- (replace-match vernum t t)
- (setq beg (length vernum))))
+ (setq case-fold-search nil)
- (goto-char beg)
- (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
- (replace-match " [0-9]+/[0-9]+")
+ (end-of-line)
+ (if (re-search-b
projects / gnus / blobdiff