;;; Code:
(require 'gnus)
+(require 'gnus-msg)
;; Default viewing action rules
For example:
To make gnus-uu use 'xli' to display JPEG and GIF files, put the
-following in your .emacs file
+following in your .emacs file:
(setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
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 vaiable provided in this package. If gnus-uu finds no
+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-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 suer will only be asked to save if the
+If the variable is nil, the user will only be asked to save if the
viewing is unsuccessful. Default is nil.")
(defvar gnus-uu-ignore-default-view-rules nil
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 traling spaces deleted.
+ "*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
no easy way to specify any meaningful volume and issue numbers were found,
so I simply dropped them.")
+(defvar 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.")
(defvar gnus-uu-shar-file-name nil)
(defconst 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-file-name nil)
(defconst gnus-uu-uudecode-process nil)
(defvar gnus-uu-generated-file-list nil)
(defvar gnus-uu-work-dir nil)
-(defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
+(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
(defconst gnus-uu-highest-article-number 1)
(defvar gnus-uu-default-dir default-directory)
+;; Keymaps
+
+(defvar gnus-uu-extract-map nil)
+(defvar gnus-uu-extract-view-map nil)
+(defvar gnus-uu-mark-map nil)
+
+(define-prefix-command 'gnus-uu-mark-map)
+(define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
+(define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable)
+(define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable)
+(define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable)
+(define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series)
+(define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region)
+(define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp)
+(define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread)
+(define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all)
+(define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse)
+
+(define-prefix-command 'gnus-uu-extract-map)
+(define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
+;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any)
+;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime)
+(define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu)
+(define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save)
+(define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar)
+(define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save)
+(define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save)
+(define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save)
+(define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex)
+(define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex)
+(define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript)
+(define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save)
+
+(define-prefix-command 'gnus-uu-extract-view-map)
+(define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map)
+(define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view)
+(define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view)
+(define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view)
+(define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view)
+(define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view)
+(define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view)
+(define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view)
+(define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view)
+(define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view)
+(define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view)
+
+
+
;; Commands.
(defun gnus-uu-decode-uu (n)
"Decodes and saves the resulting file."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ (file-name-as-directory
+ (read-file-name "Uudecode and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
(gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir))
(defun gnus-uu-decode-unshar (n)
"Unshars the current article."
(interactive "P")
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n))
+ (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan))
(defun gnus-uu-decode-unshar-and-save (n dir)
"Unshars and saves the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir))
+ (file-name-as-directory
+ (read-file-name "Unshar and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
+ (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan))
(defun gnus-uu-decode-save (n file)
"Saves the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file? "
- gnus-uu-default-dir
- gnus-uu-default-dir)))
+ (read-file-name
+ (if gnus-uu-save-separate-articles
+ "Save articles is dir: "
+ "Save articles in file: ")
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
(setq gnus-uu-saved-article-name file)
- (gnus-uu-decode-with-method 'gnus-uu-save-article n nil)
+ (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)))
"Unbinhexes the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ (file-name-as-directory
+ (read-file-name "Unbinhex and save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
(defun gnus-uu-decode-uu-view (n)
"Decodes, views and saves the resulting file."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
+ (read-file-name "Uudecode, view and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
"Unshars and saves the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
+ (read-file-name "Unshar, view and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir t)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
"Saves and views the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file? "
- gnus-uu-default-dir gnus-uu-default-dir)))
+ (read-file-name (if gnus-uu-save-separate-articles
+ "Save articles is dir: "
+ "Save articles in file: ")
+ gnus-uu-default-dir gnus-uu-default-dir)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-save n file)))
"Unbinhexes and views the current article."
(interactive
(list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
+ (read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-binhex n file)))
;; Digest and forward articles
-(defun gnus-uu-digest-and-forward (n)
+(defun gnus-uu-digest-mail-forward (n &optional post)
"Digests and forwards all articles in this series."
(interactive "P")
- (gnus-uu-initialize)
(let ((gnus-uu-save-in-digest t)
- (file (concat gnus-uu-work-dir (make-temp-name "forward"))))
+ (file (make-temp-name (concat gnus-uu-tmp-dir "forward")))
+ buf)
(gnus-uu-decode-save n file)
- (switch-to-buffer (get-buffer-create "*gnus-uu-forward*"))
+ (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)
(goto-char (point-min))
- (funcall gnus-mail-forward-method)))
+ (and (re-search-forward "^Subject: ")
+ (progn
+ (delete-region (point) (gnus-point-at-eol))
+ (insert "Digested Articles")))
+ (goto-char (point-min))
+ (and (re-search-forward "^From: ")
+ (progn
+ (delete-region (point) (gnus-point-at-eol))
+ (insert "Various")))
+ (if post
+ (gnus-forward-using-post)
+ (funcall gnus-mail-forward-method))
+ (delete-file file)
+ (kill-buffer buf)))
+
+(defun gnus-uu-digest-post-forward (n)
+ "Digest and forward to a newsgroup."
+ (interactive "P")
+ (gnus-uu-digest-mail-forward n t))
;; Process marking.
(defun gnus-uu-mark-by-regexp (regexp)
"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
(gnus-summary-set-process-mark (car articles))
(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)
"Marks all articles between point and mark."
(interactive "r")
+ (gnus-set-global-variables)
(save-excursion
(goto-char beg)
(while (< (point) end)
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
(interactive)
+ (gnus-set-global-variables)
(save-excursion
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
(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)
+ subject articles total headers)
(or marked (error "No articles marked with the process mark"))
(setq gnus-newsgroup-processable nil)
(save-excursion
(while marked
- (setq subject (header-subject (gnus-get-header-by-number (car marked)))
- articles (gnus-uu-find-articles-matching
- (gnus-uu-reginize-string subject))
- total (nconc total articles))
+ (and (setq headers (gnus-get-header-by-number (car marked)))
+ (setq subject (header-subject headers)
+ articles (gnus-uu-find-articles-matching
+ (gnus-uu-reginize-string subject))
+ total (nconc total articles)))
(while articles
(gnus-summary-set-process-mark (car articles))
(setcdr marked (delq (car articles) (cdr marked)))
(defun gnus-uu-mark-all ()
"Mark all articles in \"series\" order."
(interactive)
+ (gnus-set-global-variables)
(setq gnus-newsgroup-processable nil)
(save-excursion
(goto-char (point-min))
(forward-line 1))))
(gnus-summary-position-cursor))
+;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
+
+(defun gnus-uu-decode-postscript (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)
+ "Gets and views the current article."
+ (interactive "P")
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-postscript n)))
+
+(defun gnus-uu-decode-postscript-and-save (n dir)
+ "Extracts postscript and saves the current article."
+ (interactive
+ (list current-prefix-arg
+ (file-name-as-directory
+ (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 n dir))
+
+
+(defun gnus-uu-decode-postscript-and-save-view (n dir)
+ "Decodes, views and saves the resulting file."
+ (interactive
+ (list current-prefix-arg
+ (read-file-name "Where do you want to save the file(s)? "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
+ (gnus-uu-decode-postscript-and-save n dir)))
+
+
;; Internal functions.
-(defun gnus-uu-decode-with-method (method n &optional save)
+(defun gnus-uu-decode-with-method (method n &optional save not-insert scan)
(gnus-uu-initialize)
(if save (setq gnus-uu-default-dir save))
(let ((articles (gnus-uu-get-list-of-articles n))
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))
(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)))
- (gnus-summary-insert-pseudos files)))
+ (or not-insert (gnus-summary-insert-pseudos files save))))
+
+;; Return a list of files in dir.
+(defun gnus-uu-scan-directory (dir)
+ (let ((files (directory-files dir t))
+ dirs out)
+ (while files
+ (cond ((string-match "/\\.\\.?$" (car files)))
+ ((file-directory-p (car files))
+ (setq dirs (cons (car files) dirs)))
+ (t (setq out (cons (list (cons 'name (car files))
+ (cons 'article gnus-current-article))
+ out))))
+ (setq files (cdr files)))
+ (apply 'nconc out (mapcar (lambda (d) (gnus-uu-scan-directory d))
+ dirs))))
(defun gnus-uu-save-files (files dir)
(let ((len (length files))
- file)
+ to-file file)
(while files
(setq file (cdr (assq 'name (car files))))
(and (file-exists-p file)
- (copy-file file (if (file-directory-p dir)
- (concat dir (file-name-nondirectory file)) dir)
- 1 t))
+ (progn
+ (setq to-file (if (file-directory-p dir)
+ (concat dir (file-name-nondirectory file))
+ dir))
+ (and (or (not (file-exists-p to-file))
+ (gnus-y-or-n-p (format "%s exists; overwrite? "
+ to-file)))
+ (copy-file file to-file 1 t))))
(setq files (cdr files)))
(message "Saved %d file%s" len (if (> len 1) "s" ""))))
((eq in-state 'last) (list 'end))
(t (list 'middle)))))
(t
- (let (beg subj name headers headline sorthead body end-string state)
- (string-match "/\\([^/]*\\)$" gnus-uu-saved-article-name)
- (setq name (substring gnus-uu-saved-article-name (match-beginning 1)
- (match-end 1)))
+ (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
+ beg subj headers headline sorthead body end-string state)
(if (or (eq in-state 'first)
(eq in-state 'first-and-last))
(progn
(save-excursion
(save-restriction
(set-buffer buffer)
- (goto-char 1)
+ (goto-char (point-min))
(re-search-forward "\n\n")
(setq body (buffer-substring (1- (point)) (point-max)))
(narrow-to-region 1 (point))
- (setq headers (list "Date:" "From:" "To:" "Cc:" "Subject:"
- "Message-ID:" "Keywords:" "Summary:"))
+ (setq headers gnus-uu-digest-headers)
(while headers
(setq headline (car headers))
(setq headers (cdr headers))
- (goto-char 1)
- (if (re-search-forward (concat "^" headline ".*$") nil t)
+ (goto-char (point-min))
+ (if (re-search-forward headline nil t)
(setq sorthead
- (concat sorthead (buffer-substring
- (match-beginning 0)
- (match-end 0)) "\n"))))
+ (concat sorthead
+ (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))
(save-excursion
(set-buffer buffer)
(widen)
- (goto-char 1)
+ (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))))
(if (memq 'begin state)
(cons gnus-uu-binhex-article-name state)
state)))
+
+;; PostScript
+
+(defun gnus-uu-decode-postscript-article (process-buffer in-state)
+ (let ((state (list 'ok))
+ start-char end-char file-name)
+ (save-excursion
+ (set-buffer process-buffer)
+ (goto-char (point-min))
+ (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
+ (setq state (list 'wrong-type))
+ (beginning-of-line)
+ (setq start-char (point))
+ (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))
+ (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.
(setq name (cdr (assq 'name (car files))))
(and
(setq action (gnus-uu-get-action name))
- (setcar files (cons (cons 'execute (if (string-match "%" action)
- (format action name)
- (concat action " " name)))
- (car files))))
+ (setcar files (nconc (list (if (string= action "gnus-uu-archive")
+ (cons 'action "file")
+ (cons 'action action))
+ (cons 'execute (if (string-match "%" action)
+ (format action name)
+ (concat action " " name))))
+ (car files))))
(setq files (cdr files)))
ofiles))
;; my experience, should get most postings of a series.
(let ((count 2)
(vernum "v[0-9]+[a-z][0-9]+:")
- reg beg)
+ beg)
(save-excursion
(set-buffer (get-buffer-create gnus-uu-output-buffer-name))
(buffer-disable-undo (current-buffer))
(setq beg 1)
(setq case-fold-search nil)
- (goto-char 1)
+ (goto-char (point-min))
(if (looking-at vernum)
(progn
(replace-match vernum t t)
;; returned.
;; Failing that, articles that have subjects that are part of the
;; same "series" as the current will be returned.
- (let (articles process)
+ (let (articles)
(cond
(n
(let ((backward (< n 0))
;; non-nil, article names are not equalized before sorting.
(let ((subject (or subject
(gnus-uu-reginize-string (gnus-summary-subject-string))))
- beg end list-of-subjects)
+ list-of-subjects)
(save-excursion
(if (not subject)
()
;; sorting to find out what sequence the articles are supposed to be
;; decoded in. Returns the list of expanded strings.
(let ((out-list string-list)
- string pos num)
+ string)
(save-excursion
(set-buffer (get-buffer-create gnus-uu-output-buffer-name))
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert (car (car string-list)))
;; Translate multiple spaces to one space.
- (goto-char 1)
+ (goto-char (point-min))
(while (re-search-forward "[ \t]+" nil t)
(replace-match " "))
;; Translate all characters to "a".
- (goto-char 1)
+ (goto-char (point-min))
(if translate
(while (re-search-forward "[A-Za-z]" nil t)
(replace-match "a" t t)))
;; Expand numbers.
- (goto-char 1)
+ (goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
(replace-match
(format "%06d"
(defun gnus-uu-grab-articles
(articles process-function &optional sloppy limit no-errors)
(let ((state 'first)
- (wrong-type t)
- has-been-begin has-been-end
- article result-file result-files process-state article-buffer
- begin-article)
+ has-been-begin article result-file result-files process-state
+ article-buffer)
(if (not (gnus-server-opened gnus-current-select-method))
(progn
(setq state 'first-and-last)
(setq state 'last)))
- (message "Getting article %d" article)
+ (message "Getting article %d, %s" article (gnus-uu-part-number article))
(if (not (= (or gnus-current-article 0) article))
- (progn
+ (let ((nntp-async-number nil))
(gnus-request-article article gnus-newsgroup-name
nntp-server-buffer)
(setq gnus-last-article gnus-current-article)
(setq gnus-current-article article)
+ (setq gnus-article-current (cons gnus-newsgroup-name article))
(if (stringp nntp-server-buffer)
(setq article-buffer nntp-server-buffer)
(setq article-buffer (buffer-name nntp-server-buffer))))
(delete-file result-file)))
(if (memq 'begin process-state)
(setq result-file (car process-state)))
- (setq begin-article article)
- (setq has-been-begin t)
- (setq has-been-end nil)))
+ (setq has-been-begin t)))
(if (memq 'end process-state)
(progn
(setq result-files (cons (list (cons 'name result-file)
(cons 'article article))
result-files))
- (setq has-been-end t)
(setq has-been-begin nil)
(and limit (= (length result-files) limit)
(setq articles nil))))
(delete-file result-file)))
(if (not (memq 'wrong-type process-state))
- (setq wrong-type nil)
+ ()
(if gnus-uu-unmark-articles-not-decoded
(gnus-summary-tick-article article t)))
- (if sloppy (setq wrong-type nil))
-
(if (and (not has-been-begin)
(not sloppy)
(or (memq 'end process-state)
(widen)
(erase-buffer)
(insert-buffer-substring article-buffer)
- (goto-char 1))))
+ (goto-char (point-min)))))
(if result-files
()
(gnus-uu-unmark-list-of-grabbed)))))
result-files))
+(defun gnus-uu-part-number (article)
+ (let ((subject (header-subject (gnus-get-header-by-number article))))
+ (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+"
+ subject)
+ (substring subject (match-beginning 0) (match-end 0))
+ "")))
+
(defun gnus-uu-uudecode-sentinel (process event)
(delete-process (get-process process)))
(let ((case-fold-search nil)
(buffer-read-only nil))
- (goto-char 1)
+ (goto-char (point-min))
(if gnus-uu-kill-carriage-return
(progn
(while (search-forward "\r" nil t)
(delete-backward-char 1))
- (goto-char 1)))
+ (goto-char (point-min))))
(if (not (re-search-forward gnus-uu-begin-string nil t))
(if (not (re-search-forward gnus-uu-body-line nil t))
(if (looking-at gnus-uu-begin-string)
(progn
- (setq name-end (match-end 1))
-
+ (setq name-end (match-end 1)
+ name-beg (match-beginning 1))
+ ;; Remove any non gnus-uu-body-line right after start.
+ (forward-line 1)
+ (or (looking-at gnus-uu-body-line)
+ (gnus-delete-line))
+
; Replace any slashes and spaces in file names before decoding
- (goto-char (setq name-beg (match-beginning 1)))
+ (goto-char name-beg)
(while (re-search-forward "/" name-end t)
(replace-match ","))
(goto-char name-beg)
nil t)
(forward-line 1)))
- (condition-case err
+ (condition-case nil
(process-send-region gnus-uu-uudecode-process
start-char (point))
(error
start-char)
(save-excursion
(set-buffer process-buffer)
- (goto-char 1)
+ (goto-char (point-min))
(if (not (re-search-forward gnus-uu-shar-begin-string nil t))
(setq state (list 'wrong-type))
(beginning-of-line)
(defun gnus-uu-find-name-in-shar ()
(let ((oldpoint (point))
res)
- (goto-char 1)
+ (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))))
(goto-char oldpoint)
(defun gnus-uu-treat-archive (file-path)
;; Unpacks an archive. Returns t if unpacking is successful.
(let ((did-unpack t)
- action command files file file-name dir)
+ action command dir)
(setq action (gnus-uu-choose-action
file-path (append gnus-uu-user-archive-rules
(if gnus-uu-ignore-default-archive-rules
(if (not action) (error "No unpackers for the file %s" file-path))
(string-match "/[^/]*$" file-path)
- (setq file-name (substring file-path (1+ (match-beginning 0))))
(setq dir (substring file-path 0 (match-beginning 0)))
(if (member action gnus-uu-destructive-archivers)
;; Go through FILES and look for files to unpack.
(let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
(ofiles files)
- file did-unpack)
+ file did-unpack file-entry)
+ (gnus-uu-add-file totfiles)
(while files
- (setq file (cdr (assq 'name (car files))))
+ (setq file (cdr (setq file-entry (assq 'name (car files)))))
(if (and (not (member file ignore))
(equal (gnus-uu-get-action (file-name-nondirectory file))
"gnus-uu-archive"))
(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))
out))
(defun gnus-uu-check-correct-stripped-uucode (start end)
- (let (found beg length short)
+ (let (found beg length)
(if (not gnus-uu-correct-stripped-uucode)
()
(goto-char start)
(insert (make-string (- length (- (point) beg)) ? ))))
(forward-line 1))))))
+(defvar gnus-uu-tmp-alist nil)
+
(defun gnus-uu-initialize ()
- (setq gnus-uu-highest-article-number 1)
- (gnus-uu-check-for-generated-files)
- (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir))
- (if (string-match "[^/]$" gnus-uu-tmp-dir)
- (setq gnus-uu-tmp-dir (concat 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)))
- (setq gnus-uu-work-dir
- (concat gnus-uu-tmp-dir (make-temp-name "gnus")))
- (gnus-uu-add-file gnus-uu-work-dir)
- (if (not (file-directory-p gnus-uu-work-dir))
- (make-directory gnus-uu-work-dir))
- (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")))
+ (let (entry)
+ (if (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))
+ t
+ (setq gnus-uu-highest-article-number 1)
+ (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)))
+
+ (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))
+ (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)))))
+
;; Kills the temporary uu buffers, kills any processes, etc.
(defun gnus-uu-clean-up ()
(append file gnus-uu-generated-file-list))))
;; Inputs an action and a file and returns a full command, putting
-;; ticks round the file name and escaping any ticks in the file name.
+;; quotes round the file name and escaping any quotes in the file name.
(defun gnus-uu-command (action file)
(let ((ofile ""))
- (while (string-match "`\\|\"\\|\\$\\|\\\\" file)
+ (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file)
(progn
(setq ofile
(concat ofile (substring file 0 (match-beginning 0)) "\\"
(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
(add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files)
+\f
-;; Major mode for posting encoded articles.
+;;;
+;;; uuencoded posting
+;;;
(require 'sendmail)
(require 'rnews)
(defvar 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-reply-mode-map>\\[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.")
(defvar gnus-uu-post-length 990
"Maximum length of an article.
(defvar gnus-uu-post-inserted-file-name nil)
(defvar gnus-uu-winconf-post-news nil)
-;; The following map and mode was taken from rnewspost.el and edited
-;; somewhat.
-(defvar gnus-uu-post-reply-mode-map nil)
-(if gnus-uu-post-reply-mode-map
- ()
- (setq gnus-uu-post-reply-mode-map (make-keymap))
- (define-key gnus-uu-post-reply-mode-map "\C-c?" 'describe-mode)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-d"
- 'news-reply-distribution)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-k"
- 'news-reply-keywords)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-n"
- 'news-reply-newsgroups)
-
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-f"
- 'news-reply-followup-to)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-a"
- 'gnus-uu-post-reply-summary)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-r"
- 'news-caesar-buffer-body)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-w" 'news-reply-signature)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-y"
- 'news-reply-yank-original)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-q"
- 'mail-fill-yanked-message)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-c"
- 'gnus-uu-post-news-inews)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-s"
- 'gnus-uu-post-news-inews)
- (define-key gnus-uu-post-reply-mode-map "\C-c\C-i"
- 'gnus-uu-post-insert-binary-in-article)
- )
-
-;; This mode was taken from rnewspost.el and modified slightly.
-(defun gnus-uu-post-reply-mode ()
- "Major mode for editing binary news to be posted on USENET.
-First-time posters are asked to please read the articles in newsgroup:
- news.announce.newusers .
-
-Like news-reply-mode, which is like Text Mode, but with these
-additional commands:
-
-\\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-news-inews] post the message.
-C-c C-f move to a header field (and create it if there isn't):
- C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj:
- C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords:
- C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary:
-C-c C-y news-reply-yank-original (insert current message, in NEWS).
-C-c C-q mail-fill-yanked-message (fill what was yanked).
-C-c C-r caesar rotate all letters by 13 places in the article's body (rot13).
-\\[gnus-uu-post-insert-binary-in-article] encode and include a file in this article.
-
-This mode is almost identical to news-reply-mode, but has some
-additional commands for treating encoded binary articles. In
-particular, \\[gnus-uu-post-news-inews] will ask for a file to include, if
-one hasn't been included already. It will post, first, the message
-composed, and then it will post as many additional articles it takes
-to post the entire encoded files.
-
- Relevant Variables
-
- `gnus-uu-post-encode-method'
- 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.
-
- `gnus-uu-post-include-before-composing'
- 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 `C-c C-i' or have one included for you when you
- post the article.
-
- `gnus-uu-post-length'
- Maximum length of an article. The encoded file will be split into how
- many articles it takes to post the entire file.
-
- `gnus-uu-post-separate-description'
- 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 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.
-
- `gnus-uu-post-threaded'
- 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
- one package that does that - gnus-uu, but somehow, I don't think that
- counts...) Default is nil.
-"
- (interactive)
- ;; require...
- (or (fboundp 'mail-setup) (load "sendmail"))
- (kill-all-local-variables)
- (make-local-variable 'mail-reply-buffer)
- (setq mail-reply-buffer nil)
- (set-syntax-table text-mode-syntax-table)
- (use-local-map gnus-uu-post-reply-mode-map)
- (setq local-abbrev-table text-mode-abbrev-table)
- (setq major-mode 'gnus-uu-post-reply-mode)
- (setq mode-name "Gnus UU News")
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "^" (regexp-quote mail-header-separator)
- "$\\|" paragraph-start))
- (setq paragraph-separate (concat "^" (regexp-quote mail-header-separator)
- "$\\|" paragraph-separate))
- (run-hooks 'text-mode-hook 'gnus-uu-post-reply-mode-hook))
-
(defun gnus-uu-post-news ()
"Compose an article and post an encoded file."
(interactive)
(setq gnus-uu-post-inserted-file-name nil)
(setq gnus-uu-winconf-post-news (current-window-configuration))
- (let (news-reply-mode)
- (fset 'news-reply-mode 'gnus-uu-post-reply-mode)
- (gnus-summary-post-news)
- (if gnus-uu-post-include-before-composing
- (save-excursion (setq gnus-uu-post-inserted-file-name
- (gnus-uu-post-insert-binary))))))
+
+ (gnus-summary-post-news)
+
+ (use-local-map (copy-keymap (current-local-map)))
+ (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
+ (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
+ (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
+
+ (if 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.
(defun gnus-uu-post-encode-uuencode (path file-name)
(if (gnus-uu-post-encode-file "uuencode" path file-name)
(progn
- (goto-char 1)
+ (goto-char (point-min))
(forward-line 1)
(while (re-search-forward " " nil t)
(replace-match "`"))
;; Adds MIME headers.
(defun gnus-uu-post-make-mime (file-name encoding)
- (goto-char 1)
+ (goto-char (point-min))
(insert (format "Content-Type: %s; name=\"%s\"\n"
(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
(set-buffer gnus-post-news-buffer)
- (goto-char 1)
- (re-search-forward (regexp-quote mail-header-separator))
- (beginning-of-line)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line -1)
(narrow-to-region 1 (point))
(or (mail-fetch-field "mime-version")
(if (memq 'Message-ID gnus-required-headers)
gnus-required-headers
(cons 'Message-ID gnus-required-headers)))
- gnus-inews-article-hook elem)
+ gnus-inews-article-hook)
(setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
gnus-inews-article-hook
(cons
'(lambda ()
(save-excursion
- (goto-char 1)
+ (goto-char (point-min))
(if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
(setq gnus-uu-post-message-id
(buffer-substring
;; the current buffer. Returns the file name the user gave.
(defun gnus-uu-post-insert-binary ()
(let ((uuencode-buffer-name "*uuencode buffer*")
- file-path post-buf uubuf file-name)
+ file-path uubuf file-name)
(setq file-path (read-file-name
"What file do you want to encode? "))
(encoded-buffer-name "*encoded buffer*")
(top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
(separator (concat mail-header-separator "\n\n"))
- file uubuf length parts header i end beg
+ uubuf length parts header i end beg
beg-line minlen buf post-buf whole-len beg-binary end-binary)
(setq post-buf (current-buffer))
- (goto-char 1)
+ (goto-char (point-min))
(if (not (re-search-forward
(if gnus-uu-post-separate-description
- gnus-uu-post-binary-separator
+ (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)
(set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
(erase-buffer)
(insert-buffer-substring post-buf beg-binary end-binary)
- (goto-char 1)
+ (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))
(forward-line -1))
(kill-region (point) (point-max))
- (goto-char 1)
+ (goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(beginning-of-line)
(setq header (buffer-substring 1 (point)))
- (goto-char 1)
+ (goto-char (point-min))
(if (not gnus-uu-post-separate-description)
()
(if (and (not threaded) (re-search-forward "^Subject: " nil t))
(make-string
(if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
- (goto-char 1)
+ (goto-char (point-min))
(if (not (re-search-forward "^Subject: " nil t))
()
(if (not threaded)
(insert "\n")
(setq beg end)
(setq i (1+ i))
- (goto-char 1)
+ (goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(beginning-of-line)
(forward-line 2)
- (if (re-search-forward gnus-uu-post-binary-separator nil t)
+ (if (re-search-forward
+ (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
+ nil t)
(progn
(replace-match "")
(forward-line 1)))
projects / gnus / blobdiff