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 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, 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
  48 This command uses the MH command \"burst\" to break out each
  49 message in the digest into its own message. Using this command,
  50 you can quickly delete unwanted messages, like this: Once the
  51 digest is split up, toggle out of MH-Folder Show mode with
  52 \\[mh-toggle-showing] so that the scan lines fill the screen and
  53 messages aren't displayed. Then use \\[mh-delete-msg] to quickly
  54 delete messages that you don't want to read (based on the
  55 \"Subject:\" header field). You can also burst the digest to
  56 reply directly to the people who posted the messages in the
  57 digest. One problem you may encounter is that the \"From:\"
  58 header fields are preceded with a \">\" so that your reply can't
  59 create the \"To:\" field correctly. In this case, you must
  60 correct 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
  78 If you wish to copy a message to another folder, you can use this
  79 command (see the \"-link\" argument to \"refile\"). Like the
  80 command \\[mh-refile-msg], this command prompts you for the name
  81 of the target folder and you can specify a range. Note that
  82 unlike the command \\[mh-refile-msg], the copy takes place
  83 immediately. The original copy remains in the current folder.
  84
  85 Check the documentation of `mh-interactive-range' to see how
  86 RANGE 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
 101 Remove all of the messages (files) within the current folder, and
 102 then remove the folder (directory) itself.
 103
 104 Run the abnormal hook `mh-kill-folder-suppress-prompt-hooks'. The
 105 hook functions are called with no arguments and should return a
 106 non-nil value to suppress the normal prompt when you remove a
 107 folder. 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.
 132 Display 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
 165 This command packs the folder, removing gaps from the numbering
 166 sequence. If you don't want to rescan the entire folder
 167 afterward, this command will accept a RANGE. Check the
 168 documentation of `mh-interactive-range' to see how RANGE is read
 169 in interactive use.
 170
 171 This command will ask if you want to process refiles or deletes
 172 first and then either run \\[mh-execute-commands] for you or undo
 173 the 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
 190 Display 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
 238 You are prompted for the Unix command through which you wish to
 239 run your message. If you give a prefix argument INCLUDE-HEADER to
 240 this command, the message header is included in the text passed
 241 to 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
 259 By 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
 280 The default DIRECTORY for extraction is the current directory;
 281 however, you have a chance to specify a different extraction
 282 directory. The next time you use this command, the default
 283 directory is the last directory you used. If you would like to
 284 change the initial default directory, customize the option
 285 `mh-store-default-directory', change the value from \"Current\"
 286 to \"Directory\", and then enter the name of the directory for
 287 storing 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
 302 See `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