;;; Code:
(require 'gnus)
+(require 'gnus-art)
+(require 'message)
(require 'gnus-msg)
-(eval-when-compile (require 'cl))
+
+(defgroup gnus-extract nil
+ "Extracting encoded files."
+ :group 'gnus)
;; Default viewing action rules
-(defvar gnus-uu-default-view-rules
+(defcustom 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")
("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
("\\.\\(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.")
+match."
+ :group 'gnus-extract
+ :type '(repeat (group regexp (string :tag "Command"))))
-(defvar gnus-uu-user-view-rules nil
- "*Variable detailing what actions are to be taken to view a file.
+(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.")
+details."
+ :group 'gnus-extract
+ :type '(repeat (group regexp (string :tag "Command"))))
-(defvar gnus-uu-user-view-rules-end
+(defcustom gnus-uu-user-view-rules-end
'(("" "file"))
- "*Variable saying what actions are to be taken if no rule matched the file name.
+ "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.")
+details."
+ :group 'gnus-extract
+ :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
+ :type '(repeat (group regexp (string :tag "Command"))))
(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
'((\"\\\\.tar$\" \"untar\")
- (\"\\\\.zip$\" \"zip -x\")))")
+ (\"\\\\.zip$\" \"zip -x\")))"
+ :group 'gnus-extract
+ :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,
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,
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
;; Various variables users may set
-(defvar gnus-uu-tmp-dir "/tmp/"
+(defcustom gnus-uu-tmp-dir "/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
+(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.")
-
-(defvar gnus-uu-view-and-save nil
- "*Non-nil means that the user will always be asked to save a file after viewing it.
-If the variable is nil, the user will only be asked to save if the
-viewing is unsuccessful. Default is nil.")
+Default is nil."
+ :group 'gnus-extract
+ :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
+ :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'.")
+and `gnus-uu-grab-move'."
+ :group 'gnus-extract
+ :options '(gnus-uu-grab-view gnus-uu-grab-move)
+ :type 'hook)
-(defvar gnus-uu-ignore-default-archive-rules nil
+(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.")
+Only the user unpacking commands will be consulted. Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-kill-carriage-return t
+(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.")
+to guess at a content-type based on file name suffixes. Default
+it nil."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-unmark-articles-not-decoded nil
+(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.")
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-correct-stripped-uucode nil
+(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.")
+Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-save-in-digest nil
+(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 -
+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.")
+so I simply dropped them."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-digest-headers
+(defcustom gnus-uu-digest-headers
'("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
"^Summary:" "^References:")
- "*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.")
+ "List of regexps to match headers included in digested messages.
+The headers will be included in the sequence they are matched."
+ :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
(defconst gnus-uu-uudecode-process nil)
(defvar gnus-uu-binhex-article-name nil)
-(defvar gnus-uu-generated-file-list nil)
(defvar gnus-uu-work-dir nil)
(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
;; 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)
-
-(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-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
+ "i" gnus-uu-invert-processable)
+
+(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)
;; Commands.
-(defun gnus-uu-decode-uu (n)
+(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)
gnus-uu-default-dir t))))
(gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
-(defun gnus-uu-decode-unshar (n)
+(defun gnus-uu-decode-unshar (&optional n)
"Unshars the current article."
(interactive "P")
(gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
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)
- (setq gnus-uu-generated-file-list
- (delete file gnus-uu-generated-file-list)))
+ (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
(defun gnus-uu-decode-binhex (n dir)
"Unbinhexes the current article."
(make-temp-name (concat gnus-uu-work-dir "binhex")))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
-(defun gnus-uu-decode-uu-view (n)
+(defun gnus-uu-decode-uu-view (&optional n)
"Uudecodes and views the current article."
(interactive "P")
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu-and-save n dir)))
-(defun gnus-uu-decode-unshar-view (n)
+(defun gnus-uu-decode-unshar-view (&optional n)
"Unshars and views the current article."
(interactive "P")
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
;; Digest and forward articles
-(defun gnus-uu-digest-mail-forward (n &optional post)
+(defun gnus-uu-digest-mail-forward (&optional n post)
"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)
+ (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward")))
+ buf subject from newsgroups)
(setq gnus-uu-digest-from-subject nil)
(gnus-uu-decode-save n file)
- (gnus-uu-add-file 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)
- ()
+ (when 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)))
+ (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))))
- (or subject (setq subject "Digested Articles"))
- (or from (setq from "Various")))
+ (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))
- (and (re-search-forward "^Subject: ")
- (progn
- (delete-region (point) (gnus-point-at-eol))
- (insert subject)))
+ (when (re-search-forward "^Subject: ")
+ (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)))
+ (when (re-search-forward "^From: ")
+ (delete-region (point) (gnus-point-at-eol))
+ (insert from))
(message-forward post)
(delete-file file)
(kill-buffer buf)
(setq gnus-uu-digest-from-subject nil)))
-(defun gnus-uu-digest-post-forward (n)
+(defun gnus-uu-digest-post-forward (&optional n)
"Digest and forward to a newsgroup."
(interactive "P")
(gnus-uu-digest-mail-forward n t))
(> (gnus-summary-thread-level) level))))
(gnus-summary-position-point))
-(defun gnus-uu-mark-over (score)
+(defun gnus-uu-invert-processable ()
+ "Invert the list of process-marked articles."
+ (let ((data gnus-newsgroup-data)
+ d 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.)"
(interactive "P")
(let ((score (gnus-score-default score))
(data gnus-newsgroup-data))
(save-excursion
(while data
- (when (> (or (cdr (assq (gnus-data-number (caar data))
+ (when (> (or (cdr (assq (gnus-data-number (car data))
gnus-newsgroup-scored))
gnus-summary-default-score 0)
score)
(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 (setq headers (gnus-summary-article-header (car marked)))
+ (and (vectorp (setq headers
+ (gnus-summary-article-header (car marked))))
(setq subject (mail-header-subject headers)
articles (gnus-uu-find-articles-matching
(gnus-uu-reginize-string subject))
(let ((data gnus-newsgroup-data)
number)
(while data
- (unless (memq (setq number (gnus-data-number (car data)))
- gnus-newsgroup-processable)
+ (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)))))
;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
-(defun gnus-uu-decode-postscript (n)
+(defun gnus-uu-decode-postscript (&optional n)
"Gets postscript of the current article."
(interactive "P")
(gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
-(defun gnus-uu-decode-postscript-view (n)
+(defun gnus-uu-decode-postscript-view (&optional n)
"Gets and views the current article."
(interactive "P")
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(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)))
- (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files))
(setq files (nreverse (gnus-uu-get-actions files)))
(or not-insert (not gnus-insert-pseudo-articles)
(gnus-summary-insert-pseudos files save))))
(let ((files (directory-files dir t))
out file)
(while (setq file (pop files))
- (unless (string-match "/\\.\\.?$" file)
+ (unless (member (file-name-nondirectory file) '("." ".."))
(push (list (cons 'name file)
(cons 'article gnus-current-article))
out)
(string-match reg file)
(setq fromdir (substring file (match-end 0)))
(if (file-directory-p file)
- (unless (file-exists-p (concat dir fromdir))
- (make-directory (concat dir fromdir) t))
+ (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)))))
- (message "Saved %d file%s" len (if (= len 1) "" "s"))))
+ (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
;; Functions for saving and possibly digesting articles without
;; any decoding.
(gnus-uu-save-separate-articles
(save-excursion
(set-buffer buffer)
- (write-region 1 (point-max) (concat gnus-uu-saved-article-name
- gnus-current-article))
+ (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))
((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
'begin '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
(setq state (list 'begin))
(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))))
+ (when (not (eq in-state 'end))
+ (setq state (list 'middle))))
(save-excursion
(set-buffer (get-buffer "*gnus-uu-body*"))
(goto-char (setq beg (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*"))
- (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))))
+ (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
+ (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
+ (save-excursion
+ (set-buffer (get-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 (get-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 (get-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))
+ (kill-buffer (get-buffer "*gnus-uu-pre*"))
+ (kill-buffer (get-buffer "*gnus-uu-body*"))
+ (push 'end state))
(if (memq 'begin state)
(cons gnus-uu-saved-article-name state)
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)
()
(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))))
+ 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)
+ (append-to-file start-char (point) gnus-uu-binhex-article-name))))
(if (memq 'begin state)
(cons gnus-uu-binhex-article-name state)
state)))
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))
;; 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
+ ;; 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]+:")
(setq case-fold-search nil)
(goto-char (point-min))
- (if (looking-at vernum)
- (progn
- (replace-match vernum t t)
- (setq beg (length vernum))))
+ (when (looking-at vernum)
+ (replace-match vernum t t)
+ (setq beg (length vernum)))
(goto-char beg)
(if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
(replace-match "[0-9]+ of [0-9]+")
(end-of-line)
- (while (and (re-search-backward "[0-9]" nil t) (> count 0))
- (while (and
- (looking-at "[0-9]")
- (< 1 (goto-char (1- (point))))))
- (re-search-forward "[0-9]+" nil t)
- (replace-match "[0-9]+")
- (backward-char 5)
- (setq count (1- count)))))
-
+ (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
+ nil t)
+ (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
+
(goto-char beg)
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]*" t t))
(let (articles)
(cond
(n
+ (setq n (prefix-numeric-value n))
(let ((backward (< n 0))
(n (abs n)))
(save-excursion
(while (and (> n 0)
- (setq articles (cons (gnus-summary-article-number)
- articles))
+ (push (gnus-summary-article-number)
+ articles)
(gnus-summary-search-forward nil nil backward))
(setq n (1- n))))
(nreverse articles)))
(defun gnus-uu-find-articles-matching
(&optional subject only-unread do-not-translate)
;; Finds all articles that matches the regexp SUBJECT. If it is
- ;; nil, the current article name will be used. If ONLY-UNREAD is
- ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
+ ;; nil, the current article name will be used. If ONLY-UNREAD is
+ ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
;; non-nil, article names are not equalized before sorting.
(let ((subject (or subject
(gnus-uu-reginize-string (gnus-summary-article-subject))))
(= mark gnus-dormant-mark))
(setq subj (mail-header-subject (gnus-data-header d)))
(string-match subject subj)
- (setq list-of-subjects
- (cons (cons subj (gnus-data-number d))
- list-of-subjects)))))
+ (push (cons subj (gnus-data-number d))
+ list-of-subjects))))
;; Expand numbers, sort, and return the list of article
;; numbers.
- (mapcar (lambda (sub) (cdr sub))
+ (mapcar (lambda (sub) (cdr sub))
(sort (gnus-uu-expand-numbers
list-of-subjects
- (not do-not-translate))
+ (not do-not-translate))
'gnus-uu-string<))))))
(defun gnus-uu-expand-numbers (string-list &optional translate)
;; Takes a list of strings and "expands" all numbers in all the
;; strings. That is, this function makes all numbers equal length by
- ;; prepending lots of zeroes before each number. This is to ease later
+ ;; prepending lots of zeroes before each number. This is to ease later
;; sorting to find out what sequence the articles are supposed to be
- ;; decoded in. Returns the list of expanded strings.
+ ;; decoded in. Returns the list of expanded strings.
(let ((out-list string-list)
string)
(save-excursion
(replace-match " "))
;; Translate all characters to "a".
(goto-char (point-min))
- (if translate
- (while (re-search-forward "[A-Za-z]" nil t)
- (replace-match "a" t t)))
+ (when translate
+ (while (re-search-forward "[A-Za-z]" nil t)
+ (replace-match "a" t t)))
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
;; to apply to each article.
;;
;; The function to be called should take two parameters. The first
-;; parameter is the article buffer. The function should leave the
-;; result, if any, in this buffer. Most treatment functions will just
+;; parameter is the article buffer. The function should leave the
+;; result, if any, in this buffer. Most treatment functions will just
;; generate files...
;;
;; The second parameter is the state of the list of articles, and can
;; have four values: `first', `middle', `last' and `first-and-last'.
;;
-;; The function should return a list. The list may contain the
+;; The function should return a list. The list may contain the
;; following symbols:
;; `error' if an error occurred
;; `begin' if the beginning of an encoded file has been received
;; If the list returned contains a `begin', the first element of
;; the list *must* be a string with the file name of the decoded
;; file.
-;; `end' if the the end of an encoded file has been received
+;; `end' if the end of an encoded file has been received
;; `middle' if the article was a body part of an encoded file
;; `wrong-type' if the article was not a part of an encoded file
;; `ok', which can be used everything is ok
(if (not (and gnus-uu-has-been-grabbed
gnus-uu-unmark-articles-not-decoded))
()
- (if dont-unmark-last-article
- (progn
- (setq art (car gnus-uu-has-been-grabbed))
- (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))))
+ (when dont-unmark-last-article
+ (setq art (car gnus-uu-has-been-grabbed))
+ (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
(while gnus-uu-has-been-grabbed
(gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
(setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
- (if dont-unmark-last-article
- (setq gnus-uu-has-been-grabbed (list art))))))
+ (when dont-unmark-last-article
+ (setq gnus-uu-has-been-grabbed (list art))))))
;; This function takes a list of articles and a function to apply to
;; each article grabbed.
;;
;; This function returns a list of files decoded if the grabbing and
;; the process-function has been successful and nil otherwise.
-(defun gnus-uu-grab-articles
- (articles process-function &optional sloppy limit no-errors)
- (let ((state 'first)
+(defun gnus-uu-grab-articles (articles process-function
+ &optional sloppy limit no-errors)
+ (let ((state 'first)
+ (gnus-asynchronous nil)
has-been-begin article result-file result-files process-state
+ gnus-summary-display-article-function
+ gnus-article-display-hook gnus-article-prepare-hook
article-series files)
(while (and articles
(setq state 'last)))
(let ((part (gnus-uu-part-number article)))
- (message "Getting article %d%s..."
- article (if (string= part "") "" (concat ", " part))))
+ (gnus-message 6 "Getting article %d%s..."
+ article (if (string= part "") "" (concat ", " part))))
(gnus-summary-display-article article)
;; Push the article to the processing function.
;; If this is the beginning of a decoded file, we push it
;; on to a list.
(when (or (memq 'begin process-state)
- (and (or (eq state 'first)
+ (and (or (eq state 'first)
(eq state 'first-and-last))
(memq 'ok process-state)))
- (if has-been-begin
- ;; If there is a `result-file' here, that means that the
- ;; file was unsuccessfully decoded, so we delete it.
- (when (and result-file
- (file-exists-p result-file))
- (delete-file result-file)))
+ (when has-been-begin
+ ;; If there is a `result-file' here, that means that the
+ ;; file was unsuccessfully decoded, so we delete it.
+ (when (and result-file
+ (file-exists-p result-file)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p
+ (format "Delete unsuccessfully decoded file %s"
+ result-file))))
+ (delete-file result-file)))
(when (memq 'begin process-state)
(setq result-file (car process-state)))
(setq has-been-begin t))
(setq funcs (list funcs)))
(while funcs
(funcall (pop funcs) result-file))))
+ (setq result-file nil)
;; Check whether we have decoded enough articles.
(and limit (= (length result-files) limit)
(setq articles nil)))
(not (memq 'end process-state))
result-file
(file-exists-p result-file)
+ (not gnus-uu-be-dangerous)
+ (or (eq gnus-uu-be-dangerous t)
+ (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file)))
(delete-file result-file))
;; If this was a file of the wrong sort, then
(memq 'middle process-state)))
(progn
(setq process-state (list 'error))
- (message "No begin part at the beginning")
+ (gnus-message 2 "No begin part at the beginning")
(sleep-for 2))
(setq state 'middle)))
(message "")
(cond
((not has-been-begin)
- (message "Wrong type file"))
+ (gnus-message 2 "Wrong type file"))
((memq 'error process-state)
- (message "An error occurred during decoding"))
- ((not (or (memq 'ok process-state)
+ (gnus-message 2 "An error occurred during decoding"))
+ ((not (or (memq 'ok process-state)
(memq 'end process-state)))
- (message "End of articles reached before end of file")))
+ (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
(make-symbolic-link to-file file)))))
(defun gnus-uu-part-number (article)
- (let ((subject (mail-header-subject (gnus-summary-article-header article))))
- (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+"
- subject)
- (substring subject (match-beginning 0) (match-end 0))
+ (let* ((header (gnus-summary-article-header article))
+ (subject (and header (mail-header-subject header))))
+ (if (and subject
+ (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject))
+ (match-string 0 subject)
"")))
(defun gnus-uu-uudecode-sentinel (process event)
(let ((nnheader-file-name-translation-alist
'((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
(nnheader-translate-file-chars (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)
;; If a process is running, we kill it.
(when (and gnus-uu-uudecode-process
- (memq (process-status gnus-uu-uudecode-process)
+ (memq (process-status gnus-uu-uudecode-process)
'(run stop)))
(delete-process gnus-uu-uudecode-process)
(gnus-uu-unmark-list-of-grabbed t))
;; Start a new uudecoding process.
- (setq gnus-uu-uudecode-process
- (start-process
- "*uudecode*"
- (get-buffer-create gnus-uu-output-buffer-name)
- "sh" "-c"
- (format "cd %s ; uudecode" gnus-uu-work-dir)))
+ (let ((cdir default-directory))
+ (unwind-protect
+ (progn
+ (cd gnus-uu-work-dir)
+ (setq gnus-uu-uudecode-process
+ (start-process
+ "*uudecode*"
+ (get-buffer-create gnus-uu-output-buffer-name)
+ shell-file-name shell-command-switch
+ (format "cd %s %s uudecode" gnus-uu-work-dir
+ gnus-shell-command-separator))))
+ (cd cdir)))
(set-process-sentinel
gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
(setq state (list 'begin))
- (push (concat gnus-uu-work-dir gnus-uu-file-name) files)
- (gnus-uu-add-file (car files)))
+ (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
;; We look for the end of the thing to be decoded.
(if (re-search-forward gnus-uu-end-string nil t)
- (setq state (cons 'end state))
+ (push 'end state)
(goto-char (point-max))
(re-search-backward gnus-uu-body-line nil t))
(error
(progn
(delete-process gnus-uu-uudecode-process)
- (message "gnus-uu: Couldn't uudecode")
+ (gnus-message 2 "gnus-uu: Couldn't uudecode")
(setq state (list 'wrong-type)))))
(if (memq 'end state)
(progn
;; Send an EOF, just in case.
- (condition-case ()
- (process-send-eof gnus-uu-uudecode-process)
- (error nil))
+ (ignore-errors
+ (process-send-eof gnus-uu-uudecode-process))
(while (memq (process-status gnus-uu-uudecode-process)
'(open run))
(accept-process-output gnus-uu-uudecode-process 1)))
(beginning-of-line)
(setq start-char (point))
(call-process-region
- start-char (point-max) "sh" nil
+ start-char (point-max) shell-file-name nil
(get-buffer-create gnus-uu-output-buffer-name) nil
- "-c" (concat "cd " gnus-uu-work-dir " ; sh"))))
+ shell-command-switch
+ (concat "cd " gnus-uu-work-dir " "
+ gnus-shell-command-separator " sh"))))
state))
;; Returns the name of what the shar file is going to unpack.
(let ((oldpoint (point))
res)
(goto-char (point-min))
- (if (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
+ (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))
(case-fold-search t)
rule action)
(and
- (or no-ignore
- (and (not
- (and gnus-uu-ignore-files-by-name
- (string-match gnus-uu-ignore-files-by-name file-name)))
- (not
- (and gnus-uu-ignore-files-by-type
- (string-match gnus-uu-ignore-files-by-type
- (or (gnus-uu-choose-action
- file-name gnus-uu-ext-to-mime-list t)
- ""))))))
+ (unless no-ignore
+ (and (not
+ (and gnus-uu-ignore-files-by-name
+ (string-match gnus-uu-ignore-files-by-name file-name)))
+ (not
+ (and gnus-uu-ignore-files-by-type
+ (string-match gnus-uu-ignore-files-by-type
+ (or (gnus-uu-choose-action
+ file-name gnus-uu-ext-to-mime-list t)
+ ""))))))
(while (not (or (eq action-list ()) action))
(setq rule (car action-list))
(setq action-list (cdr action-list))
- (if (string-match (car rule) file-name)
- (setq action (cadr rule)))))
+ (when (string-match (car rule) file-name)
+ (setq action (cadr rule)))))
action))
(defun gnus-uu-treat-archive (file-path)
- ;; Unpacks an archive. Returns t if unpacking is successful.
+ ;; Unpacks an archive. Returns t if unpacking is successful.
(let ((did-unpack t)
action command dir)
(setq action (gnus-uu-choose-action
nil
gnus-uu-default-archive-rules))))
- (if (not action) (error "No unpackers for the file %s" file-path))
+ (when (not action)
+ (error "No unpackers for the file %s" file-path))
(string-match "/[^/]*$" file-path)
(setq dir (substring file-path 0 (match-beginning 0)))
- (if (member action gnus-uu-destructive-archivers)
- (copy-file file-path (concat file-path "~") t))
+ (when (member action gnus-uu-destructive-archivers)
+ (copy-file file-path (concat file-path "~") t))
(setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
(set-buffer (get-buffer-create gnus-uu-output-buffer-name))
(erase-buffer))
- (message "Unpacking: %s..." (gnus-uu-command action file-path))
+ (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
- (if (= 0 (call-process "sh" nil
+ (if (= 0 (call-process shell-file-name nil
(get-buffer-create gnus-uu-output-buffer-name)
- nil "-c" command))
+ nil shell-command-switch command))
(message "")
- (message "Error during unpacking of archive")
+ (gnus-message 2 "Error during unpacking of archive")
(setq did-unpack nil))
- (if (member action gnus-uu-destructive-archivers)
- (rename-file (concat file-path "~") file-path t))
+ (when (member action gnus-uu-destructive-archivers)
+ (rename-file (concat file-path "~") file-path t))
did-unpack))
(while dirs
(if (file-directory-p (setq file (car dirs)))
(setq files (append files (gnus-uu-dir-files file)))
- (setq files (cons file files)))
+ (push file files))
(setq dirs (cdr dirs)))
files))
(let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
(ofiles files)
file did-unpack)
- (gnus-uu-add-file totfiles)
(while files
(setq file (cdr (assq 'name (car files))))
- (if (and (not (member file ignore))
- (equal (gnus-uu-get-action (file-name-nondirectory file))
- "gnus-uu-archive"))
- (progn
- (setq did-unpack (cons file did-unpack))
- (or (gnus-uu-treat-archive file)
- (message "Error during unpacking of %s" file))
- (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
- (nfiles newfiles))
- (gnus-uu-add-file newfiles)
- (while nfiles
- (or (member (car nfiles) totfiles)
- (setq ofiles (cons (list (cons 'name (car nfiles))
- (cons 'original file))
- ofiles)))
- (setq nfiles (cdr nfiles)))
- (setq totfiles newfiles))))
+ (when (and (not (member file ignore))
+ (equal (gnus-uu-get-action (file-name-nondirectory file))
+ "gnus-uu-archive"))
+ (push file did-unpack)
+ (unless (gnus-uu-treat-archive file)
+ (gnus-message 2 "Error during unpacking of %s" file))
+ (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
+ (nfiles newfiles))
+ (while nfiles
+ (unless (member (car nfiles) totfiles)
+ (push (list (cons 'name (car nfiles))
+ (cons 'original file))
+ ofiles))
+ (setq nfiles (cdr nfiles)))
+ (setq totfiles newfiles)))
(setq files (cdr files)))
(if did-unpack
(gnus-uu-unpack-files ofiles (append did-unpack ignore))
(let* ((files (gnus-uu-directory-files dir t))
(ofiles files))
(while files
- (if (file-directory-p (car files))
- (progn
- (setq ofiles (delete (car files) ofiles))
- (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))))
+ (when (file-directory-p (car files))
+ (setq ofiles (delete (car files) ofiles))
+ (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))
(setq files (cdr files)))
ofiles))
(while files
(setq file (car files))
(setq files (cdr files))
- (or (string-match "/\\.\\.?$" file)
- (setq out (cons file out))))
+ (unless (member (file-name-nondirectory file) '("." ".."))
+ (push file out)))
(setq out (nreverse out))
out))
(goto-char start)
(while (not (eobp))
(progn
- (if (looking-at "\n") (replace-match ""))
+ (when (looking-at "\n")
+ (replace-match ""))
(forward-line 1))))
(while (not (eobp))
(if (looking-at (concat gnus-uu-begin-string "\\|"
gnus-uu-end-string))
()
- (if (not found)
- (progn
- (beginning-of-line)
- (setq beg (point))
- (end-of-line)
- (setq length (- (point) beg))))
+ (when (not found)
+ (beginning-of-line)
+ (setq beg (point))
+ (end-of-line)
+ (setq length (- (point) beg)))
(setq found t)
(beginning-of-line)
(setq beg (point))
(end-of-line)
- (if (not (= length (- (point) beg)))
- (insert (make-string (- length (- (point) beg)) ? ))))
+ (when (not (= length (- (point) beg)))
+ (insert (make-string (- length (- (point) beg)) ? ))))
(forward-line 1)))))))
(defvar gnus-uu-tmp-alist nil)
(defun gnus-uu-initialize (&optional scan)
(let (entry)
(if (and (not scan)
- (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
- (if (file-exists-p (cdr entry))
- (setq gnus-uu-work-dir (cdr entry))
- (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
- nil)))
+ (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
+ (if (file-exists-p (cdr entry))
+ (setq gnus-uu-work-dir (cdr entry))
+ (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
+ nil)))
t
(setq gnus-uu-tmp-dir (file-name-as-directory
(expand-file-name gnus-uu-tmp-dir)))
(if (not (file-directory-p gnus-uu-tmp-dir))
(error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
- (if (not (file-writable-p gnus-uu-tmp-dir))
- (error "Temp directory %s can't be written to"
- gnus-uu-tmp-dir)))
+ (when (not (file-writable-p gnus-uu-tmp-dir))
+ (error "Temp directory %s can't be written to"
+ gnus-uu-tmp-dir)))
(setq gnus-uu-work-dir
(make-temp-name (concat gnus-uu-tmp-dir "gnus")))
- (gnus-uu-add-file gnus-uu-work-dir)
- (if (not (file-directory-p gnus-uu-work-dir))
- (gnus-make-directory gnus-uu-work-dir))
+ (gnus-make-directory gnus-uu-work-dir)
(set-file-modes gnus-uu-work-dir 448)
(setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
- (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir)
- gnus-uu-tmp-alist)))))
+ (push (cons gnus-newsgroup-name gnus-uu-work-dir)
+ gnus-uu-tmp-alist))))
;; Kills the temporary uu buffers, kills any processes, etc.
(defun gnus-uu-clean-up ()
- (let (buf pst)
+ (let (buf)
(and gnus-uu-uudecode-process
- (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
- (if (or (eq pst 'stop) (eq pst 'run))
- (delete-process gnus-uu-uudecode-process)))
- (and (setq buf (get-buffer gnus-uu-output-buffer-name))
- (kill-buffer buf))))
-
-;; `gnus-uu-check-for-generated-files' deletes any generated files that
-;; hasn't been deleted, if, for instance, the user terminated decoding
-;; with `C-g'.
-(defun gnus-uu-check-for-generated-files ()
- (let (file dirs)
- ;; First delete the generated files.
- (while (setq file (pop gnus-uu-generated-file-list))
- (unless (string-match "/\\.[\\.]?$" file)
- (if (file-directory-p file)
- (push file dirs)
- (when (file-exists-p file)
- (delete-file file)))))
- ;; Then delete the directories.
- (setq dirs (nreverse dirs))
- (while (setq file (pop dirs))
- (delete-directory (directory-file-name file)))))
-
-;; Add a file (or a list of files) to be checked (and deleted if it/they
-;; still exists upon exiting the newsgroup).
-(defun gnus-uu-add-file (file)
- (if (stringp file)
- (setq gnus-uu-generated-file-list
- (cons file gnus-uu-generated-file-list))
- (setq gnus-uu-generated-file-list
- (append file gnus-uu-generated-file-list))))
+ (memq (process-status (or gnus-uu-uudecode-process "nevair"))
+ '(stop run))
+ (delete-process gnus-uu-uudecode-process))
+ (when (setq buf (get-buffer gnus-uu-output-buffer-name))
+ (kill-buffer buf))))
;; Inputs an action and a file and returns a full command, putting
;; quotes round the file name and escaping any quotes in the file name.
(format action ofile)
(concat action " " ofile))))
+(defun gnus-uu-delete-work-dir (&optional dir)
+ "Delete recursively all files and directories under `gnus-uu-work-dir'."
+ (if dir
+ (gnus-message 7 "Deleting directory %s..." dir)
+ (setq dir gnus-uu-work-dir))
+ (when (and dir
+ (file-exists-p dir))
+ (let ((files (directory-files dir t nil t))
+ file)
+ (while (setq file (pop files))
+ (unless (member (file-name-nondirectory 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 ""))
;; Initializing
(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files)
+(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
\f
;;; uuencoded posting
;;;
-(require 'sendmail)
-(require 'rnews)
-
;; Any function that is to be used as and encoding method will take two
-;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
+;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
;; and "spiral.jpg", respectively.) The function should return nil if
;; the encoding wasn't successful.
-(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
+(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
"Function used for encoding binary files.
There are three functions supplied with gnus-uu for encoding files:
`gnus-uu-post-encode-uuencode', which does straight uuencoding;
`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
-uuencode and adds MIME headers.")
-
-(defvar gnus-uu-post-include-before-composing nil
+uuencode and adds MIME headers."
+ :group 'gnus-extract
+ :type '(radio (function-item gnus-uu-post-encode-uuencode)
+ (function-item gnus-uu-post-encode-mime)
+ (function-item gnus-uu-post-encode-mime-uuencode)
+ (function :tag "Other")))
+
+(defcustom gnus-uu-post-include-before-composing nil
"Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
If this variable is t, you can either include an encoded file with
-\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
+\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-post-length 990
+(defcustom gnus-uu-post-length 990
"Maximum length of an article.
The encoded file will be split into how many articles it takes to
-post the entire file.")
+post the entire file."
+ :group 'gnus-extract
+ :type 'integer)
-(defvar gnus-uu-post-threaded nil
+(defcustom gnus-uu-post-threaded nil
"Non-nil means that gnus-uu will post the encoded file in a thread.
This may not be smart, as no other decoder I have seen are able to
-follow threads when collecting uuencoded articles. (Well, I have seen
+follow threads when collecting uuencoded articles. (Well, I have seen
one package that does that - gnus-uu, but somehow, I don't think that
-counts...) Default is nil.")
+counts...) Default is nil."
+ :group 'gnus-extract
+ :type 'boolean)
-(defvar gnus-uu-post-separate-description t
+(defcustom gnus-uu-post-separate-description t
"Non-nil means that the description will be posted in a separate article.
-The first article will typically be numbered (0/x). If this variable
+The first article will typically be numbered (0/x). If this variable
is nil, the description the user enters will be included at the
-beginning of the first article, which will be numbered (1/x). Default
-is t.")
+beginning of the first article, which will be numbered (1/x). Default
+is t."
+ :group 'gnus-extract
+ :type 'boolean)
(defvar gnus-uu-post-binary-separator "--binary follows this line--")
(defvar gnus-uu-post-message-id nil)
(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)
- (if gnus-uu-post-include-before-composing
- (save-excursion (setq gnus-uu-post-inserted-file-name
- (gnus-uu-post-insert-binary)))))
+ (when gnus-uu-post-include-before-composing
+ (save-excursion (setq gnus-uu-post-inserted-file-name
+ (gnus-uu-post-insert-binary)))))
(defun gnus-uu-post-insert-binary-in-article ()
"Inserts an encoded file in the buffer.
;; Encodes with uuencode and substitutes all spaces with backticks.
(defun gnus-uu-post-encode-uuencode (path file-name)
- (if (gnus-uu-post-encode-file "uuencode" path file-name)
- (progn
- (goto-char (point-min))
- (forward-line 1)
- (while (re-search-forward " " nil t)
- (replace-match "`"))
- t)))
+ (when (gnus-uu-post-encode-file "uuencode" path file-name)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (re-search-forward " " nil t)
+ (replace-match "`"))
+ t))
;; Encodes with uuencode and adds MIME headers.
(defun gnus-uu-post-encode-mime-uuencode (path file-name)
- (if (gnus-uu-post-encode-uuencode path file-name)
- (progn
- (gnus-uu-post-make-mime file-name "x-uue")
- t)))
+ (when (gnus-uu-post-encode-uuencode path file-name)
+ (gnus-uu-post-make-mime file-name "x-uue")
+ t))
;; Encodes with base64 and adds MIME headers
(defun gnus-uu-post-encode-mime (path file-name)
- (if (gnus-uu-post-encode-file "mmencode" path file-name)
- (progn
- (gnus-uu-post-make-mime file-name "base64")
- t)))
+ (when (gnus-uu-post-encode-file "mmencode" path file-name)
+ (gnus-uu-post-make-mime file-name "base64")
+ t))
;; Adds MIME headers.
(defun gnus-uu-post-make-mime (file-name encoding)
(goto-char (point-min))
(insert (format "Content-Type: %s; name=\"%s\"\n"
- (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
+ (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
file-name))
(insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
(save-restriction
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line -1)
(narrow-to-region 1 (point))
- (or (mail-fetch-field "mime-version")
- (progn
- (widen)
- (insert "MIME-Version: 1.0\n")))
+ (unless (mail-fetch-field "mime-version")
+ (widen)
+ (insert "MIME-Version: 1.0\n"))
(widen)))
;; 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 "sh" nil t nil "-c"
+ (= 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 ()
(setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
gnus-inews-article-hook
(list gnus-inews-article-hook)))
- (setq gnus-inews-article-hook
- (cons
- '(lambda ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
- (setq gnus-uu-post-message-id
- (buffer-substring
- (match-beginning 1) (match-end 1)))
- (setq gnus-uu-post-message-id nil))))
- gnus-inews-article-hook))
+ (push
+ '(lambda ()
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
+ (setq gnus-uu-post-message-id
+ (buffer-substring
+ (match-beginning 1) (match-end 1)))
+ (setq gnus-uu-post-message-id nil))))
+ gnus-inews-article-hook)
(gnus-uu-post-encoded file-name t))
(gnus-uu-post-encoded file-name nil)))
(setq gnus-uu-post-inserted-file-name nil)
- (and gnus-uu-winconf-post-news
- (set-window-configuration gnus-uu-winconf-post-news)))
+ (when gnus-uu-winconf-post-news
+ (set-window-configuration gnus-uu-winconf-post-news)))
;; Asks for a file to encode, encodes it and inserts the result in
-;; the current buffer. Returns the file name the user gave.
+;; the current buffer. Returns the file name the user gave.
(defun gnus-uu-post-insert-binary ()
(let ((uuencode-buffer-name "*uuencode buffer*")
file-path uubuf file-name)
(setq file-path (read-file-name
"What file do you want to encode? "))
- (if (not (file-exists-p file-path))
- (error "%s: No such file" file-path))
+ (when (not (file-exists-p file-path))
+ (error "%s: No such file" file-path))
(goto-char (point-max))
(insert (format "\n%s\n" gnus-uu-post-binary-separator))
- (if (string-match "^~/" file-path)
- (setq file-path (concat "$HOME" (substring file-path 1))))
+ (when (string-match "^~/" file-path)
+ (setq file-path (concat "$HOME" (substring file-path 1))))
(if (string-match "/[^/]*$" file-path)
(setq file-name (substring file-path (1+ (match-beginning 0))))
(setq file-name file-path))
(setq post-buf (current-buffer))
(goto-char (point-min))
- (if (not (re-search-forward
- (if gnus-uu-post-separate-description
- (concat "^" (regexp-quote gnus-uu-post-binary-separator)
- "$")
- (concat "^" (regexp-quote mail-header-separator) "$")) nil t))
- (error "Internal error: No binary/header separator"))
+ (when (not (re-search-forward
+ (if gnus-uu-post-separate-description
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator)
+ "$")
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ nil t))
+ (error "Internal error: No binary/header separator"))
(beginning-of-line)
(forward-line 1)
(setq beg-binary (point))
(goto-char (point-min))
(setq length (count-lines 1 (point-max)))
(setq parts (/ length gnus-uu-post-length))
- (if (not (< (% length gnus-uu-post-length) 4))
- (setq parts (1+ parts))))
+ (when (not (< (% length gnus-uu-post-length) 4))
+ (setq parts (1+ parts))))
- (if gnus-uu-post-separate-description
- (forward-line -1))
+ (when gnus-uu-post-separate-description
+ (forward-line -1))
(kill-region (point) (point-max))
(goto-char (point-min))
(goto-char (point-min))
(if (not gnus-uu-post-separate-description)
()
- (if (and (not threaded) (re-search-forward "^Subject: " nil t))
- (progn
- (end-of-line)
- (insert (format " (0/%d)" parts))))
- (gnus-inews-news))
+ (when (and (not threaded) (re-search-forward "^Subject: " nil t))
+ (end-of-line)
+ (insert (format " (0/%d)" parts)))
+ (message-send))
(save-excursion
(setq i 1)
(set-buffer (get-buffer-create send-buffer-name))
(erase-buffer)
(insert header)
- (if (and threaded gnus-uu-post-message-id)
- (insert (format "References: %s\n" gnus-uu-post-message-id)))
+ (when (and threaded gnus-uu-post-message-id)
+ (insert (format "References: %s\n" gnus-uu-post-message-id)))
(insert separator)
(setq whole-len
(- 62 (length (format top-string "" file-name i parts ""))))
- (if (> 1 (setq minlen (/ whole-len 2)))
- (setq minlen 1))
+ (when (> 1 (setq minlen (/ whole-len 2)))
+ (setq minlen 1))
(setq
beg-line
(format top-string
- (make-string minlen ?-)
+ (make-string minlen ?-)
file-name i parts
(make-string
(if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
(progn
(end-of-line)
(insert (format " (%d/%d)" i parts)))
- (if (or (and (= i 2) gnus-uu-post-separate-description)
- (and (= i 1) (not gnus-uu-post-separate-description)))
- (replace-match "Subject: Re: "))))
+ (when (or (and (= i 2) gnus-uu-post-separate-description)
+ (and (= i 1) (not gnus-uu-post-separate-description)))
+ (replace-match "Subject: Re: "))))
(goto-char (point-max))
(save-excursion
(if (= i parts)
(goto-char (point-max))
(forward-line gnus-uu-post-length))
- (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
- (forward-line -4))
+ (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
+ (forward-line -4))
(setq end (point)))
(insert-buffer-substring uubuf beg end)
(insert beg-line)
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(beginning-of-line)
(forward-line 2)
- (if (re-search-forward
- (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
- nil t)
- (progn
- (replace-match "")
- (forward-line 1)))
+ (when (re-search-forward
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
+ nil t)
+ (replace-match "")
+ (forward-line 1))
(insert beg-line)
(insert "\n")
- (gnus-inews-news)))
-
- (and (setq buf (get-buffer send-buffer-name))
- (kill-buffer buf))
- (and (setq buf (get-buffer encoded-buffer-name))
- (kill-buffer buf))
-
- (if (not gnus-uu-post-separate-description)
- (progn
- (set-buffer-modified-p nil)
- (and (fboundp 'bury-buffer) (bury-buffer))))))
+ (let (message-sent-message-via)
+ (message-send))))
+
+ (when (setq buf (get-buffer send-buffer-name))
+ (kill-buffer buf))
+ (when (setq buf (get-buffer encoded-buffer-name))
+ (kill-buffer buf))
+
+ (when (not gnus-uu-post-separate-description)
+ (set-buffer-modified-p nil)
+ (when (fboundp 'bury-buffer)
+ (bury-buffer)))))
(provide 'gnus-uu)
projects / gnus / blobdiff