comparison lisp/mail/mh-e.el @ 49120:30c4902b654d

Upgraded to MH-E version 7.1.
author Bill Wohler <wohler@newt.com>
date Wed, 08 Jan 2003 23:21:16 +0000
parents 8aaba207e44b
children
comparison
equal deleted inserted replaced
49119:938f153410ae 49120:30c4902b654d
2 2
3 ;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc.
4 4
5 ;; Author: Bill Wohler <wohler@newt.com> 5 ;; Author: Bill Wohler <wohler@newt.com>
6 ;; Maintainer: Bill Wohler <wohler@newt.com> 6 ;; Maintainer: Bill Wohler <wohler@newt.com>
7 ;; Version: 7.0 7 ;; Version: 7.1
8 ;; Keywords: mail 8 ;; Keywords: mail
9 9
10 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
11 11
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
77 ;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu 77 ;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
78 ;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu 78 ;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
79 ;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the 79 ;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
80 ;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. 80 ;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
81 81
82 ;; $Id: mh-e.el,v 1.198 2002/11/29 15:33:37 wohler Exp $ 82 ;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $
83 83
84 ;;; Code: 84 ;;; Code:
85 85
86 (require 'cl) 86 (require 'cl)
87
88 (defvar recursive-load-depth-limit)
89 (eval-when (compile load eval)
90 (if (and (boundp 'recursive-load-depth-limit)
91 (integerp recursive-load-depth-limit)
92 (> 50 recursive-load-depth-limit))
93 (setq recursive-load-depth-limit 50)))
94
87 (require 'mh-utils) 95 (require 'mh-utils)
88 (require 'gnus-util) 96 (require 'gnus-util)
89 (require 'easymenu) 97 (require 'easymenu)
90 (if mh-xemacs-flag 98 (if mh-xemacs-flag
91 (require 'mh-xemacs-compat)) 99 (require 'mh-xemacs-compat))
92 100
93 ;; Shush the byte-compiler 101 ;; Shush the byte-compiler
94 (defvar font-lock-auto-fontify) 102 (defvar font-lock-auto-fontify)
95 (defvar font-lock-defaults) 103 (defvar font-lock-defaults)
96 (defvar tool-bar-mode) 104
97 105 (defconst mh-version "7.1" "Version number of MH-E.")
98 (defconst mh-version "7.0" "Version number of MH-E.") 106
99 107 ;;; Autoloads
100 ;;; Initial Autoloads
101 ;;; The autoloads for mh-undo-folder, mh-widen and mh-reply are needed before
102 ;;; they are used to avoid compiler warnings.
103 (autoload 'mh-undo-folder "mh-funcs"
104 "Undo all commands in current folder." t)
105 (autoload 'mh-widen "mh-seq"
106 "Remove restrictions from current folder, thereby showing all messages." t)
107 (autoload 'mh-reply "mh-comp"
108 "Reply to a MESSAGE (default: displayed message).
109 If optional prefix argument INCLUDEP provided, then include the message
110 in the reply using filter mhl.reply in your MH directory.
111 Prompts for type of addresses to reply to:
112 from sender only,
113 to sender and primary recipients,
114 cc/all sender and all recipients.
115 If the file named by `mh-repl-formfile' exists, it is used as a skeleton
116 for the reply. See also documentation for `\\[mh-send]' function." t)
117 (autoload 'mh-map-to-seq-msgs "mh-seq")
118 (autoload 'mh-notate-seq "mh-seq")
119 (autoload 'mh-destroy-postponed-handles "mh-mime")
120 (autoload 'mh-press-button "mh-mime")
121 (autoload 'mh-mime-save-part "mh-mime")
122 (autoload 'mh-mime-inline-part "mh-mime")
123 (autoload 'mh-mime-save-parts "mh-mime")
124 (autoload 'mh-thread-inc "mh-seq")
125 (autoload 'mh-thread-forget-message "mh-seq")
126 (autoload 'mh-thread-add-spaces "mh-seq")
127
128 (autoload 'Info-goto-node "info") 108 (autoload 'Info-goto-node "info")
129 109
130 110
131
132 ;;; Hooks:
133
134 (defgroup mh nil
135 "Emacs interface to the MH mail system."
136 :group 'mail)
137
138 (defgroup mh-hook nil
139 "Hooks to MH-E mode."
140 :prefix "mh-"
141 :group 'mh)
142
143 (defcustom mh-folder-mode-hook nil
144 "Invoked in `mh-folder-mode' on a new folder."
145 :type 'hook
146 :group 'mh-hook)
147
148 (defcustom mh-inc-folder-hook nil
149 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
150 :type 'hook
151 :group 'mh-hook)
152
153 (defcustom mh-folder-updated-hook nil
154 "Invoked when the folder actions (such as moves and deletes) are performed.
155 Variables that are useful in this hook include `mh-delete-list' and
156 `mh-refile-list' which can be used to see which changes are being made to
157 current folder, `mh-current-folder'."
158 :type 'hook
159 :group 'mh-hook)
160
161 (defcustom mh-delete-msg-hook nil
162 "Invoked after marking each message for deletion."
163 :type 'hook
164 :group 'mh-hook)
165
166 (defcustom mh-refile-msg-hook nil
167 "Invoked after marking each message for refiling."
168 :type 'hook
169 :group 'mh-hook)
170
171 (defcustom mh-folder-list-change-hook nil
172 "Invoked whenever the cached folder list `mh-folder-list' is changed."
173 :type 'hook
174 :group 'mh-hook)
175
176 (defcustom mh-before-quit-hook nil
177 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
178 See also `mh-quit-hook'."
179 :type 'hook
180 :group 'mh-hook)
181
182 (defcustom mh-quit-hook nil
183 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
184 See also `mh-before-quit-hook'."
185 :type 'hook
186 :group 'mh-hook)
187
188 (defcustom mh-unseen-updated-hook nil
189 "Invoked after the unseen sequence has been updated.
190 The variable `mh-seen-list' can be used to obtain the list of messages which
191 will be removed from the unseen sequence."
192 :type 'hook
193 :group 'mh-hook)
194
195 ;;; Personal preferences:
196
197 (defcustom mh-lpr-command-format "lpr -J '%s'"
198 "*Format for Unix command that prints a message.
199 The string should be a Unix command line, with the string '%s' where
200 the job's name (folder and message number) should appear. The formatted
201 message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
202 :type 'string
203 :group 'mh)
204
205 (defcustom mh-scan-prog "scan"
206 "*Program to run to generate one-line-per-message listing of a folder.
207 Normally \"scan\" or a file name linked to scan. This file is searched
208 for relative to the mh-progs directory unless it is an absolute pathname."
209 :type 'string
210 :group 'mh)
211 (make-variable-buffer-local 'mh-scan-prog)
212
213 (defcustom mh-inc-prog "inc"
214 "*Program to run to incorporate new mail into a folder.
215 Normally \"inc\". This file is searched for relative to
216 the mh-progs directory unless it is an absolute pathname."
217 :type 'string
218 :group 'mh)
219
220 (defcustom mh-print-background-flag nil
221 "*Non-nil means messages should be printed in the background.
222 WARNING: do not delete the messages until printing is finished;
223 otherwise, your output may be truncated."
224 :type 'boolean
225 :group 'mh)
226
227 (defcustom mh-recenter-summary-flag nil
228 "*Non-nil means to recenter the summary window.
229
230 Recenter the summary window when the show window is toggled off if non-nil."
231 :type 'boolean
232 :group 'mh)
233
234 (defcustom mh-do-not-confirm-flag nil
235 "*Non-nil means do not prompt for confirmation.
236 Commands such as `mh-pack-folder' prompt to confirm whether to process
237 outstanding moves and deletes or not before continuing. A non-nil setting will
238 perform the action--which is usually desired but cannot be retracted--without
239 question."
240 :type 'boolean
241 :group 'mh)
242
243 (defcustom mh-store-default-directory nil
244 "*Last directory used by \\[mh-store-msg]; default for next store.
245 A directory name string, or nil to use current directory."
246 :type '(choice (const :tag "Current" nil)
247 directory)
248 :group 'mh)
249 111
250 (defvar mh-note-deleted "D" 112 (defvar mh-note-deleted "D"
251 "String whose first character is used to notate deleted messages.") 113 "String whose first character is used to notate deleted messages.")
252 114
253 (defvar mh-note-refiled "^" 115 (defvar mh-note-refiled "^"
261 The string is displayed after the folder's name. nil for no annotation.") 123 The string is displayed after the folder's name. nil for no annotation.")
262 124
263 ;;; Parameterize MH-E to work with different scan formats. The defaults work 125 ;;; Parameterize MH-E to work with different scan formats. The defaults work
264 ;;; with the standard MH scan listings, in which the first 4 characters on 126 ;;; with the standard MH scan listings, in which the first 4 characters on
265 ;;; the line are the message number, followed by two places for notations. 127 ;;; the line are the message number, followed by two places for notations.
266
267 (defcustom mh-scan-format-file t
268 "Specifies the format file to pass to the scan program.
269 If t, the format string will be taken from the either `mh-scan-format-mh'
270 or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
271 If nil, the default scan output will be used.
272
273 If you customize the scan format, you may need to modify a few variables
274 containing regexps that MH-E uses to identify specific portions of the output.
275 Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
276 may also have to call `mh-set-cmd-note' with the width of your message
277 numbers. See also `mh-adaptive-cmd-note-flag'."
278 :type '(choice (const :tag "Use MH-E scan format" t)
279 (const :tag "Use default scan format" nil)
280 (file :tag "Specify a scan format file"))
281 :group 'mh)
282 128
283 ;; The following scan formats are passed to the scan program if the 129 ;; The following scan formats are passed to the scan program if the
284 ;; setting of `mh-scan-format-file' above is nil. They are identical 130 ;; setting of `mh-scan-format-file' above is nil. They are identical
285 ;; except the later one makes use of the nmh `decode' function to 131 ;; except the later one makes use of the nmh `decode' function to
286 ;; decode RFC 2047 encodings. If you just want to change the width of 132 ;; decode RFC 2047 encodings. If you just want to change the width of
384 "Regexp matching the message body beginning displayed in scan lines. 230 "Regexp matching the message body beginning displayed in scan lines.
385 The default `mh-folder-font-lock-keywords' expects this expression to contain 231 The default `mh-folder-font-lock-keywords' expects this expression to contain
386 at least one parenthesized expression which matches the body text.") 232 at least one parenthesized expression which matches the body text.")
387 233
388 (defvar mh-scan-subject-regexp 234 (defvar mh-scan-subject-regexp
389 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)" 235 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
390 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" 236 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
391 "*Regexp matching the subject string in MH folder mode. 237 "*Regexp matching the subject string in MH folder mode.
392 The default `mh-folder-font-lock-keywords' expects this expression to contain 238 The default `mh-folder-font-lock-keywords' expects this expression to contain
393 at least tree parenthesized expressions. The first is expected to match the Re: 239 at least tree parenthesized expressions. The first is expected to match the Re:
394 string, if any. The second matches an optional bracketed number after Re, 240 string, if any. The second matches an optional bracketed number after Re,
402 The default `mh-folder-font-lock-keywords' expects this expression to contain 248 The default `mh-folder-font-lock-keywords' expects this expression to contain
403 at least three parenthesized expressions. The first should match the 249 at least three parenthesized expressions. The first should match the
404 fontification hint, the second is found in `mh-scan-date-regexp', and the 250 fontification hint, the second is found in `mh-scan-date-regexp', and the
405 third should match the user name.") 251 third should match the user name.")
406 252
407 (defvar mh-folder-followup-face 'mh-folder-followup-face 253
408 "Face for highlighting Re: (followup) subject text in MH-Folder buffers.") 254
409 (defface mh-folder-followup-face
410 '((((class color) (background light))
411 (:foreground "blue3"))
412 (((class color) (background dark))
413 (:foreground "LightGoldenRod"))
414 (t
415 (:bold t)))
416 "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
417 :group 'mh)
418 (defvar mh-folder-address-face 'mh-folder-address-face
419 "Face for highlighting the address in MH-Folder buffers.")
420 (copy-face 'mh-folder-subject-face 'mh-folder-address-face)
421 (defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
422 "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
423 (copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
424
425 (defvar mh-folder-date-face 'mh-folder-date-face
426 "Face for highlighting the date in MH-Folder buffers.")
427 (defface mh-folder-date-face
428 '((((class color) (background light))
429 (:foreground "snow4"))
430 (((class color) (background dark))
431 (:foreground "snow3"))
432 (t
433 (:bold t)))
434 "Face for highlighting the date in MH-Folder buffers."
435 :group 'mh)
436
437 (defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
438 "Face for highlighting the message number in MH-Folder buffers.")
439 (defface mh-folder-msg-number-face
440 '((((class color) (background light))
441 (:foreground "snow4"))
442 (((class color) (background dark))
443 (:foreground "snow3"))
444 (t
445 (:bold t)))
446 "Face for highlighting the message number in MH-Folder buffers."
447 :group 'mh)
448
449 (defvar mh-folder-deleted-face 'mh-folder-deleted-face
450 "Face for highlighting deleted messages in MH-Folder buffers.")
451 (copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
452
453 (defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
454 "Face for the current message line in MH-Folder buffers.")
455 (defface mh-folder-cur-msg-face
456 '((((type tty pc) (class color))
457 (:background "LightGreen"))
458 (((class color) (background light))
459 (:background "LightGreen") ;Use this for solid background colour
460 ;;; (:underline t) ;Use this for underlining
461 )
462 (((class color) (background dark))
463 (:background "DarkOliveGreen4"))
464 (t (:underline t)))
465 "Face for the current message line in MH-Folder buffers."
466 :group 'mh)
467
468 ;;mh-folder-subject-face is defined in mh-utils since it's needed there
469 ;;for mh-show-subject-face.
470
471 (defvar mh-folder-refiled-face 'mh-folder-refiled-face
472 "Face for highlighting refiled messages in MH-Folder buffers.")
473 (defface mh-folder-refiled-face
474 '((((type tty) (class color)) (:foreground "yellow" :weight light))
475 (((class grayscale) (background light))
476 (:foreground "Gray90" :bold t :italic t))
477 (((class grayscale) (background dark))
478 (:foreground "DimGray" :bold t :italic t))
479 (((class color) (background light)) (:foreground "DarkGoldenrod"))
480 (((class color) (background dark)) (:foreground "LightGoldenrod"))
481 (t (:bold t :italic t)))
482 "Face for highlighting refiled messages in MH-Folder buffers."
483 :group 'mh)
484
485 (defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
486 "Face for highlighting the current message in MH-Folder buffers.")
487 (defface mh-folder-cur-msg-number-face
488 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
489 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
490 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
491 (((class color) (background light)) (:foreground "Purple"))
492 (((class color) (background dark)) (:foreground "Cyan"))
493 (t (:bold t)))
494 "Face for highlighting the current message in MH-Folder buffers."
495 :group 'mh)
496
497 (defvar mh-folder-to-face 'mh-folder-to-face
498 "Face for highlighting the To: string in MH-Folder buffers.")
499 (defface mh-folder-to-face
500 '((((type tty) (class color)) (:foreground "green"))
501 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
502 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
503 (((class color) (background light)) (:foreground "RosyBrown"))
504 (((class color) (background dark)) (:foreground "LightSalmon"))
505 (t (:italic t)))
506 "Face for highlighting the To: string in MH-Folder buffers."
507 :group 'mh)
508
509 (defvar mh-folder-body-face 'mh-folder-body-face
510 "Face for highlighting body text in MH-Folder buffers.")
511 (defface mh-folder-body-face
512 '((((type tty) (class color)) (:foreground "green"))
513 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
514 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
515 (((class color) (background light)) (:foreground "RosyBrown"))
516 (((class color) (background dark)) (:foreground "LightSalmon"))
517 (t (:italic t)))
518 "Face for highlighting body text in MH-Folder buffers."
519 :group 'mh)
520
521 (defvar mh-folder-font-lock-keywords 255 (defvar mh-folder-font-lock-keywords
522 (list 256 (list
257 ;; Folders when displaying index buffer
258 (list "^\\+.*"
259 '(0 mh-index-folder-face))
523 ;; Marked for deletion 260 ;; Marked for deletion
524 (list (concat mh-scan-deleted-msg-regexp ".*") 261 (list (concat mh-scan-deleted-msg-regexp ".*")
525 '(0 mh-folder-deleted-face)) 262 '(0 mh-folder-deleted-face))
526 ;; Marked for refile 263 ;; Marked for refile
527 (list (concat mh-scan-refiled-msg-regexp ".*") 264 (list (concat mh-scan-refiled-msg-regexp ".*")
533 (2 mh-folder-subject-face append t)) 270 (2 mh-folder-subject-face append t))
534 ;;current msg 271 ;;current msg
535 (list mh-scan-cur-msg-number-regexp 272 (list mh-scan-cur-msg-number-regexp
536 '(1 mh-folder-cur-msg-number-face)) 273 '(1 mh-folder-cur-msg-number-face))
537 (list mh-scan-good-msg-regexp 274 (list mh-scan-good-msg-regexp
538 '(1 mh-folder-msg-number-face)) ;; Msg number 275 '(1 mh-folder-msg-number-face)) ;; Msg number
539 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date 276 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
540 (list mh-scan-rcpt-regexp 277 (list mh-scan-rcpt-regexp
541 '(1 mh-folder-to-face) ;; To: 278 '(1 mh-folder-to-face) ;; To:
542 '(2 mh-folder-address-face)) ;; address 279 '(2 mh-folder-address-face)) ;; address
543 ;; scan font-lock name 280 ;; scan font-lock name
544 (list mh-scan-format-regexp 281 (list mh-scan-format-regexp
545 '(1 mh-folder-date-face) 282 '(1 mh-folder-date-face)
546 '(3 mh-folder-scan-format-face)) 283 '(3 mh-folder-scan-format-face))
547 ;; Current message line 284 ;; Current message line
548 (list mh-scan-cur-msg-regexp 285 (list mh-scan-cur-msg-regexp
549 '(1 mh-folder-cur-msg-face prepend t)) 286 '(1 mh-folder-cur-msg-face prepend t))
550 ;; Unseen messages in bold 287 ;; Unseen messages in bold
551 '(mh-folder-font-lock-unseen (1 'bold append t)) 288 '(mh-folder-font-lock-unseen (1 'bold append t)))
552 )
553 "Regexp keywords used to fontify the MH-Folder buffer.") 289 "Regexp keywords used to fontify the MH-Folder buffer.")
554 290
555 (defvar mh-scan-cmd-note-width 1 291 (defvar mh-scan-cmd-note-width 1
556 "Number of columns consumed by the cmd-note field in `mh-scan-format'. 292 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
557 This column will have one of the values: ` ', `D', `^', `+' and where 293 This column will have one of the values: ` ', `D', `^', `+' and where
587 (defvar mh-scan-from-mbox-sep-width 2 323 (defvar mh-scan-from-mbox-sep-width 2
588 "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'. 324 "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
589 This column will only ever have spaces in it.") 325 This column will only ever have spaces in it.")
590 326
591 (defvar mh-scan-field-from-start-offset 327 (defvar mh-scan-field-from-start-offset
592 (+ mh-scan-cmd-note-width 328 (+ mh-scan-cmd-note-width
593 mh-scan-destination-width 329 mh-scan-destination-width
594 mh-scan-date-width 330 mh-scan-date-width
595 mh-scan-date-flag-width) 331 mh-scan-date-flag-width)
596 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.") 332 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
597 333
598 (defvar mh-scan-field-from-end-offset 334 (defvar mh-scan-field-from-end-offset
599 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width) 335 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
600 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.") 336 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
601 337
602 (defvar mh-scan-field-subject-start-offset 338 (defvar mh-scan-field-subject-start-offset
603 (+ mh-scan-cmd-note-width 339 (+ mh-scan-cmd-note-width
604 mh-scan-destination-width 340 mh-scan-destination-width
605 mh-scan-date-width 341 mh-scan-date-width
632 "Provide name of unseen sequence from mhparam." 368 "Provide name of unseen sequence from mhparam."
633 (or mh-progs (mh-find-path)) 369 (or mh-progs (mh-find-path))
634 (save-excursion 370 (save-excursion
635 (let ((unseen-seq-name "unseen")) 371 (let ((unseen-seq-name "unseen"))
636 (with-temp-buffer 372 (with-temp-buffer
637 (unwind-protect 373 (unwind-protect
638 (progn 374 (progn
639 (call-process (expand-file-name "mhparam" mh-progs) 375 (call-process (expand-file-name "mhparam" mh-progs)
640 nil '(t t) nil "-component" "Unseen-Sequence") 376 nil '(t t) nil "-component" "Unseen-Sequence")
641 (goto-char (point-min)) 377 (goto-char (point-min))
642 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t) 378 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
643 (setq unseen-seq-name (match-string 1)))))) 379 (setq unseen-seq-name (match-string 1))))))
644 unseen-seq-name))) 380 unseen-seq-name)))
645 381
646 (defun mh-folder-unseen-seq-list () 382 (defun mh-folder-unseen-seq-list ()
647 "Return a list of unseen message numbers for current folder." 383 "Return a list of unseen message numbers for current folder."
648 (if (not mh-folder-unseen-seq-name) 384 (if (not mh-folder-unseen-seq-name)
651 ((not mh-folder-unseen-seq-name) 387 ((not mh-folder-unseen-seq-name)
652 nil) 388 nil)
653 (t 389 (t
654 (let ((folder mh-current-folder)) 390 (let ((folder mh-current-folder))
655 (save-excursion 391 (save-excursion
656 (with-temp-buffer 392 (with-temp-buffer
657 (unwind-protect 393 (unwind-protect
658 (progn 394 (progn
659 (call-process (expand-file-name "mark" mh-progs) 395 (call-process (expand-file-name "mark" mh-progs)
660 nil '(t t) nil 396 nil '(t t) nil
661 folder "-seq" mh-folder-unseen-seq-name 397 folder "-seq" mh-folder-unseen-seq-name
662 "-list") 398 "-list")
663 (goto-char (point-min)) 399 (goto-char (point-min))
664 (sort (mh-read-msg-list) '<))))))))) 400 (sort (mh-read-msg-list) '<)))))))))
665 401
666 (defvar mh-folder-unseen-seq-cache nil 402 (defvar mh-folder-unseen-seq-cache nil
667 "Internal cache variable used for font-lock in MH-E. 403 "Internal cache variable used for font-lock in MH-E.
668 Should only be non-nil through font-lock stepping, and nil once font-lock 404 Should only be non-nil through font-lock stepping, and nil once font-lock
669 is done highlighting.") 405 is done highlighting.")
711 447
712 448
713 449
714 ;;; Internal variables: 450 ;;; Internal variables:
715 451
716 (defvar mh-last-destination nil) ;Destination of last refile or write 452 (defvar mh-last-destination nil) ;Destination of last refile or write
717 ;command. 453 ;command.
718 (defvar mh-last-destination-folder nil) ;Destination of last refile command. 454 (defvar mh-last-destination-folder nil) ;Destination of last refile command.
719 (defvar mh-last-destination-write nil) ;Destination of last write command. 455 (defvar mh-last-destination-write nil) ;Destination of last write command.
720 456
721 (defvar mh-folder-mode-map (make-keymap) 457 (defvar mh-folder-mode-map (make-keymap)
722 "Keymap for MH folders.") 458 "Keymap for MH folders.")
723 459
724 (defvar mh-delete-list nil) ;List of msg numbers to delete. 460 (defvar mh-delete-list nil) ;List of msg numbers to delete.
725 461
726 (defvar mh-refile-list nil) ;List of folder names in mh-seq-list. 462 (defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
727 463
728 (defvar mh-next-direction 'forward) ;Direction to move to next message. 464 (defvar mh-next-direction 'forward) ;Direction to move to next message.
729 465
730 (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or 466 (defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
731 ;nil if not narrowed. 467 ;nil if not narrowed.
732 468
733 (defvar mh-view-ops ()) ;Stack of ops that change the folder 469 (defvar mh-view-ops ()) ;Stack of ops that change the folder
734 ;view (such as narrowing or threading). 470 ;view (such as narrowing or threading).
735 471
736 (defvar mh-first-msg-num nil) ;Number of first msg in buffer. 472 (defvar mh-index-data nil) ;Info about index search results
737 473 (defvar mh-index-previous-search nil)
738 (defvar mh-last-msg-num nil) ;Number of last msg in buffer. 474 (defvar mh-index-msg-checksum-map nil)
739 475 (defvar mh-index-checksum-origin-map nil)
740 (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. 476
477 (defvar mh-first-msg-num nil) ;Number of first msg in buffer.
478
479 (defvar mh-last-msg-num nil) ;Number of last msg in buffer.
480
481 (defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
741 482
742 ;;; Macros and generic functions: 483 ;;; Macros and generic functions:
743 484
744 (defun mh-mapc (function list) 485 (defun mh-mapc (function list)
745 "Apply FUNCTION to each element of LIST for side effects only." 486 "Apply FUNCTION to each element of LIST for side effects only."
749 490
750 (defun mh-scan-format () 491 (defun mh-scan-format ()
751 "Return \"-format\" argument for the scan program." 492 "Return \"-format\" argument for the scan program."
752 (if (equal mh-scan-format-file t) 493 (if (equal mh-scan-format-file t)
753 (list "-format" (if mh-nmh-flag 494 (list "-format" (if mh-nmh-flag
754 (list (mh-update-scan-format 495 (list (mh-update-scan-format
755 mh-scan-format-nmh mh-cmd-note)) 496 mh-scan-format-nmh mh-cmd-note))
756 (list (mh-update-scan-format 497 (list (mh-update-scan-format
757 mh-scan-format-mh mh-cmd-note)))) 498 mh-scan-format-mh mh-cmd-note))))
758 (if (not (equal mh-scan-format-file nil)) 499 (if (not (equal mh-scan-format-file nil))
759 (list "-format" mh-scan-format-file)))) 500 (list "-format" mh-scan-format-file))))
760 501
761 502
762 503
763 ;;; Entry points: 504 ;;; Entry points:
764 505
769 the Emacs front end to the MH mail system." 510 the Emacs front end to the MH mail system."
770 (interactive "P") 511 (interactive "P")
771 (mh-find-path) 512 (mh-find-path)
772 (if arg 513 (if arg
773 (call-interactively 'mh-visit-folder) 514 (call-interactively 'mh-visit-folder)
774 (mh-inc-folder))) 515 (mh-inc-folder)))
775 516
776 ;;;###autoload 517 ;;;###autoload
777 (defun mh-nmail (&optional arg) 518 (defun mh-nmail (&optional arg)
778 "Check for new mail in inbox folder. 519 "Check for new mail in inbox folder.
779 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, 520 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
780 the Emacs front end to the MH mail system." 521 the Emacs front end to the MH mail system."
781 (interactive "P") 522 (interactive "P")
782 (mh-find-path) ; init mh-inbox 523 (mh-find-path) ; init mh-inbox
783 (if arg 524 (if arg
784 (call-interactively 'mh-visit-folder) 525 (call-interactively 'mh-visit-folder)
785 (mh-visit-folder mh-inbox))) 526 (mh-visit-folder mh-inbox)))
786 527
787 528
788 529
789 ;;; User executable MH-E commands: 530 ;;; User executable MH-E commands:
790
791 531
792 (defun mh-delete-msg (msg-or-seq) 532 (defun mh-delete-msg (msg-or-seq)
793 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. 533 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
794 534
795 Default is the displayed message. If optional prefix argument is given then 535 Default is the displayed message. If optional prefix argument is given then
796 prompt for the message sequence. If variable `transient-mark-mode' is non-nil 536 prompt for the message sequence. If variable `transient-mark-mode' is non-nil
797 and the mark is active, then the selected region is marked for deletion." 537 and the mark is active, then the selected region is marked for deletion."
798 (interactive (list (cond 538 (interactive (list (cond
799 ((mh-mark-active-p t) 539 ((mh-mark-active-p t)
800 (mh-region-to-sequence (region-beginning) (region-end)) 540 (mh-region-to-msg-list (region-beginning) (region-end)))
801 'region)
802 (current-prefix-arg 541 (current-prefix-arg
803 (mh-read-seq-default "Delete" t)) 542 (mh-read-seq-default "Delete" t))
804 (t 543 (t
805 (mh-get-msg-num t))))) 544 (mh-get-msg-num t)))))
806 (mh-delete-msg-no-motion msg-or-seq) 545 (mh-delete-msg-no-motion msg-or-seq)
809 (defun mh-delete-msg-no-motion (msg-or-seq) 548 (defun mh-delete-msg-no-motion (msg-or-seq)
810 "Mark the specified MSG-OR-SEQ for subsequent deletion. 549 "Mark the specified MSG-OR-SEQ for subsequent deletion.
811 Default is the displayed message. If optional prefix argument is provided, 550 Default is the displayed message. If optional prefix argument is provided,
812 then prompt for the message sequence." 551 then prompt for the message sequence."
813 (interactive (list (if current-prefix-arg 552 (interactive (list (if current-prefix-arg
814 (mh-read-seq-default "Delete" t) 553 (mh-read-seq-default "Delete" t)
815 (mh-get-msg-num t)))) 554 (mh-get-msg-num t))))
816 (if (numberp msg-or-seq) 555 (if (numberp msg-or-seq)
817 (mh-delete-a-msg msg-or-seq) 556 (mh-delete-a-msg msg-or-seq)
818 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))) 557 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
819 558
820 (defun mh-execute-commands () 559 (defun mh-execute-commands ()
821 "Process outstanding delete and refile requests." 560 "Process outstanding delete and refile requests."
822 (interactive) 561 (interactive)
823 (if mh-narrowed-to-seq (mh-widen)) 562 (if mh-narrowed-to-seq (mh-widen))
824 (mh-process-commands mh-current-folder) 563 (mh-process-commands mh-current-folder)
825 (mh-set-scan-mode) 564 (mh-set-scan-mode)
826 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency 565 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
827 (mh-make-folder-mode-line) 566 (mh-make-folder-mode-line)
828 t) ; return t for write-file-functions 567 t) ; return t for write-file-functions
829 568
830 (defun mh-first-msg () 569 (defun mh-first-msg ()
831 "Move to the first message." 570 "Move to the first message."
832 (interactive) 571 (interactive)
833 (goto-char (point-min)) 572 (goto-char (point-min))
844 (and (not mh-showing-with-headers) 583 (and (not mh-showing-with-headers)
845 (or mhl-formfile mh-clean-message-header-flag) 584 (or mhl-formfile mh-clean-message-header-flag)
846 (mh-invalidate-show-buffer)) 585 (mh-invalidate-show-buffer))
847 (let ((mh-decode-mime-flag nil) 586 (let ((mh-decode-mime-flag nil)
848 (mhl-formfile nil) 587 (mhl-formfile nil)
849 (mh-clean-message-header-flag nil)) 588 (mh-clean-message-header-flag nil))
850 (mh-show-msg nil) 589 (mh-show-msg nil)
851 (mh-in-show-buffer (mh-show-buffer) 590 (mh-in-show-buffer (mh-show-buffer)
852 (goto-char (point-min)) 591 (goto-char (point-min))
853 (mh-recenter 0)) 592 (mh-recenter 0))
854 (setq mh-showing-with-headers t))) 593 (setq mh-showing-with-headers t)))
860 folder, otherwise uses the folder named by `mh-inbox'. 599 folder, otherwise uses the folder named by `mh-inbox'.
861 The value of `mh-inc-folder-hook' is a list of functions to be called, with no 600 The value of `mh-inc-folder-hook' is a list of functions to be called, with no
862 arguments, after incorporating new mail. 601 arguments, after incorporating new mail.
863 Do not call this function from outside MH-E; use \\[mh-rmail] instead." 602 Do not call this function from outside MH-E; use \\[mh-rmail] instead."
864 (interactive (list (if current-prefix-arg 603 (interactive (list (if current-prefix-arg
865 (expand-file-name 604 (expand-file-name
866 (read-file-name "inc mail from file: " 605 (read-file-name "inc mail from file: "
867 mh-user-path))))) 606 mh-user-path)))))
868 (let ((config (current-window-configuration))) 607 (let ((threading-needed-flag nil))
869 (if (not maildrop-name) 608 (let ((config (current-window-configuration)))
870 (cond ((not (get-buffer mh-inbox)) 609 (if (not maildrop-name)
871 (mh-make-folder mh-inbox) 610 (cond ((not (get-buffer mh-inbox))
872 (setq mh-previous-window-config config)) 611 (mh-make-folder mh-inbox)
873 ((not (eq (current-buffer) (get-buffer mh-inbox))) 612 (setq threading-needed-flag mh-show-threads-flag)
874 (switch-to-buffer mh-inbox) 613 (setq mh-previous-window-config config))
875 (setq mh-previous-window-config config))))) 614 ((not (eq (current-buffer) (get-buffer mh-inbox)))
876 (mh-get-new-mail maildrop-name) 615 (switch-to-buffer mh-inbox)
877 (if mh-showing-mode (mh-show)) 616 (setq mh-previous-window-config config)))))
878 (run-hooks 'mh-inc-folder-hook)) 617 (mh-get-new-mail maildrop-name)
618 (when (and threading-needed-flag
619 (save-excursion
620 (goto-char (point-min))
621 (or (null mh-large-folder)
622 (not (equal (forward-line mh-large-folder) 0))
623 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
624 nil))))
625 (mh-toggle-threads))
626 (if mh-showing-mode (mh-show))
627 (run-hooks 'mh-inc-folder-hook)))
879 628
880 (defun mh-last-msg () 629 (defun mh-last-msg ()
881 "Move to the last message." 630 "Move to the last message."
882 (interactive) 631 (interactive)
883 (goto-char (point-max)) 632 (goto-char (point-max))
884 (while (and (not (bobp)) (looking-at "^$")) 633 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
885 (forward-line -1)) 634 (forward-line -1))
886 (mh-recenter nil)) 635 (mh-recenter nil))
887 636
888 (defun mh-next-undeleted-msg (&optional arg) 637 (defun mh-next-undeleted-msg (&optional arg)
889 "Move to the next undeleted message ARG in window." 638 "Move to the next undeleted message ARG in window."
890 (interactive "p") 639 (interactive "p")
891 (setq mh-next-direction 'forward) 640 (setq mh-next-direction 'forward)
892 (forward-line 1) 641 (forward-line 1)
893 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg) 642 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
894 (beginning-of-line) 643 (beginning-of-line)
895 (mh-maybe-show)) 644 (mh-maybe-show))
896 (t (forward-line -1) 645 (t (forward-line -1)
897 (message "No more undeleted messages")))) 646 (message "No more undeleted messages"))))
898 647
899 (defun mh-refile-msg (msg-or-seq folder) 648 (defun mh-refile-msg (msg-or-seq folder)
900 "Refile MSG-OR-SEQ (default: displayed message) into FOLDER. 649 "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
901 If optional prefix argument provided, then prompt for message sequence. 650 If optional prefix argument provided, then prompt for message sequence.
902 If variable `transient-mark-mode' is non-nil and the mark is active, then the 651 If variable `transient-mark-mode' is non-nil and the mark is active, then the
903 selected region is marked for refiling." 652 selected region is marked for refiling."
904 (interactive 653 (interactive
905 (list (cond 654 (list (cond
906 ((mh-mark-active-p t) 655 ((mh-mark-active-p t)
907 (mh-region-to-sequence (region-beginning) (region-end)) 656 (mh-region-to-msg-list (region-beginning) (region-end)))
908 'region)
909 (current-prefix-arg 657 (current-prefix-arg
910 (mh-read-seq-default "Refile" t)) 658 (mh-read-seq-default "Refile" t))
911 (t 659 (t
912 (mh-get-msg-num t))) 660 (mh-get-msg-num t)))
913 (intern 661 (intern
914 (mh-prompt-for-folder 662 (mh-prompt-for-folder
915 "Destination" 663 "Destination"
916 (or (and mh-default-folder-for-message-function 664 (or (and mh-default-folder-for-message-function
917 (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) 665 (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
918 (save-excursion 666 (save-excursion
919 (set-buffer (get-buffer-create mh-temp-buffer)) 667 (set-buffer (get-buffer-create mh-temp-buffer))
920 (erase-buffer) 668 (erase-buffer)
921 (insert-file-contents refile-file) 669 (insert-file-contents refile-file)
922 (let ((buffer-file-name refile-file)) 670 (let ((buffer-file-name refile-file))
923 (funcall mh-default-folder-for-message-function))))) 671 (funcall mh-default-folder-for-message-function)))))
924 (and (eq 'refile (car mh-last-destination-folder)) 672 (and (eq 'refile (car mh-last-destination-folder))
925 (symbol-name (cdr mh-last-destination-folder))) 673 (symbol-name (cdr mh-last-destination-folder)))
926 "") 674 "")
927 t)))) 675 t))))
928 (setq mh-last-destination (cons 'refile folder) 676 (setq mh-last-destination (cons 'refile folder)
929 mh-last-destination-folder mh-last-destination) 677 mh-last-destination-folder mh-last-destination)
930 (if (numberp msg-or-seq) 678 (if (numberp msg-or-seq)
931 (mh-refile-a-msg msg-or-seq folder) 679 (mh-refile-a-msg msg-or-seq folder)
932 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder)) 680 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
933 (mh-next-msg)) 681 (mh-next-msg))
934 682
935 (defun mh-refile-or-write-again (message) 683 (defun mh-refile-or-write-again (message)
936 "Re-execute the last refile or write command on the given MESSAGE. 684 "Re-execute the last refile or write command on the given MESSAGE.
937 Default is the displayed message. Use the same folder or file as the previous 685 Default is the displayed message. Use the same folder or file as the previous
938 refile or write command." 686 refile or write command."
939 (interactive (list (mh-get-msg-num t))) 687 (interactive (list (mh-get-msg-num t)))
940 (if (null mh-last-destination) 688 (if (null mh-last-destination)
941 (error "No previous refile or write")) 689 (error "No previous refile or write"))
942 (cond ((eq (car mh-last-destination) 'refile) 690 (cond ((eq (car mh-last-destination) 'refile)
943 (mh-refile-a-msg message (cdr mh-last-destination)) 691 (mh-refile-a-msg message (cdr mh-last-destination))
944 (message "Destination folder: %s" (cdr mh-last-destination))) 692 (message "Destination folder: %s" (cdr mh-last-destination)))
945 (t 693 (t
946 (apply 'mh-write-msg-to-file message (cdr mh-last-destination)) 694 (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
947 (message "Destination: %s" (cdr mh-last-destination)))) 695 (message "Destination: %s" (cdr mh-last-destination))))
948 (mh-next-msg)) 696 (mh-next-msg))
949 697
950 (defun mh-quit () 698 (defun mh-quit ()
951 "Quit the current MH-E folder. 699 "Quit the current MH-E folder.
952 Restore the previous window configuration, if one exists. 700 Restore the previous window configuration, if one exists.
978 first if not displayed. Show the next undeleted message if looking at the 726 first if not displayed. Show the next undeleted message if looking at the
979 bottom of the current message." 727 bottom of the current message."
980 (interactive "P") 728 (interactive "P")
981 (if mh-showing-mode 729 (if mh-showing-mode
982 (if mh-page-to-next-msg-flag 730 (if mh-page-to-next-msg-flag
983 (if (equal mh-next-direction 'backward) 731 (if (equal mh-next-direction 'backward)
984 (mh-previous-undeleted-msg) 732 (mh-previous-undeleted-msg)
985 (mh-next-undeleted-msg)) 733 (mh-next-undeleted-msg))
986 (if (mh-in-show-buffer (mh-show-buffer) 734 (if (mh-in-show-buffer (mh-show-buffer)
987 (pos-visible-in-window-p (point-max))) 735 (pos-visible-in-window-p (point-max)))
988 (progn 736 (progn
989 (message (format 737 (message (format
990 "End of message (Type %s to read %s undeleted message)" 738 "End of message (Type %s to read %s undeleted message)"
991 (single-key-description last-input-event) 739 (single-key-description last-input-event)
992 (if (equal mh-next-direction 'backward) 740 (if (equal mh-next-direction 'backward)
993 "previous" 741 "previous"
994 "next"))) 742 "next")))
995 (setq mh-page-to-next-msg-flag t)) 743 (setq mh-page-to-next-msg-flag t))
996 (scroll-other-window arg))) 744 (scroll-other-window arg)))
997 (mh-show))) 745 (mh-show)))
998 746
999 (defun mh-previous-page (&optional arg) 747 (defun mh-previous-page (&optional arg)
1000 "Page the displayed message backwards. 748 "Page the displayed message backwards.
1001 Scrolls ARG lines or a full screen if no argument is supplied." 749 Scrolls ARG lines or a full screen if no argument is supplied."
1007 "Move to the previous undeleted message ARG in window." 755 "Move to the previous undeleted message ARG in window."
1008 (interactive "p") 756 (interactive "p")
1009 (setq mh-next-direction 'backward) 757 (setq mh-next-direction 'backward)
1010 (beginning-of-line) 758 (beginning-of-line)
1011 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg) 759 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
1012 (mh-maybe-show)) 760 (mh-maybe-show))
1013 (t (message "No previous undeleted message")))) 761 (t (message "No previous undeleted message"))))
762
763 (defun mh-previous-unread-msg (&optional count)
764 "Move to previous unread message.
765 With optional argument COUNT, COUNT-1 unread messages before current message
766 are skipped."
767 (interactive "p")
768 (unless (> count 0)
769 (error "The function mh-previous-unread-msg expects positive argument"))
770 (setq count (1- count))
771 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
772 (cur-msg (mh-get-msg-num nil)))
773 (cond ((and (not cur-msg) (not (bobp))
774 ;; If we are at the end of the buffer back up one line and go
775 ;; to unread message after that.
776 (progn
777 (forward-line -1)
778 (setq cur-msg (mh-get-msg-num nil)))
779 nil))
780 ((or (null unread-sequence) (not cur-msg))
781 ;; No unread message or there aren't any messages in buffer...
782 (message "No more unread messages"))
783 ((progn
784 ;; Skip count messages...
785 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
786 (setq unread-sequence (cdr unread-sequence)))
787 (while (> count 0)
788 (setq unread-sequence (cdr unread-sequence))
789 (setq count (1- count)))
790 (not (car unread-sequence)))
791 (message "No more unread messages"))
792 (t (mh-goto-msg (car unread-sequence))))))
1014 793
1015 (defun mh-goto-next-button (backward-flag &optional criterion) 794 (defun mh-goto-next-button (backward-flag &optional criterion)
1016 "Search for next button satisfying criterion. 795 "Search for next button satisfying criterion.
1017 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If 796 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
1018 CRITERION is a function or a symbol which has a function binding then that 797 CRITERION is a function or a symbol which has a function binding then that
1023 ;; Move to the next button in the buffer satisfying criterion 802 ;; Move to the next button in the buffer satisfying criterion
1024 (goto-char (or (save-excursion 803 (goto-char (or (save-excursion
1025 (beginning-of-line) 804 (beginning-of-line)
1026 ;; Find point before current button 805 ;; Find point before current button
1027 (let ((point-before-current-button 806 (let ((point-before-current-button
1028 (save-excursion 807 (save-excursion
1029 (while (get-text-property (point) 'mh-data) 808 (while (get-text-property (point) 'mh-data)
1030 (unless (= (forward-line 809 (unless (= (forward-line
1031 (if backward-flag 1 -1)) 810 (if backward-flag 1 -1))
1032 0) 811 0)
1033 (if backward-flag 812 (if backward-flag
1034 (goto-char (point-min)) 813 (goto-char (point-min))
1035 (goto-char (point-max))))) 814 (goto-char (point-max)))))
1036 (point)))) 815 (point))))
1037 ;; Skip over current button 816 ;; Skip over current button
1038 (while (and (get-text-property (point) 'mh-data) 817 (while (and (get-text-property (point) 'mh-data)
1039 (not (if backward-flag (bobp) (eobp)))) 818 (not (if backward-flag (bobp) (eobp))))
1040 (forward-line (if backward-flag -1 1))) 819 (forward-line (if backward-flag -1 1)))
1041 ;; Stop at next MIME button if any exists. 820 ;; Stop at next MIME button if any exists.
1042 (block loop 821 (block loop
1043 (while (/= (progn 822 (while (/= (progn
1044 (unless (= (forward-line 823 (unless (= (forward-line
1045 (if backward-flag -1 1)) 824 (if backward-flag -1 1))
1046 0) 825 0)
1047 (if backward-flag 826 (if backward-flag
1048 (goto-char (point-max)) 827 (goto-char (point-max))
1049 (goto-char (point-min))) 828 (goto-char (point-min)))
1050 (beginning-of-line)) 829 (beginning-of-line))
1051 (point)) 830 (point))
1052 point-before-current-button) 831 point-before-current-button)
1053 (when (and (get-text-property (point) 'mh-data) 832 (when (and (get-text-property (point) 'mh-data)
1054 (funcall criterion (point))) 833 (funcall criterion (point)))
1055 (return-from loop (point)))) 834 (return-from loop (point))))
1056 nil))) 835 nil)))
1057 (point)))) 836 (point))))
1058 837
1059 (defun mh-next-button (&optional backward-flag) 838 (defun mh-next-button (&optional backward-flag)
1060 "Go to the next MIME button. 839 "Go to the next MIME button.
1061 Advance point to the next MIME button in the show buffer. If the end 840 Advance point to the next MIME button in the show buffer. If the end
1084 searching for a suitable parts." 863 searching for a suitable parts."
1085 (unless mh-showing-mode 864 (unless mh-showing-mode
1086 (mh-show)) 865 (mh-show))
1087 (mh-in-show-buffer (mh-show-buffer) 866 (mh-in-show-buffer (mh-show-buffer)
1088 (let ((criterion 867 (let ((criterion
1089 (cond (part-index 868 (cond (part-index
1090 (lambda (p) 869 (lambda (p)
1091 (let ((part (get-text-property p 'mh-part))) 870 (let ((part (get-text-property p 'mh-part)))
1092 (and (integerp part) (= part part-index))))) 871 (and (integerp part) (= part part-index)))))
1093 (t (lambda (p) 872 (t (lambda (p)
1094 (if include-security-flag 873 (if include-security-flag
1095 (get-text-property p 'mh-data) 874 (get-text-property p 'mh-data)
1096 (integerp (get-text-property p 'mh-part))))))) 875 (integerp (get-text-property p 'mh-part)))))))
1097 (point (point))) 876 (point (point)))
1098 (cond ((and (get-text-property point 'mh-part) 877 (cond ((and (get-text-property point 'mh-part)
1099 (or (null part-index) 878 (or (null part-index)
1100 (= (get-text-property point 'mh-part) part-index))) 879 (= (get-text-property point 'mh-part) part-index)))
1101 (funcall action)) 880 (funcall action))
1151 If optional prefix argument RANGE is provided, prompt for the range of 930 If optional prefix argument RANGE is provided, prompt for the range of
1152 messages to display. Otherwise show the entire folder. 931 messages to display. Otherwise show the entire folder.
1153 If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 932 If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1154 refiles aren't carried out." 933 refiles aren't carried out."
1155 (interactive (list (if current-prefix-arg 934 (interactive (list (if current-prefix-arg
1156 (mh-read-msg-range "Range to scan [all]? ") 935 (mh-read-msg-range mh-current-folder t)
1157 nil))) 936 nil)))
1158 (setq mh-next-direction 'forward) 937 (setq mh-next-direction 'forward)
1159 (mh-reset-threads-and-narrowing) 938 (let ((threaded-flag (memq 'unthread mh-view-ops)))
1160 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)) 939 (mh-reset-threads-and-narrowing)
940 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
941 (cond (threaded-flag (mh-toggle-threads))
942 (mh-index-data (mh-index-insert-folder-headers)))))
1161 943
1162 (defun mh-write-msg-to-file (msg file no-headers) 944 (defun mh-write-msg-to-file (msg file no-headers)
1163 "Append MSG to the end of a FILE. 945 "Append MSG to the end of a FILE.
1164 If prefix argument NO-HEADERS is provided, write only the message body. 946 If prefix argument NO-HEADERS is provided, write only the message body.
1165 Otherwise send the entire message including the headers." 947 Otherwise send the entire message including the headers."
1166 (interactive 948 (interactive
1167 (list (mh-get-msg-num t) 949 (list (mh-get-msg-num t)
1168 (let ((default-dir (if (eq 'write (car mh-last-destination-write)) 950 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
1169 (file-name-directory 951 (file-name-directory
1170 (car (cdr mh-last-destination-write))) 952 (car (cdr mh-last-destination-write)))
1171 default-directory))) 953 default-directory)))
1172 (read-file-name (format "Save message%s in file: " 954 (read-file-name (format "Save message%s in file: "
1173 (if current-prefix-arg " body" "")) 955 (if current-prefix-arg " body" ""))
1174 default-dir 956 default-dir
1175 (if (eq 'write (car mh-last-destination-write)) 957 (if (eq 'write (car mh-last-destination-write))
1176 (car (cdr mh-last-destination-write)) 958 (car (cdr mh-last-destination-write))
1177 (expand-file-name "mail.out" default-dir)))) 959 (expand-file-name "mail.out" default-dir))))
1178 current-prefix-arg)) 960 current-prefix-arg))
1179 (let ((msg-file-to-output (mh-msg-filename msg)) 961 (let ((msg-file-to-output (mh-msg-filename msg))
1180 (output-file (mh-expand-file-name file))) 962 (output-file (mh-expand-file-name file)))
1181 (setq mh-last-destination (list 'write file (if no-headers 'no-headers)) 963 (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
1182 mh-last-destination-write mh-last-destination) 964 mh-last-destination-write mh-last-destination)
1183 (save-excursion 965 (save-excursion
1184 (set-buffer (get-buffer-create mh-temp-buffer)) 966 (set-buffer (get-buffer-create mh-temp-buffer))
1185 (erase-buffer) 967 (erase-buffer)
1186 (insert-file-contents msg-file-to-output) 968 (insert-file-contents msg-file-to-output)
1187 (goto-char (point-min)) 969 (goto-char (point-min))
1201 If optional prefix argument is provided, then prompt for the message sequence. 983 If optional prefix argument is provided, then prompt for the message sequence.
1202 If variable `transient-mark-mode' is non-nil and the mark is active, then the 984 If variable `transient-mark-mode' is non-nil and the mark is active, then the
1203 selected region is unmarked." 985 selected region is unmarked."
1204 (interactive (list (cond 986 (interactive (list (cond
1205 ((mh-mark-active-p t) 987 ((mh-mark-active-p t)
1206 (mh-region-to-sequence (region-beginning) (region-end)) 988 (mh-region-to-msg-list (region-beginning) (region-end)))
1207 'region)
1208 (current-prefix-arg 989 (current-prefix-arg
1209 (mh-read-seq-default "Undo" t)) 990 (mh-read-seq-default "Undo" t))
1210 (t 991 (t
1211 (mh-get-msg-num t))))) 992 (mh-get-msg-num t)))))
1212 (cond ((numberp msg-or-seq) 993 (cond ((numberp msg-or-seq)
1213 (let ((original-position (point))) 994 (let ((original-position (point)))
1214 (beginning-of-line) 995 (beginning-of-line)
1215 (while (not (or (looking-at mh-scan-deleted-msg-regexp) 996 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
1216 (looking-at mh-scan-refiled-msg-regexp) 997 (looking-at mh-scan-refiled-msg-regexp)
1217 (and (eq mh-next-direction 'forward) (bobp)) 998 (and (eq mh-next-direction 'forward) (bobp))
1218 (and (eq mh-next-direction 'backward) 999 (and (eq mh-next-direction 'backward)
1219 (save-excursion (forward-line) (eobp))))) 1000 (save-excursion (forward-line) (eobp)))))
1220 (forward-line (if (eq mh-next-direction 'forward) -1 1))) 1001 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1221 (if (or (looking-at mh-scan-deleted-msg-regexp) 1002 (if (or (looking-at mh-scan-deleted-msg-regexp)
1222 (looking-at mh-scan-refiled-msg-regexp)) 1003 (looking-at mh-scan-refiled-msg-regexp))
1223 (progn 1004 (progn
1224 (mh-undo-msg (mh-get-msg-num t)) 1005 (mh-undo-msg (mh-get-msg-num t))
1225 (mh-maybe-show)) 1006 (mh-maybe-show))
1226 (goto-char original-position) 1007 (goto-char original-position)
1227 (error "Nothing to undo")))) 1008 (error "Nothing to undo"))))
1228 (t 1009 (t
1229 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq))) 1010 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
1230 (if (not (mh-outstanding-commands-p)) 1011 (if (not (mh-outstanding-commands-p))
1231 (mh-set-folder-modified-p nil))) 1012 (mh-set-folder-modified-p nil)))
1013
1014 ;;;###mh-autoload
1015 (defun mh-folder-line-matches-show-buffer-p ()
1016 "Return t if the message under point in folder-mode is in the show buffer.
1017 Return nil in any other circumstance (no message under point, no show buffer,
1018 the message in the show buffer doesn't match."
1019 (and (eq major-mode 'mh-folder-mode)
1020 (mh-get-msg-num nil)
1021 mh-show-buffer
1022 (get-buffer mh-show-buffer)
1023 (buffer-file-name (get-buffer mh-show-buffer))
1024 (string-match ".*/\\([0-9]+\\)$"
1025 (buffer-file-name (get-buffer mh-show-buffer)))
1026 (string-equal
1027 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1028 (int-to-string (mh-get-msg-num nil)))))
1029
1030 (eval-when-compile (require 'gnus))
1031
1032 (defmacro mh-macro-expansion-time-gnus-version ()
1033 "Return Gnus version available at macro expansion time.
1034 The macro evaluates the Gnus version at macro expansion time. If MH-E was
1035 compiled then macro expansion happens at compile time."
1036 gnus-version)
1037
1038 (defun mh-run-time-gnus-version ()
1039 "Return Gnus version available at run time."
1040 (require 'gnus)
1041 gnus-version)
1232 1042
1233 ;;;###autoload 1043 ;;;###autoload
1234 (defun mh-version () 1044 (defun mh-version ()
1235 "Display version information about MH-E and the MH mail handling system." 1045 "Display version information about MH-E and the MH mail handling system."
1236 (interactive) 1046 (interactive)
1237 (mh-find-progs) 1047 (mh-find-progs)
1238 (set-buffer (get-buffer-create mh-temp-buffer)) 1048 (set-buffer (get-buffer-create mh-temp-buffer))
1239 (erase-buffer) 1049 (erase-buffer)
1240 ;; MH-E and Emacs versions. 1050 ;; MH-E version.
1241 (insert "MH-E " mh-version "\n\n" (emacs-version) "\n\n") 1051 (insert "MH-E " mh-version "\n\n")
1052 ;; MH-E compilation details.
1053 (insert "MH-E compilation details:\n")
1054 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1055 (gnus-compiled-version (if compiled-mhe
1056 (mh-macro-expansion-time-gnus-version)
1057 "N/A")))
1058 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1059 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1060 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1061 ;; Emacs version.
1062 (insert (emacs-version) "\n\n")
1242 ;; MH version. 1063 ;; MH version.
1243 (let ((help-start (point))) 1064 (let ((help-start (point)))
1244 (condition-case err-data 1065 (condition-case err-data
1245 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) 1066 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
1246 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) 1067 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
1247 (goto-char help-start) 1068 (goto-char help-start)
1248 (if mh-nmh-flag 1069 (if mh-nmh-flag
1249 (search-forward "inc -- " nil t) 1070 (search-forward "inc -- " nil t)
1250 (search-forward "version: " nil t)) 1071 (search-forward "version: " nil t))
1251 (delete-region help-start (point))) 1072 (delete-region help-start (point)))
1252 (goto-char (point-max)) 1073 (goto-char (point-max))
1253 (insert "mh-progs:\t" mh-progs "\n" 1074 (insert " mh-progs:\t" mh-progs "\n"
1254 "mh-lib:\t\t" mh-lib "\n" 1075 " mh-lib:\t" mh-lib "\n"
1255 "mh-lib-progs:\t" mh-lib-progs "\n\n") 1076 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1256 ;; Linux version. 1077 ;; Linux version.
1257 (condition-case () 1078 (condition-case ()
1258 (call-process "uname" nil t nil "-a") 1079 (call-process "uname" nil t nil "-a")
1259 (file-error)) 1080 (file-error))
1260 (goto-char (point-min)) 1081 (goto-char (point-min))
1261 (display-buffer mh-temp-buffer)) 1082 (display-buffer mh-temp-buffer))
1262 1083
1263 (defun mh-visit-folder (folder &optional range) 1084 (defun mh-parse-flist-output-line (line)
1085 "Parse LINE to generate folder name, unseen messages and total messages."
1086 (with-temp-buffer
1087 (insert line)
1088 (goto-char (point-max))
1089 (let (folder unseen total p)
1090 (when (search-backward " out of " (point-min) t)
1091 (setq total (read-from-string
1092 (buffer-substring-no-properties
1093 (match-end 0) (line-end-position))))
1094 (when (search-backward " in sequence " (point-min) t)
1095 (setq p (point))
1096 (when (search-backward " has " (point-min) t)
1097 (setq unseen (read-from-string (buffer-substring-no-properties
1098 (match-end 0) p)))
1099 (while (or (eq (char-after) ?+) (eq (char-after) ? ))
1100 (backward-char))
1101 (setq folder (buffer-substring-no-properties
1102 (point-min) (1+ (point))))
1103 (values (format "+%s" folder) (car unseen) (car total))))))))
1104
1105 (defun mh-folder-size (folder)
1106 "Find size of FOLDER."
1107 (with-temp-buffer
1108 (call-process (expand-file-name "flist" mh-progs) nil t nil
1109 "-norecurse" folder)
1110 (goto-char (point-min))
1111 (multiple-value-bind (folder1 unseen total)
1112 (mh-parse-flist-output-line
1113 (buffer-substring (point) (line-end-position)))
1114 (unless (equal folder folder1)
1115 (error "Call to flist failed on folder %s" folder))
1116 (values total unseen))))
1117
1118 (defun mh-visit-folder (folder &optional range index-data)
1264 "Visit FOLDER and display RANGE of messages. 1119 "Visit FOLDER and display RANGE of messages.
1265 Do not call this function from outside MH-E; see \\[mh-rmail] instead." 1120 Do not call this function from outside MH-E; see \\[mh-rmail] instead.
1266 (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t) 1121
1267 (mh-read-msg-range "Range [all]? "))) 1122 If RANGE is nil (the default if it is omitted when called non-interactively),
1268 (let ((config (current-window-configuration))) 1123 then all messages in FOLDER are displayed.
1124
1125 If an index buffer is being created then INDEX-DATA is used to initialize the
1126 index buffer specific data structures."
1127 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1128 (list folder-name (mh-read-msg-range folder-name))))
1129 (let ((config (current-window-configuration))
1130 (threaded-view-flag mh-show-threads-flag))
1131 (save-excursion
1132 (when (get-buffer folder)
1133 (set-buffer folder)
1134 (setq threaded-view-flag (memq 'unthread mh-view-ops))
1135 (mh-reset-threads-and-narrowing)))
1136 (when index-data
1137 (mh-make-folder folder)
1138 (setq mh-index-data (car index-data)
1139 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1140 mh-index-checksum-origin-map (make-hash-table :test #'equal))
1141 (mh-index-update-maps folder (cadr index-data)))
1269 (mh-scan-folder folder (or range "all")) 1142 (mh-scan-folder folder (or range "all"))
1143 (cond ((and threaded-view-flag
1144 (save-excursion
1145 (goto-char (point-min))
1146 (or (null mh-large-folder)
1147 (not (equal (forward-line mh-large-folder) 0))
1148 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1149 nil))))
1150 (mh-toggle-threads))
1151 (mh-index-data
1152 (mh-index-insert-folder-headers)))
1153 (unless mh-showing-mode (delete-other-windows))
1270 (setq mh-previous-window-config config)) 1154 (setq mh-previous-window-config config))
1271 nil) 1155 nil)
1272 1156
1157 ;;;###mh-autoload
1273 (defun mh-update-sequences () 1158 (defun mh-update-sequences ()
1274 "Update MH's Unseen-Sequence and current folder and message. 1159 "Update MH's Unseen-Sequence and current folder and message.
1275 Flush MH-E's state out to MH. The message at the cursor becomes current." 1160 Flush MH-E's state out to MH. The message at the cursor becomes current."
1276 (interactive) 1161 (interactive)
1277 ;; mh-update-sequences is the opposite of mh-read-folder-sequences, 1162 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
1278 ;; which updates MH-E's state from MH. 1163 ;; which updates MH-E's state from MH.
1279 (let ((folder-set (mh-update-unseen)) 1164 (let ((folder-set (mh-update-unseen))
1280 (new-cur (mh-get-msg-num nil))) 1165 (new-cur (mh-get-msg-num nil)))
1281 (if new-cur 1166 (if new-cur
1282 (let ((seq-entry (mh-find-seq 'cur))) 1167 (let ((seq-entry (mh-find-seq 'cur)))
1283 (mh-remove-cur-notation) 1168 (mh-remove-cur-notation)
1284 (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq 1169 (setcdr seq-entry
1285 (mh-define-sequence 'cur (list new-cur)) 1170 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1286 (beginning-of-line) 1171 (mh-define-sequence 'cur (list new-cur))
1287 (if (looking-at mh-scan-good-msg-regexp) 1172 (beginning-of-line)
1288 (mh-notate nil mh-note-cur mh-cmd-note))) 1173 (if (looking-at mh-scan-good-msg-regexp)
1174 (mh-notate nil mh-note-cur mh-cmd-note)))
1289 (or folder-set 1175 (or folder-set
1290 (save-excursion 1176 (save-excursion
1291 ;; psg - mh-current-folder is nil if mh-summary-height < 4 ! 1177 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1292 ;; So I added this sanity check. 1178 ;; So I added this sanity check.
1293 (if (stringp mh-current-folder) 1179 (if (stringp mh-current-folder)
1294 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast") 1180 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
1295 (mh-exec-cmd-quiet t "folder" "-fast"))))))) 1181 (mh-exec-cmd-quiet t "folder" "-fast")))))))
1303 The value of `mh-delete-msg-hook' is a list of functions to be called, with no 1189 The value of `mh-delete-msg-hook' is a list of functions to be called, with no
1304 arguments, after the message has been deleted." 1190 arguments, after the message has been deleted."
1305 (save-excursion 1191 (save-excursion
1306 (mh-goto-msg msg nil t) 1192 (mh-goto-msg msg nil t)
1307 (if (looking-at mh-scan-refiled-msg-regexp) 1193 (if (looking-at mh-scan-refiled-msg-regexp)
1308 (error "Message %d is refiled. Undo refile before deleting" msg)) 1194 (error "Message %d is refiled. Undo refile before deleting" msg))
1309 (if (looking-at mh-scan-deleted-msg-regexp) 1195 (if (looking-at mh-scan-deleted-msg-regexp)
1310 nil 1196 nil
1311 (mh-set-folder-modified-p t) 1197 (mh-set-folder-modified-p t)
1312 (setq mh-delete-list (cons msg mh-delete-list)) 1198 (setq mh-delete-list (cons msg mh-delete-list))
1313 (mh-notate msg mh-note-deleted mh-cmd-note) 1199 (mh-notate msg mh-note-deleted mh-cmd-note)
1314 (run-hooks 'mh-delete-msg-hook)))) 1200 (run-hooks 'mh-delete-msg-hook))))
1315 1201
1316 (defun mh-refile-a-msg (msg folder) 1202 (defun mh-refile-a-msg (msg folder)
1317 "Refile MSG in FOLDER. 1203 "Refile MSG in FOLDER.
1318 Folder is a symbol, not a string. 1204 Folder is a symbol, not a string.
1319 The value of `mh-refile-msg-hook' is a list of functions to be called, with no 1205 The value of `mh-refile-msg-hook' is a list of functions to be called, with no
1320 arguments, after the message has been refiled." 1206 arguments, after the message has been refiled."
1321 (save-excursion 1207 (save-excursion
1322 (mh-goto-msg msg nil t) 1208 (mh-goto-msg msg nil t)
1323 (cond ((looking-at mh-scan-deleted-msg-regexp) 1209 (cond ((looking-at mh-scan-deleted-msg-regexp)
1324 (error "Message %d is deleted. Undo delete before moving" msg)) 1210 (error "Message %d is deleted. Undo delete before moving" msg))
1325 ((looking-at mh-scan-refiled-msg-regexp) 1211 ((looking-at mh-scan-refiled-msg-regexp)
1326 (if (y-or-n-p 1212 (if (y-or-n-p
1327 (format "Message %d already refiled. Copy to %s as well? " 1213 (format "Message %d already refiled. Copy to %s as well? "
1328 msg folder)) 1214 msg folder))
1329 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" 1215 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1330 "-src" mh-current-folder 1216 "-src" mh-current-folder
1331 (symbol-name folder)) 1217 (symbol-name folder))
1332 (message "Message not copied."))) 1218 (message "Message not copied.")))
1333 (t 1219 (t
1334 (mh-set-folder-modified-p t) 1220 (mh-set-folder-modified-p t)
1335 (if (null (assoc folder mh-refile-list)) 1221 (cond ((null (assoc folder mh-refile-list))
1336 (push (list folder msg) mh-refile-list) 1222 (push (list folder msg) mh-refile-list))
1337 (pushnew msg (cdr (assoc folder mh-refile-list)))) 1223 ((not (member msg (cdr (assoc folder mh-refile-list))))
1338 (mh-notate msg mh-note-refiled mh-cmd-note) 1224 (push msg (cdr (assoc folder mh-refile-list)))))
1339 (run-hooks 'mh-refile-msg-hook))))) 1225 (mh-notate msg mh-note-refiled mh-cmd-note)
1226 (run-hooks 'mh-refile-msg-hook)))))
1340 1227
1341 (defun mh-next-msg () 1228 (defun mh-next-msg ()
1342 "Move backward or forward to the next undeleted message in the buffer." 1229 "Move backward or forward to the next undeleted message in the buffer."
1343 (if (eq mh-next-direction 'forward) 1230 (if (eq mh-next-direction 'forward)
1344 (mh-next-undeleted-msg 1) 1231 (mh-next-undeleted-msg 1)
1345 (mh-previous-undeleted-msg 1))) 1232 (mh-previous-undeleted-msg 1)))
1233
1234 (defun mh-next-unread-msg (&optional count)
1235 "Move to next unread message.
1236 With optional argument COUNT, COUNT-1 unread messages are skipped."
1237 (interactive "p")
1238 (unless (> count 0)
1239 (error "The function mh-next-unread-msg expects positive argument"))
1240 (setq count (1- count))
1241 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1242 (cur-msg (mh-get-msg-num nil)))
1243 (cond ((and (not cur-msg) (not (bobp))
1244 ;; If we are at the end of the buffer back up one line and go
1245 ;; to unread message after that.
1246 (progn
1247 (forward-line -1)
1248 (setq cur-msg (mh-get-msg-num nil)))
1249 nil))
1250 ((or (null unread-sequence) (not cur-msg))
1251 ;; No unread message or there aren't any messages in buffer...
1252 (message "No more unread messages"))
1253 ((progn
1254 ;; Skip messages
1255 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1256 (setq unread-sequence (cdr unread-sequence)))
1257 (while (> count 0)
1258 (setq unread-sequence (cdr unread-sequence))
1259 (setq count (1- count)))
1260 (not (car unread-sequence)))
1261 (message "No more unread messages"))
1262 (t (mh-goto-msg (car unread-sequence))))))
1346 1263
1347 (defun mh-set-scan-mode () 1264 (defun mh-set-scan-mode ()
1348 "Display the scan listing buffer, but do not show a message." 1265 "Display the scan listing buffer, but do not show a message."
1349 (if (get-buffer mh-show-buffer) 1266 (if (get-buffer mh-show-buffer)
1350 (delete-windows-on mh-show-buffer)) 1267 (delete-windows-on mh-show-buffer))
1354 (mh-recenter nil))) 1271 (mh-recenter nil)))
1355 1272
1356 (defun mh-undo-msg (msg) 1273 (defun mh-undo-msg (msg)
1357 "Undo the deletion or refile of one MSG." 1274 "Undo the deletion or refile of one MSG."
1358 (cond ((memq msg mh-delete-list) 1275 (cond ((memq msg mh-delete-list)
1359 (setq mh-delete-list (delq msg mh-delete-list))) 1276 (setq mh-delete-list (delq msg mh-delete-list)))
1360 (t 1277 (t
1361 (dolist (folder-msg-list mh-refile-list) 1278 (dolist (folder-msg-list mh-refile-list)
1362 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) 1279 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1363 (setq mh-refile-list (remove-if #'(lambda (x) (null (cdr x))) 1280 (setq mh-refile-list (loop for x in mh-refile-list
1364 mh-refile-list)))) 1281 unless (null (cdr x)) collect x))))
1365 (mh-notate msg ? mh-cmd-note)) 1282 (mh-notate msg ? mh-cmd-note))
1366 1283
1367 1284
1368 1285
1369 ;;; The folder data abstraction. 1286 ;;; The folder data abstraction.
1461 "--" 1378 "--"
1462 ["Quit MH-E" mh-quit t])) 1379 ["Quit MH-E" mh-quit t]))
1463 1380
1464 1381
1465 1382
1466 ;;; Support for emacs21 toolbar using gnus/message.el icons (and code).
1467 (eval-when-compile (defvar tool-bar-map))
1468 (defvar mh-folder-tool-bar-map nil)
1469 (defvar mh-folder-seq-tool-bar-map nil
1470 "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
1471 (when (and (fboundp 'tool-bar-add-item)
1472 tool-bar-mode)
1473 (setq mh-folder-tool-bar-map
1474 (let ((tool-bar-map (make-sparse-keymap)))
1475 (tool-bar-add-item "mail" 'mh-inc-folder 'mh-foldertoolbar-inc-folder
1476 :help "Incorporate new mail in Inbox")
1477 (tool-bar-add-item "attach" 'mh-mime-save-parts
1478 'mh-foldertoolbar-mime-save-parts
1479 :help "Save MIME parts")
1480
1481 (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
1482 'mh-foldertoolbar-prev :help "Previous message")
1483 (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
1484 :help "Page this message")
1485 (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
1486 'mh-foldertoolbar-next :help "Next message")
1487
1488 (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
1489 :help "Mark for deletion")
1490 (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
1491 :help "Refile this message")
1492 (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
1493 :help "Undo this mark")
1494 (tool-bar-add-item "execute" 'mh-execute-commands 'mh-foldertoolbar-exec
1495 :help "Perform moves and deletes")
1496
1497 (tool-bar-add-item "show" 'mh-toggle-showing
1498 'mh-foldertoolbar-toggle-show
1499 :help "Toggle showing message")
1500
1501 (cond
1502 (mh-tool-bar-reply-3-buttons-flag
1503 (tool-bar-add-item "reply-from" (lambda (&optional arg)
1504 (interactive "P")
1505 (mh-reply (mh-get-msg-num nil)
1506 "from" arg))
1507 'mh-foldertoolbar-reply-from
1508 :help "Reply to \"from\"")
1509 (tool-bar-add-item "reply-to" (lambda (&optional arg)
1510 (interactive "P")
1511 (mh-reply (mh-get-msg-num nil)
1512 "to" arg))
1513 'mh-foldertoolbar-reply-to
1514 :help "Reply to \"to\"")
1515 (tool-bar-add-item "reply-all" (lambda (&optional arg)
1516 (interactive "P")
1517 (mh-reply (mh-get-msg-num nil)
1518 "all" arg))
1519 'mh-foldertoolbar-reply-all
1520 :help "Reply to \"all\""))
1521 (t
1522 (tool-bar-add-item "mail/reply2" 'mh-reply 'mh-foldertoolbar-reply
1523 :help "Reply to this message")))
1524 (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
1525 :help "Compose new message")
1526
1527 (tool-bar-add-item "rescan" 'mh-rescan-folder 'mh-foldertoolbar-rescan
1528 :help "Rescan this folder")
1529 (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
1530 :help "Repack this folder")
1531
1532 (tool-bar-add-item "search"
1533 (lambda (&optional arg)
1534 (interactive "P")
1535 (call-interactively mh-tool-bar-search-function))
1536 'mh-foldertoolbar-search :help "Search")
1537 (tool-bar-add-item "fld_open" 'mh-visit-folder 'mh-foldertoolbar-visit
1538 :help "Visit other folder")
1539
1540 (tool-bar-add-item "preferences" (lambda ()
1541 (interactive)
1542 (customize-group "mh"))
1543 'mh-foldertoolbar-customize
1544 :help "mh-e preferences")
1545 (tool-bar-add-item "help" (lambda ()
1546 (interactive)
1547 (Info-goto-node "(mh-e)Top"))
1548 'mh-foldertoolbar-help :help "Help")
1549 tool-bar-map))
1550
1551 (setq mh-folder-seq-tool-bar-map
1552 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
1553 (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
1554 :help "Widen from this sequence")
1555 tool-bar-map))
1556 )
1557
1558
1559
1560 (defmacro mh-remove-xemacs-horizontal-scrollbar () 1383 (defmacro mh-remove-xemacs-horizontal-scrollbar ()
1561 "Get rid of the horizontal scrollbar that XEmacs insists on putting in." 1384 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1562 (when mh-xemacs-flag 1385 (when mh-xemacs-flag
1563 `(if (and (featurep 'scrollbar) 1386 `(if (and (featurep 'scrollbar)
1564 (fboundp 'set-specifier)) 1387 (fboundp 'set-specifier))
1569 "Return `write-file-functions' if it exists. 1392 "Return `write-file-functions' if it exists.
1570 Otherwise return `local-write-file-hooks'. This macro exists purely for 1393 Otherwise return `local-write-file-hooks'. This macro exists purely for
1571 compatibility. The former symbol is used in Emacs 21.4 onward while the latter 1394 compatibility. The former symbol is used in Emacs 21.4 onward while the latter
1572 is used in previous versions and XEmacs." 1395 is used in previous versions and XEmacs."
1573 (if (boundp 'write-file-functions) 1396 (if (boundp 'write-file-functions)
1574 ''write-file-functions ;Emacs 21.4 1397 ''write-file-functions ;Emacs 21.4
1575 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs 1398 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
1576 1399
1577 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" 1400 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1578 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> 1401 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
1579 1402
1580 You can show the message the cursor is pointing to, and step through the 1403 You can show the message the cursor is pointing to, and step through the
1592 When a folder is visited, the hook `mh-folder-mode-hook' is run. 1415 When a folder is visited, the hook `mh-folder-mode-hook' is run.
1593 1416
1594 \\{mh-folder-mode-map}" 1417 \\{mh-folder-mode-map}"
1595 1418
1596 (make-local-variable 'font-lock-defaults) 1419 (make-local-variable 'font-lock-defaults)
1597 (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) 1420 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1598 (mh-make-local-vars 1421 (mh-make-local-vars
1599 'mh-current-folder (buffer-name) ; Name of folder, a string 1422 'mh-current-folder (buffer-name) ; Name of folder, a string
1600 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 1423 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1601 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" 1424 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1602 (file-name-as-directory (mh-expand-file-name (buffer-name))) 1425 (file-name-as-directory (mh-expand-file-name (buffer-name)))
1603 'mh-showing-mode nil ; Show message also? 1426 'mh-showing-mode nil ; Show message also?
1604 'mh-delete-list nil ; List of msgs nums to delete 1427 'mh-delete-list nil ; List of msgs nums to delete
1605 'mh-refile-list nil ; List of folder names in mh-seq-list 1428 'mh-refile-list nil ; List of folder names in mh-seq-list
1606 'mh-seq-list nil ; Alist of (seq . msgs) nums 1429 'mh-seq-list nil ; Alist of (seq . msgs) nums
1607 'mh-seen-list nil ; List of displayed messages 1430 'mh-seen-list nil ; List of displayed messages
1608 'mh-next-direction 'forward ; Direction to move to next message 1431 'mh-next-direction 'forward ; Direction to move to next message
1609 'mh-narrowed-to-seq nil ; Sequence display is narrowed to 1432 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1610 'mh-view-ops () ; Stack that keeps track of the order 1433 'mh-view-ops () ; Stack that keeps track of the order
1611 ; in which narrowing/threading has been 1434 ; in which narrowing/threading has been
1612 ; carried out. 1435 ; carried out.
1613 'mh-first-msg-num nil ; Number of first msg in buffer 1436 'mh-index-data nil ; If the folder was created by a call
1614 'mh-last-msg-num nil ; Number of last msg in buffer 1437 ; to mh-index-search this contains info
1615 'mh-msg-count nil ; Number of msgs in buffer 1438 ; about the search results.
1616 'mh-mode-line-annotation nil ; Indiction this is not the full folder 1439 'mh-index-previous-search nil ; Previous folder and search-regexp
1617 'mh-previous-window-config nil) ; Previous window configuration 1440 'mh-index-msg-checksum-map nil ; msg -> checksum map
1441 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
1442 'mh-first-msg-num nil ; Number of first msg in buffer
1443 'mh-last-msg-num nil ; Number of last msg in buffer
1444 'mh-msg-count nil ; Number of msgs in buffer
1445 'mh-mode-line-annotation nil ; Indicates message range
1446 'mh-previous-window-config nil) ; Previous window configuration
1618 (mh-remove-xemacs-horizontal-scrollbar) 1447 (mh-remove-xemacs-horizontal-scrollbar)
1619 (setq truncate-lines t) 1448 (setq truncate-lines t)
1620 (auto-save-mode -1) 1449 (auto-save-mode -1)
1621 (setq buffer-offer-save t) 1450 (setq buffer-offer-save t)
1622 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) 1451 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
1623 (make-local-variable 'revert-buffer-function) 1452 (make-local-variable 'revert-buffer-function)
1624 (make-local-variable 'hl-line-mode) ; avoid pollution 1453 (make-local-variable 'hl-line-mode) ; avoid pollution
1625 (if (fboundp 'hl-line-mode) 1454 (if (fboundp 'hl-line-mode)
1626 (hl-line-mode 1)) 1455 (hl-line-mode 1))
1627 (setq revert-buffer-function 'mh-undo-folder) 1456 (setq revert-buffer-function 'mh-undo-folder)
1628 (or (assq 'mh-showing-mode minor-mode-alist) 1457 (or (assq 'mh-showing-mode minor-mode-alist)
1629 (setq minor-mode-alist 1458 (setq minor-mode-alist
1630 (cons '(mh-showing-mode " Show") minor-mode-alist))) 1459 (cons '(mh-showing-mode " Show") minor-mode-alist)))
1631 (easy-menu-add mh-folder-sequence-menu) 1460 (easy-menu-add mh-folder-sequence-menu)
1632 (easy-menu-add mh-folder-message-menu) 1461 (easy-menu-add mh-folder-message-menu)
1633 (easy-menu-add mh-folder-folder-menu) 1462 (easy-menu-add mh-folder-folder-menu)
1634 (if (and (boundp 'tool-bar-mode) tool-bar-mode) 1463 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1635 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) 1464 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
1636 (if (and mh-xemacs-flag 1465 (if (and mh-xemacs-flag
1637 font-lock-auto-fontify) 1466 font-lock-auto-fontify)
1638 (turn-on-font-lock))) ; Force font-lock in XEmacs. 1467 (turn-on-font-lock))) ; Force font-lock in XEmacs.
1639 1468
1640 (defun mh-make-local-vars (&rest pairs) 1469 (defun mh-make-local-vars (&rest pairs)
1641 "Initialize local variables according to the variable-value PAIRS." 1470 "Initialize local variables according to the variable-value PAIRS."
1642 1471
1643 (while pairs 1472 (while pairs
1648 "Scan the FOLDER over the RANGE. 1477 "Scan the FOLDER over the RANGE.
1649 If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and 1478 If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1650 refiles aren't carried out. 1479 refiles aren't carried out.
1651 Return in the folder's buffer." 1480 Return in the folder's buffer."
1652 (cond ((null (get-buffer folder)) 1481 (cond ((null (get-buffer folder))
1653 (mh-make-folder folder)) 1482 (mh-make-folder folder))
1654 (t 1483 (t
1655 (or dont-exec-pending (mh-process-or-undo-commands folder)) 1484 (or dont-exec-pending (mh-process-or-undo-commands folder))
1656 (switch-to-buffer folder))) 1485 (switch-to-buffer folder)))
1657 (mh-regenerate-headers range) 1486 (mh-regenerate-headers range)
1658 (if (zerop (buffer-size)) 1487 (if (zerop (buffer-size))
1659 (if (equal range "all") 1488 (if (equal range "all")
1660 (message "Folder %s is empty" folder) 1489 (message "Folder %s is empty" folder)
1661 (message "No messages in %s, range %s" folder range)) 1490 (message "No messages in %s, range %s" folder range))
1662 (mh-goto-cur-msg)) 1491 (mh-goto-cur-msg))
1663 (save-excursion 1492 (save-excursion
1664 (when dont-exec-pending 1493 (when dont-exec-pending
1665 ;; Re-annotate messages to be refiled... 1494 ;; Re-annotate messages to be refiled...
1666 (dolist (folder-msg-list mh-refile-list) 1495 (dolist (folder-msg-list mh-refile-list)
1668 (mh-notate msg mh-note-refiled mh-cmd-note))) 1497 (mh-notate msg mh-note-refiled mh-cmd-note)))
1669 ;; Re-annotate messages to be deleted... 1498 ;; Re-annotate messages to be deleted...
1670 (dolist (msg mh-delete-list) 1499 (dolist (msg mh-delete-list)
1671 (mh-notate msg mh-note-deleted mh-cmd-note))))) 1500 (mh-notate msg mh-note-deleted mh-cmd-note)))))
1672 1501
1502 (defun mh-set-cmd-note (width)
1503 "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
1504
1505 If `mh-scan-format-file' specifies nil or a filename, then this function
1506 will NOT update `mh-cmd-note'."
1507 ;; Add one to the width to always have whitespace in column zero.
1508 (setq width (max (1+ width) 2))
1509 (if (and (equal mh-scan-format-file t)
1510 (not (eq mh-cmd-note width)))
1511 (setq mh-cmd-note width))
1512 mh-cmd-note)
1513
1673 (defun mh-regenerate-headers (range &optional update) 1514 (defun mh-regenerate-headers (range &optional update)
1674 "Scan folder over range RANGE. 1515 "Scan folder over range RANGE.
1675 If UPDATE, append the scan lines, otherwise replace." 1516 If UPDATE, append the scan lines, otherwise replace."
1676 (let ((folder mh-current-folder) 1517 (let ((folder mh-current-folder)
1677 (range (if (and range (atom range)) (list range) range)) 1518 (range (if (and range (atom range)) (list range) range))
1678 scan-start) 1519 scan-start)
1679 (message "Scanning %s..." folder) 1520 (message "Scanning %s..." folder)
1680 (with-mh-folder-updating (nil) 1521 (with-mh-folder-updating (nil)
1681 (if update 1522 (if update
1682 (goto-char (point-max)) 1523 (goto-char (point-max))
1683 (delete-region (point-min) (point-max)) 1524 (delete-region (point-min) (point-max))
1684 (if mh-adaptive-cmd-note-flag 1525 (if mh-adaptive-cmd-note-flag
1685 (mh-set-cmd-note (mh-message-number-width folder)))) 1526 (mh-set-cmd-note (mh-message-number-width folder))))
1686 (setq scan-start (point)) 1527 (setq scan-start (point))
1687 (apply #'mh-exec-cmd-output 1528 (apply #'mh-exec-cmd-output
1688 mh-scan-prog nil 1529 mh-scan-prog nil
1689 (mh-scan-format) 1530 (mh-scan-format)
1690 "-noclear" "-noheader" 1531 "-noclear" "-noheader"
1691 "-width" (window-width) 1532 "-width" (window-width)
1692 folder range) 1533 folder range)
1693 (goto-char scan-start) 1534 (goto-char scan-start)
1694 (cond ((looking-at "scan: no messages in") 1535 (cond ((looking-at "scan: no messages in")
1695 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines 1536 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
1696 ((looking-at "scan: bad message list ") 1537 ((looking-at "scan: bad message list ")
1697 (keep-lines mh-scan-valid-regexp)) 1538 (keep-lines mh-scan-valid-regexp))
1698 ((looking-at "scan: ")) ; Keep error messages 1539 ((looking-at "scan: ")) ; Keep error messages
1699 (t 1540 (t
1700 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines 1541 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
1701 (setq mh-seq-list (mh-read-folder-sequences folder nil)) 1542 (setq mh-seq-list (mh-read-folder-sequences folder nil))
1702 (mh-notate-user-sequences) 1543 (mh-notate-user-sequences)
1703 (or update 1544 (or update
1704 (setq mh-mode-line-annotation 1545 (setq mh-mode-line-annotation
1705 (if (equal range '("all")) 1546 (if (equal range '("all"))
1706 nil 1547 nil
1707 mh-partial-folder-mode-line-annotation))) 1548 mh-partial-folder-mode-line-annotation)))
1708 (mh-make-folder-mode-line)) 1549 (mh-make-folder-mode-line))
1709 (message "Scanning %s...done" folder))) 1550 (message "Scanning %s...done" folder)))
1710 1551
1711 (defun mh-generate-new-cmd-note (folder) 1552 (defun mh-generate-new-cmd-note (folder)
1712 "Fix the `mh-cmd-note' value for this FOLDER. 1553 "Fix the `mh-cmd-note' value for this FOLDER.
1725 messages that were removed earlier. They should all fit in the scan 1566 messages that were removed earlier. They should all fit in the scan
1726 line now with no message truncation." 1567 line now with no message truncation."
1727 (save-excursion 1568 (save-excursion
1728 (let ((maxcol (1- (window-width))) 1569 (let ((maxcol (1- (window-width)))
1729 (old-cmd-note mh-cmd-note) 1570 (old-cmd-note mh-cmd-note)
1730 mh-cmd-note-fmt 1571 mh-cmd-note-fmt
1731 msgnum) 1572 msgnum)
1732 ;; Nuke all of the lines just added by the last inc 1573 ;; Nuke all of the lines just added by the last inc
1733 (delete-char (- (point-max) (point))) 1574 (delete-char (- (point-max) (point)))
1734 ;; Update the current buffer to reflect the new mh-cmd-note 1575 ;; Update the current buffer to reflect the new mh-cmd-note
1735 ;; value needed to display messages. 1576 ;; value needed to display messages.
1736 (mh-set-cmd-note (mh-message-number-width folder)) 1577 (mh-set-cmd-note (mh-message-number-width folder))
1748 ;; trim the line to fix in the window 1589 ;; trim the line to fix in the window
1749 (end-of-line) 1590 (end-of-line)
1750 (let ((eol (point))) 1591 (let ((eol (point)))
1751 (move-to-column maxcol) 1592 (move-to-column maxcol)
1752 (if (<= (point) eol) 1593 (if (<= (point) eol)
1753 (delete-char (- eol (point)))))))) 1594 (delete-char (- eol (point))))))))
1754 ;; now re-read the lost messages 1595 ;; now re-read the lost messages
1755 (goto-char (point-max)) 1596 (goto-char (point-max))
1756 (prog1 (point) 1597 (prog1 (point)
1757 (mh-regenerate-headers "cur-last" t))))) 1598 (mh-regenerate-headers "cur-last" t)))))
1758 1599
1759 (defun mh-get-new-mail (maildrop-name) 1600 (defun mh-get-new-mail (maildrop-name)
1760 "Read new mail from MAILDROP-NAME into the current buffer. 1601 "Read new mail from MAILDROP-NAME into the current buffer.
1761 Return in the current buffer." 1602 Return in the current buffer."
1762 (let ((point-before-inc (point)) 1603 (let ((point-before-inc (point))
1763 (folder mh-current-folder) 1604 (folder mh-current-folder)
1764 (new-mail-flag nil)) 1605 (new-mail-flag nil))
1765 (with-mh-folder-updating (t) 1606 (with-mh-folder-updating (t)
1766 (if maildrop-name 1607 (if maildrop-name
1767 (message "inc %s -file %s..." folder maildrop-name) 1608 (message "inc %s -file %s..." folder maildrop-name)
1768 (message "inc %s..." folder)) 1609 (message "inc %s..." folder))
1769 (setq mh-next-direction 'forward) 1610 (setq mh-next-direction 'forward)
1770 (goto-char (point-max)) 1611 (goto-char (point-max))
1771 (let ((start-of-inc (point))) 1612 (let ((start-of-inc (point)))
1772 (mh-remove-cur-notation) 1613 (mh-remove-cur-notation)
1773 (if maildrop-name 1614 (if maildrop-name
1774 ;; I think MH 5 used "-ms-file" instead of "-file", 1615 ;; I think MH 5 used "-ms-file" instead of "-file",
1775 ;; which would make inc'ing from maildrops fail. 1616 ;; which would make inc'ing from maildrops fail.
1776 (mh-exec-cmd-output mh-inc-prog nil folder 1617 (mh-exec-cmd-output mh-inc-prog nil folder
1777 (mh-scan-format) 1618 (mh-scan-format)
1778 "-file" (expand-file-name maildrop-name) 1619 "-file" (expand-file-name maildrop-name)
1779 "-width" (window-width) 1620 "-width" (window-width)
1780 "-truncate") 1621 "-truncate")
1781 (mh-exec-cmd-output mh-inc-prog nil 1622 (mh-exec-cmd-output mh-inc-prog nil
1782 (mh-scan-format) 1623 (mh-scan-format)
1783 "-width" (window-width))) 1624 "-width" (window-width)))
1784 (if maildrop-name 1625 (if maildrop-name
1785 (message "inc %s -file %s...done" folder maildrop-name) 1626 (message "inc %s -file %s...done" folder maildrop-name)
1786 (message "inc %s...done" folder)) 1627 (message "inc %s...done" folder))
1787 (goto-char start-of-inc) 1628 (goto-char start-of-inc)
1788 (cond ((save-excursion 1629 (cond ((save-excursion
1789 (re-search-forward "^inc: no mail" nil t)) 1630 (re-search-forward "^inc: no mail" nil t))
1790 (message "No new mail%s%s" (if maildrop-name " in " "") 1631 (message "No new mail%s%s" (if maildrop-name " in " "")
1791 (if maildrop-name maildrop-name ""))) 1632 (if maildrop-name maildrop-name "")))
1792 ((and (when mh-narrowed-to-seq 1633 ((and (when mh-narrowed-to-seq
1793 (let ((saved-text (buffer-substring-no-properties 1634 (let ((saved-text (buffer-substring-no-properties
1794 start-of-inc (point-max)))) 1635 start-of-inc (point-max))))
1795 (delete-region start-of-inc (point-max)) 1636 (delete-region start-of-inc (point-max))
1796 (unwind-protect (mh-widen) 1637 (unwind-protect (mh-widen)
1797 (goto-char (point-max)) 1638 (goto-char (point-max))
1798 (setq start-of-inc (point)) 1639 (setq start-of-inc (point))
1799 (insert saved-text) 1640 (insert saved-text)
1800 (goto-char start-of-inc)))) 1641 (goto-char start-of-inc))))
1801 nil)) 1642 nil))
1802 ((re-search-forward "^inc:" nil t) ; Error messages 1643 ((re-search-forward "^inc:" nil t) ; Error messages
1803 (error "Error incorporating mail")) 1644 (error "Error incorporating mail"))
1804 ((and 1645 ((and
1805 (equal mh-scan-format-file t) 1646 (equal mh-scan-format-file t)
1806 mh-adaptive-cmd-note-flag 1647 mh-adaptive-cmd-note-flag
1807 ;; Have we reached an edge condition? 1648 ;; Have we reached an edge condition?
1808 (save-excursion 1649 (save-excursion
1809 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1)) 1650 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
1810 (setq start-of-inc (mh-generate-new-cmd-note folder)) 1651 (setq start-of-inc (mh-generate-new-cmd-note folder))
1811 nil)) 1652 nil))
1812 (t 1653 (t
1813 (setq new-mail-flag t))) 1654 (setq new-mail-flag t)))
1814 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines 1655 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1815 (setq mh-seq-list (mh-read-folder-sequences folder t)) 1656 (setq mh-seq-list (mh-read-folder-sequences folder t))
1816 (mh-notate-user-sequences) 1657 (when (equal (point-max) start-of-inc)
1817 (if new-mail-flag 1658 (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
1818 (progn 1659 (mh-notate-user-sequences)
1819 (mh-make-folder-mode-line) 1660 (if new-mail-flag
1661 (progn
1662 (mh-make-folder-mode-line)
1820 (when (memq 'unthread mh-view-ops) 1663 (when (memq 'unthread mh-view-ops)
1821 (mh-thread-inc folder start-of-inc)) 1664 (mh-thread-inc folder start-of-inc))
1822 (mh-goto-cur-msg)) 1665 (mh-goto-cur-msg))
1823 (goto-char point-before-inc)))))) 1666 (goto-char point-before-inc))))))
1824 1667
1825 (defun mh-make-folder-mode-line (&optional ignored) 1668 (defun mh-make-folder-mode-line (&optional ignored)
1826 "Set the fields of the mode line for a folder buffer. 1669 "Set the fields of the mode line for a folder buffer.
1827 The optional argument is now obsolete and IGNORED. It used to be used to pass 1670 The optional argument is now obsolete and IGNORED. It used to be used to pass
1828 in what is now stored in the buffer-local variable `mh-mode-line-annotation'." 1671 in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1829 (save-excursion 1672 (save-excursion
1830 (save-window-excursion 1673 (save-window-excursion
1831 (mh-first-msg) 1674 (mh-first-msg)
1832 (let ((new-first-msg-num (mh-get-msg-num nil))) 1675 (let ((new-first-msg-num (mh-get-msg-num nil)))
1833 (when (or (not (memq 'unthread mh-view-ops)) 1676 (when (or (not (memq 'unthread mh-view-ops))
1834 (null mh-first-msg-num) 1677 (null mh-first-msg-num)
1835 (null new-first-msg-num) 1678 (null new-first-msg-num)
1836 (< new-first-msg-num mh-first-msg-num)) 1679 (< new-first-msg-num mh-first-msg-num))
1837 (setq mh-first-msg-num new-first-msg-num))) 1680 (setq mh-first-msg-num new-first-msg-num)))
1838 (mh-last-msg) 1681 (mh-last-msg)
1839 (let ((new-last-msg-num (mh-get-msg-num nil))) 1682 (let ((new-last-msg-num (mh-get-msg-num nil)))
1840 (when (or (not (memq 'unthread mh-view-ops)) 1683 (when (or (not (memq 'unthread mh-view-ops))
1841 (null mh-last-msg-num) 1684 (null mh-last-msg-num)
1842 (null new-last-msg-num) 1685 (null new-last-msg-num)
1843 (> new-last-msg-num mh-last-msg-num)) 1686 (> new-last-msg-num mh-last-msg-num))
1844 (setq mh-last-msg-num new-last-msg-num))) 1687 (setq mh-last-msg-num new-last-msg-num)))
1845 (setq mh-msg-count (if mh-first-msg-num 1688 (setq mh-msg-count (if mh-first-msg-num
1846 (count-lines (point-min) (point-max)) 1689 (count-lines (point-min) (point-max))
1847 0)) 1690 0))
1848 (setq mode-line-buffer-identification 1691 (setq mode-line-buffer-identification
1849 (list (format "{%%b%s} %s msg%s" 1692 (list (format "{%%b%s} %s msg%s"
1850 (if mh-mode-line-annotation 1693 (if mh-mode-line-annotation
1851 (format "/%s" mh-mode-line-annotation) 1694 (format "/%s" mh-mode-line-annotation)
1852 "") 1695 "")
1853 (if (zerop mh-msg-count) 1696 (if (zerop mh-msg-count)
1854 "no" 1697 "no"
1855 (format "%d" mh-msg-count)) 1698 (format "%d" mh-msg-count))
1856 (if (zerop mh-msg-count) 1699 (if (zerop mh-msg-count)
1857 "s" 1700 "s"
1858 (cond ((> mh-msg-count 1) 1701 (cond ((> mh-msg-count 1)
1859 (format "s (%d-%d)" mh-first-msg-num 1702 (format "s (%d-%d)" mh-first-msg-num
1860 mh-last-msg-num)) 1703 mh-last-msg-num))
1861 (mh-first-msg-num 1704 (mh-first-msg-num
1862 (format " (%d)" mh-first-msg-num)) 1705 (format " (%d)" mh-first-msg-num))
1863 (""))))))))) 1706 ("")))))))))
1864 1707
1865 (defun mh-unmark-all-headers (remove-all-flags) 1708 (defun mh-unmark-all-headers (remove-all-flags)
1866 "Remove all '+' flags from the folder listing. 1709 "Remove all '+' flags from the folder listing.
1867 With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. 1710 With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1868 Optimized for speed (i.e., no regular expressions)." 1711 Optimized for speed (i.e., no regular expressions)."
1869 (save-excursion 1712 (save-excursion
1870 (let ((case-fold-search nil) 1713 (let ((case-fold-search nil)
1871 (last-line (1- (point-max))) 1714 (last-line (1- (point-max)))
1872 char) 1715 char)
1873 (mh-first-msg) 1716 (mh-first-msg)
1874 (while (<= (point) last-line) 1717 (while (<= (point) last-line)
1875 (forward-char mh-cmd-note) 1718 (forward-char mh-cmd-note)
1876 (setq char (following-char)) 1719 (setq char (following-char))
1877 (if (or (and remove-all-flags 1720 (if (or (and remove-all-flags
1878 (or (= char (aref mh-note-deleted 0)) 1721 (or (= char (aref mh-note-deleted 0))
1879 (= char (aref mh-note-refiled 0)))) 1722 (= char (aref mh-note-refiled 0))))
1880 (= char (aref mh-note-cur 0))) 1723 (= char (aref mh-note-cur 0)))
1881 (progn 1724 (progn
1882 (delete-char 1) 1725 (delete-char 1)
1883 (insert " "))) 1726 (insert " ")))
1884 (if remove-all-flags 1727 (if remove-all-flags
1885 (progn 1728 (progn
1886 (forward-char 1) 1729 (forward-char 1)
1887 (if (= (following-char) (aref mh-note-seq 0)) 1730 (if (= (following-char) (aref mh-note-seq 0))
1888 (progn 1731 (progn
1889 (delete-char 1) 1732 (delete-char 1)
1890 (insert " "))))) 1733 (insert " ")))))
1891 (forward-line))))) 1734 (forward-line)))))
1892 1735
1893 (defun mh-remove-cur-notation () 1736 (defun mh-remove-cur-notation ()
1894 "Remove old cur notation." 1737 "Remove old cur notation."
1895 (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) 1738 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1896 (save-excursion 1739 (save-excursion
1897 (and cur-msg 1740 (and cur-msg
1898 (mh-goto-msg cur-msg t t) 1741 (mh-goto-msg cur-msg t t)
1899 (looking-at mh-scan-cur-msg-number-regexp) 1742 (looking-at mh-scan-cur-msg-number-regexp)
1900 (mh-notate nil ? mh-cmd-note))))) 1743 (mh-notate nil ? mh-cmd-note)))))
1901 1744
1902 (defun mh-remove-all-notation () 1745 (defun mh-remove-all-notation ()
1903 "Remove all notations on all scan lines that MH-E introduces." 1746 "Remove all notations on all scan lines that MH-E introduces."
1904 (save-excursion 1747 (save-excursion
1905 (goto-char (point-min)) 1748 (goto-char (point-min))
1906 (while (not (eobp)) 1749 (while (not (eobp))
1907 (mh-notate nil ? mh-cmd-note) 1750 (unless (or (equal (char-after) ?+) (eolp))
1908 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) 1751 (mh-notate nil ? mh-cmd-note)
1909 (mh-notate nil ? (1+ mh-cmd-note))) 1752 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
1753 (mh-notate nil ? (1+ mh-cmd-note))))
1910 (forward-line)))) 1754 (forward-line))))
1911 1755
1756 ;;;###mh-autoload
1912 (defun mh-goto-cur-msg (&optional minimal-changes-flag) 1757 (defun mh-goto-cur-msg (&optional minimal-changes-flag)
1913 "Position the cursor at the current message. 1758 "Position the cursor at the current message.
1914 When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't 1759 When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
1915 recenter the folder buffer." 1760 recenter the folder buffer."
1916 (let ((cur-msg (car (mh-seq-to-msgs 'cur)))) 1761 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1917 (cond ((and cur-msg 1762 (cond ((and cur-msg
1918 (mh-goto-msg cur-msg t t)) 1763 (mh-goto-msg cur-msg t t))
1919 (unless minimal-changes-flag 1764 (unless minimal-changes-flag
1920 (mh-notate nil mh-note-cur mh-cmd-note) 1765 (mh-notate nil mh-note-cur mh-cmd-note)
1921 (mh-recenter 0) 1766 (mh-recenter 0)
1922 (mh-maybe-show cur-msg))) 1767 (mh-maybe-show cur-msg)))
1923 (t 1768 (t
1924 (message "No current message"))))) 1769 (message "No current message")))))
1925 1770
1926 (defun mh-process-or-undo-commands (folder) 1771 (defun mh-process-or-undo-commands (folder)
1927 "If FOLDER has outstanding commands, then either process or discard them. 1772 "If FOLDER has outstanding commands, then either process or discard them.
1928 Called by functions like `mh-sort-folder', so also invalidate show buffer." 1773 Called by functions like `mh-sort-folder', so also invalidate show buffer."
1929 (set-buffer folder) 1774 (set-buffer folder)
1930 (if (mh-outstanding-commands-p) 1775 (if (mh-outstanding-commands-p)
1931 (if (or mh-do-not-confirm-flag 1776 (if (or mh-do-not-confirm-flag
1932 (y-or-n-p 1777 (y-or-n-p
1933 "Process outstanding deletes and refiles (or lose them)? ")) 1778 "Process outstanding deletes and refiles (or lose them)? "))
1934 (mh-process-commands folder) 1779 (mh-process-commands folder)
1935 (mh-undo-folder))) 1780 (mh-undo-folder)))
1936 (mh-update-unseen) 1781 (mh-update-unseen)
1937 (mh-invalidate-show-buffer)) 1782 (mh-invalidate-show-buffer))
1938 1783
1939 (defun mh-process-commands (folder) 1784 (defun mh-process-commands (folder)
1940 "Process outstanding commands for FOLDER. 1785 "Process outstanding commands for FOLDER.
1947 (run-hooks 'mh-folder-updated-hook) 1792 (run-hooks 'mh-folder-updated-hook)
1948 1793
1949 ;; Update the unseen sequence if it exists 1794 ;; Update the unseen sequence if it exists
1950 (mh-update-unseen) 1795 (mh-update-unseen)
1951 1796
1952 (let ((redraw-needed-flag nil)) 1797 (let ((redraw-needed-flag mh-index-data))
1798 ;; Remove invalid scan lines if we are in an index folder and then remove
1799 ;; the real messages
1800 (when mh-index-data
1801 (mh-index-delete-folder-headers)
1802 (mh-index-execute-commands))
1803
1953 ;; Then refile messages 1804 ;; Then refile messages
1954 (mh-mapc #'(lambda (folder-msg-list) 1805 (mh-mapc #'(lambda (folder-msg-list)
1955 (let ((dest-folder (symbol-name (car folder-msg-list))) 1806 (let ((dest-folder (symbol-name (car folder-msg-list)))
1956 (msgs (cdr folder-msg-list))) 1807 (msgs (cdr folder-msg-list)))
1957 (setq redraw-needed-flag t) 1808 (setq redraw-needed-flag t)
1971 (setq mh-delete-list nil))) 1822 (setq mh-delete-list nil)))
1972 1823
1973 ;; Don't need to remove sequences since delete and refile do so. 1824 ;; Don't need to remove sequences since delete and refile do so.
1974 ;; Mark cur message 1825 ;; Mark cur message
1975 (if (> (buffer-size) 0) 1826 (if (> (buffer-size) 0)
1976 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last")))) 1827 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1977 1828
1978 ;; Redraw folder window if needed 1829 ;; Redraw folder buffer if needed
1979 (when (and (memq 'unthread mh-view-ops) redraw-needed-flag) 1830 (when (and redraw-needed-flag)
1980 (mh-thread-inc folder (point-max)))) 1831 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
1832 (mh-index-data (mh-index-insert-folder-headers)))))
1981 1833
1982 (and (buffer-file-name (get-buffer mh-show-buffer)) 1834 (and (buffer-file-name (get-buffer mh-show-buffer))
1983 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer)))) 1835 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1984 ;; If "inc" were to put a new msg in this file, 1836 ;; If "inc" were to put a new msg in this file,
1985 ;; we would not notice, so mark it invalid now. 1837 ;; we would not notice, so mark it invalid now.
1986 (mh-invalidate-show-buffer)) 1838 (mh-invalidate-show-buffer))
1987 1839
1988 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) 1840 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1989 (mh-unmark-all-headers t) 1841 (mh-unmark-all-headers t)
1990 (mh-notate-user-sequences) 1842 (mh-notate-user-sequences)
1991 (message "Processing deletes and refiles for %s...done" folder))) 1843 (message "Processing deletes and refiles for %s...done" folder)))
1995 Return non-nil iff the MH folder was set. 1847 Return non-nil iff the MH folder was set.
1996 The value of `mh-unseen-updated-hook' is a list of functions to be called, 1848 The value of `mh-unseen-updated-hook' is a list of functions to be called,
1997 with no arguments, after the unseen sequence is updated." 1849 with no arguments, after the unseen sequence is updated."
1998 (if mh-seen-list 1850 (if mh-seen-list
1999 (let* ((unseen-seq (mh-find-seq mh-unseen-seq)) 1851 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
2000 (unseen-msgs (mh-seq-msgs unseen-seq))) 1852 (unseen-msgs (mh-seq-msgs unseen-seq)))
2001 (if unseen-msgs 1853 (if unseen-msgs
2002 (progn 1854 (progn
2003 (mh-undefine-sequence mh-unseen-seq mh-seen-list) 1855 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
2004 (run-hooks 'mh-unseen-updated-hook) 1856 (run-hooks 'mh-unseen-updated-hook)
2005 (while mh-seen-list 1857 (while mh-seen-list
2006 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs)) 1858 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
2007 (setq mh-seen-list (cdr mh-seen-list))) 1859 (setq mh-seen-list (cdr mh-seen-list)))
2008 (setcdr unseen-seq unseen-msgs) 1860 (setcdr unseen-seq unseen-msgs)
2009 t) ;since we set the folder 1861 t) ;since we set the folder
2010 (setq mh-seen-list nil))))) 1862 (setq mh-seen-list nil)))))
2011 1863
2012 (defun mh-delete-scan-msgs (msgs) 1864 (defun mh-delete-scan-msgs (msgs)
2013 "Delete the scan listing lines for MSGS." 1865 "Delete the scan listing lines for MSGS."
2014 (save-excursion 1866 (save-excursion
2015 (while msgs 1867 (while msgs
2027 "Give a list of MESSAGES, return a list of message number ranges. 1879 "Give a list of MESSAGES, return a list of message number ranges.
2028 Sort of the opposite of `mh-read-msg-list', which expands ranges. 1880 Sort of the opposite of `mh-read-msg-list', which expands ranges.
2029 Message lists passed to MH programs go through this so 1881 Message lists passed to MH programs go through this so
2030 command line arguments won't exceed system limits." 1882 command line arguments won't exceed system limits."
2031 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) 1883 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
2032 (range-high nil) 1884 (range-high nil)
2033 (prev -1) 1885 (prev -1)
2034 (ranges nil)) 1886 (ranges nil))
2035 (while prev 1887 (while prev
2036 (if range-high 1888 (if range-high
2037 (if (or (not (numberp prev)) 1889 (if (or (not (numberp prev))
2038 (not (equal (car msgs) (1- prev)))) 1890 (not (equal (car msgs) (1- prev))))
2039 (progn ;non-sequential, flush old range 1891 (progn ;non-sequential, flush old range
2040 (if (eq prev range-high) 1892 (if (eq prev range-high)
2041 (setq ranges (cons range-high ranges)) 1893 (setq ranges (cons range-high ranges))
2042 (setq ranges (cons (format "%s-%s" prev range-high) ranges))) 1894 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
2043 (setq range-high nil)))) 1895 (setq range-high nil))))
2044 (or range-high 1896 (or range-high
2045 (setq range-high (car msgs))) ;start new or first range 1897 (setq range-high (car msgs))) ;start new or first range
2046 (setq prev (car msgs)) 1898 (setq prev (car msgs))
2047 (setq msgs (cdr msgs))) 1899 (setq msgs (cdr msgs)))
2048 ranges)) 1900 ranges))
2049 1901
2050 (defun mh-greaterp (msg1 msg2) 1902 (defun mh-greaterp (msg1 msg2)
2051 "Return the greater of two message indicators MSG1 and MSG2. 1903 "Return the greater of two message indicators MSG1 and MSG2.
2052 Strings are \"smaller\" than numbers. 1904 Strings are \"smaller\" than numbers.
2053 Legal values are things like \"cur\", \"last\", 1, and 1820." 1905 Legal values are things like \"cur\", \"last\", 1, and 1820."
2054 (if (numberp msg1) 1906 (if (numberp msg1)
2055 (if (numberp msg2) 1907 (if (numberp msg2)
2056 (> msg1 msg2) 1908 (> msg1 msg2)
2057 t) 1909 t)
2058 (if (numberp msg2) 1910 (if (numberp msg2)
2059 nil 1911 nil
2060 (string-lessp msg2 msg1)))) 1912 (string-lessp msg2 msg1))))
2061 1913
2062 (defun mh-lessp (msg1 msg2) 1914 (defun mh-lessp (msg1 msg2)
2063 "Return the lesser of two message indicators MSG1 and MSG2. 1915 "Return the lesser of two message indicators MSG1 and MSG2.
2064 Strings are \"smaller\" than numbers. 1916 Strings are \"smaller\" than numbers.
2078 "Read and return the predefined sequences for a FOLDER. 1930 "Read and return the predefined sequences for a FOLDER.
2079 If SAVE-REFILES is non-nil, then keep the sequences 1931 If SAVE-REFILES is non-nil, then keep the sequences
2080 that note messages to be refiled." 1932 that note messages to be refiled."
2081 (let ((seqs ())) 1933 (let ((seqs ()))
2082 (cond (save-refiles 1934 (cond (save-refiles
2083 (mh-mapc (function (lambda (seq) ; Save the refiling sequences 1935 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
2084 (if (mh-folder-name-p (mh-seq-name seq)) 1936 (if (mh-folder-name-p (mh-seq-name seq))
2085 (setq seqs (cons seq seqs))))) 1937 (setq seqs (cons seq seqs)))))
2086 mh-seq-list))) 1938 mh-seq-list)))
2087 (save-excursion 1939 (save-excursion
2088 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list")) 1940 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
2089 (progn 1941 (progn
2090 ;; look for name in line of form "cur: 4" or "myseq (private): 23" 1942 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
2091 (while (re-search-forward "^[^: ]+" nil t) 1943 (while (re-search-forward "^[^: ]+" nil t)
2092 (setq seqs (cons (mh-make-seq (intern (buffer-substring 1944 (setq seqs (cons (mh-make-seq (intern (buffer-substring
2093 (match-beginning 0) 1945 (match-beginning 0)
2094 (match-end 0))) 1946 (match-end 0)))
2095 (mh-read-msg-list)) 1947 (mh-read-msg-list))
2096 seqs))) 1948 seqs)))
2097 (delete-region (point-min) (point))))) ; avoid race with 1949 (delete-region (point-min) (point))))) ; avoid race with
2098 ; mh-process-daemon 1950 ; mh-process-daemon
2099 seqs)) 1951 seqs))
2100 1952
2101 (defun mh-read-msg-list () 1953 (defun mh-read-msg-list ()
2102 "Return a list of message numbers from point to the end of the line. 1954 "Return a list of message numbers from point to the end of the line.
2103 Expands ranges into set of individual numbers." 1955 Expands ranges into set of individual numbers."
2104 (let ((msgs ()) 1956 (let ((msgs ())
2105 (end-of-line (save-excursion (end-of-line) (point))) 1957 (end-of-line (save-excursion (end-of-line) (point)))
2106 num) 1958 num)
2107 (while (re-search-forward "[0-9]+" end-of-line t) 1959 (while (re-search-forward "[0-9]+" end-of-line t)
2108 (setq num (string-to-int (buffer-substring (match-beginning 0) 1960 (setq num (string-to-int (buffer-substring (match-beginning 0)
2109 (match-end 0)))) 1961 (match-end 0))))
2110 (cond ((looking-at "-") ; Message range 1962 (cond ((looking-at "-") ; Message range
2111 (forward-char 1) 1963 (forward-char 1)
2112 (re-search-forward "[0-9]+" end-of-line t) 1964 (re-search-forward "[0-9]+" end-of-line t)
2113 (let ((num2 (string-to-int (buffer-substring (match-beginning 0) 1965 (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
2114 (match-end 0))))) 1966 (match-end 0)))))
2115 (if (< num2 num) 1967 (if (< num2 num)
2116 (error "Bad message range: %d-%d" num num2)) 1968 (error "Bad message range: %d-%d" num num2))
2117 (while (<= num num2) 1969 (while (<= num num2)
2118 (setq msgs (cons num msgs)) 1970 (setq msgs (cons num msgs))
2119 (setq num (1+ num))))) 1971 (setq num (1+ num)))))
2120 ((not (zerop num)) ;"pick" outputs "0" to mean no match 1972 ((not (zerop num)) ;"pick" outputs "0" to mean no match
2121 (setq msgs (cons num msgs))))) 1973 (setq msgs (cons num msgs)))))
2122 msgs)) 1974 msgs))
2123 1975
2124 (defun mh-notate-user-sequences () 1976 (defun mh-notate-user-sequences ()
2125 "Mark the scan listing of all messages in user-defined sequences." 1977 "Mark the scan listing of all messages in user-defined sequences."
2126 (let ((seqs mh-seq-list) 1978 (let ((seqs mh-seq-list)
2127 name) 1979 name)
2128 (while seqs 1980 (while seqs
2129 (setq name (mh-seq-name (car seqs))) 1981 (setq name (mh-seq-name (car seqs)))
2130 (if (not (mh-internal-seq name)) 1982 (if (not (mh-internal-seq name))
2131 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note))) 1983 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
2132 (setq seqs (cdr seqs))))) 1984 (setq seqs (cdr seqs)))))
2133 1985
2134 (defun mh-internal-seq (name) 1986 (defun mh-internal-seq (name)
2135 "Return non-nil if NAME is the name of an internal MH-E sequence." 1987 "Return non-nil if NAME is the name of an internal MH-E sequence."
2136 (or (memq name '(answered cur deleted forwarded printed)) 1988 (or (memq name '(answered cur deleted forwarded printed))
2141 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag) 1993 (defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
2142 "Delete MESSAGE from SEQUENCE. 1994 "Delete MESSAGE from SEQUENCE.
2143 MESSAGE defaults to displayed message. From Lisp, optional third arg 1995 MESSAGE defaults to displayed message. From Lisp, optional third arg
2144 INTERNAL-FLAG non-nil means do not inform MH of the change." 1996 INTERNAL-FLAG non-nil means do not inform MH of the change."
2145 (interactive (list (mh-get-msg-num t) 1997 (interactive (list (mh-get-msg-num t)
2146 (mh-read-seq-default "Delete from" t) 1998 (mh-read-seq-default "Delete from" t)
2147 nil)) 1999 nil))
2148 (let ((entry (mh-find-seq sequence))) 2000 (let ((entry (mh-find-seq sequence)))
2149 (cond (entry 2001 (cond (entry
2150 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence) 2002 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
2151 (if (not internal-flag) 2003 (if (not internal-flag)
2152 (mh-undefine-sequence sequence (list message))) 2004 (mh-undefine-sequence sequence (list message)))
2153 (setcdr entry (delq message (mh-seq-msgs entry))))))) 2005 (setcdr entry (delq message (mh-seq-msgs entry)))))))
2154 2006
2155 (defun mh-undefine-sequence (seq msgs) 2007 (defun mh-undefine-sequence (seq msgs)
2156 "Remove from the SEQ the list of MSGS." 2008 "Remove from the SEQ the list of MSGS."
2157 (mh-exec-cmd "mark" mh-current-folder "-delete" 2009 (mh-exec-cmd "mark" mh-current-folder "-delete"
2158 "-sequence" (symbol-name seq) 2010 "-sequence" (symbol-name seq)
2159 (mh-coalesce-msg-list msgs))) 2011 (mh-coalesce-msg-list msgs)))
2160 2012
2161 (defun mh-define-sequence (seq msgs) 2013 (defun mh-define-sequence (seq msgs)
2162 "Define the SEQ to contain the list of MSGS. 2014 "Define the SEQ to contain the list of MSGS.
2163 Do not mark pseudo-sequences or empty sequences. 2015 Do not mark pseudo-sequences or empty sequences.
2164 Signals an error if SEQ is an illegal name." 2016 Signals an error if SEQ is an illegal name."
2165 (if (and msgs 2017 (if (and msgs
2166 (not (mh-folder-name-p seq))) 2018 (not (mh-folder-name-p seq)))
2167 (save-excursion 2019 (save-excursion
2168 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" 2020 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2169 "-sequence" (symbol-name seq) 2021 "-sequence" (symbol-name seq)
2170 (mh-coalesce-msg-list msgs))))) 2022 (mh-coalesce-msg-list msgs)))))
2171 2023
2172 (defun mh-map-over-seqs (function seq-list) 2024 (defun mh-map-over-seqs (function seq-list)
2173 "Apply FUNCTION to each sequence in SEQ-LIST. 2025 "Apply FUNCTION to each sequence in SEQ-LIST.
2174 The sequence name and the list of messages are passed as arguments." 2026 The sequence name and the list of messages are passed as arguments."
2175 (while seq-list 2027 (while seq-list
2176 (funcall function 2028 (funcall function
2177 (mh-seq-name (car seq-list)) 2029 (mh-seq-name (car seq-list))
2178 (mh-seq-msgs (car seq-list))) 2030 (mh-seq-msgs (car seq-list)))
2179 (setq seq-list (cdr seq-list)))) 2031 (setq seq-list (cdr seq-list))))
2180 2032
2181 (defun mh-notate-if-in-one-seq (msg character offset seq) 2033 (defun mh-notate-if-in-one-seq (msg character offset seq)
2182 "Notate MSG. 2034 "Notate MSG.
2183 The CHARACTER is placed at the given OFFSET from the beginning of the listing. 2035 The CHARACTER is placed at the given OFFSET from the beginning of the listing.
2184 The notation is performed if the MSG is only in SEQ." 2036 The notation is performed if the MSG is only in SEQ."
2185 (let ((in-seqs (mh-seq-containing-msg msg nil))) 2037 (let ((in-seqs (mh-seq-containing-msg msg nil)))
2186 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) 2038 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2187 (mh-notate msg character offset)))) 2039 (mh-notate msg character offset))))
2188 2040
2189 (defun mh-seq-containing-msg (msg &optional include-internal-flag) 2041 (defun mh-seq-containing-msg (msg &optional include-internal-flag)
2190 "Return a list of the sequences containing MSG. 2042 "Return a list of the sequences containing MSG.
2191 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." 2043 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2192 (let ((l mh-seq-list) 2044 (let ((l mh-seq-list)
2193 (seqs ())) 2045 (seqs ()))
2194 (while l 2046 (while l
2195 (and (memq msg (mh-seq-msgs (car l))) 2047 (and (memq msg (mh-seq-msgs (car l)))
2196 (or include-internal-flag 2048 (or include-internal-flag
2197 (not (mh-internal-seq (mh-seq-name (car l))))) 2049 (not (mh-internal-seq (mh-seq-name (car l)))))
2198 (setq seqs (cons (mh-seq-name (car l)) seqs))) 2050 (setq seqs (cons (mh-seq-name (car l)) seqs)))
2199 (setq l (cdr l))) 2051 (setq l (cdr l)))
2200 seqs)) 2052 seqs))
2201 2053
2202 2054
2203 2055
2204 ;;; User prompting commands. 2056 ;;; User prompting commands.
2205 2057
2206 (defun mh-read-msg-range (prompt) 2058 (defun mh-read-msg-range (folder &optional always-prompt-flag)
2207 "Read a list of blank-separated messages using the given PROMPT." 2059 "Prompt for message range from FOLDER.
2208 (let* ((buf (read-string prompt)) 2060 If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
2209 (buf-size (length buf)) 2061 range."
2210 (start 0) 2062 (multiple-value-bind (total unseen) (mh-folder-size folder)
2211 (input ())) 2063 (cond
2212 (while (< start buf-size) 2064 ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
2213 (let ((next (read-from-string buf start buf-size))) 2065 (list (symbol-name mh-unseen-seq)))
2214 (setq input (cons (car next) input)) 2066 ((or (null mh-large-folder) (not (numberp total)))
2215 (setq start (cdr next)))) 2067 (list "all"))
2216 (nreverse input))) 2068 ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
2069 (let* ((prompt
2070 (format "Range or number of messages to read (default: %s): "
2071 total))
2072 (in (read-string prompt nil nil (number-to-string total))))
2073 (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
2074 (list (format "last:%s" (car (read-from-string in)))))
2075 ((equal in "") (list "all"))
2076 (t (split-string in)))))
2077 (t (list "all")))))
2217 2078
2218 2079
2219 2080
2220 ;;; Build the folder-mode keymap: 2081 ;;; Build the folder-mode keymap:
2221 2082
2228 (defalias 'mh-alt-send 'mh-send) 2089 (defalias 'mh-alt-send 'mh-send)
2229 (defalias 'mh-alt-visit-folder 'mh-visit-folder) 2090 (defalias 'mh-alt-visit-folder 'mh-visit-folder)
2230 2091
2231 ;; Save the `b' binding for a future `back'. Maybe? 2092 ;; Save the `b' binding for a future `back'. Maybe?
2232 (gnus-define-keys mh-folder-mode-map 2093 (gnus-define-keys mh-folder-mode-map
2233 " " mh-page-msg 2094 " " mh-page-msg
2234 "!" mh-refile-or-write-again 2095 "!" mh-refile-or-write-again
2235 "," mh-header-display 2096 "," mh-header-display
2236 "." mh-alt-show 2097 "." mh-alt-show
2237 ">" mh-write-msg-to-file 2098 ">" mh-write-msg-to-file
2238 "?" mh-help 2099 "?" mh-help
2239 "E" mh-extract-rejected-mail 2100 "E" mh-extract-rejected-mail
2240 "M" mh-modify 2101 "M" mh-modify
2241 "\177" mh-previous-page 2102 "\177" mh-previous-page
2242 "\C-d" mh-delete-msg-no-motion 2103 "\C-d" mh-delete-msg-no-motion
2243 "\t" mh-next-button 2104 "\t" mh-index-next-folder
2244 [backtab] mh-prev-button 2105 [backtab] mh-index-previous-folder
2245 "\M-\t" mh-prev-button 2106 "\M-\t" mh-index-previous-folder
2246 "\e<" mh-first-msg 2107 "\e<" mh-first-msg
2247 "\e>" mh-last-msg 2108 "\e>" mh-last-msg
2248 "\ed" mh-redistribute 2109 "\ed" mh-redistribute
2249 "\r" mh-show 2110 "\r" mh-show
2250 "^" mh-alt-refile-msg 2111 "^" mh-alt-refile-msg
2251 "c" mh-copy-msg 2112 "c" mh-copy-msg
2252 "d" mh-delete-msg 2113 "d" mh-delete-msg
2253 "e" mh-edit-again 2114 "e" mh-edit-again
2254 "f" mh-forward 2115 "f" mh-forward
2255 "g" mh-goto-msg 2116 "g" mh-goto-msg
2256 "i" mh-inc-folder 2117 "i" mh-inc-folder
2257 "k" mh-delete-subject 2118 "k" mh-delete-subject-or-thread
2258 "l" mh-print-msg 2119 "l" mh-print-msg
2259 "m" mh-alt-send 2120 "m" mh-alt-send
2260 "n" mh-next-undeleted-msg 2121 "n" mh-next-undeleted-msg
2261 "o" mh-refile-msg 2122 "\M-n" mh-next-unread-msg
2262 "p" mh-previous-undeleted-msg 2123 "o" mh-refile-msg
2263 "q" mh-quit 2124 "p" mh-previous-undeleted-msg
2264 "r" mh-reply 2125 "\M-p" mh-previous-unread-msg
2265 "s" mh-send 2126 "q" mh-quit
2266 "t" mh-toggle-showing 2127 "r" mh-reply
2267 "u" mh-undo 2128 "s" mh-send
2268 "x" mh-execute-commands 2129 "t" mh-toggle-showing
2269 "|" mh-pipe-msg) 2130 "u" mh-undo
2131 "v" mh-index-visit-folder
2132 "x" mh-execute-commands
2133 "|" mh-pipe-msg)
2270 2134
2271 (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) 2135 (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2272 "?" mh-prefix-help 2136 "?" mh-prefix-help
2273 "S" mh-sort-folder 2137 "S" mh-sort-folder
2274 "f" mh-alt-visit-folder 2138 "f" mh-alt-visit-folder
2275 "i" mh-index-search 2139 "i" mh-index-search
2276 "k" mh-kill-folder 2140 "k" mh-kill-folder
2277 "l" mh-list-folders 2141 "l" mh-list-folders
2278 "o" mh-alt-visit-folder 2142 "o" mh-alt-visit-folder
2279 "p" mh-pack-folder 2143 "p" mh-pack-folder
2280 "r" mh-rescan-folder 2144 "r" mh-rescan-folder
2281 "s" mh-search-folder 2145 "s" mh-search-folder
2282 "u" mh-undo-folder 2146 "u" mh-undo-folder
2283 "v" mh-visit-folder) 2147 "v" mh-visit-folder)
2284 2148
2285 (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) 2149 (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2286 "?" mh-prefix-help 2150 "?" mh-prefix-help
2287 "d" mh-delete-msg-from-seq 2151 "d" mh-delete-msg-from-seq
2288 "k" mh-delete-seq 2152 "k" mh-delete-seq
2289 "l" mh-list-sequences 2153 "l" mh-list-sequences
2290 "n" mh-narrow-to-seq 2154 "n" mh-narrow-to-seq
2291 "p" mh-put-msg-in-seq 2155 "p" mh-put-msg-in-seq
2292 "s" mh-msg-is-in-seq 2156 "s" mh-msg-is-in-seq
2293 "w" mh-widen) 2157 "w" mh-widen)
2294 2158
2295 (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map) 2159 (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
2296 "?" mh-prefix-help 2160 "?" mh-prefix-help
2297 "t" mh-toggle-threads) 2161 "u" mh-thread-ancestor
2162 "p" mh-thread-previous-sibling
2163 "n" mh-thread-next-sibling
2164 "t" mh-toggle-threads
2165 "d" mh-thread-delete
2166 "o" mh-thread-refile)
2298 2167
2299 (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) 2168 (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2300 "?" mh-prefix-help 2169 "?" mh-prefix-help
2301 "s" mh-narrow-to-subject 2170 "s" mh-narrow-to-subject
2302 "w" mh-widen) 2171 "w" mh-widen)
2303 2172
2304 (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) 2173 (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
2305 "?" mh-prefix-help 2174 "?" mh-prefix-help
2306 "s" mh-store-msg ;shar 2175 "s" mh-store-msg ;shar
2307 "u" mh-store-msg) ;uuencode 2176 "u" mh-store-msg) ;uuencode
2308 2177
2309 (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map) 2178 (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
2310 " " mh-page-digest 2179 " " mh-page-digest
2311 "?" mh-prefix-help 2180 "?" mh-prefix-help
2312 "\177" mh-page-digest-backwards 2181 "\177" mh-page-digest-backwards
2313 "b" mh-burst-digest) 2182 "b" mh-burst-digest)
2314 2183
2315 (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) 2184 (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
2316 "?" mh-prefix-help 2185 "?" mh-prefix-help
2317 "a" mh-mime-save-parts 2186 "a" mh-mime-save-parts
2318 "i" mh-folder-inline-mime-part 2187 "i" mh-folder-inline-mime-part
2319 "o" mh-folder-save-mime-part 2188 "o" mh-folder-save-mime-part
2320 "v" mh-folder-toggle-mime-part 2189 "v" mh-folder-toggle-mime-part
2321 "\t" mh-next-button 2190 "\t" mh-next-button
2322 [backtab] mh-prev-button 2191 [backtab] mh-prev-button
2343 ;;; When adding a new prefix, ensure that the help message contains "what" the 2212 ;;; When adding a new prefix, ensure that the help message contains "what" the
2344 ;;; prefix is for. For example, if the word "folder" were not present in the 2213 ;;; prefix is for. For example, if the word "folder" were not present in the
2345 ;;; `F' entry, it would not be clear what these commands operated upon. 2214 ;;; `F' entry, it would not be clear what these commands operated upon.
2346 (defvar mh-help-messages 2215 (defvar mh-help-messages
2347 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" 2216 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
2348 "[d]elete, [o]refile, e[x]ecute,\n" 2217 "[d]elete, [o]refile, e[x]ecute,\n"
2349 "[s]end, [r]eply.\n" 2218 "[s]end, [r]eply.\n"
2350 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, " 2219 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
2351 "[T]hread, / Limit, e[X]tract, [D]igest.") 2220 "[T]hread, / Limit, e[X]tract, [D]igest.")
2352 2221
2353 (?F "[l]ist, [v]isit folder;\n" 2222 (?F "[l]ist, [v]isit folder;\n"
2354 "[t]hread; [s]earch; [i]ndexed search;\n" 2223 "[t]hread; [s]earch; [i]ndexed search;\n"
2355 "[p]ack; [S]ort; [r]escan; [k]ill") 2224 "[p]ack; [S]ort; [r]escan; [k]ill")
2356 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" 2225 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
2357 "[s]equences, [l]ist,\n" 2226 "[s]equences, [l]ist,\n"
2358 "[d]elete message from sequence, [k]ill sequence") 2227 "[d]elete message from sequence, [k]ill sequence")
2359 (?T "[t]oggle thread") 2228 (?T "[t]oggle, [d]elete, [o]refile thread")
2360 (?/ "Limit to [s]ubject; [w]iden") 2229 (?/ "Limit to [s]ubject; [w]iden")
2361 (?X "un[s]har, [u]udecode message") 2230 (?X "un[s]har, [u]udecode message")
2362 (?D "[b]urst digest") 2231 (?D "[b]urst digest")
2363 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" 2232 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
2364 "[TAB] next; [SHIFT-TAB] previous")) 2233 "[TAB] next; [SHIFT-TAB] previous"))
2365 "Key binding cheat sheet. 2234 "Key binding cheat sheet.
2366 2235
2367 This is an associative array which is used to show the most common commands. 2236 This is an associative array which is used to show the most common commands.
2368 The key is a prefix char. The value is one or more strings which are 2237 The key is a prefix char. The value is one or more strings which are
2369 concatenated together and displayed in the minibuffer if ? is pressed after 2238 concatenated together and displayed in the minibuffer if ? is pressed after
2373 The substitutions described in `substitute-command-keys' are performed as 2242 The substitutions described in `substitute-command-keys' are performed as
2374 well.") 2243 well.")
2375 2244
2376 2245
2377 2246
2378 ;;; autoload the other MH-E parts
2379
2380 ;;; mh-comp
2381
2382 (autoload 'mh-smail "mh-comp"
2383 "Compose and send mail with the MH mail system.
2384 This function is an entry point to MH-E, the Emacs front end
2385 to the MH mail system.
2386 See documentation of `\\[mh-send]' for more details on composing mail." t)
2387
2388 (autoload 'mh-smail-other-window "mh-comp"
2389 "Compose and send mail in other window with the MH mail system.
2390 This function is an entry point to MH-E, the Emacs front end
2391 to the MH mail system.
2392 See documentation of `\\[mh-send]' for more details on composing mail." t)
2393
2394 (autoload 'mh-edit-again "mh-comp"
2395 "Clean-up a draft or a message previously sent and make it resendable.
2396 Default is the current message.
2397 The variable mh-new-draft-cleaned-headers specifies the headers to remove.
2398 See also documentation for `\\[mh-send]' function." t)
2399
2400 (autoload 'mh-extract-rejected-mail "mh-comp"
2401 "Extract a letter returned by the mail system and make it resendable.
2402 Default is the current message. The variable mh-new-draft-cleaned-headers
2403 gives the headers to clean out of the original message.
2404 See also documentation for `\\[mh-send]' function." t)
2405
2406 (autoload 'mh-forward "mh-comp"
2407 "Forward a message or message sequence. Defaults to displayed message.
2408 If optional prefix argument provided, then prompt for the message sequence.
2409 See also documentation for `\\[mh-send]' function." t)
2410
2411 (autoload 'mh-redistribute "mh-comp"
2412 "Redistribute a letter.
2413 Depending on how your copy of MH was compiled, you may need to change the
2414 setting of the variable mh-redist-full-contents. See its documentation." t)
2415
2416 (autoload 'mh-send "mh-comp"
2417 "Compose and send a letter.
2418 The file named by `mh-comp-formfile' will be used as the form.
2419 Do not call this function from outside MH-E; use \\[mh-smail] instead.
2420 The letter is composed in mh-letter-mode; see its documentation for more
2421 details. If `mh-compose-letter-function' is defined, it is called on the
2422 draft and passed three arguments: to, subject, and cc." t)
2423
2424 (autoload 'mh-send-other-window "mh-comp"
2425 "Compose and send a letter in another window.
2426 Do not call this function from outside MH-E;
2427 use \\[mh-smail-other-window] instead.
2428 See also documentation for `\\[mh-send]' function." t)
2429
2430 (autoload 'mh-letter-mode "mh-comp"
2431 "Mode for composing letters in MH-E.
2432 For more details, type \\[describe-mode] while in MH-Letter mode." t)
2433
2434 ;;; mh-funcs
2435
2436 (autoload 'mh-burst-digest "mh-funcs"
2437 "Burst apart the current message, which should be a digest.
2438 The message is replaced by its table of contents and the messages from the
2439 digest are inserted into the folder after that message." t)
2440
2441 (autoload 'mh-copy-msg "mh-funcs"
2442 "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
2443 Default is the displayed message. If optional prefix argument is
2444 provided, then prompt for the message sequence." t)
2445
2446 (autoload 'mh-kill-folder "mh-funcs"
2447 "Remove the current folder." t)
2448
2449 (autoload 'mh-list-folders "mh-funcs"
2450 "List mail folders." t)
2451
2452 (autoload 'mh-pack-folder "mh-funcs"
2453 "Renumber the messages of a folder to be 1..n.
2454 First, offer to execute any outstanding commands for the current folder.
2455 If optional prefix argument provided, prompt for the range of messages
2456 to display after packing. Otherwise, show the entire folder." t)
2457
2458 (autoload 'mh-pipe-msg "mh-funcs"
2459 "Pipe the current message through the given shell COMMAND.
2460 If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
2461 Otherwise just send the message's body without the headers." t)
2462
2463 (autoload 'mh-page-digest "mh-funcs"
2464 "Advance displayed message to next digested message." t)
2465
2466 (autoload 'mh-page-digest-backwards "mh-funcs"
2467 "Back up displayed message to previous digested message." t)
2468
2469 (autoload 'mh-print-msg "mh-funcs"
2470 "Print MESSAGE(s) (default: displayed message) on printer.
2471 If optional prefix argument provided, then prompt for the message sequence.
2472 The variable mh-lpr-command-format is used to generate the print command.
2473 The messages are formatted by mhl. See the variable mhl-formfile." t)
2474
2475 (autoload 'mh-sort-folder "mh-funcs"
2476 "Sort the messages in the current folder by date.
2477 Calls the MH program sortm to do the work.
2478 The arguments in the list mh-sortm-args are passed to sortm
2479 if this function is passed an argument." t)
2480
2481 (autoload 'mh-store-msg "mh-funcs"
2482 "Store the file(s) contained in the current message into DIRECTORY.
2483 The message can contain a shar file or uuencoded file.
2484 Default directory is the last directory used, or initially the value of
2485 mh-store-default-directory or the current directory." t)
2486
2487 (autoload 'mh-store-buffer "mh-funcs"
2488 "Store the file(s) contained in the current buffer into DIRECTORY.
2489 The buffer can contain a shar file or uuencoded file.
2490 Default directory is the last directory used, or initially the value of
2491 `mh-store-default-directory' or the current directory." t)
2492
2493 (autoload 'mh-help "mh-funcs"
2494 "Display cheat sheet for MH-E commands in minibuffer." t)
2495
2496 (autoload 'mh-prefix-help "mh-funcs"
2497 "Display cheat sheet for the commands of the current prefix in minibuffer."
2498 t)
2499
2500 ;;; mh-pick
2501
2502 (autoload 'mh-search-folder "mh-pick"
2503 "Search FOLDER for messages matching a pattern.
2504 Add the messages found to the sequence named `search'." t)
2505
2506 ;;; mh-seq
2507
2508 (autoload 'mh-region-to-sequence "mh-seq"
2509 "Define sequence 'region as the messages in selected region." t)
2510 (autoload 'mh-delete-seq "mh-seq"
2511 "Delete the SEQUENCE." t)
2512 (autoload 'mh-list-sequences "mh-seq"
2513 "List the sequences defined in FOLDER." t)
2514 (autoload 'mh-msg-is-in-seq "mh-seq"
2515 "Display the sequences that contain MESSAGE (default: displayed message)." t)
2516 (autoload 'mh-narrow-to-seq "mh-seq"
2517 "Restrict display of this folder to just messages in SEQUENCE
2518 Use \\[mh-widen] to undo this command." t)
2519 (autoload 'mh-put-msg-in-seq "mh-seq"
2520 "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
2521 If optional prefix argument provided, then prompt for the message sequence." t)
2522 (autoload 'mh-rename-seq "mh-seq"
2523 "Rename SEQUENCE to have NEW-NAME." t)
2524 (autoload 'mh-narrow-to-subject "mh-seq"
2525 "Narrow to a sequence containing all following messages with same subject."
2526 t)
2527 (autoload 'mh-toggle-threads "mh-seq"
2528 "Toggle threaded view of folder." t)
2529 (autoload 'mh-delete-subject "mh-seq"
2530 "Mark all following messages with same subject to be deleted." t)
2531
2532 ;;; mh-speed
2533
2534 (autoload 'mh-folder-speedbar-buttons "mh-speed")
2535 (autoload 'mh-show-speedbar-buttons "mh-speed")
2536 (autoload 'mh-index-folder-speedbar-buttons "mh-speed")
2537 (autoload 'mh-index-show-speedbar-buttons "mh-speed")
2538 (autoload 'mh-letter-speedbar-buttons "mh-speed")
2539
2540 (dolist (mess '("^Cursor not pointing to message$" 2247 (dolist (mess '("^Cursor not pointing to message$"
2541 "^There is no other window$")) 2248 "^There is no other window$"))
2542 (add-to-list 'debug-ignored-errors mess)) 2249 (add-to-list 'debug-ignored-errors mess))
2543 2250
2544 (provide 'mh-e) 2251 (provide 'mh-e)
2545 2252
2546 ;;; Local Variables: 2253 ;;; Local Variables:
2254 ;;; indent-tabs-mode: nil
2547 ;;; sentence-end-double-space: nil 2255 ;;; sentence-end-double-space: nil
2548 ;;; End: 2256 ;;; End:
2549 2257
2550 ;;; mh-e.el ends here 2258 ;;; mh-e.el ends here