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: Stephen Gildea <gildea@alum.mit.edu>
   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.ai.mit.edu 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.18 1998/03/08 00:25:49 rms Exp kwzh $")
  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
 432 (defun mh-quit ()
 433   "Quit the current mh-e folder.
 434 Start by running mh-before-quit-hook.  Restore the previous window
 435 configuration, if one exists.  Finish by running mh-quit-hook."
 436   (interactive)
 437   (run-hooks 'mh-before-quit-hook)
 438   (mh-update-sequences)
 439   (mh-invalidate-show-buffer)
 440   (quit-window)
 441   (and mh-show-buffer
 442        (get-buffer mh-show-buffer)
 443        (bury-buffer mh-show-buffer))
 444   (if mh-previous-window-config
 445       (set-window-configuration mh-previous-window-config))
 446   (run-hooks 'mh-quit-hook))
 447
 448 (defun mh-page-msg (&optional arg)
 449   "Page the displayed message forwards.
 450 Scrolls ARG lines or a full screen if no argument is supplied."
 451   (interactive "P")
 452   (scroll-other-window arg))
 453
 454
 455 (defun mh-previous-page (&optional arg)
 456   "Page the displayed message backwards.
 457 Scrolls ARG lines or a full screen if no argument is supplied."
 458   (interactive "P")
 459   (mh-in-show-buffer (mh-show-buffer)
 460     (scroll-down arg)))
 461
 462
 463 (defun mh-previous-undeleted-msg (&optional arg)
 464   "Move to the NTH previous undeleted message in window."
 465   (interactive "p")
 466   (setq mh-next-direction 'backward)
 467   (beginning-of-line)
 468   (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
 469          (mh-maybe-show))
 470         (t
 471          (if (get-buffer mh-show-buffer)
 472              (delete-windows-on mh-show-buffer)))))
 473
 474
 475 (defun mh-rescan-folder (&optional range)
 476   "Rescan a folder after optionally processing the outstanding commands.
 477 If optional prefix argument is provided, prompt for the range of
 478 messages to display.  Otherwise show the entire folder."
 479   (interactive (list (if current-prefix-arg
 480                          (mh-read-msg-range "Range to scan [all]? ")
 481                        nil)))
 482   (setq mh-next-direction 'forward)
 483   (mh-scan-folder mh-current-folder (or range "all")))
 484
 485
 486 (defun mh-write-msg-to-file (msg file no-headers)
 487   "Append MESSAGE to the end of a FILE.
 488 If NO-HEADERS (prefix argument) is provided, write only the message body.
 489 Otherwise send the entire message including the headers."
 490   (interactive
 491    (list (mh-get-msg-num t)
 492          (let ((default-dir (if (eq 'write (car mh-last-destination))
 493                                 (file-name-directory (car (cdr mh-last-destination)))
 494                               default-directory)))
 495            (read-file-name (format "Save message%s in file: "
 496                                    (if current-prefix-arg " body" ""))
 497                            default-dir
 498                            (if (eq 'write (car mh-last-destination))
 499                                (car (cdr mh-last-destination))
 500                              (expand-file-name "mail.out" default-dir))))
 501          current-prefix-arg))
 502   (let ((msg-file-to-output (mh-msg-filename msg))
 503         (output-file (mh-expand-file-name file)))
 504     (setq mh-last-destination (list 'write file (if no-headers 'no-headers)))
 505     (save-excursion
 506       (set-buffer (get-buffer-create mh-temp-buffer))
 507       (erase-buffer)
 508       (insert-file-contents msg-file-to-output)
 509       (goto-char (point-min))
 510       (if no-headers (search-forward "\n\n"))
 511       (append-to-file (point) (point-max) output-file))))
 512
 513
 514 (defun mh-toggle-showing ()
 515   "Toggle the scanning mode/showing mode of displaying messages."
 516   (interactive)
 517   (if mh-showing
 518       (mh-set-scan-mode)
 519       (mh-show)))
 520
 521
 522 (defun mh-undo (msg-or-seq)
 523   "Undo the pending deletion or refile of the specified MESSAGE(s).
 524 Default is the displayed message.  If optional prefix argument is
 525 provided, then prompt for the message sequence."
 526   (interactive (list (if current-prefix-arg
 527                          (mh-read-seq-default "Undo" t)
 528                          (mh-get-msg-num t))))
 529   (cond ((numberp msg-or-seq)
 530          (let ((original-position (point)))
 531            (beginning-of-line)
 532            (while (not (or (looking-at mh-deleted-msg-regexp)
 533                            (looking-at mh-refiled-msg-regexp)
 534                            (and (eq mh-next-direction 'forward) (bobp))
 535                            (and (eq mh-next-direction 'backward)
 536                                 (save-excursion (forward-line) (eobp)))))
 537              (forward-line (if (eq mh-next-direction 'forward) -1 1)))
 538            (if (or (looking-at mh-deleted-msg-regexp)
 539                    (looking-at mh-refiled-msg-regexp))
 540                (progn
 541                  (mh-undo-msg (mh-get-msg-num t))
 542                  (mh-maybe-show))
 543                (goto-char original-position)
 544                (error "Nothing to undo"))))
 545         (t
 546          (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
 547   ;; update the mh-refile-list so mh-outstanding-commands-p will work
 548   (mh-mapc (function
 549             (lambda (elt)
 550               (if (not (mh-seq-to-msgs elt))
 551                   (setq mh-refile-list (delq elt mh-refile-list)))))
 552            mh-refile-list)
 553   (if (not (mh-outstanding-commands-p))
 554       (mh-set-folder-modified-p nil)))
 555
 556
 557 ;;;###autoload
 558 (defun mh-version ()
 559   "Display version information about mh-e and the MH mail handling system."
 560   (interactive)
 561   (mh-find-progs)
 562   (set-buffer (get-buffer-create mh-temp-buffer))
 563   (erase-buffer)
 564   (insert "  mh-e info:\n\nversion: " mh-e-RCS-id
 565           "\nEmacs: " emacs-version " on " (symbol-name system-type) " ")
 566   (condition-case ()
 567       (call-process "uname" nil t nil "-a")
 568     (file-error))
 569   (insert "\n\n  MH info:\n\n" (expand-file-name "inc" mh-progs) ":\n")
 570   (let ((help-start (point)))
 571     (condition-case err-data
 572         (mh-exec-cmd-output "inc" nil "-help")
 573       (file-error (insert (mapconcat 'concat (cdr err-data) ": "))))
 574     (goto-char help-start)
 575     (search-forward "version: " nil t)
 576     (beginning-of-line)
 577     (delete-region help-start (point))
 578     (goto-char (point-min)))
 579   (display-buffer mh-temp-buffer))
 580
 581
 582 (defun mh-visit-folder (folder &optional range)
 583   "Visit FOLDER and display RANGE of messages.
 584 Do not call this function from outside mh-e; see \\[mh-rmail] instead."
 585   (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t)
 586                      (mh-read-msg-range "Range [all]? ")))
 587   (let ((config (current-window-configuration)))
 588     (mh-scan-folder folder (or range "all"))
 589     (setq mh-previous-window-config config))
 590   nil)
 591
 592
 593 (defun mh-compat-quit ()
 594   "The \"b\" key is obsolescent; will assume you want \"\\[mh-quit]\" ..."
 595   ;; Was going to make it run mh-burst-digest, but got complaint that
 596   ;; 'b' should mean 'back', as it does in info, less, and rn.
 597   ;; This is a temporary compatibility function.
 598   (interactive)
 599   (message "%s" (documentation this-command))
 600   (sit-for 1)
 601   (call-interactively 'mh-quit))
 602
 603
 604 (defun mh-update-sequences ()
 605   "Update MH's Unseen sequence and current folder and message.
 606 Flush mh-e's state out to MH.  The message at the cursor becomes current."
 607   (interactive)
 608   ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
 609   ;; which updates mh-e's state from MH.
 610   (let ((folder-set (mh-update-unseen))
 611         (new-cur (mh-get-msg-num nil)))
 612     (if new-cur
 613         (let ((seq-entry (mh-find-seq 'cur)))
 614           (mh-remove-cur-notation)
 615           (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
 616           (mh-define-sequence 'cur (list new-cur))
 617           (beginning-of-line)
 618           (if (looking-at mh-good-msg-regexp)
 619               (mh-notate nil mh-note-cur mh-cmd-note)))
 620       (or folder-set
 621           (save-excursion
 622             (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast"))))))
 623
 624
 625 \f
 626
 627 ;;; Support routines.
 628
 629 (defun mh-delete-a-msg (msg)
 630   ;; Delete the MESSAGE.
 631   (save-excursion
 632     (mh-goto-msg msg nil t)
 633     (if (looking-at mh-refiled-msg-regexp)
 634         (error "Message %d is refiled.  Undo refile before deleting." msg))
 635     (if (looking-at mh-deleted-msg-regexp)
 636         nil
 637         (mh-set-folder-modified-p t)
 638         (setq mh-delete-list (cons msg mh-delete-list))
 639         (mh-add-msgs-to-seq msg 'deleted t)
 640         (mh-notate msg mh-note-deleted mh-cmd-note)
 641         (run-hooks 'mh-delete-msg-hook))))
 642
 643 (defun mh-refile-a-msg (msg destination)
 644   ;; Refile MESSAGE in FOLDER.  FOLDER is a symbol, not a string.
 645   (save-excursion
 646     (mh-goto-msg msg nil t)
 647     (cond ((looking-at mh-deleted-msg-regexp)
 648            (error "Message %d is deleted.  Undo delete before moving." msg))
 649           ((looking-at mh-refiled-msg-regexp)
 650            (if (y-or-n-p
 651                 (format "Message %d already refiled.  Copy to %s as well? "
 652                         msg destination))
 653                (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
 654                             "-src" mh-current-folder
 655                             (symbol-name destination))
 656                (message "Message not copied.")))
 657           (t
 658            (mh-set-folder-modified-p t)
 659            (if (not (memq destination mh-refile-list))
 660                (setq mh-refile-list (cons destination mh-refile-list)))
 661            (if (not (memq msg (mh-seq-to-msgs destination)))
 662                (mh-add-msgs-to-seq msg destination t))
 663            (mh-notate msg mh-note-refiled mh-cmd-note)
 664            (run-hooks 'mh-refile-msg-hook)))))
 665
 666
 667 (defun mh-next-msg ()
 668   ;; Move backward or forward to the next undeleted message in the buffer.
 669   (if (eq mh-next-direction 'forward)
 670       (mh-next-undeleted-msg 1)
 671       (mh-previous-undeleted-msg 1)))
 672
 673
 674 (defun mh-set-scan-mode ()
 675   ;; Display the scan listing buffer, but do not show a message.
 676   (if (get-buffer mh-show-buffer)
 677       (delete-windows-on mh-show-buffer))
 678   (setq mh-showing nil)
 679   (force-mode-line-update)
 680   (if mh-recenter-summary-p
 681       (mh-recenter nil)))
 682
 683
 684 (defun mh-undo-msg (msg)
 685   ;; Undo the deletion or refile of one MESSAGE.
 686   (cond ((memq msg mh-delete-list)
 687          (setq mh-delete-list (delq msg mh-delete-list))
 688          (mh-delete-msg-from-seq msg 'deleted t))
 689         (t
 690          (mh-mapc (function (lambda (dest)
 691                               (mh-delete-msg-from-seq msg dest t)))
 692                   mh-refile-list)))
 693   (mh-notate msg ?  mh-cmd-note))
 694
 695
 696 \f
 697
 698 ;;; The folder data abstraction.
 699
 700 (defun mh-make-folder (name)
 701   ;; Create and initialize a new mail folder called NAME and make it the
 702   ;; current folder.
 703   (switch-to-buffer name)
 704   (setq buffer-read-only nil)
 705   (erase-buffer)
 706   (setq buffer-read-only t)
 707   (mh-folder-mode)
 708   (mh-set-folder-modified-p nil)
 709   (setq buffer-file-name mh-folder-filename)
 710   (mh-make-folder-mode-line))
 711
 712
 713 ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
 714 (put 'mh-folder-mode 'mode-class 'special)
 715
 716 (defun mh-folder-mode ()
 717   "Major mh-e mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
 718 You can show the message the cursor is pointing to, and step through the
 719 messages.  Messages can be marked for deletion or refiling into another
 720 folder; these commands are executed all at once with a separate command.
 721
 722 A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
 723 applies the action to a message sequence.
 724
 725 Here is a list of the standard keys for mh-e commands, grouped by function.
 726 This list is purposefully not customized; mh-e has a long history, and many
 727 alternate key bindings as a result.  This list is to encourage users to use
 728 standard keys so the other keys can perhaps someday be put to new uses.
 729
 730 t       toggle show or scan-only mode
 731 RET     show message, or back to top if already showing
 732
 733 SPC     page message forward
 734 DEL     page message back
 735
 736 n       next message
 737 p       previous message
 738 g       go to message by number
 739
 740 d       mark for deletion
 741 o, ^    mark for output (refile) to another folder
 742 ?       show folder of pending refile
 743 u       undo delete or refile marking
 744
 745 x       execute marked deletes and refiles
 746 i       incorporate new mail
 747
 748 m       mail a new message
 749 r       reply to a message
 750 f       forward a message
 751
 752 q       quit mh-e
 753
 754 M-f     visit new folder
 755 M-r     rescan this folder
 756
 757 Here are all the commands with their current binding, listed in key order:
 758 \\{mh-folder-mode-map}
 759
 760 Variables controlling mh-e operation are (defaults in parentheses):
 761
 762  mh-recursive-folders (nil)
 763     Non-nil means commands which operate on folders do so recursively.
 764
 765  mh-bury-show-buffer (t)
 766     Non-nil means that the buffer used to display message is buried.
 767     It will never be offered as the default other buffer.
 768
 769  mh-clean-message-header (nil)
 770     Non-nil means remove header lines matching the regular expression
 771     specified in mh-invisible-headers from messages.
 772
 773  mh-visible-headers (nil)
 774     If non-nil, it contains a regexp specifying the headers that are shown in
 775     a message if mh-clean-message-header is non-nil.  Setting this variable
 776     overrides mh-invisible-headers.
 777
 778  mh-do-not-confirm (nil)
 779     Non-nil means do not prompt for confirmation before executing some
 780     non-recoverable commands such as mh-kill-folder and mh-undo-folder.
 781
 782  mhl-formfile (nil)
 783     Name of format file to be used by mhl to show messages.
 784     A value of T means use the default format file.
 785     Nil means don't use mhl to format messages.
 786
 787  mh-lpr-command-format (\"lpr -p -J '%s'\")
 788     Format for command used to print a message on a system printer.
 789
 790  mh-scan-prog (\"scan\")
 791     Program to run to generate one-line-per-message listing of a folder.
 792     Normally \"scan\" or a file name linked to scan.  This file is searched
 793     for relative to the mh-progs directory unless it is an absolute pathname.
 794     Automatically becomes buffer-local when set in any fashion.
 795
 796  mh-print-background (nil)
 797     Print messages in the background if non-nil.
 798     WARNING: do not delete the messages until printing is finished;
 799     otherwise, your output may be truncated.
 800
 801  mh-recenter-summary-p (nil)
 802     If non-nil, then the scan listing is recentered when the window displaying
 803     a messages is toggled off.
 804
 805  mh-summary-height (4)
 806     Number of lines in the summary window including the mode line.
 807
 808 The value of mh-folder-mode-hook is called when a new folder is set up."
 809
 810   (kill-all-local-variables)
 811   (use-local-map mh-folder-mode-map)
 812   (setq major-mode 'mh-folder-mode)
 813   (mh-set-mode-name "MH-Folder")
 814   (mh-make-local-vars
 815    'mh-current-folder (buffer-name)     ; Name of folder, a string
 816    'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
 817    'mh-folder-filename                  ; e.g. "/usr/foobar/Mail/inbox/"
 818    (file-name-as-directory (mh-expand-file-name (buffer-name)))
 819    'mh-showing nil                      ; Show message also?
 820    'mh-delete-list nil                  ; List of msgs nums to delete
 821    'mh-refile-list nil                  ; List of folder names in mh-seq-list
 822    'mh-seq-list nil                     ; Alist of (seq . msgs) nums
 823    'mh-seen-list nil                    ; List of displayed messages
 824    'mh-next-direction 'forward          ; Direction to move to next message
 825    'mh-narrowed-to-seq nil              ; Sequence display is narrowed to
 826    'mh-first-msg-num nil                ; Number of first msg in buffer
 827    'mh-last-msg-num nil                 ; Number of last msg in buffer
 828    'mh-msg-count nil                    ; Number of msgs in buffer
 829    'mh-mode-line-annotation nil         ; Indiction this is not the full folder
 830    'mh-previous-window-config nil)      ; Previous window configuration
 831   (setq truncate-lines t)
 832   (auto-save-mode -1)
 833   (setq buffer-offer-save t)
 834   (if (boundp 'local-write-file-hooks)
 835       (setq local-write-file-hooks '(mh-execute-commands)) ;Emacs 19
 836     (make-local-variable 'write-file-hooks)
 837     (setq write-file-hooks '(mh-execute-commands))) ;Emacs 18
 838   (make-local-variable 'revert-buffer-function)
 839   (setq revert-buffer-function 'mh-undo-folder)
 840   (or (assq 'mh-showing minor-mode-alist)
 841       (setq minor-mode-alist
 842             (cons '(mh-showing " Show") minor-mode-alist)))
 843   (run-hooks 'mh-folder-mode-hook))
 844
 845
 846 (defun mh-make-local-vars (&rest pairs)
 847   ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
 848   ;; value.
 849   (while pairs
 850     (make-variable-buffer-local (car pairs))
 851     (set (car pairs) (car (cdr pairs)))
 852     (setq pairs (cdr (cdr pairs)))))
 853
 854
 855 (defun mh-scan-folder (folder range)
 856   ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
 857   (cond ((null (get-buffer folder))
 858          (mh-make-folder folder))
 859         (t
 860          (mh-process-or-undo-commands folder)
 861          (switch-to-buffer folder)))
 862   (mh-regenerate-headers range)
 863   (cond ((zerop (buffer-size))
 864          (if (equal range "all")
 865              (message "Folder %s is empty" folder)
 866            (message "No messages in %s, range %s" folder range))
 867          (sit-for 5)))
 868   (mh-goto-cur-msg))
 869
 870
 871 (defun mh-regenerate-headers (range &optional update)
 872   ;; scan folder over range RANGE.
 873   ;; If UPDATE, append the scan lines, otherwise replace.
 874   (let ((folder mh-current-folder)
 875         scan-start)
 876     (message "Scanning %s..." folder)
 877     (with-mh-folder-updating (nil)
 878       (if update
 879           (goto-char (point-max))
 880         (erase-buffer))
 881       (setq scan-start (point))
 882       (mh-exec-cmd-output mh-scan-prog nil
 883                           "-noclear" "-noheader"
 884                           "-width" (window-width)
 885                           folder range)
 886       (goto-char scan-start)
 887       (cond ((looking-at "scan: no messages in")
 888              (keep-lines mh-valid-scan-line)) ; Flush random scan lines
 889             ((looking-at "scan: "))     ; Keep error messages
 890             (t
 891              (keep-lines mh-valid-scan-line))) ; Flush random scan lines
 892       (setq mh-seq-list (mh-read-folder-sequences folder nil))
 893       (mh-notate-user-sequences)
 894       (or update
 895           (setq mh-mode-line-annotation
 896                 (if (equal range "all")
 897                     nil
 898                   mh-partial-folder-mode-line-annotation)))
 899       (mh-make-folder-mode-line))
 900     (message "Scanning %s...done" folder)))
 901
 902
 903 (defun mh-get-new-mail (maildrop-name)
 904   ;; Read new mail from a maildrop into the current buffer.
 905   ;; Return in the current buffer.
 906   (let ((point-before-inc (point))
 907         (folder mh-current-folder)
 908         (new-mail-p nil))
 909     (with-mh-folder-updating (t)
 910       (if maildrop-name
 911           (message "inc %s -file %s..." folder maildrop-name)
 912         (message "inc %s..." folder))
 913       (setq mh-next-direction 'forward)
 914       (goto-char (point-max))
 915       (let ((start-of-inc (point)))
 916         (if maildrop-name
 917             ;; I think MH 5 used "-ms-file" instead of "-file",
 918             ;; which would make inc'ing from maildrops fail.
 919             (mh-exec-cmd-output mh-inc-prog nil folder
 920                                 "-file" (expand-file-name maildrop-name)
 921                                 "-width" (window-width)
 922                                 "-truncate")
 923             (mh-exec-cmd-output mh-inc-prog nil
 924                                 "-width" (window-width)))
 925         (if maildrop-name
 926             (message "inc %s -file %s...done" folder maildrop-name)
 927           (message "inc %s...done" folder))
 928         (goto-char start-of-inc)
 929         (cond ((save-excursion
 930                  (re-search-forward "^inc: no mail" nil t))
 931                (message "No new mail%s%s" (if maildrop-name " in " "")
 932                         (if maildrop-name maildrop-name "")))
 933               ((re-search-forward "^inc:" nil t) ; Error messages
 934                (error "inc error"))
 935               (t
 936                (mh-remove-cur-notation)
 937                (setq new-mail-p t)))
 938         (keep-lines mh-valid-scan-line) ; Flush random scan lines
 939         (setq mh-seq-list (mh-read-folder-sequences folder t))
 940         (mh-notate-user-sequences)
 941         (if new-mail-p
 942             (progn
 943               (mh-make-folder-mode-line)
 944               (mh-goto-cur-msg))
 945             (goto-char point-before-inc))))))
 946
 947
 948 (defun mh-make-folder-mode-line (&optional ignored)
 949   ;; Set the fields of the mode line for a folder buffer.
 950   ;; The optional argument is now obsolete.  It used to be used to pass
 951   ;; in what is now stored in the buffer-local variable
 952   ;; mh-mode-line-annotation.
 953   (save-excursion
 954     (mh-first-msg)
 955     (setq mh-first-msg-num (mh-get-msg-num nil))
 956     (mh-last-msg)
 957     (setq mh-last-msg-num (mh-get-msg-num nil))
 958     (setq mh-msg-count (count-lines (point-min) (point-max)))
 959     (setq mode-line-buffer-identification
 960           (list (format "{%%b%s} %d msg%s"
 961                         (if mh-mode-line-annotation
 962                             (format "/%s" mh-mode-line-annotation)
 963                           "")
 964                         mh-msg-count
 965                         (if (zerop mh-msg-count)
 966                             "s"
 967                           (if (> mh-msg-count 1)
 968                               (format "s (%d-%d)" mh-first-msg-num
 969                                       mh-last-msg-num)
 970                             (format " (%d)" mh-first-msg-num))))))))
 971
 972
 973 (defun mh-unmark-all-headers (remove-all-flags)
 974   ;; Remove all '+' flags from the headers, and if called with a non-nil
 975   ;; argument, remove all 'D', '^' and '%' flags too.
 976   ;; Optimized for speed (i.e., no regular expressions).
 977   (save-excursion
 978     (let ((case-fold-search nil)
 979           (last-line (1- (point-max)))
 980           char)
 981       (mh-first-msg)
 982       (while (<= (point) last-line)
 983         (forward-char mh-cmd-note)
 984         (setq char (following-char))
 985         (if (or (and remove-all-flags
 986                      (or (= char (aref mh-note-deleted 0))
 987                          (= char (aref mh-note-refiled 0))))
 988                 (= char (aref mh-note-cur 0)))
 989             (progn
 990               (delete-char 1)
 991               (insert " ")))
 992         (if remove-all-flags
 993             (progn
 994               (forward-char 1)
 995               (if (= (following-char) (aref mh-note-seq 0))
 996                   (progn
 997                     (delete-char 1)
 998                     (insert " ")))))
 999         (forward-line)))))
1000
1001
1002 (defun mh-remove-cur-notation ()
1003   ;; Remove old cur notation (cf mh-goto-cur-msg code).
1004   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1005     (save-excursion
1006       (and cur-msg
1007            (mh-goto-msg cur-msg t t)
1008            (looking-at mh-cur-scan-msg-regexp)
1009            (mh-notate nil ?  mh-cmd-note)))))
1010
1011 (defun mh-goto-cur-msg ()
1012   ;; Position the cursor at the current message.
1013   (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1014     (cond ((and cur-msg
1015                 (mh-goto-msg cur-msg t t))
1016            (mh-notate nil mh-note-cur mh-cmd-note)
1017            (mh-recenter 0)
1018            (mh-maybe-show cur-msg))
1019           (t
1020            (mh-last-msg)
1021            (message "No current message")))))
1022
1023
1024 (defun mh-process-or-undo-commands (folder)
1025   ;; If FOLDER has outstanding commands, then either process or discard them.
1026   ;; Called by functions like mh-sort-folder, so also invalidate show buffer.
1027   (set-buffer folder)
1028   (if (mh-outstanding-commands-p)
1029       (if (or mh-do-not-confirm
1030               (y-or-n-p
1031                 "Process outstanding deletes and refiles (or lose them)? "))
1032           (mh-process-commands folder)
1033           (mh-undo-folder)))
1034   (mh-update-unseen)
1035   (mh-invalidate-show-buffer))
1036
1037
1038 (defun mh-process-commands (folder)
1039   ;; Process outstanding commands for the folder FOLDER.
1040   (message "Processing deletes and refiles for %s..." folder)
1041   (set-buffer folder)
1042   (with-mh-folder-updating (nil)
1043     ;; Update the unseen sequence if it exists
1044     (mh-update-unseen)
1045
1046     ;; Then refile messages
1047     (mh-mapc
1048      (function
1049       (lambda (dest)
1050         (let ((msgs (mh-seq-to-msgs dest)))
1051           (cond (msgs
1052                  (apply 'mh-exec-cmd "refile"
1053                         "-src" folder (symbol-name dest)
1054                         (mh-coalesce-msg-list msgs))
1055                  (mh-delete-scan-msgs msgs))))))
1056      mh-refile-list)
1057     (setq mh-refile-list nil)
1058
1059     ;; Now delete messages
1060     (cond (mh-delete-list
1061            (apply 'mh-exec-cmd "rmm" folder
1062                   (mh-coalesce-msg-list mh-delete-list))
1063            (mh-delete-scan-msgs mh-delete-list)
1064            (setq mh-delete-list nil)))
1065
1066     ;; Don't need to remove sequences since delete and refile do so.
1067
1068     ;; Mark cur message
1069     (if (> (buffer-size) 0)
1070         (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1071
1072     (and (buffer-file-name (get-buffer mh-show-buffer))
1073          (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1074          ;; If "inc" were to put a new msg in this file,
1075          ;; we would not notice, so mark it invalid now.
1076          (mh-invalidate-show-buffer))
1077
1078     (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1079     (mh-unmark-all-headers t)
1080     (mh-notate-user-sequences)
1081     (message "Processing deletes and refiles for %s...done" folder)))
1082
1083
1084 (defun mh-update-unseen ()
1085   ;; Flush updates to the Unseen sequence out to MH.
1086   ;; Return non-NIL iff set the MH folder.
1087   (if mh-seen-list
1088       (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
1089              (unseen-msgs (mh-seq-msgs unseen-seq)))
1090         (if unseen-msgs
1091             (progn
1092               (mh-undefine-sequence mh-unseen-seq mh-seen-list)
1093               (while mh-seen-list
1094                 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
1095                 (setq mh-seen-list (cdr mh-seen-list)))
1096               (setcdr unseen-seq unseen-msgs)
1097               t)                        ;since we set the folder
1098           (setq mh-seen-list nil)))))
1099
1100
1101 (defun mh-delete-scan-msgs (msgs)
1102   ;; Delete the scan listing lines for each of the msgs in the LIST.
1103   (save-excursion
1104     (while msgs
1105       (if (mh-goto-msg (car msgs) t t)
1106           (mh-delete-line 1))
1107       (setq msgs (cdr msgs)))))
1108
1109
1110 (defun mh-outstanding-commands-p ()
1111   ;; Returns non-nil if there are outstanding deletes or refiles.
1112   (or mh-delete-list mh-refile-list))
1113
1114
1115 (defun mh-coalesce-msg-list (messages)
1116   ;; Give a list of MESSAGES, return a list of message number ranges.
1117   ;; Sort of the opposite of mh-read-msg-list, which expands ranges.
1118   ;; Message lists passed to MH programs go through this so
1119   ;; command line arguments won't exceed system limits.
1120   (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
1121         (range-high nil)
1122         (prev -1)
1123         (ranges nil))
1124     (while prev
1125       (if range-high
1126           (if (or (not (numberp prev))
1127                   (not (equal (car msgs) (1- prev))))
1128               (progn                    ;non-sequential, flush old range
1129                 (if (eq prev range-high)
1130                     (setq ranges (cons range-high ranges))
1131                   (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
1132                 (setq range-high nil))))
1133       (or range-high
1134           (setq range-high (car msgs))) ;start new or first range
1135       (setq prev (car msgs))
1136       (setq msgs (cdr msgs)))
1137     ranges))
1138
1139 (defun mh-greaterp (msg1 msg2)
1140   ;; Sort two message indicators.  Strings are "smaller" than numbers.
1141   ;; Legal values are things like "cur", "last", 1, and 1820.
1142   (if (numberp msg1)
1143          (if (numberp msg2)
1144              (> msg1 msg2)
1145            t)
1146     (if (numberp msg2)
1147         nil
1148       (string-lessp msg2 msg1))))
1149
1150 \f
1151
1152 ;;; Basic sequence handling
1153
1154 (defun mh-delete-seq-locally (seq)
1155   ;; Remove mh-e's record of SEQUENCE.
1156   (let ((entry (mh-find-seq seq)))
1157     (setq mh-seq-list (delq entry mh-seq-list))))
1158
1159 (defun mh-read-folder-sequences (folder save-refiles)
1160   ;; Read and return the predefined sequences for a FOLDER.
1161   ;; If SAVE-REFILES is non-nil, then keep the sequences
1162   ;; that note messages to be refiled.
1163   (let ((seqs ()))
1164     (cond (save-refiles
1165             (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1166                                  (if (mh-folder-name-p (mh-seq-name seq))
1167                                      (setq seqs (cons seq seqs)))))
1168                      mh-seq-list)))
1169     (save-excursion
1170       (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1171           (progn
1172             ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1173             (while (re-search-forward "^[^: ]+" nil t)
1174               (setq seqs (cons (mh-make-seq (intern (buffer-substring
1175                                                      (match-beginning 0)
1176                                                      (match-end 0)))
1177                                             (mh-read-msg-list))
1178                                seqs)))
1179             (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon
1180     seqs))
1181
1182 (defun mh-read-msg-list ()
1183   ;; Return a list of message numbers from the current point to the end of
1184   ;; the line.  Expands ranges into set of individual numbers.
1185   (let ((msgs ())
1186         (end-of-line (save-excursion (end-of-line) (point)))
1187         num)
1188     (while (re-search-forward "[0-9]+" end-of-line t)
1189       (setq num (string-to-int (buffer-substring (match-beginning 0)
1190                                                  (match-end 0))))
1191       (cond ((looking-at "-")           ; Message range
1192              (forward-char 1)
1193              (re-search-forward "[0-9]+" end-of-line t)
1194              (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1195                                                           (match-end 0)))))
1196                (if (< num2 num)
1197                    (error "Bad message range: %d-%d" num num2))
1198                (while (<= num num2)
1199                  (setq msgs (cons num msgs))
1200                  (setq num (1+ num)))))
1201             ((not (zerop num))          ;"pick" outputs "0" to mean no match
1202              (setq msgs (cons num msgs)))))
1203     msgs))
1204
1205 (defun mh-notate-user-sequences ()
1206   ;; Mark the scan listing of all messages in user-defined sequences.
1207   (let ((seqs mh-seq-list)
1208         name)
1209     (while seqs
1210       (setq name (mh-seq-name (car seqs)))
1211       (if (not (mh-internal-seq name))
1212           (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
1213       (setq seqs (cdr seqs)))))
1214
1215
1216 (defun mh-internal-seq (name)
1217   ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
1218   (or (memq name '(answered cur deleted forwarded printed))
1219       (eq name mh-unseen-seq)
1220       (eq name mh-previous-seq)
1221       (mh-folder-name-p name)))
1222
1223
1224 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
1225   "Delete MESSAGE from SEQUENCE.  MESSAGE defaults to displayed message.
1226 From Lisp, optional third arg INTERNAL-FLAG non-nil means do not
1227 inform MH of the change."
1228   (interactive (list (mh-get-msg-num t)
1229                      (mh-read-seq-default "Delete from" t)
1230                      nil))
1231   (let ((entry (mh-find-seq sequence)))
1232     (cond (entry
1233            (mh-notate-if-in-one-seq message ?  (1+ mh-cmd-note) sequence)
1234            (if (not internal-flag)
1235                (mh-undefine-sequence sequence (list message)))
1236            (setcdr entry (delq message (mh-seq-msgs entry)))))))
1237
1238
1239 (defun mh-undefine-sequence (seq msgs)
1240   ;; Remove from the SEQUENCE the list of MSGS.
1241   (mh-exec-cmd "mark" mh-current-folder "-delete"
1242                "-sequence" (symbol-name seq)
1243                (mh-coalesce-msg-list msgs)))
1244
1245
1246 (defun mh-define-sequence (seq msgs)
1247   ;; Define the SEQUENCE to contain the list of MSGS.
1248   ;; Do not mark pseudo-sequences or empty sequences.
1249   ;; Signals an error if SEQUENCE is an illegal name.
1250   (if (and msgs
1251            (not (mh-folder-name-p seq)))
1252       (save-excursion
1253         (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
1254                            "-sequence" (symbol-name seq)
1255                            (mh-coalesce-msg-list msgs)))))
1256
1257
1258 (defun mh-map-over-seqs (func seq-list)
1259   ;; Apply the FUNCTION to each element in the list of SEQUENCES,
1260   ;; passing the sequence name and the list of messages as arguments.
1261   (while seq-list
1262     (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
1263     (setq seq-list (cdr seq-list))))
1264
1265
1266 (defun mh-notate-if-in-one-seq (msg notation offset seq)
1267   ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
1268   ;; message with the CHARACTER at the given OFFSET from the beginning of the
1269   ;; listing line.
1270   (let ((in-seqs (mh-seq-containing-msg msg nil)))
1271     (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
1272         (mh-notate msg notation offset))))
1273
1274
1275 (defun mh-seq-containing-msg (msg &optional include-internal-p)
1276   ;; Return a list of the sequences containing MESSAGE.
1277   ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list.
1278   (let ((l mh-seq-list)
1279         (seqs ()))
1280     (while l
1281       (and (memq msg (mh-seq-msgs (car l)))
1282            (or include-internal-p
1283                (not (mh-internal-seq (mh-seq-name (car l)))))
1284            (setq seqs (cons (mh-seq-name (car l)) seqs)))
1285       (setq l (cdr l)))
1286     seqs))
1287
1288
1289 \f
1290
1291 ;;; User prompting commands.
1292
1293
1294 (defun mh-read-msg-range (prompt)
1295   ;; Read a list of blank-separated items.
1296   (let* ((buf (read-string prompt))
1297          (buf-size (length buf))
1298          (start 0)
1299          (input ()))
1300     (while (< start buf-size)
1301       (let ((next (read-from-string buf start buf-size)))
1302         (setq input (cons (car next) input))
1303         (setq start (cdr next))))
1304     (nreverse input)))
1305
1306 \f
1307
1308 ;;; Build the folder-mode keymap:
1309
1310 (suppress-keymap mh-folder-mode-map)
1311 (define-key mh-folder-mode-map "q" 'mh-quit)
1312 (define-key mh-folder-mode-map "b" 'mh-compat-quit)
1313 (define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
1314 (define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
1315 (define-key mh-folder-mode-map "|" 'mh-pipe-msg)
1316 (define-key mh-folder-mode-map "\ea" 'mh-edit-again)
1317 (define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
1318 (define-key mh-folder-mode-map "\e#" 'mh-delete-seq)
1319 (define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
1320 (define-key mh-folder-mode-map "\C-xw" 'mh-widen)
1321 (define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
1322 (define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
1323 (define-key mh-folder-mode-map "\e " 'mh-page-digest)
1324 (define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
1325 (define-key mh-folder-mode-map "\ed" 'mh-redistribute)
1326 (define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
1327 (define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
1328 (define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
1329 (define-key mh-folder-mode-map "\el" 'mh-list-folders)
1330 (define-key mh-folder-mode-map "\en" 'mh-store-msg)
1331 (define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
1332 (define-key mh-folder-mode-map "\eq" 'mh-list-sequences)
1333 (define-key mh-folder-mode-map "\es" 'mh-search-folder)
1334 (define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
1335 (define-key mh-folder-mode-map "l" 'mh-print-msg)
1336 (define-key mh-folder-mode-map "t" 'mh-toggle-showing)
1337 (define-key mh-folder-mode-map "c" 'mh-copy-msg)
1338 (define-key mh-folder-mode-map "i" 'mh-inc-folder)
1339 (define-key mh-folder-mode-map "x" 'mh-execute-commands)
1340 (define-key mh-folder-mode-map "e" 'mh-execute-commands)
1341 (define-key mh-folder-mode-map "f" 'mh-forward)
1342 (define-key mh-folder-mode-map "m" 'mh-send)
1343 (define-key mh-folder-mode-map "s" 'mh-send)
1344 (define-key mh-folder-mode-map "r" 'mh-reply)
1345 (define-key mh-folder-mode-map "a" 'mh-reply)
1346 (define-key mh-folder-mode-map "j" 'mh-goto-msg)
1347 (define-key mh-folder-mode-map "g" 'mh-goto-msg)
1348 (define-key mh-folder-mode-map "\e<" 'mh-first-msg)
1349 (define-key mh-folder-mode-map "\e>" 'mh-last-msg)
1350 (define-key mh-folder-mode-map "\177" 'mh-previous-page)
1351 (define-key mh-folder-mode-map " " 'mh-page-msg)
1352 (define-key mh-folder-mode-map "\r" 'mh-show)
1353 (define-key mh-folder-mode-map "." 'mh-show)
1354 (define-key mh-folder-mode-map "," 'mh-header-display)
1355 (define-key mh-folder-mode-map "u" 'mh-undo)
1356 (define-key mh-folder-mode-map "d" 'mh-delete-msg)
1357 (define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
1358 (define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
1359 (define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
1360 (define-key mh-folder-mode-map "o" 'mh-refile-msg)
1361 (define-key mh-folder-mode-map "^" 'mh-refile-msg)
1362 (define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file)
1363 (define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
1364 (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
1365
1366 ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
1367
1368 \f
1369
1370 ;;;autoload the other mh-e parts
1371
1372 ;;; mh-comp
1373
1374 (autoload 'mh-smail "mh-comp"
1375   "Compose and send mail with the MH mail system.
1376 This function is an entry point to mh-e, the Emacs front end
1377 to the MH mail system.
1378 See documentation of `\\[mh-send]' for more details on composing mail." t)
1379
1380 (autoload 'mh-smail-other-window "mh-comp"
1381   "Compose and send mail in other window with the MH mail system.
1382 This function is an entry point to mh-e, the Emacs front end
1383 to the MH mail system.
1384 See documentation of `\\[mh-send]' for more details on composing mail." t)
1385
1386 (autoload 'mh-edit-again "mh-comp"
1387   "Clean-up a draft or a message previously sent and make it resendable.
1388 Default is the current message.
1389 The variable mh-new-draft-cleaned-headers specifies the headers to remove.
1390 See also documentation for `\\[mh-send]' function." t)
1391
1392 (autoload 'mh-extract-rejected-mail "mh-comp"
1393   "Extract a letter returned by the mail system and make it resendable.
1394 Default is the current message.  The variable mh-new-draft-cleaned-headers
1395 gives the headers to clean out of the original message.
1396 See also documentation for `\\[mh-send]' function." t)
1397
1398 (autoload 'mh-forward "mh-comp"
1399   "Forward a message or message sequence.  Defaults to displayed message.
1400 If optional prefix argument provided, then prompt for the message sequence.
1401 See also documentation for `\\[mh-send]' function." t)
1402
1403 (autoload 'mh-redistribute "mh-comp"
1404   "Redistribute a letter.
1405 Depending on how your copy of MH was compiled, you may need to change the
1406 setting of the variable mh-redist-full-contents.  See its documentation." t)
1407
1408 (autoload 'mh-reply "mh-comp"
1409   "Reply to a MESSAGE (default: displayed message).
1410 If optional prefix argument INCLUDEP provided, then include the message
1411 in the reply using filter mhl.reply in your MH directory.
1412 Prompts for type of addresses to reply to:
1413    from    sender only,
1414    to      sender and primary recipients,
1415    cc/all  sender and all recipients.
1416 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
1417 for the reply.  See also documentation for `\\[mh-send]' function." t)
1418
1419 (autoload 'mh-send "mh-comp"
1420   "Compose and send a letter.
1421 The file named by `mh-comp-formfile' will be used as the form.
1422 Do not call this function from outside mh-e; use \\[mh-smail] instead.
1423 The letter is composed in mh-letter-mode; see its documentation for more
1424 details.  If `mh-compose-letter-function' is defined, it is called on the
1425 draft and passed three arguments: to, subject, and cc." t)
1426
1427 (autoload 'mh-send-other-window "mh-comp"
1428   "Compose and send a letter in another window.
1429 Do not call this function from outside mh-e;
1430 use \\[mh-smail-other-window] instead.
1431 See also documentation for `\\[mh-send]' function." t)
1432
1433 (autoload 'mh-letter-mode "mh-comp"
1434   "Mode for composing letters in mh-e.
1435 For more details, type \\[describe-mode] while in MH-Letter mode." t)
1436
1437
1438 ;;; mh-funcs
1439
1440 (autoload 'mh-burst-digest "mh-funcs"
1441   "Burst apart the current message, which should be a digest.
1442 The message is replaced by its table of contents and the messages from the
1443 digest are inserted into the folder after that message." t)
1444
1445 (autoload 'mh-copy-msg "mh-funcs"
1446   "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
1447 Default is the displayed message.  If optional prefix argument is
1448 provided, then prompt for the message sequence." t)
1449
1450 (autoload 'mh-kill-folder "mh-funcs"
1451   "Remove the current folder." t)
1452
1453 (autoload 'mh-list-folders "mh-funcs"
1454   "List mail folders." t)
1455
1456 (autoload 'mh-pack-folder "mh-funcs"
1457   "Renumber the messages of a folder to be 1..n.
1458 First, offer to execute any outstanding commands for the current folder.
1459 If optional prefix argument provided, prompt for the range of messages
1460 to display after packing.  Otherwise, show the entire folder." t)
1461
1462 (autoload 'mh-pipe-msg "mh-funcs"
1463   "Pipe the current message through the given shell COMMAND.
1464 If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
1465 Otherwise just send the message's body without the headers." t)
1466
1467 (autoload 'mh-page-digest "mh-funcs"
1468   "Advance displayed message to next digested message." t)
1469
1470 (autoload 'mh-page-digest-backwards "mh-funcs"
1471   "Back up displayed message to previous digested message." t)
1472
1473 (autoload 'mh-print-msg "mh-funcs"
1474   "Print MESSAGE(s) (default: displayed message) on printer.
1475 If optional prefix argument provided, then prompt for the message sequence.
1476 The variable mh-lpr-command-format is used to generate the print command.
1477 The messages are formatted by mhl.  See the variable mhl-formfile." t)
1478
1479 (autoload 'mh-sort-folder "mh-funcs"
1480   "Sort the messages in the current folder by date.
1481 Calls the MH program sortm to do the work.
1482 The arguments in the list  mh-sortm-args  are passed to sortm
1483 if this function is passed an argument." t)
1484
1485 (autoload 'mh-undo-folder "mh-funcs"
1486   "Undo all commands in current folder." t)
1487
1488 (autoload 'mh-store-msg "mh-funcs"
1489   "Store the file(s) contained in the current message into DIRECTORY.
1490 The message can contain a shar file or uuencoded file.
1491 Default directory is the last directory used, or initially the value of
1492 mh-store-default-directory  or the current directory." t)
1493
1494 (autoload 'mh-store-buffer "mh-funcs"
1495   "Store the file(s) contained in the current buffer into DIRECTORY.
1496 The buffer can contain a shar file or uuencoded file.
1497 Default directory is the last directory used, or initially the value of
1498 `mh-store-default-directory' or the current directory." t)
1499
1500
1501 ;;; mh-pick
1502
1503 (autoload 'mh-search-folder "mh-pick"
1504   "Search FOLDER for messages matching a pattern.
1505 Add the messages found to the sequence named `search'." t)
1506
1507 ;;; mh-seq
1508
1509 (autoload 'mh-delete-seq "mh-seq"
1510   "Delete the SEQUENCE." t)
1511 (autoload 'mh-list-sequences "mh-seq"
1512   "List the sequences defined in FOLDER." t)
1513 (autoload 'mh-msg-is-in-seq "mh-seq"
1514   "Display the sequences that contain MESSAGE (default: displayed message)." t)
1515 (autoload 'mh-narrow-to-seq "mh-seq"
1516   "Restrict display of this folder to just messages in SEQUENCE
1517 Use \\[mh-widen] to undo this command." t)
1518 (autoload 'mh-put-msg-in-seq "mh-seq"
1519   "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
1520 If optional prefix argument provided, then prompt for the message sequence." t)
1521 (autoload 'mh-widen "mh-seq"
1522   "Remove restrictions from current folder, thereby showing all messages." t)
1523 (autoload 'mh-rename-seq "mh-seq"
1524   "Rename SEQUENCE to have NEW-NAME." t)
1525
1526 ;;; mh-e.el ends here