Mercurial > emacs
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 |