(require 'gnus-art)
(require 'message)
(require 'gnus-msg)
-(require 'mm-decode)
(defgroup gnus-extract nil
"Extracting encoded files."
'("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
"^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
"^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
- "^Content-ID:")
+ "^Content-ID:" "^User-Agent:" "^X-Face:")
"*List of regexps to match headers included in digested messages.
The headers will be included in the sequence they are matched."
:group 'gnus-extract
(interactive "P")
(let ((gnus-uu-save-in-digest t)
(file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward")))
- (message-forward-as-mime message-forward-as-mime)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
gnus-uu-digest-buffer subject from)
- (if (and n (not (numberp n)))
- (setq message-forward-as-mime (not message-forward-as-mime)
- n nil))
(gnus-setup-message 'forward
(setq gnus-uu-digest-from-subject nil)
- (setq gnus-uu-digest-buffer
+ (setq gnus-uu-digest-buffer
(gnus-get-buffer-create " *gnus-uu-forward*"))
(gnus-uu-decode-save n file)
- (switch-to-buffer gnus-uu-digest-buffer)
+ (set-buffer gnus-uu-digest-buffer)
(let ((fs gnus-uu-digest-from-subject))
(when fs
(setq from (caar fs)
(if (gnus-news-group-p gnus-newsgroup-name)
gnus-newsgroup-name
"Various"))))
- (goto-char (point-min))
- (when (re-search-forward "^Subject: ")
- (delete-region (point) (gnus-point-at-eol))
- (insert subject))
- (goto-char (point-min))
- (when (re-search-forward "^From:")
- (delete-region (point) (gnus-point-at-eol))
- (insert " " from))
- (message-forward post t))
+ (mime-edit-enclose-digest-region (point-min) (point-max))
+ (if post
+ (message-news nil (concat "[" from "] " subject))
+ (message-mail nil (concat "[" from "] " subject)))
+ (message-goto-body)
+ ;; Make sure we're at the start of the line.
+ (unless (bolp)
+ (insert "\n"))
+ ;; Insert the forwarded buffer.
+ (insert-buffer gnus-uu-digest-buffer)
+ (kill-buffer gnus-uu-digest-buffer)
+ (set-text-properties (point-min) (point-max) nil)
+ (message-position-point))
(setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (&optional n)
(gnus-uu-save-separate-articles
(save-excursion
(set-buffer buffer)
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer
- (concat gnus-uu-saved-article-name gnus-current-article)))
+ (gnus-write-buffer-as-coding-system
+ nnheader-text-coding-system
+ (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))
(save-excursion
(set-buffer (gnus-get-buffer-create "*gnus-uu-pre*"))
(erase-buffer)
- (insert (format
- "Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
- (current-time-string) name name))
- (when (and message-forward-as-mime gnus-uu-digest-buffer)
- ;; The default part in multipart/digest is message/rfc822.
- ;; Subject is a fake head.
- (insert "<#part type=text/plain>\nSubject: Topics\n\n"))
+ (unless gnus-uu-digest-buffer
+ (insert (format "From: %s\nSubject: %s Digest\n\n" name name)))
(insert "Topics:\n")))
(when (not (eq in-state 'end))
(setq state (list 'middle))))
;; These two are necessary for XEmacs 19.12 fascism.
(put-text-property (point-min) (point-max) 'invisible nil)
(put-text-property (point-min) (point-max) 'intangible nil))
- (when (and message-forward-as-mime
- message-forward-show-mml
- gnus-uu-digest-buffer)
- (mm-enable-multibyte)
- (mime-to-mml))
(goto-char (point-min))
(re-search-forward "\n\n")
- (unless (and message-forward-as-mime gnus-uu-digest-buffer)
+ (unless gnus-uu-digest-buffer
;; Quote all 30-dash lines.
(save-excursion
(while (re-search-forward "^-" nil t)
(1- (point)))
(progn (forward-line 1) (point)))))))))
(widen)))
- (if (and message-forward-as-mime gnus-uu-digest-buffer)
- (if message-forward-show-mml
- (progn
- (insert "\n<#mml type=message/rfc822>\n")
- (insert sorthead) (goto-char (point-max))
- (insert body) (goto-char (point-max))
- (insert "\n<#/mml>\n"))
- (let ((buf (mml-generate-new-buffer " *mml*")))
- (with-current-buffer buf
- (insert sorthead)
- (goto-char (point-min))
- (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (setq subj (buffer-substring (match-beginning 1)
- (match-end 1))))
- (goto-char (point-max))
- (insert body))
- (insert "\n<#part type=message/rfc822"
- " buffer=\"" (buffer-name buf) "\">\n")))
- (insert sorthead) (goto-char (point-max))
- (insert body) (goto-char (point-max))
- (insert (concat "\n" (make-string 30 ?-) "\n\n")))
+ (insert message-forward-start-separator)
+ (insert sorthead) (goto-char (point-max))
+ (insert body) (goto-char (point-max))
(goto-char beg)
- (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (setq subj (buffer-substring (match-beginning 1) (match-end 1))))
- (when subj
+ (when (re-search-forward "^Subject:" nil t)
+ (setq subj (nnheader-decode-subject
+ (buffer-substring (match-end 0) (std11-field-end))))
(save-excursion
(set-buffer "*gnus-uu-pre*")
(insert (format " %s\n" subj)))))
(when (or (eq in-state 'last)
(eq in-state 'first-and-last))
- (if (and message-forward-as-mime gnus-uu-digest-buffer)
+ (if gnus-uu-digest-buffer
(with-current-buffer gnus-uu-digest-buffer
(erase-buffer)
(insert-buffer "*gnus-uu-pre*")
(with-current-buffer gnus-uu-digest-buffer
(erase-buffer)
(insert-buffer "*gnus-uu-pre*"))
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer gnus-uu-saved-article-name))))
+ (gnus-write-buffer-as-coding-system
+ nnheader-text-coding-system gnus-uu-saved-article-name)))
(save-excursion
(set-buffer "*gnus-uu-body*")
(goto-char (point-max))
(with-current-buffer gnus-uu-digest-buffer
(goto-char (point-max))
(insert-buffer "*gnus-uu-body*"))
- (let ((coding-system-for-write mm-text-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (write-region
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
+ (write-region-as-coding-system
+ nnheader-text-coding-system
(point-min) (point-max) gnus-uu-saved-article-name t)))))
(gnus-kill-buffer "*gnus-uu-pre*")
(gnus-kill-buffer "*gnus-uu-body*")
(beginning-of-line)
(forward-line 1)
(when (file-exists-p gnus-uu-binhex-article-name)
- (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
+ (write-region-as-binary start-char (point)
+ gnus-uu-binhex-article-name 'append))))
(if (memq 'begin state)
(cons gnus-uu-binhex-article-name state)
state)))
(gnus-inhibit-treatment t)
has-been-begin article result-file result-files process-state
gnus-summary-display-article-function
- gnus-article-prepare-hook gnus-display-mime-function
+ gnus-article-display-hook gnus-article-prepare-hook gnus-display-mime-function
article-series files)
(while (and articles
(when gnus-uu-default-dir
(let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
(file-name-nondirectory file))))
- (rename-file file to-file)
- (unless (file-exists-p file)
- (make-symbolic-link to-file file)))))
+ (cond ((fboundp 'make-symbolic-link)
+ (rename-file file to-file)
+ (unless (file-exists-p file)
+ (make-symbolic-link to-file file)))
+ (t
+ (copy-file file to-file))))))
(defun gnus-uu-part-number (article)
(let* ((header (gnus-summary-article-header article))
(when (setq buf (get-buffer gnus-uu-output-buffer-name))
(kill-buffer buf))))
+(defun gnus-quote-arg-for-sh-or-csh (arg)
+ (let ((pos 0) new-pos accum)
+ ;; *** bug: we don't handle newline characters properly
+ (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos))
+ (push (substring arg pos new-pos) accum)
+ (push "\\" accum)
+ (push (list (aref arg new-pos)) accum)
+ (setq pos (1+ new-pos)))
+ (if (= pos 0)
+ arg
+ (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
;; Inputs an action and a filename and returns a full command, making sure
;; that the filename will be treated as a single argument when the shell
;; executes the command.
(defun gnus-uu-command (action file)
- (let ((quoted-file (mm-quote-arg file)))
+ (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file)))
(if (string-match "%s" action)
(format action quoted-file)
(concat action " " quoted-file))))
projects / elisp / gnus.git- / blobdiff