1 ;;; mh-funcs.el --- MH-E functions not everyone will use right away
3 ;; Copyright (C) 1993, 1995,
4 ;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: Bill Wohler <wohler@newt.com>
7 ;; Maintainer: Bill Wohler <wohler@newt.com>
11 ;; This file is part of GNU Emacs.
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)
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.
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.
30 ;; Internal support for MH-E package.
31 ;; Putting these functions in a separate file lets MH-E start up faster,
32 ;; since less Lisp code needs to be loaded all at once.
38 (eval-when-compile (require 'mh-acros))
46 (defvar mh-note-copied "C"
47 "Messages that have been copied are marked by this character.")
49 (defvar mh-note-printed "P"
50 "Messages that have been printed are marked by this character.")
57 (defun mh-burst-digest ()
58 "Break up digest into separate messages\\<mh-folder-mode-map>.
60 This command uses the MH command \"burst\" to break out each
61 message in the digest into its own message. Using this command,
62 you can quickly delete unwanted messages, like this: Once the
63 digest is split up, toggle out of MH-Folder Show mode with
64 \\[mh-toggle-showing] so that the scan lines fill the screen and
65 messages aren't displayed. Then use \\[mh-delete-msg] to quickly
66 delete messages that you don't want to read (based on the
67 \"Subject:\" header field). You can also burst the digest to
68 reply directly to the people who posted the messages in the
69 digest. One problem you may encounter is that the \"From:\"
70 header fields are preceded with a \">\" so that your reply can't
71 create the \"To:\" field correctly. In this case, you must
72 correct the \"To:\" field yourself."
74 (let ((digest (mh-get-msg-num t)))
75 (mh-process-or-undo-commands mh-current-folder)
76 (mh-set-folder-modified-p t) ; lock folder while bursting
77 (message "Bursting digest...")
78 (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
79 (with-mh-folder-updating (t)
81 (delete-region (point) (point-max)))
82 (mh-regenerate-headers (format "%d-last" digest) t)
84 (message "Bursting digest...done")))
87 (defun mh-copy-msg (range folder)
88 "Copy RANGE to FOLDER\\<mh-folder-mode-map>.
90 If you wish to copy a message to another folder, you can use this
91 command (see the \"-link\" argument to \"refile\"). Like the
92 command \\[mh-refile-msg], this command prompts you for the name
93 of the target folder and you can specify a range. Note that
94 unlike the command \\[mh-refile-msg], the copy takes place
95 immediately. The original copy remains in the current folder.
97 Check the documentation of `mh-interactive-range' to see how
98 RANGE is read in interactive use."
99 (interactive (list (mh-interactive-range "Copy")
100 (mh-prompt-for-folder "Copy to" "" t)))
101 (let ((msg-list (let ((result ()))
102 (mh-iterate-on-range msg range
103 (mh-notate nil mh-note-copied mh-cmd-note)
106 (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
107 "-link" "-src" mh-current-folder folder)))
110 (defun mh-kill-folder ()
113 Remove all of the messages (files) within the current folder, and
114 then remove the folder (directory) itself.
116 Run the abnormal hook `mh-kill-folder-suppress-prompt-hooks'. The
117 hook functions are called with no arguments and should return a
118 non-nil value to suppress the normal prompt when you remove a
119 folder. This is useful for folders that are easily regenerated."
121 (if (or (run-hook-with-args-until-success
122 'mh-kill-folder-suppress-prompt-hooks)
123 (yes-or-no-p (format "Remove folder %s (and all included messages)? "
125 (let ((folder mh-current-folder)
126 (window-config mh-previous-window-config))
127 (mh-set-folder-modified-p t) ; lock folder to kill it
128 (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
129 (when (boundp 'mh-speed-folder-map)
130 (mh-speed-invalidate-map folder))
131 (mh-remove-from-sub-folders-cache folder)
132 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
133 (if (and mh-show-buffer (get-buffer mh-show-buffer))
134 (kill-buffer mh-show-buffer))
135 (if (get-buffer folder)
136 (kill-buffer folder))
138 (set-window-configuration window-config))
139 (message "Folder %s removed" folder))
140 (message "Folder not removed")))
142 (defun mh-rmf-daemon (process output)
143 "The rmf PROCESS puts OUTPUT in temporary buffer.
144 Display the results only if something went wrong."
145 (set-buffer (get-buffer-create mh-temp-buffer))
146 (insert-before-markers output)
147 (when (save-excursion
148 (goto-char (point-min))
149 (re-search-forward "^rmf: " (point-max) t))
150 (display-buffer mh-temp-buffer)))
152 ;; Avoid compiler warning...
153 (defvar view-exit-action)
156 (defun mh-list-folders ()
159 (let ((temp-buffer mh-folders-buffer))
160 (with-output-to-temp-buffer temp-buffer
162 (set-buffer temp-buffer)
164 (message "Listing folders...")
165 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
168 (goto-char (point-min))
170 (setq view-exit-action 'kill-buffer)
171 (message "Listing folders...done")))))
174 (defun mh-pack-folder (range)
175 "Pack folder\\<mh-folder-mode-map>.
177 This command packs the folder, removing gaps from the numbering
178 sequence. If you don't want to rescan the entire folder
179 afterward, this command will accept a RANGE. Check the
180 documentation of `mh-interactive-range' to see how RANGE is read
183 This command will ask if you want to process refiles or deletes
184 first and then either run \\[mh-execute-commands] for you or undo
185 the pending refiles and deletes, which are lost."
186 (interactive (list (if current-prefix-arg
187 (mh-read-range "Scan" mh-current-folder t nil t
188 mh-interpret-number-as-range-flag)
190 (let ((threaded-flag (memq 'unthread mh-view-ops)))
191 (mh-pack-folder-1 range)
194 (mh-index-update-maps mh-current-folder))
195 (cond (threaded-flag (mh-toggle-threads))
196 (mh-index-data (mh-index-insert-folder-headers))))
197 (message "Packing folder...done"))
199 (defun mh-pack-folder-1 (range)
200 "Close and pack the current folder.
202 Display RANGE after packing, or the entire folder if RANGE is nil."
203 (mh-process-or-undo-commands mh-current-folder)
204 (message "Packing folder...")
205 (mh-set-folder-modified-p t) ; lock folder while packing
207 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
208 "-norecurse" "-fast"))
209 (mh-reset-threads-and-narrowing)
210 (mh-regenerate-headers range))
213 (defun mh-pipe-msg (command include-header)
214 "Pipe message through shell command COMMAND.
216 You are prompted for the Unix command through which you wish to
217 run your message. If you give a prefix argument INCLUDE-HEADER to
218 this command, the message header is included in the text passed
221 (list (read-string "Shell command on message: ") current-prefix-arg))
222 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
223 (message-directory default-directory))
225 (set-buffer (get-buffer-create mh-temp-buffer))
227 (insert-file-contents msg-file-to-pipe)
228 (goto-char (point-min))
229 (if (not include-header) (search-forward "\n\n"))
230 (let ((default-directory message-directory))
231 (shell-command-on-region (point) (point-max) command nil)))))
234 (defun mh-page-digest ()
235 "Display next message in digest."
237 (mh-in-show-buffer (mh-show-buffer)
238 ;; Go to top of screen (in case user moved point).
239 (move-to-window-line 0)
240 (let ((case-fold-search nil))
241 ;; Search for blank line and then for From:
242 (or (and (search-forward "\n\n" nil t)
243 (re-search-forward "^From:" nil t))
244 (error "No more messages in digest")))
245 ;; Go back to previous blank line, then forward to the first non-blank.
246 (search-backward "\n\n" nil t)
251 (defun mh-page-digest-backwards ()
252 "Display previous message in digest."
254 (mh-in-show-buffer (mh-show-buffer)
255 ;; Go to top of screen (in case user moved point).
256 (move-to-window-line 0)
257 (let ((case-fold-search nil))
259 (or (and (search-backward "\n\n" nil t)
260 (re-search-backward "^From:" nil t))
261 (error "No previous message in digest")))
262 ;; Go back to previous blank line, then forward to the first non-blank.
263 (if (search-backward "\n\n" nil t)
268 (defun mh-sort-folder (&optional extra-args)
271 By default, messages are sorted by date. The option
272 `mh-sortm-args' holds extra arguments to pass on to the command
273 \"sortm\" when a prefix argument EXTRA-ARGS is used."
275 (mh-process-or-undo-commands mh-current-folder)
276 (setq mh-next-direction 'forward)
277 (mh-set-folder-modified-p t) ; lock folder while sorting
278 (message "Sorting folder...")
279 (let ((threaded-flag (memq 'unthread mh-view-ops)))
280 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
282 (mh-index-update-maps mh-current-folder))
283 (message "Sorting folder...done")
284 (mh-scan-folder mh-current-folder "all")
285 (cond (threaded-flag (mh-toggle-threads))
286 (mh-index-data (mh-index-insert-folder-headers)))))
289 (defun mh-undo-folder ()
290 "Undo all refiles and deletes in the current folder."
292 (cond ((or mh-do-not-confirm-flag
293 (yes-or-no-p "Undo all commands in folder? "))
294 (setq mh-delete-list nil
297 mh-next-direction 'forward)
298 (with-mh-folder-updating (nil)
299 (mh-remove-all-notation)))
301 (message "Commands not undone"))))
304 (defun mh-store-msg (directory)
305 "Unpack message created with \"uudecode\" or \"shar\".
307 The default DIRECTORY for extraction is the current directory;
308 however, you have a chance to specify a different extraction
309 directory. The next time you use this command, the default
310 directory is the last directory you used. If you would like to
311 change the initial default directory, customize the option
312 `mh-store-default-directory', change the value from \"Current\"
313 to \"Directory\", and then enter the name of the directory for
314 storing the content of these messages."
315 (interactive (list (let ((udir (or mh-store-default-directory
317 (read-file-name "Store message in directory: "
319 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
321 (set-buffer (get-buffer-create mh-temp-buffer))
323 (insert-file-contents msg-file-to-store)
324 (mh-store-buffer directory))))
327 (defun mh-store-buffer (directory)
328 "Unpack buffer created with \"uudecode\" or \"shar\".
330 See `mh-store-msg' for a description of DIRECTORY."
331 (interactive (list (let ((udir (or mh-store-default-directory
333 (read-file-name "Store buffer in directory: "
335 (let ((store-directory (expand-file-name directory))
336 (sh-start (save-excursion
337 (goto-char (point-min))
338 (if (re-search-forward
339 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
341 ;; The "cut here" pattern was removed from above
342 ;; because it seemed to hurt more than help.
343 ;; But keep this to make it easier to put it back.
344 (if (looking-at "^[^a-z0-9\"]*cut here\\b")
347 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
348 nil ;most likely end of a uuencode
351 (uudecode-filename "(unknown filename)")
355 (goto-char (point-min))
356 (if (re-search-forward "^begin [0-7]+ " nil t)
357 (setq uudecode-filename
358 (buffer-substring (point)
359 (progn (end-of-line) (point)))))))
361 (set-buffer (get-buffer-create mh-log-buffer))
362 (setq log-begin (mh-truncate-log-buffer))
363 (if (not (file-directory-p store-directory))
365 (insert "mkdir " directory "\n")
366 (call-process "mkdir" nil mh-log-buffer t store-directory)))
367 (insert "cd " directory "\n")
368 (setq mh-store-default-directory directory)
371 (setq command "uudecode")
372 (insert uudecode-filename " being uudecoded...\n"))))
373 (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress
374 (let ((default-directory (file-name-as-directory store-directory)))
375 (if (equal (call-process-region sh-start (point-max) command
379 (set-buffer mh-log-buffer)
380 (insert "\n(mh-store finished)\n"))
381 (error "Error occurred during execution of %s" command)))))
388 (defun mh-ephem-message (string)
389 "Display STRING in the minibuffer momentarily."
390 (message "%s" string)
396 "Display cheat sheet for the MH-E commands."
402 (substitute-command-keys
403 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
407 (defun mh-prefix-help ()
408 "Display cheat sheet for the commands of the current prefix in minibuffer."
410 ;; We got here because the user pressed a "?", but he pressed a prefix key
411 ;; before that. Since the the key vector starts at index 0, the index of the
412 ;; last keystroke is length-1 and thus the second to last keystroke is at
413 ;; length-2. We use that information to obtain a suitable prefix character
414 ;; from the recent keys.
415 (let* ((keys (recent-keys))
416 (prefix-char (elt keys (- (length keys) 2))))
421 (substitute-command-keys
423 (cdr (assoc prefix-char mh-help-messages)) "")))))
429 ;; indent-tabs-mode: nil
430 ;; sentence-end-double-space: nil
433 ;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762
434 ;;; mh-funcs.el ends here