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