;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985,86,87,93,94,95,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1985,86,87,93,94,95,96,97,98 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
;; Default viewing action 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")
+ '(("\\.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 -")
("\\.\\(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.
(defcustom gnus-uu-user-view-rules-end
'(("" "file"))
- "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."
:group 'gnus-extract-view
("\\.Z$" "uncompress")
("\\.gz$" "gunzip")
("\\.arc$" "arc -x"))
- "See `gnus-uu-user-archive-rules'."
+ "*See `gnus-uu-user-archive-rules'."
:group 'gnus-extract-archive
:type '(repeat (group regexp (string :tag "Command"))))
: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:")
- "List of regexps to match headers included in digested messages.
+ "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:")
+ "*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))
(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-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-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)
"v" gnus-uu-mark-over
"s" gnus-uu-mark-series
"r" gnus-uu-mark-region
+ "g" gnus-uu-unmark-region
"R" gnus-uu-mark-by-regexp
+ "G" gnus-uu-unmark-by-regexp
"t" gnus-uu-mark-thread
"T" gnus-uu-unmark-thread
"a" gnus-uu-mark-all
(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))
(data gnus-newsgroup-data))
(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
(re-search-forward "\n\n")
;; Quote all 30-dash lines.
(save-excursion
- (while (re-search-forward delim nil t)
+ (while (re-search-forward "^-" nil t)
(beginning-of-line)
(delete-char 1)
- (insert " ")))
+ (insert "- ")))
(setq body (buffer-substring (1- (point)) (point-max)))
(narrow-to-region (point-min) (point))
(if (not (setq headers gnus-uu-digest-headers))
(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*"))
+ (set-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*"))
+ (set-buffer "*gnus-uu-pre*")
(insert (format "\n\n%s\n\n" (make-string 70 ?-)))
(gnus-write-buffer gnus-uu-saved-article-name))
(save-excursion
- (set-buffer (get-buffer "*gnus-uu-body*"))
+ (set-buffer "*gnus-uu-body*")
(goto-char (point-max))
(insert
(concat (setq end-string (format "End of %s Digest" name))
(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*"))
+ (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)
;; 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)
(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)
+ ;; 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]+".
+ (let ((count 2))
(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)
(setq case-fold-search nil)
- (goto-char (point-min))
- (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]+/[0-9]+")
+ (end-of-line)
+ (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t)
+ (replace-match "\\1[0-9]+/\\2")
- (goto-char beg)
- (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
- (replace-match "[0-9]+ of [0-9]+")
+ (end-of-line)
+ (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)"
+ nil t)
+ (replace-match "\\1[0-9]+ of \\2")
(end-of-line)
(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)
+ (goto-char 1)
(while (re-search-forward "[ \t]+" nil t)
- (replace-match "[ \t]*" t t))
+ (replace-match "[ \t]+" t t))
(buffer-substring 1 (point-max)))))
(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
(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)))
+ (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
(defun gnus-uu-part-number (article)
(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)
- "")))
+ (subject (and header (mail-header-subject header)))
+ (part nil))
+ (if subject
+ (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+"
+ subject)
+ (setq part (match-string 0 subject))
+ (setq subject (substring subject (match-end 0)))))
+ (or part
+ (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject)
+ (setq part (match-string 0 subject))
+ (setq subject (substring subject (match-end 0)))))
+ (or part "")))
(defun gnus-uu-uudecode-sentinel (process event)
(delete-process (get-process process)))
;; Try to correct mishandled uucode.
(when gnus-uu-correct-stripped-uucode
(gnus-uu-check-correct-stripped-uucode start-char (point)))
+ (gnus-run-hooks 'gnus-uu-pre-uudecode-hook)
;; Send the text to the process.
(condition-case nil
;; Encodes with base64 and adds MIME headers
(defun gnus-uu-post-encode-mime (path file-name)
- (when (gnus-uu-post-encode-file "mmencode" path file-name)
+ (when (zerop (call-process shell-file-name nil t nil shell-command-switch
+ (format "%s %s -o %s" "mmencode" path file-name)))
(gnus-uu-post-make-mime file-name "base64")
t))
(goto-char (point-max))
(insert (format "\n%s\n" gnus-uu-post-binary-separator))
+ ;; #### Unix-specific?
(when (string-match "^~/" file-path)
(setq file-path (concat "$HOME" (substring file-path 1))))
+ ;; #### Unix-specific?
(if (string-match "/[^/]*$" file-path)
(setq file-name (substring file-path (1+ (match-beginning 0))))
(setq file-name file-path))
projects / gnus / blobdiff