![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mh-e.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to mh-e.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 ! root 1: ;;; mh-e.el (Version: 3.8 for GNU Emacs Version 18 and MH.5 and MH.6) ! 2: ! 3: (defvar mh-e-RCS-id) ! 4: (setq mh-e-RCS-id "$Header: mh-e.el,v 3.5 92/01/21 11:21:59 gildea Exp $") ! 5: (setq mh-e-time-stamp "92/01/21 10:59:18 gildea") ! 6: (provide 'mh-e) ! 7: ! 8: ;;; Copyright (c) 1985,1986,1987,1988,1990,1992 Free Software Foundation ! 9: ;;; Maintainer: Stephen Gildea <[email protected]> ! 10: ;;; Please send suggestions and corrections to the above address. ! 11: ;;; ! 12: ;;; This file contains mh-e, a GNU Emacs front end to the MH mail system. ! 13: ! 14: ;; This file is part of GNU Emacs. ! 15: ! 16: ;; GNU Emacs is free software; you can redistribute it and/or modify ! 17: ;; it under the terms of the GNU General Public License as published by ! 18: ;; the Free Software Foundation; either version 1, or (at your option) ! 19: ;; any later version. ! 20: ! 21: ;; GNU Emacs is distributed in the hope that it will be useful, ! 22: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! 23: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 24: ;; GNU General Public License for more details. ! 25: ! 26: ;; You should have received a copy of the GNU General Public License ! 27: ;; along with GNU Emacs; see the file COPYING. If not, write to ! 28: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ! 29: ! 30: ! 31: ;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. ! 32: ;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. ! 33: ;;; Rewritten for GNU Emacs, James Larus 1985. [email protected] ! 34: ;;; Modified by Stephen Gildea, BBN, 1988, and MIT, 1990. [email protected] ! 35: ! 36: ! 37: ;;; NB. MH must have been compiled with the MHE compiler flag or several ! 38: ;;; features necessary mh-e will be missing from MH commands, specifically ! 39: ;;; the -build switch to repl and forw. ! 40: ! 41: ;;; HOW TO USE: ! 42: ;;; M-x mh-rmail to read mail. Type C-h m there for a list of commands. ! 43: ;;; C-u M-x mh-rmail to visit any folder. ! 44: ;;; M-x mh-smail to send mail. From within the mail reader, "m" works, too. ! 45: ;;; Your .emacs might benefit from these bindings: ! 46: ;;; (global-set-key "\C-xm" 'mh-smail) ! 47: ;;; (global-set-key "\C-x4m" 'mh-smail-other-window) ! 48: ;;; (global-set-key "\C-xr" 'mh-rmail) ;clobbers copy-rectangle-to-register ! 49: ! 50: ! 51: ! 52: ;;; Constants: ! 53: ! 54: ;;; Set for local environment: ! 55: ;;;* These are now in paths.el. ! 56: ;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.") ! 57: ;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.") ! 58: ! 59: (defvar mh-redist-full-contents nil ! 60: "Non-nil if the `dist' command needs whole letter for redistribution. ! 61: This is the case when `send' is compiled with the BERK option.") ! 62: ! 63: ! 64: ;;; Hooks: ! 65: ! 66: (defvar mh-folder-mode-hook nil ! 67: "Invoked in `mh-folder mode' on a new folder.") ! 68: ! 69: (defvar mh-letter-mode-hook nil ! 70: "Invoked in `mh-letter-mode' on a new letter.") ! 71: ! 72: (defvar mh-compose-letter-function nil ! 73: "Invoked in `mh-compose-and-send-mail' on a draft letter. ! 74: It is passed three arguments: TO recipients, SUBJECT, and CC recipients.") ! 75: ! 76: (defvar mh-before-send-letter-hook nil ! 77: "Invoked at the beginning of the \\[mh-send-letter] command.") ! 78: ! 79: (defvar mh-inc-folder-hook nil ! 80: "Invoked after incorporating mail into a folder with \\[mh-inc-folder].") ! 81: ! 82: (defvar mh-before-quit-hook nil ! 83: "Invoked by \\[mh-quit] before quitting mh-e. See also mh-quit-hook") ! 84: ! 85: (defvar mh-quit-hook nil ! 86: "Invoked after quitting mh-e by \\[mh-quit]. See also mh-before-quit-hook") ! 87: ! 88: ! 89: (defvar mh-ins-string nil ! 90: "Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.") ! 91: ! 92: (defvar mh-yank-hooks ! 93: '(lambda () ! 94: (save-excursion ! 95: (goto-char (point)) ! 96: (or (bolp) (forward-line 1)) ! 97: (while (< (point) (mark)) ! 98: (insert mh-ins-string) ! 99: (forward-line 1)))) ! 100: "Hook to run citation function. ! 101: Expects POINT and MARK to be set to the region to cite.") ! 102: ! 103: ! 104: ;;; Personal preferences: ! 105: ! 106: (defvar mh-clean-message-header nil ! 107: "*Non-nil means clean headers of messages that are displayed or inserted. ! 108: The variables `mh-visible-headers' and `mh-invisible-headers' control what ! 109: is removed.") ! 110: ! 111: (defvar mh-visible-headers nil ! 112: "*If non-nil, contains a regexp specifying the headers to keep when cleaning. ! 113: Only used if `mh-clean-message-header' is non-nil. Setting this variable ! 114: overrides `mh-invisible-headers'.") ! 115: ! 116: (defvar mhl-formfile nil ! 117: "*Name of format file to be used by mhl to show messages. ! 118: A value of T means use the default format file. ! 119: Nil means don't use mhl to format messages.") ! 120: ! 121: (defvar mh-lpr-command-format "lpr -p -J '%s'" ! 122: "*Format for Unix command that prints a message. ! 123: The string should be a Unix command line, with the string '%s' where ! 124: the job's name (folder and message number) should appear. The message text ! 125: is piped to this command.") ! 126: ! 127: (defvar mh-print-background nil ! 128: "*Print messages in the background if non-nil. ! 129: WARNING: do not delete the messages until printing is finished; ! 130: otherwise, your output may be truncated.") ! 131: ! 132: (defvar mh-summary-height 4 ! 133: "*Number of lines in summary window (including the mode line).") ! 134: ! 135: (defvar mh-recenter-summary-p nil ! 136: "*Recenter summary window when the show window is toggled off if non-nil.") ! 137: ! 138: (defvar mh-ins-buf-prefix "> " ! 139: "*String to put before each non-blank line of a yanked or inserted message. ! 140: Used when the message is inserted in an outgoing letter.") ! 141: ! 142: (defvar mh-do-not-confirm nil ! 143: "*Non-nil means do not prompt for confirmation before some commands. ! 144: Only affects certain innocuous commands.") ! 145: ! 146: (defvar mh-bury-show-buffer t ! 147: "*Non-nil means that the displayed show buffer for a folder is buried.") ! 148: ! 149: (defvar mh-delete-yanked-msg-window nil ! 150: "*Controls window display when a message is yanked by \\[mh-yank-cur-msg]. ! 151: If non-nil, yanking the current message into a draft letter deletes any ! 152: windows displaying the message.") ! 153: ! 154: (defvar mh-yank-from-start-of-msg t ! 155: "*Controls which part of a message is yanked by \\[mh-yank-cur-msg]. ! 156: If non-nil, include the entire message. If the symbol `body', then yank the ! 157: message minus the header. If nil, yank only the portion of the message ! 158: following the point. If the show buffer has a region, this variable is ! 159: ignored.") ! 160: ! 161: (defvar mh-reply-default-reply-to nil ! 162: "*Sets the person or persons to whom a reply will be sent. ! 163: If nil, prompt for recipient. If non-nil, then \\[mh-reply] will use this ! 164: value and it should be one of \"from\", \"to\", or \"cc\".") ! 165: ! 166: (defvar mh-recursive-folders nil ! 167: "*If non-nil, then commands which operate on folders do so recursively.") ! 168: ! 169: (defvar mh-unshar-default-directory "" ! 170: "*Default for directory name prompted for by mh-unshar-msg.") ! 171: ! 172: ! 173: ;;; Parameterize mh-e to work with different scan formats. The defaults work ! 174: ;;; with the standard MH scan listings. ! 175: ! 176: (defvar mh-cmd-note 4 ! 177: "Offset to insert notation.") ! 178: ! 179: (defvar mh-note-repl "-" ! 180: "String whose first character is used to notate replied to messages.") ! 181: ! 182: (defvar mh-note-forw "F" ! 183: "String whose first character is used to notate forwarded messages.") ! 184: ! 185: (defvar mh-note-dist "R" ! 186: "String whose first character is used to notate redistributed messages.") ! 187: ! 188: (defvar mh-good-msg-regexp "^....[^D^]" ! 189: "Regexp specifiying the scan lines that are 'good' messages.") ! 190: ! 191: (defvar mh-deleted-msg-regexp "^....D" ! 192: "Regexp matching scan lines of deleted messages.") ! 193: ! 194: (defvar mh-refiled-msg-regexp "^....\\^" ! 195: "Regexp matching scan lines of refiled messages.") ! 196: ! 197: (defvar mh-valid-scan-line "^ *[0-9]" ! 198: "Regexp matching scan lines for messages (not error messages).") ! 199: ! 200: (defvar mh-msg-number-regexp "^ *\\([0-9]+\\)" ! 201: "Regexp to find the number of a message in a scan line. ! 202: The message's number must be surrounded with \\( \\)") ! 203: ! 204: (defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]" ! 205: "Format string containing a regexp matching the scan listing for a message. ! 206: The desired message's number will be an argument to format.") ! 207: ! 208: (defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%" ! 209: "Regexp matching flagged scan lines. ! 210: Matches lines marked as deleted, refiled, in a sequence, or the cur message.") ! 211: ! 212: (defvar mh-cur-scan-msg-regexp "^....\\+" ! 213: "Regexp matching scan line for the cur message.") ! 214: ! 215: (defvar mh-show-buffer-mode-line-buffer-id "{%%b} %s/%d" ! 216: "Format string to produce `mode-line-buffer-id' for show buffers. ! 217: First argument is folder name. Second is message number.") ! 218: ! 219: (defvar mh-partial-folder-mode-line-annotation "select" ! 220: "Annotation when displaying part of a folder. ! 221: The string is displayed after the folder's name. NIL for no annotation.") ! 222: ! 223: ! 224: ;;; Real constants: ! 225: ! 226: (defvar mh-invisible-headers ! 227: "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-" ! 228: "Regexp matching lines in a message header that are not to be shown. ! 229: If `mh-visible-headers' is non-nil, it is used instead to specify what ! 230: to keep.") ! 231: ! 232: (defvar mh-rejected-letter-start ! 233: (concat "^ ----- Unsent message follows -----$" ;from mail system ! 234: "\\|^------- Unsent Draft$" ;from MH itself ! 235: "\\|^ --- The unsent message follows ---$") ;from AIX mail system ! 236: "Regexp specifying the beginning of the wrapper around a returned letter. ! 237: This wrapper is generated by the mail system when rejecting a letter.") ! 238: ! 239: (defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:") ! 240: (?b . "Bcc:") (?f . "Fcc:")) ! 241: "A-list of (character . field name) strings for mh-to-field.") ! 242: ! 243: ! 244: ;;; Global variables: ! 245: ! 246: (defvar mh-user-path "" ! 247: "User's mail folder.") ! 248: ! 249: (defvar mh-last-destination nil ! 250: "Destination of last refile or write command.") ! 251: ! 252: (defvar mh-folder-mode-map (make-keymap) ! 253: "Keymap for MH folders.") ! 254: ! 255: (defvar mh-letter-mode-map (copy-keymap text-mode-map) ! 256: "Keymap for composing mail.") ! 257: ! 258: (defvar mh-pick-mode-map (make-sparse-keymap) ! 259: "Keymap for searching folder.") ! 260: ! 261: (defvar mh-letter-mode-syntax-table nil ! 262: "Syntax table used while in mh-e letter mode.") ! 263: ! 264: (if mh-letter-mode-syntax-table ! 265: () ! 266: (setq mh-letter-mode-syntax-table ! 267: (make-syntax-table text-mode-syntax-table)) ! 268: (set-syntax-table mh-letter-mode-syntax-table) ! 269: (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) ! 270: ! 271: (defvar mh-folder-list nil ! 272: "List of folder names for completion.") ! 273: ! 274: (defvar mh-draft-folder nil ! 275: "Name of folder containing draft messages. ! 276: NIL means do not use draft folder.") ! 277: ! 278: (defvar mh-unseen-seq nil ! 279: "Name of the unseen sequence.") ! 280: ! 281: (defvar mh-previous-window-config nil ! 282: "Window configuration before mh-e command.") ! 283: ! 284: (defvar mh-previous-seq nil ! 285: "Name of the sequence to which a message was last added.") ! 286: ! 287: ! 288: ;;; Macros and generic functions: ! 289: ! 290: (defmacro mh-push (v l) ! 291: (list 'setq l (list 'cons v l))) ! 292: ! 293: ! 294: (defmacro mh-when (pred &rest body) ! 295: (list 'cond (cons pred body))) ! 296: ! 297: ! 298: (defmacro with-mh-folder-updating (save-modification-flag-p &rest body) ! 299: ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY). ! 300: ;; Execute BODY, which can modify the folder buffer without having to ! 301: ;; worry about file locking or the read-only flag, and return its result. ! 302: ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification ! 303: ;; flag is unchanged, otherwise it is cleared. ! 304: (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style ! 305: (` (let ((folder-updating-mod-flag (buffer-modified-p))) ! 306: (prog1 ! 307: (let ((buffer-read-only nil) ! 308: (buffer-file-name nil)) ; don't let the buffer get locked ! 309: (,@ body)) ! 310: (, (if save-modification-flag-p ! 311: '(mh-set-folder-modified-p folder-updating-mod-flag) ! 312: '(mh-set-folder-modified-p nil))))))) ! 313: ! 314: ! 315: (defun mh-mapc (func list) ! 316: (while list ! 317: (funcall func (car list)) ! 318: (setq list (cdr list)))) ! 319: ! 320: ! 321: ! 322: ;;; Entry points: ! 323: ! 324: ;;;###autoload ! 325: (defun mh-rmail (&optional arg) ! 326: "Inc(orporate) new mail (no arg) or scan a MH mail box (arg given). ! 327: This front end uses the MH mail system, which uses different conventions ! 328: from the usual mail system." ! 329: (interactive "P") ! 330: (mh-find-path) ! 331: (if arg ! 332: (call-interactively 'mh-visit-folder) ! 333: (mh-inc-folder))) ! 334: ! 335: ! 336: ;;;###autoload ! 337: (defun mh-smail () ! 338: "Compose and send mail with the MH mail system." ! 339: (interactive) ! 340: (mh-find-path) ! 341: (call-interactively 'mh-send)) ! 342: ! 343: ! 344: (defun mh-smail-other-window () ! 345: "Compose and send mail in other window with the MH mail system." ! 346: (interactive) ! 347: (mh-find-path) ! 348: (call-interactively 'mh-send-other-window)) ! 349: ! 350: ! 351: ! 352: ;;; User executable mh-e commands: ! 353: ! 354: (defun mh-burst-digest () ! 355: "Burst apart the current message, which should be a digest. ! 356: The message is replaced by its table of contents and the letters from the ! 357: digest are inserted into the folder after that message." ! 358: (interactive) ! 359: (let ((digest (mh-get-msg-num t))) ! 360: (mh-process-or-undo-commands mh-current-folder) ! 361: (mh-set-folder-modified-p t) ; lock folder while bursting ! 362: (message "Bursting digest...") ! 363: (mh-exec-cmd "burst" mh-current-folder digest "-inplace") ! 364: (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num)) ! 365: (message "Bursting digest...done"))) ! 366: ! 367: ! 368: (defun mh-copy-msg (prefix-provided msg-or-seq dest) ! 369: "Copy specified MESSAGE(s) to another FOLDER without deleting them. ! 370: Default is the displayed message. If optional prefix argument is ! 371: provided, then prompt for the message sequence." ! 372: (interactive (list current-prefix-arg ! 373: (if current-prefix-arg ! 374: (mh-read-seq-default "Copy" t) ! 375: (mh-get-msg-num t)) ! 376: (mh-prompt-for-folder "Copy to" "" t))) ! 377: (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest) ! 378: (if prefix-provided ! 379: (mh-notate-seq msg-or-seq ?C mh-cmd-note) ! 380: (mh-notate msg-or-seq ?C mh-cmd-note))) ! 381: ! 382: ! 383: (defun mh-delete-msg (msg-or-seq) ! 384: "Mark the specified MESSAGE(s) for subsequent deletion and move to the next. ! 385: Default is the displayed message. If optional prefix argument is ! 386: given then prompt for the message sequence." ! 387: (interactive (list (if current-prefix-arg ! 388: (mh-read-seq-default "Delete" t) ! 389: (mh-get-msg-num t)))) ! 390: (if (numberp msg-or-seq) ! 391: (mh-delete-a-msg msg-or-seq) ! 392: (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)) ! 393: (mh-next-msg)) ! 394: ! 395: ! 396: (defun mh-delete-msg-no-motion (msg-or-seq) ! 397: "Mark the specified MESSAGE(s) for subsequent deletion. ! 398: Default is the displayed message. If optional prefix argument is ! 399: provided, then prompt for the message sequence." ! 400: (interactive (list (if current-prefix-arg ! 401: (mh-read-seq-default "Delete" t) ! 402: (mh-get-msg-num t)))) ! 403: (if (numberp msg-or-seq) ! 404: (mh-delete-a-msg msg-or-seq) ! 405: (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) ! 406: ! 407: ! 408: (defun mh-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq) ! 409: "Delete MESSAGE (default: displayed message) from SEQUENCE. ! 410: If optional prefix argument provided, then delete all messages ! 411: from a sequence." ! 412: (interactive (let ((argp current-prefix-arg)) ! 413: (list argp ! 414: (if argp ! 415: (mh-read-seq-default "Delete" t) ! 416: (mh-get-msg-num t)) ! 417: (if (not argp) ! 418: (mh-read-seq-default "Delete from" t))))) ! 419: (if prefix-provided ! 420: (mh-remove-seq msg-or-seq) ! 421: (mh-remove-msg-from-seq msg-or-seq from-seq))) ! 422: ! 423: ! 424: (defun mh-edit-again (msg) ! 425: "Clean-up a draft or a message previously sent and make it resendable." ! 426: (interactive (list (mh-get-msg-num t))) ! 427: (let* ((from-folder mh-current-folder) ! 428: (config (current-window-configuration)) ! 429: (draft ! 430: (cond ((and mh-draft-folder (equal from-folder mh-draft-folder)) ! 431: (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t) ! 432: (rename-buffer (format "draft-%d" msg)) ! 433: (buffer-name)) ! 434: (t ! 435: (mh-read-draft "clean-up" (mh-msg-filename msg) nil))))) ! 436: (mh-clean-msg-header (point-min) ! 437: "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:" ! 438: nil) ! 439: (goto-char (point-min)) ! 440: (set-buffer-modified-p nil) ! 441: (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil ! 442: config))) ! 443: ! 444: ! 445: (defun mh-execute-commands () ! 446: "Process outstanding delete and refile requests." ! 447: (interactive) ! 448: (if mh-narrowed-to-seq (mh-widen)) ! 449: (mh-process-commands mh-current-folder) ! 450: (mh-set-scan-mode) ! 451: (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency ! 452: (mh-make-folder-mode-line) ! 453: t) ; return t for write-file-hooks ! 454: ! 455: ! 456: (defun mh-extract-rejected-mail (msg) ! 457: "Extract a letter returned by the mail system and make it resendable. ! 458: Default is the displayed message." ! 459: (interactive (list (mh-get-msg-num t))) ! 460: (let ((from-folder mh-current-folder) ! 461: (config (current-window-configuration)) ! 462: (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil))) ! 463: (goto-char (point-min)) ! 464: (cond ((re-search-forward mh-rejected-letter-start nil t) ! 465: (forward-char 1) ! 466: (delete-region (point-min) (point)) ! 467: (mh-clean-msg-header (point-min) ! 468: "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:" ! 469: nil)) ! 470: (t ! 471: (message "Does not appear to be a rejected letter."))) ! 472: (goto-char (point-min)) ! 473: (set-buffer-modified-p nil) ! 474: (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To") ! 475: (mh-get-field "From") (mh-get-field "cc") ! 476: nil nil config))) ! 477: ! 478: ! 479: (defun mh-first-msg () ! 480: "Move to the first message." ! 481: (interactive) ! 482: (goto-char (point-min))) ! 483: ! 484: ! 485: (defun mh-forward (prefix-provided msg-or-seq to cc) ! 486: "Forward MESSAGE(s) (default: displayed message). ! 487: If optional prefix argument provided, then prompt for the message sequence." ! 488: (interactive (list current-prefix-arg ! 489: (if current-prefix-arg ! 490: (mh-read-seq-default "Forward" t) ! 491: (mh-get-msg-num t)) ! 492: (read-string "To: ") ! 493: (read-string "Cc: "))) ! 494: (let* ((folder mh-current-folder) ! 495: (config (current-window-configuration)) ! 496: ;; forw always leaves file in "draft" since it doesn't have -draft ! 497: (draft-name (expand-file-name "draft" mh-user-path)) ! 498: (draft (cond ((or (not (file-exists-p draft-name)) ! 499: (y-or-n-p "The file 'draft' exists. Discard it? ")) ! 500: (mh-exec-cmd "forw" ! 501: "-build" mh-current-folder msg-or-seq) ! 502: (prog1 ! 503: (mh-read-draft "" draft-name t) ! 504: (mh-insert-fields "To:" to "Cc:" cc) ! 505: (set-buffer-modified-p nil))) ! 506: (t ! 507: (mh-read-draft "" draft-name nil))))) ! 508: (goto-char (point-min)) ! 509: (re-search-forward "^------- Forwarded Message") ! 510: (forward-line -1) ! 511: (narrow-to-region (point) (point-max)) ! 512: (let* ((subject (save-excursion (mh-get-field "From:"))) ! 513: (trim (string-match "<" subject)) ! 514: (forw-subject (save-excursion (mh-get-field "Subject:")))) ! 515: (if trim ! 516: (setq subject (substring subject 0 (1- trim)))) ! 517: (widen) ! 518: (save-excursion ! 519: (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject))) ! 520: (delete-other-windows) ! 521: (if prefix-provided ! 522: (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t) ! 523: (mh-add-msgs-to-seq msg-or-seq 'forwarded t)) ! 524: (mh-compose-and-send-mail draft "" folder msg-or-seq ! 525: to subject cc ! 526: mh-note-forw "Forwarded:" ! 527: config)))) ! 528: ! 529: ! 530: (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) ! 531: "Position the cursor at message NUMBER. ! 532: Non-nil second argument means do not signal an error if message does not exist. ! 533: Non-nil third argument means not to show the message. ! 534: Return non-nil if cursor is at message." ! 535: (interactive "NGoto message: ") ! 536: (let ((cur-msg (mh-get-msg-num nil)) ! 537: (starting-place (point)) ! 538: (msg-pattern (mh-msg-search-pat number))) ! 539: (cond ((cond ((and cur-msg (= cur-msg number)) t) ! 540: ((and cur-msg ! 541: (< cur-msg number) ! 542: (re-search-forward msg-pattern nil t)) t) ! 543: ((and cur-msg ! 544: (> cur-msg number) ! 545: (re-search-backward msg-pattern nil t)) t) ! 546: (t ; Do thorough search of buffer ! 547: (goto-char (point-max)) ! 548: (re-search-backward msg-pattern nil t))) ! 549: (beginning-of-line) ! 550: (if (not dont-show) (mh-maybe-show number)) ! 551: t) ! 552: (t ! 553: (goto-char starting-place) ! 554: (if (not no-error-if-no-message) ! 555: (error "No message %d" number)) ! 556: nil)))) ! 557: ! 558: ! 559: (defun mh-inc-folder (&optional maildrop-name) ! 560: "Inc(orporate) new mail into +inbox. ! 561: Optional prefix argument specifies an alternate maildrop from the default. ! 562: If this is given, incorporate mail into the current folder, rather ! 563: than +inbox. Run `mh-inc-folder-hook' after incorporating new mail." ! 564: (interactive (list (if current-prefix-arg ! 565: (expand-file-name ! 566: (read-file-name "inc mail from file: " ! 567: mh-user-path))))) ! 568: (let ((config (current-window-configuration))) ! 569: (if (not maildrop-name) ! 570: (cond ((not (get-buffer "+inbox")) ! 571: (mh-make-folder "+inbox") ! 572: (setq mh-previous-window-config config)) ! 573: ((not (eq (current-buffer) (get-buffer "+inbox"))) ! 574: (switch-to-buffer "+inbox") ! 575: (setq mh-previous-window-config config))))) ! 576: (mh-get-new-mail maildrop-name) ! 577: (run-hooks 'mh-inc-folder-hook)) ! 578: ! 579: ! 580: (defun mh-kill-folder () ! 581: "Remove the current folder." ! 582: (interactive) ! 583: (if (or mh-do-not-confirm ! 584: (yes-or-no-p (format "Remove folder %s? " mh-current-folder))) ! 585: (let ((folder mh-current-folder)) ! 586: (mh-set-folder-modified-p t) ; lock folder to kill it ! 587: (mh-exec-cmd-daemon "rmf" folder) ! 588: (mh-remove-folder-from-folder-list folder) ! 589: (message "Folder %s removed" folder) ! 590: (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain ! 591: (if (get-buffer mh-show-buffer) ! 592: (kill-buffer mh-show-buffer)) ! 593: (kill-buffer folder)) ! 594: (message "Folder not removed"))) ! 595: ! 596: ! 597: (defun mh-last-msg () ! 598: "Move to the last message." ! 599: (interactive) ! 600: (goto-char (point-max)) ! 601: (while (and (not (bobp)) (looking-at "^$")) ! 602: (forward-line -1))) ! 603: ! 604: ! 605: (defun mh-list-folders () ! 606: "List mail folders." ! 607: (interactive) ! 608: (with-output-to-temp-buffer " *mh-temp*" ! 609: (save-excursion ! 610: (switch-to-buffer " *mh-temp*") ! 611: (erase-buffer) ! 612: (message "Listing folders...") ! 613: (mh-exec-cmd-output "folders" t (if mh-recursive-folders ! 614: "-recurse" ! 615: "-norecurse")) ! 616: (goto-char (point-min)) ! 617: (message "Listing folders...done")))) ! 618: ! 619: ! 620: (defun mh-msg-is-in-seq (msg) ! 621: "Display the sequences that contain MESSAGE (default: displayed message)." ! 622: (interactive (list (mh-get-msg-num t))) ! 623: (message "Message %d is in sequences: %s" ! 624: msg ! 625: (mapconcat 'concat ! 626: (mh-list-to-string (mh-seq-containing-msg msg)) ! 627: " "))) ! 628: ! 629: ! 630: (defun mh-narrow-to-seq (seq) ! 631: "Restrict display of this folder to just messages in a sequence. ! 632: Reads which sequence. Use \\[mh-widen] to undo this command." ! 633: (interactive (list (mh-read-seq "Narrow to" t))) ! 634: (let ((eob (point-max))) ! 635: (with-mh-folder-updating (t) ! 636: (cond ((mh-seq-to-msgs seq) ! 637: (mh-copy-seq-to-point seq eob) ! 638: (narrow-to-region eob (point-max)) ! 639: (mh-make-folder-mode-line (symbol-name seq)) ! 640: (mh-recenter nil) ! 641: (setq mh-narrowed-to-seq seq)) ! 642: (t ! 643: (error "No messages in sequence `%s'" (symbol-name seq))))))) ! 644: ! 645: ! 646: (defun mh-next-undeleted-msg (&optional arg) ! 647: "Move to next undeleted message in window." ! 648: (interactive "P") ! 649: (forward-line (prefix-numeric-value arg)) ! 650: (setq mh-next-direction 'forward) ! 651: (cond ((re-search-forward mh-good-msg-regexp nil 0 arg) ! 652: (beginning-of-line) ! 653: (mh-maybe-show)) ! 654: (t ! 655: (forward-line -1) ! 656: (if (get-buffer mh-show-buffer) ! 657: (delete-windows-on mh-show-buffer))))) ! 658: ! 659: ! 660: (defun mh-pack-folder (range) ! 661: "Renumber the messages of a folder to be 1..n. ! 662: First, offer to execute any outstanding commands for the current folder. ! 663: If optional prefix argument provided, prompt for the range of messages ! 664: to display after packing. Otherwise, show the entire folder." ! 665: (interactive (list (if current-prefix-arg ! 666: (mh-read-msg-range ! 667: "Range to scan after packing [all]? ") ! 668: "all"))) ! 669: (mh-pack-folder-1 range) ! 670: (mh-goto-cur-msg) ! 671: (message "Packing folder...done")) ! 672: ! 673: ! 674: (defun mh-pipe-msg (prefix-provided command) ! 675: "Pipe the current message through the given shell COMMAND. ! 676: If optional prefix argument is provided, send the entire message. ! 677: Otherwise just send the message's body." ! 678: (interactive ! 679: (list current-prefix-arg (read-string "Shell command on message: "))) ! 680: (save-excursion ! 681: (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer ! 682: (goto-char (point-min)) ! 683: (if (not prefix-provided) (search-forward "\n\n")) ! 684: (shell-command-on-region (point) (point-max) command nil))) ! 685: ! 686: ! 687: (defun mh-refile-msg (prefix-provided msg-or-seq dest) ! 688: "Refile MESSAGE(s) (default: displayed message) in FOLDER. ! 689: If optional prefix argument provided, then prompt for message sequence." ! 690: (interactive ! 691: (list current-prefix-arg ! 692: (if current-prefix-arg ! 693: (mh-read-seq-default "Refile" t) ! 694: (mh-get-msg-num t)) ! 695: (intern ! 696: (mh-prompt-for-folder "Destination" ! 697: (if (eq 'refile (car mh-last-destination)) ! 698: (symbol-name (cdr mh-last-destination)) ! 699: "") ! 700: t)))) ! 701: (setq mh-last-destination (cons 'refile dest)) ! 702: (if prefix-provided ! 703: (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest) ! 704: (mh-refile-a-msg msg-or-seq dest)) ! 705: (mh-next-msg)) ! 706: ! 707: ! 708: (defun mh-refile-or-write-again (msg) ! 709: "Re-execute the last refile or write command on the given MESSAGE. ! 710: Default is the displayed message. Use the same folder or file as the ! 711: previous refile or write command." ! 712: (interactive (list (mh-get-msg-num t))) ! 713: (if (null mh-last-destination) ! 714: (error "No previous refile or write")) ! 715: (cond ((eq (car mh-last-destination) 'refile) ! 716: (mh-refile-a-msg msg (cdr mh-last-destination)) ! 717: (message "Destination folder: %s" (cdr mh-last-destination))) ! 718: (t ! 719: (mh-write-msg-to-file msg (cdr mh-last-destination)) ! 720: (message "Destination: %s" (cdr mh-last-destination)))) ! 721: (mh-next-msg)) ! 722: ! 723: ! 724: (defun mh-reply (prefix-provided msg) ! 725: "Reply to a MESSAGE (default: displayed message). ! 726: If optional prefix argument provided, then include the message in the reply ! 727: using filter mhl.reply in your MH directory." ! 728: (interactive (list current-prefix-arg (mh-get-msg-num t))) ! 729: (let ((minibuffer-help-form ! 730: "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) ! 731: (let ((reply-to (or mh-reply-default-reply-to ! 732: (completing-read "Reply to whom: " ! 733: '(("from") ("to") ("cc") ("all")) ! 734: nil ! 735: t))) ! 736: (folder mh-current-folder) ! 737: (show-buffer mh-show-buffer) ! 738: (config (current-window-configuration))) ! 739: (message "Composing a reply...") ! 740: (cond ((or (equal reply-to "from") (equal reply-to "")) ! 741: (apply 'mh-exec-cmd ! 742: "repl" "-build" "-noquery" ! 743: "-nodraftfolder" mh-current-folder ! 744: msg ! 745: "-nocc" "all" ! 746: (if prefix-provided ! 747: (list "-filter" "mhl.reply")))) ! 748: ((equal reply-to "to") ! 749: (apply 'mh-exec-cmd ! 750: "repl" "-build" "-noquery" ! 751: "-nodraftfolder" mh-current-folder ! 752: msg ! 753: "-cc" "to" ! 754: (if prefix-provided ! 755: (list "-filter" "mhl.reply")))) ! 756: ((or (equal reply-to "cc") (equal reply-to "all")) ! 757: (apply 'mh-exec-cmd ! 758: "repl" "-build" "-noquery" ! 759: "-nodraftfolder" mh-current-folder ! 760: msg ! 761: "-cc" "all" "-nocc" "me" ! 762: (if prefix-provided ! 763: (list "-filter" "mhl.reply"))))) ! 764: ! 765: (let ((draft (mh-read-draft "reply" ! 766: (expand-file-name "reply" mh-user-path) ! 767: t))) ! 768: (delete-other-windows) ! 769: (set-buffer-modified-p nil) ! 770: ! 771: (let ((to (mh-get-field "To:")) ! 772: (subject (mh-get-field "Subject:")) ! 773: (cc (mh-get-field "Cc:"))) ! 774: (goto-char (point-min)) ! 775: (mh-goto-header-end 1) ! 776: (if (not prefix-provided) ! 777: (mh-display-msg msg folder)) ! 778: (mh-add-msgs-to-seq msg 'answered t) ! 779: (message "Composing a reply...done") ! 780: (mh-compose-and-send-mail draft "" folder msg to subject cc ! 781: mh-note-repl "Replied:" config)))))) ! 782: ! 783: ! 784: (defun mh-quit () ! 785: "Quit mh-e. ! 786: Start by running mh-before-quit-hook. Restore the previous window ! 787: configuration, if one exists. Finish by running mh-quit-hook." ! 788: (interactive) ! 789: (run-hooks 'mh-before-quit-hook) ! 790: (if mh-previous-window-config ! 791: (set-window-configuration mh-previous-window-config)) ! 792: (run-hooks 'mh-quit-hook)) ! 793: ! 794: ! 795: (defun mh-page-digest () ! 796: "Advance displayed message to next digested message." ! 797: (interactive) ! 798: (save-excursion ! 799: (mh-show-message-in-other-window) ! 800: ;; Go to top of screen (in case user moved point). ! 801: (move-to-window-line 0) ! 802: (let ((case-fold-search nil)) ! 803: ;; Search for blank line and then for From: ! 804: (mh-when (not (and (search-forward "\n\n" nil t) ! 805: (search-forward "From:" nil t))) ! 806: (other-window -1) ! 807: (error "No more messages"))) ! 808: ;; Go back to previous blank line, then forward to the first non-blank. ! 809: (search-backward "\n\n" nil t) ! 810: (forward-line 2) ! 811: (mh-recenter 0) ! 812: (other-window -1))) ! 813: ! 814: ! 815: (defun mh-page-digest-backwards () ! 816: "Back up displayed message to previous digested message." ! 817: (interactive) ! 818: (save-excursion ! 819: (mh-show-message-in-other-window) ! 820: ;; Go to top of screen (in case user moved point). ! 821: (move-to-window-line 0) ! 822: (let ((case-fold-search nil)) ! 823: (beginning-of-line) ! 824: (mh-when (not (and (search-backward "\n\n" nil t) ! 825: (search-backward "From:" nil t))) ! 826: (other-window -1) ! 827: (error "No more messages"))) ! 828: ;; Go back to previous blank line, then forward to the first non-blank. ! 829: (search-backward "\n\n" nil t) ! 830: (forward-line 2) ! 831: (mh-recenter 0) ! 832: (other-window -1))) ! 833: ! 834: ! 835: (defun mh-page-msg (&optional arg) ! 836: "Page the displayed message forwards. ! 837: Scrolls ARG lines or a full screen if no argument is supplied." ! 838: (interactive "P") ! 839: (scroll-other-window arg)) ! 840: ! 841: ! 842: (defun mh-previous-page (&optional arg) ! 843: "Page the displayed message backwards. ! 844: Scrolls ARG lines or a full screen if no argument is supplied." ! 845: (interactive "P") ! 846: (save-excursion ! 847: (mh-show-message-in-other-window) ! 848: (unwind-protect ! 849: (scroll-down arg) ! 850: (other-window -1)))) ! 851: ! 852: ! 853: (defun mh-previous-undeleted-msg (&optional arg) ! 854: "Move to previous undeleted message in window." ! 855: (interactive "p") ! 856: (setq mh-next-direction 'backward) ! 857: (beginning-of-line) ! 858: (cond ((re-search-backward mh-good-msg-regexp nil 0 arg) ! 859: (mh-maybe-show)) ! 860: (t ! 861: (if (get-buffer mh-show-buffer) ! 862: (delete-windows-on mh-show-buffer))))) ! 863: ! 864: ! 865: (defun mh-print-msg (prefix-provided msg-or-seq) ! 866: "Print MESSAGE(s) (default: displayed message) on a line printer. ! 867: If optional prefix argument provided, then prompt for the message sequence." ! 868: (interactive (list current-prefix-arg ! 869: (if current-prefix-arg ! 870: (reverse (mh-seq-to-msgs ! 871: (mh-read-seq-default "Print" t))) ! 872: (mh-get-msg-num t)))) ! 873: (if prefix-provided ! 874: (message "Printing sequence...") ! 875: (message "Printing message...")) ! 876: (let ((print-command ! 877: (if prefix-provided ! 878: (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" ! 879: (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") ! 880: (expand-file-name "mhl" mh-lib) ! 881: (if (stringp mhl-formfile) ! 882: (format "-form %s" mhl-formfile) ! 883: "") ! 884: (mh-msg-filenames msg-or-seq) ! 885: (format mh-lpr-command-format ! 886: (if prefix-provided ! 887: (format "Sequence from %s" mh-current-folder) ! 888: (format "%s/%d" mh-current-folder ! 889: msg-or-seq)))) ! 890: (format "%s -nobell -clear %s %s | %s" ! 891: (expand-file-name "mhl" mh-lib) ! 892: (mh-msg-filename msg-or-seq) ! 893: (if (stringp mhl-formfile) ! 894: (format "-form %s" mhl-formfile) ! 895: "") ! 896: (format mh-lpr-command-format ! 897: (if prefix-provided ! 898: (format "Sequence from %s" mh-current-folder) ! 899: (format "%s/%d" mh-current-folder ! 900: msg-or-seq))))))) ! 901: (if mh-print-background ! 902: (mh-exec-cmd-daemon shell-file-name "-c" print-command) ! 903: (call-process shell-file-name nil nil nil "-c" print-command)) ! 904: (if prefix-provided ! 905: (mh-notate-seq msg-or-seq ?P mh-cmd-note) ! 906: (mh-notate msg-or-seq ?P mh-cmd-note)) ! 907: (mh-add-msgs-to-seq msg-or-seq 'printed t) ! 908: (if prefix-provided ! 909: (message "Printing sequence...done") ! 910: (message "Printing message...done")))) ! 911: ! 912: ! 913: (defun mh-put-msg-in-seq (prefix-provided from to) ! 914: "Add MESSAGE(s) (default: displayed message) to SEQUENCE. ! 915: If optional prefix argument provided, then prompt for the message sequence." ! 916: (interactive (list current-prefix-arg ! 917: (if current-prefix-arg ! 918: (mh-seq-to-msgs ! 919: (mh-read-seq-default "Add messages from" t)) ! 920: (mh-get-msg-num t)) ! 921: (mh-read-seq-default "Add to" nil))) ! 922: (setq mh-previous-seq to) ! 923: (mh-add-msgs-to-seq from to)) ! 924: ! 925: ! 926: (defun mh-rescan-folder (&optional range) ! 927: "Rescan a folder after optionally processing the outstanding commands. ! 928: If optional prefix argument is provided, prompt for the range of ! 929: messages to display. Otherwise show the entire folder." ! 930: (interactive (list (if current-prefix-arg ! 931: (mh-read-msg-range "Range to scan [all]? ") ! 932: nil))) ! 933: (setq mh-next-direction 'forward) ! 934: (mh-scan-folder mh-current-folder (or range "all"))) ! 935: ! 936: ! 937: (defun mh-redistribute (to cc msg) ! 938: "Redistribute a letter. ! 939: Depending on how your copy of MH was compiled, you may need to change the ! 940: setting of the variable mh-redist-full-contents. See its documentation." ! 941: (interactive (list (read-string "Redist-To: ") ! 942: (read-string "Redist-Cc: ") ! 943: (mh-get-msg-num t))) ! 944: (save-window-excursion ! 945: (let ((folder mh-current-folder) ! 946: (draft (mh-read-draft "redistribution" ! 947: (if mh-redist-full-contents ! 948: (mh-msg-filename msg) ! 949: nil) ! 950: nil))) ! 951: (mh-goto-header-end 0) ! 952: (insert "Resent-To: " to "\n") ! 953: (if (not (equal cc "")) (insert "Resent-cc: " cc "\n")) ! 954: (mh-clean-msg-header (point-min) ! 955: "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:" ! 956: nil) ! 957: (save-buffer) ! 958: (message "Redistributing...") ! 959: (if mh-redist-full-contents ! 960: (call-process "/bin/sh" nil 0 nil "-c" ! 961: (format "mhdist=1 mhaltmsg=%s %s -push %s" ! 962: (buffer-file-name) ! 963: (expand-file-name "send" mh-progs) ! 964: (buffer-file-name))) ! 965: (call-process "/bin/sh" nil 0 nil "-c" ! 966: (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s" ! 967: (mh-msg-filename msg folder) ! 968: (expand-file-name "send" mh-progs) ! 969: (buffer-file-name)))) ! 970: (mh-annotate-msg msg folder mh-note-dist ! 971: "-component" "Resent:" ! 972: "-text" (format "\"%s %s\"" to cc)) ! 973: (kill-buffer draft) ! 974: (message "Redistributing...done")))) ! 975: ! 976: ! 977: (defun mh-write-msg-to-file (msg file) ! 978: "Append MESSAGE to the end of a FILE." ! 979: (interactive ! 980: (list (mh-get-msg-num t) ! 981: (let ((default-dir (if (eq 'write (car mh-last-destination)) ! 982: (file-name-directory (cdr mh-last-destination)) ! 983: default-directory))) ! 984: (read-file-name "Save message in file: " default-dir ! 985: (expand-file-name "mail.out" default-dir))))) ! 986: (let ((file-name (mh-msg-filename msg)) ! 987: (output-file (mh-expand-file-name file))) ! 988: (setq mh-last-destination (cons 'write file)) ! 989: (save-excursion ! 990: (set-buffer (get-buffer-create " *mh-temp*")) ! 991: (erase-buffer) ! 992: (insert-file-contents file-name) ! 993: (append-to-file (point-min) (point-max) output-file)))) ! 994: ! 995: ! 996: (defun mh-search-folder (folder) ! 997: "Search FOLDER for messages matching a pattern." ! 998: (interactive (list (mh-prompt-for-folder "Search" ! 999: mh-current-folder ! 1000: t))) ! 1001: (switch-to-buffer-other-window "pick-pattern") ! 1002: (if (or (zerop (buffer-size)) ! 1003: (not (y-or-n-p "Reuse pattern? "))) ! 1004: (mh-make-pick-template) ! 1005: (message "")) ! 1006: (setq mh-searching-folder folder)) ! 1007: ! 1008: ! 1009: (defun mh-send (to cc subject) ! 1010: "Compose and send a letter. ! 1011: The letter is composed in mh-letter-mode; see its documentation for more ! 1012: details. If `mh-compose-letter-function' is defined, it is called on the ! 1013: draft and passed three arguments: to, subject, and cc." ! 1014: (interactive "sTo: \nsCc: \nsSubject: ") ! 1015: (let ((config (current-window-configuration))) ! 1016: (delete-other-windows) ! 1017: (mh-send-sub to cc subject config))) ! 1018: ! 1019: ! 1020: (defun mh-send-other-window (to cc subject) ! 1021: "Compose and send a letter in another window.." ! 1022: (interactive "sTo: \nsCc: \nsSubject: ") ! 1023: (let ((pop-up-windows t)) ! 1024: (mh-send-sub to cc subject (current-window-configuration)))) ! 1025: ! 1026: ! 1027: (defun mh-send-sub (to cc subject config) ! 1028: "Do the real work of composing and sending a letter. ! 1029: Expects the TO, CC, and SUBJECT fields as arguments. ! 1030: CONFIG is the window configuration before sending mail." ! 1031: (let ((folder mh-current-folder) ! 1032: (msg-num (mh-get-msg-num nil))) ! 1033: (message "Composing a message...") ! 1034: (let ((draft (mh-read-draft ! 1035: "message" ! 1036: (if (file-exists-p ! 1037: (expand-file-name "components" mh-user-path)) ! 1038: (expand-file-name "components" mh-user-path) ! 1039: (if (file-exists-p ! 1040: (expand-file-name "components" mh-lib)) ! 1041: (expand-file-name "components" mh-lib) ! 1042: (error "Can't find components file"))) ! 1043: nil))) ! 1044: (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) ! 1045: (set-buffer-modified-p nil) ! 1046: (goto-char (point-max)) ! 1047: (message "Composing a message...done") ! 1048: (mh-compose-and-send-mail draft "" folder msg-num ! 1049: to subject cc ! 1050: nil nil config)))) ! 1051: ! 1052: ! 1053: (defun mh-show (&optional msg) ! 1054: "Show MESSAGE (default: displayed message). ! 1055: Forces a two-window display with the folder window on top (size ! 1056: mh-summary-height) and the show buffer below it." ! 1057: (interactive) ! 1058: (if (not msg) ! 1059: (setq msg (mh-get-msg-num t))) ! 1060: (setq mh-showing t) ! 1061: (mh-set-mode-name "mh-e show") ! 1062: (if (not (eql (next-window (minibuffer-window)) (selected-window))) ! 1063: (delete-other-windows)) ; force ourself to the top window ! 1064: (let ((folder mh-current-folder)) ! 1065: (mh-show-message-in-other-window) ! 1066: (mh-display-msg msg folder)) ! 1067: (other-window -1) ! 1068: (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split ! 1069: (shrink-window (- (window-height) mh-summary-height))) ! 1070: (mh-recenter nil) ! 1071: (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list))) ! 1072: ! 1073: ! 1074: (defun mh-sort-folder () ! 1075: "Sort the messages in the current folder by date." ! 1076: (interactive) ! 1077: (mh-process-or-undo-commands mh-current-folder) ! 1078: (setq mh-next-direction 'forward) ! 1079: (mh-set-folder-modified-p t) ; lock folder while sorting ! 1080: (message "Sorting folder...") ! 1081: (mh-exec-cmd "sortm" mh-current-folder) ! 1082: (message "Sorting folder...done") ! 1083: (mh-scan-folder mh-current-folder "all")) ! 1084: ! 1085: ! 1086: (defun mh-toggle-showing () ! 1087: "Toggle the scanning mode/showing mode of displaying messages." ! 1088: (interactive) ! 1089: (if mh-showing ! 1090: (mh-set-scan-mode) ! 1091: (mh-show))) ! 1092: ! 1093: ! 1094: (defun mh-undo (prefix-provided msg-or-seq) ! 1095: "Undo the deletion or refile of the specified MESSAGE(s). ! 1096: Default is the displayed message. If optional prefix argument is ! 1097: provided, then prompt for the message sequence." ! 1098: (interactive (list current-prefix-arg ! 1099: (if current-prefix-arg ! 1100: (mh-read-seq-default "Undo" t) ! 1101: (mh-get-msg-num t)))) ! 1102: (cond (prefix-provided ! 1103: (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq))) ! 1104: (t ! 1105: (let ((original-position (point))) ! 1106: (beginning-of-line) ! 1107: (while (not (or (looking-at mh-deleted-msg-regexp) ! 1108: (looking-at mh-refiled-msg-regexp) ! 1109: (and (eq mh-next-direction 'forward) (bobp)) ! 1110: (and (eq mh-next-direction 'backward) ! 1111: (save-excursion (forward-line) (eobp))))) ! 1112: (forward-line (if (eq mh-next-direction 'forward) -1 1))) ! 1113: (if (or (looking-at mh-deleted-msg-regexp) ! 1114: (looking-at mh-refiled-msg-regexp)) ! 1115: (progn ! 1116: (mh-undo-msg (mh-get-msg-num t)) ! 1117: (mh-maybe-show)) ! 1118: (goto-char original-position) ! 1119: (error "Nothing to undo"))))) ! 1120: ;; update the mh-refile-list so mh-outstanding-commands-p will work ! 1121: (mh-mapc (function ! 1122: (lambda (elt) ! 1123: (if (not (mh-seq-to-msgs elt)) ! 1124: (setq mh-refile-list (delq elt mh-refile-list))))) ! 1125: mh-refile-list) ! 1126: (if (not (mh-outstanding-commands-p)) ! 1127: (mh-set-folder-modified-p nil))) ! 1128: ! 1129: ! 1130: (defun mh-undo-msg (msg) ! 1131: ;; Undo the deletion or refile of one MESSAGE. ! 1132: (cond ((memq msg mh-delete-list) ! 1133: (setq mh-delete-list (delq msg mh-delete-list)) ! 1134: (mh-remove-msg-from-seq msg 'deleted t)) ! 1135: (t ! 1136: (mh-mapc (function (lambda (dest) ! 1137: (mh-remove-msg-from-seq msg dest t))) ! 1138: mh-refile-list))) ! 1139: (mh-notate msg ? mh-cmd-note)) ! 1140: ! 1141: ! 1142: (defun mh-undo-folder (&rest ignore) ! 1143: "Undo all commands in current folder." ! 1144: (interactive) ! 1145: (cond ((or mh-do-not-confirm ! 1146: (yes-or-no-p "Undo all commands in folder? ")) ! 1147: (setq mh-delete-list nil ! 1148: mh-refile-list nil ! 1149: mh-seq-list nil ! 1150: mh-next-direction 'forward) ! 1151: (with-mh-folder-updating (nil) ! 1152: (mh-unmark-all-headers t))) ! 1153: (t ! 1154: (message "Commands not undone.") ! 1155: (sit-for 2)))) ! 1156: ! 1157: ! 1158: (defun mh-unshar-msg (dir) ! 1159: "Unpack the shar file contained in the current message into directory DIR." ! 1160: (interactive (list (read-file-name "Unshar message in directory: " ! 1161: mh-unshar-default-directory ! 1162: mh-unshar-default-directory nil))) ! 1163: (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer ! 1164: (mh-unshar-buffer dir)) ! 1165: ! 1166: (defun mh-unshar-buffer (dir) ! 1167: ;; Unpack the shar file contained in the current buffer into directory DIR. ! 1168: (goto-char (point-min)) ! 1169: (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t) ! 1170: (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t) ! 1171: (forward-line 1)) ! 1172: (re-search-forward "^#" nil t) ! 1173: (re-search-forward "^: " nil t)) ! 1174: (let ((default-directory (expand-file-name dir)) ! 1175: (start (progn (beginning-of-line) (point))) ! 1176: (log-buffer (get-buffer-create "*Unshar Output*"))) ! 1177: (save-excursion ! 1178: (set-buffer log-buffer) ! 1179: (setq default-directory (expand-file-name dir)) ! 1180: (erase-buffer) ! 1181: (if (file-directory-p default-directory) ! 1182: (insert "cd " dir "\n") ! 1183: (insert "mkdir " dir "\n") ! 1184: (call-process "mkdir" nil log-buffer t default-directory))) ! 1185: (set-window-start (display-buffer log-buffer) 0) ;so can watch progress ! 1186: (call-process-region start (point-max) "sh" nil log-buffer t)) ! 1187: (error "Cannot find start of shar."))) ! 1188: ! 1189: ! 1190: (defun mh-visit-folder (folder &optional range) ! 1191: "Visit FOLDER and display RANGE of messages. ! 1192: Assumes mh-e has already been initialized." ! 1193: (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t) ! 1194: (mh-read-msg-range "Range [all]? "))) ! 1195: (let ((config (current-window-configuration))) ! 1196: (mh-scan-folder folder (or range "all")) ! 1197: (setq mh-previous-window-config config)) ! 1198: nil) ! 1199: ! 1200: ! 1201: (defun mh-widen () ! 1202: "Remove restrictions from the current folder, thereby showing all messages." ! 1203: (interactive) ! 1204: (if mh-narrowed-to-seq ! 1205: (with-mh-folder-updating (t) ! 1206: (delete-region (point-min) (point-max)) ! 1207: (widen) ! 1208: (mh-make-folder-mode-line))) ! 1209: (setq mh-narrowed-to-seq nil)) ! 1210: ! 1211: ! 1212: ! 1213: ;;; Support routines. ! 1214: ! 1215: (defun mh-delete-a-msg (msg) ! 1216: ;; Delete the MESSAGE. ! 1217: (save-excursion ! 1218: (mh-goto-msg msg nil t) ! 1219: (if (looking-at mh-refiled-msg-regexp) ! 1220: (error "Message %d is refiled. Undo refile before deleting." msg)) ! 1221: (if (looking-at mh-deleted-msg-regexp) ! 1222: nil ! 1223: (mh-set-folder-modified-p t) ! 1224: (mh-push msg mh-delete-list) ! 1225: (mh-add-msgs-to-seq msg 'deleted t) ! 1226: (mh-notate msg ?D mh-cmd-note)))) ! 1227: ! 1228: ! 1229: (defun mh-refile-a-msg (msg destination) ! 1230: ;; Refile MESSAGE in FOLDER. FOLDER is a symbol, not a string. ! 1231: (save-excursion ! 1232: (mh-goto-msg msg nil t) ! 1233: (cond ((looking-at mh-deleted-msg-regexp) ! 1234: (error "Message %d is deleted. Undo delete before moving." msg)) ! 1235: ((looking-at mh-refiled-msg-regexp) ! 1236: (if (y-or-n-p ! 1237: (format "Message %d already refiled. Copy to %s as well? " ! 1238: msg destination)) ! 1239: (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" ! 1240: "-src" mh-current-folder ! 1241: (symbol-name destination)) ! 1242: (message "Message not copied."))) ! 1243: (t ! 1244: (mh-set-folder-modified-p t) ! 1245: (if (not (memq destination mh-refile-list)) ! 1246: (mh-push destination mh-refile-list)) ! 1247: (if (not (memq msg (mh-seq-to-msgs destination))) ! 1248: (mh-add-msgs-to-seq msg destination t)) ! 1249: (mh-notate msg ?^ mh-cmd-note))))) ! 1250: ! 1251: ! 1252: (defun mh-display-msg (msg-num folder) ! 1253: ;; Display message NUMBER of FOLDER. ! 1254: ;; Sets the current buffer to the show buffer. ! 1255: (set-buffer folder) ! 1256: ;; Bind variables in folder buffer in case they are local ! 1257: (let ((formfile mhl-formfile) ! 1258: (clean-message-header mh-clean-message-header) ! 1259: (invisible-headers mh-invisible-headers) ! 1260: (visible-headers mh-visible-headers) ! 1261: (msg-filename (mh-msg-filename msg-num)) ! 1262: (show-buffer mh-show-buffer) ! 1263: (folder mh-current-folder)) ! 1264: (if (not (file-exists-p msg-filename)) ! 1265: (error "Message %d does not exist" msg-num)) ! 1266: (switch-to-buffer show-buffer) ! 1267: (if mh-bury-show-buffer (bury-buffer (current-buffer))) ! 1268: (mh-when (not (equal msg-filename buffer-file-name)) ! 1269: ;; Buffer does not yet contain message. ! 1270: (clear-visited-file-modtime) ! 1271: (unlock-buffer) ! 1272: (setq buffer-file-name nil) ; no locking during setup ! 1273: (erase-buffer) ! 1274: (if formfile ! 1275: (if (stringp formfile) ! 1276: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" ! 1277: "-form" formfile msg-filename) ! 1278: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" ! 1279: msg-filename)) ! 1280: (insert-file-contents msg-filename)) ! 1281: (goto-char (point-min)) ! 1282: (cond (clean-message-header ! 1283: (mh-clean-msg-header (point-min) ! 1284: invisible-headers ! 1285: visible-headers) ! 1286: (goto-char (point-min))) ! 1287: (t ! 1288: (let ((case-fold-search t)) ! 1289: (re-search-forward ! 1290: "^To:\\|^From:\\|^Subject:\\|^Date:" nil t) ! 1291: (beginning-of-line) ! 1292: (mh-recenter 0)))) ! 1293: (set-buffer-modified-p nil) ! 1294: (setq buffer-file-name msg-filename) ! 1295: (set-mark nil) ! 1296: (setq mode-line-buffer-identification ! 1297: (list (format mh-show-buffer-mode-line-buffer-id ! 1298: folder msg-num)))))) ! 1299: ! 1300: ! 1301: (defun mh-invalidate-show-buffer () ! 1302: ;; Invalidate the show buffer so we must update it to use it. ! 1303: (if (get-buffer mh-show-buffer) ! 1304: (save-excursion ! 1305: (set-buffer mh-show-buffer) ! 1306: (setq buffer-file-name nil)))) ! 1307: ! 1308: ! 1309: (defun mh-show-message-in-other-window () ! 1310: (switch-to-buffer-other-window mh-show-buffer) ! 1311: (if mh-bury-show-buffer (bury-buffer (current-buffer)))) ! 1312: ! 1313: ! 1314: (defun mh-clean-msg-header (start invisible-headers visible-headers) ! 1315: ;; Flush extraneous lines in a message header, from the given POINT to the ! 1316: ;; end of the message header. If VISIBLE-HEADERS is non-nil, it contains a ! 1317: ;; regular expression specifying the lines to display, otherwise ! 1318: ;; INVISIBLE-HEADERS contains a regular expression specifying lines to ! 1319: ;; delete from the header. ! 1320: (let ((case-fold-search t)) ! 1321: (save-restriction ! 1322: (goto-char start) ! 1323: (if (search-forward "\n\n" nil t) ! 1324: (backward-char 1)) ! 1325: (narrow-to-region start (point)) ! 1326: (goto-char (point-min)) ! 1327: (if visible-headers ! 1328: (while (< (point) (point-max)) ! 1329: (beginning-of-line) ! 1330: (cond ((looking-at visible-headers) ! 1331: (forward-line 1) ! 1332: (while (looking-at "^[ \t]+") (forward-line 1))) ! 1333: (t ! 1334: (mh-delete-line 1) ! 1335: (while (looking-at "^[ \t]+") ! 1336: (beginning-of-line) ! 1337: (mh-delete-line 1))))) ! 1338: (while (re-search-forward invisible-headers nil t) ! 1339: (beginning-of-line) ! 1340: (mh-delete-line 1) ! 1341: (while (looking-at "^[ \t]+") ! 1342: (beginning-of-line) ! 1343: (mh-delete-line 1)))) ! 1344: (unlock-buffer)))) ! 1345: ! 1346: ! 1347: (defun mh-delete-line (lines) ! 1348: ;; Delete version of kill-line. ! 1349: (delete-region (point) (save-excursion (forward-line lines) (point)))) ! 1350: ! 1351: ! 1352: (defun mh-read-draft (use initial-contents delete-contents-file) ! 1353: ;; Read draft file into a draft buffer and make that buffer the current one. ! 1354: ;; USE is a message used for prompting about the intended use of the message. ! 1355: ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL ! 1356: ;; if buffer should not be modified. Delete the initial-contents file if ! 1357: ;; DELETE-CONTENTS-FILE flag is set. ! 1358: ;; Returns the draft folder's name. ! 1359: ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is ! 1360: ;; used each time and saved in the draft folder. The draft file can then be ! 1361: ;; reused. ! 1362: (cond (mh-draft-folder ! 1363: (let ((orig-default-dir default-directory)) ! 1364: (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t) ! 1365: (rename-buffer (format "draft-%s" (buffer-name))) ! 1366: (setq default-directory orig-default-dir))) ! 1367: (t ! 1368: (let ((draft-name (expand-file-name "draft" mh-user-path))) ! 1369: (pop-to-buffer "draft") ; Create if necessary ! 1370: (if (buffer-modified-p) ! 1371: (if (y-or-n-p "Draft has been modified; kill anyway? ") ! 1372: (set-buffer-modified-p nil) ! 1373: (error "Draft preserved"))) ! 1374: (setq buffer-file-name draft-name) ! 1375: (clear-visited-file-modtime) ! 1376: (unlock-buffer) ! 1377: (mh-when (and (file-exists-p draft-name) ! 1378: (not (equal draft-name initial-contents))) ! 1379: (insert-file-contents draft-name) ! 1380: (delete-file draft-name))))) ! 1381: (mh-when (and initial-contents ! 1382: (or (zerop (buffer-size)) ! 1383: (not (y-or-n-p ! 1384: (format "A draft exists. Use for %s? " use))))) ! 1385: (erase-buffer) ! 1386: (insert-file-contents initial-contents) ! 1387: (if delete-contents-file (delete-file initial-contents))) ! 1388: (auto-save-mode 1) ! 1389: (if mh-draft-folder ! 1390: (save-buffer)) ; Do not reuse draft name ! 1391: (buffer-name)) ! 1392: ! 1393: ! 1394: (defun mh-new-draft-name () ! 1395: ;; Returns the pathname of folder for draft messages. ! 1396: (save-excursion ! 1397: (set-buffer (get-buffer-create " *mh-temp*")) ! 1398: (erase-buffer) ! 1399: (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new") ! 1400: (buffer-substring (point) (1- (mark))))) ! 1401: ! 1402: ! 1403: (defun mh-next-msg () ! 1404: ;; Move backward or forward to the next undeleted message in the buffer. ! 1405: (if (eq mh-next-direction 'forward) ! 1406: (mh-next-undeleted-msg 1) ! 1407: (mh-previous-undeleted-msg 1))) ! 1408: ! 1409: ! 1410: (defun mh-set-scan-mode () ! 1411: ;; Display the scan listing buffer, but do not show a message. ! 1412: (if (get-buffer mh-show-buffer) ! 1413: (delete-windows-on mh-show-buffer)) ! 1414: (mh-set-mode-name "mh-e scan") ! 1415: (setq mh-showing nil) ! 1416: (if mh-recenter-summary-p ! 1417: (mh-recenter nil))) ! 1418: ! 1419: ! 1420: (defun mh-maybe-show (&optional msg) ! 1421: ;; If in showing mode, then display the message pointed to by the cursor. ! 1422: (if mh-showing (mh-show msg))) ! 1423: ! 1424: ! 1425: (defun mh-set-mode-name (mode-name-string) ! 1426: ;; Set the mode-name and ensure that the mode line is updated. ! 1427: (setq mode-name mode-name-string) ! 1428: ;; Force redisplay of all buffers' mode lines to be considered. ! 1429: (save-excursion (set-buffer (other-buffer))) ! 1430: (set-buffer-modified-p (buffer-modified-p))) ! 1431: ! 1432: ! 1433: ! 1434: ;;; The folder data abstraction. ! 1435: ! 1436: (defvar mh-current-folder nil "Name of current folder, a string.") ! 1437: (defvar mh-show-buffer nil "Buffer that displays mesage for this folder.") ! 1438: (defvar mh-folder-filename nil "Full path of directory for this folder.") ! 1439: (defvar mh-showing nil "If non-nil, show the message in a separate window.") ! 1440: (defvar mh-next-seq-num nil "Index of free sequence id.") ! 1441: (defvar mh-delete-list nil "List of msg numbers to delete.") ! 1442: (defvar mh-refile-list nil "List of folder names in mh-seq-list.") ! 1443: (defvar mh-seq-list nil "Alist of (seq . msgs) numbers.") ! 1444: (defvar mh-seen-list nil "List of displayed messages.") ! 1445: (defvar mh-next-direction 'forward "Direction to move to next message.") ! 1446: (defvar mh-narrowed-to-seq nil "Sequence display is narrowed to.") ! 1447: (defvar mh-first-msg-num nil "Number of first msg in buffer.") ! 1448: (defvar mh-last-msg-num nil "Number of last msg in buffer.") ! 1449: ! 1450: ! 1451: (defun mh-make-folder (name) ! 1452: ;; Create and initialize a new mail folder called NAME and make it the ! 1453: ;; current folder. ! 1454: (switch-to-buffer name) ! 1455: (setq buffer-read-only nil) ! 1456: (erase-buffer) ! 1457: (setq buffer-read-only t) ! 1458: (mh-folder-mode) ! 1459: (mh-set-folder-modified-p nil) ! 1460: (setq buffer-file-name mh-folder-filename) ! 1461: (mh-set-mode-name "mh-e scan")) ! 1462: ! 1463: ! 1464: ;;; Don't use this mode when creating buffers if default-major-mode is nil. ! 1465: (put 'mh-folder-mode 'mode-class 'special) ! 1466: ! 1467: (defun mh-folder-mode () ! 1468: "Major mode for \"editing\" an MH folder scan listing. ! 1469: Messages can be marked for refiling and deletion. However, both actions ! 1470: are deferred until you request execution with \\[mh-execute-commands]. ! 1471: \\{mh-folder-mode-map} ! 1472: A prefix argument (\\[universal-argument]) to delete, refile, list, or undo ! 1473: applies the action to a message sequence. ! 1474: ! 1475: Variables controlling mh-e operation are (defaults in parentheses): ! 1476: ! 1477: mh-bury-show-buffer (t) ! 1478: Non-nil means that the buffer used to display message is buried. ! 1479: It will never be offered as the default other buffer. ! 1480: ! 1481: mh-clean-message-header (nil) ! 1482: Non-nil means remove header lines matching the regular expression ! 1483: specified in mh-invisible-headers from messages. ! 1484: ! 1485: mh-visible-headers (nil) ! 1486: If non-nil, it contains a regexp specifying the headers that are shown in ! 1487: a message if mh-clean-message-header is non-nil. Setting this variable ! 1488: overrides mh-invisible-headers. ! 1489: ! 1490: mh-do-not-confirm (nil) ! 1491: Non-nil means do not prompt for confirmation before executing some ! 1492: non-recoverable commands such as mh-kill-folder and mh-undo-folder. ! 1493: ! 1494: mhl-formfile (nil) ! 1495: Name of format file to be used by mhl to show messages. ! 1496: A value of T means use the default format file. ! 1497: Nil means don't use mhl to format messages. ! 1498: ! 1499: mh-lpr-command-format (\"lpr -p -J '%s'\") ! 1500: Format for command used to print a message on a system printer. ! 1501: ! 1502: mh-recenter-summary-p (nil) ! 1503: If non-nil, then the scan listing is recentered when the window displaying ! 1504: a messages is toggled off. ! 1505: ! 1506: mh-summary-height (4) ! 1507: Number of lines in the summary window including the mode line. ! 1508: ! 1509: mh-ins-buf-prefix (\"> \") ! 1510: String to insert before each non-blank line of a message as it is ! 1511: inserted in a draft letter. ! 1512: ! 1513: The value of mh-folder-mode-hook is called when a new folder is set up." ! 1514: ! 1515: (kill-all-local-variables) ! 1516: (use-local-map mh-folder-mode-map) ! 1517: (setq major-mode 'mh-folder-mode) ! 1518: (mh-set-mode-name "mh-e folder") ! 1519: (make-local-vars ! 1520: 'mh-current-folder (buffer-name) ; Name of folder, a string ! 1521: 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs ! 1522: 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" ! 1523: (file-name-as-directory (mh-expand-file-name (buffer-name))) ! 1524: 'mh-showing nil ; Show message also? ! 1525: 'mh-next-seq-num 0 ; Index of free sequence id ! 1526: 'mh-delete-list nil ; List of msgs nums to delete ! 1527: 'mh-refile-list nil ; List of folder names in mh-seq-list ! 1528: 'mh-seq-list nil ; Alist of (seq . msgs) nums ! 1529: 'mh-seen-list nil ; List of displayed messages ! 1530: 'mh-next-direction 'forward ; Direction to move to next message ! 1531: 'mh-narrowed-to-seq nil ; Sequence display is narrowed to ! 1532: 'mh-first-msg-num nil ; Number of first msg in buffer ! 1533: 'mh-last-msg-num nil ; Number of last msg in buffer ! 1534: 'mh-previous-window-config nil) ; Previous window configuration ! 1535: (setq truncate-lines t) ! 1536: (auto-save-mode -1) ! 1537: (setq buffer-offer-save t) ! 1538: (make-local-variable 'write-file-hooks) ! 1539: (setq write-file-hooks '(mh-execute-commands)) ! 1540: (make-local-variable 'revert-buffer-function) ! 1541: (setq revert-buffer-function 'mh-undo-folder) ! 1542: (run-hooks 'mh-folder-mode-hook)) ! 1543: ! 1544: ! 1545: (defun make-local-vars (&rest pairs) ! 1546: ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the ! 1547: ;; value. ! 1548: (while pairs ! 1549: (make-variable-buffer-local (car pairs)) ! 1550: (set (car pairs) (car (cdr pairs))) ! 1551: (setq pairs (cdr (cdr pairs))))) ! 1552: ! 1553: ! 1554: (defun mh-scan-folder (folder range) ! 1555: ;; Scan the FOLDER over the RANGE. Return in the folder's buffer. ! 1556: (cond ((null (get-buffer folder)) ! 1557: (mh-make-folder folder)) ! 1558: (t ! 1559: (mh-process-or-undo-commands folder) ! 1560: (switch-to-buffer folder))) ! 1561: (mh-regenerate-headers range) ! 1562: (mh-when (zerop (buffer-size)) ! 1563: (if (equal range "all") ! 1564: (message "Folder %s is empty" folder) ! 1565: (message "No messages in %s, range %s" folder range)) ! 1566: (sit-for 5)) ! 1567: (mh-goto-cur-msg)) ! 1568: ! 1569: ! 1570: (defun mh-regenerate-headers (range) ! 1571: ;; Replace buffer with scan of its contents over range RANGE. ! 1572: (let ((folder mh-current-folder)) ! 1573: (message "Scanning %s..." folder) ! 1574: (with-mh-folder-updating (nil) ! 1575: (erase-buffer) ! 1576: (mh-exec-cmd-output "scan" nil ! 1577: "-noclear" "-noheader" ! 1578: "-width" (window-width) ! 1579: folder range) ! 1580: (goto-char (point-min)) ! 1581: (cond ((looking-at "scan: no messages in") ! 1582: (keep-lines mh-valid-scan-line)) ; Flush random scan lines ! 1583: ((looking-at "scan: ")) ; Keep error messages ! 1584: (t ! 1585: (keep-lines mh-valid-scan-line))) ; Flush random scan lines ! 1586: (mh-delete-seq-locally 'cur) ; To pick up new one ! 1587: (setq mh-seq-list (mh-read-folder-sequences folder nil)) ! 1588: (mh-notate-user-sequences) ! 1589: (mh-make-folder-mode-line (if (equal range "all") ! 1590: nil ! 1591: mh-partial-folder-mode-line-annotation))) ! 1592: (message "Scanning %s...done" folder))) ! 1593: ! 1594: ! 1595: (defun mh-get-new-mail (maildrop-name) ! 1596: ;; Read new mail from a maildrop into the current buffer. ! 1597: ;; Return T if there was new mail, NIL otherwise. Return in the current ! 1598: ;; buffer. ! 1599: (let ((point-before-inc (point)) ! 1600: (folder mh-current-folder) ! 1601: (return-value t)) ! 1602: (with-mh-folder-updating (t) ! 1603: (message (if maildrop-name ! 1604: (format "inc %s -file %s..." folder maildrop-name) ! 1605: (format "inc %s..." folder))) ! 1606: (mh-unmark-all-headers nil) ! 1607: (setq mh-next-direction 'forward) ! 1608: (goto-char (point-max)) ! 1609: (let ((start-of-inc (point))) ! 1610: (if maildrop-name ! 1611: (mh-exec-cmd-output "inc" nil folder ! 1612: "-file" (expand-file-name maildrop-name) ! 1613: "-width" (window-width) ! 1614: "-truncate") ! 1615: (mh-exec-cmd-output "inc" nil ! 1616: "-width" (window-width))) ! 1617: (message ! 1618: (if maildrop-name ! 1619: (format "inc %s -file %s...done" folder maildrop-name) ! 1620: (format "inc %s...done" folder))) ! 1621: (goto-char start-of-inc) ! 1622: (cond ((looking-at "inc: no mail") ! 1623: (keep-lines mh-valid-scan-line) ; Flush random scan lines ! 1624: (goto-char point-before-inc) ! 1625: (message "No new mail%s%s" (if maildrop-name " in " "") ! 1626: (if maildrop-name maildrop-name ""))) ! 1627: ((re-search-forward "^inc:" nil t) ; Error messages ! 1628: (error "inc error")) ! 1629: (t ! 1630: (mh-delete-seq-locally 'cur) ; To pick up new one ! 1631: (setq mh-seq-list (mh-read-folder-sequences folder t)) ! 1632: (mh-notate-user-sequences) ! 1633: (keep-lines mh-valid-scan-line) ! 1634: (mh-make-folder-mode-line) ! 1635: (mh-goto-cur-msg) ! 1636: (setq return-value t)))) ! 1637: return-value))) ! 1638: ! 1639: ! 1640: (defun mh-make-folder-mode-line (&optional annotation) ! 1641: ;; Set the fields of the mode line for a folder buffer. ! 1642: ;; The optional ANNOTATION string is displayed after the folder's name. ! 1643: (save-excursion ! 1644: (mh-first-msg) ! 1645: (setq mh-first-msg-num (mh-get-msg-num nil)) ! 1646: (mh-last-msg) ! 1647: (setq mh-last-msg-num (mh-get-msg-num nil)) ! 1648: (let ((lines (count-lines (point-min) (point-max)))) ! 1649: (setq mode-line-buffer-identification ! 1650: (list (format "{%%b%s} %d msg%s" ! 1651: (if annotation (format "/%s" annotation) "") ! 1652: lines ! 1653: (if (zerop lines) ! 1654: "s" ! 1655: (if (> lines 1) ! 1656: (format "s (%d-%d)" mh-first-msg-num ! 1657: mh-last-msg-num) ! 1658: (format " (%d)" mh-first-msg-num))))))))) ! 1659: ! 1660: ! 1661: (defun mh-unmark-all-headers (remove-all-flags) ! 1662: ;; Remove all '+' flags from the headers, and if called with a non-nil ! 1663: ;; argument, remove all 'D', '^' and '%' flags too. ! 1664: ;; Optimized for speed (i.e., no regular expressions). ! 1665: (save-excursion ! 1666: (let ((case-fold-search nil) ! 1667: (last-line (- (point-max) mh-cmd-note)) ! 1668: char) ! 1669: (mh-first-msg) ! 1670: (while (<= (point) last-line) ! 1671: (forward-char mh-cmd-note) ! 1672: (setq char (following-char)) ! 1673: (if (or (and remove-all-flags ! 1674: (or (eql char ?D) ! 1675: (eql char ?^) ! 1676: (eql char ?%))) ! 1677: (eql char ?+)) ! 1678: (progn ! 1679: (delete-char 1) ! 1680: (insert " "))) ! 1681: (forward-line))))) ! 1682: ! 1683: ! 1684: (defun mh-goto-cur-msg () ! 1685: ;; Position the cursor at the current message. ! 1686: (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) ! 1687: (cond ((and cur-msg ! 1688: (mh-goto-msg cur-msg t nil)) ! 1689: (mh-notate nil ?+ mh-cmd-note) ! 1690: (mh-recenter 0) ! 1691: (mh-maybe-show cur-msg)) ! 1692: (t ! 1693: (mh-last-msg) ! 1694: (message "No current message"))))) ! 1695: ! 1696: ! 1697: (defun mh-pack-folder-1 (range) ! 1698: ;; Close and pack the current folder. ! 1699: (mh-process-or-undo-commands mh-current-folder) ! 1700: (message "Packing folder...") ! 1701: (mh-set-folder-modified-p t) ; lock folder while packing ! 1702: (save-excursion ! 1703: (mh-exec-cmd-quiet " *mh-temp*" "folder" mh-current-folder "-pack")) ! 1704: (mh-regenerate-headers range)) ! 1705: ! 1706: ! 1707: (defun mh-process-or-undo-commands (folder) ! 1708: ;; If FOLDER has outstanding commands, then either process or discard them. ! 1709: (set-buffer folder) ! 1710: (if (mh-outstanding-commands-p) ! 1711: (if (or mh-do-not-confirm ! 1712: (y-or-n-p ! 1713: "Process outstanding deletes and refiles (or lose them)? ")) ! 1714: (mh-process-commands folder) ! 1715: (mh-undo-folder)) ! 1716: (mh-invalidate-show-buffer))) ! 1717: ! 1718: ! 1719: (defun mh-process-commands (folder) ! 1720: ;; Process outstanding commands for the folder FOLDER. ! 1721: (message "Processing deletes and refiles for %s..." folder) ! 1722: (set-buffer folder) ! 1723: (with-mh-folder-updating (nil) ! 1724: ;; Update the unseen sequence if it exists ! 1725: (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq)) ! 1726: (mh-undefine-sequence mh-unseen-seq mh-seen-list)) ! 1727: ! 1728: ;; Then refile messages ! 1729: (mh-mapc ! 1730: (function ! 1731: (lambda (dest) ! 1732: (let ((msgs (mh-seq-to-msgs dest))) ! 1733: (mh-when msgs ! 1734: (apply 'mh-exec-cmd "refile" ! 1735: "-src" folder (symbol-name dest) msgs) ! 1736: (mh-delete-scan-msgs msgs))))) ! 1737: mh-refile-list) ! 1738: ! 1739: ;; Now delete messages ! 1740: (mh-when mh-delete-list ! 1741: (apply 'mh-exec-cmd "rmm" folder mh-delete-list) ! 1742: (mh-delete-scan-msgs mh-delete-list)) ! 1743: ! 1744: ;; Don't need to remove sequences since delete and refile do so. ! 1745: ! 1746: ;; Mark cur message ! 1747: (if (> (buffer-size) 0) ! 1748: (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) ! 1749: ! 1750: (mh-invalidate-show-buffer) ! 1751: ! 1752: (setq mh-delete-list nil ! 1753: mh-refile-list nil ! 1754: mh-seq-list (mh-read-folder-sequences mh-current-folder nil) ! 1755: mh-seen-list nil) ! 1756: (mh-unmark-all-headers t) ! 1757: (mh-notate-user-sequences) ! 1758: (message "Processing deletes and refiles for %s...done" folder))) ! 1759: ! 1760: ! 1761: (defun mh-delete-scan-msgs (msgs) ! 1762: ;; Delete the scan listing lines for each of the msgs in the LIST. ! 1763: ;; Optimized for speed (i.e., no regular expressions). ! 1764: (setq msgs (sort msgs (function <))) ;okay to clobber msgs ! 1765: (save-excursion ! 1766: (mh-first-msg) ! 1767: (while (and msgs (< (point) (point-max))) ! 1768: (cond ((equal (mh-get-msg-num nil) (car msgs)) ! 1769: (delete-region (point) (save-excursion (forward-line) (point))) ! 1770: (setq msgs (cdr msgs))) ! 1771: (t ! 1772: (forward-line)))))) ! 1773: ! 1774: ! 1775: (defun mh-set-folder-modified-p (flag) ! 1776: "Mark current folder as modified or unmodified according to FLAG." ! 1777: (set-buffer-modified-p flag)) ! 1778: ! 1779: ! 1780: (defun mh-outstanding-commands-p () ! 1781: ;; Returns non-nil if there are outstanding deletes or refiles. ! 1782: (or mh-delete-list mh-refile-list)) ! 1783: ! 1784: ! 1785: ! 1786: ;;; Mode for composing and sending a draft message. ! 1787: ! 1788: (defvar mh-sent-from-folder nil ! 1789: "Folder of msg associated with this letter.") ! 1790: ! 1791: (defvar mh-sent-from-msg nil ! 1792: "Number of msg associated with this letter.") ! 1793: ! 1794: (defvar mh-send-args nil ! 1795: "Extra arguments to pass to \"send\" command.") ! 1796: ! 1797: (defvar mh-annotate-char nil ! 1798: "Character to use to annotate mh-sent-from-msg.") ! 1799: ! 1800: (defvar mh-annotate-field nil ! 1801: "Field name for message annotation.") ! 1802: ! 1803: (defun mh-letter-mode () ! 1804: "Mode for composing letters in mh-e. ! 1805: When you have finished composing, type \\[mh-send-letter] to send the letter. ! 1806: ! 1807: Variables controlling this mode (defaults in parentheses): ! 1808: ! 1809: mh-delete-yanked-msg-window (nil) ! 1810: If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying ! 1811: the yanked message. ! 1812: ! 1813: mh-yank-from-start-of-msg (t) ! 1814: If non-nil, \\[mh-yank-cur-msg] will include the entire message. ! 1815: If `body', just yank the body (no header). ! 1816: If nil, only the portion of the message following the point will be yanked. ! 1817: If there is a region, this variable is ignored. ! 1818: ! 1819: Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are ! 1820: invoked with no args, if those values are non-nil. ! 1821: ! 1822: \\{mh-letter-mode-map}" ! 1823: (interactive) ! 1824: (kill-all-local-variables) ! 1825: (make-local-variable 'paragraph-start) ! 1826: (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) ! 1827: (make-local-variable 'paragraph-separate) ! 1828: (setq paragraph-separate ! 1829: (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate)) ! 1830: (make-local-variable 'mh-send-args) ! 1831: (make-local-variable 'mh-annotate-char) ! 1832: (make-local-variable 'mh-annotate-field) ! 1833: (make-local-variable 'mh-previous-window-config) ! 1834: (make-local-variable 'mh-sent-from-folder) ! 1835: (make-local-variable 'mh-sent-from-msg) ! 1836: (use-local-map mh-letter-mode-map) ! 1837: (setq major-mode 'mh-letter-mode) ! 1838: (mh-set-mode-name "mh-e letter") ! 1839: (set-syntax-table mh-letter-mode-syntax-table) ! 1840: (run-hooks 'text-mode-hook 'mh-letter-mode-hook) ! 1841: (mh-when auto-fill-hook ! 1842: (make-local-variable 'auto-fill-hook) ! 1843: (setq auto-fill-hook 'mh-auto-fill-for-letter))) ! 1844: ! 1845: ! 1846: (defun mh-auto-fill-for-letter () ! 1847: ;; Auto-fill in letters treats the header specially by inserting a tab ! 1848: ;; before continuation line. ! 1849: (do-auto-fill) ! 1850: (if (mh-in-header-p) ! 1851: (save-excursion ! 1852: (beginning-of-line nil) ! 1853: (insert-char ?\t 1)))) ! 1854: ! 1855: ! 1856: (defun mh-in-header-p () ! 1857: ;; Return non-nil if the point is in the header of a draft message. ! 1858: (save-excursion ! 1859: (let ((cur-point (point))) ! 1860: (goto-char (dot-min)) ! 1861: (re-search-forward "^--------" nil t) ! 1862: (< cur-point (point))))) ! 1863: ! 1864: ! 1865: (defun mh-to-field () ! 1866: "Move point to the end of a specified header field. ! 1867: The field is indicated by the previous keystroke. Create the field if ! 1868: it does not exist. Set the mark to point before moving." ! 1869: (interactive) ! 1870: (expand-abbrev) ! 1871: (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices))) ! 1872: (case-fold-search t)) ! 1873: (cond ((mh-position-on-field target t) ! 1874: (let ((eol (point))) ! 1875: (skip-chars-backward " \t") ! 1876: (delete-region (point) eol)) ! 1877: (if (and (not (eq (logior last-input-char ?`) ?s)) ! 1878: (save-excursion ! 1879: (backward-char 1) ! 1880: (not (looking-at "[:,]")))) ! 1881: (insert ", ") ! 1882: (insert " "))) ! 1883: (t ! 1884: (goto-char (dot-min)) ! 1885: (re-search-forward "^To:") ! 1886: (forward-line 1) ! 1887: (while (looking-at "^[ \t]") (forward-line 1)) ! 1888: (insert (format "%s \n" target)) ! 1889: (backward-char 1))))) ! 1890: ! 1891: ! 1892: (defun mh-to-fcc () ! 1893: "Insert an Fcc: field in the current message. ! 1894: Prompt for the field name with a completion list of the current folders." ! 1895: (interactive) ! 1896: (let ((last-input-char ?\C-f) ! 1897: (folder (mh-prompt-for-folder "Fcc" "" t))) ! 1898: (expand-abbrev) ! 1899: (save-excursion ! 1900: (mh-to-field) ! 1901: (insert (substring folder 1 nil))))) ! 1902: ! 1903: ! 1904: (defun mh-insert-signature () ! 1905: "Insert the file ~/.signature at the current point." ! 1906: (interactive) ! 1907: (insert-file-contents "~/.signature") ! 1908: (set-buffer-modified-p (buffer-modified-p))) ; force mode line update ! 1909: ! 1910: ! 1911: (defun mh-check-whom () ! 1912: "Verify recipients of the current letter." ! 1913: (interactive) ! 1914: (let ((file-name (buffer-file-name))) ! 1915: (set-buffer-modified-p t) ; Force writing of contents ! 1916: (save-buffer) ! 1917: (message "Checking recipients...") ! 1918: (switch-to-buffer-other-window "*Mail Recipients*") ! 1919: (bury-buffer (current-buffer)) ! 1920: (erase-buffer) ! 1921: (mh-exec-cmd-output "whom" t file-name) ! 1922: (other-window -1) ! 1923: (message "Checking recipients...done"))) ! 1924: ! 1925: ! 1926: ! 1927: ;;; Routines to make a search pattern and search for a message. ! 1928: ! 1929: (defvar mh-searching-folder nil "Folder this pick is searching.") ! 1930: ! 1931: ! 1932: (defun mh-make-pick-template () ! 1933: ;; Initialize the current buffer with a template for a pick pattern. ! 1934: (erase-buffer) ! 1935: (kill-all-local-variables) ! 1936: (make-local-variable 'mh-searching-folder) ! 1937: (insert "From: \n" ! 1938: "To: \n" ! 1939: "Cc: \n" ! 1940: "Date: \n" ! 1941: "Subject: \n" ! 1942: "---------\n") ! 1943: (mh-letter-mode) ! 1944: (use-local-map mh-pick-mode-map) ! 1945: (goto-char (point-min)) ! 1946: (end-of-line)) ! 1947: ! 1948: ! 1949: (defun mh-do-pick-search () ! 1950: "Find messages that match the qualifications in the current pattern buffer. ! 1951: Messages are searched for in the folder named in mh-searching-folder. ! 1952: Put messages found in a sequence named `search'." ! 1953: (interactive) ! 1954: (let ((pattern-buffer (buffer-name)) ! 1955: (searching-buffer mh-searching-folder) ! 1956: (range) ! 1957: (pattern nil) ! 1958: (new-buffer nil)) ! 1959: (save-excursion ! 1960: (cond ((get-buffer searching-buffer) ! 1961: (set-buffer searching-buffer) ! 1962: (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num))) ! 1963: (t ! 1964: (mh-make-folder searching-buffer) ! 1965: (setq range "all") ! 1966: (setq new-buffer t)))) ! 1967: (message "Searching...") ! 1968: (goto-char (point-min)) ! 1969: (while (setq pattern (mh-next-pick-field pattern-buffer)) ! 1970: (setq msgs (mh-seq-from-command searching-buffer ! 1971: 'search ! 1972: (nconc (cons "pick" pattern) ! 1973: (list searching-buffer ! 1974: range ! 1975: "-sequence" "search" ! 1976: "-list")))) ! 1977: (setq range "search")) ! 1978: (message "Searching...done") ! 1979: (if new-buffer ! 1980: (mh-scan-folder searching-buffer msgs) ! 1981: (switch-to-buffer searching-buffer)) ! 1982: (delete-other-windows) ! 1983: (mh-notate-seq 'search ?% (1+ mh-cmd-note)))) ! 1984: ! 1985: ! 1986: (defun mh-next-pick-field (buffer) ! 1987: ;; Return the next piece of a pick argument that can be extracted from the ! 1988: ;; BUFFER. Returns nil if no pieces remain. ! 1989: (set-buffer buffer) ! 1990: (let ((case-fold-search t)) ! 1991: (cond ((eobp) ! 1992: nil) ! 1993: ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t) ! 1994: (let* ((component ! 1995: (format "--%s" ! 1996: (downcase (buffer-substring (match-beginning 1) ! 1997: (match-end 1))))) ! 1998: (pat (buffer-substring (match-beginning 2) (match-end 2)))) ! 1999: (forward-line 1) ! 2000: (list component pat))) ! 2001: ((re-search-forward "^-*$" nil t) ! 2002: (forward-char 1) ! 2003: (let ((body (buffer-substring (point) (point-max)))) ! 2004: (if (and (> (length body) 0) (not (equal body "\n"))) ! 2005: (list "-search" body) ! 2006: nil))) ! 2007: (t ! 2008: nil)))) ! 2009: ! 2010: ! 2011: ! 2012: ;;; Routines to compose and send a letter. ! 2013: ! 2014: (defun mh-compose-and-send-mail (draft send-args ! 2015: sent-from-folder sent-from-msg ! 2016: to subject cc ! 2017: annotate-char annotate-field ! 2018: config) ! 2019: ;; Edit and compose a draft message in buffer DRAFT and send or save it. ! 2020: ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or ! 2021: ;; nil if none exists. ! 2022: ;; SENT-FROM-MSG is the message number or sequence name or nil. ! 2023: ;; SEND-ARGS is an optional argument passed to the send command. ! 2024: ;; The TO, SUBJECT, and CC fields are passed to the ! 2025: ;; mh-compose-letter-function. ! 2026: ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the ! 2027: ;; message. In that case, the ANNOTATE-FIELD is used to build a string ! 2028: ;; for mh-annotate-msg. ! 2029: ;; CONFIG is the window configuration to restore after sending the letter. ! 2030: (pop-to-buffer draft) ! 2031: (mh-letter-mode) ! 2032: (setq mh-sent-from-folder sent-from-folder) ! 2033: (setq mh-sent-from-msg sent-from-msg) ! 2034: (setq mh-send-args send-args) ! 2035: (setq mh-annotate-char annotate-char) ! 2036: (setq mh-annotate-field annotate-field) ! 2037: (setq mh-previous-window-config config) ! 2038: (setq mode-line-buffer-identification (list "{%b}")) ! 2039: (if (and (boundp 'mh-compose-letter-function) ! 2040: (symbol-value 'mh-compose-letter-function)) ! 2041: ;; run-hooks will not pass arguments. ! 2042: (let ((value (symbol-value 'mh-compose-letter-function))) ! 2043: (if (and (listp value) (not (eq (car value) 'lambda))) ! 2044: (while value ! 2045: (funcall (car value) to subject cc) ! 2046: (setq value (cdr value))) ! 2047: (funcall mh-compose-letter-function to subject cc))))) ! 2048: ! 2049: ! 2050: (defun mh-send-letter (&optional arg) ! 2051: "Send the draft letter in the current buffer. ! 2052: If optional prefix argument is provided, monitor delivery. ! 2053: Run mh-before-send-letter-hook before doing anything." ! 2054: (interactive "P") ! 2055: (run-hooks 'mh-before-send-letter-hook) ! 2056: (set-buffer-modified-p t) ; Make sure buffer is written ! 2057: (save-buffer) ! 2058: (message "Sending...") ! 2059: (let ((draft-buffer (current-buffer)) ! 2060: (file-name (buffer-file-name)) ! 2061: (config mh-previous-window-config)) ! 2062: (cond (arg ! 2063: (pop-to-buffer "MH mail delivery") ! 2064: (erase-buffer) ! 2065: (if mh-send-args ! 2066: (mh-exec-cmd-output "send" t "-watch" "-nopush" ! 2067: "-nodraftfolder" mh-send-args file-name) ! 2068: (mh-exec-cmd-output "send" t "-watch" "-nopush" ! 2069: "-nodraftfolder" file-name)) ! 2070: (goto-char (point-max)) ; show the interesting part ! 2071: (recenter -1) ! 2072: (set-buffer draft-buffer)) ; for annotation below ! 2073: (mh-send-args ! 2074: (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose" ! 2075: mh-send-args file-name)) ! 2076: (t ! 2077: (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose" ! 2078: file-name))) ! 2079: ! 2080: (if mh-annotate-char ! 2081: (mh-annotate-msg mh-sent-from-msg ! 2082: mh-sent-from-folder ! 2083: mh-annotate-char ! 2084: "-component" mh-annotate-field ! 2085: "-text" (format "\"%s %s\"" ! 2086: (mh-get-field "To:") ! 2087: (mh-get-field "Cc:")))) ! 2088: ! 2089: (mh-when (or (not arg) ! 2090: (y-or-n-p "Kill draft buffer? ")) ! 2091: (kill-buffer draft-buffer) ! 2092: (if config ! 2093: (set-window-configuration config))) ! 2094: (message "Sending...done"))) ! 2095: ! 2096: ! 2097: (defun mh-insert-letter (prefix-provided folder msg) ! 2098: "Insert a message from any folder into the current letter. ! 2099: Removes the message's headers using mh-invisible-headers. ! 2100: Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \"). ! 2101: If optional prefix argument provided, do not indent and do not delete ! 2102: headers. Leaves the mark before the letter and point after it." ! 2103: (interactive ! 2104: (list current-prefix-arg ! 2105: (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) ! 2106: (read-input (format "Message number%s: " ! 2107: (if mh-sent-from-msg ! 2108: (format " [%d]" mh-sent-from-msg) ! 2109: ""))))) ! 2110: (save-restriction ! 2111: (narrow-to-region (point) (point)) ! 2112: (let ((start (point-min))) ! 2113: (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg))) ! 2114: (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" ! 2115: (expand-file-name msg ! 2116: (mh-expand-file-name folder))) ! 2117: (mh-when (not prefix-provided) ! 2118: (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) ! 2119: (set-mark start) ; since mh-clean-msg-header moves it ! 2120: (mh-insert-prefix-string mh-ins-buf-prefix))))) ! 2121: ! 2122: ! 2123: (defun mh-yank-cur-msg () ! 2124: "Insert the current message into the draft buffer. ! 2125: Prefix each non-blank line in the message with the string in ! 2126: `mh-ins-buf-prefix'. If a region is set in the message's buffer, then ! 2127: only the region will be inserted. Otherwise, the entire message will ! 2128: be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable ! 2129: is nil, the portion of the message following the point will be yanked. ! 2130: If `mh-delete-yanked-msg-window' is non-nil, any window displaying the ! 2131: yanked message will be deleted." ! 2132: (interactive) ! 2133: (if (and mh-sent-from-folder mh-sent-from-msg) ! 2134: (let ((to-point (point)) ! 2135: (to-buffer (current-buffer))) ! 2136: (set-buffer mh-sent-from-folder) ! 2137: (if mh-delete-yanked-msg-window ! 2138: (delete-windows-on mh-show-buffer)) ! 2139: (set-buffer mh-show-buffer) ; Find displayed message ! 2140: (let ((mh-ins-str (cond ((mark) ! 2141: (buffer-substring (region-beginning) ! 2142: (region-end))) ! 2143: ((eq 'body mh-yank-from-start-of-msg) ! 2144: (buffer-substring ! 2145: (save-excursion ! 2146: (goto-char (point-min)) ! 2147: (mh-goto-header-end 1) ! 2148: (point)) ! 2149: (point-max))) ! 2150: (mh-yank-from-start-of-msg ! 2151: (buffer-substring (point-min) (point-max))) ! 2152: (t ! 2153: (buffer-substring (point) (point-max)))))) ! 2154: (set-buffer to-buffer) ! 2155: (narrow-to-region to-point to-point) ! 2156: (push-mark) ! 2157: (insert mh-ins-str) ! 2158: (mh-insert-prefix-string mh-ins-buf-prefix) ! 2159: (insert "\n") ! 2160: (widen))) ! 2161: (error "There is no current message"))) ! 2162: ! 2163: ! 2164: (defun mh-insert-prefix-string (mh-ins-string) ! 2165: ;; Run MH-YANK-HOOK to insert a prefix string before each line in the buffer. ! 2166: ;; Generality for supercite users. ! 2167: (save-excursion ! 2168: (set-mark (point-max)) ! 2169: (goto-char (point-min)) ! 2170: (run-hooks 'mh-yank-hooks))) ! 2171: ! 2172: ! 2173: (defun mh-fully-kill-draft () ! 2174: "Kill the draft message file and the draft message buffer. ! 2175: Use \\[kill-buffer] if you don't want to delete the draft message file." ! 2176: (interactive) ! 2177: (if (y-or-n-p "Kill draft message? ") ! 2178: (let ((config mh-previous-window-config)) ! 2179: (if (file-exists-p (buffer-file-name)) ! 2180: (delete-file (buffer-file-name))) ! 2181: (set-buffer-modified-p nil) ! 2182: (kill-buffer (buffer-name)) ! 2183: (message "") ! 2184: (if config ! 2185: (set-window-configuration config))) ! 2186: (error "Message not killed"))) ! 2187: ! 2188: ! 2189: (defun mh-recenter (arg) ! 2190: ;; Like recenter but with two improvements: nil arg means recenter, ! 2191: ;; and only does anything if the current buffer is in the selected ! 2192: ;; window. (Commands like save-some-buffers can make this false.) ! 2193: (if (eql (get-buffer-window (current-buffer)) ! 2194: (selected-window)) ! 2195: (recenter (if arg arg '(t))))) ! 2196: ! 2197: ! 2198: ! 2199: ;;; Commands to manipulate sequences. Sequences are stored in an alist ! 2200: ;;; of the form: ! 2201: ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) ! 2202: ! 2203: (defun mh-make-seq (name msgs) (cons name msgs)) ! 2204: ! 2205: (defmacro mh-seq-name (pair) (list 'car pair)) ! 2206: ! 2207: (defmacro mh-seq-msgs (pair) (list 'cdr pair)) ! 2208: ! 2209: (defun mh-find-seq (name) (assoc name mh-seq-list)) ! 2210: ! 2211: ! 2212: (defun mh-seq-to-msgs (seq) ! 2213: "Return a list of the messages in SEQUENCE." ! 2214: (mh-seq-msgs (mh-find-seq seq))) ! 2215: ! 2216: ! 2217: (defun mh-seq-containing-msg (msg) ! 2218: ;; Return a list of the sequences containing MESSAGE. ! 2219: (let ((l mh-seq-list) ! 2220: (seqs ())) ! 2221: (while l ! 2222: (if (memq msg (mh-seq-msgs (car l))) ! 2223: (mh-push (mh-seq-name (car l)) seqs)) ! 2224: (setq l (cdr l))) ! 2225: seqs)) ! 2226: ! 2227: ! 2228: (defun mh-msg-to-seq (msg) ! 2229: ;; Given a MESSAGE number, return the first sequence in which it occurs. ! 2230: (car (mh-seq-containing-msg msg))) ! 2231: ! 2232: ! 2233: (defun mh-read-seq-default (prompt not-empty) ! 2234: ;; Read and return sequence name with default narrowed or previous sequence. ! 2235: (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-previous-seq))) ! 2236: ! 2237: ! 2238: (defun mh-read-seq (prompt not-empty &optional default) ! 2239: ;; Read and return a sequence name. Prompt with PROMPT, raise an error ! 2240: ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply ! 2241: ;; an optional DEFAULT sequence. ! 2242: ;; A reply of '%' defaults to the first sequence containing the current ! 2243: ;; message. ! 2244: (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" ! 2245: (if default ! 2246: (format "[%s] " default) ! 2247: "")) ! 2248: (mh-seq-names mh-seq-list))) ! 2249: (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t))) ! 2250: ((equal input "") default) ! 2251: (t (intern input)))) ! 2252: (msgs (mh-seq-to-msgs seq))) ! 2253: (if (and (null msgs) not-empty) ! 2254: (error (format "No messages in sequence `%s'" seq))) ! 2255: seq)) ! 2256: ! 2257: ! 2258: (defun mh-read-folder-sequences (folder define-sequences) ! 2259: ;; Read and return the predefined sequences for a FOLDER. If ! 2260: ;; DEFINE-SEQUENCES is non-nil, then define mh-e's sequences before ! 2261: ;; reading MH's sequences. ! 2262: (let ((seqs ())) ! 2263: (mh-when define-sequences ! 2264: (mh-define-sequences mh-seq-list) ! 2265: (mh-mapc (function (lambda (seq) ; Save the internal sequences ! 2266: (if (mh-folder-name-p (mh-seq-name seq)) ! 2267: (mh-push seq seqs)))) ! 2268: mh-seq-list)) ! 2269: (save-excursion ! 2270: (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list") ! 2271: (goto-char (point-min)) ! 2272: ;; look for name in line of form "cur: 4" or "myseq (private): 23" ! 2273: (while (re-search-forward "^[^: ]+" nil t) ! 2274: (mh-push (mh-make-seq (intern (buffer-substring (match-beginning 0) ! 2275: (match-end 0))) ! 2276: (mh-read-msg-list)) ! 2277: seqs)) ! 2278: (delete-region (point-min) (point))) ; avoid race with mh-process-daemon ! 2279: seqs)) ! 2280: ! 2281: ! 2282: (defun mh-seq-names (seq-list) ! 2283: ;; Return an alist containing the names of the SEQUENCES. ! 2284: (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry))))) ! 2285: seq-list)) ! 2286: ! 2287: ! 2288: (defun mh-seq-from-command (folder seq seq-command) ! 2289: ;; In FOLDER, make a sequence named SEQ by executing COMMAND. ! 2290: ;; COMMAND is a list. The first element is a program name ! 2291: ;; and the subsequent elements are its arguments, all strings. ! 2292: (let ((msg) ! 2293: (msgs ()) ! 2294: (case-fold-search t)) ! 2295: (save-excursion ! 2296: (save-window-excursion ! 2297: (apply 'mh-exec-cmd-quiet " *mh-temp*" seq-command) ! 2298: (goto-char (point-min)) ! 2299: (while (setq msg (car (mh-read-msg-list))) ! 2300: (mh-push msg msgs) ! 2301: (forward-line 1))) ! 2302: (set-buffer folder) ! 2303: (setq msgs (nreverse msgs)) ; Put in ascending order ! 2304: (mh-push (mh-make-seq seq msgs) mh-seq-list) ! 2305: msgs))) ! 2306: ! 2307: ! 2308: (defun mh-read-msg-list () ! 2309: ;; Return a list of message numbers from the current point to the end of ! 2310: ;; the line. ! 2311: (let ((msgs ()) ! 2312: (end-of-line (save-excursion (end-of-line) (point))) ! 2313: num) ! 2314: (while (re-search-forward "[0-9]+" end-of-line t) ! 2315: (setq num (string-to-int (buffer-substring (match-beginning 0) ! 2316: (match-end 0)))) ! 2317: (cond ((looking-at "-") ; Message range ! 2318: (forward-char 1) ! 2319: (re-search-forward "[0-9]+" end-of-line t) ! 2320: (let ((num2 (string-to-int (buffer-substring (match-beginning 0) ! 2321: (match-end 0))))) ! 2322: (if (< num2 num) ! 2323: (error "Bad message range: %d-%d" num num2)) ! 2324: (while (<= num num2) ! 2325: (mh-push num msgs) ! 2326: (setq num (1+ num))))) ! 2327: ((not (zerop num)) (mh-push num msgs)))) ! 2328: msgs)) ! 2329: ! 2330: ! 2331: (defun mh-remove-seq (seq) ! 2332: ;; Delete the SEQUENCE. ! 2333: (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ? (1+ mh-cmd-note) seq) ! 2334: (mh-undefine-sequence seq (list "all")) ! 2335: (mh-delete-seq-locally seq)) ! 2336: ! 2337: ! 2338: (defun mh-delete-seq-locally (seq) ! 2339: ;; Remove mh-e's record of SEQUENCE. ! 2340: (let ((entry (mh-find-seq seq))) ! 2341: (setq mh-seq-list (delq entry mh-seq-list)))) ! 2342: ! 2343: ! 2344: (defun mh-remove-msg-from-seq (msg seq &optional internal-flag) ! 2345: ;; Remove MESSAGE from the SEQUENCE. If optional FLAG is non-nil, do not ! 2346: ;; inform MH of the change. ! 2347: (let ((entry (mh-find-seq seq))) ! 2348: (mh-when entry ! 2349: (mh-notate-if-in-one-seq msg ? (1+ mh-cmd-note) (mh-seq-name entry)) ! 2350: (if (not internal-flag) ! 2351: (mh-undefine-sequence seq (list msg))) ! 2352: (setcdr entry (delq msg (mh-seq-msgs entry)))))) ! 2353: ! 2354: ! 2355: (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag) ! 2356: ;; Add MESSAGE(s) to the SEQUENCE. If optional FLAG is non-nil, do not mark ! 2357: ;; the message in the scan listing or inform MH of the addition. ! 2358: (let ((entry (mh-find-seq seq))) ! 2359: (if (and msgs (atom msgs)) (setq msgs (list msgs))) ! 2360: (if (null entry) ! 2361: (mh-push (mh-make-seq seq msgs) mh-seq-list) ! 2362: (if msgs (setcdr entry (append msgs (cdr entry))))) ! 2363: (mh-when (not internal-flag) ! 2364: (mh-add-to-sequence seq msgs) ! 2365: (mh-notate-seq seq ?% (1+ mh-cmd-note))))) ! 2366: ! 2367: ! 2368: (defun mh-rename-seq (seq new-name) ! 2369: "Rename a SEQUENCE to have a new NAME." ! 2370: (interactive "SOld sequence name: \nSNew name: ") ! 2371: (let ((old-seq (mh-find-seq seq))) ! 2372: (if old-seq ! 2373: (rplaca old-seq new-name) ! 2374: (error "Sequence %s does not exists" seq)) ! 2375: (mh-undefine-sequence seq (mh-seq-msgs old-seq)) ! 2376: (mh-define-sequence new-name (mh-seq-msgs old-seq)))) ! 2377: ! 2378: ! 2379: (defun mh-notate-user-sequences () ! 2380: ;; Mark the scan listing of all messages in user-defined sequences. ! 2381: (let ((seqs mh-seq-list) ! 2382: name) ! 2383: (while seqs ! 2384: (setq name (mh-seq-name (car seqs))) ! 2385: (if (not (mh-internal-seq name)) ! 2386: (mh-notate-seq name ?% (1+ mh-cmd-note))) ! 2387: (setq seqs (cdr seqs))))) ! 2388: ! 2389: ! 2390: (defun mh-internal-seq (name) ! 2391: ;; Return non-NIL if NAME is the name of an internal mh-e sequence. ! 2392: (or (memq name '(answered cur deleted forwarded printed)) ! 2393: (eq name mh-unseen-seq) ! 2394: (mh-folder-name-p name))) ! 2395: ! 2396: ! 2397: (defun mh-folder-name-p (name) ! 2398: ;; Return non-NIL if NAME is possibly the name of a folder. ! 2399: ;; A name (a string or symbol) can be a folder name if it begins with "+". ! 2400: (if (symbolp name) ! 2401: (eql (aref (symbol-name name) 0) ?+) ! 2402: (eql (aref name 0) ?+))) ! 2403: ! 2404: ! 2405: (defun mh-notate-seq (seq notation offset) ! 2406: ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER ! 2407: ;; at the given OFFSET from the beginning of the listing line. ! 2408: (mh-map-to-seq-msgs 'mh-notate seq notation offset)) ! 2409: ! 2410: ! 2411: (defun mh-notate-if-in-one-seq (msg notation offset seq) ! 2412: ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the ! 2413: ;; message with the CHARACTER at the given OFFSET from the beginning of the ! 2414: ;; listing line. ! 2415: (let ((in-seqs (mh-seq-containing-msg msg))) ! 2416: (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) ! 2417: (mh-notate msg notation offset)))) ! 2418: ! 2419: ! 2420: (defun mh-map-to-seq-msgs (func seq &rest args) ! 2421: ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the ! 2422: ;; remaining ARGS as arguments. ! 2423: (save-excursion ! 2424: (let ((msgs (mh-seq-to-msgs seq))) ! 2425: (while msgs ! 2426: (if (mh-goto-msg (car msgs) t t) ! 2427: (apply func (car msgs) args)) ! 2428: (setq msgs (cdr msgs)))))) ! 2429: ! 2430: ! 2431: (defun mh-map-over-seqs (func seq-list) ! 2432: ;; Apply the FUNCTION to each element in the list of SEQUENCES, ! 2433: ;; passing the sequence name and the list of messages as arguments. ! 2434: (while seq-list ! 2435: (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list))) ! 2436: (setq seq-list (cdr seq-list)))) ! 2437: ! 2438: ! 2439: (defun mh-define-sequences (seq-list) ! 2440: ;; Define the sequences in SEQ-LIST. ! 2441: (mh-map-over-seqs 'mh-define-sequence seq-list)) ! 2442: ! 2443: ! 2444: (defun mh-add-to-sequence (seq msgs) ! 2445: ;; Add to a SEQUENCE each message the list of MSGS. ! 2446: (if (not (mh-folder-name-p seq)) ! 2447: (if msgs ! 2448: (apply 'mh-exec-cmd "mark" mh-current-folder ! 2449: "-sequence" (symbol-name seq) ! 2450: "-add" msgs)))) ! 2451: ! 2452: ! 2453: (defun mh-define-sequence (seq msgs) ! 2454: ;; Define the SEQUENCE to contain the list of MSGS. Do not mark ! 2455: ;; pseudo-sequences or empty sequences. ! 2456: (if (and msgs ! 2457: (not (mh-folder-name-p seq))) ! 2458: (save-excursion ! 2459: (apply 'mh-exec-cmd "mark" mh-current-folder ! 2460: "-sequence" (symbol-name seq) ! 2461: "-add" "-zero" (mh-list-to-string msgs))))) ! 2462: ! 2463: ! 2464: (defun mh-undefine-sequence (seq msgs) ! 2465: ;; Remove from the SEQUENCE the list of MSGS. ! 2466: (apply 'mh-exec-cmd "mark" mh-current-folder ! 2467: "-sequence" (symbol-name seq) ! 2468: "-delete" msgs)) ! 2469: ! 2470: ! 2471: (defun mh-copy-seq-to-point (seq location) ! 2472: ;; Copy the scan listing of the messages in SEQUENCE to after the point ! 2473: ;; LOCATION in the current buffer. ! 2474: (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) ! 2475: ! 2476: ! 2477: (defun mh-copy-line-to-point (msg location) ! 2478: ;; Copy the current line to the LOCATION in the current buffer. ! 2479: (beginning-of-line) ! 2480: (let ((beginning-of-line (point))) ! 2481: (forward-line 1) ! 2482: (copy-region-as-kill beginning-of-line (point)) ! 2483: (goto-char location) ! 2484: (yank) ! 2485: (goto-char beginning-of-line))) ! 2486: ! 2487: ! 2488: ! 2489: ;;; Issue commands to MH. ! 2490: ! 2491: (defun mh-exec-cmd (command &rest args) ! 2492: ;; Execute MH command COMMAND with ARGS. ! 2493: ;; Any output is assumed to be an error and is shown to the user. ! 2494: (save-excursion ! 2495: (set-buffer " *mh-temp*") ! 2496: (erase-buffer) ! 2497: (apply 'call-process ! 2498: (expand-file-name command mh-progs) nil t nil ! 2499: (mh-list-to-string args)) ! 2500: (if (> (buffer-size) 0) ! 2501: (save-window-excursion ! 2502: (switch-to-buffer-other-window " *mh-temp*") ! 2503: (sit-for 5))))) ! 2504: ! 2505: ! 2506: (defun mh-exec-cmd-quiet (buffer command &rest args) ! 2507: ;; In BUFFER, execute MH command COMMAND with ARGS. ! 2508: ;; ARGS is a list of strings. Return in BUFFER, if one exists. ! 2509: (mh-when (stringp buffer) ! 2510: (set-buffer buffer) ! 2511: (erase-buffer)) ! 2512: (apply 'call-process ! 2513: (expand-file-name command mh-progs) nil buffer nil ! 2514: args)) ! 2515: ! 2516: ! 2517: (defun mh-exec-cmd-output (command display &rest args) ! 2518: ;; Execute MH command COMMAND with DISPLAY flag and ARGS putting the output ! 2519: ;; into buffer after point. Set mark after inserted text. ! 2520: (push-mark (point) t) ! 2521: (apply 'call-process ! 2522: (expand-file-name command mh-progs) nil t display ! 2523: (mh-list-to-string args)) ! 2524: (exchange-point-and-mark)) ! 2525: ! 2526: ! 2527: (defun mh-exec-cmd-daemon (command &rest args) ! 2528: ;; Execute MH command COMMAND with ARGS. Any output from command is ! 2529: ;; displayed in an asynchronous pop-up window. ! 2530: (save-excursion ! 2531: (set-buffer (get-buffer-create " *mh-temp*")) ! 2532: (erase-buffer)) ! 2533: (let* ((process-connection-type nil) ! 2534: (process (apply 'start-process ! 2535: command nil ! 2536: (expand-file-name command mh-progs) ! 2537: (mh-list-to-string args)))) ! 2538: (set-process-filter process 'mh-process-daemon))) ! 2539: ! 2540: ! 2541: (defun mh-process-daemon (process output) ! 2542: ;; Process daemon that puts output into a temporary buffer. ! 2543: (set-buffer (get-buffer-create " *mh-temp*")) ! 2544: (insert-before-markers output) ! 2545: (display-buffer " *mh-temp*")) ! 2546: ! 2547: ! 2548: (defun mh-exec-lib-cmd-output (command &rest args) ! 2549: ;; Execute MH library command COMMAND with ARGS. ! 2550: ;; Put the output into buffer after point. Set mark after inserted text. ! 2551: (push-mark (point) t) ! 2552: (apply 'call-process ! 2553: (expand-file-name command mh-lib) nil t nil ! 2554: (mh-list-to-string args)) ! 2555: (exchange-point-and-mark)) ! 2556: ! 2557: ! 2558: (defun mh-list-to-string (l) ! 2559: ;; Flattens the list L and makes every element of the new list into a string. ! 2560: (let ((new-list nil)) ! 2561: (while l ! 2562: (cond ((null (car l))) ! 2563: ((symbolp (car l)) (mh-push (symbol-name (car l)) new-list)) ! 2564: ((numberp (car l)) (mh-push (int-to-string (car l)) new-list)) ! 2565: ((equal (car l) "")) ! 2566: ((stringp (car l)) (mh-push (car l) new-list)) ! 2567: ((listp (car l)) ! 2568: (setq new-list (nconc (nreverse (mh-list-to-string (car l))) ! 2569: new-list))) ! 2570: (t (error "Bad element in mh-list-to-string: %s" (car l)))) ! 2571: (setq l (cdr l))) ! 2572: (nreverse new-list))) ! 2573: ! 2574: ! 2575: ! 2576: ;;; Commands to annotate a message. ! 2577: ! 2578: (defun mh-annotate-msg (msg buffer note &rest args) ! 2579: ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate ! 2580: ;; the saved message with ARGS. ! 2581: (apply 'mh-exec-cmd "anno" buffer msg args) ! 2582: (save-excursion ! 2583: (cond ((get-buffer buffer) ; Buffer may be deleted ! 2584: (set-buffer buffer) ! 2585: (if (symbolp msg) ! 2586: (mh-notate-seq msg note (1+ mh-cmd-note)) ! 2587: (mh-notate msg note (1+ mh-cmd-note))))))) ! 2588: ! 2589: ! 2590: (defun mh-notate (msg notation offset) ! 2591: ;; Marks MESSAGE with the character NOTATION at position OFFSET. ! 2592: ;; Null MESSAGE means the message that the cursor points to. ! 2593: (save-excursion ! 2594: (if (or (null msg) ! 2595: (mh-goto-msg msg t t)) ! 2596: (with-mh-folder-updating (t) ! 2597: (beginning-of-line) ! 2598: (forward-char offset) ! 2599: (delete-char 1) ! 2600: (insert notation))))) ! 2601: ! 2602: ! 2603: ! 2604: ;;; User prompting commands. ! 2605: ! 2606: (defun mh-prompt-for-folder (prompt default can-create) ! 2607: ;; Prompt for a folder name with PROMPT. Returns the folder's name as a ! 2608: ;; string. DEFAULT is used if the folder exists and the user types return. ! 2609: ;; If the CAN-CREATE flag is t, then a non-existent folder is made. ! 2610: (let* ((prompt (format "%s folder%s" prompt ! 2611: (if (equal "" default) ! 2612: "? " ! 2613: (format " [%s]? " default)))) ! 2614: name) ! 2615: (if (null mh-folder-list) ! 2616: (mh-set-folder-list)) ! 2617: (while (and (setq name (completing-read prompt mh-folder-list ! 2618: nil nil "+")) ! 2619: (equal name "") ! 2620: (equal default ""))) ! 2621: (cond ((or (equal name "") (equal name "+")) ! 2622: (setq name default)) ! 2623: ((not (mh-folder-name-p name)) ! 2624: (setq name (format "+%s" name)))) ! 2625: (let ((new-file-p (not (file-exists-p (mh-expand-file-name name))))) ! 2626: (cond ((and new-file-p ! 2627: (y-or-n-p ! 2628: (format "Folder %s does not exist. Create it? " name))) ! 2629: (message "Creating %s" name) ! 2630: (call-process "mkdir" nil nil nil (mh-expand-file-name name)) ! 2631: (message "Creating %s...done" name) ! 2632: (mh-push (list name) mh-folder-list)) ! 2633: (new-file-p ! 2634: (error "Folder %s is not created" name)) ! 2635: (t ! 2636: (mh-when (null (assoc name mh-folder-list)) ! 2637: (mh-push (list name) mh-folder-list))))) ! 2638: name)) ! 2639: ! 2640: ! 2641: (defun mh-set-folder-list () ! 2642: "Sets mh-folder-list correctly. ! 2643: A useful function for the command line or for when you need to sync by hand." ! 2644: (setq mh-folder-list (mh-make-folder-list))) ! 2645: ! 2646: ! 2647: (defun mh-make-folder-list () ! 2648: "Return a list of the user's folders. ! 2649: Result is in a form suitable for completing read." ! 2650: (interactive) ! 2651: (message "Collecting folder names...") ! 2652: (save-window-excursion ! 2653: (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast" ! 2654: (if mh-recursive-folders ! 2655: "-recurse" ! 2656: "-norecurse")) ! 2657: (goto-char (point-min)) ! 2658: (let ((list nil) ! 2659: start) ! 2660: (while (not (eobp)) ! 2661: (setq start (point)) ! 2662: (forward-line 1) ! 2663: (mh-push (list (format "+%s" (buffer-substring start (1- (point))))) ! 2664: list)) ! 2665: (message "Collecting folder names...done") ! 2666: list))) ! 2667: ! 2668: ! 2669: (defun mh-remove-folder-from-folder-list (folder) ! 2670: ;; Remove FOLDER from the list of folders. ! 2671: (setq mh-folder-list ! 2672: (delq (assoc folder mh-folder-list) mh-folder-list))) ! 2673: ! 2674: ! 2675: (defun mh-read-msg-range (prompt) ! 2676: ;; Read a list of blank-separated items. ! 2677: (let* ((buf (read-string prompt)) ! 2678: (buf-size (length buf)) ! 2679: (start 0) ! 2680: (input ())) ! 2681: (while (< start buf-size) ! 2682: (let ((next (read-from-string buf start buf-size))) ! 2683: (mh-push (car next) input) ! 2684: (setq start (cdr next)))) ! 2685: (nreverse input))) ! 2686: ! 2687: ! 2688: ! 2689: ;;; Misc. functions. ! 2690: ! 2691: (defun mh-get-msg-num (error-if-no-message) ! 2692: ;; Return the message number of the displayed message. If the argument ! 2693: ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not ! 2694: ;; pointing to a message. ! 2695: (save-excursion ! 2696: (beginning-of-line) ! 2697: (cond ((looking-at mh-msg-number-regexp) ! 2698: (string-to-int (buffer-substring (match-beginning 1) ! 2699: (match-end 1)))) ! 2700: (error-if-no-message ! 2701: (error "Cursor not pointing to message")) ! 2702: (t nil)))) ! 2703: ! 2704: ! 2705: (defun mh-msg-search-pat (n) ! 2706: ;; Return a search pattern for message N in the scan listing. ! 2707: (format mh-msg-search-regexp n)) ! 2708: ! 2709: ! 2710: (defun mh-msg-filename (msg &optional folder) ! 2711: ;; Return the file name of MESSAGE in FOLDER (default current folder). ! 2712: (expand-file-name (int-to-string msg) ! 2713: (if folder ! 2714: (mh-expand-file-name folder) ! 2715: mh-folder-filename))) ! 2716: ! 2717: ! 2718: (defun mh-msg-filenames (msgs &optional folder) ! 2719: ;; Return a list of file names for MSGS in FOLDER (default current folder). ! 2720: (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) ! 2721: ! 2722: ! 2723: (defun mh-expand-file-name (filename &optional default) ! 2724: "Just like `expand-file-name', but also handles MH folder names. ! 2725: Assumes that any filename that starts with '+' is a folder name." ! 2726: (if (mh-folder-name-p filename) ! 2727: (expand-file-name (substring filename 1) mh-user-path) ! 2728: (expand-file-name filename default))) ! 2729: ! 2730: ! 2731: (defun mh-find-path () ! 2732: ;; Set mh-user-path, mh-draft-folder, and mh-unseen-seq from profile file. ! 2733: (save-excursion ! 2734: ;; Be sure profile is fully expanded before switching buffers ! 2735: (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) ! 2736: (if (not (file-exists-p profile)) ! 2737: (error "Cannot find MH profile %s" profile)) ! 2738: (set-buffer (get-buffer-create " *mh-temp*")) ! 2739: (erase-buffer) ! 2740: (insert-file-contents profile) ! 2741: (setq mh-draft-folder (mh-get-field "Draft-Folder:")) ! 2742: (cond ((equal mh-draft-folder "") ! 2743: (setq mh-draft-folder nil)) ! 2744: ((not (mh-folder-name-p mh-draft-folder)) ! 2745: (setq mh-draft-folder (format "+%s" mh-draft-folder)))) ! 2746: (setq mh-user-path (mh-get-field "Path:")) ! 2747: (if (equal mh-user-path "") ! 2748: (setq mh-user-path "Mail")) ! 2749: (setq mh-user-path ! 2750: (file-name-as-directory ! 2751: (expand-file-name mh-user-path (expand-file-name "~")))) ! 2752: (if (and mh-draft-folder ! 2753: (not (file-exists-p (mh-expand-file-name mh-draft-folder)))) ! 2754: (error "Draft folder %s does not exist. Create it and try again." ! 2755: mh-draft-folder)) ! 2756: (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:")) ! 2757: (if (equal mh-unseen-seq "") ! 2758: (setq mh-unseen-seq 'unseen) ! 2759: (setq mh-unseen-seq (intern mh-unseen-seq)))))) ! 2760: ! 2761: ! 2762: (defun mh-get-field (field) ! 2763: ;; Find and return the value of field FIELD in the current buffer. ! 2764: ;; Returns the empty string if the field is not in the message. ! 2765: (let ((case-fold-search t)) ! 2766: (goto-char (point-min)) ! 2767: (cond ((not (re-search-forward (format "^%s" field) nil t)) "") ! 2768: ((looking-at "[\t ]*$") "") ! 2769: (t ! 2770: (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) ! 2771: (let ((start (match-beginning 1))) ! 2772: (forward-line 1) ! 2773: (while (looking-at "[ \t]") ! 2774: (forward-line 1)) ! 2775: (buffer-substring start (1- (point)))))))) ! 2776: ! 2777: ! 2778: (defun mh-insert-fields (&rest name-values) ! 2779: ;; Insert the NAME-VALUE pairs in the current buffer. ! 2780: ;; Do not insert any pairs whose value is the empty string. ! 2781: (let ((case-fold-search t)) ! 2782: (while name-values ! 2783: (let ((field-name (car name-values)) ! 2784: (value (car (cdr name-values)))) ! 2785: (mh-when (not (equal value "")) ! 2786: (goto-char (point-min)) ! 2787: (cond ((not (re-search-forward (format "^%s" field-name) nil t)) ! 2788: (mh-goto-header-end 0) ! 2789: (insert field-name " " value "\n")) ! 2790: (t ! 2791: (end-of-line) ! 2792: (insert " " value)))) ! 2793: (setq name-values (cdr (cdr name-values))))))) ! 2794: ! 2795: ! 2796: (defun mh-position-on-field (field set-mark) ! 2797: ;; Set point to the end of the line beginning with FIELD. ! 2798: ;; Set the mark to the old value of point, if SET-MARK is non-nil. ! 2799: ;; Returns non-nil iff the field was found. ! 2800: (let ((case-fold-search t)) ! 2801: (if set-mark (push-mark)) ! 2802: (goto-char (point-min)) ! 2803: (mh-goto-header-end 0) ! 2804: (if (re-search-backward (format "^%s" field) nil t) ! 2805: (progn (end-of-line) t) ! 2806: nil))) ! 2807: ! 2808: ! 2809: (defun mh-goto-header-end (arg) ! 2810: ;; Find the end of the message header in the current buffer and position ! 2811: ;; the cursor at the ARG'th newline after the header. ! 2812: (if (re-search-forward "^$\\|^-+$" nil nil) ! 2813: (forward-line arg))) ! 2814: ! 2815: ! 2816: ! 2817: ;;; Build the folder-mode keymap: ! 2818: ! 2819: (suppress-keymap mh-folder-mode-map) ! 2820: (define-key mh-folder-mode-map "q" 'mh-quit) ! 2821: (define-key mh-folder-mode-map "b" 'mh-quit) ! 2822: (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq) ! 2823: (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq) ! 2824: (define-key mh-folder-mode-map "|" 'mh-pipe-msg) ! 2825: (define-key mh-folder-mode-map "\ea" 'mh-edit-again) ! 2826: (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq) ! 2827: (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq) ! 2828: (define-key mh-folder-mode-map "\C-xw" 'mh-widen) ! 2829: (define-key mh-folder-mode-map "\eb" 'mh-burst-digest) ! 2830: (define-key mh-folder-mode-map "\eu" 'mh-undo-folder) ! 2831: (define-key mh-folder-mode-map "\e " 'mh-page-digest) ! 2832: (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards) ! 2833: (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail) ! 2834: (define-key mh-folder-mode-map "\ef" 'mh-visit-folder) ! 2835: (define-key mh-folder-mode-map "\ek" 'mh-kill-folder) ! 2836: (define-key mh-folder-mode-map "\el" 'mh-list-folders) ! 2837: (define-key mh-folder-mode-map "\eo" 'mh-write-msg-to-file) ! 2838: (define-key mh-folder-mode-map "\ep" 'mh-pack-folder) ! 2839: (define-key mh-folder-mode-map "\es" 'mh-search-folder) ! 2840: (define-key mh-folder-mode-map "\er" 'mh-rescan-folder) ! 2841: (define-key mh-folder-mode-map "l" 'mh-print-msg) ! 2842: (define-key mh-folder-mode-map "t" 'mh-toggle-showing) ! 2843: (define-key mh-folder-mode-map "c" 'mh-copy-msg) ! 2844: (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file) ! 2845: (define-key mh-folder-mode-map "i" 'mh-inc-folder) ! 2846: (define-key mh-folder-mode-map "x" 'mh-execute-commands) ! 2847: (define-key mh-folder-mode-map "e" 'mh-execute-commands) ! 2848: (define-key mh-folder-mode-map "r" 'mh-redistribute) ! 2849: (define-key mh-folder-mode-map "f" 'mh-forward) ! 2850: (define-key mh-folder-mode-map "s" 'mh-send) ! 2851: (define-key mh-folder-mode-map "m" 'mh-send) ! 2852: (define-key mh-folder-mode-map "a" 'mh-reply) ! 2853: (define-key mh-folder-mode-map "j" 'mh-goto-msg) ! 2854: (define-key mh-folder-mode-map "<" 'mh-first-msg) ! 2855: (define-key mh-folder-mode-map "g" 'mh-goto-msg) ! 2856: (define-key mh-folder-mode-map "\177" 'mh-previous-page) ! 2857: (define-key mh-folder-mode-map " " 'mh-page-msg) ! 2858: (define-key mh-folder-mode-map "." 'mh-show) ! 2859: (define-key mh-folder-mode-map "u" 'mh-undo) ! 2860: (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again) ! 2861: (define-key mh-folder-mode-map "^" 'mh-refile-msg) ! 2862: (define-key mh-folder-mode-map "d" 'mh-delete-msg) ! 2863: (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion) ! 2864: (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg) ! 2865: (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg) ! 2866: (define-key mh-folder-mode-map "o" 'mh-refile-msg) ! 2867: ! 2868: ! 2869: ;;; Build the letter-mode keymap: ! 2870: ! 2871: (define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field) ! 2872: (define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field) ! 2873: (define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc) ! 2874: (define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field) ! 2875: (define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field) ! 2876: (define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field) ! 2877: (define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field) ! 2878: (define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc) ! 2879: (define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field) ! 2880: (define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field) ! 2881: (define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft) ! 2882: (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom) ! 2883: (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter) ! 2884: (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg) ! 2885: (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature) ! 2886: (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter) ! 2887: ! 2888: ! 2889: ;;; Build the pick-mode keymap: ! 2890: ! 2891: (define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search) ! 2892: (define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field) ! 2893: (define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field) ! 2894: (define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field) ! 2895: (define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field) ! 2896: (define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field) ! 2897: (define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field) ! 2898: (define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field) ! 2899: (define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field) ! 2900: (define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field) ! 2901: (define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field) ! 2902: (define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom) ! 2903: ! 2904: ! 2905: ! 2906: ;;; For Gnu Emacs. ! 2907: ;;; Local Variables: *** ! 2908: ;;; eval: (put 'mh-when 'lisp-indent-hook 1) *** ! 2909: ;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) *** ! 2910: ;;; End: ***
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.