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