Mercurial > emacs
annotate lisp/mail/mh-funcs.el @ 44940:2686a6ef3d19
(Fcommandp): Declare new arg.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 28 Apr 2002 22:06:17 +0000 |
parents | 67b464da13ec |
children | 2568d5a27317 |
rev | line source |
---|---|
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
1 ;;; mh-funcs.el --- mh-e functions not everyone will use right away |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
2 ;; Time-stamp: <2001-07-14 13:08:45 pavel> |
6365 | 3 |
11332 | 4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. |
6365 | 5 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
6 ;; This file is part of GNU Emacs. |
6365 | 7 |
11333 | 8 ;; GNU Emacs is free software; you can redistribute it and/or modify |
6365 | 9 ;; it under the terms of the GNU General Public License as published by |
10 ;; the Free Software Foundation; either version 2, or (at your option) | |
11 ;; any later version. | |
12 | |
11333 | 13 ;; GNU Emacs is distributed in the hope that it will be useful, |
6365 | 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;; GNU General Public License for more details. | |
17 | |
18 ;; You should have received a copy of the GNU General Public License | |
14169 | 19 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 ;; Boston, MA 02111-1307, USA. | |
6365 | 22 |
23 ;;; Commentary: | |
24 | |
14169 | 25 ;; Internal support for mh-e package. |
26 ;; Putting these functions in a separate file lets mh-e start up faster, | |
27 ;; since less Lisp code needs to be loaded all at once. | |
6365 | 28 |
11332 | 29 ;;; Change Log: |
30 | |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
31 ;; $Id: mh-funcs.el,v 1.5 1996/01/14 07:34:30 erik Exp $ |
11332 | 32 |
6365 | 33 ;;; Code: |
34 | |
35 (provide 'mh-funcs) | |
36 (require 'mh-e) | |
37 | |
11332 | 38 ;;; customization |
39 | |
6365 | 40 (defvar mh-sortm-args nil |
41 "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command. | |
11332 | 42 The arguments are passed to sortm if \\[mh-sort-folder] is given a |
43 prefix argument. Normally default arguments to sortm are specified in the | |
44 MH profile. | |
6365 | 45 For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") |
46 | |
11332 | 47 (defvar mh-note-copied "C" |
48 "String whose first character is used to notate copied messages.") | |
49 | |
50 (defvar mh-note-printed "P" | |
51 "String whose first character is used to notate printed messages.") | |
52 | |
53 ;;; functions | |
54 | |
6365 | 55 (defun mh-burst-digest () |
56 "Burst apart the current message, which should be a digest. | |
11332 | 57 The message is replaced by its table of contents and the messages from the |
6365 | 58 digest are inserted into the folder after that message." |
59 (interactive) | |
60 (let ((digest (mh-get-msg-num t))) | |
61 (mh-process-or-undo-commands mh-current-folder) | |
62 (mh-set-folder-modified-p t) ; lock folder while bursting | |
63 (message "Bursting digest...") | |
64 (mh-exec-cmd "burst" mh-current-folder digest "-inplace") | |
11332 | 65 (with-mh-folder-updating (t) |
66 (beginning-of-line) | |
67 (delete-region (point) (point-max))) | |
68 (mh-regenerate-headers (format "%d-last" digest) t) | |
69 (mh-goto-cur-msg) | |
6365 | 70 (message "Bursting digest...done"))) |
71 | |
72 | |
11332 | 73 (defun mh-copy-msg (msg-or-seq folder) |
74 "Copy the specified MESSAGE(s) to another FOLDER without deleting them. | |
6365 | 75 Default is the displayed message. If optional prefix argument is |
76 provided, then prompt for the message sequence." | |
11332 | 77 (interactive (list (if current-prefix-arg |
6365 | 78 (mh-read-seq-default "Copy" t) |
11332 | 79 (mh-get-msg-num t)) |
80 (mh-prompt-for-folder "Copy to" "" t))) | |
81 (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder) | |
6365 | 82 (if (numberp msg-or-seq) |
11332 | 83 (mh-notate msg-or-seq mh-note-copied mh-cmd-note) |
84 (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note))) | |
6365 | 85 |
86 (defun mh-kill-folder () | |
87 "Remove the current folder." | |
88 (interactive) | |
89 (if (or mh-do-not-confirm | |
90 (yes-or-no-p (format "Remove folder %s? " mh-current-folder))) | |
91 (let ((folder mh-current-folder)) | |
92 (if (null mh-folder-list) | |
93 (mh-set-folder-list)) | |
94 (mh-set-folder-modified-p t) ; lock folder to kill it | |
95 (mh-exec-cmd-daemon "rmf" folder) | |
96 (setq mh-folder-list | |
97 (delq (assoc folder mh-folder-list) mh-folder-list)) | |
11332 | 98 (run-hooks 'mh-folder-list-change-hook) |
6365 | 99 (message "Folder %s removed" folder) |
100 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain | |
101 (if (get-buffer mh-show-buffer) | |
102 (kill-buffer mh-show-buffer)) | |
103 (kill-buffer folder)) | |
104 (message "Folder not removed"))) | |
105 | |
106 | |
107 (defun mh-list-folders () | |
108 "List mail folders." | |
109 (interactive) | |
11332 | 110 (with-output-to-temp-buffer mh-temp-buffer |
6365 | 111 (save-excursion |
11332 | 112 (switch-to-buffer mh-temp-buffer) |
6365 | 113 (erase-buffer) |
114 (message "Listing folders...") | |
115 (mh-exec-cmd-output "folders" t (if mh-recursive-folders | |
116 "-recurse" | |
117 "-norecurse")) | |
118 (goto-char (point-min)) | |
119 (message "Listing folders...done")))) | |
120 | |
121 | |
122 (defun mh-pack-folder (range) | |
123 "Renumber the messages of a folder to be 1..n. | |
124 First, offer to execute any outstanding commands for the current folder. | |
11332 | 125 If optional prefix argument provided, prompt for the RANGE of messages |
6365 | 126 to display after packing. Otherwise, show the entire folder." |
127 (interactive (list (if current-prefix-arg | |
128 (mh-read-msg-range | |
129 "Range to scan after packing [all]? ") | |
130 "all"))) | |
131 (mh-pack-folder-1 range) | |
132 (mh-goto-cur-msg) | |
133 (message "Packing folder...done")) | |
134 | |
135 | |
136 (defun mh-pack-folder-1 (range) | |
137 ;; Close and pack the current folder. | |
138 (mh-process-or-undo-commands mh-current-folder) | |
139 (message "Packing folder...") | |
140 (mh-set-folder-modified-p t) ; lock folder while packing | |
141 (save-excursion | |
11332 | 142 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" |
143 "-norecurse" "-fast")) | |
6365 | 144 (mh-regenerate-headers range)) |
145 | |
146 | |
147 (defun mh-pipe-msg (command include-headers) | |
148 "Pipe the current message through the given shell COMMAND. | |
149 If INCLUDE-HEADERS (prefix argument) is provided, send the entire message. | |
150 Otherwise just send the message's body without the headers." | |
151 (interactive | |
152 (list (read-string "Shell command on message: ") current-prefix-arg)) | |
11332 | 153 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) |
154 (message-directory default-directory)) | |
6365 | 155 (save-excursion |
11332 | 156 (set-buffer (get-buffer-create mh-temp-buffer)) |
6365 | 157 (erase-buffer) |
11332 | 158 (insert-file-contents msg-file-to-pipe) |
6365 | 159 (goto-char (point-min)) |
160 (if (not include-headers) (search-forward "\n\n")) | |
11332 | 161 (let ((default-directory message-directory)) |
162 (shell-command-on-region (point) (point-max) command nil))))) | |
6365 | 163 |
164 | |
165 (defun mh-page-digest () | |
166 "Advance displayed message to next digested message." | |
167 (interactive) | |
168 (mh-in-show-buffer (mh-show-buffer) | |
169 ;; Go to top of screen (in case user moved point). | |
170 (move-to-window-line 0) | |
171 (let ((case-fold-search nil)) | |
172 ;; Search for blank line and then for From: | |
173 (or (and (search-forward "\n\n" nil t) | |
11332 | 174 (re-search-forward "^From:" nil t)) |
6365 | 175 (error "No more messages in digest"))) |
176 ;; Go back to previous blank line, then forward to the first non-blank. | |
177 (search-backward "\n\n" nil t) | |
178 (forward-line 2) | |
179 (mh-recenter 0))) | |
180 | |
181 | |
182 (defun mh-page-digest-backwards () | |
183 "Back up displayed message to previous 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 (beginning-of-line) | |
190 (or (and (search-backward "\n\n" nil t) | |
11332 | 191 (re-search-backward "^From:" nil t)) |
6365 | 192 (error "No previous message in digest"))) |
193 ;; Go back to previous blank line, then forward to the first non-blank. | |
194 (if (search-backward "\n\n" nil t) | |
195 (forward-line 2)) | |
196 (mh-recenter 0))) | |
197 | |
198 | |
199 (defun mh-print-msg (msg-or-seq) | |
200 "Print MESSAGE(s) (default: displayed message) on printer. | |
201 If optional prefix argument provided, then prompt for the message sequence. | |
202 The variable mh-lpr-command-format is used to generate the print command. | |
203 The messages are formatted by mhl. See the variable mhl-formfile." | |
204 (interactive (list (if current-prefix-arg | |
205 (reverse (mh-seq-to-msgs | |
206 (mh-read-seq-default "Print" t))) | |
207 (mh-get-msg-num t)))) | |
208 (if (numberp msg-or-seq) | |
209 (message "Printing message...") | |
210 (message "Printing sequence...")) | |
211 (let ((print-command | |
212 (if (numberp msg-or-seq) | |
213 (format "%s -nobell -clear %s %s | %s" | |
214 (expand-file-name "mhl" mh-lib) | |
215 (mh-msg-filename msg-or-seq) | |
216 (if (stringp mhl-formfile) | |
217 (format "-form %s" mhl-formfile) | |
218 "") | |
219 (format mh-lpr-command-format | |
220 (if (numberp msg-or-seq) | |
221 (format "%s/%d" mh-current-folder | |
222 msg-or-seq) | |
223 (format "Sequence from %s" mh-current-folder)))) | |
224 (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" | |
225 (mapconcat (function (lambda (msg) msg)) msg-or-seq " ") | |
226 (expand-file-name "mhl" mh-lib) | |
227 (if (stringp mhl-formfile) | |
228 (format "-form %s" mhl-formfile) | |
229 "") | |
230 (mh-msg-filenames msg-or-seq) | |
231 (format mh-lpr-command-format | |
232 (if (numberp msg-or-seq) | |
233 (format "%s/%d" mh-current-folder | |
234 msg-or-seq) | |
235 (format "Sequence from %s" | |
236 mh-current-folder))))))) | |
237 (if mh-print-background | |
238 (mh-exec-cmd-daemon shell-file-name "-c" print-command) | |
239 (call-process shell-file-name nil nil nil "-c" print-command)) | |
240 (if (numberp msg-or-seq) | |
11332 | 241 (mh-notate msg-or-seq mh-note-printed mh-cmd-note) |
242 (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note)) | |
6365 | 243 (mh-add-msgs-to-seq msg-or-seq 'printed t) |
244 (if (numberp msg-or-seq) | |
245 (message "Printing message...done") | |
246 (message "Printing sequence...done")))) | |
247 | |
248 | |
249 (defun mh-msg-filenames (msgs &optional folder) | |
250 ;; Return a list of file names for MSGS in FOLDER (default current folder). | |
251 (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " ")) | |
252 | |
253 | |
11332 | 254 (defun mh-sort-folder (&optional extra-args) |
6365 | 255 "Sort the messages in the current folder by date. |
256 Calls the MH program sortm to do the work. | |
257 The arguments in the list mh-sortm-args are passed to sortm | |
11332 | 258 if this function is passed an argument." |
6365 | 259 (interactive "P") |
260 (mh-process-or-undo-commands mh-current-folder) | |
261 (setq mh-next-direction 'forward) | |
262 (mh-set-folder-modified-p t) ; lock folder while sorting | |
263 (message "Sorting folder...") | |
11332 | 264 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) |
6365 | 265 (message "Sorting folder...done") |
266 (mh-scan-folder mh-current-folder "all")) | |
267 | |
268 | |
269 (defun mh-undo-folder (&rest ignore) | |
11332 | 270 "Undo all pending deletes and refiles in current folder." |
6365 | 271 (interactive) |
272 (cond ((or mh-do-not-confirm | |
273 (yes-or-no-p "Undo all commands in folder? ")) | |
274 (setq mh-delete-list nil | |
275 mh-refile-list nil | |
276 mh-seq-list nil | |
277 mh-next-direction 'forward) | |
278 (with-mh-folder-updating (nil) | |
279 (mh-unmark-all-headers t))) | |
280 (t | |
281 (message "Commands not undone.") | |
282 (sit-for 2)))) | |
283 | |
284 | |
11332 | 285 (defun mh-store-msg (directory) |
6365 | 286 "Store the file(s) contained in the current message into DIRECTORY. |
287 The message can contain a shar file or uuencoded file. | |
288 Default directory is the last directory used, or initially the value of | |
289 mh-store-default-directory or the current directory." | |
290 (interactive (list (let ((udir (or mh-store-default-directory default-directory))) | |
291 (read-file-name "Store message in directory: " | |
292 udir udir nil)))) | |
11332 | 293 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) |
6365 | 294 (save-excursion |
11332 | 295 (set-buffer (get-buffer-create mh-temp-buffer)) |
6365 | 296 (erase-buffer) |
11332 | 297 (insert-file-contents msg-file-to-store) |
298 (mh-store-buffer directory)))) | |
6365 | 299 |
11332 | 300 (defun mh-store-buffer (directory) |
6365 | 301 "Store the file(s) contained in the current buffer into DIRECTORY. |
302 The buffer can contain a shar file or uuencoded file. | |
303 Default directory is the last directory used, or initially the value of | |
304 `mh-store-default-directory' or the current directory." | |
305 (interactive (list (let ((udir (or mh-store-default-directory default-directory))) | |
11332 | 306 (read-file-name "Store buffer in directory: " |
307 udir udir nil)))) | |
308 (let ((store-directory (expand-file-name directory)) | |
309 (sh-start (save-excursion | |
310 (goto-char (point-min)) | |
311 (if (re-search-forward | |
312 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) | |
313 (progn | |
314 ;; The "cut here" pattern was removed from above | |
315 ;; because it seemed to hurt more than help. | |
316 ;; But keep this to make it easier to put it back. | |
317 (if (looking-at "^[^a-z0-9\"]*cut here\\b") | |
6365 | 318 (forward-line 1)) |
11332 | 319 (beginning-of-line) |
320 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") | |
321 nil ;most likely end of a uuencode | |
322 (point)))))) | |
6365 | 323 (log-buffer (get-buffer-create "*Store Output*")) |
11332 | 324 (command "sh") |
325 (uudecode-filename "(unknown filename)")) | |
326 (if (not sh-start) | |
327 (save-excursion | |
328 (goto-char (point-min)) | |
329 (if (re-search-forward "^begin [0-7]+ " nil t) | |
330 (setq uudecode-filename | |
331 (buffer-substring (point) | |
332 (progn (end-of-line) (point))))))) | |
6365 | 333 (save-excursion |
334 (set-buffer log-buffer) | |
335 (erase-buffer) | |
336 (if (not (file-directory-p store-directory)) | |
337 (progn | |
11332 | 338 (insert "mkdir " directory "\n") |
6365 | 339 (call-process "mkdir" nil log-buffer t store-directory))) |
11332 | 340 (insert "cd " directory "\n") |
341 (setq mh-store-default-directory directory) | |
342 (if (not sh-start) | |
6365 | 343 (progn |
344 (setq command "uudecode") | |
11332 | 345 (insert uudecode-filename " being uudecoded...\n")))) |
6365 | 346 (set-window-start (display-buffer log-buffer) 0) ;watch progress |
11332 | 347 (let (value) |
348 (let ((default-directory (file-name-as-directory store-directory))) | |
349 (setq value (call-process-region sh-start (point-max) command | |
350 nil log-buffer t))) | |
351 (set-buffer log-buffer) | |
352 (mh-handle-process-error command value)) | |
6365 | 353 (insert "\n(mh-store finished)\n"))) |
354 | |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
14169
diff
changeset
|
355 ;;; mh-funcs.el ends here |