2006-01-06 Masatake YAMATO <jet@gyve.org>
[bpt/emacs.git] / lisp / mh-e / mh-e.el
CommitLineData
c26cf6c8
RS
1;;; mh-e.el --- GNU Emacs interface to the MH mail system
2
e495eaec
BW
3;; Copyright (C) 1985, 1986, 1987, 1988,
4;; 1990, 1992, 1993, 1994, 1995, 1997, 1999,
af435184 5;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
c26cf6c8 6
a1b4049d 7;; Author: Bill Wohler <wohler@newt.com>
6e65a812 8;; Maintainer: Bill Wohler <wohler@newt.com>
a9954630 9;; Version: 7.85+cvs
c26cf6c8
RS
10;; Keywords: mail
11
60370d40 12;; This file is part of GNU Emacs.
9b7bc076
KH
13
14;; GNU Emacs is free software; you can redistribute it and/or modify
c26cf6c8
RS
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation; either version 2, or (at your option)
17;; any later version.
18
9b7bc076 19;; GNU Emacs is distributed in the hope that it will be useful,
c26cf6c8
RS
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
b578f267 25;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27;; Boston, MA 02110-1301, USA.
c26cf6c8
RS
28
29;;; Commentary:
30
a1b4049d
BW
31;; How to Use:
32;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
33;; C-u M-x mh-rmail to visit any folder.
34;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
b578f267 35
a1b4049d
BW
36;; Your .emacs might benefit from these bindings:
37;; (global-set-key "\C-cr" 'mh-rmail)
38;; (global-set-key "\C-xm" 'mh-smail)
39;; (global-set-key "\C-x4m" 'mh-smail-other-window)
b578f267 40
a1b4049d 41;; MH (Message Handler) is a powerful mail reader.
b578f267 42
a1b4049d
BW
43;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu
44;; (send to mh-users-request to be added). See the monthly Frequently Asked
bdcfe844 45;; Questions posting there for information on getting MH and MH-E:
a1b4049d 46;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html
b578f267 47
a1b4049d 48;; N.B. MH must have been compiled with the MHE compiler flag or several
bdcfe844 49;; features necessary for MH-E will be missing from MH commands, specifically
b578f267
EN
50;; the -build switch to repl and forw.
51
bdcfe844 52;; MH-E is an Emacs interface to the MH mail system.
a1b4049d 53
7094eefe
BW
54;; MH-E is supported in GNU Emacs 21 and 22 as well as XEmacs 21
55;; (except for versions 21.5.9-21.5.16), with MH 6.8.4 on, nmh 1.0.4
56;; on, and GNU mailutils 0.4 on.
a1b4049d
BW
57
58;; Mailing Lists:
59;; mh-e-users@lists.sourceforge.net
60;; mh-e-announce@lists.sourceforge.net
61;; mh-e-devel@lists.sourceforge.net
62;;
63;; Subscribe by sending a "subscribe" message to
64;; <list>-request@lists.sourceforge.net, or by using the web interface at
65;; https://sourceforge.net/mail/?group_id=13357
66
67;; Bug Reports:
68;; https://sourceforge.net/tracker/?group_id=13357&atid=113357
69;; Include the output of M-x mh-version in any bug report.
70
71;; Feature Requests:
72;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse
73
74;; Support:
75;; https://sourceforge.net/tracker/?group_id=13357&atid=213357
b578f267 76
717e06e5 77;;; Change Log:
b578f267
EN
78
79;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
80;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
f0d73c14
BW
81;; Rewritten for GNU Emacs, James Larus, 1985.
82;; Modified by Stephen Gildea, 1988.
83;; Maintenance picked up by Bill Wohler and the
84;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
a1b4049d 85
c26cf6c8
RS
86;;; Code:
87
a66894d8 88(provide 'mh-e)
c3d9274a 89
f0d73c14
BW
90(eval-when-compile (require 'mh-acros))
91(mh-require-cl)
a1b4049d 92
7094eefe
BW
93(require 'easymenu)
94(require 'gnus-util)
95(require 'mh-seq)
96(require 'mh-utils)
a1b4049d 97
a9954630 98(defconst mh-version "7.85+cvs" "Version number of MH-E.")
c26cf6c8 99
c26cf6c8
RS
100(defvar mh-partial-folder-mode-line-annotation "select"
101 "Annotation when displaying part of a folder.
2dcf34f9
BW
102The string is displayed after the folder's name. nil for no
103annotation.")
a1b4049d 104
f0d73c14 105\f
cee9f5c6 106
f0d73c14
BW
107;;; Scan Line Formats
108
cee9f5c6
BW
109;; Parameterize MH-E to work with different scan formats. The defaults work
110;; with the standard MH scan listings, in which the first 4 characters on
111;; the line are the message number, followed by two places for notations.
a1b4049d 112
f0d73c14
BW
113;; The following scan formats are passed to the scan program if the setting of
114;; `mh-scan-format-file' is t. They are identical except the later one makes
115;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
50df64d6 116;; want to change the column of the notations, use the `mh-set-cmd-note'
f0d73c14 117;; function.
a1b4049d
BW
118
119(defvar mh-scan-format-mh
120 (concat
121 "%4(msg)"
122 "%<(cur)+%| %>"
123 "%<{replied}-"
124 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
125 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
126 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
127 "%?(nonnull(comp{newsgroups}))n%>"
128 "%<(zero) %>"
129 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
130 "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
131 "%<(zero)%17(friendly{from})%> "
132 "%{subject}%<{body}<<%{body}%>")
e069fa61 133 "*Scan format string for MH.
2dcf34f9
BW
134This string is passed to the scan program via the -format
135argument. This format is identical to the default except that
136additional hints for fontification have been added to the fifth
137column (remember that in Emacs, the first column is 0).
a1b4049d 138
5a4aad03 139The values of the fifth column, in priority order, are: \"-\" if
2dcf34f9 140the message has been replied to, t if an address on the To: line
5a4aad03
BW
141matches one of the mailboxes of the current user, \"c\" if the Cc:
142line matches, \"b\" if the Bcc: line matches, and \"n\" if a
2dcf34f9 143non-empty Newsgroups: header is present.")
a1b4049d
BW
144
145(defvar mh-scan-format-nmh
146 (concat
147 "%4(msg)"
148 "%<(cur)+%| %>"
149 "%<{replied}-"
150 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
151 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
152 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
153 "%?(nonnull(comp{newsgroups}))n%>"
154 "%<(zero) %>"
155 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
156 "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
157 "%<(zero)%17(decode(friendly{from}))%> "
158 "%(decode{subject})%<{body}<<%{body}%>")
bdcfe844
BW
159 "*Scan format string for nmh.
160This string is passed to the scan program via the -format arg.
2dcf34f9
BW
161This format is identical to the default except that additional
162hints for fontification have been added to the fifth
163column (remember that in Emacs, the first column is 0).
a1b4049d 164
5a4aad03 165The values of the fifth column, in priority order, are: \"-\" if
2dcf34f9 166the message has been replied to, t if an address on the To: field
5a4aad03
BW
167matches one of the mailboxes of the current user, \"c\" if the Cc:
168field matches, \"b\" if the Bcc: field matches, and \"n\" if a
2dcf34f9 169non-empty Newsgroups: field is present.")
f0d73c14
BW
170
171(defvar mh-note-deleted ?D
e069fa61 172 "Messages that have been deleted are marked by this character.
f0d73c14
BW
173See also `mh-scan-deleted-msg-regexp'.")
174
175(defvar mh-note-refiled ?^
e069fa61 176 "Messages that have been refiled are marked by this character.
f0d73c14
BW
177See also `mh-scan-refiled-msg-regexp'.")
178
179(defvar mh-note-cur ?+
e069fa61 180 "The current message (in MH, not in MH-E) is marked by this character.
f0d73c14 181See also `mh-scan-cur-msg-number-regexp'.")
a1b4049d 182
bdcfe844 183(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
e069fa61 184 "This regular expression matches \"good\" messages.
2dcf34f9
BW
185
186It must match from the beginning of the line. Note that the
187default setting of `mh-folder-font-lock-keywords' expects this
188expression to contain at least one parenthesized expression which
189matches the message number as in the default of
190
191 \"^\\\\( *[0-9]+\\\\)[^D^0-9]\".
192
193This expression includes the leading space within the parenthesis
d49ed7d4
BW
194since it looks better to highlight it as well. The highlighting
195is done with the face `mh-folder-msg-number'. This regular
2dcf34f9 196expression should be correct as it is needed by non-fontification
ece9cbf7 197functions.")
a1b4049d 198
bdcfe844 199(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
e069fa61 200 "This regular expression matches deleted messages.
2dcf34f9
BW
201
202It must match from the beginning of the line. Note that the
203default setting of `mh-folder-font-lock-keywords' expects this
204expression to contain at least one parenthesized expression which
205matches the message number as in the default of
206
207 \"^\\\\( *[0-9]+\\\\)D\".
208
209This expression includes the leading space within the parenthesis
d49ed7d4
BW
210since it looks better to highlight it as well. The highlighting
211is done with the face `mh-folder-deleted'. This regular
2dcf34f9
BW
212expression should be correct as it is needed by non-fontification
213functions. See also `mh-note-deleted'.")
a1b4049d 214
bdcfe844 215(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
e069fa61 216 "This regular expression matches refiled messages.
2dcf34f9
BW
217
218It must match from the beginning of the line. Note that the
219default setting of `mh-folder-font-lock-keywords' expects this
220expression to contain at least one parenthesized expression which
221matches the message number as in the default of
222
223 \"^\\\\( *[0-9]+\\\\)\\\\^\".
224
225This expression includes the leading space within the parenthesis
d49ed7d4
BW
226since it looks better to highlight it as well. The highlighting
227is done with the face `mh-folder-refiled'. This regular
2dcf34f9 228expression should be correct as it is needed by non-fontification
ece9cbf7 229functions. See also `mh-note-refiled'.")
a1b4049d
BW
230
231(defvar mh-scan-valid-regexp "^ *[0-9]"
e069fa61 232 "This regular expression describes a valid scan line.
2dcf34f9
BW
233
234This is used to eliminate error messages that are occasionally
235produced by \"inc\".")
a1b4049d 236
bdcfe844 237(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
e069fa61 238 "This regular expression matches the current message.
2dcf34f9
BW
239
240It must match from the beginning of the line. Note that the
241default setting of `mh-folder-font-lock-keywords' expects this
242expression to contain at least one parenthesized expression which
243matches the message number as in the default of
244
245 \"^\\\\( *[0-9]+\\\\+\\\\).*\".
246
247This expression includes the leading space and current message
248marker \"+\" within the parenthesis since it looks better to
d49ed7d4
BW
249highlight these items as well. The highlighting is done with the
250face `mh-folder-cur-msg-number'. This regular expression should
251be correct as it is needed by non-fontification functions. See
252also `mh-note-cur'.")
a1b4049d
BW
253
254(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
e069fa61 255 "This regular expression matches a valid date.
2dcf34f9
BW
256
257It must not be anchored to the beginning or the end of the line.
258Note that the default setting of `mh-folder-font-lock-keywords'
259expects this expression to contain only one parenthesized
260expression which matches the date field as in the default of
261\"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression
d49ed7d4
BW
262is not correct, the date will not be highlighted with the face
263`mh-folder-date'.")
a1b4049d
BW
264
265(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
e069fa61 266 "This regular expression specifies the recipient in messages you sent.
2dcf34f9 267
f0d73c14 268Note that the default setting of `mh-folder-font-lock-keywords'
2dcf34f9 269expects this expression to contain two parenthesized expressions.
5a4aad03 270The first is expected to match the \"To:\" that the default scan
2dcf34f9
BW
271format file generates. The second is expected to match the
272recipient's name as in the default of
273\"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular
d49ed7d4
BW
274expression is not correct, the \"To:\" string will not be
275highlighted with the face `mh-folder-to' and the recipient will
276not be highlighted with the face `mh-folder-address'")
a1b4049d
BW
277
278(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
e069fa61 279 "This regular expression matches the message body fragment.
2dcf34f9
BW
280
281Note that the default setting of `mh-folder-font-lock-keywords'
282expects this expression to contain at least one parenthesized
283expression which matches the body text as in the default of
284\"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is
d49ed7d4
BW
285not correct, the body fragment will not be highlighted with the
286face `mh-folder-body'.")
a1b4049d
BW
287
288(defvar mh-scan-subject-regexp
bdcfe844 289 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
e069fa61 290 "This regular expression matches the subject.
2dcf34f9
BW
291
292It must match from the beginning of the line. Note that the
293default setting of `mh-folder-font-lock-keywords' expects this
294expression to contain at least three parenthesized expressions.
d49ed7d4
BW
295The first is expected to match the \"Re:\" string, if any, and is
296highlighted with the face `mh-folder-followup'. The second
297matches an optional bracketed number after \"Re:\", such as in
298\"Re[2]:\" (and is thus a sub-expression of the first expression)
299and the third is expected to match the subject line itself which
300is highlighted with the face `mh-folder-subject'. For example,
301the default (broken on multiple lines for readability) is
2dcf34f9 302
e069fa61
BW
303 ^ *[0-9]+........[ ]*...................
304 \\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*
305 \\\\([^<\\n]*\\\\)
2dcf34f9
BW
306
307This regular expression should be correct as it is needed by
308non-fontification functions.")
a1b4049d 309
d49ed7d4
BW
310(defvar mh-scan-sent-to-me-sender-regexp
311 "^ *[0-9]+.\\([bct]\\).....[ ]*\\(..................\\)"
312 "This regular expression matches messages sent to us.
2dcf34f9
BW
313
314Note that the default setting of `mh-folder-font-lock-keywords'
d49ed7d4 315expects this expression to contain at least two parenthesized
2dcf34f9 316expressions. The first should match the fontification hint (see
d49ed7d4 317`mh-scan-format-nmh') and the second should match the user name
2dcf34f9
BW
318as in the default of
319
d49ed7d4 320 ^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\)
2dcf34f9 321
d49ed7d4
BW
322If this regular expression is not correct, the notation hints
323will not be highlighted with the face
324`mh-mh-folder-sent-to-me-hint' and the sender will not be
325highlighted with the face `mh-folder-sent-to-me-sender'.")
a1b4049d 326
c3d9274a
BW
327\f
328
bdcfe844
BW
329(defvar mh-folder-font-lock-keywords
330 (list
c3d9274a
BW
331 ;; Folders when displaying index buffer
332 (list "^\\+.*"
d49ed7d4 333 '(0 'mh-index-folder))
bdcfe844
BW
334 ;; Marked for deletion
335 (list (concat mh-scan-deleted-msg-regexp ".*")
d49ed7d4 336 '(0 'mh-folder-deleted))
bdcfe844
BW
337 ;; Marked for refile
338 (list (concat mh-scan-refiled-msg-regexp ".*")
d49ed7d4
BW
339 '(0 'mh-folder-refiled))
340 ;; After subject
341 (list mh-scan-body-regexp
342 '(1 'mh-folder-body nil t))
343 ;; Subject
bdcfe844 344 '(mh-folder-font-lock-subject
d49ed7d4
BW
345 (1 'mh-folder-followup append t)
346 (2 'mh-folder-subject append t))
347 ;; Current message number
bdcfe844 348 (list mh-scan-cur-msg-number-regexp
d49ed7d4
BW
349 '(1 'mh-folder-cur-msg-number))
350 ;; Message number
bdcfe844 351 (list mh-scan-good-msg-regexp
d49ed7d4
BW
352 '(1 'mh-folder-msg-number))
353 ;; Date
354 (list mh-scan-date-regexp
355 '(1 'mh-folder-date))
356 ;; Messages from me (To:)
bdcfe844 357 (list mh-scan-rcpt-regexp
d49ed7d4
BW
358 '(1 'mh-folder-to)
359 '(2 'mh-folder-address))
360 ;; Messages to me
361 (list mh-scan-sent-to-me-sender-regexp
362 '(1 'mh-folder-sent-to-me-hint)
363 '(2 'mh-folder-sent-to-me-sender)))
e069fa61 364 "Keywords (regular expressions) used to fontify the MH-Folder buffer.")
bdcfe844
BW
365
366(defvar mh-scan-cmd-note-width 1
367 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
2dcf34f9 368
5a4aad03
BW
369This column will have one of the values: \" \", \"D\", \"^\", \"+\" and
370where \" \" is the default value,
2dcf34f9 371
5a4aad03
BW
372 \"D\" is the `mh-note-deleted' character,
373 \"^\" is the `mh-note-refiled' character, and
374 \"+\" is the `mh-note-cur' character.")
bdcfe844
BW
375
376(defvar mh-scan-destination-width 1
377 "Number of columns consumed by the destination field in `mh-scan-format'.
2dcf34f9 378
5a4aad03 379This column will have one of \" \", \"%\", \"-\", \"t\", \"c\", \"b\", or \"n\"
2dcf34f9
BW
380in it.
381
5a4aad03
BW
382 \" \" blank space is the default character.
383 \"%\" indicates that the message in in a named MH sequence.
384 \"-\" indicates that the message has been annotated with a replied field.
385 \"t\" indicates that the message contains mymbox in the To: field.
386 \"c\" indicates that the message contains mymbox in the Cc: field.
387 \"b\" indicates that the message contains mymbox in the Bcc: field.
388 \"n\" indicates that the message contains a Newsgroups: field.")
bdcfe844
BW
389
390(defvar mh-scan-date-width 5
391 "Number of columns consumed by the date field in `mh-scan-format'.
392This column will typically be of the form mm/dd.")
393
394(defvar mh-scan-date-flag-width 1
395 "Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
5a4aad03 396This column will have \" \" for valid and \"*\" for invalid or
2dcf34f9 397missing dates.")
bdcfe844
BW
398
399(defvar mh-scan-from-mbox-width 17
400 "Number of columns consumed with the \"From:\" line in `mh-scan-format'.
401This column will have a friendly name or e-mail address of the
402originator, or a \"To: address\" for outgoing e-mail messages.")
403
404(defvar mh-scan-from-mbox-sep-width 2
405 "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
406This column will only ever have spaces in it.")
407
50df64d6
BW
408(defvar mh-scan-field-destination-offset
409 (+ mh-scan-cmd-note-width)
410 "The offset from the `mh-cmd-note' for the destination column.")
411
bdcfe844 412(defvar mh-scan-field-from-start-offset
c3d9274a
BW
413 (+ mh-scan-cmd-note-width
414 mh-scan-destination-width
415 mh-scan-date-width
416 mh-scan-date-flag-width)
417 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
bdcfe844
BW
418
419(defvar mh-scan-field-from-end-offset
c3d9274a
BW
420 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
421 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
bdcfe844
BW
422
423(defvar mh-scan-field-subject-start-offset
424 (+ mh-scan-cmd-note-width
425 mh-scan-destination-width
426 mh-scan-date-width
427 mh-scan-date-flag-width
428 mh-scan-from-mbox-width
429 mh-scan-from-mbox-sep-width)
430 "The offset from the `mh-cmd-note' to find the start of the subject.")
a1b4049d
BW
431
432(defun mh-folder-font-lock-subject (limit)
bdcfe844 433 "Return MH-E scan subject strings to font-lock between point and LIMIT."
a1b4049d
BW
434 (if (not (re-search-forward mh-scan-subject-regexp limit t))
435 nil
436 (if (match-beginning 1)
bdcfe844
BW
437 (set-match-data (list (match-beginning 1) (match-end 3)
438 (match-beginning 1) (match-end 3) nil nil))
439 (set-match-data (list (match-beginning 3) (match-end 3)
440 nil nil (match-beginning 3) (match-end 3))))
a1b4049d
BW
441 t))
442
bdcfe844
BW
443\f
444
445;; Fontifify unseen mesages in bold.
446
a66894d8
BW
447(defmacro mh-generate-sequence-font-lock (seq prefix face)
448 "Generate the appropriate code to fontify messages in SEQ.
2dcf34f9
BW
449PREFIX is used to generate unique names for the variables and
450functions defined by the macro. So a different prefix should be
451provided for every invocation.
a66894d8
BW
452FACE is the font-lock face used to display the matching scan lines."
453 (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
454 (func (intern (format "mh-folder-font-lock-%s" prefix))))
455 `(progn
456 (defvar ,cache nil
457 "Internal cache variable used for font-lock in MH-E.
2dcf34f9
BW
458Should only be non-nil through font-lock stepping, and nil once
459font-lock is done highlighting.")
a66894d8
BW
460 (make-variable-buffer-local ',cache)
461
462 (defun ,func (limit)
463 "Return unseen message lines to font-lock between point and LIMIT."
464 (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
465 (let ((cur-msg (mh-get-msg-num nil)))
466 (cond ((not ,cache)
467 nil)
468 ((>= (point) limit) ;Presumably at end of buffer
469 (setq ,cache nil)
470 nil)
471 ((member cur-msg ,cache)
472 (let ((bpoint (progn (beginning-of-line)(point)))
473 (epoint (progn (forward-line 1)(point))))
474 (if (<= limit (point)) (setq ,cache nil))
475 (set-match-data (list bpoint epoint bpoint epoint))
476 t))
477 (t
478 ;; move forward one line at a time, checking each message
479 (while (and (= 0 (forward-line 1))
480 (> limit (point))
481 (not (member (mh-get-msg-num nil) ,cache))))
482 ;; Examine how we must have exited the loop...
483 (let ((cur-msg (mh-get-msg-num nil)))
484 (cond ((or (<= limit (point))
485 (not (member cur-msg ,cache)))
486 (setq ,cache nil)
487 nil)
488 ((member cur-msg ,cache)
489 (let ((bpoint (progn (beginning-of-line) (point)))
490 (epoint (progn (forward-line 1) (point))))
491 (if (<= limit (point)) (setq ,cache nil))
492 (set-match-data
493 (list bpoint epoint bpoint epoint))
494 t))))))))
495
496 (setq mh-folder-font-lock-keywords
497 (append mh-folder-font-lock-keywords
498 (list (list ',func (list 1 '',face 'prepend t))))))))
499
500(mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
5b004a34 501(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick)
bdcfe844
BW
502
503\f
c26cf6c8
RS
504
505;;; Internal variables:
506
d1699462
BW
507(defvar mh-last-destination nil
508 "Destination of last refile or write command.")
509
510(defvar mh-last-destination-folder nil
511 "Destination of last refile command.")
512
513(defvar mh-last-destination-write nil
514 "Destination of last write command.")
c26cf6c8
RS
515
516(defvar mh-folder-mode-map (make-keymap)
517 "Keymap for MH folders.")
518
d1699462
BW
519(defvar mh-arrow-marker nil
520 "Marker for arrow display in fringe.")
521
522(defvar mh-delete-list nil
523 "List of message numbers to delete.
2dcf34f9
BW
524This variable can be used by
525`mh-before-commands-processed-hook'.")
3d7ca223 526
d1699462
BW
527(defvar mh-refile-list nil
528 "List of folder names in `mh-seq-list'.
2dcf34f9
BW
529This variable can be used by
530`mh-before-commands-processed-hook'.")
c26cf6c8 531
d1699462
BW
532(defvar mh-folders-changed nil
533 "Lists which folders were affected by deletes and refiles.
2dcf34f9
BW
534This list will always include the current folder
535`mh-current-folder'. This variable can be used by
7ba8dffd 536`mh-after-commands-processed-hook'.")
c26cf6c8 537
d1699462
BW
538(defvar mh-next-direction 'forward
539 "Direction to move to next message.")
2953de8c 540
d1699462
BW
541(defvar mh-view-ops ()
542 "Stack of operations that change the folder view.
543These operations include narrowing or threading.")
c26cf6c8 544
d1699462
BW
545(defvar mh-folder-view-stack ()
546 "Stack of previous folder views.")
547
548(defvar mh-index-data nil
549 "Info about index search results.")
c26cf6c8 550
c3d9274a
BW
551(defvar mh-index-previous-search nil)
552(defvar mh-index-msg-checksum-map nil)
553(defvar mh-index-checksum-origin-map nil)
a66894d8 554(defvar mh-index-sequence-search-flag nil)
c3d9274a 555
d1699462
BW
556(defvar mh-first-msg-num nil
557 "Number of first message in buffer.")
c26cf6c8 558
d1699462
BW
559(defvar mh-last-msg-num nil
560 "Number of last msg in buffer.")
c26cf6c8 561
d1699462
BW
562(defvar mh-mode-line-annotation nil
563 "Message range displayed in buffer.")
c26cf6c8 564
d1699462
BW
565(defvar mh-sequence-notation-history nil
566 "Remember original notation that is overwritten by `mh-note-seq'.")
a66894d8 567
d1699462
BW
568(defvar mh-colors-available-flag nil
569 "Non-nil means colors are available.")
f0d73c14 570
cee9f5c6
BW
571\f
572
c26cf6c8
RS
573;;; Macros and generic functions:
574
bdcfe844
BW
575(defun mh-mapc (function list)
576 "Apply FUNCTION to each element of LIST for side effects only."
c26cf6c8 577 (while list
bdcfe844 578 (funcall function (car list))
c26cf6c8
RS
579 (setq list (cdr list))))
580
a1b4049d 581(defun mh-scan-format ()
a66894d8 582 "Return the output format argument for the scan program."
a1b4049d 583 (if (equal mh-scan-format-file t)
f0d73c14 584 (list "-format" (if (mh-variant-p 'nmh 'mu-mh)
c3d9274a
BW
585 (list (mh-update-scan-format
586 mh-scan-format-nmh mh-cmd-note))
587 (list (mh-update-scan-format
588 mh-scan-format-mh mh-cmd-note))))
a1b4049d 589 (if (not (equal mh-scan-format-file nil))
a66894d8 590 (list "-form" mh-scan-format-file))))
a1b4049d 591
c26cf6c8
RS
592\f
593
594;;; Entry points:
595
596;;;###autoload
597(defun mh-rmail (&optional arg)
2dcf34f9
BW
598 "Incorporate new mail with MH.
599Scan an MH folder if ARG is non-nil.
600
601This function is an entry point to MH-E, the Emacs interface to
602the MH mail system."
c26cf6c8
RS
603 (interactive "P")
604 (mh-find-path)
605 (if arg
606 (call-interactively 'mh-visit-folder)
3d7ca223
BW
607 (unless (get-buffer mh-inbox)
608 (mh-visit-folder mh-inbox (symbol-name mh-unseen-seq)))
c3d9274a 609 (mh-inc-folder)))
c26cf6c8 610
a1b4049d
BW
611;;;###autoload
612(defun mh-nmail (&optional arg)
613 "Check for new mail in inbox folder.
2dcf34f9
BW
614Scan an MH folder if ARG is non-nil.
615
616This function is an entry point to MH-E, the Emacs interface to
617the MH mail system."
a1b4049d 618 (interactive "P")
c3d9274a 619 (mh-find-path) ; init mh-inbox
a1b4049d
BW
620 (if arg
621 (call-interactively 'mh-visit-folder)
622 (mh-visit-folder mh-inbox)))
c26cf6c8
RS
623
624\f
625
bdcfe844 626;;; User executable MH-E commands:
c26cf6c8 627
a66894d8 628(defun mh-delete-msg (range)
7a5df5a9 629 "Delete RANGE\\<mh-folder-mode-map>.
553fb735 630
2dcf34f9
BW
631To mark a message for deletion, use this command. A \"D\" is
632placed by the message in the scan window, and the next undeleted
633message is displayed. If the previous command had been
634\\[mh-previous-undeleted-msg], then the next message displayed is
635the first undeleted message previous to the message just deleted.
636Use \\[mh-next-undeleted-msg] to force subsequent
637\\[mh-delete-msg] commands to move forward to the next undeleted
638message after deleting the message under the cursor.
639
640The hook `mh-delete-msg-hook' is called after you mark a message
641for deletion. For example, a past maintainer of MH-E used this
642once when he kept statistics on his mail usage.
643
644Check the documentation of `mh-interactive-range' to see how
645RANGE is read in interactive use."
a66894d8
BW
646 (interactive (list (mh-interactive-range "Delete")))
647 (mh-delete-msg-no-motion range)
d1699462
BW
648 (if (looking-at mh-scan-deleted-msg-regexp)
649 (mh-next-msg)))
a66894d8
BW
650
651(defun mh-delete-msg-no-motion (range)
2be362c2 652 "Delete RANGE, don't move to next message.
553fb735 653
2dcf34f9
BW
654This command marks the RANGE for deletion but leaves the cursor
655at the current message in case you wish to perform other
656operations on the message.
a66894d8 657
2dcf34f9
BW
658Check the documentation of `mh-interactive-range' to see how
659RANGE is read in interactive use."
a66894d8
BW
660 (interactive (list (mh-interactive-range "Delete")))
661 (mh-iterate-on-range () range
924df208 662 (mh-delete-a-msg nil)))
c26cf6c8 663
c26cf6c8 664(defun mh-execute-commands ()
d1699462
BW
665 "Process outstanding delete and refile requests\\<mh-folder-mode-map>.
666
2dcf34f9
BW
667If you've marked messages to be deleted or refiled and you want
668to go ahead and delete or refile the messages, use this command.
669Many MH-E commands that may affect the numbering of the
670messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder])
671will ask if you want to process refiles or deletes first and then
672either run this command for you or undo the pending refiles and
d1699462
BW
673deletes, which are lost.
674
2dcf34f9
BW
675This function runs `mh-before-commands-processed-hook' before the
676commands are processed and `mh-after-commands-processed-hook'
677after the commands are processed."
c26cf6c8 678 (interactive)
a66894d8 679 (if mh-folder-view-stack (mh-widen t))
c26cf6c8
RS
680 (mh-process-commands mh-current-folder)
681 (mh-set-scan-mode)
c3d9274a 682 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
c26cf6c8 683 (mh-make-folder-mode-line)
c3d9274a 684 t) ; return t for write-file-functions
c26cf6c8
RS
685
686(defun mh-first-msg ()
553fb735 687 "Display first message."
c26cf6c8 688 (interactive)
847b8219 689 (goto-char (point-min))
a1b4049d 690 (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
847b8219 691 (forward-line 1)))
c26cf6c8 692
c26cf6c8 693(defun mh-header-display ()
553fb735
BW
694 "Display message with all header fields\\<mh-folder-mode-map>.
695
696Use the command \\[mh-show] to show the message normally again."
c26cf6c8
RS
697 (interactive)
698 (and (not mh-showing-with-headers)
553fb735 699 (or mh-mhl-format-file mh-clean-message-header-flag)
c26cf6c8 700 (mh-invalidate-show-buffer))
bdcfe844 701 (let ((mh-decode-mime-flag nil)
553fb735 702 (mh-mhl-format-file nil)
c3d9274a 703 (mh-clean-message-header-flag nil))
c26cf6c8
RS
704 (mh-show-msg nil)
705 (mh-in-show-buffer (mh-show-buffer)
706 (goto-char (point-min))
707 (mh-recenter 0))
708 (setq mh-showing-with-headers t)))
709
af435184 710(defun mh-inc-folder (&optional file folder)
d1699462
BW
711 "Incorporate new mail into a folder.
712
713You can incorporate mail from any file into the current folder by
2dcf34f9 714specifying a prefix argument; you'll be prompted for the name of
af435184 715the FILE to use as well as the destination FOLDER
d1699462 716
2dcf34f9 717The hook `mh-inc-folder-hook' is run after incorporating new
af435184 718mail.
d1699462 719
af435184
BW
720Do not call this function from outside MH-E; use \\[mh-rmail]
721instead."
c26cf6c8 722 (interactive (list (if current-prefix-arg
c3d9274a
BW
723 (expand-file-name
724 (read-file-name "inc mail from file: "
924df208
BW
725 mh-user-path)))
726 (if current-prefix-arg
727 (mh-prompt-for-folder "inc mail into" mh-inbox t))))
728 (if (not folder)
729 (setq folder mh-inbox))
c3d9274a
BW
730 (let ((threading-needed-flag nil))
731 (let ((config (current-window-configuration)))
e495eaec
BW
732 (when (and mh-show-buffer (get-buffer mh-show-buffer))
733 (delete-windows-on mh-show-buffer))
924df208
BW
734 (cond ((not (get-buffer folder))
735 (mh-make-folder folder)
736 (setq threading-needed-flag mh-show-threads-flag)
737 (setq mh-previous-window-config config))
738 ((not (eq (current-buffer) (get-buffer folder)))
739 (switch-to-buffer folder)
740 (setq mh-previous-window-config config))))
af435184 741 (mh-get-new-mail file)
c3d9274a
BW
742 (when (and threading-needed-flag
743 (save-excursion
744 (goto-char (point-min))
745 (or (null mh-large-folder)
a66894d8 746 (not (equal (forward-line (1+ mh-large-folder)) 0))
c3d9274a
BW
747 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
748 nil))))
749 (mh-toggle-threads))
924df208
BW
750 (beginning-of-line)
751 (if (and mh-showing-mode (looking-at mh-scan-valid-regexp)) (mh-show))
c3d9274a 752 (run-hooks 'mh-inc-folder-hook)))
c26cf6c8 753
c26cf6c8 754(defun mh-last-msg ()
553fb735 755 "Display last message."
c26cf6c8
RS
756 (interactive)
757 (goto-char (point-max))
c3d9274a 758 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
bdcfe844
BW
759 (forward-line -1))
760 (mh-recenter nil))
c26cf6c8 761
553fb735
BW
762(defun mh-next-undeleted-msg (&optional count wait-after-complaining-flag)
763 "Display next message.
764
2dcf34f9
BW
765This command can be given a prefix argument COUNT to specify how
766many unread messages to skip.
553fb735 767
2dcf34f9
BW
768In a program, pause for a second after printing message if we are
769at the last undeleted message and optional argument
770WAIT-AFTER-COMPLAINING-FLAG is non-nil."
847b8219 771 (interactive "p")
c26cf6c8 772 (setq mh-next-direction 'forward)
847b8219 773 (forward-line 1)
553fb735 774 (cond ((re-search-forward mh-scan-good-msg-regexp nil t count)
c3d9274a
BW
775 (beginning-of-line)
776 (mh-maybe-show))
777 (t (forward-line -1)
924df208
BW
778 (message "No more undeleted messages")
779 (if wait-after-complaining-flag (sit-for 1)))))
c26cf6c8 780
3d7ca223 781(defun mh-folder-from-address ()
f0d73c14
BW
782 "Derive folder name from sender.
783
784The name of the folder is derived as follows:
3d7ca223 785
2dcf34f9
BW
786 a) The folder name associated with the first address found in
787 the list `mh-default-folder-list' is used. Each element in
5a4aad03 788 this list contains a \"Check Recipient\" item. If this item is
2dcf34f9
BW
789 turned on, then the address is checked against the recipient
790 instead of the sender. This is useful for mailing lists.
3d7ca223 791
2dcf34f9
BW
792 b) An alias prefixed by `mh-default-folder-prefix'
793 corresponding to the address is used. The prefix is used to
794 prevent clutter in your mail directory.
3d7ca223 795
f0d73c14 796Return nil if a folder name was not derived, or if the variable
2dcf34f9
BW
797`mh-default-folder-must-exist-flag' is t and the folder does not
798exist."
924df208 799 ;; Loop for all entries in mh-default-folder-list
a66894d8
BW
800 (save-restriction
801 (goto-char (point-min))
f0d73c14 802 (re-search-forward "\n\n" nil 'limit)
a66894d8
BW
803 (narrow-to-region (point-min) (point))
804 (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
805 (or (message-fetch-field "cc") "")))
806 (from (or (message-fetch-field "from") ""))
807 folder-name)
808 (setq folder-name
809 (loop for list in mh-default-folder-list
810 when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
811 return (nth 1 list)
812 finally return nil))
924df208
BW
813
814 ;; Make sure a result from `mh-default-folder-list' begins with "+"
815 ;; since 'mh-expand-file-name below depends on it
816 (when (and folder-name (not (eq (aref folder-name 0) ?+)))
817 (setq folder-name (concat "+" folder-name)))
818
819 ;; If not, is there an alias for the address?
820 (when (not folder-name)
821 (let* ((from-header (mh-extract-from-header-value))
822 (address (and from-header
823 (nth 1 (mail-extract-address-components
824 from-header))))
825 (alias (and address (mh-alias-address-to-alias address))))
826 (when alias
827 (setq folder-name
828 (and alias (concat "+" mh-default-folder-prefix alias))))))
829
830 ;; If mh-default-folder-must-exist-flag set, check that folder exists.
831 (if (and folder-name
832 (or (not mh-default-folder-must-exist-flag)
833 (file-exists-p (mh-expand-file-name folder-name))))
834 folder-name))))
3d7ca223
BW
835
836(defun mh-prompt-for-refile-folder ()
837 "Prompt the user for a folder in which the message should be filed.
838The folder is returned as a string.
839
f0d73c14
BW
840The default folder name is generated by the option
841`mh-default-folder-for-message-function' if it is non-nil or
842`mh-folder-from-address'."
3d7ca223
BW
843 (mh-prompt-for-folder
844 "Destination"
f0d73c14
BW
845 (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
846 (if (null refile-file) ""
847 (save-excursion
848 (set-buffer (get-buffer-create mh-temp-buffer))
849 (erase-buffer)
850 (insert-file-contents refile-file)
851 (or (and mh-default-folder-for-message-function
852 (let ((buffer-file-name refile-file))
853 (funcall mh-default-folder-for-message-function)))
854 (mh-folder-from-address)
855 (and (eq 'refile (car mh-last-destination-folder))
856 (symbol-name (cdr mh-last-destination-folder)))
857 ""))))
3d7ca223
BW
858 t))
859
a66894d8 860(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
2be362c2
BW
861 "Refile (output) RANGE into FOLDER.
862
2dcf34f9
BW
863You are prompted for the folder name. Note that this command can also
864be used to create folders. If you specify a folder that does not
865exist, you will be prompted to create it.
2be362c2 866
2dcf34f9
BW
867The hook `mh-refile-msg-hook' is called after a message is marked to
868be refiled.
a66894d8 869
2dcf34f9
BW
870Check the documentation of `mh-interactive-range' to see how RANGE is
871read in interactive use.
924df208 872
d1699462
BW
873In a program, the variables `mh-last-destination' and
874`mh-last-destination-folder' are not updated if
875DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil."
a66894d8 876 (interactive (list (mh-interactive-range "Refile")
924df208
BW
877 (intern (mh-prompt-for-refile-folder))))
878 (unless dont-update-last-destination-flag
879 (setq mh-last-destination (cons 'refile folder)
880 mh-last-destination-folder mh-last-destination))
a66894d8 881 (mh-iterate-on-range () range
924df208 882 (mh-refile-a-msg nil folder))
a66894d8 883 (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
c26cf6c8 884
e495eaec 885(defun mh-refile-or-write-again (range &optional interactive-flag)
553fb735
BW
886 "Repeat last output command.
887
af435184
BW
888If you are refiling several messages into the same folder, you
889can use this command to repeat the last
890refile (\\[mh-refile-msg]) or write (\\[mh-write-msg-to-file]).
891You can use a range.
553fb735 892
2dcf34f9
BW
893Check the documentation of `mh-interactive-range' to see how RANGE is
894read in interactive use.
553fb735 895
2dcf34f9
BW
896In a program, a non-nil INTERACTIVE-FLAG means that the function was
897called interactively."
e495eaec 898 (interactive (list (mh-interactive-range "Redo") t))
c26cf6c8
RS
899 (if (null mh-last-destination)
900 (error "No previous refile or write"))
553fb735
BW
901 (cond ((eq (car mh-last-destination) 'refile)
902 (mh-refile-msg range (cdr mh-last-destination))
f9c53c97 903 (message "Destination folder: %s" (cdr mh-last-destination)))
553fb735
BW
904 (t
905 (mh-iterate-on-range msg range
906 (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)))
907 (mh-next-msg interactive-flag))))
c26cf6c8 908
c26cf6c8 909(defun mh-quit ()
bdcfe844 910 "Quit the current MH-E folder.
d1699462 911
2dcf34f9
BW
912When you want to quit using MH-E and go back to editing, you can use
913this command. This buries the buffers of the current MH-E folder and
914restores the buffers that were present when you first ran
915\\[mh-rmail]. It also removes any MH-E working buffers whose name
916begins with \" *mh-\" or \"*MH-E \". You can later restore your MH-E
917session by selecting the \"+inbox\" buffer or by running \\[mh-rmail]
918again.
919
920The two hooks `mh-before-quit-hook' and `mh-quit-hook' are called by
921this function. The former one is called before the quit occurs, so you
922might use it to perform any MH-E operations; you could perform some
923query and abort the quit or call `mh-execute-commands', for example.
924The latter is not run in an MH-E context, so you might use it to
925modify the window setup."
c26cf6c8 926 (interactive)
a1b4049d 927 (run-hooks 'mh-before-quit-hook)
bdcfe844
BW
928 (let ((show-buffer (get-buffer mh-show-buffer)))
929 (when show-buffer
930 (kill-buffer show-buffer)))
847b8219 931 (mh-update-sequences)
bdcfe844 932 (mh-destroy-postponed-handles)
6d4de1a7 933 (bury-buffer (current-buffer))
3d7ca223
BW
934
935 ;; Delete all MH-E temporary and working buffers.
936 (dolist (buffer (buffer-list))
937 (when (or (string-match "^ \\*mh-" (buffer-name buffer))
938 (string-match "^\\*MH-E " (buffer-name buffer)))
939 (kill-buffer buffer)))
940
c26cf6c8
RS
941 (if mh-previous-window-config
942 (set-window-configuration mh-previous-window-config))
943 (run-hooks 'mh-quit-hook))
944
553fb735
BW
945(defun mh-page-msg (&optional lines)
946 "Display next page in message.
947
2dcf34f9
BW
948You can give this command a prefix argument that specifies the
949number of LINES to scroll. This command will also show the next
950undeleted message if it is used at the bottom of a message."
c26cf6c8 951 (interactive "P")
a1b4049d 952 (if mh-showing-mode
bdcfe844 953 (if mh-page-to-next-msg-flag
c3d9274a
BW
954 (if (equal mh-next-direction 'backward)
955 (mh-previous-undeleted-msg)
956 (mh-next-undeleted-msg))
957 (if (mh-in-show-buffer (mh-show-buffer)
958 (pos-visible-in-window-p (point-max)))
959 (progn
deceef67 960 (message
47570699
DG
961 "End of message (Type %s to read %s undeleted message)"
962 (single-key-description last-input-event)
963 (if (equal mh-next-direction 'backward)
964 "previous"
965 "next"))
c3d9274a 966 (setq mh-page-to-next-msg-flag t))
553fb735 967 (scroll-other-window lines)))
a1b4049d 968 (mh-show)))
c26cf6c8 969
553fb735
BW
970(defun mh-previous-page (&optional lines)
971 "Display next page in message.
972
2dcf34f9
BW
973You can give this command a prefix argument that specifies the
974number of LINES to scroll."
c26cf6c8
RS
975 (interactive "P")
976 (mh-in-show-buffer (mh-show-buffer)
553fb735 977 (scroll-down lines)))
c26cf6c8 978
553fb735
BW
979(defun mh-previous-undeleted-msg (&optional count wait-after-complaining-flag)
980 "Display previous message.
981
2dcf34f9
BW
982This command can be given a prefix argument COUNT to specify how
983many unread messages to skip.
553fb735 984
2dcf34f9
BW
985In a program, pause for a second after printing message if we are
986at the last undeleted message and optional argument
987WAIT-AFTER-COMPLAINING-FLAG is non-nil."
c26cf6c8
RS
988 (interactive "p")
989 (setq mh-next-direction 'backward)
990 (beginning-of-line)
553fb735 991 (cond ((re-search-backward mh-scan-good-msg-regexp nil t count)
c3d9274a 992 (mh-maybe-show))
924df208
BW
993 (t (message "No previous undeleted message")
994 (if wait-after-complaining-flag (sit-for 1)))))
c3d9274a
BW
995
996(defun mh-previous-unread-msg (&optional count)
553fb735
BW
997 "Display previous unread message.
998
2dcf34f9
BW
999This command can be given a prefix argument COUNT to specify how
1000many unread messages to skip."
c3d9274a
BW
1001 (interactive "p")
1002 (unless (> count 0)
f9c53c97 1003 (error "The function `mh-previous-unread-msg' expects positive argument"))
c3d9274a
BW
1004 (setq count (1- count))
1005 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
1006 (cur-msg (mh-get-msg-num nil)))
1007 (cond ((and (not cur-msg) (not (bobp))
1008 ;; If we are at the end of the buffer back up one line and go
1009 ;; to unread message after that.
1010 (progn
1011 (forward-line -1)
1012 (setq cur-msg (mh-get-msg-num nil)))
1013 nil))
1014 ((or (null unread-sequence) (not cur-msg))
1015 ;; No unread message or there aren't any messages in buffer...
1016 (message "No more unread messages"))
1017 ((progn
1018 ;; Skip count messages...
1019 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
1020 (setq unread-sequence (cdr unread-sequence)))
1021 (while (> count 0)
1022 (setq unread-sequence (cdr unread-sequence))
1023 (setq count (1- count)))
1024 (not (car unread-sequence)))
1025 (message "No more unread messages"))
f0d73c14
BW
1026 (t (loop for msg in unread-sequence
1027 when (mh-goto-msg msg t) return nil
1028 finally (message "No more unread messages"))))))
bdcfe844
BW
1029
1030(defun mh-goto-next-button (backward-flag &optional criterion)
1031 "Search for next button satisfying criterion.
2dcf34f9
BW
1032
1033If BACKWARD-FLAG is non-nil search backward in the buffer for a mime
1034button.
1035If CRITERION is a function or a symbol which has a function binding
1036then that function must return non-nil at the button we stop."
bdcfe844
BW
1037 (unless (or (and (symbolp criterion) (fboundp criterion))
1038 (functionp criterion))
1039 (setq criterion (lambda (x) t)))
1040 ;; Move to the next button in the buffer satisfying criterion
1041 (goto-char (or (save-excursion
1042 (beginning-of-line)
1043 ;; Find point before current button
1044 (let ((point-before-current-button
c3d9274a
BW
1045 (save-excursion
1046 (while (get-text-property (point) 'mh-data)
1047 (unless (= (forward-line
1048 (if backward-flag 1 -1))
1049 0)
1050 (if backward-flag
1051 (goto-char (point-min))
1052 (goto-char (point-max)))))
1053 (point))))
1054 ;; Skip over current button
1055 (while (and (get-text-property (point) 'mh-data)
1056 (not (if backward-flag (bobp) (eobp))))
1057 (forward-line (if backward-flag -1 1)))
1058 ;; Stop at next MIME button if any exists.
1059 (block loop
1060 (while (/= (progn
1061 (unless (= (forward-line
1062 (if backward-flag -1 1))
1063 0)
1064 (if backward-flag
1065 (goto-char (point-max))
1066 (goto-char (point-min)))
1067 (beginning-of-line))
1068 (point))
1069 point-before-current-button)
1070 (when (and (get-text-property (point) 'mh-data)
1071 (funcall criterion (point)))
1072 (return-from loop (point))))
1073 nil)))
bdcfe844
BW
1074 (point))))
1075
1076(defun mh-next-button (&optional backward-flag)
553fb735
BW
1077 "Go to the next button.
1078
2dcf34f9
BW
1079If the end of the buffer is reached then the search wraps over to
1080the start of the buffer.
553fb735 1081
2dcf34f9
BW
1082If an optional prefix argument BACKWARD-FLAG is given, the cursor
1083will move to the previous button."
bdcfe844
BW
1084 (interactive (list current-prefix-arg))
1085 (unless mh-showing-mode
1086 (mh-show))
1087 (mh-in-show-buffer (mh-show-buffer)
1088 (mh-goto-next-button backward-flag)))
c26cf6c8 1089
bdcfe844 1090(defun mh-prev-button ()
553fb735
BW
1091 "Go to the previous button.
1092
2dcf34f9
BW
1093If the beginning of the buffer is reached then the search wraps
1094over to the end of the buffer."
bdcfe844
BW
1095 (interactive)
1096 (mh-next-button t))
1097
1098(defun mh-folder-mime-action (part-index action include-security-flag)
1099 "Go to PART-INDEX and carry out ACTION.
2dcf34f9
BW
1100
1101If PART-INDEX is nil then go to the next part in the buffer. The
1102search for the next buffer wraps around if end of buffer is reached.
1103If argument INCLUDE-SECURITY-FLAG is non-nil then include security
1104info buttons when searching for a suitable parts."
bdcfe844
BW
1105 (unless mh-showing-mode
1106 (mh-show))
1107 (mh-in-show-buffer (mh-show-buffer)
1108 (let ((criterion
c3d9274a
BW
1109 (cond (part-index
1110 (lambda (p)
1111 (let ((part (get-text-property p 'mh-part)))
1112 (and (integerp part) (= part part-index)))))
1113 (t (lambda (p)
1114 (if include-security-flag
1115 (get-text-property p 'mh-data)
1116 (integerp (get-text-property p 'mh-part)))))))
bdcfe844
BW
1117 (point (point)))
1118 (cond ((and (get-text-property point 'mh-part)
1119 (or (null part-index)
1120 (= (get-text-property point 'mh-part) part-index)))
1121 (funcall action))
1122 ((and (get-text-property point 'mh-data)
1123 include-security-flag
1124 (null part-index))
1125 (funcall action))
1126 (t
1127 (mh-goto-next-button nil criterion)
1128 (if (= (point) point)
1129 (message "No matching MIME part found")
1130 (funcall action)))))))
1131
1132(defun mh-folder-toggle-mime-part (part-index)
553fb735
BW
1133 "View attachment.
1134
2dcf34f9
BW
1135This command displays (or hides) the attachment associated with
1136the button under the cursor. If the cursor is not located over a
1137button, then the cursor first moves to the next button, wrapping
1138to the beginning of the message if necessary. This command has
1139the advantage over related commands of working from the MH-Folder
1140buffer.
1141
1142You can also provide a numeric prefix argument PART-INDEX to view
1143the attachment labeled with that number. If Emacs does not know
1144how to display the attachment, then Emacs offers to save the
1145attachment in a file."
bdcfe844
BW
1146 (interactive "P")
1147 (when (consp part-index) (setq part-index (car part-index)))
1148 (mh-folder-mime-action part-index #'mh-press-button t))
1149
1150(defun mh-folder-inline-mime-part (part-index)
553fb735
BW
1151 "Show attachment verbatim.
1152
2dcf34f9
BW
1153You can view the raw contents of an attachment with this command.
1154This command displays (or hides) the contents of the attachment
1155associated with the button under the cursor verbatim. If the
1156cursor is not located over a button, then the cursor first moves
1157to the next button, wrapping to the beginning of the message if
1158necessary.
553fb735 1159
2dcf34f9
BW
1160You can also provide a numeric prefix argument PART-INDEX to view
1161the attachment labeled with that number."
bdcfe844
BW
1162 (interactive "P")
1163 (when (consp part-index) (setq part-index (car part-index)))
1164 (mh-folder-mime-action part-index #'mh-mime-inline-part nil))
1165
1166(defun mh-folder-save-mime-part (part-index)
553fb735
BW
1167 "Save (output) attachment.
1168
2dcf34f9
BW
1169This command saves the attachment associated with the button under the
1170cursor. If the cursor is not located over a button, then the cursor
1171first moves to the next button, wrapping to the beginning of the
1172message if necessary.
553fb735
BW
1173
1174You can also provide a numeric prefix argument PART-INDEX to save the
1175attachment labeled with that number.
1176
2dcf34f9
BW
1177This command prompts you for a filename and suggests a specific name
1178if it is available."
bdcfe844
BW
1179 (interactive "P")
1180 (when (consp part-index) (setq part-index (car part-index)))
1181 (mh-folder-mime-action part-index #'mh-mime-save-part nil))
1182
1183(defun mh-reset-threads-and-narrowing ()
1184 "Reset all variables pertaining to threads and narrowing.
1185Also removes all content from the folder buffer."
1186 (setq mh-view-ops ())
a66894d8
BW
1187 (setq mh-folder-view-stack ())
1188 (setq mh-thread-scan-line-map-stack ())
bdcfe844 1189 (let ((buffer-read-only nil)) (erase-buffer)))
c26cf6c8 1190
bdcfe844 1191(defun mh-rescan-folder (&optional range dont-exec-pending)
2be362c2
BW
1192 "Rescan folder\\<mh-folder-mode-map>.
1193
1194This command is useful to grab all messages in your \"+inbox\" after
2dcf34f9
BW
1195processing your new mail for the first time. If you don't want to
1196rescan the entire folder, this command will accept a RANGE. Check the
1197documentation of `mh-interactive-range' to see how RANGE is read in
1198interactive use.
2be362c2 1199
2dcf34f9
BW
1200This command will ask if you want to process refiles or deletes first
1201and then either run \\[mh-execute-commands] for you or undo the
1202pending refiles and deletes, which are lost.
2be362c2 1203
2dcf34f9
BW
1204In a program, the processing of outstanding commands is not performed
1205if DONT-EXEC-PENDING is non-nil."
c26cf6c8 1206 (interactive (list (if current-prefix-arg
a66894d8
BW
1207 (mh-read-range "Rescan" mh-current-folder t nil t
1208 mh-interpret-number-as-range-flag)
c3d9274a 1209 nil)))
c26cf6c8 1210 (setq mh-next-direction 'forward)
8f9efec8
BW
1211 (let ((threaded-flag (memq 'unthread mh-view-ops))
1212 (msg-num (mh-get-msg-num nil)))
c3d9274a 1213 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
8f9efec8
BW
1214 ;; If there isn't a cur sequence, mh-scan-folder goes to the first message.
1215 ;; Try to stay where we were.
1216 (if (null (car (mh-seq-to-msgs 'cur)))
1217 (mh-goto-msg msg-num t t))
c3d9274a
BW
1218 (cond (threaded-flag (mh-toggle-threads))
1219 (mh-index-data (mh-index-insert-folder-headers)))))
c26cf6c8 1220
553fb735
BW
1221(defun mh-write-msg-to-file (message file no-header)
1222 "Append MESSAGE to end of FILE\\<mh-folder-mode-map>.
1223
2dcf34f9
BW
1224You are prompted for the filename. If the file already exists,
1225the message is appended to it. You can also write the message to
1226the file without the header by specifying a prefix argument
1227NO-HEADER. Subsequent writes to the same file can be made with
1228the command \\[mh-refile-or-write-again]."
c26cf6c8
RS
1229 (interactive
1230 (list (mh-get-msg-num t)
c3d9274a
BW
1231 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
1232 (file-name-directory
1233 (car (cdr mh-last-destination-write)))
1234 default-directory)))
1235 (read-file-name (format "Save message%s in file: "
1236 (if current-prefix-arg " body" ""))
1237 default-dir
1238 (if (eq 'write (car mh-last-destination-write))
1239 (car (cdr mh-last-destination-write))
1240 (expand-file-name "mail.out" default-dir))))
1241 current-prefix-arg))
553fb735 1242 (let ((msg-file-to-output (mh-msg-filename message))
c3d9274a 1243 (output-file (mh-expand-file-name file)))
553fb735 1244 (setq mh-last-destination (list 'write file (if no-header 'no-header))
c3d9274a 1245 mh-last-destination-write mh-last-destination)
c26cf6c8 1246 (save-excursion
847b8219 1247 (set-buffer (get-buffer-create mh-temp-buffer))
c26cf6c8 1248 (erase-buffer)
847b8219 1249 (insert-file-contents msg-file-to-output)
c26cf6c8 1250 (goto-char (point-min))
553fb735 1251 (if no-header (search-forward "\n\n"))
c26cf6c8
RS
1252 (append-to-file (point) (point-max) output-file))))
1253
c26cf6c8 1254(defun mh-toggle-showing ()
af435184
BW
1255 "Toggle between MH-Folder and MH-Folder Show modes.
1256
1257This command switches between MH-Folder mode and MH-Folder Show
1258mode. MH-Folder mode turns off the associated show buffer so that
1259you can perform operations on the messages quickly without
1260reading them. This is an excellent way to prune out your junk
1261mail or to refile a group of messages to another folder for later
1262examination."
c26cf6c8 1263 (interactive)
a1b4049d 1264 (if mh-showing-mode
c26cf6c8 1265 (mh-set-scan-mode)
a1b4049d 1266 (mh-show)))
c26cf6c8 1267
a66894d8 1268(defun mh-undo (range)
2be362c2
BW
1269 "Undo pending deletes or refiles in RANGE.
1270
2dcf34f9
BW
1271If you've deleted a message or refiled it, but changed your mind,
1272you can cancel the action before you've executed it. Use this
1273command to undo a refile on or deletion of a single message. You
1274can also undo refiles and deletes for messages that are found in
1275a given RANGE.
a66894d8 1276
2dcf34f9
BW
1277Check the documentation of `mh-interactive-range' to see how
1278RANGE is read in interactive use."
a66894d8
BW
1279 (interactive (list (mh-interactive-range "Undo")))
1280 (cond ((numberp range)
c3d9274a
BW
1281 (let ((original-position (point)))
1282 (beginning-of-line)
1283 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
1284 (looking-at mh-scan-refiled-msg-regexp)
1285 (and (eq mh-next-direction 'forward) (bobp))
1286 (and (eq mh-next-direction 'backward)
1287 (save-excursion (forward-line) (eobp)))))
1288 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1289 (if (or (looking-at mh-scan-deleted-msg-regexp)
1290 (looking-at mh-scan-refiled-msg-regexp))
1291 (progn
1292 (mh-undo-msg (mh-get-msg-num t))
1293 (mh-maybe-show))
1294 (goto-char original-position)
1295 (error "Nothing to undo"))))
a66894d8 1296 (t (mh-iterate-on-range () range
924df208 1297 (mh-undo-msg nil))))
c26cf6c8
RS
1298 (if (not (mh-outstanding-commands-p))
1299 (mh-set-folder-modified-p nil)))
1300
c3d9274a
BW
1301(defun mh-folder-line-matches-show-buffer-p ()
1302 "Return t if the message under point in folder-mode is in the show buffer.
2dcf34f9
BW
1303Return nil in any other circumstance (no message under point, no
1304show buffer, the message in the show buffer doesn't match."
c3d9274a
BW
1305 (and (eq major-mode 'mh-folder-mode)
1306 (mh-get-msg-num nil)
1307 mh-show-buffer
1308 (get-buffer mh-show-buffer)
1309 (buffer-file-name (get-buffer mh-show-buffer))
1310 (string-match ".*/\\([0-9]+\\)$"
1311 (buffer-file-name (get-buffer mh-show-buffer)))
1312 (string-equal
1313 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1314 (int-to-string (mh-get-msg-num nil)))))
1315
1316(eval-when-compile (require 'gnus))
1317
1318(defmacro mh-macro-expansion-time-gnus-version ()
1319 "Return Gnus version available at macro expansion time.
2dcf34f9
BW
1320The macro evaluates the Gnus version at macro expansion time. If
1321MH-E was compiled then macro expansion happens at compile time."
1322gnus-version)
c3d9274a
BW
1323
1324(defun mh-run-time-gnus-version ()
1325 "Return Gnus version available at run time."
1326 (require 'gnus)
1327 gnus-version)
1328
847b8219 1329;;;###autoload
c26cf6c8 1330(defun mh-version ()
bdcfe844 1331 "Display version information about MH-E and the MH mail handling system."
c26cf6c8 1332 (interactive)
3d7ca223 1333 (set-buffer (get-buffer-create mh-info-buffer))
c26cf6c8 1334 (erase-buffer)
c3d9274a
BW
1335 ;; MH-E version.
1336 (insert "MH-E " mh-version "\n\n")
1337 ;; MH-E compilation details.
1338 (insert "MH-E compilation details:\n")
1339 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1340 (gnus-compiled-version (if compiled-mhe
1341 (mh-macro-expansion-time-gnus-version)
1342 "N/A")))
1343 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1344 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1345 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1346 ;; Emacs version.
1347 (insert (emacs-version) "\n\n")
a1b4049d 1348 ;; MH version.
f0d73c14
BW
1349 (if mh-variant-in-use
1350 (insert mh-variant-in-use "\n"
1351 " mh-progs:\t" mh-progs "\n"
1352 " mh-lib:\t" mh-lib "\n"
1353 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1354 (insert "No MH variant detected\n"))
a1b4049d
BW
1355 ;; Linux version.
1356 (condition-case ()
1357 (call-process "uname" nil t nil "-a")
1358 (file-error))
1359 (goto-char (point-min))
3d7ca223 1360 (display-buffer mh-info-buffer))
c26cf6c8 1361
3d7ca223
BW
1362(defun mh-parse-flist-output-line (line &optional current-folder)
1363 "Parse LINE to generate folder name, unseen messages and total messages.
2dcf34f9
BW
1364If CURRENT-FOLDER is non-nil then it contains the current folder
1365name and it is used to avoid problems in corner cases involving
1366folders whose names end with a '+' character."
c3d9274a
BW
1367 (with-temp-buffer
1368 (insert line)
1369 (goto-char (point-max))
1370 (let (folder unseen total p)
1371 (when (search-backward " out of " (point-min) t)
1372 (setq total (read-from-string
1373 (buffer-substring-no-properties
1374 (match-end 0) (line-end-position))))
1375 (when (search-backward " in sequence " (point-min) t)
1376 (setq p (point))
1377 (when (search-backward " has " (point-min) t)
1378 (setq unseen (read-from-string (buffer-substring-no-properties
1379 (match-end 0) p)))
3d7ca223 1380 (while (eq (char-after) ? )
c3d9274a
BW
1381 (backward-char))
1382 (setq folder (buffer-substring-no-properties
1383 (point-min) (1+ (point))))
3d7ca223
BW
1384 (when (and (equal (aref folder (1- (length folder))) ?+)
1385 (equal current-folder folder))
1386 (setq folder (substring folder 0 (1- (length folder)))))
c3d9274a
BW
1387 (values (format "+%s" folder) (car unseen) (car total))))))))
1388
a66894d8 1389(defun mh-folder-size-folder (folder)
5a4aad03 1390 "Find size of FOLDER using \"folder\"."
a66894d8
BW
1391 (with-temp-buffer
1392 (let ((u (length (cdr (assoc mh-unseen-seq
1393 (mh-read-folder-sequences folder nil))))))
1394 (call-process (expand-file-name "folder" mh-progs) nil t nil
1395 "-norecurse" folder)
1396 (goto-char (point-min))
1397 (if (re-search-forward " has \\([0-9]+\\) " nil t)
1398 (values (car (read-from-string (match-string 1))) u folder)
1399 (values 0 u folder)))))
1400
1401(defun mh-folder-size-flist (folder)
5a4aad03 1402 "Find size of FOLDER using \"flist\"."
c3d9274a 1403 (with-temp-buffer
f0d73c14 1404 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
3d7ca223 1405 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
c3d9274a 1406 (goto-char (point-min))
924df208 1407 (multiple-value-bind (folder unseen total)
c3d9274a
BW
1408 (mh-parse-flist-output-line
1409 (buffer-substring (point) (line-end-position)))
924df208 1410 (values total unseen folder))))
c3d9274a 1411
a66894d8
BW
1412(defun mh-folder-size (folder)
1413 "Find size of FOLDER."
1414 (if mh-flists-present-flag
1415 (mh-folder-size-flist folder)
1416 (mh-folder-size-folder folder)))
1417
c3d9274a 1418(defun mh-visit-folder (folder &optional range index-data)
2be362c2
BW
1419 "Visit FOLDER.
1420
2dcf34f9
BW
1421When you want to read the messages that you have refiled into folders,
1422use this command to visit the folder. You are prompted for the folder
1423name.
2be362c2 1424
2dcf34f9
BW
1425The folder buffer will show just unseen messages if there are any;
1426otherwise, it will show all the messages in the buffer as long there
1427are fewer than `mh-large-folder' messages. If there are more, then you
1428are prompted for a range of messages to scan.
2be362c2 1429
2dcf34f9
BW
1430You can provide a prefix argument in order to specify a RANGE of
1431messages to show when you visit the folder. In this case, regions are
1432not used to specify the range and `mh-large-folder' is ignored. Check
1433the documentation of `mh-interactive-range' to see how RANGE is read
1434in interactive use.
c3d9274a 1435
2dcf34f9
BW
1436Note that this command can also be used to create folders. If you
1437specify a folder that does not exist, you will be prompted to create
1438it.
c3d9274a 1439
2be362c2 1440Do not call this function from outside MH-E; use \\[mh-rmail] instead.
3d7ca223 1441
2dcf34f9
BW
1442If, in a program, RANGE is nil (the default), then all messages in
1443FOLDER are displayed. If an index buffer is being created then
1444INDEX-DATA is used to initialize the index buffer specific data
1445structures."
c3d9274a 1446 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
3d7ca223 1447 (list folder-name
a66894d8
BW
1448 (mh-read-range "Scan" folder-name t nil
1449 current-prefix-arg
1450 mh-interpret-number-as-range-flag))))
c3d9274a 1451 (let ((config (current-window-configuration))
924df208 1452 (current-buffer (current-buffer))
c3d9274a 1453 (threaded-view-flag mh-show-threads-flag))
f0d73c14 1454 (delete-other-windows)
c3d9274a
BW
1455 (save-excursion
1456 (when (get-buffer folder)
1457 (set-buffer folder)
924df208 1458 (setq threaded-view-flag (memq 'unthread mh-view-ops))))
c3d9274a
BW
1459 (when index-data
1460 (mh-make-folder folder)
1461 (setq mh-index-data (car index-data)
1462 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1463 mh-index-checksum-origin-map (make-hash-table :test #'equal))
a66894d8
BW
1464 (mh-index-update-maps folder (cadr index-data))
1465 (mh-index-create-sequences))
c26cf6c8 1466 (mh-scan-folder folder (or range "all"))
c3d9274a
BW
1467 (cond ((and threaded-view-flag
1468 (save-excursion
1469 (goto-char (point-min))
1470 (or (null mh-large-folder)
a66894d8 1471 (not (equal (forward-line (1+ mh-large-folder)) 0))
c3d9274a
BW
1472 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1473 nil))))
1474 (mh-toggle-threads))
1475 (mh-index-data
1476 (mh-index-insert-folder-headers)))
924df208
BW
1477 (unless (eq current-buffer (current-buffer))
1478 (setq mh-previous-window-config config)))
c26cf6c8
RS
1479 nil)
1480
847b8219 1481(defun mh-update-sequences ()
be33fce4 1482 "Flush MH-E's state out to MH.
2dcf34f9
BW
1483
1484This function updates the sequence specified by your
1485\"Unseen-Sequence:\" profile component, \"cur\", and the sequence
1486listed by the `mh-tick-seq' option which is \"tick\" by default.
1487The message at the cursor is used for \"cur\"."
847b8219
KH
1488 (interactive)
1489 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
bdcfe844 1490 ;; which updates MH-E's state from MH.
847b8219 1491 (let ((folder-set (mh-update-unseen))
c3d9274a 1492 (new-cur (mh-get-msg-num nil)))
847b8219 1493 (if new-cur
c3d9274a
BW
1494 (let ((seq-entry (mh-find-seq 'cur)))
1495 (mh-remove-cur-notation)
1496 (setcdr seq-entry
1497 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1498 (mh-define-sequence 'cur (list new-cur))
1499 (beginning-of-line)
1500 (if (looking-at mh-scan-good-msg-regexp)
3d7ca223 1501 (mh-notate-cur)))
847b8219 1502 (or folder-set
c3d9274a 1503 (save-excursion
a1b4049d
BW
1504 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1505 ;; So I added this sanity check.
1506 (if (stringp mh-current-folder)
1507 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
1508 (mh-exec-cmd-quiet t "folder" "-fast")))))))
847b8219 1509
c26cf6c8
RS
1510\f
1511
1512;;; Support routines.
1513
d1699462
BW
1514(defun mh-delete-a-msg (message)
1515 "Delete MESSAGE.
1516If MESSAGE is nil then the message at point is deleted.
2dcf34f9
BW
1517The hook `mh-delete-msg-hook' is called after you mark a message
1518for deletion. For example, a past maintainer of MH-E used this
1519once when he kept statistics on his mail usage."
c26cf6c8 1520 (save-excursion
d1699462
BW
1521 (if (numberp message)
1522 (mh-goto-msg message nil t)
3d7ca223 1523 (beginning-of-line)
d1699462 1524 (setq message (mh-get-msg-num t)))
a1b4049d 1525 (if (looking-at mh-scan-refiled-msg-regexp)
836f2863 1526 (error "Message %d is refiled; undo refile before deleting" message))
a1b4049d 1527 (if (looking-at mh-scan-deleted-msg-regexp)
c3d9274a
BW
1528 nil
1529 (mh-set-folder-modified-p t)
d1699462 1530 (setq mh-delete-list (cons message mh-delete-list))
3d7ca223 1531 (mh-notate nil mh-note-deleted mh-cmd-note)
c3d9274a 1532 (run-hooks 'mh-delete-msg-hook))))
c26cf6c8 1533
d1699462
BW
1534(defun mh-refile-a-msg (message folder)
1535 "Refile MESSAGE in FOLDER.
1536If MESSAGE is nil then the message at point is refiled.
bdcfe844 1537Folder is a symbol, not a string.
2dcf34f9
BW
1538The hook `mh-refile-msg-hook' is called after a message is marked to
1539be refiled."
c26cf6c8 1540 (save-excursion
d1699462
BW
1541 (if (numberp message)
1542 (mh-goto-msg message nil t)
3d7ca223 1543 (beginning-of-line)
d1699462 1544 (setq message (mh-get-msg-num t)))
a1b4049d 1545 (cond ((looking-at mh-scan-deleted-msg-regexp)
f9c53c97 1546 (error "Message %d is deleted; undo delete before moving" message))
c3d9274a
BW
1547 ((looking-at mh-scan-refiled-msg-regexp)
1548 (if (y-or-n-p
f9c53c97 1549 (format "Message %d already refiled; copy to %s as well? "
d1699462 1550 message folder))
c3d9274a
BW
1551 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1552 "-src" mh-current-folder
1553 (symbol-name folder))
f0d73c14 1554 (message "Message not copied")))
c3d9274a
BW
1555 (t
1556 (mh-set-folder-modified-p t)
1557 (cond ((null (assoc folder mh-refile-list))
d1699462
BW
1558 (push (list folder message) mh-refile-list))
1559 ((not (member message (cdr (assoc folder mh-refile-list))))
1560 (push message (cdr (assoc folder mh-refile-list)))))
3d7ca223 1561 (mh-notate nil mh-note-refiled mh-cmd-note)
c3d9274a 1562 (run-hooks 'mh-refile-msg-hook)))))
c26cf6c8 1563
924df208
BW
1564(defun mh-next-msg (&optional wait-after-complaining-flag)
1565 "Move backward or forward to the next undeleted message in the buffer.
2dcf34f9
BW
1566If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and
1567we are at the last message, then wait for a second after telling
1568the user that there aren't any more unread messages."
c26cf6c8 1569 (if (eq mh-next-direction 'forward)
924df208
BW
1570 (mh-next-undeleted-msg 1 wait-after-complaining-flag)
1571 (mh-previous-undeleted-msg 1 wait-after-complaining-flag)))
c3d9274a
BW
1572
1573(defun mh-next-unread-msg (&optional count)
553fb735
BW
1574 "Display next unread message.
1575
2dcf34f9
BW
1576This command can be given a prefix argument COUNT to specify how
1577many unread messages to skip."
c3d9274a
BW
1578 (interactive "p")
1579 (unless (> count 0)
f9c53c97 1580 (error "The function `mh-next-unread-msg' expects positive argument"))
c3d9274a
BW
1581 (setq count (1- count))
1582 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1583 (cur-msg (mh-get-msg-num nil)))
1584 (cond ((and (not cur-msg) (not (bobp))
1585 ;; If we are at the end of the buffer back up one line and go
1586 ;; to unread message after that.
1587 (progn
1588 (forward-line -1)
1589 (setq cur-msg (mh-get-msg-num nil)))
1590 nil))
1591 ((or (null unread-sequence) (not cur-msg))
1592 ;; No unread message or there aren't any messages in buffer...
1593 (message "No more unread messages"))
1594 ((progn
1595 ;; Skip messages
1596 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1597 (setq unread-sequence (cdr unread-sequence)))
1598 (while (> count 0)
1599 (setq unread-sequence (cdr unread-sequence))
1600 (setq count (1- count)))
1601 (not (car unread-sequence)))
1602 (message "No more unread messages"))
f0d73c14
BW
1603 (t (loop for msg in unread-sequence
1604 when (mh-goto-msg msg t) return nil
1605 finally (message "No more unread messages"))))))
c26cf6c8 1606
c26cf6c8 1607(defun mh-set-scan-mode ()
bdcfe844 1608 "Display the scan listing buffer, but do not show a message."
c26cf6c8
RS
1609 (if (get-buffer mh-show-buffer)
1610 (delete-windows-on mh-show-buffer))
a1b4049d 1611 (mh-showing-mode 0)
dc9bdc98 1612 (force-mode-line-update)
bdcfe844 1613 (if mh-recenter-summary-flag
c26cf6c8
RS
1614 (mh-recenter nil)))
1615
c26cf6c8 1616(defun mh-undo-msg (msg)
3d7ca223
BW
1617 "Undo the deletion or refile of one MSG.
1618If MSG is nil then act on the message at point"
1619 (save-excursion
1620 (if (numberp msg)
1621 (mh-goto-msg msg t t)
1622 (beginning-of-line)
1623 (setq msg (mh-get-msg-num t)))
1624 (cond ((memq msg mh-delete-list)
1625 (setq mh-delete-list (delq msg mh-delete-list)))
1626 (t
1627 (dolist (folder-msg-list mh-refile-list)
1628 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1629 (setq mh-refile-list (loop for x in mh-refile-list
1630 unless (null (cdr x)) collect x))))
1631 (mh-notate nil ? mh-cmd-note)))
c26cf6c8 1632
c26cf6c8
RS
1633\f
1634
1635;;; The folder data abstraction.
1636
a66894d8
BW
1637(defvar mh-index-data-file ".mhe_index"
1638 "MH-E specific file where index seach info is stored.")
1639
c26cf6c8 1640(defun mh-make-folder (name)
bdcfe844
BW
1641 "Create a new mail folder called NAME.
1642Make it the current folder."
c26cf6c8
RS
1643 (switch-to-buffer name)
1644 (setq buffer-read-only nil)
1645 (erase-buffer)
bdcfe844 1646 (if mh-adaptive-cmd-note-flag
50df64d6 1647 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width name))))
c26cf6c8
RS
1648 (setq buffer-read-only t)
1649 (mh-folder-mode)
1650 (mh-set-folder-modified-p nil)
847b8219 1651 (setq buffer-file-name mh-folder-filename)
a66894d8
BW
1652 (when (and (not mh-index-data)
1653 (file-exists-p (concat buffer-file-name mh-index-data-file)))
1654 (mh-index-read-data))
847b8219 1655 (mh-make-folder-mode-line))
c26cf6c8 1656
cee9f5c6 1657;; Ensure new buffers won't get this mode if default-major-mode is nil.
c26cf6c8
RS
1658(put 'mh-folder-mode 'mode-class 'special)
1659
bdcfe844
BW
1660\f
1661
cee9f5c6
BW
1662;;; Build mh-folder-mode menu
1663
1664;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1665;; Menus for folder mode: folder, message, sequence (in that order)
1666;; folder-mode "Sequence" menu
bdcfe844
BW
1667(easy-menu-define
1668 mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
1669 '("Sequence"
1670 ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
1671 ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
1672 ["Delete Message from Sequence..." mh-delete-msg-from-seq
1673 (mh-get-msg-num nil)]
1674 ["List Sequences in Folder..." mh-list-sequences t]
1675 ["Delete Sequence..." mh-delete-seq t]
1676 ["Narrow to Sequence..." mh-narrow-to-seq t]
a66894d8 1677 ["Widen from Sequence" mh-widen mh-folder-view-stack]
bdcfe844
BW
1678 "--"
1679 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
924df208
BW
1680 ["Narrow to Tick Sequence" mh-narrow-to-tick
1681 (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))]
bdcfe844 1682 ["Delete Rest of Same Subject" mh-delete-subject t]
924df208 1683 ["Toggle Tick Mark" mh-toggle-tick t]
bdcfe844
BW
1684 "--"
1685 ["Push State Out to MH" mh-update-sequences t]))
1686
cee9f5c6 1687;; folder-mode "Message" menu
bdcfe844
BW
1688(easy-menu-define
1689 mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
1690 '("Message"
1691 ["Show Message" mh-show (mh-get-msg-num nil)]
1692 ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
1693 ["Next Message" mh-next-undeleted-msg t]
1694 ["Previous Message" mh-previous-undeleted-msg t]
1695 ["Go to First Message" mh-first-msg t]
1696 ["Go to Last Message" mh-last-msg t]
1697 ["Go to Message by Number..." mh-goto-msg t]
f0d73c14 1698 ["Modify Message" mh-modify t]
bdcfe844
BW
1699 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
1700 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
f0d73c14
BW
1701 ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
1702 ["Execute Delete/Refile" mh-execute-commands
1703 (mh-outstanding-commands-p)]
bdcfe844
BW
1704 "--"
1705 ["Compose a New Message" mh-send t]
1706 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
1707 ["Forward Message..." mh-forward (mh-get-msg-num nil)]
1708 ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
1709 ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
1710 ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
1711 "--"
1712 ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
1713 ["Print Message" mh-print-msg (mh-get-msg-num nil)]
1714 ["Write Message to File..." mh-write-msg-to-file
1715 (mh-get-msg-num nil)]
1716 ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
1717 ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
1718 ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
1719
cee9f5c6 1720;; folder-mode "Folder" menu
bdcfe844
BW
1721(easy-menu-define
1722 mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
1723 '("Folder"
1724 ["Incorporate New Mail" mh-inc-folder t]
1725 ["Toggle Show/Folder" mh-toggle-showing t]
1726 ["Execute Delete/Refile" mh-execute-commands
f0d73c14 1727 (mh-outstanding-commands-p)]
bdcfe844
BW
1728 ["Rescan Folder" mh-rescan-folder t]
1729 ["Thread Folder" mh-toggle-threads
1730 (not (memq 'unthread mh-view-ops))]
1731 ["Pack Folder" mh-pack-folder t]
1732 ["Sort Folder" mh-sort-folder t]
1733 "--"
1734 ["List Folders" mh-list-folders t]
1735 ["Visit a Folder..." mh-visit-folder t]
924df208 1736 ["View New Messages" mh-index-new-messages t]
bdcfe844
BW
1737 ["Search a Folder..." mh-search-folder t]
1738 ["Indexed Search..." mh-index-search t]
1739 "--"
1740 ["Quit MH-E" mh-quit t]))
1741
1742\f
1743
bdcfe844
BW
1744(defmacro mh-remove-xemacs-horizontal-scrollbar ()
1745 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1746 (when mh-xemacs-flag
1747 `(if (and (featurep 'scrollbar)
1748 (fboundp 'set-specifier))
1749 (set-specifier horizontal-scrollbar-visible-p nil
1750 (cons (current-buffer) nil)))))
1751
1752(defmacro mh-write-file-functions-compat ()
1753 "Return `write-file-functions' if it exists.
2dcf34f9
BW
1754Otherwise return `local-write-file-hooks'. This macro exists
1755purely for compatibility. The former symbol is used in Emacs 21.4
1756onward while the latter is used in previous versions and XEmacs."
bdcfe844 1757 (if (boundp 'write-file-functions)
c3d9274a 1758 ''write-file-functions ;Emacs 21.4
6eb83a35 1759 ''local-write-file-hooks)) ;XEmacs
bdcfe844 1760
f0d73c14
BW
1761;; Register mh-folder-mode as supporting which-function-mode...
1762(load "which-func" t t)
1763(when (and (boundp 'which-func-modes)
1764 (not (member 'mh-folder-mode which-func-modes)))
1765 (push 'mh-folder-mode which-func-modes))
1766
6eb83a35 1767;; Shush compiler.
7094eefe 1768(eval-when-compile
6eb83a35
BW
1769 (defvar desktop-save-buffer)
1770 (defvar font-lock-auto-fontify))
7094eefe 1771
1dd9796d
SD
1772(defvar mh-folder-buttons-init-flag nil)
1773
e6de37c5
LH
1774;; Autoload cookie needed by desktop.el
1775;;;###autoload
a1b4049d 1776(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
bdcfe844 1777 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
a1b4049d 1778
2dcf34f9
BW
1779You can show the message the cursor is pointing to, and step through
1780the messages. Messages can be marked for deletion or refiling into
1781another folder; these commands are executed all at once with a
1782separate command.
c26cf6c8 1783
2dcf34f9
BW
1784Options that control this mode can be changed with
1785\\[customize-group]; specify the \"mh\" group. In particular, please
1786see the `mh-scan-format-file' option if you wish to modify scan's
1787format.
c26cf6c8 1788
a1b4049d 1789When a folder is visited, the hook `mh-folder-mode-hook' is run.
c26cf6c8 1790
f0d73c14
BW
1791Ranges
1792======
2dcf34f9
BW
1793Many commands that operate on individual messages, such as
1794`mh-forward' or `mh-refile-msg' take a RANGE argument. This argument
1795can be used in several ways.
f0d73c14 1796
2dcf34f9
BW
1797If you provide the prefix argument (\\[universal-argument]) to
1798these commands, then you will be prompted for the message range.
1799This can be any valid MH range which can include messages,
1800sequences, and the abbreviations (described in the mh(1) man
1801page):
f0d73c14
BW
1802
1803<num1>-<num2>
2dcf34f9
BW
1804 Indicates all messages in the range <num1> to <num2>, inclusive.
1805 The range must be nonempty.
f0d73c14 1806
5a4aad03
BW
1807<num>:N
1808<num>:+N
1809<num>:-N
2dcf34f9
BW
1810 Up to N messages beginning with (or ending with) message num. Num
1811 may be any of the predefined symbols: first, prev, cur, next or
1812 last.
f0d73c14 1813
5a4aad03
BW
1814first:N
1815prev:N
1816next:N
1817last:N
f0d73c14
BW
1818 The first, previous, next or last messages, if they exist.
1819
5a4aad03 1820all
f0d73c14
BW
1821 All of the messages.
1822
2dcf34f9
BW
1823For example, a range that shows all of these things is `1 2 3
18245-10 last:5 unseen'.
f0d73c14 1825
2dcf34f9
BW
1826If the option `transient-mark-mode' is set to t and you set a
1827region in the MH-Folder buffer, then the MH-E command will
1828perform the operation on all messages in that region.
f0d73c14 1829
a1b4049d 1830\\{mh-folder-mode-map}"
1dd9796d
SD
1831 (mh-do-in-gnu-emacs
1832 (unless mh-folder-buttons-init-flag
1833 (mh-tool-bar-folder-buttons-init)
1834 (setq mh-folder-buttons-init-flag t)))
a1b4049d 1835 (make-local-variable 'font-lock-defaults)
c3d9274a 1836 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1983467e
LH
1837 (make-local-variable 'desktop-save-buffer)
1838 (setq desktop-save-buffer t)
847b8219 1839 (mh-make-local-vars
f0d73c14
BW
1840 'mh-colors-available-flag (mh-colors-available-p)
1841 ; Do we have colors available
c3d9274a 1842 'mh-current-folder (buffer-name) ; Name of folder, a string
c26cf6c8 1843 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
c3d9274a 1844 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
c26cf6c8 1845 (file-name-as-directory (mh-expand-file-name (buffer-name)))
f0d73c14
BW
1846 'mh-display-buttons-for-inline-parts-flag
1847 mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
1848 ; be toggled.
3d7ca223
BW
1849 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
1850 'overlay-arrow-position nil ; Allow for simultaneous display in
1851 'overlay-arrow-string ">" ; different MH-E buffers.
c3d9274a
BW
1852 'mh-showing-mode nil ; Show message also?
1853 'mh-delete-list nil ; List of msgs nums to delete
1854 'mh-refile-list nil ; List of folder names in mh-seq-list
1855 'mh-seq-list nil ; Alist of (seq . msgs) nums
1856 'mh-seen-list nil ; List of displayed messages
1857 'mh-next-direction 'forward ; Direction to move to next message
bdcfe844
BW
1858 'mh-view-ops () ; Stack that keeps track of the order
1859 ; in which narrowing/threading has been
1860 ; carried out.
a66894d8
BW
1861 'mh-folder-view-stack () ; Stack of previous views of the
1862 ; folder.
c3d9274a
BW
1863 'mh-index-data nil ; If the folder was created by a call
1864 ; to mh-index-search this contains info
1865 ; about the search results.
1866 'mh-index-previous-search nil ; Previous folder and search-regexp
1867 'mh-index-msg-checksum-map nil ; msg -> checksum map
1868 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
a66894d8 1869 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
c3d9274a
BW
1870 'mh-first-msg-num nil ; Number of first msg in buffer
1871 'mh-last-msg-num nil ; Number of last msg in buffer
1872 'mh-msg-count nil ; Number of msgs in buffer
1873 'mh-mode-line-annotation nil ; Indicates message range
a66894d8
BW
1874 'mh-sequence-notation-history (make-hash-table)
1875 ; Remember what is overwritten by
1876 ; mh-note-seq.
f0d73c14
BW
1877 'imenu-create-index-function 'mh-index-create-imenu-index
1878 ; Setup imenu support
c3d9274a 1879 'mh-previous-window-config nil) ; Previous window configuration
bdcfe844 1880 (mh-remove-xemacs-horizontal-scrollbar)
c26cf6c8
RS
1881 (setq truncate-lines t)
1882 (auto-save-mode -1)
1883 (setq buffer-offer-save t)
924df208 1884 (mh-make-local-hook (mh-write-file-functions-compat))
bdcfe844 1885 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
c26cf6c8 1886 (make-local-variable 'revert-buffer-function)
c3d9274a 1887 (make-local-variable 'hl-line-mode) ; avoid pollution
924df208 1888 (mh-funcall-if-exists hl-line-mode 1)
c26cf6c8 1889 (setq revert-buffer-function 'mh-undo-folder)
a1b4049d 1890 (or (assq 'mh-showing-mode minor-mode-alist)
c26cf6c8 1891 (setq minor-mode-alist
c3d9274a 1892 (cons '(mh-showing-mode " Show") minor-mode-alist)))
a1b4049d
BW
1893 (easy-menu-add mh-folder-sequence-menu)
1894 (easy-menu-add mh-folder-message-menu)
1895 (easy-menu-add mh-folder-folder-menu)
a66894d8 1896 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
fa4075e3 1897 (mh-funcall-if-exists mh-tool-bar-init :folder)
bdcfe844 1898 (if (and mh-xemacs-flag
c3d9274a
BW
1899 font-lock-auto-fontify)
1900 (turn-on-font-lock))) ; Force font-lock in XEmacs.
c26cf6c8 1901
f0d73c14 1902(defun mh-toggle-mime-buttons ()
553fb735 1903 "Toggle option `mh-display-buttons-for-inline-parts-flag'."
f0d73c14
BW
1904 (interactive)
1905 (setq mh-display-buttons-for-inline-parts-flag
1906 (not mh-display-buttons-for-inline-parts-flag))
1907 (mh-show nil t))
1908
1909(defun mh-colors-available-p ()
1910 "Check if colors are available in the Emacs being used."
1911 (or mh-xemacs-flag
7094eefe 1912 (let ((color-cells (display-color-cells)))
f0d73c14
BW
1913 (and (numberp color-cells) (>= color-cells 8)))))
1914
1915(defun mh-colors-in-use-p ()
1916 "Check if colors are being used in the folder buffer."
1917 (and mh-colors-available-flag font-lock-mode))
1918
847b8219 1919(defun mh-make-local-vars (&rest pairs)
bdcfe844
BW
1920 "Initialize local variables according to the variable-value PAIRS."
1921
c26cf6c8 1922 (while pairs
1e495fc7 1923 (set (make-local-variable (car pairs)) (car (cdr pairs)))
c26cf6c8
RS
1924 (setq pairs (cdr (cdr pairs)))))
1925
a66894d8
BW
1926(defun mh-restore-desktop-buffer (desktop-buffer-file-name
1927 desktop-buffer-name
1928 desktop-buffer-misc)
f0d73c14 1929 "Restore an MH folder buffer specified in a desktop file.
2dcf34f9
BW
1930When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the
1931file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer
1932name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info
1933used by the `desktop-buffer-handlers' functions."
a66894d8
BW
1934 (mh-find-path)
1935 (mh-visit-folder desktop-buffer-name)
1936 (current-buffer))
1937
cee9f5c6 1938;; desktop-buffer-mode-handlers appeared in Emacs 22.
a05fcb7d
BW
1939(if (fboundp 'desktop-buffer-mode-handlers)
1940 (add-to-list 'desktop-buffer-mode-handlers
1941 '(mh-folder-mode . mh-restore-desktop-buffer)))
e6de37c5 1942
bdcfe844 1943(defun mh-scan-folder (folder range &optional dont-exec-pending)
2be362c2
BW
1944 "Scan FOLDER over RANGE.
1945
2dcf34f9
BW
1946After the scan is performed, switch to the buffer associated with
1947FOLDER.
2be362c2 1948
2dcf34f9
BW
1949Check the documentation of `mh-interactive-range' to see how RANGE is
1950read in interactive use.
2be362c2 1951
2dcf34f9
BW
1952The processing of outstanding commands is not performed if
1953DONT-EXEC-PENDING is non-nil."
f0d73c14
BW
1954 (when (stringp range)
1955 (setq range (delete "" (split-string range "[ \t\n]"))))
c26cf6c8 1956 (cond ((null (get-buffer folder))
c3d9274a
BW
1957 (mh-make-folder folder))
1958 (t
924df208
BW
1959 (unless dont-exec-pending
1960 (mh-process-or-undo-commands folder)
1961 (mh-reset-threads-and-narrowing))
c3d9274a 1962 (switch-to-buffer folder)))
c26cf6c8 1963 (mh-regenerate-headers range)
a1b4049d 1964 (if (zerop (buffer-size))
bdcfe844 1965 (if (equal range "all")
c3d9274a
BW
1966 (message "Folder %s is empty" folder)
1967 (message "No messages in %s, range %s" folder range))
bdcfe844 1968 (mh-goto-cur-msg))
924df208 1969 (when (mh-outstanding-commands-p)
3d7ca223 1970 (mh-notate-deleted-and-refiled)))
c26cf6c8 1971
50df64d6
BW
1972(defun mh-msg-num-width-to-column (width)
1973 "Return the column for notations given message number WIDTH.
1974Note that columns in Emacs start with 0.
1975
2dcf34f9
BW
1976If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this
1977means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are
1978in use. This function therefore assumes that the first column is
1979empty (to provide room for the cursor), the following WIDTH
1980columns contain the message number, and the column for notations
1981comes after that."
50df64d6
BW
1982 (if (eq mh-scan-format-file t)
1983 (max (1+ width) 2)
f9c53c97
BW
1984 (error "%s %s" "Can't call `mh-msg-num-width-to-column' when"
1985 "`mh-scan-format-file' is not set to \"Use MH-E scan Format\"")))
50df64d6
BW
1986
1987(defun mh-set-cmd-note (column)
1988 "Set `mh-cmd-note' to COLUMN.
e069fa61 1989Note that columns in Emacs start with 0."
50df64d6 1990 (setq mh-cmd-note column))
c3d9274a 1991
847b8219 1992(defun mh-regenerate-headers (range &optional update)
2be362c2 1993 "Scan folder over RANGE.
bdcfe844 1994If UPDATE, append the scan lines, otherwise replace."
847b8219 1995 (let ((folder mh-current-folder)
bdcfe844 1996 (range (if (and range (atom range)) (list range) range))
c3d9274a 1997 scan-start)
c26cf6c8 1998 (message "Scanning %s..." folder)
a66894d8 1999 (mh-remove-all-notation)
c26cf6c8 2000 (with-mh-folder-updating (nil)
847b8219 2001 (if update
c3d9274a
BW
2002 (goto-char (point-max))
2003 (delete-region (point-min) (point-max))
2004 (if mh-adaptive-cmd-note-flag
50df64d6
BW
2005 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width
2006 folder)))))
847b8219 2007 (setq scan-start (point))
bdcfe844
BW
2008 (apply #'mh-exec-cmd-output
2009 mh-scan-prog nil
2010 (mh-scan-format)
2011 "-noclear" "-noheader"
2012 "-width" (window-width)
2013 folder range)
847b8219 2014 (goto-char scan-start)
c26cf6c8 2015 (cond ((looking-at "scan: no messages in")
c3d9274a 2016 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
f0d73c14
BW
2017 ((looking-at (if (mh-variant-p 'mu-mh)
2018 "scan: message set .* does not exist"
2019 "scan: bad message list "))
c3d9274a
BW
2020 (keep-lines mh-scan-valid-regexp))
2021 ((looking-at "scan: ")) ; Keep error messages
2022 (t
2023 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
c26cf6c8
RS
2024 (setq mh-seq-list (mh-read-folder-sequences folder nil))
2025 (mh-notate-user-sequences)
847b8219 2026 (or update
c3d9274a
BW
2027 (setq mh-mode-line-annotation
2028 (if (equal range '("all"))
2029 nil
2030 mh-partial-folder-mode-line-annotation)))
847b8219 2031 (mh-make-folder-mode-line))
c26cf6c8
RS
2032 (message "Scanning %s...done" folder)))
2033
bdcfe844
BW
2034(defun mh-generate-new-cmd-note (folder)
2035 "Fix the `mh-cmd-note' value for this FOLDER.
2036
2037After doing an `mh-get-new-mail' operation in this FOLDER, at least
2038one line that looks like a truncated message number was found.
2039
2dcf34f9
BW
2040Remove the text added by the last `mh-inc' command. It should be the
2041messages cur-last. Call `mh-set-cmd-note', adjusting the notation
2042column with the width of the largest message number in FOLDER.
bdcfe844
BW
2043
2044Reformat the message number width on each line in the buffer and trim
2045the line length to fit in the window.
2046
2047Rescan the FOLDER in the range cur-last in order to display the
2048messages that were removed earlier. They should all fit in the scan
2049line now with no message truncation."
2050 (save-excursion
2051 (let ((maxcol (1- (window-width)))
2052 (old-cmd-note mh-cmd-note)
c3d9274a
BW
2053 mh-cmd-note-fmt
2054 msgnum)
bdcfe844
BW
2055 ;; Nuke all of the lines just added by the last inc
2056 (delete-char (- (point-max) (point)))
2057 ;; Update the current buffer to reflect the new mh-cmd-note
2058 ;; value needed to display messages.
50df64d6 2059 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width folder)))
bdcfe844
BW
2060 (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
2061 ;; Cleanup the messages that are in the buffer right now
2062 (goto-char (point-min))
2063 (cond ((memq 'unthread mh-view-ops)
2064 (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
2065 (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
2066 ;; reformat the number to fix in mh-cmd-note columns
2067 (setq msgnum (string-to-number
2068 (buffer-substring
2069 (match-beginning 1) (match-end 1))))
2070 (replace-match (format mh-cmd-note-fmt msgnum))
2071 ;; trim the line to fix in the window
2072 (end-of-line)
2073 (let ((eol (point)))
2074 (move-to-column maxcol)
2075 (if (<= (point) eol)
c3d9274a 2076 (delete-char (- eol (point))))))))
bdcfe844
BW
2077 ;; now re-read the lost messages
2078 (goto-char (point-max))
2079 (prog1 (point)
2080 (mh-regenerate-headers "cur-last" t)))))
c26cf6c8
RS
2081
2082(defun mh-get-new-mail (maildrop-name)
bdcfe844
BW
2083 "Read new mail from MAILDROP-NAME into the current buffer.
2084Return in the current buffer."
c26cf6c8 2085 (let ((point-before-inc (point))
c3d9274a
BW
2086 (folder mh-current-folder)
2087 (new-mail-flag nil))
c26cf6c8 2088 (with-mh-folder-updating (t)
f965c3d7 2089 (if maildrop-name
c3d9274a
BW
2090 (message "inc %s -file %s..." folder maildrop-name)
2091 (message "inc %s..." folder))
c26cf6c8
RS
2092 (setq mh-next-direction 'forward)
2093 (goto-char (point-max))
e495eaec 2094 (mh-remove-cur-notation)
c26cf6c8 2095 (let ((start-of-inc (point)))
c3d9274a
BW
2096 (if maildrop-name
2097 ;; I think MH 5 used "-ms-file" instead of "-file",
2098 ;; which would make inc'ing from maildrops fail.
2099 (mh-exec-cmd-output mh-inc-prog nil folder
2100 (mh-scan-format)
2101 "-file" (expand-file-name maildrop-name)
2102 "-width" (window-width)
2103 "-truncate")
bdcfe844
BW
2104 (mh-exec-cmd-output mh-inc-prog nil
2105 (mh-scan-format)
2106 "-width" (window-width)))
c3d9274a
BW
2107 (if maildrop-name
2108 (message "inc %s -file %s...done" folder maildrop-name)
2109 (message "inc %s...done" folder))
2110 (goto-char start-of-inc)
2111 (cond ((save-excursion
2112 (re-search-forward "^inc: no mail" nil t))
2113 (message "No new mail%s%s" (if maildrop-name " in " "")
2114 (if maildrop-name maildrop-name "")))
a66894d8 2115 ((and (when mh-folder-view-stack
bdcfe844
BW
2116 (let ((saved-text (buffer-substring-no-properties
2117 start-of-inc (point-max))))
2118 (delete-region start-of-inc (point-max))
a66894d8 2119 (unwind-protect (mh-widen t)
e495eaec 2120 (mh-remove-cur-notation)
bdcfe844
BW
2121 (goto-char (point-max))
2122 (setq start-of-inc (point))
2123 (insert saved-text)
2124 (goto-char start-of-inc))))
2125 nil))
2126 ((re-search-forward "^inc:" nil t) ; Error messages
c3d9274a
BW
2127 (error "Error incorporating mail"))
2128 ((and
2129 (equal mh-scan-format-file t)
2130 mh-adaptive-cmd-note-flag
2131 ;; Have we reached an edge condition?
2132 (save-excursion
2133 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
2134 (setq start-of-inc (mh-generate-new-cmd-note folder))
2135 nil))
2136 (t
2137 (setq new-mail-flag t)))
2138 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
e495eaec
BW
2139 (let* ((sequences (mh-read-folder-sequences folder t))
2140 (new-cur (assoc 'cur sequences))
2141 (new-unseen (assoc mh-unseen-seq sequences)))
2142 (unless (assoc 'cur mh-seq-list)
2143 (push (list 'cur) mh-seq-list))
2144 (unless (assoc mh-unseen-seq mh-seq-list)
2145 (push (list mh-unseen-seq) mh-seq-list))
2146 (setcdr (assoc 'cur mh-seq-list) (cdr new-cur))
2147 (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen)))
c3d9274a 2148 (when (equal (point-max) start-of-inc)
3d7ca223 2149 (mh-notate-cur))
c3d9274a
BW
2150 (if new-mail-flag
2151 (progn
2152 (mh-make-folder-mode-line)
924df208
BW
2153 (when (mh-speed-flists-active-p)
2154 (mh-speed-flists t mh-current-folder))
bdcfe844
BW
2155 (when (memq 'unthread mh-view-ops)
2156 (mh-thread-inc folder start-of-inc))
c3d9274a 2157 (mh-goto-cur-msg))
a66894d8 2158 (goto-char point-before-inc))
e495eaec 2159 (mh-notate-user-sequences (cons start-of-inc (point-max)))))))
c26cf6c8 2160
847b8219 2161(defun mh-make-folder-mode-line (&optional ignored)
bdcfe844 2162 "Set the fields of the mode line for a folder buffer.
2dcf34f9
BW
2163The optional argument is now obsolete and IGNORED. It used to be
2164used to pass in what is now stored in the buffer-local variable
2165`mh-mode-line-annotation'."
c26cf6c8 2166 (save-excursion
bdcfe844
BW
2167 (save-window-excursion
2168 (mh-first-msg)
2169 (let ((new-first-msg-num (mh-get-msg-num nil)))
c3d9274a
BW
2170 (when (or (not (memq 'unthread mh-view-ops))
2171 (null mh-first-msg-num)
2172 (null new-first-msg-num)
2173 (< new-first-msg-num mh-first-msg-num))
2174 (setq mh-first-msg-num new-first-msg-num)))
bdcfe844
BW
2175 (mh-last-msg)
2176 (let ((new-last-msg-num (mh-get-msg-num nil)))
c3d9274a
BW
2177 (when (or (not (memq 'unthread mh-view-ops))
2178 (null mh-last-msg-num)
2179 (null new-last-msg-num)
2180 (> new-last-msg-num mh-last-msg-num))
2181 (setq mh-last-msg-num new-last-msg-num)))
bdcfe844 2182 (setq mh-msg-count (if mh-first-msg-num
c3d9274a
BW
2183 (count-lines (point-min) (point-max))
2184 0))
bdcfe844 2185 (setq mode-line-buffer-identification
3d7ca223 2186 (list (format " {%%b%s} %s msg%s"
c3d9274a
BW
2187 (if mh-mode-line-annotation
2188 (format "/%s" mh-mode-line-annotation)
2189 "")
2190 (if (zerop mh-msg-count)
2191 "no"
2192 (format "%d" mh-msg-count))
2193 (if (zerop mh-msg-count)
2194 "s"
2195 (cond ((> mh-msg-count 1)
2196 (format "s (%d-%d)" mh-first-msg-num
2197 mh-last-msg-num))
2198 (mh-first-msg-num
2199 (format " (%d)" mh-first-msg-num))
3d7ca223
BW
2200 (""))))))
2201 (mh-logo-display))))
c26cf6c8 2202
a66894d8
BW
2203(defun mh-add-sequence-notation (msg internal-seq-flag)
2204 "Add sequence notation to the MSG on the current line.
2dcf34f9
BW
2205If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if
2206font-lock is turned on."
a66894d8
BW
2207 (with-mh-folder-updating (t)
2208 (save-excursion
2209 (beginning-of-line)
2210 (if internal-seq-flag
f0d73c14
BW
2211 (progn
2212 ;; Change the buffer so that if transient-mark-mode is active
2213 ;; and there is an active region it will get deactivated as in
2214 ;; the case of user sequences.
2215 (mh-notate nil nil mh-cmd-note)
2216 (when font-lock-mode
2217 (font-lock-fontify-region (point) (line-end-position))))
50df64d6 2218 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
a66894d8
BW
2219 (let ((stack (gethash msg mh-sequence-notation-history)))
2220 (setf (gethash msg mh-sequence-notation-history)
2221 (cons (char-after) stack)))
50df64d6
BW
2222 (mh-notate nil mh-note-seq
2223 (+ mh-cmd-note mh-scan-field-destination-offset))))))
a66894d8
BW
2224
2225(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
2226 "Remove sequence notation from the MSG on the current line.
2dcf34f9
BW
2227If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to
2228highlight the sequence. In that case, no notation needs to be removed.
2229Otherwise the effect of inserting `mh-note-seq' needs to be reversed.
2230If ALL is non-nil, then all sequence marks on the scan line are
2231removed."
a66894d8
BW
2232 (with-mh-folder-updating (t)
2233 ;; This takes care of internal sequences...
2234 (mh-notate nil nil mh-cmd-note)
2235 (unless internal-seq-flag
2236 ;; ... and this takes care of user sequences.
2237 (let ((stack (gethash msg mh-sequence-notation-history)))
2238 (while (and all (cdr stack))
2239 (setq stack (cdr stack)))
2240 (when stack
f0d73c14
BW
2241 (save-excursion
2242 (beginning-of-line)
50df64d6 2243 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
f0d73c14
BW
2244 (delete-char 1)
2245 (insert (car stack))))
a66894d8
BW
2246 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
2247
847b8219 2248(defun mh-remove-cur-notation ()
bdcfe844 2249 "Remove old cur notation."
847b8219
KH
2250 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
2251 (save-excursion
3d7ca223
BW
2252 (when (and cur-msg
2253 (mh-goto-msg cur-msg t t)
2254 (looking-at mh-scan-cur-msg-number-regexp))
2255 (mh-notate nil ? mh-cmd-note)
2256 (setq overlay-arrow-position nil)))))
847b8219 2257
bdcfe844
BW
2258(defun mh-remove-all-notation ()
2259 "Remove all notations on all scan lines that MH-E introduces."
2260 (save-excursion
3d7ca223 2261 (setq overlay-arrow-position nil)
bdcfe844 2262 (goto-char (point-min))
a66894d8
BW
2263 (mh-iterate-on-range msg (cons (point-min) (point-max))
2264 (mh-notate nil ? mh-cmd-note)
2265 (mh-remove-sequence-notation msg nil t))
2266 (clrhash mh-sequence-notation-history)))
bdcfe844
BW
2267
2268(defun mh-goto-cur-msg (&optional minimal-changes-flag)
2269 "Position the cursor at the current message.
2dcf34f9
BW
2270When optional argument MINIMAL-CHANGES-FLAG is non-nil, the
2271function doesn't recenter the folder buffer."
c26cf6c8
RS
2272 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
2273 (cond ((and cur-msg
c3d9274a
BW
2274 (mh-goto-msg cur-msg t t))
2275 (unless minimal-changes-flag
3d7ca223 2276 (mh-notate-cur)
bdcfe844
BW
2277 (mh-recenter 0)
2278 (mh-maybe-show cur-msg)))
c3d9274a 2279 (t
3d7ca223 2280 (setq overlay-arrow-position nil)
c3d9274a 2281 (message "No current message")))))
c26cf6c8 2282
c26cf6c8 2283(defun mh-process-or-undo-commands (folder)
bdcfe844 2284 "If FOLDER has outstanding commands, then either process or discard them.
2dcf34f9
BW
2285Called by functions like `mh-sort-folder', so also invalidate
2286show buffer."
c26cf6c8
RS
2287 (set-buffer folder)
2288 (if (mh-outstanding-commands-p)
bdcfe844 2289 (if (or mh-do-not-confirm-flag
c3d9274a 2290 (y-or-n-p
924df208 2291 "Process outstanding deletes and refiles? "))
c3d9274a 2292 (mh-process-commands folder)
924df208 2293 (set-buffer folder)
c3d9274a 2294 (mh-undo-folder)))
c26cf6c8
RS
2295 (mh-update-unseen)
2296 (mh-invalidate-show-buffer))
2297
c26cf6c8 2298(defun mh-process-commands (folder)
bdcfe844 2299 "Process outstanding commands for FOLDER.
d1699462 2300
2dcf34f9
BW
2301This function runs `mh-before-commands-processed-hook' before the
2302commands are processed and `mh-after-commands-processed-hook'
2303after the commands are processed."
c26cf6c8
RS
2304 (message "Processing deletes and refiles for %s..." folder)
2305 (set-buffer folder)
2306 (with-mh-folder-updating (nil)
2953de8c
SG
2307 ;; Run the before hook -- the refile and delete lists are still valid
2308 (run-hooks 'mh-before-commands-processed-hook)
a1b4049d 2309
c26cf6c8
RS
2310 ;; Update the unseen sequence if it exists
2311 (mh-update-unseen)
2312
a66894d8
BW
2313 (let ((redraw-needed-flag mh-index-data)
2314 (folders-changed (list mh-current-folder))
2315 (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
2316 (mh-create-sequence-map mh-seq-list)))
2317 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
2318 (make-hash-table))))
c3d9274a
BW
2319 ;; Remove invalid scan lines if we are in an index folder and then remove
2320 ;; the real messages
2321 (when mh-index-data
2322 (mh-index-delete-folder-headers)
a66894d8
BW
2323 (setq folders-changed
2324 (append folders-changed (mh-index-execute-commands))))
c3d9274a 2325
bdcfe844
BW
2326 ;; Then refile messages
2327 (mh-mapc #'(lambda (folder-msg-list)
a66894d8
BW
2328 (let* ((dest-folder (symbol-name (car folder-msg-list)))
2329 (last (car (mh-translate-range dest-folder "last")))
2330 (msgs (cdr folder-msg-list)))
2331 (push dest-folder folders-changed)
bdcfe844
BW
2332 (setq redraw-needed-flag t)
2333 (apply #'mh-exec-cmd
2334 "refile" "-src" folder dest-folder
2335 (mh-coalesce-msg-list msgs))
a66894d8
BW
2336 (mh-delete-scan-msgs msgs)
2337 ;; Preserve sequences in destination folder...
e495eaec 2338 (when mh-refile-preserves-sequences-flag
a66894d8 2339 (clrhash dest-map)
e495eaec 2340 (loop for i from (1+ (or last 0))
a66894d8
BW
2341 for msg in (sort (copy-sequence msgs) #'<)
2342 do (loop for seq-name in (gethash msg seq-map)
2343 do (push i (gethash seq-name dest-map))))
2344 (maphash
2345 #'(lambda (seq msgs)
e495eaec
BW
2346 ;; Can't be run in the background, since the
2347 ;; current folder is changed by mark this could
2348 ;; lead to a race condition with the next refile.
2349 (apply #'mh-exec-cmd "mark"
a66894d8
BW
2350 "-sequence" (symbol-name seq) dest-folder
2351 "-add" (mapcar #'(lambda (x) (format "%s" x))
2352 (mh-coalesce-msg-list msgs))))
2353 dest-map))))
bdcfe844
BW
2354 mh-refile-list)
2355 (setq mh-refile-list ())
2356
2357 ;; Now delete messages
2358 (cond (mh-delete-list
2359 (setq redraw-needed-flag t)
2360 (apply 'mh-exec-cmd "rmm" folder
2361 (mh-coalesce-msg-list mh-delete-list))
2362 (mh-delete-scan-msgs mh-delete-list)
2363 (setq mh-delete-list nil)))
2364
2365 ;; Don't need to remove sequences since delete and refile do so.
2366 ;; Mark cur message
2367 (if (> (buffer-size) 0)
c3d9274a 2368 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
bdcfe844 2369
c3d9274a
BW
2370 ;; Redraw folder buffer if needed
2371 (when (and redraw-needed-flag)
924df208 2372 (when (mh-speed-flists-active-p)
a66894d8 2373 (apply #'mh-speed-flists t folders-changed))
c3d9274a 2374 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
2953de8c 2375 (mh-index-data (mh-index-insert-folder-headers))))
c26cf6c8 2376
2953de8c
SG
2377 (and (buffer-file-name (get-buffer mh-show-buffer))
2378 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
2379 ;; If "inc" were to put a new msg in this file,
2380 ;; we would not notice, so mark it invalid now.
2381 (mh-invalidate-show-buffer))
2382
2383 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
2384 (mh-remove-all-notation)
2385 (mh-notate-user-sequences)
2386
d1699462 2387 ;; Run the after hook -- now folders-changed is valid,
2953de8c
SG
2388 ;; but not the lists of specific messages.
2389 (let ((mh-folders-changed folders-changed))
2390 (run-hooks 'mh-after-commands-processed-hook)))
c26cf6c8 2391
c26cf6c8
RS
2392 (message "Processing deletes and refiles for %s...done" folder)))
2393
c26cf6c8 2394(defun mh-update-unseen ()
bdcfe844
BW
2395 "Synchronize the unseen sequence with MH.
2396Return non-nil iff the MH folder was set.
d1699462
BW
2397The hook `mh-unseen-updated-hook' is called after the unseen sequence
2398is updated."
c26cf6c8 2399 (if mh-seen-list
847b8219 2400 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
c3d9274a
BW
2401 (unseen-msgs (mh-seq-msgs unseen-seq)))
2402 (if unseen-msgs
2403 (progn
2404 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
2405 (run-hooks 'mh-unseen-updated-hook)
2406 (while mh-seen-list
2407 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
2408 (setq mh-seen-list (cdr mh-seen-list)))
2409 (setcdr unseen-seq unseen-msgs)
2410 t) ;since we set the folder
2411 (setq mh-seen-list nil)))))
c26cf6c8 2412
c26cf6c8 2413(defun mh-delete-scan-msgs (msgs)
bdcfe844 2414 "Delete the scan listing lines for MSGS."
c26cf6c8 2415 (save-excursion
942fc772 2416 (while msgs
bdcfe844
BW
2417 (when (mh-goto-msg (car msgs) t t)
2418 (when (memq 'unthread mh-view-ops)
2419 (mh-thread-forget-message (car msgs)))
2420 (mh-delete-line 1))
942fc772 2421 (setq msgs (cdr msgs)))))
c26cf6c8 2422
c26cf6c8 2423(defun mh-outstanding-commands-p ()
bdcfe844 2424 "Return non-nil if there are outstanding deletes or refiles."
f0d73c14
BW
2425 (save-excursion
2426 (when (eq major-mode 'mh-show-mode)
2427 (set-buffer mh-show-folder-buffer))
2428 (or mh-delete-list mh-refile-list)))
c26cf6c8 2429
847b8219 2430(defun mh-coalesce-msg-list (messages)
924df208
BW
2431 "Given a list of MESSAGES, return a list of message number ranges.
2432This is the inverse of `mh-read-msg-list', which expands ranges.
2dcf34f9
BW
2433Message lists passed to MH programs should be processed by this
2434function to avoid exceeding system command line argument limits."
847b8219 2435 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
c3d9274a
BW
2436 (range-high nil)
2437 (prev -1)
2438 (ranges nil))
847b8219
KH
2439 (while prev
2440 (if range-high
c3d9274a
BW
2441 (if (or (not (numberp prev))
2442 (not (equal (car msgs) (1- prev))))
2443 (progn ;non-sequential, flush old range
2444 (if (eq prev range-high)
2445 (setq ranges (cons range-high ranges))
2446 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
2447 (setq range-high nil))))
847b8219 2448 (or range-high
c3d9274a 2449 (setq range-high (car msgs))) ;start new or first range
847b8219
KH
2450 (setq prev (car msgs))
2451 (setq msgs (cdr msgs)))
2452 ranges))
2453
2454(defun mh-greaterp (msg1 msg2)
bdcfe844
BW
2455 "Return the greater of two message indicators MSG1 and MSG2.
2456Strings are \"smaller\" than numbers.
88a34f43 2457Valid values are things like \"cur\", \"last\", 1, and 1820."
847b8219 2458 (if (numberp msg1)
c3d9274a
BW
2459 (if (numberp msg2)
2460 (> msg1 msg2)
2461 t)
847b8219 2462 (if (numberp msg2)
c3d9274a 2463 nil
847b8219
KH
2464 (string-lessp msg2 msg1))))
2465
a1b4049d 2466(defun mh-lessp (msg1 msg2)
bdcfe844
BW
2467 "Return the lesser of two message indicators MSG1 and MSG2.
2468Strings are \"smaller\" than numbers.
88a34f43 2469Valid values are things like \"cur\", \"last\", 1, and 1820."
a1b4049d 2470 (not (mh-greaterp msg1 msg2)))
bdcfe844 2471
c26cf6c8
RS
2472\f
2473
2474;;; Basic sequence handling
2475
2476(defun mh-delete-seq-locally (seq)
bdcfe844 2477 "Remove MH-E's record of SEQ."
c26cf6c8
RS
2478 (let ((entry (mh-find-seq seq)))
2479 (setq mh-seq-list (delq entry mh-seq-list))))
2480
2481(defun mh-read-folder-sequences (folder save-refiles)
bdcfe844
BW
2482 "Read and return the predefined sequences for a FOLDER.
2483If SAVE-REFILES is non-nil, then keep the sequences
2484that note messages to be refiled."
c26cf6c8
RS
2485 (let ((seqs ()))
2486 (cond (save-refiles
c3d9274a
BW
2487 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
2488 (if (mh-folder-name-p (mh-seq-name seq))
2489 (setq seqs (cons seq seqs)))))
2490 mh-seq-list)))
c26cf6c8
RS
2491 (save-excursion
2492 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
c3d9274a
BW
2493 (progn
2494 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
2495 (while (re-search-forward "^[^: ]+" nil t)
2496 (setq seqs (cons (mh-make-seq (intern (buffer-substring
2497 (match-beginning 0)
2498 (match-end 0)))
2499 (mh-read-msg-list))
2500 seqs)))
2501 (delete-region (point-min) (point))))) ; avoid race with
2502 ; mh-process-daemon
c26cf6c8
RS
2503 seqs))
2504
2505(defun mh-read-msg-list ()
bdcfe844
BW
2506 "Return a list of message numbers from point to the end of the line.
2507Expands ranges into set of individual numbers."
c26cf6c8 2508 (let ((msgs ())
c3d9274a
BW
2509 (end-of-line (save-excursion (end-of-line) (point)))
2510 num)
c26cf6c8 2511 (while (re-search-forward "[0-9]+" end-of-line t)
e495eaec
BW
2512 (setq num (string-to-number (buffer-substring (match-beginning 0)
2513 (match-end 0))))
c3d9274a
BW
2514 (cond ((looking-at "-") ; Message range
2515 (forward-char 1)
2516 (re-search-forward "[0-9]+" end-of-line t)
e495eaec
BW
2517 (let ((num2 (string-to-number
2518 (buffer-substring (match-beginning 0)
2519 (match-end 0)))))
c3d9274a
BW
2520 (if (< num2 num)
2521 (error "Bad message range: %d-%d" num num2))
2522 (while (<= num num2)
2523 (setq msgs (cons num msgs))
2524 (setq num (1+ num)))))
2525 ((not (zerop num)) ;"pick" outputs "0" to mean no match
2526 (setq msgs (cons num msgs)))))
c26cf6c8
RS
2527 msgs))
2528
a66894d8 2529(defun mh-notate-user-sequences (&optional range)
2be362c2
BW
2530 "Mark user-defined sequences in RANGE.
2531
2dcf34f9
BW
2532Check the documentation of `mh-interactive-range' to see how
2533RANGE is read in interactive use; if nil all messages are
2534notated."
a66894d8
BW
2535 (unless range
2536 (setq range (cons (point-min) (point-max))))
c26cf6c8 2537 (let ((seqs mh-seq-list)
a66894d8 2538 (msg-hash (make-hash-table)))
3d7ca223 2539 (dolist (seq seqs)
a66894d8
BW
2540 (dolist (msg (mh-seq-msgs seq))
2541 (push (car seq) (gethash msg msg-hash))))
2542 (mh-iterate-on-range msg range
2543 (loop for seq in (gethash msg msg-hash)
2544 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
2545
2546(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
c26cf6c8 2547
c26cf6c8 2548(defun mh-internal-seq (name)
bdcfe844 2549 "Return non-nil if NAME is the name of an internal MH-E sequence."
a66894d8 2550 (or (memq name mh-internal-seqs)
c26cf6c8 2551 (eq name mh-unseen-seq)
f0d73c14 2552 (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
c26cf6c8
RS
2553 (eq name mh-previous-seq)
2554 (mh-folder-name-p name)))
2555
a66894d8
BW
2556(defun mh-valid-seq-p (name)
2557 "Return non-nil if NAME is a valid MH sequence name."
2558 (and (symbolp name)
2559 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
2560
2561(defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
2562 "Delete RANGE from SEQUENCE.
2563
2dcf34f9
BW
2564Check the documentation of `mh-interactive-range' to see how
2565RANGE is read in interactive use.
a66894d8 2566
2dcf34f9
BW
2567In a program, non-nil INTERNAL-FLAG means do not inform MH of the
2568change."
a66894d8 2569 (interactive (list (mh-interactive-range "Delete")
c3d9274a
BW
2570 (mh-read-seq-default "Delete from" t)
2571 nil))
a66894d8
BW
2572 (let ((entry (mh-find-seq sequence))
2573 (user-sequence-flag (not (mh-internal-seq sequence)))
2574 (folders-changed (list mh-current-folder))
2575 (msg-list ()))
924df208 2576 (when entry
a66894d8
BW
2577 (mh-iterate-on-range msg range
2578 (push msg msg-list)
2579 ;; Calling "mark" repeatedly takes too long. So we will pretend here
2580 ;; that we are just modifying an internal sequence...
2581 (when (memq msg (cdr entry))
2582 (mh-remove-sequence-notation msg (not user-sequence-flag)))
2583 (mh-delete-a-msg-from-seq msg sequence t))
2584 ;; ... and here we will "mark" all the messages at one go.
2585 (unless internal-flag (mh-undefine-sequence sequence msg-list))
2586 (when (and mh-index-data (not internal-flag))
2587 (setq folders-changed
2588 (append folders-changed
2589 (mh-index-delete-from-sequence sequence msg-list))))
924df208 2590 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
a66894d8 2591 (apply #'mh-speed-flists t folders-changed)))))
924df208 2592
f0d73c14 2593(defun mh-catchup (range)
2be362c2 2594 "Delete RANGE from the \"unseen\" sequence.
f0d73c14 2595
2dcf34f9
BW
2596Check the documentation of `mh-interactive-range' to see how
2597RANGE is read in interactive use."
f0d73c14
BW
2598 (interactive (list (mh-interactive-range "Catchup"
2599 (cons (point-min) (point-max)))))
2600 (mh-delete-msg-from-seq range mh-unseen-seq))
2601
924df208
BW
2602(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
2603 "Delete MSG from SEQUENCE.
2dcf34f9
BW
2604If INTERNAL-FLAG is non-nil, then do not inform MH of the
2605change."
924df208
BW
2606 (let ((entry (mh-find-seq sequence)))
2607 (when (and entry (memq msg (mh-seq-msgs entry)))
2608 (if (not internal-flag)
2609 (mh-undefine-sequence sequence (list msg)))
2610 (setcdr entry (delq msg (mh-seq-msgs entry))))))
2611
c26cf6c8 2612(defun mh-undefine-sequence (seq msgs)
bdcfe844 2613 "Remove from the SEQ the list of MSGS."
a66894d8
BW
2614 (when (and (mh-valid-seq-p seq) msgs)
2615 (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
2616 "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
c26cf6c8 2617
c26cf6c8 2618(defun mh-define-sequence (seq msgs)
bdcfe844
BW
2619 "Define the SEQ to contain the list of MSGS.
2620Do not mark pseudo-sequences or empty sequences.
7bd10db5 2621Signals an error if SEQ is an invalid name."
c26cf6c8 2622 (if (and msgs
a66894d8 2623 (mh-valid-seq-p seq)
c3d9274a 2624 (not (mh-folder-name-p seq)))
c26cf6c8 2625 (save-excursion
c3d9274a
BW
2626 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2627 "-sequence" (symbol-name seq)
2628 (mh-coalesce-msg-list msgs)))))
c26cf6c8 2629
bdcfe844
BW
2630(defun mh-seq-containing-msg (msg &optional include-internal-flag)
2631 "Return a list of the sequences containing MSG.
2dcf34f9
BW
2632If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences
2633in list."
c26cf6c8 2634 (let ((l mh-seq-list)
c3d9274a 2635 (seqs ()))
c26cf6c8 2636 (while l
847b8219 2637 (and (memq msg (mh-seq-msgs (car l)))
c3d9274a
BW
2638 (or include-internal-flag
2639 (not (mh-internal-seq (mh-seq-name (car l)))))
2640 (setq seqs (cons (mh-seq-name (car l)) seqs)))
c26cf6c8
RS
2641 (setq l (cdr l)))
2642 seqs))
2643
c26cf6c8
RS
2644\f
2645
cee9f5c6 2646;;; Build mh-folder-mode keymap:
c26cf6c8
RS
2647
2648(suppress-keymap mh-folder-mode-map)
a1b4049d 2649
bdcfe844
BW
2650;; Use defalias to make sure the documented primary key bindings
2651;; appear in menu lists.
2652(defalias 'mh-alt-show 'mh-show)
2653(defalias 'mh-alt-refile-msg 'mh-refile-msg)
2654(defalias 'mh-alt-send 'mh-send)
2655(defalias 'mh-alt-visit-folder 'mh-visit-folder)
2656
5a4aad03 2657;; Save the "b" binding for a future `back'. Maybe?
a1b4049d 2658(gnus-define-keys mh-folder-mode-map
c3d9274a
BW
2659 " " mh-page-msg
2660 "!" mh-refile-or-write-again
924df208 2661 "'" mh-toggle-tick
c3d9274a
BW
2662 "," mh-header-display
2663 "." mh-alt-show
d103d8b3 2664 ";" mh-toggle-mh-decode-mime-flag
c3d9274a
BW
2665 ">" mh-write-msg-to-file
2666 "?" mh-help
2667 "E" mh-extract-rejected-mail
bdcfe844 2668 "M" mh-modify
c3d9274a
BW
2669 "\177" mh-previous-page
2670 "\C-d" mh-delete-msg-no-motion
2671 "\t" mh-index-next-folder
2672 [backtab] mh-index-previous-folder
2673 "\M-\t" mh-index-previous-folder
2674 "\e<" mh-first-msg
2675 "\e>" mh-last-msg
2676 "\ed" mh-redistribute
2677 "\r" mh-show
2678 "^" mh-alt-refile-msg
2679 "c" mh-copy-msg
2680 "d" mh-delete-msg
2681 "e" mh-edit-again
2682 "f" mh-forward
2683 "g" mh-goto-msg
2684 "i" mh-inc-folder
2685 "k" mh-delete-subject-or-thread
c3d9274a
BW
2686 "m" mh-alt-send
2687 "n" mh-next-undeleted-msg
2688 "\M-n" mh-next-unread-msg
2689 "o" mh-refile-msg
2690 "p" mh-previous-undeleted-msg
2691 "\M-p" mh-previous-unread-msg
2692 "q" mh-quit
2693 "r" mh-reply
2694 "s" mh-send
2695 "t" mh-toggle-showing
2696 "u" mh-undo
2697 "v" mh-index-visit-folder
2698 "x" mh-execute-commands
2699 "|" mh-pipe-msg)
a1b4049d
BW
2700
2701(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
c3d9274a 2702 "?" mh-prefix-help
a66894d8 2703 "'" mh-index-ticked-messages
c3d9274a 2704 "S" mh-sort-folder
f0d73c14 2705 "c" mh-catchup
c3d9274a 2706 "f" mh-alt-visit-folder
bdcfe844 2707 "i" mh-index-search
c3d9274a
BW
2708 "k" mh-kill-folder
2709 "l" mh-list-folders
924df208 2710 "n" mh-index-new-messages
c3d9274a
BW
2711 "o" mh-alt-visit-folder
2712 "p" mh-pack-folder
a66894d8 2713 "q" mh-index-sequenced-messages
c3d9274a
BW
2714 "r" mh-rescan-folder
2715 "s" mh-search-folder
2716 "u" mh-undo-folder
2717 "v" mh-visit-folder)
a1b4049d 2718
924df208
BW
2719(define-key mh-folder-mode-map "I" mh-inc-spool-map)
2720
2721(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
2722 "?" mh-prefix-help
2723 "b" mh-junk-blacklist
2724 "w" mh-junk-whitelist)
2725
f0d73c14
BW
2726(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
2727 "?" mh-prefix-help
f0d73c14
BW
2728 "C" mh-ps-print-toggle-color
2729 "F" mh-ps-print-toggle-faces
f0d73c14
BW
2730 "f" mh-ps-print-msg-file
2731 "l" mh-print-msg
553fb735 2732 "p" mh-ps-print-msg)
f0d73c14 2733
a1b4049d 2734(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
a66894d8 2735 "'" mh-narrow-to-tick
c3d9274a
BW
2736 "?" mh-prefix-help
2737 "d" mh-delete-msg-from-seq
2738 "k" mh-delete-seq
2739 "l" mh-list-sequences
2740 "n" mh-narrow-to-seq
2741 "p" mh-put-msg-in-seq
2742 "s" mh-msg-is-in-seq
2743 "w" mh-widen)
a1b4049d
BW
2744
2745(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
c3d9274a
BW
2746 "?" mh-prefix-help
2747 "u" mh-thread-ancestor
2748 "p" mh-thread-previous-sibling
2749 "n" mh-thread-next-sibling
2750 "t" mh-toggle-threads
2751 "d" mh-thread-delete
2752 "o" mh-thread-refile)
bdcfe844
BW
2753
2754(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
924df208 2755 "'" mh-narrow-to-tick
c3d9274a 2756 "?" mh-prefix-help
a66894d8
BW
2757 "c" mh-narrow-to-cc
2758 "f" mh-narrow-to-from
2759 "r" mh-narrow-to-range
c3d9274a 2760 "s" mh-narrow-to-subject
a66894d8 2761 "t" mh-narrow-to-to
c3d9274a 2762 "w" mh-widen)
a1b4049d
BW
2763
2764(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
c3d9274a
BW
2765 "?" mh-prefix-help
2766 "s" mh-store-msg ;shar
2767 "u" mh-store-msg) ;uuencode
a1b4049d
BW
2768
2769(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
c3d9274a
BW
2770 " " mh-page-digest
2771 "?" mh-prefix-help
2772 "\177" mh-page-digest-backwards
2773 "b" mh-burst-digest)
a1b4049d 2774
bdcfe844 2775(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
c3d9274a
BW
2776 "?" mh-prefix-help
2777 "a" mh-mime-save-parts
f0d73c14 2778 "e" mh-display-with-external-viewer
bdcfe844
BW
2779 "i" mh-folder-inline-mime-part
2780 "o" mh-folder-save-mime-part
f0d73c14 2781 "t" mh-toggle-mime-buttons
bdcfe844
BW
2782 "v" mh-folder-toggle-mime-part
2783 "\t" mh-next-button
2784 [backtab] mh-prev-button
2785 "\M-\t" mh-prev-button)
2786
a1b4049d 2787(cond
bdcfe844 2788 (mh-xemacs-flag
a1b4049d
BW
2789 (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
2790 (t
2791 (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
c26cf6c8 2792
942fc772
KH
2793;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
2794
c26cf6c8
RS
2795\f
2796
bdcfe844
BW
2797;;; Help Messages
2798
cee9f5c6
BW
2799;; If you add a new prefix, add appropriate text to the nil key.
2800;;
2801;; In general, messages are grouped logically. Taking the main commands for
2802;; example, the first line is "ways to view messages," the second line is
2803;; "things you can do with messages", and the third is "composing" messages.
2804;;
2805;; When adding a new prefix, ensure that the help message contains "what" the
2806;; prefix is for. For example, if the word "folder" were not present in the
5a4aad03 2807;; "F" entry, it would not be clear what these commands operated upon.
bdcfe844
BW
2808(defvar mh-help-messages
2809 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
c3d9274a 2810 "[d]elete, [o]refile, e[x]ecute,\n"
d103d8b3
BW
2811 "[s]end, [r]eply,\n"
2812 "[;]toggle MIME decoding.\n"
924df208 2813 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
a66894d8 2814 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
bdcfe844 2815
a66894d8
BW
2816 (?F "[l]ist; [v]isit folder;\n"
2817 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
c3d9274a 2818 "[p]ack; [S]ort; [r]escan; [k]ill")
553fb735
BW
2819 (?P "[p]rint message to [f]ile; old-style [l]pr printing;\n"
2820 "Toggle printing of [C]olors, [F]aces")
a66894d8 2821 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
c3d9274a
BW
2822 "[s]equences, [l]ist,\n"
2823 "[d]elete message from sequence, [k]ill sequence")
2824 (?T "[t]oggle, [d]elete, [o]refile thread")
a66894d8 2825 (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
bdcfe844
BW
2826 (?X "un[s]har, [u]udecode message")
2827 (?D "[b]urst digest")
2828 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
924df208
BW
2829 "[TAB] next; [SHIFT-TAB] previous")
2830 (?J "[b]lacklist, [w]hitelist message"))
bdcfe844
BW
2831 "Key binding cheat sheet.
2832
2833This is an associative array which is used to show the most common commands.
2834The key is a prefix char. The value is one or more strings which are
2835concatenated together and displayed in the minibuffer if ? is pressed after
2836the prefix character. The special key nil is used to display the
2837non-prefixed commands.
2838
2839The substitutions described in `substitute-command-keys' are performed as
2840well.")
a1b4049d 2841
bdcfe844 2842\f
a1b4049d 2843
f1ed9461 2844(dolist (mess '("^Cursor not pointing to message$"
c3d9274a 2845 "^There is no other window$"))
f1ed9461
DL
2846 (add-to-list 'debug-ignored-errors mess))
2847
bdcfe844
BW
2848(provide 'mh-e)
2849
cee9f5c6
BW
2850;; Local Variables:
2851;; indent-tabs-mode: nil
2852;; sentence-end-double-space: nil
2853;; End:
bdcfe844 2854
cee9f5c6 2855;; arch-tag: cce884de-bd37-4104-9963-e4439d5ed22b
c26cf6c8 2856;;; mh-e.el ends here