lisp/mail/mh-e.el

   1 ;;; mh-e.el --- GNU Emacs interface to the MH mail system
   2
   3 ;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000  Free Software Foundation, Inc.
   4
   5 ;; Maintainer: Bill Wohler <wohler@newt.com>
   6 ;; Version: 5.0.2
   7 ;; Keywords: mail
   8 ;; Bug-reports: include `M-x mh-version' output in any correspondence
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; HOW TO USE:
  30 ;; M-x mh-rmail to read mail.  Type C-h m there for a list of commands.
  31 ;; C-u M-x mh-rmail to visit any folder.
  32 ;; M-x mh-smail to send mail.  From within the mail reader, "m" works, too.
  33
  34 ;; MH (Message Handler) is a powerful mail reader.  The MH newsgroup
  35 ;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to
  36 ;; mh-users-request to be added).  See the monthly Frequently Asked
  37 ;; Questions posting there for information on getting MH and mh-e.
  38
  39 ;; mh-e is an Emacs interface to the MH mail system.
  40 ;; There is a mailing list for discussion of mh-e and
  41 ;; announcements of new versions.  Send a "subscribe" message to
  42 ;; mh-e-request@gnu.org to be added.  Do not report bugs here; mail
  43 ;; them directly to the maintainer (see top of mh-e.el source).
  44 ;; Include the output of M-x mh-version in any bug report.
  45
  46 ;; mh-e works with GNU Emacs 18 or 19, and MH 6.
  47
  48 ;; NB.  MH must have been compiled with the MHE compiler flag or several
  49 ;; features necessary for mh-e will be missing from MH commands, specifically
  50 ;; the -build switch to repl and forw.
  51
  52 ;; Your .emacs might benefit from these bindings:
  53 ;; (global-set-key "\C-cr" 'mh-rmail)
  54 ;; (global-set-key "\C-xm" 'mh-smail)
  55 ;; (global-set-key "\C-x4m" 'mh-smail-other-window)
  56
  57 ;;; Change Log:
  58
  59 ;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
  60 ;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
  61 ;; Rewritten for GNU Emacs, James Larus 1985.  larus@ginger.berkeley.edu
  62 ;; Modified by Stephen Gildea 1988.  gildea@lcs.mit.edu
  63 (defconst mh-e-RCS-id "$Id: mh-e.el,v 1.27 2000/11/02 12:37:54 gerd Exp $")
  64
  65 ;;; Code:
  66
  67 (provide 'mh-e)
  68 (require 'mh-utils)
  69
  70 \f
  71 ;;; Hooks:
  72
  73 (defgroup mh nil
  74   "Emacs interface to the MH mail system"
  75   :group 'mail)
  76
  77 (defgroup mh-hook nil
  78   "Hooks to mh-e mode"
  79   :prefix "mh-"
  80   :group 'mh)
  81
  82
  83 (defcustom mh-folder-mode-hook nil
  84   "Invoked in MH-Folder mode on a new folder."
  85   :type 'hook
  86   :group 'mh-hook)
  87
  88 (defcustom mh-inc-folder-hook nil
  89   "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
  90   :type 'hook
  91   :group 'mh-hook)
  92
  93 (defcustom mh-show-hook nil
  94   "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
  95   :type 'hook
  96   :group 'mh-hook)
  97
  98 (defcustom mh-show-mode-hook nil
  99   "Invoked in MH-Show mode on each message."
 100   :type 'hook
 101   :group 'mh-hook)
 102
 103 (defcustom mh-delete-msg-hook nil
 104   "Invoked after marking each message for deletion."
 105   :type 'hook
 106   :group 'mh-hook)
 107
 108 (defcustom mh-refile-msg-hook nil
 109   "Invoked after marking each message for refiling."
 110   :type 'hook
 111   :group 'mh-hook)
 112
 113 (defcustom mh-before-quit-hook nil
 114   "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting mh-e.  See also  mh-quit-hook."
 115   :type 'hook
 116   :group 'mh-hook)
 117
 118 (defcustom mh-quit-hook nil
 119   "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits mh-e.  See also  mh-before-quit-hook."
 120   :type 'hook
 121   :group 'mh-hook)
 122
 123
 124
 125 ;;; Personal preferences:
 126
 127 (defcustom mh-lpr-command-format "lpr -J '%s'"
 128   "*Format for Unix command that prints a message.
 129 The string should be a Unix command line, with the string '%s' where
 130 the job's name (folder and message number) should appear.  The formatted
 131 message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
 132   :type 'string
 133   :group 'mh)
 134
 135 (defcustom mh-scan-prog "scan"
 136   "*Program to run to generate one-line-per-message listing of a folder.
 137 Normally \"scan\" or a file name linked to scan.  This file is searched
 138 for relative to the mh-progs directory unless it is an absolute pathname.
 139 Automatically becomes buffer-local when set in any fashion."
 140   :type 'string
 141   :group 'mh)
 142 (make-variable-buffer-local 'mh-scan-prog)
 143
 144 (defcustom mh-inc-prog "inc"
 145   "*Program to run to incorporate new mail into a folder.
 146 Normally \"inc\".  This file is searched for relative to
 147 the mh-progs directory unless it is an absolute pathname."
 148   :type 'string
 149   :group 'mh)
 150
 151 (defcustom mh-print-background nil
 152   "*Print messages in the background if non-nil.
 153 WARNING: do not delete the messages until printing is finished;
 154 otherwise, your output may be truncated."
 155   :type 'boolean
 156   :group 'mh)
 157
 158 (defcustom mh-recenter-summary-p nil
 159   "*Recenter summary window when the show window is toggled off if non-nil."
 160   :type 'boolean
 161   :group 'mh)
 162
 163 (defcustom mh-do-not-confirm nil
 164   "*Non-nil means do not prompt for confirmation before some mh-e commands.
 165 Affects non-recoverable commands such as `mh-kill-folder' and `mh-undo-folder'."
 166   :type 'boolean
 167   :group 'mh)
 168
 169 (defcustom mh-store-default-directory nil
 170   "*Last directory used by \\[mh-store-msg]; default for next store.
 171 A directory name string, or nil to use current directory."
 172   :type '(choice (const :tag "Current" nil)
 173                  directory)
 174   :group 'mh)
 175
 176 ;;; Parameterize mh-e to work with different scan formats.  The defaults work
 177 ;;; with the standard MH scan listings, in which the first 4 characters on
 178 ;;; the line are the message number, followed by two places for notations.
 179
 180 (defvar mh-good-msg-regexp  "^....[^D^]"
 181   "Regexp specifying the scan lines that are 'good' messages.")
 182
 183 (defvar mh-deleted-msg-regexp "^....D"
 184   "Regexp matching scan lines of deleted messages.")
 185
 186 (defvar mh-refiled-msg-regexp  "^....\\^"
 187   "Regexp matching scan lines of refiled messages.")
 188
 189 (defvar mh-valid-scan-line "^ *[0-9]"
 190   "Regexp matching scan lines for messages (not error messages).")
 191
 192 (defvar mh-cur-scan-msg-regexp "^....\\+"
 193   "Regexp matching scan line for the cur message.")
 194
 195 (defvar mh-note-deleted "D"
 196   "String whose first character is used to notate deleted messages.")
 197
 198 (defvar mh-note-refiled "^"
 199   "String whose first character is used to notate refiled messages.")
 200
 201 (defvar mh-note-cur "+"
 202   "String whose first character is used to notate the current message.")
 203
 204 (defvar mh-partial-folder-mode-line-annotation "select"
 205   "Annotation when displaying part of a folder.
 206 The string is displayed after the folder's name.  NIL for no annotation.")
 207
 208
 209 ;;; Internal variables:
 210
 211 (defvar mh-last-destination nil)        ;Destination of last refile or write command.
 212
 213 (defvar mh-folder-mode-map (make-keymap)
 214   "Keymap for MH folders.")
 215
 216 (defvar mh-delete-list nil)             ;List of msg numbers to delete.
 217
 218 (defvar mh-refile-list nil)             ;List of folder names in mh-seq-list.
 219
 220 (defvar mh-next-direction 'forward)     ;Direction to move to next message.
 221
 222 (defvar mh-narrowed-to-seq nil)         ;Sequence display is narrowed to or nil if not narrowed.
 223
 224 (defvar mh-first-msg-num nil)           ;Number of first msg in buffer.
 225
 226 (defvar mh-last-msg-num nil)            ;Number of last msg in buffer.
 227
 228 (defvar mh-mode-line-annotation nil)    ;Indiction this is not the full folder.
 229
 230 ;;; Macros and generic functions:
 231
 232 (defun mh-mapc (func list)
 233   (while list
 234     (funcall func (car list))
 235     (setq list (cdr list))))
 236
 237 \f
 238
 239 ;;; Entry points:
 240
 241 ;;;###autoload
 242 (defun mh-rmail (&optional arg)
 243   "Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder.
 244 This function is an entry point to mh-e, the Emacs front end
 245 to the MH mail system."
 246   (interactive "P")
 247   (mh-find-path)
 248   (if arg
 249       (call-interactively 'mh-visit-folder)
 250       (mh-inc-folder)))
 251
 252
 253 ;;; mh-smail and mh-smail-other-window have been moved to the new file
 254 ;;; mh-comp.el, but Emacs 18 still looks for them here, so provide a
 255 ;;; definition here, too, for a while.
 256
 257 (defun mh-smail ()
 258   "Compose and send mail with the MH mail system.
 259 This function is an entry point to mh-e, the Emacs front end
 260 to the MH mail system."
 261   (interactive)
 262   (mh-find-path)
 263   (require 'mh-comp)
 264   (call-interactively 'mh-send))
 265
 266
 267 (defun mh-smail-other-window ()
 268   "Compose and send mail in other window with the MH mail system.
 269 This function is an entry point to mh-e, the Emacs front end
 270 to the MH mail system."
 271   (interactive)
 272   (mh-find-path)
 273   (require 'mh-comp)
 274   (call-interactively 'mh-send-other-window))
 275
 276 \f
 277
 278 ;;; User executable mh-e commands:
 279
 280
 281 (defun mh-delete-msg (msg-or-seq)
 282   "Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
 283 Default is the displayed message.  If optional prefix argument is
 284 given then prompt for the message sequence."
 285   (interactive (list (if current-prefix-arg
 286                          (mh-read-seq-default "Delete" t)
 287                          (mh-get-msg-num t))))
 288   (mh-delete-msg-no-motion msg-or-seq)
 289   (mh-next-msg))
 290
 291
 292 (defun mh-delete-msg-no-motion (msg-or-seq)
 293   "Mark the specified MESSAGE(s) for subsequent deletion.
 294 Default is the displayed message.  If optional prefix argument is
 295 provided, then prompt for the message sequence."
 296   (interactive (list (if current-prefix-arg
 297                          (mh-read-seq-default "Delete" t)
 298                          (mh-get-msg-num t))))
 299   (if (numberp msg-or-seq)
 300       (mh-delete-a-msg msg-or-seq)
 301       (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
 302
 303
 304 (defun mh-execute-commands ()
 305   "Process outstanding delete and refile requests."
 306   (interactive)
 307   (if mh-narrowed-to-seq (mh-widen))
 308   (mh-process-commands mh-current-folder)
 309   (mh-set-scan-mode)
 310   (mh-goto-cur-msg)                     ; after mh-set-scan-mode for efficiency
 311   (mh-make-folder-mode-line)
 312   t)                                    ; return t for [local-]write-file-hooks
 313
 314
 315 (defun mh-first-msg ()
 316   "Move to the first message."
 317   (interactive)
 318   (goto-char (point-min))
 319   (while (and (not (eobp)) (not (looking-at mh-valid-scan-line)))
 320     (forward-line 1)))
 321
 322
 323 (defun mh-header-display ()
 324   "Show the current message with all its headers.
 325 Displays headers that might have been suppressed by setting the
 326 variables `mh-clean-message-header' or `mhl-formfile', or by the fallback
 327 behavior of scrolling uninteresting headers off the top of the window.
 328 Type \"\\[mh-show]\" to show the message normally again."
 329   (interactive)
 330   (and (not mh-showing-with-headers)
 331        (or mhl-formfile mh-clean-message-header)
 332        (mh-invalidate-show-buffer))
 333   (let ((mhl-formfile nil)
 334         (mh-clean-message-header nil))
 335     (mh-show-msg nil)
 336     (mh-in-show-buffer (mh-show-buffer)
 337       (goto-char (point-min))
 338       (mh-recenter 0))
 339     (setq mh-showing-with-headers t)))
 340
 341
 342 (defun mh-inc-folder (&optional maildrop-name)
 343   "Inc(orporate)s new mail into the Inbox folder.
 344 Optional prefix argument specifies an alternate maildrop from the default.
 345 If the prefix argument is given, incorporates mail into the current
 346 folder, otherwise uses the folder named by `mh-inbox'.
 347 Runs `mh-inc-folder-hook' after incorporating new mail.
 348 Do not call this function from outside mh-e; use \\[mh-rmail] instead."
 349   (interactive (list (if current-prefix-arg
 350                          (expand-file-name
 351                           (read-file-name "inc mail from file: "
 352                                           mh-user-path)))))
 353   (let ((config (current-window-configuration)))
 354     (if (not maildrop-name)
 355         (cond ((not (get-buffer mh-inbox))
 356                (mh-make-folder mh-inbox)
 357                (setq mh-previous-window-config config))
 358               ((not (eq (current-buffer) (get-buffer mh-inbox)))
 359                (switch-to-buffer mh-inbox)
 360                (setq mh-previous-window-config config)))))
 361   (mh-get-new-mail maildrop-name)
 362   (run-hooks 'mh-inc-folder-hook))
 363
 364
 365 (defun mh-last-msg ()
 366   "Move to the last message."
 367   (interactive)
 368   (goto-char (point-max))
 369   (while (and (not (bobp)) (looking-at "^$"))
 370     (forward-line -1)))
 371
 372
 373 (defun mh-next-undeleted-msg (&optional arg)
 374   "Move to the NTH next undeleted message in window."
 375   (interactive "p")
 376   (setq mh-next-direction 'forward)
 377   (forward-line 1)
 378   (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
 379          (beginning-of-line)
 380          (mh-maybe-show))
 381         (t
 382          (forward-line -1)
 383          (if (get-buffer mh-show-buffer)
 384              (delete-windows-on mh-show-buffer)))))
 385
 386
 387 (defun mh-refile-msg (msg-or-seq folder)
 388   "Refile MESSAGE(s) (default: displayed message) into FOLDER.
 389 If optional prefix argument provided, then prompt for message sequence."
 390   (interactive
 391    (list (if current-prefix-arg
 392              (mh-read-seq-default "Refile" t)
 393            (mh-get-msg-num t))
 394          (intern
 395           (mh-prompt-for-folder
 396            "Destination"
 397            (or (and mh-default-folder-for-message-function
 398                     (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
 399                       (save-excursion
 400                         (set-buffer (get-buffer-create mh-temp-buffer))
 401                         (erase-buffer)
 402                         (insert-file-contents refile-file)
 403                         (let ((buffer-file-name refile-file))
 404                           (funcall mh-default-folder-for-message-function)))))
 405                (and (eq 'refile (car mh-last-destination))
 406                     (symbol-name (cdr mh-last-destination)))
 407                "")
 408            t))))
 409   (setq mh-last-destination (cons 'refile folder))
 410   (if (numberp msg-or-seq)
 411       (mh-refile-a-msg msg-or-seq folder)
 412       (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
 413   (mh-next-msg))
 414
 415
 416 (defun mh-refile-or-write-again (message)
 417   "Re-execute the last refile or write command on the given MESSAGE.
 418 Default is the displayed message.  Use the same folder or file as the
 419 previous refile or write command."
 420   (interactive (list (mh-get-msg-num t)))
 421   (if (null mh-last-destination)
 422       (error "No previous refile or write"))
 423   (cond ((eq (car mh-last-destination) 'refile)
 424          (mh-refile-a-msg message (cdr mh-last-destination))
 425          (message "Destination folder: %s" (cdr mh-last-destination)))
 426         (t
 427          (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
 428          (message "Destination: %s" (cdr mh-last-destination))))
 429   (mh-next-msg))
 430
 431 (defun mh-quit ()
 432   "Quit the current mh-e folder.
 433 Start by running mh-before-quit-hook.  Restore the previous window
 434 configuration, if one exists.  Finish by running mh-quit-hook."
 435   (interactive)
 436   (run-hooks 'mh-before-quit-hook)
 437   (mh-update-sequences)
 438   (mh-invalidate-show-buffer)
 439   (bury-buffer (current-buffer))
 440   (if (get-buffer mh-show-buffer)
 441       (bury-buffer mh-show-buffer))
 442   (if mh-previous-window-config
 443       (set-window-configuration mh-previous-window-config))
 444   (run-hooks 'mh-quit-hook))
 445
 446 (defun mh-page-msg (&optional arg)
 447   "Page the displayed message forwards.
 448 Scrolls ARG lines or a full screen if no argument is supplied."
 449   (interactive "P")
 450   (scroll-other-window arg))
 451
 452
 453 (defun mh-previous-page (&optional arg)
 454   "Page the displayed message backwards.
 455 Scrolls ARG lines or a full screen if no argument is supplied."
 456   (interactive "P")
 457   (mh-in-show-buffer (mh-show-buffer)
 458     (scroll-down arg)))
 459
 460
 461 (defun mh-previous-undeleted-msg (&optional arg)
 462   "Move to the NTH previous undeleted message in window."
 463   (interactive "p")
 464   (setq mh-next-direction 'backward)
 465   (beginning-of-line)
 466   (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
 467          (mh-maybe-show))
 468         (t
 469          (if (get-buffer mh-show-buffer)
 470              (delete-windows-on mh-show-buffer)))))
 471
 472
 473 (defun mh-rescan-folder (&optional range)
 474   "Rescan a folder after optionally processing the outstanding commands.
 475 If optional prefix argument is provided, prompt for the range of
 476 messages to display.  Otherwise show the entire folder."
 477   (interactive (list (if current-prefix-arg
 478                          (mh-read-msg-range "Range to scan [all]? ")
 479                        nil)))
 480   (setq mh-next-direction 'forward)
 481   (mh-scan-folder mh-current-folder (or range "all")))
 482
 483
 484 (defun mh-write-msg-to-file (msg file no-headers)
 485   "Append MESSAGE to the end of a FILE.
 486 If NO-HEADERS (prefix argument) is provided, write only the message body.
 487 Otherwise send the entire message including the headers."
 488   (interactive
 489    (list (mh-get-msg-num t)
 490          (let ((default-dir (if (eq 'write (car mh-last-destination))
 491                                 (file-name-directory (car (cdr mh-last-destination)))
 492                               default-directory)))
 493            (read-file-name (format "Save message%s in file: "
 494                                    (if current-prefix-arg " body" ""))
 495                            default-dir
 496                            (if (eq 'write (car mh-last-destination))
 497                                (car (cdr mh-last-destination))
 498                              (expand-file-name "mail.out" default-dir))))
 499          current-prefix-arg))
 500   (let ((msg-file-to-output (mh-msg-filename msg))
 501         (output-file (mh-expand-file-name file)))
 502     (setq mh-last-destination (list 'write file (if no-headers 'no-headers)))
 503     (save-excursion
 504       (set-buffer (get-buffer-create mh-temp-buffer))
 505       (erase-buffer)
 506       (insert-file-contents msg-file-to-output)
 507       (goto-char (point-min))
 508       (if no-headers (search-forward "\n\n"))
 509       (append-to-file (point) (point-max) output-file))))
 510
 511
 512 (defun mh-toggle-showing ()
 513   "Toggle the scanning mode/showing mode of displaying messages."
 514   (interactive)
 515   (if mh-showing
 516       (mh-set-scan-mode)
 517       (mh-show)))
 518
 519
 520 (defun mh-undo (msg-or-seq)
 521   "Undo the pending deletion or refile of the specified MESSAGE(s).
 522 Default is the displayed message.  If optional prefix argument is
 523 provided, then prompt for the message sequence."
 524   (interactive (list (if current-prefix-arg
 525                          (mh-read-seq-default "Undo" t)
 526                          (mh-get-msg-num t))))
 527   (cond ((numberp msg-or-seq)
 528          (let ((original-position (point)))
 529            (beginning-of-line)
 530            (while (not (or (looking-at mh-deleted-msg-regexp)
 531                            (looking-at mh-refiled-msg-regexp)
 532                            (and (eq mh-next-direction 'forward) (bobp))
 533                            (and (eq mh-next-direction 'backward)
 534                                 (save-excursion (forward-line) (eobp)))))
 535              (forward-line (if (eq mh-next-direction 'forward) -1 1)))
 536            (if (or (looking-at mh-deleted-msg-regexp)
 537                    (looking-at mh-refiled-msg-regexp))
 538                (progn
 539                  (mh-undo-msg (mh-get-msg-num t))
 540                  (mh-maybe-show))
 541                (goto-char original-position)
 542                (error "Nothing to undo"))))
 543         (t
 544          (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
 545   ;; update the mh-refile-list so mh-outstanding-commands-p will work
 546   (mh-mapc (function
 547             (lambda (elt)
 548               (if (not (mh-seq-to-msgs elt))
 549                   (setq mh-refile-list (delq elt mh-refile-list)))))
 550            mh-refile-list)
 551   (if (not (mh-outstanding-commands-p))
 552       (mh-set-folder-modified-p nil)))
 553
 554
 555 ;;;###autoload
 556 (defun mh-version ()
 557   "Display version information about mh-e and the MH mail handling system."
 558   (interactive)
 559   (mh-find-progs)
 560   (set-buffer (get-buffer-create mh-temp-buffer))
 561   (erase-buffer)
 562   (insert "  mh-e info:\n\nversion: " mh-e-RCS-id
 563           "\nEmacs: " emacs-version " on " (symbol-name system-type) " ")
 564   (condition-case ()
 565       (call-process "uname" nil t nil "-a")
 566     (file-error))
 567   (insert "\n\n  MH info:\n\n" (expand-file-name "inc" mh-progs) ":\n")
 568   (let ((help-start (point)))
 569     (condition-case err-data
 570         (mh-exec-cmd-output "inc" nil "-help")
 571       (file-error (insert (mapconcat 'concat (cdr err-data) ": "))))
 572     (goto-char help-start)
 573     (search-forward "version: " nil t)
 574     (beginning-of-line)
 575     (delete-region help-start (point))
 576     (goto-char (point-min)))
 577   (display-buffer mh-temp-buffer))
 578
 579
 580 (defun mh-visit-folder (folder &optional range)
 581   "Visit FOLDER and display RANGE of messages.
 582 Do not call this function from outside mh-e; see \\[mh-rmail] instead."
 583   (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t)
 584                      (mh-read-msg-range "Range [all]? ")))
 585   (let ((config (current-window-configuration)))
 586     (mh-scan-folder folder (or range "all"))
 587     (setq mh-previous-window-config config))
 588   nil)
 589
 590
 591 (defun mh-compat-quit ()
 592   "The \"b\" key is obsolescent; will assume you want \"\\[mh-quit]\" ..."
 593   ;; Was going to make it run mh-burst-digest, but got complaint that
 594   ;; 'b' should mean 'back', as it does in info, less, and rn.
 595   ;; This is a temporary compatibility function.
 596   (interactive)
 597   (message "%s" (documentation this-command))
 598   (sit-for 1)
 599   (call-interactively 'mh-quit))
 600
 601
 602 (defun mh-update-sequences ()
 603   "Update MH's Unseen sequence and current folder and message.
 604 Flush mh-e's state out to MH.  The message at the cursor becomes current."
 605   (interactive)
 606   ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
 607   ;; which updates mh-e's state from MH.
 608   (let ((folder-set (mh-update-unseen))
 609         (new-cur (mh-get-msg-num nil)))
 610     (if new-cur
 611         (let ((seq-entry (mh-find-seq 'cur)))
 612           (mh-remove-cur-notation)
 613           (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
 614           (mh-define-sequence 'cur (list new-cur))
 615           (beginning-of-line)
 616           (if (looking-at mh-good-msg-regexp)
 617               (mh-notate nil mh-note-cur mh-cmd-note)))
 618       (or folder-set
 619           (save-excursion
 620             (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast"))))))
 621
 622
 623 \f
 624
 625 ;;; Support routines.
 626
 627 (defun mh-delete-a-msg (msg)
 628   ;; Delete the MESSAGE.
 629   (save-excursion
 630     (mh-goto-msg msg nil t)
 631     (if (looking-at mh-refiled-msg-regexp)
 632         (error "Message %d is refiled.  Undo refile before deleting" msg))
 633     (if (looking-at mh-deleted-msg-regexp)
 634         nil
 635         (mh-set-folder-modified-p t)
 636         (setq mh-delete-list (cons msg mh-delete-list))
 637         (mh-add-msgs-to-seq msg 'deleted t)
 638         (mh-notate msg mh-note-deleted mh-cmd-note)
 639         (run-hooks 'mh-delete-msg-hook))))
 640
 641 (defun mh-refile-a-msg (msg destination)
 642   ;; Refile MESSAGE in FOLDER.  FOLDER is a symbol, not a string.
 643   (save-excursion
 644     (mh-goto-msg msg nil t)
 645     (cond ((looking-at mh-deleted-msg-regexp)
 646            (error "Message %d is deleted.  Undo delete before moving" msg))
 647           ((looking-at mh-refiled-msg-regexp)
 648            (if (y-or-n-p
 649                 (format "Message %d already refiled.  Copy to %s as well? "
 650                         msg destination))
 651                (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
 652                             "-src" mh-current-folder
 653                             (symbol-name destination))
 654                (message "Message not copied.")))
 655           (t
 656            (mh-set-folder-modified-p t)
 657            (if (not (memq destination mh-refile-list))
 658                (setq mh-refile-list (cons destination mh-refile-list)))
 659            (if (not (memq msg (mh-seq-to-msgs destination)))
 660                (mh-add-msgs-to-seq msg destination t))
 661            (mh-notate msg mh-note-refiled mh-cmd-note)
 662            (run-hooks 'mh-refile-msg-hook)))))
 663
 664
 665 (defun mh-next-msg ()
 666   ;; Move backward or forward to the next undeleted message in the buffer.
 667   (if (eq mh-next-direction 'forward)
 668       (mh-next-undeleted-msg 1)
 669       (mh-previous-undeleted-msg 1)))
 670
 671
 672 (defun mh-set-scan-mode ()
 673   ;; Display the scan listing buffer, but do not show a message.
 674   (if (get-buffer mh-show-buffer)
 675       (delete-windows-on mh-show-buffer))
 676   (setq mh-showing nil)
 677   (force-mode-line-update)
 678   (if mh-recenter-summary-p
 679       (mh-recenter nil)))
 680
 681
 682 (defun mh-undo-msg (msg)
 683   ;; Undo the deletion or refile of one MESSAGE.
 684   (cond ((memq msg mh-delete-list)
 685          (setq mh-delete-list (delq msg mh-delete-list))
 686          (mh-delete-msg-from-seq msg 'deleted t))
 687         (t
 688          (mh-mapc (function (lambda (dest)
 689                               (mh-delete-msg-from-seq msg dest t)))
 690                   mh-refile-list)))
 691   (mh-notate msg ?  mh-cmd-note))
 692
 693
 694 \f
 695
 696 ;;; The folder data abstraction.
 697
 698 (defun mh-make-folder (name)
 699   ;; Create and initialize a new mail folder called NAME and make it the
 700   ;; current folder.
 701   (switch-to-buffer name)
 702   (setq buffer-read-only nil)
 703   (erase-buffer)
 704   (setq buffer-read-only t)
 705   (mh-folder-mode)
 706   (mh-set-folder-modified-p nil)
 707   (setq buffer-file-name mh-folder-filename)
 708   (mh-make-folder-mode-line))
 709
 710
 711 ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
 712 (put 'mh-folder-mode 'mode-class 'special)
 713
 714 (defun mh-folder-mode ()
 715   "Major mh-e mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
 716 You can show the message the cursor is pointing to, and step through the
 717 messages.  Messages can be marked for deletion or refiling into another
 718 folder; these commands are executed all at once with a separate command.
 719
 720 A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
 721 applies the action to a message sequence.
 722
 723 Here is a list of the standard keys for mh-e commands, grouped by function.
 724 This list is purposefully not customized; mh-e has a long history, and many
 725 alternate key bindings as a result.  This list is to encourage users to use
 726 standard keys so the other keys can perhaps someday be put to new uses.
 727
 728 t       toggle show or scan-only mode
 729 RET     show message, or back to top if already showing
 730
 731 SPC     page message forward
 732 DEL     page message back
 733
 734 n       next message
 735 p       previous message
 736 g       go to message by number
 737
 738 d       mark for deletion
 739 o, ^    mark for output (refile) to another folder
 740 ?       show folder of pending refile
 741 u       undo delete or refile marking
 742
 743 x       execute marked deletes and refiles
 744 i       incorporate new mail
 745
 746 m       mail a new message
 747 r       reply to a message
 748 f       forward a message
 749
 750 q       quit mh-e
 751
 752 M-f     visit new folder
 753 M-r     rescan this folder
 754
 755 Here are all the commands with their current binding, listed in key order:
 756 \\{mh-folder-mode-map}
 757
 758 Variables controlling mh-e operation are (defaults in parentheses):
 759
 760  `mh-recursive-folders' (nil)
 761     Non-nil means commands which operate on folders do so recursively.
 762
 763  `mh-bury-show-buffer' (t)
 764     Non-nil means that the buffer used to display message is buried.
 765     It will never be offered as the default other buffer.
 766
 767  `mh-clean-message-header' (nil)
 768     Non-nil means remove header lines matching the regular expression
 769     specified in mh-invisible-headers from messages.
 770
 771  `mh-visible-headers' (nil)
 772     If non-nil, it contains a regexp specifying the headers that are shown in
 773     a message if mh-clean-message-header is non-nil.  Setting this variable
 774     overrides `mh-invisible-headers'.
 775
 776  `mh-do-not-confirm' (nil)
 777     Non-nil means do not prompt for confirmation before executing some
 778     non-recoverable commands such as `mh-kill-folder' and `mh-undo-folder'.
 779
 780  `mhl-formfile' (nil)
 781     Name of format file to be used by mhl to show messages.
 782     A value of T means use the default format file.
 783     Nil means don't use mhl to format messages.
 784
 785  `mh-lpr-command-format' (\"lpr -p -J '%s'\")
 786     Format for command used to print a message on a system printer.
 787
 788  `mh-scan-prog' (\"scan\")
 789     Program to run to generate one-line-per-message listing of a folder.
 790     Normally \"scan\" or a file name linked to scan.  This file is searched
 791     for relative to the mh-progs directory unless it is an absolute pathname.
 792     Automatically becomes buffer-local when set in any fashion.
 793
 794  `mh-print-background' (nil)
 795     Print messages in the background if non-nil.
 796     WARNING: do not delete the messages until printing is finished;
 797     otherwise, your output may be truncated.
 798
 799  `mh-recenter-summary-p' (nil)
 800     If non-nil, then the scan listing is recentered when the window displaying
 801     a messages is toggled off.
 802
 803  `mh-summary-height' (4)
 804     Number of lines in the summary window including the mode line.
 805
 806 The value of mh-folder-mode-hook is called when a new folder is set up."
 807
 808   (kill-all-local-variables)
 809   (use-local-map mh-folder-mode-map)
 810   (setq major-mode 'mh-folder-mode)
 811   (mh-set-mode-name "MH-Folder")
 812   (mh-make-local-vars
 813    'mh-current-folder (buffer-name)     ; Name of folder, a string
 814    'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
 815    'mh-folder-filename                  ; e.g. "/usr/foobar/Mail/inbox/"
 816    (file-name-as-directory (mh-expand-file-name (buffer-name)))
 817    'mh-showing nil                      ; Show message also?
 818    'mh-delete-list nil                  ; List of msgs nums to delete
 819    'mh-refile-list nil                  ; List of folder names in mh-seq-list
 820    'mh-seq-list nil                     ; Alist of (seq . msgs) nums
 821    'mh-seen-list nil                    ; List of displayed messages
 822    'mh-next-direction 'forward          ; Direction to move to next message
 823    'mh-narrowed-to-seq nil              ; Sequence display is narrowed to
 824    'mh-first-msg-num nil                ; Number of first msg in buffer
 825    'mh-last-msg-num nil                 ; Number of last msg in buffer
 826    'mh-msg-count nil                    ; Number of msgs in buffer
 827    'mh-mode-line-annotation nil         ; Indiction this is not the full folder
 828    'mh-previous-window-config nil)      ; Previous window configuration
 829   (setq truncate-lines t)
 830   (auto-save-mode -1)
 831   (setq buffer-offer-save t)
 832   (if (boundp 'local-write-file-hooks)
 833       (setq local-write-file-hooks '(mh-execute-commands)) ;Emacs 19
 834     (make-local-variable 'write-file-hooks)
 835     (setq write-file-hooks '(mh-execute-commands))) ;Emacs 18
 836   (make-local-variable 'revert-buffer-function)
 837   (setq revert-buffer-function 'mh-undo-folder)
 838   (or (assq 'mh-showing minor-mode-alist)
 839       (setq minor-mode-alist
 840             (cons '(mh-showing " Show") minor-mode-alist)))
 841   (run-hooks 'mh-folder-mode-hook))
 842
 843
 844 (defun mh-make-local-vars (&rest pairs)
 845   ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
 846   ;; value.
 847   (while pairs
 848     (set (make-local-variable (car pairs)) (car (cdr pairs)))
 849     (setq pairs (cdr (cdr pairs)))))
 850
 851
 852 (defun mh-scan-folder (folder range)
 853   ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
 854   (cond ((null (get-buffer folder))
 855          (mh-make-folder folder))
 856         (t
 857          (mh-process-or-undo-commands folder)
 858          (switch-to-buffer folder)))
 859   (mh-regenerate-headers range)
 860   (cond ((zerop (buffer-size))
 861          (if (equal range "all")
 862              (message "Folder %s is empty" folder)
 863            (message "No messages in %s, range %s" folder range))
 864          (sit-for 5)))
 865   (mh-goto-cur-msg))
 866
 867
 868 (defun mh-regenerate-headers (range &optional update)
 869   ;; scan folder over range RANGE.
 870   ;; If UPDATE, append the scan lines, otherwise replace.
 871   (let ((folder mh-current-folder)
 872         scan-start)
 873     (message "Scanning %s..." folder)
 874     (with-mh-folder-updating (nil)
 875       (if update
 876           (goto-char (point-max))
 877         (erase-buffer))
 878       (setq scan-start (point))
 879       (mh-exec-cmd-output mh-scan-prog nil
 880                           "-noclear" "-noheader"
 881                           "-width" (window-width)
 882                           folder range)
 883       (goto-char scan-start)
 884       (cond ((looking-at "scan: no messages in")
 885              (keep-lines mh-valid-scan-line)) ; Flush random scan lines
 886             ((looking-at "scan: "))     ; Keep error messages
 887             (t
 888              (keep-lines mh-valid-scan-line))) ; Flush random scan lines
 889       (setq mh-seq-list (mh-read-folder-sequences folder nil))
 890       (mh-notate-user-sequences)
 891       (or update
 892           (setq mh-mode-line-annotation
 893                 (if (equal range "all")
 894                     nil
 895                   mh-partial-folder-mode-line-annotation)))
 896       (mh-make-folder-mode-line))
 897     (message "Scanning %s...done" folder)))
 898
 899
 900 (defun mh-get-new-mail (maildrop-name)
 901   ;; Read new mail from a maildrop into the current buffer.
 902   ;; Return in the current buffer.
 903   (let ((point-before-inc (point))
 904         (folder mh-current-folder)
 905         (new-mail-p nil))
 906     (with-mh-folder-updating (t)
 907       (if maildrop-name
 908           (message "inc %s -file %s..." folder maildrop-name)
 909         (message "inc %s..." folder))
 910       (setq mh-next-direction 'forward)
 911       (goto-char (point-max))
 912       (let ((start-of-inc (point)))
 913         (if maildrop-name
 914             ;; I think MH 5 used "-ms-file" instead of "-file",
 915             ;; which would make inc'ing from maildrops fail.
 916             (mh-exec-cmd-output mh-inc-prog nil folder
 917                                 "-file" (expand-file-name maildrop-name)
 918                                 "-width" (window-width)
 919                                 "-truncate")
 920             (mh-exec-cmd-output mh-inc-prog nil
 921                                 "-width" (window-width)))
 922         (if maildrop-name
 923             (message "inc %s -file %s...done" folder maildrop-name)
 924           (message "inc %s...done" folder))
 925         (goto-char start-of-inc)
 926         (cond ((save-excursion
 927                  (re-search-forward "^inc: no mail" nil t))
 928                (message "No new mail%s%s" (if maildrop-name " in " "")
 929                         (if maildrop-name maildrop-name "")))
 930               ((re-search-forward "^inc:" nil t) ; Error messages
 931                (error "inc error"))
 932               (t
 933                (mh-remove-cur-notation)
 934                (setq new-mail-p t)))
 935         (keep-lines mh-valid-scan-line) ; Flush random scan lines
 936         (setq mh-seq-list (mh-read-folder-sequences folder t))
 937         (mh-notate-user-sequences)
 938         (if new-mail-p
 939             (progn
 940               (mh-make-folder-mode-line)
 941               (mh-goto-cur-msg))
 942             (goto-char point-before-inc))))))
 943
 944
 945 (defun mh-make-folder-mode-line (&optional ignored)
 946   ;; Set the fields of the mode line for a folder buffer.
 947   ;; The optional argument is now obsolete.  It used to be used to pass
 948   ;; in what is now stored in the buffer-local variable
 949   ;; mh-mode-line-annotation.
 950   (save-excursion
 951     (mh-first-msg)
 952     (setq mh-first-msg-num (mh-get-msg-num nil))
 953     (mh-last-msg)
 954     (setq mh-last-msg-num (mh-get-msg-num nil))
 955     (setq mh-msg-count (count-lines (point-min) (point-max)))
 956     (setq mode-line-buffer-identification
 957           (list (format "{%%b%s} %d msg%s"
 958                         (if mh-mode-line-annotation
 959                             (format "/%s" mh-mode-line-annotation)
 960                           "")
 961                         mh-msg-count
 962                         (if (zerop mh-msg-count)
 963                             "s"
 964                           (if (> mh-msg-count 1)
 965                               (format "s (%d-%d)" mh-first-msg-num
 966                                       mh-last-msg-num)
 967                             (format " (%d)" mh-first-msg-num))))))))
 968
 969
 970 (defun mh-unmark-all-headers (remove-all-flags)
 971   ;; Remove all '+' flags from the headers, and if called with a non-nil
 972   ;; argument, remove all 'D', '^' and '%' flags too.
 973   ;; Optimized for speed (i.e., no regular expressions).
 974   (save-excursion
 975     (let ((case-fold-search nil)
 976           (last-line (1- (point-max)))
 977           char)
 978       (mh-first-msg)
 979       (while (<= (point) last-line)
 980         (forward-char mh-cmd-note)
 981         (setq char (following-char))
 982         (if (or (and remove-all-flags
 983                      (or (= char (aref mh-note-deleted 0))
 984                          (= char (aref mh-note-refiled 0))))
 985                 (= char (aref mh-note-cur 0)))
 986             (progn
 987               (delete-char 1)
 988               (insert " ")))
 989         (if remove-all-flags
 990             (progn
 991               (forward-char 1)
 992               (if (= (following-char) (aref mh-note-seq 0))
 993                   (progn
 994                     (delete-char 1)
 995                     (insert " ")))))
 996         (forward-line)))))
 997
 998
 999 (defun mh-remove-cur-notation ()
1000   ;; Remove old cur notation (cf mh-goto-cur-msg code).
1001   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1002     (save-excursion
1003       (and cur-msg
1004            (mh-goto-msg cur-msg t t)
1005            (looking-at mh-cur-scan-msg-regexp)
1006            (mh-notate nil ?  mh-cmd-note)))))
1007
1008 (defun mh-goto-cur-msg ()
1009   ;; Position the cursor at the current message.
1010   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1011     (cond ((and cur-msg
1012                 (mh-goto-msg cur-msg t t))
1013            (mh-notate nil mh-note-cur mh-cmd-note)
1014            (mh-recenter 0)
1015            (mh-maybe-show cur-msg))
1016           (t
1017            (mh-last-msg)
1018            (message "No current message")))))
1019
1020
1021 (defun mh-process-or-undo-commands (folder)
1022   ;; If FOLDER has outstanding commands, then either process or discard them.
1023   ;; Called by functions like mh-sort-folder, so also invalidate show buffer.
1024   (set-buffer folder)
1025   (if (mh-outstanding-commands-p)
1026       (if (or mh-do-not-confirm
1027               (y-or-n-p
1028                 "Process outstanding deletes and refiles (or lose them)? "))
1029           (mh-process-commands folder)
1030           (mh-undo-folder)))
1031   (mh-update-unseen)
1032   (mh-invalidate-show-buffer))
1033
1034
1035 (defun mh-process-commands (folder)
1036   ;; Process outstanding commands for the folder FOLDER.
1037   (message "Processing deletes and refiles for %s..." folder)
1038   (set-buffer folder)
1039   (with-mh-folder-updating (nil)
1040     ;; Update the unseen sequence if it exists
1041     (mh-update-unseen)
1042
1043     ;; Then refile messages
1044     (mh-mapc
1045      (function
1046       (lambda (dest)
1047         (let ((msgs (mh-seq-to-msgs dest)))
1048           (cond (msgs
1049                  (apply 'mh-exec-cmd "refile"
1050                         "-src" folder (symbol-name dest)
1051                         (mh-coalesce-msg-list msgs))
1052                  (mh-delete-scan-msgs msgs))))))
1053      mh-refile-list)
1054     (setq mh-refile-list nil)
1055
1056     ;; Now delete messages
1057     (cond (mh-delete-list
1058            (apply 'mh-exec-cmd "rmm" folder
1059                   (mh-coalesce-msg-list mh-delete-list))
1060            (mh-delete-scan-msgs mh-delete-list)
1061            (setq mh-delete-list nil)))
1062
1063     ;; Don't need to remove sequences since delete and refile do so.
1064
1065     ;; Mark cur message
1066     (if (> (buffer-size) 0)
1067         (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1068
1069     (and (buffer-file-name (get-buffer mh-show-buffer))
1070          (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1071          ;; If "inc" were to put a new msg in this file,
1072          ;; we would not notice, so mark it invalid now.
1073          (mh-invalidate-show-buffer))
1074
1075     (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1076     (mh-unmark-all-headers t)
1077     (mh-notate-user-sequences)
1078     (message "Processing deletes and refiles for %s...done" folder)))
1079
1080
1081 (defun mh-update-unseen ()
1082   ;; Flush updates to the Unseen sequence out to MH.
1083   ;; Return non-NIL iff set the MH folder.
1084   (if mh-seen-list
1085       (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
1086              (unseen-msgs (mh-seq-msgs unseen-seq)))
1087         (if unseen-msgs
1088             (progn
1089               (mh-undefine-sequence mh-unseen-seq mh-seen-list)
1090               (while mh-seen-list
1091                 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
1092                 (setq mh-seen-list (cdr mh-seen-list)))
1093               (setcdr unseen-seq unseen-msgs)
1094               t)                        ;since we set the folder
1095           (setq mh-seen-list nil)))))
1096
1097
1098 (defun mh-delete-scan-msgs (msgs)
1099   ;; Delete the scan listing lines for each of the msgs in the LIST.
1100   (save-excursion
1101     (while msgs
1102       (if (mh-goto-msg (car msgs) t t)
1103           (mh-delete-line 1))
1104       (setq msgs (cdr msgs)))))
1105
1106
1107 (defun mh-outstanding-commands-p ()
1108   ;; Returns non-nil if there are outstanding deletes or refiles.
1109   (or mh-delete-list mh-refile-list))
1110
1111
1112 (defun mh-coalesce-msg-list (messages)
1113   ;; Give a list of MESSAGES, return a list of message number ranges.
1114   ;; Sort of the opposite of mh-read-msg-list, which expands ranges.
1115   ;; Message lists passed to MH programs go through this so
1116   ;; command line arguments won't exceed system limits.
1117   (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
1118         (range-high nil)
1119         (prev -1)
1120         (ranges nil))
1121     (while prev
1122       (if range-high
1123           (if (or (not (numberp prev))
1124                   (not (equal (car msgs) (1- prev))))
1125               (progn                    ;non-sequential, flush old range
1126                 (if (eq prev range-high)
1127                     (setq ranges (cons range-high ranges))
1128                   (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
1129                 (setq range-high nil))))
1130       (or range-high
1131           (setq range-high (car msgs))) ;start new or first range
1132       (setq prev (car msgs))
1133       (setq msgs (cdr msgs)))
1134     ranges))
1135
1136 (defun mh-greaterp (msg1 msg2)
1137   ;; Sort two message indicators.  Strings are "smaller" than numbers.
1138   ;; Legal values are things like "cur", "last", 1, and 1820.
1139   (if (numberp msg1)
1140          (if (numberp msg2)
1141              (> msg1 msg2)
1142            t)
1143     (if (numberp msg2)
1144         nil
1145       (string-lessp msg2 msg1))))
1146
1147 \f
1148
1149 ;;; Basic sequence handling
1150
1151 (defun mh-delete-seq-locally (seq)
1152   ;; Remove mh-e's record of SEQUENCE.
1153   (let ((entry (mh-find-seq seq)))
1154     (setq mh-seq-list (delq entry mh-seq-list))))
1155
1156 (defun mh-read-folder-sequences (folder save-refiles)
1157   ;; Read and return the predefined sequences for a FOLDER.
1158   ;; If SAVE-REFILES is non-nil, then keep the sequences
1159   ;; that note messages to be refiled.
1160   (let ((seqs ()))
1161     (cond (save-refiles
1162             (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1163                                  (if (mh-folder-name-p (mh-seq-name seq))
1164                                      (setq seqs (cons seq seqs)))))
1165                      mh-seq-list)))
1166     (save-excursion
1167       (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1168           (progn
1169             ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1170             (while (re-search-forward "^[^: ]+" nil t)
1171               (setq seqs (cons (mh-make-seq (intern (buffer-substring
1172                                                      (match-beginning 0)
1173                                                      (match-end 0)))
1174                                             (mh-read-msg-list))
1175                                seqs)))
1176             (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon
1177     seqs))
1178
1179 (defun mh-read-msg-list ()
1180   ;; Return a list of message numbers from the current point to the end of
1181   ;; the line.  Expands ranges into set of individual numbers.
1182   (let ((msgs ())
1183         (end-of-line (save-excursion (end-of-line) (point)))
1184         num)
1185     (while (re-search-forward "[0-9]+" end-of-line t)
1186       (setq num (string-to-int (buffer-substring (match-beginning 0)
1187                                                  (match-end 0))))
1188       (cond ((looking-at "-")           ; Message range
1189              (forward-char 1)
1190              (re-search-forward "[0-9]+" end-of-line t)
1191              (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1192                                                           (match-end 0)))))
1193                (if (< num2 num)
1194                    (error "Bad message range: %d-%d" num num2))
1195                (while (<= num num2)
1196                  (setq msgs (cons num msgs))
1197                  (setq num (1+ num)))))
1198             ((not (zerop num))          ;"pick" outputs "0" to mean no match
1199              (setq msgs (cons num msgs)))))
1200     msgs))
1201
1202 (defun mh-notate-user-sequences ()
1203   ;; Mark the scan listing of all messages in user-defined sequences.
1204   (let ((seqs mh-seq-list)
1205         name)
1206     (while seqs
1207       (setq name (mh-seq-name (car seqs)))
1208       (if (not (mh-internal-seq name))
1209           (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
1210       (setq seqs (cdr seqs)))))
1211
1212
1213 (defun mh-internal-seq (name)
1214   ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
1215   (or (memq name '(answered cur deleted forwarded printed))
1216       (eq name mh-unseen-seq)
1217       (eq name mh-previous-seq)
1218       (mh-folder-name-p name)))
1219
1220
1221 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
1222   "Delete MESSAGE from SEQUENCE.  MESSAGE defaults to displayed message.
1223 From Lisp, optional third arg INTERNAL-FLAG non-nil means do not
1224 inform MH of the change."
1225   (interactive (list (mh-get-msg-num t)
1226                      (mh-read-seq-default "Delete from" t)
1227                      nil))
1228   (let ((entry (mh-find-seq sequence)))
1229     (cond (entry
1230            (mh-notate-if-in-one-seq message ?  (1+ mh-cmd-note) sequence)
1231            (if (not internal-flag)
1232                (mh-undefine-sequence sequence (list message)))
1233            (setcdr entry (delq message (mh-seq-msgs entry)))))))
1234
1235
1236 (defun mh-undefine-sequence (seq msgs)
1237   ;; Remove from the SEQUENCE the list of MSGS.
1238   (mh-exec-cmd "mark" mh-current-folder "-delete"
1239                "-sequence" (symbol-name seq)
1240                (mh-coalesce-msg-list msgs)))
1241
1242
1243 (defun mh-define-sequence (seq msgs)
1244   ;; Define the SEQUENCE to contain the list of MSGS.
1245   ;; Do not mark pseudo-sequences or empty sequences.
1246   ;; Signals an error if SEQUENCE is an illegal name.
1247   (if (and msgs
1248            (not (mh-folder-name-p seq)))
1249       (save-excursion
1250         (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
1251                            "-sequence" (symbol-name seq)
1252                            (mh-coalesce-msg-list msgs)))))
1253
1254
1255 (defun mh-map-over-seqs (func seq-list)
1256   ;; Apply the FUNCTION to each element in the list of SEQUENCES,
1257   ;; passing the sequence name and the list of messages as arguments.
1258   (while seq-list
1259     (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
1260     (setq seq-list (cdr seq-list))))
1261
1262
1263 (defun mh-notate-if-in-one-seq (msg notation offset seq)
1264   ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
1265   ;; message with the CHARACTER at the given OFFSET from the beginning of the
1266   ;; listing line.
1267   (let ((in-seqs (mh-seq-containing-msg msg nil)))
1268     (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
1269         (mh-notate msg notation offset))))
1270
1271
1272 (defun mh-seq-containing-msg (msg &optional include-internal-p)
1273   ;; Return a list of the sequences containing MESSAGE.
1274   ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list.
1275   (let ((l mh-seq-list)
1276         (seqs ()))
1277     (while l
1278       (and (memq msg (mh-seq-msgs (car l)))
1279            (or include-internal-p
1280                (not (mh-internal-seq (mh-seq-name (car l)))))
1281            (setq seqs (cons (mh-seq-name (car l)) seqs)))
1282       (setq l (cdr l)))
1283     seqs))
1284
1285
1286 \f
1287
1288 ;;; User prompting commands.
1289
1290
1291 (defun mh-read-msg-range (prompt)
1292   ;; Read a list of blank-separated items.
1293   (let* ((buf (read-string prompt))
1294          (buf-size (length buf))
1295          (start 0)
1296          (input ()))
1297     (while (< start buf-size)
1298       (let ((next (read-from-string buf start buf-size)))
1299         (setq input (cons (car next) input))
1300         (setq start (cdr next))))
1301     (nreverse input)))
1302
1303 \f
1304
1305 ;;; Build the folder-mode keymap:
1306
1307 (suppress-keymap mh-folder-mode-map)
1308 (define-key mh-folder-mode-map "q" 'mh-quit)
1309 (define-key mh-folder-mode-map "b" 'mh-compat-quit)
1310 (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
1311 (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
1312 (define-key mh-folder-mode-map "|" 'mh-pipe-msg)
1313 (define-key mh-folder-mode-map "\ea" 'mh-edit-again)
1314 (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
1315 (define-key mh-folder-mode-map "\e#" 'mh-delete-seq)
1316 (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
1317 (define-key mh-folder-mode-map "\C-xw" 'mh-widen)
1318 (define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
1319 (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
1320 (define-key mh-folder-mode-map "\e " 'mh-page-digest)
1321 (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
1322 (define-key mh-folder-mode-map "\ed" 'mh-redistribute)
1323 (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
1324 (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
1325 (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
1326 (define-key mh-folder-mode-map "\el" 'mh-list-folders)
1327 (define-key mh-folder-mode-map "\en" 'mh-store-msg)
1328 (define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
1329 (define-key mh-folder-mode-map "\eq" 'mh-list-sequences)
1330 (define-key mh-folder-mode-map "\es" 'mh-search-folder)
1331 (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
1332 (define-key mh-folder-mode-map "l" 'mh-print-msg)
1333 (define-key mh-folder-mode-map "t" 'mh-toggle-showing)
1334 (define-key mh-folder-mode-map "c" 'mh-copy-msg)
1335 (define-key mh-folder-mode-map "i" 'mh-inc-folder)
1336 (define-key mh-folder-mode-map "x" 'mh-execute-commands)
1337 (define-key mh-folder-mode-map "e" 'mh-execute-commands)
1338 (define-key mh-folder-mode-map "f" 'mh-forward)
1339 (define-key mh-folder-mode-map "m" 'mh-send)
1340 (define-key mh-folder-mode-map "s" 'mh-send)
1341 (define-key mh-folder-mode-map "r" 'mh-reply)
1342 (define-key mh-folder-mode-map "a" 'mh-reply)
1343 (define-key mh-folder-mode-map "j" 'mh-goto-msg)
1344 (define-key mh-folder-mode-map "g" 'mh-goto-msg)
1345 (define-key mh-folder-mode-map "\e<" 'mh-first-msg)
1346 (define-key mh-folder-mode-map "\e>" 'mh-last-msg)
1347 (define-key mh-folder-mode-map "\177" 'mh-previous-page)
1348 (define-key mh-folder-mode-map " " 'mh-page-msg)
1349 (define-key mh-folder-mode-map "\r" 'mh-show)
1350 (define-key mh-folder-mode-map "." 'mh-show)
1351 (define-key mh-folder-mode-map "," 'mh-header-display)
1352 (define-key mh-folder-mode-map "u" 'mh-undo)
1353 (define-key mh-folder-mode-map "d" 'mh-delete-msg)
1354 (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
1355 (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
1356 (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
1357 (define-key mh-folder-mode-map "o" 'mh-refile-msg)
1358 (define-key mh-folder-mode-map "^" 'mh-refile-msg)
1359 (define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file)
1360 (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
1361 (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
1362
1363 ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
1364
1365 \f
1366
1367 ;;;autoload the other mh-e parts
1368
1369 ;;; mh-comp
1370
1371 (autoload 'mh-smail "mh-comp"
1372   "Compose and send mail with the MH mail system.
1373 This function is an entry point to mh-e, the Emacs front end
1374 to the MH mail system.
1375 See documentation of `\\[mh-send]' for more details on composing mail." t)
1376
1377 (autoload 'mh-smail-other-window "mh-comp"
1378   "Compose and send mail in other window with the MH mail system.
1379 This function is an entry point to mh-e, the Emacs front end
1380 to the MH mail system.
1381 See documentation of `\\[mh-send]' for more details on composing mail." t)
1382
1383 (autoload 'mh-edit-again "mh-comp"
1384   "Clean-up a draft or a message previously sent and make it resendable.
1385 Default is the current message.
1386 The variable mh-new-draft-cleaned-headers specifies the headers to remove.
1387 See also documentation for `\\[mh-send]' function." t)
1388
1389 (autoload 'mh-extract-rejected-mail "mh-comp"
1390   "Extract a letter returned by the mail system and make it resendable.
1391 Default is the current message.  The variable mh-new-draft-cleaned-headers
1392 gives the headers to clean out of the original message.
1393 See also documentation for `\\[mh-send]' function." t)
1394
1395 (autoload 'mh-forward "mh-comp"
1396   "Forward a message or message sequence.  Defaults to displayed message.
1397 If optional prefix argument provided, then prompt for the message sequence.
1398 See also documentation for `\\[mh-send]' function." t)
1399
1400 (autoload 'mh-redistribute "mh-comp"
1401   "Redistribute a letter.
1402 Depending on how your copy of MH was compiled, you may need to change the
1403 setting of the variable mh-redist-full-contents.  See its documentation." t)
1404
1405 (autoload 'mh-reply "mh-comp"
1406   "Reply to a MESSAGE (default: displayed message).
1407 If optional prefix argument INCLUDEP provided, then include the message
1408 in the reply using filter mhl.reply in your MH directory.
1409 Prompts for type of addresses to reply to:
1410    from    sender only,
1411    to      sender and primary recipients,
1412    cc/all  sender and all recipients.
1413 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
1414 for the reply.  See also documentation for `\\[mh-send]' function." t)
1415
1416 (autoload 'mh-send "mh-comp"
1417   "Compose and send a letter.
1418 The file named by `mh-comp-formfile' will be used as the form.
1419 Do not call this function from outside mh-e; use \\[mh-smail] instead.
1420 The letter is composed in mh-letter-mode; see its documentation for more
1421 details.  If `mh-compose-letter-function' is defined, it is called on the
1422 draft and passed three arguments: to, subject, and cc." t)
1423
1424 (autoload 'mh-send-other-window "mh-comp"
1425   "Compose and send a letter in another window.
1426 Do not call this function from outside mh-e;
1427 use \\[mh-smail-other-window] instead.
1428 See also documentation for `\\[mh-send]' function." t)
1429
1430 (autoload 'mh-letter-mode "mh-comp"
1431   "Mode for composing letters in mh-e.
1432 For more details, type \\[describe-mode] while in MH-Letter mode." t)
1433
1434
1435 ;;; mh-funcs
1436
1437 (autoload 'mh-burst-digest "mh-funcs"
1438   "Burst apart the current message, which should be a digest.
1439 The message is replaced by its table of contents and the messages from the
1440 digest are inserted into the folder after that message." t)
1441
1442 (autoload 'mh-copy-msg "mh-funcs"
1443   "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
1444 Default is the displayed message.  If optional prefix argument is
1445 provided, then prompt for the message sequence." t)
1446
1447 (autoload 'mh-kill-folder "mh-funcs"
1448   "Remove the current folder." t)
1449
1450 (autoload 'mh-list-folders "mh-funcs"
1451   "List mail folders." t)
1452
1453 (autoload 'mh-pack-folder "mh-funcs"
1454   "Renumber the messages of a folder to be 1..n.
1455 First, offer to execute any outstanding commands for the current folder.
1456 If optional prefix argument provided, prompt for the range of messages
1457 to display after packing.  Otherwise, show the entire folder." t)
1458
1459 (autoload 'mh-pipe-msg "mh-funcs"
1460   "Pipe the current message through the given shell COMMAND.
1461 If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
1462 Otherwise just send the message's body without the headers." t)
1463
1464 (autoload 'mh-page-digest "mh-funcs"
1465   "Advance displayed message to next digested message." t)
1466
1467 (autoload 'mh-page-digest-backwards "mh-funcs"
1468   "Back up displayed message to previous digested message." t)
1469
1470 (autoload 'mh-print-msg "mh-funcs"
1471   "Print MESSAGE(s) (default: displayed message) on printer.
1472 If optional prefix argument provided, then prompt for the message sequence.
1473 The variable mh-lpr-command-format is used to generate the print command.
1474 The messages are formatted by mhl.  See the variable mhl-formfile." t)
1475
1476 (autoload 'mh-sort-folder "mh-funcs"
1477   "Sort the messages in the current folder by date.
1478 Calls the MH program sortm to do the work.
1479 The arguments in the list  mh-sortm-args  are passed to sortm
1480 if this function is passed an argument." t)
1481
1482 (autoload 'mh-undo-folder "mh-funcs"
1483   "Undo all commands in current folder." t)
1484
1485 (autoload 'mh-store-msg "mh-funcs"
1486   "Store the file(s) contained in the current message into DIRECTORY.
1487 The message can contain a shar file or uuencoded file.
1488 Default directory is the last directory used, or initially the value of
1489 mh-store-default-directory  or the current directory." t)
1490
1491 (autoload 'mh-store-buffer "mh-funcs"
1492   "Store the file(s) contained in the current buffer into DIRECTORY.
1493 The buffer can contain a shar file or uuencoded file.
1494 Default directory is the last directory used, or initially the value of
1495 `mh-store-default-directory' or the current directory." t)
1496
1497
1498 ;;; mh-pick
1499
1500 (autoload 'mh-search-folder "mh-pick"
1501   "Search FOLDER for messages matching a pattern.
1502 Add the messages found to the sequence named `search'." t)
1503
1504 ;;; mh-seq
1505
1506 (autoload 'mh-delete-seq "mh-seq"
1507   "Delete the SEQUENCE." t)
1508 (autoload 'mh-list-sequences "mh-seq"
1509   "List the sequences defined in FOLDER." t)
1510 (autoload 'mh-msg-is-in-seq "mh-seq"
1511   "Display the sequences that contain MESSAGE (default: displayed message)." t)
1512 (autoload 'mh-narrow-to-seq "mh-seq"
1513   "Restrict display of this folder to just messages in SEQUENCE
1514 Use \\[mh-widen] to undo this command." t)
1515 (autoload 'mh-put-msg-in-seq "mh-seq"
1516   "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
1517 If optional prefix argument provided, then prompt for the message sequence." t)
1518 (autoload 'mh-widen "mh-seq"
1519   "Remove restrictions from current folder, thereby showing all messages." t)
1520 (autoload 'mh-rename-seq "mh-seq"
1521   "Rename SEQUENCE to have NEW-NAME." t)
1522
1523 (dolist (mess '("^Cursor not pointing to message$"
1524                 "^There is no other window$"))
1525   (add-to-list 'debug-ignored-errors mess))
1526
1527 ;;; mh-e.el ends here