|
68465
|
1 ;;; mh-folder.el --- MH-Folder mode
|
|
|
2
|
|
|
3 ;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Bill Wohler <wohler@newt.com>
|
|
|
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
|
|
|
7 ;; Keywords: mail
|
|
|
8 ;; See: mh-e.el
|
|
|
9
|
|
|
10 ;; This file is part of GNU Emacs.
|
|
|
11
|
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;; GNU General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
25 ;; Boston, MA 02110-1301, USA.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; Mode for browsing folders
|
|
|
30
|
|
|
31 ;;; Change Log:
|
|
|
32
|
|
|
33 ;;; Code:
|
|
|
34
|
|
|
35 (require 'mh-e)
|
|
|
36 (require 'mh-scan)
|
|
|
37 (mh-require-cl)
|
|
|
38
|
|
|
39 ;; Dynamically-created function not found in mh-loaddefs.el.
|
|
|
40 (autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
|
|
|
41
|
|
|
42 (require 'gnus-util)
|
|
|
43 (autoload 'message-fetch-field "message")
|
|
|
44
|
|
|
45
|
|
|
46
|
|
|
47 ;;; MH-E Entry Points
|
|
|
48
|
|
|
49 ;;;###autoload
|
|
|
50 (defun mh-rmail (&optional arg)
|
|
|
51 "Incorporate new mail with MH.
|
|
|
52 Scan an MH folder if ARG is non-nil.
|
|
|
53
|
|
|
54 This function is an entry point to MH-E, the Emacs interface to
|
|
|
55 the MH mail system."
|
|
|
56 (interactive "P")
|
|
|
57 (mh-find-path)
|
|
|
58 (if arg
|
|
|
59 (call-interactively 'mh-visit-folder)
|
|
|
60 (unless (get-buffer mh-inbox)
|
|
|
61 (mh-visit-folder mh-inbox (symbol-name mh-unseen-seq)))
|
|
|
62 (mh-inc-folder)))
|
|
|
63
|
|
|
64 ;;;###autoload
|
|
|
65 (defun mh-nmail (&optional arg)
|
|
|
66 "Check for new mail in inbox folder.
|
|
|
67 Scan an MH folder if ARG is non-nil.
|
|
|
68
|
|
|
69 This function is an entry point to MH-E, the Emacs interface to
|
|
|
70 the MH mail system."
|
|
|
71 (interactive "P")
|
|
|
72 (mh-find-path) ; init mh-inbox
|
|
|
73 (if arg
|
|
|
74 (call-interactively 'mh-visit-folder)
|
|
|
75 (mh-visit-folder mh-inbox)))
|
|
|
76
|
|
|
77
|
|
|
78 ;;; Desktop Integration
|
|
|
79
|
|
|
80 ;; desktop-buffer-mode-handlers appeared in Emacs 22.
|
|
|
81 (if (fboundp 'desktop-buffer-mode-handlers)
|
|
|
82 (add-to-list 'desktop-buffer-mode-handlers
|
|
|
83 '(mh-folder-mode . mh-restore-desktop-buffer)))
|
|
|
84
|
|
|
85 (defun mh-restore-desktop-buffer (desktop-buffer-file-name
|
|
|
86 desktop-buffer-name
|
|
|
87 desktop-buffer-misc)
|
|
|
88 "Restore an MH folder buffer specified in a desktop file.
|
|
|
89 When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the
|
|
|
90 file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer
|
|
|
91 name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info
|
|
|
92 used by the `desktop-buffer-handlers' functions."
|
|
|
93 (mh-find-path)
|
|
|
94 (mh-visit-folder desktop-buffer-name)
|
|
|
95 (current-buffer))
|
|
|
96
|
|
|
97
|
|
|
98
|
|
|
99 ;;; Variables
|
|
|
100
|
|
|
101 (defvar mh-folder-filename nil
|
|
|
102 "Full path of directory for this folder.")
|
|
|
103
|
|
|
104 (defvar mh-partial-folder-mode-line-annotation "select"
|
|
|
105 "Annotation when displaying part of a folder.
|
|
|
106 The string is displayed after the folder's name. nil for no
|
|
|
107 annotation.")
|
|
|
108
|
|
|
109 (defvar mh-last-destination nil
|
|
|
110 "Destination of last refile or write command.")
|
|
|
111
|
|
|
112 (defvar mh-last-destination-folder nil
|
|
|
113 "Destination of last refile command.")
|
|
|
114
|
|
|
115 (defvar mh-last-destination-write nil
|
|
|
116 "Destination of last write command.")
|
|
|
117
|
|
|
118 (defvar mh-first-msg-num nil
|
|
|
119 "Number of first message in buffer.")
|
|
|
120
|
|
|
121 (defvar mh-last-msg-num nil
|
|
|
122 "Number of last msg in buffer.")
|
|
|
123
|
|
|
124 (defvar mh-msg-count nil
|
|
|
125 "Number of msgs in buffer.")
|
|
|
126
|
|
|
127
|
|
|
128
|
|
|
129 ;;; Sequence Menu
|
|
|
130
|
|
|
131 (easy-menu-define
|
|
|
132 mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
|
|
|
133 '("Sequence"
|
|
|
134 ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
|
|
|
135 ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
|
|
|
136 ["Delete Message from Sequence..." mh-delete-msg-from-seq
|
|
|
137 (mh-get-msg-num nil)]
|
|
|
138 ["List Sequences in Folder..." mh-list-sequences t]
|
|
|
139 ["Delete Sequence..." mh-delete-seq t]
|
|
|
140 ["Narrow to Sequence..." mh-narrow-to-seq t]
|
|
|
141 ["Widen from Sequence" mh-widen mh-folder-view-stack]
|
|
|
142 "--"
|
|
|
143 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
|
|
|
144 ["Narrow to Tick Sequence" mh-narrow-to-tick
|
|
|
145 (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))]
|
|
|
146 ["Delete Rest of Same Subject" mh-delete-subject t]
|
|
|
147 ["Toggle Tick Mark" mh-toggle-tick t]
|
|
|
148 "--"
|
|
|
149 ["Push State Out to MH" mh-update-sequences t]))
|
|
|
150
|
|
|
151 ;;; Message Menu
|
|
|
152
|
|
|
153 (easy-menu-define
|
|
|
154 mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
|
|
|
155 '("Message"
|
|
|
156 ["Show Message" mh-show (mh-get-msg-num nil)]
|
|
|
157 ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
|
|
|
158 ["Next Message" mh-next-undeleted-msg t]
|
|
|
159 ["Previous Message" mh-previous-undeleted-msg t]
|
|
|
160 ["Go to First Message" mh-first-msg t]
|
|
|
161 ["Go to Last Message" mh-last-msg t]
|
|
|
162 ["Go to Message by Number..." mh-goto-msg t]
|
|
|
163 ["Modify Message" mh-modify t]
|
|
|
164 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
|
|
|
165 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
|
|
|
166 ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
|
|
|
167 ["Execute Delete/Refile" mh-execute-commands
|
|
|
168 (mh-outstanding-commands-p)]
|
|
|
169 "--"
|
|
|
170 ["Compose a New Message" mh-send t]
|
|
|
171 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
|
|
|
172 ["Forward Message..." mh-forward (mh-get-msg-num nil)]
|
|
|
173 ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
|
|
|
174 ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
|
|
|
175 ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
|
|
|
176 "--"
|
|
|
177 ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
|
|
|
178 ["Print Message" mh-print-msg (mh-get-msg-num nil)]
|
|
|
179 ["Write Message to File..." mh-write-msg-to-file
|
|
|
180 (mh-get-msg-num nil)]
|
|
|
181 ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
|
|
|
182 ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
|
|
|
183 ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
|
|
|
184
|
|
|
185 ;;; Folder Menu
|
|
|
186
|
|
|
187 (easy-menu-define
|
|
|
188 mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
|
|
|
189 '("Folder"
|
|
|
190 ["Incorporate New Mail" mh-inc-folder t]
|
|
|
191 ["Toggle Show/Folder" mh-toggle-showing t]
|
|
|
192 ["Execute Delete/Refile" mh-execute-commands
|
|
|
193 (mh-outstanding-commands-p)]
|
|
|
194 ["Rescan Folder" mh-rescan-folder t]
|
|
|
195 ["Thread Folder" mh-toggle-threads
|
|
|
196 (not (memq 'unthread mh-view-ops))]
|
|
|
197 ["Pack Folder" mh-pack-folder t]
|
|
|
198 ["Sort Folder" mh-sort-folder t]
|
|
|
199 "--"
|
|
|
200 ["List Folders" mh-list-folders t]
|
|
|
201 ["Visit a Folder..." mh-visit-folder t]
|
|
|
202 ["View New Messages" mh-index-new-messages t]
|
|
|
203 ["Search..." mh-search t]
|
|
|
204 "--"
|
|
|
205 ["Quit MH-E" mh-quit t]))
|
|
|
206
|
|
|
207
|
|
|
208
|
|
|
209 ;;; MH-Folder Keys
|
|
|
210
|
|
|
211 (suppress-keymap mh-folder-mode-map)
|
|
|
212
|
|
|
213 ;; Use defalias to make sure the documented primary key bindings
|
|
|
214 ;; appear in menu lists.
|
|
|
215 (defalias 'mh-alt-show 'mh-show)
|
|
|
216 (defalias 'mh-alt-refile-msg 'mh-refile-msg)
|
|
|
217 (defalias 'mh-alt-send 'mh-send)
|
|
|
218 (defalias 'mh-alt-visit-folder 'mh-visit-folder)
|
|
|
219
|
|
|
220 ;; Save the "b" binding for a future `back'. Maybe?
|
|
|
221 (gnus-define-keys mh-folder-mode-map
|
|
|
222 " " mh-page-msg
|
|
|
223 "!" mh-refile-or-write-again
|
|
|
224 "'" mh-toggle-tick
|
|
|
225 "," mh-header-display
|
|
|
226 "." mh-alt-show
|
|
|
227 ";" mh-toggle-mh-decode-mime-flag
|
|
|
228 ">" mh-write-msg-to-file
|
|
|
229 "?" mh-help
|
|
|
230 "E" mh-extract-rejected-mail
|
|
|
231 "M" mh-modify
|
|
|
232 "\177" mh-previous-page
|
|
|
233 "\C-d" mh-delete-msg-no-motion
|
|
|
234 "\t" mh-index-next-folder
|
|
|
235 [backtab] mh-index-previous-folder
|
|
|
236 "\M-\t" mh-index-previous-folder
|
|
|
237 "\e<" mh-first-msg
|
|
|
238 "\e>" mh-last-msg
|
|
|
239 "\ed" mh-redistribute
|
|
|
240 "\r" mh-show
|
|
|
241 "^" mh-alt-refile-msg
|
|
|
242 "c" mh-copy-msg
|
|
|
243 "d" mh-delete-msg
|
|
|
244 "e" mh-edit-again
|
|
|
245 "f" mh-forward
|
|
|
246 "g" mh-goto-msg
|
|
|
247 "i" mh-inc-folder
|
|
|
248 "k" mh-delete-subject-or-thread
|
|
|
249 "m" mh-alt-send
|
|
|
250 "n" mh-next-undeleted-msg
|
|
|
251 "\M-n" mh-next-unread-msg
|
|
|
252 "o" mh-refile-msg
|
|
|
253 "p" mh-previous-undeleted-msg
|
|
|
254 "\M-p" mh-previous-unread-msg
|
|
|
255 "q" mh-quit
|
|
|
256 "r" mh-reply
|
|
|
257 "s" mh-send
|
|
|
258 "t" mh-toggle-showing
|
|
|
259 "u" mh-undo
|
|
|
260 "v" mh-index-visit-folder
|
|
|
261 "x" mh-execute-commands
|
|
|
262 "|" mh-pipe-msg)
|
|
|
263
|
|
|
264 (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
|
|
|
265 "?" mh-prefix-help
|
|
|
266 "'" mh-index-ticked-messages
|
|
|
267 "S" mh-sort-folder
|
|
|
268 "c" mh-catchup
|
|
|
269 "f" mh-alt-visit-folder
|
|
|
270 "k" mh-kill-folder
|
|
|
271 "l" mh-list-folders
|
|
|
272 "n" mh-index-new-messages
|
|
|
273 "o" mh-alt-visit-folder
|
|
|
274 "p" mh-pack-folder
|
|
|
275 "q" mh-index-sequenced-messages
|
|
|
276 "r" mh-rescan-folder
|
|
|
277 "s" mh-search
|
|
|
278 "u" mh-undo-folder
|
|
|
279 "v" mh-visit-folder)
|
|
|
280
|
|
|
281 (define-key mh-folder-mode-map "I" mh-inc-spool-map)
|
|
|
282
|
|
|
283 (gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
|
|
|
284 "?" mh-prefix-help
|
|
|
285 "b" mh-junk-blacklist
|
|
|
286 "w" mh-junk-whitelist)
|
|
|
287
|
|
|
288 (gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
|
|
|
289 "?" mh-prefix-help
|
|
|
290 "C" mh-ps-print-toggle-color
|
|
|
291 "F" mh-ps-print-toggle-faces
|
|
|
292 "f" mh-ps-print-msg-file
|
|
|
293 "l" mh-print-msg
|
|
|
294 "p" mh-ps-print-msg)
|
|
|
295
|
|
|
296 (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
|
|
|
297 "'" mh-narrow-to-tick
|
|
|
298 "?" mh-prefix-help
|
|
|
299 "d" mh-delete-msg-from-seq
|
|
|
300 "k" mh-delete-seq
|
|
|
301 "l" mh-list-sequences
|
|
|
302 "n" mh-narrow-to-seq
|
|
|
303 "p" mh-put-msg-in-seq
|
|
|
304 "s" mh-msg-is-in-seq
|
|
|
305 "w" mh-widen)
|
|
|
306
|
|
|
307 (gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
|
|
|
308 "?" mh-prefix-help
|
|
|
309 "u" mh-thread-ancestor
|
|
|
310 "p" mh-thread-previous-sibling
|
|
|
311 "n" mh-thread-next-sibling
|
|
|
312 "t" mh-toggle-threads
|
|
|
313 "d" mh-thread-delete
|
|
|
314 "o" mh-thread-refile)
|
|
|
315
|
|
|
316 (gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
|
|
|
317 "'" mh-narrow-to-tick
|
|
|
318 "?" mh-prefix-help
|
|
|
319 "c" mh-narrow-to-cc
|
|
|
320 "g" mh-narrow-to-range
|
|
|
321 "m" mh-narrow-to-from
|
|
|
322 "s" mh-narrow-to-subject
|
|
|
323 "t" mh-narrow-to-to
|
|
|
324 "w" mh-widen)
|
|
|
325
|
|
|
326 (gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
|
|
|
327 "?" mh-prefix-help
|
|
|
328 "s" mh-store-msg ;shar
|
|
|
329 "u" mh-store-msg) ;uuencode
|
|
|
330
|
|
|
331 (gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
|
|
|
332 " " mh-page-digest
|
|
|
333 "?" mh-prefix-help
|
|
|
334 "\177" mh-page-digest-backwards
|
|
|
335 "b" mh-burst-digest)
|
|
|
336
|
|
|
337 (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
|
|
|
338 "?" mh-prefix-help
|
|
|
339 "a" mh-mime-save-parts
|
|
|
340 "e" mh-display-with-external-viewer
|
|
|
341 "i" mh-folder-inline-mime-part
|
|
|
342 "o" mh-folder-save-mime-part
|
|
|
343 "t" mh-toggle-mime-buttons
|
|
|
344 "v" mh-folder-toggle-mime-part
|
|
|
345 "\t" mh-next-button
|
|
|
346 [backtab] mh-prev-button
|
|
|
347 "\M-\t" mh-prev-button)
|
|
|
348
|
|
|
349 (cond
|
|
|
350 (mh-xemacs-flag
|
|
|
351 (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
|
|
|
352 (t
|
|
|
353 (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
|
|
|
354
|
|
|
355 ;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
|
|
|
356
|
|
|
357
|
|
|
358
|
|
|
359 ;;; MH-Folder Help Messages
|
|
|
360
|
|
|
361 ;; If you add a new prefix, add appropriate text to the nil key.
|
|
|
362
|
|
|
363 ;; In general, messages are grouped logically. Taking the main commands for
|
|
|
364 ;; example, the first line is "ways to view messages," the second line is
|
|
|
365 ;; "things you can do with messages", and the third is "composing" messages.
|
|
|
366
|
|
|
367 ;; When adding a new prefix, ensure that the help message contains "what" the
|
|
|
368 ;; prefix is for. For example, if the word "folder" were not present in the
|
|
|
369 ;; "F" entry, it would not be clear what these commands operated upon.
|
|
|
370 (defvar mh-folder-mode-help-messages
|
|
|
371 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
|
|
|
372 "[d]elete, [o]refile, e[x]ecute,\n"
|
|
|
373 "[s]end, [r]eply,\n"
|
|
|
374 "[;]toggle MIME decoding.\n"
|
|
|
375 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
|
|
|
376 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
|
|
|
377
|
|
|
378 (?F "[l]ist; [v]isit folder;\n"
|
|
|
379 "[n]ew messages; [']ticked messages; [s]earch;\n"
|
|
|
380 "[p]ack; [S]ort; [r]escan; [k]ill")
|
|
|
381 (?P "[p]rint message to [f]ile; old-style [l]pr printing;\n"
|
|
|
382 "Toggle printing of [C]olors, [F]aces")
|
|
|
383 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
|
|
|
384 "[s]equences, [l]ist,\n"
|
|
|
385 "[d]elete message from sequence, [k]ill sequence")
|
|
|
386 (?T "[t]oggle, [d]elete, [o]refile thread")
|
|
|
387 (?/ "Limit to [c]c, ran[g]e, fro[m], [s]ubject, [t]o; [w]iden")
|
|
|
388 (?X "un[s]har, [u]udecode message")
|
|
|
389 (?D "[b]urst digest")
|
|
|
390 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
|
|
|
391 "[TAB] next; [SHIFT-TAB] previous")
|
|
|
392 (?J "[b]lacklist, [w]hitelist message"))
|
|
|
393 "Key binding cheat sheet.
|
|
|
394 See `mh-set-help'.")
|
|
|
395
|
|
|
396
|
|
|
397
|
|
|
398 ;;; MH-Folder Font Lock
|
|
|
399
|
|
|
400 (defvar mh-folder-font-lock-keywords
|
|
|
401 (list
|
|
|
402 ;; Folders when displaying index buffer
|
|
|
403 (list "^\\+.*"
|
|
|
404 '(0 'mh-search-folder))
|
|
|
405 ;; Marked for deletion
|
|
|
406 (list (concat mh-scan-deleted-msg-regexp ".*")
|
|
|
407 '(0 'mh-folder-deleted))
|
|
|
408 ;; Marked for refile
|
|
|
409 (list (concat mh-scan-refiled-msg-regexp ".*")
|
|
|
410 '(0 'mh-folder-refiled))
|
|
|
411 ;; After subject
|
|
|
412 (list mh-scan-body-regexp
|
|
|
413 '(1 'mh-folder-body nil t))
|
|
|
414 ;; Subject
|
|
|
415 '(mh-folder-font-lock-subject
|
|
|
416 (1 'mh-folder-followup append t)
|
|
|
417 (2 'mh-folder-subject append t))
|
|
|
418 ;; Current message number
|
|
|
419 (list mh-scan-cur-msg-number-regexp
|
|
|
420 '(1 'mh-folder-cur-msg-number))
|
|
|
421 ;; Message number
|
|
|
422 (list mh-scan-good-msg-regexp
|
|
|
423 '(1 'mh-folder-msg-number))
|
|
|
424 ;; Date
|
|
|
425 (list mh-scan-date-regexp
|
|
|
426 '(1 'mh-folder-date))
|
|
|
427 ;; Messages from me (To:)
|
|
|
428 (list mh-scan-rcpt-regexp
|
|
|
429 '(1 'mh-folder-to)
|
|
|
430 '(2 'mh-folder-address))
|
|
|
431 ;; Messages to me
|
|
|
432 (list mh-scan-sent-to-me-sender-regexp
|
|
|
433 '(1 'mh-folder-sent-to-me-hint)
|
|
|
434 '(2 'mh-folder-sent-to-me-sender)))
|
|
|
435 "Keywords (regular expressions) used to fontify the MH-Folder buffer.")
|
|
|
436
|
|
|
437 (defun mh-folder-font-lock-subject (limit)
|
|
|
438 "Return MH-E scan subject strings to font-lock between point and LIMIT."
|
|
|
439 (if (not (re-search-forward mh-scan-subject-regexp limit t))
|
|
|
440 nil
|
|
|
441 (if (match-beginning 1)
|
|
|
442 (set-match-data (list (match-beginning 1) (match-end 3)
|
|
|
443 (match-beginning 1) (match-end 3) nil nil))
|
|
|
444 (set-match-data (list (match-beginning 3) (match-end 3)
|
|
|
445 nil nil (match-beginning 3) (match-end 3))))
|
|
|
446 t))
|
|
|
447
|
|
|
448 ;; Fontify unseen messages in bold.
|
|
|
449
|
|
|
450 (defmacro mh-generate-sequence-font-lock (seq prefix face)
|
|
|
451 "Generate the appropriate code to fontify messages in SEQ.
|
|
|
452 PREFIX is used to generate unique names for the variables and
|
|
|
453 functions defined by the macro. So a different prefix should be
|
|
|
454 provided for every invocation.
|
|
|
455 FACE is the font-lock face used to display the matching scan lines."
|
|
|
456 (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
|
|
|
457 (func (intern (format "mh-folder-font-lock-%s" prefix))))
|
|
|
458 `(progn
|
|
|
459 (defvar ,cache nil
|
|
|
460 "Internal cache variable used for font-lock in MH-E.
|
|
|
461 Should only be non-nil through font-lock stepping, and nil once
|
|
|
462 font-lock is done highlighting.")
|
|
|
463 (make-variable-buffer-local ',cache)
|
|
|
464
|
|
|
465 (defun ,func (limit)
|
|
|
466 "Return unseen message lines to font-lock between point and LIMIT."
|
|
|
467 (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
|
|
|
468 (let ((cur-msg (mh-get-msg-num nil)))
|
|
|
469 (cond ((not ,cache)
|
|
|
470 nil)
|
|
|
471 ((>= (point) limit) ;Presumably at end of buffer
|
|
|
472 (setq ,cache nil)
|
|
|
473 nil)
|
|
|
474 ((member cur-msg ,cache)
|
|
|
475 (let ((bpoint (progn (beginning-of-line)(point)))
|
|
|
476 (epoint (progn (forward-line 1)(point))))
|
|
|
477 (if (<= limit (point)) (setq ,cache nil))
|
|
|
478 (set-match-data (list bpoint epoint bpoint epoint))
|
|
|
479 t))
|
|
|
480 (t
|
|
|
481 ;; move forward one line at a time, checking each message
|
|
|
482 (while (and (= 0 (forward-line 1))
|
|
|
483 (> limit (point))
|
|
|
484 (not (member (mh-get-msg-num nil) ,cache))))
|
|
|
485 ;; Examine how we must have exited the loop...
|
|
|
486 (let ((cur-msg (mh-get-msg-num nil)))
|
|
|
487 (cond ((or (<= limit (point))
|
|
|
488 (not (member cur-msg ,cache)))
|
|
|
489 (setq ,cache nil)
|
|
|
490 nil)
|
|
|
491 ((member cur-msg ,cache)
|
|
|
492 (let ((bpoint (progn (beginning-of-line) (point)))
|
|
|
493 (epoint (progn (forward-line 1) (point))))
|
|
|
494 (if (<= limit (point)) (setq ,cache nil))
|
|
|
495 (set-match-data
|
|
|
496 (list bpoint epoint bpoint epoint))
|
|
|
497 t))))))))
|
|
|
498
|
|
|
499 (setq mh-folder-font-lock-keywords
|
|
|
500 (append mh-folder-font-lock-keywords
|
|
|
501 (list (list ',func (list 1 '',face 'prepend t))))))))
|
|
|
502
|
|
|
503 (mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
|
|
|
504 (mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick)
|
|
|
505
|
|
|
506
|
|
|
507
|
|
|
508 ;;; MH-Folder Mode
|
|
|
509
|
|
|
510 (defmacro mh-remove-xemacs-horizontal-scrollbar ()
|
|
|
511 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
|
|
|
512 (when mh-xemacs-flag
|
|
|
513 `(if (and (featurep 'scrollbar)
|
|
|
514 (fboundp 'set-specifier))
|
|
|
515 (set-specifier horizontal-scrollbar-visible-p nil
|
|
|
516 (cons (current-buffer) nil)))))
|
|
|
517
|
|
|
518 (defmacro mh-write-file-functions-compat ()
|
|
|
519 "Return `write-file-functions' if it exists.
|
|
|
520 Otherwise return `local-write-file-hooks'. This macro exists
|
|
|
521 purely for compatibility. The former symbol is used in Emacs 21.4
|
|
|
522 onward while the latter is used in previous versions and XEmacs."
|
|
|
523 (if (boundp 'write-file-functions)
|
|
|
524 ''write-file-functions ;Emacs 21.4
|
|
|
525 ''local-write-file-hooks)) ;XEmacs
|
|
|
526
|
|
|
527 ;; Register mh-folder-mode as supporting which-function-mode...
|
|
|
528 (require 'which-func nil t)
|
|
|
529 (when (boundp 'which-func-modes)
|
|
|
530 (add-to-list 'which-func-modes 'mh-folder-mode))
|
|
|
531
|
|
|
532 ;; Shush compiler.
|
|
|
533 (eval-when-compile
|
|
|
534 (defvar desktop-save-buffer)
|
|
|
535 (defvar font-lock-auto-fontify)
|
|
|
536 (mh-do-in-xemacs (defvar font-lock-defaults)))
|
|
|
537
|
|
|
538 (defvar mh-folder-buttons-init-flag nil)
|
|
|
539
|
|
|
540 ;; Ensure new buffers won't get this mode if default-major-mode is nil.
|
|
|
541 (put 'mh-folder-mode 'mode-class 'special)
|
|
|
542
|
|
|
543 ;; Autoload cookie needed by desktop.el
|
|
|
544 ;;;###autoload
|
|
|
545 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
|
|
|
546 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
|
|
|
547
|
|
|
548 You can show the message the cursor is pointing to, and step through
|
|
|
549 the messages. Messages can be marked for deletion or refiling into
|
|
|
550 another folder; these commands are executed all at once with a
|
|
|
551 separate command.
|
|
|
552
|
|
|
553 Options that control this mode can be changed with
|
|
|
554 \\[customize-group]; specify the \"mh\" group. In particular, please
|
|
|
555 see the `mh-scan-format-file' option if you wish to modify scan's
|
|
|
556 format.
|
|
|
557
|
|
|
558 When a folder is visited, the hook `mh-folder-mode-hook' is run.
|
|
|
559
|
|
|
560 Ranges
|
|
|
561 ======
|
|
|
562 Many commands that operate on individual messages, such as
|
|
|
563 `mh-forward' or `mh-refile-msg' take a RANGE argument. This argument
|
|
|
564 can be used in several ways.
|
|
|
565
|
|
|
566 If you provide the prefix argument (\\[universal-argument]) to
|
|
|
567 these commands, then you will be prompted for the message range.
|
|
|
568 This can be any valid MH range which can include messages,
|
|
|
569 sequences, and the abbreviations (described in the mh(1) man
|
|
|
570 page):
|
|
|
571
|
|
|
572 <num1>-<num2>
|
|
|
573 Indicates all messages in the range <num1> to <num2>, inclusive.
|
|
|
574 The range must be nonempty.
|
|
|
575
|
|
|
576 <num>:N
|
|
|
577 <num>:+N
|
|
|
578 <num>:-N
|
|
|
579 Up to N messages beginning with (or ending with) message num. Num
|
|
|
580 may be any of the predefined symbols: first, prev, cur, next or
|
|
|
581 last.
|
|
|
582
|
|
|
583 first:N
|
|
|
584 prev:N
|
|
|
585 next:N
|
|
|
586 last:N
|
|
|
587 The first, previous, next or last messages, if they exist.
|
|
|
588
|
|
|
589 all
|
|
|
590 All of the messages.
|
|
|
591
|
|
|
592 For example, a range that shows all of these things is `1 2 3
|
|
|
593 5-10 last:5 unseen'.
|
|
|
594
|
|
|
595 If the option `transient-mark-mode' is set to t and you set a
|
|
|
596 region in the MH-Folder buffer, then the MH-E command will
|
|
|
597 perform the operation on all messages in that region.
|
|
|
598
|
|
|
599 \\{mh-folder-mode-map}"
|
|
|
600 (mh-do-in-gnu-emacs
|
|
|
601 (unless mh-folder-buttons-init-flag
|
|
|
602 (mh-tool-bar-folder-buttons-init)
|
|
|
603 (setq mh-folder-buttons-init-flag t)))
|
|
|
604 (make-local-variable 'font-lock-defaults)
|
|
|
605 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
|
|
|
606 (make-local-variable 'desktop-save-buffer)
|
|
|
607 (setq desktop-save-buffer t)
|
|
|
608 (mh-make-local-vars
|
|
|
609 'mh-colors-available-flag (mh-colors-available-p)
|
|
|
610 ; Do we have colors available
|
|
|
611 'mh-current-folder (buffer-name) ; Name of folder, a string
|
|
|
612 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
|
|
|
613 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
|
|
|
614 (file-name-as-directory (mh-expand-file-name (buffer-name)))
|
|
|
615 'mh-display-buttons-for-inline-parts-flag
|
|
|
616 mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
|
|
|
617 ; be toggled.
|
|
|
618 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
|
|
|
619 'overlay-arrow-position nil ; Allow for simultaneous display in
|
|
|
620 'overlay-arrow-string ">" ; different MH-E buffers.
|
|
|
621 'mh-showing-mode nil ; Show message also?
|
|
|
622 'mh-delete-list nil ; List of msgs nums to delete
|
|
|
623 'mh-refile-list nil ; List of folder names in mh-seq-list
|
|
|
624 'mh-seq-list nil ; Alist of (seq . msgs) nums
|
|
|
625 'mh-seen-list nil ; List of displayed messages
|
|
|
626 'mh-next-direction 'forward ; Direction to move to next message
|
|
|
627 'mh-view-ops () ; Stack that keeps track of the order
|
|
|
628 ; in which narrowing/threading has been
|
|
|
629 ; carried out.
|
|
|
630 'mh-folder-view-stack () ; Stack of previous views of the
|
|
|
631 ; folder.
|
|
|
632 'mh-index-data nil ; If the folder was created by a call
|
|
|
633 ; to mh-search, this contains info
|
|
|
634 ; about the search results.
|
|
|
635 'mh-index-previous-search nil ; folder, indexer, search-regexp
|
|
|
636 'mh-index-msg-checksum-map nil ; msg -> checksum map
|
|
|
637 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
|
|
|
638 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
|
|
|
639 'mh-first-msg-num nil ; Number of first msg in buffer
|
|
|
640 'mh-last-msg-num nil ; Number of last msg in buffer
|
|
|
641 'mh-msg-count nil ; Number of msgs in buffer
|
|
|
642 'mh-mode-line-annotation nil ; Indicates message range
|
|
|
643 'mh-sequence-notation-history (make-hash-table)
|
|
|
644 ; Remember what is overwritten by
|
|
|
645 ; mh-note-seq.
|
|
|
646 'imenu-create-index-function 'mh-index-create-imenu-index
|
|
|
647 ; Setup imenu support
|
|
|
648 'mh-previous-window-config nil) ; Previous window configuration
|
|
|
649 (mh-remove-xemacs-horizontal-scrollbar)
|
|
|
650 (setq truncate-lines t)
|
|
|
651 (auto-save-mode -1)
|
|
|
652 (setq buffer-offer-save t)
|
|
|
653 (mh-make-local-hook (mh-write-file-functions-compat))
|
|
|
654 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
|
|
|
655 (make-local-variable 'revert-buffer-function)
|
|
|
656 (make-local-variable 'hl-line-mode) ; avoid pollution
|
|
|
657 (mh-funcall-if-exists hl-line-mode 1)
|
|
|
658 (setq revert-buffer-function 'mh-undo-folder)
|
|
|
659 (or (assq 'mh-showing-mode minor-mode-alist)
|
|
|
660 (setq minor-mode-alist
|
|
|
661 (cons '(mh-showing-mode " Show") minor-mode-alist)))
|
|
|
662 (easy-menu-add mh-folder-sequence-menu)
|
|
|
663 (easy-menu-add mh-folder-message-menu)
|
|
|
664 (easy-menu-add mh-folder-folder-menu)
|
|
|
665 (mh-inc-spool-make)
|
|
|
666 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
|
|
|
667 (mh-funcall-if-exists mh-tool-bar-init :folder)
|
|
|
668 (mh-set-help mh-folder-mode-help-messages)
|
|
|
669 (if (and mh-xemacs-flag
|
|
|
670 font-lock-auto-fontify)
|
|
|
671 (turn-on-font-lock))) ; Force font-lock in XEmacs.
|
|
|
672
|
|
|
673
|
|
|
674
|
|
|
675 ;;; MH-Folder Commands
|
|
|
676
|
|
|
677 ;; Alphabetical.
|
|
|
678 ;; See also mh-comp.el, mh-junk.el, mh-mime.el, mh-print.el,
|
|
|
679 ;; mh-search.el, and mh-seq.el.
|
|
|
680
|
|
|
681 ;;;###mh-autoload
|
|
|
682 (defun mh-delete-msg (range)
|
|
|
683 "Delete RANGE\\<mh-folder-mode-map>.
|
|
|
684
|
|
|
685 To mark a message for deletion, use this command. A \"D\" is
|
|
|
686 placed by the message in the scan window, and the next undeleted
|
|
|
687 message is displayed. If the previous command had been
|
|
|
688 \\[mh-previous-undeleted-msg], then the next message displayed is
|
|
|
689 the first undeleted message previous to the message just deleted.
|
|
|
690 Use \\[mh-next-undeleted-msg] to force subsequent
|
|
|
691 \\[mh-delete-msg] commands to move forward to the next undeleted
|
|
|
692 message after deleting the message under the cursor.
|
|
|
693
|
|
|
694 The hook `mh-delete-msg-hook' is called after you mark a message
|
|
|
695 for deletion. For example, a past maintainer of MH-E used this
|
|
|
696 once when he kept statistics on his mail usage.
|
|
|
697
|
|
|
698 Check the documentation of `mh-interactive-range' to see how
|
|
|
699 RANGE is read in interactive use."
|
|
|
700 (interactive (list (mh-interactive-range "Delete")))
|
|
|
701 (mh-delete-msg-no-motion range)
|
|
|
702 (if (looking-at mh-scan-deleted-msg-regexp)
|
|
|
703 (mh-next-msg)))
|
|
|
704
|
|
|
705 ;;;###mh-autoload
|
|
|
706 (defun mh-delete-msg-no-motion (range)
|
|
|
707 "Delete RANGE, don't move to next message.
|
|
|
708
|
|
|
709 This command marks the RANGE for deletion but leaves the cursor
|
|
|
710 at the current message in case you wish to perform other
|
|
|
711 operations on the message.
|
|
|
712
|
|
|
713 Check the documentation of `mh-interactive-range' to see how
|
|
|
714 RANGE is read in interactive use."
|
|
|
715 (interactive (list (mh-interactive-range "Delete")))
|
|
|
716 (mh-iterate-on-range () range
|
|
|
717 (mh-delete-a-msg nil)))
|
|
|
718
|
|
|
719 ;;;###mh-autoload
|
|
|
720 (defun mh-execute-commands ()
|
|
|
721 "Process outstanding delete and refile requests\\<mh-folder-mode-map>.
|
|
|
722
|
|
|
723 If you've marked messages to be deleted or refiled and you want
|
|
|
724 to go ahead and delete or refile the messages, use this command.
|
|
|
725 Many MH-E commands that may affect the numbering of the
|
|
|
726 messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder])
|
|
|
727 will ask if you want to process refiles or deletes first and then
|
|
|
728 either run this command for you or undo the pending refiles and
|
|
|
729 deletes, which are lost.
|
|
|
730
|
|
|
731 This function runs `mh-before-commands-processed-hook' before the
|
|
|
732 commands are processed and `mh-after-commands-processed-hook'
|
|
|
733 after the commands are processed."
|
|
|
734 (interactive)
|
|
|
735 (if mh-folder-view-stack (mh-widen t))
|
|
|
736 (mh-process-commands mh-current-folder)
|
|
|
737 (mh-set-scan-mode)
|
|
|
738 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
|
|
|
739 (mh-make-folder-mode-line)
|
|
|
740 t) ; return t for write-file-functions
|
|
|
741
|
|
|
742 ;;;###mh-autoload
|
|
|
743 (defun mh-first-msg ()
|
|
|
744 "Display first message."
|
|
|
745 (interactive)
|
|
|
746 (goto-char (point-min))
|
|
|
747 (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
|
|
|
748 (forward-line 1)))
|
|
|
749
|
|
|
750 ;;;###mh-autoload
|
|
|
751 (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
|
|
|
752 "Go to a message\\<mh-folder-mode-map>.
|
|
|
753
|
|
|
754 You can enter the message NUMBER either before or after typing
|
|
|
755 \\[mh-goto-msg]. In the latter case, Emacs prompts you.
|
|
|
756
|
|
|
757 In a program, optional non-nil second argument NO-ERROR-IF-NO-MESSAGE
|
|
|
758 means return nil instead of signaling an error if message does not
|
|
|
759 exist\; in this case, the cursor is positioned near where the message
|
|
|
760 would have been. Non-nil third argument DONT-SHOW means not to show
|
|
|
761 the message."
|
|
|
762 (interactive "NGo to message: ")
|
|
|
763 (setq number (prefix-numeric-value number))
|
|
|
764 (let ((point (point))
|
|
|
765 (return-value t))
|
|
|
766 (goto-char (point-min))
|
|
|
767 (unless (re-search-forward (format (mh-scan-msg-search-regexp) number)
|
|
|
768 nil t)
|
|
|
769 (goto-char point)
|
|
|
770 (unless no-error-if-no-message
|
|
|
771 (error "No message %d" number))
|
|
|
772 (setq return-value nil))
|
|
|
773 (beginning-of-line)
|
|
|
774 (or dont-show (not return-value) (mh-maybe-show number))
|
|
|
775 return-value))
|
|
|
776
|
|
|
777 ;;;###mh-autoload
|
|
|
778 (defun mh-inc-folder (&optional file folder)
|
|
|
779 "Incorporate new mail into a folder.
|
|
|
780
|
|
|
781 You can incorporate mail from any file into the current folder by
|
|
|
782 specifying a prefix argument; you'll be prompted for the name of
|
|
|
783 the FILE to use as well as the destination FOLDER
|
|
|
784
|
|
|
785 The hook `mh-inc-folder-hook' is run after incorporating new
|
|
|
786 mail.
|
|
|
787
|
|
|
788 Do not call this function from outside MH-E; use \\[mh-rmail]
|
|
|
789 instead."
|
|
|
790 (interactive (list (if current-prefix-arg
|
|
|
791 (expand-file-name
|
|
|
792 (read-file-name "inc mail from file: "
|
|
|
793 mh-user-path)))
|
|
|
794 (if current-prefix-arg
|
|
|
795 (mh-prompt-for-folder "inc mail into" mh-inbox t))))
|
|
|
796 (if (not folder)
|
|
|
797 (setq folder mh-inbox))
|
|
|
798 (let ((threading-needed-flag nil))
|
|
|
799 (let ((config (current-window-configuration)))
|
|
|
800 (when (and mh-show-buffer (get-buffer mh-show-buffer))
|
|
|
801 (delete-windows-on mh-show-buffer))
|
|
|
802 (cond ((not (get-buffer folder))
|
|
|
803 (mh-make-folder folder)
|
|
|
804 (setq threading-needed-flag mh-show-threads-flag)
|
|
|
805 (setq mh-previous-window-config config))
|
|
|
806 ((not (eq (current-buffer) (get-buffer folder)))
|
|
|
807 (switch-to-buffer folder)
|
|
|
808 (setq mh-previous-window-config config))))
|
|
|
809 (mh-get-new-mail file)
|
|
|
810 (when (and threading-needed-flag
|
|
|
811 (save-excursion
|
|
|
812 (goto-char (point-min))
|
|
|
813 (or (null mh-large-folder)
|
|
|
814 (not (equal (forward-line (1+ mh-large-folder)) 0))
|
|
|
815 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
|
|
|
816 nil))))
|
|
|
817 (mh-toggle-threads))
|
|
|
818 (beginning-of-line)
|
|
|
819 (if (and mh-showing-mode (looking-at mh-scan-valid-regexp)) (mh-show))
|
|
|
820 (run-hooks 'mh-inc-folder-hook)))
|
|
|
821
|
|
|
822 ;;;###mh-autoload
|
|
|
823 (defun mh-last-msg ()
|
|
|
824 "Display last message."
|
|
|
825 (interactive)
|
|
|
826 (goto-char (point-max))
|
|
|
827 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
|
|
|
828 (forward-line -1))
|
|
|
829 (mh-recenter nil))
|
|
|
830
|
|
|
831 ;;;###mh-autoload
|
|
|
832 (defun mh-modify (&optional message)
|
|
|
833 "Edit message.
|
|
|
834
|
|
|
835 There are times when you need to edit a message. For example, you
|
|
|
836 may need to fix a broken Content-Type header field. You can do
|
|
|
837 this with this command. It displays the raw message in an
|
|
|
838 editable buffer. When you are done editing, save and kill the
|
|
|
839 buffer as you would any other.
|
|
|
840
|
|
|
841 From a program, edit MESSAGE; nil means edit current message."
|
|
|
842 (interactive)
|
|
|
843 (let* ((message (or message (mh-get-msg-num t)))
|
|
|
844 (msg-filename (mh-msg-filename message))
|
|
|
845 edit-buffer)
|
|
|
846 (when (not (file-exists-p msg-filename))
|
|
|
847 (error "Message %d does not exist" message))
|
|
|
848
|
|
|
849 ;; Invalidate the show buffer if it is showing the same message that is
|
|
|
850 ;; to be edited.
|
|
|
851 (when (and (buffer-live-p (get-buffer mh-show-buffer))
|
|
|
852 (equal (save-excursion (set-buffer mh-show-buffer)
|
|
|
853 buffer-file-name)
|
|
|
854 msg-filename))
|
|
|
855 (mh-invalidate-show-buffer))
|
|
|
856
|
|
|
857 ;; Edit message
|
|
|
858 (find-file msg-filename)
|
|
|
859 (setq edit-buffer (current-buffer))
|
|
|
860
|
|
|
861 ;; Set buffer properties
|
|
|
862 (mh-letter-mode)
|
|
|
863 (use-local-map text-mode-map)
|
|
|
864
|
|
|
865 ;; Just show the edit buffer...
|
|
|
866 (delete-other-windows)
|
|
|
867 (switch-to-buffer edit-buffer)))
|
|
|
868
|
|
|
869 ;;;###mh-autoload
|
|
|
870 (defun mh-next-button (&optional backward-flag)
|
|
|
871 "Go to the next button.
|
|
|
872
|
|
|
873 If the end of the buffer is reached then the search wraps over to
|
|
|
874 the start of the buffer.
|
|
|
875
|
|
|
876 If an optional prefix argument BACKWARD-FLAG is given, the cursor
|
|
|
877 will move to the previous button."
|
|
|
878 (interactive (list current-prefix-arg))
|
|
|
879 (unless mh-showing-mode
|
|
|
880 (mh-show))
|
|
|
881 (mh-in-show-buffer (mh-show-buffer)
|
|
|
882 (mh-goto-next-button backward-flag)))
|
|
|
883
|
|
|
884 ;;;###mh-autoload
|
|
|
885 (defun mh-next-undeleted-msg (&optional count wait-after-complaining-flag)
|
|
|
886 "Display next message.
|
|
|
887
|
|
|
888 This command can be given a prefix argument COUNT to specify how
|
|
|
889 many unread messages to skip.
|
|
|
890
|
|
|
891 In a program, pause for a second after printing message if we are
|
|
|
892 at the last undeleted message and optional argument
|
|
|
893 WAIT-AFTER-COMPLAINING-FLAG is non-nil."
|
|
|
894 (interactive "p")
|
|
|
895 (setq mh-next-direction 'forward)
|
|
|
896 (forward-line 1)
|
|
|
897 (cond ((re-search-forward mh-scan-good-msg-regexp nil t count)
|
|
|
898 (beginning-of-line)
|
|
|
899 (mh-maybe-show))
|
|
|
900 (t (forward-line -1)
|
|
|
901 (message "No more undeleted messages")
|
|
|
902 (if wait-after-complaining-flag (sit-for 1)))))
|
|
|
903
|
|
|
904 ;;;###mh-autoload
|
|
|
905 (defun mh-next-unread-msg (&optional count)
|
|
|
906 "Display next unread message.
|
|
|
907
|
|
|
908 This command can be given a prefix argument COUNT to specify how
|
|
|
909 many unread messages to skip."
|
|
|
910 (interactive "p")
|
|
|
911 (unless (> count 0)
|
|
|
912 (error "The function `mh-next-unread-msg' expects positive argument"))
|
|
|
913 (setq count (1- count))
|
|
|
914 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
|
|
|
915 (cur-msg (mh-get-msg-num nil)))
|
|
|
916 (cond ((and (not cur-msg) (not (bobp))
|
|
|
917 ;; If we are at the end of the buffer back up one line and go
|
|
|
918 ;; to unread message after that.
|
|
|
919 (progn
|
|
|
920 (forward-line -1)
|
|
|
921 (setq cur-msg (mh-get-msg-num nil)))
|
|
|
922 nil))
|
|
|
923 ((or (null unread-sequence) (not cur-msg))
|
|
|
924 ;; No unread message or there aren't any messages in buffer...
|
|
|
925 (message "No more unread messages"))
|
|
|
926 ((progn
|
|
|
927 ;; Skip messages
|
|
|
928 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
|
|
|
929 (setq unread-sequence (cdr unread-sequence)))
|
|
|
930 (while (> count 0)
|
|
|
931 (setq unread-sequence (cdr unread-sequence))
|
|
|
932 (setq count (1- count)))
|
|
|
933 (not (car unread-sequence)))
|
|
|
934 (message "No more unread messages"))
|
|
|
935 (t (loop for msg in unread-sequence
|
|
|
936 when (mh-goto-msg msg t) return nil
|
|
|
937 finally (message "No more unread messages"))))))
|
|
|
938
|
|
|
939 ;;;###mh-autoload
|
|
|
940 (defun mh-page-msg (&optional lines)
|
|
|
941 "Display next page in message.
|
|
|
942
|
|
|
943 You can give this command a prefix argument that specifies the
|
|
|
944 number of LINES to scroll. This command will also show the next
|
|
|
945 undeleted message if it is used at the bottom of a message."
|
|
|
946 (interactive "P")
|
|
|
947 (if mh-showing-mode
|
|
|
948 (if mh-page-to-next-msg-flag
|
|
|
949 (if (equal mh-next-direction 'backward)
|
|
|
950 (mh-previous-undeleted-msg)
|
|
|
951 (mh-next-undeleted-msg))
|
|
|
952 (if (mh-in-show-buffer (mh-show-buffer)
|
|
|
953 (pos-visible-in-window-p (point-max)))
|
|
|
954 (progn
|
|
|
955 (message
|
|
|
956 "End of message (Type %s to read %s undeleted message)"
|
|
|
957 (single-key-description last-input-event)
|
|
|
958 (if (equal mh-next-direction 'backward)
|
|
|
959 "previous"
|
|
|
960 "next"))
|
|
|
961 (setq mh-page-to-next-msg-flag t))
|
|
|
962 (scroll-other-window lines)))
|
|
|
963 (mh-show)))
|
|
|
964
|
|
|
965 ;;;###mh-autoload
|
|
|
966 (defun mh-prev-button ()
|
|
|
967 "Go to the previous button.
|
|
|
968
|
|
|
969 If the beginning of the buffer is reached then the search wraps
|
|
|
970 over to the end of the buffer."
|
|
|
971 (interactive)
|
|
|
972 (mh-next-button t))
|
|
|
973
|
|
|
974 ;;;###mh-autoload
|
|
|
975 (defun mh-previous-page (&optional lines)
|
|
|
976 "Display next page in message.
|
|
|
977
|
|
|
978 You can give this command a prefix argument that specifies the
|
|
|
979 number of LINES to scroll."
|
|
|
980 (interactive "P")
|
|
|
981 (mh-in-show-buffer (mh-show-buffer)
|
|
|
982 (scroll-down lines)))
|
|
|
983
|
|
|
984 ;;;###mh-autoload
|
|
|
985 (defun mh-previous-undeleted-msg (&optional count wait-after-complaining-flag)
|
|
|
986 "Display previous message.
|
|
|
987
|
|
|
988 This command can be given a prefix argument COUNT to specify how
|
|
|
989 many unread messages to skip.
|
|
|
990
|
|
|
991 In a program, pause for a second after printing message if we are
|
|
|
992 at the last undeleted message and optional argument
|
|
|
993 WAIT-AFTER-COMPLAINING-FLAG is non-nil."
|
|
|
994 (interactive "p")
|
|
|
995 (setq mh-next-direction 'backward)
|
|
|
996 (beginning-of-line)
|
|
|
997 (cond ((re-search-backward mh-scan-good-msg-regexp nil t count)
|
|
|
998 (mh-maybe-show))
|
|
|
999 (t (message "No previous undeleted message")
|
|
|
1000 (if wait-after-complaining-flag (sit-for 1)))))
|
|
|
1001
|
|
|
1002 ;;;###mh-autoload
|
|
|
1003 (defun mh-previous-unread-msg (&optional count)
|
|
|
1004 "Display previous unread message.
|
|
|
1005
|
|
|
1006 This command can be given a prefix argument COUNT to specify how
|
|
|
1007 many unread messages to skip."
|
|
|
1008 (interactive "p")
|
|
|
1009 (unless (> count 0)
|
|
|
1010 (error "The function `mh-previous-unread-msg' expects positive argument"))
|
|
|
1011 (setq count (1- count))
|
|
|
1012 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
|
|
|
1013 (cur-msg (mh-get-msg-num nil)))
|
|
|
1014 (cond ((and (not cur-msg) (not (bobp))
|
|
|
1015 ;; If we are at the end of the buffer back up one line and go
|
|
|
1016 ;; to unread message after that.
|
|
|
1017 (progn
|
|
|
1018 (forward-line -1)
|
|
|
1019 (setq cur-msg (mh-get-msg-num nil)))
|
|
|
1020 nil))
|
|
|
1021 ((or (null unread-sequence) (not cur-msg))
|
|
|
1022 ;; No unread message or there aren't any messages in buffer...
|
|
|
1023 (message "No more unread messages"))
|
|
|
1024 ((progn
|
|
|
1025 ;; Skip count messages...
|
|
|
1026 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
|
|
|
1027 (setq unread-sequence (cdr unread-sequence)))
|
|
|
1028 (while (> count 0)
|
|
|
1029 (setq unread-sequence (cdr unread-sequence))
|
|
|
1030 (setq count (1- count)))
|
|
|
1031 (not (car unread-sequence)))
|
|
|
1032 (message "No more unread messages"))
|
|
|
1033 (t (loop for msg in unread-sequence
|
|
|
1034 when (mh-goto-msg msg t) return nil
|
|
|
1035 finally (message "No more unread messages"))))))
|
|
|
1036
|
|
|
1037 ;;;###mh-autoload
|
|
|
1038 (defun mh-quit ()
|
|
|
1039 "Quit the current MH-E folder.
|
|
|
1040
|
|
|
1041 When you want to quit using MH-E and go back to editing, you can use
|
|
|
1042 this command. This buries the buffers of the current MH-E folder and
|
|
|
1043 restores the buffers that were present when you first ran
|
|
|
1044 \\[mh-rmail]. It also removes any MH-E working buffers whose name
|
|
|
1045 begins with \" *mh-\" or \"*MH-E \". You can later restore your MH-E
|
|
|
1046 session by selecting the \"+inbox\" buffer or by running \\[mh-rmail]
|
|
|
1047 again.
|
|
|
1048
|
|
|
1049 The two hooks `mh-before-quit-hook' and `mh-quit-hook' are called by
|
|
|
1050 this function. The former one is called before the quit occurs, so you
|
|
|
1051 might use it to perform any MH-E operations; you could perform some
|
|
|
1052 query and abort the quit or call `mh-execute-commands', for example.
|
|
|
1053 The latter is not run in an MH-E context, so you might use it to
|
|
|
1054 modify the window setup."
|
|
|
1055 (interactive)
|
|
|
1056 (run-hooks 'mh-before-quit-hook)
|
|
|
1057 (let ((show-buffer (get-buffer mh-show-buffer)))
|
|
|
1058 (when show-buffer
|
|
|
1059 (kill-buffer show-buffer)))
|
|
|
1060 (mh-update-sequences)
|
|
|
1061 (mh-destroy-postponed-handles)
|
|
|
1062 (bury-buffer (current-buffer))
|
|
|
1063
|
|
|
1064 ;; Delete all MH-E temporary and working buffers.
|
|
|
1065 (dolist (buffer (buffer-list))
|
|
|
1066 (when (or (string-match "^ \\*mh-" (buffer-name buffer))
|
|
|
1067 (string-match "^\\*MH-E " (buffer-name buffer)))
|
|
|
1068 (kill-buffer buffer)))
|
|
|
1069
|
|
|
1070 (if mh-previous-window-config
|
|
|
1071 (set-window-configuration mh-previous-window-config))
|
|
|
1072 (run-hooks 'mh-quit-hook))
|
|
|
1073
|
|
|
1074 ;;;###mh-autoload
|
|
|
1075 (defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
|
|
|
1076 "Refile (output) RANGE into FOLDER.
|
|
|
1077
|
|
|
1078 You are prompted for the folder name. Note that this command can also
|
|
|
1079 be used to create folders. If you specify a folder that does not
|
|
|
1080 exist, you will be prompted to create it.
|
|
|
1081
|
|
|
1082 The hook `mh-refile-msg-hook' is called after a message is marked to
|
|
|
1083 be refiled.
|
|
|
1084
|
|
|
1085 Check the documentation of `mh-interactive-range' to see how RANGE is
|
|
|
1086 read in interactive use.
|
|
|
1087
|
|
|
1088 In a program, the variables `mh-last-destination' and
|
|
|
1089 `mh-last-destination-folder' are not updated if
|
|
|
1090 DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil."
|
|
|
1091 (interactive (list (mh-interactive-range "Refile")
|
|
|
1092 (intern (mh-prompt-for-refile-folder))))
|
|
|
1093 (unless dont-update-last-destination-flag
|
|
|
1094 (setq mh-last-destination (cons 'refile folder)
|
|
|
1095 mh-last-destination-folder mh-last-destination))
|
|
|
1096 (mh-iterate-on-range () range
|
|
|
1097 (mh-refile-a-msg nil folder))
|
|
|
1098 (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
|
|
|
1099
|
|
|
1100 ;;;###mh-autoload
|
|
|
1101 (defun mh-refile-or-write-again (range &optional interactive-flag)
|
|
|
1102 "Repeat last output command.
|
|
|
1103
|
|
|
1104 If you are refiling several messages into the same folder, you
|
|
|
1105 can use this command to repeat the last
|
|
|
1106 refile (\\[mh-refile-msg]) or write (\\[mh-write-msg-to-file]).
|
|
|
1107 You can use a range.
|
|
|
1108
|
|
|
1109 Check the documentation of `mh-interactive-range' to see how RANGE is
|
|
|
1110 read in interactive use.
|
|
|
1111
|
|
|
1112 In a program, a non-nil INTERACTIVE-FLAG means that the function was
|
|
|
1113 called interactively."
|
|
|
1114 (interactive (list (mh-interactive-range "Redo") t))
|
|
|
1115 (if (null mh-last-destination)
|
|
|
1116 (error "No previous refile or write"))
|
|
|
1117 (cond ((eq (car mh-last-destination) 'refile)
|
|
|
1118 (mh-refile-msg range (cdr mh-last-destination))
|
|
|
1119 (message "Destination folder: %s" (cdr mh-last-destination)))
|
|
|
1120 (t
|
|
|
1121 (mh-iterate-on-range msg range
|
|
|
1122 (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)))
|
|
|
1123 (mh-next-msg interactive-flag))))
|
|
|
1124
|
|
|
1125 ;;;###mh-autoload
|
|
|
1126 (defun mh-rescan-folder (&optional range dont-exec-pending)
|
|
|
1127 "Rescan folder\\<mh-folder-mode-map>.
|
|
|
1128
|
|
|
1129 This command is useful to grab all messages in your \"+inbox\" after
|
|
|
1130 processing your new mail for the first time. If you don't want to
|
|
|
1131 rescan the entire folder, this command will accept a RANGE. Check the
|
|
|
1132 documentation of `mh-interactive-range' to see how RANGE is read in
|
|
|
1133 interactive use.
|
|
|
1134
|
|
|
1135 This command will ask if you want to process refiles or deletes first
|
|
|
1136 and then either run \\[mh-execute-commands] for you or undo the
|
|
|
1137 pending refiles and deletes, which are lost.
|
|
|
1138
|
|
|
1139 In a program, the processing of outstanding commands is not performed
|
|
|
1140 if DONT-EXEC-PENDING is non-nil."
|
|
|
1141 (interactive (list (if current-prefix-arg
|
|
|
1142 (mh-read-range "Rescan" mh-current-folder t nil t
|
|
|
1143 mh-interpret-number-as-range-flag)
|
|
|
1144 nil)))
|
|
|
1145 (setq mh-next-direction 'forward)
|
|
|
1146 (let ((threaded-flag (memq 'unthread mh-view-ops))
|
|
|
1147 (msg-num (mh-get-msg-num nil)))
|
|
|
1148 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
|
|
|
1149 ;; If there isn't a cur sequence, mh-scan-folder goes to the first message.
|
|
|
1150 ;; Try to stay where we were.
|
|
|
1151 (if (null (car (mh-seq-to-msgs 'cur)))
|
|
|
1152 (mh-goto-msg msg-num t t))
|
|
|
1153 (cond (threaded-flag (mh-toggle-threads))
|
|
|
1154 (mh-index-data (mh-index-insert-folder-headers)))))
|
|
|
1155
|
|
|
1156 (defun mh-show-mouse (event)
|
|
|
1157 "Move point to mouse EVENT and show message."
|
|
|
1158 (interactive "e")
|
|
|
1159 (mouse-set-point event)
|
|
|
1160 (mh-show))
|
|
|
1161
|
|
|
1162 ;;;###mh-autoload
|
|
|
1163 (defun mh-toggle-showing ()
|
|
|
1164 "Toggle between MH-Folder and MH-Folder Show modes.
|
|
|
1165
|
|
|
1166 This command switches between MH-Folder mode and MH-Folder Show
|
|
|
1167 mode. MH-Folder mode turns off the associated show buffer so that
|
|
|
1168 you can perform operations on the messages quickly without
|
|
|
1169 reading them. This is an excellent way to prune out your junk
|
|
|
1170 mail or to refile a group of messages to another folder for later
|
|
|
1171 examination."
|
|
|
1172 (interactive)
|
|
|
1173 (if mh-showing-mode
|
|
|
1174 (mh-set-scan-mode)
|
|
|
1175 (mh-show)))
|
|
|
1176
|
|
|
1177 ;;;###mh-autoload
|
|
|
1178 (defun mh-undo (range)
|
|
|
1179 "Undo pending deletes or refiles in RANGE.
|
|
|
1180
|
|
|
1181 If you've deleted a message or refiled it, but changed your mind,
|
|
|
1182 you can cancel the action before you've executed it. Use this
|
|
|
1183 command to undo a refile on or deletion of a single message. You
|
|
|
1184 can also undo refiles and deletes for messages that are found in
|
|
|
1185 a given RANGE.
|
|
|
1186
|
|
|
1187 Check the documentation of `mh-interactive-range' to see how
|
|
|
1188 RANGE is read in interactive use."
|
|
|
1189 (interactive (list (mh-interactive-range "Undo")))
|
|
|
1190 (cond ((numberp range)
|
|
|
1191 (let ((original-position (point)))
|
|
|
1192 (beginning-of-line)
|
|
|
1193 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
|
|
|
1194 (looking-at mh-scan-refiled-msg-regexp)
|
|
|
1195 (and (eq mh-next-direction 'forward) (bobp))
|
|
|
1196 (and (eq mh-next-direction 'backward)
|
|
|
1197 (save-excursion (forward-line) (eobp)))))
|
|
|
1198 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
|
|
|
1199 (if (or (looking-at mh-scan-deleted-msg-regexp)
|
|
|
1200 (looking-at mh-scan-refiled-msg-regexp))
|
|
|
1201 (progn
|
|
|
1202 (mh-undo-msg (mh-get-msg-num t))
|
|
|
1203 (mh-maybe-show))
|
|
|
1204 (goto-char original-position)
|
|
|
1205 (error "Nothing to undo"))))
|
|
|
1206 (t (mh-iterate-on-range () range
|
|
|
1207 (mh-undo-msg nil))))
|
|
|
1208 (if (not (mh-outstanding-commands-p))
|
|
|
1209 (mh-set-folder-modified-p nil)))
|
|
|
1210
|
|
|
1211 ;;;###mh-autoload
|
|
|
1212 (defun mh-visit-folder (folder &optional range index-data)
|
|
|
1213 "Visit FOLDER.
|
|
|
1214
|
|
|
1215 When you want to read the messages that you have refiled into folders,
|
|
|
1216 use this command to visit the folder. You are prompted for the folder
|
|
|
1217 name.
|
|
|
1218
|
|
|
1219 The folder buffer will show just unseen messages if there are any;
|
|
|
1220 otherwise, it will show all the messages in the buffer as long there
|
|
|
1221 are fewer than `mh-large-folder' messages. If there are more, then you
|
|
|
1222 are prompted for a range of messages to scan.
|
|
|
1223
|
|
|
1224 You can provide a prefix argument in order to specify a RANGE of
|
|
|
1225 messages to show when you visit the folder. In this case, regions are
|
|
|
1226 not used to specify the range and `mh-large-folder' is ignored. Check
|
|
|
1227 the documentation of `mh-interactive-range' to see how RANGE is read
|
|
|
1228 in interactive use.
|
|
|
1229
|
|
|
1230 Note that this command can also be used to create folders. If you
|
|
|
1231 specify a folder that does not exist, you will be prompted to create
|
|
|
1232 it.
|
|
|
1233
|
|
|
1234 Do not call this function from outside MH-E; use \\[mh-rmail] instead.
|
|
|
1235
|
|
|
1236 If, in a program, RANGE is nil (the default), then all messages in
|
|
|
1237 FOLDER are displayed. If an index buffer is being created then
|
|
|
1238 INDEX-DATA is used to initialize the index buffer specific data
|
|
|
1239 structures."
|
|
|
1240 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
|
|
|
1241 (list folder-name
|
|
|
1242 (mh-read-range "Scan" folder-name t nil
|
|
|
1243 current-prefix-arg
|
|
|
1244 mh-interpret-number-as-range-flag))))
|
|
|
1245 (let ((config (current-window-configuration))
|
|
|
1246 (current-buffer (current-buffer))
|
|
|
1247 (threaded-view-flag mh-show-threads-flag))
|
|
|
1248 (delete-other-windows)
|
|
|
1249 (save-excursion
|
|
|
1250 (when (get-buffer folder)
|
|
|
1251 (set-buffer folder)
|
|
|
1252 (setq threaded-view-flag (memq 'unthread mh-view-ops))))
|
|
|
1253 (when index-data
|
|
|
1254 (mh-make-folder folder)
|
|
|
1255 (setq mh-index-data (car index-data)
|
|
|
1256 mh-index-msg-checksum-map (make-hash-table :test #'equal)
|
|
|
1257 mh-index-checksum-origin-map (make-hash-table :test #'equal))
|
|
|
1258 (mh-index-update-maps folder (cadr index-data))
|
|
|
1259 (mh-index-create-sequences))
|
|
|
1260 (mh-scan-folder folder (or range "all"))
|
|
|
1261 (cond ((and threaded-view-flag
|
|
|
1262 (save-excursion
|
|
|
1263 (goto-char (point-min))
|
|
|
1264 (or (null mh-large-folder)
|
|
|
1265 (not (equal (forward-line (1+ mh-large-folder)) 0))
|
|
|
1266 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
|
|
|
1267 nil))))
|
|
|
1268 (mh-toggle-threads))
|
|
|
1269 (mh-index-data
|
|
|
1270 (mh-index-insert-folder-headers)))
|
|
|
1271 (unless (eq current-buffer (current-buffer))
|
|
|
1272 (setq mh-previous-window-config config)))
|
|
|
1273 nil)
|
|
|
1274
|
|
|
1275 ;;;###mh-autoload
|
|
|
1276 (defun mh-write-msg-to-file (message file no-header)
|
|
|
1277 "Append MESSAGE to end of FILE\\<mh-folder-mode-map>.
|
|
|
1278
|
|
|
1279 You are prompted for the filename. If the file already exists,
|
|
|
1280 the message is appended to it. You can also write the message to
|
|
|
1281 the file without the header by specifying a prefix argument
|
|
|
1282 NO-HEADER. Subsequent writes to the same file can be made with
|
|
|
1283 the command \\[mh-refile-or-write-again]."
|
|
|
1284 (interactive
|
|
|
1285 (list (mh-get-msg-num t)
|
|
|
1286 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
|
|
|
1287 (file-name-directory
|
|
|
1288 (car (cdr mh-last-destination-write)))
|
|
|
1289 default-directory)))
|
|
|
1290 (read-file-name (format "Save message%s in file: "
|
|
|
1291 (if current-prefix-arg " body" ""))
|
|
|
1292 default-dir
|
|
|
1293 (if (eq 'write (car mh-last-destination-write))
|
|
|
1294 (car (cdr mh-last-destination-write))
|
|
|
1295 (expand-file-name "mail.out" default-dir))))
|
|
|
1296 current-prefix-arg))
|
|
|
1297 (let ((msg-file-to-output (mh-msg-filename message))
|
|
|
1298 (output-file (mh-expand-file-name file)))
|
|
|
1299 (setq mh-last-destination (list 'write file (if no-header 'no-header))
|
|
|
1300 mh-last-destination-write mh-last-destination)
|
|
|
1301 (save-excursion
|
|
|
1302 (set-buffer (get-buffer-create mh-temp-buffer))
|
|
|
1303 (erase-buffer)
|
|
|
1304 (insert-file-contents msg-file-to-output)
|
|
|
1305 (goto-char (point-min))
|
|
|
1306 (if no-header (search-forward "\n\n"))
|
|
|
1307 (append-to-file (point) (point-max) output-file))))
|
|
|
1308
|
|
|
1309 ;;;###mh-autoload
|
|
|
1310 (defun mh-update-sequences ()
|
|
|
1311 "Flush MH-E's state out to MH.
|
|
|
1312
|
|
|
1313 This function updates the sequence specified by your
|
|
|
1314 \"Unseen-Sequence:\" profile component, \"cur\", and the sequence
|
|
|
1315 listed by the `mh-tick-seq' option which is \"tick\" by default.
|
|
|
1316 The message at the cursor is used for \"cur\"."
|
|
|
1317 (interactive)
|
|
|
1318 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
|
|
|
1319 ;; which updates MH-E's state from MH.
|
|
|
1320 (let ((folder-set (mh-update-unseen))
|
|
|
1321 (new-cur (mh-get-msg-num nil)))
|
|
|
1322 (if new-cur
|
|
|
1323 (let ((seq-entry (mh-find-seq 'cur)))
|
|
|
1324 (mh-remove-cur-notation)
|
|
|
1325 (setcdr seq-entry
|
|
|
1326 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
|
|
|
1327 (mh-define-sequence 'cur (list new-cur))
|
|
|
1328 (beginning-of-line)
|
|
|
1329 (if (looking-at mh-scan-good-msg-regexp)
|
|
|
1330 (mh-notate-cur)))
|
|
|
1331 (or folder-set
|
|
|
1332 (save-excursion
|
|
|
1333 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
|
|
|
1334 ;; So I added this sanity check.
|
|
|
1335 (if (stringp mh-current-folder)
|
|
|
1336 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
|
|
|
1337 (mh-exec-cmd-quiet t "folder" "-fast")))))))
|
|
|
1338
|
|
|
1339
|
|
|
1340
|
|
|
1341 ;;; Support Routines
|
|
|
1342
|
|
|
1343 (defun mh-get-new-mail (maildrop-name)
|
|
|
1344 "Read new mail from MAILDROP-NAME into the current buffer.
|
|
|
1345 Return in the current buffer."
|
|
|
1346 (let ((point-before-inc (point))
|
|
|
1347 (folder mh-current-folder)
|
|
|
1348 (new-mail-flag nil))
|
|
|
1349 (with-mh-folder-updating (t)
|
|
|
1350 (if maildrop-name
|
|
|
1351 (message "inc %s -file %s..." folder maildrop-name)
|
|
|
1352 (message "inc %s..." folder))
|
|
|
1353 (setq mh-next-direction 'forward)
|
|
|
1354 (goto-char (point-max))
|
|
|
1355 (mh-remove-cur-notation)
|
|
|
1356 (let ((start-of-inc (point)))
|
|
|
1357 (if maildrop-name
|
|
|
1358 ;; I think MH 5 used "-ms-file" instead of "-file",
|
|
|
1359 ;; which would make inc'ing from maildrops fail.
|
|
|
1360 (mh-exec-cmd-output mh-inc-prog nil folder
|
|
|
1361 (mh-scan-format)
|
|
|
1362 "-file" (expand-file-name maildrop-name)
|
|
|
1363 "-width" (window-width)
|
|
|
1364 "-truncate")
|
|
|
1365 (mh-exec-cmd-output mh-inc-prog nil
|
|
|
1366 (mh-scan-format)
|
|
|
1367 "-width" (window-width)))
|
|
|
1368 (if maildrop-name
|
|
|
1369 (message "inc %s -file %s...done" folder maildrop-name)
|
|
|
1370 (message "inc %s...done" folder))
|
|
|
1371 (goto-char start-of-inc)
|
|
|
1372 (cond ((save-excursion
|
|
|
1373 (re-search-forward "^inc: no mail" nil t))
|
|
|
1374 (message "No new mail%s%s" (if maildrop-name " in " "")
|
|
|
1375 (if maildrop-name maildrop-name "")))
|
|
|
1376 ((and (when mh-folder-view-stack
|
|
|
1377 (let ((saved-text (buffer-substring-no-properties
|
|
|
1378 start-of-inc (point-max))))
|
|
|
1379 (delete-region start-of-inc (point-max))
|
|
|
1380 (unwind-protect (mh-widen t)
|
|
|
1381 (mh-remove-cur-notation)
|
|
|
1382 (goto-char (point-max))
|
|
|
1383 (setq start-of-inc (point))
|
|
|
1384 (insert saved-text)
|
|
|
1385 (goto-char start-of-inc))))
|
|
|
1386 nil))
|
|
|
1387 ((re-search-forward "^inc:" nil t) ; Error messages
|
|
|
1388 (error "Error incorporating mail"))
|
|
|
1389 ((and
|
|
|
1390 (equal mh-scan-format-file t)
|
|
|
1391 mh-adaptive-cmd-note-flag
|
|
|
1392 ;; Have we reached an edge condition?
|
|
|
1393 (save-excursion
|
|
|
1394 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
|
|
|
1395 (setq start-of-inc (mh-generate-new-cmd-note folder))
|
|
|
1396 nil))
|
|
|
1397 (t
|
|
|
1398 (setq new-mail-flag t)))
|
|
|
1399 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
|
|
|
1400 (let* ((sequences (mh-read-folder-sequences folder t))
|
|
|
1401 (new-cur (assoc 'cur sequences))
|
|
|
1402 (new-unseen (assoc mh-unseen-seq sequences)))
|
|
|
1403 (unless (assoc 'cur mh-seq-list)
|
|
|
1404 (push (list 'cur) mh-seq-list))
|
|
|
1405 (unless (assoc mh-unseen-seq mh-seq-list)
|
|
|
1406 (push (list mh-unseen-seq) mh-seq-list))
|
|
|
1407 (setcdr (assoc 'cur mh-seq-list) (cdr new-cur))
|
|
|
1408 (setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen)))
|
|
|
1409 (when (equal (point-max) start-of-inc)
|
|
|
1410 (mh-notate-cur))
|
|
|
1411 (if new-mail-flag
|
|
|
1412 (progn
|
|
|
1413 (mh-make-folder-mode-line)
|
|
|
1414 (when (mh-speed-flists-active-p)
|
|
|
1415 (mh-speed-flists t mh-current-folder))
|
|
|
1416 (when (memq 'unthread mh-view-ops)
|
|
|
1417 (mh-thread-inc folder start-of-inc))
|
|
|
1418 (mh-goto-cur-msg))
|
|
|
1419 (goto-char point-before-inc))
|
|
|
1420 (mh-notate-user-sequences (cons start-of-inc (point-max)))))))
|
|
|
1421
|
|
|
1422 (defun mh-generate-new-cmd-note (folder)
|
|
|
1423 "Fix the `mh-cmd-note' value for this FOLDER.
|
|
|
1424
|
|
|
1425 After doing an `mh-get-new-mail' operation in this FOLDER, at least
|
|
|
1426 one line that looks like a truncated message number was found.
|
|
|
1427
|
|
|
1428 Remove the text added by the last `mh-inc' command. It should be the
|
|
|
1429 messages cur-last. Call `mh-set-cmd-note', adjusting the notation
|
|
|
1430 column with the width of the largest message number in FOLDER.
|
|
|
1431
|
|
|
1432 Reformat the message number width on each line in the buffer and trim
|
|
|
1433 the line length to fit in the window.
|
|
|
1434
|
|
|
1435 Rescan the FOLDER in the range cur-last in order to display the
|
|
|
1436 messages that were removed earlier. They should all fit in the scan
|
|
|
1437 line now with no message truncation."
|
|
|
1438 (save-excursion
|
|
|
1439 (let ((maxcol (1- (window-width)))
|
|
|
1440 (old-cmd-note mh-cmd-note)
|
|
|
1441 mh-cmd-note-fmt
|
|
|
1442 msgnum)
|
|
|
1443 ;; Nuke all of the lines just added by the last inc
|
|
|
1444 (delete-char (- (point-max) (point)))
|
|
|
1445 ;; Update the current buffer to reflect the new mh-cmd-note
|
|
|
1446 ;; value needed to display messages.
|
|
|
1447 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width folder)))
|
|
|
1448 (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
|
|
|
1449 ;; Cleanup the messages that are in the buffer right now
|
|
|
1450 (goto-char (point-min))
|
|
|
1451 (cond ((memq 'unthread mh-view-ops)
|
|
|
1452 (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
|
|
|
1453 (t (while (re-search-forward (mh-scan-msg-number-regexp) nil 0 1)
|
|
|
1454 ;; reformat the number to fix in mh-cmd-note columns
|
|
|
1455 (setq msgnum (string-to-number
|
|
|
1456 (buffer-substring
|
|
|
1457 (match-beginning 1) (match-end 1))))
|
|
|
1458 (replace-match (format mh-cmd-note-fmt msgnum))
|
|
|
1459 ;; trim the line to fix in the window
|
|
|
1460 (end-of-line)
|
|
|
1461 (let ((eol (point)))
|
|
|
1462 (move-to-column maxcol)
|
|
|
1463 (if (<= (point) eol)
|
|
|
1464 (delete-char (- eol (point))))))))
|
|
|
1465 ;; now re-read the lost messages
|
|
|
1466 (goto-char (point-max))
|
|
|
1467 (prog1 (point)
|
|
|
1468 (mh-regenerate-headers "cur-last" t)))))
|
|
|
1469
|
|
|
1470 ;;;###mh-autoload
|
|
|
1471 (defun mh-goto-cur-msg (&optional minimal-changes-flag)
|
|
|
1472 "Position the cursor at the current message.
|
|
|
1473 When optional argument MINIMAL-CHANGES-FLAG is non-nil, the
|
|
|
1474 function doesn't recenter the folder buffer."
|
|
|
1475 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
|
|
|
1476 (cond ((and cur-msg
|
|
|
1477 (mh-goto-msg cur-msg t t))
|
|
|
1478 (unless minimal-changes-flag
|
|
|
1479 (mh-notate-cur)
|
|
|
1480 (mh-recenter 0)
|
|
|
1481 (mh-maybe-show cur-msg)))
|
|
|
1482 (t
|
|
|
1483 (setq overlay-arrow-position nil)
|
|
|
1484 (message "No current message")))))
|
|
|
1485
|
|
|
1486 ;;;###mh-autoload
|
|
|
1487 (defun mh-recenter (arg)
|
|
|
1488 "Like recenter but with three improvements:
|
|
|
1489
|
|
|
1490 - At the end of the buffer it tries to show fewer empty lines.
|
|
|
1491
|
|
|
1492 - operates only if the current buffer is in the selected window.
|
|
|
1493 (Commands like `save-some-buffers' can make this false.)
|
|
|
1494
|
|
|
1495 - nil ARG means recenter as if prefix argument had been given."
|
|
|
1496 (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window)))
|
|
|
1497 nil)
|
|
|
1498 ((= (point-max) (save-excursion
|
|
|
1499 (forward-line (- (/ (window-height) 2) 2))
|
|
|
1500 (point)))
|
|
|
1501 (let ((lines-from-end 2))
|
|
|
1502 (save-excursion
|
|
|
1503 (while (> (point-max) (progn (forward-line) (point)))
|
|
|
1504 (incf lines-from-end)))
|
|
|
1505 (recenter (- lines-from-end))))
|
|
|
1506 ;; '(4) is the same as C-u prefix argument.
|
|
|
1507 (t (recenter (or arg '(4))))))
|
|
|
1508
|
|
|
1509 (defun mh-update-unseen ()
|
|
|
1510 "Synchronize the unseen sequence with MH.
|
|
|
1511 Return non-nil iff the MH folder was set.
|
|
|
1512 The hook `mh-unseen-updated-hook' is called after the unseen sequence
|
|
|
1513 is updated."
|
|
|
1514 (if mh-seen-list
|
|
|
1515 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
|
|
|
1516 (unseen-msgs (mh-seq-msgs unseen-seq)))
|
|
|
1517 (if unseen-msgs
|
|
|
1518 (progn
|
|
|
1519 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
|
|
|
1520 (run-hooks 'mh-unseen-updated-hook)
|
|
|
1521 (while mh-seen-list
|
|
|
1522 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
|
|
|
1523 (setq mh-seen-list (cdr mh-seen-list)))
|
|
|
1524 (setcdr unseen-seq unseen-msgs)
|
|
|
1525 t) ;since we set the folder
|
|
|
1526 (setq mh-seen-list nil)))))
|
|
|
1527
|
|
|
1528 ;;;###mh-autoload
|
|
|
1529 (defun mh-outstanding-commands-p ()
|
|
|
1530 "Return non-nil if there are outstanding deletes or refiles."
|
|
|
1531 (save-excursion
|
|
|
1532 (when (eq major-mode 'mh-show-mode)
|
|
|
1533 (set-buffer mh-show-folder-buffer))
|
|
|
1534 (or mh-delete-list mh-refile-list)))
|
|
|
1535
|
|
|
1536 ;;;###mh-autoload
|
|
|
1537 (defun mh-set-folder-modified-p (flag)
|
|
|
1538 "Mark current folder as modified or unmodified according to FLAG."
|
|
|
1539 (set-buffer-modified-p flag))
|
|
|
1540
|
|
|
1541 (defun mh-process-commands (folder)
|
|
|
1542 "Process outstanding commands for FOLDER.
|
|
|
1543
|
|
|
1544 This function runs `mh-before-commands-processed-hook' before the
|
|
|
1545 commands are processed and `mh-after-commands-processed-hook'
|
|
|
1546 after the commands are processed."
|
|
|
1547 (message "Processing deletes and refiles for %s..." folder)
|
|
|
1548 (set-buffer folder)
|
|
|
1549 (with-mh-folder-updating (nil)
|
|
|
1550 ;; Run the before hook -- the refile and delete lists are still valid
|
|
|
1551 (run-hooks 'mh-before-commands-processed-hook)
|
|
|
1552
|
|
|
1553 ;; Update the unseen sequence if it exists
|
|
|
1554 (mh-update-unseen)
|
|
|
1555
|
|
|
1556 (let ((redraw-needed-flag mh-index-data)
|
|
|
1557 (folders-changed (list mh-current-folder))
|
|
|
1558 (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
|
|
|
1559 (mh-create-sequence-map mh-seq-list)))
|
|
|
1560 (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
|
|
|
1561 (make-hash-table))))
|
|
|
1562 ;; Remove invalid scan lines if we are in an index folder and then remove
|
|
|
1563 ;; the real messages
|
|
|
1564 (when mh-index-data
|
|
|
1565 (mh-index-delete-folder-headers)
|
|
|
1566 (setq folders-changed
|
|
|
1567 (append folders-changed (mh-index-execute-commands))))
|
|
|
1568
|
|
|
1569 ;; Then refile messages
|
|
|
1570 (mh-mapc #'(lambda (folder-msg-list)
|
|
|
1571 (let* ((dest-folder (symbol-name (car folder-msg-list)))
|
|
|
1572 (last (car (mh-translate-range dest-folder "last")))
|
|
|
1573 (msgs (cdr folder-msg-list)))
|
|
|
1574 (push dest-folder folders-changed)
|
|
|
1575 (setq redraw-needed-flag t)
|
|
|
1576 (apply #'mh-exec-cmd
|
|
|
1577 "refile" "-src" folder dest-folder
|
|
|
1578 (mh-coalesce-msg-list msgs))
|
|
|
1579 (mh-delete-scan-msgs msgs)
|
|
|
1580 ;; Preserve sequences in destination folder...
|
|
|
1581 (when mh-refile-preserves-sequences-flag
|
|
|
1582 (clrhash dest-map)
|
|
|
1583 (loop for i from (1+ (or last 0))
|
|
|
1584 for msg in (sort (copy-sequence msgs) #'<)
|
|
|
1585 do (loop for seq-name in (gethash msg seq-map)
|
|
|
1586 do (push i (gethash seq-name dest-map))))
|
|
|
1587 (maphash
|
|
|
1588 #'(lambda (seq msgs)
|
|
|
1589 ;; Can't be run in the background, since the
|
|
|
1590 ;; current folder is changed by mark this could
|
|
|
1591 ;; lead to a race condition with the next refile.
|
|
|
1592 (apply #'mh-exec-cmd "mark"
|
|
|
1593 "-sequence" (symbol-name seq) dest-folder
|
|
|
1594 "-add" (mapcar #'(lambda (x) (format "%s" x))
|
|
|
1595 (mh-coalesce-msg-list msgs))))
|
|
|
1596 dest-map))))
|
|
|
1597 mh-refile-list)
|
|
|
1598 (setq mh-refile-list ())
|
|
|
1599
|
|
|
1600 ;; Now delete messages
|
|
|
1601 (cond (mh-delete-list
|
|
|
1602 (setq redraw-needed-flag t)
|
|
|
1603 (apply 'mh-exec-cmd "rmm" folder
|
|
|
1604 (mh-coalesce-msg-list mh-delete-list))
|
|
|
1605 (mh-delete-scan-msgs mh-delete-list)
|
|
|
1606 (setq mh-delete-list nil)))
|
|
|
1607
|
|
|
1608 ;; Don't need to remove sequences since delete and refile do so.
|
|
|
1609 ;; Mark cur message
|
|
|
1610 (if (> (buffer-size) 0)
|
|
|
1611 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
|
|
|
1612
|
|
|
1613 ;; Redraw folder buffer if needed
|
|
|
1614 (when (and redraw-needed-flag)
|
|
|
1615 (when (mh-speed-flists-active-p)
|
|
|
1616 (apply #'mh-speed-flists t folders-changed))
|
|
|
1617 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
|
|
|
1618 (mh-index-data (mh-index-insert-folder-headers))))
|
|
|
1619
|
|
|
1620 (and (buffer-file-name (get-buffer mh-show-buffer))
|
|
|
1621 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
|
|
|
1622 ;; If "inc" were to put a new msg in this file,
|
|
|
1623 ;; we would not notice, so mark it invalid now.
|
|
|
1624 (mh-invalidate-show-buffer))
|
|
|
1625
|
|
|
1626 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
|
|
|
1627 (mh-remove-all-notation)
|
|
|
1628 (mh-notate-user-sequences)
|
|
|
1629
|
|
|
1630 ;; Run the after hook -- now folders-changed is valid,
|
|
|
1631 ;; but not the lists of specific messages.
|
|
|
1632 (let ((mh-folders-changed folders-changed))
|
|
|
1633 (run-hooks 'mh-after-commands-processed-hook)))
|
|
|
1634
|
|
|
1635 (message "Processing deletes and refiles for %s...done" folder)))
|
|
|
1636
|
|
|
1637 (defun mh-delete-scan-msgs (msgs)
|
|
|
1638 "Delete the scan listing lines for MSGS."
|
|
|
1639 (save-excursion
|
|
|
1640 (while msgs
|
|
|
1641 (when (mh-goto-msg (car msgs) t t)
|
|
|
1642 (when (memq 'unthread mh-view-ops)
|
|
|
1643 (mh-thread-forget-message (car msgs)))
|
|
|
1644 (mh-delete-line 1))
|
|
|
1645 (setq msgs (cdr msgs)))))
|
|
|
1646
|
|
|
1647 (defun mh-set-scan-mode ()
|
|
|
1648 "Display the scan listing buffer, but do not show a message."
|
|
|
1649 (if (get-buffer mh-show-buffer)
|
|
|
1650 (delete-windows-on mh-show-buffer))
|
|
|
1651 (mh-showing-mode 0)
|
|
|
1652 (force-mode-line-update)
|
|
|
1653 (if mh-recenter-summary-flag
|
|
|
1654 (mh-recenter nil)))
|
|
|
1655
|
|
|
1656 ;;;###mh-autoload
|
|
|
1657 (defun mh-make-folder-mode-line (&optional ignored)
|
|
|
1658 "Set the fields of the mode line for a folder buffer.
|
|
|
1659 The optional argument is now obsolete and IGNORED. It used to be
|
|
|
1660 used to pass in what is now stored in the buffer-local variable
|
|
|
1661 `mh-mode-line-annotation'."
|
|
|
1662 (save-excursion
|
|
|
1663 (save-window-excursion
|
|
|
1664 (mh-first-msg)
|
|
|
1665 (let ((new-first-msg-num (mh-get-msg-num nil)))
|
|
|
1666 (when (or (not (memq 'unthread mh-view-ops))
|
|
|
1667 (null mh-first-msg-num)
|
|
|
1668 (null new-first-msg-num)
|
|
|
1669 (< new-first-msg-num mh-first-msg-num))
|
|
|
1670 (setq mh-first-msg-num new-first-msg-num)))
|
|
|
1671 (mh-last-msg)
|
|
|
1672 (let ((new-last-msg-num (mh-get-msg-num nil)))
|
|
|
1673 (when (or (not (memq 'unthread mh-view-ops))
|
|
|
1674 (null mh-last-msg-num)
|
|
|
1675 (null new-last-msg-num)
|
|
|
1676 (> new-last-msg-num mh-last-msg-num))
|
|
|
1677 (setq mh-last-msg-num new-last-msg-num)))
|
|
|
1678 (setq mh-msg-count (if mh-first-msg-num
|
|
|
1679 (count-lines (point-min) (point-max))
|
|
|
1680 0))
|
|
|
1681 (setq mode-line-buffer-identification
|
|
|
1682 (list (format " {%%b%s} %s msg%s"
|
|
|
1683 (if mh-mode-line-annotation
|
|
|
1684 (format "/%s" mh-mode-line-annotation)
|
|
|
1685 "")
|
|
|
1686 (if (zerop mh-msg-count)
|
|
|
1687 "no"
|
|
|
1688 (format "%d" mh-msg-count))
|
|
|
1689 (if (zerop mh-msg-count)
|
|
|
1690 "s"
|
|
|
1691 (cond ((> mh-msg-count 1)
|
|
|
1692 (format "s (%d-%d)" mh-first-msg-num
|
|
|
1693 mh-last-msg-num))
|
|
|
1694 (mh-first-msg-num
|
|
|
1695 (format " (%d)" mh-first-msg-num))
|
|
|
1696 (""))))))
|
|
|
1697 (mh-logo-display))))
|
|
|
1698
|
|
|
1699 ;;;###mh-autoload
|
|
|
1700 (defun mh-scan-folder (folder range &optional dont-exec-pending)
|
|
|
1701 "Scan FOLDER over RANGE.
|
|
|
1702
|
|
|
1703 After the scan is performed, switch to the buffer associated with
|
|
|
1704 FOLDER.
|
|
|
1705
|
|
|
1706 Check the documentation of `mh-interactive-range' to see how RANGE is
|
|
|
1707 read in interactive use.
|
|
|
1708
|
|
|
1709 The processing of outstanding commands is not performed if
|
|
|
1710 DONT-EXEC-PENDING is non-nil."
|
|
|
1711 (when (stringp range)
|
|
|
1712 (setq range (delete "" (split-string range "[ \t\n]"))))
|
|
|
1713 (cond ((null (get-buffer folder))
|
|
|
1714 (mh-make-folder folder))
|
|
|
1715 (t
|
|
|
1716 (unless dont-exec-pending
|
|
|
1717 (mh-process-or-undo-commands folder)
|
|
|
1718 (mh-reset-threads-and-narrowing))
|
|
|
1719 (switch-to-buffer folder)))
|
|
|
1720 (mh-regenerate-headers range)
|
|
|
1721 (if (zerop (buffer-size))
|
|
|
1722 (if (equal range "all")
|
|
|
1723 (message "Folder %s is empty" folder)
|
|
|
1724 (message "No messages in %s, range %s" folder range))
|
|
|
1725 (mh-goto-cur-msg))
|
|
|
1726 (when (mh-outstanding-commands-p)
|
|
|
1727 (mh-notate-deleted-and-refiled)))
|
|
|
1728
|
|
|
1729 ;;;###mh-autoload
|
|
|
1730 (defun mh-process-or-undo-commands (folder)
|
|
|
1731 "If FOLDER has outstanding commands, then either process or discard them.
|
|
|
1732 Called by functions like `mh-sort-folder', so also invalidate
|
|
|
1733 show buffer."
|
|
|
1734 (set-buffer folder)
|
|
|
1735 (if (mh-outstanding-commands-p)
|
|
|
1736 (if (or mh-do-not-confirm-flag
|
|
|
1737 (y-or-n-p
|
|
|
1738 "Process outstanding deletes and refiles? "))
|
|
|
1739 (mh-process-commands folder)
|
|
|
1740 (set-buffer folder)
|
|
|
1741 (mh-undo-folder)))
|
|
|
1742 (mh-update-unseen)
|
|
|
1743 (mh-invalidate-show-buffer))
|
|
|
1744
|
|
|
1745 ;;;###mh-autoload
|
|
|
1746 (defun mh-regenerate-headers (range &optional update)
|
|
|
1747 "Scan folder over RANGE.
|
|
|
1748 If UPDATE, append the scan lines, otherwise replace."
|
|
|
1749 (let ((folder mh-current-folder)
|
|
|
1750 (range (if (and range (atom range)) (list range) range))
|
|
|
1751 scan-start)
|
|
|
1752 (message "Scanning %s..." folder)
|
|
|
1753 (mh-remove-all-notation)
|
|
|
1754 (with-mh-folder-updating (nil)
|
|
|
1755 (if update
|
|
|
1756 (goto-char (point-max))
|
|
|
1757 (delete-region (point-min) (point-max))
|
|
|
1758 (if mh-adaptive-cmd-note-flag
|
|
|
1759 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width
|
|
|
1760 folder)))))
|
|
|
1761 (setq scan-start (point))
|
|
|
1762 (apply #'mh-exec-cmd-output
|
|
|
1763 mh-scan-prog nil
|
|
|
1764 (mh-scan-format)
|
|
|
1765 "-noclear" "-noheader"
|
|
|
1766 "-width" (window-width)
|
|
|
1767 folder range)
|
|
|
1768 (goto-char scan-start)
|
|
|
1769 (cond ((looking-at "scan: no messages in")
|
|
|
1770 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
|
|
|
1771 ((looking-at (if (mh-variant-p 'mu-mh)
|
|
|
1772 "scan: message set .* does not exist"
|
|
|
1773 "scan: bad message list "))
|
|
|
1774 (keep-lines mh-scan-valid-regexp))
|
|
|
1775 ((looking-at "scan: ")) ; Keep error messages
|
|
|
1776 (t
|
|
|
1777 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
|
|
|
1778 (setq mh-seq-list (mh-read-folder-sequences folder nil))
|
|
|
1779 (mh-notate-user-sequences)
|
|
|
1780 (or update
|
|
|
1781 (setq mh-mode-line-annotation
|
|
|
1782 (if (equal range '("all"))
|
|
|
1783 nil
|
|
|
1784 mh-partial-folder-mode-line-annotation)))
|
|
|
1785 (mh-make-folder-mode-line))
|
|
|
1786 (message "Scanning %s...done" folder)))
|
|
|
1787
|
|
|
1788 ;;;###mh-autoload
|
|
|
1789 (defun mh-reset-threads-and-narrowing ()
|
|
|
1790 "Reset all variables pertaining to threads and narrowing.
|
|
|
1791 Also removes all content from the folder buffer."
|
|
|
1792 (setq mh-view-ops ())
|
|
|
1793 (setq mh-folder-view-stack ())
|
|
|
1794 (setq mh-thread-scan-line-map-stack ())
|
|
|
1795 (let ((buffer-read-only nil)) (erase-buffer)))
|
|
|
1796
|
|
|
1797 (defun mh-make-folder (name)
|
|
|
1798 "Create a new mail folder called NAME.
|
|
|
1799 Make it the current folder."
|
|
|
1800 (switch-to-buffer name)
|
|
|
1801 (setq buffer-read-only nil)
|
|
|
1802 (erase-buffer)
|
|
|
1803 (if mh-adaptive-cmd-note-flag
|
|
|
1804 (mh-set-cmd-note (mh-msg-num-width-to-column (mh-msg-num-width name))))
|
|
|
1805 (setq buffer-read-only t)
|
|
|
1806 (mh-folder-mode)
|
|
|
1807 (mh-set-folder-modified-p nil)
|
|
|
1808 (setq buffer-file-name mh-folder-filename)
|
|
|
1809 (when (and (not mh-index-data)
|
|
|
1810 (file-exists-p (concat buffer-file-name mh-index-data-file)))
|
|
|
1811 (mh-index-read-data))
|
|
|
1812 (mh-make-folder-mode-line))
|
|
|
1813
|
|
|
1814 ;;;###mh-autoload
|
|
|
1815 (defun mh-next-msg (&optional wait-after-complaining-flag)
|
|
|
1816 "Move backward or forward to the next undeleted message in the buffer.
|
|
|
1817 If optional argument WAIT-AFTER-COMPLAINING-FLAG is non-nil and
|
|
|
1818 we are at the last message, then wait for a second after telling
|
|
|
1819 the user that there aren't any more unread messages."
|
|
|
1820 (if (eq mh-next-direction 'forward)
|
|
|
1821 (mh-next-undeleted-msg 1 wait-after-complaining-flag)
|
|
|
1822 (mh-previous-undeleted-msg 1 wait-after-complaining-flag)))
|
|
|
1823
|
|
|
1824 ;;;###mh-autoload
|
|
|
1825 (defun mh-prompt-for-refile-folder ()
|
|
|
1826 "Prompt the user for a folder in which the message should be filed.
|
|
|
1827 The folder is returned as a string.
|
|
|
1828
|
|
|
1829 The default folder name is generated by the option
|
|
|
1830 `mh-default-folder-for-message-function' if it is non-nil or
|
|
|
1831 `mh-folder-from-address'."
|
|
|
1832 (mh-prompt-for-folder
|
|
|
1833 "Destination"
|
|
|
1834 (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
|
|
|
1835 (if (null refile-file) ""
|
|
|
1836 (save-excursion
|
|
|
1837 (set-buffer (get-buffer-create mh-temp-buffer))
|
|
|
1838 (erase-buffer)
|
|
|
1839 (insert-file-contents refile-file)
|
|
|
1840 (or (and mh-default-folder-for-message-function
|
|
|
1841 (let ((buffer-file-name refile-file))
|
|
|
1842 (funcall mh-default-folder-for-message-function)))
|
|
|
1843 (mh-folder-from-address)
|
|
|
1844 (and (eq 'refile (car mh-last-destination-folder))
|
|
|
1845 (symbol-name (cdr mh-last-destination-folder)))
|
|
|
1846 ""))))
|
|
|
1847 t))
|
|
|
1848
|
|
|
1849 ;;;###mh-autoload
|
|
|
1850 (defun mh-folder-from-address ()
|
|
|
1851 "Derive folder name from sender.
|
|
|
1852
|
|
|
1853 The name of the folder is derived as follows:
|
|
|
1854
|
|
|
1855 a) The folder name associated with the first address found in
|
|
|
1856 the list `mh-default-folder-list' is used. Each element in
|
|
|
1857 this list contains a \"Check Recipient\" item. If this item is
|
|
|
1858 turned on, then the address is checked against the recipient
|
|
|
1859 instead of the sender. This is useful for mailing lists.
|
|
|
1860
|
|
|
1861 b) An alias prefixed by `mh-default-folder-prefix'
|
|
|
1862 corresponding to the address is used. The prefix is used to
|
|
|
1863 prevent clutter in your mail directory.
|
|
|
1864
|
|
|
1865 Return nil if a folder name was not derived, or if the variable
|
|
|
1866 `mh-default-folder-must-exist-flag' is t and the folder does not
|
|
|
1867 exist."
|
|
|
1868 ;; Loop for all entries in mh-default-folder-list
|
|
|
1869 (save-restriction
|
|
|
1870 (goto-char (point-min))
|
|
|
1871 (re-search-forward "\n\n" nil 'limit)
|
|
|
1872 (narrow-to-region (point-min) (point))
|
|
|
1873 (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
|
|
|
1874 (or (message-fetch-field "cc") "")))
|
|
|
1875 (from (or (message-fetch-field "from") ""))
|
|
|
1876 folder-name)
|
|
|
1877 (setq folder-name
|
|
|
1878 (loop for list in mh-default-folder-list
|
|
|
1879 when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
|
|
|
1880 return (nth 1 list)
|
|
|
1881 finally return nil))
|
|
|
1882
|
|
|
1883 ;; Make sure a result from `mh-default-folder-list' begins with "+"
|
|
|
1884 ;; since 'mh-expand-file-name below depends on it
|
|
|
1885 (when (and folder-name (not (eq (aref folder-name 0) ?+)))
|
|
|
1886 (setq folder-name (concat "+" folder-name)))
|
|
|
1887
|
|
|
1888 ;; If not, is there an alias for the address?
|
|
|
1889 (when (not folder-name)
|
|
|
1890 (let* ((from-header (mh-extract-from-header-value))
|
|
|
1891 (address (and from-header
|
|
|
1892 (nth 1 (mail-extract-address-components
|
|
|
1893 from-header))))
|
|
|
1894 (alias (and address (mh-alias-address-to-alias address))))
|
|
|
1895 (when alias
|
|
|
1896 (setq folder-name
|
|
|
1897 (and alias (concat "+" mh-default-folder-prefix alias))))))
|
|
|
1898
|
|
|
1899 ;; If mh-default-folder-must-exist-flag set, check that folder exists.
|
|
|
1900 (if (and folder-name
|
|
|
1901 (or (not mh-default-folder-must-exist-flag)
|
|
|
1902 (file-exists-p (mh-expand-file-name folder-name))))
|
|
|
1903 folder-name))))
|
|
|
1904
|
|
|
1905 ;;;###mh-autoload
|
|
|
1906 (defun mh-delete-a-msg (message)
|
|
|
1907 "Delete MESSAGE.
|
|
|
1908 If MESSAGE is nil then the message at point is deleted.
|
|
|
1909 The hook `mh-delete-msg-hook' is called after you mark a message
|
|
|
1910 for deletion. For example, a past maintainer of MH-E used this
|
|
|
1911 once when he kept statistics on his mail usage."
|
|
|
1912 (save-excursion
|
|
|
1913 (if (numberp message)
|
|
|
1914 (mh-goto-msg message nil t)
|
|
|
1915 (beginning-of-line)
|
|
|
1916 (setq message (mh-get-msg-num t)))
|
|
|
1917 (if (looking-at mh-scan-refiled-msg-regexp)
|
|
|
1918 (error "Message %d is refiled; undo refile before deleting" message))
|
|
|
1919 (if (looking-at mh-scan-deleted-msg-regexp)
|
|
|
1920 nil
|
|
|
1921 (mh-set-folder-modified-p t)
|
|
|
1922 (setq mh-delete-list (cons message mh-delete-list))
|
|
|
1923 (mh-notate nil mh-note-deleted mh-cmd-note)
|
|
|
1924 (run-hooks 'mh-delete-msg-hook))))
|
|
|
1925
|
|
|
1926 ;;;###mh-autoload
|
|
|
1927 (defun mh-refile-a-msg (message folder)
|
|
|
1928 "Refile MESSAGE in FOLDER.
|
|
|
1929 If MESSAGE is nil then the message at point is refiled.
|
|
|
1930 Folder is a symbol, not a string.
|
|
|
1931 The hook `mh-refile-msg-hook' is called after a message is marked to
|
|
|
1932 be refiled."
|
|
|
1933 (save-excursion
|
|
|
1934 (if (numberp message)
|
|
|
1935 (mh-goto-msg message nil t)
|
|
|
1936 (beginning-of-line)
|
|
|
1937 (setq message (mh-get-msg-num t)))
|
|
|
1938 (cond ((looking-at mh-scan-deleted-msg-regexp)
|
|
|
1939 (error "Message %d is deleted; undo delete before moving" message))
|
|
|
1940 ((looking-at mh-scan-refiled-msg-regexp)
|
|
|
1941 (if (y-or-n-p
|
|
|
1942 (format "Message %d already refiled; copy to %s as well? "
|
|
|
1943 message folder))
|
|
|
1944 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
|
|
|
1945 "-src" mh-current-folder
|
|
|
1946 (symbol-name folder))
|
|
|
1947 (message "Message not copied")))
|
|
|
1948 (t
|
|
|
1949 (mh-set-folder-modified-p t)
|
|
|
1950 (cond ((null (assoc folder mh-refile-list))
|
|
|
1951 (push (list folder message) mh-refile-list))
|
|
|
1952 ((not (member message (cdr (assoc folder mh-refile-list))))
|
|
|
1953 (push message (cdr (assoc folder mh-refile-list)))))
|
|
|
1954 (mh-notate nil mh-note-refiled mh-cmd-note)
|
|
|
1955 (run-hooks 'mh-refile-msg-hook)))))
|
|
|
1956
|
|
|
1957 (defun mh-undo-msg (msg)
|
|
|
1958 "Undo the deletion or refile of one MSG.
|
|
|
1959 If MSG is nil then act on the message at point"
|
|
|
1960 (save-excursion
|
|
|
1961 (if (numberp msg)
|
|
|
1962 (mh-goto-msg msg t t)
|
|
|
1963 (beginning-of-line)
|
|
|
1964 (setq msg (mh-get-msg-num t)))
|
|
|
1965 (cond ((memq msg mh-delete-list)
|
|
|
1966 (setq mh-delete-list (delq msg mh-delete-list)))
|
|
|
1967 (t
|
|
|
1968 (dolist (folder-msg-list mh-refile-list)
|
|
|
1969 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
|
|
|
1970 (setq mh-refile-list (loop for x in mh-refile-list
|
|
|
1971 unless (null (cdr x)) collect x))))
|
|
|
1972 (mh-notate nil ? mh-cmd-note)))
|
|
|
1973
|
|
|
1974 ;;;###mh-autoload
|
|
|
1975 (defun mh-msg-filename (msg &optional folder)
|
|
|
1976 "Return the file name of MSG in FOLDER (default current folder)."
|
|
|
1977 (expand-file-name (int-to-string msg)
|
|
|
1978 (if folder
|
|
|
1979 (mh-expand-file-name folder)
|
|
|
1980 mh-folder-filename)))
|
|
|
1981
|
|
|
1982 (provide 'mh-folder)
|
|
|
1983
|
|
|
1984 ;; Local Variables:
|
|
|
1985 ;; indent-tabs-mode: nil
|
|
|
1986 ;; sentence-end-double-space: nil
|
|
|
1987 ;; End:
|
|
|
1988
|
|
|
1989 ;;; mh-folder.el ends here
|
