Commit c1589cbe authored by Chong Yidong's avatar Chong Yidong
Browse files

(pmail-output): Rewrite to handle mbox format.

(pmail-output-to-babyl-file): Renamed from pmail-output-to-pmail-file.
parent 17a1c3f7
...@@ -43,7 +43,7 @@ a file name as a string." ...@@ -43,7 +43,7 @@ a file name as a string."
:group 'pmail-output) :group 'pmail-output)
(defun pmail-output-read-pmail-file-name () (defun pmail-output-read-pmail-file-name ()
"Read the file name to use for `pmail-output-to-pmail-file'. "Read the file name to use for `pmail-output-to-babyl-file'.
Set `pmail-default-pmail-file' to this name as well as returning it." Set `pmail-default-pmail-file' to this name as well as returning it."
(let ((default-file (let ((default-file
(let (answer tail) (let (answer tail)
...@@ -112,7 +112,7 @@ Set `pmail-default-file' to this name as well as returning it." ...@@ -112,7 +112,7 @@ Set `pmail-default-file' to this name as well as returning it."
;;; There are functions elsewhere in Emacs that use this function; ;;; There are functions elsewhere in Emacs that use this function;
;;; look at them before you change the calling method. ;;; look at them before you change the calling method.
;;;###autoload ;;;###autoload
(defun pmail-output-to-pmail-file (file-name &optional count stay) (defun pmail-output-to-babyl-file (file-name &optional count stay)
"Append the current message to a Babyl file named FILE-NAME. "Append the current message to a Babyl file named FILE-NAME.
If the file does not exist, ask if it should be created. If the file does not exist, ask if it should be created.
If file is being visited, the message is appended to the Emacs If file is being visited, the message is appended to the Emacs
...@@ -170,7 +170,7 @@ Note: it means the file has no messages in it.\n\^_")) ...@@ -170,7 +170,7 @@ Note: it means the file has no messages in it.\n\^_"))
;; shift the place in the buffer where the visible text starts. ;; shift the place in the buffer where the visible text starts.
(if (pmail-message-deleted-p pmail-current-message) (if (pmail-message-deleted-p pmail-current-message)
(progn (setq redelete t) (progn (setq redelete t)
(pmail-set-attribute "deleted" nil))) (pmail-set-attribute pmail-deleted-attr-index nil)))
(save-restriction (save-restriction
(widen) (widen)
;; Decide whether to append to a file or to an Emacs buffer. ;; Decide whether to append to a file or to an Emacs buffer.
...@@ -228,8 +228,8 @@ Note: it means the file has no messages in it.\n\^_")) ...@@ -228,8 +228,8 @@ Note: it means the file has no messages in it.\n\^_"))
(goto-char (point-max)) (goto-char (point-max))
(insert-buffer-substring cur beg end) (insert-buffer-substring cur beg end)
(pmail-delete-unwanted-fields))))))) (pmail-delete-unwanted-fields)))))))
(pmail-set-attribute "filed" t)) (pmail-set-attribute pmail-filed-attr-index t))
(if redelete (pmail-set-attribute "deleted" t)))) (if redelete (pmail-set-attribute pmail-deleted-attr-index t))))
(setq count (1- count)) (setq count (1- count))
(if pmail-delete-after-output (if pmail-delete-after-output
(unless (unless
...@@ -242,6 +242,8 @@ Note: it means the file has no messages in it.\n\^_")) ...@@ -242,6 +242,8 @@ Note: it means the file has no messages in it.\n\^_"))
(if (not stay) (pmail-next-undeleted-message 1)) (if (not stay) (pmail-next-undeleted-message 1))
(setq count 0))))))) (setq count 0)))))))
(defalias 'pmail-output-to-pmail-file 'pmail-output-to-babyl-file)
;;;###autoload ;;;###autoload
(defcustom pmail-fields-not-to-output nil (defcustom pmail-fields-not-to-output nil
"*Regexp describing fields to exclude when outputting a message to a file." "*Regexp describing fields to exclude when outputting a message to a file."
...@@ -295,20 +297,12 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -295,20 +297,12 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(and pmail-default-file (and pmail-default-file
(file-name-directory pmail-default-file)))) (file-name-directory pmail-default-file))))
(if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
(pmail-output-to-pmail-file file-name count) (pmail-output-to-babyl-file file-name count)
(set-buffer pmail-buffer) (set-buffer pmail-buffer)
(let ((orig-count count) (let ((orig-count count)
(pmailbuf (current-buffer)) (pmailbuf pmail-buffer)
(case-fold-search t) (case-fold-search t)
(tembuf (get-buffer-create " pmail-output")) (tembuf (get-buffer-create " pmail-output"))
(original-headers-p
(and (not from-gnus)
(save-excursion
(save-restriction
(narrow-to-region (pmail-msgbeg pmail-current-message) (point-max))
(goto-char (point-min))
(forward-line 1)
(= (following-char) ?0)))))
header-beginning header-beginning
mail-from mime-version content-type) mail-from mime-version content-type)
(while (> count 0) (while (> count 0)
...@@ -317,10 +311,11 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -317,10 +311,11 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(or from-gnus (or from-gnus
(save-excursion (save-excursion
(save-restriction (save-restriction
(widen) (goto-char (if pmail-buffers-swapped-p
(goto-char (pmail-msgbeg pmail-current-message)) (point-min)
(pmail-msgbeg pmail-current-message)))
(setq header-beginning (point)) (setq header-beginning (point))
(search-forward "\n*** EOOH ***\n") (search-forward "\n\n" nil 'move)
(narrow-to-region header-beginning (point)) (narrow-to-region header-beginning (point))
(setq mail-from (mail-fetch-field "Mail-From")) (setq mail-from (mail-fetch-field "Mail-From"))
(unless pmail-enable-mime (unless pmail-enable-mime
...@@ -330,18 +325,19 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -330,18 +325,19 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(set-buffer tembuf) (set-buffer tembuf)
(erase-buffer) (erase-buffer)
(insert-buffer-substring pmailbuf) (insert-buffer-substring pmailbuf)
(save-excursion
(goto-char (min (point-min) (- (point-max) 2)))
(unless (looking-at "\n\n")
(goto-char (point-max))
(insert "\n\n")))
(when pmail-enable-mime (when pmail-enable-mime
(if original-headers-p (goto-char (point-min))
(delete-region (goto-char (point-min)) (forward-line 2)
(if (search-forward "\n*** EOOH ***\n") (delete-region (point-min) (point))
(match-end 0))) (search-forward "\n\n")
(goto-char (point-min)) (delete-region (match-beginning 0)
(forward-line 2) (if (search-forward "\n\n")
(delete-region (point-min)(point)) (1- (match-end 0))))
(search-forward "\n*** EOOH ***\n")
(delete-region (match-beginning 0)
(if (search-forward "\n\n")
(1- (match-end 0)))))
(setq buffer-file-coding-system (or pmail-file-coding-system (setq buffer-file-coding-system (or pmail-file-coding-system
'raw-text))) 'raw-text)))
(pmail-delete-unwanted-fields t) (pmail-delete-unwanted-fields t)
...@@ -350,10 +346,18 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -350,10 +346,18 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(if mail-from (if mail-from
(insert mail-from "\n") (insert mail-from "\n")
(insert "From " (insert "From "
(mail-strip-quoted-names (or (mail-fetch-field "from") (mail-strip-quoted-names
(mail-fetch-field "really-from") (save-excursion
(mail-fetch-field "sender") (save-restriction
"unknown")) (goto-char (point-min))
(narrow-to-region
(point)
(or (search-forward "\n\n" nil)
(point-max)))
(or (mail-fetch-field "from")
(mail-fetch-field "really-from")
(mail-fetch-field "sender")
"unknown"))))
" " (current-time-string) "\n")) " " (current-time-string) "\n"))
(when mime-version (when mime-version
(insert "MIME-Version: " mime-version) (insert "MIME-Version: " mime-version)
...@@ -371,7 +375,7 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -371,7 +375,7 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(if noattribute 'nomsg))) (if noattribute 'nomsg)))
(or noattribute (or noattribute
(if (equal major-mode 'pmail-mode) (if (equal major-mode 'pmail-mode)
(pmail-set-attribute "filed" t))) (pmail-set-attribute pmail-filed-attr-index t)))
(setq count (1- count)) (setq count (1- count))
(or from-gnus (or from-gnus
(let ((next-message-p (let ((next-message-p
...@@ -380,8 +384,6 @@ The optional fourth argument FROM-GNUS is set when called from GNUS." ...@@ -380,8 +384,6 @@ The optional fourth argument FROM-GNUS is set when called from GNUS."
(if (> count 0) (if (> count 0)
(pmail-next-undeleted-message 1)))) (pmail-next-undeleted-message 1))))
(num-appended (- orig-count count))) (num-appended (- orig-count count)))
(if (and next-message-p original-headers-p)
(pmail-toggle-header))
(if (and (> count 0) (not next-message-p)) (if (and (> count 0) (not next-message-p))
(progn (progn
(error "%s" (error "%s"
...@@ -418,7 +420,7 @@ FILE-NAME defaults, interactively, from the Subject field of the message." ...@@ -418,7 +420,7 @@ FILE-NAME defaults, interactively, from the Subject field of the message."
(error "Operation aborted")) (error "Operation aborted"))
(write-region (point) (point-max) file-name) (write-region (point) (point-max) file-name)
(if (equal major-mode 'pmail-mode) (if (equal major-mode 'pmail-mode)
(pmail-set-attribute "stored" t))) (pmail-set-attribute pmail-stored-attr-index t)))
(if pmail-delete-after-output (if pmail-delete-after-output
(pmail-delete-forward))) (pmail-delete-forward)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment