lisp/mh-e/mh-funcs.el

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