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