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