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