mh-funcs.el 14.8 KB
Newer Older
Bill Wohler's avatar
Bill Wohler committed
1
;;; mh-funcs.el --- MH-E functions not everyone will use right away
Richard M. Stallman's avatar
Richard M. Stallman committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1993, 1995, 2001-2019 Free Software Foundation, Inc.
Bill Wohler's avatar
Bill Wohler committed
4 5 6 7

;; Author: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
Richard M. Stallman's avatar
Richard M. Stallman committed
8

9
;; This file is part of GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
10

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
15

Karl Heuer's avatar
Karl Heuer committed
16
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
23 24 25

;;; Commentary:

Bill Wohler's avatar
Bill Wohler committed
26
;; Putting these functions in a separate file lets MH-E start up faster,
Erik Naggum's avatar
Erik Naggum committed
27
;; since less Lisp code needs to be loaded all at once.
Richard M. Stallman's avatar
Richard M. Stallman committed
28

Bill Wohler's avatar
Bill Wohler committed
29 30 31 32
;; Please add the functions in alphabetical order. If only one or two
;; small support routines are needed, place them with the function;
;; otherwise, create a separate section for them.

Karl Heuer's avatar
Karl Heuer committed
33 34
;;; Change Log:

Richard M. Stallman's avatar
Richard M. Stallman committed
35 36 37
;;; Code:

(require 'mh-e)
Bill Wohler's avatar
Bill Wohler committed
38
(require 'mh-scan)
Karl Heuer's avatar
Karl Heuer committed
39

Bill Wohler's avatar
Bill Wohler committed
40
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
41
(defun mh-burst-digest ()
42 43
  "Break up digest into separate messages\\<mh-folder-mode-map>.

44 45 46 47 48 49 50 51 52 53 54 55 56
This command uses the MH command \"burst\" to break out each
message in the digest into its own message. Using this command,
you can quickly delete unwanted messages, like this: Once the
digest is split up, toggle out of MH-Folder Show mode with
\\[mh-toggle-showing] so that the scan lines fill the screen and
messages aren't displayed. Then use \\[mh-delete-msg] to quickly
delete messages that you don't want to read (based on the
\"Subject:\" header field). You can also burst the digest to
reply directly to the people who posted the messages in the
digest. One problem you may encounter is that the \"From:\"
header fields are preceded with a \">\" so that your reply can't
create the \"To:\" field correctly. In this case, you must
correct the \"To:\" field yourself."
Richard M. Stallman's avatar
Richard M. Stallman committed
57 58 59
  (interactive)
  (let ((digest (mh-get-msg-num t)))
    (mh-process-or-undo-commands mh-current-folder)
Bill Wohler's avatar
Bill Wohler committed
60
    (mh-set-folder-modified-p t)        ; lock folder while bursting
Richard M. Stallman's avatar
Richard M. Stallman committed
61 62
    (message "Bursting digest...")
    (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
Karl Heuer's avatar
Karl Heuer committed
63 64 65 66 67
    (with-mh-folder-updating (t)
      (beginning-of-line)
      (delete-region (point) (point-max)))
    (mh-regenerate-headers (format "%d-last" digest) t)
    (mh-goto-cur-msg)
Richard M. Stallman's avatar
Richard M. Stallman committed
68 69
    (message "Bursting digest...done")))

Bill Wohler's avatar
Bill Wohler committed
70
;;;###mh-autoload
Bill Wohler's avatar
Bill Wohler committed
71
(defun mh-copy-msg (range folder)
72 73
  "Copy RANGE to FOLDER\\<mh-folder-mode-map>.

74
If you wish to copy a message to another folder, you can use this
75
command (see the \"-link\" argument to \"refile\"). Like the
76 77 78 79
command \\[mh-refile-msg], this command prompts you for the name
of the target folder and you can specify a range. Note that
unlike the command \\[mh-refile-msg], the copy takes place
immediately. The original copy remains in the current folder.
Bill Wohler's avatar
Bill Wohler committed
80

81 82
Check the documentation of `mh-interactive-range' to see how
RANGE is read in interactive use."
Bill Wohler's avatar
Bill Wohler committed
83
  (interactive (list (mh-interactive-range "Copy")
Bill Wohler's avatar
Bill Wohler committed
84
                     (mh-prompt-for-folder "Copy to" "" t)))
Bill Wohler's avatar
Bill Wohler committed
85
  (let ((msg-list (let ((result ()))
Bill Wohler's avatar
Bill Wohler committed
86
                    (mh-iterate-on-range msg range
Bill Wohler's avatar
Bill Wohler committed
87 88 89
                      (mh-notate nil mh-note-copied mh-cmd-note)
                      (push msg result))
                    result)))
Bill Wohler's avatar
Bill Wohler committed
90
    (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
Bill Wohler's avatar
Bill Wohler committed
91
                 "-link" "-src" mh-current-folder folder)))
Richard M. Stallman's avatar
Richard M. Stallman committed
92

Bill Wohler's avatar
Bill Wohler committed
93
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
94
(defun mh-kill-folder ()
95 96
  "Remove folder.

97 98
Remove all of the messages (files) within the current folder, and
then remove the folder (directory) itself.
99

100 101 102 103
Run the abnormal hook `mh-kill-folder-suppress-prompt-hooks'. The
hook functions are called with no arguments and should return a
non-nil value to suppress the normal prompt when you remove a
folder. This is useful for folders that are easily regenerated."
Richard M. Stallman's avatar
Richard M. Stallman committed
104
  (interactive)
Bill Wohler's avatar
Bill Wohler committed
105
  (if (or (run-hook-with-args-until-success
106
           'mh-kill-folder-suppress-prompt-hooks)
Bill Wohler's avatar
Bill Wohler committed
107
          (yes-or-no-p (format "Remove folder %s (and all included messages)? "
Bill Wohler's avatar
Bill Wohler committed
108 109 110
                               mh-current-folder)))
      (let ((folder mh-current-folder)
            (window-config mh-previous-window-config))
Bill Wohler's avatar
Bill Wohler committed
111
        (mh-set-folder-modified-p t)    ; lock folder to kill it
112
        (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
Bill Wohler's avatar
Bill Wohler committed
113 114
        (when (boundp 'mh-speed-folder-map)
          (mh-speed-invalidate-map folder))
Bill Wohler's avatar
Bill Wohler committed
115
        (mh-remove-from-sub-folders-cache folder)
Bill Wohler's avatar
Bill Wohler committed
116
        (mh-set-folder-modified-p nil)  ; so kill-buffer doesn't complain
Bill Wohler's avatar
Bill Wohler committed
117
        (if (and mh-show-buffer (get-buffer mh-show-buffer))
Bill Wohler's avatar
Bill Wohler committed
118 119
            (kill-buffer mh-show-buffer))
        (if (get-buffer folder)
Bill Wohler's avatar
Bill Wohler committed
120 121 122 123
            (kill-buffer folder))
        (when window-config
          (set-window-configuration window-config))
        (message "Folder %s removed" folder))
Bill Wohler's avatar
Bill Wohler committed
124
    (message "Folder not removed")))
Richard M. Stallman's avatar
Richard M. Stallman committed
125

Stefan Monnier's avatar
Stefan Monnier committed
126
(defun mh-rmf-daemon (_process output)
Bill Wohler's avatar
Bill Wohler committed
127 128 129 130 131
  "The rmf PROCESS puts OUTPUT in temporary buffer.
Display the results only if something went wrong."
  (set-buffer (get-buffer-create mh-temp-buffer))
  (insert-before-markers output)
  (when (save-excursion
Bill Wohler's avatar
Bill Wohler committed
132
          (goto-char (point-min))
Bill Wohler's avatar
Bill Wohler committed
133 134 135
          (re-search-forward "^rmf: " (point-max) t))
    (display-buffer mh-temp-buffer)))

Bill Wohler's avatar
Bill Wohler committed
136
;; Shush compiler.
137
(defvar view-exit-action)
Richard M. Stallman's avatar
Richard M. Stallman committed
138

Bill Wohler's avatar
Bill Wohler committed
139
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
140 141 142
(defun mh-list-folders ()
  "List mail folders."
  (interactive)
Bill Wohler's avatar
Bill Wohler committed
143
  (let ((temp-buffer mh-folders-buffer))
Bill Wohler's avatar
Bill Wohler committed
144
    (with-output-to-temp-buffer temp-buffer
145
      (with-current-buffer temp-buffer
Bill Wohler's avatar
Bill Wohler committed
146 147 148 149 150 151
        (erase-buffer)
        (message "Listing folders...")
        (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
                                            "-recurse"
                                          "-norecurse"))
        (goto-char (point-min))
152
        (mh-view-mode-enter)
Bill Wohler's avatar
Bill Wohler committed
153 154 155 156
        (setq view-exit-action 'kill-buffer)
        (message "Listing folders...done")))))

;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
157
(defun mh-pack-folder (range)
158 159
  "Pack folder\\<mh-folder-mode-map>.

160 161 162 163 164
This command packs the folder, removing gaps from the numbering
sequence. If you don't want to rescan the entire folder
afterward, this command will accept a RANGE. Check the
documentation of `mh-interactive-range' to see how RANGE is read
in interactive use.
165

166 167
This command will ask if you want to process refiles or deletes
first and then either run \\[mh-execute-commands] for you or undo
168 169
the pending refiles and deletes.

Bill Wohler's avatar
Bill Wohler committed
170 171
The hook `mh-pack-folder-hook' is run after the folder is packed;
see its documentation for variables it can use."
Richard M. Stallman's avatar
Richard M. Stallman committed
172
  (interactive (list (if current-prefix-arg
Bill Wohler's avatar
Bill Wohler committed
173 174
                         (mh-read-range "Scan" mh-current-folder t nil t
                                        mh-interpret-number-as-range-flag)
Bill Wohler's avatar
Bill Wohler committed
175 176 177 178 179 180 181 182
                       '("all"))))
  (let ((threaded-flag (memq 'unthread mh-view-ops)))
    (mh-pack-folder-1 range)
    (mh-goto-cur-msg)
    (when mh-index-data
      (mh-index-update-maps mh-current-folder))
    (cond (threaded-flag (mh-toggle-threads))
          (mh-index-data (mh-index-insert-folder-headers))))
183
  (run-hooks 'mh-pack-folder-hook)
Richard M. Stallman's avatar
Richard M. Stallman committed
184 185 186
  (message "Packing folder...done"))

(defun mh-pack-folder-1 (range)
Bill Wohler's avatar
Bill Wohler committed
187
  "Close and pack the current folder.
188 189

Display RANGE after packing, or the entire folder if RANGE is nil."
Richard M. Stallman's avatar
Richard M. Stallman committed
190 191
  (mh-process-or-undo-commands mh-current-folder)
  (message "Packing folder...")
Bill Wohler's avatar
Bill Wohler committed
192
  (mh-set-folder-modified-p t)          ; lock folder while packing
Richard M. Stallman's avatar
Richard M. Stallman committed
193
  (save-excursion
Karl Heuer's avatar
Karl Heuer committed
194
    (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
Bill Wohler's avatar
Bill Wohler committed
195
                       "-norecurse" "-fast"))
Bill Wohler's avatar
Bill Wohler committed
196
  (mh-reset-threads-and-narrowing)
Richard M. Stallman's avatar
Richard M. Stallman committed
197 198
  (mh-regenerate-headers range))

Bill Wohler's avatar
Bill Wohler committed
199
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
200
(defun mh-page-digest ()
201
  "Display next message in digest."
Richard M. Stallman's avatar
Richard M. Stallman committed
202 203 204 205 206 207 208
  (interactive)
  (mh-in-show-buffer (mh-show-buffer)
    ;; Go to top of screen (in case user moved point).
    (move-to-window-line 0)
    (let ((case-fold-search nil))
      ;; Search for blank line and then for From:
      (or (and (search-forward "\n\n" nil t)
Bill Wohler's avatar
Bill Wohler committed
209 210
               (re-search-forward "^From:" nil t))
          (error "No more messages in digest")))
Richard M. Stallman's avatar
Richard M. Stallman committed
211 212 213 214 215
    ;; Go back to previous blank line, then forward to the first non-blank.
    (search-backward "\n\n" nil t)
    (forward-line 2)
    (mh-recenter 0)))

Bill Wohler's avatar
Bill Wohler committed
216
;;;###mh-autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
217
(defun mh-page-digest-backwards ()
218
  "Display previous message in digest."
Richard M. Stallman's avatar
Richard M. Stallman committed
219 220 221 222 223 224 225
  (interactive)
  (mh-in-show-buffer (mh-show-buffer)
    ;; Go to top of screen (in case user moved point).
    (move-to-window-line 0)
    (let ((case-fold-search nil))
      (beginning-of-line)
      (or (and (search-backward "\n\n" nil t)
Bill Wohler's avatar
Bill Wohler committed
226 227
               (re-search-backward "^From:" nil t))
          (error "No previous message in digest")))
Richard M. Stallman's avatar
Richard M. Stallman committed
228 229
    ;; Go back to previous blank line, then forward to the first non-blank.
    (if (search-backward "\n\n" nil t)
Bill Wohler's avatar
Bill Wohler committed
230
        (forward-line 2))
Richard M. Stallman's avatar
Richard M. Stallman committed
231 232
    (mh-recenter 0)))

Bill Wohler's avatar
Bill Wohler committed
233 234 235 236 237 238 239 240 241 242 243 244
;;;###mh-autoload
(defun mh-pipe-msg (command include-header)
  "Pipe message through shell command COMMAND.

You are prompted for the Unix command through which you wish to
run your message. If you give a prefix argument INCLUDE-HEADER to
this command, the message header is included in the text passed
to the command."
  (interactive
   (list (read-string "Shell command on message: ") current-prefix-arg))
  (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
        (message-directory default-directory))
245
    (with-current-buffer (get-buffer-create mh-temp-buffer)
Bill Wohler's avatar
Bill Wohler committed
246 247 248 249 250 251 252
      (erase-buffer)
      (insert-file-contents msg-file-to-pipe)
      (goto-char (point-min))
      (if (not include-header) (search-forward "\n\n"))
      (let ((default-directory message-directory))
        (shell-command-on-region (point) (point-max) command nil)))))

Bill Wohler's avatar
Bill Wohler committed
253
;;;###mh-autoload
Karl Heuer's avatar
Karl Heuer committed
254
(defun mh-sort-folder (&optional extra-args)
255
  "Sort folder.
256

257 258 259
By default, messages are sorted by date. The option
`mh-sortm-args' holds extra arguments to pass on to the command
\"sortm\" when a prefix argument EXTRA-ARGS is used."
Richard M. Stallman's avatar
Richard M. Stallman committed
260 261 262
  (interactive "P")
  (mh-process-or-undo-commands mh-current-folder)
  (setq mh-next-direction 'forward)
Bill Wohler's avatar
Bill Wohler committed
263
  (mh-set-folder-modified-p t)          ; lock folder while sorting
Richard M. Stallman's avatar
Richard M. Stallman committed
264
  (message "Sorting folder...")
Bill Wohler's avatar
Bill Wohler committed
265 266 267 268 269 270 271 272 273 274
  (let ((threaded-flag (memq 'unthread mh-view-ops)))
    (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
    (when mh-index-data
      (mh-index-update-maps mh-current-folder))
    (message "Sorting folder...done")
    (mh-scan-folder mh-current-folder "all")
    (cond (threaded-flag (mh-toggle-threads))
          (mh-index-data (mh-index-insert-folder-headers)))))

;;;###mh-autoload
Karl Heuer's avatar
Karl Heuer committed
275
(defun mh-store-msg (directory)
276
  "Unpack message created with \"uudecode\" or \"shar\".
277

278 279 280 281 282
The default DIRECTORY for extraction is the current directory;
however, you have a chance to specify a different extraction
directory. The next time you use this command, the default
directory is the last directory you used. If you would like to
change the initial default directory, customize the option
283 284 285
`mh-store-default-directory', change the value from \"Current\"
to \"Directory\", and then enter the name of the directory for
storing the content of these messages."
Bill Wohler's avatar
Bill Wohler committed
286 287
  (interactive (list (let ((udir (or mh-store-default-directory
                                     default-directory)))
288
                       (read-directory-name "Store message in directory: "
Bill Wohler's avatar
Bill Wohler committed
289
                                       udir udir nil))))
Karl Heuer's avatar
Karl Heuer committed
290
  (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
291
    (with-current-buffer (get-buffer-create mh-temp-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
292
      (erase-buffer)
Karl Heuer's avatar
Karl Heuer committed
293 294
      (insert-file-contents msg-file-to-store)
      (mh-store-buffer directory))))
Richard M. Stallman's avatar
Richard M. Stallman committed
295

Karl Heuer's avatar
Karl Heuer committed
296
(defun mh-store-buffer (directory)
297
  "Unpack buffer created with \"uudecode\" or \"shar\".
298

299
See `mh-store-msg' for a description of DIRECTORY."
Bill Wohler's avatar
Bill Wohler committed
300
  (interactive (list (let ((udir (or mh-store-default-directory
Bill Wohler's avatar
Bill Wohler committed
301
                                     default-directory)))
302
                       (read-directory-name "Store buffer in directory: "
Bill Wohler's avatar
Bill Wohler committed
303
                                       udir udir nil))))
Karl Heuer's avatar
Karl Heuer committed
304
  (let ((store-directory (expand-file-name directory))
Bill Wohler's avatar
Bill Wohler committed
305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
        (sh-start (save-excursion
                    (goto-char (point-min))
                    (if (re-search-forward
                         "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
                        (progn
                          ;; The "cut here" pattern was removed from above
                          ;; because it seemed to hurt more than help.
                          ;; But keep this to make it easier to put it back.
                          (if (looking-at "^[^a-z0-9\"]*cut here\\b")
                              (forward-line 1))
                          (beginning-of-line)
                          (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
                              nil       ;most likely end of a uuencode
                            (point))))))
        (command "sh")
Bill Wohler's avatar
Bill Wohler committed
320 321
        (uudecode-filename "(unknown filename)")
        log-begin)
Karl Heuer's avatar
Karl Heuer committed
322
    (if (not sh-start)
Bill Wohler's avatar
Bill Wohler committed
323 324 325 326 327 328
        (save-excursion
          (goto-char (point-min))
          (if (re-search-forward "^begin [0-7]+ " nil t)
              (setq uudecode-filename
                    (buffer-substring (point)
                                      (progn (end-of-line) (point)))))))
329
    (with-current-buffer (get-buffer-create mh-log-buffer)
Bill Wohler's avatar
Bill Wohler committed
330
      (setq log-begin (mh-truncate-log-buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
331
      (if (not (file-directory-p store-directory))
Bill Wohler's avatar
Bill Wohler committed
332 333
          (progn
            (insert "mkdir " directory "\n")
Bill Wohler's avatar
Bill Wohler committed
334
            (call-process "mkdir" nil mh-log-buffer t store-directory)))
Karl Heuer's avatar
Karl Heuer committed
335 336 337
      (insert "cd " directory "\n")
      (setq mh-store-default-directory directory)
      (if (not sh-start)
Bill Wohler's avatar
Bill Wohler committed
338 339 340
          (progn
            (setq command "uudecode")
            (insert uudecode-filename " being uudecoded...\n"))))
Bill Wohler's avatar
Bill Wohler committed
341 342 343 344 345
    (set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress
    (let ((default-directory (file-name-as-directory store-directory)))
      (if (equal (call-process-region sh-start (point-max) command
                                      nil mh-log-buffer t)
                 0)
346
          (with-current-buffer mh-log-buffer
Bill Wohler's avatar
Bill Wohler committed
347 348
            (insert "\n(mh-store finished)\n"))
        (error "Error occurred during execution of %s" command)))))
Bill Wohler's avatar
Bill Wohler committed
349

Bill Wohler's avatar
Bill Wohler committed
350
;;;###mh-autoload
351
(defun mh-undo-folder (&rest ignored)
352 353
  "Undo all refiles and deletes in the current folder.
Arguments are IGNORED (for `revert-buffer')."
Bill Wohler's avatar
Bill Wohler committed
354
  (interactive)
Bill Wohler's avatar
Bill Wohler committed
355 356 357 358
  (cond ((or mh-do-not-confirm-flag
             (yes-or-no-p "Undo all commands in folder? "))
         (setq mh-delete-list nil
               mh-refile-list nil
359 360
               mh-blacklist nil
               mh-whitelist nil
Bill Wohler's avatar
Bill Wohler committed
361 362 363 364 365 366
               mh-seq-list nil
               mh-next-direction 'forward)
         (with-mh-folder-updating (nil)
           (mh-remove-all-notation)))
        (t
         (message "Commands not undone"))))
Bill Wohler's avatar
Bill Wohler committed
367 368 369

(provide 'mh-funcs)

Bill Wohler's avatar
Bill Wohler committed
370 371 372 373
;; Local Variables:
;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:
Bill Wohler's avatar
Bill Wohler committed
374

375
;;; mh-funcs.el ends here