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 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 2, or (at your option) 14;; 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; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;;; Code: 29 30;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu 31;; New features include attribute and keyword support, message 32;; selection by dispatch table, summary by attributes and keywords, 33;; expunging by dispatch table, sticky options for file commands. 34 35;; Extended by Bob Weiner of Motorola 36;; New features include: rmail and rmail-summary buffers remain 37;; synchronized and key bindings basically operate the same way in both 38;; buffers, summary by topic or by regular expression, rmail-reply-prefix 39;; variable, and a bury rmail buffer (wipe) command. 40;; 41 42(require 'mail-utils) 43(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority 44 45(defvar deleted-head) 46(defvar font-lock-fontified) 47(defvar mail-abbrev-syntax-table) 48(defvar mail-abbrevs) 49(defvar messages-head) 50(defvar rmail-use-spam-filter) 51(defvar rsf-beep) 52(defvar rsf-sleep-after-message) 53(defvar total-messages) 54(defvar tool-bar-map) 55 56; These variables now declared in paths.el. 57;(defvar rmail-spool-directory "/usr/spool/mail/" 58; "This is the name of the directory used by the system mailer for\n\ 59;delivering new mail. Its name should end with a slash.") 60;(defvar rmail-file-name 61; (expand-file-name "~/RMAIL") 62; "") 63 64(defgroup rmail nil 65 "Mail reader for Emacs." 66 :group 'mail) 67 68(defgroup rmail-retrieve nil 69 "Rmail retrieval options." 70 :prefix "rmail-" 71 :group 'rmail) 72 73(defgroup rmail-files nil 74 "Rmail files." 75 :prefix "rmail-" 76 :group 'rmail) 77 78(defgroup rmail-headers nil 79 "Rmail header options." 80 :prefix "rmail-" 81 :group 'rmail) 82 83(defgroup rmail-reply nil 84 "Rmail reply options." 85 :prefix "rmail-" 86 :group 'rmail) 87 88(defgroup rmail-summary nil 89 "Rmail summary options." 90 :prefix "rmail-" 91 :prefix "rmail-summary-" 92 :group 'rmail) 93 94(defgroup rmail-output nil 95 "Output message to a file." 96 :prefix "rmail-output-" 97 :prefix "rmail-" 98 :group 'rmail) 99 100(defgroup rmail-edit nil 101 "Rmail editing." 102 :prefix "rmail-edit-" 103 :group 'rmail) 104 105(defgroup rmail-obsolete nil 106 "Rmail obsolete customization variables." 107 :group 'rmail) 108 109(defcustom rmail-movemail-program nil 110 "If non-nil, the file name of the `movemail' program." 111 :group 'rmail-retrieve 112 :type '(choice (const nil) string)) 113 114(defcustom rmail-pop-password nil 115 "*Password to use when reading mail from POP server. 116Please use `rmail-remote-password' instead." 117 :type '(choice (string :tag "Password") 118 (const :tag "Not Required" nil)) 119 :group 'rmail-obsolete) 120 121(defcustom rmail-pop-password-required nil 122 "*Non-nil if a password is required when reading mail from a POP server. 123Please use rmail-remote-password-required instead." 124 :type 'boolean 125 :group 'rmail-obsolete) 126 127(defcustom rmail-remote-password nil 128 "*Password to use when reading mail from a remote server. 129This setting is ignored for mailboxes whose URL already contains a password." 130 :type '(choice (string :tag "Password") 131 (const :tag "Not Required" nil)) 132 :set-after '(rmail-pop-password) 133 :set #'(lambda (symbol value) 134 (set-default symbol 135 (if (and (not value) 136 (boundp 'rmail-pop-password) 137 rmail-pop-password) 138 rmail-pop-password 139 value)) 140 (setq rmail-pop-password nil)) 141 :group 'rmail-retrieve 142 :version "22.1") 143 144(defcustom rmail-remote-password-required nil 145 "*Non-nil if a password is required when reading mail from a remote server." 146 :type 'boolean 147 :set-after '(rmail-pop-password-required) 148 :set #'(lambda (symbol value) 149 (set-default symbol 150 (if (and (not value) 151 (boundp 'rmail-pop-password-required) 152 rmail-pop-password-required) 153 rmail-pop-password-required 154 value)) 155 (setq rmail-pop-password-required nil)) 156 :group 'rmail-retrieve 157 :version "22.1") 158 159(defcustom rmail-movemail-flags nil 160 "*List of flags to pass to movemail. 161Most commonly used to specify `-g' to enable GSS-API authentication 162or `-k' to enable Kerberos authentication." 163 :type '(repeat string) 164 :group 'rmail-retrieve 165 :version "20.3") 166 167(defvar rmail-remote-password-error "invalid usercode or password\\| 168unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE" 169 "Regular expression matching incorrect-password POP or IMAP server error 170messages. 171If you get an incorrect-password error that this expression does not match, 172please report it with \\[report-emacs-bug].") 173 174(defvar rmail-encoded-remote-password nil) 175 176(defcustom rmail-preserve-inbox nil 177 "*Non-nil means leave incoming mail in the user's inbox--don't delete it." 178 :type 'boolean 179 :group 'rmail-retrieve) 180 181(defcustom rmail-movemail-search-path nil 182 "*List of directories to search for movemail (in addition to `exec-path')." 183 :group 'rmail-retrieve 184 :type '(repeat (directory))) 185 186(defun rmail-probe (prog) 187 "Determine what flavor of movemail PROG is. 188We do this by executing it with `--version' and analyzing its output." 189 (with-temp-buffer 190 (let ((tbuf (current-buffer))) 191 (buffer-disable-undo tbuf) 192 (call-process prog nil tbuf nil "--version") 193 (if (not (buffer-modified-p tbuf)) 194 ;; Should not happen... 195 nil 196 (goto-char (point-min)) 197 (cond 198 ((looking-at ".*movemail: invalid option") 199 'emacs) ;; Possibly... 200 ((looking-at "movemail (GNU Mailutils .*)") 201 'mailutils) 202 (t 203 ;; FIXME: 204 'emacs)))))) 205 206(defun rmail-autodetect () 207 "Determine and return the file name of the `movemail' program. 208If `rmail-movemail-program' is non-nil, use it. 209Otherwise, look for `movemail' in the directories in 210`rmail-movemail-search-path', those in `exec-path', and `exec-directory'." 211 (if rmail-movemail-program 212 (rmail-probe rmail-movemail-program) 213 (catch 'scan 214 (dolist (dir (append rmail-movemail-search-path exec-path 215 (list exec-directory))) 216 (when (and dir (file-accessible-directory-p dir)) 217 (let ((progname (expand-file-name "movemail" dir))) 218 (when (and (not (file-directory-p progname)) 219 (file-executable-p progname)) 220 (let ((x (rmail-probe progname))) 221 (when x 222 (setq rmail-movemail-program progname) 223 (throw 'scan x)))))))))) 224 225(defvar rmail-movemail-variant-in-use nil 226 "The movemail variant currently in use. Known variants are: 227 228 `emacs' Means any implementation, compatible with the native Emacs one. 229 This is the default; 230 `mailutils' Means GNU mailutils implementation, capable of handling full 231mail URLs as the source mailbox;") 232 233;;;###autoload 234(defun rmail-movemail-variant-p (&rest variants) 235 "Return t if the current movemail variant is any of VARIANTS. 236Currently known variants are 'emacs and 'mailutils." 237 (when (not rmail-movemail-variant-in-use) 238 ;; Autodetect 239 (setq rmail-movemail-variant-in-use (rmail-autodetect))) 240 (not (null (member rmail-movemail-variant-in-use variants)))) 241 242;;;###autoload 243(defcustom rmail-dont-reply-to-names nil "\ 244*A regexp specifying addresses to prune from a reply message. 245A value of nil means exclude your own email address as an address 246plus whatever is specified by `rmail-default-dont-reply-to-names'." 247 :type '(choice regexp (const :tag "Your Name" nil)) 248 :group 'rmail-reply) 249 250;;;###autoload 251(defvar rmail-default-dont-reply-to-names "\\`info-" "\ 252A regular expression specifying part of the default value of the 253variable `rmail-dont-reply-to-names', for when the user does not set 254`rmail-dont-reply-to-names' explicitly. (The other part of the default 255value is the user's email address and name.) 256It is useful to set this variable in the site customization file.") 257 258;;;###autoload 259(defcustom rmail-ignored-headers 260 (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:" 261 "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" 262 "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" 263 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" 264 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" 265 "\\|^x-mailer:\\|^delivered-to:\\|^lines:" 266 "\\|^content-transfer-encoding:\\|^x-coding-system:" 267 "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" 268 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" 269 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" 270 "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent" 271 "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" 272 "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:" 273 "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" 274 275 "\\|^x-.*:") 276 "*Regexp to match header fields that Rmail should normally hide. 277\(See also `rmail-nonignored-headers', which overrides this regexp.) 278This variable is used for reformatting the message header, 279which normally happens once for each message, 280when you view the message for the first time in Rmail. 281To make a change in this variable take effect 282for a message that you have already viewed, 283go to that message and type \\[rmail-toggle-header] twice." 284 :type 'regexp 285 :group 'rmail-headers) 286 287(defcustom rmail-nonignored-headers "^x-spam-status:" 288 "*Regexp to match X header fields that Rmail should show. 289This regexp overrides `rmail-ignored-headers'; if both this regexp 290and that one match a certain header field, Rmail shows the field. 291 292This variable is used for reformatting the message header, 293which normally happens once for each message, 294when you view the message for the first time in Rmail. 295To make a change in this variable take effect 296for a message that you have already viewed, 297go to that message and type \\[rmail-toggle-header] twice." 298 :type 'regexp 299 :group 'rmail-headers) 300 301;;;###autoload 302(defcustom rmail-displayed-headers nil 303 "*Regexp to match Header fields that Rmail should display. 304If nil, display all header fields except those matched by 305`rmail-ignored-headers'." 306 :type '(choice regexp (const :tag "All")) 307 :group 'rmail-headers) 308 309;;;###autoload 310(defcustom rmail-retry-ignored-headers "^x-authentication-warning:" "\ 311*Headers that should be stripped when retrying a failed message." 312 :type '(choice regexp (const nil :tag "None")) 313 :group 'rmail-headers) 314 315;;;###autoload 316(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "\ 317*Regexp to match Header fields that Rmail should normally highlight. 318A value of nil means don't highlight. 319See also `rmail-highlight-face'." 320 :type 'regexp 321 :group 'rmail-headers) 322 323(defface rmail-highlight 324 '((t :default highlight)) 325 "Face to use for highlighting the most important header fields." 326 :group 'rmail-headers 327 :version "22.1") 328 329;;;###autoload 330(defcustom rmail-highlight-face 'rmail-highlight "\ 331*Face used by Rmail for highlighting headers." 332 :type '(choice (const :tag "Default" nil) 333 face) 334 :group 'rmail-headers) 335 336;;;###autoload 337(defcustom rmail-delete-after-output nil "\ 338*Non-nil means automatically delete a message that is copied to a file." 339 :type 'boolean 340 :group 'rmail-files) 341 342;;;###autoload 343(defcustom rmail-primary-inbox-list nil "\ 344*List of files which are inboxes for user's primary mail file `~/RMAIL'. 345nil means the default, which is (\"/usr/spool/mail/$USER\") 346\(the name varies depending on the operating system, 347and the value of the environment variable MAIL overrides it)." 348 ;; Don't use backquote here, because we don't want to need it 349 ;; at load time. 350 :type (list 'choice '(const :tag "Default" nil) 351 (list 'repeat ':value (list (or (getenv "MAIL") 352 (concat "/var/spool/mail/" 353 (getenv "USER")))) 354 'file)) 355 :group 'rmail-retrieve 356 :group 'rmail-files) 357 358;;;###autoload 359(defcustom rmail-mail-new-frame nil 360 "*Non-nil means Rmail makes a new frame for composing outgoing mail. 361This is handy if you want to preserve the window configuration of 362the frame where you have the RMAIL buffer displayed." 363 :type 'boolean 364 :group 'rmail-reply) 365 366;;;###autoload 367(defcustom rmail-secondary-file-directory "~/" 368 "*Directory for additional secondary Rmail files." 369 :type 'directory 370 :group 'rmail-files) 371;;;###autoload 372(defcustom rmail-secondary-file-regexp "\\.xmail$" 373 "*Regexp for which files are secondary Rmail files." 374 :type 'regexp 375 :group 'rmail-files) 376 377;;;###autoload 378(defcustom rmail-confirm-expunge 'y-or-n-p 379 "*Whether and how to ask for confirmation before expunging deleted messages." 380 :type '(choice (const :tag "No confirmation" nil) 381 (const :tag "Confirm with y-or-n-p" y-or-n-p) 382 (const :tag "Confirm with yes-or-no-p" yes-or-no-p)) 383 :version "21.1" 384 :group 'rmail-files) 385 386;;;###autoload 387(defvar rmail-mode-hook nil 388 "List of functions to call when Rmail is invoked.") 389 390;;;###autoload 391(defvar rmail-get-new-mail-hook nil 392 "List of functions to call when Rmail has retrieved new mail.") 393 394;;;###autoload 395(defcustom rmail-show-message-hook nil 396 "List of functions to call when Rmail displays a message." 397 :type 'hook 398 :options '(goto-address) 399 :group 'rmail) 400 401;;;###autoload 402(defvar rmail-quit-hook nil 403 "List of functions to call when quitting out of Rmail.") 404 405;;;###autoload 406(defvar rmail-delete-message-hook nil 407 "List of functions to call when Rmail deletes a message. 408When the hooks are called, the message has been marked deleted but is 409still the current message in the Rmail buffer.") 410 411;; These may be altered by site-init.el to match the format of mmdf files 412;; delimiting used on a given host (delim1 and delim2 from the config 413;; files). 414 415(defvar rmail-mmdf-delim1 "^\001\001\001\001\n" 416 "Regexp marking the start of an mmdf message.") 417(defvar rmail-mmdf-delim2 "^\001\001\001\001\n" 418 "Regexp marking the end of an mmdf message.") 419 420(defcustom rmail-message-filter nil 421 "If non-nil, a filter function for new messages in RMAIL. 422Called with region narrowed to the message, including headers, 423before obeying `rmail-ignored-headers'." 424 :group 'rmail-headers 425 :type '(choice (const nil) function)) 426 427(defcustom rmail-automatic-folder-directives nil 428 "List of directives specifying where to put a message. 429Each element of the list is of the form: 430 431 (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) 432 433Where FOLDERNAME is the name of a BABYL format folder to put the 434message. If any of the field regexp's are nil, then it is ignored. 435 436If FOLDERNAME is \"/dev/null\", it is deleted. 437If FOLDERNAME is nil then it is deleted, and skipped. 438 439FIELD is the plain text name of a field in the message, such as 440\"subject\" or \"from\". A FIELD of \"to\" will automatically include 441all text from the \"cc\" field as well. 442 443REGEXP is an expression to match in the preceeding specified FIELD. 444FIELD/REGEXP pairs continue in the list. 445 446examples: 447 (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com 448 (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS." 449 :group 'rmail 450 :version "21.1" 451 :type '(repeat (sexp :tag "Directive"))) 452 453(defvar rmail-reply-prefix "Re: " 454 "String to prepend to Subject line when replying to a message.") 455 456;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:". 457;; This pattern should catch all the common variants. 458;; rms: I deleted the change to delete tags in square brackets 459;; because they mess up RT tags. 460(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*" 461 "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") 462 463(defcustom rmail-display-summary nil 464 "*If non-nil, Rmail always displays the summary buffer." 465 :group 'rmail-summary 466 :type 'boolean) 467 468(defvar rmail-inbox-list nil) 469(put 'rmail-inbox-list 'permanent-local t) 470 471(defvar rmail-keywords nil) 472(put 'rmail-keywords 'permanent-local t) 473 474(defvar rmail-buffer nil 475 "The RMAIL buffer related to the current buffer. 476In an RMAIL buffer, this holds the RMAIL buffer itself. 477In a summary buffer, this holds the RMAIL buffer it is a summary for.") 478(put 'rmail-buffer 'permanent-local t) 479 480;; Message counters and markers. Deleted flags. 481 482(defvar rmail-current-message nil) 483(put 'rmail-current-message 'permanent-local t) 484 485(defvar rmail-total-messages nil) 486(put 'rmail-total-messages 'permanent-local t) 487 488(defvar rmail-message-vector nil) 489(put 'rmail-message-vector 'permanent-local t) 490 491(defvar rmail-deleted-vector nil) 492(put 'rmail-deleted-vector 'permanent-local t) 493 494(defvar rmail-msgref-vector nil 495 "In an Rmail buffer, a vector whose Nth element is a list (N). 496When expunging renumbers messages, these lists are modified 497by substituting the new message number into the existing list.") 498(put 'rmail-msgref-vector 'permanent-local t) 499 500(defvar rmail-overlay-list nil) 501(put 'rmail-overlay-list 'permanent-local t) 502 503;; These are used by autoloaded rmail-summary. 504 505(defvar rmail-summary-buffer nil) 506(put 'rmail-summary-buffer 'permanent-local t) 507(defvar rmail-summary-vector nil) 508(put 'rmail-summary-vector 'permanent-local t) 509 510(defvar rmail-view-buffer nil 511 "Buffer which holds RMAIL message for MIME displaying.") 512(put 'rmail-view-buffer 'permanent-local t) 513 514;; `Sticky' default variables. 515 516;; Last individual label specified to a or k. 517(defvar rmail-last-label nil) 518(put 'rmail-last-label 'permanent-local t) 519 520;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l. 521(defvar rmail-last-multi-labels nil) 522 523(defvar rmail-last-regexp nil) 524(put 'rmail-last-regexp 'permanent-local t) 525 526(defcustom rmail-default-file "~/xmail" 527 "*Default file name for \\[rmail-output]." 528 :type 'file 529 :group 'rmail-files) 530(defcustom rmail-default-rmail-file "~/XMAIL" 531 "*Default file name for \\[rmail-output-to-rmail-file]." 532 :type 'file 533 :group 'rmail-files) 534(defcustom rmail-default-body-file "~/mailout" 535 "*Default file name for \\[rmail-output-body-to-file]." 536 :type 'file 537 :group 'rmail-files 538 :version "20.3") 539 540;; Mule and MIME related variables. 541 542;;;###autoload 543(defvar rmail-file-coding-system nil 544 "Coding system used in RMAIL file. 545 546This is set to nil by default.") 547 548;;;###autoload 549(defcustom rmail-enable-mime nil 550 "*If non-nil, RMAIL uses MIME feature. 551If the value is t, RMAIL automatically shows MIME decoded message. 552If the value is neither t nor nil, RMAIL does not show MIME decoded message 553until a user explicitly requires it. 554 555Even if the value is non-nil, you can't use MIME feature 556if the feature specified by `rmail-mime-feature' is not available 557in your session." 558 :type '(choice (const :tag "on" t) 559 (const :tag "off" nil) 560 (other :tag "when asked" ask)) 561 :group 'rmail) 562 563(defvar rmail-enable-mime-composing nil 564 "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.") 565 566;;;###autoload 567(defvar rmail-show-mime-function nil 568 "Function to show MIME decoded message of RMAIL file. 569This function is called when `rmail-enable-mime' is non-nil. 570It is called with no argument.") 571 572;;;###autoload 573(defvar rmail-insert-mime-forwarded-message-function nil 574 "Function to insert a message in MIME format so it can be forwarded. 575This function is called if `rmail-enable-mime' or 576`rmail-enable-mime-composing' is non-nil. 577It is called with one argument FORWARD-BUFFER, which is a 578buffer containing the message to forward. The current buffer 579is the outgoing mail buffer.") 580 581;;;###autoload 582(defvar rmail-insert-mime-resent-message-function nil 583 "Function to insert a message in MIME format so it can be resent. 584This function is called if `rmail-enable-mime' is non-nil. 585It is called with one argument FORWARD-BUFFER, which is a 586buffer containing the message to forward. The current buffer 587is the outgoing mail buffer.") 588 589;;;###autoload 590(defvar rmail-search-mime-message-function nil 591 "Function to check if a regexp matches a MIME message. 592This function is called if `rmail-enable-mime' is non-nil. 593It is called with two arguments MSG and REGEXP, where 594MSG is the message number, REGEXP is the regular expression.") 595 596;;;###autoload 597(defvar rmail-search-mime-header-function nil 598 "Function to check if a regexp matches a header of MIME message. 599This function is called if `rmail-enable-mime' is non-nil. 600It is called with three arguments MSG, REGEXP, and LIMIT, where 601MSG is the message number, 602REGEXP is the regular expression, 603LIMIT is the position specifying the end of header.") 604 605;;;###autoload 606(defvar rmail-mime-feature 'rmail-mime 607 "Feature to require to load MIME support in Rmail. 608When starting Rmail, if `rmail-enable-mime' is non-nil, 609this feature is required with `require'. 610 611The default value is `rmail-mime'. This feature is provided by 612the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.") 613 614;;;###autoload 615(defvar rmail-decode-mime-charset t 616 "*Non-nil means a message is decoded by MIME's charset specification. 617If this variable is nil, or the message has not MIME specification, 618the message is decoded as normal way. 619 620If the variable `rmail-enable-mime' is non-nil, this variables is 621ignored, and all the decoding work is done by a feature specified by 622the variable `rmail-mime-feature'.") 623 624;;;###autoload 625(defvar rmail-mime-charset-pattern 626 (concat "^content-type:[ \t]*text/plain;" 627 "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" 628 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?") 629 "Regexp to match MIME-charset specification in a header of message. 630The first parenthesized expression should match the MIME-charset name.") 631 632 633;;; Regexp matching the delimiter of messages in UNIX mail format 634;;; (UNIX From lines), minus the initial ^. Note that if you change 635;;; this expression, you must change the code in rmail-nuke-pinhead-header 636;;; that knows the exact ordering of the \\( \\) subexpressions. 637(defvar rmail-unix-mail-delimiter 638 (let ((time-zone-regexp 639 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" 640 "\\|[-+]?[0-9][0-9][0-9][0-9]" 641 "\\|" 642 "\\) *"))) 643 (concat 644 "From " 645 646 ;; Many things can happen to an RFC 822 mailbox before it is put into 647 ;; a `From' line. The leading phrase can be stripped, e.g. 648 ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. 649 ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF 650 ;; can be removed, e.g. 651 ;; From: joe@y.z (Joe K 652 ;; User) 653 ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and 654 ;; From: Joe User 655 ;; <joe@y.z> 656 ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. 657 ;; The mailbox can be removed or be replaced by white space, e.g. 658 ;; From: "Joe User"{space}{tab} 659 ;; <joe@y.z> 660 ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', 661 ;; where {space} and {tab} represent the Ascii space and tab characters. 662 ;; We want to match the results of any of these manglings. 663 ;; The following regexp rejects names whose first characters are 664 ;; obviously bogus, but after that anything goes. 665 "\\([^\0-\b\n-\r\^?].*\\)? " 666 667 ;; The time the message was sent. 668 "\\([^\0-\r \^?]+\\) +" ; day of the week 669 "\\([^\0-\r \^?]+\\) +" ; month 670 "\\([0-3]?[0-9]\\) +" ; day of month 671 "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day 672 673 ;; Perhaps a time zone, specified by an abbreviation, or by a 674 ;; numeric offset. 675 time-zone-regexp 676 677 ;; The year. 678 " \\([0-9][0-9]+\\) *" 679 680 ;; On some systems the time zone can appear after the year, too. 681 time-zone-regexp 682 683 ;; Old uucp cruft. 684 "\\(remote from .*\\)?" 685 686 "\n")) 687 nil) 688 689(defvar rmail-font-lock-keywords 690 ;; These are all matched case-insensitively. 691 (eval-when-compile 692 (let* ((cite-chars "[>|}]") 693 (cite-prefix "a-z") 694 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) 695 (list '("^\\(From\\|Sender\\|Resent-From\\):" 696 . font-lock-function-name-face) 697 '("^Reply-To:.*$" . font-lock-function-name-face) 698 '("^Subject:" . font-lock-comment-face) 699 '("^X-Spam-Status:" . font-lock-keyword-face) 700 '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" 701 . font-lock-keyword-face) 702 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. 703 `(,cite-chars 704 (,(concat "\\=[ \t]*" 705 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" 706 "\\(" cite-chars "[ \t]*\\)\\)+\\)" 707 "\\(.*\\)") 708 (beginning-of-line) (end-of-line) 709 (1 font-lock-comment-delimiter-face nil t) 710 (5 font-lock-comment-face nil t))) 711 '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" 712 . font-lock-string-face)))) 713 "Additional expressions to highlight in Rmail mode.") 714 715;; Perform BODY in the summary buffer 716;; in such a way that its cursor is properly updated in its own window. 717(defmacro rmail-select-summary (&rest body) 718 `(let ((total rmail-total-messages)) 719 (if (rmail-summary-displayed) 720 (let ((window (selected-window))) 721 (save-excursion 722 (unwind-protect 723 (progn 724 (pop-to-buffer rmail-summary-buffer) 725 ;; rmail-total-messages is a buffer-local var 726 ;; in the rmail buffer. 727 ;; This way we make it available for the body 728 ;; even tho the rmail buffer is not current. 729 (let ((rmail-total-messages total)) 730 ,@body)) 731 (select-window window)))) 732 (save-excursion 733 (set-buffer rmail-summary-buffer) 734 (let ((rmail-total-messages total)) 735 ,@body))) 736 (rmail-maybe-display-summary))) 737 738;;;; *** Rmail Mode *** 739 740;; This variable is dynamically bound. The defvar is here to placate 741;; the byte compiler. 742 743(defvar rmail-enable-multibyte nil) 744 745 746(defun rmail-require-mime-maybe () 747 "Require `rmail-mime-feature' if that is non-nil. 748Signal an error and set `rmail-mime-feature' to nil if the feature 749isn't provided." 750 (when rmail-enable-mime 751 (condition-case err 752 (require rmail-mime-feature) 753 (error 754 (display-warning 755 :warning 756 (format "Although MIME support is requested 757by setting `rmail-enable-mime' to non-nil, the required feature 758`%s' (the value of `rmail-mime-feature') 759is not available in the current session. 760So, the MIME support is turned off for the moment." 761 rmail-mime-feature)) 762 (setq rmail-enable-mime nil))))) 763 764 765;;;###autoload 766(defun rmail (&optional file-name-arg) 767 "Read and edit incoming mail. 768Moves messages into file named by `rmail-file-name' (a babyl format file) 769 and edits that file in RMAIL Mode. 770Type \\[describe-mode] once editing that file, for a list of RMAIL commands. 771 772May be called with file name as argument; then performs rmail editing on 773that file, but does not copy any new mail into the file. 774Interactively, if you supply a prefix argument, then you 775have a chance to specify a file name with the minibuffer. 776 777If `rmail-display-summary' is non-nil, make a summary for this RMAIL file." 778 (interactive (if current-prefix-arg 779 (list (read-file-name "Run rmail on RMAIL file: ")))) 780 (rmail-require-mime-maybe) 781 (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) 782 ;; Use find-buffer-visiting, not get-file-buffer, for those users 783 ;; who have find-file-visit-truename set to t. 784 (existed (find-buffer-visiting file-name)) 785 ;; This binding is necessary because we must decide if we 786 ;; need code conversion while the buffer is unibyte 787 ;; (i.e. enable-multibyte-characters is nil). 788 (rmail-enable-multibyte 789 (if existed 790 (with-current-buffer existed enable-multibyte-characters) 791 (default-value 'enable-multibyte-characters))) 792 ;; Since the file may contain messages of different encodings 793 ;; at the tail (non-BYBYL part), we can't decode them at once 794 ;; on reading. So, at first, we read the file without text 795 ;; code conversion, then decode the messages one by one by 796 ;; rmail-decode-babyl-format or 797 ;; rmail-convert-to-babyl-format. 798 (coding-system-for-read (and rmail-enable-multibyte 'raw-text)) 799 run-mail-hook msg-shown) 800 ;; Like find-file, but in the case where a buffer existed 801 ;; and the file was reverted, recompute the message-data. 802 ;; We used to bind enable-local-variables to nil here, 803 ;; but that should not be needed now that rmail-mode 804 ;; sets it locally to nil. 805 ;; (Binding a variable locally with let is not safe if it has 806 ;; buffer-local bindings.) 807 (if (and existed (not (verify-visited-file-modtime existed))) 808 (progn 809 (find-file file-name) 810 (if (and (verify-visited-file-modtime existed) 811 (eq major-mode 'rmail-mode)) 812 (progn (rmail-forget-messages) 813 (rmail-set-message-counters)))) 814 (switch-to-buffer 815 (let ((enable-local-variables nil)) 816 (find-file-noselect file-name)))) 817 (if (eq major-mode 'rmail-edit-mode) 818 (error "Exit Rmail Edit mode before getting new mail")) 819 (if (and existed (> (buffer-size) 0)) 820 ;; Buffer not new and not empty; ensure in proper mode, but that's all. 821 (or (eq major-mode 'rmail-mode) 822 (progn (rmail-mode-2) 823 (setq run-mail-hook t))) 824 (setq run-mail-hook t) 825 (rmail-mode-2) 826 ;; Convert all or part to Babyl file if possible. 827 (rmail-convert-file) 828 (goto-char (point-max))) 829 ;; As we have read a file by raw-text, the buffer is set to 830 ;; unibyte. We must make it multibyte if necessary. 831 (if (and rmail-enable-multibyte 832 (not enable-multibyte-characters)) 833 (set-buffer-multibyte t)) 834 ;; If necessary, scan to find all the messages. 835 (rmail-maybe-set-message-counters) 836 (unwind-protect 837 (unless (and (not file-name-arg) 838 (rmail-get-new-mail)) 839 (rmail-show-message (rmail-first-unseen-message))) 840 (progn 841 (if rmail-display-summary (rmail-summary)) 842 (rmail-construct-io-menu) 843 (if run-mail-hook 844 (run-hooks 'rmail-mode-hook)))))) 845 846;; Given the value of MAILPATH, return a list of inbox file names. 847;; This is turned off because it is not clear that the user wants 848;; all these inboxes to feed into the primary rmail file. 849; (defun rmail-convert-mailpath (string) 850; (let (idx list) 851; (while (setq idx (string-match "[%:]" string)) 852; (let ((this (substring string 0 idx))) 853; (setq string (substring string (1+ idx))) 854; (setq list (cons (if (string-match "%" this) 855; (substring this 0 (string-match "%" this)) 856; this) 857; list)))) 858; list)) 859 860; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line 861; will not cause emacs 18.55 problems. 862 863;; This calls rmail-decode-babyl-format if the file is already Babyl. 864 865(defun rmail-convert-file () 866 (let (convert) 867 (widen) 868 (goto-char (point-min)) 869 ;; If file doesn't start like a Babyl file, 870 ;; convert it to one, by adding a header and converting each message. 871 (cond ((looking-at "BABYL OPTIONS:")) 872 ((looking-at "Version: 5\n") 873 ;; Losing babyl file made by old version of Rmail. 874 ;; Just fix the babyl file header; don't make a new one, 875 ;; so we don't lose the Labels: file attribute, etc. 876 (let ((buffer-read-only nil)) 877 (insert "BABYL OPTIONS: -*- rmail -*-\n"))) 878 ((equal (point-min) (point-max)) 879 ;; Empty RMAIL file. Just insert the header. 880 (rmail-insert-rmail-file-header)) 881 (t 882 ;; Non-empty file in non-RMAIL format. Add header and convert. 883 (setq convert t) 884 (rmail-insert-rmail-file-header))) 885 ;; If file was not a Babyl file or if there are 886 ;; Unix format messages added at the end, 887 ;; convert file as necessary. 888 (if (or convert 889 (save-excursion 890 (goto-char (point-max)) 891 (search-backward "\n\^_") 892 (forward-char 2) 893 (looking-at "\n*From "))) 894 (let ((buffer-read-only nil)) 895 (message "Converting to Babyl format...") 896 ;; If file needs conversion, convert it all, 897 ;; except for the BABYL header. 898 ;; (rmail-convert-to-babyl-format would delete the header.) 899 (goto-char (point-min)) 900 (search-forward "\n\^_" nil t) 901 (narrow-to-region (point) (point-max)) 902 (rmail-convert-to-babyl-format) 903 (message "Converting to Babyl format...done")) 904 (if (and (not rmail-enable-mime) 905 rmail-enable-multibyte) 906 ;; We still have to decode BABYL part. 907 (rmail-decode-babyl-format))))) 908 909(defun rmail-insert-rmail-file-header () 910 (let ((buffer-read-only nil)) 911 ;; -*-rmail-*- is here so that visiting the file normally 912 ;; recognizes it as an Rmail file. 913 (insert "BABYL OPTIONS: -*- rmail -*- 914Version: 5 915Labels: 916Note: This is the header of an rmail file. 917Note: If you are seeing it in rmail, 918Note: it means the file has no messages in it.\n\^_"))) 919 920;; Decode Babyl formatted part at the head of current buffer by 921;; rmail-file-coding-system, or if it is nil, do auto conversion. 922 923(defun rmail-decode-babyl-format () 924 (let ((modifiedp (buffer-modified-p)) 925 (buffer-read-only nil) 926 (coding-system rmail-file-coding-system) 927 from to) 928 (goto-char (point-min)) 929 (search-forward "\n\^_" nil t) ; Skip BABYL header. 930 (setq from (point)) 931 (goto-char (point-max)) 932 (search-backward "\n\^_" from 'mv) 933 (setq to (point)) 934 (unless (and coding-system 935 (coding-system-p coding-system)) 936 (setq coding-system 937 ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but 938 ;; earlier versions did that with the current buffer's encoding. 939 ;; So we want to favor detection of emacs-mule (whose normal 940 ;; priority is quite low), but still allow detection of other 941 ;; encodings if emacs-mule won't fit. The call to 942 ;; detect-coding-with-priority below achieves that. 943 (car (detect-coding-with-priority 944 from to 945 '((coding-category-emacs-mule . emacs-mule)))))) 946 (unless (memq coding-system 947 '(undecided undecided-unix)) 948 (set-buffer-modified-p t) ; avoid locking when decoding 949 (let ((buffer-undo-list t)) 950 (decode-coding-region from to coding-system)) 951 (setq coding-system last-coding-system-used)) 952 (set-buffer-modified-p modifiedp) 953 (setq buffer-file-coding-system nil) 954 (setq save-buffer-coding-system 955 (or coding-system 'undecided)))) 956 957(defvar rmail-mode-map nil) 958(if rmail-mode-map 959 nil 960 (setq rmail-mode-map (make-keymap)) 961 (suppress-keymap rmail-mode-map) 962 (define-key rmail-mode-map "a" 'rmail-add-label) 963 (define-key rmail-mode-map "b" 'rmail-bury) 964 (define-key rmail-mode-map "c" 'rmail-continue) 965 (define-key rmail-mode-map "d" 'rmail-delete-forward) 966 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward) 967 (define-key rmail-mode-map "e" 'rmail-edit-current-message) 968 (define-key rmail-mode-map "f" 'rmail-forward) 969 (define-key rmail-mode-map "g" 'rmail-get-new-mail) 970 (define-key rmail-mode-map "h" 'rmail-summary) 971 (define-key rmail-mode-map "i" 'rmail-input) 972 (define-key rmail-mode-map "j" 'rmail-show-message) 973 (define-key rmail-mode-map "k" 'rmail-kill-label) 974 (define-key rmail-mode-map "l" 'rmail-summary-by-labels) 975 (define-key rmail-mode-map "\e\C-h" 'rmail-summary) 976 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) 977 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) 978 (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp) 979 (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic) 980 (define-key rmail-mode-map "m" 'rmail-mail) 981 (define-key rmail-mode-map "\em" 'rmail-retry-failure) 982 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) 983 (define-key rmail-mode-map "\en" 'rmail-next-message) 984 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) 985 (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) 986 (define-key rmail-mode-map "\C-o" 'rmail-output) 987 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) 988 (define-key rmail-mode-map "\ep" 'rmail-previous-message) 989 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) 990 (define-key rmail-mode-map "q" 'rmail-quit) 991 (define-key rmail-mode-map "r" 'rmail-reply) 992;; I find I can't live without the default M-r command -- rms. 993;; (define-key rmail-mode-map "\er" 'rmail-search-backwards) 994 (define-key rmail-mode-map "s" 'rmail-expunge-and-save) 995 (define-key rmail-mode-map "\es" 'rmail-search) 996 (define-key rmail-mode-map "t" 'rmail-toggle-header) 997 (define-key rmail-mode-map "u" 'rmail-undelete-previous-message) 998 (define-key rmail-mode-map "w" 'rmail-output-body-to-file) 999 (define-key rmail-mode-map "x" 'rmail-expunge) 1000 (define-key rmail-mode-map "." 'rmail-beginning-of-message) 1001 (define-key rmail-mode-map "/" 'rmail-end-of-message) 1002 (define-key rmail-mode-map "<" 'rmail-first-message) 1003 (define-key rmail-mode-map ">" 'rmail-last-message) 1004 (define-key rmail-mode-map " " 'scroll-up) 1005 (define-key rmail-mode-map "\177" 'scroll-down) 1006 (define-key rmail-mode-map "?" 'describe-mode) 1007 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date) 1008 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject) 1009 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author) 1010 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient) 1011 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) 1012 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) 1013 (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) 1014 (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) 1015 (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) 1016 ) 1017 1018(define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) 1019 1020(define-key rmail-mode-map [menu-bar classify] 1021 (cons "Classify" (make-sparse-keymap "Classify"))) 1022 1023(define-key rmail-mode-map [menu-bar classify input-menu] 1024 nil) 1025 1026(define-key rmail-mode-map [menu-bar classify output-menu] 1027 nil) 1028 1029(define-key rmail-mode-map [menu-bar classify output-body] 1030 '("Output body to file..." . rmail-output-body-to-file)) 1031 1032(define-key rmail-mode-map [menu-bar classify output-inbox] 1033 '("Output (inbox)..." . rmail-output)) 1034 1035(define-key rmail-mode-map [menu-bar classify output] 1036 '("Output (Rmail)..." . rmail-output-to-rmail-file)) 1037 1038(define-key rmail-mode-map [menu-bar classify kill-label] 1039 '("Kill Label..." . rmail-kill-label)) 1040 1041(define-key rmail-mode-map [menu-bar classify add-label] 1042 '("Add Label..." . rmail-add-label)) 1043 1044(define-key rmail-mode-map [menu-bar summary] 1045 (cons "Summary" (make-sparse-keymap "Summary"))) 1046 1047(define-key rmail-mode-map [menu-bar summary senders] 1048 '("By Senders..." . rmail-summary-by-senders)) 1049 1050(define-key rmail-mode-map [menu-bar summary labels] 1051 '("By Labels..." . rmail-summary-by-labels)) 1052 1053(define-key rmail-mode-map [menu-bar summary recipients] 1054 '("By Recipients..." . rmail-summary-by-recipients)) 1055 1056(define-key rmail-mode-map [menu-bar summary topic] 1057 '("By Topic..." . rmail-summary-by-topic)) 1058 1059(define-key rmail-mode-map [menu-bar summary regexp] 1060 '("By Regexp..." . rmail-summary-by-regexp)) 1061 1062(define-key rmail-mode-map [menu-bar summary all] 1063 '("All" . rmail-summary)) 1064 1065(define-key rmail-mode-map [menu-bar mail] 1066 (cons "Mail" (make-sparse-keymap "Mail"))) 1067 1068(define-key rmail-mode-map [menu-bar mail rmail-get-new-mail] 1069 '("Get New Mail" . rmail-get-new-mail)) 1070 1071(define-key rmail-mode-map [menu-bar mail lambda] 1072 '("----")) 1073 1074(define-key rmail-mode-map [menu-bar mail continue] 1075 '("Continue" . rmail-continue)) 1076 1077(define-key rmail-mode-map [menu-bar mail resend] 1078 '("Re-send..." . rmail-resend)) 1079 1080(define-key rmail-mode-map [menu-bar mail forward] 1081 '("Forward" . rmail-forward)) 1082 1083(define-key rmail-mode-map [menu-bar mail retry] 1084 '("Retry" . rmail-retry-failure)) 1085 1086(define-key rmail-mode-map [menu-bar mail reply] 1087 '("Reply" . rmail-reply)) 1088 1089(define-key rmail-mode-map [menu-bar mail mail] 1090 '("Mail" . rmail-mail)) 1091 1092(define-key rmail-mode-map [menu-bar delete] 1093 (cons "Delete" (make-sparse-keymap "Delete"))) 1094 1095(define-key rmail-mode-map [menu-bar delete expunge/save] 1096 '("Expunge/Save" . rmail-expunge-and-save)) 1097 1098(define-key rmail-mode-map [menu-bar delete expunge] 1099 '("Expunge" . rmail-expunge)) 1100 1101(define-key rmail-mode-map [menu-bar delete undelete] 1102 '("Undelete" . rmail-undelete-previous-message)) 1103 1104(define-key rmail-mode-map [menu-bar delete delete] 1105 '("Delete" . rmail-delete-forward)) 1106 1107(define-key rmail-mode-map [menu-bar move] 1108 (cons "Move" (make-sparse-keymap "Move"))) 1109 1110(define-key rmail-mode-map [menu-bar move search-back] 1111 '("Search Back..." . rmail-search-backwards)) 1112 1113(define-key rmail-mode-map [menu-bar move search] 1114 '("Search..." . rmail-search)) 1115 1116(define-key rmail-mode-map [menu-bar move previous] 1117 '("Previous Nondeleted" . rmail-previous-undeleted-message)) 1118 1119(define-key rmail-mode-map [menu-bar move next] 1120 '("Next Nondeleted" . rmail-next-undeleted-message)) 1121 1122(define-key rmail-mode-map [menu-bar move last] 1123 '("Last" . rmail-last-message)) 1124 1125(define-key rmail-mode-map [menu-bar move first] 1126 '("First" . rmail-first-message)) 1127 1128(define-key rmail-mode-map [menu-bar move previous] 1129 '("Previous" . rmail-previous-message)) 1130 1131(define-key rmail-mode-map [menu-bar move next] 1132 '("Next" . rmail-next-message)) 1133 1134;; Rmail toolbar 1135(defvar rmail-tool-bar-map 1136 (if (display-graphic-p) 1137 (let ((map (make-sparse-keymap))) 1138 (tool-bar-local-item-from-menu 'rmail-get-new-mail "mail/inbox" 1139 map rmail-mode-map) 1140 (tool-bar-local-item-from-menu 'rmail-next-undeleted-message "right-arrow" 1141 map rmail-mode-map) 1142 (tool-bar-local-item-from-menu 'rmail-previous-undeleted-message "left-arrow" 1143 map rmail-mode-map) 1144 (tool-bar-local-item-from-menu 'rmail-search "search" 1145 map rmail-mode-map) 1146 (tool-bar-local-item-from-menu 'rmail-input "open" 1147 map rmail-mode-map) 1148 (tool-bar-local-item-from-menu 'rmail-mail "mail/compose" 1149 map rmail-mode-map) 1150 (tool-bar-local-item-from-menu 'rmail-reply "mail/reply-all" 1151 map rmail-mode-map) 1152 (tool-bar-local-item-from-menu 'rmail-forward "mail/forward" 1153 map rmail-mode-map) 1154 (tool-bar-local-item-from-menu 'rmail-delete-forward "close" 1155 map rmail-mode-map) 1156 (tool-bar-local-item-from-menu 'rmail-output "mail/move" 1157 map rmail-mode-map) 1158 (tool-bar-local-item-from-menu 'rmail-output-body-to-file "mail/save" 1159 map rmail-mode-map) 1160 (tool-bar-local-item-from-menu 'rmail-expunge "delete" 1161 map rmail-mode-map) 1162 map))) 1163 1164 1165 1166;; Rmail mode is suitable only for specially formatted data. 1167(put 'rmail-mode 'mode-class 'special) 1168 1169(defun rmail-mode-kill-summary () 1170 (if rmail-summary-buffer (kill-buffer rmail-summary-buffer))) 1171 1172;;;###autoload 1173(defun rmail-mode () 1174 "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files. 1175All normal editing commands are turned off. 1176Instead, these commands are available: 1177 1178\\[rmail-beginning-of-message] Move point to front of this message. 1179\\[rmail-end-of-message] Move point to bottom of this message. 1180\\[scroll-up] Scroll to next screen of this message. 1181\\[scroll-down] Scroll to previous screen of this message. 1182\\[rmail-next-undeleted-message] Move to Next non-deleted message. 1183\\[rmail-previous-undeleted-message] Move to Previous non-deleted message. 1184\\[rmail-next-message] Move to Next message whether deleted or not. 1185\\[rmail-previous-message] Move to Previous message whether deleted or not. 1186\\[rmail-first-message] Move to the first message in Rmail file. 1187\\[rmail-last-message] Move to the last message in Rmail file. 1188\\[rmail-show-message] Jump to message specified by numeric position in file. 1189\\[rmail-search] Search for string and show message it is found in. 1190\\[rmail-delete-forward] Delete this message, move to next nondeleted. 1191\\[rmail-delete-backward] Delete this message, move to previous nondeleted. 1192\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages 1193 till a deleted message is found. 1194\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail. 1195\\[rmail-expunge] Expunge deleted messages. 1196\\[rmail-expunge-and-save] Expunge and save the file. 1197\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer. 1198\\[save-buffer] Save without expunging. 1199\\[rmail-get-new-mail] Move new mail from system spool directory into this file. 1200\\[rmail-mail] Mail a message (same as \\[mail-other-window]). 1201\\[rmail-continue] Continue composing outgoing message started before. 1202\\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields. 1203\\[rmail-retry-failure] Send this message again. Used on a mailer failure message. 1204\\[rmail-forward] Forward this message to another user. 1205\\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it). 1206\\[rmail-output] Output this message to a Unix-format mail file (append it). 1207\\[rmail-output-body-to-file] Save message body to a file. Default filename comes from Subject line. 1208\\[rmail-input] Input Rmail file. Run Rmail on that file. 1209\\[rmail-add-label] Add label to message. It will be displayed in the mode line. 1210\\[rmail-kill-label] Kill label. Remove a label from current message. 1211\\[rmail-next-labeled-message] Move to Next message with specified label 1212 (label defaults to last one specified). 1213 Standard labels: filed, unseen, answered, forwarded, deleted. 1214 Any other label is present only if you add it with \\[rmail-add-label]. 1215\\[rmail-previous-labeled-message] Move to Previous message with specified label 1216\\[rmail-summary] Show headers buffer, with a one line summary of each message. 1217\\[rmail-summary-by-labels] Summarize only messages with particular label(s). 1218\\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s). 1219\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s). 1220\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s). 1221\\[rmail-toggle-header] Toggle display of complete header." 1222 (interactive) 1223 (let ((finding-rmail-file (not (eq major-mode 'rmail-mode)))) 1224 (rmail-mode-2) 1225 (when (and finding-rmail-file 1226 (null coding-system-for-read) 1227 default-enable-multibyte-characters) 1228 (let ((rmail-enable-multibyte t)) 1229 (rmail-require-mime-maybe) 1230 (rmail-convert-file) 1231 (goto-char (point-max)) 1232 (set-buffer-multibyte t))) 1233 (rmail-set-message-counters) 1234 (rmail-show-message rmail-total-messages) 1235 (when finding-rmail-file 1236 (when rmail-display-summary 1237 (rmail-summary)) 1238 (rmail-construct-io-menu)) 1239 (run-mode-hooks 'rmail-mode-hook))) 1240 1241(defun rmail-mode-2 () 1242 (kill-all-local-variables) 1243 (rmail-mode-1) 1244 (rmail-perm-variables) 1245 (rmail-variables)) 1246 1247(defun rmail-mode-1 () 1248 (setq major-mode 'rmail-mode) 1249 (setq mode-name "RMAIL") 1250 (setq buffer-read-only t) 1251 ;; No need to auto save RMAIL files in normal circumstances 1252 ;; because they contain no info except attribute changes 1253 ;; and deletion of messages. 1254 ;; The one exception is when messages are copied into an Rmail mode buffer. 1255 ;; rmail-output-to-rmail-file enables auto save when you do that. 1256 (setq buffer-auto-save-file-name nil) 1257 (setq mode-line-modified "--") 1258 (use-local-map rmail-mode-map) 1259 (set-syntax-table text-mode-syntax-table) 1260 (setq local-abbrev-table text-mode-abbrev-table)) 1261 1262;; Set up the permanent locals associated with an Rmail file. 1263(defun rmail-perm-variables () 1264 (make-local-variable 'rmail-last-label) 1265 (make-local-variable 'rmail-last-regexp) 1266 (make-local-variable 'rmail-deleted-vector) 1267 (make-local-variable 'rmail-buffer) 1268 (setq rmail-buffer (current-buffer)) 1269 (make-local-variable 'rmail-view-buffer) 1270 (setq rmail-view-buffer rmail-buffer) 1271 (make-local-variable 'rmail-summary-buffer) 1272 (make-local-variable 'rmail-summary-vector) 1273 (make-local-variable 'rmail-current-message) 1274 (make-local-variable 'rmail-total-messages) 1275 (make-local-variable 'rmail-overlay-list) 1276 (setq rmail-overlay-list nil) 1277 (make-local-variable 'rmail-message-vector) 1278 (make-local-variable 'rmail-msgref-vector) 1279 (make-local-variable 'rmail-inbox-list) 1280 (setq rmail-inbox-list (rmail-parse-file-inboxes)) 1281 ;; Provide default set of inboxes for primary mail file ~/RMAIL. 1282 (and (null rmail-inbox-list) 1283 (or (equal buffer-file-name (expand-file-name rmail-file-name)) 1284 (equal buffer-file-truename 1285 (abbreviate-file-name (file-truename rmail-file-name)))) 1286 (setq rmail-inbox-list 1287 (or rmail-primary-inbox-list 1288 (list (or (getenv "MAIL") 1289 (concat rmail-spool-directory 1290 (user-login-name))))))) 1291 (make-local-variable 'rmail-keywords) 1292 (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map) 1293 ;; this gets generated as needed 1294 (setq rmail-keywords nil)) 1295 1296;; Set up the non-permanent locals associated with Rmail mode. 1297(defun rmail-variables () 1298 (make-local-variable 'save-buffer-coding-system) 1299 ;; If we don't already have a value for save-buffer-coding-system, 1300 ;; get it from buffer-file-coding-system, and clear that 1301 ;; because it should be determined in rmail-show-message. 1302 (unless save-buffer-coding-system 1303 (setq save-buffer-coding-system (or buffer-file-coding-system 'undecided)) 1304 (setq buffer-file-coding-system nil)) 1305 ;; Don't let a local variables list in a message cause confusion. 1306 (make-local-variable 'local-enable-local-variables) 1307 (setq local-enable-local-variables nil) 1308 (make-local-variable 'revert-buffer-function) 1309 (setq revert-buffer-function 'rmail-revert) 1310 (make-local-variable 'font-lock-defaults) 1311 (setq font-lock-defaults 1312 '(rmail-font-lock-keywords 1313 t t nil nil 1314 (font-lock-maximum-size . nil) 1315 (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) 1316 (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) 1317 (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) 1318 (make-local-variable 'require-final-newline) 1319 (setq require-final-newline nil) 1320 (make-local-variable 'version-control) 1321 (setq version-control 'never) 1322 (make-local-variable 'kill-buffer-hook) 1323 (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) 1324 (make-local-variable 'file-precious-flag) 1325 (setq file-precious-flag t) 1326 (make-local-variable 'desktop-save-buffer) 1327 (setq desktop-save-buffer t)) 1328 1329;; Handle M-x revert-buffer done in an rmail-mode buffer. 1330(defun rmail-revert (arg noconfirm) 1331 (set-buffer rmail-buffer) 1332 (let* ((revert-buffer-function (default-value 'revert-buffer-function)) 1333 (rmail-enable-multibyte enable-multibyte-characters) 1334 ;; See similar code in `rmail'. 1335 (coding-system-for-read (and rmail-enable-multibyte 'raw-text))) 1336 ;; Call our caller again, but this time it does the default thing. 1337 (if (revert-buffer arg noconfirm) 1338 ;; If the user said "yes", and we changed something, 1339 ;; reparse the messages. 1340 (progn 1341 (set-buffer rmail-buffer) 1342 (rmail-mode-2) 1343 ;; Convert all or part to Babyl file if possible. 1344 (rmail-convert-file) 1345 ;; We have read the file as raw-text, so the buffer is set to 1346 ;; unibyte. Make it multibyte if necessary. 1347 (if (and rmail-enable-multibyte 1348 (not enable-multibyte-characters)) 1349 (set-buffer-multibyte t)) 1350 (goto-char (point-max)) 1351 (rmail-set-message-counters) 1352 (rmail-show-message rmail-total-messages) 1353 (run-hooks 'rmail-mode-hook))))) 1354 1355;; Return a list of files from this buffer's Mail: option. 1356;; Does not assume that messages have been parsed. 1357;; Just returns nil if buffer does not look like Babyl format. 1358(defun rmail-parse-file-inboxes () 1359 (save-excursion 1360 (save-restriction 1361 (widen) 1362 (goto-char 1) 1363 (cond ((looking-at "BABYL OPTIONS:") 1364 (search-forward "\n\^_" nil 'move) 1365 (narrow-to-region 1 (point)) 1366 (goto-char 1) 1367 (if (search-forward "\nMail:" nil t) 1368 (progn 1369 (narrow-to-region (point) (progn (end-of-line) (point))) 1370 (goto-char (point-min)) 1371 (mail-parse-comma-list)))))))) 1372 1373(defun rmail-expunge-and-save () 1374 "Expunge and save RMAIL file." 1375 (interactive) 1376 (rmail-expunge) 1377 (set-buffer rmail-buffer) 1378 (save-buffer) 1379 (if (rmail-summary-exists) 1380 (rmail-select-summary (set-buffer-modified-p nil)))) 1381 1382(defun rmail-quit () 1383 "Quit out of RMAIL. 1384Hook `rmail-quit-hook' is run after expunging." 1385 (interactive) 1386 (rmail-expunge-and-save) 1387 (when (boundp 'rmail-quit-hook) 1388 (run-hooks 'rmail-quit-hook)) 1389 ;; Don't switch to the summary buffer even if it was recently visible. 1390 (when rmail-summary-buffer 1391 (replace-buffer-in-windows rmail-summary-buffer) 1392 (bury-buffer rmail-summary-buffer)) 1393 (if rmail-enable-mime 1394 (let ((obuf rmail-buffer) 1395 (ovbuf rmail-view-buffer)) 1396 (set-buffer rmail-view-buffer) 1397 (quit-window) 1398 (replace-buffer-in-windows ovbuf) 1399 (replace-buffer-in-windows obuf) 1400 (bury-buffer obuf)) 1401 (let ((obuf (current-buffer))) 1402 (quit-window) 1403 (replace-buffer-in-windows obuf)))) 1404 1405(defun rmail-bury () 1406 "Bury current Rmail buffer and its summary buffer." 1407 (interactive) 1408 ;; This let var was called rmail-buffer, but that interfered 1409 ;; with the buffer-local var used in summary buffers. 1410 (let ((buffer-to-bury (current-buffer))) 1411 (if (rmail-summary-exists) 1412 (let (window) 1413 (while (setq window (get-buffer-window rmail-summary-buffer)) 1414 (quit-window nil window)) 1415 (bury-buffer rmail-summary-buffer))) 1416 (quit-window))) 1417 1418(defun rmail-duplicate-message () 1419 "Create a duplicated copy of the current message. 1420The duplicate copy goes into the Rmail file just after the 1421original copy." 1422 (interactive) 1423 (widen) 1424 (let ((buffer-read-only nil) 1425 (number rmail-current-message) 1426 (string (buffer-substring (rmail-msgbeg rmail-current-message) 1427 (rmail-msgend rmail-current-message)))) 1428 (goto-char (rmail-msgend rmail-current-message)) 1429 (insert string) 1430 (rmail-forget-messages) 1431 (rmail-show-message number) 1432 (message "Message duplicated"))) 1433 1434;;;###autoload 1435(defun rmail-input (filename) 1436 "Run Rmail on file FILENAME." 1437 (interactive "FRun rmail on RMAIL file: ") 1438 (rmail filename)) 1439 1440 1441;; This used to scan subdirectories recursively, but someone pointed out 1442;; that if the user wants that, person can put all the files in one dir. 1443;; And the recursive scan was slow. So I took it out. 1444;; rms, Sep 1996. 1445(defun rmail-find-all-files (start) 1446 "Return list of file in dir START that match `rmail-secondary-file-regexp'." 1447 (if (file-accessible-directory-p start) 1448 ;; Don't sort here. 1449 (let* ((case-fold-search t) 1450 (files (directory-files start t rmail-secondary-file-regexp))) 1451 ;; Sort here instead of in directory-files 1452 ;; because this list is usually much shorter. 1453 (sort files 'string<)))) 1454 1455(defun rmail-list-to-menu (menu-name l action &optional full-name) 1456 (let ((menu (make-sparse-keymap menu-name))) 1457 (mapcar 1458 (function (lambda (item) 1459 (let (command) 1460 (if (consp item) 1461 (progn 1462 (setq command 1463 (rmail-list-to-menu (car item) (cdr item) 1464 action 1465 (if full-name 1466 (concat full-name "/" 1467 (car item)) 1468 (car item)))) 1469 (setq name (car item))) 1470 (progn 1471 (setq name item) 1472 (setq command 1473 (list 'lambda () '(interactive) 1474 (list action 1475 (expand-file-name 1476 (if full-name 1477 (concat full-name "/" item) 1478 item) 1479 rmail-secondary-file-directory)))))) 1480 (define-key menu (vector (intern name)) 1481 (cons name command))))) 1482 (reverse l)) 1483 menu)) 1484 1485;; This command is always "disabled" when it appears in a menu. 1486(put 'rmail-disable-menu 'menu-enable ''nil) 1487 1488(defun rmail-construct-io-menu () 1489 (let ((files (rmail-find-all-files rmail-secondary-file-directory))) 1490 (if files 1491 (progn 1492 (define-key rmail-mode-map [menu-bar classify input-menu] 1493 (cons "Input Rmail File" 1494 (rmail-list-to-menu "Input Rmail File" 1495 files 1496 'rmail-input))) 1497 (define-key rmail-mode-map [menu-bar classify output-menu] 1498 (cons "Output Rmail File" 1499 (rmail-list-to-menu "Output Rmail File" 1500 files 1501 'rmail-output-to-rmail-file)))) 1502 1503 (define-key rmail-mode-map [menu-bar classify input-menu] 1504 '("Input Rmail File" . rmail-disable-menu)) 1505 (define-key rmail-mode-map [menu-bar classify output-menu] 1506 '("Output Rmail File" . rmail-disable-menu))))) 1507 1508 1509;;;; *** Rmail input *** 1510 1511;; RLK feature not added in this version: 1512;; argument specifies inbox file or files in various ways. 1513 1514(defun rmail-get-new-mail (&optional file-name) 1515 "Move any new mail from this RMAIL file's inbox files. 1516The inbox files can be specified with the file's Mail: option. The 1517variable `rmail-primary-inbox-list' specifies the inboxes for your 1518primary RMAIL file if it has no Mail: option. By default, this is 1519your /usr/spool/mail/$USER. 1520 1521You can also specify the file to get new mail from. In this case, the 1522file of new mail is not changed or deleted. Noninteractively, you can 1523pass the inbox file name as an argument. Interactively, a prefix 1524argument causes us to read a file name and use that file as the inbox. 1525 1526If the variable `rmail-preserve-inbox' is non-nil, new mail will 1527always be left in inbox files rather than deleted. 1528 1529This function runs `rmail-get-new-mail-hook' before saving the updated file. 1530It returns t if it got any new messages." 1531 (interactive 1532 (list (if current-prefix-arg 1533 (read-file-name "Get new mail from file: ")))) 1534 (run-hooks 'rmail-before-get-new-mail-hook) 1535 ;; If the disk file has been changed from under us, 1536 ;; revert to it before we get new mail. 1537 (or (verify-visited-file-modtime (current-buffer)) 1538 (find-file (buffer-file-name))) 1539 (set-buffer rmail-buffer) 1540 (rmail-maybe-set-message-counters) 1541 (widen) 1542 ;; Get rid of all undo records for this buffer. 1543 (or (eq buffer-undo-list t) 1544 (setq buffer-undo-list nil)) 1545 (let ((all-files (if file-name (list file-name) 1546 rmail-inbox-list)) 1547 (rmail-enable-multibyte (default-value 'enable-multibyte-characters)) 1548 found) 1549 (unwind-protect 1550 (progn 1551 (while all-files 1552 (let ((opoint (point)) 1553 (new-messages 0) 1554 (rsf-number-of-spam 0) 1555 (delete-files ()) 1556 ;; If buffer has not changed yet, and has not been saved yet, 1557 ;; don't replace the old backup file now. 1558 (make-backup-files (and make-backup-files (buffer-modified-p))) 1559 (buffer-read-only nil) 1560 ;; Don't make undo records for what we do in getting mail. 1561 (buffer-undo-list t) 1562 success 1563 ;; Files to insert this time around. 1564 files 1565 ;; Last names of those files. 1566 file-last-names) 1567 ;; Pull files off all-files onto files 1568 ;; as long as there is no name conflict. 1569 ;; A conflict happens when two inbox file names 1570 ;; have the same last component. 1571 (while (and all-files 1572 (not (member (file-name-nondirectory (car all-files)) 1573 file-last-names))) 1574 (setq files (cons (car all-files) files) 1575 file-last-names 1576 (cons (file-name-nondirectory (car all-files)) files)) 1577 (setq all-files (cdr all-files))) 1578 ;; Put them back in their original order. 1579 (setq files (nreverse files)) 1580 1581 (goto-char (point-max)) 1582 (skip-chars-backward " \t\n") ; just in case of brain damage 1583 (delete-region (point) (point-max)) ; caused by require-final-newline 1584 (save-excursion 1585 (save-restriction 1586 (narrow-to-region (point) (point)) 1587 ;; Read in the contents of the inbox files, 1588 ;; renaming them as necessary, 1589 ;; and adding to the list of files to delete eventually. 1590 (if file-name 1591 (rmail-insert-inbox-text files nil) 1592 (setq delete-files (rmail-insert-inbox-text files t))) 1593 ;; Scan the new text and convert each message to babyl format. 1594 (goto-char (point-min)) 1595 (unwind-protect 1596 (save-excursion 1597 (setq new-messages (rmail-convert-to-babyl-format) 1598 success t)) 1599 ;; Try to delete the garbage just inserted. 1600 (or success (delete-region (point-min) (point-max))) 1601 ;; If we could not convert the file's inboxes, 1602 ;; rename the files we tried to read 1603 ;; so we won't over and over again. 1604 (if (and (not file-name) (not success)) 1605 (let ((delfiles delete-files) 1606 (count 0)) 1607 (while delfiles 1608 (while (file-exists-p (format "RMAILOSE.%d" count)) 1609 (setq count (1+ count))) 1610 (rename-file (car delfiles) 1611 (format "RMAILOSE.%d" count)) 1612 (setq delfiles (cdr delfiles)))))) 1613 (or (zerop new-messages) 1614 (let (success) 1615 (widen) 1616 (search-backward "\n\^_" nil t) 1617 (narrow-to-region (point) (point-max)) 1618 (goto-char (1+ (point-min))) 1619 (rmail-count-new-messages) 1620 (run-hooks 'rmail-get-new-mail-hook) 1621 (save-buffer))) 1622 ;; Delete the old files, now that babyl file is saved. 1623 (while delete-files 1624 (condition-case () 1625 ;; First, try deleting. 1626 (condition-case () 1627 (delete-file (car delete-files)) 1628 (file-error 1629 ;; If we can't delete it, truncate it. 1630 (write-region (point) (point) (car delete-files)))) 1631 (file-error nil)) 1632 (setq delete-files (cdr delete-files))))) 1633 (if (= new-messages 0) 1634 (progn (goto-char opoint) 1635 (if (or file-name rmail-inbox-list) 1636 (message "(No new mail has arrived)"))) 1637 ;; check new messages to see if any of them is spam: 1638 (if (and (featurep 'rmail-spam-filter) 1639 rmail-use-spam-filter) 1640 (let* 1641 ((old-messages (- rmail-total-messages new-messages)) 1642 (rsf-scanned-message-number (1+ old-messages)) 1643 ;; save deletion flags of old messages: vector starts 1644 ;; at zero (is one longer that no of messages), 1645 ;; therefore take 1+ old-messages 1646 (save-deleted 1647 (substring rmail-deleted-vector 0 (1+ 1648 old-messages)))) 1649 ;; set all messages to undeleted 1650 (setq rmail-deleted-vector 1651 (make-string (1+ rmail-total-messages) ?\ )) 1652 (while (<= rsf-scanned-message-number 1653 rmail-total-messages) 1654 (progn 1655 (if (not (rmail-spam-filter rsf-scanned-message-number)) 1656 (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam))) 1657 ) 1658 (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)) 1659 )) 1660 (if (> rsf-number-of-spam 0) 1661 (progn 1662 (when (rmail-expunge-confirmed) 1663 (rmail-only-expunge t)) 1664 )) 1665 (setq rmail-deleted-vector 1666 (concat 1667 save-deleted 1668 (make-string (- rmail-total-messages old-messages) 1669 ?\ ))) 1670 )) 1671 (if (rmail-summary-exists) 1672 (rmail-select-summary 1673 (rmail-update-summary))) 1674 (message "%d new message%s read%s" 1675 new-messages (if (= 1 new-messages) "" "s") 1676 ;; print out a message on number of spam messages found: 1677 (if (and (featurep 'rmail-spam-filter) 1678 rmail-use-spam-filter 1679 (> rsf-number-of-spam 0)) 1680 (cond ((= 1 new-messages) 1681 ", and appears to be spam") 1682 ((= rsf-number-of-spam new-messages) 1683 ", and all appear to be spam") 1684 ((> rsf-number-of-spam 1) 1685 (format ", and %d appear to be spam" 1686 rsf-number-of-spam)) 1687 (t 1688 ", and 1 appears to be spam")) 1689 "")) 1690 (if (and (featurep 'rmail-spam-filter) 1691 rmail-use-spam-filter 1692 (> rsf-number-of-spam 0)) 1693 (progn (if rsf-beep (beep t)) 1694 (sleep-for rsf-sleep-after-message))) 1695 1696 ;; Move to the first new message 1697 ;; unless we have other unseen messages before it. 1698 (rmail-show-message (rmail-first-unseen-message)) 1699 (run-hooks 'rmail-after-get-new-mail-hook) 1700 (setq found t)))) 1701 found) 1702 ;; Don't leave the buffer screwed up if we get a disk-full error. 1703 (or found (rmail-show-message))))) 1704 1705(defun rmail-parse-url (file) 1706 "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) 1707WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the 1708actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to 1709a remote mailbox, PASSWORD is the password if it should be 1710supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD 1711is non-nil if the user has supplied the password interactively. 1712" 1713 (cond 1714 ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file) 1715 (let (got-password supplied-password 1716 (proto (match-string 1 file)) 1717 (user (match-string 3 file)) 1718 (pass (match-string 5 file)) 1719 (host (substring file (or (match-end 2) 1720 (+ 3 (match-end 1)))))) 1721 1722 (if (not pass) 1723 (when rmail-remote-password-required 1724 (setq got-password (not (rmail-have-password))) 1725 (setq supplied-password (rmail-get-remote-password 1726 (string-equal proto "imap"))))) 1727 1728 (if (rmail-movemail-variant-p 'emacs) 1729 (if (string-equal proto "pop") 1730 (list (concat "po:" user ":" host) 1731 t 1732 (or pass supplied-password) 1733 got-password) 1734 (error "Emacs movemail does not support %s protocol" proto)) 1735 (list file 1736 (or (string-equal proto "pop") (string-equal proto "imap")) 1737 supplied-password 1738 got-password)))) 1739 1740 ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file) 1741 (let (got-password supplied-password 1742 (proto "pop") 1743 (user (match-string 1 file)) 1744 (host (match-string 3 file))) 1745 1746 (when rmail-remote-password-required 1747 (setq got-password (not (rmail-have-password))) 1748 (setq supplied-password (rmail-get-remote-password nil))) 1749 1750 (list file "pop" supplied-password got-password))) 1751 1752 (t 1753 (list file nil nil nil)))) 1754 1755(defun rmail-insert-inbox-text (files renamep) 1756 ;; Detect a locked file now, so that we avoid moving mail 1757 ;; out of the real inbox file. (That could scare people.) 1758 (or (memq (file-locked-p buffer-file-name) '(nil t)) 1759 (error "RMAIL file %s is locked" 1760 (file-name-nondirectory buffer-file-name))) 1761 (let (file tofile delete-files movemail popmail got-password password) 1762 (while files 1763 ;; Handle remote mailbox names specially; don't expand as filenames 1764 ;; in case the userid contains a directory separator. 1765 (setq file (car files)) 1766 (let ((url-data (rmail-parse-url file))) 1767 (setq file (nth 0 url-data)) 1768 (setq popmail (nth 1 url-data)) 1769 (setq password (nth 2 url-data)) 1770 (setq got-password (nth 3 url-data))) 1771 1772 (if popmail 1773 (setq renamep t) 1774 (setq file (file-truename 1775 (substitute-in-file-name (expand-file-name file))))) 1776 (setq tofile (expand-file-name 1777 ;; Generate name to move to from inbox name, 1778 ;; in case of multiple inboxes that need moving. 1779 (concat ".newmail-" 1780 (file-name-nondirectory 1781 (if (memq system-type '(windows-nt cygwin)) 1782 ;; cannot have "po:" in file name 1783 (substring file 3) 1784 file))) 1785 ;; Use the directory of this rmail file 1786 ;; because it's a nuisance to use the homedir 1787 ;; if that is on a full disk and this rmail 1788 ;; file isn't. 1789 (file-name-directory 1790 (expand-file-name buffer-file-name)))) 1791 ;; Always use movemail to rename the file, 1792 ;; since there can be mailboxes in various directories. 1793 (if (not popmail) 1794 (progn 1795 ;; On some systems, /usr/spool/mail/foo is a directory 1796 ;; and the actual inbox is /usr/spool/mail/foo/foo. 1797 (if (file-directory-p file) 1798 (setq file (expand-file-name (user-login-name) 1799 file))))) 1800 (cond (popmail 1801 (message "Getting mail from the remote server ...")) 1802 ((and (file-exists-p tofile) 1803 (/= 0 (nth 7 (file-attributes tofile)))) 1804 (message "Getting mail from %s..." tofile)) 1805 ((and (file-exists-p file) 1806 (/= 0 (nth 7 (file-attributes file)))) 1807 (message "Getting mail from %s..." file))) 1808 ;; Set TOFILE if have not already done so, and 1809 ;; rename or copy the file FILE to TOFILE if and as appropriate. 1810 (cond ((not renamep) 1811 (setq tofile file)) 1812 ((or (file-exists-p tofile) (and (not popmail) 1813 (not (file-exists-p file)))) 1814 nil) 1815 (t 1816 (with-temp-buffer 1817 (let ((errors (current-buffer))) 1818 (buffer-disable-undo errors) 1819 (let ((args 1820 (append 1821 (list (or rmail-movemail-program 1822 (expand-file-name "movemail" 1823 exec-directory)) 1824 nil errors nil) 1825 (if rmail-preserve-inbox 1826 (list "-p") 1827 nil) 1828 (if (rmail-movemail-variant-p 'mailutils) 1829 (append (list "--emacs") rmail-movemail-flags) 1830 rmail-movemail-flags) 1831 (list file tofile) 1832 (if password (list password) nil)))) 1833 (apply 'call-process args)) 1834 (if (not (buffer-modified-p errors)) 1835 ;; No output => movemail won 1836 nil 1837 (set-buffer errors) 1838 (subst-char-in-region (point-min) (point-max) 1839 ?\n ?\ ) 1840 (goto-char (point-max)) 1841 (skip-chars-backward " \t") 1842 (delete-region (point) (point-max)) 1843 (goto-char (point-min)) 1844 (if (looking-at "movemail: ") 1845 (delete-region (point-min) (match-end 0))) 1846 (beep t) 1847 ;; If we just read the password, most likely it is 1848 ;; wrong. Otherwise, see if there is a specific 1849 ;; reason to think that the problem is a wrong passwd. 1850 (if (or got-password 1851 (re-search-forward rmail-remote-password-error 1852 nil t)) 1853 (rmail-set-remote-password nil)) 1854 1855 ;; If using Mailutils, remove initial error code 1856 ;; abbreviation 1857 (when (rmail-movemail-variant-p 'mailutils) 1858 (goto-char (point-min)) 1859 (when (looking-at "[A-Z][A-Z0-9_]*:") 1860 (delete-region (point-min) (match-end 0)))) 1861 1862 (message "movemail: %s" 1863 (buffer-substring (point-min) 1864 (point-max))) 1865 1866 (sit-for 3) 1867 nil))))) 1868 1869 ;; At this point, TOFILE contains the name to read: 1870 ;; Either the alternate name (if we renamed) 1871 ;; or the actual inbox (if not renaming). 1872 (if (file-exists-p tofile) 1873 (let ((coding-system-for-read 'no-conversion) 1874 size) 1875 (goto-char (point-max)) 1876 (setq size (nth 1 (insert-file-contents tofile))) 1877 (goto-char (point-max)) 1878 (or (= (preceding-char) ?\n) 1879 (zerop size) 1880 (insert ?\n)) 1881 (if (not (and rmail-preserve-inbox (string= file tofile))) 1882 (setq delete-files (cons tofile delete-files))))) 1883 (message "") 1884 (setq files (cdr files))) 1885 delete-files)) 1886 1887;; Decode the region specified by FROM and TO by CODING. 1888;; If CODING is nil or an invalid coding system, decode by `undecided'. 1889(defun rmail-decode-region (from to coding) 1890 (if (or (not coding) (not (coding-system-p coding))) 1891 (setq coding 'undecided)) 1892 ;; Use -dos decoding, to remove ^M characters left from base64 or 1893 ;; rogue qp-encoded text. 1894 (decode-coding-region from to 1895 (coding-system-change-eol-conversion coding 1)) 1896 ;; Don't reveal the fact we used -dos decoding, as users generally 1897 ;; will not expect the RMAIL buffer to use DOS EOL format. 1898 (setq buffer-file-coding-system 1899 (setq last-coding-system-used 1900 (coding-system-change-eol-conversion coding 0)))) 1901 1902;; the rmail-break-forwarded-messages feature is not implemented 1903(defun rmail-convert-to-babyl-format () 1904 (let ((count 0) start 1905 (case-fold-search nil) 1906 (buffer-undo-list t) 1907 (invalid-input-resync 1908 (function (lambda () 1909 (message "Invalid Babyl format in inbox!") 1910 (sit-for 3) 1911 ;; Try to get back in sync with a real message. 1912 (if (re-search-forward 1913 (concat rmail-mmdf-delim1 "\\|^From") nil t) 1914 (beginning-of-line) 1915 (goto-char (point-max))))))) 1916 (goto-char (point-min)) 1917 (save-restriction 1918 (while (not (eobp)) 1919 (setq start (point)) 1920 (cond ((looking-at "BABYL OPTIONS:");Babyl header 1921 (if (search-forward "\n\^_" nil t) 1922 ;; If we find the proper terminator, delete through there. 1923 (delete-region (point-min) (point)) 1924 (funcall invalid-input-resync) 1925 (delete-region (point-min) (point)))) 1926 ;; Babyl format message 1927 ((looking-at "\^L") 1928 (or (search-forward "\n\^_" nil t) 1929 (funcall invalid-input-resync)) 1930 (setq count (1+ count)) 1931 ;; Make sure there is no extra white space after the ^_ 1932 ;; at the end of the message. 1933 ;; Narrowing will make sure that whatever follows the junk 1934 ;; will be treated properly. 1935 (delete-region (point) 1936 (save-excursion 1937 (skip-chars-forward " \t\n") 1938 (point))) 1939 (save-excursion 1940 (let* ((header-end 1941 (progn 1942 (save-excursion 1943 (goto-char start) 1944 (forward-line 1) 1945 (if (looking-at "0") 1946 (forward-line 1) 1947 (forward-line 2)) 1948 (save-restriction 1949 (narrow-to-region (point) (point-max)) 1950 (rfc822-goto-eoh) 1951 (point))))) 1952 (case-fold-search t) 1953 (quoted-printable-header-field-end 1954 (save-excursion 1955 (goto-char start) 1956 (re-search-forward 1957 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" 1958 header-end t))) 1959 (base64-header-field-end 1960 (save-excursion 1961 (goto-char start) 1962 ;; Don't try to decode non-text data. 1963 (and (re-search-forward 1964 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" 1965 header-end t) 1966 (goto-char start) 1967 (re-search-forward 1968 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" 1969 header-end t))))) 1970 (if quoted-printable-header-field-end 1971 (save-excursion 1972 (unless 1973 (mail-unquote-printable-region header-end (point) nil t t) 1974 (message "Malformed MIME quoted-printable message")) 1975 ;; Change "quoted-printable" to "8bit", 1976 ;; to reflect the decoding we just did. 1977 (goto-char quoted-printable-header-field-end) 1978 (delete-region (point) (search-backward ":")) 1979 (insert ": 8bit"))) 1980 (if base64-header-field-end 1981 (save-excursion 1982 (when 1983 (condition-case nil 1984 (progn 1985 (base64-decode-region (1+ header-end) 1986 (- (point) 2)) 1987 t) 1988 (error nil)) 1989 ;; Change "base64" to "8bit", to reflect the 1990 ;; decoding we just did. 1991 (goto-char base64-header-field-end) 1992 (delete-region (point) (search-backward ":")) 1993 (insert ": 8bit")))) 1994 (setq last-coding-system-used nil) 1995 (or rmail-enable-mime 1996 (not rmail-enable-multibyte) 1997 (let ((mime-charset 1998 (if (and rmail-decode-mime-charset 1999 (save-excursion 2000 (goto-char start) 2001 (search-forward "\n\n" nil t) 2002 (let ((case-fold-search t)) 2003 (re-search-backward 2004 rmail-mime-charset-pattern 2005 start t)))) 2006 (intern (downcase (match-string 1)))))) 2007 (rmail-decode-region start (point) mime-charset))))) 2008 ;; Add an X-Coding-System: header if we don't have one. 2009 (save-excursion 2010 (goto-char start) 2011 (forward-line 1) 2012 (if (looking-at "0") 2013 (forward-line 1) 2014 (forward-line 2)) 2015 (or (save-restriction 2016 (narrow-to-region (point) (point-max)) 2017 (rfc822-goto-eoh) 2018 (goto-char (point-min)) 2019 (re-search-forward "^X-Coding-System:" nil t)) 2020 (insert "X-Coding-System: " 2021 (symbol-name last-coding-system-used) 2022 "\n"))) 2023 (narrow-to-region (point) (point-max)) 2024 (and (= 0 (% count 10)) 2025 (message "Converting to Babyl format...%d" count))) 2026 ;;*** MMDF format 2027 ((let ((case-fold-search t)) 2028 (looking-at rmail-mmdf-delim1)) 2029 (let ((case-fold-search t)) 2030 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") 2031 (re-search-forward rmail-mmdf-delim2 nil t) 2032 (replace-match "\^_")) 2033 (save-excursion 2034 (save-restriction 2035 (narrow-to-region start (1- (point))) 2036 (goto-char (point-min)) 2037 (while (search-forward "\n\^_" nil t); single char "\^_" 2038 (replace-match "\n^_")))); 2 chars: "^" and "_" 2039 (setq last-coding-system-used nil) 2040 (or rmail-enable-mime 2041 (not rmail-enable-multibyte) 2042 (decode-coding-region start (point) 'undecided)) 2043 (save-excursion 2044 (goto-char start) 2045 (forward-line 3) 2046 (insert "X-Coding-System: " 2047 (symbol-name last-coding-system-used) 2048 "\n")) 2049 (narrow-to-region (point) (point-max)) 2050 (setq count (1+ count)) 2051 (and (= 0 (% count 10)) 2052 (message "Converting to Babyl format...%d" count))) 2053 ;;*** Mail format 2054 ((looking-at "^From ") 2055 (insert "\^L\n0, unseen,,\n*** EOOH ***\n") 2056 (rmail-nuke-pinhead-header) 2057 ;; If this message has a Content-Length field, 2058 ;; skip to the end of the contents. 2059 (let* ((header-end (save-excursion 2060 (and (re-search-forward "\n\n" nil t) 2061 (1- (point))))) 2062 (case-fold-search t) 2063 (quoted-printable-header-field-end 2064 (save-excursion 2065 (re-search-forward 2066 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" 2067 header-end t))) 2068 (base64-header-field-end 2069 (and 2070 ;; Don't decode non-text data. 2071 (save-excursion 2072 (re-search-forward 2073 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" 2074 header-end t)) 2075 (save-excursion 2076 (re-search-forward 2077 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" 2078 header-end t)))) 2079 (size 2080 ;; Get the numeric value from the Content-Length field. 2081 (save-excursion 2082 ;; Back up to end of prev line, 2083 ;; in case the Content-Length field comes first. 2084 (forward-char -1) 2085 (and (search-forward "\ncontent-length: " 2086 header-end t) 2087 (let ((beg (point)) 2088 (eol (progn (end-of-line) (point)))) 2089 (string-to-number (buffer-substring beg eol))))))) 2090 (and size 2091 (if (and (natnump size) 2092 (<= (+ header-end size) (point-max)) 2093 ;; Make sure this would put us at a position 2094 ;; that we could continue from. 2095 (save-excursion 2096 (goto-char (+ header-end size)) 2097 (skip-chars-forward "\n") 2098 (or (eobp) 2099 (and (looking-at "BABYL OPTIONS:") 2100 (search-forward "\n\^_" nil t)) 2101 (and (looking-at "\^L") 2102 (search-forward "\n\^_" nil t)) 2103 (let ((case-fold-search t)) 2104 (looking-at rmail-mmdf-delim1)) 2105 (looking-at "From ")))) 2106 (goto-char (+ header-end size)) 2107 (message "Ignoring invalid Content-Length field") 2108 (sit-for 1 0 t))) 2109 (if (let ((case-fold-search nil)) 2110 (re-search-forward 2111 (concat "^[\^_]?\\(" 2112 rmail-unix-mail-delimiter 2113 "\\|" 2114 rmail-mmdf-delim1 "\\|" 2115 "^BABYL OPTIONS:\\|" 2116 "\^L\n[01],\\)") nil t)) 2117 (goto-char (match-beginning 1)) 2118 (goto-char (point-max))) 2119 (setq count (1+ count)) 2120 (if quoted-printable-header-field-end 2121 (save-excursion 2122 (unless 2123 (mail-unquote-printable-region header-end (point) nil t t) 2124 (message "Malformed MIME quoted-printable message")) 2125 ;; Change "quoted-printable" to "8bit", 2126 ;; to reflect the decoding we just did. 2127 (goto-char quoted-printable-header-field-end) 2128 (delete-region (point) (search-backward ":")) 2129 (insert ": 8bit"))) 2130 (if base64-header-field-end 2131 (save-excursion 2132 (when 2133 (condition-case nil 2134 (progn 2135 (base64-decode-region 2136 (1+ header-end) 2137 (save-excursion 2138 ;; Prevent base64-decode-region 2139 ;; from removing newline characters. 2140 (skip-chars-backward "\n\t ") 2141 (point))) 2142 t) 2143 (error nil)) 2144 ;; Change "base64" to "8bit", to reflect the 2145 ;; decoding we just did. 2146 (goto-char base64-header-field-end) 2147 (delete-region (point) (search-backward ":")) 2148 (insert ": 8bit"))))) 2149 2150 (save-excursion 2151 (save-restriction 2152 (narrow-to-region start (point)) 2153 (goto-char (point-min)) 2154 (while (search-forward "\n\^_" nil t); single char 2155 (replace-match "\n^_")))); 2 chars: "^" and "_" 2156 ;; This is for malformed messages that don't end in newline. 2157 ;; There shouldn't be any, but some users say occasionally 2158 ;; there are some. 2159 (or (bolp) (newline)) 2160 (insert ?\^_) 2161 (setq last-coding-system-used nil) 2162 (or rmail-enable-mime 2163 (not rmail-enable-multibyte) 2164 (let ((mime-charset 2165 (if (and rmail-decode-mime-charset 2166 (save-excursion 2167 (goto-char start) 2168 (search-forward "\n\n" nil t) 2169 (let ((case-fold-search t)) 2170 (re-search-backward 2171 rmail-mime-charset-pattern 2172 start t)))) 2173 (intern (downcase (match-string 1)))))) 2174 (rmail-decode-region start (point) mime-charset))) 2175 (save-excursion 2176 (goto-char start) 2177 (forward-line 3) 2178 (insert "X-Coding-System: " 2179 (symbol-name last-coding-system-used) 2180 "\n")) 2181 (narrow-to-region (point) (point-max)) 2182 (and (= 0 (% count 10)) 2183 (message "Converting to Babyl format...%d" count))) 2184 ;; 2185 ;; This kludge is because some versions of sendmail.el 2186 ;; insert an extra newline at the beginning that shouldn't 2187 ;; be there. sendmail.el has been fixed, but old versions 2188 ;; may still be in use. -- rms, 7 May 1993. 2189 ((eolp) (delete-char 1)) 2190 (t (error "Cannot convert to babyl format"))))) 2191 (setq buffer-undo-list nil) 2192 count)) 2193 2194;; Delete the "From ..." line, creating various other headers with 2195;; information from it if they don't already exist. Now puts the 2196;; original line into a mail-from: header line for debugging and for 2197;; use by the rmail-output function. 2198(defun rmail-nuke-pinhead-header () 2199 (save-excursion 2200 (save-restriction 2201 (let ((start (point)) 2202 (end (progn 2203 (condition-case () 2204 (search-forward "\n\n") 2205 (error 2206 (goto-char (point-max)) 2207 (insert "\n\n"))) 2208 (point))) 2209 has-from has-date) 2210 (narrow-to-region start end) 2211 (let ((case-fold-search t)) 2212 (goto-char start) 2213 (setq has-from (search-forward "\nFrom:" nil t)) 2214 (goto-char start) 2215 (setq has-date (and (search-forward "\nDate:" nil t) (point))) 2216 (goto-char start)) 2217 (let ((case-fold-search nil)) 2218 (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) 2219 (replace-match 2220 (concat 2221 "Mail-from: \\&" 2222 ;; Keep and reformat the date if we don't 2223 ;; have a Date: field. 2224 (if has-date 2225 "" 2226 (concat 2227 "Date: \\2, \\4 \\3 \\9 \\5 " 2228 2229 ;; The timezone could be matched by group 7 or group 10. 2230 ;; If neither of them matched, assume EST, since only 2231 ;; Easterners would be so sloppy. 2232 ;; It's a shame the substitution can't use "\\10". 2233 (cond 2234 ((/= (match-beginning 7) (match-end 7)) "\\7") 2235 ((/= (match-beginning 10) (match-end 10)) 2236 (buffer-substring (match-beginning 10) 2237 (match-end 10))) 2238 (t "EST")) 2239 "\n")) 2240 ;; Keep and reformat the sender if we don't 2241 ;; have a From: field. 2242 (if has-from 2243 "" 2244 "From: \\1\n")) 2245 t))))))) 2246 2247;;;; *** Rmail Message Formatting and Header Manipulation *** 2248 2249(defun rmail-reformat-message (beg end) 2250 (goto-char beg) 2251 (forward-line 1) 2252 (if (/= (following-char) ?0) 2253 (error "Bad format in RMAIL file")) 2254 (let ((inhibit-read-only t) 2255 (delta (- (buffer-size) end))) 2256 (delete-char 1) 2257 (insert ?1) 2258 (forward-line 1) 2259 (let ((case-fold-search t)) 2260 (while (looking-at "Summary-line:\\|Mail-From:") 2261 (forward-line 1))) 2262 (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") 2263 (delete-region (point) 2264 (progn (forward-line 1) (point)))) 2265 (let ((str (buffer-substring (point) 2266 (save-excursion (search-forward "\n\n" end 'move) 2267 (point))))) 2268 (insert str "*** EOOH ***\n") 2269 (narrow-to-region (point) (- (buffer-size) delta))) 2270 (goto-char (point-min)) 2271 (if rmail-message-filter (funcall rmail-message-filter)) 2272 (if (or rmail-displayed-headers rmail-ignored-headers) 2273 (rmail-clear-headers)))) 2274 2275(defun rmail-clear-headers (&optional ignored-headers) 2276 "Delete all header fields that Rmail should not show. 2277If the optional argument IGNORED-HEADERS is non-nil, 2278delete all header fields whose names match that regexp. 2279Otherwise, if `rmail-displayed-headers' is non-nil, 2280delete all header fields *except* those whose names match that regexp. 2281Otherwise, delete all header fields whose names match `rmail-ignored-headers' 2282unless they also match `rmail-nonignored-headers'." 2283 (when (search-forward "\n\n" nil t) 2284 (forward-char -1) 2285 (let ((case-fold-search t) 2286 (buffer-read-only nil)) 2287 (if (and rmail-displayed-headers (null ignored-headers)) 2288 (save-restriction 2289 (narrow-to-region (point-min) (point)) 2290 (let (lim next) 2291 (goto-char (point-min)) 2292 (while (and (not (eobp)) 2293 (save-excursion 2294 (if (re-search-forward "\n[^ \t]" nil t) 2295 (setq lim (match-beginning 0) 2296 next (1+ lim)) 2297 (setq lim nil next (point-max))))) 2298 (if (save-excursion 2299 (re-search-forward rmail-displayed-headers lim t)) 2300 (goto-char next) 2301 (delete-region (point) next)))) 2302 (goto-char (point-min))) 2303 (or ignored-headers (setq ignored-headers rmail-ignored-headers)) 2304 (save-restriction 2305 (narrow-to-region (point-min) (point)) 2306 (goto-char (point-min)) 2307 (while (and ignored-headers 2308 (re-search-forward ignored-headers nil t)) 2309 (beginning-of-line) 2310 (if (looking-at rmail-nonignored-headers) 2311 (forward-line 1) 2312 (delete-region (point) 2313 (save-excursion 2314 (if (re-search-forward "\n[^ \t]" nil t) 2315 (1- (point)) 2316 (point-max))))))))))) 2317 2318(defun rmail-msg-is-pruned () 2319 (rmail-maybe-set-message-counters) 2320 (save-restriction 2321 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) 2322 (save-excursion 2323 (goto-char (point-min)) 2324 (forward-line 1) 2325 (= (following-char) ?1)))) 2326 2327(defun rmail-msg-restore-non-pruned-header () 2328 (let ((old-point (point)) 2329 new-point 2330 new-start 2331 (inhibit-read-only t)) 2332 (save-excursion 2333 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) 2334 (goto-char (point-min)) 2335 (forward-line 1) 2336 ;; Change 1 to 0. 2337 (delete-char 1) 2338 (insert ?0) 2339 ;; Insert new EOOH line at the proper place. 2340 (forward-line 1) 2341 (let ((case-fold-search t)) 2342 (while (looking-at "Summary-Line:\\|Mail-From:") 2343 (forward-line 1))) 2344 (insert "*** EOOH ***\n") 2345 (setq new-start (point)) 2346 ;; Delete the old reformatted header. 2347 (forward-char -1) 2348 (search-forward "\n*** EOOH ***\n") 2349 (forward-line -1) 2350 (let ((start (point))) 2351 (search-forward "\n\n") 2352 (if (and (<= start old-point) 2353 (<= old-point (point))) 2354 (setq new-point new-start)) 2355 (delete-region start (point))) 2356 ;; Narrow to after the new EOOH line. 2357 (narrow-to-region new-start (point-max))) 2358 (if new-point 2359 (goto-char new-point)))) 2360 2361(defun rmail-msg-prune-header () 2362 (let ((new-point 2363 (= (point) (point-min)))) 2364 (save-excursion 2365 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) 2366 (rmail-reformat-message (point-min) (point-max))) 2367 (if new-point 2368 (goto-char (point-min))))) 2369 2370(defun rmail-toggle-header (&optional arg) 2371 "Show original message header if pruned header currently shown, or vice versa. 2372With argument ARG, show the message header pruned if ARG is greater than zero; 2373otherwise, show it in full." 2374 (interactive "P") 2375 (let* ((pruned (with-current-buffer rmail-buffer 2376 (rmail-msg-is-pruned))) 2377 (prune (if arg 2378 (> (prefix-numeric-value arg) 0) 2379 (not pruned)))) 2380 (if (eq pruned prune) 2381 t 2382 (set-buffer rmail-buffer) 2383 (rmail-maybe-set-message-counters) 2384 (if rmail-enable-mime 2385 (let ((buffer-read-only nil)) 2386 (if pruned 2387 (rmail-msg-restore-non-pruned-header) 2388 (rmail-msg-prune-header)) 2389 (funcall rmail-show-mime-function)) 2390 (let* ((buffer-read-only nil) 2391 (window (get-buffer-window (current-buffer))) 2392 (at-point-min (= (point) (point-min))) 2393 (all-headers-visible (= (window-start window) (point-min))) 2394 (on-header 2395 (save-excursion 2396 (and (not (search-backward "\n\n" nil t)) 2397 (progn 2398 (end-of-line) 2399 (re-search-backward "^[-A-Za-z0-9]+:" nil t)) 2400 (match-string 0)))) 2401 (old-screen-line 2402 (rmail-count-screen-lines (window-start window) (point)))) 2403 (if pruned 2404 (rmail-msg-restore-non-pruned-header) 2405 (rmail-msg-prune-header)) 2406 (cond (at-point-min 2407 (goto-char (point-min))) 2408 (on-header 2409 (goto-char (point-min)) 2410 (search-forward "\n\n") 2411 (or (re-search-backward 2412 (concat "^" (regexp-quote on-header)) nil t) 2413 (goto-char (point-min)))) 2414 (t 2415 (save-selected-window 2416 (select-window window) 2417 (recenter old-screen-line) 2418 (if (and all-headers-visible 2419 (not (= (window-start) (point-min)))) 2420 (recenter (- (window-height) 2)))))))) 2421 (rmail-highlight-headers)))) 2422 2423(defun rmail-narrow-to-non-pruned-header () 2424 "Narrow to the whole (original) header of the current message." 2425 (let (start end) 2426 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) 2427 (goto-char (point-min)) 2428 (forward-line 1) 2429 (if (= (following-char) ?1) 2430 (progn 2431 (forward-line 1) 2432 (setq start (point)) 2433 (search-forward "*** EOOH ***\n") 2434 (setq end (match-beginning 0))) 2435 (forward-line 2) 2436 (setq start (point)) 2437 (search-forward "\n\n") 2438 (setq end (1- (point)))) 2439 (narrow-to-region start end) 2440 (goto-char start))) 2441 2442;; Lifted from repos-count-screen-lines. 2443;; Return number of screen lines between START and END. 2444(defun rmail-count-screen-lines (start end) 2445 (save-excursion 2446 (save-restriction 2447 (narrow-to-region start end) 2448 (goto-char (point-min)) 2449 (vertical-motion (- (point-max) (point-min)))))) 2450 2451;;;; *** Rmail Attributes and Keywords *** 2452 2453;; Make a string describing current message's attributes and keywords 2454;; and set it up as the name of a minor mode 2455;; so it will appear in the mode line. 2456(defun rmail-display-labels () 2457 (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) 2458 (save-excursion 2459 (unwind-protect 2460 (progn 2461 (widen) 2462 (goto-char (rmail-msgbeg rmail-current-message)) 2463 (forward-line 1) 2464 (if (looking-at "[01],") 2465 (progn 2466 (narrow-to-region (point) (progn (end-of-line) (point))) 2467 ;; Truly valid BABYL format requires a space before each 2468 ;; attribute or keyword name. Put them in if missing. 2469 (let (buffer-read-only) 2470 (goto-char (point-min)) 2471 (while (search-forward "," nil t) 2472 (or (looking-at "[ ,]") (eobp) 2473 (insert " ")))) 2474 (goto-char (point-max)) 2475 (if (search-backward ",," nil 'move) 2476 (progn 2477 (if (> (point) (1+ (point-min))) 2478 (setq blurb (buffer-substring (+ 1 (point-min)) (point)))) 2479 (if (> (- (point-max) (point)) 2) 2480 (setq blurb 2481 (concat blurb 2482 ";" 2483 (buffer-substring (+ (point) 3) 2484 (1- (point-max))))))))))) 2485 ;; Note: we don't use save-restriction because that does not work right 2486 ;; if changes are made outside the saved restriction 2487 ;; before that restriction is restored. 2488 (narrow-to-region beg end) 2489 (set-marker beg nil) 2490 (set-marker end nil))) 2491 (while (string-match " +," blurb) 2492 (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," 2493 (substring blurb (match-end 0))))) 2494 (while (string-match ", +" blurb) 2495 (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," 2496 (substring blurb (match-end 0))))) 2497 (setq mode-line-process 2498 (format " %d/%d%s" 2499 rmail-current-message rmail-total-messages blurb)) 2500 ;; If rmail-enable-mime is non-nil, we may have to update 2501 ;; `mode-line-process' of rmail-view-buffer too. 2502 (if (and rmail-enable-mime 2503 (not (eq (current-buffer) rmail-view-buffer)) 2504 (buffer-live-p rmail-view-buffer)) 2505 (let ((mlp mode-line-process)) 2506 (with-current-buffer rmail-view-buffer 2507 (setq mode-line-process mlp)))))) 2508 2509;; Turn an attribute of a message on or off according to STATE. 2510;; ATTR is the name of the attribute, as a string. 2511;; MSGNUM is message number to change; nil means current message. 2512(defun rmail-set-attribute (attr state &optional msgnum) 2513 (set-buffer rmail-buffer) 2514 (let ((omax (point-max-marker)) 2515 (omin (point-min-marker)) 2516 (buffer-read-only nil)) 2517 (or msgnum (setq msgnum rmail-current-message)) 2518 (if (> msgnum 0) 2519 (unwind-protect 2520 (save-excursion 2521 (widen) 2522 (goto-char (+ 3 (rmail-msgbeg msgnum))) 2523 (let ((curstate 2524 (not 2525 (null (search-backward (concat ", " attr ",") 2526 (prog1 (point) (end-of-line)) t))))) 2527 (or (eq curstate (not (not state))) 2528 (if curstate 2529 (delete-region (point) (1- (match-end 0))) 2530 (beginning-of-line) 2531 (forward-char 2) 2532 (insert " " attr ",")))) 2533 (if (string= attr "deleted") 2534 (rmail-set-message-deleted-p msgnum state))) 2535 ;; Note: we don't use save-restriction because that does not work right 2536 ;; if changes are made outside the saved restriction 2537 ;; before that restriction is restored. 2538 (narrow-to-region omin omax) 2539 (set-marker omin nil) 2540 (set-marker omax nil) 2541 (if (= msgnum rmail-current-message) 2542 (rmail-display-labels)))))) 2543 2544;; Return t if the attributes/keywords line of msg number MSG 2545;; contains a match for the regexp LABELS. 2546(defun rmail-message-labels-p (msg labels) 2547 (save-excursion 2548 (save-restriction 2549 (widen) 2550 (goto-char (rmail-msgbeg msg)) 2551 (forward-char 3) 2552 (re-search-backward labels (prog1 (point) (end-of-line)) t)))) 2553 2554;;;; *** Rmail Message Selection And Support *** 2555 2556(defun rmail-msgend (n) 2557 (marker-position (aref rmail-message-vector (1+ n)))) 2558 2559(defun rmail-msgbeg (n) 2560 (marker-position (aref rmail-message-vector n))) 2561 2562(defun rmail-widen-to-current-msgbeg (function) 2563 "Call FUNCTION with point at start of internal data of current message. 2564Assumes that bounds were previously narrowed to display the message in Rmail. 2565The bounds are widened enough to move point where desired, then narrowed 2566again afterward. 2567 2568FUNCTION may not change the visible text of the message, but it may 2569change the invisible header text." 2570 (save-excursion 2571 (unwind-protect 2572 (progn 2573 (narrow-to-region (rmail-msgbeg rmail-current-message) 2574 (point-max)) 2575 (goto-char (point-min)) 2576 (funcall function)) 2577 ;; Note: we don't use save-restriction because that does not work right 2578 ;; if changes are made outside the saved restriction 2579 ;; before that restriction is restored. 2580 (narrow-to-region (rmail-msgbeg rmail-current-message) 2581 (rmail-msgend rmail-current-message))))) 2582 2583(defun rmail-forget-messages () 2584 (unwind-protect 2585 (if (vectorp rmail-message-vector) 2586 (let* ((i 0) 2587 (v rmail-message-vector) 2588 (n (length v))) 2589 (while (< i n) 2590 (move-marker (aref v i) nil) 2591 (setq i (1+ i))))) 2592 (setq rmail-message-vector nil) 2593 (setq rmail-msgref-vector nil) 2594 (setq rmail-deleted-vector nil))) 2595 2596(defun rmail-maybe-set-message-counters () 2597 (if (not (and rmail-deleted-vector 2598 rmail-message-vector 2599 rmail-current-message 2600 rmail-total-messages)) 2601 (rmail-set-message-counters))) 2602 2603(defun rmail-count-new-messages (&optional nomsg) 2604 (let* ((case-fold-search nil) 2605 (total-messages 0) 2606 (messages-head nil) 2607 (deleted-head nil)) 2608 (or nomsg (message "Counting new messages...")) 2609 (goto-char (point-max)) 2610 ;; Put at the end of messages-head 2611 ;; the entry for message N+1, which marks 2612 ;; the end of message N. (N = number of messages). 2613 (search-backward "\n\^_") 2614 (forward-char 1) 2615 (setq messages-head (list (point-marker))) 2616 (rmail-set-message-counters-counter (point-min)) 2617 (setq rmail-current-message (1+ rmail-total-messages)) 2618 (setq rmail-total-messages 2619 (+ rmail-total-messages total-messages)) 2620 (setq rmail-message-vector 2621 (vconcat rmail-message-vector (cdr messages-head))) 2622 (aset rmail-message-vector 2623 rmail-current-message (car messages-head)) 2624 (setq rmail-deleted-vector 2625 (concat rmail-deleted-vector deleted-head)) 2626 (setq rmail-summary-vector 2627 (vconcat rmail-summary-vector (make-vector total-messages nil))) 2628 (setq rmail-msgref-vector 2629 (vconcat rmail-msgref-vector (make-vector total-messages nil))) 2630 ;; Fill in the new elements of rmail-msgref-vector. 2631 (let ((i (1+ (- rmail-total-messages total-messages)))) 2632 (while (<= i rmail-total-messages) 2633 (aset rmail-msgref-vector i (list i)) 2634 (setq i (1+ i)))) 2635 (goto-char (point-min)) 2636 (or nomsg (message "Counting new messages...done (%d)" total-messages)))) 2637 2638(defun rmail-set-message-counters () 2639 (rmail-forget-messages) 2640 (save-excursion 2641 (save-restriction 2642 (widen) 2643 (let* ((point-save (point)) 2644 (total-messages 0) 2645 (messages-after-point) 2646 (case-fold-search nil) 2647 (messages-head nil) 2648 (deleted-head nil)) 2649 (message "Counting messages...") 2650 (goto-char (point-max)) 2651 ;; Put at the end of messages-head 2652 ;; the entry for message N+1, which marks 2653 ;; the end of message N. (N = number of messages). 2654 (search-backward "\n\^_" nil t) 2655 (if (/= (point) (point-max)) (forward-char 1)) 2656 (setq messages-head (list (point-marker))) 2657 (rmail-set-message-counters-counter (min (point) point-save)) 2658 (setq messages-after-point total-messages) 2659 (rmail-set-message-counters-counter) 2660 (setq rmail-total-messages total-messages) 2661 (setq rmail-current-message 2662 (min total-messages 2663 (max 1 (- total-messages messages-after-point)))) 2664 (setq rmail-message-vector 2665 (apply 'vector (cons (point-min-marker) messages-head)) 2666 rmail-deleted-vector (concat "0" deleted-head) 2667 rmail-summary-vector (make-vector rmail-total-messages nil) 2668 rmail-msgref-vector (make-vector (1+ rmail-total-messages) nil)) 2669 (let ((i 0)) 2670 (while (<= i rmail-total-messages) 2671 (aset rmail-msgref-vector i (list i)) 2672 (setq i (1+ i)))) 2673 (message "Counting messages...done"))))) 2674 2675(defun rmail-set-message-counters-counter (&optional stop) 2676 (let ((start (point)) 2677 next) 2678 (while (search-backward "\n\^_\^L" stop t) 2679 ;; Detect messages that have been added with DOS line endings and 2680 ;; convert the line endings for such messages. 2681 (setq next (point)) 2682 (if (looking-at "\n\^_\^L\r\n") 2683 (let ((buffer-read-only nil) 2684 (buffer-undo t)) 2685 (message "Counting messages...(converting line endings)") 2686 (save-excursion 2687 (goto-char start) 2688 (while (search-backward "\r\n" next t) 2689 (delete-char 1))))) 2690 (setq start next) 2691 (forward-char 1) 2692 (setq messages-head (cons (point-marker) messages-head)) 2693 (save-excursion 2694 (setq deleted-head 2695 (cons (if (search-backward ", deleted," 2696 (prog1 (point) 2697 (forward-line 2)) 2698 t) 2699 ?D ?\ ) 2700 deleted-head))) 2701 (if (zerop (% (setq total-messages (1+ total-messages)) 20)) 2702 (message "Counting messages...%d" total-messages))))) 2703 2704(defun rmail-beginning-of-message () 2705 "Show current message starting from the beginning." 2706 (interactive) 2707 (let ((rmail-show-message-hook 2708 (list (function (lambda () 2709 (goto-char (point-min))))))) 2710 (rmail-show-message rmail-current-message))) 2711 2712(defun rmail-end-of-message () 2713 "Show bottom of current message." 2714 (interactive) 2715 (let ((rmail-show-message-hook 2716 (list (function (lambda () 2717 (goto-char (point-max)) 2718 (recenter (1- (window-height)))))))) 2719 (rmail-show-message rmail-current-message))) 2720 2721(defun rmail-unknown-mail-followup-to () 2722 "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. 2723Ask the user whether to add that list name to `mail-mailing-lists'." 2724 (save-restriction 2725 (rmail-narrow-to-non-pruned-header) 2726 (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) 2727 (when mail-followup-to 2728 (let ((addresses 2729 (split-string 2730 (mail-strip-quoted-names mail-followup-to) 2731 ",[[:space:]]+" t))) 2732 (dolist (addr addresses) 2733 (when (and (not (member addr mail-mailing-lists)) 2734 (not 2735 ;; taken from rmailsum.el 2736 (string-match 2737 (or rmail-user-mail-address-regexp 2738 (concat "^\\(" 2739 (regexp-quote (user-login-name)) 2740 "\\($\\|@\\)\\|" 2741 (regexp-quote 2742 (or user-mail-address 2743 (concat (user-login-name) "@" 2744 (or mail-host-address 2745 (system-name))))) 2746 "\\>\\)")) 2747 addr)) 2748 (y-or-n-p 2749 (format "Add `%s' to `mail-mailing-lists'? " 2750 addr))) 2751 (customize-save-variable 'mail-mailing-lists 2752 (cons addr mail-mailing-lists))))))))) 2753 2754(defun rmail-show-message (&optional n no-summary) 2755 "Show message number N (prefix argument), counting from start of file. 2756If summary buffer is currently displayed, update current message there also." 2757 (interactive "p") 2758 (or (eq major-mode 'rmail-mode) 2759 (switch-to-buffer rmail-buffer)) 2760 (rmail-maybe-set-message-counters) 2761 (widen) 2762 (if (zerop rmail-total-messages) 2763 (progn (narrow-to-region (point-min) (1- (point-max))) 2764 (goto-char (point-min)) 2765 (setq mode-line-process nil)) 2766 (let (blurb coding-system) 2767 (if (not n) 2768 (setq n rmail-current-message) 2769 (cond ((<= n 0) 2770 (setq n 1 2771 rmail-current-message 1 2772 blurb "No previous message")) 2773 ((> n rmail-total-messages) 2774 (setq n rmail-total-messages 2775 rmail-current-message rmail-total-messages 2776 blurb "No following message")) 2777 (t 2778 (setq rmail-current-message n)))) 2779 (let ((beg (rmail-msgbeg n))) 2780 (goto-char beg) 2781 (forward-line 1) 2782 (save-excursion 2783 (let ((end (rmail-msgend n))) 2784 (save-restriction 2785 (if (prog1 (= (following-char) ?0) 2786 (forward-line 2) 2787 ;; If there's a Summary-line in the (otherwise empty) 2788 ;; header, we didn't yet get past the EOOH line. 2789 (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") 2790 (forward-line 1)) 2791 (narrow-to-region (point) end)) 2792 (rfc822-goto-eoh) 2793 (search-forward "\n*** EOOH ***\n" end t)) 2794 (narrow-to-region beg (point)) 2795 (goto-char (point-min)) 2796 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) 2797 (let ((coding-system (intern (match-string 1)))) 2798 (condition-case nil 2799 (progn 2800 (check-coding-system coding-system) 2801 (setq buffer-file-coding-system coding-system)) 2802 (error 2803 (setq buffer-file-coding-system nil)))) 2804 (setq buffer-file-coding-system nil))))) 2805 ;; Clear the "unseen" attribute when we show a message. 2806 (rmail-set-attribute "unseen" nil) 2807 (let ((end (rmail-msgend n))) 2808 ;; Reformat the header, or else find the reformatted header. 2809 (if (= (following-char) ?0) 2810 (rmail-reformat-message beg end) 2811 (search-forward "\n*** EOOH ***\n" end t) 2812 (narrow-to-region (point) end))) 2813 (goto-char (point-min)) 2814 (walk-windows 2815 (function (lambda (window) 2816 (if (eq (window-buffer window) (current-buffer)) 2817 (set-window-point window (point))))) 2818 nil t) 2819 (rmail-display-labels) 2820 (if (eq rmail-enable-mime t) 2821 (funcall rmail-show-mime-function) 2822 (setq rmail-view-buffer rmail-buffer)) 2823 (when mail-mailing-lists 2824 (rmail-unknown-mail-followup-to)) 2825 (rmail-highlight-headers) 2826 (if transient-mark-mode (deactivate-mark)) 2827 (run-hooks 'rmail-show-message-hook) 2828 ;; If there is a summary buffer, try to move to this message 2829 ;; in that buffer. But don't complain if this message 2830 ;; is not mentioned in the summary. 2831 ;; Don't do this at all if we were called on behalf 2832 ;; of cursor motion in the summary buffer. 2833 (and (rmail-summary-exists) (not no-summary) 2834 (let ((curr-msg rmail-current-message)) 2835 (rmail-select-summary 2836 (rmail-summary-goto-msg curr-msg t t)))) 2837 (with-current-buffer rmail-buffer 2838 (rmail-auto-file)) 2839 (if blurb 2840 (message blurb)))))) 2841 2842(defun rmail-redecode-body (coding &optional raw) 2843 "Decode the body of the current message using coding system CODING. 2844This is useful with mail messages that have malformed or missing 2845charset= headers. 2846 2847This function assumes that the current message is already decoded 2848and displayed in the RMAIL buffer, but the coding system used to 2849decode it was incorrect. It then encodes the message back to its 2850original form, and decodes it again, using the coding system CODING. 2851 2852Optional argument RAW, if non-nil, means don't encode the message 2853before decoding it with the new CODING. This is useful if the current 2854message text was produced by some function which invokes `insert', 2855since `insert' leaves unibyte character codes 128 through 255 unconverted 2856to multibyte. One example of such a situation is when the text was 2857produced by `base64-decode-region'. 2858 2859Interactively, invoke the function with a prefix argument to set RAW 2860non-nil. 2861 2862Note that if Emacs erroneously auto-detected one of the iso-2022 2863encodings in the message, this function might fail because the escape 2864sequences that switch between character sets and also single-shift and 2865locking-shift codes are impossible to recover. This function is meant 2866to be used to fix messages encoded with 8-bit encodings, such as 2867iso-8859, koi8-r, etc." 2868 (interactive "zCoding system for re-decoding this message: ") 2869 (when (not rmail-enable-mime) 2870 (or (eq major-mode 'rmail-mode) 2871 (switch-to-buffer rmail-buffer)) 2872 (save-excursion 2873 (let ((pruned (rmail-msg-is-pruned)) 2874 (raw (or raw current-prefix-arg))) 2875 (unwind-protect 2876 (let ((msgbeg (rmail-msgbeg rmail-current-message)) 2877 (msgend (rmail-msgend rmail-current-message)) 2878 x-coding-header) 2879 ;; We need the message headers pruned (we later restore 2880 ;; the pruned stat to what it was, see the end of 2881 ;; unwind-protect form). 2882 (or pruned 2883 (rmail-toggle-header 1)) 2884 (narrow-to-region msgbeg msgend) 2885 (goto-char (point-min)) 2886 (when (search-forward "\n*** EOOH ***\n" (point-max) t) 2887 (narrow-to-region msgbeg (point))) 2888 (goto-char (point-min)) 2889 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) 2890 (let ((old-coding (intern (match-string 1))) 2891 (buffer-read-only nil)) 2892 (check-coding-system old-coding) 2893 ;; Make sure the new coding system uses the same EOL 2894 ;; conversion, to prevent ^M characters from popping 2895 ;; up all over the place. 2896 (setq coding 2897 (coding-system-change-eol-conversion 2898 coding 2899 (coding-system-eol-type old-coding))) 2900 ;; If old-coding is `undecided', encode-coding-region 2901 ;; will not encode the text at all. Find a proper 2902 ;; non-trivial encoding to use. 2903 (if (memq (coding-system-base old-coding) '(nil undecided)) 2904 (setq old-coding 2905 (car (find-coding-systems-region msgbeg msgend)))) 2906 (setq x-coding-header (point-marker)) 2907 (narrow-to-region msgbeg msgend) 2908 (and (null raw) 2909 ;; If old and new encoding are the same, it 2910 ;; clearly doesn't make sense to encode. 2911 (not (coding-system-equal 2912 (coding-system-base old-coding) 2913 (coding-system-base coding))) 2914 ;; If the body includes only eight-bit-* 2915 ;; characters, encoding might fail, e.g. with 2916 ;; UTF-8, and isn't needed anyway. 2917 (> (length (delq 'ascii 2918 (delq 'eight-bit-graphic 2919 (delq 'eight-bit-control 2920 (find-charset-region 2921 msgbeg msgend))))) 2922 0) 2923 (encode-coding-region (point) msgend old-coding)) 2924 (decode-coding-region (point) msgend coding) 2925 (setq last-coding-system-used coding) 2926 ;; Rewrite the coding-system header according 2927 ;; to what we did. 2928 (goto-char x-coding-header) 2929 (delete-region (point) 2930 (save-excursion 2931 (beginning-of-line) 2932 (point))) 2933 (insert "X-Coding-System: " 2934 (symbol-name last-coding-system-used)) 2935 (set-marker x-coding-header nil) 2936 (rmail-show-message)) 2937 (error "No X-Coding-System header found"))) 2938 (or pruned 2939 (rmail-toggle-header 0))))))) 2940 2941;; Find all occurrences of certain fields, and highlight them. 2942(defun rmail-highlight-headers () 2943 ;; Do this only if the system supports faces. 2944 (if (and (fboundp 'internal-find-face) 2945 rmail-highlighted-headers) 2946 (save-excursion 2947 (search-forward "\n\n" nil 'move) 2948 (save-restriction 2949 (narrow-to-region (point-min) (point)) 2950 (let ((case-fold-search t) 2951 (inhibit-read-only t) 2952 ;; Highlight with boldface if that is available. 2953 ;; Otherwise use the `highlight' face. 2954 (face (or rmail-highlight-face 2955 (if (face-differs-from-default-p 'bold) 2956 'bold 'highlight))) 2957 ;; List of overlays to reuse. 2958 (overlays rmail-overlay-list)) 2959 (goto-char (point-min)) 2960 (while (re-search-forward rmail-highlighted-headers nil t) 2961 (skip-chars-forward " \t") 2962 (let ((beg (point)) 2963 overlay) 2964 (while (progn (forward-line 1) 2965 (looking-at "[ \t]"))) 2966 ;; Back up over newline, then trailing spaces or tabs 2967 (forward-char -1) 2968 (while (member (preceding-char) '(? ?\t)) 2969 (forward-char -1)) 2970 (if overlays 2971 ;; Reuse an overlay we already have. 2972 (progn 2973 (setq overlay (car overlays) 2974 overlays (cdr overlays)) 2975 (overlay-put overlay 'face face) 2976 (move-overlay overlay beg (point))) 2977 ;; Make a new overlay and add it to 2978 ;; rmail-overlay-list. 2979 (setq overlay (make-overlay beg (point))) 2980 (overlay-put overlay 'face face) 2981 (setq rmail-overlay-list 2982 (cons overlay rmail-overlay-list)))))))))) 2983 2984(defun rmail-auto-file () 2985 "Automatically move a message into a sub-folder based on criteria. 2986Called when a new message is displayed." 2987 (if (or (rmail-message-labels-p rmail-current-message "filed") 2988 (not (string= (buffer-file-name) 2989 (expand-file-name rmail-file-name)))) 2990 ;; Do nothing if it's already been filed. 2991 nil 2992 ;; Find out some basics (common fields) 2993 (let ((from (mail-fetch-field "from")) 2994 (subj (mail-fetch-field "subject")) 2995 (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) 2996 (d rmail-automatic-folder-directives) 2997 (directive-loop nil) 2998 (folder nil)) 2999 (while d 3000 (setq folder (car (car d)) 3001 directive-loop (cdr (car d))) 3002 (while (and (car directive-loop) 3003 (let ((f (cond 3004 ((string= (car directive-loop) "from") from) 3005 ((string= (car directive-loop) "to") to) 3006 ((string= (car directive-loop) "subject") subj) 3007 (t (mail-fetch-field (car directive-loop)))))) 3008 (and f (string-match (car (cdr directive-loop)) f)))) 3009 (setq directive-loop (cdr (cdr directive-loop)))) 3010 ;; If there are no directives left, then it was a complete match. 3011 (if (null directive-loop) 3012 (if (null folder) 3013 (rmail-delete-forward) 3014 (if (string= "/dev/null" folder) 3015 (rmail-delete-message) 3016 (rmail-output-to-rmail-file folder 1 t) 3017 (setq d nil)))) 3018 (setq d (cdr d)))))) 3019 3020(defun rmail-next-message (n) 3021 "Show following message whether deleted or not. 3022With prefix arg N, moves forward N messages, or backward if N is negative." 3023 (interactive "p") 3024 (set-buffer rmail-buffer) 3025 (rmail-maybe-set-message-counters) 3026 (rmail-show-message (+ rmail-current-message n))) 3027 3028(defun rmail-previous-message (n) 3029 "Show previous message whether deleted or not. 3030With prefix arg N, moves backward N messages, or forward if N is negative." 3031 (interactive "p") 3032 (rmail-next-message (- n))) 3033 3034(defun rmail-next-undeleted-message (n) 3035 "Show following non-deleted message. 3036With prefix arg N, moves forward N non-deleted messages, 3037or backward if N is negative. 3038 3039Returns t if a new message is being shown, nil otherwise." 3040 (interactive "p") 3041 (set-buffer rmail-buffer) 3042 (rmail-maybe-set-message-counters) 3043 (let ((lastwin rmail-current-message) 3044 (current rmail-current-message)) 3045 (while (and (> n 0) (< current rmail-total-messages)) 3046 (setq current (1+ current)) 3047 (if (not (rmail-message-deleted-p current)) 3048 (setq lastwin current n (1- n)))) 3049 (while (and (< n 0) (> current 1)) 3050 (setq current (1- current)) 3051 (if (not (rmail-message-deleted-p current)) 3052 (setq lastwin current n (1+ n)))) 3053 (if (/= lastwin rmail-current-message) 3054 (progn (rmail-show-message lastwin) 3055 t) 3056 (if (< n 0) 3057 (message "No previous nondeleted message")) 3058 (if (> n 0) 3059 (message "No following nondeleted message")) 3060 nil))) 3061 3062(defun rmail-previous-undeleted-message (n) 3063 "Show previous non-deleted message. 3064With prefix argument N, moves backward N non-deleted messages, 3065or forward if N is negative." 3066 (interactive "p") 3067 (rmail-next-undeleted-message (- n))) 3068 3069(defun rmail-first-message () 3070 "Show first message in file." 3071 (interactive) 3072 (rmail-maybe-set-message-counters) 3073 (rmail-show-message 1)) 3074 3075(defun rmail-last-message () 3076 "Show last message in file." 3077 (interactive) 3078 (rmail-maybe-set-message-counters) 3079 (rmail-show-message rmail-total-messages)) 3080 3081(defun rmail-what-message () 3082 (let ((where (point)) 3083 (low 1) 3084 (high rmail-total-messages) 3085 (mid (/ rmail-total-messages 2))) 3086 (while (> (- high low) 1) 3087 (if (>= where (rmail-msgbeg mid)) 3088 (setq low mid) 3089 (setq high mid)) 3090 (setq mid (+ low (/ (- high low) 2)))) 3091 (if (>= where (rmail-msgbeg high)) high low))) 3092 3093(defun rmail-message-recipients-p (msg recipients &optional primary-only) 3094 (save-restriction 3095 (goto-char (rmail-msgbeg msg)) 3096 (search-forward "\n*** EOOH ***\n") 3097 (narrow-to-region (point) (progn (search-forward "\n\n") (point))) 3098 (or (string-match recipients (or (mail-fetch-field "To") "")) 3099 (string-match recipients (or (mail-fetch-field "From") "")) 3100 (if (not primary-only) 3101 (string-match recipients (or (mail-fetch-field "Cc") "")))))) 3102 3103(defun rmail-message-regexp-p (n regexp) 3104 "Return t, if for message number N, regexp REGEXP matches in the header." 3105 (let ((beg (rmail-msgbeg n)) 3106 (end (rmail-msgend n))) 3107 (goto-char beg) 3108 (forward-line 1) 3109 (save-excursion 3110 (save-restriction 3111 (if (prog1 (= (following-char) ?0) 3112 (forward-line 2) 3113 ;; If there's a Summary-line in the (otherwise empty) 3114 ;; header, we didn't yet get past the EOOH line. 3115 (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") 3116 (forward-line 1)) 3117 (setq beg (point)) 3118 (narrow-to-region (point) end)) 3119 (progn 3120 (rfc822-goto-eoh) 3121 (setq end (point))) 3122 (setq beg (point)) 3123 (search-forward "\n*** EOOH ***\n" end t) 3124 (setq end (1+ (match-beginning 0))))) 3125 (goto-char beg) 3126 (if rmail-enable-mime 3127 (funcall rmail-search-mime-header-function n regexp end) 3128 (re-search-forward regexp end t))))) 3129 3130(defun rmail-search-message (msg regexp) 3131 "Return non-nil, if for message number MSG, regexp REGEXP matches." 3132 (goto-char (rmail-msgbeg msg)) 3133 (if rmail-enable-mime 3134 (funcall rmail-search-mime-message-function msg regexp) 3135 (re-search-forward regexp (rmail-msgend msg) t))) 3136 3137(defvar rmail-search-last-regexp nil) 3138(defun rmail-search (regexp &optional n) 3139 "Show message containing next match for REGEXP (but not the current msg). 3140Prefix argument gives repeat count; negative argument means search 3141backwards (through earlier messages). 3142Interactively, empty argument means use same regexp used last time." 3143 (interactive 3144 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) 3145 (prompt 3146 (concat (if reversep "Reverse " "") "Rmail search (regexp")) 3147 regexp) 3148 (setq prompt 3149 (concat prompt 3150 (if rmail-search-last-regexp 3151 (concat ", default " 3152 rmail-search-last-regexp "): ") 3153 "): "))) 3154 (setq regexp (read-string prompt)) 3155 (cond ((not (equal regexp "")) 3156 (setq rmail-search-last-regexp regexp)) 3157 ((not rmail-search-last-regexp) 3158 (error "No previous Rmail search string"))) 3159 (list rmail-search-last-regexp 3160 (prefix-numeric-value current-prefix-arg)))) 3161 (or n (setq n 1)) 3162 (message "%sRmail search for %s..." 3163 (if (< n 0) "Reverse " "") 3164 regexp) 3165 (set-buffer rmail-buffer) 3166 (rmail-maybe-set-message-counters) 3167 (let ((omin (point-min)) 3168 (omax (point-max)) 3169 (opoint (point)) 3170 win 3171 (reversep (< n 0)) 3172 (msg rmail-current-message)) 3173 (unwind-protect 3174 (progn 3175 (widen) 3176 (while (/= n 0) 3177 ;; Check messages one by one, advancing message number up or down 3178 ;; but searching forward through each message. 3179 (if reversep 3180 (while (and (null win) (> msg 1)) 3181 (setq msg (1- msg) 3182 win (rmail-search-message msg regexp))) 3183 (while (and (null win) (< msg rmail-total-messages)) 3184 (setq msg (1+ msg) 3185 win (rmail-search-message msg regexp)))) 3186 (setq n (+ n (if reversep 1 -1))))) 3187 (if win 3188 (progn 3189 (rmail-show-message msg) 3190 ;; Search forward (if this is a normal search) or backward 3191 ;; (if this is a reverse search) through this message to 3192 ;; position point. This search may fail because REGEXP 3193 ;; was found in the hidden portion of this message. In 3194 ;; that case, move point to the beginning of visible 3195 ;; portion. 3196 (if reversep 3197 (progn 3198 (goto-char (point-max)) 3199 (re-search-backward regexp nil 'move)) 3200 (goto-char (point-min)) 3201 (re-search-forward regexp nil t)) 3202 (message "%sRmail search for %s...done" 3203 (if reversep "Reverse " "") 3204 regexp)) 3205 (goto-char opoint) 3206 (narrow-to-region omin omax) 3207 (ding) 3208 (message "Search failed: %s" regexp))))) 3209 3210(defun rmail-search-backwards (regexp &optional n) 3211 "Show message containing previous match for REGEXP. 3212Prefix argument gives repeat count; negative argument means search 3213forward (through later messages). 3214Interactively, empty argument means use same regexp used last time." 3215 (interactive 3216 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) 3217 (prompt 3218 (concat (if reversep "Reverse " "") "Rmail search (regexp")) 3219 regexp) 3220 (setq prompt 3221 (concat prompt 3222 (if rmail-search-last-regexp 3223 (concat ", default " 3224 rmail-search-last-regexp "): ") 3225 "): "))) 3226 (setq regexp (read-string prompt)) 3227 (cond ((not (equal regexp "")) 3228 (setq rmail-search-last-regexp regexp)) 3229 ((not rmail-search-last-regexp) 3230 (error "No previous Rmail search string"))) 3231 (list rmail-search-last-regexp 3232 (prefix-numeric-value current-prefix-arg)))) 3233 (rmail-search regexp (- (or n 1)))) 3234 3235;; Show the first message which has the `unseen' attribute. 3236(defun rmail-first-unseen-message () 3237 (rmail-maybe-set-message-counters) 3238 (let ((current 1) 3239 found) 3240 (save-restriction 3241 (widen) 3242 (while (and (not found) (<= current rmail-total-messages)) 3243 (if (rmail-message-labels-p current ", ?\\(unseen\\),") 3244 (setq found current)) 3245 (setq current (1+ current)))) 3246;; Let the caller show the message. 3247;; (if found 3248;; (rmail-show-message found)) 3249 found)) 3250 3251(defun rmail-current-subject () 3252 "Return the current subject. 3253The subject is stripped of leading and trailing whitespace, and 3254of typical reply prefixes such as Re:." 3255 (let ((subject (or (mail-fetch-field "Subject") ""))) 3256 (if (string-match "\\`[ \t]+" subject) 3257 (setq subject (substring subject (match-end 0)))) 3258 (if (string-match rmail-reply-regexp subject) 3259 (setq subject (substring subject (match-end 0)))) 3260 (if (string-match "[ \t]+\\'" subject) 3261 (setq subject (substring subject 0 (match-beginning 0)))) 3262 subject)) 3263 3264(defun rmail-current-subject-regexp () 3265 "Return a regular expression matching the current subject. 3266The regular expression matches the subject header line of 3267messages about the same subject. The subject itself is stripped 3268of leading and trailing whitespace, of typical reply prefixes 3269such as Re: and whitespace within the subject is replaced by a 3270regular expression matching whitespace in general in order to 3271take into account that subject header lines may include newlines 3272and more whitespace. The returned regular expressions contains 3273`rmail-reply-regexp' and ends with a newline." 3274 (let ((subject (rmail-current-subject))) 3275 ;; If Subject is long, mailers will break it into several lines at 3276 ;; arbitrary places, so replace whitespace with a regexp that will 3277 ;; match any sequence of spaces, TABs, and newlines. 3278 (setq subject (regexp-quote subject)) 3279 (setq subject 3280 (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t)) 3281 (concat "^Subject: " 3282 (if (string= "\\`" (substring rmail-reply-regexp 0 2)) 3283 (substring rmail-reply-regexp 2) 3284 rmail-reply-regexp) 3285 subject "[ \t]*\n"))) 3286 3287(defun rmail-next-same-subject (n) 3288 "Go to the next mail message having the same subject header. 3289With prefix argument N, do this N times. 3290If N is negative, go backwards instead." 3291 (interactive "p") 3292 (let ((search-regexp (rmail-current-subject-regexp)) 3293 (forward (> n 0)) 3294 (i rmail-current-message) 3295 (case-fold-search t) 3296 found) 3297 (save-excursion 3298 (save-restriction 3299 (widen) 3300 (while (and (/= n 0) 3301 (if forward 3302 (< i rmail-total-messages) 3303 (> i 1))) 3304 (let (done) 3305 (while (and (not done) 3306 (if forward 3307 (< i rmail-total-messages) 3308 (> i 1))) 3309 (setq i (if forward (1+ i) (1- i))) 3310 (goto-char (rmail-msgbeg i)) 3311 (search-forward "\n*** EOOH ***\n") 3312 (let ((beg (point)) end) 3313 (search-forward "\n\n") 3314 (setq end (point)) 3315 (goto-char beg) 3316 (setq done (re-search-forward search-regexp end t)))) 3317 (if done (setq found i))) 3318 (setq n (if forward (1- n) (1+ n)))))) 3319 (if found 3320 (rmail-show-message found) 3321 (error "No %s message with same subject" 3322 (if forward "following" "previous"))))) 3323 3324(defun rmail-previous-same-subject (n) 3325 "Go to the previous mail message having the same subject header. 3326With prefix argument N, do this N times. 3327If N is negative, go forwards instead." 3328 (interactive "p") 3329 (rmail-next-same-subject (- n))) 3330 3331;;;; *** Rmail Message Deletion Commands *** 3332 3333(defun rmail-message-deleted-p (n) 3334 (= (aref rmail-deleted-vector n) ?D)) 3335 3336(defun rmail-set-message-deleted-p (n state) 3337 (aset rmail-deleted-vector n (if state ?D ?\ ))) 3338 3339(defun rmail-delete-message () 3340 "Delete this message and stay on it." 3341 (interactive) 3342 (rmail-set-attribute "deleted" t) 3343 (run-hooks 'rmail-delete-message-hook)) 3344 3345(defun rmail-undelete-previous-message () 3346 "Back up to deleted message, select it, and undelete it." 3347 (interactive) 3348 (set-buffer rmail-buffer) 3349 (let ((msg rmail-current-message)) 3350 (while (and (> msg 0) 3351 (not (rmail-message-deleted-p msg))) 3352 (setq msg (1- msg))) 3353 (if (= msg 0) 3354 (error "No previous deleted message") 3355 (if (/= msg rmail-current-message) 3356 (rmail-show-message msg)) 3357 (rmail-set-attribute "deleted" nil) 3358 (if (rmail-summary-exists) 3359 (save-excursion 3360 (set-buffer rmail-summary-buffer) 3361 (rmail-summary-mark-undeleted msg))) 3362 (rmail-maybe-display-summary)))) 3363 3364(defun rmail-delete-forward (&optional backward) 3365 "Delete this message and move to next nondeleted one. 3366Deleted messages stay in the file until the \\[rmail-expunge] command is given. 3367With prefix argument, delete and move backward. 3368 3369Returns t if a new message is displayed after the delete, or nil otherwise." 3370 (interactive "P") 3371 (rmail-set-attribute "deleted" t) 3372 (run-hooks 'rmail-delete-message-hook) 3373 (let ((del-msg rmail-current-message)) 3374 (if (rmail-summary-exists) 3375 (rmail-select-summary 3376 (rmail-summary-mark-deleted del-msg))) 3377 (prog1 (rmail-next-undeleted-message (if backward -1 1)) 3378 (rmail-maybe-display-summary)))) 3379 3380(defun rmail-delete-backward () 3381 "Delete this message and move to previous nondeleted one. 3382Deleted messages stay in the file until the \\[rmail-expunge] command is given." 3383 (interactive) 3384 (rmail-delete-forward t)) 3385 3386;; Compute the message number a given message would have after expunging. 3387;; The present number of the message is OLDNUM. 3388;; DELETEDVEC should be rmail-deleted-vector. 3389;; The value is nil for a message that would be deleted. 3390(defun rmail-msg-number-after-expunge (deletedvec oldnum) 3391 (if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) 3392 nil 3393 (let ((i 0) 3394 (newnum 0)) 3395 (while (< i oldnum) 3396 (if (/= (aref deletedvec i) ?D) 3397 (setq newnum (1+ newnum))) 3398 (setq i (1+ i))) 3399 newnum))) 3400 3401(defun rmail-expunge-confirmed () 3402 "Return t if deleted message should be expunged. If necessary, ask the user. 3403See also user-option `rmail-confirm-expunge'." 3404 (set-buffer rmail-buffer) 3405 (or (not (stringp rmail-deleted-vector)) 3406 (not (string-match "D" rmail-deleted-vector)) 3407 (null rmail-confirm-expunge) 3408 (funcall rmail-confirm-expunge 3409 "Erase deleted messages from Rmail file? "))) 3410 3411(defun rmail-only-expunge (&optional dont-show) 3412 "Actually erase all deleted messages in the file." 3413 (interactive) 3414 (set-buffer rmail-buffer) 3415 (message "Expunging deleted messages...") 3416 ;; Discard all undo records for this buffer. 3417 (or (eq buffer-undo-list t) 3418 (setq buffer-undo-list nil)) 3419 (rmail-maybe-set-message-counters) 3420 (let* ((omax (- (buffer-size) (point-max))) 3421 (omin (- (buffer-size) (point-min))) 3422 (opoint (if (and (> rmail-current-message 0) 3423 (rmail-message-deleted-p rmail-current-message)) 3424 0 3425 (if rmail-enable-mime 3426 (with-current-buffer rmail-view-buffer 3427 (- (point)(point-min))) 3428 (- (point) (point-min))))) 3429 (messages-head (cons (aref rmail-message-vector 0) nil)) 3430 (messages-tail messages-head) 3431 ;; Don't make any undo records for the expunging. 3432 (buffer-undo-list t) 3433 (win)) 3434 (unwind-protect 3435 (save-excursion 3436 (widen) 3437 (goto-char (point-min)) 3438 (let ((counter 0) 3439 (number 1) 3440 (total rmail-total-messages) 3441 (new-message-number rmail-current-message) 3442 (new-summary nil) 3443 (new-msgref (list (list 0))) 3444 (rmailbuf (current-buffer)) 3445 (buffer-read-only nil) 3446 (messages rmail-message-vector) 3447 (deleted rmail-deleted-vector) 3448 (summary rmail-summary-vector)) 3449 (setq rmail-total-messages nil 3450 rmail-current-message nil 3451 rmail-message-vector nil 3452 rmail-deleted-vector nil 3453 rmail-summary-vector nil) 3454 3455 (while (<= number total) 3456 (if (= (aref deleted number) ?D) 3457 (progn 3458 (delete-region 3459 (marker-position (aref messages number)) 3460 (marker-position (aref messages (1+ number)))) 3461 (move-marker (aref messages number) nil) 3462 (if (> new-message-number counter) 3463 (setq new-message-number (1- new-message-number)))) 3464 (setq counter (1+ counter)) 3465 (setq messages-tail 3466 (setcdr messages-tail 3467 (cons (aref messages number) nil))) 3468 (setq new-summary 3469 (cons (if (= counter number) (aref summary (1- number))) 3470 new-summary)) 3471 (setq new-msgref 3472 (cons (aref rmail-msgref-vector number) 3473 new-msgref)) 3474 (setcar (car new-msgref) counter)) 3475 (if (zerop (% (setq number (1+ number)) 20)) 3476 (message "Expunging deleted messages...%d" number))) 3477 (setq messages-tail 3478 (setcdr messages-tail 3479 (cons (aref messages number) nil))) 3480 (setq rmail-current-message new-message-number 3481 rmail-total-messages counter 3482 rmail-message-vector (apply 'vector messages-head) 3483 rmail-deleted-vector (make-string (1+ counter) ?\ ) 3484 rmail-summary-vector (vconcat (nreverse new-summary)) 3485 rmail-msgref-vector (apply 'vector (nreverse new-msgref)) 3486 win t))) 3487 (message "Expunging deleted messages...done") 3488 (if (not win) 3489 (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) 3490 (if (not dont-show) 3491 (rmail-show-message 3492 (if (zerop rmail-current-message) 1 nil))) 3493 (if rmail-enable-mime 3494 (goto-char (+ (point-min) opoint)) 3495 (goto-char (+ (point) opoint)))))) 3496 3497(defun rmail-expunge () 3498 "Erase deleted messages from Rmail file and summary buffer." 3499 (interactive) 3500 (when (rmail-expunge-confirmed) 3501 (rmail-only-expunge) 3502 (if (rmail-summary-exists) 3503 (rmail-select-summary (rmail-update-summary))))) 3504 3505;;;; *** Rmail Mailing Commands *** 3506 3507(defun rmail-start-mail (&optional noerase to subject in-reply-to cc 3508 replybuffer sendactions same-window others) 3509 (let (yank-action) 3510 (if replybuffer 3511 (setq yank-action (list 'insert-buffer replybuffer))) 3512 (setq others (cons (cons "cc" cc) others)) 3513 (setq others (cons (cons "in-reply-to" in-reply-to) others)) 3514 (if same-window 3515 (compose-mail to subject others 3516 noerase nil 3517 yank-action sendactions) 3518 (if rmail-mail-new-frame 3519 (prog1 3520 (compose-mail to subject others 3521 noerase 'switch-to-buffer-other-frame 3522 yank-action sendactions) 3523 ;; This is not a standard frame parameter; 3524 ;; nothing except sendmail.el looks at it. 3525 (modify-frame-parameters (selected-frame) 3526 '((mail-dedicated-frame . t)))) 3527 (compose-mail to subject others 3528 noerase 'switch-to-buffer-other-window 3529 yank-action sendactions))))) 3530 3531(defun rmail-mail () 3532 "Send mail in another window. 3533While composing the message, use \\[mail-yank-original] to yank the 3534original message into it." 3535 (interactive) 3536 (rmail-start-mail nil nil nil nil nil rmail-view-buffer)) 3537 3538(defun rmail-continue () 3539 "Continue composing outgoing message previously being composed." 3540 (interactive) 3541 (rmail-start-mail t)) 3542 3543(defun rmail-reply (just-sender) 3544 "Reply to the current message. 3545Normally include CC: to all other recipients of original message; 3546prefix argument means ignore them. While composing the reply, 3547use \\[mail-yank-original] to yank the original message into it." 3548 (interactive "P") 3549 (let (from reply-to cc subject date to message-id references 3550 resent-to resent-cc resent-reply-to 3551 (msgnum rmail-current-message)) 3552 (save-excursion 3553 (save-restriction 3554 (if rmail-enable-mime 3555 (narrow-to-region 3556 (goto-char (point-min)) 3557 (if (search-forward "\n\n" nil 'move) 3558 (1+ (match-beginning 0)) 3559 (point))) 3560 (widen) 3561 (goto-char (rmail-msgbeg rmail-current-message)) 3562 (forward-line 1) 3563 (if (= (following-char) ?0) 3564 (narrow-to-region 3565 (progn (forward-line 2) 3566 (point)) 3567 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message) 3568 'move) 3569 (point))) 3570 (narrow-to-region (point) 3571 (progn (search-forward "\n*** EOOH ***\n") 3572 (beginning-of-line) (point))))) 3573 (setq from (mail-fetch-field "from") 3574 reply-to (or (mail-fetch-field "mail-reply-to" nil t) 3575 (mail-fetch-field "reply-to" nil t) 3576 from) 3577 subject (mail-fetch-field "subject") 3578 date (mail-fetch-field "date") 3579 message-id (mail-fetch-field "message-id") 3580 references (mail-fetch-field "references" nil nil t) 3581 resent-reply-to (mail-fetch-field "resent-reply-to" nil t) 3582 resent-cc (and (not just-sender) 3583 (mail-fetch-field "resent-cc" nil t)) 3584 resent-to (or (mail-fetch-field "resent-to" nil t) "") 3585;;; resent-subject (mail-fetch-field "resent-subject") 3586;;; resent-date (mail-fetch-field "resent-date") 3587;;; resent-message-id (mail-fetch-field "resent-message-id") 3588 ) 3589 (unless just-sender 3590 (if (mail-fetch-field "mail-followup-to" nil t) 3591 ;; If this header field is present, use it instead of the To and CC fields. 3592 (setq to (mail-fetch-field "mail-followup-to" nil t)) 3593 (setq cc (or (mail-fetch-field "cc" nil t) "") 3594 to (or (mail-fetch-field "to" nil t) "")))) 3595 3596 )) 3597 3598 ;; Merge the resent-to and resent-cc into the to and cc. 3599 (if (and resent-to (not (equal resent-to ""))) 3600 (if (not (equal to "")) 3601 (setq to (concat to ", " resent-to)) 3602 (setq to resent-to))) 3603 (if (and resent-cc (not (equal resent-cc ""))) 3604 (if (not (equal cc "")) 3605 (setq cc (concat cc ", " resent-cc)) 3606 (setq cc resent-cc))) 3607 ;; Add `Re: ' to subject if not there already. 3608 (and (stringp subject) 3609 (setq subject 3610 (concat rmail-reply-prefix 3611 (if (let ((case-fold-search t)) 3612 (string-match rmail-reply-regexp subject)) 3613 (substring subject (match-end 0)) 3614 subject)))) 3615 (rmail-start-mail 3616 nil 3617 ;; Using mail-strip-quoted-names is undesirable with newer mailers 3618 ;; since they can handle the names unstripped. 3619 ;; I don't know whether there are other mailers that still 3620 ;; need the names to be stripped. 3621;;; (mail-strip-quoted-names reply-to) 3622 ;; Remove unwanted names from reply-to, since Mail-Followup-To 3623 ;; header causes all the names in it to wind up in reply-to, not 3624 ;; in cc. But if what's left is an empty list, use the original. 3625 (let* ((reply-to-list (rmail-dont-reply-to reply-to))) 3626 (if (string= reply-to-list "") reply-to reply-to-list)) 3627 subject 3628 (rmail-make-in-reply-to-field from date message-id) 3629 (if just-sender 3630 nil 3631 ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to 3632 ;; to do its job. 3633 (let* ((cc-list (rmail-dont-reply-to 3634 (mail-strip-quoted-names 3635 (if (null cc) to (concat to ", " cc)))))) 3636 (if (string= cc-list "") nil cc-list))) 3637 rmail-view-buffer 3638 (list (list 'rmail-mark-message 3639 rmail-buffer 3640 (with-current-buffer rmail-buffer 3641 (aref rmail-msgref-vector msgnum)) 3642 "answered")) 3643 nil 3644 (list (cons "References" (concat (mapconcat 'identity references " ") 3645 " " message-id)))))) 3646 3647(defun rmail-mark-message (buffer msgnum-list attribute) 3648 "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. 3649This is use in the send-actions for message buffers. 3650MSGNUM-LIST is a list of the form (MSGNUM) 3651which is an element of rmail-msgref-vector." 3652 (save-excursion 3653 (set-buffer buffer) 3654 (if (car msgnum-list) 3655 (rmail-set-attribute attribute t (car msgnum-list))))) 3656 3657(defun rmail-make-in-reply-to-field (from date message-id) 3658 (cond ((not from) 3659 (if message-id 3660 message-id 3661 nil)) 3662 (mail-use-rfc822 3663 (require 'rfc822) 3664 (let ((tem (car (rfc822-addresses from)))) 3665 (if message-id 3666 (if (or (not tem) 3667 (string-match 3668 (regexp-quote (if (string-match "@[^@]*\\'" tem) 3669 (substring tem 0 3670 (match-beginning 0)) 3671 tem)) 3672 message-id)) 3673 ;; missing From, or Message-ID is sufficiently informative 3674 message-id 3675 (concat message-id " (" tem ")")) 3676 ;; Copy TEM, discarding text properties. 3677 (setq tem (copy-sequence tem)) 3678 (set-text-properties 0 (length tem) nil tem) 3679 (setq tem (copy-sequence tem)) 3680 ;; Use prin1 to fake RFC822 quoting 3681 (let ((field (prin1-to-string tem))) 3682 (if date 3683 (concat field "'s message of " date) 3684 field))))) 3685 ((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+") 3686 (bar "[^][\000-\037()<>@,;:\\\"]+")) 3687 ;; These strings both match all non-ASCII characters. 3688 (or (string-match (concat "\\`[ \t]*\\(" bar 3689 "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'") 3690 ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser" 3691 from) 3692 (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\(" 3693 bar "\\))[ \t]*\\'") 3694 ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix" 3695 from))) 3696 (let ((start (match-beginning 1)) 3697 (end (match-end 1))) 3698 ;; Trim whitespace which above regexp match allows 3699 (while (and (< start end) 3700 (memq (aref from start) '(?\t ?\ ))) 3701 (setq start (1+ start))) 3702 (while (and (< start end) 3703 (memq (aref from (1- end)) '(?\t ?\ ))) 3704 (setq end (1- end))) 3705 (let ((field (substring from start end))) 3706 (if date (setq field (concat "message from " field " on " date))) 3707 (if message-id 3708 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)" 3709 (concat message-id " (" field ")") 3710 field)))) 3711 (t 3712 ;; If we can't kludge it simply, do it correctly 3713 (let ((mail-use-rfc822 t)) 3714 (rmail-make-in-reply-to-field from date message-id))))) 3715 3716(defun rmail-forward (resend) 3717 "Forward the current message to another user. 3718With prefix argument, \"resend\" the message instead of forwarding it; 3719see the documentation of `rmail-resend'." 3720 (interactive "P") 3721 (if resend 3722 (call-interactively 'rmail-resend) 3723 (let ((forward-buffer rmail-buffer) 3724 (msgnum rmail-current-message) 3725 (subject (concat "[" 3726 (let ((from (or (mail-fetch-field "From") 3727 (mail-fetch-field ">From")))) 3728 (if from 3729 (concat (mail-strip-quoted-names from) ": ") 3730 "")) 3731 (or (mail-fetch-field "Subject") "") 3732 "]"))) 3733 (if (rmail-start-mail 3734 nil nil subject nil nil nil 3735 (list (list 'rmail-mark-message 3736 forward-buffer 3737 (with-current-buffer rmail-buffer 3738 (aref rmail-msgref-vector msgnum)) 3739 "forwarded")) 3740 ;; If only one window, use it for the mail buffer. 3741 ;; Otherwise, use another window for the mail buffer 3742 ;; so that the Rmail buffer remains visible 3743 ;; and sending the mail will get back to it. 3744 (and (not rmail-mail-new-frame) (one-window-p t))) 3745 ;; The mail buffer is now current. 3746 (save-excursion 3747 ;; Insert after header separator--before signature if any. 3748 (goto-char (mail-text-start)) 3749 (if (or rmail-enable-mime rmail-enable-mime-composing) 3750 (funcall rmail-insert-mime-forwarded-message-function 3751 forward-buffer) 3752 (insert "------- Start of forwarded message -------\n") 3753 ;; Quote lines with `- ' if they start with `-'. 3754 (let ((beg (point)) end) 3755 (setq end (point-marker)) 3756 (set-marker-insertion-type end t) 3757 (insert-buffer-substring forward-buffer) 3758 (goto-char beg) 3759 (while (re-search-forward "^-" end t) 3760 (beginning-of-line) 3761 (insert "- ") 3762 (forward-line 1)) 3763 (goto-char end) 3764 (skip-chars-backward "\n") 3765 (if (< (point) end) 3766 (forward-char 1)) 3767 (delete-region (point) end) 3768 (set-marker end nil)) 3769 (insert "------- End of forwarded message -------\n")) 3770 (push-mark)))))) 3771 3772(defun rmail-resend (address &optional from comment mail-alias-file) 3773 "Resend current message to ADDRESSES. 3774ADDRESSES should be a single address, a string consisting of several 3775addresses separated by commas, or a list of addresses. 3776 3777Optional FROM is the address to resend the message from, and 3778defaults from the value of `user-mail-address'. 3779Optional COMMENT is a string to insert as a comment in the resent message. 3780Optional ALIAS-FILE is alternate aliases file to be used by sendmail, 3781typically for purposes of moderating a list." 3782 (interactive "sResend to: ") 3783 (require 'sendmail) 3784 (require 'mailalias) 3785 (unless (or (eq rmail-view-buffer (current-buffer)) 3786 (eq rmail-buffer (current-buffer))) 3787 (error "Not an Rmail buffer")) 3788 (if (not from) (setq from user-mail-address)) 3789 (let ((tembuf (generate-new-buffer " sendmail temp")) 3790 (case-fold-search nil) 3791 (mail-personal-alias-file 3792 (or mail-alias-file mail-personal-alias-file)) 3793 (mailbuf rmail-buffer)) 3794 (unwind-protect 3795 (with-current-buffer tembuf 3796 ;;>> Copy message into temp buffer 3797 (if rmail-enable-mime 3798 (funcall rmail-insert-mime-resent-message-function mailbuf) 3799 (insert-buffer-substring mailbuf)) 3800 (goto-char (point-min)) 3801 ;; Delete any Sender field, since that's not specifiable. 3802 ; Only delete Sender fields in the actual header. 3803 (re-search-forward "^$" nil 'move) 3804 ; Using "while" here rather than "if" because some buggy mail 3805 ; software may have inserted multiple Sender fields. 3806 (while (re-search-backward "^Sender:" nil t) 3807 (let (beg) 3808 (setq beg (point)) 3809 (forward-line 1) 3810 (while (looking-at "[ \t]") 3811 (forward-line 1)) 3812 (delete-region beg (point)))) 3813 ; Go back to the beginning of the buffer so the Resent- fields 3814 ; are inserted there. 3815 (goto-char (point-min)) 3816 ;;>> Insert resent-from: 3817 (insert "Resent-From: " from "\n") 3818 (insert "Resent-Date: " (mail-rfc822-date) "\n") 3819 ;;>> Insert resent-to: and bcc if need be. 3820 (let ((before (point))) 3821 (if mail-self-blind 3822 (insert "Resent-Bcc: " (user-login-name) "\n")) 3823 (insert "Resent-To: " (if (stringp address) 3824 address 3825 (mapconcat 'identity address ",\n\t")) 3826 "\n") 3827 ;; Expand abbrevs in the recipients. 3828 (save-excursion 3829 (if (featurep 'mailabbrev) 3830 (let ((end (point-marker)) 3831 (local-abbrev-table mail-abbrevs) 3832 (old-syntax-table (syntax-table))) 3833 (if (and (not (vectorp mail-abbrevs)) 3834 (file-exists-p mail-personal-alias-file)) 3835 (build-mail-abbrevs)) 3836 (unless mail-abbrev-syntax-table 3837 (mail-abbrev-make-syntax-table)) 3838 (set-syntax-table mail-abbrev-syntax-table) 3839 (goto-char before) 3840 (while (and (< (point) end) 3841 (progn (forward-word 1) 3842 (<= (point) end))) 3843 (expand-abbrev)) 3844 (set-syntax-table old-syntax-table)) 3845 (expand-mail-aliases before (point))))) 3846 ;;>> Set up comment, if any. 3847 (if (and (sequencep comment) (not (zerop (length comment)))) 3848 (let ((before (point)) 3849 after) 3850 (insert comment) 3851 (or (eolp) (insert "\n")) 3852 (setq after (point)) 3853 (goto-char before) 3854 (while (< (point) after) 3855 (insert "Resent-Comment: ") 3856 (forward-line 1)))) 3857 ;; Don't expand aliases in the destination fields 3858 ;; of the original message. 3859 (let (mail-aliases) 3860 (funcall send-mail-function))) 3861 (kill-buffer tembuf)) 3862 (with-current-buffer rmail-buffer 3863 (rmail-set-attribute "resent" t rmail-current-message)))) 3864 3865(defvar mail-unsent-separator 3866 (concat "^ *---+ +Unsent message follows +---+ *$\\|" 3867 "^ *---+ +Returned message +---+ *$\\|" 3868 "^ *---+ *Returned mail follows *---+ *$\\|" 3869 "^Start of returned message$\\|" 3870 "^---+ Below this line is a copy of the message.$\\|" 3871 "^ *---+ +Original message +---+ *$\\|" 3872 "^ *--+ +begin message +--+ *$\\|" 3873 "^ *---+ +Original message follows +---+ *$\\|" 3874 "^ *---+ +Your message follows +---+ *$\\|" 3875 "^|? *---+ +Message text follows: +---+ *|?$\\|" 3876 "^ *---+ +This is a copy of \\w+ message, including all the headers.*---+ *$") 3877 "A regexp that matches the separator before the text of a failed message.") 3878 3879(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" 3880 "A regexp that matches the header of a MIME body part with a failed message.") 3881 3882(defun rmail-retry-failure () 3883 "Edit a mail message which is based on the contents of the current message. 3884For a message rejected by the mail system, extract the interesting headers and 3885the body of the original message. 3886If the failed message is a MIME multipart message, it is searched for a 3887body part with a header which matches the variable `mail-mime-unsent-header'. 3888Otherwise, the variable `mail-unsent-separator' should match the string that 3889delimits the returned original message. 3890The variable `rmail-retry-ignored-headers' is a regular expression 3891specifying headers which should not be copied into the new message." 3892 (interactive) 3893 (require 'mail-utils) 3894 (let ((rmail-this-buffer (current-buffer)) 3895 (msgnum rmail-current-message) 3896 bounce-start bounce-end bounce-indent resending 3897 ;; Fetch any content-type header in current message 3898 ;; Must search thru the whole unpruned header. 3899 (content-type 3900 (save-excursion 3901 (save-restriction 3902 (rmail-narrow-to-non-pruned-header) 3903 (mail-fetch-field "Content-Type") )))) 3904 (save-excursion 3905 (goto-char (point-min)) 3906 (let ((case-fold-search t)) 3907 (if (and content-type 3908 (string-match 3909 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?" 3910 content-type)) 3911 ;; Handle a MIME multipart bounce message. 3912 (let ((codestring 3913 (concat "\n--" 3914 (substring content-type (match-beginning 1) 3915 (match-end 1))))) 3916 (unless (re-search-forward mail-mime-unsent-header nil t) 3917 (error "Cannot find beginning of header in failed message")) 3918 (unless (search-forward "\n\n" nil t) 3919 (error "Cannot find start of Mime data in failed message")) 3920 (setq bounce-start (point)) 3921 (if (search-forward codestring nil t) 3922 (setq bounce-end (match-beginning 0)) 3923 (setq bounce-end (point-max)))) 3924 ;; Non-MIME bounce. 3925 (or (re-search-forward mail-unsent-separator nil t) 3926 (error "Cannot parse this as a failure message")) 3927 (skip-chars-forward "\n") 3928 ;; Support a style of failure message in which the original 3929 ;; message is indented, and included within lines saying 3930 ;; `Start of returned message' and `End of returned message'. 3931 (if (looking-at " +Received:") 3932 (progn 3933 (setq bounce-start (point)) 3934 (skip-chars-forward " ") 3935 (setq bounce-indent (- (current-column))) 3936 (goto-char (point-max)) 3937 (re-search-backward "^End of returned message$" nil t) 3938 (setq bounce-end (point))) 3939 ;; One message contained a few random lines before 3940 ;; the old message header. The first line of the 3941 ;; message started with two hyphens. A blank line 3942 ;; followed these random lines. The same line 3943 ;; beginning with two hyphens was possibly marking 3944 ;; the end of the message. 3945 (if (looking-at "^--") 3946 (let ((boundary (buffer-substring-no-properties 3947 (point) 3948 (progn (end-of-line) (point))))) 3949 (search-forward "\n\n") 3950 (skip-chars-forward "\n") 3951 (setq bounce-start (point)) 3952 (goto-char (point-max)) 3953 (search-backward (concat "\n\n" boundary) bounce-start t) 3954 (setq bounce-end (point))) 3955 (setq bounce-start (point) 3956 bounce-end (point-max))) 3957 (unless (search-forward "\n\n" nil t) 3958 (error "Cannot find end of header in failed message")))))) 3959 ;; We have found the message that bounced, within the current message. 3960 ;; Now start sending new message; default header fields from original. 3961 ;; Turn off the usual actions for initializing the message body 3962 ;; because we want to get only the text from the failure message. 3963 (let (mail-signature mail-setup-hook) 3964 (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer 3965 (list (list 'rmail-mark-message 3966 rmail-this-buffer 3967 (aref rmail-msgref-vector msgnum) 3968 "retried"))) 3969 ;; Insert original text as initial text of new draft message. 3970 ;; Bind inhibit-read-only since the header delimiter 3971 ;; of the previous message was probably read-only. 3972 (let ((inhibit-read-only t) 3973 rmail-displayed-headers 3974 rmail-ignored-headers) 3975 (erase-buffer) 3976 (insert-buffer-substring rmail-this-buffer 3977 bounce-start bounce-end) 3978 (goto-char (point-min)) 3979 (if bounce-indent 3980 (indent-rigidly (point-min) (point-max) bounce-indent)) 3981 (rmail-clear-headers rmail-retry-ignored-headers) 3982 (rmail-clear-headers "^sender:\\|^return-path:\\|^received:") 3983 (mail-sendmail-delimit-header) 3984 (save-restriction 3985 (narrow-to-region (point-min) (mail-header-end)) 3986 (setq resending (mail-fetch-field "resent-to")) 3987 (if mail-self-blind 3988 (if resending 3989 (insert "Resent-Bcc: " (user-login-name) "\n") 3990 (insert "BCC: " (user-login-name) "\n")))) 3991 (goto-char (point-min)) 3992 (mail-position-on-field (if resending "Resent-To" "To") t)))))) 3993 3994(defun rmail-summary-exists () 3995 "Non-nil iff in an RMAIL buffer and an associated summary buffer exists. 3996In fact, the non-nil value returned is the summary buffer itself." 3997 (and rmail-summary-buffer (buffer-name rmail-summary-buffer) 3998 rmail-summary-buffer)) 3999 4000(defun rmail-summary-displayed () 4001 "t iff in RMAIL buffer and an associated summary buffer is displayed." 4002 (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer))) 4003 4004(defcustom rmail-redisplay-summary nil 4005 "*Non-nil means Rmail should show the summary when it changes. 4006This has an effect only if a summary buffer exists." 4007 :type 'boolean 4008 :group 'rmail-summary) 4009 4010(defcustom rmail-summary-window-size nil 4011 "*Non-nil means specify the height for an Rmail summary window." 4012 :type '(choice (const :tag "Disabled" nil) integer) 4013 :group 'rmail-summary) 4014 4015;; Put the summary buffer back on the screen, if user wants that. 4016(defun rmail-maybe-display-summary () 4017 (let ((selected (selected-window)) 4018 window) 4019 ;; If requested, make sure the summary is displayed. 4020 (and rmail-summary-buffer (buffer-name rmail-summary-buffer) 4021 rmail-redisplay-summary 4022 (if (get-buffer-window rmail-summary-buffer 0) 4023 ;; It's already in some frame; show that one. 4024 (let ((frame (window-frame 4025 (get-buffer-window rmail-summary-buffer 0)))) 4026 (make-frame-visible frame) 4027 (raise-frame frame)) 4028 (display-buffer rmail-summary-buffer))) 4029 ;; If requested, set the height of the summary window. 4030 (and rmail-summary-buffer (buffer-name rmail-summary-buffer) 4031 rmail-summary-window-size 4032 (setq window (get-buffer-window rmail-summary-buffer)) 4033 ;; Don't try to change the size if just one window in frame. 4034 (not (eq window (frame-root-window (window-frame window)))) 4035 (unwind-protect 4036 (progn 4037 (select-window window) 4038 (enlarge-window (- rmail-summary-window-size (window-height)))) 4039 (select-window selected))))) 4040 4041;;;; *** Rmail Local Fontification *** 4042 4043(defun rmail-fontify-buffer-function () 4044 ;; This function's symbol is bound to font-lock-fontify-buffer-function. 4045 (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t) 4046 ;; If we're already showing a message, fontify it now. 4047 (if rmail-current-message (rmail-fontify-message)) 4048 ;; Prevent Font Lock mode from kicking in. 4049 (setq font-lock-fontified t)) 4050 4051(defun rmail-unfontify-buffer-function () 4052 ;; This function's symbol is bound to font-lock-fontify-unbuffer-function. 4053 (let ((modified (buffer-modified-p)) 4054 (buffer-undo-list t) (inhibit-read-only t) 4055 before-change-functions after-change-functions 4056 buffer-file-name buffer-file-truename) 4057 (save-restriction 4058 (widen) 4059 (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) 4060 (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) 4061 (font-lock-default-unfontify-buffer) 4062 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) 4063 4064(defun rmail-fontify-message () 4065 ;; Fontify the current message if it is not already fontified. 4066 (if (text-property-any (point-min) (point-max) 'rmail-fontified nil) 4067 (let ((modified (buffer-modified-p)) 4068 (buffer-undo-list t) (inhibit-read-only t) 4069 before-change-functions after-change-functions 4070 buffer-file-name buffer-file-truename) 4071 (save-excursion 4072 (save-match-data 4073 (add-text-properties (point-min) (point-max) '(rmail-fontified t)) 4074 (font-lock-fontify-region (point-min) (point-max)) 4075 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))))) 4076 4077;;; Speedbar support for RMAIL files. 4078(eval-when-compile (require 'speedbar)) 4079 4080(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" 4081 "*This regex is used to match folder names to be displayed in speedbar. 4082Enabling this will permit speedbar to display your folders for easy 4083browsing, and moving of messages.") 4084 4085(defvar rmail-speedbar-last-user nil 4086 "The last user to be displayed in the speedbar.") 4087 4088(defvar rmail-speedbar-key-map nil 4089 "Keymap used when in rmail display mode.") 4090 4091(defun rmail-install-speedbar-variables () 4092 "Install those variables used by speedbar to enhance rmail." 4093 (if rmail-speedbar-key-map 4094 nil 4095 (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap)) 4096 4097 (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line) 4098 (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line) 4099 (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line) 4100 (define-key rmail-speedbar-key-map "M" 4101 'rmail-speedbar-move-message-to-folder-on-line))) 4102 4103(defvar rmail-speedbar-menu-items 4104 '(["Read Folder" speedbar-edit-line t] 4105 ["Move message to folder" rmail-speedbar-move-message-to-folder-on-line 4106 (save-excursion (beginning-of-line) 4107 (looking-at "<M> "))]) 4108 "Additional menu-items to add to speedbar frame.") 4109 4110;; Make sure our special speedbar major mode is loaded 4111(if (featurep 'speedbar) 4112 (rmail-install-speedbar-variables) 4113 (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables)) 4114 4115(defun rmail-speedbar-buttons (buffer) 4116 "Create buttons for BUFFER containing rmail messages. 4117Click on the address under Reply to: to reply to this person. 4118Under Folders: Click a name to read it, or on the <M> to move the 4119current message into that RMAIL folder." 4120 (let ((from nil)) 4121 (save-excursion 4122 (set-buffer buffer) 4123 (goto-char (point-min)) 4124 (if (not (re-search-forward "^Reply-To: " nil t)) 4125 (if (not (re-search-forward "^From:? " nil t)) 4126 (setq from t))) 4127 (if from 4128 nil 4129 (setq from (buffer-substring (point) (save-excursion 4130 (end-of-line) 4131 (point)))))) 4132 (goto-char (point-min)) 4133 (if (and (looking-at "Reply to:") 4134 (equal from rmail-speedbar-last-user)) 4135 nil 4136 (setq rmail-speedbar-last-user from) 4137 (erase-buffer) 4138 (insert "Reply To:\n") 4139 (if (stringp from) 4140 (speedbar-insert-button from 'speedbar-directory-face 'highlight 4141 'rmail-speedbar-button 'rmail-reply)) 4142 (insert "Folders:\n") 4143 (let* ((case-fold-search nil) 4144 (df (directory-files (save-excursion (set-buffer buffer) 4145 default-directory) 4146 nil rmail-speedbar-match-folder-regexp))) 4147 (while df 4148 (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight 4149 'rmail-speedbar-move-message (car df)) 4150 (speedbar-insert-button (car df) 'speedbar-file-face 'highlight 4151 'rmail-speedbar-find-file nil t) 4152 (setq df (cdr df))))))) 4153 4154(defun rmail-speedbar-button (text token indent) 4155 "Execute an rmail command specified by TEXT. 4156The command used is TOKEN. INDENT is not used." 4157 (speedbar-with-attached-buffer 4158 (funcall token t))) 4159 4160(defun rmail-speedbar-find-file (text token indent) 4161 "Load in the rmail file TEXT. 4162TOKEN and INDENT are not used." 4163 (speedbar-with-attached-buffer 4164 (message "Loading in RMAIL file %s..." text) 4165 (find-file text))) 4166 4167(defun rmail-speedbar-move-message-to-folder-on-line () 4168 "If the current line is a folder, move current message to it." 4169 (interactive) 4170 (save-excursion 4171 (beginning-of-line) 4172 (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t) 4173 (progn 4174 (forward-char -2) 4175 (speedbar-do-function-pointer))))) 4176 4177(defun rmail-speedbar-move-message (text token indent) 4178 "From button TEXT, copy current message to the rmail file specified by TOKEN. 4179TEXT and INDENT are not used." 4180 (speedbar-with-attached-buffer 4181 (message "Moving message to %s" token) 4182 (rmail-output-to-rmail-file token))) 4183 4184; Functions for setting, getting and encoding the POP password. 4185; The password is encoded to prevent it from being easily accessible 4186; to "prying eyes." Obviously, this encoding isn't "real security," 4187; nor is it meant to be. 4188 4189;;;###autoload 4190(defun rmail-set-remote-password (password) 4191 "Set PASSWORD to be used for retrieving mail from a POP or IMAP server." 4192 (interactive "sPassword: ") 4193 (if password 4194 (setq rmail-encoded-remote-password 4195 (rmail-encode-string password (emacs-pid))) 4196 (setq rmail-remote-password nil) 4197 (setq rmail-encoded-remote-password nil))) 4198 4199(defun rmail-get-remote-password (imap) 4200 "Get the password for retrieving mail from a POP or IMAP server. If none 4201has been set, then prompt the user for one." 4202 (when (not rmail-encoded-remote-password) 4203 (if (not rmail-remote-password) 4204 (setq rmail-remote-password 4205 (read-passwd (if imap 4206 "IMAP password: " 4207 "POP password: ")))) 4208 (rmail-set-remote-password rmail-remote-password) 4209 (setq rmail-remote-password nil)) 4210 (rmail-encode-string rmail-encoded-remote-password (emacs-pid))) 4211 4212(defun rmail-have-password () 4213 (or rmail-remote-password rmail-encoded-remote-password)) 4214 4215(defun rmail-encode-string (string mask) 4216 "Encode STRING with integer MASK, by taking the exclusive OR of the 4217lowest byte in the mask with the first character of string, the 4218second-lowest-byte with the second character of the string, etc., 4219restarting at the lowest byte of the mask whenever it runs out. 4220Returns the encoded string. Calling the function again with an 4221encoded string (and the same mask) will decode the string." 4222 (setq mask (abs mask)) ; doesn't work if negative 4223 (let* ((string-vector (string-to-vector string)) (i 0) 4224 (len (length string-vector)) (curmask mask) charmask) 4225 (while (< i len) 4226 (if (= curmask 0) 4227 (setq curmask mask)) 4228 (setq charmask (% curmask 256)) 4229 (setq curmask (lsh curmask -8)) 4230 (aset string-vector i (logxor charmask (aref string-vector i))) 4231 (setq i (1+ i))) 4232 (concat string-vector))) 4233 4234;;;; Desktop support 4235 4236(defun rmail-restore-desktop-buffer (desktop-buffer-file-name 4237 desktop-buffer-name 4238 desktop-buffer-misc) 4239 "Restore an rmail buffer specified in a desktop file." 4240 (condition-case error 4241 (progn 4242 (rmail-input desktop-buffer-file-name) 4243 (if (eq major-mode 'rmail-mode) 4244 (current-buffer) 4245 rmail-buffer)) 4246 (file-locked 4247 (kill-buffer (current-buffer)) 4248 nil))) 4249 4250(add-to-list 'desktop-buffer-mode-handlers 4251 '(rmail-mode . rmail-restore-desktop-buffer)) 4252 4253(provide 'rmail) 4254 4255;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c 4256;;; rmail.el ends here 4257