1;;; mh-funcs.el --- MH-E functions not everyone will use right away 2 3;; Copyright (C) 1993, 1995, 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Bill Wohler <wohler@newt.com> 7;; Maintainer: Bill Wohler <wohler@newt.com> 8;; Keywords: mail 9;; See: mh-e.el 10 11;; This file is part of GNU Emacs. 12 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) 16;; any later version. 17 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. 22 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. 27 28;;; Commentary: 29 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;; Please add the functions in alphabetical order. If only one or two 34;; small support routines are needed, place them with the function; 35;; otherwise, create a separate section for them. 36 37;;; Change Log: 38 39;;; Code: 40 41(require 'mh-e) 42(require 'mh-scan) 43 44;;;###mh-autoload 45(defun mh-burst-digest () 46 "Break up digest into separate messages\\<mh-folder-mode-map>. 47 48This command uses the MH command \"burst\" to break out each 49message in the digest into its own message. Using this command, 50you can quickly delete unwanted messages, like this: Once the 51digest is split up, toggle out of MH-Folder Show mode with 52\\[mh-toggle-showing] so that the scan lines fill the screen and 53messages aren't displayed. Then use \\[mh-delete-msg] to quickly 54delete messages that you don't want to read (based on the 55\"Subject:\" header field). You can also burst the digest to 56reply directly to the people who posted the messages in the 57digest. One problem you may encounter is that the \"From:\" 58header fields are preceded with a \">\" so that your reply can't 59create the \"To:\" field correctly. In this case, you must 60correct the \"To:\" field yourself." 61 (interactive) 62 (let ((digest (mh-get-msg-num t))) 63 (mh-process-or-undo-commands mh-current-folder) 64 (mh-set-folder-modified-p t) ; lock folder while bursting 65 (message "Bursting digest...") 66 (mh-exec-cmd "burst" mh-current-folder digest "-inplace") 67 (with-mh-folder-updating (t) 68 (beginning-of-line) 69 (delete-region (point) (point-max))) 70 (mh-regenerate-headers (format "%d-last" digest) t) 71 (mh-goto-cur-msg) 72 (message "Bursting digest...done"))) 73 74;;;###mh-autoload 75(defun mh-copy-msg (range folder) 76 "Copy RANGE to FOLDER\\<mh-folder-mode-map>. 77 78If you wish to copy a message to another folder, you can use this 79command (see the \"-link\" argument to \"refile\"). Like the 80command \\[mh-refile-msg], this command prompts you for the name 81of the target folder and you can specify a range. Note that 82unlike the command \\[mh-refile-msg], the copy takes place 83immediately. The original copy remains in the current folder. 84 85Check the documentation of `mh-interactive-range' to see how 86RANGE is read in interactive use." 87 (interactive (list (mh-interactive-range "Copy") 88 (mh-prompt-for-folder "Copy to" "" t))) 89 (let ((msg-list (let ((result ())) 90 (mh-iterate-on-range msg range 91 (mh-notate nil mh-note-copied mh-cmd-note) 92 (push msg result)) 93 result))) 94 (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list) 95 "-link" "-src" mh-current-folder folder))) 96 97;;;###mh-autoload 98(defun mh-kill-folder () 99 "Remove folder. 100 101Remove all of the messages (files) within the current folder, and 102then remove the folder (directory) itself. 103 104Run the abnormal hook `mh-kill-folder-suppress-prompt-hooks'. The 105hook functions are called with no arguments and should return a 106non-nil value to suppress the normal prompt when you remove a 107folder. This is useful for folders that are easily regenerated." 108 (interactive) 109 (if (or (run-hook-with-args-until-success 110 'mh-kill-folder-suppress-prompt-hooks) 111 (yes-or-no-p (format "Remove folder %s (and all included messages)? " 112 mh-current-folder))) 113 (let ((folder mh-current-folder) 114 (window-config mh-previous-window-config)) 115 (mh-set-folder-modified-p t) ; lock folder to kill it 116 (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) 117 (when (boundp 'mh-speed-folder-map) 118 (mh-speed-invalidate-map folder)) 119 (mh-remove-from-sub-folders-cache folder) 120 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain 121 (if (and mh-show-buffer (get-buffer mh-show-buffer)) 122 (kill-buffer mh-show-buffer)) 123 (if (get-buffer folder) 124 (kill-buffer folder)) 125 (when window-config 126 (set-window-configuration window-config)) 127 (message "Folder %s removed" folder)) 128 (message "Folder not removed"))) 129 130(defun mh-rmf-daemon (process output) 131 "The rmf PROCESS puts OUTPUT in temporary buffer. 132Display the results only if something went wrong." 133 (set-buffer (get-buffer-create mh-temp-buffer)) 134 (insert-before-markers output) 135 (when (save-excursion 136 (goto-char (point-min)) 137 (re-search-forward "^rmf: " (point-max) t)) 138 (display-buffer mh-temp-buffer))) 139 140;; Shush compiler. 141(defvar view-exit-action) 142 143;;;###mh-autoload 144(defun mh-list-folders () 145 "List mail folders." 146 (interactive) 147 (let ((temp-buffer mh-folders-buffer)) 148 (with-output-to-temp-buffer temp-buffer 149 (save-excursion 150 (set-buffer temp-buffer) 151 (erase-buffer) 152 (message "Listing folders...") 153 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag 154 "-recurse" 155 "-norecurse")) 156 (goto-char (point-min)) 157 (mh-view-mode-enter) 158 (setq view-exit-action 'kill-buffer) 159 (message "Listing folders...done"))))) 160 161;;;###mh-autoload 162(defun mh-pack-folder (range) 163 "Pack folder\\<mh-folder-mode-map>. 164 165This command packs the folder, removing gaps from the numbering 166sequence. If you don't want to rescan the entire folder 167afterward, this command will accept a RANGE. Check the 168documentation of `mh-interactive-range' to see how RANGE is read 169in interactive use. 170 171This command will ask if you want to process refiles or deletes 172first and then either run \\[mh-execute-commands] for you or undo 173the pending refiles and deletes." 174 (interactive (list (if current-prefix-arg 175 (mh-read-range "Scan" mh-current-folder t nil t 176 mh-interpret-number-as-range-flag) 177 '("all")))) 178 (let ((threaded-flag (memq 'unthread mh-view-ops))) 179 (mh-pack-folder-1 range) 180 (mh-goto-cur-msg) 181 (when mh-index-data 182 (mh-index-update-maps mh-current-folder)) 183 (cond (threaded-flag (mh-toggle-threads)) 184 (mh-index-data (mh-index-insert-folder-headers)))) 185 (message "Packing folder...done")) 186 187(defun mh-pack-folder-1 (range) 188 "Close and pack the current folder. 189 190Display RANGE after packing, or the entire folder if RANGE is nil." 191 (mh-process-or-undo-commands mh-current-folder) 192 (message "Packing folder...") 193 (mh-set-folder-modified-p t) ; lock folder while packing 194 (save-excursion 195 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack" 196 "-norecurse" "-fast")) 197 (mh-reset-threads-and-narrowing) 198 (mh-regenerate-headers range)) 199 200;;;###mh-autoload 201(defun mh-page-digest () 202 "Display next message in digest." 203 (interactive) 204 (mh-in-show-buffer (mh-show-buffer) 205 ;; Go to top of screen (in case user moved point). 206 (move-to-window-line 0) 207 (let ((case-fold-search nil)) 208 ;; Search for blank line and then for From: 209 (or (and (search-forward "\n\n" nil t) 210 (re-search-forward "^From:" nil t)) 211 (error "No more messages in digest"))) 212 ;; Go back to previous blank line, then forward to the first non-blank. 213 (search-backward "\n\n" nil t) 214 (forward-line 2) 215 (mh-recenter 0))) 216 217;;;###mh-autoload 218(defun mh-page-digest-backwards () 219 "Display previous message in digest." 220 (interactive) 221 (mh-in-show-buffer (mh-show-buffer) 222 ;; Go to top of screen (in case user moved point). 223 (move-to-window-line 0) 224 (let ((case-fold-search nil)) 225 (beginning-of-line) 226 (or (and (search-backward "\n\n" nil t) 227 (re-search-backward "^From:" nil t)) 228 (error "No previous message in digest"))) 229 ;; Go back to previous blank line, then forward to the first non-blank. 230 (if (search-backward "\n\n" nil t) 231 (forward-line 2)) 232 (mh-recenter 0))) 233 234;;;###mh-autoload 235(defun mh-pipe-msg (command include-header) 236 "Pipe message through shell command COMMAND. 237 238You are prompted for the Unix command through which you wish to 239run your message. If you give a prefix argument INCLUDE-HEADER to 240this command, the message header is included in the text passed 241to the command." 242 (interactive 243 (list (read-string "Shell command on message: ") current-prefix-arg)) 244 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t))) 245 (message-directory default-directory)) 246 (save-excursion 247 (set-buffer (get-buffer-create mh-temp-buffer)) 248 (erase-buffer) 249 (insert-file-contents msg-file-to-pipe) 250 (goto-char (point-min)) 251 (if (not include-header) (search-forward "\n\n")) 252 (let ((default-directory message-directory)) 253 (shell-command-on-region (point) (point-max) command nil))))) 254 255;;;###mh-autoload 256(defun mh-sort-folder (&optional extra-args) 257 "Sort folder. 258 259By default, messages are sorted by date. The option 260`mh-sortm-args' holds extra arguments to pass on to the command 261\"sortm\" when a prefix argument EXTRA-ARGS is used." 262 (interactive "P") 263 (mh-process-or-undo-commands mh-current-folder) 264 (setq mh-next-direction 'forward) 265 (mh-set-folder-modified-p t) ; lock folder while sorting 266 (message "Sorting folder...") 267 (let ((threaded-flag (memq 'unthread mh-view-ops))) 268 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args)) 269 (when mh-index-data 270 (mh-index-update-maps mh-current-folder)) 271 (message "Sorting folder...done") 272 (mh-scan-folder mh-current-folder "all") 273 (cond (threaded-flag (mh-toggle-threads)) 274 (mh-index-data (mh-index-insert-folder-headers))))) 275 276;;;###mh-autoload 277(defun mh-store-msg (directory) 278 "Unpack message created with \"uudecode\" or \"shar\". 279 280The default DIRECTORY for extraction is the current directory; 281however, you have a chance to specify a different extraction 282directory. The next time you use this command, the default 283directory is the last directory you used. If you would like to 284change the initial default directory, customize the option 285`mh-store-default-directory', change the value from \"Current\" 286to \"Directory\", and then enter the name of the directory for 287storing the content of these messages." 288 (interactive (list (let ((udir (or mh-store-default-directory 289 default-directory))) 290 (read-file-name "Store message in directory: " 291 udir udir nil)))) 292 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t)))) 293 (save-excursion 294 (set-buffer (get-buffer-create mh-temp-buffer)) 295 (erase-buffer) 296 (insert-file-contents msg-file-to-store) 297 (mh-store-buffer directory)))) 298 299(defun mh-store-buffer (directory) 300 "Unpack buffer created with \"uudecode\" or \"shar\". 301 302See `mh-store-msg' for a description of DIRECTORY." 303 (interactive (list (let ((udir (or mh-store-default-directory 304 default-directory))) 305 (read-file-name "Store buffer in directory: " 306 udir udir nil)))) 307 (let ((store-directory (expand-file-name directory)) 308 (sh-start (save-excursion 309 (goto-char (point-min)) 310 (if (re-search-forward 311 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t) 312 (progn 313 ;; The "cut here" pattern was removed from above 314 ;; because it seemed to hurt more than help. 315 ;; But keep this to make it easier to put it back. 316 (if (looking-at "^[^a-z0-9\"]*cut here\\b") 317 (forward-line 1)) 318 (beginning-of-line) 319 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$") 320 nil ;most likely end of a uuencode 321 (point)))))) 322 (command "sh") 323 (uudecode-filename "(unknown filename)") 324 log-begin) 325 (if (not sh-start) 326 (save-excursion 327 (goto-char (point-min)) 328 (if (re-search-forward "^begin [0-7]+ " nil t) 329 (setq uudecode-filename 330 (buffer-substring (point) 331 (progn (end-of-line) (point))))))) 332 (save-excursion 333 (set-buffer (get-buffer-create mh-log-buffer)) 334 (setq log-begin (mh-truncate-log-buffer)) 335 (if (not (file-directory-p store-directory)) 336 (progn 337 (insert "mkdir " directory "\n") 338 (call-process "mkdir" nil mh-log-buffer t store-directory))) 339 (insert "cd " directory "\n") 340 (setq mh-store-default-directory directory) 341 (if (not sh-start) 342 (progn 343 (setq command "uudecode") 344 (insert uudecode-filename " being uudecoded...\n")))) 345 (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress 346 (let ((default-directory (file-name-as-directory store-directory))) 347 (if (equal (call-process-region sh-start (point-max) command 348 nil mh-log-buffer t) 349 0) 350 (save-excursion 351 (set-buffer mh-log-buffer) 352 (insert "\n(mh-store finished)\n")) 353 (error "Error occurred during execution of %s" command))))) 354 355;;;###mh-autoload 356(defun mh-undo-folder () 357 "Undo all refiles and deletes in the current folder." 358 (interactive) 359 (cond ((or mh-do-not-confirm-flag 360 (yes-or-no-p "Undo all commands in folder? ")) 361 (setq mh-delete-list nil 362 mh-refile-list nil 363 mh-seq-list nil 364 mh-next-direction 'forward) 365 (with-mh-folder-updating (nil) 366 (mh-remove-all-notation))) 367 (t 368 (message "Commands not undone")))) 369 370(provide 'mh-funcs) 371 372;; Local Variables: 373;; indent-tabs-mode: nil 374;; sentence-end-double-space: nil 375;; End: 376 377;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762 378;;; mh-funcs.el ends here 379