]> code.delx.au - gnu-emacs/blob - lisp/mail/mh-e.el
Upgraded to MH-E version 7.1.
[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,2000,2001,2002 Free Software Foundation, Inc.
4
5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
7 ;; Version: 7.1
8 ;; Keywords: mail
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Commentary:
28
29 ;; How to Use:
30 ;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
31 ;; C-u M-x mh-rmail to visit any folder.
32 ;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
33
34 ;; Your .emacs might benefit from these bindings:
35 ;; (global-set-key "\C-cr" 'mh-rmail)
36 ;; (global-set-key "\C-xm" 'mh-smail)
37 ;; (global-set-key "\C-x4m" 'mh-smail-other-window)
38
39 ;; MH (Message Handler) is a powerful mail reader.
40
41 ;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu
42 ;; (send to mh-users-request to be added). See the monthly Frequently Asked
43 ;; Questions posting there for information on getting MH and MH-E:
44 ;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html
45
46 ;; N.B. MH must have been compiled with the MHE compiler flag or several
47 ;; features necessary for MH-E will be missing from MH commands, specifically
48 ;; the -build switch to repl and forw.
49
50 ;; MH-E is an Emacs interface to the MH mail system.
51
52 ;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4.
53
54 ;; Mailing Lists:
55 ;; mh-e-users@lists.sourceforge.net
56 ;; mh-e-announce@lists.sourceforge.net
57 ;; mh-e-devel@lists.sourceforge.net
58 ;;
59 ;; Subscribe by sending a "subscribe" message to
60 ;; <list>-request@lists.sourceforge.net, or by using the web interface at
61 ;; https://sourceforge.net/mail/?group_id=13357
62
63 ;; Bug Reports:
64 ;; https://sourceforge.net/tracker/?group_id=13357&atid=113357
65 ;; Include the output of M-x mh-version in any bug report.
66
67 ;; Feature Requests:
68 ;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse
69
70 ;; Support:
71 ;; https://sourceforge.net/tracker/?group_id=13357&atid=213357
72
73 ;;; Change Log:
74
75 ;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
76 ;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
77 ;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
78 ;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
79 ;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
80 ;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
81
82 ;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $
83
84 ;;; Code:
85
86 (require 'cl)
87
88 (defvar recursive-load-depth-limit)
89 (eval-when (compile load eval)
90 (if (and (boundp 'recursive-load-depth-limit)
91 (integerp recursive-load-depth-limit)
92 (> 50 recursive-load-depth-limit))
93 (setq recursive-load-depth-limit 50)))
94
95 (require 'mh-utils)
96 (require 'gnus-util)
97 (require 'easymenu)
98 (if mh-xemacs-flag
99 (require 'mh-xemacs-compat))
100
101 ;; Shush the byte-compiler
102 (defvar font-lock-auto-fontify)
103 (defvar font-lock-defaults)
104
105 (defconst mh-version "7.1" "Version number of MH-E.")
106
107 ;;; Autoloads
108 (autoload 'Info-goto-node "info")
109
110 \f
111
112 (defvar mh-note-deleted "D"
113 "String whose first character is used to notate deleted messages.")
114
115 (defvar mh-note-refiled "^"
116 "String whose first character is used to notate refiled messages.")
117
118 (defvar mh-note-cur "+"
119 "String whose first character is used to notate the current message.")
120
121 (defvar mh-partial-folder-mode-line-annotation "select"
122 "Annotation when displaying part of a folder.
123 The string is displayed after the folder's name. nil for no annotation.")
124
125 ;;; Parameterize MH-E to work with different scan formats. The defaults work
126 ;;; with the standard MH scan listings, in which the first 4 characters on
127 ;;; the line are the message number, followed by two places for notations.
128
129 ;; The following scan formats are passed to the scan program if the
130 ;; setting of `mh-scan-format-file' above is nil. They are identical
131 ;; except the later one makes use of the nmh `decode' function to
132 ;; decode RFC 2047 encodings. If you just want to change the width of
133 ;; the msg number, use the `mh-set-cmd-note' function.
134
135 (defvar mh-scan-format-mh
136 (concat
137 "%4(msg)"
138 "%<(cur)+%| %>"
139 "%<{replied}-"
140 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
141 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
142 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
143 "%?(nonnull(comp{newsgroups}))n%>"
144 "%<(zero) %>"
145 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
146 "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
147 "%<(zero)%17(friendly{from})%> "
148 "%{subject}%<{body}<<%{body}%>")
149 "*Scan format string for MH, provided to the scan program via the -format arg.
150 This format is identical to the default except that additional hints for
151 fontification have been added to the fifth column (remember that in Emacs, the
152 first column is 0).
153
154 The values of the fifth column, in priority order, are: `-' if the
155 message has been replied to, t if an address on the To: line matches
156 one of the mailboxes of the current user, `c' if the Cc: line matches,
157 `b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
158 is present.")
159
160 (defvar mh-scan-format-nmh
161 (concat
162 "%4(msg)"
163 "%<(cur)+%| %>"
164 "%<{replied}-"
165 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
166 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
167 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
168 "%?(nonnull(comp{newsgroups}))n%>"
169 "%<(zero) %>"
170 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
171 "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
172 "%<(zero)%17(decode(friendly{from}))%> "
173 "%(decode{subject})%<{body}<<%{body}%>")
174 "*Scan format string for nmh.
175 This string is passed to the scan program via the -format arg.
176 This format is identical to the default except that additional hints for
177 fontification have been added to the fifth column (remember that in Emacs, the
178 first column is 0).
179
180 The values of the fifth column, in priority order, are: `-' if the
181 message has been replied to, t if an address on the To: line matches
182 one of the mailboxes of the current user, `c' if the Cc: line matches,
183 `b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
184 is present.")
185
186 (defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
187 "Regexp specifying the scan lines that are 'good' messages.
188 The default `mh-folder-font-lock-keywords' expects this expression to contain
189 at least one parenthesized expression which matches the message number.")
190
191 (defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
192 "Regexp matching scan lines of deleted messages.
193 The default `mh-folder-font-lock-keywords' expects this expression to contain
194 at least one parenthesized expression which matches the message number.")
195
196 (defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
197 "Regexp matching scan lines of refiled messages.
198 The default `mh-folder-font-lock-keywords' expects this expression to contain
199 at least one parenthesized expression which matches the message number.")
200
201 (defvar mh-scan-valid-regexp "^ *[0-9]"
202 "Regexp matching scan lines for messages (not error messages).")
203
204 (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
205 "Regexp matching scan line for the current message.
206 The default `mh-folder-font-lock-keywords' expects this expression to contain
207 at least one parenthesized expression which matches the message number.
208 Don't disable this regexp as it's needed by non fontifying functions.")
209
210 (defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
211 "Regexp matching scan line for the current message.
212 The default `mh-folder-font-lock-keywords' expects this expression to contain
213 at least one parenthesized expression which matches the whole line.
214 To enable this feature, remove the string DISABLED from the regexp.")
215
216 (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
217 "Regexp matching a valid date in scan lines.
218 The default `mh-folder-font-lock-keywords' expects this expression to contain
219 only one parenthesized expression which matches the date field
220 \(see `mh-scan-format-regexp').")
221
222 (defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
223 "Regexp specifying the recipient in scan lines for messages we sent.
224 The default `mh-folder-font-lock-keywords' expects this expression to contain
225 two parenthesized expressions. The first is expected to match the To:
226 that the default scan format file generates. The second is expected to match
227 the recipient's name.")
228
229 (defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
230 "Regexp matching the message body beginning displayed in scan lines.
231 The default `mh-folder-font-lock-keywords' expects this expression to contain
232 at least one parenthesized expression which matches the body text.")
233
234 (defvar mh-scan-subject-regexp
235 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
236 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
237 "*Regexp matching the subject string in MH folder mode.
238 The default `mh-folder-font-lock-keywords' expects this expression to contain
239 at least tree parenthesized expressions. The first is expected to match the Re:
240 string, if any. The second matches an optional bracketed number after Re,
241 such as in Re[2]: and the third is expected to match the subject line itself.")
242
243 (defvar mh-scan-format-regexp
244 (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
245 "Regexp matching the output of scan.
246 The default value is based upon the default values of either
247 `mh-scan-format-mh' or `mh-scan-format-nmh'.
248 The default `mh-folder-font-lock-keywords' expects this expression to contain
249 at least three parenthesized expressions. The first should match the
250 fontification hint, the second is found in `mh-scan-date-regexp', and the
251 third should match the user name.")
252
253 \f
254
255 (defvar mh-folder-font-lock-keywords
256 (list
257 ;; Folders when displaying index buffer
258 (list "^\\+.*"
259 '(0 mh-index-folder-face))
260 ;; Marked for deletion
261 (list (concat mh-scan-deleted-msg-regexp ".*")
262 '(0 mh-folder-deleted-face))
263 ;; Marked for refile
264 (list (concat mh-scan-refiled-msg-regexp ".*")
265 '(0 mh-folder-refiled-face))
266 ;;after subj
267 (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
268 '(mh-folder-font-lock-subject
269 (1 mh-folder-followup-face append t)
270 (2 mh-folder-subject-face append t))
271 ;;current msg
272 (list mh-scan-cur-msg-number-regexp
273 '(1 mh-folder-cur-msg-number-face))
274 (list mh-scan-good-msg-regexp
275 '(1 mh-folder-msg-number-face)) ;; Msg number
276 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
277 (list mh-scan-rcpt-regexp
278 '(1 mh-folder-to-face) ;; To:
279 '(2 mh-folder-address-face)) ;; address
280 ;; scan font-lock name
281 (list mh-scan-format-regexp
282 '(1 mh-folder-date-face)
283 '(3 mh-folder-scan-format-face))
284 ;; Current message line
285 (list mh-scan-cur-msg-regexp
286 '(1 mh-folder-cur-msg-face prepend t))
287 ;; Unseen messages in bold
288 '(mh-folder-font-lock-unseen (1 'bold append t)))
289 "Regexp keywords used to fontify the MH-Folder buffer.")
290
291 (defvar mh-scan-cmd-note-width 1
292 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
293 This column will have one of the values: ` ', `D', `^', `+' and where
294 ` ' is the default value,
295 `D' is the `mh-note-deleted' character,
296 `^' is the `mh-note-refiled' character, and
297 `+' is the `mh-note-cur' character.")
298
299 (defvar mh-scan-destination-width 1
300 "Number of columns consumed by the destination field in `mh-scan-format'.
301 This column will have one of ' ', '%', '-', 't', 'c', 'b', or `n' in it.
302 A ' ' blank space is the default character.
303 A '%' indicates that the message in in a named MH sequence.
304 A '-' indicates that the message has been annotated with a replied field.
305 A 't' indicates that the message contains mymbox in the To: field.
306 A 'c' indicates that the message contains mymbox in the Cc: field.
307 A 'b' indicates that the message contains mymbox in the Bcc: field.
308 A 'n' indicates that the message contains a Newsgroups: field.")
309
310 (defvar mh-scan-date-width 5
311 "Number of columns consumed by the date field in `mh-scan-format'.
312 This column will typically be of the form mm/dd.")
313
314 (defvar mh-scan-date-flag-width 1
315 "Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
316 This column will have ` ' for valid and `*' for invalid or missing dates.")
317
318 (defvar mh-scan-from-mbox-width 17
319 "Number of columns consumed with the \"From:\" line in `mh-scan-format'.
320 This column will have a friendly name or e-mail address of the
321 originator, or a \"To: address\" for outgoing e-mail messages.")
322
323 (defvar mh-scan-from-mbox-sep-width 2
324 "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
325 This column will only ever have spaces in it.")
326
327 (defvar mh-scan-field-from-start-offset
328 (+ mh-scan-cmd-note-width
329 mh-scan-destination-width
330 mh-scan-date-width
331 mh-scan-date-flag-width)
332 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
333
334 (defvar mh-scan-field-from-end-offset
335 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
336 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
337
338 (defvar mh-scan-field-subject-start-offset
339 (+ mh-scan-cmd-note-width
340 mh-scan-destination-width
341 mh-scan-date-width
342 mh-scan-date-flag-width
343 mh-scan-from-mbox-width
344 mh-scan-from-mbox-sep-width)
345 "The offset from the `mh-cmd-note' to find the start of the subject.")
346
347 (defun mh-folder-font-lock-subject (limit)
348 "Return MH-E scan subject strings to font-lock between point and LIMIT."
349 (if (not (re-search-forward mh-scan-subject-regexp limit t))
350 nil
351 (if (match-beginning 1)
352 (set-match-data (list (match-beginning 1) (match-end 3)
353 (match-beginning 1) (match-end 3) nil nil))
354 (set-match-data (list (match-beginning 3) (match-end 3)
355 nil nil (match-beginning 3) (match-end 3))))
356 t))
357
358 \f
359
360 ;; Fontifify unseen mesages in bold.
361
362 (defvar mh-folder-unseen-seq-name nil
363 "Name of unseen sequence.
364 The default for this is provided by the function `mh-folder-unseen-seq-name'
365 On nmh systems.")
366
367 (defun mh-folder-unseen-seq-name ()
368 "Provide name of unseen sequence from mhparam."
369 (or mh-progs (mh-find-path))
370 (save-excursion
371 (let ((unseen-seq-name "unseen"))
372 (with-temp-buffer
373 (unwind-protect
374 (progn
375 (call-process (expand-file-name "mhparam" mh-progs)
376 nil '(t t) nil "-component" "Unseen-Sequence")
377 (goto-char (point-min))
378 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
379 (setq unseen-seq-name (match-string 1))))))
380 unseen-seq-name)))
381
382 (defun mh-folder-unseen-seq-list ()
383 "Return a list of unseen message numbers for current folder."
384 (if (not mh-folder-unseen-seq-name)
385 (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
386 (cond
387 ((not mh-folder-unseen-seq-name)
388 nil)
389 (t
390 (let ((folder mh-current-folder))
391 (save-excursion
392 (with-temp-buffer
393 (unwind-protect
394 (progn
395 (call-process (expand-file-name "mark" mh-progs)
396 nil '(t t) nil
397 folder "-seq" mh-folder-unseen-seq-name
398 "-list")
399 (goto-char (point-min))
400 (sort (mh-read-msg-list) '<)))))))))
401
402 (defvar mh-folder-unseen-seq-cache nil
403 "Internal cache variable used for font-lock in MH-E.
404 Should only be non-nil through font-lock stepping, and nil once font-lock
405 is done highlighting.")
406 (make-variable-buffer-local 'mh-folder-unseen-seq-cache)
407
408 (defun mh-folder-font-lock-unseen (limit)
409 "Return unseen message lines to font-lock between point and LIMIT."
410 (if (not mh-folder-unseen-seq-cache)
411 (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
412 (let ((cur-msg (mh-get-msg-num nil)))
413 (cond
414 ((not mh-folder-unseen-seq-cache)
415 nil)
416 ((not cur-msg) ;Presumably at end of buffer
417 (setq mh-folder-unseen-seq-cache nil)
418 nil)
419 ((member cur-msg mh-folder-unseen-seq-cache)
420 (let ((bpoint (progn (beginning-of-line)(point)))
421 (epoint (progn (forward-line 1)(point))))
422 (if (<= limit (point))
423 (setq mh-folder-unseen-seq-cache nil))
424 (set-match-data (list bpoint epoint bpoint epoint))
425 t))
426 (t
427 ;; move forward one line at a time, checking each message number.
428 (while (and
429 (= 0 (forward-line 1))
430 (> limit (point))
431 (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
432 ;; Examine how we must have exited the loop...
433 (let ((cur-msg (mh-get-msg-num nil)))
434 (cond
435 ((or (not cur-msg)
436 (<= limit (point))
437 (not (member cur-msg mh-folder-unseen-seq-cache)))
438 (setq mh-folder-unseen-seq-cache nil)
439 nil)
440 ((member cur-msg mh-folder-unseen-seq-cache)
441 (let ((bpoint (progn (beginning-of-line)(point)))
442 (epoint (progn (forward-line 1)(point))))
443 (if (<= limit (point))
444 (setq mh-folder-unseen-seq-cache nil))
445 (set-match-data (list bpoint epoint bpoint epoint))
446 t))))))))
447
448 \f
449
450 ;;; Internal variables:
451
452 (defvar mh-last-destination nil) ;Destination of last refile or write
453 ;command.
454 (defvar mh-last-destination-folder nil) ;Destination of last refile command.
455 (defvar mh-last-destination-write nil) ;Destination of last write command.
456
457 (defvar mh-folder-mode-map (make-keymap)
458 "Keymap for MH folders.")
459
460 (defvar mh-delete-list nil) ;List of msg numbers to delete.
461
462 (defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
463
464 (defvar mh-next-direction 'forward) ;Direction to move to next message.
465
466 (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
467 ;nil if not narrowed.
468
469 (defvar mh-view-ops ()) ;Stack of ops that change the folder
470 ;view (such as narrowing or threading).
471
472 (defvar mh-index-data nil) ;Info about index search results
473 (defvar mh-index-previous-search nil)
474 (defvar mh-index-msg-checksum-map nil)
475 (defvar mh-index-checksum-origin-map nil)
476
477 (defvar mh-first-msg-num nil) ;Number of first msg in buffer.
478
479 (defvar mh-last-msg-num nil) ;Number of last msg in buffer.
480
481 (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
482
483 ;;; Macros and generic functions:
484
485 (defun mh-mapc (function list)
486 "Apply FUNCTION to each element of LIST for side effects only."
487 (while list
488 (funcall function (car list))
489 (setq list (cdr list))))
490
491 (defun mh-scan-format ()
492 "Return \"-format\" argument for the scan program."
493 (if (equal mh-scan-format-file t)
494 (list "-format" (if mh-nmh-flag
495 (list (mh-update-scan-format
496 mh-scan-format-nmh mh-cmd-note))
497 (list (mh-update-scan-format
498 mh-scan-format-mh mh-cmd-note))))
499 (if (not (equal mh-scan-format-file nil))
500 (list "-format" mh-scan-format-file))))
501
502 \f
503
504 ;;; Entry points:
505
506 ;;;###autoload
507 (defun mh-rmail (&optional arg)
508 "Inc(orporate) new mail with MH.
509 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
510 the Emacs front end to the MH mail system."
511 (interactive "P")
512 (mh-find-path)
513 (if arg
514 (call-interactively 'mh-visit-folder)
515 (mh-inc-folder)))
516
517 ;;;###autoload
518 (defun mh-nmail (&optional arg)
519 "Check for new mail in inbox folder.
520 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
521 the Emacs front end to the MH mail system."
522 (interactive "P")
523 (mh-find-path) ; init mh-inbox
524 (if arg
525 (call-interactively 'mh-visit-folder)
526 (mh-visit-folder mh-inbox)))
527
528 \f
529
530 ;;; User executable MH-E commands:
531
532 (defun mh-delete-msg (msg-or-seq)
533 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
534
535 Default is the displayed message. If optional prefix argument is given then
536 prompt for the message sequence. If variable `transient-mark-mode' is non-nil
537 and the mark is active, then the selected region is marked for deletion."
538 (interactive (list (cond
539 ((mh-mark-active-p t)
540 (mh-region-to-msg-list (region-beginning) (region-end)))
541 (current-prefix-arg
542 (mh-read-seq-default "Delete" t))
543 (t
544 (mh-get-msg-num t)))))
545 (mh-delete-msg-no-motion msg-or-seq)
546 (mh-next-msg))
547
548 (defun mh-delete-msg-no-motion (msg-or-seq)
549 "Mark the specified MSG-OR-SEQ for subsequent deletion.
550 Default is the displayed message. If optional prefix argument is provided,
551 then prompt for the message sequence."
552 (interactive (list (if current-prefix-arg
553 (mh-read-seq-default "Delete" t)
554 (mh-get-msg-num t))))
555 (if (numberp msg-or-seq)
556 (mh-delete-a-msg msg-or-seq)
557 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
558
559 (defun mh-execute-commands ()
560 "Process outstanding delete and refile requests."
561 (interactive)
562 (if mh-narrowed-to-seq (mh-widen))
563 (mh-process-commands mh-current-folder)
564 (mh-set-scan-mode)
565 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
566 (mh-make-folder-mode-line)
567 t) ; return t for write-file-functions
568
569 (defun mh-first-msg ()
570 "Move to the first message."
571 (interactive)
572 (goto-char (point-min))
573 (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
574 (forward-line 1)))
575
576 (defun mh-header-display ()
577 "Show the current message with all its headers.
578 Displays headers that might have been suppressed by setting the
579 variables `mh-clean-message-header-flag' or `mhl-formfile', or by the fallback
580 behavior of scrolling uninteresting headers off the top of the window.
581 Type \"\\[mh-show]\" to show the message normally again."
582 (interactive)
583 (and (not mh-showing-with-headers)
584 (or mhl-formfile mh-clean-message-header-flag)
585 (mh-invalidate-show-buffer))
586 (let ((mh-decode-mime-flag nil)
587 (mhl-formfile nil)
588 (mh-clean-message-header-flag nil))
589 (mh-show-msg nil)
590 (mh-in-show-buffer (mh-show-buffer)
591 (goto-char (point-min))
592 (mh-recenter 0))
593 (setq mh-showing-with-headers t)))
594
595 (defun mh-inc-folder (&optional maildrop-name)
596 "Inc(orporate)s new mail into the Inbox folder.
597 Optional argument MAILDROP-NAME specifies an alternate maildrop from the
598 default. If the prefix argument is given, incorporates mail into the current
599 folder, otherwise uses the folder named by `mh-inbox'.
600 The value of `mh-inc-folder-hook' is a list of functions to be called, with no
601 arguments, after incorporating new mail.
602 Do not call this function from outside MH-E; use \\[mh-rmail] instead."
603 (interactive (list (if current-prefix-arg
604 (expand-file-name
605 (read-file-name "inc mail from file: "
606 mh-user-path)))))
607 (let ((threading-needed-flag nil))
608 (let ((config (current-window-configuration)))
609 (if (not maildrop-name)
610 (cond ((not (get-buffer mh-inbox))
611 (mh-make-folder mh-inbox)
612 (setq threading-needed-flag mh-show-threads-flag)
613 (setq mh-previous-window-config config))
614 ((not (eq (current-buffer) (get-buffer mh-inbox)))
615 (switch-to-buffer mh-inbox)
616 (setq mh-previous-window-config config)))))
617 (mh-get-new-mail maildrop-name)
618 (when (and threading-needed-flag
619 (save-excursion
620 (goto-char (point-min))
621 (or (null mh-large-folder)
622 (not (equal (forward-line mh-large-folder) 0))
623 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
624 nil))))
625 (mh-toggle-threads))
626 (if mh-showing-mode (mh-show))
627 (run-hooks 'mh-inc-folder-hook)))
628
629 (defun mh-last-msg ()
630 "Move to the last message."
631 (interactive)
632 (goto-char (point-max))
633 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
634 (forward-line -1))
635 (mh-recenter nil))
636
637 (defun mh-next-undeleted-msg (&optional arg)
638 "Move to the next undeleted message ARG in window."
639 (interactive "p")
640 (setq mh-next-direction 'forward)
641 (forward-line 1)
642 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
643 (beginning-of-line)
644 (mh-maybe-show))
645 (t (forward-line -1)
646 (message "No more undeleted messages"))))
647
648 (defun mh-refile-msg (msg-or-seq folder)
649 "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
650 If optional prefix argument provided, then prompt for message sequence.
651 If variable `transient-mark-mode' is non-nil and the mark is active, then the
652 selected region is marked for refiling."
653 (interactive
654 (list (cond
655 ((mh-mark-active-p t)
656 (mh-region-to-msg-list (region-beginning) (region-end)))
657 (current-prefix-arg
658 (mh-read-seq-default "Refile" t))
659 (t
660 (mh-get-msg-num t)))
661 (intern
662 (mh-prompt-for-folder
663 "Destination"
664 (or (and mh-default-folder-for-message-function
665 (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
666 (save-excursion
667 (set-buffer (get-buffer-create mh-temp-buffer))
668 (erase-buffer)
669 (insert-file-contents refile-file)
670 (let ((buffer-file-name refile-file))
671 (funcall mh-default-folder-for-message-function)))))
672 (and (eq 'refile (car mh-last-destination-folder))
673 (symbol-name (cdr mh-last-destination-folder)))
674 "")
675 t))))
676 (setq mh-last-destination (cons 'refile folder)
677 mh-last-destination-folder mh-last-destination)
678 (if (numberp msg-or-seq)
679 (mh-refile-a-msg msg-or-seq folder)
680 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
681 (mh-next-msg))
682
683 (defun mh-refile-or-write-again (message)
684 "Re-execute the last refile or write command on the given MESSAGE.
685 Default is the displayed message. Use the same folder or file as the previous
686 refile or write command."
687 (interactive (list (mh-get-msg-num t)))
688 (if (null mh-last-destination)
689 (error "No previous refile or write"))
690 (cond ((eq (car mh-last-destination) 'refile)
691 (mh-refile-a-msg message (cdr mh-last-destination))
692 (message "Destination folder: %s" (cdr mh-last-destination)))
693 (t
694 (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
695 (message "Destination: %s" (cdr mh-last-destination))))
696 (mh-next-msg))
697
698 (defun mh-quit ()
699 "Quit the current MH-E folder.
700 Restore the previous window configuration, if one exists.
701 The value of `mh-before-quit-hook' is a list of functions to be called, with
702 no arguments, immediately upon entry to this function.
703 The value of `mh-quit-hook' is a list of functions to be called, with no
704 arguments, upon exit of this function."
705 (interactive)
706 (run-hooks 'mh-before-quit-hook)
707 (let ((show-buffer (get-buffer mh-show-buffer)))
708 (when show-buffer
709 (kill-buffer show-buffer)))
710 (mh-update-sequences)
711 (mh-destroy-postponed-handles)
712 (bury-buffer (current-buffer))
713 (if (get-buffer mh-temp-buffer)
714 (kill-buffer mh-temp-buffer))
715 (if (get-buffer mh-temp-folders-buffer)
716 (kill-buffer mh-temp-folders-buffer))
717 (if (get-buffer mh-temp-sequences-buffer)
718 (kill-buffer mh-temp-sequences-buffer))
719 (if mh-previous-window-config
720 (set-window-configuration mh-previous-window-config))
721 (run-hooks 'mh-quit-hook))
722
723 (defun mh-page-msg (&optional arg)
724 "Page the displayed message forwards.
725 Scrolls ARG lines or a full screen if no argument is supplied. Show buffer
726 first if not displayed. Show the next undeleted message if looking at the
727 bottom of the current message."
728 (interactive "P")
729 (if mh-showing-mode
730 (if mh-page-to-next-msg-flag
731 (if (equal mh-next-direction 'backward)
732 (mh-previous-undeleted-msg)
733 (mh-next-undeleted-msg))
734 (if (mh-in-show-buffer (mh-show-buffer)
735 (pos-visible-in-window-p (point-max)))
736 (progn
737 (message (format
738 "End of message (Type %s to read %s undeleted message)"
739 (single-key-description last-input-event)
740 (if (equal mh-next-direction 'backward)
741 "previous"
742 "next")))
743 (setq mh-page-to-next-msg-flag t))
744 (scroll-other-window arg)))
745 (mh-show)))
746
747 (defun mh-previous-page (&optional arg)
748 "Page the displayed message backwards.
749 Scrolls ARG lines or a full screen if no argument is supplied."
750 (interactive "P")
751 (mh-in-show-buffer (mh-show-buffer)
752 (scroll-down arg)))
753
754 (defun mh-previous-undeleted-msg (&optional arg)
755 "Move to the previous undeleted message ARG in window."
756 (interactive "p")
757 (setq mh-next-direction 'backward)
758 (beginning-of-line)
759 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
760 (mh-maybe-show))
761 (t (message "No previous undeleted message"))))
762
763 (defun mh-previous-unread-msg (&optional count)
764 "Move to previous unread message.
765 With optional argument COUNT, COUNT-1 unread messages before current message
766 are skipped."
767 (interactive "p")
768 (unless (> count 0)
769 (error "The function mh-previous-unread-msg expects positive argument"))
770 (setq count (1- count))
771 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
772 (cur-msg (mh-get-msg-num nil)))
773 (cond ((and (not cur-msg) (not (bobp))
774 ;; If we are at the end of the buffer back up one line and go
775 ;; to unread message after that.
776 (progn
777 (forward-line -1)
778 (setq cur-msg (mh-get-msg-num nil)))
779 nil))
780 ((or (null unread-sequence) (not cur-msg))
781 ;; No unread message or there aren't any messages in buffer...
782 (message "No more unread messages"))
783 ((progn
784 ;; Skip count messages...
785 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
786 (setq unread-sequence (cdr unread-sequence)))
787 (while (> count 0)
788 (setq unread-sequence (cdr unread-sequence))
789 (setq count (1- count)))
790 (not (car unread-sequence)))
791 (message "No more unread messages"))
792 (t (mh-goto-msg (car unread-sequence))))))
793
794 (defun mh-goto-next-button (backward-flag &optional criterion)
795 "Search for next button satisfying criterion.
796 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
797 CRITERION is a function or a symbol which has a function binding then that
798 function must return non-nil at the button we stop."
799 (unless (or (and (symbolp criterion) (fboundp criterion))
800 (functionp criterion))
801 (setq criterion (lambda (x) t)))
802 ;; Move to the next button in the buffer satisfying criterion
803 (goto-char (or (save-excursion
804 (beginning-of-line)
805 ;; Find point before current button
806 (let ((point-before-current-button
807 (save-excursion
808 (while (get-text-property (point) 'mh-data)
809 (unless (= (forward-line
810 (if backward-flag 1 -1))
811 0)
812 (if backward-flag
813 (goto-char (point-min))
814 (goto-char (point-max)))))
815 (point))))
816 ;; Skip over current button
817 (while (and (get-text-property (point) 'mh-data)
818 (not (if backward-flag (bobp) (eobp))))
819 (forward-line (if backward-flag -1 1)))
820 ;; Stop at next MIME button if any exists.
821 (block loop
822 (while (/= (progn
823 (unless (= (forward-line
824 (if backward-flag -1 1))
825 0)
826 (if backward-flag
827 (goto-char (point-max))
828 (goto-char (point-min)))
829 (beginning-of-line))
830 (point))
831 point-before-current-button)
832 (when (and (get-text-property (point) 'mh-data)
833 (funcall criterion (point)))
834 (return-from loop (point))))
835 nil)))
836 (point))))
837
838 (defun mh-next-button (&optional backward-flag)
839 "Go to the next MIME button.
840 Advance point to the next MIME button in the show buffer. If the end
841 of buffer is reached then the search wraps over to the start of the
842 buffer. With prefix argument, BACKWARD-FLAG the point will move to the
843 previous MIME button."
844 (interactive (list current-prefix-arg))
845 (unless mh-showing-mode
846 (mh-show))
847 (mh-in-show-buffer (mh-show-buffer)
848 (mh-goto-next-button backward-flag)))
849
850 (defun mh-prev-button ()
851 "Go to the prev MIME button.
852 Move point to the previous MIME button in the show buffer. If the beginning
853 of the buffer is reached then the search wraps over to the end of the
854 buffer."
855 (interactive)
856 (mh-next-button t))
857
858 (defun mh-folder-mime-action (part-index action include-security-flag)
859 "Go to PART-INDEX and carry out ACTION.
860 If PART-INDEX is nil then go to the next part in the buffer. The search for
861 the next buffer wraps around if end of buffer is reached. If argument
862 INCLUDE-SECURITY-FLAG is non-nil then include security info buttons when
863 searching for a suitable parts."
864 (unless mh-showing-mode
865 (mh-show))
866 (mh-in-show-buffer (mh-show-buffer)
867 (let ((criterion
868 (cond (part-index
869 (lambda (p)
870 (let ((part (get-text-property p 'mh-part)))
871 (and (integerp part) (= part part-index)))))
872 (t (lambda (p)
873 (if include-security-flag
874 (get-text-property p 'mh-data)
875 (integerp (get-text-property p 'mh-part)))))))
876 (point (point)))
877 (cond ((and (get-text-property point 'mh-part)
878 (or (null part-index)
879 (= (get-text-property point 'mh-part) part-index)))
880 (funcall action))
881 ((and (get-text-property point 'mh-data)
882 include-security-flag
883 (null part-index))
884 (funcall action))
885 (t
886 (mh-goto-next-button nil criterion)
887 (if (= (point) point)
888 (message "No matching MIME part found")
889 (funcall action)))))))
890
891 (defun mh-folder-toggle-mime-part (part-index)
892 "Toggle display of button.
893 If point in show buffer is at a button then that part is toggled.
894 If not at a button and PART-INDEX is non-nil point is moved to that part.
895 With nil PART-INDEX find the first button after point (search wraps around if
896 end of buffer is reached) and toggle it."
897 (interactive "P")
898 (when (consp part-index) (setq part-index (car part-index)))
899 (mh-folder-mime-action part-index #'mh-press-button t))
900
901 (defun mh-folder-inline-mime-part (part-index)
902 "Show the raw bytes of MIME part inline.
903 If point in show buffer is at a mime part then that part is inlined.
904 If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
905 With nil PART-INDEX find the first button after point (search wraps around if
906 end of buffer is reached) and inline it."
907 (interactive "P")
908 (when (consp part-index) (setq part-index (car part-index)))
909 (mh-folder-mime-action part-index #'mh-mime-inline-part nil))
910
911 (defun mh-folder-save-mime-part (part-index)
912 "Save MIME part.
913 If point in show buffer is at a mime part then that part is saved.
914 If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
915 With nil PART-INDEX find the first button after point (search wraps around if
916 end of buffer is reached) and save it."
917 (interactive "P")
918 (when (consp part-index) (setq part-index (car part-index)))
919 (mh-folder-mime-action part-index #'mh-mime-save-part nil))
920
921 (defun mh-reset-threads-and-narrowing ()
922 "Reset all variables pertaining to threads and narrowing.
923 Also removes all content from the folder buffer."
924 (setq mh-view-ops ())
925 (setq mh-narrowed-to-seq nil)
926 (let ((buffer-read-only nil)) (erase-buffer)))
927
928 (defun mh-rescan-folder (&optional range dont-exec-pending)
929 "Rescan a folder after optionally processing the outstanding commands.
930 If optional prefix argument RANGE is provided, prompt for the range of
931 messages to display. Otherwise show the entire folder.
932 If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
933 refiles aren't carried out."
934 (interactive (list (if current-prefix-arg
935 (mh-read-msg-range mh-current-folder t)
936 nil)))
937 (setq mh-next-direction 'forward)
938 (let ((threaded-flag (memq 'unthread mh-view-ops)))
939 (mh-reset-threads-and-narrowing)
940 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
941 (cond (threaded-flag (mh-toggle-threads))
942 (mh-index-data (mh-index-insert-folder-headers)))))
943
944 (defun mh-write-msg-to-file (msg file no-headers)
945 "Append MSG to the end of a FILE.
946 If prefix argument NO-HEADERS is provided, write only the message body.
947 Otherwise send the entire message including the headers."
948 (interactive
949 (list (mh-get-msg-num t)
950 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
951 (file-name-directory
952 (car (cdr mh-last-destination-write)))
953 default-directory)))
954 (read-file-name (format "Save message%s in file: "
955 (if current-prefix-arg " body" ""))
956 default-dir
957 (if (eq 'write (car mh-last-destination-write))
958 (car (cdr mh-last-destination-write))
959 (expand-file-name "mail.out" default-dir))))
960 current-prefix-arg))
961 (let ((msg-file-to-output (mh-msg-filename msg))
962 (output-file (mh-expand-file-name file)))
963 (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
964 mh-last-destination-write mh-last-destination)
965 (save-excursion
966 (set-buffer (get-buffer-create mh-temp-buffer))
967 (erase-buffer)
968 (insert-file-contents msg-file-to-output)
969 (goto-char (point-min))
970 (if no-headers (search-forward "\n\n"))
971 (append-to-file (point) (point-max) output-file))))
972
973 (defun mh-toggle-showing ()
974 "Toggle the scanning mode/showing mode of displaying messages."
975 (interactive)
976 (if mh-showing-mode
977 (mh-set-scan-mode)
978 (mh-show)))
979
980 (defun mh-undo (msg-or-seq)
981 "Undo the pending deletion or refile of the specified MSG-OR-SEQ.
982 Default is the displayed message.
983 If optional prefix argument is provided, then prompt for the message sequence.
984 If variable `transient-mark-mode' is non-nil and the mark is active, then the
985 selected region is unmarked."
986 (interactive (list (cond
987 ((mh-mark-active-p t)
988 (mh-region-to-msg-list (region-beginning) (region-end)))
989 (current-prefix-arg
990 (mh-read-seq-default "Undo" t))
991 (t
992 (mh-get-msg-num t)))))
993 (cond ((numberp msg-or-seq)
994 (let ((original-position (point)))
995 (beginning-of-line)
996 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
997 (looking-at mh-scan-refiled-msg-regexp)
998 (and (eq mh-next-direction 'forward) (bobp))
999 (and (eq mh-next-direction 'backward)
1000 (save-excursion (forward-line) (eobp)))))
1001 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1002 (if (or (looking-at mh-scan-deleted-msg-regexp)
1003 (looking-at mh-scan-refiled-msg-regexp))
1004 (progn
1005 (mh-undo-msg (mh-get-msg-num t))
1006 (mh-maybe-show))
1007 (goto-char original-position)
1008 (error "Nothing to undo"))))
1009 (t
1010 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
1011 (if (not (mh-outstanding-commands-p))
1012 (mh-set-folder-modified-p nil)))
1013
1014 ;;;###mh-autoload
1015 (defun mh-folder-line-matches-show-buffer-p ()
1016 "Return t if the message under point in folder-mode is in the show buffer.
1017 Return nil in any other circumstance (no message under point, no show buffer,
1018 the message in the show buffer doesn't match."
1019 (and (eq major-mode 'mh-folder-mode)
1020 (mh-get-msg-num nil)
1021 mh-show-buffer
1022 (get-buffer mh-show-buffer)
1023 (buffer-file-name (get-buffer mh-show-buffer))
1024 (string-match ".*/\\([0-9]+\\)$"
1025 (buffer-file-name (get-buffer mh-show-buffer)))
1026 (string-equal
1027 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1028 (int-to-string (mh-get-msg-num nil)))))
1029
1030 (eval-when-compile (require 'gnus))
1031
1032 (defmacro mh-macro-expansion-time-gnus-version ()
1033 "Return Gnus version available at macro expansion time.
1034 The macro evaluates the Gnus version at macro expansion time. If MH-E was
1035 compiled then macro expansion happens at compile time."
1036 gnus-version)
1037
1038 (defun mh-run-time-gnus-version ()
1039 "Return Gnus version available at run time."
1040 (require 'gnus)
1041 gnus-version)
1042
1043 ;;;###autoload
1044 (defun mh-version ()
1045 "Display version information about MH-E and the MH mail handling system."
1046 (interactive)
1047 (mh-find-progs)
1048 (set-buffer (get-buffer-create mh-temp-buffer))
1049 (erase-buffer)
1050 ;; MH-E version.
1051 (insert "MH-E " mh-version "\n\n")
1052 ;; MH-E compilation details.
1053 (insert "MH-E compilation details:\n")
1054 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1055 (gnus-compiled-version (if compiled-mhe
1056 (mh-macro-expansion-time-gnus-version)
1057 "N/A")))
1058 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1059 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1060 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1061 ;; Emacs version.
1062 (insert (emacs-version) "\n\n")
1063 ;; MH version.
1064 (let ((help-start (point)))
1065 (condition-case err-data
1066 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
1067 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
1068 (goto-char help-start)
1069 (if mh-nmh-flag
1070 (search-forward "inc -- " nil t)
1071 (search-forward "version: " nil t))
1072 (delete-region help-start (point)))
1073 (goto-char (point-max))
1074 (insert " mh-progs:\t" mh-progs "\n"
1075 " mh-lib:\t" mh-lib "\n"
1076 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1077 ;; Linux version.
1078 (condition-case ()
1079 (call-process "uname" nil t nil "-a")
1080 (file-error))
1081 (goto-char (point-min))
1082 (display-buffer mh-temp-buffer))
1083
1084 (defun mh-parse-flist-output-line (line)
1085 "Parse LINE to generate folder name, unseen messages and total messages."
1086 (with-temp-buffer
1087 (insert line)
1088 (goto-char (point-max))
1089 (let (folder unseen total p)
1090 (when (search-backward " out of " (point-min) t)
1091 (setq total (read-from-string
1092 (buffer-substring-no-properties
1093 (match-end 0) (line-end-position))))
1094 (when (search-backward " in sequence " (point-min) t)
1095 (setq p (point))
1096 (when (search-backward " has " (point-min) t)
1097 (setq unseen (read-from-string (buffer-substring-no-properties
1098 (match-end 0) p)))
1099 (while (or (eq (char-after) ?+) (eq (char-after) ? ))
1100 (backward-char))
1101 (setq folder (buffer-substring-no-properties
1102 (point-min) (1+ (point))))
1103 (values (format "+%s" folder) (car unseen) (car total))))))))
1104
1105 (defun mh-folder-size (folder)
1106 "Find size of FOLDER."
1107 (with-temp-buffer
1108 (call-process (expand-file-name "flist" mh-progs) nil t nil
1109 "-norecurse" folder)
1110 (goto-char (point-min))
1111 (multiple-value-bind (folder1 unseen total)
1112 (mh-parse-flist-output-line
1113 (buffer-substring (point) (line-end-position)))
1114 (unless (equal folder folder1)
1115 (error "Call to flist failed on folder %s" folder))
1116 (values total unseen))))
1117
1118 (defun mh-visit-folder (folder &optional range index-data)
1119 "Visit FOLDER and display RANGE of messages.
1120 Do not call this function from outside MH-E; see \\[mh-rmail] instead.
1121
1122 If RANGE is nil (the default if it is omitted when called non-interactively),
1123 then all messages in FOLDER are displayed.
1124
1125 If an index buffer is being created then INDEX-DATA is used to initialize the
1126 index buffer specific data structures."
1127 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1128 (list folder-name (mh-read-msg-range folder-name))))
1129 (let ((config (current-window-configuration))
1130 (threaded-view-flag mh-show-threads-flag))
1131 (save-excursion
1132 (when (get-buffer folder)
1133 (set-buffer folder)
1134 (setq threaded-view-flag (memq 'unthread mh-view-ops))
1135 (mh-reset-threads-and-narrowing)))
1136 (when index-data
1137 (mh-make-folder folder)
1138 (setq mh-index-data (car index-data)
1139 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1140 mh-index-checksum-origin-map (make-hash-table :test #'equal))
1141 (mh-index-update-maps folder (cadr index-data)))
1142 (mh-scan-folder folder (or range "all"))
1143 (cond ((and threaded-view-flag
1144 (save-excursion
1145 (goto-char (point-min))
1146 (or (null mh-large-folder)
1147 (not (equal (forward-line mh-large-folder) 0))
1148 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1149 nil))))
1150 (mh-toggle-threads))
1151 (mh-index-data
1152 (mh-index-insert-folder-headers)))
1153 (unless mh-showing-mode (delete-other-windows))
1154 (setq mh-previous-window-config config))
1155 nil)
1156
1157 ;;;###mh-autoload
1158 (defun mh-update-sequences ()
1159 "Update MH's Unseen-Sequence and current folder and message.
1160 Flush MH-E's state out to MH. The message at the cursor becomes current."
1161 (interactive)
1162 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
1163 ;; which updates MH-E's state from MH.
1164 (let ((folder-set (mh-update-unseen))
1165 (new-cur (mh-get-msg-num nil)))
1166 (if new-cur
1167 (let ((seq-entry (mh-find-seq 'cur)))
1168 (mh-remove-cur-notation)
1169 (setcdr seq-entry
1170 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1171 (mh-define-sequence 'cur (list new-cur))
1172 (beginning-of-line)
1173 (if (looking-at mh-scan-good-msg-regexp)
1174 (mh-notate nil mh-note-cur mh-cmd-note)))
1175 (or folder-set
1176 (save-excursion
1177 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1178 ;; So I added this sanity check.
1179 (if (stringp mh-current-folder)
1180 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
1181 (mh-exec-cmd-quiet t "folder" "-fast")))))))
1182
1183 \f
1184
1185 ;;; Support routines.
1186
1187 (defun mh-delete-a-msg (msg)
1188 "Delete the MSG.
1189 The value of `mh-delete-msg-hook' is a list of functions to be called, with no
1190 arguments, after the message has been deleted."
1191 (save-excursion
1192 (mh-goto-msg msg nil t)
1193 (if (looking-at mh-scan-refiled-msg-regexp)
1194 (error "Message %d is refiled. Undo refile before deleting" msg))
1195 (if (looking-at mh-scan-deleted-msg-regexp)
1196 nil
1197 (mh-set-folder-modified-p t)
1198 (setq mh-delete-list (cons msg mh-delete-list))
1199 (mh-notate msg mh-note-deleted mh-cmd-note)
1200 (run-hooks 'mh-delete-msg-hook))))
1201
1202 (defun mh-refile-a-msg (msg folder)
1203 "Refile MSG in FOLDER.
1204 Folder is a symbol, not a string.
1205 The value of `mh-refile-msg-hook' is a list of functions to be called, with no
1206 arguments, after the message has been refiled."
1207 (save-excursion
1208 (mh-goto-msg msg nil t)
1209 (cond ((looking-at mh-scan-deleted-msg-regexp)
1210 (error "Message %d is deleted. Undo delete before moving" msg))
1211 ((looking-at mh-scan-refiled-msg-regexp)
1212 (if (y-or-n-p
1213 (format "Message %d already refiled. Copy to %s as well? "
1214 msg folder))
1215 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1216 "-src" mh-current-folder
1217 (symbol-name folder))
1218 (message "Message not copied.")))
1219 (t
1220 (mh-set-folder-modified-p t)
1221 (cond ((null (assoc folder mh-refile-list))
1222 (push (list folder msg) mh-refile-list))
1223 ((not (member msg (cdr (assoc folder mh-refile-list))))
1224 (push msg (cdr (assoc folder mh-refile-list)))))
1225 (mh-notate msg mh-note-refiled mh-cmd-note)
1226 (run-hooks 'mh-refile-msg-hook)))))
1227
1228 (defun mh-next-msg ()
1229 "Move backward or forward to the next undeleted message in the buffer."
1230 (if (eq mh-next-direction 'forward)
1231 (mh-next-undeleted-msg 1)
1232 (mh-previous-undeleted-msg 1)))
1233
1234 (defun mh-next-unread-msg (&optional count)
1235 "Move to next unread message.
1236 With optional argument COUNT, COUNT-1 unread messages are skipped."
1237 (interactive "p")
1238 (unless (> count 0)
1239 (error "The function mh-next-unread-msg expects positive argument"))
1240 (setq count (1- count))
1241 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1242 (cur-msg (mh-get-msg-num nil)))
1243 (cond ((and (not cur-msg) (not (bobp))
1244 ;; If we are at the end of the buffer back up one line and go
1245 ;; to unread message after that.
1246 (progn
1247 (forward-line -1)
1248 (setq cur-msg (mh-get-msg-num nil)))
1249 nil))
1250 ((or (null unread-sequence) (not cur-msg))
1251 ;; No unread message or there aren't any messages in buffer...
1252 (message "No more unread messages"))
1253 ((progn
1254 ;; Skip messages
1255 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1256 (setq unread-sequence (cdr unread-sequence)))
1257 (while (> count 0)
1258 (setq unread-sequence (cdr unread-sequence))
1259 (setq count (1- count)))
1260 (not (car unread-sequence)))
1261 (message "No more unread messages"))
1262 (t (mh-goto-msg (car unread-sequence))))))
1263
1264 (defun mh-set-scan-mode ()
1265 "Display the scan listing buffer, but do not show a message."
1266 (if (get-buffer mh-show-buffer)
1267 (delete-windows-on mh-show-buffer))
1268 (mh-showing-mode 0)
1269 (force-mode-line-update)
1270 (if mh-recenter-summary-flag
1271 (mh-recenter nil)))
1272
1273 (defun mh-undo-msg (msg)
1274 "Undo the deletion or refile of one MSG."
1275 (cond ((memq msg mh-delete-list)
1276 (setq mh-delete-list (delq msg mh-delete-list)))
1277 (t
1278 (dolist (folder-msg-list mh-refile-list)
1279 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1280 (setq mh-refile-list (loop for x in mh-refile-list
1281 unless (null (cdr x)) collect x))))
1282 (mh-notate msg ? mh-cmd-note))
1283
1284 \f
1285
1286 ;;; The folder data abstraction.
1287
1288 (defun mh-make-folder (name)
1289 "Create a new mail folder called NAME.
1290 Make it the current folder."
1291 (switch-to-buffer name)
1292 (setq buffer-read-only nil)
1293 (erase-buffer)
1294 (if mh-adaptive-cmd-note-flag
1295 (mh-set-cmd-note (mh-message-number-width name)))
1296 (setq buffer-read-only t)
1297 (mh-folder-mode)
1298 (mh-set-folder-modified-p nil)
1299 (setq buffer-file-name mh-folder-filename)
1300 (mh-make-folder-mode-line))
1301
1302 ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
1303 (put 'mh-folder-mode 'mode-class 'special)
1304
1305 \f
1306
1307 ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1308 ;;; Menus for folder mode: folder, message, sequence (in that order)
1309 ;;; folder-mode "Sequence" menu
1310 (easy-menu-define
1311 mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
1312 '("Sequence"
1313 ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
1314 ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
1315 ["Delete Message from Sequence..." mh-delete-msg-from-seq
1316 (mh-get-msg-num nil)]
1317 ["List Sequences in Folder..." mh-list-sequences t]
1318 ["Delete Sequence..." mh-delete-seq t]
1319 ["Narrow to Sequence..." mh-narrow-to-seq t]
1320 ["Widen from Sequence" mh-widen mh-narrowed-to-seq]
1321 "--"
1322 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
1323 ["Delete Rest of Same Subject" mh-delete-subject t]
1324 "--"
1325 ["Push State Out to MH" mh-update-sequences t]))
1326
1327 ;;; folder-mode "Message" menu
1328 (easy-menu-define
1329 mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
1330 '("Message"
1331 ["Show Message" mh-show (mh-get-msg-num nil)]
1332 ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
1333 ["Next Message" mh-next-undeleted-msg t]
1334 ["Previous Message" mh-previous-undeleted-msg t]
1335 ["Go to First Message" mh-first-msg t]
1336 ["Go to Last Message" mh-last-msg t]
1337 ["Go to Message by Number..." mh-goto-msg t]
1338 ["Modify Message" mh-modify]
1339 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
1340 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
1341 ["Undo Delete/Refile" mh-undo t]
1342 ["Process Delete/Refile" mh-execute-commands
1343 (or mh-refile-list mh-delete-list)]
1344 "--"
1345 ["Compose a New Message" mh-send t]
1346 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
1347 ["Forward Message..." mh-forward (mh-get-msg-num nil)]
1348 ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
1349 ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
1350 ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
1351 "--"
1352 ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
1353 ["Print Message" mh-print-msg (mh-get-msg-num nil)]
1354 ["Write Message to File..." mh-write-msg-to-file
1355 (mh-get-msg-num nil)]
1356 ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
1357 ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
1358 ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
1359
1360 ;;; folder-mode "Folder" menu
1361 (easy-menu-define
1362 mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
1363 '("Folder"
1364 ["Incorporate New Mail" mh-inc-folder t]
1365 ["Toggle Show/Folder" mh-toggle-showing t]
1366 ["Execute Delete/Refile" mh-execute-commands
1367 (or mh-refile-list mh-delete-list)]
1368 ["Rescan Folder" mh-rescan-folder t]
1369 ["Thread Folder" mh-toggle-threads
1370 (not (memq 'unthread mh-view-ops))]
1371 ["Pack Folder" mh-pack-folder t]
1372 ["Sort Folder" mh-sort-folder t]
1373 "--"
1374 ["List Folders" mh-list-folders t]
1375 ["Visit a Folder..." mh-visit-folder t]
1376 ["Search a Folder..." mh-search-folder t]
1377 ["Indexed Search..." mh-index-search t]
1378 "--"
1379 ["Quit MH-E" mh-quit t]))
1380
1381 \f
1382
1383 (defmacro mh-remove-xemacs-horizontal-scrollbar ()
1384 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1385 (when mh-xemacs-flag
1386 `(if (and (featurep 'scrollbar)
1387 (fboundp 'set-specifier))
1388 (set-specifier horizontal-scrollbar-visible-p nil
1389 (cons (current-buffer) nil)))))
1390
1391 (defmacro mh-write-file-functions-compat ()
1392 "Return `write-file-functions' if it exists.
1393 Otherwise return `local-write-file-hooks'. This macro exists purely for
1394 compatibility. The former symbol is used in Emacs 21.4 onward while the latter
1395 is used in previous versions and XEmacs."
1396 (if (boundp 'write-file-functions)
1397 ''write-file-functions ;Emacs 21.4
1398 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
1399
1400 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1401 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
1402
1403 You can show the message the cursor is pointing to, and step through the
1404 messages. Messages can be marked for deletion or refiling into another
1405 folder; these commands are executed all at once with a separate command.
1406
1407 A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
1408 applies the action to a message sequence. If `transient-mark-mode',
1409 is non-nil, the action is applied to the region.
1410
1411 Options that control this mode can be changed with \\[customize-group];
1412 specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
1413 option if you wish to modify scan's format.
1414
1415 When a folder is visited, the hook `mh-folder-mode-hook' is run.
1416
1417 \\{mh-folder-mode-map}"
1418
1419 (make-local-variable 'font-lock-defaults)
1420 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1421 (mh-make-local-vars
1422 'mh-current-folder (buffer-name) ; Name of folder, a string
1423 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1424 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1425 (file-name-as-directory (mh-expand-file-name (buffer-name)))
1426 'mh-showing-mode nil ; Show message also?
1427 'mh-delete-list nil ; List of msgs nums to delete
1428 'mh-refile-list nil ; List of folder names in mh-seq-list
1429 'mh-seq-list nil ; Alist of (seq . msgs) nums
1430 'mh-seen-list nil ; List of displayed messages
1431 'mh-next-direction 'forward ; Direction to move to next message
1432 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1433 'mh-view-ops () ; Stack that keeps track of the order
1434 ; in which narrowing/threading has been
1435 ; carried out.
1436 'mh-index-data nil ; If the folder was created by a call
1437 ; to mh-index-search this contains info
1438 ; about the search results.
1439 'mh-index-previous-search nil ; Previous folder and search-regexp
1440 'mh-index-msg-checksum-map nil ; msg -> checksum map
1441 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
1442 'mh-first-msg-num nil ; Number of first msg in buffer
1443 'mh-last-msg-num nil ; Number of last msg in buffer
1444 'mh-msg-count nil ; Number of msgs in buffer
1445 'mh-mode-line-annotation nil ; Indicates message range
1446 'mh-previous-window-config nil) ; Previous window configuration
1447 (mh-remove-xemacs-horizontal-scrollbar)
1448 (setq truncate-lines t)
1449 (auto-save-mode -1)
1450 (setq buffer-offer-save t)
1451 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
1452 (make-local-variable 'revert-buffer-function)
1453 (make-local-variable 'hl-line-mode) ; avoid pollution
1454 (if (fboundp 'hl-line-mode)
1455 (hl-line-mode 1))
1456 (setq revert-buffer-function 'mh-undo-folder)
1457 (or (assq 'mh-showing-mode minor-mode-alist)
1458 (setq minor-mode-alist
1459 (cons '(mh-showing-mode " Show") minor-mode-alist)))
1460 (easy-menu-add mh-folder-sequence-menu)
1461 (easy-menu-add mh-folder-message-menu)
1462 (easy-menu-add mh-folder-folder-menu)
1463 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1464 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
1465 (if (and mh-xemacs-flag
1466 font-lock-auto-fontify)
1467 (turn-on-font-lock))) ; Force font-lock in XEmacs.
1468
1469 (defun mh-make-local-vars (&rest pairs)
1470 "Initialize local variables according to the variable-value PAIRS."
1471
1472 (while pairs
1473 (set (make-local-variable (car pairs)) (car (cdr pairs)))
1474 (setq pairs (cdr (cdr pairs)))))
1475
1476 (defun mh-scan-folder (folder range &optional dont-exec-pending)
1477 "Scan the FOLDER over the RANGE.
1478 If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1479 refiles aren't carried out.
1480 Return in the folder's buffer."
1481 (cond ((null (get-buffer folder))
1482 (mh-make-folder folder))
1483 (t
1484 (or dont-exec-pending (mh-process-or-undo-commands folder))
1485 (switch-to-buffer folder)))
1486 (mh-regenerate-headers range)
1487 (if (zerop (buffer-size))
1488 (if (equal range "all")
1489 (message "Folder %s is empty" folder)
1490 (message "No messages in %s, range %s" folder range))
1491 (mh-goto-cur-msg))
1492 (save-excursion
1493 (when dont-exec-pending
1494 ;; Re-annotate messages to be refiled...
1495 (dolist (folder-msg-list mh-refile-list)
1496 (dolist (msg (cdr folder-msg-list))
1497 (mh-notate msg mh-note-refiled mh-cmd-note)))
1498 ;; Re-annotate messages to be deleted...
1499 (dolist (msg mh-delete-list)
1500 (mh-notate msg mh-note-deleted mh-cmd-note)))))
1501
1502 (defun mh-set-cmd-note (width)
1503 "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
1504
1505 If `mh-scan-format-file' specifies nil or a filename, then this function
1506 will NOT update `mh-cmd-note'."
1507 ;; Add one to the width to always have whitespace in column zero.
1508 (setq width (max (1+ width) 2))
1509 (if (and (equal mh-scan-format-file t)
1510 (not (eq mh-cmd-note width)))
1511 (setq mh-cmd-note width))
1512 mh-cmd-note)
1513
1514 (defun mh-regenerate-headers (range &optional update)
1515 "Scan folder over range RANGE.
1516 If UPDATE, append the scan lines, otherwise replace."
1517 (let ((folder mh-current-folder)
1518 (range (if (and range (atom range)) (list range) range))
1519 scan-start)
1520 (message "Scanning %s..." folder)
1521 (with-mh-folder-updating (nil)
1522 (if update
1523 (goto-char (point-max))
1524 (delete-region (point-min) (point-max))
1525 (if mh-adaptive-cmd-note-flag
1526 (mh-set-cmd-note (mh-message-number-width folder))))
1527 (setq scan-start (point))
1528 (apply #'mh-exec-cmd-output
1529 mh-scan-prog nil
1530 (mh-scan-format)
1531 "-noclear" "-noheader"
1532 "-width" (window-width)
1533 folder range)
1534 (goto-char scan-start)
1535 (cond ((looking-at "scan: no messages in")
1536 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
1537 ((looking-at "scan: bad message list ")
1538 (keep-lines mh-scan-valid-regexp))
1539 ((looking-at "scan: ")) ; Keep error messages
1540 (t
1541 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
1542 (setq mh-seq-list (mh-read-folder-sequences folder nil))
1543 (mh-notate-user-sequences)
1544 (or update
1545 (setq mh-mode-line-annotation
1546 (if (equal range '("all"))
1547 nil
1548 mh-partial-folder-mode-line-annotation)))
1549 (mh-make-folder-mode-line))
1550 (message "Scanning %s...done" folder)))
1551
1552 (defun mh-generate-new-cmd-note (folder)
1553 "Fix the `mh-cmd-note' value for this FOLDER.
1554
1555 After doing an `mh-get-new-mail' operation in this FOLDER, at least
1556 one line that looks like a truncated message number was found.
1557
1558 Remove the text added by the last `mh-inc' command. It should be the
1559 messages cur-last. Call `mh-set-cmd-note' with the widest message number
1560 in FOLDER.
1561
1562 Reformat the message number width on each line in the buffer and trim
1563 the line length to fit in the window.
1564
1565 Rescan the FOLDER in the range cur-last in order to display the
1566 messages that were removed earlier. They should all fit in the scan
1567 line now with no message truncation."
1568 (save-excursion
1569 (let ((maxcol (1- (window-width)))
1570 (old-cmd-note mh-cmd-note)
1571 mh-cmd-note-fmt
1572 msgnum)
1573 ;; Nuke all of the lines just added by the last inc
1574 (delete-char (- (point-max) (point)))
1575 ;; Update the current buffer to reflect the new mh-cmd-note
1576 ;; value needed to display messages.
1577 (mh-set-cmd-note (mh-message-number-width folder))
1578 (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
1579 ;; Cleanup the messages that are in the buffer right now
1580 (goto-char (point-min))
1581 (cond ((memq 'unthread mh-view-ops)
1582 (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
1583 (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
1584 ;; reformat the number to fix in mh-cmd-note columns
1585 (setq msgnum (string-to-number
1586 (buffer-substring
1587 (match-beginning 1) (match-end 1))))
1588 (replace-match (format mh-cmd-note-fmt msgnum))
1589 ;; trim the line to fix in the window
1590 (end-of-line)
1591 (let ((eol (point)))
1592 (move-to-column maxcol)
1593 (if (<= (point) eol)
1594 (delete-char (- eol (point))))))))
1595 ;; now re-read the lost messages
1596 (goto-char (point-max))
1597 (prog1 (point)
1598 (mh-regenerate-headers "cur-last" t)))))
1599
1600 (defun mh-get-new-mail (maildrop-name)
1601 "Read new mail from MAILDROP-NAME into the current buffer.
1602 Return in the current buffer."
1603 (let ((point-before-inc (point))
1604 (folder mh-current-folder)
1605 (new-mail-flag nil))
1606 (with-mh-folder-updating (t)
1607 (if maildrop-name
1608 (message "inc %s -file %s..." folder maildrop-name)
1609 (message "inc %s..." folder))
1610 (setq mh-next-direction 'forward)
1611 (goto-char (point-max))
1612 (let ((start-of-inc (point)))
1613 (mh-remove-cur-notation)
1614 (if maildrop-name
1615 ;; I think MH 5 used "-ms-file" instead of "-file",
1616 ;; which would make inc'ing from maildrops fail.
1617 (mh-exec-cmd-output mh-inc-prog nil folder
1618 (mh-scan-format)
1619 "-file" (expand-file-name maildrop-name)
1620 "-width" (window-width)
1621 "-truncate")
1622 (mh-exec-cmd-output mh-inc-prog nil
1623 (mh-scan-format)
1624 "-width" (window-width)))
1625 (if maildrop-name
1626 (message "inc %s -file %s...done" folder maildrop-name)
1627 (message "inc %s...done" folder))
1628 (goto-char start-of-inc)
1629 (cond ((save-excursion
1630 (re-search-forward "^inc: no mail" nil t))
1631 (message "No new mail%s%s" (if maildrop-name " in " "")
1632 (if maildrop-name maildrop-name "")))
1633 ((and (when mh-narrowed-to-seq
1634 (let ((saved-text (buffer-substring-no-properties
1635 start-of-inc (point-max))))
1636 (delete-region start-of-inc (point-max))
1637 (unwind-protect (mh-widen)
1638 (goto-char (point-max))
1639 (setq start-of-inc (point))
1640 (insert saved-text)
1641 (goto-char start-of-inc))))
1642 nil))
1643 ((re-search-forward "^inc:" nil t) ; Error messages
1644 (error "Error incorporating mail"))
1645 ((and
1646 (equal mh-scan-format-file t)
1647 mh-adaptive-cmd-note-flag
1648 ;; Have we reached an edge condition?
1649 (save-excursion
1650 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
1651 (setq start-of-inc (mh-generate-new-cmd-note folder))
1652 nil))
1653 (t
1654 (setq new-mail-flag t)))
1655 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1656 (setq mh-seq-list (mh-read-folder-sequences folder t))
1657 (when (equal (point-max) start-of-inc)
1658 (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
1659 (mh-notate-user-sequences)
1660 (if new-mail-flag
1661 (progn
1662 (mh-make-folder-mode-line)
1663 (when (memq 'unthread mh-view-ops)
1664 (mh-thread-inc folder start-of-inc))
1665 (mh-goto-cur-msg))
1666 (goto-char point-before-inc))))))
1667
1668 (defun mh-make-folder-mode-line (&optional ignored)
1669 "Set the fields of the mode line for a folder buffer.
1670 The optional argument is now obsolete and IGNORED. It used to be used to pass
1671 in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1672 (save-excursion
1673 (save-window-excursion
1674 (mh-first-msg)
1675 (let ((new-first-msg-num (mh-get-msg-num nil)))
1676 (when (or (not (memq 'unthread mh-view-ops))
1677 (null mh-first-msg-num)
1678 (null new-first-msg-num)
1679 (< new-first-msg-num mh-first-msg-num))
1680 (setq mh-first-msg-num new-first-msg-num)))
1681 (mh-last-msg)
1682 (let ((new-last-msg-num (mh-get-msg-num nil)))
1683 (when (or (not (memq 'unthread mh-view-ops))
1684 (null mh-last-msg-num)
1685 (null new-last-msg-num)
1686 (> new-last-msg-num mh-last-msg-num))
1687 (setq mh-last-msg-num new-last-msg-num)))
1688 (setq mh-msg-count (if mh-first-msg-num
1689 (count-lines (point-min) (point-max))
1690 0))
1691 (setq mode-line-buffer-identification
1692 (list (format "{%%b%s} %s msg%s"
1693 (if mh-mode-line-annotation
1694 (format "/%s" mh-mode-line-annotation)
1695 "")
1696 (if (zerop mh-msg-count)
1697 "no"
1698 (format "%d" mh-msg-count))
1699 (if (zerop mh-msg-count)
1700 "s"
1701 (cond ((> mh-msg-count 1)
1702 (format "s (%d-%d)" mh-first-msg-num
1703 mh-last-msg-num))
1704 (mh-first-msg-num
1705 (format " (%d)" mh-first-msg-num))
1706 ("")))))))))
1707
1708 (defun mh-unmark-all-headers (remove-all-flags)
1709 "Remove all '+' flags from the folder listing.
1710 With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1711 Optimized for speed (i.e., no regular expressions)."
1712 (save-excursion
1713 (let ((case-fold-search nil)
1714 (last-line (1- (point-max)))
1715 char)
1716 (mh-first-msg)
1717 (while (<= (point) last-line)
1718 (forward-char mh-cmd-note)
1719 (setq char (following-char))
1720 (if (or (and remove-all-flags
1721 (or (= char (aref mh-note-deleted 0))
1722 (= char (aref mh-note-refiled 0))))
1723 (= char (aref mh-note-cur 0)))
1724 (progn
1725 (delete-char 1)
1726 (insert " ")))
1727 (if remove-all-flags
1728 (progn
1729 (forward-char 1)
1730 (if (= (following-char) (aref mh-note-seq 0))
1731 (progn
1732 (delete-char 1)
1733 (insert " ")))))
1734 (forward-line)))))
1735
1736 (defun mh-remove-cur-notation ()
1737 "Remove old cur notation."
1738 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1739 (save-excursion
1740 (and cur-msg
1741 (mh-goto-msg cur-msg t t)
1742 (looking-at mh-scan-cur-msg-number-regexp)
1743 (mh-notate nil ? mh-cmd-note)))))
1744
1745 (defun mh-remove-all-notation ()
1746 "Remove all notations on all scan lines that MH-E introduces."
1747 (save-excursion
1748 (goto-char (point-min))
1749 (while (not (eobp))
1750 (unless (or (equal (char-after) ?+) (eolp))
1751 (mh-notate nil ? mh-cmd-note)
1752 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
1753 (mh-notate nil ? (1+ mh-cmd-note))))
1754 (forward-line))))
1755
1756 ;;;###mh-autoload
1757 (defun mh-goto-cur-msg (&optional minimal-changes-flag)
1758 "Position the cursor at the current message.
1759 When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
1760 recenter the folder buffer."
1761 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1762 (cond ((and cur-msg
1763 (mh-goto-msg cur-msg t t))
1764 (unless minimal-changes-flag
1765 (mh-notate nil mh-note-cur mh-cmd-note)
1766 (mh-recenter 0)
1767 (mh-maybe-show cur-msg)))
1768 (t
1769 (message "No current message")))))
1770
1771 (defun mh-process-or-undo-commands (folder)
1772 "If FOLDER has outstanding commands, then either process or discard them.
1773 Called by functions like `mh-sort-folder', so also invalidate show buffer."
1774 (set-buffer folder)
1775 (if (mh-outstanding-commands-p)
1776 (if (or mh-do-not-confirm-flag
1777 (y-or-n-p
1778 "Process outstanding deletes and refiles (or lose them)? "))
1779 (mh-process-commands folder)
1780 (mh-undo-folder)))
1781 (mh-update-unseen)
1782 (mh-invalidate-show-buffer))
1783
1784 (defun mh-process-commands (folder)
1785 "Process outstanding commands for FOLDER.
1786 The value of `mh-folder-updated-hook' is a list of functions to be called,
1787 with no arguments, before the commands are processed."
1788 (message "Processing deletes and refiles for %s..." folder)
1789 (set-buffer folder)
1790 (with-mh-folder-updating (nil)
1791 ;; Run the hook while the lists are still valid
1792 (run-hooks 'mh-folder-updated-hook)
1793
1794 ;; Update the unseen sequence if it exists
1795 (mh-update-unseen)
1796
1797 (let ((redraw-needed-flag mh-index-data))
1798 ;; Remove invalid scan lines if we are in an index folder and then remove
1799 ;; the real messages
1800 (when mh-index-data
1801 (mh-index-delete-folder-headers)
1802 (mh-index-execute-commands))
1803
1804 ;; Then refile messages
1805 (mh-mapc #'(lambda (folder-msg-list)
1806 (let ((dest-folder (symbol-name (car folder-msg-list)))
1807 (msgs (cdr folder-msg-list)))
1808 (setq redraw-needed-flag t)
1809 (apply #'mh-exec-cmd
1810 "refile" "-src" folder dest-folder
1811 (mh-coalesce-msg-list msgs))
1812 (mh-delete-scan-msgs msgs)))
1813 mh-refile-list)
1814 (setq mh-refile-list ())
1815
1816 ;; Now delete messages
1817 (cond (mh-delete-list
1818 (setq redraw-needed-flag t)
1819 (apply 'mh-exec-cmd "rmm" folder
1820 (mh-coalesce-msg-list mh-delete-list))
1821 (mh-delete-scan-msgs mh-delete-list)
1822 (setq mh-delete-list nil)))
1823
1824 ;; Don't need to remove sequences since delete and refile do so.
1825 ;; Mark cur message
1826 (if (> (buffer-size) 0)
1827 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1828
1829 ;; Redraw folder buffer if needed
1830 (when (and redraw-needed-flag)
1831 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
1832 (mh-index-data (mh-index-insert-folder-headers)))))
1833
1834 (and (buffer-file-name (get-buffer mh-show-buffer))
1835 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1836 ;; If "inc" were to put a new msg in this file,
1837 ;; we would not notice, so mark it invalid now.
1838 (mh-invalidate-show-buffer))
1839
1840 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1841 (mh-unmark-all-headers t)
1842 (mh-notate-user-sequences)
1843 (message "Processing deletes and refiles for %s...done" folder)))
1844
1845 (defun mh-update-unseen ()
1846 "Synchronize the unseen sequence with MH.
1847 Return non-nil iff the MH folder was set.
1848 The value of `mh-unseen-updated-hook' is a list of functions to be called,
1849 with no arguments, after the unseen sequence is updated."
1850 (if mh-seen-list
1851 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
1852 (unseen-msgs (mh-seq-msgs unseen-seq)))
1853 (if unseen-msgs
1854 (progn
1855 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
1856 (run-hooks 'mh-unseen-updated-hook)
1857 (while mh-seen-list
1858 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
1859 (setq mh-seen-list (cdr mh-seen-list)))
1860 (setcdr unseen-seq unseen-msgs)
1861 t) ;since we set the folder
1862 (setq mh-seen-list nil)))))
1863
1864 (defun mh-delete-scan-msgs (msgs)
1865 "Delete the scan listing lines for MSGS."
1866 (save-excursion
1867 (while msgs
1868 (when (mh-goto-msg (car msgs) t t)
1869 (when (memq 'unthread mh-view-ops)
1870 (mh-thread-forget-message (car msgs)))
1871 (mh-delete-line 1))
1872 (setq msgs (cdr msgs)))))
1873
1874 (defun mh-outstanding-commands-p ()
1875 "Return non-nil if there are outstanding deletes or refiles."
1876 (or mh-delete-list mh-refile-list))
1877
1878 (defun mh-coalesce-msg-list (messages)
1879 "Give a list of MESSAGES, return a list of message number ranges.
1880 Sort of the opposite of `mh-read-msg-list', which expands ranges.
1881 Message lists passed to MH programs go through this so
1882 command line arguments won't exceed system limits."
1883 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
1884 (range-high nil)
1885 (prev -1)
1886 (ranges nil))
1887 (while prev
1888 (if range-high
1889 (if (or (not (numberp prev))
1890 (not (equal (car msgs) (1- prev))))
1891 (progn ;non-sequential, flush old range
1892 (if (eq prev range-high)
1893 (setq ranges (cons range-high ranges))
1894 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
1895 (setq range-high nil))))
1896 (or range-high
1897 (setq range-high (car msgs))) ;start new or first range
1898 (setq prev (car msgs))
1899 (setq msgs (cdr msgs)))
1900 ranges))
1901
1902 (defun mh-greaterp (msg1 msg2)
1903 "Return the greater of two message indicators MSG1 and MSG2.
1904 Strings are \"smaller\" than numbers.
1905 Legal values are things like \"cur\", \"last\", 1, and 1820."
1906 (if (numberp msg1)
1907 (if (numberp msg2)
1908 (> msg1 msg2)
1909 t)
1910 (if (numberp msg2)
1911 nil
1912 (string-lessp msg2 msg1))))
1913
1914 (defun mh-lessp (msg1 msg2)
1915 "Return the lesser of two message indicators MSG1 and MSG2.
1916 Strings are \"smaller\" than numbers.
1917 Legal values are things like \"cur\", \"last\", 1, and 1820."
1918 (not (mh-greaterp msg1 msg2)))
1919
1920 \f
1921
1922 ;;; Basic sequence handling
1923
1924 (defun mh-delete-seq-locally (seq)
1925 "Remove MH-E's record of SEQ."
1926 (let ((entry (mh-find-seq seq)))
1927 (setq mh-seq-list (delq entry mh-seq-list))))
1928
1929 (defun mh-read-folder-sequences (folder save-refiles)
1930 "Read and return the predefined sequences for a FOLDER.
1931 If SAVE-REFILES is non-nil, then keep the sequences
1932 that note messages to be refiled."
1933 (let ((seqs ()))
1934 (cond (save-refiles
1935 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1936 (if (mh-folder-name-p (mh-seq-name seq))
1937 (setq seqs (cons seq seqs)))))
1938 mh-seq-list)))
1939 (save-excursion
1940 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1941 (progn
1942 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1943 (while (re-search-forward "^[^: ]+" nil t)
1944 (setq seqs (cons (mh-make-seq (intern (buffer-substring
1945 (match-beginning 0)
1946 (match-end 0)))
1947 (mh-read-msg-list))
1948 seqs)))
1949 (delete-region (point-min) (point))))) ; avoid race with
1950 ; mh-process-daemon
1951 seqs))
1952
1953 (defun mh-read-msg-list ()
1954 "Return a list of message numbers from point to the end of the line.
1955 Expands ranges into set of individual numbers."
1956 (let ((msgs ())
1957 (end-of-line (save-excursion (end-of-line) (point)))
1958 num)
1959 (while (re-search-forward "[0-9]+" end-of-line t)
1960 (setq num (string-to-int (buffer-substring (match-beginning 0)
1961 (match-end 0))))
1962 (cond ((looking-at "-") ; Message range
1963 (forward-char 1)
1964 (re-search-forward "[0-9]+" end-of-line t)
1965 (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1966 (match-end 0)))))
1967 (if (< num2 num)
1968 (error "Bad message range: %d-%d" num num2))
1969 (while (<= num num2)
1970 (setq msgs (cons num msgs))
1971 (setq num (1+ num)))))
1972 ((not (zerop num)) ;"pick" outputs "0" to mean no match
1973 (setq msgs (cons num msgs)))))
1974 msgs))
1975
1976 (defun mh-notate-user-sequences ()
1977 "Mark the scan listing of all messages in user-defined sequences."
1978 (let ((seqs mh-seq-list)
1979 name)
1980 (while seqs
1981 (setq name (mh-seq-name (car seqs)))
1982 (if (not (mh-internal-seq name))
1983 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
1984 (setq seqs (cdr seqs)))))
1985
1986 (defun mh-internal-seq (name)
1987 "Return non-nil if NAME is the name of an internal MH-E sequence."
1988 (or (memq name '(answered cur deleted forwarded printed))
1989 (eq name mh-unseen-seq)
1990 (eq name mh-previous-seq)
1991 (mh-folder-name-p name)))
1992
1993 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
1994 "Delete MESSAGE from SEQUENCE.
1995 MESSAGE defaults to displayed message. From Lisp, optional third arg
1996 INTERNAL-FLAG non-nil means do not inform MH of the change."
1997 (interactive (list (mh-get-msg-num t)
1998 (mh-read-seq-default "Delete from" t)
1999 nil))
2000 (let ((entry (mh-find-seq sequence)))
2001 (cond (entry
2002 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
2003 (if (not internal-flag)
2004 (mh-undefine-sequence sequence (list message)))
2005 (setcdr entry (delq message (mh-seq-msgs entry)))))))
2006
2007 (defun mh-undefine-sequence (seq msgs)
2008 "Remove from the SEQ the list of MSGS."
2009 (mh-exec-cmd "mark" mh-current-folder "-delete"
2010 "-sequence" (symbol-name seq)
2011 (mh-coalesce-msg-list msgs)))
2012
2013 (defun mh-define-sequence (seq msgs)
2014 "Define the SEQ to contain the list of MSGS.
2015 Do not mark pseudo-sequences or empty sequences.
2016 Signals an error if SEQ is an illegal name."
2017 (if (and msgs
2018 (not (mh-folder-name-p seq)))
2019 (save-excursion
2020 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2021 "-sequence" (symbol-name seq)
2022 (mh-coalesce-msg-list msgs)))))
2023
2024 (defun mh-map-over-seqs (function seq-list)
2025 "Apply FUNCTION to each sequence in SEQ-LIST.
2026 The sequence name and the list of messages are passed as arguments."
2027 (while seq-list
2028 (funcall function
2029 (mh-seq-name (car seq-list))
2030 (mh-seq-msgs (car seq-list)))
2031 (setq seq-list (cdr seq-list))))
2032
2033 (defun mh-notate-if-in-one-seq (msg character offset seq)
2034 "Notate MSG.
2035 The CHARACTER is placed at the given OFFSET from the beginning of the listing.
2036 The notation is performed if the MSG is only in SEQ."
2037 (let ((in-seqs (mh-seq-containing-msg msg nil)))
2038 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2039 (mh-notate msg character offset))))
2040
2041 (defun mh-seq-containing-msg (msg &optional include-internal-flag)
2042 "Return a list of the sequences containing MSG.
2043 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2044 (let ((l mh-seq-list)
2045 (seqs ()))
2046 (while l
2047 (and (memq msg (mh-seq-msgs (car l)))
2048 (or include-internal-flag
2049 (not (mh-internal-seq (mh-seq-name (car l)))))
2050 (setq seqs (cons (mh-seq-name (car l)) seqs)))
2051 (setq l (cdr l)))
2052 seqs))
2053
2054 \f
2055
2056 ;;; User prompting commands.
2057
2058 (defun mh-read-msg-range (folder &optional always-prompt-flag)
2059 "Prompt for message range from FOLDER.
2060 If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
2061 range."
2062 (multiple-value-bind (total unseen) (mh-folder-size folder)
2063 (cond
2064 ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
2065 (list (symbol-name mh-unseen-seq)))
2066 ((or (null mh-large-folder) (not (numberp total)))
2067 (list "all"))
2068 ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
2069 (let* ((prompt
2070 (format "Range or number of messages to read (default: %s): "
2071 total))
2072 (in (read-string prompt nil nil (number-to-string total))))
2073 (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
2074 (list (format "last:%s" (car (read-from-string in)))))
2075 ((equal in "") (list "all"))
2076 (t (split-string in)))))
2077 (t (list "all")))))
2078
2079 \f
2080
2081 ;;; Build the folder-mode keymap:
2082
2083 (suppress-keymap mh-folder-mode-map)
2084
2085 ;; Use defalias to make sure the documented primary key bindings
2086 ;; appear in menu lists.
2087 (defalias 'mh-alt-show 'mh-show)
2088 (defalias 'mh-alt-refile-msg 'mh-refile-msg)
2089 (defalias 'mh-alt-send 'mh-send)
2090 (defalias 'mh-alt-visit-folder 'mh-visit-folder)
2091
2092 ;; Save the `b' binding for a future `back'. Maybe?
2093 (gnus-define-keys mh-folder-mode-map
2094 " " mh-page-msg
2095 "!" mh-refile-or-write-again
2096 "," mh-header-display
2097 "." mh-alt-show
2098 ">" mh-write-msg-to-file
2099 "?" mh-help
2100 "E" mh-extract-rejected-mail
2101 "M" mh-modify
2102 "\177" mh-previous-page
2103 "\C-d" mh-delete-msg-no-motion
2104 "\t" mh-index-next-folder
2105 [backtab] mh-index-previous-folder
2106 "\M-\t" mh-index-previous-folder
2107 "\e<" mh-first-msg
2108 "\e>" mh-last-msg
2109 "\ed" mh-redistribute
2110 "\r" mh-show
2111 "^" mh-alt-refile-msg
2112 "c" mh-copy-msg
2113 "d" mh-delete-msg
2114 "e" mh-edit-again
2115 "f" mh-forward
2116 "g" mh-goto-msg
2117 "i" mh-inc-folder
2118 "k" mh-delete-subject-or-thread
2119 "l" mh-print-msg
2120 "m" mh-alt-send
2121 "n" mh-next-undeleted-msg
2122 "\M-n" mh-next-unread-msg
2123 "o" mh-refile-msg
2124 "p" mh-previous-undeleted-msg
2125 "\M-p" mh-previous-unread-msg
2126 "q" mh-quit
2127 "r" mh-reply
2128 "s" mh-send
2129 "t" mh-toggle-showing
2130 "u" mh-undo
2131 "v" mh-index-visit-folder
2132 "x" mh-execute-commands
2133 "|" mh-pipe-msg)
2134
2135 (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2136 "?" mh-prefix-help
2137 "S" mh-sort-folder
2138 "f" mh-alt-visit-folder
2139 "i" mh-index-search
2140 "k" mh-kill-folder
2141 "l" mh-list-folders
2142 "o" mh-alt-visit-folder
2143 "p" mh-pack-folder
2144 "r" mh-rescan-folder
2145 "s" mh-search-folder
2146 "u" mh-undo-folder
2147 "v" mh-visit-folder)
2148
2149 (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2150 "?" mh-prefix-help
2151 "d" mh-delete-msg-from-seq
2152 "k" mh-delete-seq
2153 "l" mh-list-sequences
2154 "n" mh-narrow-to-seq
2155 "p" mh-put-msg-in-seq
2156 "s" mh-msg-is-in-seq
2157 "w" mh-widen)
2158
2159 (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
2160 "?" mh-prefix-help
2161 "u" mh-thread-ancestor
2162 "p" mh-thread-previous-sibling
2163 "n" mh-thread-next-sibling
2164 "t" mh-toggle-threads
2165 "d" mh-thread-delete
2166 "o" mh-thread-refile)
2167
2168 (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2169 "?" mh-prefix-help
2170 "s" mh-narrow-to-subject
2171 "w" mh-widen)
2172
2173 (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
2174 "?" mh-prefix-help
2175 "s" mh-store-msg ;shar
2176 "u" mh-store-msg) ;uuencode
2177
2178 (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
2179 " " mh-page-digest
2180 "?" mh-prefix-help
2181 "\177" mh-page-digest-backwards
2182 "b" mh-burst-digest)
2183
2184 (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
2185 "?" mh-prefix-help
2186 "a" mh-mime-save-parts
2187 "i" mh-folder-inline-mime-part
2188 "o" mh-folder-save-mime-part
2189 "v" mh-folder-toggle-mime-part
2190 "\t" mh-next-button
2191 [backtab] mh-prev-button
2192 "\M-\t" mh-prev-button)
2193
2194 (cond
2195 (mh-xemacs-flag
2196 (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
2197 (t
2198 (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
2199
2200 ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
2201
2202 \f
2203
2204 ;;; Help Messages
2205
2206 ;;; If you add a new prefix, add appropriate text to the nil key.
2207 ;;;
2208 ;;; In general, messages are grouped logically. Taking the main commands for
2209 ;;; example, the first line is "ways to view messages," the second line is
2210 ;;; "things you can do with messages", and the third is "composing" messages.
2211 ;;;
2212 ;;; When adding a new prefix, ensure that the help message contains "what" the
2213 ;;; prefix is for. For example, if the word "folder" were not present in the
2214 ;;; `F' entry, it would not be clear what these commands operated upon.
2215 (defvar mh-help-messages
2216 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
2217 "[d]elete, [o]refile, e[x]ecute,\n"
2218 "[s]end, [r]eply.\n"
2219 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
2220 "[T]hread, / Limit, e[X]tract, [D]igest.")
2221
2222 (?F "[l]ist, [v]isit folder;\n"
2223 "[t]hread; [s]earch; [i]ndexed search;\n"
2224 "[p]ack; [S]ort; [r]escan; [k]ill")
2225 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
2226 "[s]equences, [l]ist,\n"
2227 "[d]elete message from sequence, [k]ill sequence")
2228 (?T "[t]oggle, [d]elete, [o]refile thread")
2229 (?/ "Limit to [s]ubject; [w]iden")
2230 (?X "un[s]har, [u]udecode message")
2231 (?D "[b]urst digest")
2232 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
2233 "[TAB] next; [SHIFT-TAB] previous"))
2234 "Key binding cheat sheet.
2235
2236 This is an associative array which is used to show the most common commands.
2237 The key is a prefix char. The value is one or more strings which are
2238 concatenated together and displayed in the minibuffer if ? is pressed after
2239 the prefix character. The special key nil is used to display the
2240 non-prefixed commands.
2241
2242 The substitutions described in `substitute-command-keys' are performed as
2243 well.")
2244
2245 \f
2246
2247 (dolist (mess '("^Cursor not pointing to message$"
2248 "^There is no other window$"))
2249 (add-to-list 'debug-ignored-errors mess))
2250
2251 (provide 'mh-e)
2252
2253 ;;; Local Variables:
2254 ;;; indent-tabs-mode: nil
2255 ;;; sentence-end-double-space: nil
2256 ;;; End:
2257
2258 ;;; mh-e.el ends here