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