mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-11 22:50:49 +00:00

`string-replace` is easier to understand, less error-prone, much faster, and results in shorter Lisp and byte code. Use it where applicable and obviously safe (erring on the conservative side). * admin/authors.el (authors-scan-change-log): * lisp/autoinsert.el (auto-insert-alist): * lisp/calc/calc-prog.el (calc-edit-macro-combine-alg-ent) (calc-edit-macro-combine-ext-command) (calc-edit-macro-combine-var-name): * lisp/calc/calc-units.el (math-make-unit-string): * lisp/calendar/cal-html.el (cal-html-comment): * lisp/calendar/cal-tex.el (cal-tex-comment): * lisp/calendar/icalendar.el (icalendar--convert-string-for-export) (icalendar--convert-string-for-import): * lisp/calendar/iso8601.el (iso8601--concat-regexps) (iso8601--full-time-match, iso8601--combined-match): * lisp/calendar/time-date.el (format-seconds): * lisp/calendar/todo-mode.el (todo-filter-items-filename): * lisp/cedet/cedet-files.el (cedet-directory-name-to-file-name) (cedet-file-name-to-directory-name): * lisp/comint.el (comint-watch-for-password-prompt): * lisp/dired-aux.el (dired-do-chmod): * lisp/dired-x.el (dired-man): * lisp/dired.el (dired-insert-directory, dired-goto-file-1): * lisp/emacs-lisp/comp.el (comp-c-func-name): * lisp/emacs-lisp/re-builder.el (reb-copy): * lisp/erc/erc-dcc.el (erc-dcc-unquote-filename): * lisp/erc/erc.el (erc-quit-reason-zippy, erc-part-reason-zippy) (erc-update-mode-line-buffer, erc-message-english-PART): * lisp/files.el (make-backup-file-name-1, files--transform-file-name) (read-file-modes): * lisp/fringe.el (fringe-mode): * lisp/gnus/gnus-art.el (gnus-button-handle-info-url): * lisp/gnus/gnus-group.el (gnus-group-completing-read): * lisp/gnus/gnus-icalendar.el (gnus-icalendar-event-from-ical): * lisp/gnus/gnus-mlspl.el (gnus-group-split-fancy): * lisp/gnus/gnus-search.el (gnus-search-query-parse-date) (gnus-search-transform-expression, gnus-search-run-search): * lisp/gnus/gnus-start.el (gnus-dribble-enter): * lisp/gnus/gnus-sum.el (gnus-summary-refer-article): * lisp/gnus/gnus-util.el (gnus-mode-string-quote): * lisp/gnus/message.el (message-put-addresses-in-ecomplete) (message-parse-mailto-url, message-mailto-1): * lisp/gnus/mml-sec.el (mml-secure-epg-sign): * lisp/gnus/mml-smime.el (mml-smime-epg-verify): * lisp/gnus/mml2015.el (mml2015-epg-verify): * lisp/gnus/nnmaildir.el (nnmaildir--system-name) (nnmaildir-request-list, nnmaildir-retrieve-groups) (nnmaildir-request-group, nnmaildir-retrieve-headers): * lisp/gnus/nnrss.el (nnrss-node-text): * lisp/gnus/spam-report.el (spam-report-gmane-internal) (spam-report-user-mail-address): * lisp/ibuffer.el (name): * lisp/image-dired.el (image-dired-pngnq-thumb) (image-dired-pngcrush-thumb, image-dired-optipng-thumb) (image-dired-create-thumb-1): * lisp/info.el (Info-set-mode-line): * lisp/international/mule-cmds.el (describe-language-environment): * lisp/mail/rfc2231.el (rfc2231-parse-string): * lisp/mail/rfc2368.el (rfc2368-parse-mailto-url): * lisp/mail/rmail.el (rmail-insert-inbox-text) (rmail-simplified-subject-regexp): * lisp/mail/rmailout.el (rmail-output-body-to-file): * lisp/mail/undigest.el (rmail-digest-rfc1153): * lisp/man.el (Man-default-man-entry): * lisp/mouse.el (minor-mode-menu-from-indicator): * lisp/mpc.el (mpc--debug): * lisp/net/browse-url.el (browse-url-mail): * lisp/net/eww.el (eww-update-header-line-format): * lisp/net/newst-backend.el (newsticker-save-item): * lisp/net/rcirc.el (rcirc-sentinel): * lisp/net/soap-client.el (soap-decode-date-time): * lisp/nxml/rng-cmpct.el (rng-c-literal-2-re): * lisp/nxml/xmltok.el (let*): * lisp/obsolete/nnir.el (nnir-run-swish-e, nnir-run-hyrex) (nnir-run-find-grep): * lisp/play/dunnet.el (dun-doassign): * lisp/play/handwrite.el (handwrite): * lisp/proced.el (proced-format-args): * lisp/profiler.el (profiler-report-header-line-format): * lisp/progmodes/gdb-mi.el (gdb-mi-quote): * lisp/progmodes/make-mode.el (makefile-bsdmake-rule-action-regex) (makefile-make-font-lock-keywords): * lisp/progmodes/prolog.el (prolog-guess-fill-prefix): * lisp/progmodes/ruby-mode.el (ruby-toggle-string-quotes): * lisp/progmodes/sql.el (sql-remove-tabs-filter, sql-str-literal): * lisp/progmodes/which-func.el (which-func-current): * lisp/replace.el (query-replace-read-from) (occur-engine, replace-quote): * lisp/select.el (xselect--encode-string): * lisp/ses.el (ses-export-tab): * lisp/subr.el (shell-quote-argument): * lisp/term/pc-win.el (msdos-show-help): * lisp/term/w32-win.el (w32--set-selection): * lisp/term/xterm.el (gui-backend-set-selection): * lisp/textmodes/picture.el (picture-tab-search): * lisp/thumbs.el (thumbs-call-setroot-command): * lisp/tooltip.el (tooltip-show-help-non-mode): * lisp/transient.el (transient-format-key): * lisp/url/url-mailto.el (url-mailto): * lisp/vc/log-edit.el (log-edit-changelog-ours-p): * lisp/vc/vc-bzr.el (vc-bzr-status): * lisp/vc/vc-hg.el (vc-hg--glob-to-pcre): * lisp/vc/vc-svn.el (vc-svn-after-dir-status): * lisp/xdg.el (xdg-desktop-strings): * test/lisp/electric-tests.el (defun): * test/lisp/term-tests.el (term-simple-lines): * test/lisp/time-stamp-tests.el (formatz-mod-del-colons): * test/lisp/wdired-tests.el (wdired-test-bug32173-01) (wdired-test-unfinished-edit-01): * test/src/json-tests.el (json-parse-with-custom-null-and-false-objects): Use `string-replace` instead of `replace-regexp-in-string`.
706 lines
26 KiB
EmacsLisp
706 lines
26 KiB
EmacsLisp
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 1985, 1987, 1993-1994, 2001-2021 Free Software
|
||
;; Foundation, Inc.
|
||
|
||
;; Maintainer: emacs-devel@gnu.org
|
||
;; Keywords: mail
|
||
;; Package: rmail
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;;; Code:
|
||
|
||
(require 'rmail)
|
||
(provide 'rmailout)
|
||
|
||
(defcustom rmail-output-decode-coding nil
|
||
"If non-nil, do coding system decoding when outputting message as Babyl."
|
||
:type 'boolean
|
||
:group 'rmail-output)
|
||
|
||
(defcustom rmail-output-file-alist nil
|
||
"Alist matching regexps to suggested output Rmail files.
|
||
This is a list of elements of the form (REGEXP . NAME-EXP).
|
||
The suggestion is taken if REGEXP matches anywhere in the message buffer.
|
||
NAME-EXP may be a string constant giving the file name to use,
|
||
or more generally it may be any kind of expression that returns
|
||
a file name as a string."
|
||
:type '(repeat (cons regexp
|
||
(choice :value ""
|
||
(string :tag "File Name")
|
||
sexp)))
|
||
:group 'rmail-output)
|
||
;; This is risky because NAME-EXP gets evalled.
|
||
;;;###autoload(put 'rmail-output-file-alist 'risky-local-variable t)
|
||
|
||
(defcustom rmail-fields-not-to-output nil
|
||
"Regexp describing fields to exclude when outputting a message to a file.
|
||
The function `rmail-delete-unwanted-fields' uses this, ignoring case."
|
||
:type '(choice (const :tag "None" nil)
|
||
regexp)
|
||
:group 'rmail-output)
|
||
|
||
(defcustom rmail-output-reset-deleted-flag nil
|
||
"Non-nil means reset the \"deleted\" flag when outputting a message to a file."
|
||
:type '(choice (const :tag "Output with the \"deleted\" flag reset" t)
|
||
(const :tag "Output with the \"deleted\" flag intact" nil))
|
||
:version "27.1"
|
||
:group 'rmail-output)
|
||
|
||
(defun rmail-output-read-file-name ()
|
||
"Read the file name to use for `rmail-output'.
|
||
Set `rmail-default-file' to this name as well as returning it.
|
||
This uses `rmail-output-file-alist'."
|
||
(let* ((default-file
|
||
(or
|
||
(when rmail-output-file-alist
|
||
(or rmail-buffer (error "There is no Rmail buffer"))
|
||
(save-current-buffer
|
||
(set-buffer rmail-buffer)
|
||
(let ((beg (rmail-msgbeg rmail-current-message))
|
||
(end (rmail-msgend rmail-current-message)))
|
||
(if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
|
||
(save-excursion
|
||
(save-restriction
|
||
(widen)
|
||
(narrow-to-region beg end)
|
||
(let ((tail rmail-output-file-alist)
|
||
answer) ;; err
|
||
;; Suggest a file based on a pattern match.
|
||
(while (and tail (not answer))
|
||
(goto-char (point-min))
|
||
(if (re-search-forward (caar tail) nil t)
|
||
(setq answer
|
||
(condition-case err
|
||
(eval (cdar tail) t)
|
||
(error
|
||
(display-warning
|
||
'rmail-output
|
||
(format-message "\
|
||
Error evaluating `rmail-output-file-alist' element:
|
||
regexp: %s
|
||
action: %s
|
||
error: %S\n"
|
||
(caar tail) (cdar tail) err)
|
||
:error)
|
||
nil))))
|
||
(setq tail (cdr tail)))
|
||
answer))))))
|
||
;; If no suggestion, use same file as last time.
|
||
rmail-default-file))
|
||
(read-file
|
||
(expand-file-name
|
||
(read-file-name
|
||
(concat "Output message to mail file (default "
|
||
(file-name-nondirectory default-file)
|
||
"): ")
|
||
(file-name-directory default-file)
|
||
(abbreviate-file-name default-file))
|
||
(file-name-directory default-file))))
|
||
(setq rmail-default-file
|
||
(if (file-directory-p read-file)
|
||
(expand-file-name (file-name-nondirectory default-file)
|
||
read-file)
|
||
(expand-file-name
|
||
(or read-file (file-name-nondirectory default-file))
|
||
(file-name-directory default-file))))))
|
||
|
||
(defun rmail-delete-unwanted-fields (preserve)
|
||
"Delete all headers matching `rmail-fields-not-to-output'.
|
||
Retains headers matching the regexp PRESERVE. Ignores case.
|
||
The buffer should be narrowed to just the header."
|
||
(if rmail-fields-not-to-output
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let ((case-fold-search t))
|
||
(while (re-search-forward rmail-fields-not-to-output nil t)
|
||
(beginning-of-line)
|
||
(unless (looking-at preserve)
|
||
(delete-region (point) (line-beginning-position 2))))))))
|
||
|
||
(defun rmail-output-as-babyl (file-name nomsg)
|
||
"Convert the current buffer's text to Babyl and output to FILE-NAME.
|
||
Alters the current buffer's text, so it should be a temporary buffer.
|
||
If a buffer is visiting FILE-NAME, adds the text to that buffer
|
||
rather than saving the file directly. If the buffer is an Rmail buffer,
|
||
updates it accordingly. If no buffer is visiting FILE-NAME, appends
|
||
the text directly to FILE-NAME, and displays a \"Wrote file\" message
|
||
unless NOMSG is a symbol (neither nil nor t)."
|
||
(let ((coding-system-for-write 'emacs-mule-unix))
|
||
(save-restriction
|
||
(goto-char (point-min))
|
||
(search-forward "\n\n" nil 'move)
|
||
(narrow-to-region (point-min) (point))
|
||
(if rmail-fields-not-to-output
|
||
(rmail-delete-unwanted-fields nil)))
|
||
|
||
;; Convert to Babyl format.
|
||
(rmail-convert-to-babyl-format)
|
||
;; Write it into the file, or its buffer.
|
||
(let ((buf (find-buffer-visiting file-name))
|
||
(tembuf (current-buffer)))
|
||
(if (null buf)
|
||
(write-region (point-min) (point-max) file-name t nomsg)
|
||
(if (eq buf (current-buffer))
|
||
(error "Can't output message to same file it's already in"))
|
||
;; File has been visited, in buffer BUF.
|
||
(set-buffer buf)
|
||
(let ((inhibit-read-only t)
|
||
(msg (bound-and-true-p rmail-current-message)))
|
||
;; If MSG is non-nil, buffer is in RMAIL mode.
|
||
(if msg
|
||
(rmail-output-to-babyl-buffer tembuf msg)
|
||
;; Output file not in rmail mode => just insert at the end.
|
||
(narrow-to-region (point-min) (1+ (buffer-size)))
|
||
(goto-char (point-max))
|
||
(insert-buffer-substring tembuf)))))))
|
||
|
||
;; Called only if rmail-summary-exists, which means rmailsum is loaded.
|
||
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
|
||
|
||
(defun rmail-output-to-babyl-buffer (tembuf msg)
|
||
"Copy message in TEMBUF into the current Babyl Rmail buffer.
|
||
Do what is necessary to make Rmail know about the new message, then
|
||
display message number MSG."
|
||
;; Turn on Auto Save mode, if it's off in this buffer but enabled by default.
|
||
(and (not buffer-auto-save-file-name)
|
||
auto-save-default
|
||
(auto-save-mode t))
|
||
(rmail-maybe-set-message-counters)
|
||
(widen)
|
||
(narrow-to-region (point-max) (point-max))
|
||
(insert-buffer-substring tembuf)
|
||
(goto-char (point-min))
|
||
(widen)
|
||
(search-backward "\n\^_")
|
||
(narrow-to-region (point) (point-max))
|
||
(rmail-count-new-messages t)
|
||
(if (rmail-summary-exists)
|
||
(rmail-select-summary (rmail-update-summary)))
|
||
(rmail-show-message-1 msg))
|
||
|
||
(defun rmail-convert-to-babyl-format ()
|
||
"Convert the mbox message in the current buffer to Babyl format."
|
||
(let (;; (count 0)
|
||
(start (point-min))
|
||
(case-fold-search nil)
|
||
(buffer-undo-list t))
|
||
(goto-char (point-min))
|
||
(save-restriction
|
||
(unless (looking-at "^From ")
|
||
(error "Invalid mbox message"))
|
||
(insert "\^L\n0,,\n*** EOOH ***\n")
|
||
(rmail-nuke-pinhead-header)
|
||
;; Decode base64 or quoted printable contents, Rmail style.
|
||
(let* ((header-end (save-excursion
|
||
(and (re-search-forward "\n\n" nil t)
|
||
(1- (point)))))
|
||
(case-fold-search t)
|
||
(quoted-printable-header-field-end
|
||
(save-excursion
|
||
(re-search-forward
|
||
"^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
|
||
header-end t)))
|
||
(base64-header-field-end
|
||
(and
|
||
;; Don't decode non-text data.
|
||
(save-excursion
|
||
(re-search-forward
|
||
"^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
|
||
header-end t))
|
||
(save-excursion
|
||
(re-search-forward
|
||
"^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
|
||
header-end t)))))
|
||
|
||
(goto-char (point-max))
|
||
(if quoted-printable-header-field-end
|
||
(save-excursion
|
||
(unless (mail-unquote-printable-region
|
||
header-end (point) nil t t)
|
||
(message "Malformed MIME quoted-printable message"))
|
||
;; Change "quoted-printable" to "8bit",
|
||
;; to reflect the decoding we just did.
|
||
(goto-char quoted-printable-header-field-end)
|
||
(delete-region (point) (search-backward ":"))
|
||
(insert ": 8bit")))
|
||
(if base64-header-field-end
|
||
(save-excursion
|
||
(when (condition-case nil
|
||
(progn
|
||
(base64-decode-region
|
||
(1+ header-end)
|
||
(save-excursion
|
||
;; Prevent base64-decode-region
|
||
;; from removing newline characters.
|
||
(skip-chars-backward "\n\t ")
|
||
(point)))
|
||
t)
|
||
(error nil))
|
||
;; Change "base64" to "8bit", to reflect the
|
||
;; decoding we just did.
|
||
(goto-char base64-header-field-end)
|
||
(delete-region (point) (search-backward ":"))
|
||
(insert ": 8bit")))))
|
||
;; Transform anything within the message text
|
||
;; that might appear to be the end of a Babyl-format message.
|
||
(save-excursion
|
||
(save-restriction
|
||
(narrow-to-region start (point))
|
||
(goto-char (point-min))
|
||
(while (search-forward "\n\^_" nil t) ; single char
|
||
(replace-match "\n^_")))) ; 2 chars: "^" and "_"
|
||
;; This is for malformed messages that don't end in newline.
|
||
;; There shouldn't be any, but some users say occasionally
|
||
;; there are some.
|
||
(or (bolp) (newline))
|
||
(insert ?\^_)
|
||
(setq last-coding-system-used nil)
|
||
;; Decode coding system, following specs in the message header,
|
||
;; and record what coding system was decoded.
|
||
(if rmail-output-decode-coding
|
||
(let ((mime-charset
|
||
(if (save-excursion
|
||
(goto-char start)
|
||
(search-forward "\n\n" nil t)
|
||
(let ((case-fold-search t))
|
||
(re-search-backward
|
||
rmail-mime-charset-pattern
|
||
start t)))
|
||
(intern (downcase (match-string 1))))))
|
||
(rmail-decode-region start (point) mime-charset)))
|
||
(save-excursion
|
||
(goto-char start)
|
||
(forward-line 3)
|
||
(insert "X-Coding-System: "
|
||
(symbol-name last-coding-system-used)
|
||
"\n")))))
|
||
|
||
(defun rmail-nuke-pinhead-header ()
|
||
"Delete the \"From \" line in the current mbox message.
|
||
The variable `rmail-unix-mail-delimiter' specifies the From line format.
|
||
Replaces the From line with a \"Mail-from\" header. Adds \"Date\" and
|
||
\"From\" headers if they are not already present."
|
||
(save-excursion
|
||
(save-restriction
|
||
(let ((start (point))
|
||
(end (progn
|
||
(condition-case ()
|
||
(search-forward "\n\n")
|
||
(error
|
||
(goto-char (point-max))
|
||
(insert "\n\n")))
|
||
(point)))
|
||
has-from has-date)
|
||
(narrow-to-region start end)
|
||
(let ((case-fold-search t))
|
||
(goto-char start)
|
||
(setq has-from (search-forward "\nFrom:" nil t))
|
||
(goto-char start)
|
||
(setq has-date (and (search-forward "\nDate:" nil t) (point)))
|
||
(goto-char start))
|
||
(let ((case-fold-search nil))
|
||
(if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
|
||
(replace-match
|
||
(concat
|
||
"Mail-from: \\&"
|
||
;; Keep and reformat the date if we don't
|
||
;; have a Date: field.
|
||
(if has-date
|
||
""
|
||
(concat
|
||
"Date: \\2, \\4 \\3 \\9 \\5 "
|
||
|
||
;; The timezone could be matched by group 7 or group 10.
|
||
;; If neither of them matched, assume EST, since only
|
||
;; Easterners would be so sloppy.
|
||
;; It's a shame the substitution can't use "\\10".
|
||
(cond
|
||
((/= (match-beginning 7) (match-end 7)) "\\7")
|
||
((/= (match-beginning 10) (match-end 10))
|
||
(buffer-substring (match-beginning 10)
|
||
(match-end 10)))
|
||
(t "EST"))
|
||
"\n"))
|
||
;; Keep and reformat the sender if we don't
|
||
;; have a From: field.
|
||
(if has-from
|
||
""
|
||
"From: \\1\n"))
|
||
t)))))))
|
||
|
||
(autoload 'mail-mbox-from "mail-utils")
|
||
|
||
(defun rmail-output-as-mbox (file-name nomsg &optional as-seen)
|
||
"Convert the current buffer's text to mbox and output to FILE-NAME.
|
||
Alters the current buffer's text, so it should be a temporary buffer.
|
||
If a buffer is visiting FILE-NAME, adds the text to that buffer
|
||
rather than saving the file directly. If the buffer is an Rmail buffer,
|
||
updates it accordingly. If no buffer is visiting FILE-NAME, appends
|
||
the text directly to FILE-NAME, and displays a \"Wrote file\" message
|
||
unless NOMSG is a symbol (neither nil nor t).
|
||
AS-SEEN is non-nil if we are copying the message \"as seen\"."
|
||
(let ((case-fold-search t)
|
||
encrypted-file-name
|
||
) ;; from date
|
||
(goto-char (point-min))
|
||
;; Preserve the Mail-From and MIME-Version fields
|
||
;; even if they have been pruned.
|
||
(search-forward "\n\n" nil 'move)
|
||
(narrow-to-region (point-min) (point))
|
||
(rmail-delete-unwanted-fields
|
||
(if rmail-enable-mime "Mail-From"
|
||
"Mail-From\\|MIME-Version\\|Content-type"))
|
||
(goto-char (point-min))
|
||
(or (looking-at "From ")
|
||
(insert (mail-mbox-from)))
|
||
(widen)
|
||
;; Make sure message ends with blank line.
|
||
(goto-char (point-max))
|
||
(rmail-ensure-blank-line)
|
||
(goto-char (point-min))
|
||
(let ((buf (find-buffer-visiting file-name))
|
||
(tembuf (current-buffer)))
|
||
(when (string-match "[.]gpg\\'" file-name)
|
||
(setq encrypted-file-name file-name
|
||
file-name (substring file-name 0 (match-beginning 0))))
|
||
(if (null buf)
|
||
(let ((coding-system-for-write 'raw-text-unix)
|
||
(coding-system-for-read 'raw-text-unix))
|
||
;; If the specified file is encrypted, decrypt it.
|
||
(when encrypted-file-name
|
||
(with-temp-buffer
|
||
(insert-file-contents encrypted-file-name)
|
||
(write-region 1 (point-max) file-name nil 'nomsg)))
|
||
;; FIXME should ensure existing file ends with a blank line.
|
||
(write-region (point-min) (point-max) file-name t
|
||
(if (or nomsg encrypted-file-name)
|
||
'nomsg))
|
||
;; If the specified file was encrypted, re-encrypt it.
|
||
(when encrypted-file-name
|
||
;; Save the old encrypted file as a backup.
|
||
(rename-file encrypted-file-name
|
||
(make-backup-file-name encrypted-file-name)
|
||
t)
|
||
(if (= 0
|
||
(call-process "gpg" nil nil
|
||
"--use-agent" "--batch" "--no-tty"
|
||
"--encrypt" "-r"
|
||
user-mail-address
|
||
file-name))
|
||
;; Delete the unencrypted file if encryption succeeded.
|
||
(delete-file file-name)
|
||
;; If encrypting failed, put back the original
|
||
;; encrypted file and signal an error.
|
||
(rename-file (make-backup-file-name encrypted-file-name)
|
||
encrypted-file-name
|
||
t)
|
||
(error "Encryption failed; %s unchanged"
|
||
encrypted-file-name))
|
||
(unless nomsg
|
||
(message "Added to %s" encrypted-file-name)))
|
||
)
|
||
(if (eq buf (current-buffer))
|
||
(error "Can't output message to same file it's already in"))
|
||
;; File has been visited, in buffer BUF.
|
||
(set-buffer buf)
|
||
(let ((inhibit-read-only t)
|
||
(msg (and (boundp 'rmail-current-message)
|
||
rmail-current-message)))
|
||
(and msg as-seen
|
||
(error "Can't output \"as seen\" to a visited Rmail file"))
|
||
(if msg
|
||
(rmail-output-to-rmail-buffer tembuf msg)
|
||
;; Output file not in Rmail mode => just insert at the end.
|
||
(narrow-to-region (point-min) (1+ (buffer-size)))
|
||
(goto-char (point-max))
|
||
(insert-buffer-substring tembuf)))))))
|
||
|
||
(defun rmail-output-to-rmail-buffer (tembuf msg)
|
||
"Copy message in TEMBUF into the current Rmail buffer.
|
||
Do what is necessary to make Rmail know about the new message. then
|
||
display message number MSG."
|
||
(save-excursion
|
||
(rmail-swap-buffers-maybe)
|
||
(rmail-modify-format)
|
||
;; Turn on Auto Save mode, if it's off in this buffer but enabled
|
||
;; by default.
|
||
(and (not buffer-auto-save-file-name)
|
||
auto-save-default
|
||
(auto-save-mode t))
|
||
(rmail-maybe-set-message-counters)
|
||
;; Insert the new message after the last old message.
|
||
(widen)
|
||
(unless (zerop (buffer-size))
|
||
;; Make sure the last old message ends with a blank line.
|
||
(goto-char (point-max))
|
||
(rmail-ensure-blank-line)
|
||
;; Insert the new message at the end.
|
||
(narrow-to-region (point-max) (point-max)))
|
||
(insert-buffer-substring tembuf)
|
||
(rmail-count-new-messages t)
|
||
;; FIXME should re-use existing windows.
|
||
(if (rmail-summary-exists)
|
||
(rmail-select-summary (rmail-update-summary)))
|
||
(rmail-show-message-1 msg)))
|
||
|
||
;;; There are functions elsewhere in Emacs that use this function;
|
||
;;; look at them before you change the calling method.
|
||
;;;###autoload
|
||
(defun rmail-output (file-name &optional count noattribute not-rmail)
|
||
"Append this message to mail file FILE-NAME.
|
||
Writes mbox format, unless FILE-NAME exists and is Babyl format, in which
|
||
case it writes Babyl.
|
||
|
||
Interactively, the default file name comes from `rmail-default-file',
|
||
which is updated to the name you use in this command. In all uses, if
|
||
FILE-NAME is not absolute, it is expanded with the directory part of
|
||
`rmail-default-file'.
|
||
|
||
If a buffer is visiting FILE-NAME, adds the text to that buffer
|
||
rather than saving the file directly. If the buffer is an Rmail
|
||
buffer, updates it accordingly.
|
||
|
||
This command always outputs the complete message header, even if
|
||
the header display is currently pruned.
|
||
|
||
If `rmail-output-reset-deleted-flag' is non-nil, the message's
|
||
deleted flag is reset in the message appended to the destination
|
||
file. Otherwise, the appended message will remain marked as
|
||
deleted if it was deleted before invoking this command.
|
||
|
||
Optional prefix argument COUNT (default 1) says to output that
|
||
many consecutive messages, starting with the current one (ignoring
|
||
deleted messages, unless `rmail-output-reset-deleted-flag' is
|
||
non-nil). If `rmail-delete-after-output' is non-nil, deletes
|
||
messages after output.
|
||
|
||
The optional third argument NOATTRIBUTE, if non-nil, says not to
|
||
set the `filed' attribute, and not to display a \"Wrote file\"
|
||
message (if writing a file directly).
|
||
|
||
Set the optional fourth argument NOT-RMAIL non-nil if you call this
|
||
from a non-Rmail buffer. In this case, COUNT is ignored."
|
||
(interactive
|
||
(list (rmail-output-read-file-name)
|
||
(prefix-numeric-value current-prefix-arg)))
|
||
(or count (setq count 1))
|
||
(setq file-name
|
||
(expand-file-name file-name
|
||
(and rmail-default-file
|
||
(file-name-directory rmail-default-file))))
|
||
;; Warn about creating new file.
|
||
(or (find-buffer-visiting file-name)
|
||
(file-exists-p file-name)
|
||
(yes-or-no-p (concat "\"" file-name "\" does not exist, create it? "))
|
||
(error "Output file does not exist"))
|
||
(if noattribute (setq noattribute 'nomsg))
|
||
(let ((babyl-format (and (file-readable-p file-name)
|
||
(mail-file-babyl-p file-name)))
|
||
(cur (current-buffer))
|
||
(buf (find-buffer-visiting file-name)))
|
||
|
||
;; If a babyl file is visited in a buffer, is it visited as babyl
|
||
;; or as mbox?
|
||
(and babyl-format buf
|
||
(with-current-buffer buf
|
||
(save-restriction
|
||
(widen)
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(setq babyl-format
|
||
(looking-at "BABYL OPTIONS:"))))))
|
||
|
||
(if not-rmail ; eg via message-fcc-handler-function
|
||
(with-temp-buffer
|
||
(insert-buffer-substring cur)
|
||
;; Output in the appropriate format.
|
||
(if babyl-format
|
||
(progn
|
||
(goto-char (point-min))
|
||
;; rmail-convert-to-babyl-format errors if no From line,
|
||
;; whereas rmail-output-as-mbox inserts one.
|
||
(or (looking-at "From ")
|
||
(insert (mail-mbox-from)))
|
||
(rmail-output-as-babyl file-name noattribute))
|
||
(rmail-output-as-mbox file-name noattribute)))
|
||
;; Called from an Rmail buffer.
|
||
(if rmail-buffer
|
||
(set-buffer rmail-buffer)
|
||
(error "There is no Rmail buffer"))
|
||
(if (zerop rmail-total-messages)
|
||
(error "No messages to output"))
|
||
(let ((orig-count count)
|
||
beg end delete-attr-reset-p)
|
||
(while (> count 0)
|
||
(when (and rmail-output-reset-deleted-flag
|
||
(rmail-message-deleted-p rmail-current-message))
|
||
(rmail-set-attribute rmail-deleted-attr-index nil)
|
||
(setq delete-attr-reset-p t))
|
||
;; Make sure we undo our messing with the DELETED attribute.
|
||
(unwind-protect
|
||
(progn
|
||
(setq beg (rmail-msgbeg rmail-current-message)
|
||
end (rmail-msgend rmail-current-message))
|
||
;; All access to the buffer's local variables is now finished...
|
||
(save-excursion
|
||
;; ... so it is ok to go to a different buffer.
|
||
(if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
|
||
(setq cur (current-buffer))
|
||
(save-restriction
|
||
(widen)
|
||
(with-temp-buffer
|
||
(insert-buffer-substring cur beg end)
|
||
(if babyl-format
|
||
(rmail-output-as-babyl file-name noattribute)
|
||
(rmail-output-as-mbox file-name noattribute))))))
|
||
(if delete-attr-reset-p
|
||
(rmail-set-attribute rmail-deleted-attr-index t)))
|
||
(or noattribute ; mark message as "filed"
|
||
(rmail-set-attribute rmail-filed-attr-index t))
|
||
(setq count (1- count))
|
||
(let ((next-message-p
|
||
(if rmail-output-reset-deleted-flag
|
||
(progn
|
||
(if rmail-delete-after-output
|
||
(rmail-delete-message))
|
||
(if (>= count 0)
|
||
(let ((msgnum rmail-current-message))
|
||
(rmail-next-message 1)
|
||
(eq rmail-current-message (1+ msgnum)))))
|
||
(if rmail-delete-after-output
|
||
(rmail-delete-forward)
|
||
(if (> count 0)
|
||
(rmail-next-undeleted-message 1)))))
|
||
(num-appended (- orig-count count)))
|
||
(if (and (> count 0) (not next-message-p))
|
||
(error "Only %d message%s appended" num-appended
|
||
(if (= num-appended 1) "" "s")))))))))
|
||
|
||
;; FIXME nothing outside uses this, so NOT-RMAIL could be dropped.
|
||
;; FIXME this duplicates code from rmail-output.
|
||
;;;###autoload
|
||
(defun rmail-output-as-seen (file-name &optional count noattribute not-rmail)
|
||
"Append this message to mbox file named FILE-NAME.
|
||
The details are as for `rmail-output', except that:
|
||
i) the header is output as currently seen
|
||
ii) this function cannot write to Babyl files
|
||
iii) an Rmail buffer cannot be visiting FILE-NAME
|
||
|
||
Note that if NOT-RMAIL is non-nil, there is no difference between this
|
||
function and `rmail-output'. This argument may be removed in future,
|
||
so you should call `rmail-output' directly in that case."
|
||
(interactive
|
||
(list (rmail-output-read-file-name)
|
||
(prefix-numeric-value current-prefix-arg)))
|
||
(if not-rmail
|
||
(rmail-output file-name count noattribute not-rmail)
|
||
(or count (setq count 1))
|
||
(setq file-name
|
||
(expand-file-name file-name
|
||
(and rmail-default-file
|
||
(file-name-directory rmail-default-file))))
|
||
;; Warn about creating new file.
|
||
(or (find-buffer-visiting file-name)
|
||
(file-exists-p file-name)
|
||
(yes-or-no-p (concat "\"" file-name "\" does not exist, create it? "))
|
||
(error "Output file does not exist"))
|
||
;; FIXME why not?
|
||
(if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
|
||
(error "Cannot output `as seen' to a Babyl file"))
|
||
(if noattribute (setq noattribute 'nomsg))
|
||
(if rmail-buffer
|
||
(set-buffer rmail-buffer)
|
||
(error "There is no Rmail buffer"))
|
||
(if (zerop rmail-total-messages)
|
||
(error "No messages to output"))
|
||
(let ((orig-count count)
|
||
(cur (current-buffer)))
|
||
(while (> count 0)
|
||
(let (beg end)
|
||
;; If operating from whole-mbox buffer, get message bounds.
|
||
(or (rmail-buffers-swapped-p)
|
||
(setq beg (rmail-msgbeg rmail-current-message)
|
||
end (rmail-msgend rmail-current-message)))
|
||
(save-restriction
|
||
(widen)
|
||
;; If operating from the view buffer, get the bounds.
|
||
(or beg
|
||
(setq beg (point-min)
|
||
end (point-max)))
|
||
(with-temp-buffer
|
||
(insert-buffer-substring cur beg end)
|
||
(rmail-output-as-mbox file-name noattribute t))))
|
||
(or noattribute ; mark message as "filed"
|
||
(rmail-set-attribute rmail-filed-attr-index t))
|
||
(setq count (1- count))
|
||
(let ((next-message-p
|
||
(if rmail-delete-after-output
|
||
(rmail-delete-forward)
|
||
(if (> count 0)
|
||
(rmail-next-undeleted-message 1))))
|
||
(num-appended (- orig-count count)))
|
||
(if (and (> count 0) (not next-message-p))
|
||
(error "Only %d message%s appended" num-appended
|
||
(if (= num-appended 1) "" "s"))))))))
|
||
|
||
|
||
;;;###autoload
|
||
(defun rmail-output-body-to-file (file-name)
|
||
"Write this message body to the file FILE-NAME.
|
||
Interactively, the default file name comes from either the message
|
||
\"Subject\" header, or from `rmail-default-body-file'. Updates the value
|
||
of `rmail-default-body-file' accordingly. In all uses, if FILE-NAME
|
||
is not absolute, it is expanded with the directory part of
|
||
`rmail-default-body-file'.
|
||
|
||
Note that this overwrites FILE-NAME (after confirmation), rather
|
||
than appending to it. Deletes the message after writing if
|
||
`rmail-delete-after-output' is non-nil."
|
||
(interactive
|
||
(let ((default-file
|
||
(or (mail-fetch-field "Subject")
|
||
rmail-default-body-file)))
|
||
(setq default-file
|
||
(string-replace ":" "-" default-file))
|
||
(setq default-file
|
||
(string-replace " " "-" default-file))
|
||
(list (setq rmail-default-body-file
|
||
(read-file-name
|
||
"Output message body to file: "
|
||
(and default-file (file-name-directory default-file))
|
||
default-file
|
||
nil default-file)))))
|
||
(setq file-name
|
||
(expand-file-name file-name
|
||
(and rmail-default-body-file
|
||
(file-name-directory rmail-default-body-file))))
|
||
(if (zerop rmail-current-message)
|
||
(error "No message to output"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(search-forward "\n\n")
|
||
(and (file-exists-p file-name)
|
||
(not (y-or-n-p (format "File %s exists; overwrite? " file-name)))
|
||
(error "Operation aborted"))
|
||
(write-region (point) (point-max) file-name))
|
||
(if rmail-delete-after-output
|
||
(rmail-delete-forward)))
|
||
|
||
;;; rmailout.el ends here
|