Remove a couple of extra blank lines and unneeded defvars.
[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)
c3d9274a 1211 (let ((threaded-flag (memq 'unthread mh-view-ops)))
c3d9274a
BW
1212 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
1213 (cond (threaded-flag (mh-toggle-threads))
1214 (mh-index-data (mh-index-insert-folder-headers)))))
c26cf6c8 1215
553fb735
BW
1216(defun mh-write-msg-to-file (message file no-header)
1217 "Append MESSAGE to end of FILE\\<mh-folder-mode-map>.
1218
2dcf34f9
BW
1219You are prompted for the filename. If the file already exists,
1220the message is appended to it. You can also write the message to
1221the file without the header by specifying a prefix argument
1222NO-HEADER. Subsequent writes to the same file can be made with
1223the command \\[mh-refile-or-write-again]."
c26cf6c8
RS
1224 (interactive
1225 (list (mh-get-msg-num t)
c3d9274a
BW
1226 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
1227 (file-name-directory
1228 (car (cdr mh-last-destination-write)))
1229 default-directory)))
1230 (read-file-name (format "Save message%s in file: "
1231 (if current-prefix-arg " body" ""))
1232 default-dir
1233 (if (eq 'write (car mh-last-destination-write))
1234 (car (cdr mh-last-destination-write))
1235 (expand-file-name "mail.out" default-dir))))
1236 current-prefix-arg))
553fb735 1237 (let ((msg-file-to-output (mh-msg-filename message))
c3d9274a 1238 (output-file (mh-expand-file-name file)))
553fb735 1239 (setq mh-last-destination (list 'write file (if no-header 'no-header))
c3d9274a 1240 mh-last-destination-write mh-last-destination)
c26cf6c8 1241 (save-excursion
847b8219 1242 (set-buffer (get-buffer-create mh-temp-buffer))
c26cf6c8 1243 (erase-buffer)
847b8219 1244 (insert-file-contents msg-file-to-output)
c26cf6c8 1245 (goto-char (point-min))
553fb735 1246 (if no-header (search-forward "\n\n"))
c26cf6c8
RS
1247 (append-to-file (point) (point-max) output-file))))
1248
c26cf6c8 1249(defun mh-toggle-showing ()
af435184
BW
1250 "Toggle between MH-Folder and MH-Folder Show modes.
1251
1252This command switches between MH-Folder mode and MH-Folder Show
1253mode. MH-Folder mode turns off the associated show buffer so that
1254you can perform operations on the messages quickly without
1255reading them. This is an excellent way to prune out your junk
1256mail or to refile a group of messages to another folder for later
1257examination."
c26cf6c8 1258 (interactive)
a1b4049d 1259 (if mh-showing-mode
c26cf6c8 1260 (mh-set-scan-mode)
a1b4049d 1261 (mh-show)))
c26cf6c8 1262
a66894d8 1263(defun mh-undo (range)
2be362c2
BW
1264 "Undo pending deletes or refiles in RANGE.
1265
2dcf34f9
BW
1266If you've deleted a message or refiled it, but changed your mind,
1267you can cancel the action before you've executed it. Use this
1268command to undo a refile on or deletion of a single message. You
1269can also undo refiles and deletes for messages that are found in
1270a given RANGE.
a66894d8 1271
2dcf34f9
BW
1272Check the documentation of `mh-interactive-range' to see how
1273RANGE is read in interactive use."
a66894d8
BW
1274 (interactive (list (mh-interactive-range "Undo")))
1275 (cond ((numberp range)
c3d9274a
BW
1276 (let ((original-position (point)))
1277 (beginning-of-line)
1278 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
1279 (looking-at mh-scan-refiled-msg-regexp)
1280 (and (eq mh-next-direction 'forward) (bobp))
1281 (and (eq mh-next-direction 'backward)
1282 (save-excursion (forward-line) (eobp)))))
1283 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1284 (if (or (looking-at mh-scan-deleted-msg-regexp)
1285 (looking-at mh-scan-refiled-msg-regexp))
1286 (progn
1287 (mh-undo-msg (mh-get-msg-num t))
1288 (mh-maybe-show))
1289 (goto-char original-position)
1290 (error "Nothing to undo"))))
a66894d8 1291 (t (mh-iterate-on-range () range
924df208 1292 (mh-undo-msg nil))))
c26cf6c8
RS
1293 (if (not (mh-outstanding-commands-p))
1294 (mh-set-folder-modified-p nil)))
1295
f0d73c14 1296
c3d9274a
BW
1297(defun mh-folder-line-matches-show-buffer-p ()
1298 "Return t if the message under point in folder-mode is in the show buffer.
2dcf34f9
BW
1299Return nil in any other circumstance (no message under point, no
1300show buffer, the message in the show buffer doesn't match."
c3d9274a
BW
1301 (and (eq major-mode 'mh-folder-mode)
1302 (mh-get-msg-num nil)
1303 mh-show-buffer
1304 (get-buffer mh-show-buffer)
1305 (buffer-file-name (get-buffer mh-show-buffer))
1306 (string-match ".*/\\([0-9]+\\)$"
1307 (buffer-file-name (get-buffer mh-show-buffer)))
1308 (string-equal
1309 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1310 (int-to-string (mh-get-msg-num nil)))))
1311
1312(eval-when-compile (require 'gnus))
1313
1314(defmacro mh-macro-expansion-time-gnus-version ()
1315 "Return Gnus version available at macro expansion time.
2dcf34f9
BW
1316The macro evaluates the Gnus version at macro expansion time. If
1317MH-E was compiled then macro expansion happens at compile time."
1318gnus-version)
c3d9274a
BW
1319
1320(defun mh-run-time-gnus-version ()
1321 "Return Gnus version available at run time."
1322 (require 'gnus)
1323 gnus-version)
1324
847b8219 1325;;;###autoload
c26cf6c8 1326(defun mh-version ()
bdcfe844 1327 "Display version information about MH-E and the MH mail handling system."
c26cf6c8 1328 (interactive)
3d7ca223 1329 (set-buffer (get-buffer-create mh-info-buffer))
c26cf6c8 1330 (erase-buffer)
c3d9274a
BW
1331 ;; MH-E version.
1332 (insert "MH-E " mh-version "\n\n")
1333 ;; MH-E compilation details.
1334 (insert "MH-E compilation details:\n")
1335 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1336 (gnus-compiled-version (if compiled-mhe
1337 (mh-macro-expansion-time-gnus-version)
1338 "N/A")))
1339 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1340 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1341 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1342 ;; Emacs version.
1343 (insert (emacs-version) "\n\n")
a1b4049d 1344 ;; MH version.
f0d73c14
BW
1345 (if mh-variant-in-use
1346 (insert mh-variant-in-use "\n"
1347 " mh-progs:\t" mh-progs "\n"
1348 " mh-lib:\t" mh-lib "\n"
1349 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1350 (insert "No MH variant detected\n"))
a1b4049d
BW
1351 ;; Linux version.
1352 (condition-case ()
1353 (call-process "uname" nil t nil "-a")
1354 (file-error))
1355 (goto-char (point-min))
3d7ca223 1356 (display-buffer mh-info-buffer))
c26cf6c8 1357
3d7ca223
BW
1358(defun mh-parse-flist-output-line (line &optional current-folder)
1359 "Parse LINE to generate folder name, unseen messages and total messages.
2dcf34f9
BW
1360If CURRENT-FOLDER is non-nil then it contains the current folder
1361name and it is used to avoid problems in corner cases involving
1362folders whose names end with a '+' character."
c3d9274a
BW
1363 (with-temp-buffer
1364 (insert line)
1365 (goto-char (point-max))
1366 (let (folder unseen total p)
1367 (when (search-backward " out of " (point-min) t)
1368 (setq total (read-from-string
1369 (buffer-substring-no-properties
1370 (match-end 0) (line-end-position))))
1371 (when (search-backward " in sequence " (point-min) t)
1372 (setq p (point))
1373 (when (search-backward " has " (point-min) t)
1374 (setq unseen (read-from-string (buffer-substring-no-properties
1375 (match-end 0) p)))
3d7ca223 1376 (while (eq (char-after) ? )
c3d9274a
BW
1377 (backward-char))
1378 (setq folder (buffer-substring-no-properties
1379 (point-min) (1+ (point))))
3d7ca223
BW
1380 (when (and (equal (aref folder (1- (length folder))) ?+)
1381 (equal current-folder folder))
1382 (setq folder (substring folder 0 (1- (length folder)))))
c3d9274a
BW
1383 (values (format "+%s" folder) (car unseen) (car total))))))))
1384
a66894d8 1385(defun mh-folder-size-folder (folder)
5a4aad03 1386 "Find size of FOLDER using \"folder\"."
a66894d8
BW
1387 (with-temp-buffer
1388 (let ((u (length (cdr (assoc mh-unseen-seq
1389 (mh-read-folder-sequences folder nil))))))
1390 (call-process (expand-file-name "folder" mh-progs) nil t nil
1391 "-norecurse" folder)
1392 (goto-char (point-min))
1393 (if (re-search-forward " has \\([0-9]+\\) " nil t)
1394 (values (car (read-from-string (match-string 1))) u folder)
1395 (values 0 u folder)))))
1396
1397(defun mh-folder-size-flist (folder)
5a4aad03 1398 "Find size of FOLDER using \"flist\"."
c3d9274a 1399 (with-temp-buffer
f0d73c14 1400 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
3d7ca223 1401 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
c3d9274a 1402 (goto-char (point-min))
924df208 1403 (multiple-value-bind (folder unseen total)
c3d9274a
BW
1404 (mh-parse-flist-output-line
1405 (buffer-substring (point) (line-end-position)))
924df208 1406 (values total unseen folder))))
c3d9274a 1407
a66894d8
BW
1408(defun mh-folder-size (folder)
1409 "Find size of FOLDER."
1410 (if mh-flists-present-flag
1411 (mh-folder-size-flist folder)
1412 (mh-folder-size-folder folder)))
1413
c3d9274a 1414(defun mh-visit-folder (folder &optional range index-data)
2be362c2
BW
1415 "Visit FOLDER.
1416
2dcf34f9
BW
1417When you want to read the messages that you have refiled into folders,
1418use this command to visit the folder. You are prompted for the folder
1419name.
2be362c2 1420
2dcf34f9
BW
1421The folder buffer will show just unseen messages if there are any;
1422otherwise, it will show all the messages in the buffer as long there
1423are fewer than `mh-large-folder' messages. If there are more, then you
1424are prompted for a range of messages to scan.
2be362c2 1425
2dcf34f9
BW
1426You can provide a prefix argument in order to specify a RANGE of
1427messages to show when you visit the folder. In this case, regions are
1428not used to specify the range and `mh-large-folder' is ignored. Check
1429the documentation of `mh-interactive-range' to see how RANGE is read
1430in interactive use.
c3d9274a 1431
2dcf34f9
BW
1432Note that this command can also be used to create folders. If you
1433specify a folder that does not exist, you will be prompted to create
1434it.
c3d9274a 1435
2be362c2 1436Do not call this function from outside MH-E; use \\[mh-rmail] instead.
3d7ca223 1437
2dcf34f9
BW
1438If, in a program, RANGE is nil (the default), then all messages in
1439FOLDER are displayed. If an index buffer is being created then
1440INDEX-DATA is used to initialize the index buffer specific data
1441structures."
c3d9274a 1442 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
3d7ca223 1443 (list folder-name
a66894d8
BW
1444 (mh-read-range "Scan" folder-name t nil
1445 current-prefix-arg
1446 mh-interpret-number-as-range-flag))))
c3d9274a 1447 (let ((config (current-window-configuration))
924df208 1448 (current-buffer (current-buffer))
c3d9274a 1449 (threaded-view-flag mh-show-threads-flag))
f0d73c14 1450 (delete-other-windows)
c3d9274a
BW
1451 (save-excursion
1452 (when (get-buffer folder)
1453 (set-buffer folder)
924df208 1454 (setq threaded-view-flag (memq 'unthread mh-view-ops))))
c3d9274a
BW
1455 (when index-data
1456 (mh-make-folder folder)
1457 (setq mh-index-data (car index-data)
1458 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1459 mh-index-checksum-origin-map (make-hash-table :test #'equal))
a66894d8
BW
1460 (mh-index-update-maps folder (cadr index-data))
1461 (mh-index-create-sequences))
c26cf6c8 1462 (mh-scan-folder folder (or range "all"))
c3d9274a
BW
1463 (cond ((and threaded-view-flag
1464 (save-excursion
1465 (goto-char (point-min))
1466 (or (null mh-large-folder)
a66894d8 1467 (not (equal (forward-line (1+ mh-large-folder)) 0))
c3d9274a
BW
1468 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1469 nil))))
1470 (mh-toggle-threads))
1471 (mh-index-data
1472 (mh-index-insert-folder-headers)))
924df208
BW
1473 (unless (eq current-buffer (current-buffer))
1474 (setq mh-previous-window-config config)))
c26cf6c8
RS
1475 nil)
1476
f0d73c14 1477
847b8219 1478(defun mh-update-sequences ()
be33fce4 1479 "Flush MH-E's state out to MH.
2dcf34f9
BW
1480
1481This function updates the sequence specified by your
1482\"Unseen-Sequence:\" profile component, \"cur\", and the sequence
1483listed by the `mh-tick-seq' option which is \"tick\" by default.
1484The message at the cursor is used for \"cur\"."
847b8219
KH
1485 (interactive)
1486 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
bdcfe844 1487 ;; which updates MH-E's state from MH.
847b8219 1488 (let ((folder-set (mh-update-unseen))
c3d9274a 1489 (new-cur (mh-get-msg-num nil)))
847b8219 1490 (if new-cur
c3d9274a
BW
1491 (let ((seq-entry (mh-find-seq 'cur)))
1492 (mh-remove-cur-notation)
1493 (setcdr seq-entry
1494 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1495 (mh-define-sequence 'cur (list new-cur))
1496 (beginning-of-line)
1497 (if (looking-at mh-scan-good-msg-regexp)
3d7ca223 1498 (mh-notate-cur)))
847b8219 1499 (or folder-set
c3d9274a 1500 (save-excursion
a1b4049d
BW
1501 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1502 ;; So I added this sanity check.
1503 (if (stringp mh-current-folder)
1504 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
1505 (mh-exec-cmd-quiet t "folder" "-fast")))))))
847b8219 1506
c26cf6c8
RS
1507\f
1508
1509;;; Support routines.
1510
d1699462
BW
1511(defun mh-delete-a-msg (message)
1512 "Delete MESSAGE.
1513If MESSAGE is nil then the message at point is deleted.
2dcf34f9
BW
1514The hook `mh-delete-msg-hook' is called after you mark a message
1515for deletion. For example, a past maintainer of MH-E used this
1516once when he kept statistics on his mail usage."
c26cf6c8 1517 (save-excursion
d1699462
BW
1518 (if (numberp message)
1519 (mh-goto-msg message nil t)
3d7ca223 1520 (beginning-of-line)
d1699462 1521 (setq message (mh-get-msg-num t)))
a1b4049d 1522 (if (looking-at mh-scan-refiled-msg-regexp)
836f2863 1523 (error "Message %d is refiled; undo refile before deleting" message))
a1b4049d 1524 (if (looking-at mh-scan-deleted-msg-regexp)
c3d9274a
BW
1525 nil
1526 (mh-set-folder-modified-p t)
d1699462 1527 (setq mh-delete-list (cons message mh-delete-list))
3d7ca223 1528 (mh-notate nil mh-note-deleted mh-cmd-note)
c3d9274a 1529 (run-hooks 'mh-delete-msg-hook))))
c26cf6c8 1530
d1699462
BW
1531(defun mh-refile-a-msg (message folder)
1532 "Refile MESSAGE in FOLDER.
1533If MESSAGE is nil then the message at point is refiled.
bdcfe844 1534Folder is a symbol, not a string.
2dcf34f9
BW
1535The hook `mh-refile-msg-hook' is called after a message is marked to
1536be refiled."
c26cf6c8 1537 (save-excursion
d1699462
BW
1538 (if (numberp message)
1539 (mh-goto-msg message nil t)
3d7ca223 1540 (beginning-of-line)
d1699462 1541 (setq message (mh-get-msg-num t)))
a1b4049d 1542 (cond ((looking-at mh-scan-deleted-msg-regexp)
f9c53c97 1543 (error "Message %d is deleted; undo delete before moving" message))
c3d9274a
BW
1544 ((looking-at mh-scan-refiled-msg-regexp)
1545 (if (y-or-n-p
f9c53c97 1546 (format "Message %d already refiled; copy to %s as well? "
d1699462 1547 message folder))
c3d9274a
BW
1548 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1549 "-src" mh-current-folder
1550 (symbol-name folder))
f0d73c14 1551 (message "Message not copied")))
c3d9274a
BW
1552 (t
1553 (mh-set-folder-modified-p t)
1554 (cond ((null (assoc folder mh-refile-list))
d1699462
BW
1555 (push (list folder message) mh-refile-list))
1556 ((not (member message (cdr (assoc folder mh-refile-list))))
1557 (push message (cdr (assoc folder mh-refile-list)))))
3d7ca223 1558 (mh-notate nil mh-note-refiled mh-cmd-note)
c3d9274a 1559 (run-hooks 'mh-refile-msg-hook)))))
c26cf6c8 1560
924df208
BW
1561(defun mh-next-msg (&optional wait-after-complaining-flag)
1562 "Move backward or forward to the next undeleted message in the buffer.
2dcf34f9
BW
1563If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and
1564we are at the last message, then wait for a second after telling
1565the user that there aren't any more unread messages."
c26cf6c8 1566 (if (eq mh-next-direction 'forward)
924df208
BW
1567 (mh-next-undeleted-msg 1 wait-after-complaining-flag)
1568 (mh-previous-undeleted-msg 1 wait-after-complaining-flag)))
c3d9274a
BW
1569
1570(defun mh-next-unread-msg (&optional count)
553fb735
BW
1571 "Display next unread message.
1572
2dcf34f9
BW
1573This command can be given a prefix argument COUNT to specify how
1574many unread messages to skip."
c3d9274a
BW
1575 (interactive "p")
1576 (unless (> count 0)
f9c53c97 1577 (error "The function `mh-next-unread-msg' expects positive argument"))
c3d9274a
BW
1578 (setq count (1- count))
1579 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1580 (cur-msg (mh-get-msg-num nil)))
1581 (cond ((and (not cur-msg) (not (bobp))
1582 ;; If we are at the end of the buffer back up one line and go
1583 ;; to unread message after that.
1584 (progn
1585 (forward-line -1)
1586 (setq cur-msg (mh-get-msg-num nil)))
1587 nil))
1588 ((or (null unread-sequence) (not cur-msg))
1589 ;; No unread message or there aren't any messages in buffer...
1590 (message "No more unread messages"))
1591 ((progn
1592 ;; Skip messages
1593 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1594 (setq unread-sequence (cdr unread-sequence)))
1595 (while (> count 0)
1596 (setq unread-sequence (cdr unread-sequence))
1597 (setq count (1- count)))
1598 (not (car unread-sequence)))
1599 (message "No more unread messages"))
f0d73c14
BW
1600 (t (loop for msg in unread-sequence
1601 when (mh-goto-msg msg t) return nil
1602 finally (message "No more unread messages"))))))
c26cf6c8 1603
c26cf6c8 1604(defun mh-set-scan-mode ()
bdcfe844 1605 "Display the scan listing buffer, but do not show a message."
c26cf6c8
RS
1606 (if (get-buffer mh-show-buffer)
1607 (delete-windows-on mh-show-buffer))
a1b4049d 1608 (mh-showing-mode 0)
dc9bdc98 1609 (force-mode-line-update)
bdcfe844 1610 (if mh-recenter-summary-flag
c26cf6c8
RS
1611 (mh-recenter nil)))
1612
c26cf6c8 1613(defun mh-undo-msg (msg)
3d7ca223
BW
1614 "Undo the deletion or refile of one MSG.
1615If MSG is nil then act on the message at point"
1616 (save-excursion
1617 (if (numberp msg)
1618 (mh-goto-msg msg t t)
1619 (beginning-of-line)
1620 (setq msg (mh-get-msg-num t)))
1621 (cond ((memq msg mh-delete-list)
1622 (setq mh-delete-list (delq msg mh-delete-list)))
1623 (t
1624 (dolist (folder-msg-list mh-refile-list)
1625 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1626 (setq mh-refile-list (loop for x in mh-refile-list
1627 unless (null (cdr x)) collect x))))
1628 (mh-notate nil ? mh-cmd-note)))
c26cf6c8 1629
c26cf6c8
RS
1630\f
1631
1632;;; The folder data abstraction.
1633
a66894d8
BW
1634(defvar mh-index-data-file ".mhe_index"
1635 "MH-E specific file where index seach info is stored.")
1636
c26cf6c8 1637(defun mh-make-folder (name)
bdcfe844
BW
1638 "Create a new mail folder called NAME.
1639Make it the current folder."
c26cf6c8
RS
1640 (switch-to-buffer name)
1641 (setq buffer-read-only nil)
1642 (erase-buffer)
bdcfe844 1643 (if mh-adaptive-cmd-note-flag
50df64d6 1644 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width name))))
c26cf6c8
RS
1645 (setq buffer-read-only t)
1646 (mh-folder-mode)
1647 (mh-set-folder-modified-p nil)
847b8219 1648 (setq buffer-file-name mh-folder-filename)
a66894d8
BW
1649 (when (and (not mh-index-data)
1650 (file-exists-p (concat buffer-file-name mh-index-data-file)))
1651 (mh-index-read-data))
847b8219 1652 (mh-make-folder-mode-line))
c26cf6c8 1653
cee9f5c6 1654;; Ensure new buffers won't get this mode if default-major-mode is nil.
c26cf6c8
RS
1655(put 'mh-folder-mode 'mode-class 'special)
1656
bdcfe844
BW
1657\f
1658
cee9f5c6
BW
1659;;; Build mh-folder-mode menu
1660
1661;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1662;; Menus for folder mode: folder, message, sequence (in that order)
1663;; folder-mode "Sequence" menu
bdcfe844
BW
1664(easy-menu-define
1665 mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
1666 '("Sequence"
1667 ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
1668 ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
1669 ["Delete Message from Sequence..." mh-delete-msg-from-seq
1670 (mh-get-msg-num nil)]
1671 ["List Sequences in Folder..." mh-list-sequences t]
1672 ["Delete Sequence..." mh-delete-seq t]
1673 ["Narrow to Sequence..." mh-narrow-to-seq t]
a66894d8 1674 ["Widen from Sequence" mh-widen mh-folder-view-stack]
bdcfe844
BW
1675 "--"
1676 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
924df208
BW
1677 ["Narrow to Tick Sequence" mh-narrow-to-tick
1678 (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))]
bdcfe844 1679 ["Delete Rest of Same Subject" mh-delete-subject t]
924df208 1680 ["Toggle Tick Mark" mh-toggle-tick t]
bdcfe844
BW
1681 "--"
1682 ["Push State Out to MH" mh-update-sequences t]))
1683
cee9f5c6 1684;; folder-mode "Message" menu
bdcfe844
BW
1685(easy-menu-define
1686 mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
1687 '("Message"
1688 ["Show Message" mh-show (mh-get-msg-num nil)]
1689 ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
1690 ["Next Message" mh-next-undeleted-msg t]
1691 ["Previous Message" mh-previous-undeleted-msg t]
1692 ["Go to First Message" mh-first-msg t]
1693 ["Go to Last Message" mh-last-msg t]
1694 ["Go to Message by Number..." mh-goto-msg t]
f0d73c14 1695 ["Modify Message" mh-modify t]
bdcfe844
BW
1696 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
1697 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
f0d73c14
BW
1698 ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
1699 ["Execute Delete/Refile" mh-execute-commands
1700 (mh-outstanding-commands-p)]
bdcfe844
BW
1701 "--"
1702 ["Compose a New Message" mh-send t]
1703 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
1704 ["Forward Message..." mh-forward (mh-get-msg-num nil)]
1705 ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
1706 ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
1707 ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
1708 "--"
1709 ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
1710 ["Print Message" mh-print-msg (mh-get-msg-num nil)]
1711 ["Write Message to File..." mh-write-msg-to-file
1712 (mh-get-msg-num nil)]
1713 ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
1714 ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
1715 ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
1716
cee9f5c6 1717;; folder-mode "Folder" menu
bdcfe844
BW
1718(easy-menu-define
1719 mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
1720 '("Folder"
1721 ["Incorporate New Mail" mh-inc-folder t]
1722 ["Toggle Show/Folder" mh-toggle-showing t]
1723 ["Execute Delete/Refile" mh-execute-commands
f0d73c14 1724 (mh-outstanding-commands-p)]
bdcfe844
BW
1725 ["Rescan Folder" mh-rescan-folder t]
1726 ["Thread Folder" mh-toggle-threads
1727 (not (memq 'unthread mh-view-ops))]
1728 ["Pack Folder" mh-pack-folder t]
1729 ["Sort Folder" mh-sort-folder t]
1730 "--"
1731 ["List Folders" mh-list-folders t]
1732 ["Visit a Folder..." mh-visit-folder t]
924df208 1733 ["View New Messages" mh-index-new-messages t]
bdcfe844
BW
1734 ["Search a Folder..." mh-search-folder t]
1735 ["Indexed Search..." mh-index-search t]
1736 "--"
1737 ["Quit MH-E" mh-quit t]))
1738
1739\f
1740
bdcfe844
BW
1741(defmacro mh-remove-xemacs-horizontal-scrollbar ()
1742 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1743 (when mh-xemacs-flag
1744 `(if (and (featurep 'scrollbar)
1745 (fboundp 'set-specifier))
1746 (set-specifier horizontal-scrollbar-visible-p nil
1747 (cons (current-buffer) nil)))))
1748
1749(defmacro mh-write-file-functions-compat ()
1750 "Return `write-file-functions' if it exists.
2dcf34f9
BW
1751Otherwise return `local-write-file-hooks'. This macro exists
1752purely for compatibility. The former symbol is used in Emacs 21.4
1753onward while the latter is used in previous versions and XEmacs."
bdcfe844 1754 (if (boundp 'write-file-functions)
c3d9274a 1755 ''write-file-functions ;Emacs 21.4
6eb83a35 1756 ''local-write-file-hooks)) ;XEmacs
bdcfe844 1757
f0d73c14
BW
1758;; Register mh-folder-mode as supporting which-function-mode...
1759(load "which-func" t t)
1760(when (and (boundp 'which-func-modes)
1761 (not (member 'mh-folder-mode which-func-modes)))
1762 (push 'mh-folder-mode which-func-modes))
1763
6eb83a35 1764;; Shush compiler.
7094eefe 1765(eval-when-compile
6eb83a35
BW
1766 (defvar desktop-save-buffer)
1767 (defvar font-lock-auto-fontify))
7094eefe 1768
1dd9796d
SD
1769(defvar mh-folder-buttons-init-flag nil)
1770
e6de37c5
LH
1771;; Autoload cookie needed by desktop.el
1772;;;###autoload
a1b4049d 1773(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
bdcfe844 1774 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
a1b4049d 1775
2dcf34f9
BW
1776You can show the message the cursor is pointing to, and step through
1777the messages. Messages can be marked for deletion or refiling into
1778another folder; these commands are executed all at once with a
1779separate command.
c26cf6c8 1780
2dcf34f9
BW
1781Options that control this mode can be changed with
1782\\[customize-group]; specify the \"mh\" group. In particular, please
1783see the `mh-scan-format-file' option if you wish to modify scan's
1784format.
c26cf6c8 1785
a1b4049d 1786When a folder is visited, the hook `mh-folder-mode-hook' is run.
c26cf6c8 1787
f0d73c14
BW
1788Ranges
1789======
2dcf34f9
BW
1790Many commands that operate on individual messages, such as
1791`mh-forward' or `mh-refile-msg' take a RANGE argument. This argument
1792can be used in several ways.
f0d73c14 1793
2dcf34f9
BW
1794If you provide the prefix argument (\\[universal-argument]) to
1795these commands, then you will be prompted for the message range.
1796This can be any valid MH range which can include messages,
1797sequences, and the abbreviations (described in the mh(1) man
1798page):
f0d73c14
BW
1799
1800<num1>-<num2>
2dcf34f9
BW
1801 Indicates all messages in the range <num1> to <num2>, inclusive.
1802 The range must be nonempty.
f0d73c14 1803
5a4aad03
BW
1804<num>:N
1805<num>:+N
1806<num>:-N
2dcf34f9
BW
1807 Up to N messages beginning with (or ending with) message num. Num
1808 may be any of the predefined symbols: first, prev, cur, next or
1809 last.
f0d73c14 1810
5a4aad03
BW
1811first:N
1812prev:N
1813next:N
1814last:N
f0d73c14
BW
1815 The first, previous, next or last messages, if they exist.
1816
5a4aad03 1817all
f0d73c14
BW
1818 All of the messages.
1819
2dcf34f9
BW
1820For example, a range that shows all of these things is `1 2 3
18215-10 last:5 unseen'.
f0d73c14 1822
2dcf34f9
BW
1823If the option `transient-mark-mode' is set to t and you set a
1824region in the MH-Folder buffer, then the MH-E command will
1825perform the operation on all messages in that region.
f0d73c14 1826
a1b4049d 1827\\{mh-folder-mode-map}"
1dd9796d
SD
1828 (mh-do-in-gnu-emacs
1829 (unless mh-folder-buttons-init-flag
1830 (mh-tool-bar-folder-buttons-init)
1831 (setq mh-folder-buttons-init-flag t)))
a1b4049d 1832 (make-local-variable 'font-lock-defaults)
c3d9274a 1833 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1983467e
LH
1834 (make-local-variable 'desktop-save-buffer)
1835 (setq desktop-save-buffer t)
847b8219 1836 (mh-make-local-vars
f0d73c14
BW
1837 'mh-colors-available-flag (mh-colors-available-p)
1838 ; Do we have colors available
c3d9274a 1839 'mh-current-folder (buffer-name) ; Name of folder, a string
c26cf6c8 1840 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
c3d9274a 1841 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
c26cf6c8 1842 (file-name-as-directory (mh-expand-file-name (buffer-name)))
f0d73c14
BW
1843 'mh-display-buttons-for-inline-parts-flag
1844 mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
1845 ; be toggled.
3d7ca223
BW
1846 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
1847 'overlay-arrow-position nil ; Allow for simultaneous display in
1848 'overlay-arrow-string ">" ; different MH-E buffers.
c3d9274a
BW
1849 'mh-showing-mode nil ; Show message also?
1850 'mh-delete-list nil ; List of msgs nums to delete
1851 'mh-refile-list nil ; List of folder names in mh-seq-list
1852 'mh-seq-list nil ; Alist of (seq . msgs) nums
1853 'mh-seen-list nil ; List of displayed messages
1854 'mh-next-direction 'forward ; Direction to move to next message
bdcfe844
BW
1855 'mh-view-ops () ; Stack that keeps track of the order
1856 ; in which narrowing/threading has been
1857 ; carried out.
a66894d8
BW
1858 'mh-folder-view-stack () ; Stack of previous views of the
1859 ; folder.
c3d9274a
BW
1860 'mh-index-data nil ; If the folder was created by a call
1861 ; to mh-index-search this contains info
1862 ; about the search results.
1863 'mh-index-previous-search nil ; Previous folder and search-regexp
1864 'mh-index-msg-checksum-map nil ; msg -> checksum map
1865 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
a66894d8 1866 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
c3d9274a
BW
1867 'mh-first-msg-num nil ; Number of first msg in buffer
1868 'mh-last-msg-num nil ; Number of last msg in buffer
1869 'mh-msg-count nil ; Number of msgs in buffer
1870 'mh-mode-line-annotation nil ; Indicates message range
a66894d8
BW
1871 'mh-sequence-notation-history (make-hash-table)
1872 ; Remember what is overwritten by
1873 ; mh-note-seq.
f0d73c14
BW
1874 'imenu-create-index-function 'mh-index-create-imenu-index
1875 ; Setup imenu support
c3d9274a 1876 'mh-previous-window-config nil) ; Previous window configuration
bdcfe844 1877 (mh-remove-xemacs-horizontal-scrollbar)
c26cf6c8
RS
1878 (setq truncate-lines t)
1879 (auto-save-mode -1)
1880 (setq buffer-offer-save t)
924df208 1881 (mh-make-local-hook (mh-write-file-functions-compat))
bdcfe844 1882 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
c26cf6c8 1883 (make-local-variable 'revert-buffer-function)
c3d9274a 1884 (make-local-variable 'hl-line-mode) ; avoid pollution
924df208 1885 (mh-funcall-if-exists hl-line-mode 1)
c26cf6c8 1886 (setq revert-buffer-function 'mh-undo-folder)
a1b4049d 1887 (or (assq 'mh-showing-mode minor-mode-alist)
c26cf6c8 1888 (setq minor-mode-alist
c3d9274a 1889 (cons '(mh-showing-mode " Show") minor-mode-alist)))
a1b4049d
BW
1890 (easy-menu-add mh-folder-sequence-menu)
1891 (easy-menu-add mh-folder-message-menu)
1892 (easy-menu-add mh-folder-folder-menu)
a66894d8 1893 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
fa4075e3 1894 (mh-funcall-if-exists mh-tool-bar-init :folder)
bdcfe844 1895 (if (and mh-xemacs-flag
c3d9274a
BW
1896 font-lock-auto-fontify)
1897 (turn-on-font-lock))) ; Force font-lock in XEmacs.
c26cf6c8 1898
f0d73c14 1899(defun mh-toggle-mime-buttons ()
553fb735 1900 "Toggle option `mh-display-buttons-for-inline-parts-flag'."
f0d73c14
BW
1901 (interactive)
1902 (setq mh-display-buttons-for-inline-parts-flag
1903 (not mh-display-buttons-for-inline-parts-flag))
1904 (mh-show nil t))
1905
1906(defun mh-colors-available-p ()
1907 "Check if colors are available in the Emacs being used."
1908 (or mh-xemacs-flag
7094eefe 1909 (let ((color-cells (display-color-cells)))
f0d73c14
BW
1910 (and (numberp color-cells) (>= color-cells 8)))))
1911
1912(defun mh-colors-in-use-p ()
1913 "Check if colors are being used in the folder buffer."
1914 (and mh-colors-available-flag font-lock-mode))
1915
847b8219 1916(defun mh-make-local-vars (&rest pairs)
bdcfe844
BW
1917 "Initialize local variables according to the variable-value PAIRS."
1918
c26cf6c8 1919 (while pairs
1e495fc7 1920 (set (make-local-variable (car pairs)) (car (cdr pairs)))
c26cf6c8
RS
1921 (setq pairs (cdr (cdr pairs)))))
1922
a66894d8
BW
1923(defun mh-restore-desktop-buffer (desktop-buffer-file-name
1924 desktop-buffer-name
1925 desktop-buffer-misc)
f0d73c14 1926 "Restore an MH folder buffer specified in a desktop file.
2dcf34f9
BW
1927When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the
1928file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer
1929name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info
1930used by the `desktop-buffer-handlers' functions."
a66894d8
BW
1931 (mh-find-path)
1932 (mh-visit-folder desktop-buffer-name)
1933 (current-buffer))
1934
cee9f5c6 1935;; desktop-buffer-mode-handlers appeared in Emacs 22.
a05fcb7d
BW
1936(if (fboundp 'desktop-buffer-mode-handlers)
1937 (add-to-list 'desktop-buffer-mode-handlers
1938 '(mh-folder-mode . mh-restore-desktop-buffer)))
e6de37c5 1939
bdcfe844 1940(defun mh-scan-folder (folder range &optional dont-exec-pending)
2be362c2
BW
1941 "Scan FOLDER over RANGE.
1942
2dcf34f9
BW
1943After the scan is performed, switch to the buffer associated with
1944FOLDER.
2be362c2 1945
2dcf34f9
BW
1946Check the documentation of `mh-interactive-range' to see how RANGE is
1947read in interactive use.
2be362c2 1948
2dcf34f9
BW
1949The processing of outstanding commands is not performed if
1950DONT-EXEC-PENDING is non-nil."
f0d73c14
BW
1951 (when (stringp range)
1952 (setq range (delete "" (split-string range "[ \t\n]"))))
c26cf6c8 1953 (cond ((null (get-buffer folder))
c3d9274a
BW
1954 (mh-make-folder folder))
1955 (t
924df208
BW
1956 (unless dont-exec-pending
1957 (mh-process-or-undo-commands folder)
1958 (mh-reset-threads-and-narrowing))
c3d9274a 1959 (switch-to-buffer folder)))
c26cf6c8 1960 (mh-regenerate-headers range)
a1b4049d 1961 (if (zerop (buffer-size))
bdcfe844 1962 (if (equal range "all")
c3d9274a
BW
1963 (message "Folder %s is empty" folder)
1964 (message "No messages in %s, range %s" folder range))
bdcfe844 1965 (mh-goto-cur-msg))
924df208 1966 (when (mh-outstanding-commands-p)
3d7ca223 1967 (mh-notate-deleted-and-refiled)))
c26cf6c8 1968
50df64d6
BW
1969(defun mh-msg-num-width-to-column (width)
1970 "Return the column for notations given message number WIDTH.
1971Note that columns in Emacs start with 0.
1972
2dcf34f9
BW
1973If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this
1974means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are
1975in use. This function therefore assumes that the first column is
1976empty (to provide room for the cursor), the following WIDTH
1977columns contain the message number, and the column for notations
1978comes after that."
50df64d6
BW
1979 (if (eq mh-scan-format-file t)
1980 (max (1+ width) 2)
f9c53c97
BW
1981 (error "%s %s" "Can't call `mh-msg-num-width-to-column' when"
1982 "`mh-scan-format-file' is not set to \"Use MH-E scan Format\"")))
50df64d6
BW
1983
1984(defun mh-set-cmd-note (column)
1985 "Set `mh-cmd-note' to COLUMN.
e069fa61 1986Note that columns in Emacs start with 0."
50df64d6 1987 (setq mh-cmd-note column))
c3d9274a 1988
847b8219 1989(defun mh-regenerate-headers (range &optional update)
2be362c2 1990 "Scan folder over RANGE.
bdcfe844 1991If UPDATE, append the scan lines, otherwise replace."
847b8219 1992 (let ((folder mh-current-folder)
bdcfe844 1993 (range (if (and range (atom range)) (list range) range))
c3d9274a 1994 scan-start)
c26cf6c8 1995 (message "Scanning %s..." folder)
a66894d8 1996 (mh-remove-all-notation)
c26cf6c8 1997 (with-mh-folder-updating (nil)
847b8219 1998 (if update
c3d9274a
BW
1999 (goto-char (point-max))
2000 (delete-region (point-min) (point-max))
2001 (if mh-adaptive-cmd-note-flag
50df64d6
BW
2002 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width
2003 folder)))))
847b8219 2004 (setq scan-start (point))
bdcfe844
BW
2005 (apply #'mh-exec-cmd-output
2006 mh-scan-prog nil
2007 (mh-scan-format)
2008 "-noclear" "-noheader"
2009 "-width" (window-width)
2010 folder range)
847b8219 2011 (goto-char scan-start)
c26cf6c8 2012 (cond ((looking-at "scan: no messages in")
c3d9274a 2013 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
f0d73c14
BW
2014 ((looking-at (if (mh-variant-p 'mu-mh)
2015 "scan: message set .* does not exist"
2016 "scan: bad message list "))
c3d9274a
BW
2017 (keep-lines mh-scan-valid-regexp))
2018 ((looking-at "scan: ")) ; Keep error messages
2019 (t
2020 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
c26cf6c8
RS
2021 (setq mh-seq-list (mh-read-folder-sequences folder nil))
2022 (mh-notate-user-sequences)
847b8219 2023 (or update
c3d9274a
BW
2024 (setq mh-mode-line-annotation
2025 (if (equal range '("all"))
2026 nil
2027 mh-partial-folder-mode-line-annotation)))
847b8219 2028 (mh-make-folder-mode-line))
c26cf6c8
RS
2029 (message "Scanning %s...done" folder)))
2030
bdcfe844
BW
2031(defun mh-generate-new-cmd-note (folder)
2032 "Fix the `mh-cmd-note' value for this FOLDER.
2033
2034After doing an `mh-get-new-mail' operation in this FOLDER, at least
2035one line that looks like a truncated message number was found.
2036
2dcf34f9
BW
2037Remove the text added by the last `mh-inc' command. It should be the
2038messages cur-last. Call `mh-set-cmd-note', adjusting the notation
2039column with the width of the largest message number in FOLDER.
bdcfe844
BW
2040
2041Reformat the message number width on each line in the buffer and trim
2042the line length to fit in the window.
2043
2044Rescan the FOLDER in the range cur-last in order to display the
2045messages that were removed earlier. They should all fit in the scan
2046line now with no message truncation."
2047 (save-excursion
2048 (let ((maxcol (1- (window-width)))
2049 (old-cmd-note mh-cmd-note)
c3d9274a
BW
2050 mh-cmd-note-fmt
2051 msgnum)
bdcfe844
BW
2052 ;; Nuke all of the lines just added by the last inc
2053 (delete-char (- (point-max) (point)))
2054 ;; Update the current buffer to reflect the new mh-cmd-note
2055 ;; value needed to display messages.
50df64d6 2056 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width folder)))
bdcfe844
BW
2057 (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
2058 ;; Cleanup the messages that are in the buffer right now
2059 (goto-char (point-min))
2060 (cond ((memq 'unthread mh-view-ops)
2061 (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
2062 (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
2063 ;; reformat the number to fix in mh-cmd-note columns
2064 (setq msgnum (string-to-number
2065 (buffer-substring
2066 (match-beginning 1) (match-end 1))))
2067 (replace-match (format mh-cmd-note-fmt msgnum))
2068 ;; trim the line to fix in the window
2069 (end-of-line)
2070 (let ((eol (point)))
2071 (move-to-column maxcol)
2072 (if (<= (point) eol)
c3d9274a 2073 (delete-char (- eol (point))))))))
bdcfe844
BW
2074 ;; now re-read the lost messages
2075 (goto-char (point-max))
2076 (prog1 (point)
2077 (mh-regenerate-headers "cur-last" t)))))
c26cf6c8
RS
2078
2079(defun mh-get-new-mail (maildrop-name)
bdcfe844
BW
2080 "Read new mail from MAILDROP-NAME into the current buffer.
2081Return in the current buffer."
c26cf6c8 2082 (let ((point-before-inc (point))
c3d9274a
BW
2083 (folder mh-current-folder)
2084 (new-mail-flag nil))
c26cf6c8 2085 (with-mh-folder-updating (t)
f965c3d7 2086 (if maildrop-name
c3d9274a
BW
2087 (message "inc %s -file %s..." folder maildrop-name)
2088 (message "inc %s..." folder))
c26cf6c8
RS
2089 (setq mh-next-direction 'forward)
2090 (goto-char (point-max))
e495eaec 2091 (mh-remove-cur-notation)
c26cf6c8 2092 (let ((start-of-inc (point)))
c3d9274a
BW
2093 (if maildrop-name
2094 ;; I think MH 5 used "-ms-file" instead of "-file",
2095 ;; which would make inc'ing from maildrops fail.
2096 (mh-exec-cmd-output mh-inc-prog nil folder
2097 (mh-scan-format)
2098 "-file" (expand-file-name maildrop-name)
2099 "-width" (window-width)
2100 "-truncate")
bdcfe844
BW
2101 (mh-exec-cmd-output mh-inc-prog nil
2102 (mh-scan-format)
2103 "-width" (window-width)))
c3d9274a
BW
2104 (if maildrop-name
2105 (message "inc %s -file %s...done" folder maildrop-name)
2106 (message "inc %s...done" folder))
2107 (goto-char start-of-inc)
2108 (cond ((save-excursion
2109 (re-search-forward "^inc: no mail" nil t))
2110 (message "No new mail%s%s" (if maildrop-name " in " "")
2111 (if maildrop-name maildrop-name "")))
a66894d8 2112 ((and (when mh-folder-view-stack
bdcfe844
BW
2113 (let ((saved-text (buffer-substring-no-properties
2114 start-of-inc (point-max))))
2115 (delete-region start-of-inc (point-max))
a66894d8 2116 (unwind-protect (mh-widen t)
e495eaec 2117 (mh-remove-cur-notation)
bdcfe844
BW
2118 (goto-char (point-max))
2119 (setq start-of-inc (point))
2120 (insert saved-text)
2121 (goto-char start-of-inc))))
2122 nil))
2123 ((re-search-forward "^inc:" nil t) ; Error messages
c3d9274a
BW
2124 (error "Error incorporating mail"))
2125 ((and
2126 (equal mh-scan-format-file t)
2127 mh-adaptive-cmd-note-flag
2128 ;; Have we reached an edge condition?
2129 (save-excursion
2130 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
2131 (setq start-of-inc (mh-generate-new-cmd-note folder))
2132 nil))
2133 (t
2134 (setq new-mail-flag t)))
2135 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
e495eaec
BW
2136 (let* ((sequences (mh-read-folder-sequences folder t))
2137 (new-cur (assoc 'cur sequences))
2138 (new-unseen (assoc mh-unseen-seq sequences)))
2139 (unless (assoc 'cur mh-seq-list)
2140 (push (list 'cur) mh-seq-list))
2141 (unless (assoc mh-unseen-seq mh-seq-list)
2142 (push (list mh-unseen-seq) mh-seq-list))
2143 (setcdr (assoc 'cur mh-seq-list) (cdr new-cur))
2144 (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen)))
c3d9274a 2145 (when (equal (point-max) start-of-inc)
3d7ca223 2146 (mh-notate-cur))
c3d9274a
BW
2147 (if new-mail-flag
2148 (progn
2149 (mh-make-folder-mode-line)
924df208
BW
2150 (when (mh-speed-flists-active-p)
2151 (mh-speed-flists t mh-current-folder))
bdcfe844
BW
2152 (when (memq 'unthread mh-view-ops)
2153 (mh-thread-inc folder start-of-inc))
c3d9274a 2154 (mh-goto-cur-msg))
a66894d8 2155 (goto-char point-before-inc))
e495eaec 2156 (mh-notate-user-sequences (cons start-of-inc (point-max)))))))
c26cf6c8 2157
847b8219 2158(defun mh-make-folder-mode-line (&optional ignored)
bdcfe844 2159 "Set the fields of the mode line for a folder buffer.
2dcf34f9
BW
2160The optional argument is now obsolete and IGNORED. It used to be
2161used to pass in what is now stored in the buffer-local variable
2162`mh-mode-line-annotation'."
c26cf6c8 2163 (save-excursion
bdcfe844
BW
2164 (save-window-excursion
2165 (mh-first-msg)
2166 (let ((new-first-msg-num (mh-get-msg-num nil)))
c3d9274a
BW
2167 (when (or (not (memq 'unthread mh-view-ops))
2168 (null mh-first-msg-num)
2169 (null new-first-msg-num)
2170 (< new-first-msg-num mh-first-msg-num))
2171 (setq mh-first-msg-num new-first-msg-num)))
bdcfe844
BW
2172 (mh-last-msg)
2173 (let ((new-last-msg-num (mh-get-msg-num nil)))
c3d9274a
BW
2174 (when (or (not (memq 'unthread mh-view-ops))
2175 (null mh-last-msg-num)
2176 (null new-last-msg-num)
2177 (> new-last-msg-num mh-last-msg-num))
2178 (setq mh-last-msg-num new-last-msg-num)))
bdcfe844 2179 (setq mh-msg-count (if mh-first-msg-num
c3d9274a
BW
2180 (count-lines (point-min) (point-max))
2181 0))
bdcfe844 2182 (setq mode-line-buffer-identification
3d7ca223 2183 (list (format " {%%b%s} %s msg%s"
c3d9274a
BW
2184 (if mh-mode-line-annotation
2185 (format "/%s" mh-mode-line-annotation)
2186 "")
2187 (if (zerop mh-msg-count)
2188 "no"
2189 (format "%d" mh-msg-count))
2190 (if (zerop mh-msg-count)
2191 "s"
2192 (cond ((> mh-msg-count 1)
2193 (format "s (%d-%d)" mh-first-msg-num
2194 mh-last-msg-num))
2195 (mh-first-msg-num
2196 (format " (%d)" mh-first-msg-num))
3d7ca223
BW
2197 (""))))))
2198 (mh-logo-display))))
c26cf6c8 2199
a66894d8
BW
2200(defun mh-add-sequence-notation (msg internal-seq-flag)
2201 "Add sequence notation to the MSG on the current line.
2dcf34f9
BW
2202If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if
2203font-lock is turned on."
a66894d8
BW
2204 (with-mh-folder-updating (t)
2205 (save-excursion
2206 (beginning-of-line)
2207 (if internal-seq-flag
f0d73c14
BW
2208 (progn
2209 ;; Change the buffer so that if transient-mark-mode is active
2210 ;; and there is an active region it will get deactivated as in
2211 ;; the case of user sequences.
2212 (mh-notate nil nil mh-cmd-note)
2213 (when font-lock-mode
2214 (font-lock-fontify-region (point) (line-end-position))))
50df64d6 2215 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
a66894d8
BW
2216 (let ((stack (gethash msg mh-sequence-notation-history)))
2217 (setf (gethash msg mh-sequence-notation-history)
2218 (cons (char-after) stack)))
50df64d6
BW
2219 (mh-notate nil mh-note-seq
2220 (+ mh-cmd-note mh-scan-field-destination-offset))))))
a66894d8
BW
2221
2222(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
2223 "Remove sequence notation from the MSG on the current line.
2dcf34f9
BW
2224If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to
2225highlight the sequence. In that case, no notation needs to be removed.
2226Otherwise the effect of inserting `mh-note-seq' needs to be reversed.
2227If ALL is non-nil, then all sequence marks on the scan line are
2228removed."
a66894d8
BW
2229 (with-mh-folder-updating (t)
2230 ;; This takes care of internal sequences...
2231 (mh-notate nil nil mh-cmd-note)
2232 (unless internal-seq-flag
2233 ;; ... and this takes care of user sequences.
2234 (let ((stack (gethash msg mh-sequence-notation-history)))
2235 (while (and all (cdr stack))
2236 (setq stack (cdr stack)))
2237 (when stack
f0d73c14
BW
2238 (save-excursion
2239 (beginning-of-line)
50df64d6 2240 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
f0d73c14
BW
2241 (delete-char 1)
2242 (insert (car stack))))
a66894d8
BW
2243 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
2244
847b8219 2245(defun mh-remove-cur-notation ()
bdcfe844 2246 "Remove old cur notation."
847b8219
KH
2247 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
2248 (save-excursion
3d7ca223
BW
2249 (when (and cur-msg
2250 (mh-goto-msg cur-msg t t)
2251 (looking-at mh-scan-cur-msg-number-regexp))
2252 (mh-notate nil ? mh-cmd-note)
2253 (setq overlay-arrow-position nil)))))
847b8219 2254
bdcfe844
BW
2255(defun mh-remove-all-notation ()
2256 "Remove all notations on all scan lines that MH-E introduces."
2257 (save-excursion
3d7ca223 2258 (setq overlay-arrow-position nil)
bdcfe844 2259 (goto-char (point-min))
a66894d8
BW
2260 (mh-iterate-on-range msg (cons (point-min) (point-max))
2261 (mh-notate nil ? mh-cmd-note)
2262 (mh-remove-sequence-notation msg nil t))
2263 (clrhash mh-sequence-notation-history)))
bdcfe844 2264
f0d73c14 2265
bdcfe844
BW
2266(defun mh-goto-cur-msg (&optional minimal-changes-flag)
2267 "Position the cursor at the current message.
2dcf34f9
BW
2268When optional argument MINIMAL-CHANGES-FLAG is non-nil, the
2269function doesn't recenter the folder buffer."
c26cf6c8
RS
2270 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
2271 (cond ((and cur-msg
c3d9274a
BW
2272 (mh-goto-msg cur-msg t t))
2273 (unless minimal-changes-flag
3d7ca223 2274 (mh-notate-cur)
bdcfe844
BW
2275 (mh-recenter 0)
2276 (mh-maybe-show cur-msg)))
c3d9274a 2277 (t
3d7ca223 2278 (setq overlay-arrow-position nil)
c3d9274a 2279 (message "No current message")))))
c26cf6c8 2280
c26cf6c8 2281(defun mh-process-or-undo-commands (folder)
bdcfe844 2282 "If FOLDER has outstanding commands, then either process or discard them.
2dcf34f9
BW
2283Called by functions like `mh-sort-folder', so also invalidate
2284show buffer."
c26cf6c8
RS
2285 (set-buffer folder)
2286 (if (mh-outstanding-commands-p)
bdcfe844 2287 (if (or mh-do-not-confirm-flag
c3d9274a 2288 (y-or-n-p
924df208 2289 "Process outstanding deletes and refiles? "))
c3d9274a 2290 (mh-process-commands folder)
924df208 2291 (set-buffer folder)
c3d9274a 2292 (mh-undo-folder)))
c26cf6c8
RS
2293 (mh-update-unseen)
2294 (mh-invalidate-show-buffer))
2295
c26cf6c8 2296(defun mh-process-commands (folder)
bdcfe844 2297 "Process outstanding commands for FOLDER.
d1699462 2298
2dcf34f9
BW
2299This function runs `mh-before-commands-processed-hook' before the
2300commands are processed and `mh-after-commands-processed-hook'
2301after the commands are processed."
c26cf6c8
RS
2302 (message "Processing deletes and refiles for %s..." folder)
2303 (set-buffer folder)
2304 (with-mh-folder-updating (nil)
2953de8c
SG
2305 ;; Run the before hook -- the refile and delete lists are still valid
2306 (run-hooks 'mh-before-commands-processed-hook)
a1b4049d 2307
c26cf6c8
RS
2308 ;; Update the unseen sequence if it exists
2309 (mh-update-unseen)
2310
a66894d8
BW
2311 (let ((redraw-needed-flag mh-index-data)
2312 (folders-changed (list mh-current-folder))
2313 (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
2314 (mh-create-sequence-map mh-seq-list)))
2315 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
2316 (make-hash-table))))
c3d9274a
BW
2317 ;; Remove invalid scan lines if we are in an index folder and then remove
2318 ;; the real messages
2319 (when mh-index-data
2320 (mh-index-delete-folder-headers)
a66894d8
BW
2321 (setq folders-changed
2322 (append folders-changed (mh-index-execute-commands))))
c3d9274a 2323
bdcfe844
BW
2324 ;; Then refile messages
2325 (mh-mapc #'(lambda (folder-msg-list)
a66894d8
BW
2326 (let* ((dest-folder (symbol-name (car folder-msg-list)))
2327 (last (car (mh-translate-range dest-folder "last")))
2328 (msgs (cdr folder-msg-list)))
2329 (push dest-folder folders-changed)
bdcfe844
BW
2330 (setq redraw-needed-flag t)
2331 (apply #'mh-exec-cmd
2332 "refile" "-src" folder dest-folder
2333 (mh-coalesce-msg-list msgs))
a66894d8
BW
2334 (mh-delete-scan-msgs msgs)
2335 ;; Preserve sequences in destination folder...
e495eaec 2336 (when mh-refile-preserves-sequences-flag
a66894d8 2337 (clrhash dest-map)
e495eaec 2338 (loop for i from (1+ (or last 0))
a66894d8
BW
2339 for msg in (sort (copy-sequence msgs) #'<)
2340 do (loop for seq-name in (gethash msg seq-map)
2341 do (push i (gethash seq-name dest-map))))
2342 (maphash
2343 #'(lambda (seq msgs)
e495eaec
BW
2344 ;; Can't be run in the background, since the
2345 ;; current folder is changed by mark this could
2346 ;; lead to a race condition with the next refile.
2347 (apply #'mh-exec-cmd "mark"
a66894d8
BW
2348 "-sequence" (symbol-name seq) dest-folder
2349 "-add" (mapcar #'(lambda (x) (format "%s" x))
2350 (mh-coalesce-msg-list msgs))))
2351 dest-map))))
bdcfe844
BW
2352 mh-refile-list)
2353 (setq mh-refile-list ())
2354
2355 ;; Now delete messages
2356 (cond (mh-delete-list
2357 (setq redraw-needed-flag t)
2358 (apply 'mh-exec-cmd "rmm" folder
2359 (mh-coalesce-msg-list mh-delete-list))
2360 (mh-delete-scan-msgs mh-delete-list)
2361 (setq mh-delete-list nil)))
2362
2363 ;; Don't need to remove sequences since delete and refile do so.
2364 ;; Mark cur message
2365 (if (> (buffer-size) 0)
c3d9274a 2366 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
bdcfe844 2367
c3d9274a
BW
2368 ;; Redraw folder buffer if needed
2369 (when (and redraw-needed-flag)
924df208 2370 (when (mh-speed-flists-active-p)
a66894d8 2371 (apply #'mh-speed-flists t folders-changed))
c3d9274a 2372 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
2953de8c 2373 (mh-index-data (mh-index-insert-folder-headers))))
c26cf6c8 2374
2953de8c
SG
2375 (and (buffer-file-name (get-buffer mh-show-buffer))
2376 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
2377 ;; If "inc" were to put a new msg in this file,
2378 ;; we would not notice, so mark it invalid now.
2379 (mh-invalidate-show-buffer))
2380
2381 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
2382 (mh-remove-all-notation)
2383 (mh-notate-user-sequences)
2384
d1699462 2385 ;; Run the after hook -- now folders-changed is valid,
2953de8c
SG
2386 ;; but not the lists of specific messages.
2387 (let ((mh-folders-changed folders-changed))
2388 (run-hooks 'mh-after-commands-processed-hook)))
c26cf6c8 2389
c26cf6c8
RS
2390 (message "Processing deletes and refiles for %s...done" folder)))
2391
c26cf6c8 2392(defun mh-update-unseen ()
bdcfe844
BW
2393 "Synchronize the unseen sequence with MH.
2394Return non-nil iff the MH folder was set.
d1699462
BW
2395The hook `mh-unseen-updated-hook' is called after the unseen sequence
2396is updated."
c26cf6c8 2397 (if mh-seen-list
847b8219 2398 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
c3d9274a
BW
2399 (unseen-msgs (mh-seq-msgs unseen-seq)))
2400 (if unseen-msgs
2401 (progn
2402 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
2403 (run-hooks 'mh-unseen-updated-hook)
2404 (while mh-seen-list
2405 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
2406 (setq mh-seen-list (cdr mh-seen-list)))
2407 (setcdr unseen-seq unseen-msgs)
2408 t) ;since we set the folder
2409 (setq mh-seen-list nil)))))
c26cf6c8 2410
c26cf6c8 2411(defun mh-delete-scan-msgs (msgs)
bdcfe844 2412 "Delete the scan listing lines for MSGS."
c26cf6c8 2413 (save-excursion
942fc772 2414 (while msgs
bdcfe844
BW
2415 (when (mh-goto-msg (car msgs) t t)
2416 (when (memq 'unthread mh-view-ops)
2417 (mh-thread-forget-message (car msgs)))
2418 (mh-delete-line 1))
942fc772 2419 (setq msgs (cdr msgs)))))
c26cf6c8 2420
c26cf6c8 2421(defun mh-outstanding-commands-p ()
bdcfe844 2422 "Return non-nil if there are outstanding deletes or refiles."
f0d73c14
BW
2423 (save-excursion
2424 (when (eq major-mode 'mh-show-mode)
2425 (set-buffer mh-show-folder-buffer))
2426 (or mh-delete-list mh-refile-list)))
c26cf6c8 2427
847b8219 2428(defun mh-coalesce-msg-list (messages)
924df208
BW
2429 "Given a list of MESSAGES, return a list of message number ranges.
2430This is the inverse of `mh-read-msg-list', which expands ranges.
2dcf34f9
BW
2431Message lists passed to MH programs should be processed by this
2432function to avoid exceeding system command line argument limits."
847b8219 2433 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
c3d9274a
BW
2434 (range-high nil)
2435 (prev -1)
2436 (ranges nil))
847b8219
KH
2437 (while prev
2438 (if range-high
c3d9274a
BW
2439 (if (or (not (numberp prev))
2440 (not (equal (car msgs) (1- prev))))
2441 (progn ;non-sequential, flush old range
2442 (if (eq prev range-high)
2443 (setq ranges (cons range-high ranges))
2444 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
2445 (setq range-high nil))))
847b8219 2446 (or range-high
c3d9274a 2447 (setq range-high (car msgs))) ;start new or first range
847b8219
KH
2448 (setq prev (car msgs))
2449 (setq msgs (cdr msgs)))
2450 ranges))
2451
2452(defun mh-greaterp (msg1 msg2)
bdcfe844
BW
2453 "Return the greater of two message indicators MSG1 and MSG2.
2454Strings are \"smaller\" than numbers.
88a34f43 2455Valid values are things like \"cur\", \"last\", 1, and 1820."
847b8219 2456 (if (numberp msg1)
c3d9274a
BW
2457 (if (numberp msg2)
2458 (> msg1 msg2)
2459 t)
847b8219 2460 (if (numberp msg2)
c3d9274a 2461 nil
847b8219
KH
2462 (string-lessp msg2 msg1))))
2463
a1b4049d 2464(defun mh-lessp (msg1 msg2)
bdcfe844
BW
2465 "Return the lesser of two message indicators MSG1 and MSG2.
2466Strings are \"smaller\" than numbers.
88a34f43 2467Valid values are things like \"cur\", \"last\", 1, and 1820."
a1b4049d 2468 (not (mh-greaterp msg1 msg2)))
bdcfe844 2469
c26cf6c8
RS
2470\f
2471
2472;;; Basic sequence handling
2473
2474(defun mh-delete-seq-locally (seq)
bdcfe844 2475 "Remove MH-E's record of SEQ."
c26cf6c8
RS
2476 (let ((entry (mh-find-seq seq)))
2477 (setq mh-seq-list (delq entry mh-seq-list))))
2478
2479(defun mh-read-folder-sequences (folder save-refiles)
bdcfe844
BW
2480 "Read and return the predefined sequences for a FOLDER.
2481If SAVE-REFILES is non-nil, then keep the sequences
2482that note messages to be refiled."
c26cf6c8
RS
2483 (let ((seqs ()))
2484 (cond (save-refiles
c3d9274a
BW
2485 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
2486 (if (mh-folder-name-p (mh-seq-name seq))
2487 (setq seqs (cons seq seqs)))))
2488 mh-seq-list)))
c26cf6c8
RS
2489 (save-excursion
2490 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
c3d9274a
BW
2491 (progn
2492 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
2493 (while (re-search-forward "^[^: ]+" nil t)
2494 (setq seqs (cons (mh-make-seq (intern (buffer-substring
2495 (match-beginning 0)
2496 (match-end 0)))
2497 (mh-read-msg-list))
2498 seqs)))
2499 (delete-region (point-min) (point))))) ; avoid race with
2500 ; mh-process-daemon
c26cf6c8
RS
2501 seqs))
2502
2503(defun mh-read-msg-list ()
bdcfe844
BW
2504 "Return a list of message numbers from point to the end of the line.
2505Expands ranges into set of individual numbers."
c26cf6c8 2506 (let ((msgs ())
c3d9274a
BW
2507 (end-of-line (save-excursion (end-of-line) (point)))
2508 num)
c26cf6c8 2509 (while (re-search-forward "[0-9]+" end-of-line t)
e495eaec
BW
2510 (setq num (string-to-number (buffer-substring (match-beginning 0)
2511 (match-end 0))))
c3d9274a
BW
2512 (cond ((looking-at "-") ; Message range
2513 (forward-char 1)
2514 (re-search-forward "[0-9]+" end-of-line t)
e495eaec
BW
2515 (let ((num2 (string-to-number
2516 (buffer-substring (match-beginning 0)
2517 (match-end 0)))))
c3d9274a
BW
2518 (if (< num2 num)
2519 (error "Bad message range: %d-%d" num num2))
2520 (while (<= num num2)
2521 (setq msgs (cons num msgs))
2522 (setq num (1+ num)))))
2523 ((not (zerop num)) ;"pick" outputs "0" to mean no match
2524 (setq msgs (cons num msgs)))))
c26cf6c8
RS
2525 msgs))
2526
a66894d8 2527(defun mh-notate-user-sequences (&optional range)
2be362c2
BW
2528 "Mark user-defined sequences in RANGE.
2529
2dcf34f9
BW
2530Check the documentation of `mh-interactive-range' to see how
2531RANGE is read in interactive use; if nil all messages are
2532notated."
a66894d8
BW
2533 (unless range
2534 (setq range (cons (point-min) (point-max))))
c26cf6c8 2535 (let ((seqs mh-seq-list)
a66894d8 2536 (msg-hash (make-hash-table)))
3d7ca223 2537 (dolist (seq seqs)
a66894d8
BW
2538 (dolist (msg (mh-seq-msgs seq))
2539 (push (car seq) (gethash msg msg-hash))))
2540 (mh-iterate-on-range msg range
2541 (loop for seq in (gethash msg msg-hash)
2542 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
2543
2544(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
c26cf6c8 2545
c26cf6c8 2546(defun mh-internal-seq (name)
bdcfe844 2547 "Return non-nil if NAME is the name of an internal MH-E sequence."
a66894d8 2548 (or (memq name mh-internal-seqs)
c26cf6c8 2549 (eq name mh-unseen-seq)
f0d73c14 2550 (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
c26cf6c8
RS
2551 (eq name mh-previous-seq)
2552 (mh-folder-name-p name)))
2553
a66894d8
BW
2554(defun mh-valid-seq-p (name)
2555 "Return non-nil if NAME is a valid MH sequence name."
2556 (and (symbolp name)
2557 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
2558
2559(defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
2560 "Delete RANGE from SEQUENCE.
2561
2dcf34f9
BW
2562Check the documentation of `mh-interactive-range' to see how
2563RANGE is read in interactive use.
a66894d8 2564
2dcf34f9
BW
2565In a program, non-nil INTERNAL-FLAG means do not inform MH of the
2566change."
a66894d8 2567 (interactive (list (mh-interactive-range "Delete")
c3d9274a
BW
2568 (mh-read-seq-default "Delete from" t)
2569 nil))
a66894d8
BW
2570 (let ((entry (mh-find-seq sequence))
2571 (user-sequence-flag (not (mh-internal-seq sequence)))
2572 (folders-changed (list mh-current-folder))
2573 (msg-list ()))
924df208 2574 (when entry
a66894d8
BW
2575 (mh-iterate-on-range msg range
2576 (push msg msg-list)
2577 ;; Calling "mark" repeatedly takes too long. So we will pretend here
2578 ;; that we are just modifying an internal sequence...
2579 (when (memq msg (cdr entry))
2580 (mh-remove-sequence-notation msg (not user-sequence-flag)))
2581 (mh-delete-a-msg-from-seq msg sequence t))
2582 ;; ... and here we will "mark" all the messages at one go.
2583 (unless internal-flag (mh-undefine-sequence sequence msg-list))
2584 (when (and mh-index-data (not internal-flag))
2585 (setq folders-changed
2586 (append folders-changed
2587 (mh-index-delete-from-sequence sequence msg-list))))
924df208 2588 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
a66894d8 2589 (apply #'mh-speed-flists t folders-changed)))))
924df208 2590
f0d73c14 2591(defun mh-catchup (range)
2be362c2 2592 "Delete RANGE from the \"unseen\" sequence.
f0d73c14 2593
2dcf34f9
BW
2594Check the documentation of `mh-interactive-range' to see how
2595RANGE is read in interactive use."
f0d73c14
BW
2596 (interactive (list (mh-interactive-range "Catchup"
2597 (cons (point-min) (point-max)))))
2598 (mh-delete-msg-from-seq range mh-unseen-seq))
2599
924df208
BW
2600(defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
2601 "Delete MSG from SEQUENCE.
2dcf34f9
BW
2602If INTERNAL-FLAG is non-nil, then do not inform MH of the
2603change."
924df208
BW
2604 (let ((entry (mh-find-seq sequence)))
2605 (when (and entry (memq msg (mh-seq-msgs entry)))
2606 (if (not internal-flag)
2607 (mh-undefine-sequence sequence (list msg)))
2608 (setcdr entry (delq msg (mh-seq-msgs entry))))))
2609
c26cf6c8 2610(defun mh-undefine-sequence (seq msgs)
bdcfe844 2611 "Remove from the SEQ the list of MSGS."
a66894d8
BW
2612 (when (and (mh-valid-seq-p seq) msgs)
2613 (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
2614 "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
c26cf6c8 2615
c26cf6c8 2616(defun mh-define-sequence (seq msgs)
bdcfe844
BW
2617 "Define the SEQ to contain the list of MSGS.
2618Do not mark pseudo-sequences or empty sequences.
7bd10db5 2619Signals an error if SEQ is an invalid name."
c26cf6c8 2620 (if (and msgs
a66894d8 2621 (mh-valid-seq-p seq)
c3d9274a 2622 (not (mh-folder-name-p seq)))
c26cf6c8 2623 (save-excursion
c3d9274a
BW
2624 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2625 "-sequence" (symbol-name seq)
2626 (mh-coalesce-msg-list msgs)))))
c26cf6c8 2627
bdcfe844
BW
2628(defun mh-seq-containing-msg (msg &optional include-internal-flag)
2629 "Return a list of the sequences containing MSG.
2dcf34f9
BW
2630If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences
2631in list."
c26cf6c8 2632 (let ((l mh-seq-list)
c3d9274a 2633 (seqs ()))
c26cf6c8 2634 (while l
847b8219 2635 (and (memq msg (mh-seq-msgs (car l)))
c3d9274a
BW
2636 (or include-internal-flag
2637 (not (mh-internal-seq (mh-seq-name (car l)))))
2638 (setq seqs (cons (mh-seq-name (car l)) seqs)))
c26cf6c8
RS
2639 (setq l (cdr l)))
2640 seqs))
2641
c26cf6c8
RS
2642\f
2643
cee9f5c6 2644;;; Build mh-folder-mode keymap:
c26cf6c8
RS
2645
2646(suppress-keymap mh-folder-mode-map)
a1b4049d 2647
bdcfe844
BW
2648;; Use defalias to make sure the documented primary key bindings
2649;; appear in menu lists.
2650(defalias 'mh-alt-show 'mh-show)
2651(defalias 'mh-alt-refile-msg 'mh-refile-msg)
2652(defalias 'mh-alt-send 'mh-send)
2653(defalias 'mh-alt-visit-folder 'mh-visit-folder)
2654
5a4aad03 2655;; Save the "b" binding for a future `back'. Maybe?
a1b4049d 2656(gnus-define-keys mh-folder-mode-map
c3d9274a
BW
2657 " " mh-page-msg
2658 "!" mh-refile-or-write-again
924df208 2659 "'" mh-toggle-tick
c3d9274a
BW
2660 "," mh-header-display
2661 "." mh-alt-show
d103d8b3 2662 ";" mh-toggle-mh-decode-mime-flag
c3d9274a
BW
2663 ">" mh-write-msg-to-file
2664 "?" mh-help
2665 "E" mh-extract-rejected-mail
bdcfe844 2666 "M" mh-modify
c3d9274a
BW
2667 "\177" mh-previous-page
2668 "\C-d" mh-delete-msg-no-motion
2669 "\t" mh-index-next-folder
2670 [backtab] mh-index-previous-folder
2671 "\M-\t" mh-index-previous-folder
2672 "\e<" mh-first-msg
2673 "\e>" mh-last-msg
2674 "\ed" mh-redistribute
2675 "\r" mh-show
2676 "^" mh-alt-refile-msg
2677 "c" mh-copy-msg
2678 "d" mh-delete-msg
2679 "e" mh-edit-again
2680 "f" mh-forward
2681 "g" mh-goto-msg
2682 "i" mh-inc-folder
2683 "k" mh-delete-subject-or-thread
c3d9274a
BW
2684 "m" mh-alt-send
2685 "n" mh-next-undeleted-msg
2686 "\M-n" mh-next-unread-msg
2687 "o" mh-refile-msg
2688 "p" mh-previous-undeleted-msg
2689 "\M-p" mh-previous-unread-msg
2690 "q" mh-quit
2691 "r" mh-reply
2692 "s" mh-send
2693 "t" mh-toggle-showing
2694 "u" mh-undo
2695 "v" mh-index-visit-folder
2696 "x" mh-execute-commands
2697 "|" mh-pipe-msg)
a1b4049d
BW
2698
2699(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
c3d9274a 2700 "?" mh-prefix-help
a66894d8 2701 "'" mh-index-ticked-messages
c3d9274a 2702 "S" mh-sort-folder
f0d73c14 2703 "c" mh-catchup
c3d9274a 2704 "f" mh-alt-visit-folder
bdcfe844 2705 "i" mh-index-search
c3d9274a
BW
2706 "k" mh-kill-folder
2707 "l" mh-list-folders
924df208 2708 "n" mh-index-new-messages
c3d9274a
BW
2709 "o" mh-alt-visit-folder
2710 "p" mh-pack-folder
a66894d8 2711 "q" mh-index-sequenced-messages
c3d9274a
BW
2712 "r" mh-rescan-folder
2713 "s" mh-search-folder
2714 "u" mh-undo-folder
2715 "v" mh-visit-folder)
a1b4049d 2716
924df208
BW
2717(define-key mh-folder-mode-map "I" mh-inc-spool-map)
2718
2719(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
2720 "?" mh-prefix-help
2721 "b" mh-junk-blacklist
2722 "w" mh-junk-whitelist)
2723
f0d73c14
BW
2724(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
2725 "?" mh-prefix-help
f0d73c14
BW
2726 "C" mh-ps-print-toggle-color
2727 "F" mh-ps-print-toggle-faces
f0d73c14
BW
2728 "f" mh-ps-print-msg-file
2729 "l" mh-print-msg
553fb735 2730 "p" mh-ps-print-msg)
f0d73c14 2731
a1b4049d 2732(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
a66894d8 2733 "'" mh-narrow-to-tick
c3d9274a
BW
2734 "?" mh-prefix-help
2735 "d" mh-delete-msg-from-seq
2736 "k" mh-delete-seq
2737 "l" mh-list-sequences
2738 "n" mh-narrow-to-seq
2739 "p" mh-put-msg-in-seq
2740 "s" mh-msg-is-in-seq
2741 "w" mh-widen)
a1b4049d
BW
2742
2743(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
c3d9274a
BW
2744 "?" mh-prefix-help
2745 "u" mh-thread-ancestor
2746 "p" mh-thread-previous-sibling
2747 "n" mh-thread-next-sibling
2748 "t" mh-toggle-threads
2749 "d" mh-thread-delete
2750 "o" mh-thread-refile)
bdcfe844
BW
2751
2752(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
924df208 2753 "'" mh-narrow-to-tick
c3d9274a 2754 "?" mh-prefix-help
a66894d8
BW
2755 "c" mh-narrow-to-cc
2756 "f" mh-narrow-to-from
2757 "r" mh-narrow-to-range
c3d9274a 2758 "s" mh-narrow-to-subject
a66894d8 2759 "t" mh-narrow-to-to
c3d9274a 2760 "w" mh-widen)
a1b4049d
BW
2761
2762(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
c3d9274a
BW
2763 "?" mh-prefix-help
2764 "s" mh-store-msg ;shar
2765 "u" mh-store-msg) ;uuencode
a1b4049d
BW
2766
2767(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
c3d9274a
BW
2768 " " mh-page-digest
2769 "?" mh-prefix-help
2770 "\177" mh-page-digest-backwards
2771 "b" mh-burst-digest)
a1b4049d 2772
bdcfe844 2773(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
c3d9274a
BW
2774 "?" mh-prefix-help
2775 "a" mh-mime-save-parts
f0d73c14 2776 "e" mh-display-with-external-viewer
bdcfe844
BW
2777 "i" mh-folder-inline-mime-part
2778 "o" mh-folder-save-mime-part
f0d73c14 2779 "t" mh-toggle-mime-buttons
bdcfe844
BW
2780 "v" mh-folder-toggle-mime-part
2781 "\t" mh-next-button
2782 [backtab] mh-prev-button
2783 "\M-\t" mh-prev-button)
2784
a1b4049d 2785(cond
bdcfe844 2786 (mh-xemacs-flag
a1b4049d
BW
2787 (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
2788 (t
2789 (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
c26cf6c8 2790
942fc772
KH
2791;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
2792
c26cf6c8
RS
2793\f
2794
bdcfe844
BW
2795;;; Help Messages
2796
cee9f5c6
BW
2797;; If you add a new prefix, add appropriate text to the nil key.
2798;;
2799;; In general, messages are grouped logically. Taking the main commands for
2800;; example, the first line is "ways to view messages," the second line is
2801;; "things you can do with messages", and the third is "composing" messages.
2802;;
2803;; When adding a new prefix, ensure that the help message contains "what" the
2804;; prefix is for. For example, if the word "folder" were not present in the
5a4aad03 2805;; "F" entry, it would not be clear what these commands operated upon.
bdcfe844
BW
2806(defvar mh-help-messages
2807 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
c3d9274a 2808 "[d]elete, [o]refile, e[x]ecute,\n"
d103d8b3
BW
2809 "[s]end, [r]eply,\n"
2810 "[;]toggle MIME decoding.\n"
924df208 2811 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
a66894d8 2812 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
bdcfe844 2813
a66894d8
BW
2814 (?F "[l]ist; [v]isit folder;\n"
2815 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
c3d9274a 2816 "[p]ack; [S]ort; [r]escan; [k]ill")
553fb735
BW
2817 (?P "[p]rint message to [f]ile; old-style [l]pr printing;\n"
2818 "Toggle printing of [C]olors, [F]aces")
a66894d8 2819 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
c3d9274a
BW
2820 "[s]equences, [l]ist,\n"
2821 "[d]elete message from sequence, [k]ill sequence")
2822 (?T "[t]oggle, [d]elete, [o]refile thread")
a66894d8 2823 (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
bdcfe844
BW
2824 (?X "un[s]har, [u]udecode message")
2825 (?D "[b]urst digest")
2826 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
924df208
BW
2827 "[TAB] next; [SHIFT-TAB] previous")
2828 (?J "[b]lacklist, [w]hitelist message"))
bdcfe844
BW
2829 "Key binding cheat sheet.
2830
2831This is an associative array which is used to show the most common commands.
2832The key is a prefix char. The value is one or more strings which are
2833concatenated together and displayed in the minibuffer if ? is pressed after
2834the prefix character. The special key nil is used to display the
2835non-prefixed commands.
2836
2837The substitutions described in `substitute-command-keys' are performed as
2838well.")
a1b4049d 2839
bdcfe844 2840\f
a1b4049d 2841
f1ed9461 2842(dolist (mess '("^Cursor not pointing to message$"
c3d9274a 2843 "^There is no other window$"))
f1ed9461
DL
2844 (add-to-list 'debug-ignored-errors mess))
2845
bdcfe844
BW
2846(provide 'mh-e)
2847
cee9f5c6
BW
2848;; Local Variables:
2849;; indent-tabs-mode: nil
2850;; sentence-end-double-space: nil
2851;; End:
bdcfe844 2852
cee9f5c6 2853;; arch-tag: cce884de-bd37-4104-9963-e4439d5ed22b
c26cf6c8 2854;;; mh-e.el ends here