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