diff options
| author | Bastien Guerry | 2009-01-22 17:09:23 +0000 |
|---|---|---|
| committer | Bastien Guerry | 2009-01-22 17:09:23 +0000 |
| commit | 537ab246b2a6fc229c0b44a7fcf960eab5980747 (patch) | |
| tree | 3a340af73bbffad951a90852ea5da70349f40607 | |
| parent | 13847f797015b2f3807118aa232fd209dab29b34 (diff) | |
| download | emacs-537ab246b2a6fc229c0b44a7fcf960eab5980747.tar.gz emacs-537ab246b2a6fc229c0b44a7fcf960eab5980747.zip | |
Renamed all pmail* files to rmail*.
| -rw-r--r-- | lisp/mail/rmail.el | 3893 | ||||
| -rw-r--r-- | lisp/mail/rmailedit.el | 217 | ||||
| -rw-r--r-- | lisp/mail/rmailkwd.el | 169 | ||||
| -rw-r--r-- | lisp/mail/rmailmm.el | 410 | ||||
| -rw-r--r-- | lisp/mail/rmailmsc.el | 66 | ||||
| -rw-r--r-- | lisp/mail/rmailout.el | 602 | ||||
| -rw-r--r-- | lisp/mail/rmailsort.el | 245 | ||||
| -rw-r--r-- | lisp/mail/rmailsum.el | 1765 |
8 files changed, 7367 insertions, 0 deletions
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el new file mode 100644 index 00000000000..faea62a3f74 --- /dev/null +++ b/lisp/mail/rmail.el | |||
| @@ -0,0 +1,3893 @@ | |||
| 1 | ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, | ||
| 4 | ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 | ||
| 5 | ;; Free Software Foundation, Inc. | ||
| 6 | |||
| 7 | ;; Maintainer: FSF | ||
| 8 | ;; Keywords: mail | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | ;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu | ||
| 30 | ;; New features include attribute and keyword support, message | ||
| 31 | ;; selection by dispatch table, summary by attributes and keywords, | ||
| 32 | ;; expunging by dispatch table, sticky options for file commands. | ||
| 33 | |||
| 34 | ;; Extended by Bob Weiner of Motorola | ||
| 35 | ;; New features include: rmail and rmail-summary buffers remain | ||
| 36 | ;; synchronized and key bindings basically operate the same way in both | ||
| 37 | ;; buffers, summary by topic or by regular expression, rmail-reply-prefix | ||
| 38 | ;; variable, and a bury rmail buffer (wipe) command. | ||
| 39 | ;; | ||
| 40 | |||
| 41 | (require 'mail-utils) | ||
| 42 | (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority | ||
| 43 | |||
| 44 | (defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES" | ||
| 45 | "The header that stores the Rmail attribute data.") | ||
| 46 | |||
| 47 | (defconst rmail-keyword-header "X-RMAIL-KEYWORDS" | ||
| 48 | "The header that stores the Rmail keyword data.") | ||
| 49 | |||
| 50 | ;;; Attribute indexes | ||
| 51 | |||
| 52 | (defconst rmail-answered-attr-index 0 | ||
| 53 | "The index for the `answered' attribute.") | ||
| 54 | |||
| 55 | (defconst rmail-deleted-attr-index 1 | ||
| 56 | "The index for the `deleted' attribute.") | ||
| 57 | |||
| 58 | (defconst rmail-edited-attr-index 2 | ||
| 59 | "The index for the `edited' attribute.") | ||
| 60 | |||
| 61 | (defconst rmail-filed-attr-index 3 | ||
| 62 | "The index for the `filed' attribute.") | ||
| 63 | |||
| 64 | (defconst rmail-retried-attr-index 4 | ||
| 65 | "The index for the `retried' attribute.") | ||
| 66 | |||
| 67 | (defconst rmail-forwarded-attr-index 5 | ||
| 68 | "The index for the `forwarded' attribute.") | ||
| 69 | |||
| 70 | (defconst rmail-unseen-attr-index 6 | ||
| 71 | "The index for the `unseen' attribute.") | ||
| 72 | |||
| 73 | (defconst rmail-resent-attr-index 6 | ||
| 74 | "The index for the `resent' attribute.") | ||
| 75 | |||
| 76 | (defconst rmail-attr-array | ||
| 77 | '[(?A "answered") | ||
| 78 | (?D "deleted") | ||
| 79 | (?E "edited") | ||
| 80 | (?F "filed") | ||
| 81 | (?R "retried") | ||
| 82 | (?S "forwarded") | ||
| 83 | (?U "unseen") | ||
| 84 | (?r "resent")] | ||
| 85 | "An array that provides a mapping between an attribute index, | ||
| 86 | its character representation and its display representation.") | ||
| 87 | |||
| 88 | (defvar deleted-head) | ||
| 89 | (defvar font-lock-fontified) | ||
| 90 | (defvar mail-abbrev-syntax-table) | ||
| 91 | (defvar mail-abbrevs) | ||
| 92 | (defvar messages-head) | ||
| 93 | (defvar rmail-use-spam-filter) | ||
| 94 | (defvar rsf-beep) | ||
| 95 | (defvar rsf-sleep-after-message) | ||
| 96 | (defvar total-messages) | ||
| 97 | (defvar tool-bar-map) | ||
| 98 | |||
| 99 | (defvar rmail-header-style 'normal | ||
| 100 | "The current header display style choice, one of | ||
| 101 | 'normal (selected headers) or 'full (all headers).") | ||
| 102 | |||
| 103 | ; These variables now declared in paths.el. | ||
| 104 | ;(defvar rmail-spool-directory "/usr/spool/mail/" | ||
| 105 | ; "This is the name of the directory used by the system mailer for\n\ | ||
| 106 | ;delivering new mail. Its name should end with a slash.") | ||
| 107 | ;(defvar rmail-file-name | ||
| 108 | ; (expand-file-name "~/RMAIL") | ||
| 109 | ; "") | ||
| 110 | |||
| 111 | ;; Temporary support for mbox. | ||
| 112 | (defcustom rmail-file-name "~/RMAIL" | ||
| 113 | "*Name of user's primary mail file." | ||
| 114 | :type 'string | ||
| 115 | :group 'rmail | ||
| 116 | :version "21.1") | ||
| 117 | |||
| 118 | (defgroup rmail nil | ||
| 119 | "Mail reader for Emacs." | ||
| 120 | :group 'mail) | ||
| 121 | |||
| 122 | (defgroup rmail-retrieve nil | ||
| 123 | "Rmail retrieval options." | ||
| 124 | :prefix "rmail-" | ||
| 125 | :group 'rmail) | ||
| 126 | |||
| 127 | (defgroup rmail-files nil | ||
| 128 | "Rmail files." | ||
| 129 | :prefix "rmail-" | ||
| 130 | :group 'rmail) | ||
| 131 | |||
| 132 | (defgroup rmail-headers nil | ||
| 133 | "Rmail header options." | ||
| 134 | :prefix "rmail-" | ||
| 135 | :group 'rmail) | ||
| 136 | |||
| 137 | (defgroup rmail-reply nil | ||
| 138 | "Rmail reply options." | ||
| 139 | :prefix "rmail-" | ||
| 140 | :group 'rmail) | ||
| 141 | |||
| 142 | (defgroup rmail-summary nil | ||
| 143 | "Rmail summary options." | ||
| 144 | :prefix "rmail-" | ||
| 145 | :prefix "rmail-summary-" | ||
| 146 | :group 'rmail) | ||
| 147 | |||
| 148 | (defgroup rmail-output nil | ||
| 149 | "Output message to a file." | ||
| 150 | :prefix "rmail-output-" | ||
| 151 | :prefix "rmail-" | ||
| 152 | :group 'rmail) | ||
| 153 | |||
| 154 | (defgroup rmail-edit nil | ||
| 155 | "Rmail editing." | ||
| 156 | :prefix "rmail-edit-" | ||
| 157 | :group 'rmail) | ||
| 158 | |||
| 159 | (defgroup rmail-obsolete nil | ||
| 160 | "Rmail obsolete customization variables." | ||
| 161 | :group 'rmail) | ||
| 162 | |||
| 163 | (defcustom rmail-movemail-program nil | ||
| 164 | "If non-nil, the file name of the `movemail' program." | ||
| 165 | :group 'rmail-retrieve | ||
| 166 | :type '(choice (const nil) string)) | ||
| 167 | |||
| 168 | (defcustom rmail-pop-password nil | ||
| 169 | "*Password to use when reading mail from POP server. | ||
| 170 | Please use `rmail-remote-password' instead." | ||
| 171 | :type '(choice (string :tag "Password") | ||
| 172 | (const :tag "Not Required" nil)) | ||
| 173 | :group 'rmail-obsolete) | ||
| 174 | |||
| 175 | (defcustom rmail-pop-password-required nil | ||
| 176 | "*Non-nil if a password is required when reading mail from a POP server. | ||
| 177 | Please use rmail-remote-password-required instead." | ||
| 178 | :type 'boolean | ||
| 179 | :group 'rmail-obsolete) | ||
| 180 | |||
| 181 | (defcustom rmail-remote-password nil | ||
| 182 | "*Password to use when reading mail from a remote server. | ||
| 183 | This setting is ignored for mailboxes whose URL already contains a password." | ||
| 184 | :type '(choice (string :tag "Password") | ||
| 185 | (const :tag "Not Required" nil)) | ||
| 186 | :set-after '(rmail-pop-password) | ||
| 187 | :set #'(lambda (symbol value) | ||
| 188 | (set-default symbol | ||
| 189 | (if (and (not value) | ||
| 190 | (boundp 'rmail-pop-password) | ||
| 191 | rmail-pop-password) | ||
| 192 | rmail-pop-password | ||
| 193 | value)) | ||
| 194 | (setq rmail-pop-password nil)) | ||
| 195 | :group 'rmail-retrieve | ||
| 196 | :version "22.1") | ||
| 197 | |||
| 198 | (defcustom rmail-remote-password-required nil | ||
| 199 | "*Non-nil if a password is required when reading mail from a remote server." | ||
| 200 | :type 'boolean | ||
| 201 | :set-after '(rmail-pop-password-required) | ||
| 202 | :set #'(lambda (symbol value) | ||
| 203 | (set-default symbol | ||
| 204 | (if (and (not value) | ||
| 205 | (boundp 'rmail-pop-password-required) | ||
| 206 | rmail-pop-password-required) | ||
| 207 | rmail-pop-password-required | ||
| 208 | value)) | ||
| 209 | (setq rmail-pop-password-required nil)) | ||
| 210 | :group 'rmail-retrieve | ||
| 211 | :version "22.1") | ||
| 212 | |||
| 213 | (defcustom rmail-movemail-flags nil | ||
| 214 | "*List of flags to pass to movemail. | ||
| 215 | Most commonly used to specify `-g' to enable GSS-API authentication | ||
| 216 | or `-k' to enable Kerberos authentication." | ||
| 217 | :type '(repeat string) | ||
| 218 | :group 'rmail-retrieve | ||
| 219 | :version "20.3") | ||
| 220 | |||
| 221 | (defvar rmail-remote-password-error "invalid usercode or password\\| | ||
| 222 | unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE" | ||
| 223 | "Regular expression matching incorrect-password POP or IMAP server error | ||
| 224 | messages. | ||
| 225 | If you get an incorrect-password error that this expression does not match, | ||
| 226 | please report it with \\[report-emacs-bug].") | ||
| 227 | |||
| 228 | (defvar rmail-encoded-remote-password nil) | ||
| 229 | |||
| 230 | (defcustom rmail-preserve-inbox nil | ||
| 231 | "*Non-nil means leave incoming mail in the user's inbox--don't delete it." | ||
| 232 | :type 'boolean | ||
| 233 | :group 'rmail-retrieve) | ||
| 234 | |||
| 235 | (defcustom rmail-movemail-search-path nil | ||
| 236 | "*List of directories to search for movemail (in addition to `exec-path')." | ||
| 237 | :group 'rmail-retrieve | ||
| 238 | :type '(repeat (directory))) | ||
| 239 | |||
| 240 | (declare-function mail-position-on-field "sendmail" (field &optional soft)) | ||
| 241 | (declare-function mail-text-start "sendmail" ()) | ||
| 242 | (declare-function rmail-dont-reply-to "mail-utils" (destinations)) | ||
| 243 | (declare-function rmail-update-summary "rmailsum" (&rest ignore)) | ||
| 244 | |||
| 245 | (defun rmail-probe (prog) | ||
| 246 | "Determine what flavor of movemail PROG is. | ||
| 247 | We do this by executing it with `--version' and analyzing its output." | ||
| 248 | (with-temp-buffer | ||
| 249 | (let ((tbuf (current-buffer))) | ||
| 250 | (buffer-disable-undo tbuf) | ||
| 251 | (call-process prog nil tbuf nil "--version") | ||
| 252 | (if (not (buffer-modified-p tbuf)) | ||
| 253 | ;; Should not happen... | ||
| 254 | nil | ||
| 255 | (goto-char (point-min)) | ||
| 256 | (cond | ||
| 257 | ((looking-at ".*movemail: invalid option") | ||
| 258 | 'emacs) ;; Possibly... | ||
| 259 | ((looking-at "movemail (GNU Mailutils .*)") | ||
| 260 | 'mailutils) | ||
| 261 | (t | ||
| 262 | ;; FIXME: | ||
| 263 | 'emacs)))))) | ||
| 264 | |||
| 265 | (defun rmail-autodetect () | ||
| 266 | "Determine the file name of the `movemail' program and return its flavor. | ||
| 267 | If `rmail-movemail-program' is non-nil, use it. | ||
| 268 | Otherwise, look for `movemail' in the directories in | ||
| 269 | `rmail-movemail-search-path', those in `exec-path', and `exec-directory'." | ||
| 270 | (if rmail-movemail-program | ||
| 271 | (rmail-probe rmail-movemail-program) | ||
| 272 | (catch 'scan | ||
| 273 | (dolist (dir (append rmail-movemail-search-path exec-path | ||
| 274 | (list exec-directory))) | ||
| 275 | (when (and dir (file-accessible-directory-p dir)) | ||
| 276 | ;; Previously, this didn't have to work on Windows, because | ||
| 277 | ;; rmail-insert-inbox-text before r1.439 fell back to using | ||
| 278 | ;; (expand-file-name "movemail" exec-directory) and just | ||
| 279 | ;; assuming it would work. | ||
| 280 | ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00087.html | ||
| 281 | (let ((progname (expand-file-name | ||
| 282 | (concat "movemail" | ||
| 283 | (if (memq system-type '(ms-dos windows-nt)) | ||
| 284 | ".exe")) dir))) | ||
| 285 | (when (and (not (file-directory-p progname)) | ||
| 286 | (file-executable-p progname)) | ||
| 287 | (let ((x (rmail-probe progname))) | ||
| 288 | (when x | ||
| 289 | (setq rmail-movemail-program progname) | ||
| 290 | (throw 'scan x)))))))))) | ||
| 291 | |||
| 292 | (defvar rmail-movemail-variant-in-use nil | ||
| 293 | "The movemail variant currently in use. Known variants are: | ||
| 294 | |||
| 295 | `emacs' Means any implementation, compatible with the native Emacs one. | ||
| 296 | This is the default; | ||
| 297 | `mailutils' Means GNU mailutils implementation, capable of handling full | ||
| 298 | mail URLs as the source mailbox.") | ||
| 299 | |||
| 300 | ;;;###autoload | ||
| 301 | (defun rmail-movemail-variant-p (&rest variants) | ||
| 302 | "Return t if the current movemail variant is any of VARIANTS. | ||
| 303 | Currently known variants are 'emacs and 'mailutils." | ||
| 304 | (when (not rmail-movemail-variant-in-use) | ||
| 305 | ;; Autodetect | ||
| 306 | (setq rmail-movemail-variant-in-use (rmail-autodetect))) | ||
| 307 | (not (null (member rmail-movemail-variant-in-use variants)))) | ||
| 308 | |||
| 309 | ;; Call for effect, to set rmail-movemail-program (if not set by the | ||
| 310 | ;; user), and rmail-movemail-variant-in-use. Used by various functions. | ||
| 311 | ;; I'm not sure if M-x rmail is the only entry point to this package. | ||
| 312 | ;; If so, this can be moved there. | ||
| 313 | (rmail-movemail-variant-p) | ||
| 314 | |||
| 315 | ;;;###autoload | ||
| 316 | (defcustom rmail-dont-reply-to-names nil "\ | ||
| 317 | *A regexp specifying addresses to prune from a reply message. | ||
| 318 | A value of nil means exclude your own email address as an address | ||
| 319 | plus whatever is specified by `rmail-default-dont-reply-to-names'." | ||
| 320 | :type '(choice regexp (const :tag "Your Name" nil)) | ||
| 321 | :group 'rmail-reply) | ||
| 322 | |||
| 323 | ;;;###autoload | ||
| 324 | (defvar rmail-default-dont-reply-to-names "\\`info-" "\ | ||
| 325 | A regular expression specifying part of the default value of the | ||
| 326 | variable `rmail-dont-reply-to-names', for when the user does not set | ||
| 327 | `rmail-dont-reply-to-names' explicitly. (The other part of the default | ||
| 328 | value is the user's email address and name.) | ||
| 329 | It is useful to set this variable in the site customization file.") | ||
| 330 | |||
| 331 | ;;;###autoload | ||
| 332 | (defcustom rmail-ignored-headers | ||
| 333 | (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:" | ||
| 334 | "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" | ||
| 335 | "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" | ||
| 336 | "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" | ||
| 337 | "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" | ||
| 338 | "\\|^x-mailer:\\|^delivered-to:\\|^lines:" | ||
| 339 | "\\|^content-transfer-encoding:\\|^x-coding-system:" | ||
| 340 | "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" | ||
| 341 | "\\|^precedence:\\|^mime-version:" | ||
| 342 | "\\|^list-owner:\\|^list-help:\\|^list-post:\\|^list-subscribe:" | ||
| 343 | "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" | ||
| 344 | "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent" | ||
| 345 | "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" | ||
| 346 | "\\|^mbox-line:\\|^cancel-lock:" | ||
| 347 | "\\|^DomainKey-Signature:\\|^dkim-signature:" | ||
| 348 | "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" | ||
| 349 | "\\|^x-.*:") | ||
| 350 | "*Regexp to match header fields that Rmail should normally hide. | ||
| 351 | \(See also `rmail-nonignored-headers', which overrides this regexp.) | ||
| 352 | This variable is used for reformatting the message header, | ||
| 353 | which normally happens once for each message, | ||
| 354 | when you view the message for the first time in Rmail. | ||
| 355 | To make a change in this variable take effect | ||
| 356 | for a message that you have already viewed, | ||
| 357 | go to that message and type \\[rmail-toggle-header] twice." | ||
| 358 | :type 'regexp | ||
| 359 | :group 'rmail-headers) | ||
| 360 | |||
| 361 | (defcustom rmail-nonignored-headers "^x-spam-status:" | ||
| 362 | "*Regexp to match X header fields that Rmail should show. | ||
| 363 | This regexp overrides `rmail-ignored-headers'; if both this regexp | ||
| 364 | and that one match a certain header field, Rmail shows the field. | ||
| 365 | If this is nil, ignore all header fields in `rmail-ignored-headers'. | ||
| 366 | |||
| 367 | This variable is used for reformatting the message header, | ||
| 368 | which normally happens once for each message, | ||
| 369 | when you view the message for the first time in Rmail. | ||
| 370 | To make a change in this variable take effect | ||
| 371 | for a message that you have already viewed, | ||
| 372 | go to that message and type \\[rmail-toggle-header] twice." | ||
| 373 | :type '(choice (const nil) (regexp)) | ||
| 374 | :group 'rmail-headers) | ||
| 375 | |||
| 376 | ;;;###autoload | ||
| 377 | (defcustom rmail-displayed-headers nil | ||
| 378 | "*Regexp to match Header fields that Rmail should display. | ||
| 379 | If nil, display all header fields except those matched by | ||
| 380 | `rmail-ignored-headers'." | ||
| 381 | :type '(choice regexp (const :tag "All")) | ||
| 382 | :group 'rmail-headers) | ||
| 383 | |||
| 384 | ;;;###autoload | ||
| 385 | (defcustom rmail-retry-ignored-headers "^x-authentication-warning:" "\ | ||
| 386 | *Headers that should be stripped when retrying a failed message." | ||
| 387 | :type '(choice regexp (const nil :tag "None")) | ||
| 388 | :group 'rmail-headers) | ||
| 389 | |||
| 390 | ;;;###autoload | ||
| 391 | (defcustom rmail-highlighted-headers "^From:\\|^Subject:" "\ | ||
| 392 | *Regexp to match Header fields that Rmail should normally highlight. | ||
| 393 | A value of nil means don't highlight." | ||
| 394 | :type 'regexp | ||
| 395 | :group 'rmail-headers) | ||
| 396 | |||
| 397 | (defface rmail-highlight | ||
| 398 | '((t (:inherit highlight))) | ||
| 399 | "Face to use for highlighting the most important header fields." | ||
| 400 | :group 'rmail-headers | ||
| 401 | :version "22.1") | ||
| 402 | |||
| 403 | (defface rmail-header-name | ||
| 404 | '((t (:inherit font-lock-function-name-face))) | ||
| 405 | "Face to use for highlighting the header names." | ||
| 406 | :group 'rmail-headers | ||
| 407 | :version "23.1") | ||
| 408 | |||
| 409 | ;;;###autoload | ||
| 410 | (defcustom rmail-delete-after-output nil "\ | ||
| 411 | *Non-nil means automatically delete a message that is copied to a file." | ||
| 412 | :type 'boolean | ||
| 413 | :group 'rmail-files) | ||
| 414 | |||
| 415 | ;;;###autoload | ||
| 416 | (defcustom rmail-primary-inbox-list nil "\ | ||
| 417 | *List of files which are inboxes for user's primary mail file `~/RMAIL'. | ||
| 418 | nil means the default, which is (\"/usr/spool/mail/$USER\") | ||
| 419 | \(the name varies depending on the operating system, | ||
| 420 | and the value of the environment variable MAIL overrides it)." | ||
| 421 | ;; Don't use backquote here, because we don't want to need it | ||
| 422 | ;; at load time. | ||
| 423 | :type (list 'choice '(const :tag "Default" nil) | ||
| 424 | (list 'repeat ':value (list (or (getenv "MAIL") | ||
| 425 | (concat "/var/spool/mail/" | ||
| 426 | (getenv "USER")))) | ||
| 427 | 'file)) | ||
| 428 | :group 'rmail-retrieve | ||
| 429 | :group 'rmail-files) | ||
| 430 | |||
| 431 | ;;;###autoload | ||
| 432 | (defcustom rmail-mail-new-frame nil | ||
| 433 | "*Non-nil means Rmail makes a new frame for composing outgoing mail. | ||
| 434 | This is handy if you want to preserve the window configuration of | ||
| 435 | the frame where you have the RMAIL buffer displayed." | ||
| 436 | :type 'boolean | ||
| 437 | :group 'rmail-reply) | ||
| 438 | |||
| 439 | ;;;###autoload | ||
| 440 | (defcustom rmail-secondary-file-directory "~/" | ||
| 441 | "*Directory for additional secondary Rmail files." | ||
| 442 | :type 'directory | ||
| 443 | :group 'rmail-files) | ||
| 444 | ;;;###autoload | ||
| 445 | (defcustom rmail-secondary-file-regexp "\\.xmail$" | ||
| 446 | "*Regexp for which files are secondary Rmail files." | ||
| 447 | :type 'regexp | ||
| 448 | :group 'rmail-files) | ||
| 449 | |||
| 450 | ;;;###autoload | ||
| 451 | (defcustom rmail-confirm-expunge 'y-or-n-p | ||
| 452 | "*Whether and how to ask for confirmation before expunging deleted messages." | ||
| 453 | :type '(choice (const :tag "No confirmation" nil) | ||
| 454 | (const :tag "Confirm with y-or-n-p" y-or-n-p) | ||
| 455 | (const :tag "Confirm with yes-or-no-p" yes-or-no-p)) | ||
| 456 | :version "21.1" | ||
| 457 | :group 'rmail-files) | ||
| 458 | |||
| 459 | ;;;###autoload | ||
| 460 | (defvar rmail-mode-hook nil | ||
| 461 | "List of functions to call when Rmail is invoked.") | ||
| 462 | |||
| 463 | ;;;###autoload | ||
| 464 | (defvar rmail-get-new-mail-hook nil | ||
| 465 | "List of functions to call when Rmail has retrieved new mail.") | ||
| 466 | |||
| 467 | ;;;###autoload | ||
| 468 | (defcustom rmail-show-message-hook nil | ||
| 469 | "List of functions to call when Rmail displays a message." | ||
| 470 | :type 'hook | ||
| 471 | :options '(goto-address) | ||
| 472 | :group 'rmail) | ||
| 473 | |||
| 474 | ;;;###autoload | ||
| 475 | (defvar rmail-quit-hook nil | ||
| 476 | "List of functions to call when quitting out of Rmail.") | ||
| 477 | |||
| 478 | ;;;###autoload | ||
| 479 | (defvar rmail-delete-message-hook nil | ||
| 480 | "List of functions to call when Rmail deletes a message. | ||
| 481 | When the hooks are called, the message has been marked deleted but is | ||
| 482 | still the current message in the Rmail buffer.") | ||
| 483 | |||
| 484 | ;; These may be altered by site-init.el to match the format of mmdf files | ||
| 485 | ;; delimiting used on a given host (delim1 and delim2 from the config | ||
| 486 | ;; files). | ||
| 487 | |||
| 488 | (defvar rmail-mmdf-delim1 "^\001\001\001\001\n" | ||
| 489 | "Regexp marking the start of an mmdf message.") | ||
| 490 | (defvar rmail-mmdf-delim2 "^\001\001\001\001\n" | ||
| 491 | "Regexp marking the end of an mmdf message.") | ||
| 492 | |||
| 493 | (defcustom rmail-message-filter nil | ||
| 494 | "If non-nil, a filter function for new messages in RMAIL. | ||
| 495 | Called with region narrowed to the message, including headers, | ||
| 496 | before obeying `rmail-ignored-headers'." | ||
| 497 | :group 'rmail-headers | ||
| 498 | :type '(choice (const nil) function)) | ||
| 499 | |||
| 500 | (defcustom rmail-automatic-folder-directives nil | ||
| 501 | "List of directives specifying where to put a message. | ||
| 502 | Each element of the list is of the form: | ||
| 503 | |||
| 504 | (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) | ||
| 505 | |||
| 506 | Where FOLDERNAME is the name of a BABYL format folder to put the | ||
| 507 | message. If any of the field regexp's are nil, then it is ignored. | ||
| 508 | |||
| 509 | If FOLDERNAME is \"/dev/null\", it is deleted. | ||
| 510 | If FOLDERNAME is nil then it is deleted, and skipped. | ||
| 511 | |||
| 512 | FIELD is the plain text name of a field in the message, such as | ||
| 513 | \"subject\" or \"from\". A FIELD of \"to\" will automatically include | ||
| 514 | all text from the \"cc\" field as well. | ||
| 515 | |||
| 516 | REGEXP is an expression to match in the preceeding specified FIELD. | ||
| 517 | FIELD/REGEXP pairs continue in the list. | ||
| 518 | |||
| 519 | examples: | ||
| 520 | (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com | ||
| 521 | (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS." | ||
| 522 | :group 'rmail | ||
| 523 | :version "21.1" | ||
| 524 | :type '(repeat (sexp :tag "Directive"))) | ||
| 525 | |||
| 526 | (defvar rmail-reply-prefix "Re: " | ||
| 527 | "String to prepend to Subject line when replying to a message.") | ||
| 528 | |||
| 529 | ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:". | ||
| 530 | ;; This pattern should catch all the common variants. | ||
| 531 | ;; rms: I deleted the change to delete tags in square brackets | ||
| 532 | ;; because they mess up RT tags. | ||
| 533 | (defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*" | ||
| 534 | "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") | ||
| 535 | |||
| 536 | (defcustom rmail-display-summary nil | ||
| 537 | "*If non-nil, Rmail always displays the summary buffer." | ||
| 538 | :group 'rmail-summary | ||
| 539 | :type 'boolean) | ||
| 540 | |||
| 541 | (defvar rmail-inbox-list nil) | ||
| 542 | (put 'rmail-inbox-list 'permanent-local t) | ||
| 543 | |||
| 544 | (defvar rmail-buffer nil | ||
| 545 | "The RMAIL buffer related to the current buffer. | ||
| 546 | In an RMAIL buffer, this holds the RMAIL buffer itself. | ||
| 547 | In a summary buffer, this holds the RMAIL buffer it is a summary for.") | ||
| 548 | (put 'rmail-buffer 'permanent-local t) | ||
| 549 | |||
| 550 | ;; Message counters and markers. Deleted flags. | ||
| 551 | |||
| 552 | (defvar rmail-current-message nil) | ||
| 553 | (put 'rmail-current-message 'permanent-local t) | ||
| 554 | |||
| 555 | (defvar rmail-total-messages nil) | ||
| 556 | (put 'rmail-total-messages 'permanent-local t) | ||
| 557 | |||
| 558 | (defvar rmail-message-vector nil) | ||
| 559 | (put 'rmail-message-vector 'permanent-local t) | ||
| 560 | |||
| 561 | (defvar rmail-deleted-vector nil) | ||
| 562 | (put 'rmail-deleted-vector 'permanent-local t) | ||
| 563 | |||
| 564 | (defvar rmail-msgref-vector nil | ||
| 565 | "In an Rmail buffer, a vector whose Nth element is a list (N). | ||
| 566 | When expunging renumbers messages, these lists are modified | ||
| 567 | by substituting the new message number into the existing list.") | ||
| 568 | (put 'rmail-msgref-vector 'permanent-local t) | ||
| 569 | |||
| 570 | (defvar rmail-overlay-list nil) | ||
| 571 | (put 'rmail-overlay-list 'permanent-local t) | ||
| 572 | |||
| 573 | ;; These are used by autoloaded rmail-summary. | ||
| 574 | |||
| 575 | (defvar rmail-summary-buffer nil) | ||
| 576 | (put 'rmail-summary-buffer 'permanent-local t) | ||
| 577 | (defvar rmail-summary-vector nil) | ||
| 578 | (put 'rmail-summary-vector 'permanent-local t) | ||
| 579 | |||
| 580 | ;; Rmail buffer swapping variables. | ||
| 581 | |||
| 582 | (defvar rmail-buffer-swapped nil | ||
| 583 | "If non-nil, `rmail-buffer' is swapped with `rmail-view-buffer'.") | ||
| 584 | (make-variable-buffer-local 'rmail-buffer-swapped) | ||
| 585 | |||
| 586 | (defvar rmail-view-buffer nil | ||
| 587 | "Buffer which holds RMAIL message for MIME displaying.") | ||
| 588 | (put 'rmail-view-buffer 'permanent-local t) | ||
| 589 | |||
| 590 | ;; `Sticky' default variables. | ||
| 591 | |||
| 592 | ;; Last individual label specified to a or k. | ||
| 593 | (defvar rmail-last-label nil) | ||
| 594 | |||
| 595 | ;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l. | ||
| 596 | (defvar rmail-last-multi-labels nil) | ||
| 597 | |||
| 598 | (defvar rmail-last-regexp nil) | ||
| 599 | (put 'rmail-last-regexp 'permanent-local t) | ||
| 600 | |||
| 601 | (defcustom rmail-default-file "~/xmail" | ||
| 602 | "*Default file name for \\[rmail-output]." | ||
| 603 | :type 'file | ||
| 604 | :group 'rmail-files) | ||
| 605 | (defcustom rmail-default-body-file "~/mailout" | ||
| 606 | "*Default file name for \\[rmail-output-body-to-file]." | ||
| 607 | :type 'file | ||
| 608 | :group 'rmail-files | ||
| 609 | :version "20.3") | ||
| 610 | |||
| 611 | ;; Mule and MIME related variables. | ||
| 612 | |||
| 613 | ;;;###autoload | ||
| 614 | (defvar rmail-file-coding-system nil | ||
| 615 | "Coding system used in RMAIL file. | ||
| 616 | |||
| 617 | This is set to nil by default.") | ||
| 618 | |||
| 619 | ;;;###autoload | ||
| 620 | (defcustom rmail-enable-mime nil | ||
| 621 | "*If non-nil, RMAIL uses MIME feature. | ||
| 622 | If the value is t, RMAIL automatically shows MIME decoded message. | ||
| 623 | If the value is neither t nor nil, RMAIL does not show MIME decoded message | ||
| 624 | until a user explicitly requires it. | ||
| 625 | |||
| 626 | Even if the value is non-nil, you can't use MIME feature | ||
| 627 | if the feature specified by `rmail-mime-feature' is not available | ||
| 628 | in your session." | ||
| 629 | :type '(choice (const :tag "on" t) | ||
| 630 | (const :tag "off" nil) | ||
| 631 | (other :tag "when asked" ask)) | ||
| 632 | :group 'rmail) | ||
| 633 | |||
| 634 | (defvar rmail-enable-mime-composing nil | ||
| 635 | "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.") | ||
| 636 | |||
| 637 | ;;;###autoload | ||
| 638 | (defvar rmail-show-mime-function nil | ||
| 639 | "Function to show MIME decoded message of RMAIL file. | ||
| 640 | This function is called when `rmail-enable-mime' is non-nil. | ||
| 641 | It is called with no argument.") | ||
| 642 | |||
| 643 | ;;;###autoload | ||
| 644 | (defvar rmail-insert-mime-forwarded-message-function nil | ||
| 645 | "Function to insert a message in MIME format so it can be forwarded. | ||
| 646 | This function is called if `rmail-enable-mime' or | ||
| 647 | `rmail-enable-mime-composing' is non-nil. | ||
| 648 | It is called with one argument FORWARD-BUFFER, which is a | ||
| 649 | buffer containing the message to forward. The current buffer | ||
| 650 | is the outgoing mail buffer.") | ||
| 651 | |||
| 652 | ;;;###autoload | ||
| 653 | (defvar rmail-insert-mime-resent-message-function nil | ||
| 654 | "Function to insert a message in MIME format so it can be resent. | ||
| 655 | This function is called if `rmail-enable-mime' is non-nil. | ||
| 656 | It is called with one argument FORWARD-BUFFER, which is a | ||
| 657 | buffer containing the message to forward. The current buffer | ||
| 658 | is the outgoing mail buffer.") | ||
| 659 | |||
| 660 | ;;;###autoload | ||
| 661 | (defvar rmail-search-mime-message-function nil | ||
| 662 | "Function to check if a regexp matches a MIME message. | ||
| 663 | This function is called if `rmail-enable-mime' is non-nil. | ||
| 664 | It is called with two arguments MSG and REGEXP, where | ||
| 665 | MSG is the message number, REGEXP is the regular expression.") | ||
| 666 | |||
| 667 | ;;;###autoload | ||
| 668 | (defvar rmail-search-mime-header-function nil | ||
| 669 | "Function to check if a regexp matches a header of MIME message. | ||
| 670 | This function is called if `rmail-enable-mime' is non-nil. | ||
| 671 | It is called with three arguments MSG, REGEXP, and LIMIT, where | ||
| 672 | MSG is the message number, | ||
| 673 | REGEXP is the regular expression, | ||
| 674 | LIMIT is the position specifying the end of header.") | ||
| 675 | |||
| 676 | ;;;###autoload | ||
| 677 | (defvar rmail-mime-feature 'rmail-mime | ||
| 678 | "Feature to require to load MIME support in Rmail. | ||
| 679 | When starting Rmail, if `rmail-enable-mime' is non-nil, | ||
| 680 | this feature is required with `require'. | ||
| 681 | |||
| 682 | The default value is `rmail-mime'. This feature is provided by | ||
| 683 | the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.") | ||
| 684 | |||
| 685 | ;;;###autoload | ||
| 686 | (defvar rmail-decode-mime-charset t | ||
| 687 | "*Non-nil means a message is decoded by MIME's charset specification. | ||
| 688 | If this variable is nil, or the message has not MIME specification, | ||
| 689 | the message is decoded as normal way. | ||
| 690 | |||
| 691 | If the variable `rmail-enable-mime' is non-nil, this variables is | ||
| 692 | ignored, and all the decoding work is done by a feature specified by | ||
| 693 | the variable `rmail-mime-feature'.") | ||
| 694 | |||
| 695 | ;;;###autoload | ||
| 696 | (defvar rmail-mime-charset-pattern | ||
| 697 | (concat "^content-type:[ \t]*text/plain;" | ||
| 698 | "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" | ||
| 699 | "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?") | ||
| 700 | "Regexp to match MIME-charset specification in a header of message. | ||
| 701 | The first parenthesized expression should match the MIME-charset name.") | ||
| 702 | |||
| 703 | |||
| 704 | ;;; Regexp matching the delimiter of messages in UNIX mail format | ||
| 705 | ;;; (UNIX From lines), minus the initial ^. Note that if you change | ||
| 706 | ;;; this expression, you must change the code in rmail-nuke-pinhead-header | ||
| 707 | ;;; that knows the exact ordering of the \\( \\) subexpressions. | ||
| 708 | (defvar rmail-unix-mail-delimiter | ||
| 709 | (let ((time-zone-regexp | ||
| 710 | (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" | ||
| 711 | "\\|[-+]?[0-9][0-9][0-9][0-9]" | ||
| 712 | "\\|" | ||
| 713 | "\\) *"))) | ||
| 714 | (concat | ||
| 715 | "From " | ||
| 716 | |||
| 717 | ;; Many things can happen to an RFC 822 mailbox before it is put into | ||
| 718 | ;; a `From' line. The leading phrase can be stripped, e.g. | ||
| 719 | ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. | ||
| 720 | ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF | ||
| 721 | ;; can be removed, e.g. | ||
| 722 | ;; From: joe@y.z (Joe K | ||
| 723 | ;; User) | ||
| 724 | ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and | ||
| 725 | ;; From: Joe User | ||
| 726 | ;; <joe@y.z> | ||
| 727 | ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. | ||
| 728 | ;; The mailbox can be removed or be replaced by white space, e.g. | ||
| 729 | ;; From: "Joe User"{space}{tab} | ||
| 730 | ;; <joe@y.z> | ||
| 731 | ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', | ||
| 732 | ;; where {space} and {tab} represent the Ascii space and tab characters. | ||
| 733 | ;; We want to match the results of any of these manglings. | ||
| 734 | ;; The following regexp rejects names whose first characters are | ||
| 735 | ;; obviously bogus, but after that anything goes. | ||
| 736 | "\\([^\0-\b\n-\r\^?].*\\)? " | ||
| 737 | |||
| 738 | ;; The time the message was sent. | ||
| 739 | "\\([^\0-\r \^?]+\\) +" ; day of the week | ||
| 740 | "\\([^\0-\r \^?]+\\) +" ; month | ||
| 741 | "\\([0-3]?[0-9]\\) +" ; day of month | ||
| 742 | "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day | ||
| 743 | |||
| 744 | ;; Perhaps a time zone, specified by an abbreviation, or by a | ||
| 745 | ;; numeric offset. | ||
| 746 | time-zone-regexp | ||
| 747 | |||
| 748 | ;; The year. | ||
| 749 | " \\([0-9][0-9]+\\) *" | ||
| 750 | |||
| 751 | ;; On some systems the time zone can appear after the year, too. | ||
| 752 | time-zone-regexp | ||
| 753 | |||
| 754 | ;; Old uucp cruft. | ||
| 755 | "\\(remote from .*\\)?" | ||
| 756 | |||
| 757 | "\n")) | ||
| 758 | nil) | ||
| 759 | |||
| 760 | (defvar rmail-font-lock-keywords | ||
| 761 | ;; These are all matched case-insensitively. | ||
| 762 | (eval-when-compile | ||
| 763 | (let* ((cite-chars "[>|}]") | ||
| 764 | (cite-prefix "a-z") | ||
| 765 | (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) | ||
| 766 | (list '("^\\(From\\|Sender\\|Resent-From\\):" | ||
| 767 | . 'rmail-header-name) | ||
| 768 | '("^Reply-To:.*$" . 'rmail-header-name) | ||
| 769 | '("^Subject:" . 'rmail-header-name) | ||
| 770 | '("^X-Spam-Status:" . 'rmail-header-name) | ||
| 771 | '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" | ||
| 772 | . 'rmail-header-name) | ||
| 773 | ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. | ||
| 774 | `(,cite-chars | ||
| 775 | (,(concat "\\=[ \t]*" | ||
| 776 | "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" | ||
| 777 | "\\(" cite-chars "[ \t]*\\)\\)+\\)" | ||
| 778 | "\\(.*\\)") | ||
| 779 | (beginning-of-line) (end-of-line) | ||
| 780 | (1 font-lock-comment-delimiter-face nil t) | ||
| 781 | (5 font-lock-comment-face nil t))) | ||
| 782 | '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" | ||
| 783 | . 'rmail-header-name)))) | ||
| 784 | "Additional expressions to highlight in Rmail mode.") | ||
| 785 | |||
| 786 | ;; Perform BODY in the summary buffer | ||
| 787 | ;; in such a way that its cursor is properly updated in its own window. | ||
| 788 | (defmacro rmail-select-summary (&rest body) | ||
| 789 | `(let ((total rmail-total-messages)) | ||
| 790 | (if (rmail-summary-displayed) | ||
| 791 | (let ((window (selected-window))) | ||
| 792 | (save-excursion | ||
| 793 | (unwind-protect | ||
| 794 | (progn | ||
| 795 | (pop-to-buffer rmail-summary-buffer) | ||
| 796 | ;; rmail-total-messages is a buffer-local var | ||
| 797 | ;; in the rmail buffer. | ||
| 798 | ;; This way we make it available for the body | ||
| 799 | ;; even tho the rmail buffer is not current. | ||
| 800 | (let ((rmail-total-messages total)) | ||
| 801 | ,@body)) | ||
| 802 | (select-window window)))) | ||
| 803 | (save-excursion | ||
| 804 | (set-buffer rmail-summary-buffer) | ||
| 805 | (let ((rmail-total-messages total)) | ||
| 806 | ,@body))) | ||
| 807 | (rmail-maybe-display-summary))) | ||
| 808 | |||
| 809 | ;;;; *** Rmail Mode *** | ||
| 810 | |||
| 811 | ;; This variable is dynamically bound. The defvar is here to placate | ||
| 812 | ;; the byte compiler. | ||
| 813 | |||
| 814 | (defvar rmail-enable-multibyte nil) | ||
| 815 | |||
| 816 | |||
| 817 | (defun rmail-require-mime-maybe () | ||
| 818 | "Require `rmail-mime-feature' if that is non-nil. | ||
| 819 | Signal an error and set `rmail-mime-feature' to nil if the feature | ||
| 820 | isn't provided." | ||
| 821 | (when rmail-enable-mime | ||
| 822 | (condition-case err | ||
| 823 | (require rmail-mime-feature) | ||
| 824 | (error | ||
| 825 | (display-warning | ||
| 826 | 'rmail | ||
| 827 | (format "Although MIME support is requested | ||
| 828 | by setting `rmail-enable-mime' to non-nil, the required feature | ||
| 829 | `%s' (the value of `rmail-mime-feature') | ||
| 830 | is not available in the current session. | ||
| 831 | So, the MIME support is turned off for the moment." | ||
| 832 | rmail-mime-feature) | ||
| 833 | :warning) | ||
| 834 | (setq rmail-enable-mime nil))))) | ||
| 835 | |||
| 836 | |||
| 837 | ;;;###autoload | ||
| 838 | (defun rmail (&optional file-name-arg) | ||
| 839 | "Read and edit incoming mail. | ||
| 840 | Moves messages into file named by `rmail-file-name' (a babyl format file) | ||
| 841 | and edits that file in RMAIL Mode. | ||
| 842 | Type \\[describe-mode] once editing that file, for a list of RMAIL commands. | ||
| 843 | |||
| 844 | May be called with file name as argument; then performs rmail editing on | ||
| 845 | that file, but does not copy any new mail into the file. | ||
| 846 | Interactively, if you supply a prefix argument, then you | ||
| 847 | have a chance to specify a file name with the minibuffer. | ||
| 848 | |||
| 849 | If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." | ||
| 850 | (interactive (if current-prefix-arg | ||
| 851 | (list (read-file-name "Run rmail on RMAIL file: ")))) | ||
| 852 | (rmail-require-mime-maybe) | ||
| 853 | (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) | ||
| 854 | ;; Use find-buffer-visiting, not get-file-buffer, for those users | ||
| 855 | ;; who have find-file-visit-truename set to t. | ||
| 856 | (existed (find-buffer-visiting file-name)) | ||
| 857 | run-mail-hook mail-buf msg-shown) | ||
| 858 | ;; Determine if an existing mail file has been changed behind the | ||
| 859 | ;; scene... | ||
| 860 | (if (and existed (not (verify-visited-file-modtime existed))) | ||
| 861 | ;; The mail file has been changed. Revisit it and reset the | ||
| 862 | ;; message state variables when in rmail mode. | ||
| 863 | (progn | ||
| 864 | (find-file file-name) | ||
| 865 | (when (and (verify-visited-file-modtime existed) | ||
| 866 | (eq major-mode 'rmail-mode)) | ||
| 867 | (rmail-set-message-counters))) | ||
| 868 | ;; The mail file is either unchanged or not visited. Visit it. | ||
| 869 | (switch-to-buffer | ||
| 870 | (let ((enable-local-variables nil)) | ||
| 871 | (find-file-noselect file-name)))) | ||
| 872 | ;; Insure that the collection and view buffers are in sync and | ||
| 873 | ;; insure that a message is not being edited. | ||
| 874 | (if (eq major-mode 'rmail-mode) | ||
| 875 | (rmail-swap-buffers-maybe)) | ||
| 876 | (if (eq major-mode 'rmail-edit-mode) | ||
| 877 | (error "Exit Rmail Edit mode before getting new mail")) | ||
| 878 | (or (and existed (> (buffer-size) 0)) | ||
| 879 | (setq run-mail-hook t)) | ||
| 880 | ;; Insure that the Rmail file is in mbox format, the buffer is in | ||
| 881 | ;; Rmail mode and has been scanned to find all the messages | ||
| 882 | ;; (setting the global message variables in the process). | ||
| 883 | (rmail-convert-file-maybe) | ||
| 884 | (unless (eq major-mode 'rmail-mode) | ||
| 885 | (rmail-mode-2)) | ||
| 886 | (goto-char (point-max)) | ||
| 887 | (rmail-maybe-set-message-counters) | ||
| 888 | (setq mail-buf rmail-buffer) | ||
| 889 | ;; Show the first unread message and process summary mode. | ||
| 890 | (unwind-protect | ||
| 891 | ;; Only get new mail when there is not a file name argument. | ||
| 892 | (unless file-name-arg | ||
| 893 | (rmail-get-new-mail)) | ||
| 894 | (progn | ||
| 895 | (set-buffer mail-buf) | ||
| 896 | (rmail-show-message-maybe (rmail-first-unseen-message)) | ||
| 897 | (if rmail-display-summary (rmail-summary)) | ||
| 898 | (rmail-construct-io-menu) | ||
| 899 | (if run-mail-hook | ||
| 900 | (run-hooks 'rmail-mode-hook)))))) | ||
| 901 | |||
| 902 | (defun rmail-convert-file-maybe () | ||
| 903 | "Determine if the file needs to be converted to mbox format." | ||
| 904 | (widen) | ||
| 905 | (goto-char (point-min)) | ||
| 906 | ;; Detect previous Babyl format files. | ||
| 907 | (cond ((looking-at "BABYL OPTIONS:") | ||
| 908 | ;; The file is Babyl version 5. Use unrmail to convert | ||
| 909 | ;; it. | ||
| 910 | (rmail-convert-babyl-to-mbox)) | ||
| 911 | ((looking-at "Version: 5\n") | ||
| 912 | ;; Losing babyl file made by old version of Rmail. Fix the | ||
| 913 | ;; babyl file header and use unrmail to convert to mbox | ||
| 914 | ;; format. | ||
| 915 | (let ((buffer-read-only nil)) | ||
| 916 | (insert "BABYL OPTIONS: -*- rmail -*-\n") | ||
| 917 | (rmail-convert-babyl-to-mbox))) | ||
| 918 | ((equal (point-min) (point-max)) | ||
| 919 | (message "Empty Rmail file.")) | ||
| 920 | ((looking-at "From ")) | ||
| 921 | (t (error "Invalid mbox file")))) | ||
| 922 | |||
| 923 | (defun rmail-error-bad-format (&optional msgnum) | ||
| 924 | "Report that the buffer is not in the mbox file format. | ||
| 925 | MSGNUM, if present, indicates the malformed message." | ||
| 926 | (if msgnum | ||
| 927 | (error "Message %d is not a valid RFC2822 message" msgnum) | ||
| 928 | (error "Message is not a valid RFC2822 message"))) | ||
| 929 | |||
| 930 | (defun rmail-convert-babyl-to-mbox () | ||
| 931 | "Convert the mail file from Babyl version 5 to mbox. | ||
| 932 | This function also reinitializes local variables used by Rmail." | ||
| 933 | (let ((old-file (make-temp-file "rmail")) | ||
| 934 | (new-file (make-temp-file "rmail"))) | ||
| 935 | (unwind-protect | ||
| 936 | (progn | ||
| 937 | (kill-all-local-variables) | ||
| 938 | (write-region (point-min) (point-max) old-file) | ||
| 939 | (unrmail old-file new-file) | ||
| 940 | (message "Replacing BABYL format with mbox format...") | ||
| 941 | (let ((inhibit-read-only t)) | ||
| 942 | (erase-buffer) | ||
| 943 | (insert-file-contents-literally new-file) | ||
| 944 | (rmail-mode-1) | ||
| 945 | (rmail-perm-variables) | ||
| 946 | (rmail-variables) | ||
| 947 | (goto-char (point-max)) | ||
| 948 | (rmail-set-message-counters)) | ||
| 949 | (message "Replacing BABYL format with mbox format...done")) | ||
| 950 | (delete-file old-file) | ||
| 951 | (delete-file new-file)))) | ||
| 952 | |||
| 953 | (defun rmail-get-coding-system () | ||
| 954 | "Return a suitable coding system to use for the current mail message. | ||
| 955 | The buffer is expected to be narrowed to just the header of the message." | ||
| 956 | (let ((content-type-header (mail-fetch-field "content-type")) | ||
| 957 | separator) | ||
| 958 | (save-excursion | ||
| 959 | (setq separator (search-forward "\n\n"))) | ||
| 960 | (if (and content-type-header | ||
| 961 | (string-match rmail-mime-charset-pattern content-type-header)) | ||
| 962 | (substring content-type-header (match-beginning 1) (match-end 1)) | ||
| 963 | 'undecided))) | ||
| 964 | |||
| 965 | ;;; Set up Rmail mode keymaps | ||
| 966 | |||
| 967 | (defvar rmail-mode-map nil) | ||
| 968 | (if rmail-mode-map | ||
| 969 | nil | ||
| 970 | (setq rmail-mode-map (make-keymap)) | ||
| 971 | (suppress-keymap rmail-mode-map) | ||
| 972 | (define-key rmail-mode-map "a" 'rmail-add-label) | ||
| 973 | (define-key rmail-mode-map "b" 'rmail-bury) | ||
| 974 | (define-key rmail-mode-map "c" 'rmail-continue) | ||
| 975 | (define-key rmail-mode-map "d" 'rmail-delete-forward) | ||
| 976 | (define-key rmail-mode-map "\C-d" 'rmail-delete-backward) | ||
| 977 | (define-key rmail-mode-map "e" 'rmail-edit-current-message) | ||
| 978 | (define-key rmail-mode-map "f" 'rmail-forward) | ||
| 979 | (define-key rmail-mode-map "g" 'rmail-get-new-mail) | ||
| 980 | (define-key rmail-mode-map "h" 'rmail-summary) | ||
| 981 | (define-key rmail-mode-map "i" 'rmail-input) | ||
| 982 | (define-key rmail-mode-map "j" 'rmail-show-message-maybe) | ||
| 983 | (define-key rmail-mode-map "k" 'rmail-kill-label) | ||
| 984 | (define-key rmail-mode-map "l" 'rmail-summary-by-labels) | ||
| 985 | (define-key rmail-mode-map "\e\C-h" 'rmail-summary) | ||
| 986 | (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) | ||
| 987 | (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) | ||
| 988 | (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp) | ||
| 989 | (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic) | ||
| 990 | (define-key rmail-mode-map "m" 'rmail-mail) | ||
| 991 | (define-key rmail-mode-map "\em" 'rmail-retry-failure) | ||
| 992 | (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) | ||
| 993 | (define-key rmail-mode-map "\en" 'rmail-next-message) | ||
| 994 | (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) | ||
| 995 | (define-key rmail-mode-map "o" 'rmail-output) | ||
| 996 | (define-key rmail-mode-map "\C-o" 'rmail-output-as-seen) | ||
| 997 | (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) | ||
| 998 | (define-key rmail-mode-map "\ep" 'rmail-previous-message) | ||
| 999 | (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) | ||
| 1000 | (define-key rmail-mode-map "q" 'rmail-quit) | ||
| 1001 | (define-key rmail-mode-map "r" 'rmail-reply) | ||
| 1002 | ;; I find I can't live without the default M-r command -- rms. | ||
| 1003 | ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) | ||
| 1004 | (define-key rmail-mode-map "s" 'rmail-expunge-and-save) | ||
| 1005 | (define-key rmail-mode-map "\es" 'rmail-search) | ||
| 1006 | (define-key rmail-mode-map "t" 'rmail-toggle-header) | ||
| 1007 | (define-key rmail-mode-map "u" 'rmail-undelete-previous-message) | ||
| 1008 | (define-key rmail-mode-map "w" 'rmail-output-body-to-file) | ||
| 1009 | (define-key rmail-mode-map "\C-c\C-w" 'rmail-widen) | ||
| 1010 | (define-key rmail-mode-map "x" 'rmail-expunge) | ||
| 1011 | (define-key rmail-mode-map "." 'rmail-beginning-of-message) | ||
| 1012 | (define-key rmail-mode-map "/" 'rmail-end-of-message) | ||
| 1013 | (define-key rmail-mode-map "<" 'rmail-first-message) | ||
| 1014 | (define-key rmail-mode-map ">" 'rmail-last-message) | ||
| 1015 | (define-key rmail-mode-map " " 'scroll-up) | ||
| 1016 | (define-key rmail-mode-map "\177" 'scroll-down) | ||
| 1017 | (define-key rmail-mode-map "?" 'describe-mode) | ||
| 1018 | (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) | ||
| 1019 | (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) | ||
| 1020 | (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) | ||
| 1021 | (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) | ||
| 1022 | (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) | ||
| 1023 | (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) | ||
| 1024 | (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) | ||
| 1025 | (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) | ||
| 1026 | (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) | ||
| 1027 | ) | ||
| 1028 | |||
| 1029 | (define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) | ||
| 1030 | |||
| 1031 | (define-key rmail-mode-map [menu-bar classify] | ||
| 1032 | (cons "Classify" (make-sparse-keymap "Classify"))) | ||
| 1033 | |||
| 1034 | (define-key rmail-mode-map [menu-bar classify input-menu] | ||
| 1035 | nil) | ||
| 1036 | |||
| 1037 | (define-key rmail-mode-map [menu-bar classify output-menu] | ||
| 1038 | nil) | ||
| 1039 | |||
| 1040 | (define-key rmail-mode-map [menu-bar classify output-body] | ||
| 1041 | '("Output body to file..." . rmail-output-body-to-file)) | ||
| 1042 | |||
| 1043 | (define-key rmail-mode-map [menu-bar classify output-inbox] | ||
| 1044 | '("Output..." . rmail-output)) | ||
| 1045 | |||
| 1046 | (define-key rmail-mode-map [menu-bar classify output] | ||
| 1047 | '("Output as seen..." . rmail-output-as-seen)) | ||
| 1048 | |||
| 1049 | (define-key rmail-mode-map [menu-bar classify kill-label] | ||
| 1050 | '("Kill Label..." . rmail-kill-label)) | ||
| 1051 | |||
| 1052 | (define-key rmail-mode-map [menu-bar classify add-label] | ||
| 1053 | '("Add Label..." . rmail-add-label)) | ||
| 1054 | |||
| 1055 | (define-key rmail-mode-map [menu-bar summary] | ||
| 1056 | (cons "Summary" (make-sparse-keymap "Summary"))) | ||
| 1057 | |||
| 1058 | (define-key rmail-mode-map [menu-bar summary senders] | ||
| 1059 | '("By Senders..." . rmail-summary-by-senders)) | ||
| 1060 | |||
| 1061 | (define-key rmail-mode-map [menu-bar summary labels] | ||
| 1062 | '("By Labels..." . rmail-summary-by-labels)) | ||
| 1063 | |||
| 1064 | (define-key rmail-mode-map [menu-bar summary recipients] | ||
| 1065 | '("By Recipients..." . rmail-summary-by-recipients)) | ||
| 1066 | |||
| 1067 | (define-key rmail-mode-map [menu-bar summary topic] | ||
| 1068 | '("By Topic..." . rmail-summary-by-topic)) | ||
| 1069 | |||
| 1070 | (define-key rmail-mode-map [menu-bar summary regexp] | ||
| 1071 | '("By Regexp..." . rmail-summary-by-regexp)) | ||
| 1072 | |||
| 1073 | (define-key rmail-mode-map [menu-bar summary all] | ||
| 1074 | '("All" . rmail-summary)) | ||
| 1075 | |||
| 1076 | (define-key rmail-mode-map [menu-bar mail] | ||
| 1077 | (cons "Mail" (make-sparse-keymap "Mail"))) | ||
| 1078 | |||
| 1079 | (define-key rmail-mode-map [menu-bar mail rmail-get-new-mail] | ||
| 1080 | '("Get New Mail" . rmail-get-new-mail)) | ||
| 1081 | |||
| 1082 | (define-key rmail-mode-map [menu-bar mail lambda] | ||
| 1083 | '("----")) | ||
| 1084 | |||
| 1085 | (define-key rmail-mode-map [menu-bar mail continue] | ||
| 1086 | '("Continue" . rmail-continue)) | ||
| 1087 | |||
| 1088 | (define-key rmail-mode-map [menu-bar mail resend] | ||
| 1089 | '("Re-send..." . rmail-resend)) | ||
| 1090 | |||
| 1091 | (define-key rmail-mode-map [menu-bar mail forward] | ||
| 1092 | '("Forward" . rmail-forward)) | ||
| 1093 | |||
| 1094 | (define-key rmail-mode-map [menu-bar mail retry] | ||
| 1095 | '("Retry" . rmail-retry-failure)) | ||
| 1096 | |||
| 1097 | (define-key rmail-mode-map [menu-bar mail reply] | ||
| 1098 | '("Reply" . rmail-reply)) | ||
| 1099 | |||
| 1100 | (define-key rmail-mode-map [menu-bar mail mail] | ||
| 1101 | '("Mail" . rmail-mail)) | ||
| 1102 | |||
| 1103 | (define-key rmail-mode-map [menu-bar delete] | ||
| 1104 | (cons "Delete" (make-sparse-keymap "Delete"))) | ||
| 1105 | |||
| 1106 | (define-key rmail-mode-map [menu-bar delete expunge/save] | ||
| 1107 | '("Expunge/Save" . rmail-expunge-and-save)) | ||
| 1108 | |||
| 1109 | (define-key rmail-mode-map [menu-bar delete expunge] | ||
| 1110 | '("Expunge" . rmail-expunge)) | ||
| 1111 | |||
| 1112 | (define-key rmail-mode-map [menu-bar delete undelete] | ||
| 1113 | '("Undelete" . rmail-undelete-previous-message)) | ||
| 1114 | |||
| 1115 | (define-key rmail-mode-map [menu-bar delete delete] | ||
| 1116 | '("Delete" . rmail-delete-forward)) | ||
| 1117 | |||
| 1118 | (define-key rmail-mode-map [menu-bar move] | ||
| 1119 | (cons "Move" (make-sparse-keymap "Move"))) | ||
| 1120 | |||
| 1121 | (define-key rmail-mode-map [menu-bar move search-back] | ||
| 1122 | '("Search Back..." . rmail-search-backwards)) | ||
| 1123 | |||
| 1124 | (define-key rmail-mode-map [menu-bar move search] | ||
| 1125 | '("Search..." . rmail-search)) | ||
| 1126 | |||
| 1127 | (define-key rmail-mode-map [menu-bar move previous] | ||
| 1128 | '("Previous Nondeleted" . rmail-previous-undeleted-message)) | ||
| 1129 | |||
| 1130 | (define-key rmail-mode-map [menu-bar move next] | ||
| 1131 | '("Next Nondeleted" . rmail-next-undeleted-message)) | ||
| 1132 | |||
| 1133 | (define-key rmail-mode-map [menu-bar move last] | ||
| 1134 | '("Last" . rmail-last-message)) | ||
| 1135 | |||
| 1136 | (define-key rmail-mode-map [menu-bar move first] | ||
| 1137 | '("First" . rmail-first-message)) | ||
| 1138 | |||
| 1139 | (define-key rmail-mode-map [menu-bar move previous] | ||
| 1140 | '("Previous" . rmail-previous-message)) | ||
| 1141 | |||
| 1142 | (define-key rmail-mode-map [menu-bar move next] | ||
| 1143 | '("Next" . rmail-next-message)) | ||
| 1144 | |||
| 1145 | ;; Rmail toolbar | ||
| 1146 | (defvar rmail-tool-bar-map | ||
| 1147 | (let ((map (make-sparse-keymap))) | ||
| 1148 | (tool-bar-local-item-from-menu 'rmail-get-new-mail "mail/inbox" | ||
| 1149 | map rmail-mode-map) | ||
| 1150 | (tool-bar-local-item-from-menu 'rmail-next-undeleted-message "right-arrow" | ||
| 1151 | map rmail-mode-map) | ||
| 1152 | (tool-bar-local-item-from-menu 'rmail-previous-undeleted-message "left-arrow" | ||
| 1153 | map rmail-mode-map) | ||
| 1154 | (tool-bar-local-item-from-menu 'rmail-search "search" | ||
| 1155 | map rmail-mode-map) | ||
| 1156 | (tool-bar-local-item-from-menu 'rmail-input "open" | ||
| 1157 | map rmail-mode-map) | ||
| 1158 | (tool-bar-local-item-from-menu 'rmail-mail "mail/compose" | ||
| 1159 | map rmail-mode-map) | ||
| 1160 | (tool-bar-local-item-from-menu 'rmail-reply "mail/reply-all" | ||
| 1161 | map rmail-mode-map) | ||
| 1162 | (tool-bar-local-item-from-menu 'rmail-forward "mail/forward" | ||
| 1163 | map rmail-mode-map) | ||
| 1164 | (tool-bar-local-item-from-menu 'rmail-delete-forward "close" | ||
| 1165 | map rmail-mode-map) | ||
| 1166 | (tool-bar-local-item-from-menu 'rmail-output "mail/move" | ||
| 1167 | map rmail-mode-map) | ||
| 1168 | (tool-bar-local-item-from-menu 'rmail-output-body-to-file "mail/save" | ||
| 1169 | map rmail-mode-map) | ||
| 1170 | (tool-bar-local-item-from-menu 'rmail-expunge "delete" | ||
| 1171 | map rmail-mode-map) | ||
| 1172 | map)) | ||
| 1173 | |||
| 1174 | |||
| 1175 | |||
| 1176 | ;; Rmail mode is suitable only for specially formatted data. | ||
| 1177 | (put 'rmail-mode 'mode-class 'special) | ||
| 1178 | |||
| 1179 | (defun rmail-mode-kill-summary () | ||
| 1180 | (if rmail-summary-buffer (kill-buffer rmail-summary-buffer))) | ||
| 1181 | |||
| 1182 | ;;;###autoload | ||
| 1183 | (defun rmail-mode () | ||
| 1184 | "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files. | ||
| 1185 | All normal editing commands are turned off. | ||
| 1186 | Instead, these commands are available: | ||
| 1187 | |||
| 1188 | \\[rmail-beginning-of-message] Move point to front of this message. | ||
| 1189 | \\[rmail-end-of-message] Move point to bottom of this message. | ||
| 1190 | \\[scroll-up] Scroll to next screen of this message. | ||
| 1191 | \\[scroll-down] Scroll to previous screen of this message. | ||
| 1192 | \\[rmail-next-undeleted-message] Move to Next non-deleted message. | ||
| 1193 | \\[rmail-previous-undeleted-message] Move to Previous non-deleted message. | ||
| 1194 | \\[rmail-next-message] Move to Next message whether deleted or not. | ||
| 1195 | \\[rmail-previous-message] Move to Previous message whether deleted or not. | ||
| 1196 | \\[rmail-first-message] Move to the first message in Rmail file. | ||
| 1197 | \\[rmail-last-message] Move to the last message in Rmail file. | ||
| 1198 | \\[rmail-show-message-maybe] Jump to message specified by numeric position in file. | ||
| 1199 | \\[rmail-search] Search for string and show message it is found in. | ||
| 1200 | \\[rmail-delete-forward] Delete this message, move to next nondeleted. | ||
| 1201 | \\[rmail-delete-backward] Delete this message, move to previous nondeleted. | ||
| 1202 | \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages | ||
| 1203 | till a deleted message is found. | ||
| 1204 | \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. | ||
| 1205 | \\[rmail-expunge] Expunge deleted messages. | ||
| 1206 | \\[rmail-expunge-and-save] Expunge and save the file. | ||
| 1207 | \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. | ||
| 1208 | \\[save-buffer] Save without expunging. | ||
| 1209 | \\[rmail-get-new-mail] Move new mail from system spool directory into this file. | ||
| 1210 | \\[rmail-mail] Mail a message (same as \\[mail-other-window]). | ||
| 1211 | \\[rmail-continue] Continue composing outgoing message started before. | ||
| 1212 | \\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields. | ||
| 1213 | \\[rmail-retry-failure] Send this message again. Used on a mailer failure message. | ||
| 1214 | \\[rmail-forward] Forward this message to another user. | ||
| 1215 | \\[rmail-output] Output (append) this message to another mail file. | ||
| 1216 | \\[rmail-output-as-seen] Output (append) this message to file as it's displayed. | ||
| 1217 | \\[rmail-output-body-to-file] Save message body to a file. Default filename comes from Subject line. | ||
| 1218 | \\[rmail-input] Input Rmail file. Run Rmail on that file. | ||
| 1219 | \\[rmail-add-label] Add label to message. It will be displayed in the mode line. | ||
| 1220 | \\[rmail-kill-label] Kill label. Remove a label from current message. | ||
| 1221 | \\[rmail-next-labeled-message] Move to Next message with specified label | ||
| 1222 | (label defaults to last one specified). | ||
| 1223 | Standard labels: filed, unseen, answered, forwarded, deleted. | ||
| 1224 | Any other label is present only if you add it with \\[rmail-add-label]. | ||
| 1225 | \\[rmail-previous-labeled-message] Move to Previous message with specified label | ||
| 1226 | \\[rmail-summary] Show headers buffer, with a one line summary of each message. | ||
| 1227 | \\[rmail-summary-by-labels] Summarize only messages with particular label(s). | ||
| 1228 | \\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). | ||
| 1229 | \\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). | ||
| 1230 | \\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). | ||
| 1231 | \\[rmail-toggle-header] Toggle display of complete header." | ||
| 1232 | (interactive) | ||
| 1233 | (let ((finding-rmail-file (not (eq major-mode 'rmail-mode)))) | ||
| 1234 | (rmail-mode-2) | ||
| 1235 | (when (and finding-rmail-file | ||
| 1236 | (null coding-system-for-read) | ||
| 1237 | default-enable-multibyte-characters) | ||
| 1238 | (let ((rmail-enable-multibyte t)) | ||
| 1239 | (rmail-require-mime-maybe) | ||
| 1240 | (rmail-convert-file-maybe) | ||
| 1241 | (goto-char (point-max)) | ||
| 1242 | (set-buffer-multibyte t))) | ||
| 1243 | (rmail-set-message-counters) | ||
| 1244 | (rmail-show-message-maybe rmail-total-messages) | ||
| 1245 | (when finding-rmail-file | ||
| 1246 | (when rmail-display-summary | ||
| 1247 | (rmail-summary)) | ||
| 1248 | (rmail-construct-io-menu)) | ||
| 1249 | (run-mode-hooks 'rmail-mode-hook))) | ||
| 1250 | |||
| 1251 | (defun rmail-mode-2 () | ||
| 1252 | (kill-all-local-variables) | ||
| 1253 | (rmail-mode-1) | ||
| 1254 | (rmail-perm-variables) | ||
| 1255 | (rmail-variables)) | ||
| 1256 | |||
| 1257 | (defun rmail-mode-1 () | ||
| 1258 | (setq major-mode 'rmail-mode) | ||
| 1259 | (setq mode-name "RMAIL") | ||
| 1260 | (setq buffer-read-only t) | ||
| 1261 | ;; No need to auto save RMAIL files in normal circumstances | ||
| 1262 | ;; because they contain no info except attribute changes | ||
| 1263 | ;; and deletion of messages. | ||
| 1264 | ;; The one exception is when messages are copied into another mbox buffer. | ||
| 1265 | ;; rmail-output enables auto save when you do that. | ||
| 1266 | (setq buffer-auto-save-file-name nil) | ||
| 1267 | (use-local-map rmail-mode-map) | ||
| 1268 | (set-syntax-table text-mode-syntax-table) | ||
| 1269 | (setq local-abbrev-table text-mode-abbrev-table) | ||
| 1270 | ;; Functions to support buffer swapping: | ||
| 1271 | (add-hook 'write-region-annotate-functions | ||
| 1272 | 'rmail-write-region-annotate nil t) | ||
| 1273 | (add-hook 'kill-buffer-hook 'rmail-mode-kill-buffer-hook nil t) | ||
| 1274 | (add-hook 'change-major-mode-hook 'rmail-change-major-mode-hook nil t)) | ||
| 1275 | |||
| 1276 | (defun rmail-generate-viewer-buffer () | ||
| 1277 | "Return a reusable buffer suitable for viewing messages. | ||
| 1278 | Create the buffer if necessary." | ||
| 1279 | (let* ((suffix (file-name-nondirectory (or buffer-file-name (buffer-name)))) | ||
| 1280 | (name (format " *message-viewer %s*" suffix)) | ||
| 1281 | (buf (get-buffer name))) | ||
| 1282 | (unless buf | ||
| 1283 | (generate-new-buffer name)))) | ||
| 1284 | |||
| 1285 | (defun rmail-change-major-mode-hook () | ||
| 1286 | ;; Bring the actual Rmail messages back into the main buffer. | ||
| 1287 | (when (rmail-buffers-swapped-p) | ||
| 1288 | (setq rmail-buffer-swapped nil) | ||
| 1289 | (let ((modp (buffer-modified-p))) | ||
| 1290 | (buffer-swap-text rmail-view-buffer) | ||
| 1291 | (set-buffer-modified-p modp)))) | ||
| 1292 | |||
| 1293 | (defun rmail-buffers-swapped-p () | ||
| 1294 | "Return non-nil if the message collection is in `rmail-view-buffer'." | ||
| 1295 | ;; This is analogous to tar-data-swapped-p in tar-mode.el. | ||
| 1296 | (and (buffer-live-p rmail-view-buffer) | ||
| 1297 | rmail-buffer-swapped)) | ||
| 1298 | |||
| 1299 | (defun rmail-swap-buffers-maybe () | ||
| 1300 | "Determine if the Rmail buffer is showing a message. | ||
| 1301 | If so restore the actual mbox message collection." | ||
| 1302 | (with-current-buffer rmail-buffer | ||
| 1303 | (when (rmail-buffers-swapped-p) | ||
| 1304 | (let ((modp (buffer-modified-p))) | ||
| 1305 | (buffer-swap-text rmail-view-buffer) | ||
| 1306 | (set-buffer-modified-p modp)) | ||
| 1307 | (setq rmail-buffer-swapped nil)))) | ||
| 1308 | |||
| 1309 | (defun rmail-mode-kill-buffer-hook () | ||
| 1310 | (if (buffer-live-p rmail-view-buffer) (kill-buffer rmail-view-buffer))) | ||
| 1311 | |||
| 1312 | ;; Set up the permanent locals associated with an Rmail file. | ||
| 1313 | (defun rmail-perm-variables () | ||
| 1314 | (make-local-variable 'rmail-last-regexp) | ||
| 1315 | (make-local-variable 'rmail-deleted-vector) | ||
| 1316 | (make-local-variable 'rmail-buffer) | ||
| 1317 | (setq rmail-buffer (current-buffer)) | ||
| 1318 | (set-buffer-multibyte nil) | ||
| 1319 | (make-local-variable 'rmail-view-buffer) | ||
| 1320 | (save-excursion | ||
| 1321 | (setq rmail-view-buffer (rmail-generate-viewer-buffer)) | ||
| 1322 | (set-buffer rmail-view-buffer) | ||
| 1323 | (setq buffer-undo-list t) | ||
| 1324 | (set-buffer-multibyte t)) | ||
| 1325 | (make-local-variable 'rmail-summary-buffer) | ||
| 1326 | (make-local-variable 'rmail-summary-vector) | ||
| 1327 | (make-local-variable 'rmail-current-message) | ||
| 1328 | (make-local-variable 'rmail-total-messages) | ||
| 1329 | (setq rmail-total-messages 0) | ||
| 1330 | (make-local-variable 'rmail-overlay-list) | ||
| 1331 | (setq rmail-overlay-list nil) | ||
| 1332 | (make-local-variable 'rmail-message-vector) | ||
| 1333 | (make-local-variable 'rmail-msgref-vector) | ||
| 1334 | (make-local-variable 'rmail-inbox-list) | ||
| 1335 | ;; Provide default set of inboxes for primary mail file ~/RMAIL. | ||
| 1336 | (and (null rmail-inbox-list) | ||
| 1337 | (or (equal buffer-file-name (expand-file-name rmail-file-name)) | ||
| 1338 | (equal buffer-file-truename | ||
| 1339 | (abbreviate-file-name (file-truename rmail-file-name)))) | ||
| 1340 | (setq rmail-inbox-list | ||
| 1341 | (or rmail-primary-inbox-list | ||
| 1342 | (list (or (getenv "MAIL") | ||
| 1343 | (concat rmail-spool-directory | ||
| 1344 | (user-login-name))))))) | ||
| 1345 | (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map)) | ||
| 1346 | |||
| 1347 | ;; Set up the non-permanent locals associated with Rmail mode. | ||
| 1348 | (defun rmail-variables () | ||
| 1349 | ;; Turn off undo. We turn it back on in rmail-edit. | ||
| 1350 | (setq buffer-undo-list t) | ||
| 1351 | ;; Don't let a local variables list in a message cause confusion. | ||
| 1352 | (make-local-variable 'local-enable-local-variables) | ||
| 1353 | (setq local-enable-local-variables nil) | ||
| 1354 | (make-local-variable 'revert-buffer-function) | ||
| 1355 | (setq revert-buffer-function 'rmail-revert) | ||
| 1356 | (make-local-variable 'font-lock-defaults) | ||
| 1357 | (setq font-lock-defaults | ||
| 1358 | '(rmail-font-lock-keywords | ||
| 1359 | t t nil nil | ||
| 1360 | (font-lock-maximum-size . nil) | ||
| 1361 | (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) | ||
| 1362 | (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) | ||
| 1363 | (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) | ||
| 1364 | (make-local-variable 'require-final-newline) | ||
| 1365 | (setq require-final-newline nil) | ||
| 1366 | (make-local-variable 'version-control) | ||
| 1367 | (setq version-control 'never) | ||
| 1368 | (make-local-variable 'kill-buffer-hook) | ||
| 1369 | (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) | ||
| 1370 | (make-local-variable 'file-precious-flag) | ||
| 1371 | (setq file-precious-flag t) | ||
| 1372 | (make-local-variable 'desktop-save-buffer) | ||
| 1373 | (setq desktop-save-buffer t)) | ||
| 1374 | |||
| 1375 | ;; Handle M-x revert-buffer done in an rmail-mode buffer. | ||
| 1376 | (defun rmail-revert (arg noconfirm) | ||
| 1377 | (set-buffer rmail-buffer) | ||
| 1378 | (let* ((revert-buffer-function (default-value 'revert-buffer-function)) | ||
| 1379 | (rmail-enable-multibyte enable-multibyte-characters) | ||
| 1380 | ;; See similar code in `rmail'. | ||
| 1381 | (coding-system-for-read (and rmail-enable-multibyte 'raw-text))) | ||
| 1382 | ;; Call our caller again, but this time it does the default thing. | ||
| 1383 | (when (revert-buffer arg noconfirm) | ||
| 1384 | ;; If the user said "yes", and we changed something, | ||
| 1385 | ;; reparse the messages. | ||
| 1386 | (set-buffer rmail-buffer) | ||
| 1387 | (rmail-mode-2) | ||
| 1388 | ;; Convert all or part to Babyl file if possible. | ||
| 1389 | (rmail-convert-file-maybe) | ||
| 1390 | ;; We have read the file as raw-text, so the buffer is set to | ||
| 1391 | ;; unibyte. Make it multibyte if necessary. | ||
| 1392 | (if (and rmail-enable-multibyte | ||
| 1393 | (not enable-multibyte-characters)) | ||
| 1394 | (set-buffer-multibyte t)) | ||
| 1395 | (goto-char (point-max)) | ||
| 1396 | (rmail-set-message-counters) | ||
| 1397 | (rmail-show-message-maybe rmail-total-messages) | ||
| 1398 | (run-hooks 'rmail-mode-hook)))) | ||
| 1399 | |||
| 1400 | (defun rmail-expunge-and-save () | ||
| 1401 | "Expunge and save RMAIL file." | ||
| 1402 | (interactive) | ||
| 1403 | (set-buffer rmail-buffer) | ||
| 1404 | (rmail-expunge t) | ||
| 1405 | (rmail-swap-buffers-maybe) | ||
| 1406 | (save-buffer) | ||
| 1407 | (if (rmail-summary-exists) | ||
| 1408 | (rmail-select-summary (set-buffer-modified-p nil)) | ||
| 1409 | (rmail-show-message))) | ||
| 1410 | |||
| 1411 | (defun rmail-quit () | ||
| 1412 | "Quit out of RMAIL. | ||
| 1413 | Hook `rmail-quit-hook' is run after expunging." | ||
| 1414 | (interactive) | ||
| 1415 | (set-buffer rmail-buffer) | ||
| 1416 | (rmail-expunge t) | ||
| 1417 | (rmail-swap-buffers-maybe) | ||
| 1418 | (save-buffer) | ||
| 1419 | (when (boundp 'rmail-quit-hook) | ||
| 1420 | (run-hooks 'rmail-quit-hook)) | ||
| 1421 | ;; Don't switch to the summary buffer even if it was recently visible. | ||
| 1422 | (when rmail-summary-buffer | ||
| 1423 | (replace-buffer-in-windows rmail-summary-buffer) | ||
| 1424 | (bury-buffer rmail-summary-buffer)) | ||
| 1425 | (if rmail-enable-mime | ||
| 1426 | (let ((obuf rmail-buffer) | ||
| 1427 | (ovbuf rmail-view-buffer)) | ||
| 1428 | (set-buffer rmail-view-buffer) | ||
| 1429 | (quit-window) | ||
| 1430 | (replace-buffer-in-windows ovbuf) | ||
| 1431 | (replace-buffer-in-windows obuf) | ||
| 1432 | (bury-buffer obuf)) | ||
| 1433 | (let ((obuf (current-buffer))) | ||
| 1434 | (quit-window) | ||
| 1435 | (replace-buffer-in-windows obuf)))) | ||
| 1436 | |||
| 1437 | (defun rmail-bury () | ||
| 1438 | "Bury current Rmail buffer and its summary buffer." | ||
| 1439 | (interactive) | ||
| 1440 | ;; This let var was called rmail-buffer, but that interfered | ||
| 1441 | ;; with the buffer-local var used in summary buffers. | ||
| 1442 | (let ((buffer-to-bury (current-buffer))) | ||
| 1443 | (if (rmail-summary-exists) | ||
| 1444 | (let (window) | ||
| 1445 | (while (setq window (get-buffer-window rmail-summary-buffer)) | ||
| 1446 | (quit-window nil window)) | ||
| 1447 | (bury-buffer rmail-summary-buffer))) | ||
| 1448 | (quit-window))) | ||
| 1449 | |||
| 1450 | (defun rmail-duplicate-message () | ||
| 1451 | "Create a duplicated copy of the current message. | ||
| 1452 | The duplicate copy goes into the Rmail file just after the | ||
| 1453 | original copy." | ||
| 1454 | (interactive) | ||
| 1455 | (widen) | ||
| 1456 | (let ((buffer-read-only nil) | ||
| 1457 | (number rmail-current-message) | ||
| 1458 | (string (buffer-substring (rmail-msgbeg rmail-current-message) | ||
| 1459 | (rmail-msgend rmail-current-message)))) | ||
| 1460 | (goto-char (rmail-msgend rmail-current-message)) | ||
| 1461 | (insert string) | ||
| 1462 | (rmail-forget-messages) | ||
| 1463 | (rmail-show-message-maybe number) | ||
| 1464 | (message "Message duplicated"))) | ||
| 1465 | |||
| 1466 | ;;;###autoload | ||
| 1467 | (defun rmail-input (filename) | ||
| 1468 | "Run Rmail on file FILENAME." | ||
| 1469 | (interactive "FRun rmail on RMAIL file: ") | ||
| 1470 | (rmail filename)) | ||
| 1471 | |||
| 1472 | ;; This used to scan subdirectories recursively, but someone pointed out | ||
| 1473 | ;; that if the user wants that, person can put all the files in one dir. | ||
| 1474 | ;; And the recursive scan was slow. So I took it out. | ||
| 1475 | ;; rms, Sep 1996. | ||
| 1476 | (defun rmail-find-all-files (start) | ||
| 1477 | "Return list of file in dir START that match `rmail-secondary-file-regexp'." | ||
| 1478 | (if (file-accessible-directory-p start) | ||
| 1479 | ;; Don't sort here. | ||
| 1480 | (let* ((case-fold-search t) | ||
| 1481 | (files (directory-files start t rmail-secondary-file-regexp))) | ||
| 1482 | ;; Sort here instead of in directory-files | ||
| 1483 | ;; because this list is usually much shorter. | ||
| 1484 | (sort files 'string<)))) | ||
| 1485 | |||
| 1486 | (defun rmail-list-to-menu (menu-name l action &optional full-name) | ||
| 1487 | (let ((menu (make-sparse-keymap menu-name))) | ||
| 1488 | (mapc | ||
| 1489 | (lambda (item) | ||
| 1490 | (let (command) | ||
| 1491 | (if (consp item) | ||
| 1492 | (setq command | ||
| 1493 | (rmail-list-to-menu | ||
| 1494 | (car item) (cdr item) action | ||
| 1495 | (if full-name | ||
| 1496 | (concat full-name "/" | ||
| 1497 | (car item)) | ||
| 1498 | (car item))) | ||
| 1499 | name (car item)) | ||
| 1500 | (setq name item) | ||
| 1501 | (setq command | ||
| 1502 | (list 'lambda () '(interactive) | ||
| 1503 | (list action | ||
| 1504 | (expand-file-name | ||
| 1505 | (if full-name | ||
| 1506 | (concat full-name "/" item) | ||
| 1507 | item) | ||
| 1508 | rmail-secondary-file-directory))))) | ||
| 1509 | (define-key menu (vector (intern name)) | ||
| 1510 | (cons name command)))) | ||
| 1511 | (reverse l)) | ||
| 1512 | menu)) | ||
| 1513 | |||
| 1514 | ;; This command is always "disabled" when it appears in a menu. | ||
| 1515 | (put 'rmail-disable-menu 'menu-enable ''nil) | ||
| 1516 | |||
| 1517 | (defun rmail-construct-io-menu () | ||
| 1518 | (let ((files (rmail-find-all-files rmail-secondary-file-directory))) | ||
| 1519 | (if files | ||
| 1520 | (progn | ||
| 1521 | (define-key rmail-mode-map [menu-bar classify input-menu] | ||
| 1522 | (cons "Input Rmail File" | ||
| 1523 | (rmail-list-to-menu "Input Rmail File" | ||
| 1524 | files | ||
| 1525 | 'rmail-input))) | ||
| 1526 | (define-key rmail-mode-map [menu-bar classify output-menu] | ||
| 1527 | (cons "Output Rmail File" | ||
| 1528 | (rmail-list-to-menu "Output Rmail File" | ||
| 1529 | files | ||
| 1530 | 'rmail-output)))) | ||
| 1531 | |||
| 1532 | (define-key rmail-mode-map [menu-bar classify input-menu] | ||
| 1533 | '("Input Rmail File" . rmail-disable-menu)) | ||
| 1534 | (define-key rmail-mode-map [menu-bar classify output-menu] | ||
| 1535 | '("Output Rmail File" . rmail-disable-menu))))) | ||
| 1536 | |||
| 1537 | |||
| 1538 | ;;;; *** Rmail input *** | ||
| 1539 | |||
| 1540 | (declare-function rmail-spam-filter "rmail-spam-filter" (msg)) | ||
| 1541 | (declare-function rmail-summary-goto-msg "rmailsum" (&optional n nowarn skip-rmail)) | ||
| 1542 | (declare-function rmail-summary-mark-undeleted "rmailsum" (n)) | ||
| 1543 | (declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel)) | ||
| 1544 | (declare-function rfc822-addresses "rfc822" (header-text)) | ||
| 1545 | (declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ()) | ||
| 1546 | (declare-function mail-sendmail-delimit-header "sendmail" ()) | ||
| 1547 | (declare-function mail-header-end "sendmail" ()) | ||
| 1548 | |||
| 1549 | ;; RLK feature not added in this version: | ||
| 1550 | ;; argument specifies inbox file or files in various ways. | ||
| 1551 | |||
| 1552 | (defun rmail-get-new-mail (&optional file-name) | ||
| 1553 | "Move any new mail from this RMAIL file's inbox files. | ||
| 1554 | The inbox files can be specified with the file's Mail: option. The | ||
| 1555 | variable `rmail-primary-inbox-list' specifies the inboxes for your | ||
| 1556 | primary RMAIL file if it has no Mail: option. By default, this is | ||
| 1557 | your /usr/spool/mail/$USER. | ||
| 1558 | |||
| 1559 | You can also specify the file to get new mail from. In this case, the | ||
| 1560 | file of new mail is not changed or deleted. Noninteractively, you can | ||
| 1561 | pass the inbox file name as an argument. Interactively, a prefix | ||
| 1562 | argument causes us to read a file name and use that file as the inbox. | ||
| 1563 | |||
| 1564 | If the variable `rmail-preserve-inbox' is non-nil, new mail will | ||
| 1565 | always be left in inbox files rather than deleted. | ||
| 1566 | |||
| 1567 | This function runs `rmail-get-new-mail-hook' before saving the updated file. | ||
| 1568 | It returns t if it got any new messages." | ||
| 1569 | (interactive | ||
| 1570 | (list (if current-prefix-arg | ||
| 1571 | (read-file-name "Get new mail from file: ")))) | ||
| 1572 | (run-hooks 'rmail-before-get-new-mail-hook) | ||
| 1573 | ;; If the disk file has been changed from under us, | ||
| 1574 | ;; revert to it before we get new mail. | ||
| 1575 | (or (verify-visited-file-modtime (current-buffer)) | ||
| 1576 | (find-file (buffer-file-name))) | ||
| 1577 | (set-buffer rmail-buffer) | ||
| 1578 | (rmail-swap-buffers-maybe) | ||
| 1579 | (rmail-maybe-set-message-counters) | ||
| 1580 | (widen) | ||
| 1581 | ;; Get rid of all undo records for this buffer. | ||
| 1582 | (or (eq buffer-undo-list t) | ||
| 1583 | (setq buffer-undo-list nil)) | ||
| 1584 | (let ((all-files (if file-name (list file-name) rmail-inbox-list)) | ||
| 1585 | (rmail-enable-multibyte (default-value 'enable-multibyte-characters)) | ||
| 1586 | found) | ||
| 1587 | (unwind-protect | ||
| 1588 | (when all-files | ||
| 1589 | (let ((opoint (point)) | ||
| 1590 | ;; If buffer has not changed yet, and has not been | ||
| 1591 | ;; saved yet, don't replace the old backup file now. | ||
| 1592 | (make-backup-files (and make-backup-files (buffer-modified-p))) | ||
| 1593 | (buffer-read-only nil) | ||
| 1594 | ;; Don't make undo records while getting mail. | ||
| 1595 | (buffer-undo-list t) | ||
| 1596 | delete-files success files file-last-names) | ||
| 1597 | ;; Pull files off all-files onto files as long as there is | ||
| 1598 | ;; no name conflict. A conflict happens when two inbox | ||
| 1599 | ;; file names have the same last component. | ||
| 1600 | (while (and all-files | ||
| 1601 | (not (member (file-name-nondirectory (car all-files)) | ||
| 1602 | file-last-names))) | ||
| 1603 | (setq files (cons (car all-files) files) | ||
| 1604 | file-last-names | ||
| 1605 | (cons (file-name-nondirectory (car all-files)) files)) | ||
| 1606 | (setq all-files (cdr all-files))) | ||
| 1607 | ;; Put them back in their original order. | ||
| 1608 | (setq files (nreverse files)) | ||
| 1609 | (goto-char (point-max)) | ||
| 1610 | (skip-chars-backward " \t\n") ; just in case of brain damage | ||
| 1611 | (delete-region (point) (point-max)) ; caused by require-final-newline | ||
| 1612 | (setq found (rmail-get-new-mail-1 file-name files delete-files)))) | ||
| 1613 | found) | ||
| 1614 | ;; Don't leave the buffer screwed up if we get a disk-full error. | ||
| 1615 | (or found (rmail-show-message-maybe)))) | ||
| 1616 | |||
| 1617 | (defun rmail-get-new-mail-1 (file-name files delete-files) | ||
| 1618 | "Return t if new messages are detected without error, nil otherwise." | ||
| 1619 | (save-excursion | ||
| 1620 | (save-restriction | ||
| 1621 | (let ((new-messages 0) | ||
| 1622 | (spam-filter-p (and (featurep 'rmail-spam-filter) | ||
| 1623 | rmail-use-spam-filter)) | ||
| 1624 | (blurb "") | ||
| 1625 | result success suffix) | ||
| 1626 | (narrow-to-region (point) (point)) | ||
| 1627 | ;; Read in the contents of the inbox files, renaming them as | ||
| 1628 | ;; necessary, and adding to the list of files to delete | ||
| 1629 | ;; eventually. | ||
| 1630 | (if file-name | ||
| 1631 | (rmail-insert-inbox-text files nil) | ||
| 1632 | (setq delete-files (rmail-insert-inbox-text files t))) | ||
| 1633 | ;; Scan the new text and convert each message to | ||
| 1634 | ;; Rmail/mbox format. | ||
| 1635 | (goto-char (point-min)) | ||
| 1636 | (skip-chars-forward " \n") | ||
| 1637 | (narrow-to-region (point) (point-max)) | ||
| 1638 | (unwind-protect | ||
| 1639 | (setq new-messages (rmail-add-mbox-headers) | ||
| 1640 | success t) | ||
| 1641 | ;; Try to delete the garbage just inserted. | ||
| 1642 | (or success (delete-region (point-min) (point-max))) | ||
| 1643 | ;; If we could not convert the file's inboxes, rename the | ||
| 1644 | ;; files we tried to read so we won't over and over again. | ||
| 1645 | (if (and (not file-name) (not success)) | ||
| 1646 | (let ((delfiles delete-files) | ||
| 1647 | (count 0)) | ||
| 1648 | (while delfiles | ||
| 1649 | (while (file-exists-p (format "RMAILOSE.%d" count)) | ||
| 1650 | (setq count (1+ count))) | ||
| 1651 | (rename-file (car delfiles) (format "RMAILOSE.%d" count)) | ||
| 1652 | (setq delfiles (cdr delfiles)))))) | ||
| 1653 | ;; Determine if there are messages. | ||
| 1654 | (unless (zerop new-messages) | ||
| 1655 | ;; There are. Process them. | ||
| 1656 | (goto-char (point-min)) | ||
| 1657 | (rmail-count-new-messages) | ||
| 1658 | (run-hooks 'rmail-get-new-mail-hook) | ||
| 1659 | (save-buffer)) | ||
| 1660 | ;; Delete the old files, now that the Rmail file is saved. | ||
| 1661 | (while delete-files | ||
| 1662 | (condition-case () | ||
| 1663 | ;; First, try deleting. | ||
| 1664 | (condition-case () | ||
| 1665 | (delete-file (car delete-files)) | ||
| 1666 | (file-error | ||
| 1667 | ;; If we can't delete it, truncate it. | ||
| 1668 | (write-region (point) (point) (car delete-files)))) | ||
| 1669 | (file-error nil)) | ||
| 1670 | (setq delete-files (cdr delete-files))) | ||
| 1671 | (if (zerop new-messages) | ||
| 1672 | (when (or file-name rmail-inbox-list) | ||
| 1673 | (message "(No new mail has arrived)")) | ||
| 1674 | ;; Generate the spam message. | ||
| 1675 | (setq blurb (if spam-filter-p | ||
| 1676 | (rmail-get-new-mail-filter-spam new-messages) | ||
| 1677 | ""))) | ||
| 1678 | (if (rmail-summary-exists) | ||
| 1679 | (rmail-select-summary (rmail-update-summary))) | ||
| 1680 | (setq suffix (if (= 1 new-messages) "" "s")) | ||
| 1681 | (message "%d new message%s read%s" new-messages suffix blurb) | ||
| 1682 | (when spam-filter-p | ||
| 1683 | (if rsf-beep (beep t)) | ||
| 1684 | (sleep-for rsf-sleep-after-message)) | ||
| 1685 | |||
| 1686 | ;; Establish the return value and move to the first new | ||
| 1687 | ;; message unless we have other unseen messages before it. | ||
| 1688 | (setq result (> new-messages 0)) | ||
| 1689 | (when result | ||
| 1690 | (rmail-show-message-maybe (rmail-first-unseen-message))) | ||
| 1691 | (run-hooks 'rmail-after-get-new-mail-hook) | ||
| 1692 | result)))) | ||
| 1693 | |||
| 1694 | (defun rmail-get-new-mail-filter-spam (new-message-count) | ||
| 1695 | "Process new messages for spam." | ||
| 1696 | (let* ((old-messages (- rmail-total-messages new-message-count)) | ||
| 1697 | (rsf-number-of-spam 0) | ||
| 1698 | (rsf-scanned-message-number (1+ old-messages)) | ||
| 1699 | ;; save deletion flags of old messages: vector starts at zero | ||
| 1700 | ;; (is one longer that no of messages), therefore take 1+ | ||
| 1701 | ;; old-messages | ||
| 1702 | (save-deleted (substring rmail-deleted-vector 0 (1+ old-messages))) | ||
| 1703 | blurb) | ||
| 1704 | ;; set all messages to undeleted | ||
| 1705 | (setq rmail-deleted-vector (make-string (1+ rmail-total-messages) ?\ )) | ||
| 1706 | (while (<= rsf-scanned-message-number rmail-total-messages) | ||
| 1707 | (progn | ||
| 1708 | (if (not (rmail-spam-filter rsf-scanned-message-number)) | ||
| 1709 | (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam)))) | ||
| 1710 | (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)))) | ||
| 1711 | (if (> rsf-number-of-spam 0) | ||
| 1712 | (progn | ||
| 1713 | (when (rmail-expunge-confirmed) | ||
| 1714 | (rmail-only-expunge t)))) | ||
| 1715 | (setq rmail-deleted-vector | ||
| 1716 | (concat save-deleted | ||
| 1717 | (make-string (- rmail-total-messages old-messages) ?\ ))) | ||
| 1718 | ;; Generate a return value message based on the number of spam | ||
| 1719 | ;; messages found. | ||
| 1720 | (cond | ||
| 1721 | ((zerop rsf-number-of-spam) "") | ||
| 1722 | ((= 1 new-message-count) ", and appears to be spam") | ||
| 1723 | ((= rsf-number-of-spam new-message-count) ", and all appear to be spam") | ||
| 1724 | ((> rsf-number-of-spam 1) | ||
| 1725 | (format ", and %d appear to be spam" rsf-number-of-spam)) | ||
| 1726 | (t ", and 1 appears to be spam")))) | ||
| 1727 | |||
| 1728 | (defun rmail-parse-url (file) | ||
| 1729 | "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) | ||
| 1730 | WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the | ||
| 1731 | actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to | ||
| 1732 | a remote mailbox, PASSWORD is the password if it should be | ||
| 1733 | supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD | ||
| 1734 | is non-nil if the user has supplied the password interactively. | ||
| 1735 | " | ||
| 1736 | (cond | ||
| 1737 | ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file) | ||
| 1738 | (let (got-password supplied-password | ||
| 1739 | (proto (match-string 1 file)) | ||
| 1740 | (user (match-string 3 file)) | ||
| 1741 | (pass (match-string 5 file)) | ||
| 1742 | (host (substring file (or (match-end 2) | ||
| 1743 | (+ 3 (match-end 1)))))) | ||
| 1744 | |||
| 1745 | (if (not pass) | ||
| 1746 | (when rmail-remote-password-required | ||
| 1747 | (setq got-password (not (rmail-have-password))) | ||
| 1748 | (setq supplied-password (rmail-get-remote-password | ||
| 1749 | (string-equal proto "imap")))) | ||
| 1750 | ;; The password is embedded. Strip it out since movemail | ||
| 1751 | ;; does not really like it, in spite of the movemail spec. | ||
| 1752 | (setq file (concat proto "://" user "@" host))) | ||
| 1753 | |||
| 1754 | (if (rmail-movemail-variant-p 'emacs) | ||
| 1755 | (if (string-equal proto "pop") | ||
| 1756 | (list (concat "po:" user ":" host) | ||
| 1757 | t | ||
| 1758 | (or pass supplied-password) | ||
| 1759 | got-password) | ||
| 1760 | (error "Emacs movemail does not support %s protocol" proto)) | ||
| 1761 | (list file | ||
| 1762 | (or (string-equal proto "pop") (string-equal proto "imap")) | ||
| 1763 | (or supplied-password pass) | ||
| 1764 | got-password)))) | ||
| 1765 | |||
| 1766 | ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file) | ||
| 1767 | (let (got-password supplied-password | ||
| 1768 | (proto "pop") | ||
| 1769 | (user (match-string 1 file)) | ||
| 1770 | (host (match-string 3 file))) | ||
| 1771 | |||
| 1772 | (when rmail-remote-password-required | ||
| 1773 | (setq got-password (not (rmail-have-password))) | ||
| 1774 | (setq supplied-password (rmail-get-remote-password nil))) | ||
| 1775 | |||
| 1776 | (list file "pop" supplied-password got-password))) | ||
| 1777 | |||
| 1778 | (t | ||
| 1779 | (list file nil nil nil)))) | ||
| 1780 | |||
| 1781 | (defun rmail-insert-inbox-text (files renamep) | ||
| 1782 | ;; Detect a locked file now, so that we avoid moving mail | ||
| 1783 | ;; out of the real inbox file. (That could scare people.) | ||
| 1784 | (or (memq (file-locked-p buffer-file-name) '(nil t)) | ||
| 1785 | (error "RMAIL file %s is locked" | ||
| 1786 | (file-name-nondirectory buffer-file-name))) | ||
| 1787 | (let (file tofile delete-files movemail pormail got-password password) | ||
| 1788 | (while files | ||
| 1789 | ;; Handle remote mailbox names specially; don't expand as filenames | ||
| 1790 | ;; in case the userid contains a directory separator. | ||
| 1791 | (setq file (car files)) | ||
| 1792 | (let ((url-data (rmail-parse-url file))) | ||
| 1793 | (setq file (nth 0 url-data)) | ||
| 1794 | (setq pormail (nth 1 url-data)) | ||
| 1795 | (setq password (nth 2 url-data)) | ||
| 1796 | (setq got-password (nth 3 url-data))) | ||
| 1797 | |||
| 1798 | (if pormail | ||
| 1799 | (setq renamep t) | ||
| 1800 | (setq file (file-truename | ||
| 1801 | (substitute-in-file-name (expand-file-name file))))) | ||
| 1802 | (setq tofile (expand-file-name | ||
| 1803 | ;; Generate name to move to from inbox name, | ||
| 1804 | ;; in case of multiple inboxes that need moving. | ||
| 1805 | (concat ".newmail-" | ||
| 1806 | (file-name-nondirectory | ||
| 1807 | (if (memq system-type '(windows-nt cygwin ms-dos)) | ||
| 1808 | ;; cannot have colons in file name | ||
| 1809 | (replace-regexp-in-string ":" "-" file) | ||
| 1810 | file))) | ||
| 1811 | ;; Use the directory of this rmail file | ||
| 1812 | ;; because it's a nuisance to use the homedir | ||
| 1813 | ;; if that is on a full disk and this rmail | ||
| 1814 | ;; file isn't. | ||
| 1815 | (file-name-directory | ||
| 1816 | (expand-file-name buffer-file-name)))) | ||
| 1817 | ;; Always use movemail to rename the file, | ||
| 1818 | ;; since there can be mailboxes in various directories. | ||
| 1819 | (when (not pormail) | ||
| 1820 | ;; On some systems, /usr/spool/mail/foo is a directory | ||
| 1821 | ;; and the actual inbox is /usr/spool/mail/foo/foo. | ||
| 1822 | (if (file-directory-p file) | ||
| 1823 | (setq file (expand-file-name (user-login-name) | ||
| 1824 | file)))) | ||
| 1825 | (cond (pormail | ||
| 1826 | (message "Getting mail from the remote server ...")) | ||
| 1827 | ((and (file-exists-p tofile) | ||
| 1828 | (/= 0 (nth 7 (file-attributes tofile)))) | ||
| 1829 | (message "Getting mail from %s..." tofile)) | ||
| 1830 | ((and (file-exists-p file) | ||
| 1831 | (/= 0 (nth 7 (file-attributes file)))) | ||
| 1832 | (message "Getting mail from %s..." file))) | ||
| 1833 | ;; Set TOFILE if have not already done so, and | ||
| 1834 | ;; rename or copy the file FILE to TOFILE if and as appropriate. | ||
| 1835 | (cond ((not renamep) | ||
| 1836 | (setq tofile file)) | ||
| 1837 | ((or (file-exists-p tofile) (and (not pormail) | ||
| 1838 | (not (file-exists-p file)))) | ||
| 1839 | nil) | ||
| 1840 | (t | ||
| 1841 | (with-temp-buffer | ||
| 1842 | (let ((errors (current-buffer))) | ||
| 1843 | (buffer-disable-undo errors) | ||
| 1844 | (let ((args | ||
| 1845 | (append | ||
| 1846 | (list (or rmail-movemail-program "movemail") nil errors nil) | ||
| 1847 | (if rmail-preserve-inbox | ||
| 1848 | (list "-p") | ||
| 1849 | nil) | ||
| 1850 | (if (rmail-movemail-variant-p 'mailutils) | ||
| 1851 | (append (list "--emacs") rmail-movemail-flags) | ||
| 1852 | rmail-movemail-flags) | ||
| 1853 | (list file tofile) | ||
| 1854 | (if password (list password) nil)))) | ||
| 1855 | (apply 'call-process args)) | ||
| 1856 | (if (not (buffer-modified-p errors)) | ||
| 1857 | ;; No output => movemail won | ||
| 1858 | nil | ||
| 1859 | (set-buffer errors) | ||
| 1860 | (subst-char-in-region (point-min) (point-max) | ||
| 1861 | ?\n ?\ ) | ||
| 1862 | (goto-char (point-max)) | ||
| 1863 | (skip-chars-backward " \t") | ||
| 1864 | (delete-region (point) (point-max)) | ||
| 1865 | (goto-char (point-min)) | ||
| 1866 | (if (looking-at "movemail: ") | ||
| 1867 | (delete-region (point-min) (match-end 0))) | ||
| 1868 | (beep t) | ||
| 1869 | ;; If we just read the password, most likely it is | ||
| 1870 | ;; wrong. Otherwise, see if there is a specific | ||
| 1871 | ;; reason to think that the problem is a wrong passwd. | ||
| 1872 | (if (or got-password | ||
| 1873 | (re-search-forward rmail-remote-password-error | ||
| 1874 | nil t)) | ||
| 1875 | (rmail-set-remote-password nil)) | ||
| 1876 | |||
| 1877 | ;; If using Mailutils, remove initial error code | ||
| 1878 | ;; abbreviation | ||
| 1879 | (when (rmail-movemail-variant-p 'mailutils) | ||
| 1880 | (goto-char (point-min)) | ||
| 1881 | (when (looking-at "[A-Z][A-Z0-9_]*:") | ||
| 1882 | (delete-region (point-min) (match-end 0)))) | ||
| 1883 | |||
| 1884 | (message "movemail: %s" | ||
| 1885 | (buffer-substring (point-min) | ||
| 1886 | (point-max))) | ||
| 1887 | |||
| 1888 | (sit-for 3) | ||
| 1889 | nil))))) | ||
| 1890 | |||
| 1891 | ;; At this point, TOFILE contains the name to read: | ||
| 1892 | ;; Either the alternate name (if we renamed) | ||
| 1893 | ;; or the actual inbox (if not renaming). | ||
| 1894 | (if (file-exists-p tofile) | ||
| 1895 | (let ((coding-system-for-read 'no-conversion) | ||
| 1896 | size) | ||
| 1897 | (goto-char (point-max)) | ||
| 1898 | (setq size (nth 1 (insert-file-contents tofile))) | ||
| 1899 | ;; Determine if a pair of newline message separators need | ||
| 1900 | ;; to be added to the new collection of messages. This is | ||
| 1901 | ;; the case for all new message collections added to a | ||
| 1902 | ;; non-empty mail file. | ||
| 1903 | (unless (zerop size) | ||
| 1904 | (save-restriction | ||
| 1905 | (let ((start (point-min))) | ||
| 1906 | (widen) | ||
| 1907 | (unless (eq start (point-min)) | ||
| 1908 | (goto-char start) | ||
| 1909 | (insert "\n\n") | ||
| 1910 | (setq size (+ 2 size)))))) | ||
| 1911 | (goto-char (point-max)) | ||
| 1912 | (or (= (preceding-char) ?\n) | ||
| 1913 | (zerop size) | ||
| 1914 | (insert ?\n)) | ||
| 1915 | (if (not (and rmail-preserve-inbox (string= file tofile))) | ||
| 1916 | (setq delete-files (cons tofile delete-files))))) | ||
| 1917 | (message "") | ||
| 1918 | (setq files (cdr files))) | ||
| 1919 | delete-files)) | ||
| 1920 | |||
| 1921 | ;; Decode the region specified by FROM and TO by CODING. | ||
| 1922 | ;; If CODING is nil or an invalid coding system, decode by `undecided'. | ||
| 1923 | (defun rmail-decode-region (from to coding &optional destination) | ||
| 1924 | (if (or (not coding) (not (coding-system-p coding))) | ||
| 1925 | (setq coding 'undecided)) | ||
| 1926 | ;; Use -dos decoding, to remove ^M characters left from base64 or | ||
| 1927 | ;; rogue qp-encoded text. | ||
| 1928 | (decode-coding-region | ||
| 1929 | from to (coding-system-change-eol-conversion coding 1) destination) | ||
| 1930 | ;; Don't reveal the fact we used -dos decoding, as users generally | ||
| 1931 | ;; will not expect the RMAIL buffer to use DOS EOL format. | ||
| 1932 | (setq buffer-file-coding-system | ||
| 1933 | (setq last-coding-system-used | ||
| 1934 | (coding-system-change-eol-conversion coding 0)))) | ||
| 1935 | |||
| 1936 | (defun rmail-add-mbox-headers () | ||
| 1937 | "Validate the RFC2822 format for the new messages. | ||
| 1938 | Point should be at the first new message. | ||
| 1939 | An error is signalled if the new messages are not RFC2822 | ||
| 1940 | compliant. | ||
| 1941 | Unless an Rmail attribute header already exists, add it to the | ||
| 1942 | new messages. Return the number of new messages." | ||
| 1943 | (save-excursion | ||
| 1944 | (save-restriction | ||
| 1945 | (let ((count 0) | ||
| 1946 | (start (point)) | ||
| 1947 | (value "------U-") | ||
| 1948 | limit) | ||
| 1949 | ;; Detect an empty inbox file. | ||
| 1950 | (unless (= start (point-max)) | ||
| 1951 | ;; Scan the new messages to establish a count and to insure that | ||
| 1952 | ;; an attribute header is present. | ||
| 1953 | (while (looking-at "From ") | ||
| 1954 | ;; Determine if a new attribute header needs to be added to | ||
| 1955 | ;; the message. | ||
| 1956 | (if (search-forward "\n\n" nil t) | ||
| 1957 | (progn | ||
| 1958 | (setq count (1+ count)) | ||
| 1959 | (narrow-to-region start (point)) | ||
| 1960 | (unless (mail-fetch-field rmail-attribute-header) | ||
| 1961 | (backward-char 1) | ||
| 1962 | (insert rmail-attribute-header ": " value "\n")) | ||
| 1963 | (widen)) | ||
| 1964 | (rmail-error-bad-format)) | ||
| 1965 | ;; Move to the next message. | ||
| 1966 | (if (search-forward "\n\nFrom " nil 'move) | ||
| 1967 | (forward-char -5)) | ||
| 1968 | (setq start (point)))) | ||
| 1969 | count)))) | ||
| 1970 | |||
| 1971 | (defun rmail-get-header (name &optional msgnum) | ||
| 1972 | "Return the value of message header NAME, nil if it has none. | ||
| 1973 | MSGNUM specifies the message number to get it from. | ||
| 1974 | If MSGNUM is nil, use the current message." | ||
| 1975 | (with-current-buffer rmail-buffer | ||
| 1976 | (or msgnum (setq msgnum rmail-current-message)) | ||
| 1977 | (when (> msgnum 0) | ||
| 1978 | (let (msgbeg end) | ||
| 1979 | (setq msgbeg (rmail-msgbeg msgnum)) | ||
| 1980 | ;; All access to the buffer's local variables is now finished... | ||
| 1981 | (save-excursion | ||
| 1982 | ;; ... so it is ok to go to a different buffer. | ||
| 1983 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | ||
| 1984 | (save-restriction | ||
| 1985 | (widen) | ||
| 1986 | (save-excursion | ||
| 1987 | (goto-char msgbeg) | ||
| 1988 | (setq end (search-forward "\n\n" nil t)) | ||
| 1989 | (if end | ||
| 1990 | (progn | ||
| 1991 | (narrow-to-region msgbeg end) | ||
| 1992 | (mail-fetch-field name)) | ||
| 1993 | (rmail-error-bad-format msgnum))))))))) | ||
| 1994 | |||
| 1995 | (defun rmail-set-header (name &optional msgnum value) | ||
| 1996 | "Store VALUE in message header NAME, nil if it has none. | ||
| 1997 | MSGNUM specifies the message number to operate on. | ||
| 1998 | If MSGNUM is nil, use the current message." | ||
| 1999 | (with-current-buffer rmail-buffer | ||
| 2000 | (or msgnum (setq msgnum rmail-current-message)) | ||
| 2001 | (when (> msgnum 0) | ||
| 2002 | (let (msgbeg end) | ||
| 2003 | (setq msgbeg (rmail-msgbeg msgnum)) | ||
| 2004 | ;; All access to the buffer's local variables is now finished... | ||
| 2005 | (save-excursion | ||
| 2006 | ;; ... so it is ok to go to a different buffer. | ||
| 2007 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | ||
| 2008 | (save-restriction | ||
| 2009 | (widen) | ||
| 2010 | (save-excursion | ||
| 2011 | (goto-char msgbeg) | ||
| 2012 | (setq end (search-forward "\n\n" nil t)) | ||
| 2013 | (if end (setq end (1- end))) | ||
| 2014 | (if end | ||
| 2015 | (progn | ||
| 2016 | (narrow-to-region msgbeg end) | ||
| 2017 | (goto-char msgbeg) | ||
| 2018 | (if (re-search-forward (concat "^" | ||
| 2019 | (regexp-quote name) | ||
| 2020 | ":") | ||
| 2021 | nil t) | ||
| 2022 | (progn | ||
| 2023 | (delete-region (point) (line-end-position)) | ||
| 2024 | (insert " " value)) | ||
| 2025 | (goto-char end) | ||
| 2026 | (insert name ": " value "\n"))) | ||
| 2027 | (rmail-error-bad-format msgnum))))))))) | ||
| 2028 | |||
| 2029 | ;;;; *** Rmail Attributes and Keywords *** | ||
| 2030 | |||
| 2031 | (defun rmail-get-attr-names (&optional msg) | ||
| 2032 | "Return the message attributes in a comma separated string. | ||
| 2033 | MSG specifies the message number to get it from. | ||
| 2034 | If MSG is nil, use the current message." | ||
| 2035 | (let ((value (rmail-get-header rmail-attribute-header msg)) | ||
| 2036 | result temp) | ||
| 2037 | (dotimes (index (length value)) | ||
| 2038 | (setq temp (and (not (= ?- (aref value index))) | ||
| 2039 | (nth 1 (aref rmail-attr-array index))) | ||
| 2040 | result | ||
| 2041 | (cond | ||
| 2042 | ((and temp result) (format "%s, %s" result temp)) | ||
| 2043 | (temp temp) | ||
| 2044 | (t result)))) | ||
| 2045 | result)) | ||
| 2046 | |||
| 2047 | (defun rmail-get-keywords (&optional msg) | ||
| 2048 | "Return the message keywords in a comma separated string. | ||
| 2049 | MSG, if non-nil, identifies the message number to use. | ||
| 2050 | If nil, that means the current message." | ||
| 2051 | (rmail-get-header rmail-keyword-header msg)) | ||
| 2052 | |||
| 2053 | (defun rmail-get-labels (&optional msg) | ||
| 2054 | "Return a string with the labels (attributes and keywords) of msg MSG. | ||
| 2055 | It is put in comma-separated form. | ||
| 2056 | MSG, if non-nil, identifies the message number to use. | ||
| 2057 | If nil, that means the current message." | ||
| 2058 | (let (blurb attr-names keywords) | ||
| 2059 | ;; Combine the message attributes and keywords | ||
| 2060 | ;; into a comma-separated list. | ||
| 2061 | (setq attr-names (rmail-get-attr-names rmail-current-message) | ||
| 2062 | keywords (rmail-get-keywords rmail-current-message)) | ||
| 2063 | (if (string= keywords "") | ||
| 2064 | (setq keywords nil)) | ||
| 2065 | (cond | ||
| 2066 | ((and attr-names keywords) (concat " " attr-names ", " keywords)) | ||
| 2067 | (attr-names (concat " " attr-names)) | ||
| 2068 | (keywords (concat " " keywords)) | ||
| 2069 | (t "")))) | ||
| 2070 | |||
| 2071 | (defun rmail-display-labels () | ||
| 2072 | "Update the current messages's attributes and keywords in mode line." | ||
| 2073 | (let ((blurb (rmail-get-labels))) | ||
| 2074 | (setq mode-line-process | ||
| 2075 | (format " %d/%d%s" | ||
| 2076 | rmail-current-message rmail-total-messages blurb)) | ||
| 2077 | ;; If rmail-enable-mime is non-nil, we may have to update | ||
| 2078 | ;; `mode-line-process' of rmail-view-buffer too. | ||
| 2079 | (if (and rmail-enable-mime | ||
| 2080 | (not (eq (current-buffer) rmail-view-buffer)) | ||
| 2081 | (buffer-live-p rmail-view-buffer)) | ||
| 2082 | (let ((mlp mode-line-process)) | ||
| 2083 | (with-current-buffer rmail-view-buffer | ||
| 2084 | (setq mode-line-process mlp)))))) | ||
| 2085 | |||
| 2086 | (defun rmail-get-attr-value (attr state) | ||
| 2087 | "Return the character value for ATTR. | ||
| 2088 | ATTR is a (numeric) index, an offset into the mbox attribute | ||
| 2089 | header value. STATE is one of nil, t, or a character value." | ||
| 2090 | (cond | ||
| 2091 | ((numberp state) state) | ||
| 2092 | ((not state) ?-) | ||
| 2093 | (t (nth 0 (aref rmail-attr-array attr))))) | ||
| 2094 | |||
| 2095 | (defun rmail-set-attribute (attr state &optional msgnum) | ||
| 2096 | "Turn an attribute of a message on or off according to STATE. | ||
| 2097 | STATE is either nil or the character (numeric) value associated | ||
| 2098 | with the state (nil represents off and non-nil represents on). | ||
| 2099 | ATTR is the index of the attribute. MSGNUM is message number to | ||
| 2100 | change; nil means current message." | ||
| 2101 | (with-current-buffer rmail-buffer | ||
| 2102 | (let ((value (rmail-get-attr-value attr state)) | ||
| 2103 | (inhibit-read-only t) | ||
| 2104 | limit | ||
| 2105 | altered | ||
| 2106 | msgbeg) | ||
| 2107 | (or msgnum (setq msgnum rmail-current-message)) | ||
| 2108 | (when (> msgnum 0) | ||
| 2109 | ;; The "deleted" attribute is also stored in a special vector | ||
| 2110 | ;; so update that too. | ||
| 2111 | (if (= attr rmail-deleted-attr-index) | ||
| 2112 | (rmail-set-message-deleted-p msgnum state)) | ||
| 2113 | (setq msgbeg (rmail-msgbeg msgnum)) | ||
| 2114 | |||
| 2115 | ;; All access to the buffer's local variables is now finished... | ||
| 2116 | (unwind-protect | ||
| 2117 | (save-excursion | ||
| 2118 | ;; ... so it is ok to go to a different buffer. | ||
| 2119 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | ||
| 2120 | (save-restriction | ||
| 2121 | (widen) | ||
| 2122 | (save-excursion | ||
| 2123 | ;; Determine if the current state is the desired state. | ||
| 2124 | (goto-char msgbeg) | ||
| 2125 | (save-excursion | ||
| 2126 | (setq limit (search-forward "\n\n" nil t))) | ||
| 2127 | (if (search-forward (concat rmail-attribute-header ": ") limit t) | ||
| 2128 | ;; If this message already records attributes, | ||
| 2129 | ;; just change the value for this one. | ||
| 2130 | (let ((missing (- (+ (point) attr) (line-end-position)))) | ||
| 2131 | ;; Position point at this attribute, | ||
| 2132 | ;; adding attributes if necessary. | ||
| 2133 | (if (> missing 0) | ||
| 2134 | (progn | ||
| 2135 | (end-of-line) | ||
| 2136 | (insert-char ?- missing) | ||
| 2137 | (backward-char 1)) | ||
| 2138 | (forward-char attr)) | ||
| 2139 | ;; Change this attribute. | ||
| 2140 | (when (/= value (char-after)) | ||
| 2141 | (setq altered t) | ||
| 2142 | (delete-char 1) | ||
| 2143 | (insert value))) | ||
| 2144 | ;; Otherwise add a header line to record the attributes | ||
| 2145 | ;; and set all but this one to no. | ||
| 2146 | (let ((header-value "--------")) | ||
| 2147 | (aset header-value attr value) | ||
| 2148 | (goto-char (if limit (- limit 1) (point-max))) | ||
| 2149 | (setq altered (/= value ?-)) | ||
| 2150 | (insert rmail-attribute-header ": " header-value "\n")))))) | ||
| 2151 | (if (= msgnum rmail-current-message) | ||
| 2152 | (rmail-display-labels)))) | ||
| 2153 | ;; If we made a significant change in an attribute, | ||
| 2154 | ;; mark rmail-buffer modified, so it will be (1) saved | ||
| 2155 | ;; and (2) displayed in the mode line. | ||
| 2156 | (if altered | ||
| 2157 | (set-buffer-modified-p t))))) | ||
| 2158 | |||
| 2159 | (defun rmail-message-attr-p (msg attrs) | ||
| 2160 | "Return t if the attributes header for message MSG matches regexp ATTRS. | ||
| 2161 | This function assumes the Rmail buffer is unswapped." | ||
| 2162 | (save-excursion | ||
| 2163 | (save-restriction | ||
| 2164 | (let ((start (rmail-msgbeg msg)) | ||
| 2165 | limit) | ||
| 2166 | (widen) | ||
| 2167 | (goto-char start) | ||
| 2168 | (setq limit (search-forward "\n\n" (rmail-msgend msg) t)) | ||
| 2169 | (goto-char start) | ||
| 2170 | (and limit | ||
| 2171 | (search-forward (concat rmail-attribute-header ": ") limit t) | ||
| 2172 | (looking-at attrs)))))) | ||
| 2173 | |||
| 2174 | (defun rmail-message-unseen-p (msgnum) | ||
| 2175 | "Test the unseen attribute for message MSGNUM. | ||
| 2176 | Return non-nil if the unseen attribute is set, nil otherwise." | ||
| 2177 | (rmail-message-attr-p msgnum "......U")) | ||
| 2178 | |||
| 2179 | ;; Return t if the attributes/keywords line of msg number MSG | ||
| 2180 | ;; contains a match for the regexp LABELS. | ||
| 2181 | (defun rmail-message-labels-p (msg labels) | ||
| 2182 | (string-match labels (rmail-get-labels msg))) | ||
| 2183 | |||
| 2184 | ;;;; *** Rmail Message Selection And Support *** | ||
| 2185 | |||
| 2186 | (defun rmail-msgend (n) | ||
| 2187 | (marker-position (aref rmail-message-vector (1+ n)))) | ||
| 2188 | |||
| 2189 | (defun rmail-msgbeg (n) | ||
| 2190 | (marker-position (aref rmail-message-vector n))) | ||
| 2191 | |||
| 2192 | (defun rmail-apply-in-message (msgnum function &rest args) | ||
| 2193 | "Call FUNCTION on ARGS while narrowed to message MSGNUM. | ||
| 2194 | Point is at the start of the message. | ||
| 2195 | This returns what the call to FUNCTION returns. | ||
| 2196 | If MSGNUM is nil, use the current message." | ||
| 2197 | (with-current-buffer rmail-buffer | ||
| 2198 | (or msgnum (setq msgnum rmail-current-message)) | ||
| 2199 | (when (> msgnum 0) | ||
| 2200 | (let (msgbeg msgend) | ||
| 2201 | (setq msgbeg (rmail-msgbeg msgnum)) | ||
| 2202 | (setq msgend (rmail-msgend msgnum)) | ||
| 2203 | ;; All access to the rmail-buffer's local variables is now finished... | ||
| 2204 | (save-excursion | ||
| 2205 | ;; ... so it is ok to go to a different buffer. | ||
| 2206 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | ||
| 2207 | (save-restriction | ||
| 2208 | (widen) | ||
| 2209 | (save-excursion | ||
| 2210 | (goto-char msgbeg) | ||
| 2211 | (save-restriction | ||
| 2212 | (narrow-to-region msgbeg msgend) | ||
| 2213 | (apply function args))))))))) | ||
| 2214 | |||
| 2215 | (defun rmail-widen-to-current-msgbeg (function) | ||
| 2216 | "Call FUNCTION with point at start of internal data of current message. | ||
| 2217 | Assumes that bounds were previously narrowed to display the message in Rmail. | ||
| 2218 | The bounds are widened enough to move point where desired, then narrowed | ||
| 2219 | again afterward. | ||
| 2220 | |||
| 2221 | FUNCTION may not change the visible text of the message, but it may | ||
| 2222 | change the invisible header text." | ||
| 2223 | (save-excursion | ||
| 2224 | (unwind-protect | ||
| 2225 | (progn | ||
| 2226 | (narrow-to-region (rmail-msgbeg rmail-current-message) | ||
| 2227 | (point-max)) | ||
| 2228 | (goto-char (point-min)) | ||
| 2229 | (funcall function)) | ||
| 2230 | ;; Note: we don't use save-restriction because that does not work right | ||
| 2231 | ;; if changes are made outside the saved restriction | ||
| 2232 | ;; before that restriction is restored. | ||
| 2233 | (narrow-to-region (rmail-msgbeg rmail-current-message) | ||
| 2234 | (rmail-msgend rmail-current-message))))) | ||
| 2235 | |||
| 2236 | ;; Manage the message vectors and counters. | ||
| 2237 | |||
| 2238 | (defun rmail-forget-messages () | ||
| 2239 | (unwind-protect | ||
| 2240 | (if (vectorp rmail-message-vector) | ||
| 2241 | (let* ((i 0) | ||
| 2242 | (v rmail-message-vector) | ||
| 2243 | (n (length v))) | ||
| 2244 | (while (< i n) | ||
| 2245 | (move-marker (aref v i) nil) | ||
| 2246 | (setq i (1+ i))))) | ||
| 2247 | (setq rmail-message-vector nil) | ||
| 2248 | (setq rmail-msgref-vector nil) | ||
| 2249 | (setq rmail-deleted-vector nil))) | ||
| 2250 | |||
| 2251 | (defun rmail-maybe-set-message-counters () | ||
| 2252 | (if (not (and rmail-deleted-vector | ||
| 2253 | rmail-message-vector | ||
| 2254 | rmail-current-message | ||
| 2255 | rmail-total-messages)) | ||
| 2256 | (rmail-set-message-counters))) | ||
| 2257 | |||
| 2258 | (defun rmail-count-new-messages (&optional nomsg) | ||
| 2259 | "Count the number of new messages. | ||
| 2260 | The buffer should be narrowed to include only the new messages. | ||
| 2261 | Output a helpful message unless NOMSG is non-nil." | ||
| 2262 | (let* ((case-fold-search nil) | ||
| 2263 | (total-messages 0) | ||
| 2264 | (messages-head nil) | ||
| 2265 | (deleted-head nil)) | ||
| 2266 | (or nomsg (message "Counting new messages...")) | ||
| 2267 | (goto-char (point-max)) | ||
| 2268 | ;; Put at the end of messages-head | ||
| 2269 | ;; the entry for message N+1, which marks | ||
| 2270 | ;; the end of message N. (N = number of messages). | ||
| 2271 | (setq messages-head (list (point-marker))) | ||
| 2272 | (rmail-set-message-counters-counter (point-min)) | ||
| 2273 | (setq rmail-current-message (1+ rmail-total-messages)) | ||
| 2274 | (setq rmail-total-messages | ||
| 2275 | (+ rmail-total-messages total-messages)) | ||
| 2276 | (setq rmail-message-vector | ||
| 2277 | (vconcat rmail-message-vector (cdr messages-head))) | ||
| 2278 | (aset rmail-message-vector | ||
| 2279 | rmail-current-message (car messages-head)) | ||
| 2280 | (setq rmail-deleted-vector | ||
| 2281 | (concat rmail-deleted-vector deleted-head)) | ||
| 2282 | (setq rmail-summary-vector | ||
| 2283 | (vconcat rmail-summary-vector (make-vector total-messages nil))) | ||
| 2284 | (setq rmail-msgref-vector | ||
| 2285 | (vconcat rmail-msgref-vector (make-vector total-messages nil))) | ||
| 2286 | ;; Fill in the new elements of rmail-msgref-vector. | ||
| 2287 | (let ((i (1+ (- rmail-total-messages total-messages)))) | ||
| 2288 | (while (<= i rmail-total-messages) | ||
| 2289 | (aset rmail-msgref-vector i (list i)) | ||
| 2290 | (setq i (1+ i)))) | ||
| 2291 | (goto-char (point-min)) | ||
| 2292 | (or nomsg (message "Counting new messages...done (%d)" total-messages)))) | ||
| 2293 | |||
| 2294 | (defun rmail-set-message-counters () | ||
| 2295 | (rmail-forget-messages) | ||
| 2296 | (save-excursion | ||
| 2297 | (save-restriction | ||
| 2298 | (widen) | ||
| 2299 | (let* ((point-save (point)) | ||
| 2300 | (total-messages 0) | ||
| 2301 | (messages-after-point) | ||
| 2302 | (case-fold-search nil) | ||
| 2303 | (messages-head nil) | ||
| 2304 | (deleted-head nil)) | ||
| 2305 | ;; Determine how many messages follow point. | ||
| 2306 | (message "Counting messages...") | ||
| 2307 | (goto-char (point-max)) | ||
| 2308 | ;; Put at the end of messages-head | ||
| 2309 | ;; the entry for message N+1, which marks | ||
| 2310 | ;; the end of message N. (N = number of messages). | ||
| 2311 | (setq messages-head (list (point-marker))) | ||
| 2312 | (rmail-set-message-counters-counter (min (point) point-save)) | ||
| 2313 | (setq messages-after-point total-messages) | ||
| 2314 | |||
| 2315 | ;; Determine how many precede point. | ||
| 2316 | (rmail-set-message-counters-counter) | ||
| 2317 | (setq rmail-total-messages total-messages) | ||
| 2318 | (setq rmail-current-message | ||
| 2319 | (min total-messages | ||
| 2320 | (max 1 (- total-messages messages-after-point)))) | ||
| 2321 | (setq rmail-message-vector | ||
| 2322 | (apply 'vector (cons (point-min-marker) messages-head)) | ||
| 2323 | rmail-deleted-vector (concat "0" deleted-head) | ||
| 2324 | rmail-summary-vector (make-vector rmail-total-messages nil) | ||
| 2325 | rmail-msgref-vector (make-vector (1+ rmail-total-messages) nil)) | ||
| 2326 | (let ((i 0)) | ||
| 2327 | (while (<= i rmail-total-messages) | ||
| 2328 | (aset rmail-msgref-vector i (list i)) | ||
| 2329 | (setq i (1+ i)))) | ||
| 2330 | (let ((i 0)) | ||
| 2331 | (while (<= i rmail-total-messages) | ||
| 2332 | (rmail-set-message-deleted-p i (rmail-message-attr-p i ".D")) | ||
| 2333 | (setq i (1+ i)))) | ||
| 2334 | (message "Counting messages...done"))))) | ||
| 2335 | |||
| 2336 | |||
| 2337 | (defsubst rmail-collect-deleted (message-end) | ||
| 2338 | "Collect the message deletion flags for each message. | ||
| 2339 | MESSAGE-END is the buffer position corresponding to the end of | ||
| 2340 | the message. Point is at the beginning of the message." | ||
| 2341 | ;; NOTE: This piece of code will be executed on a per-message basis. | ||
| 2342 | ;; In the face of thousands of messages, it has to be as fast as | ||
| 2343 | ;; possible, hence some brute force constant use is employed in | ||
| 2344 | ;; addition to inlining. | ||
| 2345 | (save-excursion | ||
| 2346 | (setq deleted-head | ||
| 2347 | (cons (if (and (search-forward (concat rmail-attribute-header ": ") message-end t) | ||
| 2348 | (looking-at "?D")) | ||
| 2349 | ?D | ||
| 2350 | ?\ ) deleted-head)))) | ||
| 2351 | |||
| 2352 | (defun rmail-set-message-counters-counter (&optional stop) | ||
| 2353 | ;; Collect the start position for each message into 'messages-head. | ||
| 2354 | (let ((start (point))) | ||
| 2355 | (while (search-backward "\n\nFrom " stop t) | ||
| 2356 | (forward-char 2) | ||
| 2357 | (rmail-collect-deleted start) | ||
| 2358 | (setq messages-head (cons (point-marker) messages-head) | ||
| 2359 | total-messages (1+ total-messages) | ||
| 2360 | start (point)) | ||
| 2361 | ;; Show progress after every 20 messages or so. | ||
| 2362 | (if (zerop (% total-messages 20)) | ||
| 2363 | (message "Counting messages...%d" total-messages))) | ||
| 2364 | ;; Handle the first message, maybe. | ||
| 2365 | (if stop | ||
| 2366 | (goto-char stop) | ||
| 2367 | (goto-char (point-min))) | ||
| 2368 | (unless (not (looking-at "From ")) | ||
| 2369 | (rmail-collect-deleted start) | ||
| 2370 | (setq messages-head (cons (point-marker) messages-head) | ||
| 2371 | total-messages (1+ total-messages))))) | ||
| 2372 | |||
| 2373 | ;; Display a message. | ||
| 2374 | |||
| 2375 | ;;;; *** Rmail Message Formatting and Header Manipulation *** | ||
| 2376 | |||
| 2377 | (defun rmail-toggle-header (&optional arg) | ||
| 2378 | "Show original message header if pruned header currently shown, or vice versa. | ||
| 2379 | With argument ARG, show the message header pruned if ARG is greater than zero; | ||
| 2380 | otherwise, show it in full." | ||
| 2381 | (interactive "P") | ||
| 2382 | (setq rmail-header-style | ||
| 2383 | (cond | ||
| 2384 | ((and (numberp arg) (> arg 0)) 'normal) | ||
| 2385 | ((eq rmail-header-style 'full) 'normal) | ||
| 2386 | (t 'full))) | ||
| 2387 | (rmail-show-message-maybe)) | ||
| 2388 | |||
| 2389 | (defun rmail-beginning-of-message () | ||
| 2390 | "Show current message starting from the beginning." | ||
| 2391 | (interactive) | ||
| 2392 | (let ((rmail-show-message-hook | ||
| 2393 | (list (function (lambda () | ||
| 2394 | (goto-char (point-min))))))) | ||
| 2395 | (rmail-show-message-maybe rmail-current-message))) | ||
| 2396 | |||
| 2397 | (defun rmail-end-of-message () | ||
| 2398 | "Show bottom of current message." | ||
| 2399 | (interactive) | ||
| 2400 | (let ((rmail-show-message-hook | ||
| 2401 | (list (function (lambda () | ||
| 2402 | (goto-char (point-max)) | ||
| 2403 | (recenter (1- (window-height)))))))) | ||
| 2404 | (rmail-show-message-maybe rmail-current-message))) | ||
| 2405 | |||
| 2406 | (defun rmail-unknown-mail-followup-to () | ||
| 2407 | "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. | ||
| 2408 | Ask the user whether to add that list name to `mail-mailing-lists'." | ||
| 2409 | (save-restriction | ||
| 2410 | (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) | ||
| 2411 | (when mail-followup-to | ||
| 2412 | (let ((addresses | ||
| 2413 | (split-string | ||
| 2414 | (mail-strip-quoted-names mail-followup-to) | ||
| 2415 | ",[[:space:]]+" t))) | ||
| 2416 | (dolist (addr addresses) | ||
| 2417 | (when (and (not (member addr mail-mailing-lists)) | ||
| 2418 | (not | ||
| 2419 | ;; taken from rmailsum.el | ||
| 2420 | (string-match | ||
| 2421 | (or rmail-user-mail-address-regexp | ||
| 2422 | (concat "^\\(" | ||
| 2423 | (regexp-quote (user-login-name)) | ||
| 2424 | "\\($\\|@\\)\\|" | ||
| 2425 | (regexp-quote | ||
| 2426 | (or user-mail-address | ||
| 2427 | (concat (user-login-name) "@" | ||
| 2428 | (or mail-host-address | ||
| 2429 | (system-name))))) | ||
| 2430 | "\\>\\)")) | ||
| 2431 | addr)) | ||
| 2432 | (y-or-n-p | ||
| 2433 | (format "Add `%s' to `mail-mailing-lists'? " | ||
| 2434 | addr))) | ||
| 2435 | (customize-save-variable 'mail-mailing-lists | ||
| 2436 | (cons addr mail-mailing-lists))))))))) | ||
| 2437 | |||
| 2438 | (defun rmail-widen () | ||
| 2439 | "Display the entire mailbox file." | ||
| 2440 | (interactive) | ||
| 2441 | (rmail-swap-buffers-maybe) | ||
| 2442 | (widen)) | ||
| 2443 | |||
| 2444 | (defun rmail-show-message-maybe (&optional n no-summary) | ||
| 2445 | "Show message number N (prefix argument), counting from start of file. | ||
| 2446 | If summary buffer is currently displayed, update current message there also." | ||
| 2447 | (interactive "p") | ||
| 2448 | (or (eq major-mode 'rmail-mode) | ||
| 2449 | (switch-to-buffer rmail-buffer)) | ||
| 2450 | (rmail-swap-buffers-maybe) | ||
| 2451 | (rmail-maybe-set-message-counters) | ||
| 2452 | (widen) | ||
| 2453 | (let ((msgnum (or n rmail-current-message)) | ||
| 2454 | blurb) | ||
| 2455 | (if (zerop rmail-total-messages) | ||
| 2456 | (save-excursion | ||
| 2457 | (with-current-buffer rmail-view-buffer | ||
| 2458 | (erase-buffer) | ||
| 2459 | (setq blurb "No mail."))) | ||
| 2460 | (setq blurb (rmail-show-message msgnum)) | ||
| 2461 | (when mail-mailing-lists | ||
| 2462 | (rmail-unknown-mail-followup-to)) | ||
| 2463 | (if transient-mark-mode (deactivate-mark)) | ||
| 2464 | ;; If there is a summary buffer, try to move to this message | ||
| 2465 | ;; in that buffer. But don't complain if this message | ||
| 2466 | ;; is not mentioned in the summary. | ||
| 2467 | ;; Don't do this at all if we were called on behalf | ||
| 2468 | ;; of cursor motion in the summary buffer. | ||
| 2469 | (and (rmail-summary-exists) (not no-summary) | ||
| 2470 | (let ((curr-msg rmail-current-message)) | ||
| 2471 | (rmail-select-summary | ||
| 2472 | (rmail-summary-goto-msg curr-msg t t)))) | ||
| 2473 | (with-current-buffer rmail-buffer | ||
| 2474 | (rmail-auto-file))) | ||
| 2475 | (if blurb | ||
| 2476 | (message blurb)))) | ||
| 2477 | |||
| 2478 | (defun rmail-is-text-p () | ||
| 2479 | "Return t if the region contains a text message, nil otherwise." | ||
| 2480 | (save-excursion | ||
| 2481 | (let ((text-regexp "\\(text\\|message\\)/") | ||
| 2482 | (content-type-header (mail-fetch-field "content-type"))) | ||
| 2483 | ;; The message is text if either there is no content type header | ||
| 2484 | ;; (a default of "text/plain; charset=US-ASCII" is assumed) or | ||
| 2485 | ;; the base content type is either text or message. | ||
| 2486 | (or (not content-type-header) | ||
| 2487 | (string-match text-regexp content-type-header))))) | ||
| 2488 | |||
| 2489 | (defun rmail-show-message (&optional msg) | ||
| 2490 | "Show message MSG using a special view buffer. | ||
| 2491 | Return text to display in the minibuffer if MSG is out of | ||
| 2492 | range (displaying a reasonable choice as well), nil otherwise. | ||
| 2493 | The current mail message becomes the message displayed." | ||
| 2494 | (let ((mbox-buf rmail-buffer) | ||
| 2495 | (view-buf rmail-view-buffer) | ||
| 2496 | blurb beg end body-start coding-system character-coding is-text-message) | ||
| 2497 | (if (not msg) | ||
| 2498 | (setq msg rmail-current-message)) | ||
| 2499 | (cond ((<= msg 0) | ||
| 2500 | (setq msg 1 | ||
| 2501 | rmail-current-message 1 | ||
| 2502 | blurb "No previous message")) | ||
| 2503 | ((> msg rmail-total-messages) | ||
| 2504 | (setq msg rmail-total-messages | ||
| 2505 | rmail-current-message rmail-total-messages | ||
| 2506 | blurb "No following message")) | ||
| 2507 | (t (setq rmail-current-message msg))) | ||
| 2508 | (with-current-buffer rmail-buffer | ||
| 2509 | ;; Mark the message as seen, bracket the message in the mail | ||
| 2510 | ;; buffer and determine the coding system the transfer encoding. | ||
| 2511 | (rmail-set-attribute rmail-unseen-attr-index nil) | ||
| 2512 | (rmail-swap-buffers-maybe) | ||
| 2513 | (setq beg (rmail-msgbeg msg) | ||
| 2514 | end (rmail-msgend msg)) | ||
| 2515 | (narrow-to-region beg end) | ||
| 2516 | (goto-char beg) | ||
| 2517 | (setq body-start (search-forward "\n\n" nil t)) | ||
| 2518 | (narrow-to-region beg (point)) | ||
| 2519 | (goto-char beg) | ||
| 2520 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | ||
| 2521 | is-text-message (rmail-is-text-p) | ||
| 2522 | coding-system (rmail-get-coding-system)) | ||
| 2523 | (if character-coding | ||
| 2524 | (setq character-coding (downcase character-coding))) | ||
| 2525 | (narrow-to-region beg end) | ||
| 2526 | ;; Decode the message body into an empty view buffer using a | ||
| 2527 | ;; unibyte temporary buffer where the character decoding takes | ||
| 2528 | ;; place. | ||
| 2529 | (with-current-buffer rmail-view-buffer | ||
| 2530 | (erase-buffer)) | ||
| 2531 | (if (null character-coding) | ||
| 2532 | ;; Do it directly since that is fast. | ||
| 2533 | (rmail-decode-region body-start end coding-system view-buf) | ||
| 2534 | ;; Can this be done directly, skipping the temp buffer? | ||
| 2535 | (with-temp-buffer | ||
| 2536 | (set-buffer-multibyte nil) | ||
| 2537 | (insert-buffer-substring mbox-buf body-start end) | ||
| 2538 | (cond | ||
| 2539 | ((string= character-coding "quoted-printable") | ||
| 2540 | (mail-unquote-printable-region (point-min) (point-max))) | ||
| 2541 | ((and (string= character-coding "base64") is-text-message) | ||
| 2542 | (base64-decode-region (point-min) (point-max))) | ||
| 2543 | ((eq character-coding 'uuencode) | ||
| 2544 | (error "Not supported yet")) | ||
| 2545 | (t)) | ||
| 2546 | (rmail-decode-region (point-min) (point-max) | ||
| 2547 | coding-system view-buf))) | ||
| 2548 | ;; Copy the headers to the front of the message view buffer. | ||
| 2549 | (with-current-buffer rmail-view-buffer | ||
| 2550 | (goto-char (point-min))) | ||
| 2551 | (rmail-copy-headers beg end) | ||
| 2552 | ;; Add the separator (blank line) between headers and body; | ||
| 2553 | ;; highlight the message, activate any URL like text and add | ||
| 2554 | ;; special highlighting for and quoted material. | ||
| 2555 | (with-current-buffer rmail-view-buffer | ||
| 2556 | (insert "\n") | ||
| 2557 | (goto-char (point-min)) | ||
| 2558 | (rmail-highlight-headers) | ||
| 2559 | ;(rmail-activate-urls) | ||
| 2560 | ;(rmail-process-quoted-material) | ||
| 2561 | ) | ||
| 2562 | ;; Update the mode-line with message status information and swap | ||
| 2563 | ;; the view buffer/mail buffer contents. | ||
| 2564 | (rmail-display-labels) | ||
| 2565 | (let ((modp (buffer-modified-p))) | ||
| 2566 | (buffer-swap-text rmail-view-buffer) | ||
| 2567 | (set-buffer-modified-p modp)) | ||
| 2568 | (setq rmail-buffer-swapped t) | ||
| 2569 | (run-hooks 'rmail-show-message-hook)) | ||
| 2570 | blurb)) | ||
| 2571 | |||
| 2572 | (defun rmail-copy-headers (beg end &optional ignored-headers) | ||
| 2573 | "Copy displayed header fields to the message viewer buffer. | ||
| 2574 | BEG and END marks the start and end positions of the message in | ||
| 2575 | the mbox buffer. If the optional argument IGNORED-HEADERS is | ||
| 2576 | non-nil, ignore all header fields whose names match that regexp. | ||
| 2577 | Otherwise, if `rmail-displayed-headers' is non-nil, copy only | ||
| 2578 | those header fields whose names match that regexp. Otherwise, | ||
| 2579 | copy all header fields whose names do not match | ||
| 2580 | `rmail-ignored-headers' (unless they also match | ||
| 2581 | `rmail-nonignored-headers')." | ||
| 2582 | (let ((header-start-regexp "\n[^ \t]") | ||
| 2583 | lim) | ||
| 2584 | (with-current-buffer rmail-buffer | ||
| 2585 | (when (search-forward "\n\n" nil t) | ||
| 2586 | (forward-char -1) | ||
| 2587 | (save-restriction | ||
| 2588 | ;; Put point right after the From header line. | ||
| 2589 | (narrow-to-region beg (point)) | ||
| 2590 | (goto-char (point-min)) | ||
| 2591 | (unless (re-search-forward header-start-regexp nil t) | ||
| 2592 | (rmail-error-bad-format)) | ||
| 2593 | (forward-char -1) | ||
| 2594 | (cond | ||
| 2595 | ;; Handle the case where all headers should be copied. | ||
| 2596 | ((eq rmail-header-style 'full) | ||
| 2597 | (prepend-to-buffer rmail-view-buffer beg (point-max))) | ||
| 2598 | ;; Handle the case where the headers matching the diplayed | ||
| 2599 | ;; headers regexp should be copied. | ||
| 2600 | ((and rmail-displayed-headers (null ignored-headers)) | ||
| 2601 | (while (not (eobp)) | ||
| 2602 | (save-excursion | ||
| 2603 | (setq lim (if (re-search-forward header-start-regexp nil t) | ||
| 2604 | (1+ (match-beginning 0)) | ||
| 2605 | (point-max)))) | ||
| 2606 | (when (looking-at rmail-displayed-headers) | ||
| 2607 | (append-to-buffer rmail-view-buffer (point) lim)) | ||
| 2608 | (goto-char lim))) | ||
| 2609 | ;; Handle the ignored headers. | ||
| 2610 | ((or ignored-headers (setq ignored-headers rmail-ignored-headers)) | ||
| 2611 | (while (and ignored-headers (not (eobp))) | ||
| 2612 | (save-excursion | ||
| 2613 | (setq lim (if (re-search-forward header-start-regexp nil t) | ||
| 2614 | (1+ (match-beginning 0)) | ||
| 2615 | (point-max)))) | ||
| 2616 | (if (and (looking-at ignored-headers) | ||
| 2617 | (not (looking-at rmail-nonignored-headers))) | ||
| 2618 | (goto-char lim) | ||
| 2619 | (append-to-buffer rmail-view-buffer (point) lim) | ||
| 2620 | (goto-char lim)))) | ||
| 2621 | (t (error "No headers selected for display!")))))))) | ||
| 2622 | |||
| 2623 | ;; Find all occurrences of certain fields, and highlight them. | ||
| 2624 | (defun rmail-highlight-headers () | ||
| 2625 | ;; Do this only if the system supports faces. | ||
| 2626 | (if (and (fboundp 'internal-find-face) | ||
| 2627 | rmail-highlighted-headers) | ||
| 2628 | (save-excursion | ||
| 2629 | (search-forward "\n\n" nil 'move) | ||
| 2630 | (save-restriction | ||
| 2631 | (narrow-to-region (point-min) (point)) | ||
| 2632 | (let ((case-fold-search t) | ||
| 2633 | (inhibit-read-only t) | ||
| 2634 | ;; Highlight with boldface if that is available. | ||
| 2635 | ;; Otherwise use the `highlight' face. | ||
| 2636 | (face (or 'rmail-highlight | ||
| 2637 | (if (face-differs-from-default-p 'bold) | ||
| 2638 | 'bold 'highlight))) | ||
| 2639 | ;; List of overlays to reuse. | ||
| 2640 | (overlays rmail-overlay-list)) | ||
| 2641 | (goto-char (point-min)) | ||
| 2642 | (while (re-search-forward rmail-highlighted-headers nil t) | ||
| 2643 | (skip-chars-forward " \t") | ||
| 2644 | (let ((beg (point)) | ||
| 2645 | overlay) | ||
| 2646 | (while (progn (forward-line 1) | ||
| 2647 | (looking-at "[ \t]"))) | ||
| 2648 | ;; Back up over newline, then trailing spaces or tabs | ||
| 2649 | (forward-char -1) | ||
| 2650 | (while (member (preceding-char) '(? ?\t)) | ||
| 2651 | (forward-char -1)) | ||
| 2652 | (if overlays | ||
| 2653 | ;; Reuse an overlay we already have. | ||
| 2654 | (progn | ||
| 2655 | (setq overlay (car overlays) | ||
| 2656 | overlays (cdr overlays)) | ||
| 2657 | (overlay-put overlay 'face face) | ||
| 2658 | (move-overlay overlay beg (point))) | ||
| 2659 | ;; Make a new overlay and add it to | ||
| 2660 | ;; rmail-overlay-list. | ||
| 2661 | (setq overlay (make-overlay beg (point))) | ||
| 2662 | (overlay-put overlay 'face face) | ||
| 2663 | (setq rmail-overlay-list | ||
| 2664 | (cons overlay rmail-overlay-list)))))))))) | ||
| 2665 | |||
| 2666 | (defun rmail-auto-file () | ||
| 2667 | "Automatically move a message into a sub-folder based on criteria. | ||
| 2668 | Called when a new message is displayed." | ||
| 2669 | (if (or (zerop rmail-total-messages) | ||
| 2670 | (rmail-message-attr-p rmail-current-message "...F") | ||
| 2671 | (not (string= (buffer-file-name) | ||
| 2672 | (expand-file-name rmail-file-name)))) | ||
| 2673 | ;; Do nothing if the message has already been filed or if there | ||
| 2674 | ;; are no messages. | ||
| 2675 | nil | ||
| 2676 | ;; Find out some basics (common fields) | ||
| 2677 | (let ((from (mail-fetch-field "from")) | ||
| 2678 | (subj (mail-fetch-field "subject")) | ||
| 2679 | (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) | ||
| 2680 | (d rmail-automatic-folder-directives) | ||
| 2681 | (directive-loop nil) | ||
| 2682 | (folder nil)) | ||
| 2683 | (while d | ||
| 2684 | (setq folder (car (car d)) | ||
| 2685 | directive-loop (cdr (car d))) | ||
| 2686 | (while (and (car directive-loop) | ||
| 2687 | (let ((f (cond | ||
| 2688 | ((string= (car directive-loop) "from") from) | ||
| 2689 | ((string= (car directive-loop) "to") to) | ||
| 2690 | ((string= (car directive-loop) "subject") subj) | ||
| 2691 | (t (mail-fetch-field (car directive-loop)))))) | ||
| 2692 | (and f (string-match (car (cdr directive-loop)) f)))) | ||
| 2693 | (setq directive-loop (cdr (cdr directive-loop)))) | ||
| 2694 | ;; If there are no directives left, then it was a complete match. | ||
| 2695 | (if (null directive-loop) | ||
| 2696 | (if (null folder) | ||
| 2697 | (rmail-delete-forward) | ||
| 2698 | (if (string= "/dev/null" folder) | ||
| 2699 | (rmail-delete-message) | ||
| 2700 | (rmail-output folder 1 t) | ||
| 2701 | (setq d nil)))) | ||
| 2702 | (setq d (cdr d)))))) | ||
| 2703 | |||
| 2704 | ;; Simple message motion commands. | ||
| 2705 | |||
| 2706 | (defun rmail-next-message (n) | ||
| 2707 | "Show following message whether deleted or not. | ||
| 2708 | With prefix arg N, moves forward N messages, or backward if N is negative." | ||
| 2709 | (interactive "p") | ||
| 2710 | (set-buffer rmail-buffer) | ||
| 2711 | (rmail-maybe-set-message-counters) | ||
| 2712 | (rmail-show-message-maybe (+ rmail-current-message n))) | ||
| 2713 | |||
| 2714 | (defun rmail-previous-message (n) | ||
| 2715 | "Show previous message whether deleted or not. | ||
| 2716 | With prefix arg N, moves backward N messages, or forward if N is negative." | ||
| 2717 | (interactive "p") | ||
| 2718 | (rmail-next-message (- n))) | ||
| 2719 | |||
| 2720 | (defun rmail-next-undeleted-message (n) | ||
| 2721 | "Show following non-deleted message. | ||
| 2722 | With prefix arg N, moves forward N non-deleted messages, | ||
| 2723 | or backward if N is negative. | ||
| 2724 | |||
| 2725 | Returns t if a new message is being shown, nil otherwise." | ||
| 2726 | (interactive "p") | ||
| 2727 | (set-buffer rmail-buffer) | ||
| 2728 | (rmail-maybe-set-message-counters) | ||
| 2729 | (let ((lastwin rmail-current-message) | ||
| 2730 | (current rmail-current-message)) | ||
| 2731 | (while (and (> n 0) (< current rmail-total-messages)) | ||
| 2732 | (setq current (1+ current)) | ||
| 2733 | (if (not (rmail-message-deleted-p current)) | ||
| 2734 | (setq lastwin current n (1- n)))) | ||
| 2735 | (while (and (< n 0) (> current 1)) | ||
| 2736 | (setq current (1- current)) | ||
| 2737 | (if (not (rmail-message-deleted-p current)) | ||
| 2738 | (setq lastwin current n (1+ n)))) | ||
| 2739 | (if (/= lastwin rmail-current-message) | ||
| 2740 | (progn (rmail-show-message-maybe lastwin) | ||
| 2741 | t) | ||
| 2742 | (if (< n 0) | ||
| 2743 | (message "No previous nondeleted message")) | ||
| 2744 | (if (> n 0) | ||
| 2745 | (message "No following nondeleted message")) | ||
| 2746 | nil))) | ||
| 2747 | |||
| 2748 | (defun rmail-previous-undeleted-message (n) | ||
| 2749 | "Show previous non-deleted message. | ||
| 2750 | With prefix argument N, moves backward N non-deleted messages, | ||
| 2751 | or forward if N is negative." | ||
| 2752 | (interactive "p") | ||
| 2753 | (rmail-next-undeleted-message (- n))) | ||
| 2754 | |||
| 2755 | (defun rmail-first-message () | ||
| 2756 | "Show first message in file." | ||
| 2757 | (interactive) | ||
| 2758 | (rmail-maybe-set-message-counters) | ||
| 2759 | (rmail-show-message-maybe (< 1 rmail-total-messages))) | ||
| 2760 | |||
| 2761 | (defun rmail-last-message () | ||
| 2762 | "Show last message in file." | ||
| 2763 | (interactive) | ||
| 2764 | (rmail-maybe-set-message-counters) | ||
| 2765 | (rmail-show-message-maybe rmail-total-messages)) | ||
| 2766 | |||
| 2767 | (defun rmail-what-message () | ||
| 2768 | "For debugging Rmail: find the message number that point is in." | ||
| 2769 | (let ((where (point)) | ||
| 2770 | (low 1) | ||
| 2771 | (high rmail-total-messages) | ||
| 2772 | (mid (/ rmail-total-messages 2))) | ||
| 2773 | (while (> (- high low) 1) | ||
| 2774 | (if (>= where (rmail-msgbeg mid)) | ||
| 2775 | (setq low mid) | ||
| 2776 | (setq high mid)) | ||
| 2777 | (setq mid (+ low (/ (- high low) 2)))) | ||
| 2778 | (if (>= where (rmail-msgbeg high)) high low))) | ||
| 2779 | |||
| 2780 | ;; Searching in Rmail file. | ||
| 2781 | |||
| 2782 | (defun rmail-search-message (msg regexp) | ||
| 2783 | "Return non-nil, if for message number MSG, regexp REGEXP matches." | ||
| 2784 | ;; This is adequate because its only caller, rmail-search, | ||
| 2785 | ;; unswaps the buffers. | ||
| 2786 | (goto-char (rmail-msgbeg msg)) | ||
| 2787 | (if rmail-enable-mime | ||
| 2788 | (funcall rmail-search-mime-message-function msg regexp) | ||
| 2789 | (re-search-forward regexp (rmail-msgend msg) t))) | ||
| 2790 | |||
| 2791 | (defvar rmail-search-last-regexp nil) | ||
| 2792 | (defun rmail-search (regexp &optional n) | ||
| 2793 | "Show message containing next match for REGEXP (but not the current msg). | ||
| 2794 | Prefix argument gives repeat count; negative argument means search | ||
| 2795 | backwards (through earlier messages). | ||
| 2796 | Interactively, empty argument means use same regexp used last time." | ||
| 2797 | (interactive | ||
| 2798 | (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) | ||
| 2799 | (prompt | ||
| 2800 | (concat (if reversep "Reverse " "") "Rmail search (regexp")) | ||
| 2801 | regexp) | ||
| 2802 | (setq prompt | ||
| 2803 | (concat prompt | ||
| 2804 | (if rmail-search-last-regexp | ||
| 2805 | (concat ", default " | ||
| 2806 | rmail-search-last-regexp "): ") | ||
| 2807 | "): "))) | ||
| 2808 | (setq regexp (read-string prompt)) | ||
| 2809 | (cond ((not (equal regexp "")) | ||
| 2810 | (setq rmail-search-last-regexp regexp)) | ||
| 2811 | ((not rmail-search-last-regexp) | ||
| 2812 | (error "No previous Rmail search string"))) | ||
| 2813 | (list rmail-search-last-regexp | ||
| 2814 | (prefix-numeric-value current-prefix-arg)))) | ||
| 2815 | (or n (setq n 1)) | ||
| 2816 | (message "%sRmail search for %s..." | ||
| 2817 | (if (< n 0) "Reverse " "") | ||
| 2818 | regexp) | ||
| 2819 | (set-buffer rmail-buffer) | ||
| 2820 | (let ((orig-message rmail-current-message) | ||
| 2821 | (msg rmail-current-message) | ||
| 2822 | (reversep (< n 0)) | ||
| 2823 | (opoint (if (rmail-buffers-swapped-p) (point))) | ||
| 2824 | found) | ||
| 2825 | (rmail-swap-buffers-maybe) | ||
| 2826 | (rmail-maybe-set-message-counters) | ||
| 2827 | (widen) | ||
| 2828 | (unwind-protect | ||
| 2829 | (while (/= n 0) | ||
| 2830 | ;; Check messages one by one, advancing message number up or | ||
| 2831 | ;; down but searching forward through each message. | ||
| 2832 | (if reversep | ||
| 2833 | (while (and (null found) (> msg 1)) | ||
| 2834 | (setq msg (1- msg) | ||
| 2835 | found (rmail-search-message msg regexp))) | ||
| 2836 | (while (and (null found) (< msg rmail-total-messages)) | ||
| 2837 | (setq msg (1+ msg) | ||
| 2838 | found (rmail-search-message msg regexp)))) | ||
| 2839 | (setq n (+ n (if reversep 1 -1)))) | ||
| 2840 | (if found | ||
| 2841 | (progn | ||
| 2842 | (rmail-show-message-maybe msg) | ||
| 2843 | ;; Search forward (if this is a normal search) or backward | ||
| 2844 | ;; (if this is a reverse search) through this message to | ||
| 2845 | ;; position point. This search may fail because REGEXP | ||
| 2846 | ;; was found in the hidden portion of this message. In | ||
| 2847 | ;; that case, move point to the beginning of visible | ||
| 2848 | ;; portion. | ||
| 2849 | (if reversep | ||
| 2850 | (progn | ||
| 2851 | (goto-char (point-max)) | ||
| 2852 | (re-search-backward regexp nil 'move)) | ||
| 2853 | (goto-char (point-min)) | ||
| 2854 | (re-search-forward regexp nil t)) | ||
| 2855 | (message "%sRmail search for %s...done" | ||
| 2856 | (if reversep "Reverse " "") | ||
| 2857 | regexp)) | ||
| 2858 | (rmail-show-message-maybe orig-message) | ||
| 2859 | (if opoint (goto-char opoint)) | ||
| 2860 | (ding) | ||
| 2861 | (message "Search failed: %s" regexp))))) | ||
| 2862 | |||
| 2863 | (defun rmail-search-backwards (regexp &optional n) | ||
| 2864 | "Show message containing previous match for REGEXP. | ||
| 2865 | Prefix argument gives repeat count; negative argument means search | ||
| 2866 | forward (through later messages). | ||
| 2867 | Interactively, empty argument means use same regexp used last time." | ||
| 2868 | (interactive | ||
| 2869 | (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) | ||
| 2870 | (prompt | ||
| 2871 | (concat (if reversep "Reverse " "") "Rmail search (regexp")) | ||
| 2872 | regexp) | ||
| 2873 | (setq prompt | ||
| 2874 | (concat prompt | ||
| 2875 | (if rmail-search-last-regexp | ||
| 2876 | (concat ", default " | ||
| 2877 | rmail-search-last-regexp "): ") | ||
| 2878 | "): "))) | ||
| 2879 | (setq regexp (read-string prompt)) | ||
| 2880 | (cond ((not (equal regexp "")) | ||
| 2881 | (setq rmail-search-last-regexp regexp)) | ||
| 2882 | ((not rmail-search-last-regexp) | ||
| 2883 | (error "No previous Rmail search string"))) | ||
| 2884 | (list rmail-search-last-regexp | ||
| 2885 | (prefix-numeric-value current-prefix-arg)))) | ||
| 2886 | (rmail-search regexp (- (or n 1)))) | ||
| 2887 | |||
| 2888 | ;; Scan for attributes, and compare subjects. | ||
| 2889 | |||
| 2890 | (defun rmail-first-unseen-message () | ||
| 2891 | "Return message number of first message which has `unseen' attribute." | ||
| 2892 | (rmail-maybe-set-message-counters) | ||
| 2893 | (let ((current 1) | ||
| 2894 | found) | ||
| 2895 | (save-restriction | ||
| 2896 | (widen) | ||
| 2897 | (while (and (not found) (<= current rmail-total-messages)) | ||
| 2898 | (if (rmail-message-attr-p current "......U") | ||
| 2899 | (setq found current)) | ||
| 2900 | (setq current (1+ current)))) | ||
| 2901 | found)) | ||
| 2902 | |||
| 2903 | (defun rmail-simplified-subject (&optional msgnum) | ||
| 2904 | "Return the simplified subject of message MSGNUM (or current message). | ||
| 2905 | Simplifying the subject means stripping leading and trailing whitespace, | ||
| 2906 | and typical reply prefixes such as Re:." | ||
| 2907 | (let ((subject (or (rmail-get-header "Subject" msgnum) ""))) | ||
| 2908 | (if (string-match "\\`[ \t]+" subject) | ||
| 2909 | (setq subject (substring subject (match-end 0)))) | ||
| 2910 | (if (string-match rmail-reply-regexp subject) | ||
| 2911 | (setq subject (substring subject (match-end 0)))) | ||
| 2912 | (if (string-match "[ \t]+\\'" subject) | ||
| 2913 | (setq subject (substring subject 0 (match-beginning 0)))) | ||
| 2914 | subject)) | ||
| 2915 | |||
| 2916 | (defun rmail-simplified-subject-regexp () | ||
| 2917 | "Return a regular expression matching the current simplified subject. | ||
| 2918 | The idea is to match it against simplified subjects of other messages." | ||
| 2919 | (let ((subject (rmail-simplified-subject))) | ||
| 2920 | (setq subject (regexp-quote subject)) | ||
| 2921 | ;; Hide commas so it will work ok if parsed as a comma-separated list | ||
| 2922 | ;; of regexps. | ||
| 2923 | (setq subject | ||
| 2924 | (replace-regexp-in-string "," "\054" subject t t)) | ||
| 2925 | (concat "\\`" subject "\\'"))) | ||
| 2926 | |||
| 2927 | (defun rmail-next-same-subject (n) | ||
| 2928 | "Go to the next mail message having the same subject header. | ||
| 2929 | With prefix argument N, do this N times. | ||
| 2930 | If N is negative, go backwards instead." | ||
| 2931 | (interactive "p") | ||
| 2932 | (let ((subject (rmail-simplified-subject)) | ||
| 2933 | (forward (> n 0)) | ||
| 2934 | (i rmail-current-message) | ||
| 2935 | found) | ||
| 2936 | (while (and (/= n 0) | ||
| 2937 | (if forward | ||
| 2938 | (< i rmail-total-messages) | ||
| 2939 | (> i 1))) | ||
| 2940 | (let (done) | ||
| 2941 | (while (and (not done) | ||
| 2942 | (if forward | ||
| 2943 | (< i rmail-total-messages) | ||
| 2944 | (> i 1))) | ||
| 2945 | (setq i (if forward (1+ i) (1- i))) | ||
| 2946 | (setq done (string-equal subject (rmail-simplified-subject i)))) | ||
| 2947 | (if done (setq found i))) | ||
| 2948 | (setq n (if forward (1- n) (1+ n)))) | ||
| 2949 | (if found | ||
| 2950 | (rmail-show-message-maybe found) | ||
| 2951 | (error "No %s message with same subject" | ||
| 2952 | (if forward "following" "previous"))))) | ||
| 2953 | |||
| 2954 | (defun rmail-previous-same-subject (n) | ||
| 2955 | "Go to the previous mail message having the same subject header. | ||
| 2956 | With prefix argument N, do this N times. | ||
| 2957 | If N is negative, go forwards instead." | ||
| 2958 | (interactive "p") | ||
| 2959 | (rmail-next-same-subject (- n))) | ||
| 2960 | |||
| 2961 | ;;;; *** Rmail Message Deletion Commands *** | ||
| 2962 | |||
| 2963 | (defun rmail-message-deleted-p (n) | ||
| 2964 | (= (aref rmail-deleted-vector n) ?D)) | ||
| 2965 | |||
| 2966 | (defun rmail-set-message-deleted-p (n state) | ||
| 2967 | (aset rmail-deleted-vector n (if state ?D ?\ ))) | ||
| 2968 | |||
| 2969 | (defun rmail-delete-message () | ||
| 2970 | "Delete this message and stay on it." | ||
| 2971 | (interactive) | ||
| 2972 | (rmail-set-attribute rmail-deleted-attr-index t) | ||
| 2973 | (run-hooks 'rmail-delete-message-hook)) | ||
| 2974 | |||
| 2975 | (defun rmail-undelete-previous-message () | ||
| 2976 | "Back up to deleted message, select it, and undelete it." | ||
| 2977 | (interactive) | ||
| 2978 | (set-buffer rmail-buffer) | ||
| 2979 | (let ((msg rmail-current-message)) | ||
| 2980 | (while (and (> msg 0) | ||
| 2981 | (not (rmail-message-deleted-p msg))) | ||
| 2982 | (setq msg (1- msg))) | ||
| 2983 | (if (= msg 0) | ||
| 2984 | (error "No previous deleted message") | ||
| 2985 | (if (/= msg rmail-current-message) | ||
| 2986 | (rmail-show-message-maybe msg)) | ||
| 2987 | (rmail-set-attribute rmail-deleted-attr-index nil) | ||
| 2988 | (if (rmail-summary-exists) | ||
| 2989 | (save-excursion | ||
| 2990 | (set-buffer rmail-summary-buffer) | ||
| 2991 | (rmail-summary-mark-undeleted msg))) | ||
| 2992 | (rmail-maybe-display-summary)))) | ||
| 2993 | |||
| 2994 | (defun rmail-delete-forward (&optional backward) | ||
| 2995 | "Delete this message and move to next nondeleted one. | ||
| 2996 | Deleted messages stay in the file until the \\[rmail-expunge] command is given. | ||
| 2997 | With prefix argument, delete and move backward. | ||
| 2998 | |||
| 2999 | Returns t if a new message is displayed after the delete, or nil otherwise." | ||
| 3000 | (interactive "P") | ||
| 3001 | (rmail-set-attribute rmail-deleted-attr-index t) | ||
| 3002 | (run-hooks 'rmail-delete-message-hook) | ||
| 3003 | (let ((del-msg rmail-current-message)) | ||
| 3004 | (if (rmail-summary-exists) | ||
| 3005 | (rmail-select-summary | ||
| 3006 | (rmail-summary-mark-deleted del-msg))) | ||
| 3007 | (prog1 (rmail-next-undeleted-message (if backward -1 1)) | ||
| 3008 | (rmail-maybe-display-summary)))) | ||
| 3009 | |||
| 3010 | (defun rmail-delete-backward () | ||
| 3011 | "Delete this message and move to previous nondeleted one. | ||
| 3012 | Deleted messages stay in the file until the \\[rmail-expunge] command is given." | ||
| 3013 | (interactive) | ||
| 3014 | (rmail-delete-forward t)) | ||
| 3015 | |||
| 3016 | ;; Expunging. | ||
| 3017 | |||
| 3018 | ;; Compute the message number a given message would have after expunging. | ||
| 3019 | ;; The present number of the message is OLDNUM. | ||
| 3020 | ;; DELETEDVEC should be rmail-deleted-vector. | ||
| 3021 | ;; The value is nil for a message that would be deleted. | ||
| 3022 | (defun rmail-msg-number-after-expunge (deletedvec oldnum) | ||
| 3023 | (if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) | ||
| 3024 | nil | ||
| 3025 | (let ((i 0) | ||
| 3026 | (newnum 0)) | ||
| 3027 | (while (< i oldnum) | ||
| 3028 | (if (/= (aref deletedvec i) ?D) | ||
| 3029 | (setq newnum (1+ newnum))) | ||
| 3030 | (setq i (1+ i))) | ||
| 3031 | newnum))) | ||
| 3032 | |||
| 3033 | (defun rmail-expunge-confirmed () | ||
| 3034 | "Return t if deleted message should be expunged. If necessary, ask the user. | ||
| 3035 | See also user-option `rmail-confirm-expunge'." | ||
| 3036 | (set-buffer rmail-buffer) | ||
| 3037 | (or (not (stringp rmail-deleted-vector)) | ||
| 3038 | (not (string-match "D" rmail-deleted-vector)) | ||
| 3039 | (null rmail-confirm-expunge) | ||
| 3040 | (funcall rmail-confirm-expunge | ||
| 3041 | "Erase deleted messages from Rmail file? "))) | ||
| 3042 | |||
| 3043 | (defun rmail-only-expunge (&optional dont-show) | ||
| 3044 | "Actually erase all deleted messages in the file." | ||
| 3045 | (interactive) | ||
| 3046 | (rmail-swap-buffers-maybe) | ||
| 3047 | (set-buffer rmail-buffer) | ||
| 3048 | (message "Expunging deleted messages...") | ||
| 3049 | ;; Discard all undo records for this buffer. | ||
| 3050 | (or (eq buffer-undo-list t) | ||
| 3051 | (setq buffer-undo-list nil)) | ||
| 3052 | (rmail-maybe-set-message-counters) | ||
| 3053 | (let* ((omax (- (buffer-size) (point-max))) | ||
| 3054 | (omin (- (buffer-size) (point-min))) | ||
| 3055 | (opoint (if (and (> rmail-current-message 0) | ||
| 3056 | (rmail-message-deleted-p rmail-current-message)) | ||
| 3057 | 0 | ||
| 3058 | (if rmail-enable-mime | ||
| 3059 | (with-current-buffer rmail-view-buffer | ||
| 3060 | (- (point)(point-min))) | ||
| 3061 | (- (point) (point-min))))) | ||
| 3062 | (messages-head (cons (aref rmail-message-vector 0) nil)) | ||
| 3063 | (messages-tail messages-head) | ||
| 3064 | ;; Don't make any undo records for the expunging. | ||
| 3065 | (buffer-undo-list t) | ||
| 3066 | (win)) | ||
| 3067 | (unwind-protect | ||
| 3068 | (save-excursion | ||
| 3069 | (widen) | ||
| 3070 | (goto-char (point-min)) | ||
| 3071 | (let ((counter 0) | ||
| 3072 | (number 1) | ||
| 3073 | new-summary | ||
| 3074 | (new-msgref (list (list 0))) | ||
| 3075 | (buffer-read-only nil) | ||
| 3076 | (total rmail-total-messages) | ||
| 3077 | (new-message-number rmail-current-message) | ||
| 3078 | (messages rmail-message-vector) | ||
| 3079 | (deleted rmail-deleted-vector) | ||
| 3080 | (summary rmail-summary-vector)) | ||
| 3081 | (setq rmail-total-messages nil | ||
| 3082 | rmail-current-message nil | ||
| 3083 | rmail-message-vector nil | ||
| 3084 | rmail-deleted-vector nil | ||
| 3085 | rmail-summary-vector nil) | ||
| 3086 | |||
| 3087 | (while (<= number total) | ||
| 3088 | (if (= (aref deleted number) ?D) | ||
| 3089 | (progn | ||
| 3090 | (delete-region (aref messages number) | ||
| 3091 | (aref messages (1+ number))) | ||
| 3092 | (move-marker (aref messages number) nil) | ||
| 3093 | (if (> new-message-number counter) | ||
| 3094 | (setq new-message-number (1- new-message-number)))) | ||
| 3095 | (setq counter (1+ counter)) | ||
| 3096 | (setq messages-tail | ||
| 3097 | (setcdr messages-tail | ||
| 3098 | (cons (aref messages number) nil))) | ||
| 3099 | (setq new-summary | ||
| 3100 | (cons (if (= counter number) (aref summary (1- number))) | ||
| 3101 | new-summary)) | ||
| 3102 | (setq new-msgref | ||
| 3103 | (cons (aref rmail-msgref-vector number) | ||
| 3104 | new-msgref)) | ||
| 3105 | (setcar (car new-msgref) counter)) | ||
| 3106 | (if (zerop (% (setq number (1+ number)) 20)) | ||
| 3107 | (message "Expunging deleted messages...%d" number))) | ||
| 3108 | (setq messages-tail | ||
| 3109 | (setcdr messages-tail | ||
| 3110 | (cons (aref messages number) nil))) | ||
| 3111 | (setq rmail-current-message new-message-number | ||
| 3112 | rmail-total-messages counter | ||
| 3113 | rmail-message-vector (apply 'vector messages-head) | ||
| 3114 | rmail-deleted-vector (make-string (1+ counter) ?\ ) | ||
| 3115 | rmail-summary-vector (vconcat (nreverse new-summary)) | ||
| 3116 | rmail-msgref-vector (apply 'vector (nreverse new-msgref)) | ||
| 3117 | win t))) | ||
| 3118 | (message "Expunging deleted messages...done") | ||
| 3119 | (if (not win) | ||
| 3120 | (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) | ||
| 3121 | (if (not dont-show) | ||
| 3122 | (rmail-show-message-maybe (min rmail-current-message rmail-total-messages))) | ||
| 3123 | (if rmail-enable-mime | ||
| 3124 | (goto-char (+ (point-min) opoint)) | ||
| 3125 | (goto-char (+ (point) opoint)))))) | ||
| 3126 | |||
| 3127 | (defun rmail-expunge (&optional dont-show) | ||
| 3128 | "Erase deleted messages from Rmail file and summary buffer." | ||
| 3129 | (interactive) | ||
| 3130 | (when (rmail-expunge-confirmed) | ||
| 3131 | (let ((old-total rmail-total-messages) | ||
| 3132 | (opoint (with-current-buffer rmail-buffer | ||
| 3133 | (when (rmail-buffers-swapped-p) | ||
| 3134 | (point))))) | ||
| 3135 | (rmail-only-expunge dont-show) | ||
| 3136 | (if (rmail-summary-exists) | ||
| 3137 | (rmail-select-summary (rmail-update-summary)) | ||
| 3138 | (rmail-show-message rmail-current-message) | ||
| 3139 | (if (and (eq old-total rmail-total-messages) opoint) | ||
| 3140 | (goto-char opoint)))))) | ||
| 3141 | |||
| 3142 | ;;;; *** Rmail Mailing Commands *** | ||
| 3143 | |||
| 3144 | (defun rmail-start-mail (&optional noerase to subject in-reply-to cc | ||
| 3145 | replybuffer sendactions same-window others) | ||
| 3146 | (let (yank-action) | ||
| 3147 | (if replybuffer | ||
| 3148 | (setq yank-action (list 'insert-buffer replybuffer))) | ||
| 3149 | (setq others (cons (cons "cc" cc) others)) | ||
| 3150 | (setq others (cons (cons "in-reply-to" in-reply-to) others)) | ||
| 3151 | (if same-window | ||
| 3152 | (compose-mail to subject others | ||
| 3153 | noerase nil | ||
| 3154 | yank-action sendactions) | ||
| 3155 | (if rmail-mail-new-frame | ||
| 3156 | (prog1 | ||
| 3157 | (compose-mail to subject others | ||
| 3158 | noerase 'switch-to-buffer-other-frame | ||
| 3159 | yank-action sendactions) | ||
| 3160 | ;; This is not a standard frame parameter; | ||
| 3161 | ;; nothing except sendmail.el looks at it. | ||
| 3162 | (modify-frame-parameters (selected-frame) | ||
| 3163 | '((mail-dedicated-frame . t)))) | ||
| 3164 | (compose-mail to subject others | ||
| 3165 | noerase 'switch-to-buffer-other-window | ||
| 3166 | yank-action sendactions))))) | ||
| 3167 | |||
| 3168 | (defun rmail-mail () | ||
| 3169 | "Send mail in another window. | ||
| 3170 | While composing the message, use \\[mail-yank-original] to yank the | ||
| 3171 | original message into it." | ||
| 3172 | (interactive) | ||
| 3173 | (rmail-start-mail nil nil nil nil nil rmail-view-buffer)) | ||
| 3174 | |||
| 3175 | (defun rmail-continue () | ||
| 3176 | "Continue composing outgoing message previously being composed." | ||
| 3177 | (interactive) | ||
| 3178 | (rmail-start-mail t)) | ||
| 3179 | |||
| 3180 | (defun rmail-reply (just-sender) | ||
| 3181 | "Reply to the current message. | ||
| 3182 | Normally include CC: to all other recipients of original message; | ||
| 3183 | prefix argument means ignore them. While composing the reply, | ||
| 3184 | use \\[mail-yank-original] to yank the original message into it." | ||
| 3185 | (interactive "P") | ||
| 3186 | (let (from reply-to cc subject date to message-id references | ||
| 3187 | resent-to resent-cc resent-reply-to | ||
| 3188 | (msgnum rmail-current-message)) | ||
| 3189 | (save-excursion | ||
| 3190 | (save-restriction | ||
| 3191 | (widen) | ||
| 3192 | (if (rmail-buffers-swapped-p) | ||
| 3193 | (narrow-to-region | ||
| 3194 | (goto-char (point-min)) | ||
| 3195 | (search-forward "\n\n" nil 'move)) | ||
| 3196 | (goto-char (rmail-msgbeg rmail-current-message)) | ||
| 3197 | (forward-line 1) | ||
| 3198 | (narrow-to-region | ||
| 3199 | (point) | ||
| 3200 | (search-forward "\n\n" | ||
| 3201 | (rmail-msgend rmail-current-message) | ||
| 3202 | 'move))) | ||
| 3203 | (setq from (mail-fetch-field "from") | ||
| 3204 | reply-to (or (mail-fetch-field "mail-reply-to" nil t) | ||
| 3205 | (mail-fetch-field "reply-to" nil t) | ||
| 3206 | from) | ||
| 3207 | subject (mail-fetch-field "subject") | ||
| 3208 | date (mail-fetch-field "date") | ||
| 3209 | message-id (mail-fetch-field "message-id") | ||
| 3210 | references (mail-fetch-field "references" nil nil t) | ||
| 3211 | resent-reply-to (mail-fetch-field "resent-reply-to" nil t) | ||
| 3212 | resent-cc (and (not just-sender) | ||
| 3213 | (mail-fetch-field "resent-cc" nil t)) | ||
| 3214 | resent-to (or (mail-fetch-field "resent-to" nil t) "") | ||
| 3215 | ;;; resent-subject (mail-fetch-field "resent-subject") | ||
| 3216 | ;;; resent-date (mail-fetch-field "resent-date") | ||
| 3217 | ;;; resent-message-id (mail-fetch-field "resent-message-id") | ||
| 3218 | ) | ||
| 3219 | (unless just-sender | ||
| 3220 | (if (mail-fetch-field "mail-followup-to" nil t) | ||
| 3221 | ;; If this header field is present, use it instead of | ||
| 3222 | ;; the To and CC fields. | ||
| 3223 | (setq to (mail-fetch-field "mail-followup-to" nil t)) | ||
| 3224 | (setq cc (or (mail-fetch-field "cc" nil t) "") | ||
| 3225 | to (or (mail-fetch-field "to" nil t) "")))))) | ||
| 3226 | |||
| 3227 | ;; Merge the resent-to and resent-cc into the to and cc. | ||
| 3228 | (if (and resent-to (not (equal resent-to ""))) | ||
| 3229 | (if (not (equal to "")) | ||
| 3230 | (setq to (concat to ", " resent-to)) | ||
| 3231 | (setq to resent-to))) | ||
| 3232 | (if (and resent-cc (not (equal resent-cc ""))) | ||
| 3233 | (if (not (equal cc "")) | ||
| 3234 | (setq cc (concat cc ", " resent-cc)) | ||
| 3235 | (setq cc resent-cc))) | ||
| 3236 | ;; Add `Re: ' to subject if not there already. | ||
| 3237 | (and (stringp subject) | ||
| 3238 | (setq subject | ||
| 3239 | (concat rmail-reply-prefix | ||
| 3240 | (if (let ((case-fold-search t)) | ||
| 3241 | (string-match rmail-reply-regexp subject)) | ||
| 3242 | (substring subject (match-end 0)) | ||
| 3243 | subject)))) | ||
| 3244 | (rmail-start-mail | ||
| 3245 | nil | ||
| 3246 | ;; Using mail-strip-quoted-names is undesirable with newer mailers | ||
| 3247 | ;; since they can handle the names unstripped. | ||
| 3248 | ;; I don't know whether there are other mailers that still | ||
| 3249 | ;; need the names to be stripped. | ||
| 3250 | ;;; (mail-strip-quoted-names reply-to) | ||
| 3251 | ;; Remove unwanted names from reply-to, since Mail-Followup-To | ||
| 3252 | ;; header causes all the names in it to wind up in reply-to, not | ||
| 3253 | ;; in cc. But if what's left is an empty list, use the original. | ||
| 3254 | (let* ((reply-to-list (rmail-dont-reply-to reply-to))) | ||
| 3255 | (if (string= reply-to-list "") reply-to reply-to-list)) | ||
| 3256 | subject | ||
| 3257 | (rmail-make-in-reply-to-field from date message-id) | ||
| 3258 | (if just-sender | ||
| 3259 | nil | ||
| 3260 | ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to | ||
| 3261 | ;; to do its job. | ||
| 3262 | (let* ((cc-list (rmail-dont-reply-to | ||
| 3263 | (mail-strip-quoted-names | ||
| 3264 | (if (null cc) to (concat to ", " cc)))))) | ||
| 3265 | (if (string= cc-list "") nil cc-list))) | ||
| 3266 | rmail-view-buffer | ||
| 3267 | (list (list 'rmail-mark-message | ||
| 3268 | rmail-buffer | ||
| 3269 | (with-current-buffer rmail-buffer | ||
| 3270 | (aref rmail-msgref-vector msgnum)) | ||
| 3271 | rmail-answered-attr-index)) | ||
| 3272 | nil | ||
| 3273 | (list (cons "References" (concat (mapconcat 'identity references " ") | ||
| 3274 | " " message-id)))))) | ||
| 3275 | |||
| 3276 | (defun rmail-mark-message (buffer msgnum-list attribute) | ||
| 3277 | "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. | ||
| 3278 | This is use in the send-actions for message buffers. | ||
| 3279 | MSGNUM-LIST is a list of the form (MSGNUM) | ||
| 3280 | which is an element of rmail-msgref-vector." | ||
| 3281 | (save-excursion | ||
| 3282 | (set-buffer buffer) | ||
| 3283 | (if (car msgnum-list) | ||
| 3284 | (rmail-set-attribute attribute t (car msgnum-list))))) | ||
| 3285 | |||
| 3286 | (defun rmail-make-in-reply-to-field (from date message-id) | ||
| 3287 | (cond ((not from) | ||
| 3288 | (if message-id | ||
| 3289 | message-id | ||
| 3290 | nil)) | ||
| 3291 | (mail-use-rfc822 | ||
| 3292 | (require 'rfc822) | ||
| 3293 | (let ((tem (car (rfc822-addresses from)))) | ||
| 3294 | (if message-id | ||
| 3295 | (if (or (not tem) | ||
| 3296 | (string-match | ||
| 3297 | (regexp-quote (if (string-match "@[^@]*\\'" tem) | ||
| 3298 | (substring tem 0 | ||
| 3299 | (match-beginning 0)) | ||
| 3300 | tem)) | ||
| 3301 | message-id)) | ||
| 3302 | ;; missing From, or Message-ID is sufficiently informative | ||
| 3303 | message-id | ||
| 3304 | (concat message-id " (" tem ")")) | ||
| 3305 | ;; Copy TEM, discarding text properties. | ||
| 3306 | (setq tem (copy-sequence tem)) | ||
| 3307 | (set-text-properties 0 (length tem) nil tem) | ||
| 3308 | (setq tem (copy-sequence tem)) | ||
| 3309 | ;; Use prin1 to fake RFC822 quoting | ||
| 3310 | (let ((field (prin1-to-string tem))) | ||
| 3311 | (if date | ||
| 3312 | (concat field "'s message of " date) | ||
| 3313 | field))))) | ||
| 3314 | ((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+") | ||
| 3315 | (bar "[^][\000-\037()<>@,;:\\\"]+")) | ||
| 3316 | ;; These strings both match all non-ASCII characters. | ||
| 3317 | (or (string-match (concat "\\`[ \t]*\\(" bar | ||
| 3318 | "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'") | ||
| 3319 | ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser" | ||
| 3320 | from) | ||
| 3321 | (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\(" | ||
| 3322 | bar "\\))[ \t]*\\'") | ||
| 3323 | ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix" | ||
| 3324 | from))) | ||
| 3325 | (let ((start (match-beginning 1)) | ||
| 3326 | (end (match-end 1))) | ||
| 3327 | ;; Trim whitespace which above regexp match allows | ||
| 3328 | (while (and (< start end) | ||
| 3329 | (memq (aref from start) '(?\t ?\ ))) | ||
| 3330 | (setq start (1+ start))) | ||
| 3331 | (while (and (< start end) | ||
| 3332 | (memq (aref from (1- end)) '(?\t ?\ ))) | ||
| 3333 | (setq end (1- end))) | ||
| 3334 | (let ((field (substring from start end))) | ||
| 3335 | (if date (setq field (concat "message from " field " on " date))) | ||
| 3336 | (if message-id | ||
| 3337 | ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)" | ||
| 3338 | (concat message-id " (" field ")") | ||
| 3339 | field)))) | ||
| 3340 | (t | ||
| 3341 | ;; If we can't kludge it simply, do it correctly | ||
| 3342 | (let ((mail-use-rfc822 t)) | ||
| 3343 | (rmail-make-in-reply-to-field from date message-id))))) | ||
| 3344 | |||
| 3345 | (defun rmail-forward (resend) | ||
| 3346 | "Forward the current message to another user. | ||
| 3347 | With prefix argument, \"resend\" the message instead of forwarding it; | ||
| 3348 | see the documentation of `rmail-resend'." | ||
| 3349 | (interactive "P") | ||
| 3350 | (if resend | ||
| 3351 | (call-interactively 'rmail-resend) | ||
| 3352 | (let ((forward-buffer rmail-buffer) | ||
| 3353 | (msgnum rmail-current-message) | ||
| 3354 | (subject (concat "[" | ||
| 3355 | (let ((from (or (mail-fetch-field "From") | ||
| 3356 | (mail-fetch-field ">From")))) | ||
| 3357 | (if from | ||
| 3358 | (concat (mail-strip-quoted-names from) ": ") | ||
| 3359 | "")) | ||
| 3360 | (or (mail-fetch-field "Subject") "") | ||
| 3361 | "]"))) | ||
| 3362 | (if (rmail-start-mail | ||
| 3363 | nil nil subject nil nil nil | ||
| 3364 | (list (list 'rmail-mark-message | ||
| 3365 | forward-buffer | ||
| 3366 | (with-current-buffer rmail-buffer | ||
| 3367 | (aref rmail-msgref-vector msgnum)) | ||
| 3368 | rmail-forwarded-attr-index)) | ||
| 3369 | ;; If only one window, use it for the mail buffer. | ||
| 3370 | ;; Otherwise, use another window for the mail buffer | ||
| 3371 | ;; so that the Rmail buffer remains visible | ||
| 3372 | ;; and sending the mail will get back to it. | ||
| 3373 | (and (not rmail-mail-new-frame) (one-window-p t))) | ||
| 3374 | ;; The mail buffer is now current. | ||
| 3375 | (save-excursion | ||
| 3376 | ;; Insert after header separator--before signature if any. | ||
| 3377 | (goto-char (mail-text-start)) | ||
| 3378 | (if (or rmail-enable-mime rmail-enable-mime-composing) | ||
| 3379 | (funcall rmail-insert-mime-forwarded-message-function | ||
| 3380 | forward-buffer) | ||
| 3381 | (insert "------- Start of forwarded message -------\n") | ||
| 3382 | ;; Quote lines with `- ' if they start with `-'. | ||
| 3383 | (let ((beg (point)) end) | ||
| 3384 | (setq end (point-marker)) | ||
| 3385 | (set-marker-insertion-type end t) | ||
| 3386 | (insert-buffer-substring forward-buffer) | ||
| 3387 | (goto-char beg) | ||
| 3388 | (while (re-search-forward "^-" end t) | ||
| 3389 | (beginning-of-line) | ||
| 3390 | (insert "- ") | ||
| 3391 | (forward-line 1)) | ||
| 3392 | (goto-char end) | ||
| 3393 | (skip-chars-backward "\n") | ||
| 3394 | (if (< (point) end) | ||
| 3395 | (forward-char 1)) | ||
| 3396 | (delete-region (point) end) | ||
| 3397 | (set-marker end nil)) | ||
| 3398 | (insert "------- End of forwarded message -------\n")) | ||
| 3399 | (push-mark)))))) | ||
| 3400 | |||
| 3401 | (defun rmail-resend (address &optional from comment mail-alias-file) | ||
| 3402 | "Resend current message to ADDRESSES. | ||
| 3403 | ADDRESSES should be a single address, a string consisting of several | ||
| 3404 | addresses separated by commas, or a list of addresses. | ||
| 3405 | |||
| 3406 | Optional FROM is the address to resend the message from, and | ||
| 3407 | defaults from the value of `user-mail-address'. | ||
| 3408 | Optional COMMENT is a string to insert as a comment in the resent message. | ||
| 3409 | Optional ALIAS-FILE is alternate aliases file to be used by sendmail, | ||
| 3410 | typically for purposes of moderating a list." | ||
| 3411 | (interactive "sResend to: ") | ||
| 3412 | (require 'sendmail) | ||
| 3413 | (require 'mailalias) | ||
| 3414 | (unless (or (eq rmail-view-buffer (current-buffer)) | ||
| 3415 | (eq rmail-buffer (current-buffer))) | ||
| 3416 | (error "Not an Rmail buffer")) | ||
| 3417 | (if (not from) (setq from user-mail-address)) | ||
| 3418 | (let ((tembuf (generate-new-buffer " sendmail temp")) | ||
| 3419 | (case-fold-search nil) | ||
| 3420 | (mail-personal-alias-file | ||
| 3421 | (or mail-alias-file mail-personal-alias-file)) | ||
| 3422 | (mailbuf rmail-buffer)) | ||
| 3423 | (unwind-protect | ||
| 3424 | (with-current-buffer tembuf | ||
| 3425 | ;;>> Copy message into temp buffer | ||
| 3426 | (if rmail-enable-mime | ||
| 3427 | (funcall rmail-insert-mime-resent-message-function mailbuf) | ||
| 3428 | (insert-buffer-substring mailbuf)) | ||
| 3429 | (goto-char (point-min)) | ||
| 3430 | ;; Delete any Sender field, since that's not specifiable. | ||
| 3431 | ; Only delete Sender fields in the actual header. | ||
| 3432 | (re-search-forward "^$" nil 'move) | ||
| 3433 | ; Using "while" here rather than "if" because some buggy mail | ||
| 3434 | ; software may have inserted multiple Sender fields. | ||
| 3435 | (while (re-search-backward "^Sender:" nil t) | ||
| 3436 | (let (beg) | ||
| 3437 | (setq beg (point)) | ||
| 3438 | (forward-line 1) | ||
| 3439 | (while (looking-at "[ \t]") | ||
| 3440 | (forward-line 1)) | ||
| 3441 | (delete-region beg (point)))) | ||
| 3442 | ; Go back to the beginning of the buffer so the Resent- fields | ||
| 3443 | ; are inserted there. | ||
| 3444 | (goto-char (point-min)) | ||
| 3445 | ;;>> Insert resent-from: | ||
| 3446 | (insert "Resent-From: " from "\n") | ||
| 3447 | (insert "Resent-Date: " (mail-rfc822-date) "\n") | ||
| 3448 | ;;>> Insert resent-to: and bcc if need be. | ||
| 3449 | (let ((before (point))) | ||
| 3450 | (if mail-self-blind | ||
| 3451 | (insert "Resent-Bcc: " (user-login-name) "\n")) | ||
| 3452 | (insert "Resent-To: " (if (stringp address) | ||
| 3453 | address | ||
| 3454 | (mapconcat 'identity address ",\n\t")) | ||
| 3455 | "\n") | ||
| 3456 | ;; Expand abbrevs in the recipients. | ||
| 3457 | (save-excursion | ||
| 3458 | (if (featurep 'mailabbrev) | ||
| 3459 | (let ((end (point-marker)) | ||
| 3460 | (local-abbrev-table mail-abbrevs) | ||
| 3461 | (old-syntax-table (syntax-table))) | ||
| 3462 | (if (and (not (vectorp mail-abbrevs)) | ||
| 3463 | (file-exists-p mail-personal-alias-file)) | ||
| 3464 | (build-mail-abbrevs)) | ||
| 3465 | (unless mail-abbrev-syntax-table | ||
| 3466 | (mail-abbrev-make-syntax-table)) | ||
| 3467 | (set-syntax-table mail-abbrev-syntax-table) | ||
| 3468 | (goto-char before) | ||
| 3469 | (while (and (< (point) end) | ||
| 3470 | (progn (forward-word 1) | ||
| 3471 | (<= (point) end))) | ||
| 3472 | (expand-abbrev)) | ||
| 3473 | (set-syntax-table old-syntax-table)) | ||
| 3474 | (expand-mail-aliases before (point))))) | ||
| 3475 | ;;>> Set up comment, if any. | ||
| 3476 | (if (and (sequencep comment) (not (zerop (length comment)))) | ||
| 3477 | (let ((before (point)) | ||
| 3478 | after) | ||
| 3479 | (insert comment) | ||
| 3480 | (or (eolp) (insert "\n")) | ||
| 3481 | (setq after (point)) | ||
| 3482 | (goto-char before) | ||
| 3483 | (while (< (point) after) | ||
| 3484 | (insert "Resent-Comment: ") | ||
| 3485 | (forward-line 1)))) | ||
| 3486 | ;; Don't expand aliases in the destination fields | ||
| 3487 | ;; of the original message. | ||
| 3488 | (let (mail-aliases) | ||
| 3489 | (funcall send-mail-function))) | ||
| 3490 | (kill-buffer tembuf)) | ||
| 3491 | (with-current-buffer rmail-buffer | ||
| 3492 | (rmail-set-attribute rmail-resent-attr-index t rmail-current-message)))) | ||
| 3493 | |||
| 3494 | (defvar mail-unsent-separator | ||
| 3495 | (concat "^ *---+ +Unsent message follows +---+ *$\\|" | ||
| 3496 | "^ *---+ +Returned message +---+ *$\\|" | ||
| 3497 | "^ *---+ *Returned mail follows *---+ *$\\|" | ||
| 3498 | "^Start of returned message$\\|" | ||
| 3499 | "^---+ Below this line is a copy of the message.$\\|" | ||
| 3500 | "^ *---+ +Original message +---+ *$\\|" | ||
| 3501 | "^ *--+ +begin message +--+ *$\\|" | ||
| 3502 | "^ *---+ +Original message follows +---+ *$\\|" | ||
| 3503 | "^ *---+ +Your message follows +---+ *$\\|" | ||
| 3504 | "^|? *---+ +Message text follows: +---+ *|?$\\|" | ||
| 3505 | "^ *---+ +This is a copy of \\w+ message, including all the headers.*---+ *$") | ||
| 3506 | "A regexp that matches the separator before the text of a failed message.") | ||
| 3507 | |||
| 3508 | (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" | ||
| 3509 | "A regexp that matches the header of a MIME body part with a failed message.") | ||
| 3510 | |||
| 3511 | (defun rmail-retry-failure () | ||
| 3512 | "Edit a mail message which is based on the contents of the current message. | ||
| 3513 | For a message rejected by the mail system, extract the interesting headers and | ||
| 3514 | the body of the original message. | ||
| 3515 | If the failed message is a MIME multipart message, it is searched for a | ||
| 3516 | body part with a header which matches the variable `mail-mime-unsent-header'. | ||
| 3517 | Otherwise, the variable `mail-unsent-separator' should match the string that | ||
| 3518 | delimits the returned original message. | ||
| 3519 | The variable `rmail-retry-ignored-headers' is a regular expression | ||
| 3520 | specifying headers which should not be copied into the new message." | ||
| 3521 | (interactive) | ||
| 3522 | (require 'mail-utils) | ||
| 3523 | (let ((rmail-this-buffer (current-buffer)) | ||
| 3524 | (msgnum rmail-current-message) | ||
| 3525 | bounce-start bounce-end bounce-indent resending | ||
| 3526 | ;; Fetch any content-type header in current message | ||
| 3527 | ;; Must search thru the whole unpruned header. | ||
| 3528 | (content-type | ||
| 3529 | (save-excursion | ||
| 3530 | (save-restriction | ||
| 3531 | (mail-fetch-field "Content-Type") )))) | ||
| 3532 | (save-excursion | ||
| 3533 | (goto-char (point-min)) | ||
| 3534 | (let ((case-fold-search t)) | ||
| 3535 | (if (and content-type | ||
| 3536 | (string-match | ||
| 3537 | ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" | ||
| 3538 | content-type)) | ||
| 3539 | ;; Handle a MIME multipart bounce message. | ||
| 3540 | (let ((codestring | ||
| 3541 | (concat "\n--" | ||
| 3542 | (substring content-type (match-beginning 1) | ||
| 3543 | (match-end 1))))) | ||
| 3544 | (unless (re-search-forward mail-mime-unsent-header nil t) | ||
| 3545 | (error "Cannot find beginning of header in failed message")) | ||
| 3546 | (unless (search-forward "\n\n" nil t) | ||
| 3547 | (error "Cannot find start of Mime data in failed message")) | ||
| 3548 | (setq bounce-start (point)) | ||
| 3549 | (if (search-forward codestring nil t) | ||
| 3550 | (setq bounce-end (match-beginning 0)) | ||
| 3551 | (setq bounce-end (point-max)))) | ||
| 3552 | ;; Non-MIME bounce. | ||
| 3553 | (or (re-search-forward mail-unsent-separator nil t) | ||
| 3554 | (error "Cannot parse this as a failure message")) | ||
| 3555 | (skip-chars-forward "\n") | ||
| 3556 | ;; Support a style of failure message in which the original | ||
| 3557 | ;; message is indented, and included within lines saying | ||
| 3558 | ;; `Start of returned message' and `End of returned message'. | ||
| 3559 | (if (looking-at " +Received:") | ||
| 3560 | (progn | ||
| 3561 | (setq bounce-start (point)) | ||
| 3562 | (skip-chars-forward " ") | ||
| 3563 | (setq bounce-indent (- (current-column))) | ||
| 3564 | (goto-char (point-max)) | ||
| 3565 | (re-search-backward "^End of returned message$" nil t) | ||
| 3566 | (setq bounce-end (point))) | ||
| 3567 | ;; One message contained a few random lines before | ||
| 3568 | ;; the old message header. The first line of the | ||
| 3569 | ;; message started with two hyphens. A blank line | ||
| 3570 | ;; followed these random lines. The same line | ||
| 3571 | ;; beginning with two hyphens was possibly marking | ||
| 3572 | ;; the end of the message. | ||
| 3573 | (if (looking-at "^--") | ||
| 3574 | (let ((boundary (buffer-substring-no-properties | ||
| 3575 | (point) | ||
| 3576 | (progn (end-of-line) (point))))) | ||
| 3577 | (search-forward "\n\n") | ||
| 3578 | (skip-chars-forward "\n") | ||
| 3579 | (setq bounce-start (point)) | ||
| 3580 | (goto-char (point-max)) | ||
| 3581 | (search-backward (concat "\n\n" boundary) bounce-start t) | ||
| 3582 | (setq bounce-end (point))) | ||
| 3583 | (setq bounce-start (point) | ||
| 3584 | bounce-end (point-max))) | ||
| 3585 | (unless (search-forward "\n\n" nil t) | ||
| 3586 | (error "Cannot find end of header in failed message")))))) | ||
| 3587 | ;; We have found the message that bounced, within the current message. | ||
| 3588 | ;; Now start sending new message; default header fields from original. | ||
| 3589 | ;; Turn off the usual actions for initializing the message body | ||
| 3590 | ;; because we want to get only the text from the failure message. | ||
| 3591 | (let (mail-signature mail-setup-hook) | ||
| 3592 | (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer | ||
| 3593 | (list (list 'rmail-mark-message | ||
| 3594 | rmail-this-buffer | ||
| 3595 | (aref rmail-msgref-vector msgnum) | ||
| 3596 | rmail-retried-attr-index))) | ||
| 3597 | ;; Insert original text as initial text of new draft message. | ||
| 3598 | ;; Bind inhibit-read-only since the header delimiter | ||
| 3599 | ;; of the previous message was probably read-only. | ||
| 3600 | (let ((inhibit-read-only t) | ||
| 3601 | rmail-displayed-headers | ||
| 3602 | rmail-ignored-headers) | ||
| 3603 | (erase-buffer) | ||
| 3604 | (insert-buffer-substring rmail-this-buffer | ||
| 3605 | bounce-start bounce-end) | ||
| 3606 | (goto-char (point-min)) | ||
| 3607 | (if bounce-indent | ||
| 3608 | (indent-rigidly (point-min) (point-max) bounce-indent)) | ||
| 3609 | (mail-sendmail-delimit-header) | ||
| 3610 | (save-restriction | ||
| 3611 | (narrow-to-region (point-min) (mail-header-end)) | ||
| 3612 | (setq resending (mail-fetch-field "resent-to")) | ||
| 3613 | (if mail-self-blind | ||
| 3614 | (if resending | ||
| 3615 | (insert "Resent-Bcc: " (user-login-name) "\n") | ||
| 3616 | (insert "BCC: " (user-login-name) "\n")))) | ||
| 3617 | (goto-char (point-min)) | ||
| 3618 | (mail-position-on-field (if resending "Resent-To" "To") t)))))) | ||
| 3619 | |||
| 3620 | (defun rmail-summary-exists () | ||
| 3621 | "Non-nil if in an RMAIL buffer and an associated summary buffer exists. | ||
| 3622 | In fact, the non-nil value returned is the summary buffer itself." | ||
| 3623 | (and rmail-summary-buffer (buffer-name rmail-summary-buffer) | ||
| 3624 | rmail-summary-buffer)) | ||
| 3625 | |||
| 3626 | (defun rmail-summary-displayed () | ||
| 3627 | "t if in RMAIL buffer and an associated summary buffer is displayed." | ||
| 3628 | (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer))) | ||
| 3629 | |||
| 3630 | (defcustom rmail-redisplay-summary nil | ||
| 3631 | "*Non-nil means Rmail should show the summary when it changes. | ||
| 3632 | This has an effect only if a summary buffer exists." | ||
| 3633 | :type 'boolean | ||
| 3634 | :group 'rmail-summary) | ||
| 3635 | |||
| 3636 | (defcustom rmail-summary-window-size nil | ||
| 3637 | "*Non-nil means specify the height for an Rmail summary window." | ||
| 3638 | :type '(choice (const :tag "Disabled" nil) integer) | ||
| 3639 | :group 'rmail-summary) | ||
| 3640 | |||
| 3641 | ;; Put the summary buffer back on the screen, if user wants that. | ||
| 3642 | (defun rmail-maybe-display-summary () | ||
| 3643 | (let ((selected (selected-window)) | ||
| 3644 | window) | ||
| 3645 | ;; If requested, make sure the summary is displayed. | ||
| 3646 | (and rmail-summary-buffer (buffer-name rmail-summary-buffer) | ||
| 3647 | rmail-redisplay-summary | ||
| 3648 | (if (get-buffer-window rmail-summary-buffer 0) | ||
| 3649 | ;; It's already in some frame; show that one. | ||
| 3650 | (let ((frame (window-frame | ||
| 3651 | (get-buffer-window rmail-summary-buffer 0)))) | ||
| 3652 | (make-frame-visible frame) | ||
| 3653 | (raise-frame frame)) | ||
| 3654 | (display-buffer rmail-summary-buffer))) | ||
| 3655 | ;; If requested, set the height of the summary window. | ||
| 3656 | (and rmail-summary-buffer (buffer-name rmail-summary-buffer) | ||
| 3657 | rmail-summary-window-size | ||
| 3658 | (setq window (get-buffer-window rmail-summary-buffer)) | ||
| 3659 | ;; Don't try to change the size if just one window in frame. | ||
| 3660 | (not (eq window (frame-root-window (window-frame window)))) | ||
| 3661 | (unwind-protect | ||
| 3662 | (progn | ||
| 3663 | (select-window window) | ||
| 3664 | (enlarge-window (- rmail-summary-window-size (window-height)))) | ||
| 3665 | (select-window selected))))) | ||
| 3666 | |||
| 3667 | ;;;; *** Rmail Local Fontification *** | ||
| 3668 | |||
| 3669 | (defun rmail-fontify-buffer-function () | ||
| 3670 | ;; This function's symbol is bound to font-lock-fontify-buffer-function. | ||
| 3671 | (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) | ||
| 3672 | ;; If we're already showing a message, fontify it now. | ||
| 3673 | (if rmail-current-message (rmail-fontify-message)) | ||
| 3674 | ;; Prevent Font Lock mode from kicking in. | ||
| 3675 | (setq font-lock-fontified t)) | ||
| 3676 | |||
| 3677 | (defun rmail-unfontify-buffer-function () | ||
| 3678 | ;; This function's symbol is bound to font-lock-fontify-unbuffer-function. | ||
| 3679 | (let ((modified (buffer-modified-p)) | ||
| 3680 | (buffer-undo-list t) (inhibit-read-only t) | ||
| 3681 | before-change-functions after-change-functions | ||
| 3682 | buffer-file-name buffer-file-truename) | ||
| 3683 | (save-restriction | ||
| 3684 | (widen) | ||
| 3685 | (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) | ||
| 3686 | (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) | ||
| 3687 | (font-lock-default-unfontify-buffer) | ||
| 3688 | (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) | ||
| 3689 | |||
| 3690 | (defun rmail-fontify-message () | ||
| 3691 | ;; Fontify the current message if it is not already fontified. | ||
| 3692 | (if (text-property-any (point-min) (point-max) 'rmail-fontified nil) | ||
| 3693 | (let ((modified (buffer-modified-p)) | ||
| 3694 | (buffer-undo-list t) (inhibit-read-only t) | ||
| 3695 | before-change-functions after-change-functions | ||
| 3696 | buffer-file-name buffer-file-truename) | ||
| 3697 | (save-excursion | ||
| 3698 | (save-match-data | ||
| 3699 | (add-text-properties (point-min) (point-max) '(rmail-fontified t)) | ||
| 3700 | (font-lock-fontify-region (point-min) (point-max)) | ||
| 3701 | (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))))) | ||
| 3702 | |||
| 3703 | ;;; Speedbar support for RMAIL files. | ||
| 3704 | (eval-when-compile (require 'speedbar)) | ||
| 3705 | |||
| 3706 | (defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" | ||
| 3707 | "*This regex is used to match folder names to be displayed in speedbar. | ||
| 3708 | Enabling this will permit speedbar to display your folders for easy | ||
| 3709 | browsing, and moving of messages.") | ||
| 3710 | |||
| 3711 | (defvar rmail-speedbar-last-user nil | ||
| 3712 | "The last user to be displayed in the speedbar.") | ||
| 3713 | |||
| 3714 | (defvar rmail-speedbar-key-map nil | ||
| 3715 | "Keymap used when in rmail display mode.") | ||
| 3716 | |||
| 3717 | (defun rmail-install-speedbar-variables () | ||
| 3718 | "Install those variables used by speedbar to enhance rmail." | ||
| 3719 | (if rmail-speedbar-key-map | ||
| 3720 | nil | ||
| 3721 | (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) | ||
| 3722 | |||
| 3723 | (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) | ||
| 3724 | (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) | ||
| 3725 | (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) | ||
| 3726 | (define-key rmail-speedbar-key-map "M" | ||
| 3727 | 'rmail-speedbar-move-message-to-folder-on-line))) | ||
| 3728 | |||
| 3729 | (defvar rmail-speedbar-menu-items | ||
| 3730 | '(["Read Folder" speedbar-edit-line t] | ||
| 3731 | ["Move message to folder" rmail-speedbar-move-message-to-folder-on-line | ||
| 3732 | (save-excursion (beginning-of-line) | ||
| 3733 | (looking-at "<M> "))]) | ||
| 3734 | "Additional menu-items to add to speedbar frame.") | ||
| 3735 | |||
| 3736 | ;; Make sure our special speedbar major mode is loaded | ||
| 3737 | (if (featurep 'speedbar) | ||
| 3738 | (rmail-install-speedbar-variables) | ||
| 3739 | (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables)) | ||
| 3740 | |||
| 3741 | (defun rmail-speedbar-buttons (buffer) | ||
| 3742 | "Create buttons for BUFFER containing rmail messages. | ||
| 3743 | Click on the address under Reply to: to reply to this person. | ||
| 3744 | Under Folders: Click a name to read it, or on the <M> to move the | ||
| 3745 | current message into that RMAIL folder." | ||
| 3746 | (let ((from nil)) | ||
| 3747 | (save-excursion | ||
| 3748 | (set-buffer buffer) | ||
| 3749 | (goto-char (point-min)) | ||
| 3750 | (if (not (re-search-forward "^Reply-To: " nil t)) | ||
| 3751 | (if (not (re-search-forward "^From:? " nil t)) | ||
| 3752 | (setq from t))) | ||
| 3753 | (if from | ||
| 3754 | nil | ||
| 3755 | (setq from (buffer-substring (point) (save-excursion | ||
| 3756 | (end-of-line) | ||
| 3757 | (point)))))) | ||
| 3758 | (goto-char (point-min)) | ||
| 3759 | (if (and (looking-at "Reply to:") | ||
| 3760 | (equal from rmail-speedbar-last-user)) | ||
| 3761 | nil | ||
| 3762 | (setq rmail-speedbar-last-user from) | ||
| 3763 | (erase-buffer) | ||
| 3764 | (insert "Reply To:\n") | ||
| 3765 | (if (stringp from) | ||
| 3766 | (speedbar-insert-button from 'speedbar-directory-face 'highlight | ||
| 3767 | 'rmail-speedbar-button 'rmail-reply)) | ||
| 3768 | (insert "Folders:\n") | ||
| 3769 | (let* ((case-fold-search nil) | ||
| 3770 | (df (directory-files (save-excursion (set-buffer buffer) | ||
| 3771 | default-directory) | ||
| 3772 | nil rmail-speedbar-match-folder-regexp))) | ||
| 3773 | (while df | ||
| 3774 | (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight | ||
| 3775 | 'rmail-speedbar-move-message (car df)) | ||
| 3776 | (speedbar-insert-button (car df) 'speedbar-file-face 'highlight | ||
| 3777 | 'rmail-speedbar-find-file nil t) | ||
| 3778 | (setq df (cdr df))))))) | ||
| 3779 | |||
| 3780 | (defun rmail-speedbar-button (text token indent) | ||
| 3781 | "Execute an rmail command specified by TEXT. | ||
| 3782 | The command used is TOKEN. INDENT is not used." | ||
| 3783 | (speedbar-with-attached-buffer | ||
| 3784 | (funcall token t))) | ||
| 3785 | |||
| 3786 | (defun rmail-speedbar-find-file (text token indent) | ||
| 3787 | "Load in the rmail file TEXT. | ||
| 3788 | TOKEN and INDENT are not used." | ||
| 3789 | (speedbar-with-attached-buffer | ||
| 3790 | (message "Loading in RMAIL file %s..." text) | ||
| 3791 | (find-file text))) | ||
| 3792 | |||
| 3793 | (defun rmail-speedbar-move-message-to-folder-on-line () | ||
| 3794 | "If the current line is a folder, move current message to it." | ||
| 3795 | (interactive) | ||
| 3796 | (save-excursion | ||
| 3797 | (beginning-of-line) | ||
| 3798 | (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t) | ||
| 3799 | (progn | ||
| 3800 | (forward-char -2) | ||
| 3801 | (speedbar-do-function-pointer))))) | ||
| 3802 | |||
| 3803 | (defun rmail-speedbar-move-message (text token indent) | ||
| 3804 | "From button TEXT, copy current message to the rmail file specified by TOKEN. | ||
| 3805 | TEXT and INDENT are not used." | ||
| 3806 | (speedbar-with-attached-buffer | ||
| 3807 | (message "Moving message to %s" token) | ||
| 3808 | (rmail-output token))) | ||
| 3809 | |||
| 3810 | ; Functions for setting, getting and encoding the POP password. | ||
| 3811 | ; The password is encoded to prevent it from being easily accessible | ||
| 3812 | ; to "prying eyes." Obviously, this encoding isn't "real security," | ||
| 3813 | ; nor is it meant to be. | ||
| 3814 | |||
| 3815 | ;;;###autoload | ||
| 3816 | (defun rmail-set-remote-password (password) | ||
| 3817 | "Set PASSWORD to be used for retrieving mail from a POP or IMAP server." | ||
| 3818 | (interactive "sPassword: ") | ||
| 3819 | (if password | ||
| 3820 | (setq rmail-encoded-remote-password | ||
| 3821 | (rmail-encode-string password (emacs-pid))) | ||
| 3822 | (setq rmail-remote-password nil) | ||
| 3823 | (setq rmail-encoded-remote-password nil))) | ||
| 3824 | |||
| 3825 | (defun rmail-get-remote-password (imap) | ||
| 3826 | "Get the password for retrieving mail from a POP or IMAP server. If none | ||
| 3827 | has been set, then prompt the user for one." | ||
| 3828 | (when (not rmail-encoded-remote-password) | ||
| 3829 | (if (not rmail-remote-password) | ||
| 3830 | (setq rmail-remote-password | ||
| 3831 | (read-passwd (if imap | ||
| 3832 | "IMAP password: " | ||
| 3833 | "POP password: ")))) | ||
| 3834 | (rmail-set-remote-password rmail-remote-password) | ||
| 3835 | (setq rmail-remote-password nil)) | ||
| 3836 | (rmail-encode-string rmail-encoded-remote-password (emacs-pid))) | ||
| 3837 | |||
| 3838 | (defun rmail-have-password () | ||
| 3839 | (or rmail-remote-password rmail-encoded-remote-password)) | ||
| 3840 | |||
| 3841 | (defun rmail-encode-string (string mask) | ||
| 3842 | "Encode STRING with integer MASK, by taking the exclusive OR of the | ||
| 3843 | lowest byte in the mask with the first character of string, the | ||
| 3844 | second-lowest-byte with the second character of the string, etc., | ||
| 3845 | restarting at the lowest byte of the mask whenever it runs out. | ||
| 3846 | Returns the encoded string. Calling the function again with an | ||
| 3847 | encoded string (and the same mask) will decode the string." | ||
| 3848 | (setq mask (abs mask)) ; doesn't work if negative | ||
| 3849 | (let* ((string-vector (string-to-vector string)) (i 0) | ||
| 3850 | (len (length string-vector)) (curmask mask) charmask) | ||
| 3851 | (while (< i len) | ||
| 3852 | (if (= curmask 0) | ||
| 3853 | (setq curmask mask)) | ||
| 3854 | (setq charmask (% curmask 256)) | ||
| 3855 | (setq curmask (lsh curmask -8)) | ||
| 3856 | (aset string-vector i (logxor charmask (aref string-vector i))) | ||
| 3857 | (setq i (1+ i))) | ||
| 3858 | (concat string-vector))) | ||
| 3859 | |||
| 3860 | ;;;; Desktop support | ||
| 3861 | |||
| 3862 | (defun rmail-restore-desktop-buffer (desktop-buffer-file-name | ||
| 3863 | desktop-buffer-name | ||
| 3864 | desktop-buffer-misc) | ||
| 3865 | "Restore an rmail buffer specified in a desktop file." | ||
| 3866 | (condition-case error | ||
| 3867 | (progn | ||
| 3868 | (rmail-input desktop-buffer-file-name) | ||
| 3869 | (if (eq major-mode 'rmail-mode) | ||
| 3870 | (current-buffer) | ||
| 3871 | rmail-buffer)) | ||
| 3872 | (file-locked | ||
| 3873 | (kill-buffer (current-buffer)) | ||
| 3874 | nil))) | ||
| 3875 | |||
| 3876 | (add-to-list 'desktop-buffer-mode-handlers | ||
| 3877 | '(rmail-mode . rmail-restore-desktop-buffer)) | ||
| 3878 | |||
| 3879 | ;; Used in `write-region-annotate-functions' to write rmail files. | ||
| 3880 | (defun rmail-write-region-annotate (start end) | ||
| 3881 | (when (rmail-buffers-swapped-p) | ||
| 3882 | (set-buffer rmail-view-buffer) | ||
| 3883 | (widen) | ||
| 3884 | nil)) | ||
| 3885 | |||
| 3886 | (provide 'rmail) | ||
| 3887 | |||
| 3888 | ;; Local Variables: | ||
| 3889 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 3890 | ;; End: | ||
| 3891 | |||
| 3892 | ;; arch-tag: 65d257d3-c281-4a65-9c38-e61af95af2f0 | ||
| 3893 | ;;; rmail.el ends here | ||
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el new file mode 100644 index 00000000000..16ffb9bdc75 --- /dev/null +++ b/lisp/mail/rmailedit.el | |||
| @@ -0,0 +1,217 @@ | |||
| 1 | ;;; rmailedit.el --- "RMAIL edit mode" Edit the current message | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006, | ||
| 4 | ;; 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile | ||
| 29 | (require 'rmail) | ||
| 30 | (require 'rmailsum)) | ||
| 31 | |||
| 32 | (defcustom rmail-edit-mode-hook nil | ||
| 33 | "List of functions to call when editing an RMAIL message." | ||
| 34 | :type 'hook | ||
| 35 | :version "21.1" | ||
| 36 | :group 'rmail-edit) | ||
| 37 | |||
| 38 | (defvar rmail-old-text) | ||
| 39 | |||
| 40 | (defvar rmail-edit-map nil) | ||
| 41 | (if rmail-edit-map | ||
| 42 | nil | ||
| 43 | ;; Make a keymap that inherits text-mode-map. | ||
| 44 | (setq rmail-edit-map (make-sparse-keymap)) | ||
| 45 | (set-keymap-parent rmail-edit-map text-mode-map) | ||
| 46 | (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit) | ||
| 47 | (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit)) | ||
| 48 | |||
| 49 | ;; Rmail Edit mode is suitable only for specially formatted data. | ||
| 50 | (put 'rmail-edit-mode 'mode-class 'special) | ||
| 51 | |||
| 52 | (declare-function rmail-summary-disable "" ()) | ||
| 53 | (declare-function rmail-summary-enable "rmailsum" ()) | ||
| 54 | |||
| 55 | (defun rmail-edit-mode () | ||
| 56 | "Major mode for editing the contents of an RMAIL message. | ||
| 57 | The editing commands are the same as in Text mode, together with two commands | ||
| 58 | to return to regular RMAIL: | ||
| 59 | * \\[rmail-abort-edit] cancels the changes | ||
| 60 | you have made and returns to RMAIL | ||
| 61 | * \\[rmail-cease-edit] makes them permanent. | ||
| 62 | This functions runs the normal hook `rmail-edit-mode-hook'. | ||
| 63 | \\{rmail-edit-map}" | ||
| 64 | (if (rmail-summary-exists) | ||
| 65 | (save-excursion | ||
| 66 | (set-buffer rmail-summary-buffer) | ||
| 67 | (rmail-summary-disable))) | ||
| 68 | (let (rmail-buffer-swapped) | ||
| 69 | ;; Prevent change-major-mode-hook from unswapping the buffers. | ||
| 70 | (delay-mode-hooks (text-mode)) | ||
| 71 | (use-local-map rmail-edit-map) | ||
| 72 | (setq major-mode 'rmail-edit-mode) | ||
| 73 | (setq mode-name "RMAIL Edit") | ||
| 74 | (if (boundp 'mode-line-modified) | ||
| 75 | (setq mode-line-modified (default-value 'mode-line-modified)) | ||
| 76 | (setq mode-line-format (default-value 'mode-line-format))) | ||
| 77 | (run-mode-hooks 'rmail-edit-mode-hook))) | ||
| 78 | |||
| 79 | (defvar rmail-old-pruned nil) | ||
| 80 | (put 'rmail-old-pruned 'permanent-local t) | ||
| 81 | |||
| 82 | ;;;###autoload | ||
| 83 | (defun rmail-edit-current-message () | ||
| 84 | "Edit the contents of this message." | ||
| 85 | (interactive) | ||
| 86 | (if (= rmail-total-messages 0) | ||
| 87 | (error "No messages in this buffer")) | ||
| 88 | (make-local-variable 'rmail-old-pruned) | ||
| 89 | (setq rmail-old-pruned (eq rmail-header-style 'normal)) | ||
| 90 | (rmail-edit-mode) | ||
| 91 | (make-local-variable 'rmail-old-text) | ||
| 92 | (save-restriction | ||
| 93 | (widen) | ||
| 94 | (setq rmail-old-text (buffer-substring (point-min) (point-max)))) | ||
| 95 | (setq buffer-read-only nil) | ||
| 96 | (setq buffer-undo-list nil) | ||
| 97 | (force-mode-line-update) | ||
| 98 | (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit) | ||
| 99 | (eq (key-binding "\C-c\C-]") 'rmail-abort-edit)) | ||
| 100 | (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort") | ||
| 101 | (message "%s" (substitute-command-keys | ||
| 102 | "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort")))) | ||
| 103 | |||
| 104 | (defun rmail-cease-edit () | ||
| 105 | "Finish editing message; switch back to Rmail proper." | ||
| 106 | (interactive) | ||
| 107 | (if (rmail-summary-exists) | ||
| 108 | (save-excursion | ||
| 109 | (set-buffer rmail-summary-buffer) | ||
| 110 | (rmail-summary-enable))) | ||
| 111 | (widen) | ||
| 112 | ;; Disguise any "From " lines so they don't start a new message. | ||
| 113 | (save-excursion | ||
| 114 | (goto-char (point-min)) | ||
| 115 | (while (search-forward "\nFrom " nil t) | ||
| 116 | (beginning-of-line) | ||
| 117 | (insert ">"))) | ||
| 118 | ;; Make sure buffer ends with a blank line | ||
| 119 | ;; so as not to run this message together with the following one. | ||
| 120 | (save-excursion | ||
| 121 | (goto-char (point-max)) | ||
| 122 | (if (/= (preceding-char) ?\n) | ||
| 123 | (insert "\n")) | ||
| 124 | (unless (looking-back "\n\n") | ||
| 125 | (insert "\n"))) | ||
| 126 | (let ((old rmail-old-text) | ||
| 127 | character-coding is-text-message coding-system | ||
| 128 | headers-end) | ||
| 129 | ;; Go back to Rmail mode, but carefully. | ||
| 130 | (force-mode-line-update) | ||
| 131 | (let (rmail-buffer-swapped) | ||
| 132 | (kill-all-local-variables) | ||
| 133 | (rmail-mode-1) | ||
| 134 | (if (boundp 'tool-bar-map) | ||
| 135 | (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map)) | ||
| 136 | (setq buffer-undo-list t) | ||
| 137 | (rmail-variables)) | ||
| 138 | ;; If text has really changed, mark message as edited. | ||
| 139 | (unless (and (= (length old) (- (point-max) (point-min))) | ||
| 140 | (string= old (buffer-substring (point-min) (point-max)))) | ||
| 141 | (setq old nil) | ||
| 142 | (goto-char (point-min)) | ||
| 143 | (search-forward "\n\n") | ||
| 144 | (setq headers-end (point)) | ||
| 145 | |||
| 146 | (rmail-swap-buffers-maybe) | ||
| 147 | |||
| 148 | (setq character-coding (mail-fetch-field "content-transfer-encoding") | ||
| 149 | is-text-message (rmail-is-text-p) | ||
| 150 | coding-system (rmail-get-coding-system)) | ||
| 151 | (if character-coding | ||
| 152 | (setq character-coding (downcase character-coding))) | ||
| 153 | |||
| 154 | (narrow-to-region (rmail-msgbeg rmail-current-message) | ||
| 155 | (rmail-msgend rmail-current-message)) | ||
| 156 | (goto-char (point-min)) | ||
| 157 | (search-forward "\n\n") | ||
| 158 | (let ((inhibit-read-only t) | ||
| 159 | (headers-end-1 (point))) | ||
| 160 | (insert-buffer-substring rmail-view-buffer headers-end) | ||
| 161 | (delete-region (point) (point-max)) | ||
| 162 | |||
| 163 | ;; Re-encode the message body in whatever | ||
| 164 | ;; way it was decoded. | ||
| 165 | (cond | ||
| 166 | ((string= character-coding "quoted-printable") | ||
| 167 | (mail-quote-printable-region headers-end-1 (point-max))) | ||
| 168 | ((and (string= character-coding "base64") is-text-message) | ||
| 169 | (base64-encode-region headers-end-1 (point-max))) | ||
| 170 | ((eq character-coding 'uuencode) | ||
| 171 | (error "Not supported yet.")) | ||
| 172 | (t | ||
| 173 | (if (or (not coding-system) (not (coding-system-p coding-system))) | ||
| 174 | (setq coding-system 'undecided)) | ||
| 175 | (encode-coding-region headers-end-1 (point-max) coding-system))) | ||
| 176 | )) | ||
| 177 | |||
| 178 | (rmail-set-attribute rmail-edited-attr-index t) | ||
| 179 | |||
| 180 | ;;??? BROKEN perhaps. | ||
| 181 | ;; I think that the Summary-Line header may not be kept there any more. | ||
| 182 | ;;; (if (boundp 'rmail-summary-vector) | ||
| 183 | ;;; (progn | ||
| 184 | ;;; (aset rmail-summary-vector (1- rmail-current-message) nil) | ||
| 185 | ;;; (save-excursion | ||
| 186 | ;;; (rmail-widen-to-current-msgbeg | ||
| 187 | ;;; (function (lambda () | ||
| 188 | ;;; (forward-line 2) | ||
| 189 | ;;; (if (looking-at "Summary-line: ") | ||
| 190 | ;;; (let ((buffer-read-only nil)) | ||
| 191 | ;;; (delete-region (point) | ||
| 192 | ;;; (progn (forward-line 1) | ||
| 193 | ;;; (point))))))))))) | ||
| 194 | ) | ||
| 195 | |||
| 196 | (save-excursion | ||
| 197 | (rmail-show-message) | ||
| 198 | (rmail-toggle-header (if rmail-old-pruned 1 0))) | ||
| 199 | (run-hooks 'rmail-mode-hook)) | ||
| 200 | |||
| 201 | (defun rmail-abort-edit () | ||
| 202 | "Abort edit of current message; restore original contents." | ||
| 203 | (interactive) | ||
| 204 | (widen) | ||
| 205 | (delete-region (point-min) (point-max)) | ||
| 206 | (insert rmail-old-text) | ||
| 207 | (rmail-cease-edit) | ||
| 208 | (rmail-highlight-headers)) | ||
| 209 | |||
| 210 | (provide 'rmailedit) | ||
| 211 | |||
| 212 | ;; Local Variables: | ||
| 213 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 214 | ;; End: | ||
| 215 | |||
| 216 | ;; arch-tag: 9524f335-12cc-4e95-9e9b-3208dc30550b | ||
| 217 | ;;; rmailedit.el ends here | ||
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el new file mode 100644 index 00000000000..49d27cddebe --- /dev/null +++ b/lisp/mail/rmailkwd.el | |||
| @@ -0,0 +1,169 @@ | |||
| 1 | ;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, | ||
| 4 | ;; 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'rmail) | ||
| 29 | |||
| 30 | ;; Global to all RMAIL buffers. It exists primarily for the sake of | ||
| 31 | ;; completion. It is better to use strings with the label functions | ||
| 32 | ;; and let them worry about making the label. | ||
| 33 | |||
| 34 | (defvar rmail-label-obarray (make-vector 47 0)) | ||
| 35 | |||
| 36 | (mapc (function (lambda (s) (intern s rmail-label-obarray))) | ||
| 37 | '("deleted" "answered" "filed" "forwarded" "unseen" "edited" | ||
| 38 | "resent")) | ||
| 39 | |||
| 40 | (defun rmail-make-label (s) | ||
| 41 | (intern (downcase s) rmail-label-obarray)) | ||
| 42 | |||
| 43 | ;;;###autoload | ||
| 44 | (defun rmail-add-label (string) | ||
| 45 | "Add LABEL to labels associated with current RMAIL message. | ||
| 46 | Performs completion over known labels when reading." | ||
| 47 | (interactive (list (rmail-read-label "Add label"))) | ||
| 48 | (rmail-set-label string t)) | ||
| 49 | |||
| 50 | ;;;###autoload | ||
| 51 | (defun rmail-kill-label (string) | ||
| 52 | "Remove LABEL from labels associated with current RMAIL message. | ||
| 53 | Performs completion over known labels when reading." | ||
| 54 | (interactive (list (rmail-read-label "Remove label"))) | ||
| 55 | (rmail-set-label string nil)) | ||
| 56 | |||
| 57 | ;;;###autoload | ||
| 58 | (defun rmail-read-label (prompt) | ||
| 59 | (let ((result | ||
| 60 | (completing-read (concat prompt | ||
| 61 | (if rmail-last-label | ||
| 62 | (concat " (default " | ||
| 63 | (symbol-name rmail-last-label) | ||
| 64 | "): ") | ||
| 65 | ": ")) | ||
| 66 | rmail-label-obarray | ||
| 67 | nil | ||
| 68 | nil))) | ||
| 69 | (if (string= result "") | ||
| 70 | rmail-last-label | ||
| 71 | (setq rmail-last-label (rmail-make-label result))))) | ||
| 72 | |||
| 73 | (defun rmail-set-label (label state &optional msg) | ||
| 74 | "Set LABEL as present or absent according to STATE in message MSG." | ||
| 75 | (with-current-buffer rmail-buffer | ||
| 76 | (rmail-maybe-set-message-counters) | ||
| 77 | (if (not msg) (setq msg rmail-current-message)) | ||
| 78 | ;; Force recalculation of summary for this message. | ||
| 79 | (aset rmail-summary-vector (1- msg) nil) | ||
| 80 | (let (attr-index) | ||
| 81 | ;; Is this label an attribute? | ||
| 82 | (dotimes (i (length rmail-attr-array)) | ||
| 83 | (if (string= (cadr (aref rmail-attr-array i)) label) | ||
| 84 | (setq attr-index i))) | ||
| 85 | (if attr-index | ||
| 86 | ;; If so, set it as an attribute. | ||
| 87 | (rmail-set-attribute attr-index state msg) | ||
| 88 | ;; Is this keyword already present in msg's keyword list? | ||
| 89 | (let* ((header (rmail-get-header rmail-keyword-header msg)) | ||
| 90 | (regexp (concat ", " (regexp-quote (symbol-name label)) ",")) | ||
| 91 | (present (string-match regexp (concat ", " header ",")))) | ||
| 92 | ;; If current state is not correct, | ||
| 93 | (unless (eq present state) | ||
| 94 | ;; either add it or delete it. | ||
| 95 | (rmail-set-header | ||
| 96 | rmail-keyword-header msg | ||
| 97 | (if state | ||
| 98 | ;; Add this keyword at the end. | ||
| 99 | (if (and header (not (string= header ""))) | ||
| 100 | (concat header ", " (symbol-name label)) | ||
| 101 | (symbol-name label)) | ||
| 102 | ;; Delete this keyword. | ||
| 103 | (let ((before (substring header 0 | ||
| 104 | (max 0 (- (match-beginning 0) 2)))) | ||
| 105 | (after (substring header | ||
| 106 | (min (length header) | ||
| 107 | (- (match-end 0) 1))))) | ||
| 108 | (cond ((string= before "") | ||
| 109 | after) | ||
| 110 | ((string= after "") | ||
| 111 | before) | ||
| 112 | (t (concat before ", " after))))))))) | ||
| 113 | (if (= msg rmail-current-message) | ||
| 114 | (rmail-display-labels))))) | ||
| 115 | |||
| 116 | ;; Motion on messages with keywords. | ||
| 117 | |||
| 118 | ;;;###autoload | ||
| 119 | (defun rmail-previous-labeled-message (n labels) | ||
| 120 | "Show previous message with one of the labels LABELS. | ||
| 121 | LABELS should be a comma-separated list of label names. | ||
| 122 | If LABELS is empty, the last set of labels specified is used. | ||
| 123 | With prefix argument N moves backward N messages with these labels." | ||
| 124 | (interactive "p\nsMove to previous msg with labels: ") | ||
| 125 | (rmail-next-labeled-message (- n) labels)) | ||
| 126 | |||
| 127 | (declare-function mail-comma-list-regexp "mail-utils" (labels)) | ||
| 128 | |||
| 129 | ;;;###autoload | ||
| 130 | (defun rmail-next-labeled-message (n labels) | ||
| 131 | "Show next message with one of the labels LABELS. | ||
| 132 | LABELS should be a comma-separated list of label names. | ||
| 133 | If LABELS is empty, the last set of labels specified is used. | ||
| 134 | With prefix argument N moves forward N messages with these labels." | ||
| 135 | (interactive "p\nsMove to next msg with labels: ") | ||
| 136 | (if (string= labels "") | ||
| 137 | (setq labels rmail-last-multi-labels)) | ||
| 138 | (or labels | ||
| 139 | (error "No labels to find have been specified previously")) | ||
| 140 | (set-buffer rmail-buffer) | ||
| 141 | (setq rmail-last-multi-labels labels) | ||
| 142 | (rmail-maybe-set-message-counters) | ||
| 143 | (let ((lastwin rmail-current-message) | ||
| 144 | (current rmail-current-message) | ||
| 145 | (regexp (concat ", ?\\(" | ||
| 146 | (mail-comma-list-regexp labels) | ||
| 147 | "\\),"))) | ||
| 148 | (while (and (> n 0) (< current rmail-total-messages)) | ||
| 149 | (setq current (1+ current)) | ||
| 150 | (if (string-match regexp (rmail-get-labels current)) | ||
| 151 | (setq lastwin current n (1- n)))) | ||
| 152 | (while (and (< n 0) (> current 1)) | ||
| 153 | (setq current (1- current)) | ||
| 154 | (if (string-match regexp (rmail-get-labels current)) | ||
| 155 | (setq lastwin current n (1+ n)))) | ||
| 156 | (if (< n 0) | ||
| 157 | (error "No previous message with labels %s" labels) | ||
| 158 | (if (> n 0) | ||
| 159 | (error "No following message with labels %s" labels) | ||
| 160 | (rmail-show-message lastwin))))) | ||
| 161 | |||
| 162 | (provide 'rmailkwd) | ||
| 163 | |||
| 164 | ;; Local Variables: | ||
| 165 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 166 | ;; End: | ||
| 167 | |||
| 168 | ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7 | ||
| 169 | ;;; rmailkwd.el ends here | ||
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el new file mode 100644 index 00000000000..9f9348edea1 --- /dev/null +++ b/lisp/mail/rmailmm.el | |||
| @@ -0,0 +1,410 @@ | |||
| 1 | ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL | ||
| 2 | |||
| 3 | ;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: mail | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; Essentially based on the design of Alexander Pohoyda's MIME | ||
| 26 | ;; extensions (mime-display.el and mime.el). To use, copy a complete | ||
| 27 | ;; message into a new buffer and call (mime-show t). | ||
| 28 | |||
| 29 | ;; To use: | ||
| 30 | |||
| 31 | ;; (autoload 'rmail-mime "rmailmm" | ||
| 32 | ;; "Show MIME message." t) | ||
| 33 | ;; (add-hook 'rmail-mode-hook | ||
| 34 | ;; (lambda () | ||
| 35 | ;; (define-key rmail-mode-map (kbd "v") | ||
| 36 | ;; 'rmail-mime))) | ||
| 37 | |||
| 38 | ;;; Code: | ||
| 39 | |||
| 40 | (require 'rmail) | ||
| 41 | (require 'mail-parse) | ||
| 42 | |||
| 43 | ;;; Variables | ||
| 44 | |||
| 45 | (defcustom rmail-mime-media-type-handlers-alist | ||
| 46 | '(("multipart/.*" rmail-mime-multipart-handler) | ||
| 47 | ("text/.*" rmail-mime-text-handler) | ||
| 48 | ("text/\\(x-\\)?patch" rmail-mime-bulk-handler) | ||
| 49 | ("application/pgp-signature" rmail-mime-application/pgp-signature-handler) | ||
| 50 | ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler)) | ||
| 51 | "Alist of media type handlers, also known as agents. | ||
| 52 | Every handler is a list of type (string symbol) where STRING is a | ||
| 53 | regular expression to match the media type with and SYMBOL is a | ||
| 54 | function to run. Handlers should return a non-nil value if the | ||
| 55 | job is done." | ||
| 56 | :type 'list | ||
| 57 | :group 'mime) | ||
| 58 | |||
| 59 | (defcustom rmail-mime-attachment-dirs-alist | ||
| 60 | '(("text/.*" "~/Documents") | ||
| 61 | ("image/.*" "~/Pictures") | ||
| 62 | (".*" "~/Desktop" "~" "/tmp")) | ||
| 63 | "Default directories to save attachments into. | ||
| 64 | Each media type may have it's own list of directories in order of | ||
| 65 | preference. The first existing directory in the list will be | ||
| 66 | used." | ||
| 67 | :type 'list | ||
| 68 | :group 'mime) | ||
| 69 | |||
| 70 | (defvar rmail-mime-total-number-of-bulk-attachments 0 | ||
| 71 | "A total number of attached bulk bodyparts in the message. If more than 3, | ||
| 72 | offer a way to save all attachments at once.") | ||
| 73 | (put 'rmail-mime-total-number-of-bulk-attachments 'permanent-local t) | ||
| 74 | |||
| 75 | ;;; Buttons | ||
| 76 | |||
| 77 | (defun rmail-mime-save (button) | ||
| 78 | "Save the attachment using info in the BUTTON." | ||
| 79 | (let* ((filename (button-get button 'filename)) | ||
| 80 | (directory (button-get button 'directory)) | ||
| 81 | (data (button-get button 'data))) | ||
| 82 | (while (file-exists-p (expand-file-name filename directory)) | ||
| 83 | (let* ((f (file-name-sans-extension filename)) | ||
| 84 | (i 1)) | ||
| 85 | (when (string-match "-\\([0-9]+\\)$" f) | ||
| 86 | (setq i (1+ (string-to-number (match-string 1 f))) | ||
| 87 | f (substring f 0 (match-beginning 0)))) | ||
| 88 | (setq filename (concat f "-" (number-to-string i) "." | ||
| 89 | (file-name-extension filename))))) | ||
| 90 | (setq filename (expand-file-name | ||
| 91 | (read-file-name (format "Save as (default: %s): " filename) | ||
| 92 | directory | ||
| 93 | (expand-file-name filename directory)) | ||
| 94 | directory)) | ||
| 95 | (when (file-regular-p filename) | ||
| 96 | (error (message "File `%s' already exists" filename))) | ||
| 97 | (with-temp-file filename | ||
| 98 | (set-buffer-file-coding-system 'no-conversion) | ||
| 99 | (insert data)))) | ||
| 100 | |||
| 101 | (define-button-type 'rmail-mime-save | ||
| 102 | 'action 'rmail-mime-save) | ||
| 103 | |||
| 104 | ;;; Handlers | ||
| 105 | |||
| 106 | (defun rmail-mime-text-handler (content-type | ||
| 107 | content-disposition | ||
| 108 | content-transfer-encoding) | ||
| 109 | "Handle the current buffer as a plain text MIME part." | ||
| 110 | (let* ((charset (cdr (assq 'charset (cdr content-type)))) | ||
| 111 | (coding-system (when charset | ||
| 112 | (intern (downcase charset))))) | ||
| 113 | (when (coding-system-p coding-system) | ||
| 114 | (decode-coding-region (point-min) (point-max) coding-system)))) | ||
| 115 | |||
| 116 | (defun test-rmail-mime-handler () | ||
| 117 | "Test of a mail using no MIME parts at all." | ||
| 118 | (let ((mail "To: alex@gnu.org | ||
| 119 | Content-Type: text/plain; charset=koi8-r | ||
| 120 | Content-Transfer-Encoding: 8bit | ||
| 121 | MIME-Version: 1.0 | ||
| 122 | |||
| 123 | \372\304\322\301\327\323\324\327\325\312\324\305\41")) | ||
| 124 | (switch-to-buffer (get-buffer-create "*test*")) | ||
| 125 | (erase-buffer) | ||
| 126 | (set-buffer-multibyte nil) | ||
| 127 | (insert mail) | ||
| 128 | (rmail-mime-show t) | ||
| 129 | (set-buffer-multibyte t))) | ||
| 130 | |||
| 131 | (defun rmail-mime-bulk-handler (content-type | ||
| 132 | content-disposition | ||
| 133 | content-transfer-encoding) | ||
| 134 | "Handle the current buffer as an attachment to download." | ||
| 135 | (setq rmail-mime-total-number-of-bulk-attachments | ||
| 136 | (1+ rmail-mime-total-number-of-bulk-attachments)) | ||
| 137 | ;; Find the default directory for this media type | ||
| 138 | (let* ((directory (catch 'directory | ||
| 139 | (dolist (entry rmail-mime-attachment-dirs-alist) | ||
| 140 | (when (string-match (car entry) (car content-type)) | ||
| 141 | (dolist (dir (cdr entry)) | ||
| 142 | (when (file-directory-p dir) | ||
| 143 | (throw 'directory dir))))))) | ||
| 144 | (filename (or (cdr (assq 'name (cdr content-type))) | ||
| 145 | (cdr (assq 'filename (cdr content-disposition))) | ||
| 146 | "noname")) | ||
| 147 | (label (format "\nAttached %s file: " (car content-type))) | ||
| 148 | (data (buffer-string))) | ||
| 149 | (delete-region (point-min) (point-max)) | ||
| 150 | (insert label) | ||
| 151 | (insert-button filename | ||
| 152 | :type 'rmail-mime-save | ||
| 153 | 'filename filename | ||
| 154 | 'directory directory | ||
| 155 | 'data data))) | ||
| 156 | |||
| 157 | (defun test-rmail-mime-bulk-handler () | ||
| 158 | "Test of a mail used as an example in RFC 2183." | ||
| 159 | (let ((mail "Content-Type: image/jpeg | ||
| 160 | Content-Disposition: attachment; filename=genome.jpeg; | ||
| 161 | modification-date=\"Wed, 12 Feb 1997 16:29:51 -0500\"; | ||
| 162 | Content-Description: a complete map of the human genome | ||
| 163 | Content-Transfer-Encoding: base64 | ||
| 164 | |||
| 165 | iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAMAAABg3Am1AAAABGdBTUEAALGPC/xhBQAAAAZQ | ||
| 166 | TFRF////AAAAVcLTfgAAAPZJREFUeNq9ldsOwzAIQ+3//+l1WlvA5ZLsoUiTto4TB+ISoAjy | ||
| 167 | +ITfRBfcAmgRFFeAm+J6uhdKdFhFWUgDkFsK0oUp/9G2//Kj7Jx+5tSKOdBscgUYiKHRS/me | ||
| 168 | WATQdRUvAK0Bnmshmtn79PpaLBbbOZkjKvRnjRZoRswOkG1wFchKew2g9wXVJVZL/m4+B+vv | ||
| 169 | 9AxQQR2Q33SgAYJzzVACdAWjAfRYzYFO9n6SLnydtQHSMxYDMAKqZ/8FS/lTK+zuq3CtK64L | ||
| 170 | UDwbgUEAUmk2Zyg101d6PhCDySgAvTvDgKiuOrc4dLxUb7UMnhGIexyI+d6U+ABuNAP4Simx | ||
| 171 | lgAAAABJRU5ErkJggg== | ||
| 172 | ")) | ||
| 173 | (switch-to-buffer (get-buffer-create "*test*")) | ||
| 174 | (erase-buffer) | ||
| 175 | (insert mail) | ||
| 176 | (rmail-mime-show))) | ||
| 177 | |||
| 178 | (defun rmail-mime-multipart-handler (content-type | ||
| 179 | content-disposition | ||
| 180 | content-transfer-encoding) | ||
| 181 | "Handle the current buffer as a multipart MIME body. | ||
| 182 | The current buffer should be narrowed to the body. CONTENT-TYPE, | ||
| 183 | CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values | ||
| 184 | of the respective parsed headers. See `rmail-mime-handle' for their | ||
| 185 | format." | ||
| 186 | ;; Some MUAs start boundaries with "--", while it should start | ||
| 187 | ;; with "CRLF--", as defined by RFC 2046: | ||
| 188 | ;; The boundary delimiter MUST occur at the beginning of a line, | ||
| 189 | ;; i.e., following a CRLF, and the initial CRLF is considered to | ||
| 190 | ;; be attached to the boundary delimiter line rather than part | ||
| 191 | ;; of the preceding part. | ||
| 192 | ;; We currently don't handle that. | ||
| 193 | (let ((boundary (cdr (assq 'boundary content-type))) | ||
| 194 | beg end next) | ||
| 195 | (unless boundary | ||
| 196 | (rmail-mm-get-boundary-error-message | ||
| 197 | "No boundary defined" content-type content-disposition | ||
| 198 | content-transfer-encoding)) | ||
| 199 | (setq boundary (concat "\n--" boundary)) | ||
| 200 | ;; Hide the body before the first bodypart | ||
| 201 | (goto-char (point-min)) | ||
| 202 | (when (and (search-forward boundary nil t) | ||
| 203 | (looking-at "[ \t]*\n")) | ||
| 204 | (delete-region (point-min) (match-end 0))) | ||
| 205 | ;; Reset the counter | ||
| 206 | (setq rmail-mime-total-number-of-bulk-attachments 0) | ||
| 207 | ;; Loop over all body parts, where beg points at the beginning of | ||
| 208 | ;; the part and end points at the end of the part. next points at | ||
| 209 | ;; the beginning of the next part. | ||
| 210 | (setq beg (point-min)) | ||
| 211 | (while (search-forward boundary nil t) | ||
| 212 | (setq end (match-beginning 0)) | ||
| 213 | ;; If this is the last boundary according to RFC 2046, hide the | ||
| 214 | ;; epilogue, else hide the boundary only. Use a marker for | ||
| 215 | ;; `next' because `rmail-mime-show' may change the buffer. | ||
| 216 | (cond ((looking-at "--[ \t]*\n") | ||
| 217 | (setq next (point-max-marker))) | ||
| 218 | ((looking-at "[ \t]*\n") | ||
| 219 | (setq next (copy-marker (match-end 0)))) | ||
| 220 | (t | ||
| 221 | (rmail-mm-get-boundary-error-message | ||
| 222 | "Malformed boundary" content-type content-disposition | ||
| 223 | content-transfer-encoding))) | ||
| 224 | (delete-region end next) | ||
| 225 | ;; Handle the part. | ||
| 226 | (save-match-data | ||
| 227 | (save-excursion | ||
| 228 | (save-restriction | ||
| 229 | (narrow-to-region beg end) | ||
| 230 | (rmail-mime-show)))) | ||
| 231 | (setq beg next) | ||
| 232 | (goto-char beg)))) | ||
| 233 | |||
| 234 | (defun test-rmail-mime-multipart-handler () | ||
| 235 | "Test of a mail used as an example in RFC 2046." | ||
| 236 | (let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com> | ||
| 237 | To: Ned Freed <ned@innosoft.com> | ||
| 238 | Date: Sun, 21 Mar 1993 23:56:48 -0800 (PST) | ||
| 239 | Subject: Sample message | ||
| 240 | MIME-Version: 1.0 | ||
| 241 | Content-type: multipart/mixed; boundary=\"simple boundary\" | ||
| 242 | |||
| 243 | This is the preamble. It is to be ignored, though it | ||
| 244 | is a handy place for composition agents to include an | ||
| 245 | explanatory note to non-MIME conformant readers. | ||
| 246 | |||
| 247 | --simple boundary | ||
| 248 | |||
| 249 | This is implicitly typed plain US-ASCII text. | ||
| 250 | It does NOT end with a linebreak. | ||
| 251 | --simple boundary | ||
| 252 | Content-type: text/plain; charset=us-ascii | ||
| 253 | |||
| 254 | This is explicitly typed plain US-ASCII text. | ||
| 255 | It DOES end with a linebreak. | ||
| 256 | |||
| 257 | --simple boundary-- | ||
| 258 | |||
| 259 | This is the epilogue. It is also to be ignored.")) | ||
| 260 | (switch-to-buffer (get-buffer-create "*test*")) | ||
| 261 | (erase-buffer) | ||
| 262 | (insert mail) | ||
| 263 | (rmail-mime-show t))) | ||
| 264 | |||
| 265 | ;;; Main code | ||
| 266 | |||
| 267 | (defun rmail-mime-handle (content-type | ||
| 268 | content-disposition | ||
| 269 | content-transfer-encoding) | ||
| 270 | "Handle the current buffer as a MIME part. | ||
| 271 | The current buffer should be narrowed to the respective body, and | ||
| 272 | point should be at the beginning of the body. | ||
| 273 | |||
| 274 | CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING | ||
| 275 | are the values of the respective parsed headers. The parsed | ||
| 276 | headers for CONTENT-TYPE and CONTENT-DISPOSITION have the form | ||
| 277 | |||
| 278 | \(VALUE . ALIST) | ||
| 279 | |||
| 280 | In other words: | ||
| 281 | |||
| 282 | \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) | ||
| 283 | |||
| 284 | VALUE is a string and ATTRIBUTE is a symbol. | ||
| 285 | |||
| 286 | Consider the following header, for example: | ||
| 287 | |||
| 288 | Content-Type: multipart/mixed; | ||
| 289 | boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\" | ||
| 290 | |||
| 291 | The parsed header value: | ||
| 292 | |||
| 293 | \(\"multipart/mixed\" | ||
| 294 | \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))" | ||
| 295 | ;; Handle the content transfer encodings we know. Unknown transfer | ||
| 296 | ;; encodings will be passed on to the various handlers. | ||
| 297 | (cond ((string= content-transfer-encoding "base64") | ||
| 298 | (when (ignore-errors | ||
| 299 | (base64-decode-region (point) (point-max))) | ||
| 300 | (setq content-transfer-encoding nil))) | ||
| 301 | ((string= content-transfer-encoding "quoted-printable") | ||
| 302 | (quoted-printable-decode-region (point) (point-max)) | ||
| 303 | (setq content-transfer-encoding nil)) | ||
| 304 | ((string= content-transfer-encoding "8bit") | ||
| 305 | ;; FIXME: Is this the correct way? | ||
| 306 | (set-buffer-multibyte nil))) | ||
| 307 | ;; Inline stuff requires work. Attachments are handled by the bulk | ||
| 308 | ;; handler. | ||
| 309 | (if (string= "inline" (car content-disposition)) | ||
| 310 | (let ((stop nil)) | ||
| 311 | (dolist (entry rmail-mime-media-type-handlers-alist) | ||
| 312 | (when (and (string-match (car entry) (car content-type)) (not stop)) | ||
| 313 | (progn | ||
| 314 | (setq stop (funcall (cadr entry) content-type | ||
| 315 | content-disposition | ||
| 316 | content-transfer-encoding)))))) | ||
| 317 | ;; Everything else is an attachment. | ||
| 318 | (rmail-mime-bulk-handler content-type | ||
| 319 | content-disposition | ||
| 320 | content-transfer-encoding))) | ||
| 321 | |||
| 322 | (defun rmail-mime-show (&optional show-headers) | ||
| 323 | "Handle the current buffer as a MIME message. | ||
| 324 | If SHOW-HEADERS is non-nil, then the headers of the current part | ||
| 325 | will shown as usual for a MIME message. The headers are also | ||
| 326 | shown for the content type message/rfc822. This function will be | ||
| 327 | called recursively if multiple parts are available. | ||
| 328 | |||
| 329 | The current buffer must contain a single message. It will be | ||
| 330 | modified." | ||
| 331 | (let ((end (point-min)) | ||
| 332 | content-type | ||
| 333 | content-transfer-encoding | ||
| 334 | content-disposition) | ||
| 335 | ;; `point-min' returns the beginning and `end' points at the end | ||
| 336 | ;; of the headers. | ||
| 337 | (goto-char (point-min)) | ||
| 338 | ;; If we're showing a part without headers, then it will start | ||
| 339 | ;; with a newline. | ||
| 340 | (if (eq (char-after) ?\n) | ||
| 341 | (setq end (1+ (point))) | ||
| 342 | (when (search-forward "\n\n" nil t) | ||
| 343 | (setq end (match-end 0)) | ||
| 344 | (save-restriction | ||
| 345 | (narrow-to-region (point-min) end) | ||
| 346 | ;; FIXME: Default disposition of the multipart entities should | ||
| 347 | ;; be inherited. | ||
| 348 | (setq content-type | ||
| 349 | (mail-fetch-field "Content-Type") | ||
| 350 | content-transfer-encoding | ||
| 351 | (mail-fetch-field "Content-Transfer-Encoding") | ||
| 352 | content-disposition | ||
| 353 | (mail-fetch-field "Content-Disposition"))))) | ||
| 354 | (if content-type | ||
| 355 | (setq content-type (mail-header-parse-content-type | ||
| 356 | content-type)) | ||
| 357 | ;; FIXME: Default "message/rfc822" in a "multipart/digest" | ||
| 358 | ;; according to RFC 2046. | ||
| 359 | (setq content-type '("text/plain"))) | ||
| 360 | (setq content-disposition | ||
| 361 | (if content-disposition | ||
| 362 | (mail-header-parse-content-disposition content-disposition) | ||
| 363 | ;; If none specified, we are free to choose what we deem | ||
| 364 | ;; suitable according to RFC 2183. We like inline. | ||
| 365 | '("inline"))) | ||
| 366 | ;; Unrecognized disposition types are to be treated like | ||
| 367 | ;; attachment according to RFC 2183. | ||
| 368 | (unless (member (car content-disposition) '("inline" "attachment")) | ||
| 369 | (setq content-disposition '("attachment"))) | ||
| 370 | ;; Hide headers and handle the part. | ||
| 371 | (save-restriction | ||
| 372 | (cond ((string= (car content-type) "message/rfc822") | ||
| 373 | (narrow-to-region end (point-max))) | ||
| 374 | ((not show-headers) | ||
| 375 | (delete-region (point-min) end))) | ||
| 376 | (rmail-mime-handle content-type content-disposition | ||
| 377 | content-transfer-encoding)))) | ||
| 378 | |||
| 379 | (defun rmail-mime () | ||
| 380 | "Copy buffer contents to a temporary buffer and handle MIME. | ||
| 381 | This calls `rmail-mime-show' to do the real job." | ||
| 382 | (interactive) | ||
| 383 | (rmail-swap-buffers-maybe) | ||
| 384 | (let ((data (with-current-buffer rmail-buffer | ||
| 385 | (save-restriction | ||
| 386 | (widen) | ||
| 387 | (buffer-substring | ||
| 388 | (rmail-msgbeg rmail-current-message) | ||
| 389 | (rmail-msgend rmail-current-message))))) | ||
| 390 | (buf (get-buffer-create "*RMAIL*"))) | ||
| 391 | (set-buffer buf) | ||
| 392 | (let ((inhibit-read-only t)) | ||
| 393 | (erase-buffer) | ||
| 394 | (insert data) | ||
| 395 | (rmail-mime-show t)) | ||
| 396 | (view-buffer buf))) | ||
| 397 | |||
| 398 | (defun rmail-mm-get-boundary-error-message (message type disposition encoding) | ||
| 399 | "Return MESSAGE with more information on the main mime components." | ||
| 400 | (error "%s; type: %s; disposition: %s; encoding: %s" | ||
| 401 | message type disposition encoding)) | ||
| 402 | |||
| 403 | (provide 'rmailmm) | ||
| 404 | |||
| 405 | ;; Local Variables: | ||
| 406 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 407 | ;; End: | ||
| 408 | |||
| 409 | ;; arch-tag: 3f2c5e5d-1aef-4512-bc20-fd737c9d5dd9 | ||
| 410 | ;;; rmailmm.el ends here | ||
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el new file mode 100644 index 00000000000..aba7b8178e5 --- /dev/null +++ b/lisp/mail/rmailmsc.el | |||
| @@ -0,0 +1,66 @@ | |||
| 1 | ;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 2002, 2003, 2004, 2005, 2006, 2007, 2008, | ||
| 4 | ;; 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile | ||
| 29 | (require 'rmail)) | ||
| 30 | |||
| 31 | (defvar rmail-current-message) | ||
| 32 | (defvar rmail-inbox-list) | ||
| 33 | |||
| 34 | (declare-function mail-parse-comma-list "mail-utils" ()) | ||
| 35 | (declare-function rmail-show-message "rmail" (&optional msg)) | ||
| 36 | |||
| 37 | ;;;###autoload | ||
| 38 | (defun set-rmail-inbox-list (file-name) | ||
| 39 | "Set the inbox list of the current RMAIL file to FILE-NAME. | ||
| 40 | You can specify one file name, or several names separated by commas. | ||
| 41 | If FILE-NAME is empty, remove any existing inbox list." | ||
| 42 | (interactive "sSet mailbox list to (comma-separated list of filenames): ") | ||
| 43 | (unless (eq major-mode 'rmail-mode) | ||
| 44 | (error "set-rmail-inbox-list works only for an Rmail file")) | ||
| 45 | (let ((inbox-list | ||
| 46 | (with-temp-buffer | ||
| 47 | (insert file-name) | ||
| 48 | (goto-char (point-min)) | ||
| 49 | (nreverse (mail-parse-comma-list))))) | ||
| 50 | (when (or (not rmail-inbox-list) | ||
| 51 | (y-or-n-p (concat "Replace " | ||
| 52 | (mapconcat 'identity | ||
| 53 | rmail-inbox-list | ||
| 54 | ", ") | ||
| 55 | "? "))) | ||
| 56 | (message "Setting the inbox list for %s for this session" | ||
| 57 | (file-name-nondirectory (buffer-file-name))) | ||
| 58 | (setq rmail-inbox-list inbox-list))) | ||
| 59 | (rmail-show-message rmail-current-message)) | ||
| 60 | |||
| 61 | ;; Local Variables: | ||
| 62 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 63 | ;; End: | ||
| 64 | |||
| 65 | ;; arch-tag: 94614a62-2a0a-4e25-bac9-06f461ed4c60 | ||
| 66 | ;;; rmailmsc.el ends here | ||
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el new file mode 100644 index 00000000000..8c853ed2974 --- /dev/null +++ b/lisp/mail/rmailout.el | |||
| @@ -0,0 +1,602 @@ | |||
| 1 | ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 1987, 1993, 1994, 2001, 2002, 2003, 2004, 2005, | ||
| 4 | ;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'rmail) | ||
| 29 | (provide 'rmailout) | ||
| 30 | |||
| 31 | ;;;###autoload | ||
| 32 | (defcustom rmail-output-decode-coding nil | ||
| 33 | "*If non-nil, do coding system decoding when outputting message as Babyl." | ||
| 34 | :type '(choice (const :tag "on" t) | ||
| 35 | (const :tag "off" nil)) | ||
| 36 | :group 'rmail) | ||
| 37 | |||
| 38 | ;;;###autoload | ||
| 39 | (defcustom rmail-output-file-alist nil | ||
| 40 | "*Alist matching regexps to suggested output Rmail files. | ||
| 41 | This is a list of elements of the form (REGEXP . NAME-EXP). | ||
| 42 | The suggestion is taken if REGEXP matches anywhere in the message buffer. | ||
| 43 | NAME-EXP may be a string constant giving the file name to use, | ||
| 44 | or more generally it may be any kind of expression that returns | ||
| 45 | a file name as a string." | ||
| 46 | :type '(repeat (cons regexp | ||
| 47 | (choice :value "" | ||
| 48 | (string :tag "File Name") | ||
| 49 | sexp))) | ||
| 50 | :group 'rmail-output) | ||
| 51 | |||
| 52 | (defun rmail-output-read-file-name () | ||
| 53 | "Read the file name to use for `rmail-output'. | ||
| 54 | Set `rmail-default-file' to this name as well as returning it." | ||
| 55 | (let ((default-file | ||
| 56 | (let (answer tail) | ||
| 57 | (setq tail rmail-output-file-alist) | ||
| 58 | ;; Suggest a file based on a pattern match. | ||
| 59 | (while (and tail (not answer)) | ||
| 60 | (save-excursion | ||
| 61 | (goto-char (point-min)) | ||
| 62 | (if (re-search-forward (car (car tail)) nil t) | ||
| 63 | (setq answer (eval (cdr (car tail))))) | ||
| 64 | (setq tail (cdr tail)))) | ||
| 65 | ;; If no suggestion, use same file as last time. | ||
| 66 | (or answer rmail-default-file)))) | ||
| 67 | (let ((read-file | ||
| 68 | (expand-file-name | ||
| 69 | (read-file-name | ||
| 70 | (concat "Output message to mail file (default " | ||
| 71 | (file-name-nondirectory default-file) | ||
| 72 | "): ") | ||
| 73 | (file-name-directory default-file) | ||
| 74 | (abbreviate-file-name default-file)) | ||
| 75 | (file-name-directory default-file)))) | ||
| 76 | (setq rmail-default-file | ||
| 77 | (if (file-directory-p read-file) | ||
| 78 | (expand-file-name (file-name-nondirectory default-file) | ||
| 79 | read-file) | ||
| 80 | (expand-file-name | ||
| 81 | (or read-file (file-name-nondirectory default-file)) | ||
| 82 | (file-name-directory default-file))))))) | ||
| 83 | |||
| 84 | ;;;###autoload | ||
| 85 | (defcustom rmail-fields-not-to-output nil | ||
| 86 | "*Regexp describing fields to exclude when outputting a message to a file." | ||
| 87 | :type '(choice (const :tag "None" nil) | ||
| 88 | regexp) | ||
| 89 | :group 'rmail-output) | ||
| 90 | |||
| 91 | ;; Delete from the buffer header fields we don't want output. | ||
| 92 | ;; Buffer should be pre-narrowed to the header. | ||
| 93 | ;; PRESERVE is a regexp for fields NEVER to delete. | ||
| 94 | (defun rmail-delete-unwanted-fields (preserve) | ||
| 95 | (if rmail-fields-not-to-output | ||
| 96 | (save-excursion | ||
| 97 | (goto-char (point-min)) | ||
| 98 | (while (re-search-forward rmail-fields-not-to-output nil t) | ||
| 99 | (beginning-of-line) | ||
| 100 | (unless (looking-at preserve) | ||
| 101 | (delete-region (point) | ||
| 102 | (progn (forward-line 1) (point)))))))) | ||
| 103 | |||
| 104 | (defun rmail-output-as-babyl (file-name nomsg) | ||
| 105 | "Convert the current buffer's text to Babyl and output to FILE-NAME. | ||
| 106 | It alters the current buffer's text, so it should be a temp buffer." | ||
| 107 | (let ((coding-system-for-write | ||
| 108 | 'emacs-mule-unix)) | ||
| 109 | (save-restriction | ||
| 110 | (goto-char (point-min)) | ||
| 111 | (search-forward "\n\n" nil 'move) | ||
| 112 | (narrow-to-region (point-min) (point)) | ||
| 113 | (if rmail-fields-not-to-output | ||
| 114 | (rmail-delete-unwanted-fields nil))) | ||
| 115 | |||
| 116 | ;; Convert to Babyl format. | ||
| 117 | (rmail-convert-to-babyl-format) | ||
| 118 | ;; Write it into the file, or its buffer. | ||
| 119 | (let ((buf (find-buffer-visiting file-name)) | ||
| 120 | (tembuf (current-buffer))) | ||
| 121 | (if (null buf) | ||
| 122 | (write-region (point-min) (point-max) file-name t nomsg) | ||
| 123 | (if (eq buf (current-buffer)) | ||
| 124 | (error "Can't output message to same file it's already in")) | ||
| 125 | ;; File has been visited, in buffer BUF. | ||
| 126 | (set-buffer buf) | ||
| 127 | (let ((inhibit-read-only t) | ||
| 128 | (msg (with-no-warnings | ||
| 129 | (and (boundp 'rmail-current-message) | ||
| 130 | rmail-current-message)))) | ||
| 131 | ;; If MSG is non-nil, buffer is in RMAIL mode. | ||
| 132 | (if msg | ||
| 133 | (rmail-output-to-r-mail-buffer tembuf msg) | ||
| 134 | ;; Output file not in rmail mode => just insert at the end. | ||
| 135 | (narrow-to-region (point-min) (1+ (buffer-size))) | ||
| 136 | (goto-char (point-max)) | ||
| 137 | (insert-buffer-substring tembuf))))))) | ||
| 138 | |||
| 139 | ;; When Rmail is really installed, if we delete or rename the old Rmail | ||
| 140 | ;; we should do likewise with this function. | ||
| 141 | |||
| 142 | (defun rmail-output-to-r-mail-buffer (tembuf msg) | ||
| 143 | "Copy msg in TEMBUF from BEG to END into this old R-mail BABYL buffer. | ||
| 144 | Do what is necessary to make babyl R-mail know about the new message. | ||
| 145 | Then display message number MSG." | ||
| 146 | (with-no-warnings | ||
| 147 | ;; Turn on Auto Save mode, if it's off in this | ||
| 148 | ;; buffer but enabled by default. | ||
| 149 | (and (not buffer-auto-save-file-name) | ||
| 150 | auto-save-default | ||
| 151 | (auto-save-mode t)) | ||
| 152 | (rmail-maybe-set-message-counters) | ||
| 153 | (widen) | ||
| 154 | (narrow-to-region (point-max) (point-max)) | ||
| 155 | (insert-buffer-substring tembuf) | ||
| 156 | (goto-char (point-min)) | ||
| 157 | (widen) | ||
| 158 | (search-backward "\n\^_") | ||
| 159 | (narrow-to-region (point) (point-max)) | ||
| 160 | (rmail-count-new-messages t) | ||
| 161 | (if (rmail-summary-exists) | ||
| 162 | (rmail-select-summary | ||
| 163 | (rmail-update-summary))) | ||
| 164 | (rmail-show-message msg))) | ||
| 165 | |||
| 166 | (defun rmail-convert-to-babyl-format () | ||
| 167 | (let ((count 0) (start (point-min)) | ||
| 168 | (case-fold-search nil) | ||
| 169 | (buffer-undo-list t)) | ||
| 170 | (goto-char (point-min)) | ||
| 171 | (save-restriction | ||
| 172 | (unless (looking-at "^From ") | ||
| 173 | (error "Invalid mbox message")) | ||
| 174 | (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | ||
| 175 | (rmail-nuke-pinhead-header) | ||
| 176 | ;; Decode base64 or quoted printable contents, Rmail style. | ||
| 177 | (let* ((header-end (save-excursion | ||
| 178 | (and (re-search-forward "\n\n" nil t) | ||
| 179 | (1- (point))))) | ||
| 180 | (case-fold-search t) | ||
| 181 | (quoted-printable-header-field-end | ||
| 182 | (save-excursion | ||
| 183 | (re-search-forward | ||
| 184 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | ||
| 185 | header-end t))) | ||
| 186 | (base64-header-field-end | ||
| 187 | (and | ||
| 188 | ;; Don't decode non-text data. | ||
| 189 | (save-excursion | ||
| 190 | (re-search-forward | ||
| 191 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | ||
| 192 | header-end t)) | ||
| 193 | (save-excursion | ||
| 194 | (re-search-forward | ||
| 195 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | ||
| 196 | header-end t))))) | ||
| 197 | |||
| 198 | (goto-char (point-max)) | ||
| 199 | (if quoted-printable-header-field-end | ||
| 200 | (save-excursion | ||
| 201 | (unless (mail-unquote-printable-region | ||
| 202 | header-end (point) nil t t) | ||
| 203 | (message "Malformed MIME quoted-printable message")) | ||
| 204 | ;; Change "quoted-printable" to "8bit", | ||
| 205 | ;; to reflect the decoding we just did. | ||
| 206 | (goto-char quoted-printable-header-field-end) | ||
| 207 | (delete-region (point) (search-backward ":")) | ||
| 208 | (insert ": 8bit"))) | ||
| 209 | (if base64-header-field-end | ||
| 210 | (save-excursion | ||
| 211 | (when (condition-case nil | ||
| 212 | (progn | ||
| 213 | (base64-decode-region | ||
| 214 | (1+ header-end) | ||
| 215 | (save-excursion | ||
| 216 | ;; Prevent base64-decode-region | ||
| 217 | ;; from removing newline characters. | ||
| 218 | (skip-chars-backward "\n\t ") | ||
| 219 | (point))) | ||
| 220 | t) | ||
| 221 | (error nil)) | ||
| 222 | ;; Change "base64" to "8bit", to reflect the | ||
| 223 | ;; decoding we just did. | ||
| 224 | (goto-char base64-header-field-end) | ||
| 225 | (delete-region (point) (search-backward ":")) | ||
| 226 | (insert ": 8bit"))))) | ||
| 227 | ;; Transform anything within the message text | ||
| 228 | ;; that might appear to be the end of a Babyl-format message. | ||
| 229 | (save-excursion | ||
| 230 | (save-restriction | ||
| 231 | (narrow-to-region start (point)) | ||
| 232 | (goto-char (point-min)) | ||
| 233 | (while (search-forward "\n\^_" nil t) ; single char | ||
| 234 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" | ||
| 235 | ;; This is for malformed messages that don't end in newline. | ||
| 236 | ;; There shouldn't be any, but some users say occasionally | ||
| 237 | ;; there are some. | ||
| 238 | (or (bolp) (newline)) | ||
| 239 | (insert ?\^_) | ||
| 240 | (setq last-coding-system-used nil) | ||
| 241 | ;; Decode coding system, following specs in the message header, | ||
| 242 | ;; and record what coding system was decoded. | ||
| 243 | (if rmail-output-decode-coding | ||
| 244 | (let ((mime-charset | ||
| 245 | (if (save-excursion | ||
| 246 | (goto-char start) | ||
| 247 | (search-forward "\n\n" nil t) | ||
| 248 | (let ((case-fold-search t)) | ||
| 249 | (re-search-backward | ||
| 250 | rmail-mime-charset-pattern | ||
| 251 | start t))) | ||
| 252 | (intern (downcase (match-string 1)))))) | ||
| 253 | (rmail-decode-region start (point) mime-charset))) | ||
| 254 | (save-excursion | ||
| 255 | (goto-char start) | ||
| 256 | (forward-line 3) | ||
| 257 | (insert "X-Coding-System: " | ||
| 258 | (symbol-name last-coding-system-used) | ||
| 259 | "\n"))))) | ||
| 260 | |||
| 261 | ;; Delete the "From ..." line, creating various other headers with | ||
| 262 | ;; information from it if they don't already exist. Now puts the | ||
| 263 | ;; original line into a mail-from: header line for debugging and for | ||
| 264 | ;; use by the rmail-output function. | ||
| 265 | (defun rmail-nuke-pinhead-header () | ||
| 266 | (save-excursion | ||
| 267 | (save-restriction | ||
| 268 | (let ((start (point)) | ||
| 269 | (end (progn | ||
| 270 | (condition-case () | ||
| 271 | (search-forward "\n\n") | ||
| 272 | (error | ||
| 273 | (goto-char (point-max)) | ||
| 274 | (insert "\n\n"))) | ||
| 275 | (point))) | ||
| 276 | has-from has-date) | ||
| 277 | (narrow-to-region start end) | ||
| 278 | (let ((case-fold-search t)) | ||
| 279 | (goto-char start) | ||
| 280 | (setq has-from (search-forward "\nFrom:" nil t)) | ||
| 281 | (goto-char start) | ||
| 282 | (setq has-date (and (search-forward "\nDate:" nil t) (point))) | ||
| 283 | (goto-char start)) | ||
| 284 | (let ((case-fold-search nil)) | ||
| 285 | (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) | ||
| 286 | (replace-match | ||
| 287 | (concat | ||
| 288 | "Mail-from: \\&" | ||
| 289 | ;; Keep and reformat the date if we don't | ||
| 290 | ;; have a Date: field. | ||
| 291 | (if has-date | ||
| 292 | "" | ||
| 293 | (concat | ||
| 294 | "Date: \\2, \\4 \\3 \\9 \\5 " | ||
| 295 | |||
| 296 | ;; The timezone could be matched by group 7 or group 10. | ||
| 297 | ;; If neither of them matched, assume EST, since only | ||
| 298 | ;; Easterners would be so sloppy. | ||
| 299 | ;; It's a shame the substitution can't use "\\10". | ||
| 300 | (cond | ||
| 301 | ((/= (match-beginning 7) (match-end 7)) "\\7") | ||
| 302 | ((/= (match-beginning 10) (match-end 10)) | ||
| 303 | (buffer-substring (match-beginning 10) | ||
| 304 | (match-end 10))) | ||
| 305 | (t "EST")) | ||
| 306 | "\n")) | ||
| 307 | ;; Keep and reformat the sender if we don't | ||
| 308 | ;; have a From: field. | ||
| 309 | (if has-from | ||
| 310 | "" | ||
| 311 | "From: \\1\n")) | ||
| 312 | t))))))) | ||
| 313 | |||
| 314 | (defun rmail-output-as-mbox (file-name nomsg &optional as-seen) | ||
| 315 | "Convert the current buffer's text to mbox Babyl and output to FILE-NAME. | ||
| 316 | It alters the current buffer's text, so call with a temp buffer current. | ||
| 317 | If FILE-NAME is visited, output into its buffer instead. | ||
| 318 | AS-SEEN is non-nil if we are copying the message \"as seen\"." | ||
| 319 | (let ((case-fold-search t) | ||
| 320 | mail-from mime-version content-type) | ||
| 321 | |||
| 322 | ;; Preserve the Mail-From and MIME-Version fields | ||
| 323 | ;; even if they have been pruned. | ||
| 324 | (search-forward "\n\n" nil 'move) | ||
| 325 | (narrow-to-region (point-min) (point)) | ||
| 326 | |||
| 327 | (rmail-delete-unwanted-fields | ||
| 328 | (if rmail-enable-mime "Mail-From" | ||
| 329 | "Mail-From\\|MIME-Version\\|Content-type")) | ||
| 330 | |||
| 331 | (widen) | ||
| 332 | |||
| 333 | ;; Make sure message ends with blank line. | ||
| 334 | (goto-char (point-max)) | ||
| 335 | (unless (bolp) | ||
| 336 | (insert "\n")) | ||
| 337 | (unless (looking-back "\n\n") | ||
| 338 | (insert "\n")) | ||
| 339 | |||
| 340 | ;; Generate a From line from other header fields | ||
| 341 | ;; if necessary. | ||
| 342 | (goto-char (point-min)) | ||
| 343 | (unless (looking-at "From ") | ||
| 344 | (insert "From " | ||
| 345 | (mail-strip-quoted-names | ||
| 346 | (save-excursion | ||
| 347 | (save-restriction | ||
| 348 | (goto-char (point-min)) | ||
| 349 | (narrow-to-region | ||
| 350 | (point) | ||
| 351 | (or (search-forward "\n\n" nil) | ||
| 352 | (point-max))) | ||
| 353 | (or (mail-fetch-field "from") | ||
| 354 | (mail-fetch-field "really-from") | ||
| 355 | (mail-fetch-field "sender") | ||
| 356 | "unknown")))) | ||
| 357 | " " (current-time-string) "\n")) | ||
| 358 | |||
| 359 | (let ((buf (find-buffer-visiting file-name)) | ||
| 360 | (tembuf (current-buffer))) | ||
| 361 | (if (null buf) | ||
| 362 | (let ((coding-system-for-write 'raw-text-unix)) | ||
| 363 | (write-region (point-min) (point-max) file-name t nomsg)) | ||
| 364 | (if (eq buf (current-buffer)) | ||
| 365 | (error "Can't output message to same file it's already in")) | ||
| 366 | ;; File has been visited, in buffer BUF. | ||
| 367 | (set-buffer buf) | ||
| 368 | (let ((inhibit-read-only t) | ||
| 369 | (msg (and (boundp 'rmail-current-message) | ||
| 370 | rmail-current-message))) | ||
| 371 | (and msg as-seen | ||
| 372 | (error "Can't output \"as seen\" to a visited Rmail file")) | ||
| 373 | (if msg | ||
| 374 | (rmail-output-to-rmail-buffer tembuf msg) | ||
| 375 | ;; Output file not in Rmail mode => just insert at the end. | ||
| 376 | (narrow-to-region (point-min) (1+ (buffer-size))) | ||
| 377 | (goto-char (point-max)) | ||
| 378 | (insert-buffer-substring tembuf))))))) | ||
| 379 | |||
| 380 | ;; Called only if rmail-summary-exists, which means rmailsum is loaded. | ||
| 381 | (declare-function rmail-update-summary "rmailsum" (&rest ignore)) | ||
| 382 | |||
| 383 | (defun rmail-output-to-rmail-buffer (tembuf msg) | ||
| 384 | "Copy msg in TEMBUF from BEG to END into this Rmail buffer. | ||
| 385 | Do what is necessary to make Rmail know about the new message. | ||
| 386 | Then display message number MSG." | ||
| 387 | (save-excursion | ||
| 388 | (rmail-swap-buffers-maybe) | ||
| 389 | ;; Turn on Auto Save mode, if it's off in this | ||
| 390 | ;; buffer but enabled by default. | ||
| 391 | (and (not buffer-auto-save-file-name) | ||
| 392 | auto-save-default | ||
| 393 | (auto-save-mode t)) | ||
| 394 | (rmail-maybe-set-message-counters) | ||
| 395 | (narrow-to-region (point-max) (point-max)) | ||
| 396 | (insert-buffer-substring tembuf) | ||
| 397 | (rmail-count-new-messages t) | ||
| 398 | (if (rmail-summary-exists) | ||
| 399 | (rmail-select-summary | ||
| 400 | (rmail-update-summary))) | ||
| 401 | (rmail-show-message msg))) | ||
| 402 | |||
| 403 | ;;; There are functions elsewhere in Emacs that use this function; | ||
| 404 | ;;; look at them before you change the calling method. | ||
| 405 | ;;;###autoload | ||
| 406 | (defun rmail-output (file-name &optional count noattribute from-gnus) | ||
| 407 | "Append this message to mail file FILE-NAME. | ||
| 408 | This works with both mbox format and Babyl format files, | ||
| 409 | outputting in the appropriate format for each. | ||
| 410 | The default file name comes from `rmail-default-file', | ||
| 411 | which is updated to the name you use in this command. | ||
| 412 | |||
| 413 | A prefix argument COUNT says to output that many consecutive messages, | ||
| 414 | starting with the current one. Deleted messages are skipped and don't count. | ||
| 415 | When called from Lisp code, COUNT may be omitted and defaults to 1. | ||
| 416 | |||
| 417 | This command always outputs the complete message header, | ||
| 418 | even the header display is currently pruned. | ||
| 419 | |||
| 420 | The optional third argument NOATTRIBUTE, if non-nil, says not | ||
| 421 | to set the `filed' attribute, and not to display a message. | ||
| 422 | |||
| 423 | The optional fourth argument FROM-GNUS is set when called from GNUS." | ||
| 424 | (interactive | ||
| 425 | (list (rmail-output-read-file-name) | ||
| 426 | (prefix-numeric-value current-prefix-arg))) | ||
| 427 | (or count (setq count 1)) | ||
| 428 | (setq file-name | ||
| 429 | (expand-file-name file-name | ||
| 430 | (and rmail-default-file | ||
| 431 | (file-name-directory rmail-default-file)))) | ||
| 432 | |||
| 433 | ;; Warn about creating new file. | ||
| 434 | (or (find-buffer-visiting file-name) | ||
| 435 | (file-exists-p file-name) | ||
| 436 | (yes-or-no-p | ||
| 437 | (concat "\"" file-name "\" does not exist, create it? ")) | ||
| 438 | (error "Output file does not exist")) | ||
| 439 | |||
| 440 | (set-buffer rmail-buffer) | ||
| 441 | |||
| 442 | (let ((orig-count count) | ||
| 443 | (case-fold-search t) | ||
| 444 | (tembuf (get-buffer-create " rmail-output")) | ||
| 445 | (babyl-format | ||
| 446 | (and (file-readable-p file-name) (mail-file-babyl-p file-name)))) | ||
| 447 | |||
| 448 | (unwind-protect | ||
| 449 | (while (> count 0) | ||
| 450 | (with-current-buffer rmail-buffer | ||
| 451 | (let (cur beg end) | ||
| 452 | (setq beg (rmail-msgbeg rmail-current-message) | ||
| 453 | end (rmail-msgend rmail-current-message)) | ||
| 454 | ;; All access to the buffer's local variables is now finished... | ||
| 455 | (save-excursion | ||
| 456 | ;; ... so it is ok to go to a different buffer. | ||
| 457 | (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer)) | ||
| 458 | (setq cur (current-buffer)) | ||
| 459 | (save-restriction | ||
| 460 | (widen) | ||
| 461 | (with-current-buffer tembuf | ||
| 462 | (insert-buffer-substring cur beg end) | ||
| 463 | ;; Convert the text to one format or another and output. | ||
| 464 | (if babyl-format | ||
| 465 | (rmail-output-as-babyl file-name (if noattribute 'nomsg)) | ||
| 466 | (rmail-output-as-mbox file-name | ||
| 467 | (if noattribute 'nomsg)))))))) | ||
| 468 | |||
| 469 | ;; Mark message as "filed". | ||
| 470 | (unless noattribute | ||
| 471 | (rmail-set-attribute rmail-filed-attr-index t)) | ||
| 472 | |||
| 473 | (setq count (1- count)) | ||
| 474 | |||
| 475 | (or from-gnus | ||
| 476 | (let ((next-message-p | ||
| 477 | (if rmail-delete-after-output | ||
| 478 | (rmail-delete-forward) | ||
| 479 | (if (> count 0) | ||
| 480 | (rmail-next-undeleted-message 1)))) | ||
| 481 | (num-appended (- orig-count count))) | ||
| 482 | (if (and (> count 0) (not next-message-p)) | ||
| 483 | (error "Only %d message%s appended" num-appended | ||
| 484 | (if (= num-appended 1) "" "s")))))) | ||
| 485 | (kill-buffer tembuf)))) | ||
| 486 | |||
| 487 | (defun rmail-output-as-seen (file-name &optional count noattribute from-gnus) | ||
| 488 | "Append this message to system-inbox-format mail file named FILE-NAME. | ||
| 489 | A prefix argument COUNT says to output that many consecutive messages, | ||
| 490 | starting with the current one. Deleted messages are skipped and don't count. | ||
| 491 | When called from Lisp code, COUNT may be omitted and defaults to 1. | ||
| 492 | |||
| 493 | This outputs the message header as you see it. | ||
| 494 | |||
| 495 | The default file name comes from `rmail-default-file', | ||
| 496 | which is updated to the name you use in this command. | ||
| 497 | |||
| 498 | The optional third argument NOATTRIBUTE, if non-nil, says not | ||
| 499 | to set the `filed' attribute, and not to display a message. | ||
| 500 | |||
| 501 | The optional fourth argument FROM-GNUS is set when called from GNUS." | ||
| 502 | (interactive | ||
| 503 | (list (rmail-output-read-file-name) | ||
| 504 | (prefix-numeric-value current-prefix-arg))) | ||
| 505 | (or count (setq count 1)) | ||
| 506 | (setq file-name | ||
| 507 | (expand-file-name file-name | ||
| 508 | (and rmail-default-file | ||
| 509 | (file-name-directory rmail-default-file)))) | ||
| 510 | (set-buffer rmail-buffer) | ||
| 511 | |||
| 512 | ;; Warn about creating new file. | ||
| 513 | (or (find-buffer-visiting file-name) | ||
| 514 | (file-exists-p file-name) | ||
| 515 | (yes-or-no-p | ||
| 516 | (concat "\"" file-name "\" does not exist, create it? ")) | ||
| 517 | (error "Output file does not exist")) | ||
| 518 | |||
| 519 | (if (and (file-readable-p file-name) (mail-file-babyl-p file-name)) | ||
| 520 | (error "Cannot output `as seen' to a Babyl file")) | ||
| 521 | |||
| 522 | (let ((orig-count count) | ||
| 523 | (case-fold-search t) | ||
| 524 | (tembuf (get-buffer-create " rmail-output"))) | ||
| 525 | |||
| 526 | (unwind-protect | ||
| 527 | (while (> count 0) | ||
| 528 | (let (cur beg end) | ||
| 529 | ;; If operating from whole-mbox buffer, get message bounds. | ||
| 530 | (if (not (rmail-buffers-swapped-p)) | ||
| 531 | (setq beg (rmail-msgbeg rmail-current-message) | ||
| 532 | end (rmail-msgend rmail-current-message))) | ||
| 533 | ;; All access to the buffer's local variables is now finished... | ||
| 534 | (save-excursion | ||
| 535 | (setq cur (current-buffer)) | ||
| 536 | (save-restriction | ||
| 537 | (widen) | ||
| 538 | ;; If operating from the view buffer, get the bounds. | ||
| 539 | (unless beg | ||
| 540 | (setq beg (point-min) | ||
| 541 | end (point-max))) | ||
| 542 | |||
| 543 | (with-current-buffer tembuf | ||
| 544 | (insert-buffer-substring cur beg end) | ||
| 545 | ;; Convert the text to one format or another and output. | ||
| 546 | (rmail-output-as-mbox file-name | ||
| 547 | (if noattribute 'nomsg) | ||
| 548 | t))))) | ||
| 549 | |||
| 550 | ;; Mark message as "filed". | ||
| 551 | (unless noattribute | ||
| 552 | (rmail-set-attribute rmail-filed-attr-index t)) | ||
| 553 | |||
| 554 | (setq count (1- count)) | ||
| 555 | |||
| 556 | (or from-gnus | ||
| 557 | (let ((next-message-p | ||
| 558 | (if rmail-delete-after-output | ||
| 559 | (rmail-delete-forward) | ||
| 560 | (if (> count 0) | ||
| 561 | (rmail-next-undeleted-message 1)))) | ||
| 562 | (num-appended (- orig-count count))) | ||
| 563 | (if (and (> count 0) (not next-message-p)) | ||
| 564 | (error "Only %d message%s appended" num-appended | ||
| 565 | (if (= num-appended 1) "" "s")))))) | ||
| 566 | (kill-buffer tembuf)))) | ||
| 567 | |||
| 568 | |||
| 569 | ;;;###autoload | ||
| 570 | (defun rmail-output-body-to-file (file-name) | ||
| 571 | "Write this message body to the file FILE-NAME. | ||
| 572 | FILE-NAME defaults, interactively, from the Subject field of the message." | ||
| 573 | (interactive | ||
| 574 | (let ((default-file | ||
| 575 | (or (mail-fetch-field "Subject") | ||
| 576 | rmail-default-body-file))) | ||
| 577 | (list (setq rmail-default-body-file | ||
| 578 | (read-file-name | ||
| 579 | "Output message body to file: " | ||
| 580 | (and default-file (file-name-directory default-file)) | ||
| 581 | default-file | ||
| 582 | nil default-file))))) | ||
| 583 | (setq file-name | ||
| 584 | (expand-file-name file-name | ||
| 585 | (and rmail-default-body-file | ||
| 586 | (file-name-directory rmail-default-body-file)))) | ||
| 587 | (save-excursion | ||
| 588 | (goto-char (point-min)) | ||
| 589 | (search-forward "\n\n") | ||
| 590 | (and (file-exists-p file-name) | ||
| 591 | (not (y-or-n-p (format "File %s exists; overwrite? " file-name))) | ||
| 592 | (error "Operation aborted")) | ||
| 593 | (write-region (point) (point-max) file-name)) | ||
| 594 | (if rmail-delete-after-output | ||
| 595 | (rmail-delete-forward))) | ||
| 596 | |||
| 597 | ;; Local Variables: | ||
| 598 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 599 | ;; End: | ||
| 600 | |||
| 601 | ;; arch-tag: 4059abf0-f249-4be4-8e0d-602d370d01d1 | ||
| 602 | ;;; rmailout.el ends here | ||
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el new file mode 100644 index 00000000000..b1811be78ec --- /dev/null +++ b/lisp/mail/rmailsort.el | |||
| @@ -0,0 +1,245 @@ | |||
| 1 | ;;; rmailsort.el --- Rmail: sort messages | ||
| 2 | |||
| 3 | ;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> | ||
| 7 | ;; Maintainer: FSF | ||
| 8 | ;; Keywords: mail | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (eval-when-compile | ||
| 30 | (require 'mail-utils) | ||
| 31 | (require 'sort) | ||
| 32 | (require 'rmail)) | ||
| 33 | |||
| 34 | (autoload 'timezone-make-date-sortable "timezone") | ||
| 35 | |||
| 36 | (declare-function rmail-update-summary "rmailsum" (&rest ignore)) | ||
| 37 | |||
| 38 | ;; Sorting messages in Rmail buffer | ||
| 39 | |||
| 40 | ;;;###autoload | ||
| 41 | (defun rmail-sort-by-date (reverse) | ||
| 42 | "Sort messages of current Rmail file by date. | ||
| 43 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 44 | (interactive "P") | ||
| 45 | (rmail-sort-messages reverse | ||
| 46 | (function | ||
| 47 | (lambda (msg) | ||
| 48 | (rmail-make-date-sortable | ||
| 49 | (rmail-get-header "Date" msg)))))) | ||
| 50 | |||
| 51 | ;;;###autoload | ||
| 52 | (defun rmail-sort-by-subject (reverse) | ||
| 53 | "Sort messages of current Rmail file by subject. | ||
| 54 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 55 | (interactive "P") | ||
| 56 | (rmail-sort-messages reverse | ||
| 57 | (function | ||
| 58 | (lambda (msg) | ||
| 59 | (let ((key (or (rmail-get-header "Subject" msg) "")) | ||
| 60 | (case-fold-search t)) | ||
| 61 | ;; Remove `Re:' | ||
| 62 | (if (string-match "^\\(re:[ \t]*\\)*" key) | ||
| 63 | (substring key (match-end 0)) | ||
| 64 | key)))))) | ||
| 65 | |||
| 66 | ;;;###autoload | ||
| 67 | (defun rmail-sort-by-author (reverse) | ||
| 68 | "Sort messages of current Rmail file by author. | ||
| 69 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 70 | (interactive "P") | ||
| 71 | (rmail-sort-messages reverse | ||
| 72 | (function | ||
| 73 | (lambda (msg) | ||
| 74 | (downcase ;Canonical name | ||
| 75 | (mail-strip-quoted-names | ||
| 76 | (or (rmail-get-header "From" msg) | ||
| 77 | (rmail-get-header "Sender" msg) ""))))))) | ||
| 78 | |||
| 79 | ;;;###autoload | ||
| 80 | (defun rmail-sort-by-recipient (reverse) | ||
| 81 | "Sort messages of current Rmail file by recipient. | ||
| 82 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 83 | (interactive "P") | ||
| 84 | (rmail-sort-messages reverse | ||
| 85 | (function | ||
| 86 | (lambda (msg) | ||
| 87 | (downcase ;Canonical name | ||
| 88 | (mail-strip-quoted-names | ||
| 89 | (or (rmail-get-header "To" msg) | ||
| 90 | (rmail-get-header "Apparently-To" msg) "") | ||
| 91 | )))))) | ||
| 92 | |||
| 93 | ;;;###autoload | ||
| 94 | (defun rmail-sort-by-correspondent (reverse) | ||
| 95 | "Sort messages of current Rmail file by other correspondent. | ||
| 96 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 97 | (interactive "P") | ||
| 98 | (rmail-sort-messages reverse | ||
| 99 | (function | ||
| 100 | (lambda (msg) | ||
| 101 | (rmail-select-correspondent | ||
| 102 | msg | ||
| 103 | '("From" "Sender" "To" "Apparently-To")))))) | ||
| 104 | |||
| 105 | (defun rmail-select-correspondent (msg fields) | ||
| 106 | (let ((ans "")) | ||
| 107 | (while (and fields (string= ans "")) | ||
| 108 | (setq ans | ||
| 109 | ;; NB despite the name, this lives in mail-utils.el. | ||
| 110 | (rmail-dont-reply-to | ||
| 111 | (mail-strip-quoted-names | ||
| 112 | (or (rmail-get-header (car fields) msg) "")))) | ||
| 113 | (setq fields (cdr fields))) | ||
| 114 | ans)) | ||
| 115 | |||
| 116 | ;;;###autoload | ||
| 117 | (defun rmail-sort-by-lines (reverse) | ||
| 118 | "Sort messages of current Rmail file by number of lines. | ||
| 119 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 120 | (interactive "P") | ||
| 121 | (rmail-sort-messages reverse | ||
| 122 | (function | ||
| 123 | (lambda (msg) | ||
| 124 | (count-lines (rmail-msgbeg msg) | ||
| 125 | (rmail-msgend msg)))))) | ||
| 126 | |||
| 127 | ;;;###autoload | ||
| 128 | (defun rmail-sort-by-labels (reverse labels) | ||
| 129 | "Sort messages of current Rmail file by labels. | ||
| 130 | If prefix argument REVERSE is non-nil, sort them in reverse order. | ||
| 131 | KEYWORDS is a comma-separated list of labels." | ||
| 132 | (interactive "P\nsSort by labels: ") | ||
| 133 | (or (string-match "[^ \t]" labels) | ||
| 134 | (error "No labels specified")) | ||
| 135 | (setq labels (concat (substring labels (match-beginning 0)) ",")) | ||
| 136 | (let (labelvec) | ||
| 137 | (while (string-match "[ \t]*,[ \t]*" labels) | ||
| 138 | (setq labelvec (cons | ||
| 139 | (concat ", ?\\(" | ||
| 140 | (substring labels 0 (match-beginning 0)) | ||
| 141 | "\\),") | ||
| 142 | labelvec)) | ||
| 143 | (setq labels (substring labels (match-end 0)))) | ||
| 144 | (setq labelvec (apply 'vector (nreverse labelvec))) | ||
| 145 | (rmail-sort-messages reverse | ||
| 146 | (function | ||
| 147 | (lambda (msg) | ||
| 148 | (let ((n 0)) | ||
| 149 | (while (and (< n (length labelvec)) | ||
| 150 | (not (rmail-message-labels-p | ||
| 151 | msg (aref labelvec n)))) | ||
| 152 | (setq n (1+ n))) | ||
| 153 | n)))))) | ||
| 154 | |||
| 155 | ;; Basic functions | ||
| 156 | |||
| 157 | (defun rmail-sort-messages (reverse keyfun) | ||
| 158 | "Sort messages of current Rmail file. | ||
| 159 | If 1st argument REVERSE is non-nil, sort them in reverse order. | ||
| 160 | 2nd argument KEYFUN is called with a message number, and should return a key." | ||
| 161 | (with-current-buffer rmail-buffer | ||
| 162 | (let ((return-to-point | ||
| 163 | (if (rmail-buffers-swapped-p) | ||
| 164 | (point))) | ||
| 165 | (predicate nil) ;< or string-lessp | ||
| 166 | (sort-lists nil)) | ||
| 167 | (rmail-swap-buffers-maybe) | ||
| 168 | (message "Finding sort keys...") | ||
| 169 | (widen) | ||
| 170 | (let ((msgnum 1)) | ||
| 171 | (while (>= rmail-total-messages msgnum) | ||
| 172 | (setq sort-lists | ||
| 173 | (cons (list (funcall keyfun msgnum) ;Make sorting key | ||
| 174 | (eq rmail-current-message msgnum) ;True if current | ||
| 175 | (aref rmail-message-vector msgnum) | ||
| 176 | (aref rmail-message-vector (1+ msgnum))) | ||
| 177 | sort-lists)) | ||
| 178 | (if (zerop (% msgnum 10)) | ||
| 179 | (message "Finding sort keys...%d" msgnum)) | ||
| 180 | (setq msgnum (1+ msgnum)))) | ||
| 181 | (or reverse (setq sort-lists (nreverse sort-lists))) | ||
| 182 | ;; Decide predicate: < or string-lessp | ||
| 183 | (if (numberp (car (car sort-lists))) ;Is a key numeric? | ||
| 184 | (setq predicate (function <)) | ||
| 185 | (setq predicate (function string-lessp))) | ||
| 186 | (setq sort-lists | ||
| 187 | (sort sort-lists | ||
| 188 | (function | ||
| 189 | (lambda (a b) | ||
| 190 | (funcall predicate (car a) (car b)))))) | ||
| 191 | (if reverse (setq sort-lists (nreverse sort-lists))) | ||
| 192 | ;; Now we enter critical region. So, keyboard quit is disabled. | ||
| 193 | (message "Reordering messages...") | ||
| 194 | (let ((inhibit-quit t) ;Inhibit quit | ||
| 195 | (inhibit-read-only t) | ||
| 196 | (current-message nil) | ||
| 197 | (msgnum 1) | ||
| 198 | (msginfo nil)) | ||
| 199 | ;; There's little hope that we can easily undo after that. | ||
| 200 | (buffer-disable-undo (current-buffer)) | ||
| 201 | (goto-char (rmail-msgbeg 1)) | ||
| 202 | ;; To force update of all markers, | ||
| 203 | ;; keep the new copies separated from the remaining old messages. | ||
| 204 | (insert-before-markers ?Z) | ||
| 205 | (backward-char 1) | ||
| 206 | ;; Now reorder messages. | ||
| 207 | (dolist (msginfo sort-lists) | ||
| 208 | ;; Swap two messages. | ||
| 209 | (insert-buffer-substring | ||
| 210 | (current-buffer) (nth 2 msginfo) (nth 3 msginfo)) | ||
| 211 | ;; The last message may not have \n\n after it. | ||
| 212 | (unless (bobp) | ||
| 213 | (insert "\n")) | ||
| 214 | (unless (looking-back "\n\n") | ||
| 215 | (insert "\n")) | ||
| 216 | (delete-region (nth 2 msginfo) (nth 3 msginfo)) | ||
| 217 | ;; Is current message? | ||
| 218 | (if (nth 1 msginfo) | ||
| 219 | (setq current-message msgnum)) | ||
| 220 | (if (zerop (% msgnum 10)) | ||
| 221 | (message "Reordering messages...%d" msgnum)) | ||
| 222 | (setq msgnum (1+ msgnum))) | ||
| 223 | ;; Delete the dummy separator Z inserted before. | ||
| 224 | (delete-char 1) | ||
| 225 | (setq quit-flag nil) | ||
| 226 | (rmail-set-message-counters) | ||
| 227 | (rmail-show-message current-message) | ||
| 228 | (if return-to-point | ||
| 229 | (goto-char return-to-point)) | ||
| 230 | (if (rmail-summary-exists) | ||
| 231 | (rmail-select-summary (rmail-update-summary))))))) | ||
| 232 | |||
| 233 | (defun rmail-make-date-sortable (date) | ||
| 234 | "Make DATE sortable using the function string-lessp." | ||
| 235 | ;; Assume the default time zone is GMT. | ||
| 236 | (timezone-make-date-sortable date "GMT" "GMT")) | ||
| 237 | |||
| 238 | (provide 'rmailsort) | ||
| 239 | |||
| 240 | ;; Local Variables: | ||
| 241 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 242 | ;; End: | ||
| 243 | |||
| 244 | ;; arch-tag: 665da245-f6a7-4115-ad8c-ba19216988d5 | ||
| 245 | ;;; rmailsort.el ends here | ||
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el new file mode 100644 index 00000000000..dd8b0b8f670 --- /dev/null +++ b/lisp/mail/rmailsum.el | |||
| @@ -0,0 +1,1765 @@ | |||
| 1 | ;;; rmailsum.el --- make summary buffers for the mail reader | ||
| 2 | |||
| 3 | ;; Copyright (C) 1985, 1993, 1994, 1995, 1996, 2000, 2001, 2002, 2003, | ||
| 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Maintainer: FSF | ||
| 7 | ;; Keywords: mail | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; Extended by Bob Weiner of Motorola | ||
| 27 | ;; Provided all commands from rmail-mode in rmail-summary-mode and made key | ||
| 28 | ;; bindings in both modes wholly compatible. | ||
| 29 | |||
| 30 | ;;; Code: | ||
| 31 | |||
| 32 | (defvar msgnum) | ||
| 33 | |||
| 34 | ;; For rmail-select-summary | ||
| 35 | (require 'rmail) | ||
| 36 | |||
| 37 | ;;;###autoload | ||
| 38 | (defcustom rmail-summary-scroll-between-messages t | ||
| 39 | "*Non-nil means Rmail summary scroll commands move between messages." | ||
| 40 | :type 'boolean | ||
| 41 | :group 'rmail-summary) | ||
| 42 | |||
| 43 | ;;;###autoload | ||
| 44 | (defcustom rmail-summary-line-count-flag t | ||
| 45 | "*Non-nil means Rmail summary should show the number of lines in each message." | ||
| 46 | :type 'boolean | ||
| 47 | :group 'rmail-summary) | ||
| 48 | |||
| 49 | (defvar rmail-summary-font-lock-keywords | ||
| 50 | '(("^.....D.*" . font-lock-string-face) ; Deleted. | ||
| 51 | ("^.....-.*" . font-lock-type-face) ; Unread. | ||
| 52 | ;; Neither of the below will be highlighted if either of the above are: | ||
| 53 | ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date. | ||
| 54 | ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels. | ||
| 55 | "Additional expressions to highlight in Rmail Summary mode.") | ||
| 56 | |||
| 57 | (defvar rmail-summary-redo | ||
| 58 | "(FUNCTION . ARGS) to regenerate this Rmail summary buffer.") | ||
| 59 | |||
| 60 | (defvar rmail-summary-overlay nil) | ||
| 61 | (put 'rmail-summary-overlay 'permanent-local t) | ||
| 62 | |||
| 63 | (defvar rmail-summary-mode-map nil) | ||
| 64 | |||
| 65 | ;; Entry points for making a summary buffer. | ||
| 66 | |||
| 67 | ;; Regenerate the contents of the summary | ||
| 68 | ;; using the same selection criterion as last time. | ||
| 69 | ;; M-x revert-buffer in a summary buffer calls this function. | ||
| 70 | (defun rmail-update-summary (&rest ignore) | ||
| 71 | (apply (car rmail-summary-redo) (cdr rmail-summary-redo))) | ||
| 72 | |||
| 73 | ;;;###autoload | ||
| 74 | (defun rmail-summary () | ||
| 75 | "Display a summary of all messages, one line per message." | ||
| 76 | (interactive) | ||
| 77 | (rmail-new-summary "All" '(rmail-summary) nil) | ||
| 78 | (unless (get-buffer-window rmail-buffer) | ||
| 79 | (rmail-summary-beginning-of-message))) | ||
| 80 | |||
| 81 | ;;;###autoload | ||
| 82 | (defun rmail-summary-by-labels (labels) | ||
| 83 | "Display a summary of all messages with one or more LABELS. | ||
| 84 | LABELS should be a string containing the desired labels, separated by commas." | ||
| 85 | (interactive "sLabels to summarize by: ") | ||
| 86 | (if (string= labels "") | ||
| 87 | (setq labels (or rmail-last-multi-labels | ||
| 88 | (error "No label specified")))) | ||
| 89 | (setq rmail-last-multi-labels labels) | ||
| 90 | (rmail-new-summary (concat "labels " labels) | ||
| 91 | (list 'rmail-summary-by-labels labels) | ||
| 92 | 'rmail-message-labels-p | ||
| 93 | (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) | ||
| 94 | |||
| 95 | ;;;###autoload | ||
| 96 | (defun rmail-summary-by-recipients (recipients &optional primary-only) | ||
| 97 | "Display a summary of all messages with the given RECIPIENTS. | ||
| 98 | Normally checks the To, From and Cc fields of headers; | ||
| 99 | but if PRIMARY-ONLY is non-nil (prefix arg given), | ||
| 100 | only look in the To and From fields. | ||
| 101 | RECIPIENTS is a string of regexps separated by commas." | ||
| 102 | (interactive "sRecipients to summarize by: \nP") | ||
| 103 | (rmail-new-summary | ||
| 104 | (concat "recipients " recipients) | ||
| 105 | (list 'rmail-summary-by-recipients recipients primary-only) | ||
| 106 | 'rmail-message-recipients-p | ||
| 107 | (mail-comma-list-regexp recipients) primary-only)) | ||
| 108 | |||
| 109 | (defun rmail-message-recipients-p (msg recipients &optional primary-only) | ||
| 110 | (rmail-apply-in-message msg 'rmail-message-recipients-p-1 | ||
| 111 | recipients primary-only)) | ||
| 112 | |||
| 113 | (defun rmail-message-recipients-p-1 (recipients &optional primary-only) | ||
| 114 | (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | ||
| 115 | (or (string-match recipients (or (mail-fetch-field "To") "")) | ||
| 116 | (string-match recipients (or (mail-fetch-field "From") "")) | ||
| 117 | (if (not primary-only) | ||
| 118 | (string-match recipients (or (mail-fetch-field "Cc") ""))))) | ||
| 119 | |||
| 120 | ;;;###autoload | ||
| 121 | (defun rmail-summary-by-regexp (regexp) | ||
| 122 | "Display a summary of all messages according to regexp REGEXP. | ||
| 123 | If the regular expression is found in the header of the message | ||
| 124 | \(including in the date and other lines, as well as the subject line), | ||
| 125 | Emacs will list the header line in the RMAIL-summary." | ||
| 126 | (interactive "sRegexp to summarize by: ") | ||
| 127 | (if (string= regexp "") | ||
| 128 | (setq regexp (or rmail-last-regexp | ||
| 129 | (error "No regexp specified")))) | ||
| 130 | (setq rmail-last-regexp regexp) | ||
| 131 | (rmail-new-summary (concat "regexp " regexp) | ||
| 132 | (list 'rmail-summary-by-regexp regexp) | ||
| 133 | 'rmail-message-regexp-p | ||
| 134 | regexp)) | ||
| 135 | |||
| 136 | (defun rmail-message-regexp-p (msg regexp) | ||
| 137 | "Return t, if for message number MSG, regexp REGEXP matches in the header." | ||
| 138 | (rmail-apply-in-message msg 'rmail-message-regexp-p-1 msg regexp)) | ||
| 139 | |||
| 140 | (defun rmail-message-regexp-p-1 (msg regexp) | ||
| 141 | (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | ||
| 142 | (if rmail-enable-mime | ||
| 143 | (funcall rmail-search-mime-header-function msg regexp (point)) | ||
| 144 | (re-search-forward regexp nil t))) | ||
| 145 | |||
| 146 | ;;;###autoload | ||
| 147 | (defun rmail-summary-by-topic (subject &optional whole-message) | ||
| 148 | "Display a summary of all messages with the given SUBJECT. | ||
| 149 | Normally checks the Subject field of headers; | ||
| 150 | but if WHOLE-MESSAGE is non-nil (prefix arg given), | ||
| 151 | look in the whole message. | ||
| 152 | SUBJECT is a string of regexps separated by commas." | ||
| 153 | (interactive | ||
| 154 | (let* ((subject (rmail-simplified-subject)) | ||
| 155 | (prompt (concat "Topics to summarize by (regexp" | ||
| 156 | (if subject ", default current subject" "") | ||
| 157 | "): "))) | ||
| 158 | (list (read-string prompt nil nil subject) current-prefix-arg))) | ||
| 159 | (rmail-new-summary | ||
| 160 | (concat "about " subject) | ||
| 161 | (list 'rmail-summary-by-topic subject whole-message) | ||
| 162 | 'rmail-message-subject-p | ||
| 163 | (mail-comma-list-regexp subject) whole-message)) | ||
| 164 | |||
| 165 | (defun rmail-message-subject-p (msg subject &optional whole-message) | ||
| 166 | (if whole-message | ||
| 167 | (rmail-apply-in-message msg 're-search-forward subject nil t) | ||
| 168 | (string-match subject (rmail-simplified-subject msg)))) | ||
| 169 | |||
| 170 | ;;;###autoload | ||
| 171 | (defun rmail-summary-by-senders (senders) | ||
| 172 | "Display a summary of all messages with the given SENDERS. | ||
| 173 | SENDERS is a string of names separated by commas." | ||
| 174 | (interactive "sSenders to summarize by: ") | ||
| 175 | (rmail-new-summary | ||
| 176 | (concat "senders " senders) | ||
| 177 | (list 'rmail-summary-by-senders senders) | ||
| 178 | 'rmail-message-senders-p | ||
| 179 | (mail-comma-list-regexp senders))) | ||
| 180 | |||
| 181 | (defun rmail-message-senders-p (msg senders) | ||
| 182 | (string-match senders (or (rmail-get-header "From" msg) ""))) | ||
| 183 | |||
| 184 | ;; General making of a summary buffer. | ||
| 185 | |||
| 186 | (defvar rmail-summary-symbol-number 0) | ||
| 187 | |||
| 188 | (defvar rmail-new-summary-line-count) | ||
| 189 | |||
| 190 | (defun rmail-new-summary (desc redo func &rest args) | ||
| 191 | "Create a summary of selected messages. | ||
| 192 | DESC makes part of the mode line of the summary buffer. REDO is form ... | ||
| 193 | For each message, FUNC is applied to the message number and ARGS... | ||
| 194 | and if the result is non-nil, that message is included. | ||
| 195 | nil for FUNCTION means all messages." | ||
| 196 | (message "Computing summary lines...") | ||
| 197 | (unless rmail-buffer | ||
| 198 | (error "No RMAIL buffer found")) | ||
| 199 | (let (mesg was-in-summary) | ||
| 200 | (if (eq major-mode 'rmail-summary-mode) | ||
| 201 | (setq was-in-summary t)) | ||
| 202 | (with-current-buffer rmail-buffer | ||
| 203 | (setq mesg rmail-current-message | ||
| 204 | rmail-summary-buffer (rmail-new-summary-1 desc redo func args))) | ||
| 205 | ;; Now display the summary buffer and go to the right place in it. | ||
| 206 | (unless was-in-summary | ||
| 207 | (if (and (one-window-p) | ||
| 208 | pop-up-windows | ||
| 209 | (not pop-up-frames)) | ||
| 210 | ;; If there is just one window, put the summary on the top. | ||
| 211 | (progn | ||
| 212 | (split-window (selected-window) rmail-summary-window-size) | ||
| 213 | (select-window (next-window (frame-first-window))) | ||
| 214 | (pop-to-buffer rmail-summary-buffer) | ||
| 215 | ;; If pop-to-buffer did not use that window, delete that | ||
| 216 | ;; window. (This can happen if it uses another frame.) | ||
| 217 | (if (not (eq rmail-summary-buffer | ||
| 218 | (window-buffer (frame-first-window)))) | ||
| 219 | (delete-other-windows))) | ||
| 220 | (pop-to-buffer rmail-summary-buffer)) | ||
| 221 | (set-buffer rmail-buffer) | ||
| 222 | ;; This is how rmail makes the summary buffer reappear. | ||
| 223 | ;; We do this here to make the window the proper size. | ||
| 224 | (rmail-select-summary nil) | ||
| 225 | (set-buffer rmail-summary-buffer)) | ||
| 226 | (rmail-summary-goto-msg mesg t t) | ||
| 227 | (rmail-summary-construct-io-menu) | ||
| 228 | (message "Computing summary lines...done"))) | ||
| 229 | |||
| 230 | (defun rmail-new-summary-1 (description form function args) | ||
| 231 | "Filter messages to obtain summary lines. | ||
| 232 | DESCRIPTION is added to the mode line. | ||
| 233 | |||
| 234 | Return the summary buffer by invoking FUNCTION on each message | ||
| 235 | passing the message number and ARGS... | ||
| 236 | |||
| 237 | REDO is a form ... | ||
| 238 | |||
| 239 | The current buffer must be a Rmail buffer either containing a | ||
| 240 | collection of mbox formatted messages or displaying a single | ||
| 241 | message." | ||
| 242 | (let ((summary-msgs ()) | ||
| 243 | (rmail-new-summary-line-count 0) | ||
| 244 | (sumbuf (rmail-get-create-summary-buffer))) | ||
| 245 | ;; Scan the messages, getting their summary strings | ||
| 246 | ;; and putting the list of them in SUMMARY-MSGS. | ||
| 247 | (let ((msgnum 1) | ||
| 248 | (main-buffer (current-buffer)) | ||
| 249 | (total rmail-total-messages) | ||
| 250 | (inhibit-read-only t)) | ||
| 251 | (save-excursion | ||
| 252 | ;; Go where the mbox text is. | ||
| 253 | (if (rmail-buffers-swapped-p) | ||
| 254 | (set-buffer rmail-view-buffer)) | ||
| 255 | (let ((old-min (point-min-marker)) | ||
| 256 | (old-max (point-max-marker))) | ||
| 257 | (unwind-protect | ||
| 258 | ;; Can't use save-restriction here; that doesn't work if we | ||
| 259 | ;; plan to modify text outside the original restriction. | ||
| 260 | (save-excursion | ||
| 261 | (widen) | ||
| 262 | (goto-char (point-min)) | ||
| 263 | (while (>= total msgnum) | ||
| 264 | ;; Go back to the Rmail buffer so | ||
| 265 | ;; so FUNCTION and rmail-get-summary can see its local vars. | ||
| 266 | (with-current-buffer main-buffer | ||
| 267 | ;; First test whether to include this message. | ||
| 268 | (if (or (null function) | ||
| 269 | (apply function msgnum args)) | ||
| 270 | (setq summary-msgs | ||
| 271 | (cons (cons msgnum (rmail-get-summary msgnum)) | ||
| 272 | summary-msgs)))) | ||
| 273 | (setq msgnum (1+ msgnum)) | ||
| 274 | ;; Provide a periodic User progress message. | ||
| 275 | (if (zerop (% rmail-new-summary-line-count 10)) | ||
| 276 | (message "Computing summary lines...%d" | ||
| 277 | rmail-new-summary-line-count))) | ||
| 278 | (setq summary-msgs (nreverse summary-msgs))) | ||
| 279 | (narrow-to-region old-min old-max))))) | ||
| 280 | |||
| 281 | ;; Temporarily, while summary buffer is unfinished, | ||
| 282 | ;; we "don't have" a summary. | ||
| 283 | ;; | ||
| 284 | ;; I have not a clue what this clause is doing. If you read this | ||
| 285 | ;; chunk of code and have a clue, then please email that clue to | ||
| 286 | ;; pmr@pajato.com | ||
| 287 | (setq rmail-summary-buffer nil) | ||
| 288 | (if rmail-enable-mime | ||
| 289 | (with-current-buffer rmail-buffer | ||
| 290 | (setq rmail-summary-buffer nil))) | ||
| 291 | |||
| 292 | (save-excursion | ||
| 293 | (let ((rbuf (current-buffer)) | ||
| 294 | (total rmail-total-messages)) | ||
| 295 | (set-buffer sumbuf) | ||
| 296 | ;; Set up the summary buffer's contents. | ||
| 297 | (let ((buffer-read-only nil)) | ||
| 298 | (erase-buffer) | ||
| 299 | (while summary-msgs | ||
| 300 | (princ (cdr (car summary-msgs)) sumbuf) | ||
| 301 | (setq summary-msgs (cdr summary-msgs))) | ||
| 302 | (goto-char (point-min))) | ||
| 303 | ;; Set up the rest of its state and local variables. | ||
| 304 | (setq buffer-read-only t) | ||
| 305 | (rmail-summary-mode) | ||
| 306 | (make-local-variable 'minor-mode-alist) | ||
| 307 | (setq minor-mode-alist (list (list t (concat ": " description)))) | ||
| 308 | (setq rmail-buffer rbuf | ||
| 309 | rmail-summary-redo form | ||
| 310 | rmail-total-messages total))) | ||
| 311 | sumbuf)) | ||
| 312 | |||
| 313 | (defun rmail-get-create-summary-buffer () | ||
| 314 | "Obtain a summary buffer by re-using an existing summary | ||
| 315 | buffer, or by creating a new summary buffer." | ||
| 316 | (if (and rmail-summary-buffer (buffer-name rmail-summary-buffer)) | ||
| 317 | rmail-summary-buffer | ||
| 318 | (generate-new-buffer (concat (buffer-name) "-summary")))) | ||
| 319 | |||
| 320 | |||
| 321 | ;; Low levels of generating a summary. | ||
| 322 | |||
| 323 | (defun rmail-get-summary (msgnum) | ||
| 324 | "Return the summary line for message MSGNUM. | ||
| 325 | The mbox buffer must be current when you call this function | ||
| 326 | even if its text is swapped. | ||
| 327 | |||
| 328 | If the message has a summary line already, it will be stored in | ||
| 329 | the message as a header and simply returned, otherwise the | ||
| 330 | summary line is created, saved in the message header, cached and | ||
| 331 | returned. | ||
| 332 | |||
| 333 | The current buffer contains the unrestricted message collection." | ||
| 334 | (let ((line (aref rmail-summary-vector (1- msgnum)))) | ||
| 335 | (unless line | ||
| 336 | ;; Register a summary line for MSGNUM. | ||
| 337 | (setq rmail-new-summary-line-count (1+ rmail-new-summary-line-count) | ||
| 338 | line (rmail-create-summary-line msgnum)) | ||
| 339 | ;; Cache the summary line for use during this Rmail session. | ||
| 340 | (aset rmail-summary-vector (1- msgnum) line)) | ||
| 341 | line)) | ||
| 342 | |||
| 343 | ;;;###autoload | ||
| 344 | (defcustom rmail-summary-line-decoder (function identity) | ||
| 345 | "*Function to decode a Rmail summary line. | ||
| 346 | It receives the summary line for one message as a string | ||
| 347 | and should return the decoded string. | ||
| 348 | |||
| 349 | By default, it is `identity', which returns the string unaltered." | ||
| 350 | :type 'function | ||
| 351 | :group 'rmail-summary) | ||
| 352 | |||
| 353 | (defun rmail-create-summary-line (msgnum) | ||
| 354 | "Return the summary line for message MSGNUM. | ||
| 355 | Obtain the message summary from the header if it is available | ||
| 356 | otherwise create it and store it in the message header. | ||
| 357 | |||
| 358 | The mbox buffer must be current when you call this function | ||
| 359 | even if its text is swapped." | ||
| 360 | (let ((beg (rmail-msgbeg msgnum)) | ||
| 361 | (end (rmail-msgend msgnum)) | ||
| 362 | (deleted (rmail-message-deleted-p msgnum)) | ||
| 363 | (unseen (rmail-message-unseen-p msgnum)) | ||
| 364 | lines) | ||
| 365 | (save-excursion | ||
| 366 | ;; Switch to the buffer that has the whole mbox text. | ||
| 367 | (if (rmail-buffers-swapped-p) | ||
| 368 | (set-buffer rmail-view-buffer)) | ||
| 369 | ;; Now we can compute the line count. | ||
| 370 | (if rmail-summary-line-count-flag | ||
| 371 | (setq lines (count-lines beg end))) | ||
| 372 | |||
| 373 | ;; Narrow to the message header. | ||
| 374 | (save-excursion | ||
| 375 | (goto-char beg) | ||
| 376 | (if (search-forward "\n\n" end t) | ||
| 377 | (save-restriction | ||
| 378 | (narrow-to-region beg (point)) | ||
| 379 | ;; Generate a status line from the message. | ||
| 380 | (rmail-create-summary msgnum deleted unseen lines)) | ||
| 381 | (rmail-error-bad-format msgnum)))))) | ||
| 382 | |||
| 383 | (defun rmail-get-summary-labels () | ||
| 384 | "Return a coded string wrapped in curly braces denoting the status labels. | ||
| 385 | |||
| 386 | The current buffer must already be narrowed to the message headers for | ||
| 387 | the message being processed." | ||
| 388 | (let ((status (mail-fetch-field rmail-attribute-header)) | ||
| 389 | (index 0) | ||
| 390 | (result "") | ||
| 391 | char) | ||
| 392 | ;; Strip off the read/unread and the deleted attribute which are | ||
| 393 | ;; handled separately. | ||
| 394 | (setq status | ||
| 395 | (if status | ||
| 396 | (concat (substring status 0 1) (substring status 2 6)) | ||
| 397 | "")) | ||
| 398 | (while (< index (length status)) | ||
| 399 | (unless (string= "-" (setq char (substring status index (1+ index)))) | ||
| 400 | (setq result (concat result char))) | ||
| 401 | (setq index (1+ index))) | ||
| 402 | (when (> (length result) 0) | ||
| 403 | (setq result (concat "{" result "}"))) | ||
| 404 | result)) | ||
| 405 | |||
| 406 | (defun rmail-create-summary (msgnum deleted unseen lines) | ||
| 407 | "Return the summary line for message MSGNUM. | ||
| 408 | The current buffer should already be narrowed to the header for that message. | ||
| 409 | It could be either buffer, so don't access Rmail local variables. | ||
| 410 | DELETED is t if this message is marked deleted. | ||
| 411 | UNSEEN is t if it is marked unseen. | ||
| 412 | LINES is the number of lines in the message (if we should display that) | ||
| 413 | or else nil." | ||
| 414 | (goto-char (point-min)) | ||
| 415 | (let ((line (rmail-header-summary)) | ||
| 416 | (labels (rmail-get-summary-labels)) | ||
| 417 | pos status prefix basic-start basic-end linecount-string) | ||
| 418 | |||
| 419 | (setq linecount-string | ||
| 420 | (cond | ||
| 421 | ((not lines) " ") | ||
| 422 | ((<= lines 9) (format " [%d]" lines)) | ||
| 423 | ((<= lines 99) (format " [%d]" lines)) | ||
| 424 | ((<= lines 999) (format " [%d]" lines)) | ||
| 425 | ((<= lines 9999) (format " [%dk]" (/ lines 1000))) | ||
| 426 | ((<= lines 99999) (format " [%dk]" (/ lines 1000))) | ||
| 427 | (t (format "[%dk]" (/ lines 1000))))) | ||
| 428 | |||
| 429 | (setq status (cond | ||
| 430 | (deleted ?D) | ||
| 431 | (unseen ?-) | ||
| 432 | (t ? )) | ||
| 433 | prefix (format "%5d%c" msgnum status) | ||
| 434 | basic-start (car line) | ||
| 435 | basic-end (cadr line)) | ||
| 436 | (funcall rmail-summary-line-decoder | ||
| 437 | (concat prefix basic-start linecount-string " " | ||
| 438 | labels basic-end)))) | ||
| 439 | |||
| 440 | ;;;###autoload | ||
| 441 | (defcustom rmail-user-mail-address-regexp nil | ||
| 442 | "*Regexp matching user mail addresses. | ||
| 443 | If non-nil, this variable is used to identify the correspondent | ||
| 444 | when receiving new mail. If it matches the address of the sender, | ||
| 445 | the recipient is taken as correspondent of a mail. | ||
| 446 | If nil \(default value\), your `user-login-name' and `user-mail-address' | ||
| 447 | are used to exclude yourself as correspondent. | ||
| 448 | |||
| 449 | Usually you don't have to set this variable, except if you collect mails | ||
| 450 | sent by you under different user names. | ||
| 451 | Then it should be a regexp matching your mail addresses. | ||
| 452 | |||
| 453 | Setting this variable has an effect only before reading a mail." | ||
| 454 | :type '(choice (const :tag "None" nil) regexp) | ||
| 455 | :group 'rmail-retrieve | ||
| 456 | :version "21.1") | ||
| 457 | |||
| 458 | (defun rmail-header-summary () | ||
| 459 | "Return a message summary based on the message headers. | ||
| 460 | The value is a list of two strings, the first and second parts of the summary. | ||
| 461 | |||
| 462 | The current buffer must already be narrowed to the message headers for | ||
| 463 | the message being processed." | ||
| 464 | (goto-char (point-min)) | ||
| 465 | (list | ||
| 466 | (concat (save-excursion | ||
| 467 | (if (not (re-search-forward "^Date:" nil t)) | ||
| 468 | " " | ||
| 469 | (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" | ||
| 470 | (save-excursion (end-of-line) (point)) t) | ||
| 471 | (format "%2d-%3s" | ||
| 472 | (string-to-number (buffer-substring | ||
| 473 | (match-beginning 2) | ||
| 474 | (match-end 2))) | ||
| 475 | (buffer-substring | ||
| 476 | (match-beginning 4) (match-end 4)))) | ||
| 477 | ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" | ||
| 478 | (save-excursion (end-of-line) (point)) t) | ||
| 479 | (format "%2d-%3s" | ||
| 480 | (string-to-number (buffer-substring | ||
| 481 | (match-beginning 4) | ||
| 482 | (match-end 4))) | ||
| 483 | (buffer-substring | ||
| 484 | (match-beginning 2) (match-end 2)))) | ||
| 485 | ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)" | ||
| 486 | (save-excursion (end-of-line) (point)) t) | ||
| 487 | (format "%2s%2s%2s" | ||
| 488 | (buffer-substring | ||
| 489 | (match-beginning 2) (match-end 2)) | ||
| 490 | (buffer-substring | ||
| 491 | (match-beginning 3) (match-end 3)) | ||
| 492 | (buffer-substring | ||
| 493 | (match-beginning 4) (match-end 4)))) | ||
| 494 | (t "??????")))) | ||
| 495 | " " | ||
| 496 | (save-excursion | ||
| 497 | (let* ((from (and (re-search-forward "^From:[ \t]*" nil t) | ||
| 498 | (mail-strip-quoted-names | ||
| 499 | (buffer-substring | ||
| 500 | (1- (point)) | ||
| 501 | ;; Get all the lines of the From field | ||
| 502 | ;; so that we get a whole comment if there is one, | ||
| 503 | ;; so that mail-strip-quoted-names can discard it. | ||
| 504 | (let ((opoint (point))) | ||
| 505 | (while (progn (forward-line 1) | ||
| 506 | (looking-at "[ \t]"))) | ||
| 507 | ;; Back up over newline, then trailing spaces or tabs | ||
| 508 | (forward-char -1) | ||
| 509 | (skip-chars-backward " \t") | ||
| 510 | (point)))))) | ||
| 511 | len mch lo) | ||
| 512 | (if (or (null from) | ||
| 513 | (string-match | ||
| 514 | (or rmail-user-mail-address-regexp | ||
| 515 | (concat "^\\(" | ||
| 516 | (regexp-quote (user-login-name)) | ||
| 517 | "\\($\\|@\\)\\|" | ||
| 518 | (regexp-quote | ||
| 519 | ;; Don't lose if run from init file | ||
| 520 | ;; where user-mail-address is not | ||
| 521 | ;; set yet. | ||
| 522 | (or user-mail-address | ||
| 523 | (concat (user-login-name) "@" | ||
| 524 | (or mail-host-address | ||
| 525 | (system-name))))) | ||
| 526 | "\\>\\)")) | ||
| 527 | from)) | ||
| 528 | ;; No From field, or it's this user. | ||
| 529 | (save-excursion | ||
| 530 | (goto-char (point-min)) | ||
| 531 | (if (not (re-search-forward "^To:[ \t]*" nil t)) | ||
| 532 | nil | ||
| 533 | (setq from | ||
| 534 | (concat "to: " | ||
| 535 | (mail-strip-quoted-names | ||
| 536 | (buffer-substring | ||
| 537 | (point) | ||
| 538 | (progn (end-of-line) | ||
| 539 | (skip-chars-backward " \t") | ||
| 540 | (point))))))))) | ||
| 541 | (if (null from) | ||
| 542 | " " | ||
| 543 | (setq len (length from)) | ||
| 544 | (setq mch (string-match "[@%]" from)) | ||
| 545 | (format "%25s" | ||
| 546 | (if (or (not mch) (<= len 25)) | ||
| 547 | (substring from (max 0 (- len 25))) | ||
| 548 | (substring from | ||
| 549 | (setq lo (cond ((< (- mch 14) 0) 0) | ||
| 550 | ((< len (+ mch 11)) | ||
| 551 | (- len 25)) | ||
| 552 | (t (- mch 14)))) | ||
| 553 | (min len (+ lo 25))))))))) | ||
| 554 | (concat (if (re-search-forward "^Subject:" nil t) | ||
| 555 | (progn (skip-chars-forward " \t") | ||
| 556 | (buffer-substring (point) | ||
| 557 | (progn (end-of-line) | ||
| 558 | (point)))) | ||
| 559 | (re-search-forward "[\n][\n]+" nil t) | ||
| 560 | (buffer-substring (point) (progn (end-of-line) (point)))) | ||
| 561 | "\n"))) | ||
| 562 | |||
| 563 | ;; Simple motion in a summary buffer. | ||
| 564 | |||
| 565 | (defun rmail-summary-next-all (&optional number) | ||
| 566 | (interactive "p") | ||
| 567 | (forward-line (if number number 1)) | ||
| 568 | ;; It doesn't look nice to move forward past the last message line. | ||
| 569 | (and (eobp) (> number 0) | ||
| 570 | (forward-line -1)) | ||
| 571 | (display-buffer rmail-buffer)) | ||
| 572 | |||
| 573 | (defun rmail-summary-previous-all (&optional number) | ||
| 574 | (interactive "p") | ||
| 575 | (forward-line (- (if number number 1))) | ||
| 576 | ;; It doesn't look nice to move forward past the last message line. | ||
| 577 | (and (eobp) (< number 0) | ||
| 578 | (forward-line -1)) | ||
| 579 | (display-buffer rmail-buffer)) | ||
| 580 | |||
| 581 | (defun rmail-summary-next-msg (&optional number) | ||
| 582 | "Display next non-deleted msg from rmail file. | ||
| 583 | With optional prefix argument NUMBER, moves forward this number of non-deleted | ||
| 584 | messages, or backward if NUMBER is negative." | ||
| 585 | (interactive "p") | ||
| 586 | (forward-line 0) | ||
| 587 | (and (> number 0) (end-of-line)) | ||
| 588 | (let ((count (if (< number 0) (- number) number)) | ||
| 589 | (search (if (> number 0) 're-search-forward 're-search-backward)) | ||
| 590 | (non-del-msg-found nil)) | ||
| 591 | (while (and (> count 0) (setq non-del-msg-found | ||
| 592 | (or (funcall search "^.....[^D]" nil t) | ||
| 593 | non-del-msg-found))) | ||
| 594 | (setq count (1- count)))) | ||
| 595 | (beginning-of-line) | ||
| 596 | (display-buffer rmail-buffer)) | ||
| 597 | |||
| 598 | (defun rmail-summary-previous-msg (&optional number) | ||
| 599 | "Display previous non-deleted msg from rmail file. | ||
| 600 | With optional prefix argument NUMBER, moves backward this number of | ||
| 601 | non-deleted messages." | ||
| 602 | (interactive "p") | ||
| 603 | (rmail-summary-next-msg (- (if number number 1)))) | ||
| 604 | |||
| 605 | (defun rmail-summary-next-labeled-message (n labels) | ||
| 606 | "Show next message with LABELS. Defaults to last labels used. | ||
| 607 | With prefix argument N moves forward N messages with these labels." | ||
| 608 | (interactive "p\nsMove to next msg with labels: ") | ||
| 609 | (let (msg) | ||
| 610 | (save-excursion | ||
| 611 | (set-buffer rmail-buffer) | ||
| 612 | (rmail-next-labeled-message n labels) | ||
| 613 | (setq msg rmail-current-message)) | ||
| 614 | (rmail-summary-goto-msg msg))) | ||
| 615 | |||
| 616 | (defun rmail-summary-previous-labeled-message (n labels) | ||
| 617 | "Show previous message with LABELS. Defaults to last labels used. | ||
| 618 | With prefix argument N moves backward N messages with these labels." | ||
| 619 | (interactive "p\nsMove to previous msg with labels: ") | ||
| 620 | (let (msg) | ||
| 621 | (save-excursion | ||
| 622 | (set-buffer rmail-buffer) | ||
| 623 | (rmail-previous-labeled-message n labels) | ||
| 624 | (setq msg rmail-current-message)) | ||
| 625 | (rmail-summary-goto-msg msg))) | ||
| 626 | |||
| 627 | (defun rmail-summary-next-same-subject (n) | ||
| 628 | "Go to the next message in the summary having the same subject. | ||
| 629 | With prefix argument N, do this N times. | ||
| 630 | If N is negative, go backwards." | ||
| 631 | (interactive "p") | ||
| 632 | (let ((forward (> n 0)) | ||
| 633 | subject i found) | ||
| 634 | (with-current-buffer rmail-buffer | ||
| 635 | (setq subject (rmail-simplified-subject) | ||
| 636 | i rmail-current-message)) | ||
| 637 | (save-excursion | ||
| 638 | (while (and (/= n 0) | ||
| 639 | (if forward | ||
| 640 | (not (eobp)) | ||
| 641 | (not (bobp)))) | ||
| 642 | (let (done) | ||
| 643 | (while (and (not done) | ||
| 644 | (if forward | ||
| 645 | (not (eobp)) | ||
| 646 | (not (bobp)))) | ||
| 647 | ;; Advance thru summary. | ||
| 648 | (forward-line (if forward 1 -1)) | ||
| 649 | ;; Get msg number of this line. | ||
| 650 | (setq i (string-to-number | ||
| 651 | (buffer-substring (point) | ||
| 652 | (min (point-max) (+ 6 (point)))))) | ||
| 653 | (setq done (string-equal subject (rmail-simplified-subject i)))) | ||
| 654 | (if done (setq found i))) | ||
| 655 | (setq n (if forward (1- n) (1+ n))))) | ||
| 656 | (if found | ||
| 657 | (rmail-summary-goto-msg found) | ||
| 658 | (error "No %s message with same subject" | ||
| 659 | (if forward "following" "previous"))))) | ||
| 660 | |||
| 661 | (defun rmail-summary-previous-same-subject (n) | ||
| 662 | "Go to the previous message in the summary having the same subject. | ||
| 663 | With prefix argument N, do this N times. | ||
| 664 | If N is negative, go forwards instead." | ||
| 665 | (interactive "p") | ||
| 666 | (rmail-summary-next-same-subject (- n))) | ||
| 667 | |||
| 668 | ;; Delete and undelete summary commands. | ||
| 669 | |||
| 670 | (defun rmail-summary-delete-forward (&optional count) | ||
| 671 | "Delete this message and move to next nondeleted one. | ||
| 672 | Deleted messages stay in the file until the \\[rmail-expunge] command is given. | ||
| 673 | A prefix argument serves as a repeat count; | ||
| 674 | a negative argument means to delete and move backward." | ||
| 675 | (interactive "p") | ||
| 676 | (unless (numberp count) (setq count 1)) | ||
| 677 | (let (end del-msg | ||
| 678 | (backward (< count 0))) | ||
| 679 | (while (/= count 0) | ||
| 680 | (rmail-summary-goto-msg) | ||
| 681 | (with-current-buffer rmail-buffer | ||
| 682 | (rmail-delete-message) | ||
| 683 | (setq del-msg rmail-current-message)) | ||
| 684 | (rmail-summary-mark-deleted del-msg) | ||
| 685 | (while (and (not (if backward (bobp) (eobp))) | ||
| 686 | (save-excursion (beginning-of-line) | ||
| 687 | (looking-at " *[0-9]+D"))) | ||
| 688 | (forward-line (if backward -1 1))) | ||
| 689 | ;; It looks ugly to move to the empty line at end of buffer. | ||
| 690 | (and (eobp) (not backward) | ||
| 691 | (forward-line -1)) | ||
| 692 | (setq count | ||
| 693 | (if (> count 0) (1- count) (1+ count)))))) | ||
| 694 | |||
| 695 | (defun rmail-summary-delete-backward (&optional count) | ||
| 696 | "Delete this message and move to previous nondeleted one. | ||
| 697 | Deleted messages stay in the file until the \\[rmail-expunge] command is given. | ||
| 698 | A prefix argument serves as a repeat count; | ||
| 699 | a negative argument means to delete and move forward." | ||
| 700 | (interactive "p") | ||
| 701 | (rmail-summary-delete-forward (- count))) | ||
| 702 | |||
| 703 | (defun rmail-summary-mark-deleted (&optional n undel) | ||
| 704 | ;; Since third arg is t, this only alters the summary, not the Rmail buf. | ||
| 705 | (and n (rmail-summary-goto-msg n t t)) | ||
| 706 | (or (eobp) | ||
| 707 | (not (overlay-get rmail-summary-overlay 'face)) | ||
| 708 | (let ((buffer-read-only nil)) | ||
| 709 | (skip-chars-forward " ") | ||
| 710 | (skip-chars-forward "[0-9]") | ||
| 711 | (if undel | ||
| 712 | (if (looking-at "D") | ||
| 713 | (progn (delete-char 1) (insert " "))) | ||
| 714 | (delete-char 1) | ||
| 715 | (insert "D")))) | ||
| 716 | (beginning-of-line)) | ||
| 717 | |||
| 718 | (defun rmail-summary-mark-undeleted (n) | ||
| 719 | (rmail-summary-mark-deleted n t)) | ||
| 720 | |||
| 721 | (defun rmail-summary-deleted-p (&optional n) | ||
| 722 | (save-excursion | ||
| 723 | (and n (rmail-summary-goto-msg n nil t)) | ||
| 724 | (skip-chars-forward " ") | ||
| 725 | (skip-chars-forward "[0-9]") | ||
| 726 | (looking-at "D"))) | ||
| 727 | |||
| 728 | (defun rmail-summary-undelete (&optional arg) | ||
| 729 | "Undelete current message. | ||
| 730 | Optional prefix ARG means undelete ARG previous messages." | ||
| 731 | (interactive "p") | ||
| 732 | (if (/= arg 1) | ||
| 733 | (rmail-summary-undelete-many arg) | ||
| 734 | (let ((buffer-read-only nil) | ||
| 735 | (opoint (point))) | ||
| 736 | (end-of-line) | ||
| 737 | (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) | ||
| 738 | (replace-match "\\1 ") | ||
| 739 | (rmail-summary-goto-msg) | ||
| 740 | (if rmail-enable-mime | ||
| 741 | (set-buffer rmail-buffer) | ||
| 742 | (pop-to-buffer rmail-buffer)) | ||
| 743 | (and (rmail-message-deleted-p rmail-current-message) | ||
| 744 | (rmail-undelete-previous-message)) | ||
| 745 | (if rmail-enable-mime | ||
| 746 | (pop-to-buffer rmail-buffer)) | ||
| 747 | (pop-to-buffer rmail-summary-buffer)) | ||
| 748 | (t (goto-char opoint)))))) | ||
| 749 | |||
| 750 | (defun rmail-summary-undelete-many (&optional n) | ||
| 751 | "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." | ||
| 752 | (interactive "P") | ||
| 753 | (save-excursion | ||
| 754 | (set-buffer rmail-buffer) | ||
| 755 | (let* ((init-msg (if n rmail-current-message rmail-total-messages)) | ||
| 756 | (rmail-current-message init-msg) | ||
| 757 | (n (or n rmail-total-messages)) | ||
| 758 | (msgs-undeled 0)) | ||
| 759 | (while (and (> rmail-current-message 0) | ||
| 760 | (< msgs-undeled n)) | ||
| 761 | (if (rmail-message-deleted-p rmail-current-message) | ||
| 762 | (progn (rmail-set-attribute "deleted" nil) | ||
| 763 | (setq msgs-undeled (1+ msgs-undeled)))) | ||
| 764 | (setq rmail-current-message (1- rmail-current-message))) | ||
| 765 | (set-buffer rmail-summary-buffer) | ||
| 766 | (setq rmail-current-message init-msg msgs-undeled 0) | ||
| 767 | (while (and (> rmail-current-message 0) | ||
| 768 | (< msgs-undeled n)) | ||
| 769 | (if (rmail-summary-deleted-p rmail-current-message) | ||
| 770 | (progn (rmail-summary-mark-undeleted rmail-current-message) | ||
| 771 | (setq msgs-undeled (1+ msgs-undeled)))) | ||
| 772 | (setq rmail-current-message (1- rmail-current-message)))) | ||
| 773 | (rmail-summary-goto-msg))) | ||
| 774 | |||
| 775 | ;; Rmail Summary mode is suitable only for specially formatted data. | ||
| 776 | (put 'rmail-summary-mode 'mode-class 'special) | ||
| 777 | |||
| 778 | (defun rmail-summary-mode () | ||
| 779 | "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary]. | ||
| 780 | As commands are issued in the summary buffer, they are applied to the | ||
| 781 | corresponding mail messages in the rmail buffer. | ||
| 782 | |||
| 783 | All normal editing commands are turned off. | ||
| 784 | Instead, nearly all the Rmail mode commands are available, | ||
| 785 | though many of them move only among the messages in the summary. | ||
| 786 | |||
| 787 | These additional commands exist: | ||
| 788 | |||
| 789 | \\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages. | ||
| 790 | \\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer. | ||
| 791 | |||
| 792 | Commands for sorting the summary: | ||
| 793 | |||
| 794 | \\[rmail-summary-sort-by-date] Sort by date. | ||
| 795 | \\[rmail-summary-sort-by-subject] Sort by subject. | ||
| 796 | \\[rmail-summary-sort-by-author] Sort by author. | ||
| 797 | \\[rmail-summary-sort-by-recipient] Sort by recipient. | ||
| 798 | \\[rmail-summary-sort-by-correspondent] Sort by correspondent. | ||
| 799 | \\[rmail-summary-sort-by-lines] Sort by lines. | ||
| 800 | \\[rmail-summary-sort-by-labels] Sort by labels." | ||
| 801 | (interactive) | ||
| 802 | (kill-all-local-variables) | ||
| 803 | (setq major-mode 'rmail-summary-mode) | ||
| 804 | (setq mode-name "RMAIL Summary") | ||
| 805 | (setq truncate-lines t) | ||
| 806 | (setq buffer-read-only t) | ||
| 807 | (set-syntax-table text-mode-syntax-table) | ||
| 808 | (make-local-variable 'rmail-buffer) | ||
| 809 | (make-local-variable 'rmail-total-messages) | ||
| 810 | (make-local-variable 'rmail-current-message) | ||
| 811 | (setq rmail-current-message nil) | ||
| 812 | (make-local-variable 'rmail-summary-redo) | ||
| 813 | (setq rmail-summary-redo nil) | ||
| 814 | (make-local-variable 'revert-buffer-function) | ||
| 815 | (make-local-variable 'font-lock-defaults) | ||
| 816 | (setq font-lock-defaults '(rmail-summary-font-lock-keywords t)) | ||
| 817 | (rmail-summary-enable) | ||
| 818 | (run-mode-hooks 'rmail-summary-mode-hook)) | ||
| 819 | |||
| 820 | ;; Summary features need to be disabled during edit mode. | ||
| 821 | (defun rmail-summary-disable () | ||
| 822 | (use-local-map text-mode-map) | ||
| 823 | (remove-hook 'post-command-hook 'rmail-summary-rmail-update t) | ||
| 824 | (setq revert-buffer-function nil)) | ||
| 825 | |||
| 826 | (defun rmail-summary-enable () | ||
| 827 | (use-local-map rmail-summary-mode-map) | ||
| 828 | (add-hook 'post-command-hook 'rmail-summary-rmail-update nil t) | ||
| 829 | (setq revert-buffer-function 'rmail-update-summary)) | ||
| 830 | |||
| 831 | (defvar rmail-summary-put-back-unseen nil | ||
| 832 | "Used for communicating between calls to `rmail-summary-rmail-update'. | ||
| 833 | If it moves to a message within an Incremental Search, and removes | ||
| 834 | the `unseen' attribute from that message, it sets this flag | ||
| 835 | so that if the next motion between messages is in the same Incremental | ||
| 836 | Search, the `unseen' attribute is restored.") | ||
| 837 | |||
| 838 | ;; Show in Rmail the message described by the summary line that point is on, | ||
| 839 | ;; but only if the Rmail buffer is already visible. | ||
| 840 | ;; This is a post-command-hook in summary buffers. | ||
| 841 | (defun rmail-summary-rmail-update () | ||
| 842 | (let (buffer-read-only) | ||
| 843 | (save-excursion | ||
| 844 | ;; If at end of buffer, pretend we are on the last text line. | ||
| 845 | (if (eobp) | ||
| 846 | (forward-line -1)) | ||
| 847 | (beginning-of-line) | ||
| 848 | (skip-chars-forward " ") | ||
| 849 | (let ((msg-num (string-to-number (buffer-substring | ||
| 850 | (point) | ||
| 851 | (progn (skip-chars-forward "0-9") | ||
| 852 | (point)))))) | ||
| 853 | ;; Always leave `unseen' removed | ||
| 854 | ;; if we get out of isearch mode. | ||
| 855 | ;; Don't let a subsequent isearch restore that `unseen'. | ||
| 856 | (if (not isearch-mode) | ||
| 857 | (setq rmail-summary-put-back-unseen nil)) | ||
| 858 | |||
| 859 | (or (eq rmail-current-message msg-num) | ||
| 860 | (let ((window (get-buffer-window rmail-buffer t)) | ||
| 861 | (owin (selected-window))) | ||
| 862 | (if isearch-mode | ||
| 863 | (save-excursion | ||
| 864 | (set-buffer rmail-buffer) | ||
| 865 | ;; If we first saw the previous message in this search, | ||
| 866 | ;; and we have gone to a different message while searching, | ||
| 867 | ;; put back `unseen' on the former one. | ||
| 868 | (if rmail-summary-put-back-unseen | ||
| 869 | (rmail-set-attribute "unseen" t | ||
| 870 | rmail-current-message)) | ||
| 871 | ;; Arrange to do that later, for the new current message, | ||
| 872 | ;; if it still has `unseen'. | ||
| 873 | (setq rmail-summary-put-back-unseen | ||
| 874 | (rmail-message-attr-p msg-num rmail-unseen-attr-index))) | ||
| 875 | (setq rmail-summary-put-back-unseen nil)) | ||
| 876 | |||
| 877 | ;; Go to the desired message. | ||
| 878 | (setq rmail-current-message msg-num) | ||
| 879 | |||
| 880 | ;; Update the summary to show the message has been seen. | ||
| 881 | (if (= (following-char) ?-) | ||
| 882 | (progn | ||
| 883 | (delete-char 1) | ||
| 884 | (insert " "))) | ||
| 885 | |||
| 886 | (if window | ||
| 887 | ;; Using save-window-excursion would cause the new value | ||
| 888 | ;; of point to get lost. | ||
| 889 | (unwind-protect | ||
| 890 | (progn | ||
| 891 | (select-window window) | ||
| 892 | (rmail-show-message-maybe msg-num t)) | ||
| 893 | (select-window owin)) | ||
| 894 | (if (buffer-name rmail-buffer) | ||
| 895 | (save-excursion | ||
| 896 | (set-buffer rmail-buffer) | ||
| 897 | (rmail-show-message-maybe msg-num t)))))) | ||
| 898 | (rmail-summary-update-highlight nil))))) | ||
| 899 | |||
| 900 | (defun rmail-summary-save-buffer () | ||
| 901 | "Save the buffer associated with this RMAIL summary." | ||
| 902 | (interactive) | ||
| 903 | (save-window-excursion | ||
| 904 | (save-excursion | ||
| 905 | (switch-to-buffer rmail-buffer) | ||
| 906 | (save-buffer)))) | ||
| 907 | |||
| 908 | |||
| 909 | (if rmail-summary-mode-map | ||
| 910 | nil | ||
| 911 | (setq rmail-summary-mode-map (make-keymap)) | ||
| 912 | (suppress-keymap rmail-summary-mode-map) | ||
| 913 | |||
| 914 | (define-key rmail-summary-mode-map [mouse-2] 'rmail-summary-mouse-goto-message) | ||
| 915 | (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label) | ||
| 916 | (define-key rmail-summary-mode-map "b" 'rmail-summary-bury) | ||
| 917 | (define-key rmail-summary-mode-map "c" 'rmail-summary-continue) | ||
| 918 | (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) | ||
| 919 | (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward) | ||
| 920 | (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message) | ||
| 921 | (define-key rmail-summary-mode-map "f" 'rmail-summary-forward) | ||
| 922 | (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail) | ||
| 923 | (define-key rmail-summary-mode-map "h" 'rmail-summary) | ||
| 924 | (define-key rmail-summary-mode-map "i" 'rmail-summary-input) | ||
| 925 | (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) | ||
| 926 | (define-key rmail-summary-mode-map "\C-m" 'rmail-summary-goto-msg) | ||
| 927 | (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label) | ||
| 928 | (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels) | ||
| 929 | (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary) | ||
| 930 | (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels) | ||
| 931 | (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients) | ||
| 932 | (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp) | ||
| 933 | (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic) | ||
| 934 | (define-key rmail-summary-mode-map "m" 'rmail-summary-mail) | ||
| 935 | (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure) | ||
| 936 | (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) | ||
| 937 | (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) | ||
| 938 | (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message) | ||
| 939 | (define-key rmail-summary-mode-map "o" 'rmail-summary-output) | ||
| 940 | (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output) | ||
| 941 | (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) | ||
| 942 | (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) | ||
| 943 | (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message) | ||
| 944 | (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) | ||
| 945 | (define-key rmail-summary-mode-map "Q" 'rmail-summary-wipe) | ||
| 946 | (define-key rmail-summary-mode-map "r" 'rmail-summary-reply) | ||
| 947 | (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save) | ||
| 948 | (define-key rmail-summary-mode-map "\es" 'rmail-summary-search) | ||
| 949 | (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header) | ||
| 950 | (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) | ||
| 951 | (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many) | ||
| 952 | (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge) | ||
| 953 | (define-key rmail-summary-mode-map "w" 'rmail-summary-output-body) | ||
| 954 | (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message) | ||
| 955 | (define-key rmail-summary-mode-map "/" 'rmail-summary-end-of-message) | ||
| 956 | (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message) | ||
| 957 | (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message) | ||
| 958 | (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) | ||
| 959 | (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) | ||
| 960 | (define-key rmail-summary-mode-map "?" 'describe-mode) | ||
| 961 | (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject) | ||
| 962 | (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject) | ||
| 963 | (define-key rmail-summary-mode-map "\C-c\C-s\C-d" | ||
| 964 | 'rmail-summary-sort-by-date) | ||
| 965 | (define-key rmail-summary-mode-map "\C-c\C-s\C-s" | ||
| 966 | 'rmail-summary-sort-by-subject) | ||
| 967 | (define-key rmail-summary-mode-map "\C-c\C-s\C-a" | ||
| 968 | 'rmail-summary-sort-by-author) | ||
| 969 | (define-key rmail-summary-mode-map "\C-c\C-s\C-r" | ||
| 970 | 'rmail-summary-sort-by-recipient) | ||
| 971 | (define-key rmail-summary-mode-map "\C-c\C-s\C-c" | ||
| 972 | 'rmail-summary-sort-by-correspondent) | ||
| 973 | (define-key rmail-summary-mode-map "\C-c\C-s\C-l" | ||
| 974 | 'rmail-summary-sort-by-lines) | ||
| 975 | (define-key rmail-summary-mode-map "\C-c\C-s\C-k" | ||
| 976 | 'rmail-summary-sort-by-labels) | ||
| 977 | (define-key rmail-summary-mode-map "\C-x\C-s" 'rmail-summary-save-buffer) | ||
| 978 | ) | ||
| 979 | |||
| 980 | ;;; Menu bar bindings. | ||
| 981 | |||
| 982 | (define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap)) | ||
| 983 | |||
| 984 | (define-key rmail-summary-mode-map [menu-bar classify] | ||
| 985 | (cons "Classify" (make-sparse-keymap "Classify"))) | ||
| 986 | |||
| 987 | (define-key rmail-summary-mode-map [menu-bar classify output-menu] | ||
| 988 | '("Output (Rmail Menu)..." . rmail-summary-output-menu)) | ||
| 989 | |||
| 990 | (define-key rmail-summary-mode-map [menu-bar classify input-menu] | ||
| 991 | '("Input Rmail File (menu)..." . rmail-input-menu)) | ||
| 992 | |||
| 993 | (define-key rmail-summary-mode-map [menu-bar classify input-menu] | ||
| 994 | '(nil)) | ||
| 995 | |||
| 996 | (define-key rmail-summary-mode-map [menu-bar classify output-menu] | ||
| 997 | '(nil)) | ||
| 998 | |||
| 999 | (define-key rmail-summary-mode-map [menu-bar classify output-body] | ||
| 1000 | '("Output (body)..." . rmail-summary-output-body)) | ||
| 1001 | |||
| 1002 | (define-key rmail-summary-mode-map [menu-bar classify output-inbox] | ||
| 1003 | '("Output (inbox)..." . rmail-summary-output)) | ||
| 1004 | |||
| 1005 | (define-key rmail-summary-mode-map [menu-bar classify output] | ||
| 1006 | '("Output (Rmail)..." . rmail-summary-output)) | ||
| 1007 | |||
| 1008 | (define-key rmail-summary-mode-map [menu-bar classify kill-label] | ||
| 1009 | '("Kill Label..." . rmail-summary-kill-label)) | ||
| 1010 | |||
| 1011 | (define-key rmail-summary-mode-map [menu-bar classify add-label] | ||
| 1012 | '("Add Label..." . rmail-summary-add-label)) | ||
| 1013 | |||
| 1014 | (define-key rmail-summary-mode-map [menu-bar summary] | ||
| 1015 | (cons "Summary" (make-sparse-keymap "Summary"))) | ||
| 1016 | |||
| 1017 | (define-key rmail-summary-mode-map [menu-bar summary senders] | ||
| 1018 | '("By Senders..." . rmail-summary-by-senders)) | ||
| 1019 | |||
| 1020 | (define-key rmail-summary-mode-map [menu-bar summary labels] | ||
| 1021 | '("By Labels..." . rmail-summary-by-labels)) | ||
| 1022 | |||
| 1023 | (define-key rmail-summary-mode-map [menu-bar summary recipients] | ||
| 1024 | '("By Recipients..." . rmail-summary-by-recipients)) | ||
| 1025 | |||
| 1026 | (define-key rmail-summary-mode-map [menu-bar summary topic] | ||
| 1027 | '("By Topic..." . rmail-summary-by-topic)) | ||
| 1028 | |||
| 1029 | (define-key rmail-summary-mode-map [menu-bar summary regexp] | ||
| 1030 | '("By Regexp..." . rmail-summary-by-regexp)) | ||
| 1031 | |||
| 1032 | (define-key rmail-summary-mode-map [menu-bar summary all] | ||
| 1033 | '("All" . rmail-summary)) | ||
| 1034 | |||
| 1035 | (define-key rmail-summary-mode-map [menu-bar mail] | ||
| 1036 | (cons "Mail" (make-sparse-keymap "Mail"))) | ||
| 1037 | |||
| 1038 | (define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail] | ||
| 1039 | '("Get New Mail" . rmail-summary-get-new-mail)) | ||
| 1040 | |||
| 1041 | (define-key rmail-summary-mode-map [menu-bar mail lambda] | ||
| 1042 | '("----")) | ||
| 1043 | |||
| 1044 | (define-key rmail-summary-mode-map [menu-bar mail continue] | ||
| 1045 | '("Continue" . rmail-summary-continue)) | ||
| 1046 | |||
| 1047 | (define-key rmail-summary-mode-map [menu-bar mail resend] | ||
| 1048 | '("Re-send..." . rmail-summary-resend)) | ||
| 1049 | |||
| 1050 | (define-key rmail-summary-mode-map [menu-bar mail forward] | ||
| 1051 | '("Forward" . rmail-summary-forward)) | ||
| 1052 | |||
| 1053 | (define-key rmail-summary-mode-map [menu-bar mail retry] | ||
| 1054 | '("Retry" . rmail-summary-retry-failure)) | ||
| 1055 | |||
| 1056 | (define-key rmail-summary-mode-map [menu-bar mail reply] | ||
| 1057 | '("Reply" . rmail-summary-reply)) | ||
| 1058 | |||
| 1059 | (define-key rmail-summary-mode-map [menu-bar mail mail] | ||
| 1060 | '("Mail" . rmail-summary-mail)) | ||
| 1061 | |||
| 1062 | (define-key rmail-summary-mode-map [menu-bar delete] | ||
| 1063 | (cons "Delete" (make-sparse-keymap "Delete"))) | ||
| 1064 | |||
| 1065 | (define-key rmail-summary-mode-map [menu-bar delete expunge/save] | ||
| 1066 | '("Expunge/Save" . rmail-summary-expunge-and-save)) | ||
| 1067 | |||
| 1068 | (define-key rmail-summary-mode-map [menu-bar delete expunge] | ||
| 1069 | '("Expunge" . rmail-summary-expunge)) | ||
| 1070 | |||
| 1071 | (define-key rmail-summary-mode-map [menu-bar delete undelete] | ||
| 1072 | '("Undelete" . rmail-summary-undelete)) | ||
| 1073 | |||
| 1074 | (define-key rmail-summary-mode-map [menu-bar delete delete] | ||
| 1075 | '("Delete" . rmail-summary-delete-forward)) | ||
| 1076 | |||
| 1077 | (define-key rmail-summary-mode-map [menu-bar move] | ||
| 1078 | (cons "Move" (make-sparse-keymap "Move"))) | ||
| 1079 | |||
| 1080 | (define-key rmail-summary-mode-map [menu-bar move search-back] | ||
| 1081 | '("Search Back..." . rmail-summary-search-backward)) | ||
| 1082 | |||
| 1083 | (define-key rmail-summary-mode-map [menu-bar move search] | ||
| 1084 | '("Search..." . rmail-summary-search)) | ||
| 1085 | |||
| 1086 | (define-key rmail-summary-mode-map [menu-bar move previous] | ||
| 1087 | '("Previous Nondeleted" . rmail-summary-previous-msg)) | ||
| 1088 | |||
| 1089 | (define-key rmail-summary-mode-map [menu-bar move next] | ||
| 1090 | '("Next Nondeleted" . rmail-summary-next-msg)) | ||
| 1091 | |||
| 1092 | (define-key rmail-summary-mode-map [menu-bar move last] | ||
| 1093 | '("Last" . rmail-summary-last-message)) | ||
| 1094 | |||
| 1095 | (define-key rmail-summary-mode-map [menu-bar move first] | ||
| 1096 | '("First" . rmail-summary-first-message)) | ||
| 1097 | |||
| 1098 | (define-key rmail-summary-mode-map [menu-bar move previous] | ||
| 1099 | '("Previous" . rmail-summary-previous-all)) | ||
| 1100 | |||
| 1101 | (define-key rmail-summary-mode-map [menu-bar move next] | ||
| 1102 | '("Next" . rmail-summary-next-all)) | ||
| 1103 | |||
| 1104 | (defun rmail-summary-mouse-goto-message (event) | ||
| 1105 | "Select the message whose summary line you click on." | ||
| 1106 | (interactive "@e") | ||
| 1107 | (goto-char (posn-point (event-end event))) | ||
| 1108 | (rmail-summary-goto-msg)) | ||
| 1109 | |||
| 1110 | (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail) | ||
| 1111 | "Go to message N in the summary buffer and the Rmail buffer. | ||
| 1112 | If N is nil, use the message corresponding to point in the summary | ||
| 1113 | and move to that message in the Rmail buffer. | ||
| 1114 | |||
| 1115 | If NOWARN, don't say anything if N is out of range. | ||
| 1116 | If SKIP-RMAIL, don't do anything to the Rmail buffer." | ||
| 1117 | (interactive "P") | ||
| 1118 | (if (consp n) (setq n (prefix-numeric-value n))) | ||
| 1119 | (if (eobp) (forward-line -1)) | ||
| 1120 | (beginning-of-line) | ||
| 1121 | (let* ((obuf (current-buffer)) | ||
| 1122 | (buf rmail-buffer) | ||
| 1123 | (cur (point)) | ||
| 1124 | message-not-found | ||
| 1125 | (curmsg (string-to-number | ||
| 1126 | (buffer-substring (point) | ||
| 1127 | (min (point-max) (+ 6 (point)))))) | ||
| 1128 | (total (save-excursion (set-buffer buf) rmail-total-messages))) | ||
| 1129 | ;; If message number N was specified, find that message's line | ||
| 1130 | ;; or set message-not-found. | ||
| 1131 | ;; If N wasn't specified or that message can't be found. | ||
| 1132 | ;; set N by default. | ||
| 1133 | (if (not n) | ||
| 1134 | (setq n curmsg) | ||
| 1135 | (if (< n 1) | ||
| 1136 | (progn (message "No preceding message") | ||
| 1137 | (setq n 1))) | ||
| 1138 | (if (and (> n total) | ||
| 1139 | (> total 0)) | ||
| 1140 | (progn (message "No following message") | ||
| 1141 | (goto-char (point-max)) | ||
| 1142 | (rmail-summary-goto-msg nil nowarn skip-rmail))) | ||
| 1143 | (goto-char (point-min)) | ||
| 1144 | (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t)) | ||
| 1145 | (progn (or nowarn (message "Message %d not found" n)) | ||
| 1146 | (setq n curmsg) | ||
| 1147 | (setq message-not-found t) | ||
| 1148 | (goto-char cur)))) | ||
| 1149 | (beginning-of-line) | ||
| 1150 | (skip-chars-forward " ") | ||
| 1151 | (skip-chars-forward "0-9") | ||
| 1152 | (save-excursion (if (= (following-char) ?-) | ||
| 1153 | (let ((buffer-read-only nil)) | ||
| 1154 | (delete-char 1) | ||
| 1155 | (insert " ")))) | ||
| 1156 | (rmail-summary-update-highlight message-not-found) | ||
| 1157 | (beginning-of-line) | ||
| 1158 | (if skip-rmail | ||
| 1159 | nil | ||
| 1160 | (let ((selwin (selected-window))) | ||
| 1161 | (unwind-protect | ||
| 1162 | (progn (pop-to-buffer buf) | ||
| 1163 | (rmail-show-message-maybe n)) | ||
| 1164 | (select-window selwin) | ||
| 1165 | ;; The actions above can alter the current buffer. Preserve it. | ||
| 1166 | (set-buffer obuf)))))) | ||
| 1167 | |||
| 1168 | ;; Update the highlighted line in an rmail summary buffer. | ||
| 1169 | ;; That should be current. We highlight the line point is on. | ||
| 1170 | ;; If NOT-FOUND is non-nil, we turn off highlighting. | ||
| 1171 | (defun rmail-summary-update-highlight (not-found) | ||
| 1172 | ;; Make sure we have an overlay to use. | ||
| 1173 | (or rmail-summary-overlay | ||
| 1174 | (progn | ||
| 1175 | (make-local-variable 'rmail-summary-overlay) | ||
| 1176 | (setq rmail-summary-overlay (make-overlay (point) (point))))) | ||
| 1177 | ;; If this message is in the summary, use the overlay to highlight it. | ||
| 1178 | ;; Otherwise, don't highlight anything. | ||
| 1179 | (if not-found | ||
| 1180 | (overlay-put rmail-summary-overlay 'face nil) | ||
| 1181 | (move-overlay rmail-summary-overlay | ||
| 1182 | (save-excursion (beginning-of-line) | ||
| 1183 | (skip-chars-forward " ") | ||
| 1184 | (point)) | ||
| 1185 | (save-excursion (end-of-line) (point))) | ||
| 1186 | (overlay-put rmail-summary-overlay 'face 'highlight))) | ||
| 1187 | |||
| 1188 | (defun rmail-summary-scroll-msg-up (&optional dist) | ||
| 1189 | "Scroll the Rmail window forward. | ||
| 1190 | If the Rmail window is displaying the end of a message, | ||
| 1191 | advance to the next message." | ||
| 1192 | (interactive "P") | ||
| 1193 | (if (eq dist '-) | ||
| 1194 | (rmail-summary-scroll-msg-down nil) | ||
| 1195 | (let ((rmail-buffer-window (get-buffer-window rmail-buffer))) | ||
| 1196 | (if rmail-buffer-window | ||
| 1197 | (if (let ((rmail-summary-window (selected-window))) | ||
| 1198 | (select-window rmail-buffer-window) | ||
| 1199 | (prog1 | ||
| 1200 | ;; Is EOB visible in the buffer? | ||
| 1201 | (save-excursion | ||
| 1202 | (let ((ht (window-height (selected-window)))) | ||
| 1203 | (move-to-window-line (- ht 2)) | ||
| 1204 | (end-of-line) | ||
| 1205 | (eobp))) | ||
| 1206 | (select-window rmail-summary-window))) | ||
| 1207 | (if (not rmail-summary-scroll-between-messages) | ||
| 1208 | (error "End of buffer") | ||
| 1209 | (rmail-summary-next-msg (or dist 1))) | ||
| 1210 | (let ((other-window-scroll-buffer rmail-buffer)) | ||
| 1211 | (scroll-other-window dist))) | ||
| 1212 | ;; If it isn't visible at all, show the beginning. | ||
| 1213 | (rmail-summary-beginning-of-message))))) | ||
| 1214 | |||
| 1215 | (defun rmail-summary-scroll-msg-down (&optional dist) | ||
| 1216 | "Scroll the Rmail window backward. | ||
| 1217 | If the Rmail window is now displaying the beginning of a message, | ||
| 1218 | move to the previous message." | ||
| 1219 | (interactive "P") | ||
| 1220 | (if (eq dist '-) | ||
| 1221 | (rmail-summary-scroll-msg-up nil) | ||
| 1222 | (let ((rmail-buffer-window (get-buffer-window rmail-buffer))) | ||
| 1223 | (if rmail-buffer-window | ||
| 1224 | (if (let ((rmail-summary-window (selected-window))) | ||
| 1225 | (select-window rmail-buffer-window) | ||
| 1226 | (prog1 | ||
| 1227 | ;; Is BOB visible in the buffer? | ||
| 1228 | (save-excursion | ||
| 1229 | (move-to-window-line 0) | ||
| 1230 | (beginning-of-line) | ||
| 1231 | (bobp)) | ||
| 1232 | (select-window rmail-summary-window))) | ||
| 1233 | (if (not rmail-summary-scroll-between-messages) | ||
| 1234 | (error "Beginning of buffer") | ||
| 1235 | (rmail-summary-previous-msg (or dist 1))) | ||
| 1236 | (let ((other-window-scroll-buffer rmail-buffer)) | ||
| 1237 | (scroll-other-window-down dist))) | ||
| 1238 | ;; If it isn't visible at all, show the beginning. | ||
| 1239 | (rmail-summary-beginning-of-message))))) | ||
| 1240 | |||
| 1241 | (defun rmail-summary-beginning-of-message () | ||
| 1242 | "Show current message from the beginning." | ||
| 1243 | (interactive) | ||
| 1244 | (rmail-summary-show-message 'BEG)) | ||
| 1245 | |||
| 1246 | (defun rmail-summary-end-of-message () | ||
| 1247 | "Show bottom of current message." | ||
| 1248 | (interactive) | ||
| 1249 | (rmail-summary-show-message 'END)) | ||
| 1250 | |||
| 1251 | (defun rmail-summary-show-message (where) | ||
| 1252 | "Show current mail message. | ||
| 1253 | Position it according to WHERE which can be BEG or END" | ||
| 1254 | (if (and (one-window-p) (not pop-up-frames)) | ||
| 1255 | ;; If there is just one window, put the summary on the top. | ||
| 1256 | (let ((buffer rmail-buffer)) | ||
| 1257 | (split-window (selected-window) rmail-summary-window-size) | ||
| 1258 | (select-window (frame-first-window)) | ||
| 1259 | (pop-to-buffer rmail-buffer) | ||
| 1260 | ;; If pop-to-buffer did not use that window, delete that | ||
| 1261 | ;; window. (This can happen if it uses another frame.) | ||
| 1262 | (or (eq buffer (window-buffer (next-window (frame-first-window)))) | ||
| 1263 | (delete-other-windows))) | ||
| 1264 | (pop-to-buffer rmail-buffer)) | ||
| 1265 | (cond | ||
| 1266 | ((eq where 'BEG) | ||
| 1267 | (goto-char (point-min)) | ||
| 1268 | (search-forward "\n\n")) | ||
| 1269 | ((eq where 'END) | ||
| 1270 | (goto-char (point-max)) | ||
| 1271 | (recenter (1- (window-height)))) | ||
| 1272 | ) | ||
| 1273 | (pop-to-buffer rmail-summary-buffer)) | ||
| 1274 | |||
| 1275 | (defun rmail-summary-bury () | ||
| 1276 | "Bury the Rmail buffer and the Rmail summary buffer." | ||
| 1277 | (interactive) | ||
| 1278 | (let ((buffer-to-bury (current-buffer))) | ||
| 1279 | (let (window) | ||
| 1280 | (while (setq window (get-buffer-window rmail-buffer)) | ||
| 1281 | (set-window-buffer window (other-buffer rmail-buffer))) | ||
| 1282 | (bury-buffer rmail-buffer)) | ||
| 1283 | (switch-to-buffer (other-buffer buffer-to-bury)) | ||
| 1284 | (bury-buffer buffer-to-bury))) | ||
| 1285 | |||
| 1286 | (defun rmail-summary-quit () | ||
| 1287 | "Quit out of Rmail and Rmail summary." | ||
| 1288 | (interactive) | ||
| 1289 | (rmail-summary-wipe) | ||
| 1290 | (rmail-quit)) | ||
| 1291 | |||
| 1292 | (defun rmail-summary-wipe () | ||
| 1293 | "Kill and wipe away Rmail summary, remaining within Rmail." | ||
| 1294 | (interactive) | ||
| 1295 | (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil)) | ||
| 1296 | (let ((local-rmail-buffer rmail-buffer)) | ||
| 1297 | (kill-buffer (current-buffer)) | ||
| 1298 | ;; Delete window if not only one. | ||
| 1299 | (if (not (eq (selected-window) (next-window nil 'no-minibuf))) | ||
| 1300 | (delete-window)) | ||
| 1301 | ;; Switch windows to the rmail buffer, or switch to it in this window. | ||
| 1302 | (pop-to-buffer local-rmail-buffer))) | ||
| 1303 | |||
| 1304 | (defun rmail-summary-expunge () | ||
| 1305 | "Actually erase all deleted messages and recompute summary headers." | ||
| 1306 | (interactive) | ||
| 1307 | (save-excursion | ||
| 1308 | (set-buffer rmail-buffer) | ||
| 1309 | (when (rmail-expunge-confirmed) | ||
| 1310 | (rmail-only-expunge))) | ||
| 1311 | (rmail-update-summary)) | ||
| 1312 | |||
| 1313 | (defun rmail-summary-expunge-and-save () | ||
| 1314 | "Expunge and save RMAIL file." | ||
| 1315 | (interactive) | ||
| 1316 | (save-excursion | ||
| 1317 | (rmail-expunge-and-save)) | ||
| 1318 | (rmail-update-summary) | ||
| 1319 | (set-buffer-modified-p nil)) | ||
| 1320 | |||
| 1321 | (defun rmail-summary-get-new-mail (&optional file-name) | ||
| 1322 | "Get new mail and recompute summary headers. | ||
| 1323 | |||
| 1324 | Optionally you can specify the file to get new mail from. In this case, | ||
| 1325 | the file of new mail is not changed or deleted. Noninteractively, you can | ||
| 1326 | pass the inbox file name as an argument. Interactively, a prefix | ||
| 1327 | argument says to read a file name and use that file as the inbox." | ||
| 1328 | (interactive | ||
| 1329 | (list (if current-prefix-arg | ||
| 1330 | (read-file-name "Get new mail from file: ")))) | ||
| 1331 | (let (msg) | ||
| 1332 | (save-excursion | ||
| 1333 | (set-buffer rmail-buffer) | ||
| 1334 | (rmail-get-new-mail file-name) | ||
| 1335 | ;; Get the proper new message number. | ||
| 1336 | (setq msg rmail-current-message)) | ||
| 1337 | ;; Make sure that message is displayed. | ||
| 1338 | (or (zerop msg) | ||
| 1339 | (rmail-summary-goto-msg msg)))) | ||
| 1340 | |||
| 1341 | (defun rmail-summary-input (filename) | ||
| 1342 | "Run Rmail on file FILENAME." | ||
| 1343 | (interactive "FRun rmail on RMAIL file: ") | ||
| 1344 | ;; We switch windows here, then display the other Rmail file there. | ||
| 1345 | (pop-to-buffer rmail-buffer) | ||
| 1346 | (rmail filename)) | ||
| 1347 | |||
| 1348 | (defun rmail-summary-first-message () | ||
| 1349 | "Show first message in Rmail file from summary buffer." | ||
| 1350 | (interactive) | ||
| 1351 | (with-no-warnings | ||
| 1352 | (beginning-of-buffer))) | ||
| 1353 | |||
| 1354 | (defun rmail-summary-last-message () | ||
| 1355 | "Show last message in Rmail file from summary buffer." | ||
| 1356 | (interactive) | ||
| 1357 | (with-no-warnings | ||
| 1358 | (end-of-buffer)) | ||
| 1359 | (forward-line -1)) | ||
| 1360 | |||
| 1361 | (declare-function rmail-abort-edit "rmailedit" ()) | ||
| 1362 | (declare-function rmail-cease-edit "rmailedit"()) | ||
| 1363 | (declare-function rmail-set-label "rmailkwd" (l state &optional n)) | ||
| 1364 | (declare-function rmail-output-read-file-name "rmailout" ()) | ||
| 1365 | (declare-function mail-send-and-exit "sendmail" (&optional arg)) | ||
| 1366 | |||
| 1367 | (defvar rmail-summary-edit-map nil) | ||
| 1368 | (if rmail-summary-edit-map | ||
| 1369 | nil | ||
| 1370 | (setq rmail-summary-edit-map | ||
| 1371 | (nconc (make-sparse-keymap) text-mode-map)) | ||
| 1372 | (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit) | ||
| 1373 | (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit)) | ||
| 1374 | |||
| 1375 | (defun rmail-summary-edit-current-message () | ||
| 1376 | "Edit the contents of this message." | ||
| 1377 | (interactive) | ||
| 1378 | (pop-to-buffer rmail-buffer) | ||
| 1379 | (rmail-edit-current-message) | ||
| 1380 | (use-local-map rmail-summary-edit-map)) | ||
| 1381 | |||
| 1382 | (defun rmail-summary-cease-edit () | ||
| 1383 | "Finish editing message, then go back to Rmail summary buffer." | ||
| 1384 | (interactive) | ||
| 1385 | (rmail-cease-edit) | ||
| 1386 | (pop-to-buffer rmail-summary-buffer)) | ||
| 1387 | |||
| 1388 | (defun rmail-summary-abort-edit () | ||
| 1389 | "Abort edit of current message; restore original contents. | ||
| 1390 | Go back to summary buffer." | ||
| 1391 | (interactive) | ||
| 1392 | (rmail-abort-edit) | ||
| 1393 | (pop-to-buffer rmail-summary-buffer)) | ||
| 1394 | |||
| 1395 | (defun rmail-summary-search-backward (regexp &optional n) | ||
| 1396 | "Show message containing next match for REGEXP. | ||
| 1397 | Prefix argument gives repeat count; negative argument means search | ||
| 1398 | backwards (through earlier messages). | ||
| 1399 | Interactively, empty argument means use same regexp used last time." | ||
| 1400 | (interactive | ||
| 1401 | (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) | ||
| 1402 | (prompt | ||
| 1403 | (concat (if reversep "Reverse " "") "Rmail search (regexp")) | ||
| 1404 | regexp) | ||
| 1405 | (setq prompt | ||
| 1406 | (concat prompt | ||
| 1407 | (if rmail-search-last-regexp | ||
| 1408 | (concat ", default " | ||
| 1409 | rmail-search-last-regexp "): ") | ||
| 1410 | "): "))) | ||
| 1411 | (setq regexp (read-string prompt)) | ||
| 1412 | (cond ((not (equal regexp "")) | ||
| 1413 | (setq rmail-search-last-regexp regexp)) | ||
| 1414 | ((not rmail-search-last-regexp) | ||
| 1415 | (error "No previous Rmail search string"))) | ||
| 1416 | (list rmail-search-last-regexp | ||
| 1417 | (prefix-numeric-value current-prefix-arg)))) | ||
| 1418 | ;; Don't use save-excursion because that prevents point from moving | ||
| 1419 | ;; properly in the summary buffer. | ||
| 1420 | (let ((buffer (current-buffer))) | ||
| 1421 | (unwind-protect | ||
| 1422 | (progn | ||
| 1423 | (set-buffer rmail-buffer) | ||
| 1424 | (rmail-search regexp (- n))) | ||
| 1425 | (set-buffer buffer)))) | ||
| 1426 | |||
| 1427 | (defun rmail-summary-search (regexp &optional n) | ||
| 1428 | "Show message containing next match for REGEXP. | ||
| 1429 | Prefix argument gives repeat count; negative argument means search | ||
| 1430 | backwards (through earlier messages). | ||
| 1431 | Interactively, empty argument means use same regexp used last time." | ||
| 1432 | (interactive | ||
| 1433 | (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) | ||
| 1434 | (prompt | ||
| 1435 | (concat (if reversep "Reverse " "") "Rmail search (regexp")) | ||
| 1436 | regexp) | ||
| 1437 | (setq prompt | ||
| 1438 | (concat prompt | ||
| 1439 | (if rmail-search-last-regexp | ||
| 1440 | (concat ", default " | ||
| 1441 | rmail-search-last-regexp "): ") | ||
| 1442 | "): "))) | ||
| 1443 | (setq regexp (read-string prompt)) | ||
| 1444 | (cond ((not (equal regexp "")) | ||
| 1445 | (setq rmail-search-last-regexp regexp)) | ||
| 1446 | ((not rmail-search-last-regexp) | ||
| 1447 | (error "No previous Rmail search string"))) | ||
| 1448 | (list rmail-search-last-regexp | ||
| 1449 | (prefix-numeric-value current-prefix-arg)))) | ||
| 1450 | ;; Don't use save-excursion because that prevents point from moving | ||
| 1451 | ;; properly in the summary buffer. | ||
| 1452 | (let ((buffer (current-buffer))) | ||
| 1453 | (unwind-protect | ||
| 1454 | (progn | ||
| 1455 | (set-buffer rmail-buffer) | ||
| 1456 | (rmail-search regexp n)) | ||
| 1457 | (set-buffer buffer)))) | ||
| 1458 | |||
| 1459 | (defun rmail-summary-toggle-header () | ||
| 1460 | "Show original message header if pruned header currently shown, or vice versa." | ||
| 1461 | (interactive) | ||
| 1462 | (save-window-excursion | ||
| 1463 | (set-buffer rmail-buffer) | ||
| 1464 | (rmail-toggle-header)) | ||
| 1465 | ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost. | ||
| 1466 | ;; Set point to point-min in the RMAIL buffer, if it is visible. | ||
| 1467 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1468 | (if window | ||
| 1469 | ;; Using save-window-excursion would lose the new value of point. | ||
| 1470 | (let ((owin (selected-window))) | ||
| 1471 | (unwind-protect | ||
| 1472 | (progn | ||
| 1473 | (select-window window) | ||
| 1474 | (goto-char (point-min))) | ||
| 1475 | (select-window owin)))))) | ||
| 1476 | |||
| 1477 | |||
| 1478 | (defun rmail-summary-add-label (label) | ||
| 1479 | "Add LABEL to labels associated with current Rmail message. | ||
| 1480 | Completion is performed over known labels when reading." | ||
| 1481 | (interactive (list (save-excursion | ||
| 1482 | (set-buffer rmail-buffer) | ||
| 1483 | (rmail-read-label "Add label")))) | ||
| 1484 | (save-excursion | ||
| 1485 | (set-buffer rmail-buffer) | ||
| 1486 | (rmail-add-label label))) | ||
| 1487 | |||
| 1488 | (defun rmail-summary-kill-label (label) | ||
| 1489 | "Remove LABEL from labels associated with current Rmail message. | ||
| 1490 | Completion is performed over known labels when reading." | ||
| 1491 | (interactive (list (save-excursion | ||
| 1492 | (set-buffer rmail-buffer) | ||
| 1493 | (rmail-read-label "Kill label")))) | ||
| 1494 | (save-excursion | ||
| 1495 | (set-buffer rmail-buffer) | ||
| 1496 | (rmail-set-label label nil))) | ||
| 1497 | |||
| 1498 | ;;;; *** Rmail Summary Mailing Commands *** | ||
| 1499 | |||
| 1500 | (defun rmail-summary-override-mail-send-and-exit () | ||
| 1501 | "Replace bindings to `mail-send-and-exit' with `rmail-summary-send-and-exit'." | ||
| 1502 | (use-local-map (copy-keymap (current-local-map))) | ||
| 1503 | (dolist (key (where-is-internal 'mail-send-and-exit)) | ||
| 1504 | (define-key (current-local-map) key 'rmail-summary-send-and-exit))) | ||
| 1505 | |||
| 1506 | (defun rmail-summary-mail () | ||
| 1507 | "Send mail in another window. | ||
| 1508 | While composing the message, use \\[mail-yank-original] to yank the | ||
| 1509 | original message into it." | ||
| 1510 | (interactive) | ||
| 1511 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1512 | (if window | ||
| 1513 | (select-window window) | ||
| 1514 | (set-buffer rmail-buffer))) | ||
| 1515 | (rmail-start-mail nil nil nil nil nil (current-buffer)) | ||
| 1516 | (rmail-summary-override-mail-send-and-exit)) | ||
| 1517 | |||
| 1518 | (defun rmail-summary-continue () | ||
| 1519 | "Continue composing outgoing message previously being composed." | ||
| 1520 | (interactive) | ||
| 1521 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1522 | (if window | ||
| 1523 | (select-window window) | ||
| 1524 | (set-buffer rmail-buffer))) | ||
| 1525 | (rmail-start-mail t)) | ||
| 1526 | |||
| 1527 | (defun rmail-summary-reply (just-sender) | ||
| 1528 | "Reply to the current message. | ||
| 1529 | Normally include CC: to all other recipients of original message; | ||
| 1530 | prefix argument means ignore them. While composing the reply, | ||
| 1531 | use \\[mail-yank-original] to yank the original message into it." | ||
| 1532 | (interactive "P") | ||
| 1533 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1534 | (if window | ||
| 1535 | (select-window window) | ||
| 1536 | (set-buffer rmail-buffer))) | ||
| 1537 | (rmail-reply just-sender) | ||
| 1538 | (rmail-summary-override-mail-send-and-exit)) | ||
| 1539 | |||
| 1540 | (defun rmail-summary-retry-failure () | ||
| 1541 | "Edit a mail message which is based on the contents of the current message. | ||
| 1542 | For a message rejected by the mail system, extract the interesting headers and | ||
| 1543 | the body of the original message; otherwise copy the current message." | ||
| 1544 | (interactive) | ||
| 1545 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1546 | (if window | ||
| 1547 | (select-window window) | ||
| 1548 | (set-buffer rmail-buffer))) | ||
| 1549 | (rmail-retry-failure) | ||
| 1550 | (rmail-summary-override-mail-send-and-exit)) | ||
| 1551 | |||
| 1552 | (defun rmail-summary-send-and-exit () | ||
| 1553 | "Send mail reply and return to summary buffer." | ||
| 1554 | (interactive) | ||
| 1555 | (mail-send-and-exit t)) | ||
| 1556 | |||
| 1557 | (defun rmail-summary-forward (resend) | ||
| 1558 | "Forward the current message to another user. | ||
| 1559 | With prefix argument, \"resend\" the message instead of forwarding it; | ||
| 1560 | see the documentation of `rmail-resend'." | ||
| 1561 | (interactive "P") | ||
| 1562 | (save-excursion | ||
| 1563 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1564 | (if window | ||
| 1565 | (select-window window) | ||
| 1566 | (set-buffer rmail-buffer))) | ||
| 1567 | (rmail-forward resend) | ||
| 1568 | (rmail-summary-override-mail-send-and-exit))) | ||
| 1569 | |||
| 1570 | (defun rmail-summary-resend () | ||
| 1571 | "Resend current message using `rmail-resend'." | ||
| 1572 | (interactive) | ||
| 1573 | (save-excursion | ||
| 1574 | (let ((window (get-buffer-window rmail-buffer))) | ||
| 1575 | (if window | ||
| 1576 | (select-window window) | ||
| 1577 | (set-buffer rmail-buffer))) | ||
| 1578 | (call-interactively 'rmail-resend))) | ||
| 1579 | |||
| 1580 | ;; Summary output commands. | ||
| 1581 | |||
| 1582 | (defun rmail-summary-output (&optional file-name n) | ||
| 1583 | "Append this message to mail file FILE-NAME. | ||
| 1584 | This works with both mbox format and Babyl format files, | ||
| 1585 | outputting in the appropriate format for each. | ||
| 1586 | The default file name comes from `rmail-default-file', | ||
| 1587 | which is updated to the name you use in this command. | ||
| 1588 | |||
| 1589 | A prefix argument N says to output that many consecutive messages | ||
| 1590 | from those in the summary, starting with the current one. | ||
| 1591 | Deleted messages are skipped and don't count. | ||
| 1592 | When called from Lisp code, N may be omitted and defaults to 1. | ||
| 1593 | |||
| 1594 | This command always outputs the complete message header, | ||
| 1595 | even the header display is currently pruned." | ||
| 1596 | (interactive | ||
| 1597 | (progn (require 'rmailout) | ||
| 1598 | (list (rmail-output-read-file-name) | ||
| 1599 | (prefix-numeric-value current-prefix-arg)))) | ||
| 1600 | (let ((i 0) prev-msg) | ||
| 1601 | (while | ||
| 1602 | (and (< i n) | ||
| 1603 | (progn (rmail-summary-goto-msg) | ||
| 1604 | (not (eq prev-msg | ||
| 1605 | (setq prev-msg | ||
| 1606 | (with-current-buffer rmail-buffer | ||
| 1607 | rmail-current-message)))))) | ||
| 1608 | (setq i (1+ i)) | ||
| 1609 | (with-current-buffer rmail-buffer | ||
| 1610 | (let ((rmail-delete-after-output nil)) | ||
| 1611 | (rmail-output file-name 1))) | ||
| 1612 | (if rmail-delete-after-output | ||
| 1613 | (rmail-summary-delete-forward nil) | ||
| 1614 | (if (< i n) | ||
| 1615 | (rmail-summary-next-msg 1)))))) | ||
| 1616 | |||
| 1617 | (defalias 'rmail-summary-output-to-rmail-file 'rmail-summary-output) | ||
| 1618 | |||
| 1619 | (declare-function rmail-output-as-seen "rmailout" | ||
| 1620 | (file-name &optional count noattribute from-gnus)) | ||
| 1621 | |||
| 1622 | (defun rmail-summary-output-as-seen (&optional file-name n) | ||
| 1623 | "Append this message to system-inbox-format mail file named FILE-NAME. | ||
| 1624 | A prefix argument N says to output that many consecutive messages, | ||
| 1625 | from the summary, starting with the current one. | ||
| 1626 | Deleted messages are skipped and don't count. | ||
| 1627 | When called from Lisp code, N may be omitted and defaults to 1. | ||
| 1628 | |||
| 1629 | This outputs the message header as you see it (or would see it) | ||
| 1630 | displayed in Rmail. | ||
| 1631 | |||
| 1632 | The default file name comes from `rmail-default-file', | ||
| 1633 | which is updated to the name you use in this command." | ||
| 1634 | (interactive | ||
| 1635 | (progn (require 'rmailout) | ||
| 1636 | (list (rmail-output-read-file-name) | ||
| 1637 | (prefix-numeric-value current-prefix-arg)))) | ||
| 1638 | (require 'rmailout) ; for rmail-output-as-seen in non-interactive case | ||
| 1639 | (let ((i 0) prev-msg) | ||
| 1640 | (while | ||
| 1641 | (and (< i n) | ||
| 1642 | (progn (rmail-summary-goto-msg) | ||
| 1643 | (not (eq prev-msg | ||
| 1644 | (setq prev-msg | ||
| 1645 | (with-current-buffer rmail-buffer | ||
| 1646 | rmail-current-message)))))) | ||
| 1647 | (setq i (1+ i)) | ||
| 1648 | (with-current-buffer rmail-buffer | ||
| 1649 | (let ((rmail-delete-after-output nil)) | ||
| 1650 | (rmail-output-as-seen file-name 1))) | ||
| 1651 | (if rmail-delete-after-output | ||
| 1652 | (rmail-summary-delete-forward nil) | ||
| 1653 | (if (< i n) | ||
| 1654 | (rmail-summary-next-msg 1)))))) | ||
| 1655 | |||
| 1656 | (defun rmail-summary-output-menu () | ||
| 1657 | "Output current message to another Rmail file, chosen with a menu. | ||
| 1658 | Also set the default for subsequent \\[rmail-output-to-babyl-file] commands. | ||
| 1659 | The variables `rmail-secondary-file-directory' and | ||
| 1660 | `rmail-secondary-file-regexp' control which files are offered in the menu." | ||
| 1661 | (interactive) | ||
| 1662 | (save-excursion | ||
| 1663 | (set-buffer rmail-buffer) | ||
| 1664 | (let ((rmail-delete-after-output nil)) | ||
| 1665 | (call-interactively 'rmail-output-menu))) | ||
| 1666 | (if rmail-delete-after-output | ||
| 1667 | (rmail-summary-delete-forward nil))) | ||
| 1668 | |||
| 1669 | (defun rmail-summary-construct-io-menu () | ||
| 1670 | (let ((files (rmail-find-all-files rmail-secondary-file-directory))) | ||
| 1671 | (if files | ||
| 1672 | (progn | ||
| 1673 | (define-key rmail-summary-mode-map [menu-bar classify input-menu] | ||
| 1674 | (cons "Input Rmail File" | ||
| 1675 | (rmail-list-to-menu "Input Rmail File" | ||
| 1676 | files | ||
| 1677 | 'rmail-summary-input))) | ||
| 1678 | (define-key rmail-summary-mode-map [menu-bar classify output-menu] | ||
| 1679 | (cons "Output Rmail File" | ||
| 1680 | (rmail-list-to-menu "Output Rmail File" | ||
| 1681 | files | ||
| 1682 | 'rmail-summary-output)))) | ||
| 1683 | (define-key rmail-summary-mode-map [menu-bar classify input-menu] | ||
| 1684 | '("Input Rmail File" . rmail-disable-menu)) | ||
| 1685 | (define-key rmail-summary-mode-map [menu-bar classify output-menu] | ||
| 1686 | '("Output Rmail File" . rmail-disable-menu))))) | ||
| 1687 | |||
| 1688 | (defun rmail-summary-output-body (&optional file-name) | ||
| 1689 | "Write this message body to the file FILE-NAME. | ||
| 1690 | FILE-NAME defaults, interactively, from the Subject field of the message." | ||
| 1691 | (interactive) | ||
| 1692 | (save-excursion | ||
| 1693 | (set-buffer rmail-buffer) | ||
| 1694 | (let ((rmail-delete-after-output nil)) | ||
| 1695 | (if file-name | ||
| 1696 | (rmail-output-body-to-file file-name) | ||
| 1697 | (call-interactively 'rmail-output-body-to-file)))) | ||
| 1698 | (if rmail-delete-after-output | ||
| 1699 | (rmail-summary-delete-forward nil))) | ||
| 1700 | |||
| 1701 | ;; Sorting messages in Rmail Summary buffer. | ||
| 1702 | |||
| 1703 | (defun rmail-summary-sort-by-date (reverse) | ||
| 1704 | "Sort messages of current Rmail summary by date. | ||
| 1705 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1706 | (interactive "P") | ||
| 1707 | (rmail-sort-from-summary (function rmail-sort-by-date) reverse)) | ||
| 1708 | |||
| 1709 | (defun rmail-summary-sort-by-subject (reverse) | ||
| 1710 | "Sort messages of current Rmail summary by subject. | ||
| 1711 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1712 | (interactive "P") | ||
| 1713 | (rmail-sort-from-summary (function rmail-sort-by-subject) reverse)) | ||
| 1714 | |||
| 1715 | (defun rmail-summary-sort-by-author (reverse) | ||
| 1716 | "Sort messages of current Rmail summary by author. | ||
| 1717 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1718 | (interactive "P") | ||
| 1719 | (rmail-sort-from-summary (function rmail-sort-by-author) reverse)) | ||
| 1720 | |||
| 1721 | (defun rmail-summary-sort-by-recipient (reverse) | ||
| 1722 | "Sort messages of current Rmail summary by recipient. | ||
| 1723 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1724 | (interactive "P") | ||
| 1725 | (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse)) | ||
| 1726 | |||
| 1727 | (defun rmail-summary-sort-by-correspondent (reverse) | ||
| 1728 | "Sort messages of current Rmail summary by other correspondent. | ||
| 1729 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1730 | (interactive "P") | ||
| 1731 | (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse)) | ||
| 1732 | |||
| 1733 | (defun rmail-summary-sort-by-lines (reverse) | ||
| 1734 | "Sort messages of current Rmail summary by lines of the message. | ||
| 1735 | If prefix argument REVERSE is non-nil, sort them in reverse order." | ||
| 1736 | (interactive "P") | ||
| 1737 | (rmail-sort-from-summary (function rmail-sort-by-lines) reverse)) | ||
| 1738 | |||
| 1739 | (defun rmail-summary-sort-by-labels (reverse labels) | ||
| 1740 | "Sort messages of current Rmail summary by labels. | ||
| 1741 | If prefix argument REVERSE is non-nil, sort them in reverse order. | ||
| 1742 | KEYWORDS is a comma-separated list of labels." | ||
| 1743 | (interactive "P\nsSort by labels: ") | ||
| 1744 | (rmail-sort-from-summary | ||
| 1745 | (function (lambda (reverse) | ||
| 1746 | (rmail-sort-by-labels reverse labels))) | ||
| 1747 | reverse)) | ||
| 1748 | |||
| 1749 | (defun rmail-sort-from-summary (sortfun reverse) | ||
| 1750 | "Sort Rmail messages from Summary buffer and update it after sorting." | ||
| 1751 | (require 'rmailsort) | ||
| 1752 | (let ((selwin (selected-window))) | ||
| 1753 | (unwind-protect | ||
| 1754 | (progn (pop-to-buffer rmail-buffer) | ||
| 1755 | (funcall sortfun reverse)) | ||
| 1756 | (select-window selwin)))) | ||
| 1757 | |||
| 1758 | (provide 'rmailsum) | ||
| 1759 | |||
| 1760 | ;; Local Variables: | ||
| 1761 | ;; change-log-default-name: "ChangeLog.rmail" | ||
| 1762 | ;; End: | ||
| 1763 | |||
| 1764 | ;; arch-tag: 80b0a27a-a50d-4f37-9466-83d32d1e0ca8 | ||
| 1765 | ;;; rmailsum.el ends here | ||