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, |
deceef67 | 4 | ;; 2001, 2002, 2003, 2004 Free Software Foundation, Inc. |
a1b4049d BW |
5 | |
6 | ;; Author: Bill Wohler <wohler@newt.com> | |
7 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 | ;; Keywords: mail | |
9 | ;; See: mh-e.el | |
c26cf6c8 | 10 | |
60370d40 | 11 | ;; This file is part of GNU Emacs. |
c26cf6c8 | 12 | |
9b7bc076 | 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
c26cf6c8 RS |
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 | ||
9b7bc076 | 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c26cf6c8 RS |
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 | |
b578f267 | 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
c26cf6c8 RS |
27 | |
28 | ;;; Commentary: | |
29 | ||
bdcfe844 BW |
30 | ;; Internal support for MH-E package. |
31 | ;; Putting these functions in a separate file lets MH-E start up faster, | |
b578f267 | 32 | ;; since less Lisp code needs to be loaded all at once. |
c26cf6c8 | 33 | |
847b8219 KH |
34 | ;;; Change Log: |
35 | ||
c26cf6c8 RS |
36 | ;;; Code: |
37 | ||
f0d73c14 BW |
38 | (eval-when-compile (require 'mh-acros)) |
39 | (mh-require-cl) | |
c26cf6c8 RS |
40 | (require 'mh-e) |
41 | ||
c3d9274a | 42 | ;;; Customization |
847b8219 | 43 | |
c26cf6c8 RS |
44 | (defvar mh-sortm-args nil |
45 | "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. | |
847b8219 KH |
46 | The arguments are passed to sortm if \\[mh-sort-folder] is given a |
47 | prefix argument. Normally default arguments to sortm are specified in the | |
48 | MH profile. | |
c26cf6c8 RS |
49 | For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") |
50 | ||
f0d73c14 BW |
51 | ;;; Scan Line Formats |
52 | ||
847b8219 | 53 | (defvar mh-note-copied "C" |
e069fa61 | 54 | "Messages that have been copied are marked by this character.") |
847b8219 KH |
55 | |
56 | (defvar mh-note-printed "P" | |
f0d73c14 | 57 | "Messages that have been printed are marked by this character.") |
847b8219 | 58 | |
bdcfe844 | 59 | ;;; Functions |
847b8219 | 60 | |
c3d9274a | 61 | ;;;###mh-autoload |
c26cf6c8 RS |
62 | (defun mh-burst-digest () |
63 | "Burst apart the current message, which should be a digest. | |
847b8219 | 64 | The message is replaced by its table of contents and the messages from the |
c26cf6c8 RS |
65 | digest are inserted into the folder after that message." |
66 | (interactive) | |
67 | (let ((digest (mh-get-msg-num t))) | |
68 | (mh-process-or-undo-commands mh-current-folder) | |
c3d9274a | 69 | (mh-set-folder-modified-p t) ; lock folder while bursting |
c26cf6c8 RS |
70 | (message "Bursting digest...") |
71 | (mh-exec-cmd "burst" mh-current-folder digest "-inplace") | |
847b8219 KH |
72 | (with-mh-folder-updating (t) |
73 | (beginning-of-line) | |
74 | (delete-region (point) (point-max))) | |
75 | (mh-regenerate-headers (format "%d-last" digest) t) | |
76 | (mh-goto-cur-msg) | |
c26cf6c8 RS |
77 | (message "Bursting digest...done"))) |
78 | ||
c3d9274a | 79 | ;;;###mh-autoload |
a66894d8 BW |
80 | (defun mh-copy-msg (range folder) |
81 | "Copy the specified RANGE to another FOLDER without deleting them. | |
82 | ||
83 | Check the documentation of `mh-interactive-range' to see how RANGE is read in | |
84 | interactive use." | |
85 | (interactive (list (mh-interactive-range "Copy") | |
c3d9274a | 86 | (mh-prompt-for-folder "Copy to" "" t))) |
924df208 | 87 | (let ((msg-list (let ((result ())) |
a66894d8 | 88 | (mh-iterate-on-range msg range |
924df208 BW |
89 | (mh-notate nil mh-note-copied mh-cmd-note) |
90 | (push msg result)) | |
91 | result))) | |
3d7ca223 | 92 | (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list) |
924df208 | 93 | "-link" "-src" mh-current-folder folder))) |
c26cf6c8 | 94 | |
c3d9274a | 95 | ;;;###mh-autoload |
c26cf6c8 | 96 | (defun mh-kill-folder () |
a1b4049d BW |
97 | "Remove the current folder and all included messages. |
98 | Removes all of the messages (files) within the specified current folder, | |
a66894d8 BW |
99 | and then removes the folder (directory) itself. |
100 | The value of `mh-kill-folder-suppress-prompt-hook' is a list of functions to | |
101 | be called, with no arguments, which should return a value of non-nil if | |
102 | verification is not desired." | |
c26cf6c8 | 103 | (interactive) |
a66894d8 BW |
104 | (if (or (run-hook-with-args-until-success |
105 | 'mh-kill-folder-suppress-prompt-hook) | |
924df208 | 106 | (yes-or-no-p (format "Remove folder %s (and all included messages)? " |
3d7ca223 BW |
107 | mh-current-folder))) |
108 | (let ((folder mh-current-folder) | |
109 | (window-config mh-previous-window-config)) | |
c3d9274a | 110 | (mh-set-folder-modified-p t) ; lock folder to kill it |
3d7ca223 | 111 | (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) |
bdcfe844 BW |
112 | (when (boundp 'mh-speed-folder-map) |
113 | (mh-speed-invalidate-map folder)) | |
3d7ca223 | 114 | (mh-remove-from-sub-folders-cache folder) |
c3d9274a | 115 | (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain |
3d7ca223 | 116 | (if (and mh-show-buffer (get-buffer mh-show-buffer)) |
c3d9274a BW |
117 | (kill-buffer mh-show-buffer)) |
118 | (if (get-buffer folder) | |
3d7ca223 BW |
119 | (kill-buffer folder)) |
120 | (when window-config | |
121 | (set-window-configuration window-config)) | |
122 | (message "Folder %s removed" folder)) | |
c3d9274a | 123 | (message "Folder not removed"))) |
c26cf6c8 | 124 | |
3d7ca223 BW |
125 | (defun mh-rmf-daemon (process output) |
126 | "The rmf PROCESS puts OUTPUT in temporary buffer. | |
127 | Display the results only if something went wrong." | |
128 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
129 | (insert-before-markers output) | |
130 | (when (save-excursion | |
e495eaec | 131 | (goto-char (point-min)) |
3d7ca223 BW |
132 | (re-search-forward "^rmf: " (point-max) t)) |
133 | (display-buffer mh-temp-buffer))) | |
134 | ||
bdcfe844 BW |
135 | ;; Avoid compiler warning... |
136 | (defvar view-exit-action) | |
c26cf6c8 | 137 | |
c3d9274a | 138 | ;;;###mh-autoload |
c26cf6c8 RS |
139 | (defun mh-list-folders () |
140 | "List mail folders." | |
141 | (interactive) | |
3d7ca223 | 142 | (let ((temp-buffer mh-folders-buffer)) |
a1b4049d BW |
143 | (with-output-to-temp-buffer temp-buffer |
144 | (save-excursion | |
c3d9274a BW |
145 | (set-buffer temp-buffer) |
146 | (erase-buffer) | |
147 | (message "Listing folders...") | |
148 | (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag | |
149 | "-recurse" | |
150 | "-norecurse")) | |
151 | (goto-char (point-min)) | |
e495eaec | 152 | (view-mode-enter) |
c3d9274a BW |
153 | (setq view-exit-action 'kill-buffer) |
154 | (message "Listing folders...done"))))) | |
155 | ||
156 | ;;;###mh-autoload | |
c26cf6c8 RS |
157 | (defun mh-pack-folder (range) |
158 | "Renumber the messages of a folder to be 1..n. | |
bdcfe844 BW |
159 | First, offer to execute any outstanding commands for the current folder. If |
160 | optional prefix argument provided, prompt for the RANGE of messages to display | |
161 | after packing. Otherwise, show the entire folder." | |
c26cf6c8 | 162 | (interactive (list (if current-prefix-arg |
a66894d8 BW |
163 | (mh-read-range "Scan" mh-current-folder t nil t |
164 | mh-interpret-number-as-range-flag) | |
c3d9274a BW |
165 | '("all")))) |
166 | (let ((threaded-flag (memq 'unthread mh-view-ops))) | |
167 | (mh-pack-folder-1 range) | |
168 | (mh-goto-cur-msg) | |
169 | (when mh-index-data | |
170 | (mh-index-update-maps mh-current-folder)) | |
171 | (cond (threaded-flag (mh-toggle-threads)) | |
172 | (mh-index-data (mh-index-insert-folder-headers)))) | |
c26cf6c8 RS |
173 | (message "Packing folder...done")) |
174 | ||
c26cf6c8 | 175 | (defun mh-pack-folder-1 (range) |
bdcfe844 BW |
176 | "Close and pack the current folder. |
177 | Display the given RANGE of messages after packing. If RANGE is nil, show the | |
178 | entire folder." | |
c26cf6c8 RS |
179 | (mh-process-or-undo-commands mh-current-folder) |
180 | (message "Packing folder...") | |
c3d9274a | 181 | (mh-set-folder-modified-p t) ; lock folder while packing |
c26cf6c8 | 182 | (save-excursion |
847b8219 | 183 | (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" |
c3d9274a | 184 | "-norecurse" "-fast")) |
bdcfe844 | 185 | (mh-reset-threads-and-narrowing) |
c26cf6c8 RS |
186 | (mh-regenerate-headers range)) |
187 | ||
c3d9274a | 188 | ;;;###mh-autoload |
c26cf6c8 RS |
189 | (defun mh-pipe-msg (command include-headers) |
190 | "Pipe the current message through the given shell COMMAND. | |
191 | If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. | |
192 | Otherwise just send the message's body without the headers." | |
193 | (interactive | |
194 | (list (read-string "Shell command on message: ") current-prefix-arg)) | |
847b8219 | 195 | (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) |
c3d9274a | 196 | (message-directory default-directory)) |
c26cf6c8 | 197 | (save-excursion |
847b8219 | 198 | (set-buffer (get-buffer-create mh-temp-buffer)) |
c26cf6c8 | 199 | (erase-buffer) |
847b8219 | 200 | (insert-file-contents msg-file-to-pipe) |
c26cf6c8 RS |
201 | (goto-char (point-min)) |
202 | (if (not include-headers) (search-forward "\n\n")) | |
847b8219 | 203 | (let ((default-directory message-directory)) |
c3d9274a | 204 | (shell-command-on-region (point) (point-max) command nil))))) |
c26cf6c8 | 205 | |
c3d9274a | 206 | ;;;###mh-autoload |
c26cf6c8 RS |
207 | (defun mh-page-digest () |
208 | "Advance displayed message to next digested message." | |
209 | (interactive) | |
210 | (mh-in-show-buffer (mh-show-buffer) | |
211 | ;; Go to top of screen (in case user moved point). | |
212 | (move-to-window-line 0) | |
213 | (let ((case-fold-search nil)) | |
214 | ;; Search for blank line and then for From: | |
215 | (or (and (search-forward "\n\n" nil t) | |
c3d9274a BW |
216 | (re-search-forward "^From:" nil t)) |
217 | (error "No more messages in digest"))) | |
c26cf6c8 RS |
218 | ;; Go back to previous blank line, then forward to the first non-blank. |
219 | (search-backward "\n\n" nil t) | |
220 | (forward-line 2) | |
221 | (mh-recenter 0))) | |
222 | ||
c3d9274a | 223 | ;;;###mh-autoload |
c26cf6c8 RS |
224 | (defun mh-page-digest-backwards () |
225 | "Back up displayed message to previous digested message." | |
226 | (interactive) | |
227 | (mh-in-show-buffer (mh-show-buffer) | |
228 | ;; Go to top of screen (in case user moved point). | |
229 | (move-to-window-line 0) | |
230 | (let ((case-fold-search nil)) | |
231 | (beginning-of-line) | |
232 | (or (and (search-backward "\n\n" nil t) | |
c3d9274a BW |
233 | (re-search-backward "^From:" nil t)) |
234 | (error "No previous message in digest"))) | |
c26cf6c8 RS |
235 | ;; Go back to previous blank line, then forward to the first non-blank. |
236 | (if (search-backward "\n\n" nil t) | |
c3d9274a | 237 | (forward-line 2)) |
c26cf6c8 RS |
238 | (mh-recenter 0))) |
239 | ||
c3d9274a | 240 | ;;;###mh-autoload |
847b8219 | 241 | (defun mh-sort-folder (&optional extra-args) |
c26cf6c8 RS |
242 | "Sort the messages in the current folder by date. |
243 | Calls the MH program sortm to do the work. | |
bdcfe844 BW |
244 | The arguments in the list `mh-sortm-args' are passed to sortm if the optional |
245 | argument EXTRA-ARGS is given." | |
c26cf6c8 RS |
246 | (interactive "P") |
247 | (mh-process-or-undo-commands mh-current-folder) | |
248 | (setq mh-next-direction 'forward) | |
c3d9274a | 249 | (mh-set-folder-modified-p t) ; lock folder while sorting |
c26cf6c8 | 250 | (message "Sorting folder...") |
c3d9274a BW |
251 | (let ((threaded-flag (memq 'unthread mh-view-ops))) |
252 | (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) | |
253 | (when mh-index-data | |
254 | (mh-index-update-maps mh-current-folder)) | |
255 | (message "Sorting folder...done") | |
c3d9274a BW |
256 | (mh-scan-folder mh-current-folder "all") |
257 | (cond (threaded-flag (mh-toggle-threads)) | |
258 | (mh-index-data (mh-index-insert-folder-headers))))) | |
259 | ||
260 | ;;;###mh-autoload | |
f0d73c14 BW |
261 | (defun mh-undo-folder () |
262 | "Undo all pending deletes and refiles in current folder." | |
c26cf6c8 | 263 | (interactive) |
bdcfe844 | 264 | (cond ((or mh-do-not-confirm-flag |
c3d9274a BW |
265 | (yes-or-no-p "Undo all commands in folder? ")) |
266 | (setq mh-delete-list nil | |
267 | mh-refile-list nil | |
268 | mh-seq-list nil | |
269 | mh-next-direction 'forward) | |
270 | (with-mh-folder-updating (nil) | |
a66894d8 | 271 | (mh-remove-all-notation))) |
c3d9274a | 272 | (t |
f0d73c14 | 273 | (message "Commands not undone")))) |
c3d9274a BW |
274 | |
275 | ;;;###mh-autoload | |
847b8219 | 276 | (defun mh-store-msg (directory) |
c26cf6c8 RS |
277 | "Store the file(s) contained in the current message into DIRECTORY. |
278 | The message can contain a shar file or uuencoded file. | |
279 | Default directory is the last directory used, or initially the value of | |
a1b4049d | 280 | `mh-store-default-directory' or the current directory." |
c3d9274a BW |
281 | (interactive (list (let ((udir (or mh-store-default-directory |
282 | default-directory))) | |
283 | (read-file-name "Store message in directory: " | |
284 | udir udir nil)))) | |
847b8219 | 285 | (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) |
c26cf6c8 | 286 | (save-excursion |
847b8219 | 287 | (set-buffer (get-buffer-create mh-temp-buffer)) |
c26cf6c8 | 288 | (erase-buffer) |
847b8219 KH |
289 | (insert-file-contents msg-file-to-store) |
290 | (mh-store-buffer directory)))) | |
c26cf6c8 | 291 | |
c3d9274a | 292 | ;;;###mh-autoload |
847b8219 | 293 | (defun mh-store-buffer (directory) |
c26cf6c8 RS |
294 | "Store the file(s) contained in the current buffer into DIRECTORY. |
295 | The buffer can contain a shar file or uuencoded file. | |
296 | Default directory is the last directory used, or initially the value of | |
297 | `mh-store-default-directory' or the current directory." | |
bdcfe844 | 298 | (interactive (list (let ((udir (or mh-store-default-directory |
c3d9274a BW |
299 | default-directory))) |
300 | (read-file-name "Store buffer in directory: " | |
301 | udir udir nil)))) | |
847b8219 | 302 | (let ((store-directory (expand-file-name directory)) |
c3d9274a BW |
303 | (sh-start (save-excursion |
304 | (goto-char (point-min)) | |
305 | (if (re-search-forward | |
306 | "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) | |
307 | (progn | |
308 | ;; The "cut here" pattern was removed from above | |
309 | ;; because it seemed to hurt more than help. | |
310 | ;; But keep this to make it easier to put it back. | |
311 | (if (looking-at "^[^a-z0-9\"]*cut here\\b") | |
312 | (forward-line 1)) | |
313 | (beginning-of-line) | |
314 | (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") | |
315 | nil ;most likely end of a uuencode | |
316 | (point)))))) | |
c3d9274a | 317 | (command "sh") |
924df208 BW |
318 | (uudecode-filename "(unknown filename)") |
319 | log-begin) | |
847b8219 | 320 | (if (not sh-start) |
c3d9274a BW |
321 | (save-excursion |
322 | (goto-char (point-min)) | |
323 | (if (re-search-forward "^begin [0-7]+ " nil t) | |
324 | (setq uudecode-filename | |
325 | (buffer-substring (point) | |
326 | (progn (end-of-line) (point))))))) | |
c26cf6c8 | 327 | (save-excursion |
924df208 BW |
328 | (set-buffer (get-buffer-create mh-log-buffer)) |
329 | (setq log-begin (mh-truncate-log-buffer)) | |
c26cf6c8 | 330 | (if (not (file-directory-p store-directory)) |
c3d9274a BW |
331 | (progn |
332 | (insert "mkdir " directory "\n") | |
924df208 | 333 | (call-process "mkdir" nil mh-log-buffer t store-directory))) |
847b8219 KH |
334 | (insert "cd " directory "\n") |
335 | (setq mh-store-default-directory directory) | |
336 | (if (not sh-start) | |
c3d9274a BW |
337 | (progn |
338 | (setq command "uudecode") | |
339 | (insert uudecode-filename " being uudecoded...\n")))) | |
924df208 BW |
340 | (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress |
341 | (let ((default-directory (file-name-as-directory store-directory))) | |
342 | (if (equal (call-process-region sh-start (point-max) command | |
343 | nil mh-log-buffer t) | |
344 | 0) | |
345 | (save-excursion | |
346 | (set-buffer mh-log-buffer) | |
347 | (insert "\n(mh-store finished)\n")) | |
348 | (error "Error occurred during execution of %s" command))))) | |
bdcfe844 BW |
349 | |
350 | \f | |
351 | ||
352 | ;;; Help Functions | |
353 | ||
924df208 | 354 | ;;;###mh-autoload |
bdcfe844 BW |
355 | (defun mh-ephem-message (string) |
356 | "Display STRING in the minibuffer momentarily." | |
357 | (message "%s" string) | |
358 | (sit-for 5) | |
359 | (message "")) | |
360 | ||
c3d9274a | 361 | ;;;###mh-autoload |
bdcfe844 | 362 | (defun mh-help () |
f0d73c14 | 363 | "Display cheat sheet for the MH-E commands." |
bdcfe844 | 364 | (interactive) |
f0d73c14 BW |
365 | (with-electric-help |
366 | (function | |
367 | (lambda () | |
368 | (insert | |
369 | (substitute-command-keys | |
370 | (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) | |
371 | mh-help-buffer))) | |
a1506d29 | 372 | |
c3d9274a | 373 | ;;;###mh-autoload |
bdcfe844 BW |
374 | (defun mh-prefix-help () |
375 | "Display cheat sheet for the commands of the current prefix in minibuffer." | |
376 | (interactive) | |
377 | ;; We got here because the user pressed a `?', but he pressed a prefix key | |
378 | ;; before that. Since the the key vector starts at index 0, the index of the | |
379 | ;; last keystroke is length-1 and thus the second to last keystroke is at | |
380 | ;; length-2. We use that information to obtain a suitable prefix character | |
381 | ;; from the recent keys. | |
382 | (let* ((keys (recent-keys)) | |
c3d9274a | 383 | (prefix-char (elt keys (- (length keys) 2)))) |
f0d73c14 BW |
384 | (with-electric-help |
385 | (function | |
386 | (lambda () | |
387 | (insert | |
388 | (substitute-command-keys | |
389 | (mapconcat 'identity | |
390 | (cdr (assoc prefix-char mh-help-messages)) ""))))) | |
391 | mh-help-buffer))) | |
bdcfe844 BW |
392 | |
393 | (provide 'mh-funcs) | |
394 | ||
395 | ;;; Local Variables: | |
c3d9274a | 396 | ;;; indent-tabs-mode: nil |
bdcfe844 BW |
397 | ;;; sentence-end-double-space: nil |
398 | ;;; End: | |
399 | ||
ab5796a9 | 400 | ;;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762 |
60370d40 | 401 | ;;; mh-funcs.el ends here |