|
|
1.1 ! root 1: ;; "RMAIL" mail reader for Emacs. ! 2: ;; Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 Free Software Foundation, Inc. ! 3: ! 4: ;; This file is part of GNU Emacs. ! 5: ! 6: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 7: ;; it under the terms of the GNU General Public License as published by ! 8: ;; the Free Software Foundation; either version 1, or (at your option) ! 9: ;; any later version. ! 10: ! 11: ;; GNU Emacs is distributed in the hope that it will be useful, ! 12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: ;; GNU General Public License for more details. ! 15: ! 16: ;; You should have received a copy of the GNU General Public License ! 17: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 19: ! 20: ! 21: ;; Souped up by shane@mit-ajax based on ideas of [email protected] ! 22: ;; New features include attribute and keyword support, message ! 23: ;; selection by dispatch table, summary by attributes and keywords, ! 24: ;; expunging by dispatch table, sticky options for file commands. ! 25: ! 26: (require 'mail-utils) ! 27: (provide 'rmail) ! 28: ! 29: ; these variables now declared in loaddefs or paths.el ! 30: ;(defvar rmail-spool-directory "/usr/spool/mail/" ! 31: ; "This is the name of the directory used by the system mailer for\n\ ! 32: ;delivering new mail. It's name should end with a slash.") ! 33: ;(defvar rmail-dont-reply-to-names ! 34: ; nil ! 35: ; "*A regexp specifying names to prune of reply to messages. ! 36: ;nil means dont reply to yourself.") ! 37: ;(defvar rmail-ignored-headers ! 38: ; "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:" ! 39: ; "*Gubbish headers one would rather not see.") ! 40: ;(defvar rmail-file-name ! 41: ; (expand-file-name "~/RMAIL") ! 42: ; "") ! 43: ; ! 44: ;(defvar rmail-delete-after-output nil ! 45: ; "*Non-nil means automatically delete a message that is copied to a file.") ! 46: ; ! 47: ;(defvar rmail-primary-inbox-list ! 48: ; '("/usr/spool/mail/$USER" "~/mbox") ! 49: ; "") ! 50: ! 51: ;; these may be altered by site-init.el to match the format of mmdf files ! 52: ;; delimitation used on a given host (delim1 and delim2 from the config ! 53: ;; files) ! 54: ! 55: (defvar mmdf-delim1 "^\001\001\001\001\n" ! 56: "Regexp marking the start of an mmdf message") ! 57: (defvar mmdf-delim2 "^\001\001\001\001\n" ! 58: "Regexp marking the end of an mmdf message") ! 59: ! 60: (defvar rmail-message-filter nil ! 61: "If non nil, is a filter function for new headers in RMAIL. ! 62: Called with region narrowed to unformatted header.") ! 63: ! 64: (defvar rmail-mode-map nil) ! 65: ! 66: ;; Message counters and markers. Deleted flags. ! 67: ! 68: (defvar rmail-current-message nil) ! 69: (defvar rmail-total-messages nil) ! 70: (defvar rmail-message-vector nil) ! 71: (defvar rmail-deleted-vector nil) ! 72: ! 73: ;; These are used by autoloaded rmail-summary. ! 74: ! 75: (defvar rmail-summary-buffer nil) ! 76: (defvar rmail-summary-vector nil) ! 77: ! 78: ;; `Sticky' default variables. ! 79: ! 80: ;; Last individual label specified to a or k. ! 81: (defvar rmail-last-label nil) ! 82: ;; Last set of labels specified to C-M-n or C-M-p or C-M-l. ! 83: (defvar rmail-last-multi-labels nil) ! 84: (defvar rmail-last-file nil) ! 85: (defvar rmail-last-rmail-file nil) ! 86: ! 87: ;; Regexp matching the delimiter of messages in UNIX mail format ! 88: ;; (UNIX From lines). This is often used with ^ added on the front. ! 89: (defvar rmail-unix-mail-delimiter ! 90: "From \\([^ \n]*\\(\\|\".*\"[^ \n]*\\)\\) ?\\([^ \n]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ?[A-Z]?[A-Z][A-Z]T\\( DST\\)?\\| ?[-+]?[0-9][0-9][0-9][0-9]\\|\\) 19\\([0-9]*\\) *\\(remote from [^\n]*\\)?\n") ! 91: ! 92: ;;;; *** Rmail Mode *** ! 93: ! 94: (defun rmail (&optional file-name-arg) ! 95: "Read and edit incoming mail. ! 96: Moves messages into file named by rmail-file-name (a babyl format file) ! 97: and edits that file in RMAIL Mode. ! 98: Type \\[describe-mode] once editing that file, for a list of RMAIL commands. ! 99: ! 100: May be called with filename as argument; ! 101: then performs rmail editing on that file, ! 102: but does not copy any new mail into the file." ! 103: (interactive (if current-prefix-arg ! 104: (list (read-file-name "Run rmail on RMAIL file: " ! 105: nil nil t)))) ! 106: (or rmail-last-file ! 107: (setq rmail-last-file (expand-file-name "~/xmail"))) ! 108: (or rmail-last-rmail-file ! 109: (setq rmail-last-rmail-file (expand-file-name "~/XMAIL"))) ! 110: (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) ! 111: (existed (get-file-buffer file-name)) ! 112: ;; Don't be confused by apparent local-variables spec ! 113: ;; in the last message in the RMAIL file. ! 114: (inhibit-local-variables t)) ! 115: ;; Like find-file, but in the case where a buffer existed ! 116: ;; and the file was reverted, recompute the message-data. ! 117: (if (and existed (not (verify-visited-file-modtime existed))) ! 118: (progn ! 119: (find-file file-name) ! 120: (if (and (verify-visited-file-modtime existed) ! 121: (eq major-mode 'rmail-mode)) ! 122: (progn (rmail-forget-messages) ! 123: (rmail-set-message-counters)))) ! 124: (find-file file-name)) ! 125: (if (eq major-mode 'rmail-edit-mode) ! 126: (error "exit rmail-edit-mode before getting new mail")) ! 127: (if (and existed (eq major-mode 'rmail-mode)) ! 128: nil ! 129: (rmail-mode) ! 130: ;; Provide default set of inboxes for primary mail file ~/RMAIL. ! 131: (and (null rmail-inbox-list) ! 132: (null file-name-arg) ! 133: (setq rmail-inbox-list ! 134: (or rmail-primary-inbox-list ! 135: (list "~/mbox" ! 136: (concat rmail-spool-directory ! 137: (or (getenv "LOGNAME") ! 138: (getenv "USER") ! 139: (user-login-name))))))) ! 140: ;; Convert all or part to Babyl file if possible. ! 141: (rmail-convert-file) ! 142: (goto-char (point-max)) ! 143: (if (null rmail-inbox-list) ! 144: (progn ! 145: (rmail-set-message-counters) ! 146: (rmail-show-message)))) ! 147: (rmail-get-new-mail))) ! 148: ! 149: (defun rmail-convert-file () ! 150: (let (convert) ! 151: (widen) ! 152: (goto-char (point-min)) ! 153: ;; If file doesn't start like a Babyl file, ! 154: ;; convert it to one, by adding a header and converting each message. ! 155: (cond ((looking-at "BABYL OPTIONS:")) ! 156: ((looking-at "Version: 5\n") ! 157: ;; Losing babyl file made by old version of Rmail. ! 158: ;; Just fix the babyl file header; don't make a new one, ! 159: ;; so we don't lose the Labels: file attribute, etc. ! 160: (let ((buffer-read-only nil)) ! 161: (insert "BABYL OPTIONS:\n"))) ! 162: (t ! 163: (setq convert t) ! 164: (rmail-insert-rmail-file-header))) ! 165: ;; If file was not a Babyl file or if there are ! 166: ;; Unix format messages added at the end, ! 167: ;; convert file as necessary. ! 168: (if (or convert ! 169: (progn (goto-char (point-max)) ! 170: (search-backward "\^_") ! 171: (forward-char 1) ! 172: (looking-at "\n*From "))) ! 173: (let ((buffer-read-only nil)) ! 174: (message "Converting to Babyl format...") ! 175: (narrow-to-region (point) (point-max)) ! 176: (rmail-convert-to-babyl-format) ! 177: (message "Converting to Babyl format...done"))))) ! 178: ! 179: (defun rmail-insert-rmail-file-header () ! 180: (let ((buffer-read-only nil)) ! 181: (insert "BABYL OPTIONS: ! 182: Version: 5 ! 183: Labels: ! 184: Note: This is the header of an rmail file. ! 185: Note: If you are seeing it in rmail, ! 186: Note: it means the file has no messages in it.\n\^_"))) ! 187: ! 188: (if rmail-mode-map ! 189: nil ! 190: (setq rmail-mode-map (make-keymap)) ! 191: (suppress-keymap rmail-mode-map) ! 192: (define-key rmail-mode-map "." 'rmail-beginning-of-message) ! 193: (define-key rmail-mode-map " " 'scroll-up) ! 194: (define-key rmail-mode-map "\177" 'scroll-down) ! 195: (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) ! 196: (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) ! 197: (define-key rmail-mode-map "\en" 'rmail-next-message) ! 198: (define-key rmail-mode-map "\ep" 'rmail-previous-message) ! 199: (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) ! 200: (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) ! 201: (define-key rmail-mode-map "a" 'rmail-add-label) ! 202: (define-key rmail-mode-map "k" 'rmail-kill-label) ! 203: (define-key rmail-mode-map "d" 'rmail-delete-forward) ! 204: (define-key rmail-mode-map "u" 'rmail-undelete-previous-message) ! 205: (define-key rmail-mode-map "e" 'rmail-expunge) ! 206: (define-key rmail-mode-map "x" 'rmail-expunge) ! 207: (define-key rmail-mode-map "s" 'rmail-expunge-and-save) ! 208: (define-key rmail-mode-map "g" 'rmail-get-new-mail) ! 209: (define-key rmail-mode-map "h" 'rmail-summary) ! 210: (define-key rmail-mode-map "\e\C-h" 'rmail-summary) ! 211: (define-key rmail-mode-map "l" 'rmail-summary-by-labels) ! 212: (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) ! 213: (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) ! 214: (define-key rmail-mode-map "t" 'rmail-toggle-header) ! 215: (define-key rmail-mode-map "m" 'rmail-mail) ! 216: (define-key rmail-mode-map "r" 'rmail-reply) ! 217: (define-key rmail-mode-map "c" 'rmail-continue) ! 218: (define-key rmail-mode-map "f" 'rmail-forward) ! 219: (define-key rmail-mode-map "\es" 'rmail-search) ! 220: (define-key rmail-mode-map "j" 'rmail-show-message) ! 221: (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) ! 222: (define-key rmail-mode-map "\C-o" 'rmail-output) ! 223: (define-key rmail-mode-map "i" 'rmail-input) ! 224: (define-key rmail-mode-map "q" 'rmail-quit) ! 225: (define-key rmail-mode-map ">" 'rmail-last-message) ! 226: (define-key rmail-mode-map "?" 'describe-mode) ! 227: (define-key rmail-mode-map "w" 'rmail-edit-current-message) ! 228: (define-key rmail-mode-map "\C-d" 'rmail-delete-backward)) ! 229: ! 230: ;; Rmail mode is suitable only for specially formatted data. ! 231: (put 'rmail-mode 'mode-class 'special) ! 232: ! 233: (defun rmail-mode () ! 234: "Rmail Mode is used by \\[rmail] for editing Rmail files. ! 235: All normal editing commands are turned off. ! 236: Instead, these commands are available: ! 237: ! 238: . Move point to front of this message (same as \\[beginning-of-buffer]). ! 239: SPC Scroll to next screen of this message. ! 240: DEL Scroll to previous screen of this message. ! 241: n Move to Next non-deleted message. ! 242: p Move to Previous non-deleted message. ! 243: M-n Move to Next message whether deleted or not. ! 244: M-p Move to Previous message whether deleted or not. ! 245: > Move to the last message in Rmail file. ! 246: j Jump to message specified by numeric position in file. ! 247: M-s Search for string and show message it is found in. ! 248: d Delete this message, move to next nondeleted. ! 249: C-d Delete this message, move to previous nondeleted. ! 250: u Undelete message. Tries current message, then earlier messages ! 251: till a deleted message is found. ! 252: e Expunge deleted messages. ! 253: s Expunge and save the file. ! 254: q Quit Rmail: expunge, save, then switch to another buffer. ! 255: C-x C-s Save without expunging. ! 256: g Move new mail from system spool directory or mbox into this file. ! 257: m Mail a message (same as \\[mail-other-window]). ! 258: c Continue composing outgoing message started before. ! 259: r Reply to this message. Like m but initializes some fields. ! 260: f Forward this message to another user. ! 261: o Output this message to an Rmail file (append it). ! 262: C-o Output this message to a Unix-format mail file (append it). ! 263: i Input Rmail file. Run Rmail on that file. ! 264: a Add label to message. It will be displayed in the mode line. ! 265: k Kill label. Remove a label from current message. ! 266: C-M-n Move to Next message with specified label ! 267: (label defaults to last one specified). ! 268: Standard labels: filed, unseen, answered, forwarded, deleted. ! 269: Any other label is present only if you add it with `a'. ! 270: C-M-p Move to Previous message with specified label ! 271: C-M-h Show headers buffer, with a one line summary of each message. ! 272: C-M-l Like h only just messages with particular label(s) are summarized. ! 273: C-M-r Like h only just messages with particular recipient(s) are summarized. ! 274: t Toggle header, show Rmail header if unformatted or vice versa. ! 275: w Edit the current message. C-c C-c to return to Rmail." ! 276: (interactive) ! 277: (kill-all-local-variables) ! 278: (rmail-mode-1) ! 279: (rmail-variables) ! 280: (run-hooks 'rmail-mode-hook)) ! 281: ! 282: (defun rmail-mode-1 () ! 283: (setq major-mode 'rmail-mode) ! 284: (setq mode-name "RMAIL") ! 285: (setq buffer-read-only t) ! 286: ;; No need to auto save RMAIL files. ! 287: (setq buffer-auto-save-file-name nil) ! 288: (if (boundp 'mode-line-modified) ! 289: (setq mode-line-modified "--- ") ! 290: (setq mode-line-format ! 291: (cons "--- " (cdr (default-value 'mode-line-format))))) ! 292: (use-local-map rmail-mode-map) ! 293: (set-syntax-table text-mode-syntax-table) ! 294: (setq local-abbrev-table text-mode-abbrev-table)) ! 295: ! 296: (defun rmail-variables () ! 297: (make-local-variable 'revert-buffer-function) ! 298: (setq revert-buffer-function 'rmail-revert) ! 299: (make-local-variable 'rmail-last-label) ! 300: (make-local-variable 'rmail-deleted-vector) ! 301: (make-local-variable 'rmail-keywords) ! 302: (make-local-variable 'rmail-summary-buffer) ! 303: (make-local-variable 'rmail-summary-vector) ! 304: (make-local-variable 'rmail-current-message) ! 305: (make-local-variable 'rmail-total-messages) ! 306: (make-local-variable 'require-final-newline) ! 307: (setq require-final-newline nil) ! 308: (make-local-variable 'version-control) ! 309: (setq version-control 'never) ! 310: (make-local-variable 'file-precious-flag) ! 311: (setq file-precious-flag t) ! 312: (make-local-variable 'rmail-message-vector) ! 313: (make-local-variable 'rmail-last-file) ! 314: (make-local-variable 'rmail-inbox-list) ! 315: (setq rmail-inbox-list (rmail-parse-file-inboxes)) ! 316: (make-local-variable 'rmail-keywords) ! 317: ;; this gets generated as needed ! 318: (setq rmail-keywords nil)) ! 319: ! 320: ;; Handle M-x revert-buffer done in an rmail-mode buffer. ! 321: (defun rmail-revert (arg noconfirm) ! 322: (let (revert-buffer-function) ! 323: ;; Call our caller again, but this time it does the default thing. ! 324: (if (revert-buffer arg noconfirm) ! 325: ;; If the user said "yes", and we changed something, ! 326: ;; reparse the messages. ! 327: (progn ! 328: (rmail-convert-file) ! 329: (goto-char (point-max)) ! 330: (rmail-set-message-counters) ! 331: (rmail-show-message))))) ! 332: ! 333: ;; Return a list of files from this buffer's Mail: option. ! 334: ;; Does not assume that messages have been parsed. ! 335: ;; Just returns nil if buffer does not look like Babyl format. ! 336: (defun rmail-parse-file-inboxes () ! 337: (save-excursion ! 338: (save-restriction ! 339: (widen) ! 340: (goto-char 1) ! 341: (cond ((looking-at "BABYL OPTIONS:") ! 342: (search-forward "\^_" nil 'move) ! 343: (narrow-to-region 1 (point)) ! 344: (goto-char 1) ! 345: (if (search-forward "\nMail:" nil t) ! 346: (progn ! 347: (narrow-to-region (point) (progn (end-of-line) (point))) ! 348: (goto-char (point-min)) ! 349: (mail-parse-comma-list)))))))) ! 350: ! 351: (defun rmail-expunge-and-save () ! 352: "Expunge and save RMAIL file." ! 353: (interactive) ! 354: (rmail-expunge) ! 355: (save-buffer)) ! 356: ! 357: (defun rmail-quit () ! 358: "Quit out of RMAIL." ! 359: (interactive) ! 360: (rmail-expunge-and-save) ! 361: ;; Don't switch to the summary buffer even if it was recently visible. ! 362: (if rmail-summary-buffer ! 363: (bury-buffer rmail-summary-buffer)) ! 364: (let ((obuf (current-buffer))) ! 365: (switch-to-buffer (other-buffer)) ! 366: (bury-buffer obuf))) ! 367: ! 368: (defun rmail-input (filename) ! 369: "Run RMAIL on file FILENAME." ! 370: (interactive "FRun rmail on RMAIL file: ") ! 371: (rmail filename)) ! 372: ! 373: ! 374: ;;;; *** Rmail input *** ! 375: ! 376: ;; RLK feature not added in this version: ! 377: ;; argument specifies inbox file or files in various ways. ! 378: ! 379: (defun rmail-get-new-mail (&optional file-name) ! 380: "Move any new mail from this RMAIL file's inbox files. ! 381: The inbox files can be specified with the file's Mail: option. ! 382: The variable rmail-primary-inbox-list specifies the inboxes for ! 383: your primary RMAIL file if it has no Mail: option. ! 384: These are normally your ~/mbox and your /usr/spool/mail/$USER. ! 385: ! 386: You can also specify the file to get new mail from. In this ! 387: case, the file of new mail is not changed or deleted. ! 388: Noninteractively, you can pass the inbox file name as an argument. ! 389: Interactively, a prefix argument causes us to read a file name ! 390: and use that file as the inbox." ! 391: (interactive ! 392: (list (if current-prefix-arg ! 393: (read-file-name "Get new mail from file: ")))) ! 394: (or (verify-visited-file-modtime (current-buffer)) ! 395: (progn ! 396: (find-file (buffer-file-name)) ! 397: (if (verify-visited-file-modtime (current-buffer)) ! 398: (rmail-forget-messages)))) ! 399: (rmail-maybe-set-message-counters) ! 400: (widen) ! 401: ;; Get rid of all undo records for this buffer. ! 402: (or (eq buffer-undo-list t) ! 403: (setq buffer-undo-list nil)) ! 404: (unwind-protect ! 405: (let ((opoint (point)) ! 406: (new-messages 0) ! 407: (delete-files ()) ! 408: ;; If buffer has not changed yet, and has not been saved yet, ! 409: ;; don't replace the old backup file now. ! 410: (make-backup-files (and make-backup-files (buffer-modified-p))) ! 411: (buffer-read-only nil) ! 412: ;; Don't make undo records for what we do in getting mail. ! 413: (buffer-undo-list t)) ! 414: (goto-char (point-max)) ! 415: (skip-chars-backward " \t\n") ; just in case of brain damage ! 416: (delete-region (point) (point-max)) ; caused by require-final-newline ! 417: (save-excursion ! 418: (save-restriction ! 419: (narrow-to-region (point) (point)) ! 420: ;; Read in the contents of the inbox files, ! 421: ;; renaming them as necessary, ! 422: ;; and adding to the list of files to delete eventually. ! 423: (if file-name ! 424: (rmail-insert-inbox-text (list file-name) nil) ! 425: (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t))) ! 426: ;; Scan the new text and convert each message to babyl format. ! 427: (goto-char (point-min)) ! 428: (save-excursion ! 429: (setq new-messages (rmail-convert-to-babyl-format))) ! 430: (or (zerop new-messages) ! 431: (let (success) ! 432: (widen) ! 433: (search-backward "\^_") ! 434: (narrow-to-region (point) (point-max)) ! 435: (goto-char (1+ (point-min))) ! 436: (rmail-count-new-messages) ! 437: (save-buffer))) ! 438: ;; Delete the old files, now that babyl file is saved. ! 439: (while delete-files ! 440: (condition-case () ! 441: ;; First, try deleting. ! 442: (condition-case () ! 443: (delete-file (car delete-files)) ! 444: (file-error ! 445: ;; If we can't delete it, truncate it. ! 446: (write-region (point) (point) (car delete-files)))) ! 447: (file-error nil)) ! 448: (setq delete-files (cdr delete-files))))) ! 449: (if (= new-messages 0) ! 450: (progn (goto-char opoint) ! 451: (if (or file-name rmail-inbox-list) ! 452: (message "(No new mail has arrived)"))) ! 453: (message "%d new message%s read" ! 454: new-messages (if (= 1 new-messages) "" "s")))) ! 455: ;; Don't leave the buffer screwed up if we get a disk-full error. ! 456: (rmail-show-message))) ! 457: ! 458: (defun rmail-insert-inbox-text (files renamep) ! 459: (let (file tofile delete-files movemail popmail) ! 460: (while files ! 461: (setq file (expand-file-name (substitute-in-file-name (car files))) ! 462: ;;>> un*x specific << ! 463: tofile (concat file "~")) ! 464: ;; If getting from mail spool directory, ! 465: ;; use movemail to move rather than renaming. ! 466: (setq movemail (equal (file-name-directory file) rmail-spool-directory)) ! 467: (setq popmail (string-match "^po:" (file-name-nondirectory file))) ! 468: (if popmail (setq file (file-name-nondirectory file) ! 469: renamep t)) ! 470: (if movemail ! 471: (progn ! 472: (setq tofile (expand-file-name ! 473: ".newmail" ! 474: ;; Use the directory of this rmail file ! 475: ;; because it's a nuisance to use the homedir ! 476: ;; if that is on a full disk and this rmail ! 477: ;; file isn't. ! 478: (file-name-directory ! 479: (expand-file-name buffer-file-name)))) ! 480: ;; On some systems, /usr/spool/mail/foo is a directory ! 481: ;; and the actual inbox is /usr/spool/mail/foo/foo. ! 482: (if (file-directory-p file) ! 483: (setq file (expand-file-name (or (getenv "LOGNAME") ! 484: (getenv "USER") ! 485: (user-login-name)) ! 486: file))))) ! 487: (if popmail ! 488: (message "Getting mail from post office ...") ! 489: (if (or (file-exists-p tofile) (file-exists-p file)) ! 490: (message "Getting mail from %s..." file))) ! 491: ;; Set TOFILE if have not already done so, and ! 492: ;; rename or copy the file FILE to TOFILE if and as appropriate. ! 493: (cond ((not renamep) ! 494: (setq tofile file)) ! 495: ((or (file-exists-p tofile) (and (not popmail) ! 496: (not (file-exists-p file)))) ! 497: nil) ! 498: ((and (not movemail) (not popmail)) ! 499: (rename-file file tofile nil) ! 500: ;; Make the real inbox file empty. ! 501: ;; Leaving it deleted could cause lossage ! 502: ;; because mailers often won't create the file. ! 503: (condition-case () ! 504: (write-region (point) (point) file) ! 505: (file-error nil))) ! 506: (t ! 507: (let ((errors nil)) ! 508: (unwind-protect ! 509: (save-excursion ! 510: (setq errors (generate-new-buffer " *rmail loss*")) ! 511: (buffer-flush-undo errors) ! 512: (call-process ! 513: (expand-file-name "movemail" exec-directory) ! 514: nil errors nil file tofile) ! 515: (if (not (buffer-modified-p errors)) ! 516: ;; No output => movemail won ! 517: nil ! 518: (set-buffer errors) ! 519: (subst-char-in-region (point-min) (point-max) ! 520: ?\n ?\ ) ! 521: (goto-char (point-max)) ! 522: (skip-chars-backward " \t") ! 523: (delete-region (point) (point-max)) ! 524: (goto-char (point-min)) ! 525: (if (looking-at "movemail: ") ! 526: (delete-region (point-min) (match-end 0))) ! 527: (beep t) ! 528: (message (concat "movemail: " ! 529: (buffer-substring (point-min) ! 530: (point-max)))) ! 531: (sit-for 3) ! 532: nil)) ! 533: (if errors (kill-buffer errors)))))) ! 534: ;; At this point, TOFILE contains the name to read: ! 535: ;; Either the alternate name (if we renamed) ! 536: ;; or the actual inbox (if not renaming). ! 537: (if (file-exists-p tofile) ! 538: (let ((omax (point-max))) ! 539: (goto-char (point-max)) ! 540: (insert-file-contents tofile) ! 541: (goto-char (point-max)) ! 542: (or (= (preceding-char) ?\n) ! 543: (= opoint (point-max)) ! 544: (insert ?\n)) ! 545: (setq delete-files (cons tofile delete-files)))) ! 546: (message "") ! 547: (setq files (cdr files))) ! 548: delete-files)) ! 549: ! 550: ;; the rmail-break-forwarded-messages feature is not implemented ! 551: (defun rmail-convert-to-babyl-format () ! 552: (let ((count 0) start ! 553: (case-fold-search nil)) ! 554: (goto-char (point-min)) ! 555: (save-restriction ! 556: (while (not (eobp)) ! 557: (cond ((looking-at "BABYL OPTIONS:");Babyl header ! 558: (search-forward "\n\^_") ! 559: (delete-region (point-min) (point))) ! 560: ;; Babyl format message ! 561: ((looking-at "\^L") ! 562: (or (search-forward "\n\^_" nil t) ! 563: (progn ! 564: (message "Invalid Babyl format in inbox!") ! 565: (sit-for 1) ! 566: (goto-char (point-max)))) ! 567: (setq count (1+ count)) ! 568: ;; Make sure there is no extra white space after the ^_ ! 569: ;; at the end of the message. ! 570: ;; Narrowing will make sure that whatever follows the junk ! 571: ;; will be treated properly. ! 572: (delete-region (point) ! 573: (save-excursion ! 574: (skip-chars-forward " \t\n") ! 575: (point))) ! 576: (narrow-to-region (point) (point-max))) ! 577: ;;*** MMDF format ! 578: ((let ((case-fold-search t)) ! 579: (looking-at mmdf-delim1)) ! 580: (let ((case-fold-search t)) ! 581: (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") ! 582: (setq start (point)) ! 583: (re-search-forward mmdf-delim2 nil t) ! 584: (replace-match "\^_")) ! 585: (save-excursion ! 586: (save-restriction ! 587: (narrow-to-region start (1- (point))) ! 588: (goto-char (point-min)) ! 589: (while (search-forward "\n\^_" nil t) ; single char "\^_" ! 590: (replace-match "\n^_")))) ; 2 chars: "^" and "_" ! 591: (narrow-to-region (point) (point-max)) ! 592: (setq count (1+ count))) ! 593: ;;*** Mail format ! 594: ((looking-at "^From ") ! 595: (setq start (point)) ! 596: (insert "\^L\n0, unseen,,\n*** EOOH ***\n") ! 597: (rmail-nuke-pinhead-header) ! 598: ;; If this message has a Content-Length field, ! 599: ;; skip to the end of the contents. ! 600: (let* ((header-end (save-excursion ! 601: (and (re-search-forward "\n\n" nil t) ! 602: (point)))) ! 603: (case-fold-search t) ! 604: (size ! 605: ;; Get the numeric value from the Content-Length field. ! 606: (save-excursion ! 607: ;; Back up to end of prev line, ! 608: ;; in case the Content-Length field comes first. ! 609: (forward-char -1) ! 610: (and (search-forward "\ncontent-length: " ! 611: header-end t) ! 612: (let ((beg (point)) ! 613: (eol (progn (end-of-line) (point)))) ! 614: (read (buffer-substring beg eol))))))) ! 615: (if size ! 616: (goto-char (+ header-end size)))) ! 617: ! 618: (if (re-search-forward ! 619: (concat "^[\^_]?\\(" ! 620: rmail-unix-mail-delimiter ! 621: "\\|" ! 622: mmdf-delim1 "\\|" ! 623: "^BABYL OPTIONS:\\|" ! 624: "\^L\n[01],\\)") nil t) ! 625: (goto-char (match-beginning 1)) ! 626: (goto-char (point-max))) ! 627: (setq count (1+ count)) ! 628: (save-excursion ! 629: (save-restriction ! 630: (narrow-to-region start (point)) ! 631: (goto-char (point-min)) ! 632: (while (search-forward "\n\^_" nil t); single char ! 633: (replace-match "\n^_")))); 2 chars: "^" and "_" ! 634: (insert ?\^_) ! 635: (narrow-to-region (point) (point-max))) ! 636: ;; ! 637: ;;This is a kludge, in case we're wrong about mmdf not ! 638: ;;allowing anything in between. If it loses, we'll have ! 639: ;;to look for something else ! 640: (t (delete-char 1))))) ! 641: count)) ! 642: ! 643: (defun rmail-nuke-pinhead-header () ! 644: (save-excursion ! 645: (save-restriction ! 646: (let ((start (point)) ! 647: (end (progn ! 648: (condition-case () ! 649: (search-forward "\n\n") ! 650: (error ! 651: (goto-char (point-max)) ! 652: (insert "\n\n"))) ! 653: (point))) ! 654: has-from has-date) ! 655: (narrow-to-region start end) ! 656: (let ((case-fold-search t)) ! 657: (goto-char start) ! 658: (setq has-from (search-forward "\nFrom:" nil t)) ! 659: (goto-char start) ! 660: (setq has-date (and (search-forward "\nDate:" nil t) (point))) ! 661: (goto-char start)) ! 662: (let ((case-fold-search nil)) ! 663: (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) ! 664: (replace-match ! 665: (concat ! 666: ;; Keep and reformat the date if we don't ! 667: ;; have a Date: field. ! 668: (if has-date ! 669: "" ! 670: ;; If no time zone specified, assume est. ! 671: (if (= (match-beginning 7) (match-end 7)) ! 672: "Date: \\3, \\5 \\4 \\9 \\6 EST\n" ! 673: "Date: \\3, \\5 \\4 \\9 \\6\\7\n")) ! 674: ;; Keep and reformat the sender if we don't ! 675: ;; have a From: field. ! 676: (if has-from ! 677: "" ! 678: "From: \\1\n"))))))))) ! 679: ! 680: ;;;; *** Rmail Message Formatting and Header Manipulation *** ! 681: ! 682: (defun rmail-reformat-message (beg end) ! 683: (goto-char beg) ! 684: (forward-line 1) ! 685: (if (/= (following-char) ?0) ! 686: (error "Bad format in RMAIL file.")) ! 687: (let ((buffer-read-only nil) ! 688: (delta (- (buffer-size) end))) ! 689: (delete-char 1) ! 690: (insert ?1) ! 691: (forward-line 1) ! 692: (if (looking-at "Summary-line: ") ! 693: (forward-line 1)) ! 694: (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") ! 695: (delete-region (point) ! 696: (progn (forward-line 1) (point)))) ! 697: (let ((str (buffer-substring (point) ! 698: (save-excursion (search-forward "\n\n" end 'move) ! 699: (point))))) ! 700: (insert str "*** EOOH ***\n") ! 701: (narrow-to-region (point) (- (buffer-size) delta))) ! 702: (goto-char (point-min)) ! 703: (if rmail-ignored-headers (rmail-clear-headers)) ! 704: (if rmail-message-filter (funcall rmail-message-filter)))) ! 705: ! 706: (defun rmail-clear-headers () ! 707: (if (search-forward "\n\n" nil t) ! 708: (save-restriction ! 709: (narrow-to-region (point-min) (point)) ! 710: (let ((buffer-read-only nil)) ! 711: (while (let ((case-fold-search t)) ! 712: (goto-char (point-min)) ! 713: (re-search-forward rmail-ignored-headers nil t)) ! 714: (beginning-of-line) ! 715: (delete-region (point) ! 716: (progn (re-search-forward "\n[^ \t]") ! 717: (forward-char -1) ! 718: (point)))))))) ! 719: ! 720: (defun rmail-toggle-header () ! 721: "Show original message header if pruned header currently shown, or vice versa." ! 722: (interactive) ! 723: (rmail-maybe-set-message-counters) ! 724: (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) ! 725: (let ((buffer-read-only nil)) ! 726: (goto-char (point-min)) ! 727: (forward-line 1) ! 728: (if (= (following-char) ?1) ! 729: (progn (delete-char 1) ! 730: (insert ?0) ! 731: (forward-line 1) ! 732: (if (looking-at "Summary-Line:") ! 733: (forward-line 1)) ! 734: (insert "*** EOOH ***\n") ! 735: (forward-char -1) ! 736: (search-forward "\n*** EOOH ***\n") ! 737: (forward-line -1) ! 738: (let ((temp (point))) ! 739: (and (search-forward "\n\n" nil t) ! 740: (delete-region temp (point)))) ! 741: (goto-char (point-min)) ! 742: (search-forward "\n*** EOOH ***\n") ! 743: (narrow-to-region (point) (point-max))) ! 744: (rmail-reformat-message (point-min) (point-max))))) ! 745: ! 746: ;;;; *** Rmail Attributes and Keywords *** ! 747: ! 748: ;; Make a string describing current message's attributes and keywords ! 749: ;; and set it up as the name of a minor mode ! 750: ;; so it will appear in the mode line. ! 751: (defun rmail-display-labels () ! 752: (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) ! 753: (save-excursion ! 754: (unwind-protect ! 755: (progn ! 756: (widen) ! 757: (goto-char (rmail-msgbeg rmail-current-message)) ! 758: (forward-line 1) ! 759: (if (looking-at "[01],") ! 760: (progn ! 761: (narrow-to-region (point) (progn (end-of-line) (point))) ! 762: ;; Truly valid BABYL format requires a space before each ! 763: ;; attribute or keyword name. Put them in if missing. ! 764: (let (buffer-read-only) ! 765: (goto-char (point-min)) ! 766: (while (search-forward "," nil t) ! 767: (or (looking-at "[ ,]") (eobp) ! 768: (insert " ")))) ! 769: (goto-char (point-max)) ! 770: (if (search-backward ",," nil 'move) ! 771: (progn ! 772: (if (> (point) (1+ (point-min))) ! 773: (setq blurb (buffer-substring (+ 1 (point-min)) (point)))) ! 774: (if (> (- (point-max) (point)) 2) ! 775: (setq blurb ! 776: (concat blurb ! 777: ";" ! 778: (buffer-substring (+ (point) 3) ! 779: (1- (point-max))))))))))) ! 780: (narrow-to-region beg end) ! 781: (set-marker beg nil) ! 782: (set-marker end nil))) ! 783: (while (string-match " +," blurb) ! 784: (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," ! 785: (substring blurb (match-end 0))))) ! 786: (while (string-match ", +" blurb) ! 787: (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," ! 788: (substring blurb (match-end 0))))) ! 789: (setq mode-line-process ! 790: (concat " " rmail-current-message "/" rmail-total-messages ! 791: blurb)))) ! 792: ! 793: ;; Turn an attribute of the current message on or off according to STATE. ! 794: ;; ATTR is the name of the attribute, as a string. ! 795: (defun rmail-set-attribute (attr state) ! 796: (let ((omax (- (buffer-size) (point-max))) ! 797: (omin (- (buffer-size) (point-min))) ! 798: (buffer-read-only nil)) ! 799: (unwind-protect ! 800: (save-excursion ! 801: (widen) ! 802: (goto-char (+ 3 (rmail-msgbeg rmail-current-message))) ! 803: (let ((curstate (search-backward (concat ", " attr ",") ! 804: (prog1 (point) (end-of-line)) t))) ! 805: (or (eq curstate (not (not state))) ! 806: (if curstate ! 807: (delete-region (point) (1- (match-end 0))) ! 808: (beginning-of-line) ! 809: (forward-char 2) ! 810: (insert " " attr ",")))) ! 811: (if (string= attr "deleted") ! 812: (rmail-set-message-deleted-p rmail-current-message state))) ! 813: (narrow-to-region (max 1 (- (buffer-size) omin)) ! 814: (- (buffer-size) omax)) ! 815: (rmail-display-labels)))) ! 816: ! 817: ;; Return t if the attributes/keywords line of msg number MSG ! 818: ;; contains a match for the regexp LABELS. ! 819: (defun rmail-message-labels-p (msg labels) ! 820: (goto-char (rmail-msgbeg msg)) ! 821: (forward-char 3) ! 822: (re-search-backward labels (prog1 (point) (end-of-line)) t)) ! 823: ! 824: ;;;; *** Rmail Message Selection And Support *** ! 825: ! 826: (defun rmail-msgend (n) ! 827: (marker-position (aref rmail-message-vector (1+ n)))) ! 828: ! 829: (defun rmail-msgbeg (n) ! 830: (marker-position (aref rmail-message-vector n))) ! 831: ! 832: (defun rmail-widen-to-current-msgbeg (function) ! 833: "Call FUNCTION with point at start of internal data of current message. ! 834: Assumes that bounds were previously narrowed to display the message in Rmail. ! 835: The bounds are widened enough to move point where desired, ! 836: then narrowed again afterward. ! 837: Assumes that the visible text of the message is not changed by FUNCTION." ! 838: (save-excursion ! 839: (let ((obeg (- (point-max) (point-min))) ! 840: (unwind-protect ! 841: (progn ! 842: (narrow-to-region (rmail-msgbeg rmail-current-message) ! 843: (point-max)) ! 844: (goto-char (point-min)) ! 845: (funcall function)) ! 846: (narrow-to-region (- (point-max) obeg) (point-max))))))) ! 847: ! 848: (defun rmail-forget-messages () ! 849: (unwind-protect ! 850: (if (vectorp rmail-message-vector) ! 851: (let* ((i 0) ! 852: (v rmail-message-vector) ! 853: (n (length v))) ! 854: (while (< i n) ! 855: (move-marker (aref v i) nil) ! 856: (setq i (1+ i))))) ! 857: (setq rmail-message-vector nil) ! 858: (setq rmail-deleted-vector nil))) ! 859: ! 860: (defun rmail-maybe-set-message-counters () ! 861: (if (not (and rmail-deleted-vector ! 862: rmail-message-vector ! 863: rmail-current-message ! 864: rmail-total-messages)) ! 865: (rmail-set-message-counters))) ! 866: ! 867: (defun rmail-count-new-messages (&optional nomsg) ! 868: (let* ((case-fold-search nil) ! 869: (total-messages 0) ! 870: (messages-head nil) ! 871: (deleted-head nil)) ! 872: (or nomsg (message "Counting new messages...")) ! 873: (goto-char (point-max)) ! 874: ;; Put at the end of messages-head ! 875: ;; the entry for message N+1, which marks ! 876: ;; the end of message N. (N = number of messages). ! 877: (search-backward "\^_") ! 878: (setq messages-head (list (point-marker))) ! 879: (rmail-set-message-counters-counter (point-min)) ! 880: (setq rmail-current-message (1+ rmail-total-messages)) ! 881: (setq rmail-total-messages ! 882: (+ rmail-total-messages total-messages)) ! 883: (setq rmail-message-vector ! 884: (vconcat rmail-message-vector (cdr messages-head))) ! 885: (aset rmail-message-vector ! 886: rmail-current-message (car messages-head)) ! 887: (setq rmail-deleted-vector ! 888: (concat rmail-deleted-vector deleted-head)) ! 889: (setq rmail-summary-vector ! 890: (vconcat rmail-summary-vector (make-vector total-messages nil))) ! 891: (goto-char (point-min)) ! 892: (or nomsg (message "Counting new messages...done (%d)" total-messages)))) ! 893: ! 894: (defun rmail-set-message-counters () ! 895: (rmail-forget-messages) ! 896: (save-excursion ! 897: (save-restriction ! 898: (widen) ! 899: (let* ((point-save (point)) ! 900: (total-messages 0) ! 901: (messages-after-point) ! 902: (case-fold-search nil) ! 903: (messages-head nil) ! 904: (deleted-head nil)) ! 905: (message "Counting messages...") ! 906: (goto-char (point-max)) ! 907: ;; Put at the end of messages-head ! 908: ;; the entry for message N+1, which marks ! 909: ;; the end of message N. (N = number of messages). ! 910: (search-backward "\^_") ! 911: (setq messages-head (list (point-marker))) ! 912: (rmail-set-message-counters-counter (min (point) point-save)) ! 913: (setq messages-after-point total-messages) ! 914: (rmail-set-message-counters-counter) ! 915: (setq rmail-total-messages total-messages) ! 916: (setq rmail-current-message ! 917: (min total-messages ! 918: (max 1 (- total-messages messages-after-point)))) ! 919: (setq rmail-message-vector ! 920: (apply 'vector (cons (point-min-marker) messages-head)) ! 921: rmail-deleted-vector (concat "D" deleted-head) ! 922: rmail-summary-vector (make-vector rmail-total-messages nil)) ! 923: (message "Counting messages...done"))))) ! 924: ! 925: (defun rmail-set-message-counters-counter (&optional stop) ! 926: (while (search-backward "\^_\^L\n" stop t) ! 927: (setq messages-head (cons (point-marker) messages-head)) ! 928: (save-excursion ! 929: (setq deleted-head ! 930: (cons (if (search-backward ", deleted," ! 931: (prog1 (point) ! 932: (forward-line 2)) ! 933: t) ! 934: ?D ?\ ) ! 935: deleted-head))) ! 936: (if (zerop (% (setq total-messages (1+ total-messages)) 20)) ! 937: (message "Counting messages...%d" total-messages)))) ! 938: ! 939: (defun rmail-beginning-of-message () ! 940: "Show current message starting from the beginning." ! 941: (interactive) ! 942: (rmail-show-message rmail-current-message)) ! 943: ! 944: (defun rmail-show-message (&optional n) ! 945: "Show message number N (prefix argument), counting from start of file." ! 946: (interactive "p") ! 947: (rmail-maybe-set-message-counters) ! 948: (widen) ! 949: (if (zerop rmail-total-messages) ! 950: (progn (narrow-to-region (point-min) (1- (point-max))) ! 951: (goto-char (point-min)) ! 952: (setq mode-line-process nil)) ! 953: (let (blurb) ! 954: (if (not n) ! 955: (setq n rmail-current-message) ! 956: (cond ((<= n 0) ! 957: (setq n 1 ! 958: rmail-current-message 1 ! 959: blurb "No previous message")) ! 960: ((> n rmail-total-messages) ! 961: (setq n rmail-total-messages ! 962: rmail-current-message rmail-total-messages ! 963: blurb "No following message")) ! 964: (t ! 965: (setq rmail-current-message n)))) ! 966: (let ((beg (rmail-msgbeg n)) ! 967: (end (rmail-msgend n))) ! 968: (goto-char beg) ! 969: (forward-line 1) ! 970: (if (= (following-char) ?0) ! 971: (progn ! 972: (rmail-reformat-message beg end) ! 973: (rmail-set-attribute "unseen" nil)) ! 974: (search-forward "\n*** EOOH ***\n" end t) ! 975: (narrow-to-region (point) end)) ! 976: (goto-char (point-min)) ! 977: (rmail-display-labels) ! 978: (run-hooks 'rmail-show-message-hook) ! 979: (if blurb ! 980: (message blurb)))))) ! 981: ! 982: (defun rmail-next-message (n) ! 983: "Show following message whether deleted or not. ! 984: With prefix argument N, moves forward N messages, ! 985: or backward if N is negative." ! 986: (interactive "p") ! 987: (rmail-maybe-set-message-counters) ! 988: (rmail-show-message (+ rmail-current-message n))) ! 989: ! 990: (defun rmail-previous-message (n) ! 991: "Show previous message whether deleted or not. ! 992: With prefix argument N, moves backward N messages, ! 993: or forward if N is negative." ! 994: (interactive "p") ! 995: (rmail-next-message (- n))) ! 996: ! 997: (defun rmail-next-undeleted-message (n) ! 998: "Show following non-deleted message. ! 999: With prefix argument N, moves forward N non-deleted messages, ! 1000: or backward if N is negative." ! 1001: (interactive "p") ! 1002: (rmail-maybe-set-message-counters) ! 1003: (let ((lastwin rmail-current-message) ! 1004: (current rmail-current-message)) ! 1005: (while (and (> n 0) (< current rmail-total-messages)) ! 1006: (setq current (1+ current)) ! 1007: (if (not (rmail-message-deleted-p current)) ! 1008: (setq lastwin current n (1- n)))) ! 1009: (while (and (< n 0) (> current 1)) ! 1010: (setq current (1- current)) ! 1011: (if (not (rmail-message-deleted-p current)) ! 1012: (setq lastwin current n (1+ n)))) ! 1013: (if (/= lastwin rmail-current-message) ! 1014: (rmail-show-message lastwin)) ! 1015: (if (< n 0) ! 1016: (message "No previous nondeleted message")) ! 1017: (if (> n 0) ! 1018: (message "No following nondeleted message")))) ! 1019: ! 1020: (defun rmail-previous-undeleted-message (n) ! 1021: "Show previous non-deleted message. ! 1022: With prefix argument N, moves backward N non-deleted messages, ! 1023: or forward if N is negative." ! 1024: (interactive "p") ! 1025: (rmail-next-undeleted-message (- n))) ! 1026: ! 1027: (defun rmail-last-message () ! 1028: "Show last message in file." ! 1029: (interactive) ! 1030: (rmail-maybe-set-message-counters) ! 1031: (rmail-show-message rmail-total-messages)) ! 1032: ! 1033: (defun rmail-what-message () ! 1034: (let ((where (point)) ! 1035: (low 1) ! 1036: (high rmail-total-messages) ! 1037: (mid (/ rmail-total-messages 2))) ! 1038: (while (> (- high low) 1) ! 1039: (if (>= where (rmail-msgbeg mid)) ! 1040: (setq low mid) ! 1041: (setq high mid)) ! 1042: (setq mid (+ low (/ (- high low) 2)))) ! 1043: (if (>= where (rmail-msgbeg high)) high low))) ! 1044: ! 1045: (defvar rmail-search-last-regexp nil) ! 1046: (defun rmail-search (regexp &optional reversep) ! 1047: "Show message containing next match for REGEXP. ! 1048: Search in reverse (earlier messages) with non-nil 2nd arg REVERSEP. ! 1049: Interactively, empty argument means use same regexp used last time, ! 1050: and reverse search is specified by a negative numeric arg." ! 1051: (interactive ! 1052: (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) ! 1053: (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) ! 1054: regexp) ! 1055: (if rmail-search-last-regexp ! 1056: (setq prompt (concat prompt ! 1057: "(default " ! 1058: rmail-search-last-regexp ! 1059: ") "))) ! 1060: (setq regexp (read-string prompt)) ! 1061: (cond ((not (equal regexp "")) ! 1062: (setq rmail-search-last-regexp regexp)) ! 1063: ((not rmail-search-last-regexp) ! 1064: (error "No previous Rmail search string"))) ! 1065: (list rmail-search-last-regexp reversep))) ! 1066: (message "%sRmail search for %s..." ! 1067: (if reversep "Reverse " "") ! 1068: regexp) ! 1069: (rmail-maybe-set-message-counters) ! 1070: (let ((omin (point-min)) ! 1071: (omax (point-max)) ! 1072: (opoint (point)) ! 1073: win ! 1074: (msg rmail-current-message)) ! 1075: (unwind-protect ! 1076: (progn ! 1077: (widen) ! 1078: ;; Check messages one by one, advancing message number up or down ! 1079: ;; but searching forward through each message. ! 1080: (if reversep ! 1081: (while (and (null win) (> msg 1)) ! 1082: (goto-char (rmail-msgbeg (setq msg (1- msg)))) ! 1083: (setq win (re-search-forward ! 1084: regexp (rmail-msgend msg) t))) ! 1085: (while (and (null win) (< msg rmail-total-messages)) ! 1086: (goto-char (rmail-msgbeg (setq msg (1+ msg)))) ! 1087: (setq win (re-search-forward regexp (rmail-msgend msg) t))))) ! 1088: (if win ! 1089: (progn ! 1090: ;; If this is a reverse search and we found a message, ! 1091: ;; search backward thru this message to position point. ! 1092: (if reversep ! 1093: (progn ! 1094: (goto-char (rmail-msgend msg)) ! 1095: (re-search-backward ! 1096: regexp (rmail-msgbeg msg) t))) ! 1097: (setq win (point)) ! 1098: (rmail-show-message msg) ! 1099: (message "%sRmail search for %s...done" ! 1100: (if reversep "Reverse " "") ! 1101: regexp) ! 1102: (goto-char win)) ! 1103: (goto-char opoint) ! 1104: (narrow-to-region omin omax) ! 1105: (ding) ! 1106: (message "Searched failed: %s" regexp))))) ! 1107: ! 1108: ;;;; *** Rmail Message Deletion Commands *** ! 1109: ! 1110: (defun rmail-message-deleted-p (n) ! 1111: (= (aref rmail-deleted-vector n) ?D)) ! 1112: ! 1113: (defun rmail-set-message-deleted-p (n state) ! 1114: (aset rmail-deleted-vector n (if state ?D ?\ ))) ! 1115: ! 1116: (defun rmail-delete-message () ! 1117: "Delete this message and stay on it." ! 1118: (interactive) ! 1119: (rmail-set-attribute "deleted" t)) ! 1120: ! 1121: (defun rmail-undelete-previous-message () ! 1122: "Back up to deleted message, select it, and undelete it." ! 1123: (interactive) ! 1124: (let ((msg rmail-current-message)) ! 1125: (while (and (> msg 0) ! 1126: (not (rmail-message-deleted-p msg))) ! 1127: (setq msg (1- msg))) ! 1128: (if (= msg 0) ! 1129: (error "No previous deleted message") ! 1130: (if (/= msg rmail-current-message) ! 1131: (rmail-show-message msg)) ! 1132: (rmail-set-attribute "deleted" nil)))) ! 1133: ! 1134: (defun rmail-delete-forward (&optional backward) ! 1135: "Delete this message and move to next nondeleted one. ! 1136: Deleted messages stay in the file until the \\[rmail-expunge] command is given. ! 1137: With prefix argument, delete and move backward." ! 1138: (interactive "P") ! 1139: (rmail-set-attribute "deleted" t) ! 1140: (rmail-next-undeleted-message (if backward -1 1))) ! 1141: ! 1142: (defun rmail-delete-backward () ! 1143: "Delete this message and move to previous nondeleted one. ! 1144: Deleted messages stay in the file until the \\[rmail-expunge] command is given." ! 1145: (interactive) ! 1146: (rmail-delete-forward t)) ! 1147: ! 1148: (defun rmail-expunge () ! 1149: "Actually erase all deleted messages in the file." ! 1150: (interactive) ! 1151: (message "Expunging deleted messages...") ! 1152: ;; Discard any prior undo information. ! 1153: (or (eq buffer-undo-list t) ! 1154: (setq buffer-undo-list nil)) ! 1155: (rmail-maybe-set-message-counters) ! 1156: (let* ((omax (- (buffer-size) (point-max))) ! 1157: (omin (- (buffer-size) (point-min))) ! 1158: (opoint (if (and (> rmail-current-message 0) ! 1159: (= ?D (aref rmail-deleted-vector rmail-current-message))) ! 1160: 0 (- (point) (point-min)))) ! 1161: (messages-head (cons (aref rmail-message-vector 0) nil)) ! 1162: (messages-tail messages-head) ! 1163: ;; Don't make any undo records for the expunging itself. ! 1164: (buffer-undo-list t) ! 1165: (win)) ! 1166: (unwind-protect ! 1167: (save-excursion ! 1168: (widen) ! 1169: (goto-char (point-min)) ! 1170: (let ((counter 0) ! 1171: (number 1) ! 1172: (total rmail-total-messages) ! 1173: (new-message-number rmail-current-message) ! 1174: (new-summary nil) ! 1175: (buffer-read-only nil) ! 1176: (messages rmail-message-vector) ! 1177: (deleted rmail-deleted-vector) ! 1178: (summary rmail-summary-vector)) ! 1179: (setq rmail-total-messages nil ! 1180: rmail-current-message nil ! 1181: rmail-message-vector nil ! 1182: rmail-deleted-vector nil ! 1183: rmail-summary-vector nil) ! 1184: (while (<= number total) ! 1185: (if (= (aref deleted number) ?D) ! 1186: (progn ! 1187: (delete-region ! 1188: (marker-position (aref messages number)) ! 1189: (marker-position (aref messages (1+ number)))) ! 1190: (move-marker (aref messages number) nil) ! 1191: (if (> new-message-number counter) ! 1192: (setq new-message-number (1- new-message-number)))) ! 1193: (setq counter (1+ counter)) ! 1194: (setq messages-tail ! 1195: (setcdr messages-tail ! 1196: (cons (aref messages number) nil))) ! 1197: (setq new-summary ! 1198: (cons (if (= counter number) (aref summary (1- number))) ! 1199: new-summary))) ! 1200: (if (zerop (% (setq number (1+ number)) 20)) ! 1201: (message "Expunging deleted messages...%d" number))) ! 1202: (setq messages-tail ! 1203: (setcdr messages-tail ! 1204: (cons (aref messages number) nil))) ! 1205: (setq rmail-current-message new-message-number ! 1206: rmail-total-messages counter ! 1207: rmail-message-vector (apply 'vector messages-head) ! 1208: rmail-deleted-vector (make-string (1+ counter) ?\ ) ! 1209: rmail-summary-vector (vconcat (nreverse new-summary)) ! 1210: win t))) ! 1211: (message "Expunging deleted messages...done") ! 1212: (if (not win) ! 1213: (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) ! 1214: (rmail-show-message ! 1215: (if (zerop rmail-current-message) 1 nil)) ! 1216: (forward-char opoint)))) ! 1217: ! 1218: ;;;; *** Rmail Mailing Commands *** ! 1219: ! 1220: (defun rmail-mail () ! 1221: "Send mail in another window. ! 1222: While composing the message, use \\[mail-yank-original] to yank the ! 1223: original message into it." ! 1224: (interactive) ! 1225: (mail-other-window nil nil nil nil nil (current-buffer))) ! 1226: ! 1227: (defun rmail-continue () ! 1228: "Continue composing outgoing message previously being composed." ! 1229: (interactive) ! 1230: (mail-other-window t)) ! 1231: ! 1232: (defun rmail-reply (just-sender) ! 1233: "Reply to the current message. ! 1234: Normally include CC: to all other recipients of original message; ! 1235: prefix argument means ignore them. ! 1236: While composing the reply, use \\[mail-yank-original] to yank the ! 1237: original message into it." ! 1238: (interactive "P") ! 1239: ;;>> this gets set even if we abort. Can't do anything about it, though. ! 1240: (rmail-set-attribute "answered" t) ! 1241: (rmail-display-labels) ! 1242: (let (from reply-to cc subject date to message-id resent-reply-to) ! 1243: (save-excursion ! 1244: (save-restriction ! 1245: (widen) ! 1246: (goto-char (rmail-msgbeg rmail-current-message)) ! 1247: (forward-line 1) ! 1248: (if (= (following-char) ?0) ! 1249: (narrow-to-region ! 1250: (progn (forward-line 2) ! 1251: (point)) ! 1252: (progn (search-forward "\n\n" (rmail-msgend rmail-current-message) ! 1253: 'move) ! 1254: (point))) ! 1255: (narrow-to-region (point) ! 1256: (progn (search-forward "\n*** EOOH ***\n") ! 1257: (beginning-of-line) (point)))) ! 1258: (setq resent-reply-to (mail-fetch-field "resent-reply-to" t) ! 1259: from (mail-fetch-field "from") ! 1260: reply-to (or resent-reply-to ! 1261: (mail-fetch-field "reply-to" nil t) ! 1262: from) ! 1263: cc (cond (just-sender nil) ! 1264: (resent-reply-to (mail-fetch-field "resent-cc" t)) ! 1265: (t (mail-fetch-field "cc" nil t))) ! 1266: subject (or (and resent-reply-to ! 1267: (mail-fetch-field "resent-subject" t)) ! 1268: (mail-fetch-field "subject")) ! 1269: date (cond (resent-reply-to ! 1270: (mail-fetch-field "resent-date" t)) ! 1271: ((mail-fetch-field "date"))) ! 1272: to (cond (resent-reply-to ! 1273: (mail-fetch-field "resent-to" t)) ! 1274: ((mail-fetch-field "to" nil t)) ! 1275: ;((mail-fetch-field "apparently-to")) ack gag barf ! 1276: (t "")) ! 1277: message-id (cond (resent-reply-to ! 1278: (mail-fetch-field "resent-message-id" t)) ! 1279: ((mail-fetch-field "message-id")))))) ! 1280: (and subject ! 1281: (string-match "\\`Re: " subject) ! 1282: (setq subject (substring subject 4))) ! 1283: (mail-other-window nil ! 1284: (mail-strip-quoted-names reply-to) ! 1285: subject ! 1286: (rmail-make-in-reply-to-field from date message-id) ! 1287: (if just-sender ! 1288: nil ! 1289: (let* ((cc-list (rmail-dont-reply-to ! 1290: (mail-strip-quoted-names ! 1291: (if (null cc) to (concat to ", " cc)))))) ! 1292: (if (string= cc-list "") nil cc-list))) ! 1293: (current-buffer)))) ! 1294: ! 1295: (defun rmail-make-in-reply-to-field (from date message-id) ! 1296: (if mail-use-rfc822 (require 'rfc822)) ! 1297: (let (field) ! 1298: (if (and mail-use-rfc822 from) ! 1299: (let ((tem (car (rfc822-addresses from)))) ! 1300: (and message-id ! 1301: (setq field (if (string-match ! 1302: (regexp-quote ! 1303: (if (string-match "@[^@]*\\'" tem) ! 1304: (substring tem ! 1305: 0 (match-beginning 0)) ! 1306: tem)) ! 1307: message-id) ! 1308: message-id ! 1309: (concat message-id " \"" tem "\"")) ! 1310: message-id nil date nil)) ! 1311: (or field ! 1312: (setq field (prin1-to-string tem)))) ! 1313: ; (if message-id ! 1314: ; (setq field message-id message-id nil date nil) ! 1315: ; (setq field (car (rfc882-addresses from)))) ! 1316: ) ! 1317: (or field ! 1318: (not from) ! 1319: ;; Compute the sender for the in-reply-to; prefer full name. ! 1320: (let* ((stop-pos (string-match " *at \\| *@ \\| *<" from)) ! 1321: (start-pos (if stop-pos 0 ! 1322: ;;>> this loses on nested ()'s ! 1323: (let ((pos (string-match " *(" from))) ! 1324: (if (not pos) nil ! 1325: (setq stop-pos (string-match ")" from pos)) ! 1326: (if (zerop pos) 0 (+ 2 pos))))))) ! 1327: (setq field (if stop-pos ! 1328: (substring from start-pos stop-pos) ! 1329: from)))) ! 1330: (if date (setq field (concat field "'s message of " date))) ! 1331: (if message-id (setq field (concat field " " message-id))) ! 1332: field)) ! 1333: ! 1334: (defun rmail-forward () ! 1335: "Forward the current message to another user." ! 1336: (interactive) ! 1337: ;;>> this gets set even if we abort. Can't do anything about it, though. ! 1338: (rmail-set-attribute "forwarded" t) ! 1339: (let ((forward-buffer (current-buffer)) ! 1340: (subject (concat "[" ! 1341: (let ((from (or (mail-fetch-field "From") ! 1342: (mail-fetch-field ">From")))) ! 1343: (if from ! 1344: (concat (mail-strip-quoted-names from) ": ") ! 1345: "")) ! 1346: (or (mail-fetch-field "Subject") "") ! 1347: "]"))) ! 1348: ;; If only one window, use it for the mail buffer. ! 1349: ;; Otherwise, use another window for the mail buffer ! 1350: ;; so that the Rmail buffer remains visible ! 1351: ;; and sending the mail will get back to it. ! 1352: (if (if (one-window-p t) ! 1353: (mail nil nil subject) ! 1354: (mail-other-window nil nil subject)) ! 1355: (save-excursion ! 1356: (goto-char (point-max)) ! 1357: (forward-line 1) ! 1358: (insert-buffer forward-buffer))))) ! 1359: ! 1360: ;;;; *** Rmail Specify Inbox Files *** ! 1361: ! 1362: (autoload 'set-rmail-inbox-list "rmailmsc" ! 1363: "Set the inbox list of the current RMAIL file to FILE-NAME. ! 1364: This may be a list of file names separated by commas. ! 1365: If FILE-NAME is empty, remove any inbox list." ! 1366: t) ! 1367: ! 1368: ;;;; *** Rmail Commands for Labels *** ! 1369: ! 1370: (autoload 'rmail-add-label "rmailkwd" ! 1371: "Add LABEL to labels associated with current RMAIL message. ! 1372: Completion is performed over known labels when reading." ! 1373: t) ! 1374: ! 1375: (autoload 'rmail-kill-label "rmailkwd" ! 1376: "Remove LABEL from labels associated with current RMAIL message. ! 1377: Completion is performed over known labels when reading." ! 1378: t) ! 1379: ! 1380: (autoload 'rmail-next-labeled-message "rmailkwd" ! 1381: "Show next message with LABEL. Defaults to last label used. ! 1382: With prefix argument N moves forward N messages with this label." ! 1383: t) ! 1384: ! 1385: (autoload 'rmail-previous-labeled-message "rmailkwd" ! 1386: "Show previous message with LABEL. Defaults to last label used. ! 1387: With prefix argument N moves backward N messages with this label." ! 1388: t) ! 1389: ! 1390: ;;;; *** Rmail Edit Mode *** ! 1391: ! 1392: (autoload 'rmail-edit-current-message "rmailedit" ! 1393: "Edit the contents of the current message" ! 1394: t) ! 1395: ! 1396: ;;;; *** Rmail Summary Mode *** ! 1397: ! 1398: (autoload 'rmail-summary "rmailsum" ! 1399: "Display a summary of all messages, one line per message." ! 1400: t) ! 1401: ! 1402: (autoload 'rmail-summary-by-labels "rmailsum" ! 1403: "Display a summary of all messages with one or more LABELS. ! 1404: LABELS should be a string containing the desired labels, separated by commas." ! 1405: t) ! 1406: ! 1407: (autoload 'rmail-summary-by-recipients "rmailsum" ! 1408: "Display a summary of all messages with the given RECIPIENTS. ! 1409: Normally checks the To, From and Cc fields of headers; ! 1410: but if PRIMARY-ONLY is non-nil (prefix arg given), ! 1411: only look in the To and From fields. ! 1412: RECIPIENTS is a string of names separated by commas." ! 1413: t) ! 1414: ! 1415: ;;;; *** Rmail output messages to files *** ! 1416: ! 1417: (autoload 'rmail-output-to-rmail-file "rmailout" ! 1418: "Append the current message to an Rmail file named FILE-NAME. ! 1419: If the file does not exist, ask if it should be created. ! 1420: If file is being visited, the message is appended to the Emacs ! 1421: buffer visiting that file." ! 1422: t) ! 1423: ! 1424: (autoload 'rmail-output "rmailout" ! 1425: "Append this message to Unix mail file named FILE-NAME." ! 1426: t) ! 1427: ! 1428: ;;;; *** Rmail undigestification *** ! 1429: ! 1430: (autoload 'undigestify-rmail-message "undigest" ! 1431: "Break up a digest message into its constituent messages. ! 1432: Leaves original message, deleted, before the undigestified messages." ! 1433: t)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.