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