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 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: None
   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 mh-e, 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.22 1999/11/09 13:40:03 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     (make-variable-buffer-local (car pairs))
 849     (set (car pairs) (car (cdr pairs)))
 850     (setq pairs (cdr (cdr pairs)))))
 851
 852
 853 (defun mh-scan-folder (folder range)
 854   ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
 855   (cond ((null (get-buffer folder))
 856          (mh-make-folder folder))
 857         (t
 858          (mh-process-or-undo-commands folder)
 859          (switch-to-buffer folder)))
 860   (mh-regenerate-headers range)
 861   (cond ((zerop (buffer-size))
 862          (if (equal range "all")
 863              (message "Folder %s is empty" folder)
 864            (message "No messages in %s, range %s" folder range))
 865          (sit-for 5)))
 866   (mh-goto-cur-msg))
 867
 868
 869 (defun mh-regenerate-headers (range &optional update)
 870   ;; scan folder over range RANGE.
 871   ;; If UPDATE, append the scan lines, otherwise replace.
 872   (let ((folder mh-current-folder)
 873         scan-start)
 874     (message "Scanning %s..." folder)
 875     (with-mh-folder-updating (nil)
 876       (if update
 877           (goto-char (point-max))
 878         (erase-buffer))
 879       (setq scan-start (point))
 880       (mh-exec-cmd-output mh-scan-prog nil
 881                           "-noclear" "-noheader"
 882                           "-width" (window-width)
 883                           folder range)
 884       (goto-char scan-start)
 885       (cond ((looking-at "scan: no messages in")
 886              (keep-lines mh-valid-scan-line)) ; Flush random scan lines
 887             ((looking-at "scan: "))     ; Keep error messages
 888             (t
 889              (keep-lines mh-valid-scan-line))) ; Flush random scan lines
 890       (setq mh-seq-list (mh-read-folder-sequences folder nil))
 891       (mh-notate-user-sequences)
 892       (or update
 893           (setq mh-mode-line-annotation
 894                 (if (equal range "all")
 895                     nil
 896                   mh-partial-folder-mode-line-annotation)))
 897       (mh-make-folder-mode-line))
 898     (message "Scanning %s...done" folder)))
 899
 900
 901 (defun mh-get-new-mail (maildrop-name)
 902   ;; Read new mail from a maildrop into the current buffer.
 903   ;; Return in the current buffer.
 904   (let ((point-before-inc (point))
 905         (folder mh-current-folder)
 906         (new-mail-p nil))
 907     (with-mh-folder-updating (t)
 908       (if maildrop-name
 909           (message "inc %s -file %s..." folder maildrop-name)
 910         (message "inc %s..." folder))
 911       (setq mh-next-direction 'forward)
 912       (goto-char (point-max))
 913       (let ((start-of-inc (point)))
 914         (if maildrop-name
 915             ;; I think MH 5 used "-ms-file" instead of "-file",
 916             ;; which would make inc'ing from maildrops fail.
 917             (mh-exec-cmd-output mh-inc-prog nil folder
 918                                 "-file" (expand-file-name maildrop-name)
 919                                 "-width" (window-width)
 920                                 "-truncate")
 921             (mh-exec-cmd-output mh-inc-prog nil
 922                                 "-width" (window-width)))
 923         (if maildrop-name
 924             (message "inc %s -file %s...done" folder maildrop-name)
 925           (message "inc %s...done" folder))
 926         (goto-char start-of-inc)
 927         (cond ((save-excursion
 928                  (re-search-forward "^inc: no mail" nil t))
 929                (message "No new mail%s%s" (if maildrop-name " in " "")
 930                         (if maildrop-name maildrop-name "")))
 931               ((re-search-forward "^inc:" nil t) ; Error messages
 932                (error "inc error"))
 933               (t
 934                (mh-remove-cur-notation)
 935                (setq new-mail-p t)))
 936         (keep-lines mh-valid-scan-line) ; Flush random scan lines
 937         (setq mh-seq-list (mh-read-folder-sequences folder t))
 938         (mh-notate-user-sequences)
 939         (if new-mail-p
 940             (progn
 941               (mh-make-folder-mode-line)
 942               (mh-goto-cur-msg))
 943             (goto-char point-before-inc))))))
 944
 945
 946 (defun mh-make-folder-mode-line (&optional ignored)
 947   ;; Set the fields of the mode line for a folder buffer.
 948   ;; The optional argument is now obsolete.  It used to be used to pass
 949   ;; in what is now stored in the buffer-local variable
 950   ;; mh-mode-line-annotation.
 951   (save-excursion
 952     (mh-first-msg)
 953     (setq mh-first-msg-num (mh-get-msg-num nil))
 954     (mh-last-msg)
 955     (setq mh-last-msg-num (mh-get-msg-num nil))
 956     (setq mh-msg-count (count-lines (point-min) (point-max)))
 957     (setq mode-line-buffer-identification
 958           (list (format "{%%b%s} %d msg%s"
 959                         (if mh-mode-line-annotation
 960                             (format "/%s" mh-mode-line-annotation)
 961                           "")
 962                         mh-msg-count
 963                         (if (zerop mh-msg-count)
 964                             "s"
 965                           (if (> mh-msg-count 1)
 966                               (format "s (%d-%d)" mh-first-msg-num
 967                                       mh-last-msg-num)
 968                             (format " (%d)" mh-first-msg-num))))))))
 969
 970
 971 (defun mh-unmark-all-headers (remove-all-flags)
 972   ;; Remove all '+' flags from the headers, and if called with a non-nil
 973   ;; argument, remove all 'D', '^' and '%' flags too.
 974   ;; Optimized for speed (i.e., no regular expressions).
 975   (save-excursion
 976     (let ((case-fold-search nil)
 977           (last-line (1- (point-max)))
 978           char)
 979       (mh-first-msg)
 980       (while (<= (point) last-line)
 981         (forward-char mh-cmd-note)
 982         (setq char (following-char))
 983         (if (or (and remove-all-flags
 984                      (or (= char (aref mh-note-deleted 0))
 985                          (= char (aref mh-note-refiled 0))))
 986                 (= char (aref mh-note-cur 0)))
 987             (progn
 988               (delete-char 1)
 989               (insert " ")))
 990         (if remove-all-flags
 991             (progn
 992               (forward-char 1)
 993               (if (= (following-char) (aref mh-note-seq 0))
 994                   (progn
 995                     (delete-char 1)
 996                     (insert " ")))))
 997         (forward-line)))))
 998
 999
1000 (defun mh-remove-cur-notation ()
1001   ;; Remove old cur notation (cf mh-goto-cur-msg code).
1002   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1003     (save-excursion
1004       (and cur-msg
1005            (mh-goto-msg cur-msg t t)
1006            (looking-at mh-cur-scan-msg-regexp)
1007            (mh-notate nil ?  mh-cmd-note)))))
1008
1009 (defun mh-goto-cur-msg ()
1010   ;; Position the cursor at the current message.
1011   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1012     (cond ((and cur-msg
1013                 (mh-goto-msg cur-msg t t))
1014            (mh-notate nil mh-note-cur mh-cmd-note)
1015            (mh-recenter 0)
1016            (mh-maybe-show cur-msg))
1017           (t
1018            (mh-last-msg)
1019            (message "No current message")))))
1020
1021
1022 (defun mh-process-or-undo-commands (folder)
1023   ;; If FOLDER has outstanding commands, then either process or discard them.
1024   ;; Called by functions like mh-sort-folder, so also invalidate show buffer.
1025   (set-buffer folder)
1026   (if (mh-outstanding-commands-p)
1027       (if (or mh-do-not-confirm
1028               (y-or-n-p
1029                 "Process outstanding deletes and refiles (or lose them)? "))
1030           (mh-process-commands folder)
1031           (mh-undo-folder)))
1032   (mh-update-unseen)
1033   (mh-invalidate-show-buffer))
1034
1035
1036 (defun mh-process-commands (folder)
1037   ;; Process outstanding commands for the folder FOLDER.
1038   (message "Processing deletes and refiles for %s..." folder)
1039   (set-buffer folder)
1040   (with-mh-folder-updating (nil)
1041     ;; Update the unseen sequence if it exists
1042     (mh-update-unseen)
1043
1044     ;; Then refile messages
1045     (mh-mapc
1046      (function
1047       (lambda (dest)
1048         (let ((msgs (mh-seq-to-msgs dest)))
1049           (cond (msgs
1050                  (apply 'mh-exec-cmd "refile"
1051                         "-src" folder (symbol-name dest)
1052                         (mh-coalesce-msg-list msgs))
1053                  (mh-delete-scan-msgs msgs))))))
1054      mh-refile-list)
1055     (setq mh-refile-list nil)
1056
1057     ;; Now delete messages
1058     (cond (mh-delete-list
1059            (apply 'mh-exec-cmd "rmm" folder
1060                   (mh-coalesce-msg-list mh-delete-list))
1061            (mh-delete-scan-msgs mh-delete-list)
1062            (setq mh-delete-list nil)))
1063
1064     ;; Don't need to remove sequences since delete and refile do so.
1065
1066     ;; Mark cur message
1067     (if (> (buffer-size) 0)
1068         (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1069
1070     (and (buffer-file-name (get-buffer mh-show-buffer))
1071          (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1072          ;; If "inc" were to put a new msg in this file,
1073          ;; we would not notice, so mark it invalid now.
1074          (mh-invalidate-show-buffer))
1075
1076     (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1077     (mh-unmark-all-headers t)
1078     (mh-notate-user-sequences)
1079     (message "Processing deletes and refiles for %s...done" folder)))
1080
1081
1082 (defun mh-update-unseen ()
1083   ;; Flush updates to the Unseen sequence out to MH.
1084   ;; Return non-NIL iff set the MH folder.
1085   (if mh-seen-list
1086       (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
1087              (unseen-msgs (mh-seq-msgs unseen-seq)))
1088         (if unseen-msgs
1089             (progn
1090               (mh-undefine-sequence mh-unseen-seq mh-seen-list)
1091               (while mh-seen-list
1092                 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
1093                 (setq mh-seen-list (cdr mh-seen-list)))
1094               (setcdr unseen-seq unseen-msgs)
1095               t)                        ;since we set the folder
1096           (setq mh-seen-list nil)))))
1097
1098
1099 (defun mh-delete-scan-msgs (msgs)
1100   ;; Delete the scan listing lines for each of the msgs in the LIST.
1101   (save-excursion
1102     (while msgs
1103       (if (mh-goto-msg (car msgs) t t)
1104           (mh-delete-line 1))
1105       (setq msgs (cdr msgs)))))
1106
1107
1108 (defun mh-outstanding-commands-p ()
1109   ;; Returns non-nil if there are outstanding deletes or refiles.
1110   (or mh-delete-list mh-refile-list))
1111
1112
1113 (defun mh-coalesce-msg-list (messages)
1114   ;; Give a list of MESSAGES, return a list of message number ranges.
1115   ;; Sort of the opposite of mh-read-msg-list, which expands ranges.
1116   ;; Message lists passed to MH programs go through this so
1117   ;; command line arguments won't exceed system limits.
1118   (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
1119         (range-high nil)
1120         (prev -1)
1121         (ranges nil))
1122     (while prev
1123       (if range-high
1124           (if (or (not (numberp prev))
1125                   (not (equal (car msgs) (1- prev))))
1126               (progn                    ;non-sequential, flush old range
1127                 (if (eq prev range-high)
1128                     (setq ranges (cons range-high ranges))
1129                   (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
1130                 (setq range-high nil))))
1131       (or range-high
1132           (setq range-high (car msgs))) ;start new or first range
1133       (setq prev (car msgs))
1134       (setq msgs (cdr msgs)))
1135     ranges))
1136
1137 (defun mh-greaterp (msg1 msg2)
1138   ;; Sort two message indicators.  Strings are "smaller" than numbers.
1139   ;; Legal values are things like "cur", "last", 1, and 1820.
1140   (if (numberp msg1)
1141          (if (numberp msg2)
1142              (> msg1 msg2)
1143            t)
1144     (if (numberp msg2)
1145         nil
1146       (string-lessp msg2 msg1))))
1147
1148 \f
1149
1150 ;;; Basic sequence handling
1151
1152 (defun mh-delete-seq-locally (seq)
1153   ;; Remove mh-e's record of SEQUENCE.
1154   (let ((entry (mh-find-seq seq)))
1155     (setq mh-seq-list (delq entry mh-seq-list))))
1156
1157 (defun mh-read-folder-sequences (folder save-refiles)
1158   ;; Read and return the predefined sequences for a FOLDER.
1159   ;; If SAVE-REFILES is non-nil, then keep the sequences
1160   ;; that note messages to be refiled.
1161   (let ((seqs ()))
1162     (cond (save-refiles
1163             (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1164                                  (if (mh-folder-name-p (mh-seq-name seq))
1165                                      (setq seqs (cons seq seqs)))))
1166                      mh-seq-list)))
1167     (save-excursion
1168       (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1169           (progn
1170             ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1171             (while (re-search-forward "^[^: ]+" nil t)
1172               (setq seqs (cons (mh-make-seq (intern (buffer-substring
1173                                                      (match-beginning 0)
1174                                                      (match-end 0)))
1175                                             (mh-read-msg-list))
1176                                seqs)))
1177             (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon
1178     seqs))
1179
1180 (defun mh-read-msg-list ()
1181   ;; Return a list of message numbers from the current point to the end of
1182   ;; the line.  Expands ranges into set of individual numbers.
1183   (let ((msgs ())
1184         (end-of-line (save-excursion (end-of-line) (point)))
1185         num)
1186     (while (re-search-forward "[0-9]+" end-of-line t)
1187       (setq num (string-to-int (buffer-substring (match-beginning 0)
1188                                                  (match-end 0))))
1189       (cond ((looking-at "-")           ; Message range
1190              (forward-char 1)
1191              (re-search-forward "[0-9]+" end-of-line t)
1192              (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1193                                                           (match-end 0)))))
1194                (if (< num2 num)
1195                    (error "Bad message range: %d-%d" num num2))
1196                (while (<= num num2)
1197                  (setq msgs (cons num msgs))
1198                  (setq num (1+ num)))))
1199             ((not (zerop num))          ;"pick" outputs "0" to mean no match
1200              (setq msgs (cons num msgs)))))
1201     msgs))
1202
1203 (defun mh-notate-user-sequences ()
1204   ;; Mark the scan listing of all messages in user-defined sequences.
1205   (let ((seqs mh-seq-list)
1206         name)
1207     (while seqs
1208       (setq name (mh-seq-name (car seqs)))
1209       (if (not (mh-internal-seq name))
1210           (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
1211       (setq seqs (cdr seqs)))))
1212
1213
1214 (defun mh-internal-seq (name)
1215   ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
1216   (or (memq name '(answered cur deleted forwarded printed))
1217       (eq name mh-unseen-seq)
1218       (eq name mh-previous-seq)
1219       (mh-folder-name-p name)))
1220
1221
1222 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
1223   "Delete MESSAGE from SEQUENCE.  MESSAGE defaults to displayed message.
1224 From Lisp, optional third arg INTERNAL-FLAG non-nil means do not
1225 inform MH of the change."
1226   (interactive (list (mh-get-msg-num t)
1227                      (mh-read-seq-default "Delete from" t)
1228                      nil))
1229   (let ((entry (mh-find-seq sequence)))
1230     (cond (entry
1231            (mh-notate-if-in-one-seq message ?  (1+ mh-cmd-note) sequence)
1232            (if (not internal-flag)
1233                (mh-undefine-sequence sequence (list message)))
1234            (setcdr entry (delq message (mh-seq-msgs entry)))))))
1235
1236
1237 (defun mh-undefine-sequence (seq msgs)
1238   ;; Remove from the SEQUENCE the list of MSGS.
1239   (mh-exec-cmd "mark" mh-current-folder "-delete"
1240                "-sequence" (symbol-name seq)
1241                (mh-coalesce-msg-list msgs)))
1242
1243
1244 (defun mh-define-sequence (seq msgs)
1245   ;; Define the SEQUENCE to contain the list of MSGS.
1246   ;; Do not mark pseudo-sequences or empty sequences.
1247   ;; Signals an error if SEQUENCE is an illegal name.
1248   (if (and msgs
1249            (not (mh-folder-name-p seq)))
1250       (save-excursion
1251         (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
1252                            "-sequence" (symbol-name seq)
1253                            (mh-coalesce-msg-list msgs)))))
1254
1255
1256 (defun mh-map-over-seqs (func seq-list)
1257   ;; Apply the FUNCTION to each element in the list of SEQUENCES,
1258   ;; passing the sequence name and the list of messages as arguments.
1259   (while seq-list
1260     (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
1261     (setq seq-list (cdr seq-list))))
1262
1263
1264 (defun mh-notate-if-in-one-seq (msg notation offset seq)
1265   ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
1266   ;; message with the CHARACTER at the given OFFSET from the beginning of the
1267   ;; listing line.
1268   (let ((in-seqs (mh-seq-containing-msg msg nil)))
1269     (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
1270         (mh-notate msg notation offset))))
1271
1272
1273 (defun mh-seq-containing-msg (msg &optional include-internal-p)
1274   ;; Return a list of the sequences containing MESSAGE.
1275   ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list.
1276   (let ((l mh-seq-list)
1277         (seqs ()))
1278     (while l
1279       (and (memq msg (mh-seq-msgs (car l)))
1280            (or include-internal-p
1281                (not (mh-internal-seq (mh-seq-name (car l)))))
1282            (setq seqs (cons (mh-seq-name (car l)) seqs)))
1283       (setq l (cdr l)))
1284     seqs))
1285
1286
1287 \f
1288
1289 ;;; User prompting commands.
1290
1291
1292 (defun mh-read-msg-range (prompt)
1293   ;; Read a list of blank-separated items.
1294   (let* ((buf (read-string prompt))
1295          (buf-size (length buf))
1296          (start 0)
1297          (input ()))
1298     (while (< start buf-size)
1299       (let ((next (read-from-string buf start buf-size)))
1300         (setq input (cons (car next) input))
1301         (setq start (cdr next))))
1302     (nreverse input)))
1303
1304 \f
1305
1306 ;;; Build the folder-mode keymap:
1307
1308 (suppress-keymap mh-folder-mode-map)
1309 (define-key mh-folder-mode-map "q" 'mh-quit)
1310 (define-key mh-folder-mode-map "b" 'mh-compat-quit)
1311 (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
1312 (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
1313 (define-key mh-folder-mode-map "|" 'mh-pipe-msg)
1314 (define-key mh-folder-mode-map "\ea" 'mh-edit-again)
1315 (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
1316 (define-key mh-folder-mode-map "\e#" 'mh-delete-seq)
1317 (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
1318 (define-key mh-folder-mode-map "\C-xw" 'mh-widen)
1319 (define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
1320 (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
1321 (define-key mh-folder-mode-map "\e " 'mh-page-digest)
1322 (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
1323 (define-key mh-folder-mode-map "\ed" 'mh-redistribute)
1324 (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
1325 (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
1326 (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
1327 (define-key mh-folder-mode-map "\el" 'mh-list-folders)
1328 (define-key mh-folder-mode-map "\en" 'mh-store-msg)
1329 (define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
1330 (define-key mh-folder-mode-map "\eq" 'mh-list-sequences)
1331 (define-key mh-folder-mode-map "\es" 'mh-search-folder)
1332 (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
1333 (define-key mh-folder-mode-map "l" 'mh-print-msg)
1334 (define-key mh-folder-mode-map "t" 'mh-toggle-showing)
1335 (define-key mh-folder-mode-map "c" 'mh-copy-msg)
1336 (define-key mh-folder-mode-map "i" 'mh-inc-folder)
1337 (define-key mh-folder-mode-map "x" 'mh-execute-commands)
1338 (define-key mh-folder-mode-map "e" 'mh-execute-commands)
1339 (define-key mh-folder-mode-map "f" 'mh-forward)
1340 (define-key mh-folder-mode-map "m" 'mh-send)
1341 (define-key mh-folder-mode-map "s" 'mh-send)
1342 (define-key mh-folder-mode-map "r" 'mh-reply)
1343 (define-key mh-folder-mode-map "a" 'mh-reply)
1344 (define-key mh-folder-mode-map "j" 'mh-goto-msg)
1345 (define-key mh-folder-mode-map "g" 'mh-goto-msg)
1346 (define-key mh-folder-mode-map "\e<" 'mh-first-msg)
1347 (define-key mh-folder-mode-map "\e>" 'mh-last-msg)
1348 (define-key mh-folder-mode-map "\177" 'mh-previous-page)
1349 (define-key mh-folder-mode-map " " 'mh-page-msg)
1350 (define-key mh-folder-mode-map "\r" 'mh-show)
1351 (define-key mh-folder-mode-map "." 'mh-show)
1352 (define-key mh-folder-mode-map "," 'mh-header-display)
1353 (define-key mh-folder-mode-map "u" 'mh-undo)
1354 (define-key mh-folder-mode-map "d" 'mh-delete-msg)
1355 (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
1356 (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
1357 (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
1358 (define-key mh-folder-mode-map "o" 'mh-refile-msg)
1359 (define-key mh-folder-mode-map "^" 'mh-refile-msg)
1360 (define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file)
1361 (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
1362 (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
1363
1364 ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
1365
1366 \f
1367
1368 ;;;autoload the other mh-e parts
1369
1370 ;;; mh-comp
1371
1372 (autoload 'mh-smail "mh-comp"
1373   "Compose and send mail with the MH mail system.
1374 This function is an entry point to mh-e, the Emacs front end
1375 to the MH mail system.
1376 See documentation of `\\[mh-send]' for more details on composing mail." t)
1377
1378 (autoload 'mh-smail-other-window "mh-comp"
1379   "Compose and send mail in other window with the MH mail system.
1380 This function is an entry point to mh-e, the Emacs front end
1381 to the MH mail system.
1382 See documentation of `\\[mh-send]' for more details on composing mail." t)
1383
1384 (autoload 'mh-edit-again "mh-comp"
1385   "Clean-up a draft or a message previously sent and make it resendable.
1386 Default is the current message.
1387 The variable mh-new-draft-cleaned-headers specifies the headers to remove.
1388 See also documentation for `\\[mh-send]' function." t)
1389
1390 (autoload 'mh-extract-rejected-mail "mh-comp"
1391   "Extract a letter returned by the mail system and make it resendable.
1392 Default is the current message.  The variable mh-new-draft-cleaned-headers
1393 gives the headers to clean out of the original message.
1394 See also documentation for `\\[mh-send]' function." t)
1395
1396 (autoload 'mh-forward "mh-comp"
1397   "Forward a message or message sequence.  Defaults to displayed message.
1398 If optional prefix argument provided, then prompt for the message sequence.
1399 See also documentation for `\\[mh-send]' function." t)
1400
1401 (autoload 'mh-redistribute "mh-comp"
1402   "Redistribute a letter.
1403 Depending on how your copy of MH was compiled, you may need to change the
1404 setting of the variable mh-redist-full-contents.  See its documentation." t)
1405
1406 (autoload 'mh-reply "mh-comp"
1407   "Reply to a MESSAGE (default: displayed message).
1408 If optional prefix argument INCLUDEP provided, then include the message
1409 in the reply using filter mhl.reply in your MH directory.
1410 Prompts for type of addresses to reply to:
1411    from    sender only,
1412    to      sender and primary recipients,
1413    cc/all  sender and all recipients.
1414 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
1415 for the reply.  See also documentation for `\\[mh-send]' function." t)
1416
1417 (autoload 'mh-send "mh-comp"
1418   "Compose and send a letter.
1419 The file named by `mh-comp-formfile' will be used as the form.
1420 Do not call this function from outside mh-e; use \\[mh-smail] instead.
1421 The letter is composed in mh-letter-mode; see its documentation for more
1422 details.  If `mh-compose-letter-function' is defined, it is called on the
1423 draft and passed three arguments: to, subject, and cc." t)
1424
1425 (autoload 'mh-send-other-window "mh-comp"
1426   "Compose and send a letter in another window.
1427 Do not call this function from outside mh-e;
1428 use \\[mh-smail-other-window] instead.
1429 See also documentation for `\\[mh-send]' function." t)
1430
1431 (autoload 'mh-letter-mode "mh-comp"
1432   "Mode for composing letters in mh-e.
1433 For more details, type \\[describe-mode] while in MH-Letter mode." t)
1434
1435
1436 ;;; mh-funcs
1437
1438 (autoload 'mh-burst-digest "mh-funcs"
1439   "Burst apart the current message, which should be a digest.
1440 The message is replaced by its table of contents and the messages from the
1441 digest are inserted into the folder after that message." t)
1442
1443 (autoload 'mh-copy-msg "mh-funcs"
1444   "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
1445 Default is the displayed message.  If optional prefix argument is
1446 provided, then prompt for the message sequence." t)
1447
1448 (autoload 'mh-kill-folder "mh-funcs"
1449   "Remove the current folder." t)
1450
1451 (autoload 'mh-list-folders "mh-funcs"
1452   "List mail folders." t)
1453
1454 (autoload 'mh-pack-folder "mh-funcs"
1455   "Renumber the messages of a folder to be 1..n.
1456 First, offer to execute any outstanding commands for the current folder.
1457 If optional prefix argument provided, prompt for the range of messages
1458 to display after packing.  Otherwise, show the entire folder." t)
1459
1460 (autoload 'mh-pipe-msg "mh-funcs"
1461   "Pipe the current message through the given shell COMMAND.
1462 If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
1463 Otherwise just send the message's body without the headers." t)
1464
1465 (autoload 'mh-page-digest "mh-funcs"
1466   "Advance displayed message to next digested message." t)
1467
1468 (autoload 'mh-page-digest-backwards "mh-funcs"
1469   "Back up displayed message to previous digested message." t)
1470
1471 (autoload 'mh-print-msg "mh-funcs"
1472   "Print MESSAGE(s) (default: displayed message) on printer.
1473 If optional prefix argument provided, then prompt for the message sequence.
1474 The variable mh-lpr-command-format is used to generate the print command.
1475 The messages are formatted by mhl.  See the variable mhl-formfile." t)
1476
1477 (autoload 'mh-sort-folder "mh-funcs"
1478   "Sort the messages in the current folder by date.
1479 Calls the MH program sortm to do the work.
1480 The arguments in the list  mh-sortm-args  are passed to sortm
1481 if this function is passed an argument." t)
1482
1483 (autoload 'mh-undo-folder "mh-funcs"
1484   "Undo all commands in current folder." t)
1485
1486 (autoload 'mh-store-msg "mh-funcs"
1487   "Store the file(s) contained in the current message into DIRECTORY.
1488 The message can contain a shar file or uuencoded file.
1489 Default directory is the last directory used, or initially the value of
1490 mh-store-default-directory  or the current directory." t)
1491
1492 (autoload 'mh-store-buffer "mh-funcs"
1493   "Store the file(s) contained in the current buffer into DIRECTORY.
1494 The buffer can contain a shar file or uuencoded file.
1495 Default directory is the last directory used, or initially the value of
1496 `mh-store-default-directory' or the current directory." t)
1497
1498
1499 ;;; mh-pick
1500
1501 (autoload 'mh-search-folder "mh-pick"
1502   "Search FOLDER for messages matching a pattern.
1503 Add the messages found to the sequence named `search'." t)
1504
1505 ;;; mh-seq
1506
1507 (autoload 'mh-delete-seq "mh-seq"
1508   "Delete the SEQUENCE." t)
1509 (autoload 'mh-list-sequences "mh-seq"
1510   "List the sequences defined in FOLDER." t)
1511 (autoload 'mh-msg-is-in-seq "mh-seq"
1512   "Display the sequences that contain MESSAGE (default: displayed message)." t)
1513 (autoload 'mh-narrow-to-seq "mh-seq"
1514   "Restrict display of this folder to just messages in SEQUENCE
1515 Use \\[mh-widen] to undo this command." t)
1516 (autoload 'mh-put-msg-in-seq "mh-seq"
1517   "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
1518 If optional prefix argument provided, then prompt for the message sequence." t)
1519 (autoload 'mh-widen "mh-seq"
1520   "Remove restrictions from current folder, thereby showing all messages." t)
1521 (autoload 'mh-rename-seq "mh-seq"
1522   "Rename SEQUENCE to have NEW-NAME." t)
1523
1524 ;;; mh-e.el ends here