;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000, 2001
+;; Copyright (C) 1985,86,87,88,93,94,95,96,97,98,2000,01,2004,2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
:prefix "rmail-edit-"
:group 'rmail)
+(defgroup rmail-obsolete nil
+ "Rmail obsolete customization variables."
+ :group 'rmail)
(defcustom rmail-movemail-program nil
"If non-nil, name of program for fetching new mail."
:type '(choice (const nil) string))
(defcustom rmail-pop-password nil
- "*Password to use when reading mail from a POP server, if required."
+ "*Password to use when reading mail from POP server. Please, use rmail-remote-password instead."
:type '(choice (string :tag "Password")
(const :tag "Not Required" nil))
- :group 'rmail-retrieve)
+ :group 'rmail-obsolete)
(defcustom rmail-pop-password-required nil
- "*Non-nil if a password is required when reading mail using POP."
+ "*Non-nil if a password is required when reading mail from a POP server. Please, use rmail-remote-password-required instead."
:type 'boolean
- :group 'rmail-retrieve)
+ :group 'rmail-obsolete)
+
+(defcustom rmail-remote-password nil
+ "*Password to use when reading mail from a remote server. This setting is ignored for mailboxes whose URL already contains a password."
+ :type '(choice (string :tag "Password")
+ (const :tag "Not Required" nil))
+ :set-after '(rmail-pop-password)
+ :set #'(lambda (symbol value)
+ (set-default symbol
+ (if (and (not value)
+ (boundp 'rmail-pop-password)
+ rmail-pop-password)
+ rmail-pop-password
+ value))
+ (setq rmail-pop-password nil))
+ :group 'rmail-retrieve
+ :version "22.1")
+
+(defcustom rmail-remote-password-required nil
+ "*Non-nil if a password is required when reading mail from a remote server."
+ :type 'boolean
+ :set-after '(rmail-pop-password-required)
+ :set #'(lambda (symbol value)
+ (set-default symbol
+ (if (and (not value)
+ (boundp 'rmail-pop-password-required)
+ rmail-pop-password-required)
+ rmail-pop-password-required
+ value))
+ (setq rmail-pop-password-required nil))
+ :group 'rmail-retrieve
+ :version "22.1")
(defcustom rmail-movemail-flags nil
"*List of flags to pass to movemail.
:group 'rmail-retrieve
:version "20.3")
-(defvar rmail-pop-password-error "invalid usercode or password\\|
-unknown user name or bad password"
- "Regular expression matching incorrect-password POP server error messages.
+(defvar rmail-remote-password-error "invalid usercode or password\\|
+unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE"
+ "Regular expression matching incorrect-password POP or IMAP server error
+messages.
If you get an incorrect-password error that this expression does not match,
please report it with \\[report-emacs-bug].")
-(defvar rmail-encoded-pop-password nil)
+(defvar rmail-encoded-remote-password nil)
(defcustom rmail-preserve-inbox nil
"*Non-nil if incoming mail should be left in the user's inbox,
:type 'boolean
:group 'rmail-retrieve)
+(defcustom rmail-movemail-search-path nil
+ "*List of directories to search for movemail (in addition to `exec-path')."
+ :group 'rmail-retrieve
+ :type '(repeat (directory)))
+
+(defun rmail-probe (prog)
+ "Determine what flavor of movemail PROG is by executing it with --version
+command line option and analyzing its output."
+ (with-temp-buffer
+ (let ((tbuf (current-buffer)))
+ (buffer-disable-undo tbuf)
+ (call-process prog nil tbuf nil "--version")
+ (if (not (buffer-modified-p tbuf))
+ ;; Should not happen...
+ nil
+ (goto-char (point-min))
+ (cond
+ ((looking-at ".*movemail: invalid option")
+ 'emacs) ;; Possibly...
+ ((looking-at "movemail (GNU Mailutils .*)")
+ 'mailutils)
+ (t
+ ;; FIXME:
+ 'emacs))))))
+
+(defun rmail-autodetect ()
+ "Determine and return the flavor of `movemail' program in use. If
+rmail-movemail-program is set, use it. Otherwise, look for `movemail'
+in the path constructed by appending rmail-movemail-search-path,
+exec-path and exec-directory."
+ (if rmail-movemail-program
+ (rmail-probe rmail-movemail-program)
+ (catch 'scan
+ (dolist (dir (append rmail-movemail-search-path exec-path
+ (list exec-directory)))
+ (when (and dir (file-accessible-directory-p dir))
+ (let ((progname (expand-file-name "movemail" dir)))
+ (when (and (not (file-directory-p progname))
+ (file-executable-p progname))
+ (let ((x (rmail-probe progname)))
+ (when x
+ (setq rmail-movemail-program progname)
+ (throw 'scan x))))))))))
+
+(defvar rmail-movemail-variant-in-use nil
+ "The movemail variant currently in use. Known variants are:
+
+ `emacs' Means any implementation, compatible with the native Emacs one.
+ This is the default;
+ `mailutils' Means GNU mailutils implementation, capable of handling full
+mail URLs as the source mailbox;")
+
+;;;###autoload
+(defun rmail-movemail-variant-p (&rest variants)
+ "Return t if the current movemail variant is any of VARIANTS.
+Currently known variants are 'emacs and 'mailutils."
+ (when (not rmail-movemail-variant-in-use)
+ ;; Autodetect
+ (setq rmail-movemail-variant-in-use (rmail-autodetect)))
+ (not (null (member rmail-movemail-variant-in-use variants))))
+
;;;###autoload
(defcustom rmail-dont-reply-to-names nil "\
*A regexp specifying addresses to prune from a reply message.
:group 'rmail-reply)
;;;###autoload
-(defvar rmail-default-dont-reply-to-names "info-" "\
-A regular expression specifying part of the value of the default value of
-the variable `rmail-dont-reply-to-names', for when the user does not set
+(defvar rmail-default-dont-reply-to-names "\\`info-" "\
+A regular expression specifying part of the default value of the
+variable `rmail-dont-reply-to-names', for when the user does not set
`rmail-dont-reply-to-names' explicitly. (The other part of the default
value is the user's email address and name.)
It is useful to set this variable in the site customization file.")
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
- "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:"
+ "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:"
"\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:"
"\\|^content-transfer-encoding:\\|^x-coding-system:"
"\\|^return-path:\\|^errors-to:\\|^return-receipt-to:"
;;;###autoload
(defcustom rmail-primary-inbox-list nil "\
*List of files which are inboxes for user's primary mail file `~/RMAIL'.
-`nil' means the default, which is (\"/usr/spool/mail/$USER\")
+nil means the default, which is (\"/usr/spool/mail/$USER\")
\(the name varies depending on the operating system,
and the value of the environment variable MAIL overrides it)."
;; Don't use backquote here, because we don't want to need it
;;;###autoload
(defcustom rmail-mail-new-frame nil
- "*Non-nil means Rmail makes a new frame for composing outgoing mail."
+ "*Non-nil means Rmail makes a new frame for composing outgoing mail.
+This is handy if you want to preserve the window configuration of
+the frame where you have the RMAIL buffer displayed."
:type 'boolean
:group 'rmail-reply)
;; files).
(defvar rmail-mmdf-delim1 "^\001\001\001\001\n"
- "Regexp marking the start of an mmdf message")
+ "Regexp marking the start of an mmdf message.")
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
- "Regexp marking the end of an mmdf message")
+ "Regexp marking the end of an mmdf message.")
(defcustom rmail-message-filter nil
"If non-nil, a filter function for new messages in RMAIL.
;;;###autoload
(defvar rmail-mime-charset-pattern
- "^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\"]+\\)\"?"
+ "^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"
"Regexp to match MIME-charset specification in a header of message.
The first parenthesized expression should match the MIME-charset name.")
nil)
(defvar rmail-font-lock-keywords
+ ;; These are all matched case-insensitively.
(eval-when-compile
(let* ((cite-chars "[>|}]")
- (cite-prefix "A-Za-z")
+ (cite-prefix "a-z")
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
- (list '("^\\(From\\|Sender\\|Resent-[Ff]rom\\):" . font-lock-function-name-face)
+ (list '("^\\(From\\|Sender\\|Resent-From\\):"
+ . font-lock-function-name-face)
'("^Reply-To:.*$" . font-lock-function-name-face)
'("^Subject:" . font-lock-comment-face)
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
(beginning-of-line) (end-of-line)
(2 font-lock-constant-face nil t)
(4 font-lock-comment-face nil t)))
- '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$"
+ '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
. font-lock-string-face))))
"Additional expressions to highlight in Rmail mode.")
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
- ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
- ;; earlier versions did that with the current buffer's encoding.
- ;; So we want to favor detection of emacs-mule (whose normal
- ;; priority is quite low), but still allow detection of other
- ;; encodings if emacs-mule won't fit. The call to
- ;; detect-coding-with-priority below achieves that.
- (car (detect-coding-with-priority
- from to
- '((coding-category-emacs-mule . emacs-mule))))))
- (unless (memq coding-system
- '(undecided undecided-unix))
+ ;; If rmail-file-coding-system is nil, Emacs 21 writes
+ ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
+ ;; earlier versions did that with the current buffer's
+ ;; encoding. So we want to favor detection of emacs-mule
+ ;; (whose normal priority is quite low) and utf-8, but
+ ;; still allow detection of other encodings if they won't
+ ;; fit. The call to with-coding-priority below achieves
+ ;; that.
+ (with-coding-priority '(emacs-mule utf-8)
+ (detect-coding-region from to 'highest))))
+ (unless (eq (coding-system-type coding-system) 'undecided)
(set-buffer-modified-p t) ; avoid locking when decoding
(let ((buffer-undo-list t))
(decode-coding-region from to coding-system))
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
'(rmail-font-lock-keywords
- t nil nil nil
+ t t nil nil
(font-lock-maximum-size . nil)
(font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
(font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
(make-local-variable 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
(make-local-variable 'file-precious-flag)
- (setq file-precious-flag t))
+ (setq file-precious-flag t)
+ (make-local-variable 'desktop-save-buffer)
+ (setq desktop-save-buffer t))
;; Handle M-x revert-buffer done in an rmail-mode buffer.
(defun rmail-revert (arg noconfirm)
(while all-files
(let ((opoint (point))
(new-messages 0)
+ (rsf-number-of-spam 0)
(delete-files ())
;; If buffer has not changed yet, and has not been saved yet,
;; don't replace the old backup file now.
(progn (goto-char opoint)
(if (or file-name rmail-inbox-list)
(message "(No new mail has arrived)")))
- (if (rmail-summary-exists)
+ ;; check new messages to see if any of them is spam:
+ (if (and (featurep 'rmail-spam-filter)
+ rmail-use-spam-filter)
+ (let*
+ ((old-messages (- rmail-total-messages new-messages))
+ (rsf-scanned-message-number (1+ old-messages))
+ ;; save deletion flags of old messages: vector starts
+ ;; at zero (is one longer that no of messages),
+ ;; therefore take 1+ old-messages
+ (save-deleted
+ (substring rmail-deleted-vector 0 (1+
+ old-messages))))
+ ;; set all messages to undeleted
+ (setq rmail-deleted-vector
+ (make-string (1+ rmail-total-messages) ?\ ))
+ (while (<= rsf-scanned-message-number
+ rmail-total-messages)
+ (progn
+ (if (not (rmail-spam-filter rsf-scanned-message-number))
+ (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam)))
+ )
+ (setq rsf-scanned-message-number (1+ rsf-scanned-message-number))
+ ))
+ (if (> rsf-number-of-spam 0)
+ (progn
+ (when (rmail-expunge-confirmed)
+ (rmail-only-expunge t))
+ ))
+ (setq rmail-deleted-vector
+ (concat
+ save-deleted
+ (make-string (- rmail-total-messages old-messages)
+ ?\ )))
+ ))
+ (if (rmail-summary-exists)
(rmail-select-summary
(rmail-update-summary)))
- (message "%d new message%s read"
- new-messages (if (= 1 new-messages) "" "s"))
+ (message "%d new message%s read%s"
+ new-messages (if (= 1 new-messages) "" "s")
+ ;; print out a message on number of spam messages found:
+ (if (and (featurep 'rmail-spam-filter)
+ rmail-use-spam-filter
+ (> rsf-number-of-spam 0))
+ (if (= 1 new-messages)
+ ", and found to be a spam message"
+ (if (> rsf-number-of-spam 1)
+ (format ", %d of which found to be spam messages"
+ rsf-number-of-spam)
+ ", one of which found to be a spam message"))
+ ""))
+ (if (and (featurep 'rmail-spam-filter)
+ rmail-use-spam-filter
+ (> rsf-number-of-spam 0))
+ (progn (if rsf-beep (beep t))
+ (sleep-for rsf-sleep-after-message)))
+
;; Move to the first new message
;; unless we have other unseen messages before it.
(rmail-show-message (rmail-first-unseen-message))
;; Don't leave the buffer screwed up if we get a disk-full error.
(or found (rmail-show-message)))))
+(defun rmail-parse-url (file)
+ "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
+WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
+actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to
+a remote mailbox, PASSWORD is the password if it should be
+supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
+is non-nil if the user has supplied the password interactively.
+"
+ (if (string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
+ (let (got-password supplied-password
+ (proto (match-string 1 file))
+ (user (match-string 3 file))
+ (pass (match-string 5 file))
+ (host (substring file (or (match-end 2)
+ (+ 3 (match-end 1))))))
+ (if (not pass)
+ (when rmail-remote-password-required
+ (setq got-password (not (rmail-have-password)))
+ (setq supplied-password (rmail-get-remote-password
+ (string-equal proto "imap")))))
+
+ (if (rmail-movemail-variant-p 'emacs)
+ (if (string-equal proto "pop")
+ (list (concat "po:" user ":" host)
+ t
+ (or pass supplied-password)
+ got-password)
+ (error "Emacs movemail does not support %s protocol" proto))
+ (list file
+ (or (string-equal proto "pop") (string-equal proto "imap"))
+ supplied-password
+ got-password)))
+ (list file nil nil nil)))
+
(defun rmail-insert-inbox-text (files renamep)
;; Detect a locked file now, so that we avoid moving mail
;; out of the real inbox file. (That could scare people.)
(file-name-nondirectory buffer-file-name)))
(let (file tofile delete-files movemail popmail got-password password)
(while files
- ;; Handle POP mailbox names specially; don't expand as filenames
+ ;; Handle remote mailbox names specially; don't expand as filenames
;; in case the userid contains a directory separator.
(setq file (car files))
- (setq popmail (string-match "^po:" file))
+ (let ((url-data (rmail-parse-url file)))
+ (setq file (nth 0 url-data))
+ (setq popmail (nth 1 url-data))
+ (setq password (nth 2 url-data))
+ (setq got-password (nth 3 url-data)))
+
(if popmail
(setq renamep t)
(setq file (file-truename
(setq tofile (expand-file-name
;; Generate name to move to from inbox name,
;; in case of multiple inboxes that need moving.
- (concat ".newmail-" (file-name-nondirectory file))
+ (concat ".newmail-"
+ (file-name-nondirectory
+ (if (memq system-type '(windows-nt cygwin))
+ ;; cannot have "po:" in file name
+ (substring file 3)
+ file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
;; if that is on a full disk and this rmail
(setq file (expand-file-name (user-login-name)
file)))))
(cond (popmail
- (if rmail-pop-password-required
- (progn (setq got-password (not (rmail-have-password)))
- (setq password (rmail-get-pop-password))))
- (if (eq system-type 'windows-nt)
- ;; cannot have "po:" in file name
- (setq tofile
- (expand-file-name
- (concat ".newmail-pop-"
- (file-name-nondirectory (substring file 3)))
- (file-name-directory
- (expand-file-name buffer-file-name)))))
- (message "Getting mail from post office ..."))
+ (message "Getting mail from the remote server ..."))
((and (file-exists-p tofile)
(/= 0 (nth 7 (file-attributes tofile))))
(message "Getting mail from %s..." tofile))
(write-region (point) (point) file)
(file-error nil))))
(t
- (let ((errors nil))
- (unwind-protect
- (save-excursion
- (setq errors (generate-new-buffer " *rmail loss*"))
- (buffer-disable-undo errors)
- (let ((args
- (append
- (list (or rmail-movemail-program
- (expand-file-name "movemail"
- exec-directory))
- nil errors nil)
- (if rmail-preserve-inbox
- (list "-p")
- nil)
- rmail-movemail-flags
- (list file tofile)
- (if password (list password) nil))))
- (apply 'call-process args))
- (if (not (buffer-modified-p errors))
- ;; No output => movemail won
- nil
- (set-buffer errors)
- (subst-char-in-region (point-min) (point-max)
- ?\n ?\ )
- (goto-char (point-max))
- (skip-chars-backward " \t")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (if (looking-at "movemail: ")
- (delete-region (point-min) (match-end 0)))
- (beep t)
- (message "movemail: %s"
- (buffer-substring (point-min)
- (point-max)))
- ;; If we just read the password, most likely it is
- ;; wrong. Otherwise, see if there is a specific
- ;; reason to think that the problem is a wrong passwd.
- (if (or got-password
- (re-search-forward rmail-pop-password-error
- nil t))
- (rmail-set-pop-password nil))
- (sit-for 3)
- nil))
- (if errors (kill-buffer errors))))))
+ (with-temp-buffer
+ (let ((errors (current-buffer)))
+ (buffer-disable-undo errors)
+ (let ((args
+ (append
+ (list (or rmail-movemail-program
+ (expand-file-name "movemail"
+ exec-directory))
+ nil errors nil)
+ (if rmail-preserve-inbox
+ (list "-p")
+ nil)
+ (if (rmail-movemail-variant-p 'mailutils)
+ (append (list "--emacs") rmail-movemail-flags)
+ rmail-movemail-flags)
+ (list file tofile)
+ (if password (list password) nil))))
+ (apply 'call-process args))
+ (if (not (buffer-modified-p errors))
+ ;; No output => movemail won
+ nil
+ (set-buffer errors)
+ (subst-char-in-region (point-min) (point-max)
+ ?\n ?\ )
+ (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (delete-region (point) (point-max))
+ (goto-char (point-min))
+ (if (looking-at "movemail: ")
+ (delete-region (point-min) (match-end 0)))
+ (beep t)
+ ;; If we just read the password, most likely it is
+ ;; wrong. Otherwise, see if there is a specific
+ ;; reason to think that the problem is a wrong passwd.
+ (if (or got-password
+ (re-search-forward rmail-remote-password-error
+ nil t))
+ (rmail-set-remote-password nil))
+
+ ;; If using Mailutils, remove initial error code
+ ;; abbreviation
+ (when (rmail-movemail-variant-p 'mailutils)
+ (goto-char (point-min))
+ (when (looking-at "[A-Z][A-Z0-9_]*:")
+ (delete-region (point-min) (match-end 0))))
+
+ (message "movemail: %s"
+ (buffer-substring (point-min)
+ (point-max)))
+
+ (sit-for 3)
+ nil)))))
+
;; At this point, TOFILE contains the name to read:
;; Either the alternate name (if we renamed)
;; or the actual inbox (if not renaming).
(defun rmail-decode-region (from to coding)
(if (or (not coding) (not (coding-system-p coding)))
(setq coding 'undecided))
- (decode-coding-region from to coding))
+ ;; Use -dos decoding, to remove ^M characters left from base64 or
+ ;; rogue qp-encoded text.
+ (decode-coding-region from to
+ (coding-system-change-eol-conversion coding 1))
+ ;; Don't reveal the fact we used -dos decoding, as users generally
+ ;; will not expect the RMAIL buffer to use DOS EOL format.
+ (setq buffer-file-coding-system
+ (setq last-coding-system-used
+ (coding-system-change-eol-conversion coding 0))))
;; the rmail-break-forwarded-messages feature is not implemented
(defun rmail-convert-to-babyl-format ()
(save-excursion
(skip-chars-forward " \t\n")
(point)))
- (setq last-coding-system-used nil)
- (or rmail-enable-mime
- (not rmail-enable-multibyte)
- (decode-coding-region start (point)
- (or rmail-file-coding-system
- 'undecided)))
+ (save-excursion
+ (let* ((header-end
+ (progn
+ (save-excursion
+ (goto-char start)
+ (forward-line 1)
+ (if (looking-at "0")
+ (forward-line 1)
+ (forward-line 2))
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (rfc822-goto-eoh)
+ (point)))))
+ (case-fold-search t)
+ (quoted-printable-header-field-end
+ (save-excursion
+ (goto-char start)
+ (re-search-forward
+ "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
+ header-end t)))
+ (base64-header-field-end
+ (save-excursion
+ (goto-char start)
+ (re-search-forward
+ "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
+ header-end t))))
+ (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)
+ (- (point) 2))
+ 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"))))
+ (setq last-coding-system-used nil)
+ (or rmail-enable-mime
+ (not rmail-enable-multibyte)
+ (let ((mime-charset
+ (if (and rmail-decode-mime-charset
+ (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)))))
;; Add an X-Coding-System: header if we don't have one.
(save-excursion
(goto-char start)
(insert "X-Coding-System: "
(symbol-name last-coding-system-used)
"\n")))
- (narrow-to-region (point) (point-max)))
+ (narrow-to-region (point) (point-max))
+ (and (= 0 (% count 10))
+ (message "Converting to Babyl format...%d" count)))
;;*** MMDF format
((let ((case-fold-search t))
(looking-at rmail-mmdf-delim1))
(symbol-name last-coding-system-used)
"\n"))
(narrow-to-region (point) (point-max))
- (setq count (1+ count)))
+ (setq count (1+ count))
+ (and (= 0 (% count 10))
+ (message "Converting to Babyl format...%d" count)))
;;*** Mail format
((looking-at "^From ")
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
(re-search-forward
"^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
header-end t)))
+ (base64-header-field-end
+ (save-excursion
+ (re-search-forward
+ "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
+ header-end t)))
(size
;; Get the numeric value from the Content-Length field.
(save-excursion
(goto-char (+ header-end size))
(message "Ignoring invalid Content-Length field")
(sit-for 1 0 t)))
- (if (re-search-forward
- (concat "^[\^_]?\\("
- rmail-unix-mail-delimiter
- "\\|"
- rmail-mmdf-delim1 "\\|"
- "^BABYL OPTIONS:\\|"
- "\^L\n[01],\\)") nil t)
+ (if (let ((case-fold-search nil))
+ (re-search-forward
+ (concat "^[\^_]?\\("
+ rmail-unix-mail-delimiter
+ "\\|"
+ rmail-mmdf-delim1 "\\|"
+ "^BABYL OPTIONS:\\|"
+ "\^L\n[01],\\)") nil t))
(goto-char (match-beginning 1))
(goto-char (point-max)))
(setq count (1+ count))
(if quoted-printable-header-field-end
(save-excursion
- (rmail-decode-quoted-printable header-end (point))
+ (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"))))
+ (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")))))
(save-excursion
(save-restriction
(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)
(or rmail-enable-mime
(insert "X-Coding-System: "
(symbol-name last-coding-system-used)
"\n"))
- (narrow-to-region (point) (point-max)))
+ (narrow-to-region (point) (point-max))
+ (and (= 0 (% count 10))
+ (message "Converting to Babyl format...%d" count)))
;;
;; This kludge is because some versions of sendmail.el
;; insert an extra newline at the beginning that shouldn't
(t (error "Cannot convert to babyl format")))))
count))
-(defun rmail-hex-char-to-integer (character)
- "Return CHARACTER's value interpreted as a hex digit."
- (if (and (>= character ?0) (<= character ?9))
- (- character ?0)
- (let ((ch (logior character 32)))
- (if (and (>= ch ?a) (<= ch ?f))
- (- ch (- ?a 10))
- (error "Invalid hex digit `%c'" ch)))))
-
-(defun rmail-hex-string-to-integer (hex-string)
- "Return decimal integer for HEX-STRING."
- (let ((hex-num 0)
- (index 0))
- (while (< index (length hex-string))
- (setq hex-num (+ (* hex-num 16)
- (rmail-hex-char-to-integer (aref hex-string index))))
- (setq index (1+ index)))
- hex-num))
-
-(defun rmail-decode-quoted-printable (from to)
- "Decode Quoted-Printable in the region between FROM and TO."
- (interactive "r")
- (goto-char from)
- (or (markerp to)
- (setq to (copy-marker to)))
- (while (search-forward "=" to t)
- (cond ((eq (following-char) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((looking-at "[0-9A-F][0-9A-F]")
- (let ((byte (rmail-hex-string-to-integer
- (buffer-substring (point) (+ 2 (point))))))
- (delete-region (1- (point)) (+ 2 (point)))
- (insert byte)))
- ((looking-at "=")
- (delete-char 1))
- (t
- (message "Malformed MIME quoted-printable message")))))
-
;; Delete the "From ..." line, creating various other headers with
;; information from it if they don't already exist. Now puts the
;; original line into a mail-from: header line for debugging and for
(progn
(check-coding-system coding-system)
(setq buffer-file-coding-system coding-system))
- (error
+ (error
(setq buffer-file-coding-system nil))))
(setq buffer-file-coding-system nil)))))
;; Clear the "unseen" attribute when we show a message.
(funcall rmail-confirm-expunge
"Erase deleted messages from Rmail file? ")))
-(defun rmail-only-expunge ()
+(defun rmail-only-expunge (&optional dont-show)
"Actually erase all deleted messages in the file."
(interactive)
(set-buffer rmail-buffer)
(message "Expunging deleted messages...done")
(if (not win)
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
- (rmail-show-message
- (if (zerop rmail-current-message) 1 nil))
- (if rmail-enable-mime
- (goto-char (+ (point-min) opoint))
- (goto-char (+ (point) opoint))))))
+ (if (not dont-show)
+ (rmail-show-message
+ (if (zerop rmail-current-message) 1 nil)
+ (if rmail-enable-mime
+ (goto-char (+ (point-min) opoint))
+ (goto-char (+ (point) opoint))))))))
(defun rmail-expunge ()
"Erase deleted messages from Rmail file and summary buffer."
(compose-mail to subject others
noerase nil
yank-action sendactions)
- (if (and (display-multi-frame-p) rmail-mail-new-frame)
+ (if rmail-mail-new-frame
(prog1
(compose-mail to subject others
noerase 'switch-to-buffer-other-frame
;; since they can handle the names unstripped.
;; I don't know whether there are other mailers that still
;; need the names to be stripped.
- (mail-strip-quoted-names reply-to)
+;;; (mail-strip-quoted-names reply-to)
+ reply-to
subject
(rmail-make-in-reply-to-field from date message-id)
(if just-sender
(if (not from) (setq from user-mail-address))
(let ((tembuf (generate-new-buffer " sendmail temp"))
(case-fold-search nil)
+ (mail-personal-alias-file
+ (or mail-alias-file mail-personal-alias-file))
(mailbuf rmail-buffer))
(unwind-protect
(with-current-buffer tembuf
; nor is it meant to be.
;;;###autoload
-(defun rmail-set-pop-password (password)
- "Set PASSWORD to be used for retrieving mail from a POP server."
+(defun rmail-set-remote-password (password)
+ "Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
(interactive "sPassword: ")
(if password
- (setq rmail-encoded-pop-password
+ (setq rmail-encoded-remote-password
(rmail-encode-string password (emacs-pid)))
- (setq rmail-pop-password nil)
- (setq rmail-encoded-pop-password nil)))
+ (setq rmail-remote-password nil)
+ (setq rmail-encoded-remote-password nil)))
-(defun rmail-get-pop-password ()
- "Get the password for retrieving mail from a POP server. If none
+(defun rmail-get-remote-password (imap)
+ "Get the password for retrieving mail from a POP or IMAP server. If none
has been set, then prompt the user for one."
- (if (not rmail-encoded-pop-password)
- (progn (if (not rmail-pop-password)
- (setq rmail-pop-password (read-passwd "POP password: ")))
- (rmail-set-pop-password rmail-pop-password)
- (setq rmail-pop-password nil)))
- (rmail-encode-string rmail-encoded-pop-password (emacs-pid)))
+ (when (not rmail-encoded-remote-password)
+ (if (not rmail-remote-password)
+ (setq rmail-remote-password
+ (read-passwd (if imap
+ "IMAP password: "
+ "POP password: "))))
+ (rmail-set-remote-password rmail-remote-password)
+ (setq rmail-remote-password nil))
+ (rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
(defun rmail-have-password ()
- (or rmail-pop-password rmail-encoded-pop-password))
+ (or rmail-remote-password rmail-encoded-remote-password))
(defun rmail-encode-string (string mask)
"Encode STRING with integer MASK, by taking the exclusive OR of the
(setq i (1+ i)))
(concat string-vector)))
+;;;; Desktop support
+
+;;;###autoload
+(defun rmail-restore-desktop-buffer (desktop-buffer-file-name
+ desktop-buffer-name
+ desktop-buffer-misc)
+ "Restore an rmail buffer specified in a desktop file."
+ (condition-case error
+ (progn
+ (rmail-input desktop-buffer-file-name)
+ (if (eq major-mode 'rmail-mode)
+ (current-buffer)
+ rmail-buffer))
+ (file-locked
+ (kill-buffer (current-buffer))
+ nil)))
+
(provide 'rmail)
+;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
;;; rmail.el ends here