Commit | Line | Data |
---|---|---|
bdcfe844 | 1 | ;;; mh-funcs.el --- MH-E functions not everyone will use right away |
c26cf6c8 | 2 | |
e495eaec | 3 | ;; Copyright (C) 1993, 1995, |
114f9c96 | 4 | ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
dcf71371 | 5 | ;; Free Software Foundation, Inc. |
a1b4049d BW |
6 | |
7 | ;; Author: Bill Wohler <wohler@newt.com> | |
8 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
9 | ;; Keywords: mail | |
10 | ;; See: mh-e.el | |
c26cf6c8 | 11 | |
60370d40 | 12 | ;; This file is part of GNU Emacs. |
c26cf6c8 | 13 | |
5e809f55 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c26cf6c8 | 15 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
16 | ;; the Free Software Foundation, either version 3 of the License, or |
17 | ;; (at your option) any later version. | |
c26cf6c8 | 18 | |
9b7bc076 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c26cf6c8 RS |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c26cf6c8 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
bdcfe844 | 29 | ;; Putting these functions in a separate file lets MH-E start up faster, |
b578f267 | 30 | ;; since less Lisp code needs to be loaded all at once. |
c26cf6c8 | 31 | |
dda00b2c BW |
32 | ;; Please add the functions in alphabetical order. If only one or two |
33 | ;; small support routines are needed, place them with the function; | |
34 | ;; otherwise, create a separate section for them. | |
35 | ||
847b8219 KH |
36 | ;;; Change Log: |
37 | ||
c26cf6c8 RS |
38 | ;;; Code: |
39 | ||
c26cf6c8 | 40 | (require 'mh-e) |
dda00b2c | 41 | (require 'mh-scan) |
847b8219 | 42 | |
c3d9274a | 43 | ;;;###mh-autoload |
c26cf6c8 | 44 | (defun mh-burst-digest () |
553fb735 BW |
45 | "Break up digest into separate messages\\<mh-folder-mode-map>. |
46 | ||
2dcf34f9 BW |
47 | This command uses the MH command \"burst\" to break out each |
48 | message in the digest into its own message. Using this command, | |
49 | you can quickly delete unwanted messages, like this: Once the | |
50 | digest is split up, toggle out of MH-Folder Show mode with | |
51 | \\[mh-toggle-showing] so that the scan lines fill the screen and | |
52 | messages aren't displayed. Then use \\[mh-delete-msg] to quickly | |
53 | delete messages that you don't want to read (based on the | |
54 | \"Subject:\" header field). You can also burst the digest to | |
55 | reply directly to the people who posted the messages in the | |
56 | digest. One problem you may encounter is that the \"From:\" | |
57 | header fields are preceded with a \">\" so that your reply can't | |
58 | create the \"To:\" field correctly. In this case, you must | |
59 | correct the \"To:\" field yourself." | |
c26cf6c8 RS |
60 | (interactive) |
61 | (let ((digest (mh-get-msg-num t))) | |
62 | (mh-process-or-undo-commands mh-current-folder) | |
c3d9274a | 63 | (mh-set-folder-modified-p t) ; lock folder while bursting |
c26cf6c8 RS |
64 | (message "Bursting digest...") |
65 | (mh-exec-cmd "burst" mh-current-folder digest "-inplace") | |
847b8219 KH |
66 | (with-mh-folder-updating (t) |
67 | (beginning-of-line) | |
68 | (delete-region (point) (point-max))) | |
69 | (mh-regenerate-headers (format "%d-last" digest) t) | |
70 | (mh-goto-cur-msg) | |
c26cf6c8 RS |
71 | (message "Bursting digest...done"))) |
72 | ||
c3d9274a | 73 | ;;;###mh-autoload |
a66894d8 | 74 | (defun mh-copy-msg (range folder) |
2be362c2 BW |
75 | "Copy RANGE to FOLDER\\<mh-folder-mode-map>. |
76 | ||
2dcf34f9 | 77 | If you wish to copy a message to another folder, you can use this |
4023e353 | 78 | command (see the \"-link\" argument to \"refile\"). Like the |
2dcf34f9 BW |
79 | command \\[mh-refile-msg], this command prompts you for the name |
80 | of the target folder and you can specify a range. Note that | |
81 | unlike the command \\[mh-refile-msg], the copy takes place | |
82 | immediately. The original copy remains in the current folder. | |
a66894d8 | 83 | |
2dcf34f9 BW |
84 | Check the documentation of `mh-interactive-range' to see how |
85 | RANGE is read in interactive use." | |
a66894d8 | 86 | (interactive (list (mh-interactive-range "Copy") |
c3d9274a | 87 | (mh-prompt-for-folder "Copy to" "" t))) |
924df208 | 88 | (let ((msg-list (let ((result ())) |
a66894d8 | 89 | (mh-iterate-on-range msg range |
924df208 BW |
90 | (mh-notate nil mh-note-copied mh-cmd-note) |
91 | (push msg result)) | |
92 | result))) | |
3d7ca223 | 93 | (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list) |
924df208 | 94 | "-link" "-src" mh-current-folder folder))) |
c26cf6c8 | 95 | |
c3d9274a | 96 | ;;;###mh-autoload |
c26cf6c8 | 97 | (defun mh-kill-folder () |
d1699462 BW |
98 | "Remove folder. |
99 | ||
2dcf34f9 BW |
100 | Remove all of the messages (files) within the current folder, and |
101 | then remove the folder (directory) itself. | |
d1699462 | 102 | |
2dcf34f9 BW |
103 | Run the abnormal hook `mh-kill-folder-suppress-prompt-hooks'. The |
104 | hook functions are called with no arguments and should return a | |
105 | non-nil value to suppress the normal prompt when you remove a | |
106 | folder. This is useful for folders that are easily regenerated." | |
c26cf6c8 | 107 | (interactive) |
a66894d8 | 108 | (if (or (run-hook-with-args-until-success |
d1699462 | 109 | 'mh-kill-folder-suppress-prompt-hooks) |
924df208 | 110 | (yes-or-no-p (format "Remove folder %s (and all included messages)? " |
3d7ca223 BW |
111 | mh-current-folder))) |
112 | (let ((folder mh-current-folder) | |
113 | (window-config mh-previous-window-config)) | |
c3d9274a | 114 | (mh-set-folder-modified-p t) ; lock folder to kill it |
3d7ca223 | 115 | (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) |
bdcfe844 BW |
116 | (when (boundp 'mh-speed-folder-map) |
117 | (mh-speed-invalidate-map folder)) | |
3d7ca223 | 118 | (mh-remove-from-sub-folders-cache folder) |
c3d9274a | 119 | (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain |
3d7ca223 | 120 | (if (and mh-show-buffer (get-buffer mh-show-buffer)) |
c3d9274a BW |
121 | (kill-buffer mh-show-buffer)) |
122 | (if (get-buffer folder) | |
3d7ca223 BW |
123 | (kill-buffer folder)) |
124 | (when window-config | |
125 | (set-window-configuration window-config)) | |
126 | (message "Folder %s removed" folder)) | |
c3d9274a | 127 | (message "Folder not removed"))) |
c26cf6c8 | 128 | |
3d7ca223 BW |
129 | (defun mh-rmf-daemon (process output) |
130 | "The rmf PROCESS puts OUTPUT in temporary buffer. | |
131 | Display the results only if something went wrong." | |
132 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
133 | (insert-before-markers output) | |
134 | (when (save-excursion | |
e495eaec | 135 | (goto-char (point-min)) |
3d7ca223 BW |
136 | (re-search-forward "^rmf: " (point-max) t)) |
137 | (display-buffer mh-temp-buffer))) | |
138 | ||
04f6a2d1 | 139 | ;; Shush compiler. |
73e6d1af | 140 | (defvar view-exit-action) |
c26cf6c8 | 141 | |
c3d9274a | 142 | ;;;###mh-autoload |
c26cf6c8 RS |
143 | (defun mh-list-folders () |
144 | "List mail folders." | |
145 | (interactive) | |
3d7ca223 | 146 | (let ((temp-buffer mh-folders-buffer)) |
a1b4049d | 147 | (with-output-to-temp-buffer temp-buffer |
b5553d47 | 148 | (with-current-buffer temp-buffer |
c3d9274a BW |
149 | (erase-buffer) |
150 | (message "Listing folders...") | |
151 | (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag | |
152 | "-recurse" | |
153 | "-norecurse")) | |
154 | (goto-char (point-min)) | |
d5dc8c56 | 155 | (mh-view-mode-enter) |
c3d9274a BW |
156 | (setq view-exit-action 'kill-buffer) |
157 | (message "Listing folders...done"))))) | |
158 | ||
159 | ;;;###mh-autoload | |
c26cf6c8 | 160 | (defun mh-pack-folder (range) |
2be362c2 BW |
161 | "Pack folder\\<mh-folder-mode-map>. |
162 | ||
2dcf34f9 BW |
163 | This command packs the folder, removing gaps from the numbering |
164 | sequence. If you don't want to rescan the entire folder | |
165 | afterward, this command will accept a RANGE. Check the | |
166 | documentation of `mh-interactive-range' to see how RANGE is read | |
167 | in interactive use. | |
2be362c2 | 168 | |
2dcf34f9 BW |
169 | This command will ask if you want to process refiles or deletes |
170 | first and then either run \\[mh-execute-commands] for you or undo | |
031c6757 SG |
171 | the pending refiles and deletes. |
172 | ||
2f4029e8 BW |
173 | The hook `mh-pack-folder-hook' is run after the folder is packed; |
174 | see its documentation for variables it can use." | |
c26cf6c8 | 175 | (interactive (list (if current-prefix-arg |
a66894d8 BW |
176 | (mh-read-range "Scan" mh-current-folder t nil t |
177 | mh-interpret-number-as-range-flag) | |
c3d9274a BW |
178 | '("all")))) |
179 | (let ((threaded-flag (memq 'unthread mh-view-ops))) | |
180 | (mh-pack-folder-1 range) | |
181 | (mh-goto-cur-msg) | |
182 | (when mh-index-data | |
183 | (mh-index-update-maps mh-current-folder)) | |
184 | (cond (threaded-flag (mh-toggle-threads)) | |
185 | (mh-index-data (mh-index-insert-folder-headers)))) | |
031c6757 | 186 | (run-hooks 'mh-pack-folder-hook) |
c26cf6c8 RS |
187 | (message "Packing folder...done")) |
188 | ||
c26cf6c8 | 189 | (defun mh-pack-folder-1 (range) |
bdcfe844 | 190 | "Close and pack the current folder. |
2be362c2 BW |
191 | |
192 | Display RANGE after packing, or the entire folder if RANGE is nil." | |
c26cf6c8 RS |
193 | (mh-process-or-undo-commands mh-current-folder) |
194 | (message "Packing folder...") | |
c3d9274a | 195 | (mh-set-folder-modified-p t) ; lock folder while packing |
c26cf6c8 | 196 | (save-excursion |
847b8219 | 197 | (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" |
c3d9274a | 198 | "-norecurse" "-fast")) |
bdcfe844 | 199 | (mh-reset-threads-and-narrowing) |
c26cf6c8 RS |
200 | (mh-regenerate-headers range)) |
201 | ||
c3d9274a | 202 | ;;;###mh-autoload |
c26cf6c8 | 203 | (defun mh-page-digest () |
553fb735 | 204 | "Display next message in digest." |
c26cf6c8 RS |
205 | (interactive) |
206 | (mh-in-show-buffer (mh-show-buffer) | |
207 | ;; Go to top of screen (in case user moved point). | |
208 | (move-to-window-line 0) | |
209 | (let ((case-fold-search nil)) | |
210 | ;; Search for blank line and then for From: | |
211 | (or (and (search-forward "\n\n" nil t) | |
c3d9274a BW |
212 | (re-search-forward "^From:" nil t)) |
213 | (error "No more messages in digest"))) | |
c26cf6c8 RS |
214 | ;; Go back to previous blank line, then forward to the first non-blank. |
215 | (search-backward "\n\n" nil t) | |
216 | (forward-line 2) | |
217 | (mh-recenter 0))) | |
218 | ||
c3d9274a | 219 | ;;;###mh-autoload |
c26cf6c8 | 220 | (defun mh-page-digest-backwards () |
553fb735 | 221 | "Display previous message in digest." |
c26cf6c8 RS |
222 | (interactive) |
223 | (mh-in-show-buffer (mh-show-buffer) | |
224 | ;; Go to top of screen (in case user moved point). | |
225 | (move-to-window-line 0) | |
226 | (let ((case-fold-search nil)) | |
227 | (beginning-of-line) | |
228 | (or (and (search-backward "\n\n" nil t) | |
c3d9274a BW |
229 | (re-search-backward "^From:" nil t)) |
230 | (error "No previous message in digest"))) | |
c26cf6c8 RS |
231 | ;; Go back to previous blank line, then forward to the first non-blank. |
232 | (if (search-backward "\n\n" nil t) | |
c3d9274a | 233 | (forward-line 2)) |
c26cf6c8 RS |
234 | (mh-recenter 0))) |
235 | ||
dda00b2c BW |
236 | ;;;###mh-autoload |
237 | (defun mh-pipe-msg (command include-header) | |
238 | "Pipe message through shell command COMMAND. | |
239 | ||
240 | You are prompted for the Unix command through which you wish to | |
241 | run your message. If you give a prefix argument INCLUDE-HEADER to | |
242 | this command, the message header is included in the text passed | |
243 | to the command." | |
244 | (interactive | |
245 | (list (read-string "Shell command on message: ") current-prefix-arg)) | |
246 | (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) | |
247 | (message-directory default-directory)) | |
b5553d47 | 248 | (with-current-buffer (get-buffer-create mh-temp-buffer) |
dda00b2c BW |
249 | (erase-buffer) |
250 | (insert-file-contents msg-file-to-pipe) | |
251 | (goto-char (point-min)) | |
252 | (if (not include-header) (search-forward "\n\n")) | |
253 | (let ((default-directory message-directory)) | |
254 | (shell-command-on-region (point) (point-max) command nil))))) | |
255 | ||
c3d9274a | 256 | ;;;###mh-autoload |
847b8219 | 257 | (defun mh-sort-folder (&optional extra-args) |
af435184 | 258 | "Sort folder. |
2dcf34f9 | 259 | |
af435184 BW |
260 | By default, messages are sorted by date. The option |
261 | `mh-sortm-args' holds extra arguments to pass on to the command | |
262 | \"sortm\" when a prefix argument EXTRA-ARGS is used." | |
c26cf6c8 RS |
263 | (interactive "P") |
264 | (mh-process-or-undo-commands mh-current-folder) | |
265 | (setq mh-next-direction 'forward) | |
c3d9274a | 266 | (mh-set-folder-modified-p t) ; lock folder while sorting |
c26cf6c8 | 267 | (message "Sorting folder...") |
c3d9274a BW |
268 | (let ((threaded-flag (memq 'unthread mh-view-ops))) |
269 | (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) | |
270 | (when mh-index-data | |
271 | (mh-index-update-maps mh-current-folder)) | |
272 | (message "Sorting folder...done") | |
c3d9274a BW |
273 | (mh-scan-folder mh-current-folder "all") |
274 | (cond (threaded-flag (mh-toggle-threads)) | |
275 | (mh-index-data (mh-index-insert-folder-headers))))) | |
276 | ||
c3d9274a | 277 | ;;;###mh-autoload |
847b8219 | 278 | (defun mh-store-msg (directory) |
5a4aad03 | 279 | "Unpack message created with \"uudecode\" or \"shar\". |
553fb735 | 280 | |
2dcf34f9 BW |
281 | The default DIRECTORY for extraction is the current directory; |
282 | however, you have a chance to specify a different extraction | |
283 | directory. The next time you use this command, the default | |
284 | directory is the last directory you used. If you would like to | |
285 | change the initial default directory, customize the option | |
af435184 BW |
286 | `mh-store-default-directory', change the value from \"Current\" |
287 | to \"Directory\", and then enter the name of the directory for | |
288 | storing the content of these messages." | |
c3d9274a BW |
289 | (interactive (list (let ((udir (or mh-store-default-directory |
290 | default-directory))) | |
291 | (read-file-name "Store message in directory: " | |
292 | udir udir nil)))) | |
847b8219 | 293 | (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) |
b5553d47 | 294 | (with-current-buffer (get-buffer-create mh-temp-buffer) |
c26cf6c8 | 295 | (erase-buffer) |
847b8219 KH |
296 | (insert-file-contents msg-file-to-store) |
297 | (mh-store-buffer directory)))) | |
c26cf6c8 | 298 | |
847b8219 | 299 | (defun mh-store-buffer (directory) |
af435184 | 300 | "Unpack buffer created with \"uudecode\" or \"shar\". |
2dcf34f9 | 301 | |
af435184 | 302 | See `mh-store-msg' for a description of DIRECTORY." |
bdcfe844 | 303 | (interactive (list (let ((udir (or mh-store-default-directory |
c3d9274a BW |
304 | default-directory))) |
305 | (read-file-name "Store buffer in directory: " | |
306 | udir udir nil)))) | |
847b8219 | 307 | (let ((store-directory (expand-file-name directory)) |
c3d9274a BW |
308 | (sh-start (save-excursion |
309 | (goto-char (point-min)) | |
310 | (if (re-search-forward | |
311 | "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) | |
312 | (progn | |
313 | ;; The "cut here" pattern was removed from above | |
314 | ;; because it seemed to hurt more than help. | |
315 | ;; But keep this to make it easier to put it back. | |
316 | (if (looking-at "^[^a-z0-9\"]*cut here\\b") | |
317 | (forward-line 1)) | |
318 | (beginning-of-line) | |
319 | (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") | |
320 | nil ;most likely end of a uuencode | |
321 | (point)))))) | |
c3d9274a | 322 | (command "sh") |
924df208 BW |
323 | (uudecode-filename "(unknown filename)") |
324 | log-begin) | |
847b8219 | 325 | (if (not sh-start) |
c3d9274a BW |
326 | (save-excursion |
327 | (goto-char (point-min)) | |
328 | (if (re-search-forward "^begin [0-7]+ " nil t) | |
329 | (setq uudecode-filename | |
330 | (buffer-substring (point) | |
331 | (progn (end-of-line) (point))))))) | |
b5553d47 | 332 | (with-current-buffer (get-buffer-create mh-log-buffer) |
924df208 | 333 | (setq log-begin (mh-truncate-log-buffer)) |
c26cf6c8 | 334 | (if (not (file-directory-p store-directory)) |
c3d9274a BW |
335 | (progn |
336 | (insert "mkdir " directory "\n") | |
924df208 | 337 | (call-process "mkdir" nil mh-log-buffer t store-directory))) |
847b8219 KH |
338 | (insert "cd " directory "\n") |
339 | (setq mh-store-default-directory directory) | |
340 | (if (not sh-start) | |
c3d9274a BW |
341 | (progn |
342 | (setq command "uudecode") | |
343 | (insert uudecode-filename " being uudecoded...\n")))) | |
924df208 BW |
344 | (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress |
345 | (let ((default-directory (file-name-as-directory store-directory))) | |
346 | (if (equal (call-process-region sh-start (point-max) command | |
347 | nil mh-log-buffer t) | |
348 | 0) | |
b5553d47 | 349 | (with-current-buffer mh-log-buffer |
924df208 BW |
350 | (insert "\n(mh-store finished)\n")) |
351 | (error "Error occurred during execution of %s" command))))) | |
bdcfe844 | 352 | |
c3d9274a | 353 | ;;;###mh-autoload |
dda00b2c BW |
354 | (defun mh-undo-folder () |
355 | "Undo all refiles and deletes in the current folder." | |
bdcfe844 | 356 | (interactive) |
dda00b2c BW |
357 | (cond ((or mh-do-not-confirm-flag |
358 | (yes-or-no-p "Undo all commands in folder? ")) | |
359 | (setq mh-delete-list nil | |
360 | mh-refile-list nil | |
361 | mh-seq-list nil | |
362 | mh-next-direction 'forward) | |
363 | (with-mh-folder-updating (nil) | |
364 | (mh-remove-all-notation))) | |
365 | (t | |
366 | (message "Commands not undone")))) | |
bdcfe844 BW |
367 | |
368 | (provide 'mh-funcs) | |
369 | ||
cee9f5c6 BW |
370 | ;; Local Variables: |
371 | ;; indent-tabs-mode: nil | |
372 | ;; sentence-end-double-space: nil | |
373 | ;; End: | |
bdcfe844 | 374 | |
cee9f5c6 | 375 | ;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762 |
60370d40 | 376 | ;;; mh-funcs.el ends here |